'To use on linux add the following 2 or 3 directives to your program, run bc.exe on your app
'then send your .CPP file to linux. I rename mine to .c and compile using gpp
'$LINUX
'$CPP
'$NOWIN
' **************************************************************************
' BCX-32 Self-Translating [ Basic To C/C++ Translator ] Version 5.09.1108
' **************************************************************************
' (c) 1999 - 2005 Kevin Diggins
' **************************************************************************
'
' BCX is distributed under the terms of the GNU General Public License (GPL), Version 2.
' The complete source code that is PRODUCED BY BCX is subject to a License Exception to
' the GPL, which allows you to produce commercial applications.
'
'
' BCX LICENSE EXCEPTION
' -------------------------------------------------------------------------------------------
'
' As a special exception, the BCX license gives permission for additional uses of the text
' contained in its release of BCX. The exception is that, if you use BCX to create source
' code that will link the BCX libraries with other files to produce an executable, this
' does not by itself cause the resulting executable to be covered by the GNU GPL. Your
' use of that executable is in no way restricted on account of using BCX to produce source
' code that will link the BCX library code into it.
'
' This exception does not invalidate any other reasons why the executable file might be
' covered by the GNU General Public License. This exception applies only to the code
' released with this BCX explicit exception. If you add or copy code from other sources,
' as the General Public License permits, the above exception does not apply to the code
' that you add in this way.
'
' To avoid misleading anyone as to the status of such modified files, you must delete
' this exception notice from them. If you write modifications of your own for BCX, it
' is your choice whether to permit this exception to apply to your modifications.
' This program is distributed in the hope that it will be useful, but WITHOUT ANY
' WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR
' A PARTICULAR PURPOSE. See the GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License along with
' this program; if not, write to the Free Software Foundation, Inc.,
' 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
' or visit http://www.gnu.org/copyleft/gpl.html#SEC1
CONST Version$ = "5.09.1108 NON $TURBO compiled! $LINUX NON $TURBO FUNCTIONS!" ' BCX Version number
CONST __BCX__ = 1 ' define BCX so we know we are in bc.bas
$COMMENT - Comment section added 10/20/2004 05:00AM by Vic McClung
-------------------------------------------------------------------------------
Developer Guidelines
-------------------------------------------------------------------------------
Code should be written in BCX Basic. If it can not be written in BCX Basic for
some reason or results in code that seems too inefficient then this may be a
cue that a new Basic function is needed.
* All KEYWORDS should be capitalized
* Use two space indentation
* Use spaces not tabs
* Record all notes in reverse chronological order
* When adding a runtime function please enclose it as described below:
* The first line of code should be formatted as follows, that is the
* first line should be type name ( param1, parm1, ....)
* for example:
* FPRINT Outfile,"int Eof(FILE* stream)"
* DO NOT split the line!
* second line should only cantain the opening bracket, for example:
* FPRINT Outfile,"{"
* there should be no space between Outfile and the comma and no space
* between the comman and opening double quote, just like the example below:
*
IF Use_Eof THEN
Add this line---> IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: Eof" <---- name of file used in RTL (Eof.c or Eof.cpp)
FPRINT Outfile,"int EoF (FILE* stream)"
FPRINT Outfile,"{"
FPRINT Outfile," register int c, status = ((c = fgetc(stream)) == EOF);"
FPRINT Outfile," ungetc(c,stream);"
FPRINT Outfile," return status;"
FPRINT Outfile,"}\n\n"
Add this line---> IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
* The last line of code in the function should be:
* FPRINT Outfile,"}\n\n"
* Also when adding a runtime procedure, you need to add a statement in the UseAll subroutine:
Use_Eof = TRUE
* All of this formatting makes it much easier to create the runtime library without having to write a full-fledged parser to do
* it.
* And most importantly....Have fun!
-------------------------------------------------------------------------------
This section is used to communicate todos, changes, ideas, suggestions,etc.
between various developers of BCX.
Example format:
11/15/2004 12:28PM GMT-5 - JD - Removed function foo. The world still had problems
11/14/2004 10:28AM GMT-5 - JD - Added function foo to solve the worlds problems
end of example ----
===============================================================================
08/06/2006 11:27AM GMT-5- MH - Kevin Diggins increased VarInfo.VarDim from 64 to 128 bytes to allow for longer initializers.
László Csöndes reported a bug that caused Global Dynamic arrays of type FILE to emit the wrong code.
Note that for the moment PTR should be specified for global dynamic arrays.
Added support to handle arrays of file handles.
Restructing the way FILEs are handled is on the top of my todo list.
Fixed a bug reported by Shbuyira that would crash BCX when a function was used in a TYPE
without a type specifier. The function will now default to the expected type of integer.
Shbuyira added support for the "character set" member to BCX_FONT.
BCX_FONT.CHARSET
In addition, BCX_SET_FONT will accept a character set as the last optional argument.
Shbuyira inspired two new keywords StartDraw and EndDraw to be used for drawing on a static control.
Written by Kevin Diggins and modified for BCX by Mike H. :)
Syntax:
RetHDC = StartDraw (HWND)
RetHBMP = EndDraw (HWND, RetHDC)
The keyboard version of LINE INPUT will now allow a string variable or a string literal for the user prompt.
Ian Casey modified GetFileName to only allocate space for MAX_PATH in the absence of the
OFN_ALLOWMULTISELECT flag.
I started making the changes by Ian Casey to some of the string functions to better
support unicode. It seems there are other issues that should still be addressed for it to be
correct, such as memory allocation.
Kevin Diggins removed the erroneous LVS_EX_FULLROWSELECT style from BCX_LISTVIEW.
-----------------------------------------------------------------------------------------------
05/03/2006 10:24PM GMT-5- MH - Removed the function VarType since it's function was being duplicated by SubVarType.
Added Waynes fix to SubVarType to correctly print variables that are of single type "char".
Modified slightly to allow for assignments in the declaration.
i.e. DIM A = 55 AS CHAR
Fixed a bug when using the string syntax within a type define.
TYPE foo
a AS DOUBLE
b AS STRING * 255 ' BCX would just eat this :)
END TYPE
-----------------------------------------------------------------------------------------------
04/30/2006 12:50PM GMT-5- MH - Fixed a bug when printing strings declared as "as string" or "as char" the variable
would be emitted as an integer printing the address instead of the string.
(Added "vt_CHAR" to the function SubVarType)
Functions declared as strings still need the "$" type specifier when printing (for now).
Fixed the bad output when using "as string" with Declare and C_Declare.
-----------------------------------------------------------------------------------------------
04/22/2006 12:30PM GMT-5- MH - Kevin Diggins added an optional argument to GETFILENAME$
The last argument is an integer pointer returning the index of the user selected file type.
Example:
DIM F$, Filter$, Ndx
Filter$ = "Bmp Files(*.bmp)|*.Bmp|Gif Files(*.gif)|*.Gif|Jpg Files(*.jpg)|*.Jpg|Png Files(*.png)|*.Png|Tiff Files(*.Tif)|*.Tif"
F$ = TRIM$(UCASE$(GETFILENAME$("Save",Filter$,1,Form1,0,0,0,&Ndx)))
IF F$ <> "" AND NOT INCHR(F$, ".") THEN
SELECT CASE Ndx
CASE 1 : F$ = F$ + ".bmp"
CASE 2 : F$ = F$ + ".gif"
CASE 3 : F$ = F$ + ".jpg"
CASE 4 : F$ = F$ + ".png"
CASE 5 : F$ = F$ + ".tif"
END SELECT
END IF
Modified SaveBmp to allow an HDC or HBITMAP to be passed.
-----------------------------------------------------------------------------------------------
03/19/2006 03:03AM GMT-5- MH - Released version 5.09
-----------------------------------------------------------------------------------------------
03/19/2006 03:03AM GMT-5 MH - Fixed a problem with the new Declare handling so BYREF arguments would not be added to the pool
causing false errors/warnings when the same name was used again in a function or sub.
Changes were made to the BYREF handling in general so you should not need to add parenthesis
when referencing a TYPE.
example:
Function foo (BYREF rc as RECT)
(rc).top = 55 <--- ()'s had to be added before
rc.top = 55 <---- Will now work correctly
Fixed a bug in the WITH handling reported by Ian Casey.
When referencing a multilevel TYPE the base name was being added to all levels.
i.e. With C : .mytype.rc.top was translating to C.mytpeC.rc.top
Changed the pitch argument in Bcx_Set_font to type float to allow fractional pitches.
Fixed another bug when handling dereferenced strings within a TYPE that is passed as a pointer.
----------------------------------------------------------------------------------------------- -----------------------------------------------------------------------------------------------
$COMMENT ================== END OF COMMENT SECTION ============================
$GENFREE
$IPRINT_OFF
$NOINI
$LEANANDMEAN
'$TURBO
$HEADER
typedef long (CALLBACK *CPP_FARPROC)(char *);
static CPP_FARPROC PPProc;
$HEADER
ENUM
vt_UNKNOWN ' Not a Variable
vt_STRLIT ' "Quoted String Literal"
vt_INTEGER ' Integer%
vt_SINGLE ' Single!
vt_DOUBLE ' Double#
vt_LDOUBLE ' Long Double¦
vt_STRVAR ' StringVariable$
vt_DECFUNC ' Translated Decimal Func: Strlen,Asin
vt_NUMBER ' A Pure Literal Number
vt_FILEPTR ' @ FILE*
vt_UDT ' User ( or Windows ) Defined Type
vt_STRUCT ' Structures
vt_UNION ' Unions
vt_LPSTR
vt_BOOL
vt_CHAR
vt_LPSTRPTR
vt_PCHAR
vt_CHARPTR
vt_VOID
vt_LONG
vt_DWORD
vt_FARPROC
vt_LPBYTE
vt_LRESULT
vt_BYTE
vt_SHORT
vt_USHORT
vt_UINT
vt_ULONG
vt_HWND
vt_HDC
vt_COLORREF
vt_HANDLE
vt_HINSTANCE
vt_WNDCLASSEX
vt_VARIANT
END ENUM
'*********************************
CONST vt_VarMin = 2
CONST vt_VarMax = vt_VARIANT
'*********************************
ENUM
mt_ProcessSetCommand
mt_FuncSubDecC_Dec
mt_FuncSubDecC_Dec2
mt_Opts
mt_Opts2
mt_Opts3
mt_OverLoad
mt_OverLoad2
mt_FuncSubx1
mt_FuncSubx2
END ENUM
'******************************
' User Defined Type Support
'******************************
CONST MaxElements = 128
CONST MaxTypes = 512
CONST MaxLocalVars = 512
CONST MaxGlobalVars = 4096 'max size 233000
'******************************
' Library Support
'******************************
CONST MaxLib = 64 ' max no of libraries
'***********************
' Bracket Handling
'***********************
CONST c_SglQt = 39
CONST c_DblQt = 34
CONST c_LPar = 40
CONST c_RPar = 41
CONST c_Komma = 44
CONST c_LtBkt = 91
CONST c_RtBkt = 93
'**************************************************************
' $PROJECT/Runtime Library support
' These are used to keep Modifiers of BCX source code
' from accidently changing certain output lines of
' code that are used by the $PROJECT/Library code
'**************************************************************
CONST BCX_STR_RUNTIME = "Runtime Functions"
CONST BCX_STR_VBS_STRUCTS = "VBSCRIPT SUPPORT STRUCTURES"
CONST BCX_STR_MAIN_PROG = "Main Program"
CONST BCX_STR_SYS_VARS = "System Variables"
CONST BCX_STR_STD_MACROS = "Standard Macros"
CONST BCX_STR_STD_PROTOS = "Standard Prototypes"
CONST BCX_STR_USR_PROCS = "User Subs and Functions"
CONST BCX_STR_USR_VARS = "User Global Variables"
CONST BCX_STR_USR_PROTOS = "User Prototypes"
CONST BCX_STR_USR_CONST = "User Defined Constants"
CONST BCX_STR_USR_TYPES = "User Defined Types And Unions"
'**************************************************************
TYPE ARGTYPE
Arg$
ArgType
END TYPE
TYPE ProtoStore
Prototype$[2048] AS CHAR
Condition$[512] AS CHAR
CondLevel AS INTEGER
END TYPE
TYPE Element
ElementType AS INTEGER
ElementID AS INTEGER
ElementName$[64] AS CHAR
END TYPE
TYPE UserTypeDefs
TypeofDef AS INTEGER
EleCnt AS INTEGER
Elements[MaxElements] AS Element
VarName$[64] AS CHAR
END TYPE
TYPE VarInfo
VarLine AS INTEGER
VarType AS INTEGER
VarDef AS INTEGER
VarPntr AS INTEGER
VarSF AS INTEGER
VarExtn AS INTEGER
VarCondLevel AS INTEGER
VarName$[64] AS CHAR
VarDim$[128] AS CHAR
VarModule[300] AS CHAR
VarCondDef[128] AS CHAR
END TYPE
TYPE VARCODE
VarNo AS INTEGER
Method AS INTEGER
IsPtrFlag AS INTEGER
Header$
Proto$
Functype$
StaticOut$
Token$
AsToken$
END TYPE
'*************************************************************************
' GLOBAL VARIABLES
'*************************************************************************
GLOBAL USING_LINUX
GLOBAL ByrefVars$[1024]
GLOBAL ByrefCnt
GLOBAL CurLine$
GLOBAL gLinesWritten
GLOBAL LoopLocalVar[256]
GLOBAL LoopLocalCnt
GLOBAL GlobalVarCnt
GLOBAL BaseTypeDefsCnt[16]
GLOBAL TypeDefsCnt
GLOBAL LocalVarCnt
GLOBAL LocalDynArrCount ' Local Dynamic String Array Stack Counter
GLOBAL LocalDynaCnt ' Queue Stack Counter
GLOBAL GlobalDynaCnt
GLOBAL Modules$[256] ' array of source filenames
GLOBAL ModuleNdx ' index of source files
GLOBAL CombineRes ' Join generated rc file with existing rc file
GLOBAL UserResFile$ ' holds name of user *.rc file
GLOBAL ResCompiler$ ' resource compiler, lrc.exe
GLOBAL ModuleLineNos[256] ' line no in source files, uses ModuleNdx also
GLOBAL FPtrNdx ' Controls $Include Files
GLOBAL FPtr [256] AS FILE ' Controls $Include Files
GLOBAL Stk$ [4096] ' Parse array
GLOBAL ProtoType [1024] AS ProtoStore ' C prototype declarations of user func's
GLOBAL SrcStk$ [128] ' used in parsing single line if-THEN-else
GLOBAL SplitStk$ [128] ' used in parsing ":" separated lines
GLOBAL SplitCnt
GLOBAL SplitCur
GLOBAL SrcTmp$ ' used for storing string to use as parameter to Parse()
GLOBAL CaseStk$ [256] ' Stack For Nested "Select Case" variable
GLOBAL CaseElseFlag [256] ' Set if Select Case contains a Case Else
GLOBAL Entry$ [256] ' Controls the $OnEntry
GLOBAL Xit$ [256] ' Controls the $OnExit
GLOBAL LocalDynArrName$ [256] ' Queues LOCAL dynamic string arrays
GLOBAL GlobalDynaStr$ [256]
GLOBAL DynaStr$ [256] ' Queues Dynamic strings in SUBS/FUNCTIONS
GLOBAL TmpStk$ [128] ' used in parsing single line if-THEN-else
GLOBAL StartSub$ [32] ' user's startup code subs
GLOBAL StartNdx ' index for StartSub$
GLOBAL ExitSub$ [32] ' user's exit code subs
GLOBAL ExitNdx ' index for ExitSub$
GLOBAL Library$ [MaxLib] ' stores libraries to used
GLOBAL RmLibs$ * 32767 ' libraries to remove
GLOBAL GlobalVarHash[MaxGlobalVars]
GLOBAL GlobalVars[MaxGlobalVars] AS VarInfo ' Holds global variables
GLOBAL LocalVars[MaxLocalVars] AS VarInfo ' Holds local variables
GLOBAL TypeDefs [MaxTypes] AS UserTypeDefs ' Holds typedefs
GLOBAL VarCode AS VARCODE
GLOBAL UmQt 'Handles quoted lines split with a contination _
'************************************************************************************************
GLOBAL Accelerator$
GLOBAL B
GLOBAL CallBackFlag
GLOBAL CallType$ ' Calling convention cdecl, stdcall ...
GLOBAL CaseFlag
GLOBAL CaseVar$
GLOBAL Cmd$
GLOBAL CmdPP$ ' preprocessor file
GLOBAL Comma
GLOBAL Compiler$
GLOBAL CmdLineConst$
GLOBAL CmdLineFileOut$
GLOBAL CurrentFuncType
GLOBAL DidConsts
GLOBAL DimType$
GLOBAL DllDecl$ [800][512] AS CHAR
GLOBAL DllCnt
GLOBAL Loadlibs$ [128][512] AS CHAR
GLOBAL LoadLibsCnt
GLOBAL Elapsed AS SINGLE
GLOBAL EndOfProgram
GLOBAL EntryCnt
GLOBAL ErrFile
GLOBAL szFile$
GLOBAL Filnam$
GLOBAL ForceMainToFunc
GLOBAL Funcname$
GLOBAL Handle$
GLOBAL HFileCnt
GLOBAL HFiles$[128]
GLOBAL HFile$
GLOBAL InConditional
GLOBAL IncludeCount
GLOBAL InIfDef$
GLOBAL Indent
GLOBAL InfoBoxWarn
GLOBAL InDialogEvt
GLOBAL ModDialogEvt
GLOBAL InFunc
GLOBAL InMain
GLOBAL InWinMain
'
'GLOBAL InClass
'
GLOBAL IsCallBack
GLOBAL TurboSize
GLOBAL UseFileTest = TRUE
GLOBAL Use_ContainedIn
GLOBAL Use_Inkey
GLOBAL Use_InkeyD
GLOBAL Use_Inputbox
GLOBAL Use_Infobox
GLOBAL Use_Isptr
GLOBAL Use_Static
GLOBAL InTypeDef
GLOBAL IsAuto
GLOBAL NoTypeDeclare
GLOBAL IsDim
GLOBAL IsExported
GLOBAL IsRegister
GLOBAL IsStatic
GLOBAL IsStdFunc
GLOBAL IsLocal
GLOBAL IsRaw
GLOBAL KillCFile
GLOBAL Keyword1$
GLOBAL LastCmd
GLOBAL LinesRead
GLOBAL Linker$
GLOBAL Lookup$
GLOBAL MakeDLL
GLOBAL Ndx
GLOBAL NoMain
GLOBAL NoDllMain
GLOBAL NoScoot
GLOBAL OkayToSend
GLOBAL Op$
GLOBAL OptimizerEnabled
GLOBAL OptimizerFirstSetting
GLOBAL OptionBase
GLOBAL OutfileClone$
GLOBAL PassOne
GLOBAL Project$
GLOBAL ProtoCnt
GLOBAL ParCnt
GLOBAL Pusher
GLOBAL PPFlag
GLOBAL PPDLL_HANDLE AS HINSTANCE
GLOBAL Use_Library ' Vic McClung for Building Runtime Library
GLOBAL Use_Project ' Vic McClung for $PROJECT Support
GLOBAL Gen_Header ' Vic McClung for $Project Support
GLOBAL Use_Dll ' Vic McClung for Building BCXRT.DLL
GLOBAL Project_Main$ ' main file in project
GLOBAL Project_List$ ' list of files in project
GLOBAL Project_Path$ ' path for project output files, i.e. .h;.c;.cpp
GLOBAL NoRT ' No Runtime
GLOBAL NoKill ' don't erase BCXRT.C file - used for debugging runtime
GLOBAL Quiet ' no output to screen, for use with BCX Builder
GLOBAL ReDirect
GLOBAL SaveOutfileNum AS FILE
GLOBAL Scoot$
GLOBAL ShowStatus
GLOBAL SrcCnt
GLOBAL SrcFlag
GLOBAL TrcFlag
GLOBAL TestForBcxIni
GLOBAL FileIn$
GLOBAL FileOut$
GLOBAL FileErr$
GLOBAL szTmp$ * 1048576
GLOBAL szTmp1$ * 1048576
GLOBAL Src$ * 1048576
GLOBAL AbortSrc$ * 1048576
GLOBAL WarnMsg$ * 32767
GLOBAL T$
GLOBAL Res_File$
GLOBAL ResFileOut$
GLOBAL Test
GLOBAL Statements
GLOBAL szTest$
GLOBAL TestState
GLOBAL TestString
GLOBAL Tipe$
GLOBAL TranslateSlash
GLOBAL TypeName$[16]
GLOBAL UseCpp
GLOBAL UseFlag
GLOBAL UseStdCall
GLOBAL UseLCaseTbl
GLOBAL WinHeaders
GLOBAL W1$
GLOBAL W2$
GLOBAL W3$
GLOBAL Var$
GLOBAL XitCount
'GLOBAL Xport$
GLOBAL Z$
'**********************
' BEGIN BCX_GUI MODIFICATIONS
GLOBAL Use_GUINoMain
GLOBAL Use_MDIGUINoMain
GLOBAL GUIIcon$
GLOBAL GUIMetric$
GLOBAL Use_Wingui
GLOBAL Use_MainEvent
GLOBAL Use_Mdigui
GLOBAL Use_ShowModal
GLOBAL Use_EndModal
GLOBAL Use_BCX_MsgPump
GLOBAL Use_BCX_MDI_MsgPump
GLOBAL Use_BCX_Wnd
GLOBAL Use_BCX_FrameWnd
GLOBAL Use_BCX_SetBkGrdBrush
GLOBAL Use_BCX_SetClassStyle
GLOBAL Use_BCX_SetIcon
GLOBAL Use_BCX_SetIconSm
GLOBAL Use_BCX_SetMetric
GLOBAL Use_BCX_InitGUI
GLOBAL Use_BCX_RegWnd
'GLOBAL Use_BCX_WndClass
GLOBAL Use_BCX_SetCursor
' END OF BCX_GUI MODIFICATIONS
GLOBAL Use_AnsiToWide
GLOBAL Use_Asinh
GLOBAL Use_Acosh
GLOBAL Use_AppActivate
GLOBAL Use_Atanh
GLOBAL Use_Abs
GLOBAL Use_Asc
GLOBAL Use_AppExeName
GLOBAL Use_AppExePath
GLOBAL Use_Bff
GLOBAL Use_Boolstr
GLOBAL Use_Bor
GLOBAL Use_Band
GLOBAL Use_Bnot
GLOBAL Use_BCX_BmpWidth
GLOBAL Use_BCX_BmpHeight
GLOBAL Use_BCX_Class_Info
GLOBAL Use_BCX_LoadBMP
GLOBAL Use_BCX_LoadImage
GLOBAL Use_BCX_Control
GLOBAL Use_BCX_Colordlg
GLOBAL Use_BCX_Cursor
GLOBAL Use_BCX_Fontdlg
GLOBAL Use_BCX_Floodfill
GLOBAL Use_BCX_Get
GLOBAL Use_BCX_Path
GLOBAL Use_BCX_Put
GLOBAL Use_BCX_Preset
GLOBAL Use_BCX_Pset
GLOBAL Use_BCX_Line
GLOBAL Use_BCX_Lineto
GLOBAL Use_BCX_Circle
GLOBAL Use_BCX_Ellipse
GLOBAL Use_BCX_Rectangle
GLOBAL Use_BCX_Roundrect
GLOBAL Use_BCX_Getpixel
GLOBAL Use_BCX_Arc
GLOBAL Use_BCX_OlePicture
GLOBAL Use_BCX_Polygon
GLOBAL Use_BCX_PolyBezier
GLOBAL Use_BCX_Polyline
GLOBAL Use_BCX_Print
GLOBAL Use_BCX_Tile
GLOBAL Use_BCX_Slider
GLOBAL Use_BCX_Splitter
GLOBAL Use_BCX_Tab
GLOBAL Use_BCX_Toolbar
GLOBAL Use_BCX_UpDown
GLOBAL Use_BCX_Get_UpDown
GLOBAL Use_Bin
GLOBAL Use_Bin2dec
GLOBAL Use_Cvd
GLOBAL Use_Cvld
GLOBAL Use_Cvi
GLOBAL Use_Cvl
GLOBAL Use_Cvs
GLOBAL Use_Cdbl
GLOBAL Use_Cldbl
GLOBAL Use_Csng
GLOBAL Use_Clear
GLOBAL Use_Chr
GLOBAL Use_Cbool
GLOBAL Use_Cint
GLOBAL Use_Clng
GLOBAL Use_Cls
GLOBAL Use_Color
GLOBAL Use_Command
GLOBAL Use_ComboBoxLoadFile
GLOBAL Use_Console
GLOBAL Use_CreateRegInt
GLOBAL Use_CreateRegString
GLOBAL Use_Crlf
GLOBAL Use_Csrlin
GLOBAL Use_Curdir
GLOBAL Use_Date
GLOBAL Use_Del
GLOBAL Use_DeleteRegKey
GLOBAL Use_Doevents
GLOBAL Use_Download
GLOBAL Use_Draw
GLOBAL Use_Dynacall
GLOBAL Use_DynamicA
GLOBAL Use_DrawTransBMP
GLOBAL Use_Elf
GLOBAL Use_Enclose
GLOBAL Use_Environ
GLOBAL Use_EnumFile
GLOBAL Use_Eof
GLOBAL Use_Exist
GLOBAL Use_ExitCode
GLOBAL Use_Extract
GLOBAL Use_LeanAndMean
GLOBAL Use_LoadFile
GLOBAL Use_FillArray
GLOBAL Use_FirstInstance
GLOBAL Use_Findfirst
GLOBAL Use_Findnext
GLOBAL Use_FindInType
GLOBAL Use_Fint
GLOBAL Use_Fix
GLOBAL Use_FileLocked
GLOBAL Use_Frac
GLOBAL Use_Fracl
GLOBAL Use_Freefile
GLOBAL Use_Get
GLOBAL Use_GetBmp
GLOBAL Use_Getdrive
GLOBAL Use_Getfilename
GLOBAL Use_Getattr
GLOBAL Use_GetResource
GLOBAL Use_GetTextSize
GLOBAL Use_GenFree
GLOBAL Use_Gosub
GLOBAL Use_Hex
GLOBAL Use_Hex2Dec
GLOBAL Use_Hook
GLOBAL Use_Iif
GLOBAL Use_Inputbuffer
GLOBAL Use_Inp
GLOBAL Use_Inpw
GLOBAL Use_Ins
GLOBAL Use_Instr
GLOBAL Use_Inchr
GLOBAL Use_iReplace
GLOBAL Use_IRemove
GLOBAL Use_Instrrev
GLOBAL Use_Imod
GLOBAL Use_Join
GLOBAL Use_Keypress
GLOBAL Use_Lcase
GLOBAL Use_LccPath
GLOBAL Use_PellesPath
GLOBAL Use_Ldouble
GLOBAL Use_Left
GLOBAL Use_Like
GLOBAL Use_ListBoxLoadFile
GLOBAL Use_Loc
GLOBAL Use_Locate
GLOBAL Use_Lof
GLOBAL Use_Lpad
GLOBAL Use_Ltrim
GLOBAL Use_Mcase
GLOBAL Use_Mid
GLOBAL Use_Midstr
GLOBAL Use_Msgbox
GLOBAL Use_Mkd
GLOBAL Use_Mkld
GLOBAL Use_Mki
GLOBAL Use_Mkl
GLOBAL Use_Mks
GLOBAL Use_Min
GLOBAL Use_Modstyle
GLOBAL Use_Max
GLOBAL Use_Now
GLOBAL Use_Numqsortdint
GLOBAL Use_Numqsortaint
GLOBAL Use_Numqsortdfloat
GLOBAL Use_Numqsortafloat
GLOBAL Use_Numqsortddouble
GLOBAL Use_Numqsortadouble
GLOBAL Use_Idxqsort
GLOBAL Use_IdxqsortSt
GLOBAL Use_PtrqsortSt
GLOBAL Use_Oct
GLOBAL Use_Outp
GLOBAL Use_Outpw
GLOBAL Use_Overloaded
GLOBAL Use_OSVersion
GLOBAL Use_Panel
GLOBAL Use_Pause
GLOBAL Use_PeekStr
GLOBAL Use_Pos
GLOBAL Use_Printer
GLOBAL Use_ProgressBar
GLOBAL Use_Proto
GLOBAL Use_Put
GLOBAL Use_QBColor
GLOBAL Use_Randomize
GLOBAL Use_Rec
GLOBAL Use_RecCount
GLOBAL Use_Remain
GLOBAL Use_Remove
GLOBAL Use_Repeat
GLOBAL Use_Replace
GLOBAL Use_Reverse
GLOBAL Use_Right
GLOBAL Use_Rpad
GLOBAL Use_Rnd
GLOBAL Use_Exp
GLOBAL Use_Retain
GLOBAL Use_Round
GLOBAL Use_Rtrim
GLOBAL Use_Run
GLOBAL Use_SaveBmp
GLOBAL Use_Scan
GLOBAL Use_Screen
GLOBAL Use_Setattr
GLOBAL Use_SearchPath
GLOBAL Use_Set_BCX_Bitmap
GLOBAL Use_Set_BCX_Bitmap2
GLOBAL Use_Set_BCX_BmpButton
GLOBAL Use_Set_BCX_Icon
GLOBAL Use_Sgn
GLOBAL Use_SingleFile
GLOBAL Use_Sound
GLOBAL Use_Space
GLOBAL Use_Split
GLOBAL Use_DSplit
GLOBAL Use_StartupCode
GLOBAL Use_Stristr
GLOBAL Use_StrStr
GLOBAL Use_Str
GLOBAL Use_Strl
GLOBAL Use_Str_Cmp
GLOBAL Use_Strim
GLOBAL Use_String
GLOBAL Use_Strptr
GLOBAL Use_Strqsorta
GLOBAL Use_Strqsortd
GLOBAL Use_Strtoken
GLOBAL Use_DynStrqsorta
GLOBAL Use_DynStrqsortd
GLOBAL Use_RegInt
GLOBAL Use_RegString
GLOBAL Use_Resource
GLOBAL Use_GenResFile
GLOBAL Use_Swap
GLOBAL Use_Sysdir
GLOBAL Use_Sysmacros
GLOBAL Use_SysStr
GLOBAL Use_sziif
GLOBAL Use_Tally
GLOBAL Use_Tempdir
GLOBAL Use_TempFileName
GLOBAL Use_Textmode
GLOBAL Use_Threads
GLOBAL Use_Time
GLOBAL Use_Timer
GLOBAL Use_Treeview
GLOBAL Use_Trim
GLOBAL Use_Turbo
GLOBAL Use_Ucase
GLOBAL Use_Using
GLOBAL Use_Ubound
GLOBAL Use_VChr
GLOBAL Use_VBS
GLOBAL Use_Verify
GLOBAL Use_Val
GLOBAL Use_Vall
GLOBAL Use_WideToAnsi
GLOBAL Use_Vscroll
GLOBAL Use_Hscroll
GLOBAL Use_Windir
'*******************
GLOBAL Use_BCX_Input
GLOBAL Use_Bitmap
GLOBAL Use_Blackrect
GLOBAL Use_BmpButton
GLOBAL Use_Button
GLOBAL Use_Center
GLOBAL Use_Checkbox
GLOBAL Use_Combobox
GLOBAL Use_Datepick
GLOBAL Use_Edit
GLOBAL Use_BCXMDialog
GLOBAL Use_BCXDialog
GLOBAL Use_Form
GLOBAL Use_GetText
GLOBAL Use_Grayrect
GLOBAL Use_Group
GLOBAL Use_Hide
GLOBAL Use_Icon
GLOBAL Use_Label
GLOBAL Use_Listbox
GLOBAL Use_Listview
GLOBAL Use_PlayWav
GLOBAL Use_Radio
GLOBAL Use_Refresh
GLOBAL Use_Richedit
GLOBAL Use_SetColor
GLOBAL Use_SetFont
GLOBAL Use_SetFormColor
GLOBAL Use_SetText
GLOBAL Use_Show
GLOBAL Use_Status
GLOBAL Use_Whiterect
'********************************
' PB Compatible String Constants
'********************************
GLOBAL Use_BEL
GLOBAL Use_BS
GLOBAL Use_CR
GLOBAL Use_DDQ
GLOBAL Use_DQ
GLOBAL Use_EOF
GLOBAL Use_ESC
GLOBAL Use_FF
GLOBAL Use_LF
GLOBAL Use_NUL
GLOBAL Use_SPC
GLOBAL Use_TAB
GLOBAL Use_VT
'*********************
GLOBAL O1$ ' "%o"
GLOBAL S1$ ' "%s"
GLOBAL S2$ ' "%s%s"
GLOBAL S3$ ' "%s%s%s"
GLOBAL D1$ ' "% .15G"
GLOBAL D2$ ' "% .19LG"
GLOBAL X1$ ' "%X"
GLOBAL T0$ ' "%H:%M:%S"
GLOBAL T1$ ' "%H"
GLOBAL T2$ ' "%M"
GLOBAL T3$ ' "%S"
GLOBAL T4$ ' "%p"
GLOBAL T5$ ' "%Y"
GLOBAL T6$ ' "%m"
GLOBAL T7$ ' "%d"
GLOBAL T8$ ' "%A"
GLOBAL T9$ ' "%w"
GLOBAL T10$ ' "%j"
GLOBAL T11$ ' "%U"
GLOBAL U1$
GLOBAL Slash1$ ' "\"
GLOBAL Slash2$ ' "\\"
'**************************************************************
GLOBAL prcFile$ ' translated subs and functions
GLOBAL udtFile$ ' translated User Defined Types
GLOBAL datFile$ ' translated DATA statements
GLOBAL cstFile$ ' translated CONSTants
GLOBAL ovrFile$ ' translated overloaded subs and functions
GLOBAL hdrFile$ ' user specified .h directives
GLOBAL setFile$ ' translated GLOBAL set statements
GLOBAL resFile$ ' user specified .rc directives
GLOBAL enuFile$ ' user GLOBAL enum blocks
SET VarStorage[3][10] AS CHAR
"static ",
"extern ",
""
END SET
'*************************************************************************
' GLOBAL VARIABLES FOR LATE BINDING COM SUPPORT
'*************************************************************************
' bc.500_com
DIM RAW ComSwitchON = TRUE ' flag indicating use of COM in source
DIM RAW Use_COM = 0 ' COM is used in project, so emit com functions.
DIM RAW Use_MULTITHREADED_SW = 0 ' for multithreaded applications
CONST COM_STACK_SIZE = 64 ' number of chained dispatch objects.
TYPE COM_NAMES_STORAGE ' used for recognition of Object - COM variables
name[65] AS CHAR
initialized AS BOOL
END TYPE
CONST MAX_Global_COM_Objects = 64 ' max number of Global Com objects that may be declared in program
CONST MAX_Local_COM_Objects = 64 ' max number of Local Com objects that may be declared in Functions/Subs
CONST MAX_BCX_COM_NESTED_WITHS = 32 ' max number of nested (WITH - END WITH) constructions, used for COM objects
GLOBAL gl_COM_names_storage[MAX_Global_COM_Objects+1] AS COM_NAMES_STORAGE ' variable that holds global names of COM objects
GLOBAL lc_COM_names_storage[MAX_Local_COM_Objects+1] AS COM_NAMES_STORAGE ' variable that holds names of COM objects defined in SUBs and FUNCs
GLOBAL gl_COM_names_index% ' count of com objects used as global variables
GLOBAL lc_COM_names_index% ' count of com objects used as locals (in SUBs and FUNCTIONs)
GLOBAL gl_COM_names_free_index% ' pointer to a free space in gl_COM_names_storage[]
GLOBAL lc_COM_names_free_index% ' pointer to a free space in lc_COM_names_storage[]
DIM RAW build_com_trace_code = FALSE
DIM RAW ProcessingCOM_Set = FALSE
DIM RAW bcx_com_open_with_statement = 0
DIM RAW bcx_get_com_enumerator = 0 ' temp variable used in (for each ...) constructions
GLOBAL com_with_temp_str_name$
' Controls code emission for COM Parser (size optimizations)
DIM RAW Use_BCX_COM_CreateObject = 0
DIM RAW Use_BCX_COM_GetObject = 0
DIM RAW Use_BCX_COM_DispatchObject = 0
DIM RAW Use_BCX_COM_GetProperty = 0
DIM RAW Use_BCX_COM_SetProperty = 0
DIM RAW Use_BCX_COM_InvokeMethod = 0
DIM RAW Use_BCX_COM_SafeArray = 0
DIM RAW Use_BCX_COM_UsesConversion = TRUE ' quick fix this is really necessary!
DIM RAW Use_UNICODE_Switch = 0 ' for unicode support
DIM RAW Use_COM_Collections = 0 ' for unicode support
' bc.500_com
'*************************************************************************
' END OF: GLOBAL VARIABLES FOR LATE BINDING COM SUPPORT
'*************************************************************************
'*************************************************************************
' CODE BEGINS
'*************************************************************************
IncludeCount = 28 ' C Library Header Files Count
ProtoCnt = 0 ' Prototypes counter
WinHeaders = TRUE ' Include Win specific headers (*.h)
TranslateSlash = TRUE ' Default TO changing "\" TO "\\"
OkayToSend = TRUE
OptimizerEnabled = TRUE
OptimizerFirstSetting = TRUE
Use_SingleFile = TRUE
NoRT = FALSE
Use_StartupCode = FALSE
StartNdx = 0
Use_ExitCode = FALSE
Use_LeanAndMean = FALSE
ExitNdx = 0
Gen_Header = FALSE
Project_Main$ = ""
HFile$ = ""
CmdLineFileOut$ = ""
RmLibs$ = ""
InMain = TRUE
TestState = FALSE
CmdLineConst$ = ""
Project_List$ = ""
Slash1$ = CHR$(92)
Slash2$ = CHR$(92,92)
D1$ = VCHR$(8,34,37,32,46,49,53,71,34)
D2$ = VCHR$(9,34,37,32,46,49,57,76,71,34)
O1$ = VCHR$(4,34,37,111,34)
S1$ = VCHR$(4,34,37,115,34)
S2$ = VCHR$(6,34,37,115,37,115,34)
S3$ = VCHR$(8,34,37,115,37,115,37,115,34)
T0$ = VCHR$(10,34,37,72,58,37,77,58,37,83,34)
T1$ = VCHR$(4,34,37, 72,34)
T2$ = VCHR$(4,34,37, 77,34)
T3$ = VCHR$(4,34,37, 83,34)
T4$ = VCHR$(4,34,37,112,34)
T5$ = VCHR$(4,34,37, 89,34)
T6$ = VCHR$(4,34,37,109,34)
T7$ = VCHR$(4,34,37,100,34)
T8$ = VCHR$(4,34,37, 65,34)
T9$ = VCHR$(4,34,37,119,34)
T10$ = VCHR$(4,34,37,106,34)
T11$ = VCHR$(4,34,37, 85,34)
X1$ = VCHR$(4,34,37,88,34)
U1$ = VCHR$(7,37,39,42,46,42,32,102)
W1$ = ENC$("%*.*s%*.*lf")
W2$ = ENC$("%s%*.*s")
W3$ = ENC$("%s%*.*s%s")
'**************************************************************************
PPFlag = FALSE ' Initialize User-Defined PreProcessor
PPProc = NULL
PPDLL_HANDLE = NULL
'**************************************************************************
'**************************************************************************
' I append & test for Xport$ IN SUB & FUNC Names that are exported IN DLLs
'Xport$ = "nvksigd" ' a fairly unique sequence of chars
'**************************************************************************
IF COMMAND$ = "" THEN
PRINT "BCX-32: BASIC to C/C++ Translator by Kevin Diggins (c) 1999-2005 Ver ";
PRINT Version$
PRINT "Compiled with ";
$IF __BCPLUSPLUS__
PRINT "Borland C++"
$ELSEIF __BORLANDC__
PRINT "Borland C"
$ELSEIF __POCC__
PRINT "Pelles C"
$ELSEIF __LCC__
PRINT "LCCWin32 C"
$ELSEIF __WATCOM_CPLUSPLUS__
PRINT "Open Watcom C++"
$ELSEIF __MINGW32__
PRINT "MinGW32 C"
$ELSEIF __DMC__
PRINT "Digital Mars C/C++"
$ELSEIF _MSC_VER
PRINT "Microsoft Visual C++"
$ELSE
PRINT "Unknown"
$ENDIF
PRINT " Usage: BC infile [.bas] [options]"
PRINT " [-c] Generate C++ Compatible code"
PRINT " [-d] DEFINE a constant ... ex. BC MyFile -D:MyConst[=SomeValue]"
PRINT " [-e] Write ERRORS to BCX.ERR file"
PRINT " [-f] Output FILENAME... ex. BC MyFile -f:C:\\MyFiles\\MyFile.c"
PRINT " [-h] Generate HEADER file for use with $Projects"
PRINT " [-i] Send Warnings and Errors to INFOBOX"
PRINT " [-k] KILL the generated BCX generated 'C' file"
PRINT " [-l] Create Runtime LIBRARY source and header Files"
PRINT " [-n] Enable NO RUNTIME Code Generation"
PRINT " [-o] OUTPUT a copy of the generated C file to STDOUT"
PRINT " [-q] QUIET - No output to screen during translation"
PRINT " [-r] Update BCX Path variable in the Windows REGISTRY"
PRINT " [-s] Show STATUS of translation by line number"
PRINT " [-w] Enable WARNINGS during translation"
PRINT " [-x] EXCLUDE Win32 Headers from the resulting C file"
PRINT " [-t] TURBO Mode ON w/optional size ... ex. BC MyFile -t[:1024]"
PRINT " [-u] Turn UNICODE Support ON"
PRINT " -------Obsolete switches-------"
PRINT " [-m] Enable MODULE Name/Line Number Reporting"
PRINT " [-p] Generate PELLES C Compatible code"
IF BCXPATH$ = "Not Found" THEN
CREATEREGSTRING _
(HKEY_LOCAL_MACHINE,"Software\\Bcx-32\\Bcx\\Settings","Path",APPEXEPATH$)
PRINT " BCX Path set to ", BCXPATH$
END IF
CALL FREEGLOBALS
END
END IF
IF BCXPATH$ = "Not Found" THEN
CREATEREGSTRING _
(HKEY_LOCAL_MACHINE,"Software\\Bcx-32\\Bcx\\Settings","Path",APPEXEPATH$)
PRINT " BCX Path set to ", BCXPATH$
END IF
IF LCASE$(COMMAND$) = "-r" THEN
CREATEREGSTRING _
(HKEY_LOCAL_MACHINE,"Software\\Bcx-32\\Bcx\\Settings","Path",APPEXEPATH$)
PRINT " BCX Path set to ", BCXPATH$
END
END IF
' build runtime library - no filename as firsts parameter
IF LCASE$(LEFT$(COMMAND$(1),2)) = "-l" THEN
Use_Library = TRUE
Cmd$ = LCASE$(COMMAND$(1))
IF INCHR(Cmd$, "c") THEN UseCpp = TRUE
IF INCHR(Cmd$, "n") THEN NoKill = TRUE
IF INCHR(Cmd$, "d") THEN Use_Dll = TRUE
IF INCHR(Cmd$, "q") THEN Quiet = TRUE
ELSE
NoKill = FALSE
Use_Project = FALSE
Use_Library = FALSE
Use_Dll = FALSE
Quiet = FALSE
END IF
FOR INTEGER i = 2 TO ARGC-1
IF INSTR(LCASE$(ARGV$[i]),"-f") THEN CmdLineFileOut$ = MID$(ARGV$[i],4)
IF INSTR(LCASE$(ARGV$[i]),"-d") THEN CmdLineConst$ = CmdLineConst$ + MID$(ARGV$[i],4) + CHR$(1)
IF LCASE$(ARGV$[i]) = "-c" THEN UseCpp = TRUE
IF LCASE$(ARGV$[i]) = "-e" THEN ErrFile = TRUE
IF LCASE$(ARGV$[i]) = "-h" THEN Gen_Header = TRUE
IF LCASE$(ARGV$[i]) = "-i" THEN InfoBoxWarn = TRUE
IF LCASE$(ARGV$[i]) = "-q" THEN Quiet = TRUE
IF LCASE$(ARGV$[i]) = "-k" THEN KillCFile = TRUE
IF LCASE$(ARGV$[i]) = "-n" THEN NoRT = TRUE
IF LCASE$(ARGV$[i]) = "-o" THEN ReDirect = TRUE
IF LCASE$(ARGV$[i]) = "-s" THEN ShowStatus = TRUE
IF LCASE$(ARGV$[i]) = "-w" THEN TestState = TRUE
IF LCASE$(ARGV$[i]) = "-x" THEN WinHeaders = FALSE
IF LCASE$(ARGV$[i]) = "-u" THEN Use_UNICODE_Switch = TRUE
IF INSTR(LCASE$(ARGV$[i]),"-t") THEN
Use_Turbo = TRUE
TurboSize = VAL(MID$(ARGV$[i],4))
IF TurboSize <> 0 THEN
IF (TurboSize & (TurboSize-1)) <> 0 THEN
TurboSize = 512
Warning("Invalid $Turbo size - defaulting to 512")
END IF
ELSE
TurboSize = 512
END IF
END IF
NEXT
'****************************** [ Announce Program ] ********************************
IF ShowStatus THEN CLS
IF NOT Quiet THEN
PRINT "BCX-32: BASIC to C/C++ Translator by Kevin Diggins (c) 1999-2005 Ver "; Version$
END IF
'************************************************************************************
IF INCHR(COMMAND$(1),".") THEN
Cmd$ = COMMAND$(1) ' Allow ANY extension
ELSE
Cmd$ = UCASE$(EXTRACT$(COMMAND$(1),".")) + ".BAS" ' Assume implicit .BAS
END IF
IF Use_Library THEN
OPEN "bcxRT.bas" FOR OUTPUT AS hRT
FPRINT hRT, "$NOINI"
FPRINT hRT, "$NOMAIN"
CLOSE hRT
Cmd$ = "BCXRT.BAS"
END IF
IF INCHR(Cmd$,"*") OR INCHR(Cmd$,"?") THEN Cmd$ = FINDFIRST$(Cmd$)
CmdPP$ = "" 'quiet the warning
$IF BCXPP
'
' Invoke the BCX Standard Preprocessor - bcxpp.exe
CmdPP$ = EXTRACT$(Cmd$,".") + ".PPO"
IF NOT Quiet THEN PRINT "Preproccessing " + Cmd$ + "..."
SHELL "BCXPP.EXE " + Cmd$
IF NOT Quiet THEN PRINT "Translating " + CmdPP$ + "..."
FileIn$ = CmdPP$
'
$ELSE
FileIn$ = Cmd
$ENDIF
IF CmdLineFileOut$ = "" THEN
FileOut$ = LEFT$(Cmd$, INSTRREV(Cmd$,".",0)-1) + ".C"
ELSE
FileOut$ = CmdLineFileOut$
END IF
FileErr$ = LEFT$(Cmd$, INSTRREV(Cmd$,".",0)-1) + ".ERR"
IF EXIST(FileErr$) THEN
SHELL "DEL " + FileErr$
END IF
'*******************************************************
prcFile$ = TEMPFILENAME$(TEMPDIR$,"prc")
udtFile$ = TEMPFILENAME$(TEMPDIR$,"udt")
datFile$ = TEMPFILENAME$(TEMPDIR$,"dat")
cstFile$ = TEMPFILENAME$(TEMPDIR$,"cst")
ovrFile$ = TEMPFILENAME$(TEMPDIR$,"ovr")
hdrFile$ = TEMPFILENAME$(TEMPDIR$,"hdr")
setFile$ = TEMPFILENAME$(TEMPDIR$,"set")
resFile$ = TEMPFILENAME$(TEMPDIR$,"res")
enuFile$ = TEMPFILENAME$(TEMPDIR$,"enu")
'**************************************************************************
OPEN FileIn$ FOR INPUT AS SourceFile
OPEN FileOut$ FOR OUTPUT AS FP2 ' THE FINAL C FILE <<<<<<<<
'**************************************************************************
Outfile = FP2 ' Outfile = FP3 when in a SUB or FUNCTION
'**************************************************************************
OPEN prcFile$ FOR OUTPUT AS FP3 ' Temp File FOR Storing User Functions
OPEN udtFile$ FOR OUTPUT AS FP4 ' Temp File FOR Storing User Def Types
OPEN datFile$ FOR OUTPUT AS FP5 ' Temp File FOR Storing User "Data"
OPEN cstFile$ FOR OUTPUT AS FP6 ' Temp File FOR Storing User CONST
OPEN hdrFile$ FOR OUTPUT AS FP7 ' Temp File FOR Storing User .H files
OPEN ovrFile$ FOR OUTPUT AS FP8 ' Temp File FOR Storing overloaded funcs
OPEN setFile$ FOR OUTPUT AS FP9 ' Temp File FOR Storing GLOBAL SET Vars
OPEN resFile$ FOR OUTPUT AS FP10 ' Temp File FOR Storing User .rc files
OPEN enuFile$ FOR OUTPUT AS FP11 ' Temp File FOR Storing User global enums
'*************************************************************************
ModuleNdx = 1
Modules$[ModuleNdx] = FileIn$ ' store the current module name
ModuleLineNos[ModuleNdx] = 0
'**************************************************************************
IF Use_Library THEN UseAll( UseCpp )
IF NoRT = TRUE THEN CALL EnableProject
global popstart
'*****************
' The Main LOOP
'*****************
ReadSrcLine:
'*****************
WHILE NOT EOF(SourceFile) OR SplitCnt
IF SplitCnt = 0 THEN 'Process separated lines before
LINE INPUT SourceFile,Src$ 'getting next line from file.
'**************************
IF RTRIM$(LCASE$(LEFT$(Src$,6)))="$linux" THEN
USING_LINUX=1
END IF
IF popstart=0 THEN
popstart=1
CALL EmitProlog
'CALL BumpUp
CALL ClearIfThenStacks
CALL EmitCompilerDefines
CALL EmitCmdLineConst
END IF
'$INCLUDE "BCXPreProcess.inc"
ModuleLineNos[ModuleNdx]++
CALL StripCode(Src$) 'Remove spaces, tabs, comments
IF *Src = 0 THEN ITERATE
IF JoinLines(Src$) = 1 THEN ITERATE 'Join continuation lines " _"
IF INCHR(Src$,"[") THEN CALL BracketHandler(Src$,0) 'Fix Brackets
IF SplitLines(Src$) THEN Src$ = SplitStk$[++SplitCur] 'Split statements separated by
ELSE 'colons and single line if/then
Src$ = SplitStk$[++SplitCur]
END IF
IF SplitCur = SplitCnt THEN SplitCur = SplitCnt = 0
IF *Src = 0 THEN ITERATE
AbortSrc$ = Src$
'***************************************************************************
ReProcess: ' label added for use with BCX User-Defined PreProcessor
' so line could be changed and be run back thru BCX from start
'***************************************************************************
IF TrcFlag THEN
IF NOT iMatchLft(Src$,"$trace") THEN
IF NOT iMatchLft(Src$,"end ") AND INSTR(Src$,"FUNCTION",0,1) = 0 THEN
FPRINT Outfile,"// [", TRIM$(Modules$[ModuleNdx]), " - ", TRIM$(STR$(ModuleLineNos[ModuleNdx])), "] ", Src$
Z$ = TRIM$(Modules$[ModuleNdx])
Z$ = REPLACE$(Z$,"\\","\\\\")
Z$ = " " + Z$ + " - " + STR$(ModuleLineNos[ModuleNdx]) + " "
Z$ = "printf(" + ENC$(Z$) + ");"
FPRINT Outfile,Z$
END IF
END IF
END IF
'******************************
IF SrcFlag THEN
IF NOT iMatchLft(Src$,"$sourc") AND *Src <> 33 THEN '33 = !
FPRINT Outfile,"// [", TRIM$(Modules$[ModuleNdx]), " - ", TRIM$(STR$(ModuleLineNos[ModuleNdx])), "] ", Src$
END IF
END IF
'******************************
IF ShowStatus THEN
LOCATE 2,1,0
PRINT "Processing Module: ", TRIM$(Modules$[ModuleNdx]), " - Line:", ModuleLineNos[ModuleNdx]
END IF
'******************************
IF Src[0] = 33 THEN 'Test for ! symbol -- inline C
Src[0] = 32
FPRINT Outfile,Src$
Src$ = ""
END IF
'******************************
IF iMatchLft(Src$,"bcx_resource ") THEN
Use_GenResFile = TRUE
FPRINT FP10, MID$(Src$,14)
Src$ = ""
END IF
'******************************
IF *Src$ = 0 THEN ITERATE
DIM RAW di
di = Directives()
IF di = 0 THEN GOTO ReadNextLine
IF di = 1 THEN GOTO ReadSrcLine
IF iMatchLft(Src$,"set ") THEN
IF ComSwitchON = TRUE THEN
'Check for COM SET Statement
ProcessingCOM_Set = FALSE
IF INCHR(Src$, "=") THEN
Use_COM = UseFlag = TRUE
Src$ = MID$(Src$,5)
ProcessingCOM_Set = TRUE
ELSE
CALL ProcessSetCommand(0)
END IF
ELSE
CALL ProcessSetCommand(0)
END IF
END IF
IF iMatchLft(Src$,"sharedset ") THEN
CALL ProcessSetCommand(1)
END IF
' handle_msg handler
IF iMatchLft(Src$,"handle_msg") THEN
CALL ProcessMsgCracker
END IF
IF iMatchLft(Src$,"handle_cmd") THEN
CALL ProcessCmdHandler
END IF
IF iMatchLft(Src$,"end handler") THEN
CALL ProcessMsgHandlerEnd
END IF
IF iMatchLft(Src$,"msghandler") OR iMatchLft(Src$,"cmdhandler") THEN
CALL ProcessMsgHandler
END IF
IF ComSwitchON = TRUE THEN
IF Find_COM_statement(Src$, FALSE) = TRUE THEN
Src$ = ""
END IF
END IF
PassOne = TRUE
'****************
' CallParse:
'****************
CALL CheckParQuotes
IF PPFlag THEN ' PreProcess the line
GLOBAL ppret AS LONG
ppret = PPProc(Src$) ' Error in PP returns error message in Src$
IF ppret = 0 THEN Abort(Src$)
IF ppret = 2 THEN GOTO ReProcess
END IF
IF SpecialCaseHandler(Src$) THEN ITERATE
CALL Parse(Src$)
PassOne = FALSE
IF Ndx THEN
CALL Emit
END IF
'****************
ReadNextLine:
'****************
WEND
'***************************************************
' END OF MAIN LOOP -- All Source code has been read
'***************************************************
' everything from here below must be stopped from
' executing more than once
IF CmdLineConst$ > "" THEN
Src$ = "CONST " + CmdLineConst$
CALL Parse (Src$)
CALL Emit
CmdLineConst$ = ""
END IF
IF TestForBcxIni = FALSE THEN
TestForBcxIni = TRUE
szFile$ = CURDIR$ + "\\bcx.ini"
IF NOT EXIST(szFile$) THEN
szFile$ = APPEXEPATH$ + "bcx.ini"
END IF
IF EXIST(szFile$) THEN
CALL PushFileIO
OPEN szFile$ FOR INPUT AS SourceFile
Modules$[++ModuleNdx] = szFile$
ModuleLineNos[ModuleNdx] = 0
GOTO ReadSrcLine
END IF
END IF
IF Use_VBS THEN
CALL Emit_VBSCRIPT_Support
END IF
'IF Use_Project = FALSE AND Use_Library = FALSE THEN
IF Use_Project = FALSE THEN
STATIC Pass_1
INCR Pass_1
IF Pass_1 = 1 THEN
AddLibrary("kernel32.lib")
AddLibrary("user32.lib")
AddLibrary("gdi32.lib")
AddLibrary("comctl32.lib")
AddLibrary("advapi32.lib")
AddLibrary("winspool.lib")
AddLibrary("shell32.lib")
AddLibrary("ole32.lib")
AddLibrary("oleaut32.lib")
AddLibrary("uuid.lib")
AddLibrary("odbc32.lib")
AddLibrary("odbccp32.lib")
AddLibrary("winmm.lib")
AddLibrary("comdlg32.lib")
AddLibrary("imagehlp.lib")
AddLibrary("version.lib")
END IF
CALL Emit_Pragmas
END IF ' Use_Project = FALSE
FLUSH (Outfile) '*************************************
IF FPtrNdx THEN ' Pop out the $Include File Handles
CALL PopFileIO ' and close them in sequence until
GOTO ReadSrcLine ' we end up back in the main file
END IF '*************************************
CALL EmitLibs
IF Use_GenFree AND GlobalDynaCnt THEN
CALL MakeFreeGlobals
END IF
CALL ExportInternalConst
CALL EmitEpilog
CALL CloseAll
CALL AddProtos
CALL DeclareVariables
CALL AddFuncs
CALL CloseAll
'***************************
' Final Disk Gymnastics
'***************************
IF UseCpp AND CmdLineFileOut$ = "" THEN
szTmp$ = EXTRACT$(UCASE$(FileOut$),".") + ".CPP"
KILL szTmp$
RENAME FileOut$, szTmp$
FileOut$ = szTmp$
END IF
OPEN FileOut$ FOR INPUT AS FP1
OPEN hdrFile$ FOR INPUT AS FP2
OPEN "$temp$" FOR OUTPUT AS FP3
FOR INTEGER i = 1 TO 4
LINE INPUT FP1,Z$ ' Read from "C" FileOut$
FPRINT FP3,Z$ ' Write to $temp$
gLinesWritten++
NEXT
IF UseCpp THEN
IF NOT Use_Library THEN FPRINT FP3,"// Translated for compiling with a C++ Compiler"
ELSE
IF NOT Use_Library THEN FPRINT FP3,"// Translated for compiling with a C Compiler"
END IF
IF NOT Use_Library THEN FPRINT FP3,"// *************************************************************"
gLinesWritten++
IF Use_MULTITHREADED_SW THEN
FPRINT FP3, "#define __BCX_MULTITHREADED__"
gLinesWritten++
END IF
IF Use_COM OR Use_VBS THEN
FPRINT FP3, "#ifndef _WIN32_DCOM"
FPRINT FP3, "#define _WIN32_DCOM"
FPRINT FP3, "#endif"
gLinesWritten += 3
END IF
'
IF Use_UNICODE_Switch THEN
' this should be emmited before any other windows header
FPRINT FP3, "#ifndef UNICODE"
FPRINT FP3, "#define UNICODE"
FPRINT FP3, "#endif"
FPRINT FP3, "#ifndef _UNICODE"
FPRINT FP3, "#define _UNICODE"
FPRINT FP3, "#endif"
gLinesWritten += 6
END IF
'
IF Use_LeanAndMean = TRUE THEN
FPRINT FP3,"#define WIN32_LEAN_AND_MEAN // limits reading seldom used header files"
gLinesWritten++
END IF
DO
LINE INPUT FP1,Z$ ' Read from "C" FileOut$
FPRINT FP3,Z$ ' Write to $temp$
gLinesWritten++
IF LEFT$(Z$,8) <> "#include" THEN EXIT LOOP
LOOP
WHILE NOT EOF(FP2)
LINE INPUT FP2,Z$ ' Read from BCX.HDR
FPRINT FP3,Z$ ' Write to $temp$
gLinesWritten++
WEND
WHILE NOT EOF(FP1)
STATIC bMainOut = 0
LINE INPUT FP1,Z$ ' Read from "C" FileOut$
FPRINT FP3,Z$ ' Write to $temp$
gLinesWritten++
IF bMainOut THEN ITERATE
IF _
LEFT$(LTRIM$(Z$),8) = "int main" OR _
LEFT$(LTRIM$(Z$),18) = "int WINAPI WinMain" OR _
LEFT$(LTRIM$(Z$),41) = "__declspec(dllexport) BOOL WINAPI DllMain" THEN
WHILE TRIM$(Z$) <> "{"
LINE INPUT FP1,Z$
FPRINT FP3,Z$
gLinesWritten++
WEND
IF Use_StartupCode THEN
FPRINT FP3,Scoot$,"int BCX_SUCode = BCX_StartupCode_(); // execute user's startup code"
gLinesWritten++
END IF
IF Use_ExitCode THEN
FPRINT FP3,Scoot$,"int BCX_EXCode = BCX_ExitCode_(); // Prepare for user's exit code"
gLinesWritten++
END IF
IF DllCnt THEN
DIM RAW i
FPRINT FP3, ""
FPRINT FP3, "// **********[ DLL Declarations ]**********"
FPRINT FP3, ""
gLinesWritten += 3
'------------------------------------------------------------------------
' Emit LoadLibrary assignments
' HMODULE H_DLLNAME = LoadLibrary("DLLNAME.DLL");
' Todo: Add a check for H_DLLNAME = NULL in case of failure to load the DLL.
'------------------------------------------------------------------------
FOR i = 0 TO LoadLibsCnt - 1
FPRINT FP3, "HMODULE H_", UCASE$(EXTRACT$(Loadlibs$[i], ".")), _
" = LoadLibrary(", ENC$(Loadlibs$[i]), ");"
gLinesWritten++
NEXT i
FOR i = 1 TO DllCnt
FPRINT FP3, DllDecl$[i] ' Emit the users DLL Declarations
gLinesWritten++
NEXT
FPRINT FP3, ""
FPRINT FP3, "// ****************************************"
FPRINT FP3, ""
gLinesWritten += 3
END IF
bMainOut++
END IF
WEND
CALL CloseAll
KILL hdrFile$
KILL FileOut$
'***************************************************************
RENAME "$temp$", FileOut$ ' This is our FINAL "C" File
'***************************************************************
IF Use_Resource AND NOT Use_GenResFile THEN
IF UserResFile$ > "" THEN Res_File$ = UserResFile$
END IF
IF Use_GenResFile THEN
CombineRes = FALSE
IF EXIST(UserResFile$) THEN CombineRes = TRUE 'don't overwrite rc file
szTmp$ = EXTRACT$(UCASE$(FileOut$),".") + "__.rc"
Res_File$ = szTmp$
OPEN resFile$ FOR INPUT AS ResIn
OPEN szTmp$ FOR OUTPUT AS ResOut
FPRINT ResOut, "// BCX Generated Resource File"
FPRINT ResOut, "// Date: ",DATE$, " Time: ",TIME$
FPRINT ResOut, ""
FPRINT ResOut, "#include "
FPRINT ResOut, ""
IF CombineRes THEN
OPEN UserResFile$ FOR INPUT AS UserResIn
FPRINT ResOut, "// User *.rc file listing"
FPRINT ResOut, ""
WHILE NOT EOF(UserResIn)
LINE INPUT UserResIn,Z$ ' Read from user resource file
IF INSTR(Z$,"windows.h",0,1) > 0 THEN
Z$ = ""
END IF
FPRINT ResOut,Z$ ' Write to final *.rc file
WEND
END IF
FPRINT ResOut, ""
FPRINT ResOut, "// BCX generated *.rc file listing"
FPRINT ResOut, ""
WHILE NOT EOF(ResIn)
LINE INPUT ResIn,Z$ ' Read from temp$
IF INSTR(Z$,"include",0,1) > 0 THEN
FPRINT ResOut, ""
END IF
FPRINT ResOut,Z$ ' Write to final *.rc file
WEND
CLOSE ResOut
CLOSE ResIn
IF CombineRes THEN
CLOSE UserResIn
END IF
END IF
IF EXIST(resFile$) THEN
KILL resFile$
END IF
'*******************************
IF ShowStatus THEN LOCATE 2,1,1
'*******************************
IF NOT Quiet THEN
INCR LinesRead, ModuleLineNos[1]
Elapsed! = ROUND((float)clock()/(float)CLOCKS_PER_SEC,2)
PRINT "[Lines In:" ; LinesRead ; "] [Lines Out:" ; gLinesWritten ; "] ";
PRINT "[Statements:" ; Statements ; "] [Time:" ; Elapsed! ; " sec's]"
IF Use_Library THEN
Z$ = "BCX Created Runtime Library Files"
ELSE
Z$ = "BCX translated " + REMOVE$(FileIn$," ") + " to " + REMOVE$(FileOut$," ")
END IF
IF NOT Use_Library THEN
IF UseCpp THEN
Z$ = Z$ + " For a C++ Compiler"
ELSE
Z$ = Z$ + " For a C Compiler"
END IF
END IF
IF Use_Project THEN
Z$ = Z$ + " With No Runtime"
END IF
PRINT Z$
END IF
IF Use_Project AND Gen_Header THEN
CALL Project_Support
END IF
IF Use_Library THEN
CALL Library_Support
END IF
CALL PostProcess
IF WarnMsg$ > "" THEN
IF InfoBoxWarn THEN
INFOBOX("Warning! " + FileIn$,WarnMsg$)
ELSE
PRINT "Warning!", CRLF$, FileIn$, CRLF$, WarnMsg$
END IF
END IF
IF KillCFile THEN KILL FileOut$ ' -k switch issued ?
CALL FREEGLOBALS
' END of BCX Translator Code
' The old symbols marking end were changed because of warnings of
' continuation characters following comments with some compilers??
'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
' **************************************************************
' Added for $Project Support
' This reads the .c file created by BCX and creates the .h files
' from the information at the top of the .c file in sections such
' as ' User Defined Structs And Unions and User Prototyes, etc.
' I have instigated the BCX_STR_XXX_XXX MACROS to prevent changes
' being made unawares that will affect this code.
' **************************************************************
SUB Project_Support()
LOCAL nPos1
LOCAL nPos2
LOCAL sExt$
LOCAL cHFn$
Z$ = ""
IF EXIST( FileOut$ ) THEN
CLOSE
IF CmdLineFileOut$ = "" THEN
Project_Path$ = CURDIR$
ELSE
Project_Path$ = MID$( CmdLineFileOut$, 1, INSTRREV(CmdLineFileOut$, "\", 0 ) - 1)
END IF
IF INCHR( COMMAND$(1), "\") THEN ' has a path
cHFn$ = MID$( COMMAND$(1), INSTRREV( COMMAND$(1), "\", 0 ) + 1 )
ELSE
cHFn$ = COMMAND$(1)
END IF
IF INCHR( cHFn$, "." ) THEN ' has an extension
cHFn$ = MID$( cHFn$, 1, INSTRREV( cHFn$, ".", 0 ) -1 )
END IF
HFile$ = Project_Path$ + "\" + cHFn$ + ".bh"
OPEN FileOut$ FOR INPUT AS PJ1
OPEN HFile$ FOR OUTPUT AS PJ2
FPRINT PJ2, "#ifndef __BCX_HEADER_" + UCASE$(cHFn$) + "__"
WHILE NOT EOF(PJ1)
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
LINE INPUT PJ1, Z$
WEND
IF INSTR(Z$, $BCX_STR_SYS_VARS) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
IF EOF(PJ1) THEN EXIT WHILE
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_SYS_VARS
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF Z$ <> "" THEN
IF INCHR(Z$, "=" ) THEN
' Get rid of = TO ;
' char CRLF[3]={13,10,0}; // Carr Rtn & Line Feed
nPos1 = INCHR(Z$, "=" )
nPos2 = INCHR(Z$, ";" )
sExt$ = MID$( Z$, nPos1, nPos2 - nPos1 )
REPLACE sExt$ WITH "" IN Z$
END IF
IF NOT LEFT$(Z$, 6) = "static" THEN
FPRINT PJ2, "extern " + Z$
END IF
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_USR_VARS) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_USR_VARS
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF LEFT$(TRIM$(Z$),1) = "#" THEN
FPRINT PJ2, Z$
ELSEIF Z$ <> "" THEN
IF INCHR(Z$, "=" ) THEN
' Get rid of = TO ;
' char CRLF[3]={13,10,0}; // Carr Rtn & Line Feed
nPos1 = INCHR(Z$, "=" )
nPos2 = INCHR(Z$, ";" )
sExt$ = MID$( Z$, nPos1, nPos2 - nPos1 )
REPLACE sExt$ WITH "" IN Z$
END IF
IF LEFT$(Z$, 6) <> "extern" THEN
FPRINT PJ2, "extern " + Z$
ELSE
FPRINT PJ2, Z$
END IF
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_STD_MACROS) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_STD_MACROS
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF Z$ <> "" THEN
FPRINT PJ2,Z$
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_STD_PROTOS) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_STD_PROTOS
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF Z$ <> "" THEN
LOCAL p AS CHAR PTR
' added to get rid of assignment to optional parameters
' PellesC don't like them
WHILE INCHR(Z$, "=" )
' remove = up to comma, space, right paren, semi-colon
' char* mid (char*, int, int=-1);
nPos1 = INCHR(Z$, "=" )
p = Z$
p = p + nPos1 - 1
DO
IF *p <> ASC(",") AND *p <> ASC(" ") AND *p <> ASC(")") THEN
*p = 1
ELSE
EXIT DO
END IF
p++
LOOP
REPLACE CHR$(1) WITH "" IN Z$
WEND
IF LEFT$(Z$, 6) <> "extern" THEN
FPRINT PJ2, "extern " + Z$
ELSE
FPRINT PJ2, Z$
END IF
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_USR_PROTOS) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_USR_PROTOS
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
IF EOF(PJ1) THEN EXIT WHILE
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF INSTR(Z$, " main") OR INSTR(Z$, " WinMain") THEN
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF LEFT$(Z$,1) = " " THEN
ELSEIF Z$ <> "" THEN
FPRINT PJ2, "extern " + Z$
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_USR_CONST) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_USR_CONST
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT INSTR(Z$, $BCX_STR_USR_TYPES) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF Z$ <> "" THEN
FPRINT PJ2, Z$
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
ELSEIF INSTR(Z$, $BCX_STR_MAIN_PROG) THEN
EXIT WHILE
ELSEIF INSTR(Z$, $BCX_STR_USR_PROCS) THEN
EXIT WHILE
ELSEIF INSTR(Z$, $BCX_STR_USR_TYPES) THEN
LINE INPUT PJ1, Z$ ' get rid of '// ***************
FPRINT PJ2, "// *****************"
FPRINT PJ2, "// " + $BCX_STR_USR_TYPES
FPRINT PJ2, "// *****************"
FPRINT PJ2, ""
LINE INPUT PJ1, Z$
WHILE NOT INSTR(Z$, $BCX_STR_SYS_VARS) AND _
NOT INSTR(Z$, $BCX_STR_USR_VARS) AND _
NOT INSTR(Z$, $BCX_STR_STD_MACROS) AND _
NOT INSTR(Z$, $BCX_STR_STD_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROTOS) AND _
NOT INSTR(Z$, $BCX_STR_USR_CONST) AND _
NOT INSTR(Z$, $BCX_STR_MAIN_PROG) AND _
NOT INSTR(Z$, $BCX_STR_USR_PROCS) AND _
NOT EOF(PJ1)
IF LEFT$( Z$, 4) = "// *" THEN
LINE INPUT PJ1, Z$
EXIT WHILE
ELSEIF Z$ = "" THEN
ELSEIF LEFT$(TRIM$(Z$),2) = "//" THEN
ELSEIF Z$ <> "" THEN
'IF LEFT$(Z$, 7) = "typedef" THEN
' FPRINT PJ2, "extern " + Z$
'ELSE
FPRINT PJ2, Z$
'END IF
END IF
LINE INPUT PJ1, Z$
WEND
FPRINT PJ2, ""
END IF
WEND
FPRINT PJ2, "#endif // __BCX_HEADER_" + UCASE$(cHFn$) + "__"
CLOSE PJ1
CLOSE PJ2
END IF
' **************************************************************
' End of $Project Support
' **************************************************************
END SUB ' Project_Support
' **************************************************************
' BCX Runtime Library Support
' **************************************************************
' NOTE: LCC-WIN32's MAKE.EXE REQUIRES TABS, 8 SPACES WON'T DO!!!
SUB Library_Support()
CONST MAX_C_FILES = 500
LOCAL thisDir$
LOCAL BCXDir$
LOCAL SrcDir$
LOCAL ObjDir$
LOCAL LibDir$
LOCAL DllDir$
LOCAL Exprt$
LOCAL IncLibFile$
LOCAL IncDir$
LOCAL IncFile$
LOCAL RTFile$
LOCAL RSPFile$
LOCAL BuildBat$
LOCAL nPos1
LOCAL nPos2
LOCAL sExt$
LOCAL SrcF$
LOCAL SrcExt$
LOCAL TmpF$
LOCAL TmpExt$
LOCAL BraceCnt
LOCAL typePos
LOCAL pstr$
LOCAL fstr$
LOCAL DYNAMIC C_Files$[MAX_C_FILES]
LOCAL cIdx
LOCAL rspNdx
LOCAL Z1$
LOCAL i_
DIM RAW NewSrc$ * 1024 * 25
DIM RAW OldSrc$ * 1024 * 25
' ************************************************************
IF UseCpp THEN
SrcExt$ = ".cpp"
RTFile$ = "BCXRT.CPP"
ELSE
SrcExt$ = ".c"
RTFile$ = "BCXRT.C"
END IF
thisDir$ = CURDIR$
BCXDir$ = LEFT$( BCXPATH$, LEN( BCXPATH$ ) - 4 )
SrcDir$ = BCXDir$ + "rtlib\\source\\"
ObjDir$ = BCXDir$ + "rtlib\\obj\\"
LibDir$ = BCXDir$ + "rtlib\\lib\\"
DllDir$ = BCXDir$ + "rtlib\\dll\\"
IncDir$ = BCXDir$ + "rtlib\\include\\"
RSPFile$ = BCXDir$ + "rtlib\\bcxrt.rsp"
BuildBat$ = BCXDir$ + "rtlib\\BuildRTL.bat"
IncLibFile$ = IncDir$ + "BCXLib.h"
IncFile$ = IncDir$ + "bcxRT.h"
Z$ = ""
' Make Sure Directories exist
' and if not make them
IF EXIST( "BCXRT.BAS" ) THEN KILL "BCXRT.BAS"
IF NOT EXIST( BCXDir$ + "rtlib" ) THEN MKDIR BCXDir$ + "rtlib"
IF NOT EXIST( SrcDir$ ) THEN MKDIR SrcDir$
IF NOT EXIST( ObjDir$ ) THEN MKDIR ObjDir$
IF NOT EXIST( IncDir$ ) THEN MKDIR IncDir$
IF NOT EXIST( LibDir$ ) THEN MKDIR LibDir$
IF NOT EXIST( DllDir$ ) THEN MKDIR DllDir$
IF NOT EXIST( SrcDir$ ) THEN MSGBOX( "Failed to Create " + SrcDir$ ) : END = 1
IF NOT EXIST( ObjDir$ ) THEN MSGBOX( "Failed to Create " + ObjDir$ ) : END = 1
IF NOT EXIST( IncDir$ ) THEN MSGBOX( "Failed to Create " + IncDir$ ) : END = 1
IF NOT EXIST( LibDir$ ) THEN MSGBOX( "Failed to Create " + LibDir$ ) : END = 1
IF NOT EXIST( DllDir$ ) THEN MSGBOX( "Failed to Create " + DllDir$ ) : END = 1
IF NOT EXIST( ObjDir$ + "LC" ) THEN MKDIR ObjDir$ + "LC"
IF NOT EXIST( ObjDir$ + "PC" ) THEN MKDIR ObjDir$ + "PC"
IF NOT EXIST( ObjDir$ + "BC" ) THEN MKDIR ObjDir$ + "BC"
IF NOT EXIST( ObjDir$ + "MC" ) THEN MKDIR ObjDir$ + "MC"
IF NOT EXIST( ObjDir$ + "WC" ) THEN MKDIR ObjDir$ + "WC"
IF NOT EXIST( ObjDir$ + "GC" ) THEN MKDIR ObjDir$ + "GC"
IF NOT EXIST( ObjDir$ + "DC" ) THEN MKDIR ObjDir$ + "DC"
IF NOT EXIST( ObjDir$ + "LC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "LC" ) : END = 1
IF NOT EXIST( ObjDir$ + "PC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "PC" ) : END = 1
IF NOT EXIST( ObjDir$ + "BC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "BC" ) : END = 1
IF NOT EXIST( ObjDir$ + "MC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "MC" ) : END = 1
IF NOT EXIST( ObjDir$ + "WC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "WC" ) : END = 1
IF NOT EXIST( ObjDir$ + "GC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "GC" ) : END = 1
IF NOT EXIST( ObjDir$ + "DC" ) THEN MSGBOX( "Failed to Create " + ObjDir$ + "DC" ) : END = 1
IF NOT EXIST( LibDir$ + "LC" ) THEN MKDIR LibDir$ + "LC"
IF NOT EXIST( LibDir$ + "PC" ) THEN MKDIR LibDir$ + "PC"
IF NOT EXIST( LibDir$ + "BC" ) THEN MKDIR LibDir$ + "BC"
IF NOT EXIST( LibDir$ + "MC" ) THEN MKDIR LibDir$ + "MC"
IF NOT EXIST( LibDir$ + "WC" ) THEN MKDIR LibDir$ + "WC"
IF NOT EXIST( LibDir$ + "GC" ) THEN MKDIR LibDir$ + "GC"
IF NOT EXIST( LibDir$ + "DC" ) THEN MKDIR LibDir$ + "DC"
IF NOT EXIST( LibDir$ + "LC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "LC" ) : END = 1
IF NOT EXIST( LibDir$ + "PC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "PC" ) : END = 1
IF NOT EXIST( LibDir$ + "BC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "BC" ) : END = 1
IF NOT EXIST( LibDir$ + "MC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "MC" ) : END = 1
IF NOT EXIST( LibDir$ + "WC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "WC" ) : END = 1
IF NOT EXIST( LibDir$ + "GC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "GC" ) : END = 1
IF NOT EXIST( LibDir$ + "DC" ) THEN MSGBOX( "Failed to Create " + LibDir$ + "DC" ) : END = 1
IF EXIST( RTFile$ ) THEN
CLOSE
IF Use_Dll THEN
SrcF$ = SrcDir$ + "\\BCXRTDLL" + SrcExt$
OPEN SrcF$ FOR OUTPUT AS LB5
FPRINT LB5, "#include \n\n"
FPRINT LB5,"__declspec(dllexport) BOOL WINAPI DllMain (HINSTANCE hInst, DWORD Reason, LPVOID Reserved)"
FPRINT LB5,"{"
FPRINT LB5," switch (Reason)"
FPRINT LB5," {"
FPRINT LB5," case DLL_PROCESS_ATTACH:"
FPRINT LB5," BCX_hInstance = hInst;"
FPRINT LB5," break;"
FPRINT LB5," case DLL_PROCESS_DETACH:"
FPRINT LB5," break;"
FPRINT LB5," case DLL_THREAD_ATTACH:"
FPRINT LB5," break;"
FPRINT LB5," case DLL_THREAD_DETACH:"
FPRINT LB5," break;"
FPRINT LB5," }"
FPRINT LB5," return TRUE;"
FPRINT LB5,"}\n\n"
END IF
OPEN IncFile$ FOR OUTPUT AS LB0
OPEN RTFile$ FOR INPUT AS LB1
OPEN IncLibFile$ FOR OUTPUT AS LB2
WHILE NOT INSTR( Z$, "BCXRTHEADER: SYSTEM VARIABLES" )
READLINE1:
Z$ = Getline$()
IF INSTR( Z$, "BCXRTHEADER: SYSTEM VARIABLES" ) THEN ITERATE
Z1$ = Z$
Z$ = TRIM$(Z$)
' check for structs
IF LEFT$(Z$, 7) = "typedef" THEN
IF INSTR(Z$, "struct") THEN
BraceCnt = BraceCount( Z$ )
FPRINT LB2, Z$
WHILE BraceCnt = 0
Z$ = Getline$()
BraceCnt = BraceCnt + BraceCount( Z$ )
FPRINT LB2, Z$
WEND
WHILE BraceCnt <> 0
Z$ = Getline$()
BraceCnt = BraceCnt + BraceCount( Z$ )
FPRINT LB2, Z$
WEND
GOTO READLINE1
END IF
ITERATE
END IF
'----
IF LEFT$(Z$,18) = "DECLARE_INTERFACE_" THEN
FPRINT LB2, Z1$
WHILE TRUE
Z$ = Getline$()
IF INSTR( Z$, "BCXRTHEADER: SYSTEM VARIABLES" ) THEN EXIT
FPRINT LB2, Z$
IF INCHR(Z$, ";") AND INCHR(Z$, "}") THEN EXIT
WEND
ITERATE
END IF
IF Z$ = "" OR LEFT$(Z$, 2) = "//" OR LEFT$(Z$, 1) = " " OR _
LEFT$(Z$, 1) = "{" OR LEFT$(Z$, 1) = "}" OR _
LEFT$(Z$, 9) = "STDMETHOD" OR LEFT$(Z$, 7) = "DECLARE" OR _
LEFT$(Z$, 9) = "ITypeInfo" OR LEFT$(Z$, 1) = "#" THEN
FPRINT LB2, Z1$
ITERATE
END IF
IF iMatchLft(Z$,"const") THEN
REPLACE "=" WITH ";" IN Z1$
FPRINT LB2, "extern " + Z1$
WHILE NOT INCHR(Z$, ";")
Z$ = Getline$()
'FPRINT LB2, Z$
WEND
ITERATE
END IF
IF iMatchLft(Z$,"enum") THEN
FPRINT LB2, Z1$
WHILE NOT INCHR(Z$, ";")
Z$ = Getline$()
IF INSTR( Z$, "BCXRTHEADER: SYSTEM VARIABLES" ) THEN EXIT
FPRINT LB2, Z$
WEND
ITERATE
END IF
IF INCHR(Z$, "=" ) AND INCHR(Z$, ";" ) THEN
' Get rid of = TO ;
' char CRLF[3]={13,10,0}; // Carr Rtn & Line Feed
nPos1 = INCHR(Z$, "=" )
nPos2 = INCHR(Z$, ";" )
sExt$ = MID$( Z$, nPos1, nPos2 - nPos1 )
REPLACE sExt$ WITH "" IN Z$
IF NOT Use_Dll THEN
Z$ = "extern " + Z$
END IF
FPRINT LB2, Z$
ELSEIF INCHR( Z$, "=") AND NOT INCHR(Z$, ";" ) THEN
REPLACE "=" WITH ";" IN Z$
IF NOT Use_Dll THEN
FPRINT LB2, "extern " + Z$
END IF
Z$ = ""
WHILE NOT INCHR(Z$, ";" )
Z$ = Getline$()
IF INSTR( Z$, "BCXRTHEADER: SYSTEM VARIABLES" ) THEN EXIT
WEND
ELSE
IF NOT Use_Dll THEN
Z$ = "extern " + Z$
END IF
FPRINT LB2, Z$
END IF
WEND
WHILE NOT INSTR( Z$, "// BCXRTHEADER: STANDARD PROTOTYPES" )
FPRINT LB2, Z$
READLINE:
Z$ = Getline$()
IF Z$ = "" THEN ITERATE
IF LEFT$(Z$, 2) = "//" THEN ITERATE
IF LEFT$(Z$, 1) = " " THEN ITERATE
IF LEFT$(Z$, 1) = "{" THEN ITERATE
IF LEFT$(Z$, 1) = "}" THEN ITERATE
IF LEFT$(Z$, 1) = "#" THEN ITERATE
IF LEFT$(Z$, 6) = "static" THEN
IF Use_Dll THEN
REPLACE "static " WITH "C_EXPORT " IN Z$
ELSE
REPLACE "static " WITH "" IN Z$
END IF
END IF
IF LEFT$(Z$, 7) = "typedef" THEN
IF INSTR(Z$, "struct") THEN
BraceCnt = BraceCount( Z$ )
FPRINT LB2, Z$
WHILE BraceCnt = 0
Z$ = Getline$()
BraceCnt = BraceCnt + BraceCount( Z$ )
FPRINT LB2, Z$
WEND
WHILE BraceCnt <> 0
Z$ = Getline$()
BraceCnt = BraceCnt + BraceCount( Z$ )
FPRINT LB2, Z$
WEND
GOTO READLINE
END IF
ITERATE
END IF
IF INCHR(Z$, "=" ) THEN
' Get rid of = TO ;
' char CRLF[3]={13,10,0}; // Carr Rtn & Line Feed
nPos1 = INCHR(Z$, "=" )
nPos2 = INCHR(Z$, ";" )
sExt$ = MID$( Z$, nPos1, nPos2 - nPos1 )
REPLACE sExt$ WITH "" IN Z$
END IF
IF NOT Use_Dll THEN Z$ = "extern " + Z$
WEND
' Kludge solution to Ljubisas New Com Stuff
FPRINT LB0, "// *************************************************"
FPRINT LB0, "// Late binding COM support section"
FPRINT LB0, "// (c) Ljubisa Knezevic 2004, ljube@blic.net"
FPRINT LB0, "// *************************************************"
FPRINT LB0, "// types used by Late binding COM support"
FPRINT LB0, ""
FPRINT LB0, "#define COM_STACK_SIZE 64"
FPRINT LB0, "#ifndef CON_VARBOOL2BOOL"
FPRINT LB0, "#define CON_VARBOOL2BOOL(b) ((BOOL)(b ? TRUE : FALSE))"
FPRINT LB0, "#endif"
FPRINT LB0, ""
FPRINT LB0, "typedef struct _OBJECT"
FPRINT LB0, "{"
FPRINT LB0, "IUnknown* p_unknown;"
FPRINT LB0, "VARIANT pObjects[COM_STACK_SIZE];"
FPRINT LB0, "BOOL pStatus;"
FPRINT LB0, "int ipointer;"
FPRINT LB0, "}OBJECT, *LPOBJECT;"
FPRINT LB0, ""
FPRINT LB0, "typedef struct _PARAM_VARARRAY"
FPRINT LB0, "{"
FPRINT LB0, "VARIANT pParams[COM_STACK_SIZE];"
FPRINT LB0, "}PARAM_VARARRAY, *LPPARAM_VARARRAY;"
' End of ComKludge
FPRINT LB0, ""
FPRINT LB0, "// *************************************************"
FPRINT LB0, "// Standard Prototypes"
FPRINT LB0, "// *************************************************"
FPRINT LB0, ""
WHILE NOT INSTR( Z$, "Runtime Functions" )
FPRINT LB2, Z$
BYPASS:
Z$ = Getline$()
IF Z$ = "" THEN ITERATE
IF LEFT$(Z$, 2) = "//" THEN ITERATE
IF LEFT$(Z$, 1) = " " THEN ITERATE
IF LEFT$(Z$, 1) = "{" THEN ITERATE
IF LEFT$(Z$, 1) = "}" THEN ITERATE
IF LEFT$(Z$, 6) = "STDAPI" THEN ITERATE
IF LEFT$(Z$, 7) = "#define" THEN ITERATE
IF LEFT$(Z$, 1) = "#" THEN ITERATE
IF LEFT$(Z$, 6) = "static" THEN
REPLACE "static " WITH "" IN Z$
END IF
IF LEFT$(Z$, 7) = "typedef" THEN
FPRINT LB0, Z$
'REPLACE "typedef" WITH "extern typedef" IN Z$
ITERATE
END IF
IF Use_Dll THEN
typePos = INCHR( Z$, "(")
typePos = INSTRREV( Z$," ", typePos-2)
pstr$ = LEFT$(Z$,typePos-1)
fstr$ = MID$(Z$,typePos)
FPRINT LB0, Z% '"C_EXPORT " + Z$
FPRINT LB2, "C_EXPORT " + Z$
' FPRINT LB0, "#if defined( __LCC__ )"
' FPRINT LB2, "#if defined( __LCC__ )"
' FPRINT LB0, " __stdcall " + Z$
' FPRINT LB2, " __stdcall " + Z$
' FPRINT LB0, "#else"
' FPRINT LB2, "#else"
' Z$ = " " + pstr$ + " __stdcall " + fstr$
' FPRINT LB0, Z$
' FPRINT LB2, Z$
' FPRINT LB0, "#endif"
' FPRINT LB2, "#endif"
GOTO BYPASS
ELSE
Z$ = "extern " + Z$
FPRINT LB0, Z$
END IF
WEND
FPRINT LB2, "// End of bcxLIB.h Runtime Library Include File"
FPRINT LB2, "// *************************************************"
CLOSE LB2
' Create the .c source files
cIdx = 0
Z$ = Getline$()
Z$ = Getline$()
TmpExt$ = ".tmp"
IF Use_Dll THEN
WHILE NOT EOF(LB1)
Z$ = Getline$()
IF NOT INSTR(Z$, "BCXRTLIB:") THEN ITERATE
Z$ = Getline$() ' get next line following "BCXRTLIB:"
WHILE LEFT$(TRIM$(Z$),1) = "#"
FPRINT LB5, Z$
Z$ = Getline$()
WEND
WHILE NOT INCHR( Z$, "(")
Z$ = Z$ + TRIM$(Getline$())
WEND
typePos = INCHR( Z$, "(")
typePos = INSTRREV( Z$," ", typePos-2)
pstr$ = LEFT$(Z$,typePos-1)
fstr$ = MID$(Z$,typePos)
FPRINT LB5,"C_EXPORT " + Z$
'FPRINT LB5, "#if defined( __LCC__ )"
'FPRINT LB5, " C_EXPORT __stdcall " + Z$
'FPRINT LB5, "#else"
'Z$ = " C_EXPORT " + pstr$ + " __stdcall " + fstr$
'FPRINT LB5, Z$
'FPRINT LB5, "#endif"
Z$ = Getline$()
WHILE NOT INSTR( Z$, "ENDBCXRTLIB" )
FPRINT LB5, Z$
Z$ = Getline$()
WEND
WEND
FPRINT LB5, ""
CLOSE LB5
ELSE
WHILE NOT EOF(LB1)
Z$ = Getline$()
IF NOT INSTR(Z$, "BCXRTLIB:") THEN ITERATE
SrcF$ = TRIM$(MID$( Z$, INCHR(Z$, ":") + 1))
Exprt$ = SrcF$
IF cIdx >= MAX_C_FILES THEN MSGBOX "TOO MANY C FILES", "ERROR!" : END = 1
C_Files$[cIdx++] = SrcF$
TmpF$ = SrcDir$ + "\" + SrcF$ + TmpExt$
SrcF$ = SrcDir$ + "\" + SrcF$ + SrcExt$
' First write to temp file for comparison if
' Source file exists
IF EXIST ( SrcF$ ) THEN
OPEN TmpF$ FOR OUTPUT AS LB2
ELSE
OPEN SrcF$ FOR OUTPUT AS LB2
END IF
FPRINT LB2, "#include "
FPRINT LB2, ""
Z$ = Getline$()
WHILE NOT INSTR( Z$, "ENDBCXRTLIB" )
FPRINT LB2, Z$
Z$ = Getline$()
WEND
FPRINT LB2, ""
CLOSE LB2
' compare files and if new is same as what
' exist, don't replace it. This will make
' it much quicker to rebuild the .lib if the .c/.cpp
' files are not changed from version to version
' All of this is in anticipation of using a make file
' or build.exe to build the runtime library only if
' needed. Theoretically the same code will compile
' and link for all C and C++ compilers and if it won't
' we need to fix it.
IF EXIST ( TmpF$ ) AND EXIST ( SrcF$ ) THEN
' Load them both into memory
' I have dim'ed both to be 100,000 bytes, as of this
' writing the largest .c/.cpp file is < 5KB so
' this should be good for a while
NewSrc$ = LOADFILE$( TmpF$ )
OldSrc$ = LOADFILE$( SrcF$ )
' compare them
IF NewSrc$ = OldSrc$ THEN
' if same then kill the tmp and keep old one
KILL TmpF$
ELSE
COPYFILE TmpF$, SrcF$
END IF
ELSE ' both don't exist, copy tmp to src
COPYFILE TmpF$, SrcF$
KILL TmpF$
END IF
WEND
END IF
CLOSE LB1
' add the libraries pragmas to bcxRT.h
FPRINT LB0,"#if !defined ( __LCC__ )"
FPRINT LB0,""
FPRINT LB0,"// *************************************************"
FPRINT LB0,"// Instruct Linker to Search Object/Import Libraries"
FPRINT LB0, "// *************************************************"
FPRINT LB0,"#pragma comment(lib,", ENC$("kernel32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("user32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("gdi32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("comctl32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("advapi32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("winspool.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("shell32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("ole32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("oleaut32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("uuid.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("odbc32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("odbccp32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("delayimp.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("dxguid.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("winmm.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("comdlg32.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("htmlhelp.lib"), ")"
FPRINT LB0,"#pragma comment(lib,", ENC$("bcxRT.lib"), ")"
FPRINT LB0, "// *************************************************"
FPRINT LB0,"#else"
FPRINT LB0, "// *************************************************"
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0,"#pragma lib "
FPRINT LB0, "// *************************************************"
FPRINT LB0,"// End of Object/Import Libraries To Search"
FPRINT LB0,"// *************************************************"
FPRINT LB0,"#endif"
CLOSE LB0
' create response file for BCC55's TLib.exe
OPEN RSPFile$ FOR OUTPUT AS LB3
REDIM PRESERVE C_Files$[cIdx]
QSORT DYNAMIC C_Files$, cIdx
cIdx--
FOR INTEGER i = 0 TO cIdx
IF i < cIdx THEN
FPRINT LB3, " + " + ObjDir$ + "BC\\" + C_Files$[i] + ".obj" + " &"
ELSE
FPRINT LB3, " + " + ObjDir$ + "BC\\" + C_Files$[i] + ".obj"
END IF
NEXT
CLOSE LB3
' emit BuildRTL.bat if it doesn't exist only
IF NOT EXIST ( BuildBat$ ) THEN
OPEN BuildBat$ FOR OUTPUT AS LB4
' This is a work in progress
$IPRINT_ON
FPRINT LB4,"@ECHO OFF"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\DC\*.obj ERASE .\obj\DC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\LC\*.obj ERASE .\obj\LC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\MC\*.obj ERASE .\obj\MC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\BC\*.obj ERASE .\obj\BC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\PC\*.obj ERASE .\obj\PC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\WC\*.obj ERASE .\obj\WC\*.obj"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\obj\GC\*.o ERASE .\obj\GC\*.o"
FPRINT LB4,""
FPRINT LB4,"IF EXIST .\source\*.err ERASE .\source\*.err"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\source\*.c ERASE .\source\*.c"
FPRINT LB4,""
FPRINT LB4,":: IF EXIST .\source\*.cpp ERASE .\source\*.cpp"
FPRINT LB4,""
FPRINT LB4,"IF EXIST *.err ERASE *.err"
FPRINT LB4,""
FPRINT LB4,"IF EXIST bcxrt.rsp ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"IF EXIST bcxRT.lib ERASE bcxRT.lib"
FPRINT LB4,""
FPRINT LB4,"REM NOTE You must change the location of your compiler installs here"
FPRINT LB4,"REM ================================================================"
FPRINT LB4,"SET BCX_INSTALL=C:\BCX"
FPRINT LB4,""
FPRINT LB4,"SET MC_INSTALL=", ENC$("C:\PROGRAM FILES\Microsoft Visual C++ Toolkit 2003")
FPRINT LB4,""
FPRINT LB4,"SET BC_INSTALL=C:\Borland\BCC55"
FPRINT LB4,""
FPRINT LB4,"SET LC_INSTALL=C:\LCC"
FPRINT LB4,""
FPRINT LB4,"SET PC_INSTALL=C:\PellesC"
FPRINT LB4,""
FPRINT LB4,"SET WC_INSTALL=C:\WATCOM"
FPRINT LB4,""
FPRINT LB4,"SET GC_INSTALL=C:\MINGW"
FPRINT LB4,""
FPRINT LB4,"SET DC_INSTALL=C:\DM"
FPRINT LB4,""
FPRINT LB4,"REM ================================================================"
FPRINT LB4,"REM NOTE You must change the location of your compiler installs above"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("D"), " GOTO DMARS32"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("M"), " GOTO VCCPLUS"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("L"), " GOTO LCCWIN32"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("P"), " GOTO PELLESC"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("B"), " GOTO BCC55"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("W"), " GOTO WATCOM"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("G"), " GOTO GCC"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO LCCWIN32"
FPRINT LB4,""
FPRINT LB4,"ECHO Missing Parameter"
FPRINT LB4,"ECHO D for Digial Mars"
FPRINT LB4,"ECHO M for MSVC++"
FPRINT LB4,"ECHO L for LCCWin32"
FPRINT LB4,"ECHO P for Pelles C"
FPRINT LB4,"ECHO B for Borland C++ 5.5"
FPRINT LB4,"ECHO W for Open Watcom"
FPRINT LB4,"ECHO G for MinGW GCC"
FPRINT LB4,"ECHO A for ", ENC$("ALL"), " = Build Libraries For MCVC++, Borland C++ 5.5, MinGW GCC, Open Watcom, LccWin32, Digital Mars and Pelles C"
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY with MINGW GCC Compiler"
FPRINT LB4,":GCC"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for MinGW GCC..."
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lcq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %GC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %GC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"SET GCCFLAGS=-c -pipe -mconsole -mwin32 -w -s -O2 -D_WIN32_IE=0x0501"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\source\*.cpp) DO %GC_INSTALL%\bin\gcc.exe %GCCFLAGS% %%I -o .\obj\GC\%%~nI.o"
FPRINT LB4,""
FPRINT LB4,"IF ERRORLEVEL 1 GOTO ERROR"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\obj\GC\*.o ) DO %GC_INSTALL%\bin\ar.exe -rf %GC_INSTALL%\lib\libbcxrt.a .\obj\GC\%%~nI.o"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %GC_INSTALL%\lib\libbcxrt.a COPY %GC_INSTALL%\lib\libbcxrt.a .\lib\GC\libbcxrt.a /Y"
FPRINT LB4,""
FPRINT LB4,"ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO DMARS32"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY with Digital Mars Compiler"
FPRINT LB4,":DMARS32"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for Digital Mars..."
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lcq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %DC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %DC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"SET DMARSFLAGS=-D_WIN32_WINNT=0x0400 -I", ENC$("C:\Program Files\Microsoft Platform SDK for Windows XP SP2\Include"), " -cpp -c -w7"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\source\*.cpp) DO %DC_INSTALL%\bin\dmc.exe %%I %DMARSFLAGS% -o.\obj\DC\%%~nI.obj"
FPRINT LB4,""
FPRINT LB4,"IF ERRORLEVEL 1 GOTO ERROR"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %DC_INSTALL%\lib\bcxRT.lib ERASE %DC_INSTALL%\lib\bcxRT.lib"
FPRINT LB4,""
FPRINT LB4,"%DC_INSTALL%\bin\lib.exe -c %DC_INSTALL%\lib\bcxRT.lib .\obj\DC\abs.obj"
FPRINT LB4,""
FPRINT LB4,"%DC_INSTALL%\bin\lib.exe -d %DC_INSTALL%\lib\bcxRT.lib abs"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\obj\DC\*.obj ) DO %DC_INSTALL%\bin\lib.exe %DC_INSTALL%\lib\bcxRT.lib .\obj\DC\%%~nI.obj"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %DC_INSTALL%\lib\bcxRT.lib COPY %DC_INSTALL%\lib\bcxRT.lib .\lib\DC\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %DC_INSTALL%\lib\bcxRT.bak ERASE %DC_INSTALL%\lib\bcxRT.bak"
FPRINT LB4,""
FPRINT LB4,"IF EXIST bcxRT.rsp ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO WATCOM"
FPRINT LB4,""
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY with Open Watcom Compiler"
FPRINT LB4,":WATCOM"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for Open Watcom..."
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lcq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %WC_INSTALL%\h\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %WC_INSTALL%\h\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"CALL %WC_INSTALL%\setvars.bat"
FPRINT LB4,""
FPRINT LB4,"SET WPP386=/bt=nt /bc /os /vcap /d0 /D__WIN32__ /zq /D_WIN32_WINNT=0x0400 /D_WIN32_IE=0x0300"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\source\*.cpp) DO %WC_INSTALL%\binnt\WPP386.exe %%I /fo=.\obj\WC\%%~nI /fr=%%~nI.err"
FPRINT LB4,""
FPRINT LB4,"IF ERRORLEVEL 1 GOTO ERROR"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\obj\WC\*.obj ) DO %WC_INSTALL%\binnt\WLIB.exe /b /q %WC_INSTALL%\lib386\nt\bcxRT.lib + .\obj\WC\%%~nI.obj"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %WC_INSTALL%\lib386\nt\bcxRT.lib COPY %WC_INSTALL%\lib386\nt\bcxRT.lib .\lib\WC\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY WITH Borland C++ 5.5 Free Commandline tools"
FPRINT LB4,":BCC55"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for Borland C++ 5.5..."
FPRINT LB4,""
FPRINT LB4,"SET BCCFLAGS=-c -a8 -D__WIN32__ -w-8012 -w-8004 -w-8066 -w-8057 -w-8002 -w-8060"
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lcq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %BC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %BC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %BC_INSTALL%\lib\bcxRT.lib ERASE %BC_INSTALL%\lib\bcxRT.lib"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\source\*.cpp) DO %BC_INSTALL%\bin\bcc32.exe %BCCFLAGS% -o.\obj\BC\%%~nI.obj %%I"
FPRINT LB4,""
FPRINT LB4,"%BC_INSTALL%\bin\tlib.exe %BC_INSTALL%\lib\bcxRT.lib @bcxrt.rsp /P32"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %BC_INSTALL%\lib\bcxRT.lib COPY %BC_INSTALL%\lib\bcxRT.lib .\lib\BC\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO GCC"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY WITH MSVC++ Free Visual C++ Toolkit 2003"
FPRINT LB4,":VCCPLUS"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for Microsoft Visual C++ Toolkit 2003..,"
FPRINT LB4,""
FPRINT LB4,"SET MSVCPPFLAGS=/c /O1 /Gd /W1 /Ze /MT /D_WIN32_IE=0x0501 /D_WIN32_WINNT=0x0400"
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lcq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %MC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %MC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"CALL %MC_INSTALL%\VCVARS32.BAT"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\source\*.cpp) DO %MC_INSTALL%\bin\cl.exe %MSVCPPFLAGS% /Fo.\obj\MC\%%~nI.obj %%I"
FPRINT LB4,""
FPRINT LB4,"%MC_INSTALL%\bin\lib.exe .\obj\MC\*.obj"
FPRINT LB4,"REM bcxRT.lib \LIBPATH:%MC_INSTALL%\lib"
FPRINT LB4,"IF EXIST .\obj\MC\*.lib REN .\obj\MC\*.lib bcxRT.lib"
FPRINT LB4,"IF EXIST .\obj\MC\bcxRT.lib COPY .\obj\MC\bcxRT.lib %MC_INSTALL%\lib\bcxRT.lib /Y"
FPRINT LB4,"IF EXIST .\obj\MC\bcxRT.lib COPY .\obj\MC\bcxRT.lib .\lib\MC\bcxRT.lib /Y"
FPRINT LB4,"IF EXIST .\obj\MC\bcxRT.lib ERASE .\obj\MC\bcxRT.lib"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO BCC55"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY WITH PELLESC"
FPRINT LB4,""
FPRINT LB4,":PELLESC"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for PellesC..."
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %PC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %PC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,"call %PC_INSTALL%\bin\povars32.bat"
FPRINT LB4,""
FPRINT LB4,"SET PELLESFLAGS=-W0 -Ot -Gd -Go -Ze -Zx -X -Tx86-coff"
FPRINT LB4,""
FPRINT LB4,"FOR %%f IN (.\source\*.c) DO %PC_INSTALL%\bin\pocc.exe %PELLESFLAGS% /Fo .\obj\PC\%%~nf.obj -I%PC_INSTALL%\include -I%PC_INSTALL%\include\sys -I%PC_INSTALL%\include\win -I%PC_INSTALL%\include\win\gl %%f"
FPRINT LB4,""
FPRINT LB4,"%PC_INSTALL%\BIN\POLIB.EXE /OUT:%PC_INSTALL%\lib\bcxRT.lib .\obj\PC\*.obj"
FPRINT LB4,""
FPRINT LB4,"IF EXIST %PC_INSTALL%\lib\bcxRT.lib COPY %PC_INSTALL%\lib\bcxRT.lib .\lib\PC\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO VCCPLUS"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,"REM ========= BUILD LIBRARY WITH LCCWIN32"
FPRINT LB4,""
FPRINT LB4,":LCCWIN32"
FPRINT LB4,""
FPRINT LB4,"ECHO Creating BCX Runtime Library for LccWin32..."
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BC.EXE -lq"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxlib.h %LC_INSTALL%\include\bcxlib.h /Y"
FPRINT LB4,""
FPRINT LB4,"COPY .\include\bcxrt.h %LC_INSTALL%\include\bcxrt.h /Y"
FPRINT LB4,""
FPRINT LB4,":: FOR %%f IN (.\source\*.c) do %LC_INSTALL%\bin\lcc.exe -Zp1 .\source\%%~nf.c -Fo.\obj\LC\%%~nf.obj"
FPRINT LB4,""
FPRINT LB4,"%BCX_INSTALL%\BIN\BUILD.EXE .\obj\LC\*.obj .\source\*.c ", ENC$("%LC_INSTALL%\bin\lcc.exe -Zp1 .\source\$dn.c -Fo.\obj\LC\$dn.obj")
FPRINT LB4,""
FPRINT LB4,"IF EXIST bcxrt.rsp ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"FOR %%I IN (.\obj\LC\*.obj) DO ECHO %%I >> bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"%LC_INSTALL%\bin\lcclib.exe bcxRT.lib @bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"ERASE bcxrt.rsp"
FPRINT LB4,""
FPRINT LB4,"COPY bcxRT.lib %LC_INSTALL%\lib\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"COPY bcxRT.lib .\lib\LC\bcxRT.lib /Y"
FPRINT LB4,""
FPRINT LB4,"ERASE bcxRT.lib"
FPRINT LB4,""
FPRINT LB4,"IF /i ", ENC$("%1"), " == ", ENC$("A"), " GOTO PELLESC"
FPRINT LB4,""
FPRINT LB4,"GOTO FINISHED"
FPRINT LB4,""
FPRINT LB4,":ERROR"
FPRINT LB4,""
FPRINT LB4,"ECHO ERROR!"
FPRINT LB4,""
FPRINT LB4,"GOTO OUTOFHERE"
FPRINT LB4,""
FPRINT LB4,":FINISHED"
FPRINT LB4,""
FPRINT LB4,"ECHO Finished!"
FPRINT LB4,""
FPRINT LB4,":OUTOFHERE"
$IPRINT_OFF
CLOSE LB4
END IF
IF NoKill = FALSE THEN
KILL RTFile$ ' BCXRT.C(PP) is a file automatically created by BCX for
' use in building the BCXRT.LIB
END IF
' *******************************************************
END IF ' Exist( "BCXRT.C" ) THEN
END SUB ' Library_Support
FUNCTION Getline$( )
DIM RAW cArg$
LINE INPUT LB1, cArg$
IF INSTR( cArg$, "/*" ) THEN REPLACE "/*" WITH "// " IN cArg$
IF INSTR( cArg$, "*/" ) THEN REPLACE "*/" WITH "" IN cArg$
FUNCTION = cArg$
END FUNCTION ' GetLine$
' **************************************************************
' End of BCX Runtime Library Support
' **************************************************************
SUB EmitCmdLineConst()
IF CmdLineConst$ > "" THEN
RAW Ftmp AS FILE
FPRINT FP7, ""
FPRINT FP7, "// ***************************************************"
FPRINT FP7, "// Commandline Defines"
FPRINT FP7, "// ***************************************************"
FPRINT FP7, ""
' Save FILE Ptr to SourceFile
Ftmp = FP6
' Direct output to HeaderFile
FP6 = FP7
FOR INTEGER i = 1 TO TALLY( CmdLineConst$, CHR$(1) )
Src$ = STRTOKEN$( CmdLineConst$, CHR$(1), i )
IF Src$ = "" THEN EXIT
Src$ = "CONST " + Src$ ' CmdLineConst$
CALL Parse (Src$)
CALL Emit
NEXT
CmdLineConst$ = ""
' Restore Ptr to SourceFile
FP6 = Ftmp
FPRINT FP7, ""
END IF
END SUB 'EmitCmdLineConst
SUB EmitCompilerDefines()
FPRINT FP7,""
IF Use_Library THEN
FPRINT FP7,"// BCXRTHEADER: COMPILER DEFINES"
ELSE
FPRINT FP7,"// ***************************************************"
FPRINT FP7,"// Compiler Defines"
FPRINT FP7,"// ***************************************************"
END IF
FPRINT FP7,""
FPRINT FP7,"// C++"
FPRINT FP7,"#if defined( __cplusplus )"
FPRINT FP7," #define overloaded"
FPRINT FP7," #define C_EXPORT EXTERN_C __declspec(dllexport)"
FPRINT FP7," #define C_IMPORT EXTERN_C __declspec(dllimport)"
FPRINT FP7,"#else"
FPRINT FP7," #define C_EXPORT __declspec(dllexport)"
FPRINT FP7," #define C_IMPORT __declspec(dllimport)"
FPRINT FP7,"#endif"
FPRINT FP7,""
FPRINT FP7,"// Open Watcom defs"
FPRINT FP7,"#if defined( __WATCOM_CPLUSPLUS__ )"
FPRINT FP7," #define atanl atan"
FPRINT FP7," #define sinl sin"
FPRINT FP7," #define cosl cos"
FPRINT FP7," #define tanl tan"
FPRINT FP7," #define asinl asin"
FPRINT FP7," #define acosl acos"
FPRINT FP7," #define log10l log10"
FPRINT FP7," #define logl log"
FPRINT FP7," #define _fcloseall fcloseall"
FPRINT FP7,"#endif"
FPRINT FP7,""
FPRINT FP7,"// Borland C++ 5.5.1 defs - bcc32.exe"
FPRINT FP7,"#if defined( __BCPLUSPLUS__ )"
FPRINT FP7," // ===== Borland Libraries =========="
FPRINT FP7," #include "
FPRINT FP7," #pragma comment(lib,", ENC$("import32.lib"), ")"
FPRINT FP7," #pragma comment(lib,", ENC$("cw32.lib"), ")"
FPRINT FP7," // =================================="
FPRINT FP7,"#endif"
FPRINT FP7,""
FPRINT FP7,"// Microsoft VC++"
' this may need to be changed to work with all C++ compilers?????
FPRINT FP7,"#ifndef DECLSPEC_UUID"
FPRINT FP7," #if (_MSC_VER >= 1100) && defined ( __cplusplus )"
FPRINT FP7," #define DECLSPEC_UUID(x) __declspec(uuid(x))"
FPRINT FP7," #else"
FPRINT FP7," #define DECLSPEC_UUID(x)"
FPRINT FP7," #endif"
FPRINT FP7,"#endif"
FPRINT FP7,""
IF Use_Library THEN FPRINT FP7,"// END BCXRTHEADER\n\n"
END SUB 'EmitCompilerDefines
SUB Emit_VBSCRIPT_Support
STATIC nTimes = 0
IF nTimes > 0 THEN EXIT SUB
INCR nTimes
Use_AnsiToWide = Use_WideToAnsi = TRUE
FPRINT FP7, ""
IF Use_Library THEN
FPRINT FP7, "// BCXRTHEADER: VBSCRIPT SUPPORT STRUCTURES"
ELSE
FPRINT FP7, "// ****************************************"
FPRINT FP7, "// ***** " + $BCX_STR_VBS_STRUCTS + " *****"
FPRINT FP7, "// ****************************************"
FPRINT FP7, ""
END IF
FPRINT FP7, "const GUID IID_IScriptControl ="
FPRINT FP7, "{"
FPRINT FP7, " 0x0e59f1d3,0x1fbe,0x11d0,"
FPRINT FP7, " {0x8f,0xf2,0x00,0xa0,0xd1,0x00,0x38,0xbc}"
FPRINT FP7, "};"
FPRINT FP7, ""
FPRINT FP7, "enum ScriptControlStates"
FPRINT FP7, "{"
FPRINT FP7, " SCRIPTSTATE_UNINITIALIZED0, SCRIPTSTATE_STARTED1, SCRIPTSTATE_CONNECTED2,"
FPRINT FP7, " SCRIPTSTATE_DISCONNECTED3, SCRIPTSTATE_CLOSED4, SCRIPTSTATE_INITIALIZED5"
FPRINT FP7, "};"
FPRINT FP7, ""
FPRINT FP7, "const GUID IID_IScriptError ="
FPRINT FP7, "{"
FPRINT FP7, " 0x70841C78, 0x67D, 0x11D0,"
FPRINT FP7, " {0x95, 0xD8, 0x0, 0xA0, 0x24, 0x63, 0xAB, 0x28}"
FPRINT FP7, "};"
FPRINT FP7, ""
FPRINT FP7, "// ------------------------------"
FPRINT FP7, "#undef INTERFACE"
FPRINT FP7, "#define INTERFACE IScriptError"
FPRINT FP7, "// ------------------------------"
FPRINT FP7, "DECLARE_INTERFACE_(IScriptError, IDispatch) {"
FPRINT FP7, "STDMETHOD (QueryInterface)(THIS_ REFIID riid, LPVOID FAR* ppvObj) PURE;"
FPRINT FP7, "STDMETHOD_(ULONG, AddRef)(THIS) PURE;"
FPRINT FP7, "STDMETHOD_(ULONG, Release)(THIS) PURE;"
FPRINT FP7, "STDMETHOD (GetTypeInfoCount)(THIS_ UINT FAR* pctinfo) PURE;"
FPRINT FP7, "STDMETHOD (GetTypeInfo)(THIS_ UINT itinfo, LCID lcid,"
FPRINT FP7, "ITypeInfo FAR* FAR* pptinfo) PURE;"
FPRINT FP7, "STDMETHOD (GetIDsOfNames)(THIS_ REFIID riid, OLECHAR FAR* FAR* rgszNames,"
FPRINT FP7, " UINT cNames, LCID lcid, DISPID FAR* rgdispid) PURE;"
FPRINT FP7, "STDMETHOD (Invoke)(THIS_ DISPID dispidMember, REFIID riid, LCID lcid,"
FPRINT FP7, " WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult,"
FPRINT FP7, " EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) PURE;"
FPRINT FP7, "STDMETHOD (Get_Number)(THIS_ long* pNumber) PURE;"
FPRINT FP7, "STDMETHOD (Get_Source)(THIS_ BSTR* pbstrSource) PURE;"
FPRINT FP7, "STDMETHOD (Get_Description)(THIS_ BSTR* pbstrDescription) PURE;"
FPRINT FP7, "STDMETHOD (Get_HelpFile)(THIS_ BSTR* pbstrHelpFile) PURE;"
FPRINT FP7, "STDMETHOD (Get_HelpContext)(THIS_ long* pHelpContext) PURE;"
FPRINT FP7, "STDMETHOD (Get_Text)(THIS_ BSTR* pbstrText) PURE;"
FPRINT FP7, "STDMETHOD (Get_Line)(THIS_ long* pLine) PURE;"
FPRINT FP7, "STDMETHOD (Get_Column)(THIS_ long* pColumn) PURE;"
FPRINT FP7, "STDMETHOD (Clear)(THIS) PURE;};"
FPRINT FP7, ""
FPRINT FP7, "// ------------------------------"
FPRINT FP7, "#undef INTERFACE"
FPRINT FP7, "#define INTERFACE IScriptControl"
FPRINT FP7, "// ------------------------------"
FPRINT FP7, "DECLARE_INTERFACE_(IScriptControl, IDispatch) {"
FPRINT FP7, "STDMETHOD (QueryInterface)(THIS_ REFIID riid, LPVOID FAR* ppvObj) PURE;"
FPRINT FP7, "STDMETHOD_(ULONG, AddRef)(THIS) PURE;"
FPRINT FP7, "STDMETHOD_(ULONG, Release)(THIS) PURE;"
FPRINT FP7, "STDMETHOD (GetTypeInfoCount)(THIS_ UINT FAR* pctinfo) PURE;"
FPRINT FP7, "STDMETHOD (GetTypeInfo)(THIS_ UINT itinfo, LCID lcid,"
FPRINT FP7, "ITypeInfo FAR* FAR* pptinfo) PURE;"
FPRINT FP7, "STDMETHOD (GetIDsOfNames)(THIS_ REFIID riid, OLECHAR FAR* FAR* rgszNames,"
FPRINT FP7, " UINT cNames, LCID lcid, DISPID FAR* rgdispid) PURE;"
FPRINT FP7, "STDMETHOD (Invoke)(THIS_ DISPID dispidMember, REFIID riid, LCID lcid,"
FPRINT FP7, " WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult,"
FPRINT FP7, " EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) PURE;"
FPRINT FP7, "STDMETHOD (get_Language)(THIS_ BSTR* pbstrLanguage) PURE;"
FPRINT FP7, "STDMETHOD (put_Language)(THIS_ BSTR pbstrLanguage) PURE;"
FPRINT FP7, "STDMETHOD (get_State)(THIS_ enum ScriptControlStates* pssState) PURE;"
FPRINT FP7, "STDMETHOD (put_State)(THIS_ enum ScriptControlStates pssState ) PURE;"
FPRINT FP7, "STDMETHOD (put_SitehWnd)(THIS_ long phwnd) PURE;"
FPRINT FP7, "STDMETHOD (get_SitehWnd)(THIS_ long* phwnd) PURE;"
FPRINT FP7, "STDMETHOD (get_Timeout)(THIS_ long* plMilliseconds) PURE;"
FPRINT FP7, "STDMETHOD (put_Timeout)(THIS_ long plMilliseconds) PURE;"
FPRINT FP7, "STDMETHOD (get_AllowUI)(THIS_ VARIANT_BOOL* pfAllowUI) PURE;"
FPRINT FP7, "STDMETHOD (put_AllowUI)(THIS_ VARIANT_BOOL pfAllowUI) PURE;"
FPRINT FP7, "STDMETHOD (get_UseSafeSubset)(THIS_ VARIANT_BOOL* pfUseSafeSubset) PURE;"
FPRINT FP7, "STDMETHOD (put_UseSafeSubset)(THIS_ VARIANT_BOOL pfUseSafeSubset) PURE;"
FPRINT FP7, "STDMETHOD (get_Modules)(THIS_ interface"
FPRINT FP7, " IScriptModuleCollection** ppmods) PURE;"
FPRINT FP7, "STDMETHOD (get_Error)(THIS_ interface IScriptError** ppse) PURE;"
FPRINT FP7, "STDMETHOD (get_CodeObject)(THIS_ IDispatch** ppdispObject) PURE;"
FPRINT FP7, "STDMETHOD (get_Procedures)(THIS_ interface"
FPRINT FP7, " IScriptProcedureCollection** ppdispProcedures) PURE;"
FPRINT FP7, "STDMETHOD (_AboutBox)(THIS) PURE;"
FPRINT FP7, "STDMETHOD (AddObject)(THIS_ BSTR Name, IDispatch* Object,"
FPRINT FP7, " VARIANT_BOOL AddMembers) PURE;"
FPRINT FP7, "STDMETHOD (Reset)(THIS) PURE;"
FPRINT FP7, "STDMETHOD (AddCode)(THIS_ BSTR Code) PURE;"
FPRINT FP7, "STDMETHOD (Eval)(THIS_ BSTR Expression, VARIANT* pvarResult) PURE;"
FPRINT FP7, "STDMETHOD (ExecuteStatement)(THIS_ BSTR Statement) PURE;"
FPRINT FP7, "STDMETHOD (Run)(THIS_ BSTR ProcedureName, SAFEARRAY** Parameters,"
FPRINT FP7, " VARIANT* pvarResult) PURE;};"
FPRINT FP7, ""
IF Use_Project OR Use_Library THEN
FPRINT FP7, "BOOL OLE_ERROR_S;"
FPRINT FP7, "IScriptControl *pSC;"
ELSE
FPRINT FP7, "static BOOL OLE_ERROR_S;"
FPRINT FP7, "static IScriptControl *pSC;"
END IF
AddLibrary("ole32.lib")
AddLibrary("oleaut32.lib")
IF Use_Library THEN FPRINT FP7, "// END BCXRTHEADER\n\n"
END SUB 'Emit_VBSCRIPT_Support
SUB Emit_Pragmas
IF Use_BCX_OlePicture OR Use_BCX_LoadImage THEN
AddLibrary("ole32.lib")
AddLibrary("uuid.lib")
AddLibrary("olepro32.lib")
AddLibrary("oleaut32.lib")
AddLibrary("shell32.lib")
END IF
IF Use_Bff THEN
AddLibrary("shell32.lib")
AddLibrary("ole32.lib")
END IF
IF Use_Sound OR Use_PlayWav THEN
AddLibrary("winmm.lib")
END IF
END SUB ' Emit_Pragmas
SUB MakeFreeGlobals
Src$ = "SUB FreeGlobals"
PassOne = 1
CALL Parse(Src$)
CALL Emit
WHILE GlobalDynaCnt
FPRINT Outfile," ";GlobalDynaStr$[GlobalDynaCnt]
GlobalDynaCnt--
WEND
Src$ = "END SUB"
PassOne = 1
CALL Parse(Src$)
CALL Emit
END SUB ' MakeFreeGlobals
SUB ProcessMsgHandlerEnd
'END HANDLER
Src$ = "FUNCTION = LReturn"
CALL Parse(Src$)
CALL Emit
Src$ = "END FUNCTION"
CALL Parse(Src$)
CALL Emit
Src$ = ""
END SUB
SUB ProcessMsgHandler
'MSGHANDLER procedure or CMDHANDLER procedure
DIM RAW proc_$
FastLexer(Src$, ", ()","")
proc_$ = Stk$[2]
Src$ = "FUNCTION " + proc_$ + " OPTIONAL ( hWnd AS HWND, wParam AS WPARAM, lParam AS LPARAM, LReturn AS LONG=0 ) AS LONG"
CALL Parse(Src$)
CALL Emit
Src$ = ""
END SUB
SUB ProcessMsgCracker
'handle_msg( WM_SIZE, form1_onSize)
' HANDLE_MSG WM_SIZE INLINE SendMessage(hWnd, WM_XXXX, 0, 0 ) : EXIT FUNCTION
DIM RAW bInline AS BOOLEAN
DIM RAW msg_$
DIM RAW proc_$
DIM RAW ret_$
DIM RAW tmp_$[16]
DIM RAW tmpNdx
DIM RAW i
tmpNdx = 0
bInline = FALSE
FastLexer$(Src$, " ", "")
IF LCASE$(Stk$[3]) = "inline" THEN bInline = TRUE
IF bInline = TRUE THEN
msg_$ = Stk$[2]
tmp_$[++tmpNdx] = "IF Msg = " + msg_$ + " THEN "
Src$ = MID$( Stk$[4], 2, LEN(Stk$[4]) - 2 )
FastLexer(Src$, ":","")
FOR i = 1 TO Ndx
tmp_$[++tmpNdx] = Stk$[i]
NEXT
tmp_$[++tmpNdx] = "END IF"
FOR i = 1 TO tmpNdx
CALL Parse(tmp_$[i])
CALL Emit
NEXT
ELSE
FastLexer(Src$, " ,()","")
msg_$ = Stk$[2]
proc_$ = Stk$[3]
ret_$ = Stk$[4]
IF ret_$ <> "" THEN ret_$ = ","+ret_$
Src$ = "IF Msg = " + msg_$ + " THEN" : CALL Parse(Src$) : CALL Emit
IF LEN(TRIM$(ret_$)) THEN
Src$ = " FUNCTION=" + proc_$ + "(hWnd,wParam,lParam" + ret_$ + ")" : CALL Parse(Src$) : CALL Emit
ELSE
Src$ = " " + proc_$ + "(hWnd,wParam,lParam" + ret_$ + ")" : CALL Parse(Src$) : CALL Emit
END IF
Src$ = "END IF" : CALL Parse(Src$) : CALL Emit
END IF
Src$ = ""
END SUB
SUB ProcessCmdHandler
'handle_cmd( IDM_NEW, procedure, retval )
' handle_cmd IDM_NEW INLINE "SendMessage(hWnd, WM_XXXX, 0, 0) : EXIT FUNCTION:
DIM RAW bInline AS BOOLEAN
DIM RAW id_$
DIM RAW proc_$
DIM RAW ret_$
DIM RAW tmp_$[16]
DIM RAW tmpNdx
DIM RAW i
tmpNdx = 0
bInline = FALSE
FastLexer$(Src$, " ", "")
IF LCASE$(Stk$[3]) = "inline" THEN bInline = TRUE
IF bInline = TRUE THEN
id_$ = Stk$[2]
tmp_$[++tmpNdx] = "IF Msg = WM_COMMAND AND CBCTL = " + id_$ + " THEN "
Src$ = MID$( Stk$[4], 2, LEN(Stk$[4]) - 2 )
FastLexer(Src$, ":","")
FOR i = 1 TO Ndx
tmp_$[++tmpNdx] = Stk$[i]
NEXT
tmp_$[++tmpNdx] = "END IF"
FOR i = 1 TO tmpNdx
CALL Parse(tmp_$[i])
CALL Emit
NEXT
ELSE
FastLexer(Src$, " ,()","")
id_$ = Stk$[2]
proc_$ = Stk$[3]
ret_$ = Stk$[4]
IF ret_$ <> "" THEN ret_$ = ","+ret_$
Src$ = "IF Msg = WM_COMMAND AND CBCTL = " + id_$ + " THEN" : CALL Parse(Src$) : CALL Emit
IF LEN(TRIM$(ret_$)) THEN
Src$ = " FUNCTION=" + proc_$ + "(hWnd,wParam,lParam" + ret_$ + ")" : CALL Parse(Src$) : CALL Emit
ELSE
Src$ = " " + proc_$ + "(hWnd,wParam,lParam" + ret_$ + ") " : CALL Parse(Src$) : CALL Emit
END IF
Src$ = "END IF" : CALL Parse(Src$) : CALL Emit
END IF
Src$ = ""
END SUB
SUB ProcessSetCommand(GS)
DIM RAW i, j, SetString=0
LOCAL SaveFP AS FILE
SaveFP = Outfile
IF NOT InFunc THEN Outfile = FP9 ' Global context
IF INCHR(Src$,"$") AND TALLY(Src$,"[") >1 THEN
Src$ = STRIM$(Src$)
IREMOVE "as string" FROM Src$
IREMOVE "as lpstr" FROM Src$
IREMOVE "as char" FROM Src$
CONCAT(Src$," AS char")
END IF
CONCAT(Src$,"=")
PassOne = 1
CALL Parse(Src$)
Tipe$ = ""
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"as") THEN
Tipe$ = Stk$[i+1]
Stk$[i] = ""
Stk$[i+1] = ""
EXIT FOR
END IF
NEXT
IF Tipe$ = "" THEN
szTmp$ = Stk$[2]
SetString = DataType(Stk$[2])
j = SetString
VarCode.Method% = mt_ProcessSetCommand
VarCode.Token$ = szTmp$
VarCode.VarNo% = j
CALL GetVarCode(&VarCode)
IF GS THEN
FPRINT Outfile,Scoot$,REMOVE$(VarCode.StaticOut$,"static ");
ELSE
FPRINT Outfile,Scoot$,VarCode.StaticOut$;
END IF
ELSE
IF GS THEN
FPRINT Outfile,Scoot$ ; Tipe$;" ";Clean$(Stk$[2]);
ELSE
FPRINT Outfile,Scoot$ ; "static ";Tipe$;" ";Clean$(Stk$[2]);
END IF
END IF
i = 2
j = 0
DO
i++
IF Stk$[i]= "=" THEN j = 1
IF SetString = vt_STRVAR AND j = 1 THEN
FPRINT Outfile,"[2048]=";
ELSE
FPRINT Outfile,Stk$[i];
END IF
IF Stk$[i]= "=" THEN EXIT LOOP
IF i = Ndx THEN EXIT LOOP
LOOP
FPRINT Outfile,""
FPRINT Outfile,"{"
WHILE NOT EOF(SourceFile)
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripCode(Src$)
IF JoinLines(Src$) = 1 THEN ITERATE
PassOne = TRUE
CALL XParse(Src$)
PassOne = FALSE
CALL TokenSubstitutions
IF iMatchLft(Src$,"end ") THEN EXIT LOOP
IF LEN (Src$) THEN
FPRINT Outfile," ";
FOR integer ii = 1 TO Ndx
FPRINT Outfile, Clean$(Stk$[ii]);
NEXT ii
FPRINT Outfile,""
END IF
WEND
FPRINT Outfile,"};\n"
Src$ = ""
Outfile = SaveFP
END SUB 'ProcessSetCommand
FUNCTION Directives
DIM RAW lszTmp$
' = # = $
IF *Src = 35 OR *Src = 36 THEN
Z$ = RTRIM$(LCASE$(LEFT$(Src$,6)))
'******************************
SELECT CASE Z$
'**************************
CASE "$linux"
USING_LINUX=1
Src$ = ""
EXIT FUNCTION
'**************************
'****************************
CASE "$accel"
'****************************
CALL XParse(Src$)
Accelerator$ = REMOVE$(Stk$[2],DQ$)
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$bcx_r"
'****************************
Src$ = ""
Use_GenResFile = TRUE
DO
IF EOF(SourceFile) THEN Abort ("Unbalanced $BCX_RESOURCE")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripCode(Src$)
IF iMatchLft(Src$,"$bcx_r") THEN EXIT LOOP
FPRINT FP10,Src$
LOOP
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$bcxve"
'****************************
Src$ = TRIM$(MID$(Src$,12))
REMOVE DQ$ FROM Src$
IF LCASE$(Version$) < LCASE$(Src$) THEN
Abort (CRLF$ + "Your Translator needs updating." + CRLF$ + _
"This program " + ENC$(Modules$[ModuleNdx]) + " requires BCX Version: " + Src$ + " or later." + CRLF$ + CRLF$)
ELSE
PRINT ""
PRINT "Program written for BCX Version ", Src$
PRINT ""
END IF
EXIT FUNCTION
'****************************
CASE "$compi"
'****************************
PassOne = 1
CALL XParse(Src$)
PassOne = 0
Compiler$ = Stk$[2]
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$genfr"
'****************************
Use_GenFree = TRUE
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$filet"
'****************************
FastLexer(Src$,SPC$,"")
IF iMatchWrd(Stk$[2],"ON") THEN
UseFileTest = TRUE
ELSEIF iMatchWrd(Stk$[2],"OFF") THEN
UseFileTest = FALSE
ELSE
Abort("Unrecognized argument to $FILETEST")
END IF
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$noini"
'****************************
Src$ = ""
TestForBcxIni = TRUE
EXIT FUNCTION
'****************************
CASE "$linke"
'****************************
PassOne = 1
CALL XParse(Src$)
PassOne = 0
Linker$ = Stk$[2]
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$onexi"
'****************************
PassOne = 1
CALL XParse(Src$)
PassOne = 0
XitCount++
Xit$[XitCount]= Stk$[2]
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$onent"
'****************************
PassOne = 1
CALL XParse(Src$)
PassOne = 0
EntryCnt++
Entry$[EntryCnt]= Stk$[2]
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$pack","$pack("
'****************************
'Src$ = EXTRACT$(Src$,"'") ' allow Basic comments
Src$ = MID$(Src$,6)
FPRINT FP4,"#pragma pack ",LTRIM$(Src$)
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$nodll"
'****************************
NoDllMain = TRUE
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$pelle"
'****************************
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$stdca"
'****************************
UseStdCall = TRUE
Src$ = ""
EXIT FUNCTION
'****************************
' bc.500_com
CASE "$com_t"
IF INSTR(Src$,"com_trace",0,1) THEN
build_com_trace_code = TRUE
PRINT "COM trace code added to translated C file!"
PRINT "Trace informations will be sent to file: c:\\com_trace.txt"
Src$ = ""
EXIT FUNCTION
END IF
CASE "$com_o" ' support for $COM_ON and $COM_OFF
'****************************
IF INSTR(LCASE$(Src$),"$com_on") THEN
Use_COM = UseFlag = TRUE
ComSwitchON = TRUE
ELSEIF INSTR(LCASE$(Src$),"$com_off") THEN
Use_COM = FALSE
ComSwitchON = FALSE
END IF
Src$ = ""
EXIT FUNCTION
' bc.500_com
'****************************
CASE "$iprin"
'****************************
IF INSTR(LCASE$(Src$),"_on") THEN
TranslateSlash = TRUE
ELSE
TranslateSlash = FALSE
END IF
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$nowin"
'****************************
WinHeaders = FALSE
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$nomai"
'****************************
NoMain = TRUE
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$test"
'****************************
TestState = NOT TestState
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$typed"
'****************************
FPRINT FP7,"typedef " + REMAIN$(Src$," "),";"
Src$ = ""
EXIT FUNCTION
'****************************
' must be after CASE "$pelle"
CASE "$proje" ' $PROJECT 6/13/2004 7:41AM Vic McClung
CALL EnableProject
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$prj"
'****************************
Project$ = UCASE$(EXTRACT$(COMMAND$(1),".")) + ".USE"
HFile$ = UCASE$(EXTRACT$(COMMAND$(1),".")) + ".H"
Use_SingleFile = FALSE
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$prjus"
'****************************
PreParse(Src$)
CALL SetUsed
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$resou"
'****************************
Use_Resource = TRUE
CALL XParse(Src$)
ResCompiler$ = Stk$[2]
UserResFile$ = REMOVE$(Stk$[3], DQ$)
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$leana" ' LeanAndMean
Use_LeanAndMean = TRUE
Src$ = ""
EXIT FUNCTION
'****************************
$COMMENT
CASE "$turbo"
Src$ = LTRIM$(MID$(Src$,7))
IF *Src$ <> 0 THEN
TurboSize = VAL(Src$)
IF (TurboSize & (TurboSize-1)) <> 0 THEN
TurboSize = 512
Warning("Invalid $Turbo size - defaulting to 512")
END IF
ELSE
TurboSize = 512
END IF
Use_Turbo = TRUE
Src$ = ""
EXIT FUNCTION
$COMMENT
'****************************
CASE "$sourc"
'****************************
SrcFlag = NOT SrcFlag
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$fssta"
'****************************
Use_Static = NOT Use_Static
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$trace"
'****************************
TrcFlag = NOT TrcFlag
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$pp"
'****************************
PPFlag = NOT PPFlag
IF PPFlag THEN
IF PPDLL_HANDLE = NULL THEN
PPDLL_HANDLE = LOADLIBRARY( "BCXPP.DLL")
IF NOT PPDLL_HANDLE THEN ' failed to load preprocessor dll
Abort ("Failed to Open BCX Preprocessor DLL!")
ELSE
PRINT "BCXPP.DLL Successfully Loaded"
END IF
PPProc = (CPP_FARPROC) GetProcAddress (PPDLL_HANDLE,"_ProcessLine");
IF NOT PPProc THEN
Abort ("Couldn't Find 'ProcessLine' Procedure in BCX Preprocessor DLL!")
END IF
END IF
END IF
Src$ = ""
EXIT FUNCTION ' goto ReadNextLine:
'****************************
CASE "$inclu"
'****************************
IREPLACE "$BCX$" WITH BCXPATH$ IN Src$
szFile$ = TRIM$(REMOVE$(MID$(Src$,9),DQ$))
IF LEFT$(szFile$,1) = "<" THEN
szFile$ = MID$(szFile$, 2, LEN(szFile$)-2)
szFile$ = ENVIRON$("BCXLIB") + szFile$
END IF
CALL PushFileIO
OPEN szFile$ FOR INPUT AS SourceFile
Modules$[++ModuleNdx] = szFile$
ModuleLineNos[ModuleNdx] = 0
FUNCTION = 1
'****************************
' Beginning of Temporary Directives
' in support of C++ Classes
'****************************
CASE "$try"
'****************************
FPRINT Outfile,"try {"
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$throw" ' $throw "An Exception has Occured!"
szTmp$ = MID$(Src$,8)
IF szTmp$ = "" THEN szTmp$ = ENC$("An Exception has occured!")
FPRINT Outfile,Scoot$,"throw " + szTmp$ + ";"
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$catch"
'****************************
szTmp$ = MID$(Src$,8)
IF szTmp$ = "" THEN szTmp$ = "char *str"
FPRINT Outfile,"}"
FPRINT Outfile,"catch (" + szTmp$ + ")" ' catch (char *str)
FPRINT Outfile,"{"
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$endtr","$endna"
'****************************
FPRINT Outfile,"}"
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$names" ' $namespace/$endnamespace
'****************************
UseCpp = TRUE
szTmp$ = MID$(Src$,INCHR(Src$," ")+1)
FPRINT Outfile,"namespace " + LTRIM$(szTmp$)
FPRINT Outfile,"{"
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$usena" ' $usenamespace = using namespace std; etc.
'****************************
UseCpp = TRUE
szTmp$ = MID$(Src$, INCHR(Src$, " ") + 1)
IF RIGHT$(TRIM$(szTmp$),1) <> ";" THEN
FPRINT Outfile,"using namespace ", szTmp$, ";"
ELSE
FPRINT Outfile,"using namespace ", szTmp$
END IF
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$class" ' $class/$endclass
'****************************
STATIC BeenHere
UseCpp = TRUE
szTmp$ = MID$(Src$, INCHR(Src$, " ") + 1)
IF NOT BeenHere THEN
BeenHere++
FPRINT FP4,"#ifndef __cplusplus"
FPRINT FP4," #error A C++ compiler is required"
FPRINT FP4,"#endif"
END IF
WHILE NOT iMatchLft(Src$,"$endclass")
IF EOF(SourceFile) THEN Abort ("$Class Without $EndClass")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
'StripCode(Src$)
IF iMatchLft(Src$,"$endclass") THEN
EXIT LOOP
END IF
FPRINT FP4,Src$
WEND
Src$ = ""
EXIT FUNCTION
'****************************
' END of Temporary Directives
' in support of C++ Classes
'****************************
CASE "$multi", "$mt"
Src$ = ""
Use_MULTITHREADED_SW = TRUE
EXIT FUNCTION
CASE "$comme"
'****************************
Src$ = ""
DO
IF EOF(SourceFile) THEN Abort ("Unbalanced $Comment")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripTabs
IF iMatchLft(LTRIM$(Src$),"$comment") THEN EXIT LOOP
FPRINT Outfile,"// ",Src$
LOOP
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$ccode"
'****************************
Src$ = ""
DO
IF EOF(SourceFile) THEN Abort ("Unbalanced $Ccode")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripTabs
IF iMatchLft(LTRIM$(Src$) ,"$ccode") THEN
IF SrcFlag THEN 'comments seem to interfere with C line continuations '\'
FPRINT Outfile,"// [", TRIM$(Modules$[ModuleNdx]), " - ", _
TRIM$(STR$(ModuleLineNos[ModuleNdx])), "] End of $CCODE Block"
END IF
EXIT LOOP
END IF
FPRINT Outfile,RTRIM$(Src$)
LOOP
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$heade"
'****************************
Src$ = ""
FPRINT FP7, "// ***************************************************"
FPRINT FP7, ""
DO
IF EOF(SourceFile) THEN Abort ("Unbalanced $Header")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripTabs
Src$ = TRIM$(Src$)
IF iMatchLft(Src$,"$heade") THEN EXIT LOOP
FPRINT FP7,Src$
LOOP
Src$ = ""
FPRINT FP7, ""
EXIT FUNCTION
'****************************
CASE "$asm"
'****************************
IF NOT iMatchLft(Src$,"$asm") THEN
Abort ("Unknown metastatement: " + Src$)
END IF
Src$ = ""
IF OptimizerEnabled = TRUE THEN
FPRINT Outfile,"#if defined ( __POCC__ ) && !defined( __cplusplus )"
FPRINT Outfile,"#pragma optimize(none) // No Optimizations in ASM block"
FPRINT Outfile,"#elif !defined ( __cplusplus )"
FPRINT Outfile,"#pragma optimize(0) // No Optimizations in ASM block"
FPRINT Outfile,"#endif"
END IF
DO
IF EOF(SourceFile) THEN Abort ("Unbalanced $Asm")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
IF SrcFlag THEN
FPRINT Outfile,"// ",Src$
END IF
CALL StripTabs
Src$ = TRIM$(Src$)
DIM meta_asm_loop
DIM meta_asm_comment_present AS BOOL
DIM Src_Len
Src_Len = LEN(Src$)
meta_asm_comment_present = FALSE
FOR meta_asm_loop = 0 TO Src_Len
'******************************************
' Extracts both the Basic Single Quote
' and the Assembly Semicolon
'******************************************
IF Src[meta_asm_loop] = 39 OR Src[meta_asm_loop] = 59 THEN
lszTmp$ = RIGHT$(Src$,Src_Len - meta_asm_loop - 1)
Src[meta_asm_loop] = 0
meta_asm_comment_present = TRUE
EXIT LOOP
END IF
NEXT
Src$ = TRIM$(Src$)
IF iMatchLft(Src$,"$asm") THEN EXIT LOOP
REPLACE "$" WITH "0x" IN Src$
IREPLACE "&h" WITH "0x" IN Src$
IF Src$ <> "" THEN
Src$ = "_asm(" + ENC$(Src$) + CHR$(1)
IF meta_asm_comment_present THEN
Src$ = Src$ + TAB$ + "//" + lszTmp$
END IF
SrcTmp$ = Src$
FPRINT Outfile,"#if !defined( __POCC__ ) && !defined (__cplusplus )"
REPLACE CHR$(1) WITH ")" IN Src$
FPRINT Outfile,Src$
FPRINT Outfile,"#else"
REPLACE "_asm(" WITH "__asm{" IN SrcTmp$
REPLACE CHR$(1) WITH "}" IN SrcTmp$
FPRINT Outfile,REMOVE$(SrcTmp$,DQ$)
FPRINT Outfile,"#endif"
END IF
LOOP
IF OptimizerEnabled = TRUE THEN
FPRINT Outfile,"#if defined ( __POCC__ ) && !defined ( __cplusplus )"
FPRINT Outfile,"#pragma optimize() // Restoring Optimizer state"
FPRINT Outfile,"#elif !defined ( __cplusplus )"
FPRINT Outfile,"#pragma optimize(1) // Restoring Optimizer state"
FPRINT Outfile,"#endif"
END IF
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$optim"
'****************************
Src$ = LCASE$(Src$)
IF NOT iMatchLft(Src$,"$optimizer") THEN
Abort("Unknown metastatement: " + Src$)
END IF
lszTmp$ = LCASE$(LTRIM$(RIGHT$(Src$,LEN(Src$)-10)))
IF INSTR(lszTmp$,"on") = 1 THEN
IF OptimizerFirstSetting = TRUE THEN
OptimizerFirstSetting = FALSE
Src$ = "~pragmaoptimizeon"
OptimizerEnabled = TRUE
ELSE
IF OptimizerEnabled = FALSE THEN
OptimizerEnabled = TRUE
Src$ = "~pragmaoptimizeon"
END IF
END IF
ELSEIF INSTR(lszTmp$,"off") = 1 THEN
IF OptimizerFirstSetting = TRUE THEN
OptimizerFirstSetting = FALSE
Src$ = "~pragmaoptimizeoff"
OptimizerEnabled = FALSE
ELSE
IF OptimizerEnabled = TRUE THEN
OptimizerEnabled = FALSE
Src$ = "~pragmaoptimizeoff"
END IF
END IF
ELSE
Abort("Error in $OPTIMIZER MetaStatement: " + Src$ )
END IF
FUNCTION = 2
'****************************
CASE "#inclu"
'****************************
FPRINT FP7, LCASE$(Src$)
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$libra"
'****************************
'Src$ = EXTRACT$(Src$,"'") ' allow comments
REPLACE "\\" WITH "\\\\" IN Src$
Src$ = REMOVE$(LCASE$(Src$),"$library")
REMOVE SPC$ FROM Src$
AddLibrary(Src$)
Src$ = ""
EXIT FUNCTION
'****************************
CASE "$nolib"
'****************************
'Src$ = EXTRACT$(Src$,"'") ' allow comments
REPLACE "\\" WITH "\\\\" IN Src$
Src$ = REMOVE$(LCASE$(Src$),"$nolibrary")
RemoveLibrary(Src$)
Src$ = ""
EXIT FUNCTION
END SELECT
END IF
FUNCTION = 2
END FUNCTION ' Directives
SUB EnableProject
LOCAL cHFn$
STATIC cnt = 0
IF cnt > 0 THEN EXIT SUB
cnt++
Project_Main$ = TRIM$(REMOVE$(MID$(Src$,9),DQ$))
Project_Main$ = EXTRACT$(Project_Main$,"'") ' allow comments
Project_Main$ = EXTRACT$(Project_Main$, ".")
Use_Project = TRUE
FPRINT FP7,""
FPRINT FP7,"// include BCX Runtime header file"
FPRINT FP7,"#include "
FPRINT FP7,""
IF INCHR( COMMAND$(1), "\") THEN ' has a path
cHFn$ = MID$( COMMAND$(1), INSTRREV( COMMAND$(1), "\", 0 ) + 1 )
ELSE
cHFn$ = COMMAND$(1)
END IF
IF INCHR( cHFn$, "." ) THEN ' has an extension
cHFn$ = MID$( cHFn$, 1, INSTRREV( cHFn$, ".", 0 ) -1 )
END IF
FPRINT FP7, "#define __BCX_HEADER_" + UCASE$(cHFn$) + "__"
END SUB ' EnableProject
FUNCTION SubVarType(TokenNum)
DIM RAW k, j = 0
k = CheckLocal(Stk$[TokenNum], &j)
IF k = vt_CHAR THEN
IF *LocalVars[j].VarDim$ <> ASC("[") AND LocalVars[j].VarPntr = 0 THEN
k = vt_INTEGER
ENDIF
ELSEIF k = vt_UNKNOWN THEN
k = CheckGlobal(Stk$[TokenNum], &j)
IF k = vt_CHAR THEN
IF *GlobalVars[j].VarDim$ <> ASC("[") AND GlobalVars[j].VarPntr = 0 THEN
k = vt_INTEGER
ENDIF
ENDIF
END IF
j = ASC(RIGHT$(Stk$[TokenNum],1))
SELECT CASE k
CASE vt_STRVAR, vt_CHAR
IF j <> 36 THEN
CONCAT (Stk$[TokenNum], "$")
END IF
CASE vt_INTEGER
IF j <> 37 THEN
CONCAT (Stk$[TokenNum], "%")
END IF
CASE vt_SINGLE
IF j <> 33 THEN
CONCAT (Stk$[TokenNum], "!")
END IF
CASE vt_DOUBLE
IF j <> 35 THEN
CONCAT (Stk$[TokenNum], "#")
END IF
CASE vt_LDOUBLE
IF j <> 166 THEN
CONCAT (Stk$[TokenNum], "¦")
END IF
END SELECT
FUNCTION = k
END FUNCTION ' SubVarType
FUNCTION PrintWriteFormat$(DoWrite)
DIM RAW Stak[128] AS ARGTYPE
DIM RAW Frmat$
DIM RAW Arg$
DIM RAW ZZ$
DIM RAW Cast$
DIM RAW NewLineFlag = 0
DIM RAW Argcount = 0
DIM RAW i = 0
DIM RAW j = 0
DIM RAW k = 0
Frmat$ = ""
Arg$ = ""
ZZ$ = ""
IF Stk$[Ndx]= ";" THEN
NewLineFlag = TRUE
Ndx--
END IF
IF Ndx = 1 THEN GOTO PrintWriteLabel
Stak[1].ArgType = -1
j = 2
WHILE j <= Ndx
IF Clean$(Stk$[j]) <> "BCX_DynaCall" THEN
i = SubVarType(j)
IF Stak[Argcount+1].ArgType = -1 THEN
IF i = vt_CHAR OR i = vt_STRVAR OR i = vt_INTEGER OR i = vt_SINGLE OR i = vt_DOUBLE OR i = vt_LDOUBLE THEN
Stak[Argcount+1].ArgType = i
END IF
END IF
IF Stk$[j] = "(" THEN
i = 0
DO
IF Stk$[j] = "(" THEN i++
IF Stk$[j] = ")" THEN i--
' IF DataType(Stk$[j]) = vt_STRVAR THEN
' Stk$[j] = "(char*) " + Stk$[j]
' END IF
CONCAT (Arg$,Stk$[j])
j++
LOOP UNTIL i <= 0 OR j >= Ndx
END IF
IF Stk$[j] = "[" THEN
i = 0
DO
DoAgain:
IF Stk$[j] = "[" THEN i++
IF Stk$[j] = "]" THEN i--
CONCAT (Arg$,Stk$[j])
j++
IF Stk$[j] = "[" AND i = 0 THEN GOTO DoAgain
LOOP UNTIL i <= 0 OR j >= Ndx
END IF
IF Stk$[j] = ";" OR Stk$[j] = "," OR Stk$[j] = "&" THEN
Argcount++
Stak[Argcount].Arg$ = Arg$
Stak[Argcount+1].ArgType = -1
Arg$ = ""
j++
ELSE
CONCAT (Arg$,Stk$[j])
j++
END IF
ELSE
CONCAT(Arg$,Stk$[j])
j++
END IF
WEND
Argcount++
Stak[Argcount].Arg$ = Arg$
Arg$ = ""
FOR i = 1 TO Argcount
j = Stak[i].ArgType
IF j = -1 THEN
ZZ$ = EXTRACT$(Stak[i].Arg$,"(")
j = DataType(ZZ$)
END IF
SELECT CASE j
CASE vt_STRLIT, vt_STRVAR, vt_CHAR
IF DoWrite THEN
Frmat$ = Frmat$ + "\\" + DQ$ + "%s" + "\\" + DQ$ + ","
ELSE
CONCAT (Frmat$,"%s")
END IF
IF LEFT$(ZZ$, 12) = "BCX_DynaCall" THEN
Arg$ = Arg$ + ",(char*)" + Clean$(Stak[i].Arg$)
ELSE
Arg$ = Arg$ + "," + Clean$(Stak[i].Arg$)
END IF
CASE vt_INTEGER, vt_DECFUNC
IF DoWrite THEN
Frmat$ = Frmat$ + "%d" + ","
ELSE
CONCAT (Frmat$,"% d")
END IF
REMOVE "%" FROM Stak[i].Arg$
Arg$ = Arg$ + ",(int)" + Clean$(Stak[i].Arg$)
CASE vt_SINGLE
IF DoWrite THEN
Frmat$ = Frmat$ + "%.7G" + ","
ELSE
CONCAT (Frmat$,"% .7G")
END IF
Arg$ = Arg$ + ",(float)" + Clean$(Stak[i].Arg$)
CASE vt_DOUBLE,vt_NUMBER
IF DoWrite THEN
Frmat$ = Frmat$ + "%.15G" + ","
ELSE
CONCAT (Frmat$,"% .15G")
END IF
Arg$ = Arg$ + ",(double)" + Clean$(Stak[i].Arg$)
CASE vt_LDOUBLE
IF DoWrite THEN
Frmat$ = Frmat$ + "%.19LG" + ","
ELSE
CONCAT (Frmat$,"% .19LG")
END IF
Arg$ = Arg$ + ",(LDOUBLE)" + Clean$(Stak[i].Arg$)
CASE ELSE
IF ASC(Stak[i].Arg$) = 40 THEN
ZZ$ = ""
CONCAT(Arg$,",")
DO
k = INSTR(Stak[i].Arg$,")")
Cast$ = MID$(Stak[i].Arg$ ,1 ,k)
Stak[i].Arg$ = TRIM$(MID$(Stak[i].Arg$,k+1))
IREPLACE "char*" WITH "char *" IN Cast$
IREPLACE "lpstr" WITH "char *" IN Cast$
IREPLACE "integer" WITH "int" IN Cast$
IREPLACE "single" WITH "float" IN Cast$
IREPLACE "ldouble" WITH "LDOUBLE" IN Cast$
IF ZZ$ = "" THEN
IF Cast$ = "(char *)" OR Cast$ = "(int)" OR Cast$ = "(float)" OR Cast$ = "(double)" OR Cast$ = "(LDOUBLE)" THEN
ZZ$ = Cast$
ELSE
ZZ$ = "(double)"
Cast$ = ZZ$ + Cast$
END IF
RemoveAll(ZZ$,"()")
IREPLACE "char *" WITH "%s" IN ZZ$
IREPLACE "int" WITH "% d" IN ZZ$
IREPLACE "float" WITH "% .7G" IN ZZ$
IREPLACE "ldouble" WITH "% .19LG" IN ZZ$
IREPLACE "double" WITH "% .15G" IN ZZ$
END IF
CONCAT(Arg$,Cast$)
LOOP WHILE ASC(Stak[i].Arg$) = 40
CONCAT(Arg$,Clean$(Stak[i].Arg$))
CONCAT (Frmat$,ZZ$)
IF DoWrite THEN CONCAT (Frmat$,",")
ELSE
IF DoWrite THEN
Frmat$ = Frmat$ + "%G" + ","
ELSE
CONCAT (Frmat$,"% G")
Arg$ = Arg$ + ",(float)" + Clean$(Stak[i].Arg$)
END IF
END IF
END SELECT
NEXT
IF DoWrite THEN Frmat$ = LEFT$(Frmat$,LEN(Frmat$)-1)
'*********************
PrintWriteLabel:
'*********************
IF NewLineFlag = 0 THEN
CONCAT (Frmat$,"\\n")
END IF
FUNCTION = "printf(" + ENC$(Frmat$) + Arg$ + ");"
END FUNCTION ' PrintWriteFormat$
SUB EmitInputCode
DIM RAW Argcount = 0
DIM RAW VarCnt = 0
DIM RAW i = 0
DIM RAW j = 0
DIM RAW l = 0
DIM RAW Arg$
DIM RAW Tmp$
DIM RAW Frmat$
DIM AUTO Stak$[128]
DIM RAW Y$
DIM RAW ZZ$
IF NOT Use_Inputbuffer THEN
Use_Inputbuffer = TRUE
Use_Scan = TRUE
Use_Proto = TRUE
UseFlag = TRUE
Use_Split = TRUE
Use_Remove = TRUE
Use_StrStr = TRUE
Use_Mid = TRUE
Use_Left = TRUE
Use_Instr = TRUE
Use_Stristr = TRUE
UseLCaseTbl = TRUE
END IF
Arg$ = ""
ZZ$ = ""
Frmat$ = ""
Tmp$ = DQ$ + "," + DQ$ + "," + DQ$ + " " + DQ$
IF DataType(Stk$[2]) = vt_STRLIT THEN
FPRINT Outfile,Scoot$,"printf(" ; Clean$(Stk$[2]) ; ");"
END IF
IF DataType(Stk$[2]) = vt_STRLIT THEN
j = 4
ELSE
j = 2
END IF
l = j
WHILE j <= Ndx
IF j = l THEN
i = SubVarType(j)
END IF
IF Stk$[j] = "," THEN l = j + 1
CONCAT(ZZ$, Stk$[j])
j++
WEND
FastLexer(ZZ$, "", ",")
j = 1 '0
WHILE j <= Ndx
IF Stk$[j] = "," THEN
Argcount++
Stak$[Argcount]= Arg$
Arg$ = ""
j++
ELSE
CONCAT (Arg$, Stk$[j])
j++
IF j < Ndx THEN
IF Stk$[j] = "[" THEN
i = 0
DO
DoAgain:
IF Stk$[j] = "[" THEN i++
IF Stk$[j] = "]" THEN i--
CONCAT (Arg$,Stk$[j])
j++
IF Stk$[j] = "[" AND i = 0 THEN GOTO DoAgain
LOOP UNTIL i <= 0 OR j >= Ndx
END IF
END IF
END IF
WEND
Argcount++
Stak$[Argcount] = Arg$
Arg$ = ""
FOR i = 1 TO Argcount
Y$ = Stak$[i]
j = DataType(Y$)
SELECT CASE j
CASE vt_STRVAR
CONCAT (Frmat$,"%s")
Arg$ = Arg$ + "," + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, "*" + TRIM$(Clean$(Stak$[i])) + "=0;"
VarCnt++
CASE vt_INTEGER
CONCAT (Frmat$,"%d")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_SINGLE
CONCAT (Frmat$,"%g")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_DOUBLE
CONCAT (Frmat$,"%lG")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_LDOUBLE
CONCAT (Frmat$,"%lG")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE ELSE
CONCAT (Frmat$,"%d")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
END SELECT
NEXT
FPRINT Outfile,Scoot$, "gets(InputBuffer);"
FPRINT Outfile,Scoot$, "ScanError = scan(InputBuffer," + ENC$(Frmat$) + Arg$ + ");\n"
FPRINT Outfile,Scoot$, "*InputBuffer=0;"
END SUB ' EmitInputCode
SUB EmitFileInputCode
DIM RAW Argcount = 0
DIM RAW VarCnt = 0
DIM RAW i
DIM RAW j
DIM RAW Arg$
DIM RAW Frmat$
DIM RAW FHandle$
DIM RAW Y$
DIM RAW ZZ$
DIM AUTO Stak$[128]
Arg$ = ""
Frmat$ = ""
ZZ$ = ""
FHandle$ = ""
IF NOT Use_Inputbuffer THEN
Use_Inputbuffer = TRUE
Use_Scan = TRUE
Use_Proto = TRUE
UseFlag = TRUE
Use_Split = TRUE
Use_Remove= TRUE
Use_StrStr= TRUE
Use_Mid = TRUE
Use_Left = TRUE
Use_Instr = TRUE
Use_Stristr = TRUE
UseLCaseTbl = TRUE
END IF
i = 4 ' Extract the file handle
FOR j = 2 TO Ndx
IF *Stk$[j] = ASC(",") THEN i=j+1 : EXIT FOR
FHandle$ = FHandle$ + Stk$[j]
NEXT j
FOR j = i TO Ndx ' build the variable list
IF j = i THEN SubVarType(j)
IF Stk$[j] = "," THEN SubVarType(j+1)
CONCAT(ZZ$, Stk$[j])
NEXT
FastLexer(ZZ$, "", ",")
j = 1 '0
WHILE j <= Ndx
IF Stk$[j] = "," THEN
Argcount++
Stak$[Argcount]= Arg$
Arg$ = ""
j++
ELSE
CONCAT (Arg$, Stk$[j])
j++
IF j < Ndx THEN
IF Stk$[j] = "[" THEN
i = 0
DO
DoAgain:
IF Stk$[j] = "[" THEN i++
IF Stk$[j] = "]" THEN i--
CONCAT (Arg$,Stk$[j])
j++
IF Stk$[j] = "[" AND i = 0 THEN GOTO DoAgain
LOOP UNTIL i <= 0 OR j >= Ndx
END IF
END IF
END IF
WEND
Argcount++
Stak$[Argcount] = Arg$
Arg$ = ""
FOR i = 1 TO Argcount
Y$ = Stak$[i]
j = DataType(Y$)
SELECT CASE j
CASE vt_STRVAR
CONCAT (Frmat$, "%s")
Arg$ = Arg$ + "," + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, "*" + TRIM$(Clean$(Stak$[i])) + "=0;"
VarCnt++
CASE vt_INTEGER
CONCAT (Frmat$, "%d")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_SINGLE
CONCAT (Frmat$, "%g")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_DOUBLE
CONCAT (Frmat$, "%lG")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE vt_LDOUBLE
CONCAT (Frmat$, "%lG")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
CASE ELSE
CONCAT (Frmat$, "%d")
Arg$ = Arg$ + ",&" + Clean$(Stak$[i])
FPRINT Outfile,Scoot$, Clean$(Stak$[i]) + "=0;"
VarCnt++
END SELECT
NEXT
FPRINT Outfile,Scoot$, "fgets(InputBuffer,1048576," ; FHandle$ ; ");"
FPRINT Outfile,Scoot$, "if(InputBuffer[strlen(InputBuffer)-1]== 10)"
FPRINT Outfile,Scoot$, " InputBuffer[strlen(InputBuffer)-1]=0;"
FPRINT Outfile,Scoot$, "ScanError = scan(InputBuffer," + ENC$(Frmat$) + Arg$ + ");\n"
FPRINT Outfile,Scoot$, "*InputBuffer=0;"
END SUB ' EmitFileInputCode
SUB AddFuncs
DIM RAW ZZ$
DIM RAW Last$
Last$ = ""
CALL CloseAll
OPEN prcFile$ FOR INPUT AS FP1
OPEN FileOut$ FOR APPEND AS Outfile
IF ProtoType[1].Prototype$ > "" THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER SUBS AND FUNCTIONS"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// ************************************"
FPRINT Outfile,"// " + $BCX_STR_USR_PROCS
FPRINT Outfile,"// ************************************"
END IF
FPRINT Outfile,"\n"
END IF
WHILE NOT EOF(FP1)
LINE INPUT FP1,ZZ$
'================== strip out dead callback code ======================
IF INSTR(ZZ$,"DefWindowProc") THEN
IF _
INSTR(Last$,"CallWindowProc") OR _
INSTR(Last$,"DefWindowProc") OR _
INSTR(Last$,"DefMDIChildProc") OR _
INSTR(Last$,"DefFrameProc") THEN
Last$ = ""
ITERATE
END IF
END IF
'======================================================================
FPRINT Outfile,ZZ$
IF LEFT$(ZZ$,2) <> "//" THEN
Last$ = ZZ$
END IF
WEND
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
CALL CloseAll
KILL prcFile$ ' translated subs and functions
KILL udtFile$ ' translated User Defined Types
KILL datFile$ ' translated DATA statements
KILL cstFile$ ' translated CONSTants
KILL ovrFile$ ' translated overloaded subs and functions
KILL setFile$ ' translated KILL set statements
KILL enuFile$ ' translated GLOBAL enum blocks
END SUB ' AddFuncs
FUNCTION CheckLocal(ZZ$, BYREF varidx)
DIM RAW TT$
IF LocalVarCnt THEN
TT$ = Clean$(ZZ$)
FOR INTEGER i = 1 TO LocalVarCnt
IF TT$ = LocalVars[i].VarName$ THEN
varidx = i
FUNCTION = LocalVars[i].VarType
END IF
NEXT
END IF
FUNCTION = vt_UNKNOWN
END FUNCTION ' CheckLocal
FUNCTION CheckGlobal(ZZ$, BYREF varidx)
DIM RAW hn
DIM RAW s
DIM RAW TT$
TT$ = Clean$(ZZ$)
hn = HashNumber(TT$)
WHILE GlobalVarHash[hn]
s = GlobalVarHash[hn]
IF TT$ = GlobalVars[s].VarName$ THEN
varidx = s
FUNCTION = GlobalVars[s].VarType
END IF
hn = IMOD(hn + 1,MaxGlobalVars)
WEND
FUNCTION = vt_UNKNOWN
END FUNCTION ' CheckGlobal
FUNCTION CheckType(ZZ$)
DIM RAW Keyword$
DIM RAW varid = 0
DIM RAW i
Keyword$ = LCASE$(ZZ$)
SELECT CASE Keyword$
CASE "int"
FUNCTION = vt_INTEGER
CASE "string"
FUNCTION = vt_STRVAR
CASE "char"
FUNCTION = vt_CHAR
CASE "lpstr"
FUNCTION = vt_LPSTR
CASE "pchar"
FUNCTION = vt_PCHAR
CASE "byte"
FUNCTION = vt_BYTE
CASE "double"
FUNCTION = vt_DOUBLE
CASE "ldouble"
FUNCTION = vt_LDOUBLE
CASE "file"
FUNCTION = vt_FILEPTR
CASE "float"
FUNCTION = vt_SINGLE
CASE "bool","boolean"
FUNCTION = vt_BOOL
CASE "long"
FUNCTION = vt_LONG
CASE "dword"
FUNCTION = vt_DWORD
CASE "farproc"
FUNCTION = vt_FARPROC
CASE "void"
FUNCTION = vt_VOID
CASE "lpbyte"
FUNCTION = vt_LPBYTE
CASE "lresult"
FUNCTION = vt_LRESULT
CASE "short"
FUNCTION = vt_SHORT
CASE "ushort"
FUNCTION = vt_USHORT
CASE "uint"
FUNCTION = vt_UINT
CASE "ulong"
FUNCTION = vt_ULONG
CASE "colorref"
FUNCTION = vt_COLORREF
CASE "hwnd"
FUNCTION = vt_HWND
CASE "handle"
FUNCTION = vt_HANDLE
CASE "hdc"
FUNCTION = vt_HDC
CASE "variant"
FUNCTION = vt_VARIANT
CASE "wndclassex"
FUNCTION = vt_WNDCLASSEX
END SELECT
i = CheckLocal(ZZ$, &varid)
IF i = vt_UNKNOWN THEN
i = DefsID(ZZ$)
IF i THEN FUNCTION = TypeDefs[i].TypeofDef
ELSE
FUNCTION = i
END IF
FUNCTION = CheckGlobal(ZZ$, &varid)
END FUNCTION ' CheckType
SUB ExportInternalConst
IF Use_FillArray THEN
Src$="CONST vt_INTEGER = 2"
PassOne = 1
CALL Parse(Src$)
CALL Emit
Src$="CONST vt_SINGLE = 3"
PassOne = 1
CALL Parse(Src$)
CALL Emit
Src$="CONST vt_DOUBLE = 4"
PassOne = 1
CALL Parse(Src$)
CALL Emit
Src$="CONST vt_LDOUBLE = 5"
PassOne = 1
CALL Parse(Src$)
CALL Emit
END IF
END SUB ' ExportInternalConst
FUNCTION RestrictedWords(ZZ$)
IF ZZ$ = "CmdLine" THEN FUNCTION = 1
IF ZZ$ = "CmdShow" THEN FUNCTION = 1
IF ZZ$ = "hInst" THEN FUNCTION = 1
IF ZZ$ = "hPrev" THEN FUNCTION = 1
IF ZZ$ = "hWnd" THEN FUNCTION = 1
IF ZZ$ = "lParam" THEN FUNCTION = 1
IF ZZ$ = "Msg" THEN FUNCTION = 1
IF ZZ$ = "wParam" THEN FUNCTION = 1
IF ZZ$ = "vt_INTEGER" THEN FUNCTION = 1
IF ZZ$ = "vt_SINGLE" THEN FUNCTION = 1
IF ZZ$ = "vt_DOUBLE" THEN FUNCTION = 1
IF ZZ$ = "vt_LDOUBLE" THEN FUNCTION = 1
FUNCTION = 0
END FUNCTION ' RestrictedWords
SUB AddTypeDefs(TypeName$, TDef)
TypeDefsCnt++
IF TypeDefsCnt = MaxTypes THEN Abort("Exceeded TYPE Limits.")
TypeDefs[TypeDefsCnt].VarName$ = TypeName$
TypeDefs[TypeDefsCnt].TypeofDef = TDef
TypeDefs[TypeDefsCnt].EleCnt = 0
END SUB ' AddTypeDefs
FUNCTION DefsID(ZZ$)
DIM RAW i
IF TypeDefsCnt > 0 THEN
FOR i = 1 TO TypeDefsCnt
IF ZZ$ = TypeDefs[i].VarName$ THEN
FUNCTION = i
END IF
NEXT
END IF
FUNCTION = 0
END FUNCTION ' DefsID
FUNCTION DataType(ZZ$)
DIM RAW Keyword$
DIM RAW i
IF ZZ[0] = 34 THEN
FUNCTION = vt_STRLIT
END IF
IF INCHR(ZZ$,"$") THEN
FUNCTION = vt_STRVAR
END IF
IF IsNumber(ZZ$) THEN
FUNCTION = vt_NUMBER
END IF
i = DefsID(ZZ$)
IF i THEN FUNCTION = TypeDefs[i].TypeofDef
'****************
' Functions
'****************
Keyword$ = LCASE$(ZZ$)
IF Keyword$ = "strlen" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "instr" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "inchr" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "sizeof" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "tally" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "band" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "bor" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "lof" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "pos" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "qbcolor" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "split" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "dsplit" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "csrlin" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "cursorx" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "cursory" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "screen" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "msgbox" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "sgn" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "timer" THEN
FUNCTION = vt_SINGLE
END IF
IF Keyword$ = "keypress()" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "getattr" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "FindFirstInstance" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "fix" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "instrrev" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "kbhit" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "textmode" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "exp" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "expl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "sinh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "cosh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "tanh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "asinh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "acosh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "atanh" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "round" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "val" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "vall" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "iif" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "bin2dec" THEN
FUNCTION = vt_INTEGER
END IF
IF Keyword$ = "hex2dec" THEN
FUNCTION = vt_INTEGER
END IF
IF Keyword$ = "rnd" THEN
FUNCTION = vt_SINGLE
END IF
IF Keyword$ = "frac" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "fracl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "asin" THEN
FUNCTION = vt_DOUBLE
END IF
'
IF Keyword$ = "asinl" THEN
FUNCTION = vt_LDOUBLE
END IF
'
IF Keyword$ = "hypot" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "hypotl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "log" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "logl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "log10" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "log10l" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "acos" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "acosl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "atan" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "atanl" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "sin" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "sinl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "cos" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "cosl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "tan" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "tanl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "pow" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "powl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "sqrt" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "sqrtl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "min" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "max" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "exist" THEN
FUNCTION = vt_DECFUNC
END IF
IF Keyword$ = "abs" THEN
FUNCTION = vt_DOUBLE
END IF
IF Keyword$ = "absl" THEN
FUNCTION = vt_LDOUBLE
END IF
IF Keyword$ = "freefile" THEN
FUNCTION = vt_FILEPTR
END IF
IF Keyword$ = "fint" THEN
FUNCTION = vt_INTEGER
END IF
IF INCHR(ZZ$,"%") THEN
FUNCTION = vt_INTEGER
END IF
IF INCHR(ZZ$,"!") THEN
FUNCTION = vt_SINGLE
END IF
IF INCHR(ZZ$,"#") THEN
FUNCTION = vt_DOUBLE
END IF
IF INCHR(ZZ$,"^") THEN
FUNCTION = vt_DOUBLE
END IF
IF INCHR(ZZ$,"¦") THEN
FUNCTION = vt_LDOUBLE
END IF
IF iMatchRgt(ZZ$,"@") THEN
FUNCTION = vt_FILEPTR
END IF
IF INCHR(ZZ$," ") THEN
FUNCTION = vt_UDT
END IF
IF isalpha(*ZZ$) THEN
FUNCTION = vt_INTEGER
END IF
FUNCTION = vt_UNKNOWN
END FUNCTION ' DataType
SUB CloseAll
IF PPDLL_HANDLE THEN
FreeLibrary(PPDLL_HANDLE)
PPDLL_HANDLE = NULL
PPProc = NULL
END IF
CLOSE ' Flush and Close all open files
END SUB ' CloseAll
FUNCTION Clean$(ZZ$)
DIM RAW Tmp$
IF INCHR(ZZ$,"%") THEN
IF TRIM$(ZZ$) = "%" THEN FUNCTION = " % "
END IF
IF INSTR(ZZ$,"!=") THEN FUNCTION = ZZ$
Tmp$ = ZZ$
RemoveAll(Tmp$,"%$#!@¦",1) '1 = ignore anything in quotes
FUNCTION = Tmp$
END FUNCTION ' Clean$
SUB RemoveAll OPTIONAL(Arg$, MatchChars$, qtflag=0)
DIM RAW C = Arg AS PCHAR
DIM RAW pmc AS PCHAR
WHILE *Arg
IF qtflag THEN
IF *Arg = 34 THEN
*(C++) = *Arg
WHILE *(++Arg) <> 34
*(C++) = *Arg
IF *Arg = 0 THEN EXIT SUB
WEND
*(C++) = *(Arg++)
ITERATE
END IF
END IF
pmc = MatchChars
WHILE *pmc
IF *(pmc++) = *Arg THEN GOTO SKIP
WEND
*(C++) = *Arg
SKIP:
INCR Arg
WEND
*C = 0
END SUB
SUB Warning OPTIONAL(ZZ$, WarnLvl=0)
LOCAL fErr AS FILE
IF WarnLvl THEN
WarnMsg$ = WarnMsg$ + ZZ$ + " at line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx])
ELSE
WarnMsg$ = WarnMsg$ + ZZ$
END IF
WarnMsg$ = WarnMsg$ + CRLF$
IF ErrFile THEN
OPEN FileErr$ FOR APPEND AS fErr
FPRINT fErr, "WARNING ";ZZ$
CLOSE fErr
END IF
END SUB ' Warnings
FUNCTION GetVarTypeName(i) AS LPSTR
DIM STATIC A$
SELECT CASE i
CASE vt_INTEGER : A$ = "int"
CASE vt_STRVAR : A$ = "char *"
CASE vt_STRLIT : A$ = "STRLIT"
CASE vt_UNKNOWN : A$ = "UNKNOWN"
CASE vt_SINGLE : A$ = "float"
CASE vt_DOUBLE : A$ = "double"
CASE vt_LDOUBLE : A$ = "LDOUBLE"
CASE vt_DECFUNC : A$ = "DECFUNC"
CASE vt_NUMBER : A$ = "NUMBER"
CASE vt_FILEPTR : A$ = "FILE*"
CASE vt_UDT : A$ = "struct"
CASE vt_STRUCT : A$ = "struct"
CASE vt_UNION : A$ = "union"
CASE vt_LPSTR : A$ = "LPSTR"
CASE vt_BOOL : A$ = "BOOL"
CASE vt_CHAR : A$ = "char"
CASE vt_LPSTRPTR : A$ = "LPSTR *"
CASE vt_CHARPTR : A$ = "char *"
CASE vt_PCHAR : A$ = "PCHAR"
CASE vt_VOID : A$ = "void"
CASE vt_LONG : A$ = "long"
CASE vt_DWORD : A$ = "DWORD"
CASE vt_FARPROC : A$ = "FARPROC"
CASE vt_LPBYTE : A$ = "LPBYTE"
CASE vt_LRESULT : A$ = "LRESULT"
CASE vt_BYTE : A$ = "BYTE"
CASE vt_SHORT : A$ = "short"
CASE vt_USHORT : A$ = "USHORT"
CASE vt_COLORREF : A$ = "COLORREF"
CASE vt_UINT : A$ = "UINT"
CASE vt_ULONG : A$ = "ULONG"
CASE vt_HWND : A$ = "HWND"
CASE vt_HANDLE : A$ = "HANDLE"
CASE vt_HINSTANCE : A$ = "HINSTANCE"
CASE vt_HDC : A$ = "HDC"
CASE vt_VARIANT : A$ = "VARIANT"
CASE ELSE : A$ = "" 'Assume the programmer has a brain
END SELECT
FUNCTION = A
END FUNCTION ' GetVarTypeName$
FUNCTION HashNumber(HT$)
DIM RAW TT AS CHAR PTR
DIM RAW i = 0 AS ULONG
TT = HT
WHILE *TT
i <<= 1
! i ^= *TT;
TT++
WEND
FUNCTION = IMOD(i,MaxGlobalVars)
END FUNCTION 'HashNumber
SUB AddLibrary( LibName$ )
STATIC nTimes
LOCAL nLibNdx
DIM RAW TempLibName$
TempLibName$ = LCASE$(LibName$)
IF NOT INCHR(TempLibName$,DQ$) AND NOT INCHR(TempLibName$,"<") THEN
TempLibName$ = ENC$(TempLibName$,60,62)
END IF
IF nTimes = 0 THEN
FOR INTEGER i = 0 TO MaxLib - 1
Library$[i] = ""
NEXT
nTimes++
Library$[0] = TempLibName$
EXIT SUB
END IF
nLibNdx = 0
WHILE Library$[nLibNdx] <> ""
IF Library$[nLibNdx] = TempLibName$ THEN EXIT SUB
INCR nLibNdx
WEND
IF nLibNdx < MaxLib - 1 THEN
Library$[nLibNdx] = TempLibName$
END IF
END SUB ' AddLibrary
SUB RemoveLibrary( LibName$ )
IF NOT INSTR( RmLibs$, LibName$, 1, 1 ) THEN
RmLibs$ = RmLibs$ + "," + LCASE$(LibName$)
END IF
END SUB ' RemoveLibrary
SUB EmitLibs()
STATIC nTimes
STATIC nCount
DIM RAW ltmp$
IF nTimes > 0 THEN EXIT SUB
INCR nTimes
IF Library$[0] = "" THEN EXIT SUB
FPRINT FP7,""
FPRINT FP7,"#if !defined( __LCC__ )"
FOR INTEGER i = 0 TO MaxLib - 1
IF Library$[i] = "" AND nCount > 0 THEN
GOTO NEXTLIB
ELSEIF Library$[i] = "" THEN
GOTO NEXTLIB
END IF
ltmp$ = Library$[i]
RemoveAll(ltmp$,"<>" & DQ$)
IF INSTR( RmLibs$, ltmp$ ) THEN ITERATE ' skip libraries that have been removed
IF nCount = 0 THEN
INCR nCount
FPRINT FP7,"// *************************************************"
FPRINT FP7,"// Instruct Linker to Search Object/Import Libraries"
FPRINT FP7,"// *************************************************"
END IF
FPRINT FP7,"#pragma comment(lib,",ENC$(ltmp$), ")"
NEXT
NEXTLIB:
FPRINT FP7, "#else"
' add lccwin32's default libraries to the remove library list so they won't be emitted
RmLibs$ = RmLibs$ + ",,,,,,,,"
FOR INTEGER i = 0 TO MaxLib - 1
IF Library$[i] = "" AND nCount > 0 THEN
FPRINT FP7,"// *************************************************"
FPRINT FP7,"// End of Object/Import Libraries To Search"
FPRINT FP7,"// *************************************************"
GOTO LIBEND
ELSEIF Library$[i] = "" THEN
GOTO LIBEND
END IF
IF INSTR( RmLibs$, Library$[i] ) THEN ITERATE ' skip libraries that have been removed
IF nCount = 0 THEN
INCR nCount
FPRINT FP7,""
FPRINT FP7,"// *************************************************"
FPRINT FP7,"// Instruct Linker to Search Object/Import Libraries"
FPRINT FP7,"// *************************************************"
END IF
FPRINT FP7,"#pragma lib ",Library$[i]
NEXT
LIBEND:
FPRINT FP7,"#endif"
IF Use_Library THEN FPRINT FP7,"// END BCXRTHEADER\n\n"
END SUB ' EmitLibs
SUB AddGlobal(GlobalName$, GlobalType, GlobalDef, GlobalDim$, GlobalPtr, GlobalFS, GlobalExtn)
DIM RAW FirstVar$
DIM RAW SecondVar$
DIM RAW Warn$
DIM RAW ss
DIM RAW s
IF Use_Project = TRUE THEN
IF GlobalExtn = 0 THEN
GlobalExtn = 2
END IF
END IF
IF RestrictedWords(GlobalName$) AND TestState THEN
Warn$ = "Restricted Word " + GlobalName$ + " on Line"
Warn$ = Warn$ + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx])
CALL Warning(Warn$)
END IF
ss = HashNumber(GlobalName$)
WHILE GlobalVarHash[ss]
s = GlobalVarHash[ss]
IF GlobalName$ = GlobalVars[s].VarName$ THEN
IF GlobalVars[s].VarType <> GlobalType OR _
GlobalDim$ <> GlobalVars[s].VarDim$ OR _
GlobalVars[s].VarDef <> GlobalDef THEN
FirstVar$ = "Line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + " : " + GlobalName$ + GlobalDim$ + " as " + GetVarTypeName$(GlobalType) + " " + TypeDefs[GlobalDef].VarName$
SecondVar$ = "Line" + STR$(GlobalVars[s].VarLine) + " in Module: " + GlobalVars[s].VarModule + " : " + GlobalName$ + GlobalVars[s].VarDim$ + " as " + GetVarTypeName$(GlobalVars[s].VarType) + " " + TypeDefs[GlobalVars[s].VarDef].VarName$
Warn$ = "Two Variables " + FirstVar$ + " previously defined at " + SecondVar$
CALL Warning(Warn$)
END IF
EXIT SUB
END IF
ss = IMOD(ss + 1,MaxGlobalVars)
WEND
GlobalVarCnt++
IF GlobalVarCnt = MaxGlobalVars THEN Abort("Maximum Global Variables reached.")
GlobalVars[GlobalVarCnt].VarName$ = GlobalName$
GlobalVars[GlobalVarCnt].VarType = GlobalType
GlobalVars[GlobalVarCnt].VarDef = GlobalDef
GlobalVars[GlobalVarCnt].VarDim$ = GlobalDim$
GlobalVars[GlobalVarCnt].VarLine = ModuleLineNos[ModuleNdx]
GlobalVars[GlobalVarCnt].VarPntr = GlobalPtr
GlobalVars[GlobalVarCnt].VarSF = GlobalFS
GlobalVars[GlobalVarCnt].VarModule$ = TRIM$(Modules$[ModuleNdx])
GlobalVars[GlobalVarCnt].VarExtn = GlobalExtn
GlobalVars[GlobalVarCnt].VarCondLevel = InConditional
GlobalVars[GlobalVarCnt].VarCondDef$ = InIfDef$
GlobalVarHash[ss] = GlobalVarCnt
END SUB ' AddGlobal
SUB AddLocal(LocalName$, LocalType, LocalDef, LocalDim$, LocalPtr, LocalFS)
DIM RAW varid = 0
DIM RAW FirstVar$
DIM RAW SecondVar$
DIM RAW Warn$
DIM RAW s
IF LocalVarCnt AND TestState THEN
IF CheckGlobal(LocalName$, &varid) <> vt_UNKNOWN THEN
IF LocalDef THEN
FirstVar$ = "Line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + " : " + LocalName$ + LocalDim$ + " as " + TypeDefs[LocalDef].VarName$
ELSE
FirstVar$ = "Line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + " : " + LocalName$ + LocalDim$ + " as " + GetVarTypeName$(LocalType)
END IF
IF GlobalVars[varid].VarDef THEN
SecondVar$ = "Line" + STR$(GlobalVars[varid].VarLine) + " in Module: " + GlobalVars[varid].VarModule + " : " + LocalName$ + GlobalVars[varid].VarDim$ + " as " + TypeDefs[GlobalVars[varid].VarDef].VarName$
ELSE
SecondVar$ = "Line" + STR$(GlobalVars[varid].VarLine) + " in Module: " + GlobalVars[varid].VarModule + " : " + LocalName$ + GlobalVars[varid].VarDim$ + " as " + GetVarTypeName$(GlobalVars[varid].VarType)
END IF
Warn$ = "Local Variable " + FirstVar$ + CRLF$ + "Has Same Name as Global " + SecondVar$
CALL Warning(Warn$)
END IF
FOR s = 1 TO LocalVarCnt
IF LocalName$ = LocalVars[s].VarName$ THEN
IF LocalVars[s].VarType <> LocalType OR LocalDim$ <> LocalVars[s].VarDim$ OR LocalVars[s].VarDef <> LocalDef THEN
FirstVar$ = "Line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + " : " + LocalName$ + LocalDim$ + " as " + GetVarTypeName$(LocalType) + " " + TypeDefs[LocalDef].VarName$
SecondVar$ = "Line" + STR$(LocalVars[s].VarLine) + " in Module: " + LocalVars[s].VarModule + " : " + LocalName$ + LocalVars[s].VarDim$ + " as " + GetVarTypeName$(LocalVars[s].VarType) + " " + TypeDefs[LocalVars[s].VarDef].VarName$
Warn$ = "Two Variables " + FirstVar$ + " previously defined at " + SecondVar$
CALL Warning(Warn$)
END IF
EXIT SUB
END IF
NEXT
END IF
LocalVarCnt++
IF LocalVarCnt = MaxLocalVars THEN
Warn$ = "Maximum Local Variables reached."
Abort(Warn$)
END IF
LocalVars[LocalVarCnt].VarName$ = LocalName$
LocalVars[LocalVarCnt].VarType = LocalType
LocalVars[LocalVarCnt].VarDef = LocalDef
LocalVars[LocalVarCnt].VarDim$ = LocalDim$
LocalVars[LocalVarCnt].VarLine = ModuleLineNos[ModuleNdx]
LocalVars[LocalVarCnt].VarPntr = LocalPtr
LocalVars[LocalVarCnt].VarSF = LocalFS
LocalVars[LocalVarCnt].VarModule$= TRIM$(Modules$[ModuleNdx])
END SUB ' AddLocal
FUNCTION IsNumber(a$)
DIM RAW i = 0
IF NOT *a THEN FUNCTION = FALSE ' Handle null arguments
WHILE a[i] ' While NOT null terminator
IF a[i]>47 AND a[i]<58 THEN ' Test for 0123456789
i++ ' bump our index
ELSE
FUNCTION = FALSE ' a$ is not a number
END IF '
WEND '
FUNCTION = TRUE ' a$ is a number
END FUNCTION ' IsNumber
FUNCTION IsNumberEx(a$)
DIM RAW i = 0
IF NOT *a THEN FUNCTION = FALSE ' Handle null arguments
WHILE a[i] ' While NOT null terminator
IF a[i]>44 AND a[i]<58 THEN ' Test FOR -+.0123456789
i++ ' bump our index
ELSE
FUNCTION = FALSE ' a$ is not a number
END IF '
WEND '
FUNCTION = TRUE ' a$ is a number
END FUNCTION ' IsNumberEx
SUB StripTabs
DIM RAW i = 0
WHILE Src[i]
IF Src[i] = 9 THEN Src[i] = 32
i++
WEND
END SUB ' StripTabs
SUB PushFileIO
FPtr[++FPtrNdx] = SourceFile
END SUB 'PushFileIO
SUB PopFileIO
IF FPtrNdx = 0 THEN EXIT SUB
CLOSE SourceFile
INCR LinesRead, ModuleLineNos[ModuleNdx--]
SourceFile = FPtr[FPtrNdx--]
END SUB 'PopFileIO
FUNCTION Inset(Mane$,Match$)
DIM RAW i = -1, j = -1
WHILE Match[++i]
WHILE Mane[++j]
IF Match[i] = Mane[j] THEN FUNCTION = TRUE
WEND
j = -1
WEND
FUNCTION = FALSE
END FUNCTION 'Inset
' FUNCTION LinesWritten
' DIM RAW FP0 AS FILE
' DIM RAW NL = 10
' DIM RAW C
' DIM RAW Lines = 0
' OPEN FileOut$ FOR BINARY AS FP0
' WHILE NOT EOF(FP0)
' C = GETC (FP0)
' IF C = NL THEN
' Lines++
' END IF
' WEND
' CLOSE FP0
' FUNCTION = Lines
' END FUNCTION ' LinesWritten
SUB CheckParQuotes
DIM RAW CountR=0 'Round bracket counter
DIM RAW CountS=0 'Square bracket counter
DIM RAW i=0
DIM RAW DoCount=TRUE AS BOOL
WHILE Src[i]
IF Src[i]=34 THEN
DoCount = NOT DoCount
END IF
IF DoCount THEN
IF Src[i]=40 THEN
CountR++
ELSEIF Src[i]=41 THEN
CountR--
ELSEIF Src[i]=91 THEN
CountS++
ELSEIF Src[i]=93 THEN
CountS--
END IF
END IF
i++
WEND
IF NOT DoCount THEN
Abort ("Unmatched Quotes")
ELSEIF CountS THEN
Abort ("Unmatched []")
ELSEIF CountR THEN
Abort ("Unmatched ()")
END IF
END SUB ' CheckParQuotes
'SUB InsertSrcStk(sz$)
' IF sz$ = "" THEN
' EXIT SUB
' END IF
' SrcStk$[++SrcCnt] = sz$
'END SUB 'InsertSrcStk
SUB ClearIfThenStacks
FOR INTEGER i = 0 TO 127
TmpStk$[i] = ""
SrcStk$[i] = ""
NEXT
SrcCnt = 0
END SUB ' ClearIfThenStacks
FUNCTION IsQuoted(ZZ$)
IF NOT iMatchLft(LTRIM$(ZZ$),DQ$) THEN EXIT FUNCTION
IF NOT iMatchRgt(RTRIM$(ZZ$),DQ$) THEN EXIT FUNCTION
FUNCTION = TRUE
END FUNCTION ' IsQuoted
SUB PostProcess
DIM RAW A
IF ReDirect = TRUE THEN
OPEN FileOut$ FOR INPUT AS FP1
WHILE NOT EOF(FP1)
LINE INPUT FP1,Z$
PRINT Z$
WEND
CALL CloseAll
END IF
'**************************
OutfileClone$ = FileOut$
FOR A = 1 TO EntryCnt
OutfileClone$ = EXTRACT$(OutfileClone$,".")
Cmd$ = REMOVE$(Entry$[A],DQ$)
REPLACE "\\\\" WITH "\\" IN Cmd$
IREPLACE "$file$" WITH EXTRACT$(OutfileClone$,".") IN Cmd$
'IF Use_Pelles THEN
IREPLACE "$PELLES$\\" WITH PELLESPATH$ IN Cmd$
IREPLACE "$PELLES$" WITH PELLESPATH$ IN Cmd$
'ELSE
IREPLACE "$LCC$\\" WITH LCCPATH$ IN Cmd$
IREPLACE "$LCC$" WITH LCCPATH$ IN Cmd$
'END IF
IREPLACE "$BCX$\\" WITH BCXPATH$ IN Cmd$
IREPLACE "$BCX$" WITH BCXPATH$ IN Cmd$
PRINT "Shelling Out To:", Linker$
SHELL Cmd$
NEXT
IF Compiler$ > "" THEN
Compiler$ = TRIM$(REMOVE$(Compiler$,DQ$))
IF INCHR(Compiler$, " ") THEN
Compiler$ = ENC$(EXTRACT$(Compiler$," ")) + " " + REMAIN$(Compiler$," ")
ELSE
Compiler$ = ENC$(Compiler$)
END IF
FileOut$ = EXTRACT$(FileOut$,".") + ".c"
Compiler$ = Compiler$ + " " + FileOut$
'IF Use_Pelles THEN
IREPLACE "$PELLES$\\" WITH PELLESPATH$ IN Compiler$
IREPLACE "$PELLES$" WITH PELLESPATH$ IN Compiler$
'ELSE
IREPLACE "$LCC$\\" WITH LCCPATH$ IN Compiler$
IREPLACE "$LCC$" WITH LCCPATH$ IN Compiler$
'END IF
IREPLACE "$FILE$" WITH EXTRACT$(OutfileClone$,".") IN Compiler$
REPLACE "\\\\" WITH "\\" IN Compiler$
REPLACE DDQ$ WITH DQ$ IN Compiler$
PRINT "Shelling Out To:", Compiler$
SHELL Compiler$
END IF
'**************************
IF ResCompiler$ > "" THEN
ResCompiler$ = ENC$(ResCompiler$)
ResCompiler$ = ResCompiler$ + " " + Res_File$
'IF Use_Pelles THEN
IREPLACE "$PELLES$\\" WITH PELLESPATH$ IN ResCompiler$
IREPLACE "$PELLES$" WITH PELLESPATH$ IN ResCompiler$
'ELSE
IREPLACE "$LCC$\\" WITH LCCPATH$ IN ResCompiler$
IREPLACE "$LCC$" WITH LCCPATH$ IN ResCompiler$
'END IF
IREPLACE "$FILE$" WITH EXTRACT$(OutfileClone$,".") IN ResCompiler$
REPLACE "\\\\" WITH "\\" IN ResCompiler$
REPLACE DDQ$ WITH DQ$ IN ResCompiler$
PRINT "Shelling Out To:", ResCompiler$
SHELL ResCompiler$
END IF
'**************************
IF Linker$ > "" THEN
Linker$ = TRIM$(REMOVE$(Linker$,DQ$))
IF INCHR(Linker$, " ") THEN
Linker$ = DQ$ + EXTRACT$(Linker$," ") + DQ$ + " " + REMAIN$(Linker$," ")
ELSE
Linker$ = ENC$(Linker$)
END IF
FileOut$ = EXTRACT$(FileOut$,".") + ".obj"
Linker$ = Linker$ + " " + FileOut$
'IF Use_Pelles THEN
IREPLACE "$PELLES$\\" WITH PELLESPATH$ IN Linker$
IREPLACE "$PELLES$" WITH PELLESPATH$ IN Linker$
'ELSE
IREPLACE "$LCC$\\" WITH LCCPATH$ IN Linker$
IREPLACE "$LCC$" WITH LCCPATH$ IN Linker$
'END IF
IREPLACE "$FILE$" WITH EXTRACT$(OutfileClone$,".") IN Linker$
REPLACE "\\\\" WITH "\\" IN Linker$
REPLACE DDQ$ WITH DQ$ IN Linker$
IF Use_Resource THEN
ResFileOut$ = EXTRACT$(Res_File$,".") + ".res"
Linker$ = Linker$ + " " + ResFileOut$
END IF
PRINT "Shelling Out To:", Linker$
SHELL Linker$
END IF
'**************************
FOR A = 1 TO XitCount
FileOut$ = EXTRACT$(FileOut$,".")
Cmd$ = REMOVE$(Xit$[A],DQ$)
IREPLACE "$FILE$" WITH EXTRACT$(OutfileClone$,".") IN Cmd$
IREPLACE "$PELLES$\\" WITH PELLESPATH$ IN Cmd$
IREPLACE "$PELLES$" WITH PELLESPATH$ IN Cmd$
IREPLACE "$LCC$\\" WITH LCCPATH$ IN Cmd$
IREPLACE "$LCC$" WITH LCCPATH$ IN Cmd$
IREPLACE "$BCX$\\" WITH BCXPATH$ IN Cmd$
IREPLACE "$BCX$" WITH BCXPATH$ IN Cmd$
REPLACE "\\\\" WITH "\\" IN Cmd$
REPLACE DDQ$ WITH DQ$ IN Cmd$
PRINT "Shelling Out To:", Cmd$
SHELL Cmd$
NEXT
END SUB ' PostProcess
SUB XParse(Arg$)
'***************
DIM RAW lszTmp$
DIM RAW j, i = 0, Gapflag = 0
DIM RAW InIF = 0
IF TRIM$(Arg$) = "" THEN
Ndx = 0
EXIT SUB
END IF
FastLexer(Arg$, SPC$, "=&()[]{}',+-*/<>?;.|:^")
'****************************************
' Pre Parse
'****************************************
WHILE ++i < 17 : Stk$[i+Ndx] = "" : WEND
FOR i = 1 TO Ndx
Keyword1$ = LCASE$(Stk$[i])
IF Keyword1[1] <> 0 THEN
SELECT CASE Keyword1$
CASE "and" : Stk$[i] = "&&"
CASE "or" : Stk$[i] = "||"
CASE "not" : Stk$[i] = "!"
CASE "is" : Stk$[i] = "="
CASE "xor" : Stk$[i] = "xor"
CASE "if","iif","iif$","case","elseif","while"
InIF = 1
CASE "then"
InIF = 0
CASE "byval"
Stk$[i] = ""
Gapflag = TRUE
CASE "byref"
IF NOT iMatchWrd(Stk$[1], "declare") AND _
NOT iMatchWrd(Stk$[1], "c_declare") THEN
ByrefVars[++ByrefCnt] = Stk$[i+1]
END IF
FOR j = i TO Ndx
IF Stk$[j+1] = "," OR Stk$[j+1] = ")" THEN
Stk$[j] = "PTR"
EXIT FOR
END IF
Stk$[j] = Stk$[j+1]
NEXT
CASE ELSE
IF PassOne THEN
IF Keyword1$ = ENC$(CHR$(92)) THEN
Stk$[i] = "chr$"
InsertTokens(i, 3, "(", "92", ")")
INCR i,3
ELSEIF TranslateSlash THEN
REPLACE "\\" WITH "\\\\" IN Stk$[i]
END IF
END IF
END SELECT
'*******************************************************************
' Allow logical 'OR/AND' to be used as 'binary BOR/BAND'
'*******************************************************************
IF NOT InIF THEN
IF Stk$[i] = "&&" THEN
Stk$[i] = "BAND"
ELSEIF Stk$[i] = "||" THEN
Stk$[i] = "BOR"
END IF
END IF
ELSE
SELECT CASE ASC(Keyword1$)
CASE ASC("?")
Stk$[i] = "print"
CASE ASC("-")
IF ASC(Stk$[i+1]) = ASC(">") THEN
Stk$[i] = "->" & Stk$[i+2]
Stk$[++i] = "" : Stk$[++i] = ""
Gapflag=TRUE
END IF
CASE ASC(".")
IF IsNumber(Stk$[i-1]) THEN
Stk$[i] = Stk$[i-1] & "."
Stk$[i-1] = "" : Gapflag=TRUE
END IF
IF NOT INCHR( ",)=<>*/+-^" , Stk[i+1]) THEN
Stk$[i] = Stk$[i] & Stk$[i+1]
Stk$[++i] = "" : Gapflag=TRUE
END IF
END SELECT
END IF
NEXT i
IF Gapflag THEN
FOR i = 1 TO Ndx
IF NOT *Stk[i] THEN
j = i + 1
WHILE NOT *Stk[j] AND (j < Ndx) : INCR j : WEND
IF NOT *Stk[j] THEN EXIT FOR
Stk$[i] = Stk$[j] : Stk$[j] = ""
END IF
NEXT i
Ndx = i-1
END IF
' *******************************************************************
' Special Case Handler: BYREF - BCX prepends * to BYREF'd Variables
' *******************************************************************
IF PassOne = 1 THEN
IF InFunc THEN ' Must be in a SUB or FUNCTION
FOR i = 1 TO Ndx
FOR j = 1 TO ByrefCnt
lszTmp$ = Stk$[i]
IF Clean$(lszTmp$) = Clean$(ByrefVars[j]) THEN
IF i > 2 THEN
IF INCHR("+-^%*/|&<=>,", Stk$[i-2]) AND Stk$[i-1] = "*" THEN
Stk$[i-1] = ""
END IF
IF Stk$[i-1] = "&" THEN
Stk$[i-1] = ""
EXIT FOR
END IF
ELSEIF i = 2 THEN
IF Stk$[i-1] = "*" THEN Stk$[i-1] = ""
END IF
Stk$[i] = "*" & Stk$[i]
IF Stk$[i-1] <> "(" OR Stk$[i+1] <> ")" THEN
Stk$[i] = ENC$(Stk$[i], ASC("("), ASC(")"))
END IF
EXIT FOR
END IF
NEXT
NEXT
' FOR i = 1 TO Ndx
' lszTmp$ = RIGHT$(Stk$[i-1],1)
' IF NOT isalpha(*lszTmp$) THEN
' IF NOT IsNumber(lszTmp$) THEN
' IF NOT INCHR("()[]",lszTmp$) THEN
' IF Stk$[i] = "*" THEN
' IF *Stk[i+1] = ASC("*") THEN Stk$[i] = ""
' END IF
' END IF
' END IF
' END IF
' NEXT
END IF
END IF
' *******************************************************************
' Special Case Handler: DIM BLAHBLAH[22][33] AS STATIC INTEGER
' *******************************************************************
IF iMatchWrd(Stk$[1],"dim") THEN
IF iMatchWrd(Stk$[Ndx-1],"static") THEN
Stk$[1] = "static"
Stk$[Ndx-1] = Stk$[Ndx]
Ndx--
END IF
END IF
' ***************************************************************************
' Special Case Handler: In the contexts of UDT,s this handler transforms:
' FUNCTION Foo (a as integer) AS INTEGER to:
' DIM Foo (a as integer) AS FUNCTION INTEGER
'
' Change "as string" to "as char *" for UDTs and Declarations
' ***************************************************************************
IF InTypeDef OR iMatchWrd(Stk$[1], "declare") OR iMatchWrd(Stk$[1], "c_declare") THEN
FOR INTEGER i = 2 TO Ndx
IF iMatchLft(Stk$[i],"as") THEN
IF iMatchWrd(Stk$[i+1],"string") THEN
IF *Stk$[i+2] <> ASC("*") THEN Stk$[i+1] = "char *"
END IF
END IF
NEXT
END IF
IF InTypeDef THEN
IF iMatchWrd(Stk$[1],"sub") THEN
Stk$[1] = "function"
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "void"
END IF
IF iMatchWrd(Stk$[1],"function") THEN ' default to type integer
IF iMatchWrd(Stk$[2], Clean$(Stk$[2])) AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "integer"
END IF
END IF
IF INCHR(Stk$[2],"$") AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
REMOVE "$" FROM Stk$[2]
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "char*"
END IF
IF INCHR(Stk$[2],"%") AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
REMOVE "%" FROM Stk$[2]
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "integer"
END IF
IF INCHR(Stk$[2],"!") AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
REMOVE "!" FROM Stk$[2]
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "float"
END IF
IF INCHR(Stk$[2],"#") AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
REMOVE "#" FROM Stk$[2]
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "double"
END IF
IF INCHR(Stk$[2],"¦") AND NOT iMatchWrd(Stk$[Ndx-1],"as") THEN
REMOVE "¦" FROM Stk$[2]
Stk$[++Ndx] = "as"
Stk$[++Ndx] = "LDOUBLE"
END IF
IF iMatchWrd(Stk$[1],"function") THEN
Stk$[Ndx+1] = Stk$[Ndx]
Stk$[1] = "dim"
Stk$[Ndx] = "function"
Ndx++
'Stk$[Ndx] = lszTmp$
'IF iMatchWrd(Stk$[Ndx],"string") THEN Stk$[Ndx] = "char*"
END IF
END IF
END SUB 'XParse
SUB TokenSubstitutions
'*****************************
' Start Doing Text Substitutions
'*****************************
DIM RAW A
DIM RAW CompPtr
DIM RAW CompToken
DIM RAW Keyword$
DIM RAW a, i, j, Tmp
'******************************************************************************************
' Following Block added in 5.05.157+ -- recognizes COBJECT for use with C++ Classes, ex:
' dim raw obj AS COBJECT person ( "John", 56 ) should translate to:
' person obj("John", 56 );
'******************************************************************************************
'
' IF LCASE$(Stk$[Ndx]) = "cobject" THEN
' IF InTypeDef THEN
' Abort("Use of CObject type in UDTs is Illegal!")
' END IF
' ' global shared x(x,y,z) classname AS CObject
' IF InFunc THEN
' IF Stk$[1] = "global" OR Stk$[2] = "shared" THEN
' Add_
' END IF
' IF bFound THEN
' ? i
' FOR i = 1 TO Ndx
' ? Stk$[i]
' NEXT
' 'IF InFunc THEN
' ' IF Stk$[1] = "global" OR Stk$[2] = "shared"
' FPRINT Outfile, Scoot$, Stk$[5] + " " + Stk$[2];
' FOR Tmp = bFound+2 TO Ndx
' FPRINT Outfile, Stk$[Tmp];
' NEXT
' FPRINT Outfile, ";"
' Ndx = 0
' EXIT SUB
' END IF
'
'******************************************************************************************
' Following block added in bc.500_com -- recognizes OBJECT variables for dynamic COM use.
'******************************************************************************************
IF ComSwitchON THEN
' bc.500_com
IF iMatchWrd(Stk$[Ndx],"object") THEN
IF InTypeDef THEN
Abort("Use of Object type in UDTs is Illegal!")
END IF
IF InFunc THEN
IF Stk$[1] = "global" OR Stk$[2] = "shared" THEN
Add_COM_Global_Variable(Stk$[Ndx-2])
ELSE
Add_COM_Local_Variable(Stk$[Ndx-2])
END IF
ELSE
Add_COM_Global_Variable(Stk$[Ndx-2])
END IF
Use_COM = UseFlag = TRUE
END IF
' bc.500_com
END IF
'******************************************************************************************
' Following block added in 4.13 -- Dim XXX as string * 12345
' Works in UDT, GLOBALS, LOCALS, and RAW
'******************************************************************************************
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"as") THEN
IF iMatchWrd(Stk$[i+1],"string") THEN
IF Stk$[i+2] = "*" THEN
Stk$[i] = "["
Stk$[i+1] = Stk$[i+3]
Stk$[i+2] = "]"
Stk$[i+3] = "as"
INCR Ndx
Stk$[Ndx] = "char"
EXIT FOR
END IF
END IF
END IF
NEXT
'******************************************************************************************
FOR i = 1 TO Ndx
IF NOT InFunc THEN
IF iMatchWrd(Stk$[i],"global") THEN Stk$[i] = "dim"
END IF
NEXT
FOR Tmp = 1 TO Ndx
IF *Stk[Tmp] = ASC("0") AND NOT iMatchWrd(MID$(Stk$[Tmp],2,1),"x") AND NOT iMatchWrd(MID$(Stk$[Tmp],2,1),"l") THEN
Stk$[Tmp] = LTRIM$(Stk$[Tmp],48) 'allow leading zero's in numbers
IF Stk$[Tmp] = "" THEN Stk$[Tmp] = "0"
END IF
IF iMatchWrd(Stk$[Tmp],"xor") THEN
Stk$[Tmp] = "^"
ELSEIF Stk$[Tmp] = "=" AND Stk$[Tmp+1]= ">" THEN
Stk$[Tmp] = ">"
Stk$[Tmp+1]= "="
ELSEIF Stk$[Tmp] = "=" AND Stk$[Tmp+1]= "<" THEN
Stk$[Tmp] = "<"
Stk$[Tmp+1] = "="
ELSEIF Stk$[Tmp] = "<" AND Stk$[Tmp+1]= ">" THEN
Stk$[Tmp] = "!="
Stk$[Tmp+1] = ""
ELSEIF Stk$[Tmp] = ">" AND Stk$[Tmp+1]= "<" THEN
Stk$[Tmp] = "!="
Stk$[Tmp+1] = ""
ELSEIF Stk$[Tmp]= "!" AND Stk$[Tmp+1]= "=" THEN
Stk$[Tmp]= "!=" ' needed when recursively
FOR A = Tmp+2 TO Ndx ' calling parse() after <>
Stk$[A-1]= Stk$[A] ' has already translated TO
NEXT ' ! = otherwise on the second
Ndx-- ' pass it emits as !== which
END IF ' is clearly NOT what we want
NEXT
'*****************************
CompToken = 0
FOR Tmp = 1 TO Ndx
A = CheckLocal(Stk$[Tmp], &i)
IF A = vt_UNKNOWN THEN A = CheckGlobal(Stk$[Tmp], &i)
IF A = vt_STRUCT OR A = vt_UDT OR A = vt_UNION THEN
CompToken = 1
END IF
IF iMatchWrd(Stk$[Tmp],"int") AND Stk$[Tmp+1] = "(" THEN
Stk$[Tmp]= "fint"
ELSEIF iMatchWrd(Stk$[Tmp],"integer") THEN
Stk$[Tmp]= "int"
ELSEIF iMatchWrd(Stk$[Tmp],"fint") AND Stk$[Tmp+1]= ")" THEN
Stk$[Tmp]= "int"
END IF
NEXT
'*****************************
CompPtr = 0
FOR Tmp = 1 TO Ndx
Keyword$ = LCASE$(Stk$[Tmp])
a = INCHR("abcdefghijklmnopqrstuvwxyz", Keyword$)
SELECT CASE a
CASE 1
SELECT CASE Keyword$
CASE "abs"
Stk$[Tmp]= "Abs"
Use_Abs = Use_Proto = TRUE
CASE "acos"
Stk$[Tmp]= "acos"
CASE "acosl"
Stk$[Tmp]= "acosl"
CASE "acosh"
Stk$[Tmp]= "acosh"
Use_Acosh = Use_Proto = TRUE
CASE "appactivate"
Stk$[Tmp]= "AppActivate"
Use_AppActivate = UseFlag = Use_Instr = Use_Stristr = TRUE
Use_Lcase = Use_Left = Use_StrStr = TRUE
UseLCaseTbl = TRUE
CASE "appexename$"
Stk$[Tmp] = "AppExeName$()"
Use_AppExeName = UseFlag = TRUE
CASE "appexepath$"
Stk$[Tmp] = "AppExePath$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_AppExePath = UseFlag = TRUE
CASE "ansitowide"
Stk$[Tmp] = "AnsiToWide"
Use_AnsiToWide = UseFlag = TRUE
CASE "argc"
Stk$[Tmp]= "argc"
CASE "argv"
Stk$[Tmp]= "argv"
CASE "argv$"
Stk$[Tmp]= "argv$"
CASE "asc"
i=0
j=GetNumArgs(Tmp+2,&i)
IF *Stk[Tmp+2] = *DQ$ THEN
IF j > 0 OR *Stk[Tmp+3] <> ASC(")") THEN
Stk$[Tmp] = "asc"
Use_Asc = Use_Proto = TRUE
ELSE
IF Stk$[Tmp+2] = DDQ$ THEN
Stk$[Tmp] = "0"
ELSE
Stk$[Tmp] = LTRIM$(STR$(ASC(Stk$[Tmp+2],1)))
END IF
Stk$[Tmp+1] = "" : Stk$[Tmp+2] = "" : Stk$[Tmp+3] = ""
END IF
ELSE
IF j > 0 THEN Stk$[i] = "+"
Stk$[Tmp] = "(UCHAR)*"
END IF
CASE "asin"
Stk$[Tmp]= "asin"
CASE "asinl"
Stk$[Tmp]= "asinl"
CASE "asinh"
Stk$[Tmp]= "asinh"
Use_Asinh = Use_Proto = TRUE
CASE "atanh"
Stk$[Tmp]= "atanh"
Use_Atanh = Use_Proto = TRUE
CASE "atn","atan"
Stk$[Tmp]= "atan"
CASE "atnl","atanl"
Stk$[Tmp]= "atanl"
CASE "auto"
IF iMatchWrd(Stk$[Tmp+1],"local") THEN
Stk$[Tmp] = "dim" : Stk$[Tmp+1] = "raw"
ELSE
Stk$[Tmp]= "auto"
END IF
END SELECT
CASE 2
SELECT CASE Keyword$
CASE "bcopy"
*Stk[1] = 0
FOR i = Tmp+1 TO Ndx
IF iMatchWrd(Stk$[i],"to") THEN EXIT FOR
CONCAT(Stk$[1], Stk$[i]) 'Source
NEXT
*Stk[2] = 0
FOR i = i+1 TO Ndx
CONCAT(Stk$[2], Stk$[i]) 'Destination
NEXT
Src$ = "memmove(&" + Stk$[2] + ",&" + Stk$[1] + ",sizeof(" + Stk$[2] + "))"
REMOVE "&*" FROM Src$
Ndx = 0
CALL XParse(Src$)
' BEGIN BCX_GUI MODIFICATION
CASE "begin"
IF iMatchWrd(Stk$[Tmp+1],"events") OR iMatchWrd(Stk$[Tmp+1],"mdievents") OR iMatchWrd(Stk$[Tmp+1],"mdichildevents") THEN
IF Ndx = 3 THEN
Src$ = "FUNCTION|LRESULT CALLBACK "+Stk$[Tmp+2]+"(hWnd|AS|HWND,Msg|AS|UINT,wParam|AS|WPARAM,lParam|AS|LPARAM)"
ELSE
Src$ = "FUNCTION|LRESULT CALLBACK WndProc(hWnd|AS|HWND,Msg|AS|UINT,wParam|AS|WPARAM,lParam|AS|LPARAM)"
END IF
FastLexer(Src$,"|", ",()")
Use_Wingui = TRUE 'Use_Str_Cmp = Use_Ucase = TRUE
EXIT SUB
END IF
' END BCX_GUI MODIFICATION
CASE "bel$"
Stk$[Tmp] = "BEL$"
Use_BEL = UseFlag = TRUE
CASE "bs$"
Stk$[Tmp] = "BS$"
Use_BS = UseFlag = TRUE
CASE "bool","boolean"
Stk$[Tmp]= "BOOL"
CASE "band"
Stk$[Tmp]= " BAND "
Use_Band = TRUE
Use_Sysmacros = TRUE
CASE "bnot"
Stk$[Tmp] = " BNOT "
Use_Bnot = Use_Sysmacros = TRUE
' *******************************************************************
' Special Case Handler: Maintain case sensitivity for this structure
' *******************************************************************
CASE "bcx_font"
Stk$[Tmp] = UCASE$(Stk$[Tmp])
DIM RAW tmp$
tmp$ = Clean$(UCASE$(Stk$[Tmp+1]))
SELECT CASE tmp$
CASE ".NAME" : Stk$[Tmp+1] = ".lf.lfFaceName$"
CASE ".BOLD" : Stk$[Tmp+1] = ".lf.lfWeight"
CASE ".UNDERLINE" : Stk$[Tmp+1] = ".lf.lfUnderline"
CASE ".STRIKEOUT" : Stk$[Tmp+1] = ".lf.lfStrikeOut"
CASE ".ITALIC" : Stk$[Tmp+1] = ".lf.lfItalic"
CASE ".CHARSET" : Stk$[Tmp+1] = ".lf.lfCharSet"
CASE ".SIZE", ".RGB" : Stk$[Tmp+1] = tmp$
CASE ELSE
Stk$[Tmp+1] = Clean$(Stk$[Tmp+1])
END SELECT
' BEGIN BCX_GUI MODIFICATION
CASE "bcx_setcursor"
Stk$[Tmp] = "BCX_SetCursor"
Use_BCX_SetCursor = Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_msgpump"
Stk$[Tmp] = "BCX_MsgPump"
Use_BCX_MsgPump = TRUE
CALL AddGUIGlobals
CASE "bcx_wnd"
Stk$[Tmp] = "BCX_Wnd"
Use_BCX_Wnd = Use_BCX_InitGUI = Use_BCX_SetMetric = Use_BCX_RegWnd = TRUE
CALL AddGUIGlobals
CASE "bcx_framewnd"
Stk$[Tmp] = "BCX_FrameWnd"
Use_BCX_FrameWnd = Use_BCX_RegWnd = Use_BCX_InitGUI = Use_BCX_SetMetric = TRUE
CALL AddGUIGlobals
CASE "bcx_setbkgrdbrush"
Stk$[Tmp] = "BCX_SetBkGrdBrush"
Use_BCX_SetBkGrdBrush = Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_setclassstyle"
Stk$[Tmp] = "BCX_SetClassStyle"
Use_BCX_SetClassStyle = Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_seticon"
Stk$[Tmp] = "BCX_SetIcon"
Use_BCX_SetIcon = Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_seticonsm"
Stk$[Tmp] = "BCX_SetIconSm"
Use_BCX_SetIconSm = Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_setmetric"
Stk$[Tmp] = "BCX_SetMetric"
Use_BCX_SetMetric = Use_BCX_InitGUI = TRUE
'Use_Ucase = Use_Str_Cmp = TRUE 'UseFlag = TRUE
CALL AddGUIGlobals
CASE "bcx_initgui"
Stk$[Tmp] = "BCX_InitGUI"
Use_BCX_InitGUI = TRUE
CALL AddGUIGlobals
CASE "bcx_regwnd"
Stk$[Tmp] = "BCX_RegWnd"
Use_BCX_RegWnd = Use_BCX_InitGUI = Use_BCX_SetMetric = TRUE
'Use_Ucase = Use_Str_Cmp = UseFlag = TRUE
CALL AddGUIGlobals
CASE "bcx_mdi_msgpump"
Stk$[Tmp] = "BCX_MDI_MsgPump"
Use_BCX_MDI_MsgPump = TRUE
CALL AddGUIGlobals
CASE "bcx_bcx_wndclass"
Stk$[Tmp] = "BCX_WndClass"
CALL AddGUIGlobals
' END BCX_GUI MODIFICATION
CASE "bcx_remtab"
Stk$[Tmp] = "BCX_RemTab"
CASE "bcx_addtab"
Stk$[Tmp] = "BCX_AddTab"
CASE "bcxpath$"
Stk$[Tmp] = "BcxPath$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_BCX_Path = Use_RegString = TRUE
UseFlag = TRUE
CASE "bcx_mdiclient", "bcx_mdiclass", "bcx_mdichild"
Stk$[Tmp] = UCASE$(Stk$[Tmp])
CASE "bcx_hinstance"
Stk$[Tmp] = "BCX_hInstance"
CASE "bcx_scalex"
Stk$[Tmp] = "BCX_ScaleX"
CASE "bcx_scaley"
Stk$[Tmp] = "BCX_ScaleY"
CASE "bcx_arc"
Stk$[Tmp] = "BCX_Arc"
Use_BCX_Arc = Use_Proto = TRUE
CASE "bcx_bitmap"
Stk$[Tmp] = "BCX_Bitmap"
Use_Bitmap = Use_Proto = TRUE
CASE "bcx_olepicture"
Stk$[Tmp] = "BCX_OlePicture"
Use_BCX_OlePicture = Use_GetResource = Use_Proto = TRUE
CASE "bcx_ole_width"
Stk$[Tmp] = "BCX_OLE_WIDTH"
Use_Sysmacros = TRUE
CASE "bcx_ole_height"
Stk$[Tmp] = "BCX_OLE_HEIGHT"
Use_Sysmacros = TRUE
CASE "bcx_blackrect"
Stk$[Tmp] = "BCX_BlackRect"
Use_Blackrect = Use_Proto = TRUE
CASE "bcx_button"
Stk$[Tmp] = "BCX_Button"
Use_Button = Use_GetTextSize = Use_Proto = TRUE
CASE "bcx_bmpbutton"
Stk$[Tmp] = "BCX_BmpButton"
Use_BmpButton = Use_Proto = TRUE
CASE "bcx_bmpwidth"
Stk$[Tmp] = "BCX_BmpWidth"
Use_BCX_BmpWidth = Use_Proto = TRUE
CASE "bcx_bmpheight"
Stk$[Tmp] = "BCX_BmpHeight"
Use_BCX_BmpHeight = Use_Proto = TRUE
CASE "bcx_checkbox"
Stk$[Tmp] = "BCX_Checkbox"
Use_Checkbox = Use_GetTextSize = Use_Proto = TRUE
CASE "bcx_classname$"
Stk$[Tmp] = "BCX_ClassName$"
CASE "bcx_combobox"
Stk$[Tmp] = "BCX_Combobox"
Use_Combobox = Use_Proto = TRUE
CASE "bcx_control"
Stk$[Tmp] = "BCX_Control"
Use_BCX_Control = Use_Proto = TRUE
CASE "bcx_colordlg"
Stk$[Tmp] = "BCX_ColorDlg"
IF NOT INCHR(Src$,"(") THEN Stk$[Tmp] = Stk$[Tmp] + "()"
Use_BCX_Colordlg = Use_Hook = UseFlag = Use_Proto = TRUE
CASE "bcx_cursor"
Stk$[Tmp]= "BCX_Cursor"
Use_BCX_Cursor = Use_Sysmacros = TRUE
CASE "bcx_datepick"
Stk$[Tmp] = "BCX_DatePick"
Use_Datepick = Use_Proto = TRUE
CASE "bcx_edit"
Stk$[Tmp] = "BCX_Edit"
Use_Edit = Use_Proto = TRUE
CASE "bcx_circle"
Stk$[Tmp] = "BCX_Circle"
Use_BCX_Circle = Use_Proto = TRUE
CASE "bcx_ellipse"
Stk$[Tmp] = "BCX_Ellipse"
Use_BCX_Ellipse = Use_Proto = TRUE
CASE "bcx_mdialog"
IF InWinMain AND NOT Use_BCXMDialog THEN
FPRINT Outfile,Scoot$,"BCX_hInstance = hInst;"
CALL AddGlobal("BCX_ScaleX", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ScaleY", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_hInstance",vt_HINSTANCE,0,"",0,0,0)
END IF
Stk$[Tmp] = "BCX_MDialog"
Use_BCXMDialog = Use_Proto = TRUE
CASE "bcx_dialog"
Stk$[Tmp] = "BCX_Dialog"
Use_BCXDialog = Use_Proto = TRUE
CASE "bcx_form"
Stk$[Tmp] = "BCX_Form"
Use_Form = Use_Proto = Use_MainEvent = TRUE
IF NOT Use_BCX_Class_Info THEN
Use_BCX_Class_Info = TRUE
CALL AddGlobal("BCX_ScaleX", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ScaleY", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ClassName",vt_STRVAR, 0,"",0,0,0)
END IF
CASE "bcx_fontdlg"
Stk$[Tmp] = "BCX_FontDlg"
IF Tmp = Ndx THEN CONCAT(Stk$[Tmp],"()")
Use_BCX_Fontdlg = TRUE
Use_Hook = UseFlag = Use_Proto = TRUE
CASE "bcx_floodfill"
Stk$[Tmp] = "BCX_FloodFill"
Use_BCX_Floodfill = Use_Proto = TRUE
CASE "bcx_get"
Stk$[Tmp] = "BCX_Get"
Use_BCX_Get = Use_Proto = TRUE
CASE "bcx_get_text$"
Stk$[Tmp] = "$$BCX_Get_Text$"
Use_GetText = UseFlag = TRUE
CASE "bcx_getpixel"
Stk$[Tmp] = "BCX_Getpixel"
Use_BCX_Getpixel = UseFlag = TRUE
CASE "bcx_grayrect"
Stk$[Tmp] = "BCX_GrayRect"
Use_Grayrect = Use_Proto = TRUE
CASE "bcx_group"
Stk$[Tmp] = "BCX_Group"
Use_Group = Use_Proto = TRUE
CASE "bcx_icon"
Stk$[Tmp] = "BCX_Icon"
Use_Icon = Use_GetResource = Use_Proto = TRUE
CASE "bcx_input"
Stk$[Tmp] = "BCX_Input"
Use_BCX_Input = Use_Proto = TRUE
CASE "bcx_label"
Stk$[Tmp] = "BCX_Label"
Use_Label = Use_GetTextSize = Use_Proto = TRUE
CASE "bcx_line"
Stk$[Tmp] = "BCX_Line"
Use_BCX_Line = Use_Proto = TRUE
CASE "bcx_lineto"
Stk$[Tmp] = "BCX_Lineto"
Use_BCX_Lineto = Use_Proto = TRUE
CASE "bcx_listbox"
Stk$[Tmp] = "BCX_Listbox"
Use_Listbox = Use_Proto = TRUE
CASE "bcx_listview"
Stk$[Tmp] = "BCX_ListView"
Use_Listview = Use_Proto = TRUE
CASE "bcx_loadbmp"
Stk$[Tmp] = "BCX_LoadBMP"
Use_BCX_LoadBMP = Use_Proto = TRUE
CASE "bcx_loadimage"
Stk$[Tmp] = "BCX_LoadImage"
Use_BCX_LoadImage = Use_GetResource = Use_Proto = TRUE
CASE "bcx_print"
Stk$[Tmp] = "BCX_Print"
Use_BCX_Print = Use_Proto = TRUE
CASE "bcx_polygon"
Stk$[Tmp] = "BCX_Polygon"
Use_BCX_Polygon = Use_Proto = TRUE
CASE "bcx_polybezier"
Stk$[Tmp] = "BCX_PolyBezier"
Use_BCX_PolyBezier = Use_Proto = TRUE
CASE "bcx_polyline"
Stk$[Tmp] = "BCX_Polyline"
Use_BCX_Polyline = Use_Proto = TRUE
CASE "bcx_preset"
Stk$[Tmp] = "BCX_Preset"
Use_BCX_Preset = Use_Proto = TRUE
CASE "bcx_pset"
Stk$[Tmp] = "BCX_Pset"
Use_BCX_Pset = Use_Proto = TRUE
CASE "bcx_progressbar"
Stk$[Tmp] = "BCX_ProgressBar"
Use_ProgressBar = Use_Proto = TRUE
CASE "bcx_put"
Stk$[Tmp] = "BCX_Put"
Use_BCX_Put = Use_Proto = TRUE
CASE "bcx_radio"
Stk$[Tmp] = "BCX_Radio"
Use_Radio = Use_GetTextSize = Use_Proto = TRUE
CASE "bcx_rectangle"
Stk$[Tmp] = "BCX_Rectangle"
Use_BCX_Rectangle = UseFlag = TRUE
CASE "bcx_richedit"
Stk$[Tmp] = "BCX_RichEdit"
Use_Richedit = Use_Proto = TRUE
CASE "bcx_roundrect"
Stk$[Tmp] = "BCX_Roundrect"
Use_BCX_Roundrect = Use_Proto = TRUE
CASE "bcx_slider"
Stk$[Tmp] = "BCX_Slider"
Use_BCX_Slider = Use_Label = Use_GetTextSize = Use_Proto = TRUE
CASE "bcx_splitter"
Stk$[Tmp] = "BCX_Splitter"
Use_BCX_Splitter = Use_Proto = Use_Modstyle = TRUE
CASE "bcx_setsplitpos"
Stk$[Tmp] = "BCX_SetSplitPos"
Use_BCX_Splitter = Use_Proto = Use_Modstyle = TRUE
CASE "bcx_tab"
Stk$[Tmp] = "BCX_Tab"
Use_BCX_Tab = Use_Proto = TRUE
CASE "bcx_toolbar"
Stk$[Tmp] = "BCX_Toolbar"
Use_BCX_Toolbar = Use_Proto = TRUE
CASE "bcx_updown"
Stk$[Tmp] = "BCX_UpDown"
Use_BCX_UpDown = Use_Proto = TRUE
CASE "bcx_get_updown"
Stk$[Tmp] = "BCX_Get_UpDown"
Use_BCX_Get_UpDown = Use_Proto = UseFlag = TRUE
CASE "bcx_set_form_color"
Use_SetFormColor = Use_Proto = TRUE
Stk$[Tmp] = "BCX_Set_Form_Color"
IF Stk$[Tmp+1] <> "(" THEN
InsertTokens(Tmp,1,"(")
Stk$[++Ndx] = ")"
END IF
CASE "bcxfont"
Stk$[Tmp] = "BcxFont"
CASE "bcx_set_font"
Stk$[Tmp] = "BCX_Set_Font"
Use_SetFont = Use_Proto = TRUE
IF Stk$[Tmp+1] <> "(" THEN
InsertTokens(Tmp,1,"(")
Stk$[++Ndx] = ")"
END IF
CASE "bcx_setcolor"
Stk$[Tmp] = "Set_Color"
IF GetNumArgs(Tmp+2) < 3 THEN
InsertTokens(Ndx-1, 4, ",", "wParam", ",", "lParam")
END IF
Use_SetColor = Use_Proto = TRUE
CASE "bcx_set_text"
Stk$[Tmp] = "BCX_Set_Text"
Use_SetText = Use_Proto = TRUE
IF Stk$[Tmp+1] <> "(" THEN
InsertTokens(Tmp,1,"(")
Stk$[++Ndx] = ")"
END IF
CASE "bcx_status"
Stk$[Tmp] = "BCX_Status"
Use_Status = Use_Proto = TRUE
CASE "bcx_tabselect"
Stk$[Tmp] = "BCX_TabSelect(hWnd, lParam)"
Use_BCX_Tab = Use_Proto = TRUE
CASE "bcx_tile"
Use_BCX_Tile = Use_Proto = TRUE
Stk$[Tmp] = "BCX_Tile"
IF Stk$[Tmp+1] <> "(" THEN
InsertTokens(Tmp,1,"(")
Stk$[++Ndx] = ")"
END IF
CASE "bcx_thread", "bcx_threadwait", "bcx_threadsuspend","bcx_threadresume","bcx_threadkill","bcx_threadend"
Stk$[Tmp] = UCASE$(Stk$[Tmp])
Use_Threads = Use_Sysmacros = Use_Dynacall = TRUE
CASE "bcx_treeview"
Stk$[Tmp] = "BCX_Treeview"
Use_Treeview = Use_Proto = TRUE
CASE "bcx_whiterect"
Stk$[Tmp] = "BCX_WhiteRect"
Use_Whiterect = Use_Proto = TRUE
' bc.500_com
CASE "bcx_get_com_error_desc"
Stk$[1] = "BCX_GET_COM_ERROR_DESC"
CASE "bcx_get_com_error_code"
Stk$[1] = "BCX_GET_COM_ERROR_CODE"
CASE "bcx_get_com_success"
Stk$[1] = "BCX_GET_COM_SUCCESS"
CASE "bcx_show_com_errors"
Stk$[1] = "BCX_SHOW_COM_ERRORS"
CASE "bcx_dispatchobject"
Use_BCX_COM_DispatchObject = Use_COM = TRUE
Stk$[3] = Stk$[5]
sprintf(Stk[5],"&%s", Stk[1])
Stk$[1] = "BCX_DispatchObject"
Stk$[2] = "("
Stk$[4] = ","
Use_COM = UseFlag = TRUE
' bc.500_com
CASE "bff$"
Stk$[Tmp] = "$$BFF$"
Use_Bff = UseFlag = TRUE
CASE "bin$"
Stk$[Tmp] = "$$Bin$"
Use_Bin = UseFlag = TRUE
CASE "bool$"
Stk$[Tmp] = "$$BoolStr$"
Use_Boolstr = UseFlag = TRUE
CASE "bin2dec"
Stk$[Tmp]= "Bin2Dec"
Use_Bin2dec = Use_Proto = TRUE
CASE "boolean"
Stk$[Tmp]= "BOOLEAN"
CASE "bor"
Stk$[Tmp]= " BOR "
Use_Bor = Use_Sysmacros = TRUE
CASE "byte"
Stk$[Tmp]= "BYTE"
END SELECT
CASE 3
SELECT CASE Keyword$
CASE "callback"
IF Tmp = 1 THEN
IF Ndx > 5 THEN Warning("Extra Callback code truncated",1)
Src$ = "FUNCTION|LRESULT CALLBACK " & Stk$[3] & _
"(hWnd|AS|HWND,Msg|AS|UINT,wParam|AS|WPARAM,lParam|AS|LPARAM)"
FastLexer(Src$,"|",",()")
CallBackFlag = TRUE
END IF
CASE "callwindowproc"
'*****************************
' CallWindowProc HELPER
'*****************************
Stk$[Tmp] = "CallWindowProc"
IF Stk$[Tmp+3] <> "WNDPROC" THEN InsertTokens(Tmp+1,3,"(","WNDPROC",")")
' bc.500_com
CASE "createobject"
IF ComSwitchON THEN
Use_BCX_COM_CreateObject = Use_COM = TRUE
IF Stk$[2] = "[" THEN ' object from an array of objects
'Stk$[7] = Stk$[3]
'sprintf(Stk[5],"&%s", Stk[1])
'Stk$[1] = "BCX_CreateObject"
'Stk$[2] = "("
'Stk$[3] = Stk$[8]
'Stk$[4] = ","
'Stk$[6] = "["
'Stk$[8] = "]"
Abort("Arrays of COM objects are not currently supported!")
ELSE
Stk$[3] = Stk$[5]
sprintf(Stk[5],"&%s", Stk[1])
Stk$[1] = "BCX_CreateObject"
Stk$[2] = "("
Stk$[4] = ","
END IF
' bc.500_com
END IF
CASE "containedin"
Stk$[Tmp] = "containedin"
Use_ContainedIn = TRUE
CASE "cr$"
Stk$[Tmp] = "CR$"
Use_CR = UseFlag = TRUE
CASE "close#"
Stk$[Tmp] = "close"
CASE "close"
IF LEFT$(Stk$[Tmp+1],1)= "#" THEN
Stk$[Tmp+1] = MID$(Stk$[Tmp+1],2)
END IF
CASE "closedialog"
Ndx = 1
IF ModDialogEvt THEN
Stk$[1] = "EndDialog(hWnd,0)"
ELSE
Stk$[1] = "DestroyWindow(hWnd)"
END IF
CASE "cvd"
Stk$[Tmp]="CVD"
Use_Cvd = Use_Proto = TRUE
CASE "cvi"
Stk$[Tmp]="CVI"
Use_Cvi = Use_Proto = TRUE
CASE "cvl"
Stk$[Tmp]="CVL"
Use_Cvl = Use_Proto = TRUE
CASE "cvld"
Stk$[Tmp]="CVLD"
Use_Cvld = Use_Proto = TRUE
CASE "cvs"
Stk$[Tmp]="CVS"
Use_Cvs = Use_Proto = TRUE
CASE "concat"
Stk$[Tmp]= "strcat"
CASE "chr$"
Stk$[Tmp]= "$$chr$"
Use_Chr = UseFlag = TRUE
CASE "char"
Stk$[Tmp]= "char"
CASE "crlf$"
Stk$[Tmp] = "CRLF$"
Use_Crlf = UseFlag = TRUE
CASE "createregstring"
Stk$[Tmp] = "CreateRegString"
Use_CreateRegString = UseFlag = TRUE
CASE "createregint"
Stk$[Tmp] = "CreateRegInt"
Use_CreateRegInt = UseFlag = TRUE
CASE "cbctl"
Stk$[Tmp]= "LOWORD(wParam)"
CASE "cbctlmsg"
Stk$[Tmp]= "HIWORD(wParam)"
CASE "cbhndl"
Stk$[Tmp]= "hWnd"
CASE "cbhwnd"
Stk$[Tmp]= "hWnd"
CASE "cblparam"
Stk$[Tmp]= "lParam"
CASE "cbmsg"
Stk$[Tmp]= "Msg"
CASE "cbwparam"
Stk$[Tmp]= "wParam"
CASE "cdbl"
Stk$[Tmp]= "CDBL"
Use_Cdbl = Use_Sysmacros = TRUE
CASE "center"
Stk$[Tmp] = "Center"
Use_Center = Use_Proto = TRUE
CASE "chdrive", "chdir"
Stk$[Tmp]= "chdir"
CASE "cint"
Stk$[Tmp]= "Cint"
Use_Cint = Use_Proto = TRUE
CASE "cldbl"
Stk$[Tmp]= "CLDBL"
Use_Cldbl = Use_Sysmacros = TRUE
CASE "clng"
Stk$[Tmp]= "CLNG"
Use_Clng = Use_Proto = TRUE
CASE "cls"
Stk$[Tmp]= "cls"
Use_Cls = TRUE
Use_Locate = Use_Console = Use_Proto = TRUE
CASE "color", "color_fg", "color_bg"
Stk$[Tmp] = LCASE$(Stk$[Tmp])
Use_Color = Use_Console = Use_Proto = TRUE
CASE "command$"
Use_Command = UseFlag = TRUE
Stk$[Tmp]= "command$(-1)"
IF Stk$ [Tmp+1] = "(" THEN
Stk$ [Tmp]= "command$"
END IF
CASE "comboboxloadfile"
Stk$[Tmp] = "ComboBoxLoadFile"
Use_ComboBoxLoadFile = TRUE
Use_Proto = TRUE
Use_Trim = TRUE
UseFlag = TRUE
CASE "control"
Stk$[Tmp]= "HWND"
CASE "colorref"
Stk$[Tmp]= "COLORREF"
CASE "cos"
Stk$[Tmp]= "cos"
CASE "cosl"
Stk$[Tmp]= "cosl"
CASE "cosh"
Stk$[Tmp]= "cosh"
CASE "cbool"
Stk$[Tmp] = "CBOOL"
DIM RAW t = ArgStart(Tmp + 2)
DIM RAW e = ArgEnd(Tmp + 1)
t = DataType(Stk$[t])
IF t = vt_STRLIT OR t = vt_STRVAR THEN
t=ExpPostion(Tmp+2)
IF t THEN
IF INCHR("!<>=", Stk$[t+1]) THEN Stk$[t+1] = Stk$[t] + Stk$[t+1] : Stk$[t++] = ""
IF Stk$[t] = "=" THEN Stk$[t] = "=="
IF Stk$[t] = "!=" THEN Stk$[++t] = "!=" :Stk$[t-1] = ""
Stk$[Tmp+1] = Stk$[Tmp+1] + "strcmp("
Stk$[e] = ")" + Stk$[t] + "0)"
Stk$[t] = ","
Src$ = ""
FOR t = 1 TO Ndx
Src$ = Src$ + Stk$[t]
Src$ = Src$ + SPC$
NEXT
FastLexer(Src$," ","(),")
END IF
END IF
Use_Cbool = Use_Sysmacros = TRUE
CASE "csng"
Stk$[Tmp]= "CSNG"
Use_Csng = Use_Sysmacros = TRUE
CASE "cursorx"
Stk$[Tmp] = "Pos()"
Use_Pos = Use_Proto = TRUE
CASE "csrlin","cursory"
Stk$[Tmp] = "Csrlin()"
Use_Csrlin = Use_Proto = TRUE
CASE "curdir$"
Stk$[Tmp]= "curdir$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Curdir = UseFlag = TRUE
CASE "currency"
Stk$[Tmp] = "CURRENCY"
CASE "c_declare"
CallType$ = "__cdecl "
Stk$[Tmp]= "declare"
IF iMatchWrd(Stk$[4], "lib") THEN
NoTypeDeclare = FALSE
ELSE
NoTypeDeclare = TRUE
END IF
END SELECT
CASE 4
SELECT CASE Keyword$
CASE "declare"
CallType$ = "__stdcall "
Stk$[Tmp]= "declare"
IF NOT iMatchWrd(Stk$[4], "lib") THEN
NoTypeDeclare = TRUE
ELSE
NoTypeDeclare = FALSE
END IF
CASE "dq$"
Stk$[Tmp] = "DQ$"
Use_DQ = UseFlag = TRUE
CASE "ddq$"
Stk$[Tmp] = "DDQ$"
Use_DDQ = UseFlag = TRUE
CASE "data$"
Stk$[Tmp]= "DATA$"
CASE "date$"
Stk$[Tmp] = "_strdate$(Date)"
Use_Date = UseFlag = TRUE
'
CASE "delete"
IF UseCpp = FALSE THEN Abort( "'DELETE' can only be used with C++" )
Stk$[Tmp]="delete "
'
CASE "del$"
Stk$[Tmp]= "del$"
Use_Del = UseFlag = Use_Proto = TRUE
CASE "deleteregkey"
Stk$[Tmp] = "DeleteRegKey"
Use_DeleteRegKey = UseFlag = TRUE
CASE "dialog"
IF iMatchWrd(Stk$[1],"begin") THEN
IF Ndx = 4 AND iMatchWrd(Stk$[3],"as") THEN
InDialogEvt = TRUE
ELSEIF Ndx = 5 AND iMatchWrd(Stk$[4],"as") THEN
ModDialogEvt = TRUE
ELSE
Abort("Malformed Begin Dialog")
END IF
Src$ = "function " & Stk$[Ndx] & _
"(hWnd AS HWND,Msg AS UINT,wParam AS WPARAM,lParam AS LPARAM) AS BOOL CALLBACK"
FastLexer(Src$, SPC$, "(),")
ELSEIF Ndx = 2 AND iMatchWrd(Stk$[Tmp-1],"end") THEN
Stk$[2] = "function"
END IF
CASE "doevents"
Stk$[Tmp]= "DoEvents()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Doevents = Use_Proto = TRUE
CASE "drawtransbmp"
Stk$[Tmp]= "DrawTransBMP"
Use_DrawTransBMP = Use_Proto = TRUE
CASE "double"
Stk$[Tmp]= "double"
CASE "download"
Stk$[Tmp] = "Download"
Use_Download = Use_Dynacall = Use_Proto = TRUE
CASE "dsplit"
Stk$[Tmp]= "DSplit"
Use_Proto = TRUE
UseFlag = TRUE
Use_DSplit = TRUE
Use_Remove = TRUE
Use_StrStr = TRUE
Use_Mid = TRUE
Use_Left = TRUE
Use_Instr = TRUE
Use_Stristr = TRUE
UseLCaseTbl = TRUE
CASE "dword"
Stk$[Tmp]= "DWORD"
END SELECT
CASE 5
SELECT CASE Keyword$
CASE "enddraw"
Stk$[Tmp]= "EndDraw"
Use_Draw = TRUE
CASE "endmodal"
Stk$[Tmp] = "EndModal"
Use_Show = Use_Sysmacros = Use_ShowModal = Use_EndModal = TRUE
CASE "extern"
Stk$[Tmp] = "extern"
CASE "editloadfile"
Stk$[Tmp]= "EditLoadFile"
Use_Elf = TRUE
Use_Exist = TRUE
Use_Get = TRUE
Use_Lof = TRUE
Use_Proto = TRUE
Use_Join = TRUE
UseFlag = TRUE
Use_Sysmacros = TRUE
CASE "enc$"
Stk$[Tmp]= "$$enc$"
Use_Enclose = UseFlag = TRUE
CASE "extract$"
Stk$[Tmp]= "$$extract$"
Use_Extract = Use_StrStr = UseFlag = TRUE
CASE "eof$"
Stk$[Tmp] = "EF$"
Use_EOF = UseFlag = TRUE
CASE "eof"
Stk$[Tmp]= "EoF"
Use_Eof = UseFlag = TRUE
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
CASE "esc$"
Stk$[Tmp] = "ESC$"
Use_ESC = UseFlag = TRUE
CASE "enum"
IF Ndx =1 THEN
Use_EnumFile = TRUE
'******************************************************
' We're dealing with a ENUM - END ENUM block
'******************************************************
DIM RAW EnumFlag = FALSE
FPRINT FP11,""
FPRINT FP11,"enum"
FPRINT FP11," {"
Src$ = ""
WHILE NOT iMatchLft(Src$,"end ")
IF EOF(SourceFile) THEN Abort ("Unbalanced ENUM")
LINE INPUT SourceFile,Src$
ModuleLineNos[ModuleNdx]++
CALL StripCode(Src$)
IF iMatchLft(Src$,"$comme") THEN
Directives()
ITERATE
END IF
'Src$ = EXTRACT$(Src$,"'")
Src$ = TRIM$(Src$)
IF Src$ = "" THEN ITERATE ' line starts with comment
IF LCASE$(LEFT$(Src$ + " ",4)) = "end " THEN
EXIT LOOP
ELSE
IF EnumFlag = FALSE THEN
EnumFlag = TRUE
ELSE
FPRINT FP11,","
END IF
END IF
FPRINT FP11," ",RTRIM$(Src$);
WEND
Src$ = ""
Ndx = 0
FPRINT FP11,""
FPRINT FP11," };\n"
EXIT SUB
END IF
'*************************************************************
' We're dealing with a smaller, single line ENUM statement
'*************************************************************
szTmp$ = ""
FOR j = 2 TO Ndx-1
CONCAT (szTmp$,Stk$[j])
NEXT
szTmp$ = szTmp$ + Stk$[Ndx] + "}"
Stk$[1]= "enum {" + szTmp$
Ndx = 1
CASE "environ$"
Stk$[Tmp]= "Environ$"
Use_Environ = UseFlag = TRUE
CASE "exist"
Stk$[Tmp]= "Exist"
Use_Exist = Use_Proto = UseFlag = TRUE
CASE "exp"
Stk$[Tmp]= "Exp"
Use_Exp = Use_Proto = TRUE
END SELECT
CASE 6
SELECT CASE Keyword$
CASE "freeglobals"
Stk$[Tmp] = "FreeGlobals"
CASE "ff$"
Stk$[Tmp] = "FF$"
Use_FF = UseFlag = TRUE
CASE "function"
IF Stk$[Tmp+1] = "=" THEN
IF Stk$[Tmp+2] = DDQ$ THEN Stk$[Tmp+2] = "NUL$"
Stk$[Tmp] = "functionreturn"
END IF
CASE "false"
Stk$[Tmp]= "FALSE"
CASE "file"
Stk$[Tmp]= "FILE"
CASE "findintype"
'Convert this :FindInType(char *Token, Type.member, int c)"
'To this :FindInType(char *Token, Stptr + offsetof(Type,member), sizeof(Type), int c)"
Stk$[Tmp]= "FindInType"
Use_FindInType = Use_Proto = TRUE
DIM RAW StMem$, StName$
FOR j = 6 TO Ndx
IF INCHR(Stk$[Tmp+j],".") = 1 THEN
CONCAT (Stk$[Tmp+5],Stk$[Tmp+j])
Stk$[Tmp+j] = ""
ELSE
EXIT FOR
END IF
NEXT
StMem$ = REMAIN$(Clean$(Stk$[Tmp+5]),".")
Stk$[Tmp+5] = ""
IF CheckLocal(Stk$[Tmp+4],&i) <> vt_UNKNOWN THEN
StName$ = TypeDefs[LocalVars[i].VarDef].VarName$
ELSEIF CheckGlobal(Stk$[Tmp+4],&i) <> vt_UNKNOWN THEN
StName$ = TypeDefs[GlobalVars[i].VarDef].VarName$
END IF
Stk$[Tmp+4] = "(char*)" & Stk$[Tmp+4] & " + offsetof(" & StName$ & _
"," & StMem$ & "), sizeof(" & StName$ & ")"
CASE "farproc"
Stk$[Tmp] = "FARPROC"
CASE "fillarray"
Stk$[Tmp] = "fillarray"
Use_FillArray = TRUE
Use_Proto = TRUE
CASE "findfirst$"
Stk$[Tmp]= "findfirst$"
Use_Findfirst = UseFlag = TRUE
CASE "findfirstinstance"
Stk$[Tmp]= "FindFirstInstance"
Use_FirstInstance = TRUE
CASE "findnext$"
Stk$[Tmp]= "findnext$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Findnext = UseFlag = TRUE
CASE "fint"
Stk$[Tmp]= "FINT"
Use_Fint = Use_Sysmacros = TRUE
CASE "fix"
Stk$[Tmp]= "FIX"
Use_Fix = Use_Sysmacros = TRUE
CASE "filelocked"
Stk$[Tmp]= "FileLocked"
Use_FileLocked = Use_Proto = TRUE
CASE "flush"
Stk$[Tmp]= "fflush"
CASE "frac"
Stk$[Tmp]= "FRAC"
Use_Fix = Use_Frac = Use_Sysmacros = TRUE
CASE "fracl"
Stk$[Tmp]= "FRACL"
Use_Fix = Use_Fracl = Use_Sysmacros = TRUE
CASE "freefile"
Stk$[Tmp]= "FreeFile()"
Use_Freefile = Use_Proto = TRUE
END SELECT
CASE 7
SELECT CASE Keyword$
' bc.Collections
CASE "getobject"
IF ComSwitchON THEN
IF Ndx < 7 THEN ' COM version of getobject uses only one param, while Windows API has three params - Ndx > 6.
Use_BCX_COM_GetObject = Use_COM = TRUE
Stk$[3] = Stk$[5]
sprintf(Stk[5],"&%s", Stk[1])
Stk$[1] = "BCX_GetObject"
Stk$[2] = "("
Stk$[4] = ","
END IF
' bc.Collections
END IF
CASE "getprocaddress"
LOCAL GlobalName$, s, ss, tempA$
GlobalName$ = Stk$[Tmp-2]
ss = HashNumber(GlobalName$)
WHILE GlobalVarHash[ss]
s = GlobalVarHash[ss]
IF GlobalName$ = GlobalVars[s].VarName$ THEN
tempA$ = TypeDefs[GlobalVars[s].VarDef].VarName$
IF GlobalVars[i].VarPntr THEN
tempA$=tempA$+" *"
END IF
END IF
ss = IMOD(ss + 1,MaxGlobalVars)
WEND
IF tempA$ = "" THEN
LOCAL LocalName$
LocalName$ = Stk$[Tmp-2]
IF LocalVarCnt THEN
FOR INTEGER i = 1 TO LocalVarCnt
IF LocalName$ = LocalVars[i].VarName$ THEN
tempA$ = TypeDefs[LocalVars[i].VarDef].VarName$
IF LocalVars[i].VarPntr THEN
tempA$ = tempA$ + " *"
END IF
EXIT FOR
END IF
NEXT
END IF
END IF
IF tempA$ <> "" THEN
Stk$[Tmp]= "(" + tempA$ + ")GetProcAddress"
ELSE
Stk$[Tmp]= "GetProcAddress"
END IF
CASE "getattr"
Stk$[Tmp]= "GETATTR"
Use_Getattr = Use_Sysmacros = TRUE
CASE "gettextsize"
Stk$[Tmp] = "GetTextSize"
Use_GetTextSize = Use_Proto = TRUE
CASE "getbmp"
Stk$[Tmp] = "GetBmp"
Use_GetBmp = Use_Proto = UseFlag = TRUE
CASE "getbvalue"
Stk$[Tmp]= "GetBValue"
CASE "getc"
Stk$[Tmp]= "getc"
CASE "getdrive"
Stk$[Tmp]= "_getdrive()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Getdrive = Use_Proto = TRUE
CASE "getfilename$"
Stk$[Tmp] = "$$GetFileName$"
Use_Getfilename = Use_Hook = TRUE
CASE "getgvalue"
Stk$[Tmp]= "GetGValue"
CASE "getrvalue"
Stk$[Tmp]= "GetRValue"
CASE "getresource"
Stk$[Tmp] = "GetResource"
Use_GetResource = Use_Proto = TRUE
END SELECT
CASE 8
SELECT CASE Keyword$
CASE "hiword"
Stk$[Tmp]= "HIWORD"
CASE "hex$"
Stk$[Tmp]= "hex$"
Use_Hex = UseFlag = TRUE
CASE "hex2dec"
Stk$[Tmp]= "Hex2Dec"
Use_Hex2Dec = UseLCaseTbl = Use_Proto = TRUE
CASE "hibyte"
Stk$[Tmp]= "HIBYTE"
CASE "hide"
Stk$[Tmp]= "Hide"
Use_Hide = Use_Sysmacros = TRUE
CASE "hypot"
Stk$[Tmp]= "hypot"
END SELECT
CASE 9
SELECT CASE Keyword$
CASE "instr"
Stk$[Tmp]= "instr"
Use_Instr = Use_StrStr = Use_Proto = TRUE
Use_Stristr = UseLCaseTbl = TRUE
CASE "inchr"
Stk$[Tmp]= "inchr"
Use_Inchr = Use_Proto = TRUE
CASE "imod"
Stk$[Tmp]= "imod"
Use_Imod = Use_Sysmacros = TRUE
CASE "iif"
Stk$[Tmp]= "iif"
Use_Iif = Use_Proto = TRUE
FOR i = Tmp+1 TO Ndx
IF Stk$[i] = "=" THEN
IF Stk$[i-1] <> "<" AND Stk$[i-1] <> ">" THEN
Stk$[i] = "=="
END IF
END IF
NEXT
CASE "iif$"
Stk$[Tmp]= "sziif$"
Use_sziif = Use_Proto = TRUE
FOR i = Tmp+1 TO Ndx
IF Stk$[i] = "=" THEN
IF Stk$[i-1] <> "<" AND Stk$[i-1] <> ">" THEN
Stk$[i] = "=="
END IF
END IF
NEXT
CASE "inkey"
UseFlag = Use_Proto = Use_InkeyD = TRUE
Stk$[Tmp]= "inkeyd()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
CASE "inkey$"
UseFlag = Use_Proto = Use_Inkey = TRUE
Stk$[Tmp]= "inkey$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
CASE "inp"
Stk$[Tmp]= "Inp"
Use_Inp = Use_Sysmacros = TRUE
CASE "inputbox$"
Stk$[Tmp] = "InputBox$"
Use_Inputbox = UseFlag = TRUE
CASE "infobox"
Stk$[Tmp] = "InfoBox"
Use_Infobox = UseFlag = TRUE
CASE "inpw"
Stk$[Tmp]= "Inpw"
Use_Inpw = Use_Sysmacros = TRUE
CASE "ins$"
Stk$[Tmp]= "ins$"
Use_Ins = Use_Proto = UseFlag = TRUE
CASE "instat"
Stk$[Tmp]= "kbhit()"
CASE "instrrev"
Stk$[Tmp]= "InstrRev"
Use_Instrrev = Use_Instr = Use_Stristr = Use_Proto = TRUE
UseLCaseTbl = Use_StrStr = TRUE
CASE "isptr"
Stk$[Tmp]= "IsPtr"
Use_Isptr = Use_Sysmacros = TRUE
CASE "ireplace$"
Stk$[Tmp]= "iReplace$"
Use_iReplace = Use_Stristr = UseFlag = TRUE
UseLCaseTbl = TRUE
CASE "iremove$"
Stk$[Tmp]= "IRemoveStr$"
Use_IRemove = UseFlag = TRUE
Use_Stristr = UseLCaseTbl = TRUE
CASE "iterate"
Stk$[Tmp]= "continue"
END SELECT
CASE 10
SELECT CASE Keyword$
CASE "join$"
Stk$[Tmp]= "$$join$"
Use_Join = UseFlag = TRUE
END SELECT
CASE 11
SELECT CASE Keyword$
CASE "keypress"
Stk$[Tmp] = "keypress()"
IF Stk$[Tmp+1] = "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Keypress = Use_Proto = TRUE
END SELECT
CASE 12
SELECT CASE Keyword$
CASE "lccpath$"
Stk$[Tmp] = "LccPath$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_LccPath = Use_RegString = Use_Instrrev = TRUE
Use_Left = UseFlag = TRUE
CASE "loadfile$"
Stk$[Tmp]= "$$LoadFile$"
Use_LoadFile = Use_Get = UseFlag = TRUE
Use_Sysmacros = Use_Exist = Use_Lof = TRUE
CASE "listboxloadfile"
Stk$[Tmp] = "ListBoxLoadFile"
Use_ListBoxLoadFile = TRUE
Use_GetTextSize = TRUE
Use_Proto = TRUE
Use_Trim = TRUE
Use_String = TRUE
UseFlag = TRUE
CASE "lf$"
Stk$[Tmp] = "LF$"
Use_LF = UseFlag = TRUE
CASE "line"
IF iMatchWrd(Stk$[Tmp+1],"input") THEN
Stk$[Tmp] = "lineinput"
j = Tmp + 4
Stk$[Tmp+1] = "" ' Extract the file handle
FOR i = Tmp+2 TO Ndx
IF *Stk$[i] = ASC(",") THEN j=i+1 : EXIT FOR
Stk$[Tmp+1] = Stk$[Tmp+1] + Stk$[i]
Stk$[i] = ""
NEXT j
FOR i = j TO Ndx
Stk$[Tmp+2]= Stk$[Tmp+2] & Stk$[i]
NEXT
END IF
CASE "lcase$"
Stk$[Tmp] = "$$lcase$"
Use_Lcase = UseFlag = TRUE
CASE "ldouble"
Stk$[Tmp] = "LDOUBLE"
Use_Ldouble = UseFlag = TRUE
CASE "left$"
Stk$[Tmp]= "$$left$"
Use_Left = UseFlag = TRUE
CASE "long"
Stk$[Tmp]= "long"
CASE "longlong"
Stk$[Tmp] = "LONGLONG"
CASE "lpbyte"
Stk$[Tmp] = "LPBYTE"
CASE "len"
Stk$[Tmp]= "strlen"
CASE "lprint"
Stk$[Tmp]= "lprint"
IF Tmp = Ndx THEN
Ndx++
Stk$[Ndx] = ENC$ ("") ' Allow LPRINT with no args
END IF
CASE "lpad$"
Stk$[Tmp]= "$$lpad$"
Use_Lpad = UseFlag = TRUE
CASE "ltrim$"
Stk$[Tmp]= "$$ltrim$"
Use_Ltrim = UseFlag = TRUE
CASE "lof"
Stk$[Tmp]= "lof"
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
Use_Lof = Use_Proto = TRUE
CASE "loadlibrary", "load_dll"
Stk$[Tmp]= "LoadLibrary"
CASE "like"
Stk$[Tmp] = "like"
Use_Like = Use_Proto = TRUE
CASE "lobyte"
Stk$[Tmp]= "LOBYTE"
CASE "loc"
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
Stk$[Tmp] = "loc(" + Stk$[Tmp + 2] + "," + Stk$[Tmp + 2] + "len)"
Stk$[Tmp + 1] = ""
Stk$[Tmp + 2] = ""
Stk$[Tmp + 3] = ""
Use_Loc = TRUE
CASE "locate"
Use_Locate = Use_Console = Use_Proto = TRUE
CASE "log"
Stk$[Tmp]= "log"
CASE "logl"
Stk$[Tmp]= "logl"
CASE "log10"
Stk$[Tmp]= "log10"
CASE "log10l"
Stk$[Tmp]= "log10l"
CASE "loword"
Stk$[Tmp]= "LOWORD"
CASE "lpstr"
Stk$[Tmp]= "LPSTR"
END SELECT
CASE 13
SELECT CASE Keyword$
CASE "mkd$"
IF Tmp > 2 THEN
IF INCHR(Stk$[Tmp-2],"$") AND *Stk$[Tmp-1] = ASC("=") THEN
Stk$[1] = "memcpy(" + Stk$[1]
Stk$[Tmp-1] = ","
Stk$[++Ndx] = ",9)"
END IF
END IF
Stk$[Tmp]="MKD"
Use_Mkd = UseFlag = TRUE
CASE "mki$"
IF Tmp > 2 THEN
IF INCHR(Stk$[Tmp-2],"$") AND *Stk$[Tmp-1] = ASC("=") THEN
Stk$[1] = "memcpy(" + Stk$[1]
Stk$[Tmp-1] = ","
Stk$[++Ndx] = ",3)"
END IF
END IF
Stk$[Tmp]="MKI"
Use_Mki = UseFlag = TRUE
CASE "mkl$"
IF Tmp > 2 THEN
IF INCHR(Stk$[Tmp-2],"$") AND *Stk$[Tmp-1] = ASC("=") THEN
Stk$[1] = "memcpy(" + Stk$[1]
Stk$[Tmp-1] = ","
Stk$[++Ndx] = ",5)"
END IF
END IF
Stk$[Tmp]="MKL"
Use_Mkl = UseFlag = TRUE
CASE "mkld$"
IF Tmp > 2 THEN
IF INCHR(Stk$[Tmp-2],"$") AND *Stk$[Tmp-1] = ASC("=") THEN
Stk$[1] = "memcpy(" + Stk$[1]
Stk$[Tmp-1] = ","
Stk$[++Ndx] = ",11)"
END IF
END IF
Stk$[Tmp]="MKLD"
Use_Mkld = UseFlag = TRUE
CASE "mks$"
IF Tmp > 2 THEN
IF INCHR(Stk$[Tmp-2],"$") AND *Stk$[Tmp-1] = ASC("=") THEN
Stk$[1] = "memcpy(" + Stk$[1]
Stk$[Tmp-1] = ","
Stk$[++Ndx] = ",5)"
END IF
END IF
Stk$[Tmp]="MKS"
Use_Mks = UseFlag = TRUE
CASE "mid$"
IF Tmp > 1 THEN
Stk$[Tmp]= "$$mid$"
Use_Mid = UseFlag = TRUE
ELSE
Stk$[Tmp]= "midstr"
Use_Midstr = TRUE
END IF
CASE "min"
Stk$[Tmp]= "MIN"
Use_Min = Use_Proto = TRUE
CASE "main"
Stk$[Tmp]= "main"
CASE "makeintresource"
Stk$[Tmp]= "MAKEINTRESOURCE"
CASE "makelong"
Stk$[Tmp]= "MAKELONG"
CASE "makeword"
Stk$[Tmp]= "MAKEWORD"
CASE "max"
Stk$[Tmp]= "MAX"
Use_Max = Use_Proto = TRUE
CASE "mcase$"
Stk$[Tmp] = "$$mcase$"
Use_Mcase = UseFlag = TRUE
CASE "mkdir"
Stk$[Tmp]= "mkdir"
CASE "mod"
Stk$[Tmp]= "fmod"
CASE "modstyle"
Stk$[Tmp]= "ModStyle"
Use_Modstyle = Use_Proto = TRUE
CASE "msgbox"
IF Stk$[Tmp-1]= "=" OR LCASE$(Stk$[Tmp-1])= "if" THEN
Stk$[Tmp]= "MsgBox"
Use_Msgbox = Use_Proto = TRUE
END IF
END SELECT
CASE 14
SELECT CASE Keyword$
'
CASE "new"
IF iMatchWrd(Stk$[Tmp-1],"binary") THEN EXIT
IF UseCpp = FALSE THEN Abort( "'NEW' can only be used with C++" )
Stk$[Tmp] = "new "
'
' bc.500_com
' For compatibility with VB code, See CreateObject for more details what I'm doin' here
CASE "nothing"
Use_COM = TRUE
' Next line should be called only if NOT inside (IF...END IF)
' BCX_Remove_COM_Object(Stk$[1]) ' temporary disbled until I figure out is it called from (IF...END IF)
Stk$[3] = "&" & Stk$[1]
Stk$[1] = "BCX_SetNothing"
Stk$[2] = "("
Stk$[4] = ")"
Ndx++
' bc.500_com
CASE "nosort"
Stk$[Tmp] = "WS_CHILD|WS_VISIBLE|WS_VSCROLL"
CASE "nul$"
Stk$[Tmp] = "NUL$"
Use_NUL = UseFlag = TRUE
CASE "null"
Stk$[Tmp]= "NULL"
CASE "now$"
Stk$[Tmp]= "now$()"
Use_Now = UseFlag = TRUE
END SELECT
CASE 15
SELECT CASE Keyword$
' bc.500_com
CASE "object"
IF ComSwitchON THEN
Stk$[Tmp] = "OBJECT"
Use_COM = UseFlag = TRUE
' bc.500_com
END IF
CASE "open"
FOR A = Tmp+1 TO Ndx
IF LEFT$(Stk$[A],1) = "#" THEN
Stk$[A] = MID$(Stk$[A],2)
EXIT FOR
END IF
NEXT
CASE "oct$"
Stk$[Tmp]= "oct$"
Use_Oct = UseFlag = TRUE
CASE "outp"
Stk$[Tmp]= "Outp"
Use_Outp = Use_Sysmacros = TRUE
CASE "outpw"
Stk$[Tmp]= "Outpw"
Use_Outpw = Use_Sysmacros = TRUE
CASE "osversion"
Stk$[Tmp]= "OSVersion()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_OSVersion = Use_Proto = TRUE
END SELECT
CASE 16
SELECT CASE Keyword$
CASE "pellespath$"
Stk$[Tmp] = "PellesPath$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_PellesPath = Use_RegString = Use_Instrrev = TRUE
Use_Left = UseFlag = TRUE
CASE "printer"
Stk$[1] = "printer"
Stk$[2] = LCASE$(Stk$[2])
Emit()
Use_Printer = Use_Proto = TRUE
SrcTmp$ = "GLOBAL BcxPtr_hDC AS HDC" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_FontMetrix AS LONG" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_LineCtr AS LONG" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_PrinterOn AS LONG" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_hFont AS HFONT" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_hFontOld AS HFONT" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_di AS DOCINFO" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_Lf AS LOGFONT" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_tm AS TEXTMETRIC" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_Text$" : Parse(SrcTmp$) : Emit()
SrcTmp$ = "GLOBAL BcxPtr_Buffer$" : Parse(SrcTmp$) : Emit()
Use_Mid = Use_Left = Use_StrStr = TRUE
Use_Extract = Use_Str = UseFlag = TRUE
'********************************************************************
CASE "preserve"
Stk$[Tmp] = "PRESERVE"
CASE "print#"
Stk$[Tmp] = "fprint"
CASE "print"
IF LEFT$(Stk$[Tmp+1],1)= "#" THEN
Stk$[Tmp] = "fprint"
Stk$[Tmp+1] = MID$(Stk$[Tmp+1],2)
END IF
CASE "ptr"
CompPtr = 1
Stk$[Tmp-1] = Stk$[Tmp-1] + "*"
Stk$[Tmp]= ""
IF Tmp = Ndx THEN
Ndx--
WHILE TALLY(Stk$[Ndx],"*") = LEN(Stk$[Ndx])
Stk$[Ndx-1] = Stk$[Ndx-1] + Stk$[Ndx]
Stk$[Ndx] = ""
Ndx--
WEND
ELSE
i = Tmp-1
WHILE TALLY(Stk$[i],"*") = LEN(Stk$[i])
Stk$[i-1] = Stk$[i-1] + Stk$[i]
Stk$[i] = ""
i--
WEND
END IF
CASE "panel"
Stk$[Tmp] = "panel"
Use_Panel = Use_Console = Use_Proto = TRUE
CASE "pause"
Stk$[Tmp] = "Pause()"
IF Stk$[Tmp+1] = "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Pause = Use_Keypress = Use_Proto = TRUE
CASE "peek$"
Stk$[Tmp]= "$$peekstr$"
Use_PeekStr = UseFlag = TRUE
CASE "playwav"
Stk$[Tmp] = "PlayWav"
Use_PlayWav = Use_GetResource = Use_Proto = TRUE
CASE "poke"
Stk$[Tmp]= "memmove"
CASE "pos"
Stk$[Tmp] = "Pos()"
Use_Pos = Use_Proto = TRUE
CASE "pow"
Stk$[Tmp]= "pow"
CASE "powl"
Stk$[Tmp]= "powl"
CASE "private"
IF iMatchWrd(Stk$[Tmp+1],"const") THEN
Stk$[Tmp]= "enum "
Stk$[Tmp+1]= Stk$[Tmp+2] + "{"
Ndx++
Stk$[Ndx]= "}"
END IF
END SELECT
CASE 17
SELECT CASE Keyword$
CASE "qbcolor"
Stk$[Tmp]= "qbcolor"
Use_QBColor = Use_Proto = TRUE
END SELECT
CASE 18
SELECT CASE Keyword$
CASE "rewind"
Stk$[Tmp]= "rewind"
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
CASE "remove$"
Stk$[Tmp]= "$$RemoveStr$"
Use_Remove = Use_StrStr = UseFlag = TRUE
CASE "replace$"
Stk$[Tmp]= "$$replace$"
Use_Replace = Use_StrStr = UseFlag = TRUE
CASE "right$"
Stk$[Tmp]= "$$right$"
Use_Right = UseFlag = TRUE
CASE "rename"
Stk$[Tmp]= "rename"
CASE "register"
Stk$[Tmp]= "register"
CASE "randomize"
Stk$[Tmp]= "randomize"
Use_Randomize = TRUE
Use_Rnd = TRUE
Use_Proto = TRUE
IF Ndx = 1 THEN
Use_Timer = TRUE
Stk$[1] ="srand(unsigned(time(NULL)));" 'LINUX
END IF
CASE "rec"
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
Stk$[Tmp] = "rec(" + Stk$[Tmp + 2] + "," + Stk$[Tmp + 2] + "len)"
Stk$[Tmp + 1] = ""
Stk$[Tmp + 2] = ""
Stk$[Tmp + 3] = ""
Use_Rec = Use_Proto = TRUE
CASE "reccount"
DIM RAW length$
IF DataType(Stk$[Tmp + 2]) = vt_NUMBER THEN
Stk$[Tmp + 2] = "FP" + Stk$[Tmp + 2]
END IF
Stk$[Tmp] = "reccount"
length$ = Stk$[Tmp + 2] + "len)"
FOR i = Tmp+1 TO Ndx
IF *Stk$[i] = ASC(")") THEN
Stk$[i] = ""
EXIT FOR
END IF
Stk$[Tmp] = Stk$[Tmp] + Stk$[i]
Stk$[i] = ""
NEXT i
Stk$[Tmp] = Stk$[Tmp] + "," + length$
Use_RecCount = Use_Proto = TRUE
CASE "reclen"
Stk$[Tmp] = "reclen"
CASE "record"
Stk$[Tmp] = "record"
CASE "refresh"
Stk$[Tmp]= "Refresh"
Use_Refresh = Use_Sysmacros = TRUE
CASE "regstring$"
Stk$[Tmp] = "$$RegString$"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_RegString = UseFlag = TRUE
CASE "regint"
Stk$[Tmp] = "RegInt"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_RegInt = UseFlag = TRUE
CASE "remain$"
Stk$[Tmp]= "$$remain$"
Use_Remain = UseFlag = TRUE
CASE "retain$"
Stk$[Tmp]= "$$Retain$"
Use_Retain = UseFlag = TRUE
CASE "repeat$"
Stk$[Tmp]= "$$repeat$"
Use_Repeat = UseFlag = TRUE
CASE "reverse$"
Stk$[Tmp]= "$$reverse$"
Use_Reverse = UseFlag = TRUE
CASE "rgb"
Stk$[Tmp]= "RGB"
CASE "rmdir"
Stk$[Tmp]= "rmdir"
CASE "rnd"
Stk$[Tmp]= "rnd()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Rnd = Use_Proto = TRUE
CASE "round"
Stk$[Tmp]= "Round"
Use_Round = Use_Proto = TRUE
CASE "rpad$"
Stk$[Tmp]= "$$rpad$"
Use_Rpad = UseFlag = TRUE
CASE "rtrim$"
Stk$[Tmp]= "$$rtrim$"
Use_Rtrim = UseFlag = TRUE
CASE "run"
Stk$[Tmp]= "Run"
Use_Run = Use_Proto = TRUE
END SELECT
CASE 19
SELECT CASE Keyword$
CASE "sprint"
Stk$[Tmp]= "sprint"
CASE "spc$"
Stk$[Tmp] = "SPC$"
Use_SPC = UseFlag = TRUE
CASE "startdraw"
Stk$[Tmp]= "StartDraw"
Use_Draw = TRUE
CASE "str$"
Stk$[Tmp]= "$$str$"
Use_Str = UseFlag = TRUE
CASE "strl$"
Stk$[Tmp]= "$$strl$"
Use_Strl = UseFlag = TRUE
CASE "searchpath$"
Stk$[Tmp]= "$$SEARCHPATH$"
Use_SearchPath = UseFlag = TRUE
CASE "sizeof"
Stk$[Tmp]= "sizeof"
CASE "sendmessage", "sndmsg"
'*****************************
' SendMessage HELPER
'*****************************
IF NOT iMatchWrd(Stk$[1],"const") THEN
Stk$[Tmp] = "SendMessage"
Comma = i = 0
A = Tmp+1
DO
IF A > Ndx THEN Abort("Malformed SendMessage")
A++
IF INCHR("([{",Stk$[A]) THEN INCR i
IF INCHR(")]}",Stk$[A]) THEN DECR i
IF i <> 0 THEN ITERATE
IF *Stk$[A] = ASC(",") THEN
IF Comma = 0 THEN
IF NOT iMatchWrd(Stk$[A+2],"UINT") THEN
InsertTokens(A,3,"(","UINT",")")
END IF
ELSEIF Comma = 1 THEN
IF NOT iMatchWrd(Stk$[A+2],"WPARAM") THEN
InsertTokens(A,3,"(","WPARAM",")")
END IF
ELSEIF Comma = 2 THEN
IF NOT iMatchWrd(Stk$[A+2],"LPARAM") THEN
InsertTokens(A,3,"(","LPARAM",")")
END IF
EXIT LOOP
END IF
Comma++
END IF 'Is a comma
LOOP
END IF
CASE "savebmp"
Stk$[Tmp] = "SaveBmp"
Use_SaveBmp = Use_Proto = UseFlag = TRUE
CASE "set_bcx_bitmap"
Stk$[Tmp] = "Set_BCX_Bitmap"
Use_Set_BCX_Bitmap = UseFlag = TRUE
CASE "set_bcx_bitmap2"
Stk$[Tmp] = "Set_BCX_Bitmap2"
Use_Set_BCX_Bitmap2 = UseFlag = TRUE
CASE "set_bcx_bmpbutton"
Stk$[Tmp] = "Set_BCX_BmpButton"
Use_Set_BCX_BmpButton = UseFlag = TRUE
CASE "set_bcx_icon"
Stk$[Tmp] = "Set_BCX_Icon"
Use_Proto = TRUE
Use_Set_BCX_Icon = Use_GetResource = TRUE
CASE "screen"
Stk$[Tmp]= "Screen"
Use_Screen = Use_Proto = TRUE
CASE "setattr"
Stk$[Tmp]= "SETATTR"
Use_Setattr = Use_Sysmacros = TRUE
CASE "setwindowrtftext"
Stk$[Tmp] = "SetWindowRTFText"
Use_Richedit = UseFlag = TRUE
CASE "sgn"
Stk$[Tmp]= "sgn"
Use_Sgn = Use_Proto = TRUE
CASE "short"
Stk$[Tmp] = "short"
CASE "show"
Stk$[Tmp]= "Show"
Use_Show = Use_Sysmacros = TRUE
CASE "showmodal"
Stk$[Tmp] = "ShowModal"
Use_Show = Use_Sysmacros = Use_ShowModal = Use_EndModal = TRUE
CASE "sin"
Stk$[Tmp]= "sin"
CASE "sinl"
Stk$[Tmp]= "sinl"
CASE "single"
Stk$[Tmp]= "float"
CASE "sinh"
Stk$[Tmp]= "sinh"
CASE "sleep"
Stk$[Tmp]= "Sleep"
CASE "space$"
Stk$[Tmp]= "$$space$"
Use_Space = UseFlag = TRUE
CASE "sound"
Stk$[Tmp]= "Sound"
Use_Sound = Use_Round = Use_Str = Use_Abs = UseFlag = TRUE
CASE "split"
Stk$[Tmp]= "Split"
Use_Proto = TRUE
UseFlag = TRUE
Use_Split = TRUE
Use_Remove= TRUE
Use_StrStr= TRUE
Use_Mid = TRUE
Use_Left = TRUE
Use_Instr = TRUE
Use_Stristr = TRUE
UseLCaseTbl = TRUE
CASE "splitbarfg"
Stk$[Tmp]= "SplitBarFG"
CASE "splitbarbg"
Stk$[Tmp]= "SplitBarBG"
CASE "sqr","sqrt"
Stk$[Tmp]= "sqrt"
CASE "sqrl","sqrtl"
Stk$[Tmp]= "sqrtl"
CASE "strarray"
Stk$[Tmp]= "LPSTR*"
CASE "strim$"
Stk$[Tmp]= "$$strim$"
Use_Strim = UseFlag = TRUE
CASE "string"
Stk$[Tmp]= "string"
CASE "string$"
Stk$[Tmp]= "$$string$"
Use_String = UseFlag = TRUE
CASE "strptr"
Stk$[Tmp]= "STRPTR"
Use_Strptr = Use_Sysmacros = TRUE
CASE "strtoken$"
Stk$[Tmp]= "StrToken$"
Use_Strtoken = UseFlag = Use_Mid = Use_Left = Use_Extract = TRUE
Use_Instr =Use_Instrrev = Use_Stristr = Use_Tally = Use_Remove = TRUE
Use_StrStr = UseLCaseTbl = TRUE
CASE "swap"
Stk$[Tmp]= "swap"
Use_Swap = Use_Proto = TRUE
CASE "sysdir$"
Stk$[Tmp]= "$$sysdir$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Sysdir = UseFlag = TRUE
CASE "sysstr"
Stk$[Tmp] = "SysStr"
Use_SysStr = Use_Proto = TRUE
END SELECT
CASE 20
SELECT CASE Keyword$
CASE "tab$"
Stk$[Tmp] = "TAB$"
Use_TAB = UseFlag = TRUE
CASE "true"
Stk$[Tmp]= "TRUE"
CASE "trim$"
Stk$[Tmp]= "$$trim$"
Use_Trim = UseFlag = TRUE
CASE "tally"
Stk$[Tmp]= "tally"
Use_Tally = Use_StrStr = Use_Proto = TRUE
CASE "tan"
Stk$[Tmp]= "tan"
CASE "tanh"
Stk$[Tmp]= "tanh"
CASE "tanl"
Stk$[Tmp]= "tanl"
CASE "tempdir$"
Stk$[Tmp]= "$$tempdir$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Tempdir = UseFlag = TRUE
CASE "tempfilename$"
Stk$[Tmp] = "$$TempFileName$"
Use_TempFileName = UseFlag = TRUE
CASE "textmode"
Stk$[Tmp]= "TextMode"
Use_Textmode = Use_Proto = TRUE
' *******************************************************************
' Special Case Handler: Substitute "This." with "This->"
' *******************************************************************
CASE "this"
Stk$[Tmp] = "This"
IF *Stk[Tmp+1] = ASC(".") THEN
Stk$[Tmp+1] = "->" & MID$(Stk$[Tmp+1],2)
END IF
CASE "time$"
IF Stk$[Tmp+1] <> "(" THEN
Stk$[Tmp] = "$$timef$()"
ELSE
Stk$[Tmp] = "$$timef$"
END IF
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Time = UseFlag = TRUE
CASE "timer"
Stk$[Tmp]= "timer()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Timer = Use_Proto = TRUE
END SELECT
CASE 21
SELECT CASE Keyword$
CASE "uint"
Stk$[Tmp]= "UINT"
CASE "ushort"
Stk$[Tmp] = "USHORT"
CASE "ulong"
Stk$[Tmp] = "ULONG"
CASE "ulonglong"
Stk$[Tmp] = "ULONGLONG"
CASE "ucase$"
Stk$[Tmp]= "$$ucase$"
Use_Ucase = UseFlag = TRUE
CASE "ubound"
Stk$[Tmp]= "ubound"
Use_Ubound = Use_Sysmacros = TRUE
CASE "using$"
Stk$[Tmp] = "$$Using$"
Use_Using = UseFlag = TRUE
END SELECT
CASE 22
SELECT CASE Keyword$
CASE "val"
Stk$[Tmp]= "VAL"
Use_Val = Use_Sysmacros = TRUE
CASE "vall"
Stk$[Tmp]= "VALL"
Use_Vall = Use_Sysmacros = TRUE
CASE "variant"
Stk$[Tmp]= "VARIANT"
CASE "varptr"
Stk$[Tmp]= ""
CASE "vchr$"
Stk$[Tmp] = "$$vchr$"
Use_VChr = UseFlag = TRUE
CASE "vt$"
Stk$[Tmp] = "VT$"
Use_VT = UseFlag = TRUE
CASE "verify"
Stk$[Tmp] = "Verify"
Use_Verify = Use_Mid = UseFlag = TRUE
CASE "vbs_addcode","vbs_run_script","vbs_eval_str$"
Stk$[Tmp] = UCASE$(Stk$[Tmp])
Use_VBS = UseFlag = TRUE
CASE "vbs_eval_num","vbs_eval_num#"
Stk$[Tmp] = "VBS_EVAL_NUM#"
Use_VBS = UseFlag = TRUE
CASE "vbs_start","vbs_stop","vbs_reset","vbs_error$"
Use_VBS = UseFlag = TRUE
Stk$[Tmp] = UCASE$(Stk$[Tmp]) + "()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
END SELECT
CASE 23
SELECT CASE Keyword$
CASE "widetoansi$"
Stk$[Tmp] = "$$WideToAnsi$"
Use_WideToAnsi = UseFlag = TRUE
CASE "windir$"
Stk$[Tmp]= "$$windir$()"
IF Stk$[Tmp+1]= "(" AND Stk$[Tmp+2]= ")" THEN
Stk$[Tmp+1] = ""
Stk$[Tmp+2] = ""
END IF
Use_Windir = UseFlag = TRUE
CASE "wndproc"
IF Tmp = 2 AND Ndx < 6 THEN
Src$ = "FUNCTION|LRESULT CALLBACK WndProc(hWnd|AS|HWND,Msg|AS|UINT,wParam|AS|WPARAM,lParam|AS|LPARAM)"
FastLexer(Src$,"|",",()")
Use_Wingui = TRUE 'Use_Str_Cmp = Use_Ucase = TRUE
END IF
CASE "winmain"
Use_Wingui = InWinMain = TRUE 'Use_Str_Cmp = Use_Ucase = TRUE
IF Tmp = 2 AND Ndx < 6 THEN
Src$ = "FUNCTION|WinMain(hInst|AS|HINSTANCE,hPrev|AS|HINSTANCE,CmdLine|AS|LPSTR,CmdShow|AS|int)AS|int WINAPI"
FastLexer(Src$,"|",",()")
ELSE
Stk$[Tmp] = "WinMain"
END IF
END SELECT
END SELECT
NEXT
'************************************************************
' handle programming style global and locals using same name
'************************************************************
Keyword$ = LCASE$(Stk$[1])
SELECT CASE Keyword$
CASE "dim" : CompToken = 0
CASE "local" : CompToken = 0
CASE "global" : CompToken = 0
CASE "static" : CompToken = 0
CASE "shared" : CompToken = 0
CASE "raw" : CompToken = 0
CASE "dynamic" : CompToken = 0
CASE "redim" : CompToken = 0
CASE "sub" : CompToken = 0
CASE "function" : CompToken = 0
CASE "overloaded" : CompToken = 0
CASE "callback" : CompToken = 0
CASE "public" : CompToken = 0
CASE "declare" : CompToken = 0
CASE "c_declare" : CompToken = 0
CASE "auto" : CompToken = 0
CASE "register" : CompToken = 0
CASE "extern" : CompToken = 0
END SELECT
IF CompPtr = 1 THEN CALL RemEmptyTokens
' FOR Tmp = 1 TO Ndx
' IF Stk$[Tmp] = "" THEN
' FOR i = Tmp TO Ndx-1
' Stk$[i] = Stk$[i+1]
' NEXT
' Stk$[Ndx] = ""
' Ndx--
' END IF
' NEXT
' END IF
IF CompToken = 1 THEN
CALL CompStructVars(1)
END IF
END SUB 'TokenSubstitutions
SUB ProcNonPara(cs AS INTEGER)
DIM RAW i,j,k,vt,sj,inif
DIM RAW br = 0
DIM RAW pr = 0
DIM RAW t$
IF cs THEN CALL CompStructVars(1)
FOR i = 1 TO Ndx-1
IF Stk$[i+1] = "(" AND Stk$[i+2] <> "(" THEN
ProcPara(i+2,i+2)
vt = DataType(Stk$[i])
IF iMatchRgt(Stk$[i+2], ")") AND vt = vt_STRVAR AND iMatchLft(Stk$[i+2],"join$") THEN
IF Stk$[i+3] = "" THEN
Stk$[i+2] = LEFT$(Stk$[i+2],LEN(Stk$[i+2])-1)
Stk$[i+3] = ")"
END IF
END IF
FOR k = i TO Ndx
IF Stk$[k] = "" THEN
DO
Ndx--
FOR j = k TO Ndx
Stk$[j] = Stk$[j+1]
NEXT
LOOP WHILE Stk$[k] = "" AND k <= Ndx
END IF
NEXT
END IF
vt = DataType(Stk$[i])
IF vt = vt_STRVAR THEN
IF NOT iMatchRgt(Stk$[i],"$") THEN
IF INSTR(Stk$[i],"(") - INSTR(Stk$[i],"$(") <> 1 THEN
vt = vt_UNKNOWN
END IF
END IF
END IF
IF vt = vt_STRVAR OR vt = vt_STRLIT THEN
t$ = LCASE$(Stk$[i+1])
IF INSTR("&,:+-*/^;=<>",t$) = 0 AND t$ <> "for" AND t$ <> "then" THEN
j = i+1
DO
IF Stk$[j] = ")" THEN pr--
IF Stk$[j] = "(" THEN pr++
IF Stk$[j] = "]" THEN br--
IF Stk$[j] = "[" THEN br++
IF br = 0 AND pr = 0 THEN
IF INSTR("&,:+-*/^;=<>then",LCASE$(Stk$[j])) THEN EXIT LOOP
END IF
IF Stk$[j] = "||" THEN Stk$[j] = " or"
IF Stk$[j] = "&&" THEN Stk$[j] = " and"
Stk$[i] = Stk$[i] + Stk$[j] + " "
Stk$[j] = ""
j++
LOOP WHILE j <= Ndx
i = j
END IF
END IF
NEXT
FOR i = 1 TO Ndx
IF Stk$[i] = "" THEN
DO
Ndx--
FOR j = i TO Ndx
Stk$[j] = Stk$[j+1]
NEXT
LOOP WHILE Stk$[i] = "" AND i <= Ndx
END IF
NEXT
i = 1
inif = 0
WHILE i <= Ndx
t$ = LCASE$(Stk$[i])
vt = DataType(t$)
IF t$ = "if" THEN
inif = 1
ELSEIF t$ = "then" THEN
inif = 0
ELSEIF t$ = "sprint" OR t$ = "lprint" OR t$ = "fprint" OR t$ = "fprintf" OR t$ = "print" OR t$ = "print#" OR (t$ = "=" AND inif = 0) THEN
EXIT SUB
END IF
IF vt = vt_STRVAR OR vt = vt_STRLIT THEN
sj = i
i++
IF Stk$[i] = "&" THEN
Stk$[i] = ","
j = 1
DO
i++
vt = DataType(Stk$[i])
IF (vt = vt_STRVAR OR vt = vt_STRLIT) THEN
j++
i++
IF Stk$[i] = "&" THEN
Stk$[i] = ","
ELSE
i--
EXIT LOOP
END IF
ELSE
IF Stk[i][0] THEN
i--
EXIT LOOP
END IF
END IF
LOOP WHILE i < Ndx
Stk$[sj] = "join$(" + STR$(j) + "," + Stk$[sj]
FOR j = sj+1 TO i
IF Stk[j][0] THEN
Stk$[sj] = Stk$[sj] + " " + Stk$[j]
Stk$[j] = ""
END IF
NEXT
Stk$[sj] = Stk$[sj] + ")"
ELSE
IF Stk$[i] = "=" AND inif = 0 THEN
EXIT SUB
END IF
END IF
END IF
i++
WEND
END SUB ' ProcNonPara
SUB ProcPara(i AS INTEGER, s AS INTEGER)
'**************
DIM RAW j = 0
DIM RAW l = 0
DIM RAW sj = i
DIM RAW t$
DIM RAW vt
'**************
WHILE i < Ndx
t$ = Stk$[i]
SELECT CASE t$
CASE "&"
vt = DataType(Stk$[i+1])
IF vt <> vt_STRVAR AND vt <> vt_STRLIT THEN
vt = DataType(Stk$[i-1])
END IF
IF vt = vt_STRVAR OR vt = vt_STRLIT THEN
IF Stk$[i-1] <> "," AND Stk$[i-1] <> "(" THEN
j++
Stk$[i] = ","
END IF
END IF
CASE "("
ProcPara(i+1,s)
l = i-1
WHILE Stk$[i] <> ")"
Stk$[l] = Stk$[l] + Stk$[i]
Stk$[i] = ""
i++
WEND
Stk$[l] = Stk$[l] + Stk$[i]
Stk$[i] = ""
CASE ")"
IF j THEN
Stk$[sj] = "join$(" + STR$(j+1) + "," + Stk$[sj]
j = sj
j++
WHILE j <= i
Stk$[sj] = Stk$[sj] + Stk$[j]
Stk$[j] = ""
j++
WEND
Stk$[sj] = Stk$[sj] + ")"
END IF
EXIT SUB
CASE ","
IF j THEN
Stk$[sj] = "join$(" + STR$(j+1) + "," + Stk$[sj]
j = sj
j++
WHILE j < i
Stk$[sj] = Stk$[sj] + Stk$[j]
Stk$[j] = ""
j++
WEND
Stk$[sj] = Stk$[sj] + ")"
END IF
j = 0
sj = i + 1
CASE "||"
j = 0
sj = i + 1
Stk$[i] = " or "
CASE "&&"
j = 0
sj = i + 1
Stk$[i] = " and "
CASE ELSE
IF t[0] THEN
vt = DataType(t$)
IF vt <> vt_STRVAR AND vt <> vt_STRLIT THEN
' test failed
END IF
END IF
END SELECT
i++
WEND
IF sj >= s THEN
IF j THEN
Stk$[sj] = "join$(" + STR$(j+1) + "," + Stk$[sj]
j = sj
j++
WHILE j <= i
Stk$[sj] = Stk$[sj] + Stk$[j]
Stk$[j] = ""
j++
WEND
Stk$[sj] = Stk$[sj] + ")"
END IF
END IF
END SUB ' ProcPara
SUB Transforms()
'****************
DIM RAW nBrace
DIM RAW CntMarker
DIM RAW IFCond
DIM RAW a
DIM RAW i
DIM RAW j
DIM RAW Keyword$
DIM RAW lszTmp$
'****************
Keyword$ = ""
lszTmp$ = ""
' ReTransform:
IF Ndx = 3 AND NOT WithCnt THEN
IF Stk$[2] = "+" AND Stk$[3] = "+" THEN
FPRINT Outfile,Scoot$,Clean$(Stk$[1]);"++;"
Ndx = 0
Statements++
EXIT SUB
END IF
IF Stk$[2] = "-" AND Stk$[3] = "-" THEN
FPRINT Outfile,Scoot$,Clean$(Stk$[1]);"--;"
Ndx = 0
Statements++
EXIT SUB
END IF
IF Stk$[1] = "+" AND Stk$[2] = "+" THEN
FPRINT Outfile,Scoot$,"++";Clean$(Stk$[3]);";"
Ndx = 0
Statements++
EXIT SUB
END IF
IF Stk$[1] = "-" AND Stk$[2] = "-" THEN
FPRINT Outfile,Scoot$,"--";Clean$(Stk$[3]);";"
Ndx = 0
Statements++
EXIT SUB
END IF
END IF
Keyword$ = LCASE$(Stk$[1])
a = INCHR("abcdefghijklmnopqrstuvwxyz$", Keyword$)
SELECT CASE a
CASE 3
IF Keyword$ = "case" THEN
nBrace = 0
CntMarker = 2
j = 0
FOR i = 2 TO Ndx
IF INCHR("([",Stk$[i]) THEN nBrace++
IF INCHR(")]",Stk$[i]) THEN nBrace--
IF Stk$[i] = "," THEN
IF nBrace=0 THEN CntMarker = i + 1
END IF
IF iMatchWrd(Stk$[i],"to") THEN
j = 1
Stk$[i] = " and <="
Stk$[CntMarker] = ">=" + Stk$[CntMarker]
END IF
NEXT
IF j=1 THEN
Src$ = ""
FOR i = 1 TO Ndx
Src$ = Src$ + Stk$[i] + " "
NEXT
CALL XParse(Src$)
END IF
EXIT SUB
END IF
CASE 4
'*********************************************************************
' The following code introduces the following DLL declarations to BCX
'*********************************************************************
' DECLARE FUNCTION Foo LIB "FOO.DLL" ALIAS "FooA" ( A$ )
' OR
' DECLARE FUNCTION Foo LIB "FOO.DLL" ( A$ ) - Alias will default to "FOO"
' [5.08.1102] Foo = (BCXFPROTx)GetProcAddress(H_FOO, "FooA");
'*********************************************************************
IF Keyword$ = "declare" AND iMatchWrd(Stk$[4],"lib") THEN
DIM RAW alias$, i, idx=-1
REMOVE DQ$ FROM Stk$[5]
FOR i = 0 TO LoadLibsCnt - 1
IF Stk$[5] = Loadlibs$[i] THEN
idx = i
EXIT FOR
END IF
NEXT i
IF idx < 0 THEN
Loadlibs$[LoadLibsCnt] = Stk$[5]
INCR LoadLibsCnt
END IF
IF iMatchWrd(Stk$[6],"alias") THEN
alias$ = Stk$[7]
Stk$[6] = ""
Stk$[7] = ""
ELSE
alias$ = ENC$(UCASE$(Stk$[3]))
END IF
INCR DllCnt
IF DllCnt > 799 THEN Abort("Maximum number of declarations exceded.")
DllDecl$ [DllCnt] = Clean$(Stk$[3]) + "=(BCXFPROT" + LTRIM$(STR$(DllCnt)) + _
")GetProcAddress(H_" + UCASE$(EXTRACT$(Stk$[5], ".")) + ", " + alias$ + ");"
Stk$[4] = ""
Stk$[5] = ""
EXIT SUB
END IF
CASE 5
' BEGIN BCX_GUI MODIFICATION
IF Keyword$ = "end" AND iMatchWrd(Stk$[2],"events") THEN
Stk$[1] = "endevents"
IF iMatchWrd(Stk$[3], "main" ) THEN Use_MainEvent = TRUE
Ndx=1
EXIT SUB
END IF
IF Keyword$ = "end" AND iMatchWrd(Stk$[2],"mdievents") THEN
Stk$[1] = "endmdievents"
IF iMatchWrd(Stk$[3], "main" ) THEN Use_MainEvent = TRUE
Ndx=1
EXIT SUB
END IF
IF Keyword$ = "end" AND iMatchWrd(Stk$[2],"mdichildevents") THEN
Stk$[1] = "endmdichildevents"
IF iMatchWrd(Stk$[3], "main" ) THEN Use_MainEvent = TRUE
Ndx=1
EXIT SUB
END IF
' END BCX_GUI MODIFICATION
CASE 7
IF Keyword$ = "get$" THEN
Stk$[1] = "~get"
EXIT SUB
END IF
IF Keyword$ = "global" AND iMatchWrd(Stk$[2],"dynamic") THEN
Stk$[1] = "global"
EXIT SUB
END IF
CASE 9
IF Keyword$ = "iremove" THEN
'***********************************************************
' Translate IREMOVE UCASE$("aaa") FROM LTRIM$(RTRIM$(A$))
' into A$ = IREMOVE$(LTRIM$(RTRIM$(A$)),UCASE$("aaa"))
'***********************************************************
DIM RAW Mat$, Fat$
Mat$ = "" : Fat$ = ""
FOR i = 2 TO Ndx
IF iMatchWrd(Stk$[i],"from") THEN
Stk$[i]= ""
EXIT FOR
END IF
NEXT
FOR j = 2 TO i
CONCAT(Mat$,Stk$[j]) ' build match string
NEXT
FOR j = i TO Ndx
CONCAT(Fat$,Stk$[j]) ' build fat source
NEXT
lszTmp$ = "=iremove$(" + Fat$ + "," + Mat$ + ")"
FastLexer(Fat$," ()","")
lszTmp$ = Stk$[Ndx] + lszTmp$
CALL XParse(lszTmp$)
CALL TokenSubstitutions
CALL Emit
Ndx = 0
EXIT SUB
END IF
IF Keyword$ = "ireplace" THEN
'**********************************************************
' IREPLACE "this" WITH "that" IN A$ is transformed into
' A$ = ireplace$ ( A$, "this", "that" )
' BCX 3.73 introduces CASE INSENSITIVE REPLACE
'**********************************************************
IF Ndx < 6 THEN Abort("Problem with IREPLACE statement")
DIM RAW W, I, VV$, RR$, WW$
VV$ = "" : RR$ = "" : WW$ = ""
FOR W = 2 TO Ndx
IF iMatchWrd(Stk$[W],"with") THEN
Stk$[W]= ""
EXIT FOR
END IF
NEXT
FOR I = 2 TO Ndx
IF iMatchWrd(Stk$[I],"in") THEN
Stk$[I]= ""
EXIT FOR
END IF
NEXT
i = I+1
FOR j = i TO Ndx
CONCAT (VV$,Stk$[j])
NEXT
FOR j = 2 TO W
CONCAT (RR$,Stk$[j])
NEXT
i = W+1
FOR j = i TO I
CONCAT (WW$,Stk$[j])
NEXT
lszTmp$ = "=ireplace$(" + VV$ + "," + RR$ + "," + WW$ + ")"
FastLexer(VV$," ()","")
lszTmp$ = Stk$[Ndx] + lszTmp$
CALL XParse(lszTmp$)
CALL TokenSubstitutions
CALL Emit
Ndx = 0
EXIT SUB
END IF
CASE 12
IF Keyword$ = "local" AND iMatchWrd(Stk$[2],"dynamic") THEN
Stk$[1] = "dim"
EXIT SUB
END IF
CASE 16
IF Keyword$ = "put$" THEN
Stk$[1] = "~put"
EXIT SUB
END IF
CASE 18
IF Keyword$ = "remove" THEN
'***********************************************************
' Translate REMOVE UCASE$("aaa") FROM LTRIM$(RTRIM$(A$))
' into A$ = REMOVE$(LTRIM$(RTRIM$(A$)),UCASE$("aaa"))
'***********************************************************
DIM RAW Mat$, Fat$
Mat$ = "" : Fat$ = ""
FOR i = 2 TO Ndx
IF iMatchWrd(Stk$[i],"from") THEN
Stk$[i]= ""
EXIT FOR
END IF
NEXT
FOR j = 2 TO i
CONCAT(Mat$,Stk$[j]) ' build match string
NEXT
FOR j = i TO Ndx
CONCAT(Fat$,Stk$[j]) ' build fat source
NEXT
lszTmp$ = "=remove$(" + Fat$ + "," + Mat$ + ")"
FastLexer(Fat$," ()","")
lszTmp$ = Stk$[Ndx] + lszTmp$
CALL XParse(lszTmp$)
CALL TokenSubstitutions
CALL Emit
Ndx = 0
EXIT SUB
END IF
IF Keyword$ = "replace" THEN
'***********************
' REPLACE "this" WITH "that" IN A$ is transformed into
' A$ = replace$ ( A$, "this", "that" )
' BCX 2.93 allows expressions and arrays to be used
'***********************
IF Ndx < 6 THEN Abort("Problem with REPLACE statement")
DIM RAW W, I, VV$, RR$, WW$
VV$ = "" : RR$ = "" : WW$ = ""
FOR W = 2 TO Ndx
IF iMatchWrd(Stk$[W],"with") THEN
Stk$[W]= ""
EXIT FOR
END IF
NEXT
FOR I = 2 TO Ndx
IF iMatchWrd(Stk$[I],"in") THEN
Stk$[I]= ""
EXIT FOR
END IF
NEXT
i = I+1
FOR j = i TO Ndx
CONCAT (VV$,Stk$[j])
NEXT
FOR j = 2 TO W
CONCAT (RR$,Stk$[j])
NEXT
i = W+1
FOR j = i TO I
CONCAT (WW$,Stk$[j])
NEXT
lszTmp$ = "=replace$(" + VV$ + "," + RR$ + "," + WW$ + ")"
FastLexer(VV$," ()","")
lszTmp$ = Stk$[Ndx] + lszTmp$
CALL XParse(lszTmp$)
CALL TokenSubstitutions
CALL Emit
Ndx = 0
EXIT SUB
END IF
CASE 27
SELECT CASE Keyword$
'**************************
CASE "$ifndef"
Stk$[1] = "~ifndef"
InConditional++
'**************************
CASE "$if","$ifdef"
Stk$[1] = "~if"
InConditional++
'**************************
CASE "$else"
Stk$[1] = "~else"
'**************************
CASE "$elseif"
Stk$[1] = "~elseif"
'**************************
CASE "$endif"
Stk$[1] = "~endif"
InConditional--
'**************************
CASE "$vscroll"
Stk$[1] = "~vscroll"
'**************************
'**************************
CASE "$hscroll"
Stk$[1] = "~hscroll"
'**************************
'**************************
CASE "$cpp"
Ndx = 0
UseCpp = TRUE
IncludeCount=IncludeCount+5
'**************************
END SELECT
EXIT SUB
END SELECT
IF iMatchWrd(Stk$[2],"formload") THEN
Stk$[2] = "FormLoad"
END IF
IFCond = 0
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"if") THEN IFCond = i + 1
IF iMatchWrd(Stk$[i],"then") AND iMatchWrd(Stk$[i+1],"if") THEN
FOR j = i + 2 TO Ndx
IF iMatchWrd(Stk$[j],"else") THEN
EXIT FOR
END IF
NEXT
IF j > Ndx THEN ' safe to transform
FOR j = i TO IFCond + 1 STEP -1
Stk$[j] = Stk$[j - 1]
NEXT
Stk$[IFCond] = "("
i++
Stk$[i] = ")"
i++
FOR j = Ndx TO i STEP -1
Stk$[j + 2] = Stk$[j]
NEXT
Ndx++
Ndx++
Stk$[i] = "&&"
i++
Stk$[i] = "("
i++
FOR i = i TO Ndx
IF iMatchWrd(Stk$[i],"then") THEN
Ndx++
FOR j = Ndx TO i STEP -1
Stk$[j] = Stk$[j - 1]
NEXT
Stk$[i] = ")"
EXIT FOR
END IF
NEXT
i--
ELSE
EXIT FOR
END IF
END IF
NEXT
END SUB ' Transforms
SUB Parse(Arg$)
'****************
DIM RAW A
DIM RAW CommaCnt
DIM RAW Tmp
DIM RAW i
DIM RAW j
DIM RAW k
DIM RAW lszTmp$
DIM RAW L_Stk_1$
DIM RAW L_Stk_2$
DIM RAW Var1$
DIM RAW Plus2Amp = 0
'****************
L_Stk_1$ = ""
L_Stk_2$ = ""
lszTmp$ = ""
Var1$ = ""
'****************
CALL XParse(Arg$)
PassOne = 0
FOR Tmp = 1 TO Ndx-1
DIM RAW vt
IF Stk$[Tmp] = "+" THEN
vt = DataType(Stk$[Tmp+1])
IF vt = vt_STRVAR OR vt = vt_STRLIT THEN
Stk$[Tmp] = "&"
Plus2Amp = TRUE
ELSE
vt = DataType(Stk$[Tmp-1])
IF vt = vt_STRVAR OR vt = vt_STRLIT THEN
Stk$[Tmp] = "&"
Plus2Amp = TRUE
END IF
END IF
END IF
NEXT
'AND Stk$[1] <> "BCX_RetStr$"
IF ( iMatchNQ(Arg$,"&") OR Plus2Amp ) AND NOT iMatchWrd(Stk$[1],"function") THEN
Use_Join = UseFlag = TRUE
j = 0
k = 0
FOR Tmp = 1 TO Ndx-1
A = CheckLocal(Stk$[Tmp], &i)
IF A = vt_UNKNOWN THEN A = CheckGlobal(Stk$[Tmp], &i)
IF A = vt_STRUCT OR A = vt_UDT OR A = vt_UNION THEN 'added vt_UNION 4.40
j = 1
END IF
IF Stk$[Tmp] = "&" THEN
A = DataType(Stk$[Tmp+1])
IF A = vt_STRVAR OR A = vt_STRLIT THEN
k = 1
ELSE
A = DataType(Stk$[Tmp-1])
IF A = vt_STRVAR OR A = vt_STRLIT THEN
k = 1
END IF
END IF
END IF
NEXT
IF k THEN
CALL ProcNonPara(j)
Src$ = ""
FOR i = 1 TO Ndx
IF Stk[i][0] THEN
Src$ = Src$ + Stk$[i] + " "
END IF
NEXT
CALL XParse(Src$)
END IF
END IF
'********************************************************************
' At this point we have a fresh set of Stk$[] values, totaling Ndx
' Start handling some unique situations
'********************************************************************
CALL TokenSubstitutions
IF Ndx = 0 THEN EXIT SUB
CALL Transforms
IF Ndx = 0 THEN EXIT SUB
'***********************************************************
'Moved here by Mike H. Was being applied too early.
'causing lines with multiple statements to not receive the
'conversion. i.e. sp->lpVtbl->Release(sp) : sp = NULL
'***********************************************************
IF UseCpp THEN
IF iMatchNQ(Src$,"->lpVtbl") THEN
FOR INTEGER i= 1 TO Ndx
IF iMatchRgt(Stk$[i],"->lpVtbl") THEN
Stk$[i] = EXTRACT$(Stk$[i],"->lpVtbl")
IF (Stk$[i+3]=Stk$[i-1] OR Stk$[i+3]=Stk$[i]) AND Stk$[i+3] <> ")" THEN
Stk$[i+3] = ""
IF Stk$[i+4] = "," THEN Stk$[i+4] = ""
END IF
END IF
NEXT
END IF
END IF
'***********************************************************
'Modification to allow 2 names as function types
'***********************************************************
IF iMatchWrd(Stk$[1],"function") THEN
IF iMatchWrd(Stk$[Ndx-2],"as") AND Stk$[Ndx] <> ")" THEN
IF NOT iMatchWrd(Stk$[Ndx],"export") AND NOT iMatchWrd(Stk$[Ndx],"stdcall") THEN
Stk$[Ndx-1] = Stk$[Ndx-1] + " " + Stk$[Ndx]
Ndx--
END IF
END IF
END IF
'***********************************************************
'Modification to allow 2 names as argument types in sub or function
'***********************************************************
IF iMatchWrd(Stk$[1],"function") OR iMatchWrd(Stk$[1],"sub") THEN
DIM RAW offset
DIM RAW LastBrk = Ndx - 2
FOR i = Ndx TO 3 STEP -1
IF Stk$[i] = ")" THEN
LastBrk = i
EXIT FOR
END IF
NEXT
FOR i = 3 TO LastBrk
offset = 2
IF iMatchWrd(Stk$[i],"as") AND (i < LastBrk) AND Stk$[i + offset] <> "=" THEN
IF iMatchWrd(Stk$[i+1],"function") THEN offset = 3
IF NOT INCHR(Stk$[i + offset],")") AND NOT INCHR(Stk$[i + offset],",") THEN
IF LEN(Stk$[i + offset]) <> 0 AND NOT iMatchWrd(Stk$[i + 3],"as") THEN
Stk$[i+offset-1] = Stk$[i+offset-1] + " " + Stk$[i+offset]
Stk$[i + offset] = ""
END IF
END IF
END IF
NEXT
END IF
'***********************************************************
IF InTypeDef THEN
Var1$ = LCASE$(Stk$[1])
IF Var1$ <> "end" AND Var1$ <> "dim" AND Var1$ <> "declare" AND Var1$ <> "type" AND Var1$ <> "union" THEN
IF Stk$[2] <> "(" AND Stk$[1] <> "(" THEN
FOR i = Ndx TO 1 STEP -1
Stk$[i+1] = Stk$[i]
NEXT
Stk$[1] = "dim"
Ndx++
END IF
END IF
END IF
'DynaCall Handler
IF NOT iMatchWrd(Stk$[1],"declare") THEN
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"lib") THEN
IF Stk$[i-1] = "(" AND (DataType(Stk$[i+1]) = vt_STRLIT OR DataType(Stk$[i+1]) = vt_STRVAR) THEN
j = GetNumArgs(i+2)
lszTmp$ = "BCX_DynaCall"
IF NOT iMatchWrd(Stk$[1],"print") THEN 'print does its own casting
IF DataType(Stk$[i-2]) = vt_STRVAR OR DataType(Stk$[1]) = vt_STRVAR THEN
lszTmp$ = "(char*)" & lszTmp$
END IF
END IF
Var1$ = RIGHT$(Stk$[i-2], 1)
IF INCHR ("!$#¦%", Var1$) THEN
CONCAT (lszTmp$, Var1$)
Stk$[i] = ENC$(LEFT$(Stk$[i-2], LEN(Stk$[i-2]) - 1))
ELSE
Stk$[i] = ENC$(Stk$[i-2])
END IF
Stk$[i-2] = lszTmp$
FOR B = Ndx+3 TO i+3 STEP -1
Stk$[B] = Stk$[B-3]
NEXT
Stk$[i+2] = Stk$[i+1]
Stk$[i+1] = ","
Stk$[i+3] = ","
Stk$[i+4] = LTRIM$(STR$(j))
Stk$[i+5] = IIF$(j, ",", ")")
INCR Ndx, 3
Use_Dynacall = UseFlag = TRUE
END IF
END IF
NEXT
END IF
'****************[ Exponentiation Operator Handler ]******************
IF INCHR(Arg$,"^") THEN
DIM RAW lp = 0
DIM RAW rp = 0
Test = FALSE
FOR i = 1 TO Ndx
IF Stk$[i] = "^" THEN
Test = TRUE
IF Stk$[i+1] = "-" THEN
Ndx++
FOR A = Ndx TO i+2 STEP -1
Stk$[A] = Stk$[A-1]
NEXT
Stk$[i+1] = "("
B = i+3
IF Stk$[B] = "(" THEN
lp=0
rp=0
DO
IF Stk$[B] = "(" THEN lp++
IF Stk$[B] = ")" THEN rp++
B++
LOOP UNTIL lp = rp
Ndx++
j = B+1
FOR A = Ndx TO j STEP -1
Stk$[A] = Stk$[A-1]
NEXT
Stk$[B] = ")"
ELSE
B=i+4
IF INCHR("[",Stk$[B]) THEN
DO
B++
LOOP UNTIL INCHR("]",Stk$[B])
Ndx++
j = B+2
FOR A = Ndx TO j STEP -1
Stk$[A] = Stk$[A-1]
NEXT
Stk$[B+1] = ")"
ELSE
IF INCHR("(",Stk$[B]) THEN
DO
B++
LOOP UNTIL INCHR(")",Stk$[B])
Ndx++
j = B+2
FOR A = Ndx TO j STEP -1
Stk$[A] = Stk$[A-1]
NEXT
Stk$[B+1] = ")"
ELSE
Ndx++
j = B+1
FOR A = Ndx TO j STEP -1
Stk$[A] = Stk$[A-1]
NEXT
Stk$[B] = ")"
END IF
END IF
END IF
END IF
END IF
NEXT
IF Test THEN
FOR i = 1 TO Ndx
IF Stk$[i] = "^" THEN
A = i - 1
B = 0
WHILE Stk$[A] <> "="
IF Stk$[A] = "]" THEN B++
IF Stk$[A] = ")" THEN B++
IF Stk$[A] = "[" THEN B--
IF Stk$[A] = "(" THEN B--
IF B = 0 THEN EXIT WHILE
A--
WEND
IF Stk$[A] = "[" THEN A--
IF Stk$[A] = "=" THEN A++
IF Stk$[A] = "(" THEN
B = DataType(Stk$[A-1]) ' check if it's a function
IF Stk$[A-1] <> "print" AND _
(B = vt_INTEGER OR B = vt_SINGLE OR B = vt_DOUBLE) THEN
A--
END IF
END IF
Arg$ = "pow("
B = A - 1
WHILE B > 0
Arg$ = Stk$[B] + " " + Arg$
B--
WEND
FOR B = A TO i - 1
Arg$ = Arg$ + Stk$[B] + " "
NEXT
CONCAT (Arg$, ",")
A = i + 1
B = DataType(Stk$[A])
IF (Stk$[A + 1] = "(" OR Stk$[A + 1] = "[") AND _
(B = vt_INTEGER OR B = vt_SINGLE OR B = vt_DOUBLE) THEN
A++
END IF
B = 0
WHILE A <= Ndx
IF Stk$[A] = "[" THEN B++
IF Stk$[A] = "(" THEN B++
IF Stk$[A] = "]" THEN B--
IF Stk$[A] = ")" THEN B--
IF NOT B THEN EXIT DO
A++
WEND
FOR B = i + 1 TO A
Arg$ = Arg$ + Stk$[B] + " "
NEXT
CONCAT(Arg$,")")
A++
WHILE A <= Ndx
Arg$ = Arg$ + Stk$[A] + " "
A++
WEND
EXIT FOR
END IF
NEXT
CALL Parse(Arg$)
END IF
END IF
'*****************************************************
L_Stk_1$ = LCASE$(Stk$[1]) ' Performance Optimizer
L_Stk_2$ = LCASE$(Stk$[2]) ' Performance Optimizer
'*****************************************************
IF L_Stk_1$ = "$dll" THEN
MakeDLL = TRUE
Ndx = 0
IF L_Stk_2$ = "stdcall" THEN
UseStdCall = TRUE
END IF
IF NoDllMain THEN
EXIT SUB
END IF
FPRINT Outfile,""
FPRINT Outfile,"__declspec(dllexport) BOOL WINAPI DllMain (HINSTANCE hInst, DWORD Reason, LPVOID Reserved)"
FPRINT Outfile,"{"
FPRINT Outfile," switch (Reason)"
FPRINT Outfile," {"
FPRINT Outfile," case DLL_PROCESS_ATTACH:"
FPRINT Outfile," BCX_hInstance = hInst;"
FPRINT Outfile," break;"
FPRINT Outfile," case DLL_PROCESS_DETACH:"
FPRINT Outfile," break;"
FPRINT Outfile," case DLL_THREAD_ATTACH:"
FPRINT Outfile," break;"
FPRINT Outfile," case DLL_THREAD_DETACH:"
FPRINT Outfile," break;"
FPRINT Outfile," }"
FPRINT Outfile," return TRUE;"
FPRINT Outfile,"}\n\n"
Src$ = "GLOBAL BCX_hInstance AS HINSTANCE"
Parse(Src$)
Emit()
EXIT SUB
END IF
IsCallBack = 0
'******************************
IF iMatchWrd(Stk$[Ndx],"callback") THEN
IsCallBack = 1
Ndx--
END IF
'******************************
IF L_Stk_1$ = "open" THEN
FOR A = 1 TO Ndx
IF iMatchWrd(Stk$[A],"binary") THEN
EXIT FOR
END IF
NEXT
IF A < Ndx THEN
A++
Var1$ = LCASE$(Stk$[A])
IF Var1$ = "new" THEN
Stk$[A-1]= "binarynew"
FOR i = A+1 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
IF Var1$ = "append" THEN
Stk$[A-1]= "binaryappend"
FOR i = A+1 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
IF Var1$ = "input" THEN
Stk$[A-1]= "binaryinput"
FOR i = A+1 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
IF Var1$ = "output" THEN
Stk$[A-1]= "binaryoutput"
FOR i = A+1 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
END IF
END IF
IF L_Stk_1$ = "free" AND L_Stk_2$ = "dynamic" THEN
Stk$[1]= "dynafree"
FOR i = 3 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
IF L_Stk_1$ = "option" AND L_Stk_2$ = "base" THEN
OptionBase = VAL(Stk$[3])
Ndx = 0
EXIT SUB
END IF
'******************************
IF L_Stk_1$ = "dim" THEN
IF L_Stk_2$ = "shared" OR _
L_Stk_2$ = "dynamic" OR _
L_Stk_2$ = "raw" OR _
L_Stk_2$ = "local" OR _
L_Stk_2$ = "auto" OR _
L_Stk_2$ = "register" OR _
L_Stk_2$ = "static" THEN
Stk$[1] = L_Stk_2$
L_Stk_1$ = L_Stk_2$
FOR i = 3 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
END IF
'******************************
IF L_Stk_1$ = "public" THEN
IF L_Stk_2$ = "function" OR L_Stk_2$ = "sub" THEN
Stk$[1] = L_Stk_2$
L_Stk_1$ = L_Stk_2$
FOR i = 3 TO Ndx
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
END IF
END IF
'******************************
' creates a static function for use in $PROJECTs
IF L_Stk_1$ = "private" THEN
IF L_Stk_2$ = "function" OR L_Stk_2$ = "sub" THEN
Use_Static = TRUE
Stk$[1] = L_Stk_2$
L_Stk_1$ = L_Stk_2$
FOR i = 3 TO Ndx
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
END IF
END IF
'******************************
IF L_Stk_1$ = "onexit" THEN
IF L_Stk_2$ = "sub" THEN
Use_ExitCode = Use_Proto = TRUE
INCR ExitNdx
ExitSub$[ExitNdx] = Stk$[3]
Stk$[1] = L_Stk_2$
L_Stk_1$ = L_Stk_2$
FOR i = 3 TO Ndx
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
END IF
END IF
'******************************
IF L_Stk_1$ = "onstart" THEN
IF L_Stk_2$ = "sub" THEN
Use_StartupCode = Use_Proto = TRUE
INCR StartNdx
StartSub$[StartNdx] = Stk$[3]
Stk$[1] = L_Stk_2$
L_Stk_1$ = L_Stk_2$
FOR i = 3 TO Ndx
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
END IF
END IF
'******************************
IF L_Stk_1$ = "overloaded" AND L_Stk_2$ = "function" THEN
Stk$[1] = "overloadedfunction"
L_Stk_1$ = "overloadedfunction"
FOR i = 3 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
'******************************
IF L_Stk_1$ = "overloadedfunction" AND Stk$[2] <> "=" THEN
OkayToSend = TRUE
END IF
'******************************
IF L_Stk_1$ = "overloaded" AND L_Stk_2$ = "sub" THEN
Stk$[1]= "overloadedsub"
FOR i = 3 TO Ndx
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
END IF
'******************************
IF L_Stk_1$ = "function" AND iMatchWrd(Stk[3],"optional") THEN
Stk$[1]= "optfunction"
L_Stk_1$ = "optfunction"
FOR i = 4 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
'******************************
IF L_Stk_1$ = "optfunction" AND Stk$[2] <> "=" THEN
OkayToSend = TRUE
END IF
'******************************
IF L_Stk_1$ = "sub" AND iMatchWrd(Stk[3],"optional") THEN
L_Stk_1$ = "optsub"
Stk$[1]= "optsub"
FOR i = 4 TO Ndx
Stk$[i-1]= Stk$[i]
NEXT
Ndx--
END IF
'******************************
IF L_Stk_1$ = "end" AND Stk$[2] <> "=" THEN
Stk$[1]= L_Stk_1$ + L_Stk_2$
Ndx = 1
END IF
'******************************
IF L_Stk_1$ = "function" AND Stk$[2] <> "=" THEN
OkayToSend = TRUE
END IF
'******************************
IF L_Stk_1$ = "midstr" THEN
CommaCnt = 0
FOR i = 1 TO Ndx
IF Stk$[i] = "," THEN
INCR CommaCnt
ELSEIF Stk$[i]= "=" THEN
IF CommaCnt < 2 THEN
Stk$[i] = "-1,"
ELSE
Stk$[i]= ""
END IF
Stk$[i-1]= ","
Ndx++
Stk$[Ndx]= ")"
EXIT FOR
END IF
NEXT
END IF
'******************************
' BEGIN BCX_GUI MODIFICATIONS
IF L_Stk_1$ = "endevents" OR L_Stk_1$ = "endmdievents" OR L_Stk_1$ = "endmdichildevents" THEN
' END BCX_GUI MODIFICATIONS
IF Use_Vscroll OR Use_Hscroll THEN
Use_Min = Use_Max = TRUE
'========================================================================
Src$ = "GLOBAL BCX_siX AS SCROLLINFO" : Parse(Src$) : Emit()
Src$ = "GLOBAL BCX_siY AS SCROLLINFO" : Parse(Src$) : Emit()
Src$ = "GLOBAL BCX_DynaScroll AS INTEGER" : Parse(Src$) : Emit()
END IF
IF Use_Vscroll OR Use_Hscroll THEN
IF Use_Project THEN
FPRINT Outfile," int BCX_ViewWidth =", Use_Hscroll, ";"
FPRINT Outfile," int BCX_ViewHeight =", Use_Vscroll, ";"
FPRINT Outfile," int BCX_SmallChangeX;"
FPRINT Outfile," int BCX_SmallChangeY;"
FPRINT Outfile," int BCX_LargeChangeX;"
FPRINT Outfile," int BCX_LargeChangeY;"
FPRINT Outfile," int BCX_ScrollInit;"
ELSE
FPRINT Outfile," static int BCX_ViewWidth =", Use_Hscroll, ";"
FPRINT Outfile," static int BCX_ViewHeight =", Use_Vscroll, ";"
FPRINT Outfile," static int BCX_SmallChangeX;"
FPRINT Outfile," static int BCX_SmallChangeY;"
FPRINT Outfile," static int BCX_LargeChangeX;"
FPRINT Outfile," static int BCX_LargeChangeY;"
FPRINT Outfile," static int BCX_ScrollInit;"
END IF
FPRINT Outfile,""
FPRINT Outfile," if(!BCX_ScrollInit)"
FPRINT Outfile," {"
FPRINT Outfile," BCX_siY.cbSize=sizeof(BCX_siY);"
FPRINT Outfile," BCX_siX.cbSize=sizeof(BCX_siX);"
FPRINT Outfile," BCX_siY.fMask=SIF_ALL;"
FPRINT Outfile," BCX_siX.fMask=SIF_ALL;"
FPRINT Outfile," BCX_siX.nMax=BCX_ViewWidth;"
FPRINT Outfile," BCX_siY.nMax=BCX_ViewHeight;"
FPRINT Outfile," BCX_SmallChangeX=1;"
FPRINT Outfile," BCX_LargeChangeX=20;"
FPRINT Outfile," BCX_SmallChangeY=1;"
FPRINT Outfile," BCX_LargeChangeY=20;"
FPRINT Outfile," BCX_siY.nPage=1;"
FPRINT Outfile," BCX_siX.nPage=1;"
FPRINT Outfile," SetScrollInfo(hWnd,SB_VERT,&BCX_siY,TRUE);"
FPRINT Outfile," SetScrollInfo(hWnd,SB_HORZ,&BCX_siX,TRUE);"
FPRINT Outfile," BCX_DynaScroll=TRUE;"
FPRINT Outfile," BCX_ScrollInit=TRUE;"
FPRINT Outfile," }"
FPRINT Outfile," if(Msg==WM_HSCROLL||WM_VSCROLL||WM_SIZE)"
FPRINT Outfile," {"
FPRINT Outfile," BCX_Scroll(hWnd,Msg,wParam,lParam,BCX_LargeChangeX,"
FPRINT Outfile," BCX_LargeChangeY,BCX_SmallChangeX,BCX_SmallChangeY,"
FPRINT Outfile," BCX_ViewWidth,BCX_ViewHeight,BCX_DynaScroll);"
FPRINT Outfile," }"
END IF
IF NOT Use_BCX_Class_Info THEN
Use_BCX_Class_Info = TRUE
CALL AddGlobal("BCX_ScaleX", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ScaleY", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ClassName",vt_STRVAR, 0,"",0,0,0)
END IF
' BEGIN BCX_GUI MODIFICATIONS
IF L_Stk_1$ <> "endmdichildevents" AND Use_MainEvent THEN
FPRINT Outfile," if(Msg==WM_DESTROY)"
FPRINT Outfile," {"
IF Use_MainEvent = TRUE THEN
FPRINT Outfile," PostQuitMessage(0);"
FPRINT Outfile," return 0;"
Use_MainEvent = FALSE
END IF
FPRINT Outfile," }"
END IF
IF L_Stk_1$ = "endevents" THEN
FPRINT Outfile," return DefWindowProc(hWnd,Msg,wParam,lParam);"
ELSEIF L_Stk_1$ = "endmdievents" THEN
FPRINT Outfile," return DefFrameProc(hWnd,BCX_hwndMDIClient,Msg,wParam,lParam);"
ELSEIF L_Stk_1$ = "endmdichildevents" THEN
FPRINT Outfile," return DefMDIChildProc(hWnd,Msg,wParam,lParam);"
END IF
FPRINT Outfile,"}\n\n"
' END BCX_GUI MODIFICATION
CALL BumpDown
Ndx = 0
L_Stk_1$ = ""
END IF
IF L_Stk_1$ = "elseif" THEN
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
FPRINT Outfile,Scoot$,"else ";
NoScoot = 1
Arg$ = "if "
FOR i = 2 TO Ndx
IF Stk$[i] = "||" THEN
Stk$[i] = "or"
END IF
IF Stk$[i] = "&&" THEN
Stk$[i] = "and"
END IF
Arg$ = Arg$ + Stk$[i] + " "
NEXT
CALL Parse(Arg$)
END IF
'******************************
IF Stk$[2]= ":" THEN
IF Ndx = 2 THEN
Stk$[1]= UCASE$(Stk$[1]) + ":" 'preserve the GOTO labels
Ndx = 1
EXIT SUB
END IF
END IF
'******************************
IF LCASE$(Stk$[3])= "createwindow" THEN 'HELPER
Comma = 0
FOR A = 4 TO Ndx
IF Stk$[A]= "," THEN Comma++
IF Stk$[A]= "," THEN
IF Comma = 8 THEN
Stk$[A]= ",(HMENU)"
Comma++
END IF
END IF
NEXT
END IF
'******************************
IF LCASE$(Stk$[3])= "createwindowex" THEN 'HELPER
Comma = 0
FOR A = 4 TO Ndx
IF Stk$[A]= "," THEN Comma++
IF Stk$[A]= "," THEN
IF Comma = 9 THEN
Stk$[A]= ",(HMENU)"
Comma++
END IF
END IF
NEXT
END IF
'******************************
IF L_Stk_1$ = "case" AND L_Stk_2$ = "else" THEN
Ndx = 1
Stk$[1]= "caseelse"
END IF
'******************************
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"let") THEN
FOR j = i+1 TO Ndx
Stk$[j-1] = Stk$[j]
NEXT
Ndx--
END IF
NEXT
'******************************
IF Stk$[Ndx]= "*" THEN
Stk$[Ndx-1]= Stk$[Ndx-1] + "*"
Ndx--
END IF
'******************************
IF iMatchWrd(Stk$[3],"setwindowlong") THEN 'HELPER
Comma = 0
Stk$[3]= "(WNDPROC) SetWindowLong"
FOR A = 4 TO Ndx
IF Stk$[A]= "," THEN Comma++
IF Stk$[A]= "," THEN
IF Comma = 2 THEN
Stk$[A]= ",(LONG)"
Comma++
END IF
END IF
NEXT
EXIT SUB
END IF
'*************************************
' 4.29 Part of the new BYREF handler
'*************************************
' DIM RAW Byref_Flag=0
'
' FOR i = 1 TO Ndx
' IF iMatchWrd(Stk$[i],"byref") THEN
' ByrefVars[++ByrefCnt] = Stk$[i+1]
' FOR j = i TO Ndx
' IF Stk$[j+1] = "," OR Stk$[j+1] = ")" THEN
' Stk$[j] = "PTR"
' Byref_Flag = TRUE
' EXIT FOR
' END IF
' Stk$[j] = Stk$[j+1]
' NEXT
' END IF
' NEXT
'
' IF Byref_Flag THEN
' lszTmp$ = ""
' FOR i = 1 TO Ndx
' lszTmp$ = lszTmp$ + Stk$[i] + " "
' NEXT
' CALL Parse(lszTmp$)
' END IF
'************************************
' Allow an assumed single declaration?
' i.e. A$ becomes DIM A$
'************************************
' IF DataType(Stk$[1]) = vt_STRVAR THEN
' IF INCHR(Arg$,"=") = 0 THEN
' IF INCHR(Arg$,"-") = 0 THEN
' IF INCHR(Arg$,"+") = 0 THEN
' IF Ndx = 1 THEN
' CONCAT(Arg$,"[2048]")
' END IF
' Z$ = "dim " + Arg$
' CALL Parse(Z$)
' EXIT SUB
' END IF
' END IF
' END IF
' END IF
'************************************
IF TestState = TRUE THEN
IF LastCmd = 0 THEN
IF Stk$[1] = "*" THEN
Z$ = Clean$(Stk$[2])
ELSE
Z$ = Clean$(Stk$[1])
END IF
IF LEFT$(Z$,1) = "*" THEN Z$ = MID$(Z$,2)
i = INCHR(Z$,".")
IF i = 0 THEN i = INSTR(Z$,"->")
IF i > 0 THEN
IF WithCnt THEN
Z$ = WithVar$[WithCnt]
ELSE
Z$ = LEFT$(Z$, i - 1)
END IF
END IF
IF INCHR(Z$,"[") THEN Z$ = EXTRACT$(Z$,"[")
IF CheckLocal(Z$, &j) = vt_UNKNOWN THEN
IF CheckGlobal(Z$, &j) = vt_UNKNOWN THEN
Z$ = LCASE$(Z$)
IF Stk$[2] = "=" AND Z$ <> "functionreturn" AND Z$ <> "bcx_retstr" AND Z$ <> "end" THEN
Warning("Assignment before Declaration in Line " + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + ": " + Src$)
END IF
END IF
END IF
END IF
END IF
END SUB ' Parse
SUB CompStructVars(start)
'***************
DIM RAW DefID
DIM RAW F
DIM RAW GL
DIM RAW IsStPtr
DIM RAW Tmp
DIM RAW id = 0
DIM RAW idrcnt
DIM RAW i = 0
DIM RAW j = 0
DIM RAW k = 0
DIM RAW lszVar$
DIM RAW lt
DIM RAW pcnt
DIM RAW y$
STATIC idcnt
STATIC ids[64]
'****************
IF start = 1 THEN idcnt = 0
idrcnt = idcnt
Tmp = start
WHILE Tmp <= Ndx
GL = 0
i = CheckLocal(Stk$[Tmp], &id)
IF i = vt_STRUCT OR i = vt_UDT OR i = vt_UNION THEN 'added vt_UNION 4.40
IsStPtr = LocalVars[id].VarPntr
DefID = LocalVars[id].VarDef
GL = i
ELSE
i = CheckGlobal(Stk$[Tmp], &id)
IF i = vt_STRUCT OR i = vt_UDT OR i = vt_UNION THEN 'added vt_UNION 4.40
IsStPtr = GlobalVars[id].VarPntr
DefID = GlobalVars[id].VarDef
GL = i
END IF
END IF
IF GL THEN
lt = Tmp
IF IsStPtr AND Stk$[Tmp + 1] <> "[" THEN
IF Tmp > 2 THEN
IF Stk$[Tmp - 1] = "*" AND Stk$[Tmp - 2] = "(" THEN
lt = Tmp - 2
Stk$[lt] = "(*" + Stk$[Tmp]
Stk$[Tmp] = ""
Stk$[Tmp - 1] = ""
pcnt = 1
FOR i = Tmp TO Ndx
IF Stk$[i] = ")" THEN pcnt--
IF Stk$[i] = "(" THEN pcnt++
Stk$[lt] = Stk$[lt] + Stk$[i]
Stk$[i] = ""
IF pcnt = 0 THEN
EXIT FOR
END IF
NEXT
END IF
y$ = Stk$[Tmp + 1]
IF Stk$[Tmp - 1] = "(" AND (y$ = ")" OR y$ = "," OR y$ = "!=" OR y$ = "=") THEN
Tmp++
GOTO NxtToken
END IF
IF y$ = "(" OR (Stk$[Tmp-1] = "=" AND (y$ = "+" OR y$ = "-")) THEN
Tmp++
GOTO NxtToken
END IF
IF y$ = "[" THEN
Stk$[Tmp] = Stk$[Tmp] + y$
lt = Tmp
Tmp++
Stk$[Tmp] = ""
pcnt = 1
FOR i = Tmp TO Ndx
j = CheckGlobal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
END IF
j = CheckLocal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
END IF
IF LEFT$(Stk$[i],2) = "->" OR LEFT$(Stk$[i],1) = "." THEN
EXIT FOR
END IF
IF pcnt = 0 THEN
IF Stk$[i] = ")" OR Stk$[i] = "=" OR Stk$[i] = "," THEN
EXIT FOR
END IF
END IF
Stk$[lt] = Stk$[lt] + Stk$[i]
IF Stk$[i] = "]" THEN pcnt--
IF Stk$[i] = "[" THEN pcnt++
Stk$[i] = ""
IF pcnt = 0 THEN
EXIT FOR
END IF
NEXT
END IF
END IF
IF Tmp = 2 THEN
i = 1
IF Stk$[3] = "!=" OR Stk$[3] = "=" THEN
i = 0
END IF
IF Stk$[1] = "(" AND i THEN
Stk$[1] = "(" + Stk$[2]
Stk$[2] = ""
pcnt = 1
FOR i = 3 TO Ndx
j = CheckGlobal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
END IF
j = CheckLocal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
END IF
Stk$[1] = Stk$[1] + Stk$[i]
IF Stk$[i] = ")" THEN pcnt--
IF Stk$[i] = "(" THEN pcnt++
Stk$[i] = ""
IF Stk$[i] = ")" AND pcnt = 0 THEN
EXIT FOR
END IF
NEXT
END IF
END IF
ELSE
IF Stk$[Tmp-1] = "=" AND (Stk$[Tmp+1] = "+" OR Stk$[Tmp+1] = "-") THEN
Tmp++
GOTO NxtToken
END IF
IF Stk$[Tmp+1] = "[" THEN
lt = Tmp
Stk$[lt] = Stk$[lt] + "["
Tmp++
Stk$[Tmp] = ""
pcnt = 1
FOR i = Tmp TO Ndx
j = CheckGlobal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
IF INCHR(Stk$[i],"]") > 1 THEN pcnt--
END IF
j = CheckLocal(Stk$[i], &k)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(i)
IF INCHR(Stk$[i],"]") > 1 THEN pcnt--
END IF
Stk$[lt] = Stk$[lt] + Stk$[i]
IF Stk$[i] = "]" THEN pcnt--
IF Stk$[i] = "[" THEN pcnt++
Stk$[i] = ""
IF pcnt = 0 AND Stk$[i+1] <> "[" THEN
EXIT FOR
END IF
NEXT
END IF
END IF
DO
Check:
Tmp++
j = CheckGlobal(Stk$[Tmp], &i)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(Tmp)
END IF
j = CheckLocal(Stk$[Tmp], &i)
IF j = vt_STRUCT OR j = vt_UDT OR j = vt_UNION THEN 'added vt_UNION 4.40
CALL CompStructVars(Tmp)
END IF
j = 0
IF LEFT$(Stk$[Tmp],2) = "->" THEN
IF GL = vt_UDT THEN
lszVar$ = MID$(Stk$[Tmp],3)
ELSE
lszVar$ = Clean$(MID$(Stk$[Tmp],3))
END IF
Stk$[lt] = Stk$[lt] + "->" + lszVar$
Stk$[Tmp] = ""
j = 1
END IF
IF Stk[Tmp][0] = 46 THEN
IF GL = vt_UDT THEN
lszVar$ = MID$(Stk$[Tmp],2)
ELSE
lszVar$ = Clean$(MID$(Stk$[Tmp],2))
END IF
Stk$[lt] = Stk$[lt] + "." + lszVar$
Stk$[Tmp] = ""
j = 1
END IF
IF j = 1 THEN
FOR i = 0 TO TypeDefs[DefID].EleCnt - 1
IF lszVar$ = TypeDefs[DefID].Elements[i].ElementName$ THEN
SELECT CASE TypeDefs[DefID].Elements[i].ElementType
CASE vt_INTEGER
Stk$[lt] = Stk$[lt] + "%"
CASE vt_SINGLE
Stk$[lt] = Stk$[lt] + "!"
CASE vt_DOUBLE
Stk$[lt] = Stk$[lt] + "#"
CASE vt_LDOUBLE
Stk$[lt] = Stk$[lt] + "¦"
CASE vt_STRVAR, vt_CHAR
Stk$[lt] = Stk$[lt] + "$"
CASE vt_STRUCT,vt_UDT,vt_UNION
ids[idcnt] = DefID
idcnt++
DefID = TypeDefs[DefID].Elements[i].ElementID
GOTO Check
END SELECT
EXIT FOR
END IF
NEXT
lt++
Tmp++
F = Tmp
Tmp = lt
WHILE F <= Ndx
Stk$[lt] = Stk$[F]
Stk$[F] = ""
lt++
F++
WEND
IF idcnt THEN
idcnt--
DefID = ids[idcnt]
END IF
Ndx = lt - 1
IF start = 1 OR idrcnt < idcnt THEN
GOTO NxtToken
ELSE
EXIT SUB
END IF
END IF
IF Stk$[Tmp] = ":" THEN
Tmp++
GOTO NxtToken
END IF
IF Stk$[Tmp] = "[" _
OR Stk$[Tmp] = ")" _
OR Stk$[Tmp] = "," _
OR Stk$[Tmp] = "=" _
OR Stk$[Tmp] = ">" _
OR Stk$[Tmp] = "<" _
OR Stk$[Tmp] = "!=" _
OR Stk$[Tmp] = "==" _
OR Stk$[Tmp] = ";" _
OR Stk$[Tmp] = "&&" _
OR Stk$[Tmp] = "||" _
OR iMatchWrd(Stk$[Tmp],"then") _
OR iMatchWrd(Stk$[Tmp],"to") THEN GOTO NxtToken
Stk$[lt] = Stk$[lt] + Stk$[Tmp]
Stk$[Tmp] = ""
LOOP WHILE Tmp <= Ndx
END IF
Tmp++
NxtToken:
WEND
IF start = 1 THEN
FOR i = 1 TO Ndx
WHILE Stk$[i] = ""
FOR j = i TO Ndx
Stk$[j] = Stk$[j + 1]
NEXT
Ndx--
IF Ndx < i THEN EXIT LOOP
WEND
NEXT
FOR i = 1 TO Ndx
y$ = RIGHT$(Stk$[i],1)
IF (INCHR(Stk$[i], ".") OR INSTR(Stk$[i], "->")) AND INCHR("%!#¦$",y$) THEN
IF Stk$[i-1] <> "[" THEN
Stk$[i] = Clean$(Stk$[i]) + y$
ELSE
Stk$[i] = Clean$(Stk$[i])
END IF
END IF
NEXT
END IF
END SUB ' CompStructVars
SUB FuncSubDecs1(s$)
'*****************
DIM RAW i, j
'*****************
IF iMatchWrd(Stk$[1], s$) THEN
IF DataType(Stk$[2]) = vt_STRVAR THEN
Abort("Invalid " + s$ + "name")
END IF
END IF
FOR i = 1 TO Ndx
IF Stk$[i]= "[" AND Stk$[i+1]= "]" THEN
IF iMatchWrd(Stk$[i+2],"as") THEN
Stk$[i+3] = Stk$[i+3] + "*"
ELSEIF Stk$[i+2] = "[" THEN
j = i-1
WHILE i <= Ndx
IF iMatchWrd(Stk$[i],"as") THEN EXIT FOR
IF iMatchRgt(Stk$[j],"]") AND INCHR(",)=", Stk$[i]) THEN EXIT FOR
Stk$[j] = Stk$[j] + Stk$[i]
Stk$[i++] = ""
WEND
ITERATE
ELSE
IF DataType(Stk$[i-1]) = vt_STRVAR THEN
Stk$[i-1] = Stk$[i-1] + "[][2048]"
END IF
Stk$[i-1] = "*" + Stk$[i-1]
END IF
Stk$[i++] = "" : Stk$[i] = ""
END IF
NEXT
CALL RemEmptyTokens
IsExported = FALSE
IF iMatchWrd(Stk$[Ndx],"export") THEN
Ndx--
IsExported = TRUE
IF UseStdCall THEN
CallType$ = "__stdcall "
ELSE
CallType$ = "__cdecl "
END IF
END IF
END SUB ' FuncSubDecs1
SUB RemEmptyTokens()
DIM RAW i, j
FOR i = 1 TO Ndx
IF NOT *Stk[i] THEN
j = i + 1
WHILE NOT *Stk[j] AND (j < Ndx) : INCR j : WEND
IF NOT *Stk[j] THEN EXIT FOR
Stk$[i] = Stk$[j] : Stk$[j] = ""
END IF
NEXT i
Ndx = i-1
END SUB
SUB FuncSubDecs2(s$, method)
IF iMatchWrd(Stk$[1], s$) THEN
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
Abort("Attempted type assignment to " + s$)
END IF
VarCode.IsPtrFlag = 0
CurrentFuncType = vt_VOID
ELSE
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
CurrentFuncType = CheckType(Stk$[Ndx])
VarCode.Token$ = Stk$[2]
VarCode.AsToken$ = Stk$[Ndx]
VarCode.IsPtrFlag = TALLY(Stk$[Ndx],"*")
Stk$[Ndx] = ""
Stk$[Ndx-1] = ""
Ndx--
Ndx--
ELSE
CurrentFuncType = DataType(Stk$[2])
VarCode.Token$ = Stk$[2]
VarCode.IsPtrFlag = TALLY(Stk$[2],"*")
VarCode.AsToken$ = ""
END IF
END IF
VarCode.Proto$ = " ("
VarCode.Header$ = " ("
VarCode.Functype$ = ""
VarCode.Method% = method
VarCode.VarNo% = CurrentFuncType
CALL GetVarCode(&VarCode)
END SUB ' FuncSubDecs2
SUB FuncSubDecs3(varcode AS VARCODE PTR)
IF *Stk[Ndx-1] = ASC(".") THEN ' Allow Functions | Subs WITH one OR
varcode->Header$ = varcode->Header$ + "..." ' more "." TO produce the "..." needed
END IF
varcode->Header$ = RTRIM$(varcode->Header$)
IF iMatchRgt(varcode->Header$, ",") THEN
MID$(varcode->Header$, LEN(varcode->Header$)) = ")"
ELSE
CONCAT(varcode->Header$, ")")
END IF
REPLACE "()" WITH "(void)" IN varcode->Header$
varcode->Header$ = varcode->Functype$ + varcode->Token$ + varcode->Header$
IF varcode->Method% = 2 THEN
IF *Stk[Ndx-1] = ASC(".") THEN ' Allow Functions | Subs with one OR
varcode->Proto$ = varcode->Proto$ + "..." ' FOR variable argument declarations
END IF
varcode->Proto$ = RTRIM$(varcode->Proto$)
IF iMatchRgt(varcode->Proto$, ",") THEN
MID$(varcode->Proto$, LEN(varcode->Proto$)) = ")"
ELSE
CONCAT(varcode->Proto$, ")")
END IF
REPLACE "()" WITH "(void)" IN varcode->Proto$
varcode->Proto$ = varcode->Functype$ + varcode->Token$ + varcode->Proto$ + ";"
END IF
IF IsExported THEN
varcode->Proto$ = "C_EXPORT " + varcode->Proto$
varcode->Header$ = "C_EXPORT " + varcode->Header$
END IF
END SUB ' FuncSubDecs3
SUB GetTypeInfo(stk$, BYREF IsPointer, BYREF UdtIdx, BYREF vtCode, BYREF k)
DIM RAW Var1$
IsPointer = TALLY(stk$,"*")
Var1$ = REMOVE$(stk$,"*")
vtCode = CheckType(Var1$)
k = TypeDefsCnt
IF vtCode = vt_UNKNOWN THEN
CALL AddTypeDefs(Var1$, vt_UDT) 'windows def
vtCode = vt_UDT
END IF
UdtIdx = 0
IF vtCode = vt_STRUCT OR vtCode = vt_UNION OR vtCode = vt_UDT THEN
UdtIdx = DefsID(Var1$)
END IF
END SUB ' GetTypeInfo
SUB AddTypedefElement(WorkingTypeDefsCnt,ElType, EName$, EType$)
DIM RAW i
DIM TD AS UserTypeDefs PTR
TD = &(TypeDefs[WorkingTypeDefsCnt])
IF TD->EleCnt = MaxElements THEN Abort("Exceeded TYPE Element Limits.")
TD->Elements[TD->EleCnt].ElementType = ElType
IF ElType = vt_STRUCT OR ElType = vt_UNION OR ElType = vt_UDT THEN
i = DefsID(EType$)
ELSE
i = 0
END IF
TD->Elements[TD->EleCnt].ElementID = i
TD->Elements[TD->EleCnt].ElementName$ = EName$
TD->EleCnt = 1 + TD->EleCnt
END SUB ' AddTypedefElement
SUB HandleNonsense
DIM RAW i
FOR i = 1 TO Ndx ' tolerate nonsense like DIM A% as double
IF iMatchWrd(Stk$[i],"as") THEN Stk$[i - 1] = Clean$(Stk$[i - 1])
IF OptionBase THEN ' This was the easiest way I could see to do this!
IF Stk$[i] = "[" THEN Stk$[i+1] = LTRIM$(STR$(OptionBase)) + "+" + Stk$[i+1]
END IF
NEXT
END SUB ' HandleNonsense
SUB ValidVar(v$)
DIM RAW ZZ$
IF NOT isalpha(*v$) AND *v$ <> ASC("_") THEN
Abort("Invalid String Variable Name")
END IF
IF RestrictedWords(v$) AND TestState THEN
ZZ$ = "Variable " + v$ + " on line"
ZZ$ = ZZ$ + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + " is a Restricted Word"
CALL Warning(ZZ$)
END IF
END SUB ' ValidVar
SUB PointerFix
Stk$[Ndx-1] = Stk$[Ndx-1] + Stk$[Ndx]
Stk[Ndx][0] = 0
Ndx--
WHILE TALLY(Stk$[Ndx],"*") = LEN(Stk$[Ndx])
Stk$[Ndx-1] = Stk$[Ndx-1] + Stk$[Ndx]
Stk[Ndx][0] = 0
Ndx--
WEND
END SUB ' PointerFix
SUB DimDynaString(SVar$, DG, s)
DIM RAW A
DIM RAW DS$
DS$ = "if(" + SVar$ + ")free(" + SVar$ + ");"
IF InFunc AND (IsLocal OR IsDim OR IsRaw OR IsAuto OR IsRegister) AND DG = 0 THEN
LocalDynaCnt++
DynaStr$[LocalDynaCnt] = DS$
IF IsAuto THEN
FPRINT Outfile,Scoot$ ;"auto char *";SVar$;";"
ELSEIF IsRegister THEN
FPRINT Outfile,Scoot$ ;"register char *";SVar$;";"
ELSE
FPRINT Outfile,Scoot$ ;"char *";SVar$;";"
END IF
CALL AddLocal(SVar$, vt_CHAR, 0,"",1,0)
ELSE
IF Use_GenFree THEN
GlobalDynaCnt++
GlobalDynaStr$[GlobalDynaCnt] = DS$
END IF
IF DG = 2 THEN
CALL AddGlobal(SVar$, vt_CHAR, 0,"",1,0,1)
ELSE
IF s THEN
CALL AddGlobal(SVar$, vt_CHAR, 0,"",1,0,2)
ELSE
CALL AddGlobal(SVar$, vt_CHAR, 0,"",1,0,0)
END IF
END IF
END IF
IF DG <> 2 THEN
FPRINT Outfile,Scoot$ ; SVar$ ; "=(char*)calloc(256+";
FOR A = 4 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,",1);"
END IF
END SUB ' DimDynaString
'
' handles dimensioning class object with
' constructor code:
' dim c(parm1, parm2, parm...) AS CObject
FUNCTION CObjectTest
DIM RAW IsCObject = FALSE
IF LCASE$(Stk$[Ndx]) = "cobject" THEN
IsCObject = TRUE
Stk$[Ndx] = ""
Stk$[Ndx-1] = ""
END IF
FUNCTION = IsCObject
END FUNCTION
SUB DimCObject()
END SUB
'
FUNCTION SubFuncTest
DIM RAW IsSubOrFuncPtr = FALSE
IF iMatchWrd(Stk$[Ndx],"sub") THEN
IsSubOrFuncPtr = 1
Stk$[Ndx] = ""
Stk$[Ndx-1] = ""
END IF
IF iMatchWrd(Stk$[Ndx-1],"function") THEN
IsSubOrFuncPtr = 2
Stk$[Ndx-1] = ""
Stk$[Ndx-2] = ""
END IF
FUNCTION = IsSubOrFuncPtr
END FUNCTION ' SubFuncTest
SUB DimSubFunc(SF, DG, s)
'******************************
DIM RAW CVar$
DIM RAW IsPointer = 0
DIM RAW WorkingTypeDefsCnt = 0
DIM RAW id = 0
DIM RAW i
DIM RAW j
DIM RAW lszTmp$
DIM RAW vt = 0
DIM RAW w = 0
'******************************
CVar$ = Clean$(Stk$[2])
IsPointer = TALLY(Stk$[Ndx],"*")
DimType$ = ""
lszTmp$ = ""
FOR i = 2 TO Ndx-2
IF i > 2 THEN
IF iMatchWrd(Stk$[i+1],"as") THEN
FOR j = i+2 TO Ndx-2
IF Stk$[j] = "," OR Stk$[j] = ")" THEN
EXIT FOR
END IF
NEXT
CONCAT(DimType$, Stk$[i+2])
i = j-1
ELSE
j = DataType(Stk$[i])
IF j <> vt_UNKNOWN THEN
CONCAT(DimType$, GetVarTypeName$(j))
ELSE
CONCAT(DimType$, Stk$[i])
END IF
END IF
END IF
CONCAT(lszTmp$, Stk$[i])
NEXT
IF SF = 1 THEN
vt = vt_VOID
id = 0
Var$ = ""
ELSE
Var$ = REMOVE$(Stk$[Ndx],"*")
GetTypeInfo(Var$, &w, &id, &vt, &WorkingTypeDefsCnt)
END IF
IF InFunc OR InTypeDef THEN
IF IsRaw = TRUE THEN
IF vt = vt_VOID THEN
FPRINT Outfile,Scoot$,"void ";
ELSE
FPRINT Outfile,Scoot$,Stk$[Ndx];" ";
END IF
ELSE
IF vt = vt_VOID THEN
IF IsRegister THEN
FPRINT Outfile,Scoot$,"register void ";
ELSE
IF InTypeDef THEN
FPRINT Outfile,Scoot$, "void ";
ELSE
FPRINT Outfile,Scoot$,"static void ";
END IF
END IF
ELSEIF IsAuto THEN
FPRINT Outfile,Scoot$,"auto "; Stk$[Ndx] ; " ";
ELSEIF IsRegister THEN
FPRINT Outfile,Scoot$,"register "; Stk$[Ndx] ; " ";
ELSE
IF InTypeDef THEN
FPRINT Outfile,Scoot$,Stk$[Ndx] ; " ";
ELSE
FPRINT Outfile,Scoot$,"static "; Stk$[Ndx] ; " ";
END IF
END IF
IF InTypeDef THEN
CALL AddTypedefElement(WorkingTypeDefsCnt,vt, CVar$, Var$)
END IF
END IF
IF InFunc AND NOT InTypeDef THEN
IF DG = 0 THEN
CALL AddLocal(CVar$, vt, id, DimType$, IsPointer, SF)
ELSEIF DG = 1 THEN
CALL AddGlobal(CVar$, vt, id, DimType$, IsPointer, SF,0)
ELSE
CALL AddGlobal(CVar$, vt, id, DimType$, IsPointer, SF,1)
END IF
END IF
i = INCHR(lszTmp$, "(")
T$ = "(*" + LEFT$(lszTmp$, i-1) + ")" + MID$(lszTmp$, i)
FPRINT Outfile,Clean$(T$); ";"
IF NOT InTypeDef AND NOT IsStatic AND NOT IsRaw AND NOT IsRegister AND DG <> 2 THEN
T$ = Clean$(EXTRACT$(lszTmp$,"("))
FPRINT Outfile,Scoot$,"memset(&";T$;",0,sizeof(";T$;"));"
END IF
ELSE
IF DG <> 2 THEN
IF s THEN
CALL AddGlobal(CVar$, vt, id, DimType$, IsPointer, SF,2)
ELSE
CALL AddGlobal(CVar$, vt, id, DimType$, IsPointer, SF,0)
END IF
ELSE
CALL AddGlobal(CVar$, vt, id, DimType$, IsPointer, SF,1)
END IF
END IF
END SUB ' DimSubFunc
SUB Emit
'******************************
DIM RAW HasStorage = 0
DIM RAW A,i,j,Tmp
DIM RAW FuncRetnFlag
DIM RAW IsPointer = 0
DIM RAW VType
DIM RAW WorkingTypeDefsCnt = 0
DIM RAW id = 0
DIM RAW k = 0
DIM RAW vt = 0
DIM RAW Arg$
DIM RAW CVar$
DIM RAW Keyword$
DIM RAW lszTmp$
DIM RAW Var1$
DIM RAW ZZ$
DIM RAW IsSubOrFuncPtr
DIM RAW dms
STATIC NoBreak
STATIC NoBreak2
'******************************
FuncRetnFlag = 0
lszTmp$ = ""
ZZ$ = ""
'******************************
'*************************************
' Resets the break suppression flag if
' any keyword follows other than these
'*************************************
Keyword$ = LCASE$(Stk$[1])
IF NoBreak2 AND NOT iMatchLft(Keyword$,"case") _
AND NOT iMatchWrd(Keyword$,"endselect") THEN
NoBreak2 = 0
END IF
'*********************
EmitAgain:
'*********************
IF Ndx = 0 THEN EXIT SUB
Statements++
IF iMatchRgt(Stk$[1], ":") THEN 'This Must Be A Label
FPRINT Outfile,""
FPRINT Outfile,UCASE$(Stk$[1]),";"
EXIT SUB
END IF
IF CurrentFuncType = vt_STRVAR AND InFunc AND OkayToSend THEN
'Keyword$ = LCASE$(Stk$[1])
'I'm trying to figure out what this extra test for declaration types is for?
'Any ideas?
'It seems the flags surrounding this isolate it. I have'nt gotten any bad
'output translating all the Progs I can find so far.
'IF NOT INSTR( "dim,local,dynamic,static,global,shared,auto,register,extern,!", Keyword$ ) THEN
'IF Keyword$ <> "dim" AND _
'Keyword$ <> "local" AND _
'Keyword$ <> "dynamic" AND _
'Keyword$ <> "static" AND _
'Keyword$ <> "global" AND _
'Keyword$ <> "shared" AND _
'Keyword$ <> "auto" AND _
'Keyword$ <> "register" AND _
'Keyword$ <> "extern" AND _
'Keyword$ <> "!" THEN
FPRINT Outfile,Scoot$,"char *BCX_RetStr={0};"
OkayToSend = 0
'END IF
END IF
IF WithCnt THEN
FOR i = 1 TO Ndx
IF LEFT$(Stk$[i],1) = "." AND NOT IsNumber(MID$(Stk$[i],2,1)) THEN
IF WithVar$[WithCnt] = "This" THEN
Stk$[i] = "->" + MID$(Stk$[i],2)
END IF
Stk$[i] = WithVar$[WithCnt] + Stk$[i]
WHILE (isalpha(*Stk[i+1]) OR *Stk[i+1] = ASC(".")) AND (i < Ndx)
INCR i
WEND
END IF
NEXT
END IF
'**************************
' SingleLineIfReEntry:
'**************************
Lookup$ = LCASE$(Stk$[1])
SELECT CASE Lookup$
'********************************************************************
CASE "fprint", "lprint", "sprint" 'LPRINT & FPRINT handle,{list}
'********************************************************************
DIM RAW IsLprint = FALSE
DIM RAW IsSprint = FALSE
IF iMatchWrd(Stk$[1],"lprint") THEN
Use_Proto = IsLprint = IsSprint = TRUE
Stk$[1] = "sprint"
Ndx++
FOR i = Ndx TO 1 STEP -1
Stk$[i] = Stk$[i-1]
NEXT
INCR Ndx,1
FOR i = Ndx TO 1 STEP -1
Stk$[i] = Stk$[i-1]
NEXT
Stk$[2] = "BcxPtr_Buffer"
Stk$[3] = ","
END IF
IF iMatchWrd(Stk$[1],"sprint") THEN
IsSprint = TRUE
END IF
IF IsNumber(Stk$[2]) THEN
Stk$[2] = "FP" + Stk$[2]
END IF
IF IsSprint THEN
Handle$ = Clean$(Stk$[2])
ELSE
IF LCASE$(Stk$[2]) = "stderr" THEN
Handle$ = LCASE$(Stk$[2])
ELSE
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
IF CheckGlobal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
Handle$ = ""
FOR i = 2 TO Ndx
IF *Stk$[i] = ASC(",") OR *Stk$[i] = ASC(";") THEN
Stk$[i] = ""
EXIT FOR
END IF
Handle$ = Handle$ + Stk$[i]
Stk$[i] = ""
NEXT i
Handle$ = Handle$ + "@"
END IF
END IF
Stk$[2] = "" 'get rid of handle
Stk$[3] = "" 'get rid of the Comma
IF IsSprint THEN
ZZ$ = "s" + PrintWriteFormat$(0)
REMOVE "\\n" FROM ZZ$
ELSE
ZZ$ = "f" + PrintWriteFormat$(0)
END IF
ZZ$ = LEFT$(ZZ$,8) + REMOVE$(Handle$,"@") + "," + MID$(ZZ$,9)
IF IsLprint THEN
FPRINT Outfile,Scoot$, ZZ$
FPRINT Outfile,Scoot$, "PrinterWrite(BcxPtr_Buffer);"
IF NOT Use_Printer THEN
SrcTmp$ = "printer" : Parse(SrcTmp$) : Emit() ' Force printer globals declarations
END IF
ELSE
FPRINT Outfile,Scoot$, ZZ$
END IF
'***********************
CASE "end"
'***********************
IF Ndx = 1 THEN
IF Use_Wingui = FALSE THEN
FPRINT Outfile,Scoot$,"fflush(stdout);"
END IF
FPRINT Outfile,Scoot$,"ExitProcess(0);"
EXIT SELECT
END IF
IF Stk$[2] = "=" THEN
IF Use_Wingui = FALSE THEN
FPRINT Outfile,Scoot$,"fflush(stdout);"
END IF
FPRINT Outfile,Scoot$,"ExitProcess(";
FOR Tmp = 3 TO Ndx
FPRINT Outfile,Clean$(Stk$[Tmp]);
NEXT
FPRINT Outfile,");"
EXIT SELECT
END IF
IF iMatchWrd(Stk$[2],"if") THEN
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
EXIT SELECT
END IF
'***********************
CASE "endif"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
'***********************
CASE "if"
'***********************
TestString = DataType(Stk$[2])
IF TestString = vt_STRVAR THEN
IF Stk$[4] = DDQ$ THEN
Stk$[2] = Clean$(Stk$[2]) + "[0]"
Stk$[4] = "0"
END IF
END IF
IF TestString = vt_STRVAR THEN
IF Stk$[3] = "[" AND Stk$[7] = DDQ$ THEN
Stk$[2] = Clean$(Stk$[2])
CONCAT (Stk$[5],"[0]")
Stk$[7] = "0"
END IF
END IF
'********************** IF Handler ***********************
IF NoScoot THEN
FPRINT Outfile,"if(";
NoScoot = 0
ELSE
FPRINT Outfile,Scoot$,"if(";
END IF
Tmp = 2
WHILE Stk$[Tmp] = "(" OR Stk$[Tmp] = "!"
FPRINT Outfile,Stk$[Tmp];
Tmp++
WEND
lszTmp$ = Stk$[Tmp]
A = DataType(lszTmp$)
TestString = FALSE
IF A = vt_STRLIT OR A = vt_STRVAR THEN
IF Stk$[Tmp + 1] <> ")" AND NOT iMatchWrd(Stk$[Tmp+1],"then") THEN
TestString = TRUE
Use_Str_Cmp = TRUE
UseFlag = TRUE
IF USING_LINUX=1 THEN
FPRINT Outfile,"strcmp(";
ELSE
FPRINT Outfile,"str_cmp(";
END IF
END IF
END IF
szTest$ = ""
ParCnt = 0
DO
IF TestString THEN
IF Stk$[Tmp] = "=" THEN
Stk$[Tmp] = "," : szTest$ = ")==0"
ParCnt = 0
ELSEIF Stk$[Tmp] = "!=" THEN
Stk$[Tmp] = ","
szTest$ = ")!=0"
ParCnt = 0
ELSEIF Stk$[Tmp] = ">" THEN
IF Stk$[Tmp + 1] = "=" THEN
Stk$[Tmp] = ","
szTest$ = ")>=0"
Stk$[Tmp + 1] = ""
ELSE
Stk$[Tmp] = ","
szTest$ = ")==1"
END IF
ParCnt = 0
ELSEIF Stk$[Tmp] = "<" THEN
IF Stk$[Tmp + 1] = "=" THEN
Stk$[Tmp] = ","
szTest$ = ")<=0"
Stk$[Tmp + 1] = ""
ELSE
Stk$[Tmp] = ","
szTest$ = ")==-1"
END IF
ParCnt = 0
END IF
IF Stk$[Tmp] = "(" THEN ParCnt++
IF Stk$[Tmp] = ")" THEN ParCnt--
IF Stk$[Tmp] = ")" AND szTest$ <> "" AND ParCnt < 0 THEN
FPRINT Outfile,szTest$;Stk$[Tmp];
szTest$ = ""
ELSE
IF Stk$[Tmp]= "||" OR Stk$[Tmp]= "&&" THEN
Stk$[Tmp]= szTest$ + " " + Stk$[Tmp]
szTest$ = ""
B = 1
WHILE Stk$[Tmp + B] = "("
CONCAT (Stk$[Tmp],"(")
Stk$[Tmp + B] = ""
B++
WEND
A = DataType(Stk$[Tmp+B]) ' look ahead
ZZ$ = LCASE$(Stk$[Tmp+B+1])
IF (A = vt_STRLIT OR A = vt_STRVAR) AND ZZ$ <> ")" THEN
IF USING_LINUX=1 THEN
CONCAT (Stk$[Tmp]," strcmp(")
ELSE
CONCAT (Stk$[Tmp]," str_cmp(")
END IF
Use_Str_Cmp = TRUE
UseFlag = TRUE
ELSE
FPRINT Outfile,Clean$(Stk$[Tmp]);
TestString = False
GOTO NxtToken
END IF
END IF
FPRINT Outfile,Clean$(Stk$[Tmp]);
END IF
ELSE 'Not TestString
IF Stk$[Tmp] = "||" OR Stk$[Tmp] = "&&" THEN
B = 1
WHILE Stk$[Tmp + B] = "("
CONCAT (Stk$[Tmp], "(")
Stk$[Tmp + B] = ""
B++
WEND
A = DataType(Stk$[Tmp+B]) ' look ahead
ZZ$ = LCASE$(Stk$[Tmp+B+1])
IF (A = vt_STRLIT OR A = vt_STRVAR) AND ZZ$ <> ")" THEN
IF USING_LINUX=1 THEN
CONCAT (Stk$[Tmp],"strcmp(" )
ELSE
CONCAT (Stk$[Tmp],"str_cmp(" )
END IF
Use_Str_Cmp = TRUE
UseFlag = TRUE
szTest$ = ""
ParCnt = 0
FPRINT Outfile,Clean$(Stk$[Tmp]);
TestString = TRUE
GOTO NxtToken
END IF
END IF
IF Stk$[Tmp]= "!" THEN
FPRINT Outfile,Stk$[Tmp];
ELSE
FPRINT Outfile,Clean$(Stk$[Tmp]);
END IF
IF Stk$[Tmp] = "=" THEN
IF Stk$[Tmp-1] <> "<" AND Stk$[Tmp-1] <> ">" THEN
IF Stk$[Tmp+1] <> ">" AND Stk$[Tmp+1] <> "<" THEN
FPRINT Outfile,"=";
END IF
END IF
END IF
END IF
NxtToken:
Tmp++
IF Tmp>Ndx THEN Abort("If Without THEN")
LOOP UNTIL iMatchWrd(Stk$[Tmp],"then")
FPRINT Outfile,szTest$;")"
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'******************************************************
CASE "for"
'******************************************************
IF iMatchWrd(Stk$[2],"each") THEN ' "each" becomes reserved keyword
' beginning of for each - collections support
'
DIM RAW foreachlocal$
DIM RAW temp_parms$
Use_COM_Collections = Use_COM = TRUE
FPRINT Outfile, Scoot$, "VariantClear(&bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, "bcx_sys_temp_enum_var = NULL;"
FPRINT Outfile, Scoot$, "bcx_sys_temp_long_coll = 0;"
IF NOT IsVariableComObject(Stk$[3]) THEN FPRINT Outfile, Scoot$, "OBJECT ", Stk$[3], ";"
FPRINT Outfile, Scoot$, "ZeroMemory((PVOID)&", Stk$[3], ",sizeof(OBJECT));"
LoopLocalVar[LoopLocalCnt++] = 0
bcx_get_com_enumerator = TRUE
foreachlocal$ = MID$(Src$,INSTR(Src$," in ",1,1) + 3)
IF NOT IsVariableComObject(Stk$[3]) THEN Add_COM_Local_Variable(Stk$[3])
IF INCHR(foreachlocal$,".") THEN
BCX_COM_Parse_GetProperty("bcx_sys_temp_ack_var", foreachlocal$)
temp_parms$ = TRIM$(EXTRACT$(foreachlocal$, "."))
ELSE
temp_parms$ = TRIM$(foreachlocal$)
END IF
bcx_get_com_enumerator = FALSE
FPRINT Outfile, Scoot$, "bcx_com_get_enumerator_intf = TRUE;"
FPRINT Outfile, Scoot$, "bcx_invoke_helper(&", temp_parms$,", L", DDQ$ ,",DISPATCH_PROPERTYGET|DISPATCH_METHOD, &bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, "bcx_reset_dispatch_chain(&", temp_parms$ , ");"
FPRINT Outfile, Scoot$, "bcx_com_get_enumerator_intf = FALSE;"
FPRINT Outfile, Scoot$, "while(1) { // for each construction ..."
CALL BumpUp
FPRINT Outfile, Scoot$, "if (FAILED(bcx_last_com_HRESULT)) {"
FPRINT Outfile, Scoot$, " bcx_catch_hr_error_desc(bcx_last_com_HRESULT, _T(", ENC$("Get object enumerator failed! Collections unavailable!"),"));"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, "} "
FPRINT Outfile, Scoot$, "if (bcx_sys_temp_ack_var.vt != VT_DISPATCH && bcx_sys_temp_ack_var.vt != VT_UNKNOWN) {"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = E_NOINTERFACE;"
FPRINT Outfile, Scoot$, " bcx_catch_hr_error_desc(bcx_last_com_HRESULT, _T(", ENC$("Enumerations interface not available! Collections unavailable!"),"));"
FPRINT Outfile, Scoot$, " VariantClear(&bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, "} "
FPRINT Outfile, Scoot$, "if (bcx_sys_temp_ack_var.vt == VT_DISPATCH) {"
CALL BumpUp
FPRINT Outfile, Scoot$, "#ifdef __cplusplus"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_ack_var.pdispVal->QueryInterface(IID_IEnumVARIANT, (void **)&bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, "#else"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_ack_var.pdispVal->lpVtbl->QueryInterface(bcx_sys_temp_ack_var.pdispVal, &IID_IEnumVARIANT, (void **)&bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, "#endif"
FPRINT Outfile, Scoot$, "if (FAILED(bcx_last_com_HRESULT)) {"
FPRINT Outfile, Scoot$, " bcx_catch_hr_error_desc(bcx_last_com_HRESULT, _T(", ENC$("QueryInterface: Get enum variant failed! Collections unavailable!"),"));"
FPRINT Outfile, Scoot$, " VariantClear(&bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, "} "
CALL BumpDown
FPRINT Outfile, Scoot$, "} else if (bcx_sys_temp_ack_var.vt == VT_UNKNOWN) {"
CALL BumpUp
FPRINT Outfile, Scoot$, "#ifdef __cplusplus"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_ack_var.punkVal->QueryInterface(IID_IEnumVARIANT, (void **)&bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, "#else"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_ack_var.punkVal->lpVtbl->QueryInterface(bcx_sys_temp_ack_var.punkVal, &IID_IEnumVARIANT, (void **)&bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, "#endif"
FPRINT Outfile, Scoot$, "if (FAILED(bcx_last_com_HRESULT)) {"
FPRINT Outfile, Scoot$, " bcx_catch_hr_error_desc(bcx_last_com_HRESULT, _T(", ENC$("QueryInterface: Get enum variant failed! Collections unavailable!"),"));"
FPRINT Outfile, Scoot$, " VariantClear(&bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, "} "
CALL BumpDown
FPRINT Outfile, Scoot$, "} "
FPRINT Outfile, Scoot$, "VariantClear(&bcx_sys_temp_ack_var);"
FPRINT Outfile, Scoot$, "break;"
FPRINT Outfile, Scoot$, "} // loop"
FPRINT Outfile, Scoot$, " while(bcx_sys_temp_enum_var) {"
FPRINT Outfile, Scoot$, " BCX_SetNothing(&" + Stk$[3] + ");"
FPRINT Outfile, Scoot$, " #ifdef __cplusplus"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_enum_var->Next(1, &" + Stk$[3] + ".pObjects[0], &bcx_sys_temp_long_coll);"
FPRINT Outfile, Scoot$, " #else"
FPRINT Outfile, Scoot$, " bcx_last_com_HRESULT = bcx_sys_temp_enum_var->lpVtbl->Next(bcx_sys_temp_enum_var, 1, &" + Stk$[3] + ".pObjects[0], &bcx_sys_temp_long_coll);"
FPRINT Outfile, Scoot$, " #endif"
FPRINT Outfile, Scoot$, " if (FAILED(bcx_last_com_HRESULT)) {"
FPRINT Outfile, Scoot$, " bcx_catch_hr_error_desc(bcx_last_com_HRESULT, _T(", ENC$("Enumeration failed! Collections unavailable!"),"));"
FPRINT Outfile, Scoot$, " #ifdef __cplusplus"
FPRINT Outfile, Scoot$, " if(bcx_sys_temp_enum_var) bcx_sys_temp_enum_var->Release();"
FPRINT Outfile, Scoot$, " #else"
FPRINT Outfile, Scoot$, " if(bcx_sys_temp_enum_var) bcx_sys_temp_enum_var->lpVtbl->Release(bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, " #endif"
FPRINT Outfile, Scoot$, " bcx_sys_temp_enum_var = NULL;"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, " } "
FPRINT Outfile, Scoot$, " if (" + Stk$[3] + ".pObjects[0].vt != VT_DISPATCH) {"
FPRINT Outfile, Scoot$, " VariantClear(&" + Stk$[3] + ".pObjects[0]);"
FPRINT Outfile, Scoot$, " bcx_sys_temp_long_coll = 0;"
FPRINT Outfile, Scoot$, " } else { "
FPRINT Outfile, Scoot$, " ", Stk$[3], ".pStatus = TRUE;"
FPRINT Outfile, Scoot$, " ", Stk$[3], ".ipointer = 0;"
FPRINT Outfile, Scoot$, " bcx_ole_objects_count++;"
FPRINT Outfile, Scoot$, " }"
FPRINT Outfile, Scoot$, " if (bcx_sys_temp_long_coll == 0) {"
FPRINT Outfile, Scoot$, " #ifdef __cplusplus"
FPRINT Outfile, Scoot$, " if(bcx_sys_temp_enum_var) bcx_sys_temp_enum_var->Release();"
FPRINT Outfile, Scoot$, " #else"
FPRINT Outfile, Scoot$, " if(bcx_sys_temp_enum_var) bcx_sys_temp_enum_var->lpVtbl->Release(bcx_sys_temp_enum_var);"
FPRINT Outfile, Scoot$, " #endif"
FPRINT Outfile, Scoot$, " BCX_SetNothing(&" + Stk$[3] + ");"
FPRINT Outfile, Scoot$, " bcx_sys_temp_enum_var = NULL;"
FPRINT Outfile, Scoot$, " break;"
FPRINT Outfile, Scoot$, " }"
'
ELSE ' this is "Normal" For - Next Loop
DIM RAW FFlg = 0
DIM RAW For1 = 0
DIM RAW For2 = 0
DIM RAW For3 = 0
DIM RAW For4 = 0
DIM RAW Reg$, xxx$, yyy$, zzz$, qqq$
Reg$ = ""
xxx$ = ""
yyy$ = ""
zzz$ = ""
qqq$ = ""
'******************************************************
FOR i = Ndx TO 1 STEP -1
IF iMatchWrd(Stk$[i],"step") THEN
FFlg = TRUE
EXIT FOR
END IF
NEXT
IF NOT FFlg THEN
Ndx++
Stk$[Ndx] = "step"
Ndx++
Stk$[Ndx] = "1"
END IF
'******************************************************
Test = FALSE
FOR i = 1 TO Ndx
IF Stk$[i]= "=" THEN Test = TRUE
NEXT
IF Test = FALSE THEN Abort("Missing =")
'******************************************************
Test = FALSE
FOR i = 1 TO Ndx
IF iMatchWrd(Stk$[i],"to") THEN Test = TRUE
NEXT
IF Test = FALSE THEN Abort("Missing TO")
'******************************************************
Reg$ = LCASE$(Stk$[2])
SELECT CASE Reg$
CASE "int","fint"
Reg$ = SPC$
LoopLocalVar[LoopLocalCnt++] = 1
FPRINT Outfile,Scoot$," {register int ";
CASE "single", "float"
Reg$ = SPC$
LoopLocalVar[LoopLocalCnt++] = 1
FPRINT Outfile,Scoot$," {float ";
CASE "double"
Reg$ = SPC$
LoopLocalVar[LoopLocalCnt++] = 1
FPRINT Outfile,Scoot$," {double ";
CASE "ldouble"
Reg$ = SPC$
LoopLocalVar[LoopLocalCnt++] = 1
FPRINT Outfile,Scoot$," {LDOUBLE ";
CASE ELSE
Reg$ = ""
LoopLocalVar[LoopLocalCnt++] = 0
END SELECT
IF LEN(Reg$) THEN
FOR j = 3 TO Ndx
Stk$[j-1] = Stk$[j]
NEXT
Ndx--
END IF
'******************************************************
' Every statement now conforms to the following:
' FOR xxx = yyy TO zzz STEP qqq
'******************************************************
FOR i = 2 TO Ndx
IF Stk$[i] = "=" THEN
For1 = i-1 'xxx spans from Stk$[2] to Stk$[For1]
EXIT FOR
END IF
NEXT
FOR i = For1+2 TO Ndx
IF iMatchWrd(Stk$[i],"to") THEN
For2 = i-1 'yyy spans from Stk$[For1+2] to Stk$[For2]
EXIT FOR
END IF
NEXT
FOR i = For2+2 TO Ndx
IF iMatchWrd(Stk$[i],"step") THEN
For3 = i-1 'zzz spans from Stk$[For2+2] to Stk$[For3]
EXIT FOR
END IF
NEXT
For4 = For3+2 'qqq spans from Stk$[For4] to Stk$[Ndx]
FOR i = 2 TO For1
CONCAT(xxx$,Stk$[i])
NEXT
FOR i = For1+2 TO For2
CONCAT(yyy$,Stk$[i])
NEXT
FOR i = For2+2 TO For3
CONCAT(zzz$,Stk$[i])
NEXT
FOR i = For4 TO Ndx
CONCAT(qqq$,Stk$[i])
NEXT
xxx$ = Clean$(xxx$)
yyy$ = Clean$(yyy$)
zzz$ = Clean$(zzz$)
qqq$ = Clean$(qqq$)
IF Reg$ = SPC$ THEN FPRINT Outfile, xxx$, ";"
Reg$ = ""
IF IsNumberEx (qqq$) THEN
IF LEFT$(qqq$,1) = "-" THEN
FPRINT Outfile,Scoot$,"for(", Reg$, xxx$, "=", yyy$, "; ", xxx$, ">=" , zzz$, "; " , xxx$, "+=" , qqq$, ")"
ELSE
FPRINT Outfile,Scoot$,"for(", Reg$, xxx$, "=", yyy$, "; ", xxx$, "<=" , zzz$, "; " , xxx$, "+=" , qqq$, ")"
END IF
ELSE
FPRINT Outfile,Scoot$,"for(", Reg$, xxx$, "=", yyy$, "; ", qqq$, ">=0 ? ", xxx$, "<=" , zzz$, " : ", xxx$, ">=", zzz$, "; " , xxx$, "+=" , qqq$, ")"
END IF
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
END IF
'***********************
CASE "next"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
IF LoopLocalVar[--LoopLocalCnt] THEN FPRINT Outfile,Scoot$,"}"
IF LoopLocalCnt < 0 THEN Abort ("Next without For")
CALL BumpDown
'***********************
CASE "do"
'***********************
FPRINT Outfile,Scoot$,"while(1)"
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'***********************
CASE "loop"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
'***********************
CASE "caseelse"
'***********************
CaseElseFlag[Pusher] = TRUE
IF CaseFlag THEN
IF NoBreak2 = 0 THEN
FPRINT Outfile,Scoot$,"break;"
END IF
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
FPRINT Outfile,Scoot$,"// case else"
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
END IF
'***********************
CASE "endselect"
'***********************
IF CaseFlag THEN
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
END IF
CALL BumpDown
' Only suppress this break if the Case block contains
' a "CASE ELSE" and the last statement is a redirection.
IF CaseElseFlag[Pusher] = 0 OR NoBreak2 = 0 THEN
FPRINT Outfile,Scoot$,"break;"
END IF
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
NoBreak2 = CaseElseFlag[Pusher] = 0
CALL Pop(CaseVar$)
'***********************
CASE "else"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
FPRINT Outfile,Scoot$,"else"
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
' **************
CASE "case"
' **************
FOR i = 2 TO Ndx
IF Stk$[i] = "%" THEN Stk$[i] = " % " ' Added by MrBCX 3.36
IF Stk$[i] = "!=" THEN Stk$[i] = "<>"
IF Stk$[i] = "!" AND Stk$[i+1] = "=" THEN
Stk$[i] = "<>" : Stk$[i+1] = ""
END IF
IF isalpha(Stk[i][0]) THEN
CONCAT(Stk$[i]," ")
END IF
NEXT
szTmp$ = ""
Test = FALSE
IF DataType(CaseVar$) = vt_STRVAR THEN Test = TRUE
i = 0
FOR A = 2 TO Ndx
IF INCHR("([",Stk$[A]) THEN i++
IF INCHR(")]",Stk$[A]) THEN i--
IF i THEN
CONCAT(szTmp$, Stk$[A])
ITERATE
END IF
IF Stk$[A] = "," THEN ' comma
IF NOT INCHR("<>=",Stk$[A+1]) THEN
szTmp$ = szTmp$ + " or " + CaseVar$ + "="
ELSE
szTmp$ = szTmp$ + " or " + CaseVar$
END IF
Stk$[A] = ""
ITERATE
END IF
IF Stk$[A] = "&&" THEN
szTmp$ = szTmp$ + " and " + CaseVar$
Stk$[A]= ""
ELSEIF Stk$[A] = "||" THEN
szTmp$ = szTmp$ + " or " + CaseVar$
Stk$[A]= ""
ELSE
CONCAT(szTmp$, Stk$[A])
END IF
NEXT
IF CaseFlag = 0 THEN NoBreak = 0
IF CaseFlag THEN
IF NoBreak = 0 THEN
IF NoBreak2 = 0 THEN FPRINT Outfile,Scoot$;"break;"
END IF
CALL BumpDown()
FPRINT Outfile,Scoot$;"}"
CALL BumpDown()
END IF
CaseFlag = TRUE
IF iMatchLft(CaseVar$," BAND ") THEN
NoBreak = 1
Src$ = "IF " + szTmp$ + CaseVar$ + " Then "
ELSE
IF INCHR("<>=",szTmp$) AND NOT IsQuoted(szTmp$) THEN
Src$ = "IF " + CaseVar$ + szTmp$ + " Then "
ELSE
Src$ = "IF " + CaseVar$ + " = " + szTmp$ + " Then "
END IF
END IF
CALL Parse(Src$)
CALL Emit()
'***********************
CASE "textmode"
'***********************
lszTmp$ = ""
FOR i = 2 TO Ndx 'allow size to be an expression
CONCAT(lszTmp$, Clean$(Stk$[i]))
NEXT
FPRINT Outfile,Scoot$, "TextMode("; lszTmp$ ; ");"
'***********************
CASE "delay"
'***********************
lszTmp$ = ""
FOR i = 2 TO Ndx ' Allow size to be an expression
CONCAT(lszTmp$, Clean$(Stk$[i]))
NEXT
FPRINT Outfile,Scoot$,"Sleep(1000*";lszTmp$;");"
'***********************
CASE "qsortidx" 'qsortidx idx, size_of_array, A$, key
'***********************
UseFlag = TRUE
lszTmp$ = ""
Var$ = Clean$(Stk$[2]) 'index array
FOR i = 4 TO Ndx-4 'allow size to be an expression
CONCAT(lszTmp$, Stk$[i])
NEXT
lszTmp$ = Clean$(lszTmp$)
FPRINT Outfile,Scoot$,"Key = ",Stk[Ndx],";"
IF Var$ <> "0" THEN
FPRINT Outfile,Scoot$,"register int iDx;"
FPRINT Outfile,Scoot$,"for(iDx=0; iDx<",lszTmp$,"; iDx+=1) ";
FPRINT Outfile, Var$,"[iDx]=iDx;"
END IF
IF NOT INCHR(Stk$[Ndx-2],".") THEN 'Check if this is a struct sort
Use_Idxqsort = TRUE
FPRINT Outfile,Scoot$,"pppStr = ",Clean$(Stk[Ndx-2]),";"
FPRINT Outfile,Scoot$,"qsort(";Var$;",";lszTmp$;",sizeof(int),IdxCompare);"
ELSE
DIM RAW Stptr$, StMem$, StName$
StMem$ = REMAIN$(Clean$(Stk$[Ndx-2]),".")
Stptr$ = EXTRACT$(Stk$[Ndx-2],".")
IF CheckLocal(Stptr,&i) <> vt_UNKNOWN THEN
StName$ = TypeDefs[LocalVars[i].VarDef].VarName$
ELSEIF CheckGlobal(Stptr,&i) <> vt_UNKNOWN THEN
StName$ = TypeDefs[GlobalVars[i].VarDef].VarName$
END IF
IF Var$ <> "0" THEN
Use_IdxqsortSt = TRUE
FPRINT Outfile,Scoot$,"cmp1 =(char*)(",Stptr$ ,") + offsetof(",StName$,",",StMem$,");"
FPRINT Outfile,Scoot$,"StructSize = sizeof(",StName$,");"
FPRINT Outfile,Scoot$,"qsort(",Var$;",",lszTmp$,",sizeof(int),IdxCompareSt);"
ELSE
Use_PtrqsortSt = TRUE
FPRINT Outfile,Scoot$,"OffSet = offsetof(",StName$,",",StMem$,");"
FPRINT Outfile,Scoot$,"qsort(",Stptr$;",",lszTmp$,",sizeof(",StName$,"),PtrCompareSt);"
END IF
END IF
'***********************
CASE "qsort" 'qsort A$,size_of_array,ascending|descending
'***********************
DIM RAW QST=0
DIM RAW order=0
UseFlag = TRUE
IF iMatchWrd(Stk$[2],"dynamic") THEN
QST = TRUE
FOR j = 3 TO Ndx
Stk$ [j-1] = Stk$[j]
NEXT
Ndx--
END IF
IF LCASE$(Stk$[Ndx])= "ascending" THEN
order = 2
Ndx--
Ndx--
END IF
IF LCASE$(Stk$[Ndx])= "descending" THEN
order = 1
Ndx--
Ndx--
END IF
IF order = 0 THEN order = 2 'default to ascending
lszTmp$ = ""
FOR i = 4 TO Ndx 'allow size to be an expression
CONCAT(lszTmp$, Stk$[i])
NEXT
Var$ = Clean$(Stk$[2])
vt = DataType(Stk$[2])
IF vt <> vt_STRVAR AND vt <> vt_INTEGER AND vt <> vt_SINGLE AND vt <> vt_DOUBLE THEN
vt = CheckType(Stk$[2])
END IF
FPRINT Outfile,Scoot$,"qsort(";Var$;",";Clean$(lszTmp$);
SELECT CASE vt
CASE vt_STRVAR
IF NOT QST THEN
IF order = 1 THEN
FPRINT Outfile,",sizeof(";Var$;"[0]),StrCompareD);"
Use_Strqsortd = TRUE
ELSE
FPRINT Outfile,",sizeof(";Var$;"[0]),StrCompareA);"
Use_Strqsorta = TRUE
END IF
ELSE
IF order = 1 THEN
FPRINT Outfile,",sizeof(";Var$;"[0]),DynStrCompareD);"
Use_DynStrqsortd = TRUE
ELSE
FPRINT Outfile,",sizeof(";Var$;"[0]),DynStrCompareA);"
Use_DynStrqsorta = TRUE
END IF
END IF
CASE vt_INTEGER
IF order = 1 THEN
FPRINT Outfile,",sizeof(int),NumCompareDint);"
Use_Numqsortdint = TRUE
ELSE
FPRINT Outfile,",sizeof(int),NumCompareAint);"
Use_Numqsortaint = TRUE
END IF
CASE vt_SINGLE
IF order = 1 THEN
FPRINT Outfile,",sizeof(float),NumCompareDfloat);"
Use_Numqsortdfloat = TRUE
ELSE
FPRINT Outfile,",sizeof(float),NumCompareAfloat);"
Use_Numqsortafloat = TRUE
END IF
CASE vt_DOUBLE
IF order = 1 THEN
FPRINT Outfile,",sizeof(double),NumCompareDdouble);"
Use_Numqsortddouble = TRUE
ELSE
FPRINT Outfile,",sizeof(double),NumCompareAdouble);"
Use_Numqsortadouble = TRUE
END IF
CASE ELSE
IF order = 1 THEN
FPRINT Outfile,",sizeof(int),NumCompareDint);"
Use_Numqsortdint = TRUE
ELSE
FPRINT Outfile,",sizeof(int),NumCompareAint);"
Use_Numqsortaint = TRUE
END IF
END SELECT
'***********************
CASE "endprogram" 'Force END of main- allow inclusions outside of main
'***********************
FPRINT Outfile,"return 0; // End of main program"
FPRINT Outfile,"}\n\n"
EndOfProgram = 1
'******************************
' Allow Conditional Compilation
'******************************
'***********************
CASE "~ifndef"
'***********************
InIfDef$ = "#ifndef "
FOR i = 2 TO Ndx
InIfDef$ = InIfDef$ + Stk$[i] + " "
NEXT
InIfDef$ = TRIM$(InIfDef$)
IF InFunc OR InMain THEN
FPRINT Outfile,InIfDef$
ELSE
FPRINT FP6,InIfDef$
END IF
'***********************
CASE "~if"
'***********************
InIfDef$ = "#if defined "
FOR i = 2 TO Ndx
InIfDef$ = InIfDef$ + Stk$[i] + " "
NEXT
InIfDef$ = TRIM$(InIfDef$)
IF InFunc OR InMain THEN
FPRINT Outfile,InIfDef$
ELSE
FPRINT FP6,InIfDef$
END IF
'***********************
CASE "~else"
'***********************
InIfDef$ = "#else"
IF InFunc OR InMain THEN
FPRINT Outfile,InIfDef$
END IF
'***********************
CASE "~elseif"
'***********************
InIfDef$ = "#elif defined "
FOR i = 2 TO Ndx
InIfDef$ = InIfDef$ + Stk$[2] + " "
NEXT
InIfDef$ = TRIM$(InIfDef$)
IF InFunc OR InMain THEN
FPRINT Outfile,InIfDef$
ELSE
IF Outfile = FP2 THEN
FPRINT Outfile,InIfDef$
END IF
END IF
'***********************
CASE "~endif"
'***********************
DIM RAW FPsave AS FILE
FPsave = Outfile
IF InIfDef$ = "FP3" THEN
Outfile = FP3
END IF
InIfDef$ = "#endif"
IF InFunc OR InMain THEN
FPRINT Outfile,InIfDef$
ELSE
IF InConditional = 0 AND DidConsts THEN
FPRINT FP6,InIfDef$
END IF
IF InConditional = 0 AND Outfile = FP3 THEN
FPRINT FP3,InIfDef$
END IF
END IF
IF InConditional = 0 THEN
InIfDef$ = ""
DidConsts = 0
END IF
Outfile = FPsave
'***********************
CASE "~pragmaoptimizeon"
'***********************
FPRINT Outfile,"#ifdef __POCC__"
FPRINT Outfile,"#pragma optimize(time)"
FPRINT Outfile,"#endif"
FPRINT Outfile,"#ifdef __LCC__"
FPRINT Outfile,"#pragma optimize(1)"
FPRINT Outfile,"#endif"
'***********************
CASE "~pragmaoptimizeoff"
'***********************
FPRINT Outfile,"#ifdef __POCC__"
FPRINT Outfile,"#pragma optimize(none)"
FPRINT Outfile,"#endif"
FPRINT Outfile,"#ifdef __LCC__"
FPRINT Outfile,"#pragma optimize(0)"
FPRINT Outfile,"#endif"
'***********************
CASE "incr"
'***********************
j=FALSE
FPRINT Outfile,Scoot$;
FOR i=2 TO Ndx
IF Stk$[i]="," THEN
FPRINT Outfile,"+=(";
j=TRUE
ELSE
FPRINT Outfile,Clean$(Stk$[i]);
END IF
NEXT
FPRINT Outfile,IIF$(j,");","++;")
'***********************
CASE "decr"
'***********************
j=FALSE
FPRINT Outfile,Scoot$;
FOR i=2 TO Ndx
IF Stk$[i]="," THEN
FPRINT Outfile,"-=(";
j=TRUE
ELSE
FPRINT Outfile,Clean$(Stk$[i]);
END IF
NEXT
FPRINT Outfile,IIF$(j,");","--;")
'***********************
CASE "seek"
'***********************
IF DataType(Stk$[2])= vt_NUMBER THEN
Stk$[2]= "FP" + Stk$[2]
END IF
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
FPRINT Outfile,Scoot$,"fseek(";
FOR Tmp = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[Tmp]);
NEXT
FPRINT Outfile,",0);"
'***********************
CASE "select"
'***********************
CaseVar$ = ""
CaseFlag = 0
FOR A = 3 TO Ndx
CONCAT(CaseVar$, Stk$[A])
NEXT
CALL Push(CaseVar$)
FPRINT Outfile,Scoot$,"while(1)"
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'***********************
CASE "~get"
'***********************
Use_Get = TRUE
Use_Sysmacros = TRUE
IF DataType(Stk$[2])= vt_NUMBER THEN
Stk$[2]= "FP" + Stk$[2]
END IF
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
IF CheckGlobal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
FPRINT Outfile,Scoot$,"GET(";
FOR Tmp = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[Tmp]);
NEXT
FPRINT Outfile,");"
'***********************
CASE "~put"
'***********************
Use_Put = TRUE
Use_Sysmacros = TRUE
IF DataType(Stk$[2]) = vt_NUMBER THEN
Stk$[2]= "FP" + Stk$[2]
END IF
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
IF CheckGlobal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
FPRINT Outfile,Scoot$,"PUT(";
FOR Tmp = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[Tmp]);
NEXT
FPRINT Outfile,");"
'***********************
CASE "~vscroll"
'***********************
Use_Vscroll = VAL(Stk$[2])
IF Use_Vscroll = 0 THEN Use_Vscroll = TRUE
'***********************
CASE "~hscroll"
'***********************
Use_Hscroll = VAL(Stk$[2])
IF Use_Hscroll = 0 THEN Use_Hscroll = TRUE
'***********************
CASE "gosub"
'***********************
Use_Gosub = TRUE
FPRINT Outfile,Scoot$,"if (setjmp(GosubStack[GosubNdx++])==0)";
FPRINT Outfile," goto ";UCASE$(Stk$[2]);";"
'***********************
CASE "return"
'***********************
Use_Gosub = TRUE
FPRINT Outfile,Scoot$,"longjmp (GosubStack [--GosubNdx],1 );"
FPRINT Outfile,""
'***********************
CASE "data"
'***********************
IF Stk$[Ndx] <> "," THEN
Stk$[Ndx+1] = ","
Ndx++
END IF
FOR A = 2 TO Ndx
IF INCHR(Stk$[A],DQ$) = 0 AND Stk$[A] <> "," THEN
Stk$[A] = ENC$(Stk$[A]) ' Allow unquoted text
END IF
FPRINT FP5,Stk$[A];
NEXT
FPRINT FP5,""
'***********************
CASE "type"
'***********************
IF InTypeDef = 0 THEN
SaveOutfileNum = Outfile
END IF
Outfile = FP4
IF Ndx > 2 THEN
IF InTypeDef THEN
CALL Abort("Single line TYPE within type/union not supported")
END IF
FOR i = Ndx TO 1 STEP -1
IF iMatchWrd(Stk$[i],"as") THEN
EXIT FOR
END IF
NEXT
IF NOT iMatchWrd(Stk$[i],"as") THEN
CALL Abort("Missing AS TYPE")
END IF
FPRINT Outfile,"typedef ";
j = i-1
i++
WHILE i <= Ndx
FPRINT Outfile,Stk$[i];" ";
i++
WEND
FOR i = 2 TO j
FPRINT Outfile,Stk$[i];
NEXT
FPRINT Outfile,";"
Outfile = SaveOutfileNum
ELSE
InTypeDef++
TypeName$[InTypeDef] = Stk$[2]
CALL AddTypeDefs(TypeName$[InTypeDef],vt_STRUCT)
BaseTypeDefsCnt[InTypeDef] = TypeDefsCnt
IF InTypeDef = 1 THEN
FPRINT Outfile,""
FPRINT Outfile,"typedef struct _";TypeName$[InTypeDef]
FPRINT Outfile,"{"
ELSE
FPRINT Outfile,Scoot$;"struct"
FPRINT Outfile,Scoot$;"{"
CALL AddTypedefElement(BaseTypeDefsCnt[InTypeDef-1],vt_STRUCT,TypeName$[InTypeDef],TypeName$[InTypeDef])
CALL BumpUp
END IF
END IF
'***********************
CASE "endtype"
'***********************
IF InTypeDef = 1 THEN
FPRINT Outfile,"}";TypeName$[InTypeDef];", *";"LP";UCASE$(TypeName$[InTypeDef]); ";"
FPRINT Outfile,""
Outfile = SaveOutfileNum
FPRINT FP6,Scoot$;"#define ",UCASE$(TypeName$[InTypeDef]),"_CLASS struct _",UCASE$(TypeName$[InTypeDef]),"*"
ELSE
CALL BumpDown
FPRINT Outfile,Scoot$;"} ";TypeName$[InTypeDef];";"
FPRINT Outfile,""
END IF
InTypeDef--
'***********************
CASE "union"
'***********************
IF InTypeDef = 0 THEN
SaveOutfileNum = Outfile
END IF
Outfile = FP4
InTypeDef++
TypeName$[InTypeDef] = Stk$[2]
CALL AddTypeDefs(TypeName$[InTypeDef],vt_UNION)
BaseTypeDefsCnt[InTypeDef] = TypeDefsCnt
IF InTypeDef = 1 THEN
FPRINT Outfile,""
FPRINT Outfile,"typedef union "
FPRINT Outfile,"{"
ELSE
FPRINT Outfile,Scoot$;"union"
FPRINT Outfile,Scoot$;"{"
CALL AddTypedefElement(BaseTypeDefsCnt[InTypeDef-1],vt_UNION,TypeName$[InTypeDef],TypeName$[InTypeDef])
CALL BumpUp
END IF
'***********************
CASE "endunion"
'***********************
IF InTypeDef = 1 THEN
FPRINT Outfile,"} ";TypeName$[InTypeDef];", *";"LP";UCASE$(TypeName$[InTypeDef]); ";"
FPRINT Outfile,""
Outfile = SaveOutfileNum
ELSE
CALL BumpDown
FPRINT Outfile,Scoot$;"} ";TypeName$[InTypeDef];";"
FPRINT Outfile,""
END IF
InTypeDef--
'***********************
CASE "with"
'***********************
GLOBAL WithVar$[8]
GLOBAL WithCnt
WithCnt++
IF WithCnt = 8 THEN Abort("[With] depth exceeded")
WithVar$[WithCnt] = ""
FOR i = 2 TO Ndx
CONCAT(WithVar$[WithCnt],Stk$[i])
NEXT
'***********************
CASE "endwith"
'***********************
IF bcx_com_open_with_statement THEN
IF bcx_com_open_with_statement > 1 THEN
FPRINT Outfile, Scoot$, "bcx_preserve_dispatch_storage_index--;"
FPRINT Outfile, Scoot$, "bcx_preserve_dispatch_at_offset = bcx_preserve_dispatch_storage[bcx_preserve_dispatch_storage_index];"
ELSE
FPRINT Outfile, Scoot$, "bcx_preserve_dispatch_at_offset = 0;"
FPRINT Outfile, Scoot$, "bcx_preserve_dispatch_storage_index = 0;"
END IF
FPRINT Outfile, Scoot$, "bcx_reset_dispatch_chain(&" + com_with_temp_str_name$ + ");"
DECR bcx_com_open_with_statement
ELSE
WithCnt--
END IF
'***********************
CASE "clear"
'***********************
Use_Clear = TRUE
Use_Sysmacros = TRUE
FPRINT Outfile, Scoot$, "Clear ";
IF Stk$[2]<> "(" THEN FPRINT Outfile,"(";
FOR i = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[i]);
NEXT
IF Stk$[2]<> "(" THEN FPRINT Outfile,")";
FPRINT Outfile,";"
'******************************************************************************
CASE "bcx_set_label_color" ' These statements must appear in the EVENTS LOOP
'******************************************************************************
Use_SetColor = Use_Proto = TRUE
IF Stk$[2] = "(" THEN
FOR i = 3 TO Ndx-1
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
Ndx--
END IF
szTmp$ = ""
FOR i = 2 TO Ndx
IF Stk$[i] = "," THEN EXIT FOR
CONCAT(szTmp$,Stk$[i])
NEXT
FPRINT Outfile,Scoot$,"if((HWND)lParam=="; szTmp$ ;" && Msg==WM_CTLCOLORSTATIC)"
FPRINT Outfile,Scoot$,"return Set_Color(" ;
FOR j = i+1 TO Ndx
FPRINT Outfile,Clean$(Stk$[j]);
NEXT
FPRINT Outfile,",wParam,lParam);"
'*****************************************************************************
CASE "bcx_set_edit_color" 'These statements must appear in the EVENTS LOOP
'*****************************************************************************
Use_SetColor = Use_Proto = TRUE
IF Stk$[2] = "(" THEN
FOR i = 3 TO Ndx-1
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
Ndx--
END IF
szTmp$ = ""
FOR i = 2 TO Ndx
IF Stk$[i] = "," THEN EXIT FOR
CONCAT(szTmp$,Stk$[i])
NEXT
FPRINT Outfile,Scoot$,"if((HWND)lParam=="; szTmp$ ;" && Msg==WM_CTLCOLOREDIT)"
FPRINT Outfile,Scoot$,"return Set_Color(" ;
FOR j = i+1 TO Ndx
FPRINT Outfile,Clean$(Stk$[j]);
NEXT
FPRINT Outfile,",wParam,lParam);"
'***********************
CASE "bcx_set_font"
'***********************
Use_SetFont = TRUE
Use_Proto = TRUE
IF Stk$[2] = "(" THEN
FOR i = 3 TO Ndx-1
Stk$[i-1] = Stk$[i]
NEXT
Ndx--
Ndx--
END IF
FPRINT Outfile,Scoot$,"SendMessage(";
i = 2
DO
FPRINT Outfile,Clean$(Stk$[i]);
i++
IF Stk$[i] = "," THEN EXIT LOOP
IF i>Ndx THEN Abort ("Malformed BCX_SET_FONT")
LOOP
i++
FPRINT Outfile,",(UINT)WM_SETFONT," ;
FPRINT Outfile,"(WPARAM)BCX_Set_Font(" ;
FOR j = i TO Ndx
FPRINT Outfile,Clean$(Stk$[j]);
NEXT
FPRINT Outfile,"),1);"
'***********************
CASE "repeat"
'***********************
lszTmp$ = ""
FOR i = 2 TO Ndx
CONCAT(lszTmp$, Stk$[i])
NEXT
lszTmp$ = Clean$(lszTmp$)
CALL BumpUp
IF INCHR(Stk$[2],"-") THEN
IF LEFT$(lszTmp$,1) = "-" THEN lszTmp$ = MID$(lszTmp$,2)
FPRINT Outfile,Scoot$,"{register int BCX_REPEAT;"
FPRINT Outfile,Scoot$,"for(BCX_REPEAT=";lszTmp$;";BCX_REPEAT>=1;BCX_REPEAT--)"
FPRINT Outfile,Scoot$,"{"
ELSE
FPRINT Outfile,Scoot$,"{register int BCX_REPEAT;"
FPRINT Outfile,Scoot$,"for(BCX_REPEAT=1;BCX_REPEAT<=";lszTmp$;";BCX_REPEAT++)"
FPRINT Outfile,Scoot$,"{"
END IF
CALL BumpUp
'***********************
CASE "endrepeat"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
'***********************
CASE "gui", "mdigui"
'***********************
' BEGIN BCX_GUI MODIFICATION
IF Ndx < 2 THEN Abort( "Not Enough Parameters with " + UCASE$(Lookup$) + " Statement!" )
IF LCASE$(Stk$[2]) = "nomain" THEN
Use_Wingui = TRUE
NoMain = TRUE
Use_GUINoMain = TRUE
IF LCASE$(Stk$[4]) = "pixels" THEN
GUIMetric$ = "pixels"
END IF
IF LCASE$(Stk$[4]) = "icon" AND Stk$[6] <> "" THEN
GUIIcon$ = " LoadIcon(BCX_hInstance,MAKEINTRESOURCE(" & Stk$[6] & "));"
ELSEIF LCASE$(Stk$[6]) = "icon" AND Stk$[8] <> "" THEN
GUIIcon$ = " LoadIcon(BCX_hInstance,MAKEINTRESOURCE(" & Stk$[8] & "));"
ELSE
GUIIcon$ = " LoadIcon(NULL,IDI_WINLOGO);"
END IF
IF Lookup$ = "mdigui" THEN
Use_Mdigui = TRUE
CALL EmitMDICode
Use_MDIGUINoMain = TRUE
Use_GUINoMain = FALSE
END IF
ELSE ' Old GUI code before GUI NOMAIN
Use_Wingui = TRUE
'Use_Ucase = Use_Str_Cmp = UseFlag = TRUE
LOCAL classname$
LOCAL metric$
classname$ = Stk$[2]
IF LCASE$(Stk$[4]) = "pixels" THEN
metric$ = "pixels"
GUIMetric$ = "pixels"
END IF
IF LCASE$(Stk$[4]) = "icon" AND Stk$[6] <> "" THEN
GUIIcon$ = " LoadIcon(BCX_hInstance,MAKEINTRESOURCE(" & Stk$[6] & "));"
ELSEIF LCASE$(Stk$[6]) = "icon" AND Stk$[8] <> "" THEN
GUIIcon$ = " LoadIcon(BCX_hInstance,MAKEINTRESOURCE(" & Stk$[8] & "));"
ELSE
GUIIcon$ = " LoadIcon(NULL,IDI_WINLOGO);"
END IF
Use_BCX_SetMetric = Use_BCX_InitGUI = Use_BCX_RegWnd = TRUE
EmitWinGUIMain( classname$, metric$, GUIIcon$ )
IF Lookup$ = "mdigui" THEN
Use_Mdigui = TRUE
CALL EmitMDI_MsgPump
CALL EmitMDICode
ELSE
CALL EmitGUI_MsgPump
END IF ' Lookup$ = "mdigui"
END IF
CALL AddGUIGlobals
' END BCX_GUI MODIFICATION
IF NOT Use_BCX_Class_Info THEN
Use_BCX_Class_Info = TRUE
CALL AddGlobal("BCX_ScaleX", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ScaleY", vt_SINGLE, 0,"",0,0,0)
CALL AddGlobal("BCX_ClassName",vt_STRVAR, 0,"",0,0,0)
END IF
'******************************
CASE "dialogbox" 'HELPER
'******************************
Comma = 0
FPRINT Outfile,Scoot$,"DialogBox";
FOR A = 2 TO Ndx
IF Stk$[A] = "," THEN Comma++
IF Comma = 3 THEN
IF Stk$[A] = "," THEN Stk$[A] = ",(DLGPROC)"
END IF
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,";"
'********************************
CASE "insertmenu" 'HELPER
'********************************
Comma = 0
FPRINT Outfile,Scoot$,"InsertMenu";
FOR A = 2 TO Ndx
IF Stk$[A] = "," THEN Comma++
IF Stk$[A] = "," THEN
IF Comma = 3 THEN
Stk$[A] = ",(UINT)"
END IF
END IF
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,";"
'***********************
CASE "const"
'***********************
DIM RAW Buffer$
DIM RAW Sep$
Buffer$ = ""
Sep$ = ""
Stk$[1] = ""
FOR i = 2 TO Ndx
IF Stk$[i] = "=" THEN
INCR i
EXIT FOR
ELSE
CONCAT(Stk$[1], Stk$[i])
END IF
NEXT
Stk$[1] = "#define " + Clean$(Stk$[1]) + SPC$
FOR i = i TO Ndx
IF isalpha(Stk[i][0]) OR Stk[i][0] = ASC("_") AND _
isalpha(Stk[i+1][0]) OR Stk[i+1][0] = ASC("_") THEN Sep$ = " " ELSE Sep$ = ""
IF NOT IsQuoted(Stk$[i]) THEN REMOVE "$" FROM Stk$[i]
Buffer$ = Buffer$ + Stk$[i] + Sep$
NEXT
Buffer$ = Stk$[1] + Buffer$
IF InConditional THEN
IF InFunc THEN
FPRINT Outfile,Buffer$
ELSE
DidConsts = 1
FPRINT FP6,Buffer$
END IF
ELSE
FPRINT FP6,Buffer$
END IF
'***********************
CASE "kill"
'***********************
FPRINT Outfile,Scoot$,"DeleteFile (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
'***********************
CASE "chdir", "_chdir"
'***********************
FPRINT Outfile,Scoot$,"chdir (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
'***********************
CASE "rmdir", "_rmdir"
'***********************
FPRINT Outfile,Scoot$,"rmdir (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
'***********************
CASE "mkdir", "_mkdir"
'***********************
FPRINT Outfile,Scoot$,"mkdir (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
'***********************
CASE "free"
'***********************
DIM RAW VI AS VarInfo PTR
IF Stk$[2] <> "(" THEN
CVar$ = Clean$(Stk$[2])
vt = CheckLocal(CVar$, &id)
IF vt = vt_UNKNOWN THEN
vt = CheckGlobal(CVar$, &id)
IF vt = vt_UNKNOWN THEN
Abort("Can not REDIM " + CVar$ + " not previously dimensioned")
END IF
VI = &GlobalVars[id]
ELSE
VI = &LocalVars[id]
END IF
ELSE
VI = &LocalVars[0]
END IF
IF VI->VarPntr > 1 THEN
Use_DynamicA= TRUE
UseFlag = TRUE
FPRINT Outfile,Scoot$,"if (" ; CVar$ ;
FPRINT Outfile,") { DestroyArr((void **)" + CVar$ + "," + STR$(VI->VarPntr) + ", 1); ";
FPRINT Outfile,CVar$ ; "=NULL; }"
ELSE
FPRINT Outfile,Scoot$,"free(";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
END IF
'***********************
CASE "dynafree"
'***********************
Use_DynamicA= TRUE
UseFlag = TRUE
CVar$ = Clean$(Stk[2])
vt = CheckGlobal(CVar$, &id)
FPRINT Outfile,Scoot$,"if (" ; CVar$ ;
FPRINT Outfile,") { DestroyArr((void **)" + CVar$ + "," + STR$(GlobalVars[id].VarPntr) + ", 1); ";
FPRINT Outfile,CVar$ ; "=NULL; }"
'*************************************************************************
CASE "midstr" ' alias TO MID$ statement(NOT FUNCTION)
'*************************************************************************
Src$ = ""
FOR A = 1 TO Ndx
CONCAT(Src$,Clean$(Stk$[A]))
NEXT
FPRINT Outfile,Scoot$, TRIM$(Src$), ";"
'***********************
CASE "swap"
'***********************
UseFlag = TRUE
FPRINT Outfile,Scoot$,"swap ((char*)&";
FOR i = 2 TO Ndx
IF Stk$[i]= "," THEN EXIT FOR
FPRINT Outfile,Clean$(Stk$[i]);
NEXT
FPRINT Outfile,",(char*)&";
FOR j = i+1 TO Ndx
FPRINT Outfile,Clean$(Stk$[j]);
NEXT
FPRINT Outfile,",sizeof(";
FOR j = i+1 TO Ndx
FPRINT Outfile,Clean$(Stk$[j]);
NEXT
FPRINT Outfile,"));"
'***********************
CASE "rename"
'***********************
FPRINT Outfile,Scoot$,"MoveFile (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
FPRINT Outfile,");"
'***********************
CASE "copyfile"
'***********************
FPRINT Outfile,Scoot$,"CopyFile (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(TRIM$(Stk$[A]));
NEXT
Stk$[Ndx]=UCASE$(Stk$[Ndx])
SELECT CASE Stk$[Ndx]
CASE "TRUE", "FALSE", "1", "0"
FPRINT Outfile,Scoot$,");"
CASE ELSE
FPRINT Outfile,Scoot$,",FALSE);"
END SELECT
'***********************
CASE "msgbox" ' MsgBox Msg$,Title$,button
'***********************
j = 0
k = 0
FOR i = 2 TO Ndx
IF Stk$[i] = "[" THEN
j++
ELSEIF Stk$[i] = "]" THEN
j--
ELSEIF Stk$[i] = "(" THEN
j++
ELSEIF Stk$[i] = ")" THEN
j--
END IF
IF j = 0 AND Stk$[i] = "," THEN k++
NEXT
IF k = 0 THEN
Ndx++
Stk$[Ndx]= ","
Ndx++
Stk$[Ndx]= DDQ$
k = 1
END IF
IF k = 1 THEN
Ndx++
Stk$[Ndx]= ","
Ndx++
Stk$[Ndx]= "0"
END IF
FPRINT Outfile,Scoot$,"MessageBox (GetActiveWindow(),";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,");"
'***********************
CASE "shell"
'***********************
IF Ndx > 2 THEN
FOR A = 3 TO Ndx
Stk$[2] = Stk$[2] + Stk$[A]
NEXT
END IF
ZZ$ = Stk$[2]
IF ZZ$ = "" THEN ZZ$ = DDQ$
FPRINT Outfile,Scoot$ ; "system(" ; Clean$(ZZ$) ; ");"
'*****************************************************************************
CASE "lineinput" 'LINEINPUT fp1,A$
' LINEINPUT "prompt", A$ <<< Keyboard version 4.21
'*****************************************************************************
' Test for new keyboard version of LINE INPUT
i = DataType(Stk$[2])
IF i = vt_STRLIT OR i = vt_STRVAR THEN
IF i <> vt_STRLIT THEN Stk$[2] = Clean$(Stk$[2])
FPRINT Outfile,Scoot$,"printf(", ENC$("%s"), ",", Stk$[2], ");"
FPRINT Outfile,Scoot$,"gets(", Clean$(Stk$[3]), ");"
EXIT SELECT
END IF
' ********************* Okay, we're dealing with a file ************************
REMOVE "#" FROM Stk$[2]
IF DataType(Stk$[2]) = vt_NUMBER THEN
Stk$[2]= "FP" & Stk$[2]
END IF
Handle$ = EXTRACT$(Stk$[2], "[")
IF CheckLocal(Handle$, &i) = vt_UNKNOWN THEN
IF CheckGlobal(Handle$, &i) = vt_UNKNOWN THEN
CALL AddGlobal(Handle$, vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
Var$ = Clean$(Stk$[3])
Var1$ = ""
CVar$ = Var$
IF INCHR( Var$, "[" ) AND INCHR( Var$, "]" ) THEN
IF INSTR( Var$, "[++" ) THEN
REPLACE "++" WITH "" IN CVar$
END IF
IF INSTR( Var$, "[--" ) THEN
REPLACE "--" WITH "" IN CVar$
END IF
IF INSTR( Var$, "++]" ) THEN
REPLACE "++" WITH "" IN CVar$
Var1$ = MID$(Var$,INCHR(Var$,"[")+1)
Var1$ = EXTRACT$(Var1$,"]")
Var$ = CVar$
END IF
IF INSTR( Var$, "--]" ) THEN
REPLACE "--" WITH "" IN CVar$
Var1$ = MID$(Var$,INCHR(Var$,"[")+1)
Var1$ = EXTRACT$(Var1$,"]")
Var$ = CVar$
END IF
END IF
FPRINT Outfile,Scoot$, Var$ ; "[0]=0;"
FPRINT Outfile,Scoot$, "fgets(" ; Var$ ; ",1048576,"; Clean$(Stk$[2]) ; ");"
FPRINT Outfile,Scoot$, "if(" ; CVar$ ; "[strlen(" ;CVar$ ; ")-1]==10)";
FPRINT Outfile,CVar$ ; "[strlen(" ; CVar$ ; ")-1]=0;"
IF Var1$ <> "" THEN
FPRINT Outfile,Var1$ ; ";"
END IF
'*************************************************************************
CASE "open" 'OPEN filename$ FOR INPUT | OUTPUT | APPEND AS handle
'*************************************************************************
FOR A = 1 TO Ndx
Keyword$ = LCASE$(Stk$[A])
SELECT CASE Keyword$
CASE "open"
Stk$[A] = ""
CASE "for"
Stk$[A] = ""
Filnam$ = ""
FOR j = 2 TO A-1
CONCAT (Filnam$,Stk$[j])
NEXT
Filnam$ = Clean$(Filnam$)
CASE "as"
Stk$[A] = ""
IF DataType(Stk$[A + 1]) = vt_NUMBER THEN
Stk$[A + 1] = "FP" + Stk$[A + 1]
END IF
IF CheckLocal(Stk$[A + 1], &i) = vt_UNKNOWN THEN
IF CheckGlobal(Stk$[A + 1], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[A + 1], vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
Var$ = ""
FOR j = A+1 TO Ndx
IF iMatchWrd(Stk$[j], "reclen") THEN EXIT FOR
CONCAT (Var$,Stk$[j])
Stk$[j] = ""
NEXT
Handle$ = Var$ + "@"
CASE "input"
Op$ = ENC$("r")
Stk$[A] = ""
CASE "output"
Op$ = ENC$("w")
Stk$[A] = ""
CASE "append"
Op$ = ENC$("a")
Stk$[A] = ""
CASE "binary"
Op$ = ENC$("rb+")
Stk$[A] = ""
CASE "binaryappend"
Op$ = ENC$("ab+")
Stk$[A] = ""
CASE "binarynew"
Op$ = ENC$("wb+")
Stk$[A] = ""
CASE "binaryinput"
Op$ = ENC$("rb")
Stk$[A] = ""
CASE "binaryoutput"
Op$ = ENC$("rb+")
Stk$[A] = ""
CASE "reclen"
IF Stk$[A+1] = "=" THEN
FOR j = A+2 TO Ndx
Stk$[j-1] = Stk$[j]
NEXT
Ndx--
END IF
Var$ = EXTRACT$(Clean$(Handle$), "[") + "len"
IF CheckLocal(Var$, &i) = vt_UNKNOWN THEN
CALL AddGlobal(Var$, vt_INTEGER , 0,"",0,0,0)
ELSE
IF CheckLocal(Var$, &i) = vt_UNKNOWN THEN
CALL AddLocal(Var$, vt_INTEGER , 0,"",0,0)
Var$ = "int " + Var$
END IF
END IF
i = CheckType(Stk$[A+1])
ZZ$ = LCASE$(Stk$[A+1])
IF i = vt_STRUCT OR i = vt_UNION OR ZZ$ = "int" OR ZZ$ = "double" OR ZZ$ = "float" THEN
FPRINT Outfile,Scoot$,Var$ + " = sizeof(";Stk$[A+1];");"
ELSE
FPRINT Outfile,Scoot$,Var$ + " = ";Clean$(Stk$[A+1]);";"
END IF
Stk$[A] = ""
Stk$[A + 1] = ""
END SELECT
NEXT
IF UseFileTest THEN
FPRINT Outfile,Scoot$,"if((";Clean$(Handle$);"=fopen(";Filnam$;",";Op$;"))==0)"
FPRINT Outfile,Scoot$," {"
lszTmp$ = ENC$("Can't open file %s\\n")
FPRINT Outfile,Scoot$,"fprintf(stderr,";lszTmp$;",";Filnam$;");exit(1);"
FPRINT Outfile,Scoot$," }"
ELSE
FPRINT Outfile,Scoot$,Clean$(Handle$);"=fopen(";Filnam$;",";Op$;");"
END IF
'*************************************************************************
' Statement RECORD [#] filenumber,recordnumber [,location in record]
' Definition: Position the file pointer anywhere in a file.
' filenumber Filenumber from 1 to 99
' record number RECORD number to point to. Default first record
' location in record Optional location in RECORD. Default is Zero
' RECORD fp1, 6[, 10]
'*************************************************************************
CASE "record"
DIM AUTO ffp AS functionParse
DIM RAW numargs = 0
IF DataType(Stk$[2]) = vt_NUMBER THEN
Stk$[2]= "FP" + Stk$[2]
END IF
IF Ndx > 1 THEN numargs = SepFuncArgs(2, &ffp)
IF numargs < 1 THEN Abort("Missing required arguments to RECORD")
IF numargs > 4 THEN Abort("Too many arguments to RECORD")
IF numargs = 3 THEN
FPRINT Outfile,Scoot$,"fseek("; GetArg$(1, &ffp); _
", ("; GetArg$(2, &ffp); " - 1) * ";Stk$[2];"len + ";GetArg$(3, &ffp);", SEEK_SET);"
ELSEIF numargs = 2 THEN
FPRINT Outfile,Scoot$,"fseek("; GetArg$(1, &ffp); _
", ("; GetArg$(2, &ffp); " - 1) * ";Stk$[2];"len, SEEK_SET);"
ELSE
FPRINT Outfile,Scoot$,"fseek("; GetArg$(1, &ffp); ", 0, SEEK_SET);"
END IF
'***********************
CASE "fwrite" 'write handle,{list}
'***********************
IF DataType(Stk$[2]) = vt_NUMBER THEN
Stk$[2] = "FP" + Stk$[Ndx]
END IF
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
Handle$ = ""
FOR j = 2 TO Ndx
IF iMatchWrd(Stk$[j], ",") OR iMatchWrd(Stk$[j], ";") THEN
Stk$[j] = "" 'get rid of the Comma
EXIT FOR
END IF
Handle$ = Handle$ + Stk$[j]
Stk$[j] = "" 'get rid of handle
NEXT j
Handle$ = Handle$ + "@"
ZZ$ = "f" + PrintWriteFormat$(1)
ZZ$ = LEFT$(ZZ$,8) + Clean$(Handle$) + "," + MID$(ZZ$,9)
FPRINT Outfile,Scoot$, ZZ$
'***********************
CASE "close" 'CLOSE handle
'***********************
IF Ndx = 1 THEN
FPRINT Outfile,Scoot$, "_fcloseall();"
EXIT SELECT
END IF
IF DataType(Stk$[2]) = vt_NUMBER THEN
Stk$[2]= "FP" + Stk$[Ndx]
END IF
IF CheckLocal(Stk$[2], &i) = vt_UNKNOWN THEN
IF CheckGlobal(Stk$[2], &i) = vt_UNKNOWN THEN
CALL AddGlobal(Stk$[2], vt_FILEPTR, 0,"",0,0,0)
END IF
END IF
Handle$ = ""
FOR j = 2 TO Ndx
Handle$ = Handle$ + Stk$[j]
NEXT j
IF UseFileTest THEN
FPRINT Outfile,Scoot$,"if(",Handle$,")"
FPRINT Outfile,Scoot$," {"
FPRINT Outfile,Scoot$," fclose(";Handle$;");"
FPRINT Outfile,Scoot$," ";Handle$;"=NULL;"
FPRINT Outfile,Scoot$," }"
ELSE
FPRINT Outfile,Scoot$,"fclose(";Handle$;");"
END IF
'***********************
CASE "printer"
'***********************
IF iMatchWrd(Stk$[2],"open") THEN FPRINT Outfile,Scoot$,"PrinterOpen();"
IF iMatchWrd(Stk$[2],"ejectpage") THEN FPRINT Outfile,Scoot$,"EjectPage();"
IF iMatchWrd(Stk$[2],"close") THEN FPRINT Outfile,Scoot$,"PrinterClose();"
'***********************
CASE "call"
'***********************
lszTmp$ = ""
FOR Tmp = 2 TO Ndx
CONCAT(lszTmp$, Clean$(Stk$[Tmp]))
NEXT
IF NOT iMatchRgt(lszTmp$,")") THEN
CONCAT(lszTmp$, "()")
END IF
CONCAT(lszTmp$, ";")
FPRINT Outfile,Scoot$,lszTmp$
'*************************************************************************
CASE "declare"
'*************************************************************************
DIM AUTO FP AS functionParse
DIM RAW TempProto$
CALL FuncSubDecs1("sub") 'convert [] to pointer * and $[] to [][2048]
FOR integer i = 1 TO Ndx
IF Stk$[i] = "(" THEN
CALL SepFuncArgs(i+1,&FP)
EXIT FOR
END IF
NEXT
TempProto$ = MakeDecProto$(&FP)
IF NOT NoTypeDeclare THEN
FPRINT FP4, TempProto$, ";"
ELSE
ProtoCnt++
ProtoType[ProtoCnt].Prototype$ = TempProto$ + ";"
END IF
' IF InIfDef$ = "FP3" THEN
' ProtoType[ProtoCnt].Condition$ = ""
' ELSE
' ProtoType[ProtoCnt].Condition$ = InIfDef$
' END IF
'
' ProtoType[ProtoCnt].CondLevel = InConditional
'*************************************************************************
CASE "function", "sub"
'*************************************************************************
DIM RAW w = 0
IF Stk$[2] = "main" THEN
Stk$[1] = "function"
Stk$[2] = "main%"
ForceMainToFunc = TRUE
END IF
CALL FuncSubDecs1("sub")
IsStdFunc = FALSE
IF iMatchWrd(Stk$[Ndx],"stdcall") THEN
CallType$ = "__stdcall "
Ndx--
IsStdFunc = TRUE
END IF
InFunc = TRUE
InMain = FALSE
LocalVarCnt = 0
Outfile = FP3
CALL FuncSubDecs2("sub", mt_FuncSubDecC_Dec)
' to compensate previous substitutions errors not fixed
VarCode.Functype$ = LTRIM$(VarCode.Functype$)
Funcname$ = Clean$(Stk$[2])
IF IsExported OR IsStdFunc THEN
Funcname$ = CallType$ + Funcname$
END IF
' IF IsExported THEN Funcname$ = Funcname$ + Xport$
VarCode.Method% = mt_FuncSubDecC_Dec2
A = 3
WHILE A <= Ndx
IF Stk$[A+1] = "(" THEN ' sub/function ptr
FOR k = A+2 TO Ndx
IF Stk$[k] = ")" THEN
EXIT FOR
END IF
NEXT
IF iMatchWrd(Stk$[k+2], "sub") THEN
j = vt_VOID
VarCode.AsToken$ = "void"
ELSEIF iMatchWrd(Stk$[k+2], "function") THEN
CALL GetTypeInfo(Stk$[k+3], &IsPointer, &i, &j, &w)
VarCode.AsToken$ = Stk$[k+3]
END IF
VarCode.Token$ = Stk$[A]
VarCode.VarNo% = j
VarCode.IsPtrFlag = 1
VarCode.Method% = mt_FuncSubx1
CALL GetVarCode(&VarCode)
' IF InFunc THEN
Var$ = Clean$(Stk$[A])
lszTmp$ = ""
A += 2
WHILE A <= k
IF iMatchWrd(Stk$[A+1], "as") AND A < k THEN
Tmp = A + 2
WHILE Stk$[Tmp] <> "," AND Stk$[Tmp] <> ")"
CALL GetTypeInfo(Stk$[Tmp], &IsPointer, &i, &j, &w)
CALL AddLocal(Stk$[A], j, i, "", IsPointer,0)
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = Stk$[Tmp]
VarCode.VarNo% = j
VarCode.IsPtrFlag = 1
VarCode.Method% = mt_FuncSubx2
CALL GetVarCode(&VarCode)
Tmp++
IF Stk$[Tmp] = "," THEN
CONCAT(VarCode.Proto$,",")
CONCAT(VarCode.Header$,",")
END IF
WEND
A = Tmp
ELSE
IF Stk$[A] <> "," AND Stk$[A] <> ")" THEN
IsPointer = TALLY((Stk$[A]), "*")
Var$ = REMOVE$(Stk$[A], "*") ' in case we used ptr
j = DataType(Var$)
IF j <> vt_UNKNOWN AND InFunc = TRUE AND Var[0] THEN
CALL AddLocal(Clean(Var$), j, 0, "", IsPointer,0)
END IF
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = ""
VarCode.VarNo% = j
VarCode.IsPtrFlag = IsPointer
VarCode.Method% = mt_FuncSubDecC_Dec2
CALL GetVarCode(&VarCode)
END IF
END IF
A++
WEND
A = k+3
IF VarCode.Method% = mt_FuncSubDecC_Dec2 THEN
MID$(VarCode.Proto$,LEN(VarCode.Proto$)-1,1) = ")"
MID$(VarCode.Header$,LEN(VarCode.Header$)-1,1) = ")"
ELSE
CONCAT(VarCode.Proto$,")")
CONCAT(VarCode.Header$,")")
END IF
' END IF
VarCode.Method% = mt_FuncSubDecC_Dec2
ELSE
IF iMatchWrd(Stk$[A+1],"as") THEN
CALL GetTypeInfo(Stk$[A+2], &IsPointer, &i, &j, &w)
'IF InFunc THEN
Var$ = Clean$(Stk$[A])
CALL AddLocal(Var$, j, i, "", IsPointer,0)
'END IF
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = Stk$[A+2]
VarCode.VarNo% = j
VarCode.IsPtrFlag = IsPointer
CALL GetVarCode(&VarCode)
Stk$[A+1] = ""
Stk$[A+2] = ""
A+=2
ELSE
IF INCHR("=", Stk$[A]) AND Stk$[A] <> "" THEN
CALL Abort("Illegal optional parameter found")
END IF
IF NOT INCHR(",().",Stk$[A]) AND Stk$[A] <> "" THEN
IsPointer = TALLY((Stk$[A]), "*")
Var$ = REMOVE$(Stk$[A], "*") ' in case we used ptr
j = DataType(Var$)
IF j <> vt_UNKNOWN AND Var[0] THEN
CALL AddLocal(Clean(Var$), j, 0, "", IsPointer,0)
END IF
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = ""
VarCode.VarNo% = j
VarCode.IsPtrFlag = IsPointer
CALL GetVarCode(&VarCode)
END IF
END IF
END IF
A++
WEND
VarCode.Method% = 2
VarCode.Token$ = Funcname$
FuncSubDecs3(&VarCode)
IF iMatchLft(VarCode.Header$,"main(") THEN
VarCode.Header$ = "int main(int argc, char *argv[])"
VarCode.Proto$ = "int main(int argc, char *argv[]);"
CurrentFuncType = vt_INTEGER
END IF
IF Use_Static THEN
VarCode.Header$ = "static " + VarCode.Header$
VarCode.Proto$ = "static " + VarCode.Proto$
END IF
ProtoCnt++
ProtoType[ProtoCnt].Prototype$ = VarCode.Proto$
IF InIfDef$ = "FP3" THEN
ProtoType[ProtoCnt].Condition$ = ""
ELSE
ProtoType[ProtoCnt].Condition$ = InIfDef$
END IF
ProtoType[ProtoCnt].CondLevel = InConditional
IF *InIfDef$ THEN
IF InIfDef$ <> "FP3" THEN
FPRINT Outfile,InIfDef$
END IF
END IF
FPRINT Outfile,VarCode.Header$
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'***********************************************
CASE "optfunction", "optsub" ', "optdeclare"
'***********************************************
DIM RAW w = 0
CALL FuncSubDecs1("optsub")
InFunc = TRUE
LocalVarCnt = 0
Outfile = FP3
CALL FuncSubDecs2("optsub", mt_Opts)
Funcname$ = Clean$(Stk$[2])
' IF IsExported THEN
' CONCAT(Funcname$, Xport$)
' END IF
VarCode.Method% = mt_Opts2
A = 4
WHILE A < Ndx
IF Stk$[A] = "," THEN
VarCode.Method% = mt_Opts3
VarCode.Token$ = Stk$[A]
CALL GetVarCode(&VarCode)
VarCode.Method% = mt_Opts2
ELSEIF Stk$[A] = "=" THEN
VarCode.Method% = mt_Opts3
IF Stk$[A + 1] = "-" THEN
VarCode.Token$ = Stk$[A] + Stk$[A + 1] + Stk$[A + 2]
A++
ELSE
VarCode.Token$ = Stk$[A] + Stk$[A + 1]
END IF
CALL GetVarCode(&VarCode)
A++
VarCode.Method% = mt_Opts2
ELSEIF iMatchWrd(Stk$[A+1],"as") THEN
CALL GetTypeInfo(Stk$[A+2], &IsPointer, &i, &j, &w)
IF InFunc THEN
Var$ = Clean$(Stk$[A])
CALL AddLocal(Var$, j, i, "", IsPointer,0)
END IF
VarCode.VarNo% = j
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = Stk$[A+2]
VarCode.IsPtrFlag = IsPointer
CALL GetVarCode(&VarCode)
Stk$[A+1]= ""
Stk$[A+2]= ""
A++
A++
ELSE
IsPointer = TALLY((Stk$[A]),"*")
Var$ = REMOVE$(Stk$[A],"*") ' in case we used ptr
j = DataType(Var$)
IF j <> vt_UNKNOWN THEN
CALL AddLocal(Clean(Var$),j,0,"",IsPointer,0)
END IF
VarCode.VarNo% = j
VarCode.Token$ = Stk$[A]
VarCode.AsToken$ = ""
VarCode.IsPtrFlag = IsPointer
CALL GetVarCode(&VarCode)
END IF
A++
WEND
VarCode.Method% = 2
VarCode.Token$ = Funcname$
FuncSubDecs3(&VarCode)
IF Use_Static THEN
VarCode.Header$ = "static " + VarCode.Header$
VarCode.Proto$ = "static " + VarCode.Proto$
END IF
ProtoCnt++
ProtoType[ProtoCnt].Prototype$ = VarCode.Proto$
IF InIfDef$ = "FP3" THEN
ProtoType[ProtoCnt].Condition$ = ""
ELSE
ProtoType[ProtoCnt].Condition$ = InIfDef$
END IF
ProtoType[ProtoCnt].CondLevel = InConditional
FPRINT Outfile,VarCode.Header$
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'*******************************************
CASE "overloadedfunction", "overloadedsub"
'*******************************************
DIM RAW w = 0
Use_Overloaded = TRUE
CALL FuncSubDecs1("overloadedsub")
InFunc = TRUE
InMain = FALSE
LocalVarCnt = 0
Outfile = FP8 '<<----- writing TO BCX.OVR
CALL FuncSubDecs2("overloadedsub", mt_OverLoad)
Funcname$ = Clean$(Stk$[2])
' IF IsExported THEN
' CONCAT(Funcname$, Xport$)
' END IF
lszTmp$ = " overloaded " + Funcname$
Funcname$ = lszTmp$
VarCode.Method% = mt_OverLoad2
FOR A = 3 TO Ndx
IF iMatchWrd(Stk$[A+1],"as") THEN
CALL GetTypeInfo(Stk$[A+2], &IsPointer, &i, &j, &w)
Var$ = Clean$(Stk$[A])
CALL AddLocal(Var$, j, i, "", IsPointer,0)
VarCode.AsToken$ = Stk$[A+2]
Stk$[A+1] = ""
Stk$[A+2] = ""
ELSE
Var$ = REMOVE$(Stk$[A],"*") ' in case we used ptr
j = DataType(Var$)
IF NOT INCHR(",().",Stk$[A]) AND Stk$[A] <> "" THEN
IsPointer = TALLY((Stk$[A]),"*")
IF j <> vt_UNKNOWN AND InFunc = TRUE AND Var[0] THEN
CALL AddLocal(Clean(Var$), j, 0, "", IsPointer,0)
END IF
END IF
VarCode.AsToken$ = ""
END IF
VarCode.VarNo% = j
VarCode.Token$ = Stk$[A]
CALL GetVarCode(&VarCode)
NEXT
VarCode.Method% = 1
VarCode.Token$ = Funcname$
FuncSubDecs3(&VarCode)
IF Use_Static THEN
VarCode.Header$ = "static " + VarCode.Header$
END IF
FPRINT Outfile,VarCode.Header$
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'*******************************************************************
CASE "functionreturn" 'This is an alias TO "FUNCTION ="
'*******************************************************************
IF CaseFlag THEN NoBreak2 = TRUE
lszTmp$ = ""
FOR A = 3 TO Ndx
lszTmp$ = lszTmp$ + Stk$[A] + " "
NEXT
IF CurrentFuncType = vt_STRVAR THEN
lszTmp$ = "BCX_RetStr$ = " + lszTmp$
FuncRetnFlag = 1 '1 = return a string
UseFlag = TRUE
ELSE
FuncRetnFlag = 2 '2 = return a number
END IF
IF FuncRetnFlag = 2 THEN
'*********************************
' Clean up dynamic strings
'*********************************
IF LocalDynaCnt <> 0 THEN
FOR j = 1 TO LocalDynaCnt
FPRINT Outfile,Scoot$,DynaStr$[j]
NEXT
END IF
'*********************************
' Clean up dynamic strings arrays
'*********************************
IF LocalDynArrCount <> 0 THEN
FOR i = 1 TO LocalDynArrCount
FPRINT Outfile,Scoot$,LocalDynArrName$[i]
NEXT
END IF
'*********************************
FPRINT Outfile,Scoot$,"return ";
LastCmd = 2
END IF
CALL Parse(lszTmp$)
LastCmd = 0
GOTO EmitAgain
'*******************************
CASE "endfunction", "endsub"
'*******************************
' bc.500_com
IF lc_COM_names_index > 0 THEN
' cleaning local COM objects if user forgot to call xxx = Nothing for each declared object
CALL BCX_FreeLocalCOMObjects(TRUE)
END IF
' bc.500_com
IF iMatchWrd(Stk$[1],"endfunction") THEN
InWinMain = FALSE
LocalDynaCnt = 0
LocalDynArrCount = 0
IF InDialogEvt THEN
FPRINT Outfile,Scoot$,"if(Msg==WM_CLOSE) DestroyWindow(hWnd);"
FPRINT Outfile,Scoot$,"return 0;"
InDialogEvt = FALSE
END IF
IF ModDialogEvt THEN
FPRINT Outfile,Scoot$,"if(Msg==WM_CLOSE) EndDialog(hWnd,0);"
FPRINT Outfile,Scoot$,"return 0;"
ModDialogEvt = FALSE
END IF
IF CallBackFlag THEN
FPRINT Outfile,Scoot$,"return DefWindowProc(hWnd, Msg, wParam, lParam);"
CallBackFlag = FALSE
END IF
END IF
IF iMatchWrd(Stk$[1],"endsub") THEN
'**************************
' Clean up dynamic strings
'**************************
IF LocalDynaCnt <> 0 THEN
FOR j = 1 TO LocalDynaCnt
FPRINT Outfile,Scoot$,DynaStr$[j]
NEXT
LocalDynaCnt = 0
END IF
'*********************************
' Clean up dynamic strings arrays
'*********************************
IF LocalDynArrCount <> 0 THEN
FOR i = 1 TO LocalDynArrCount
FPRINT Outfile,Scoot$,LocalDynArrName$[i]
NEXT
LocalDynArrCount = 0
END IF
END IF
'*********************************
IF ForceMainToFunc = TRUE THEN
FPRINT Outfile,Scoot$,"return 0;"
ForceMainToFunc = FALSE
END IF
CALL BumpDown
FPRINT Outfile,Scoot$,"}\n\n"
CALL BumpDown
InFunc = FALSE
Use_Static = FALSE
IF Outfile = FP3 THEN
InIfDef$ = "FP3"
END IF
Outfile = FP2
ByrefCnt = 0
'***********************
CASE "input"
'***********************
CALL EmitInputCode
'***********************
CASE "finput"
'***********************
CALL EmitFileInputCode
'***********************
CASE "dynamic"
'***********************
DIM RAW w = 0
DIM RAW x = 0
DIM RAW SOF$
CALL HandleNonsense
CVar$ = Clean$(Stk$[2])
CALL ValidVar(CVar$)
IF Stk$[Ndx] = "*" THEN CALL PointerFix
ZZ$ = ""
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
SOF$ = Stk$[Ndx]
GetTypeInfo(SOF$, &w, &id, &vt, &x)
IF vt = vt_STRLIT OR vt = vt_DECFUNC OR vt = vt_NUMBER OR _
(vt = vt_VOID AND INCHR(Stk$[Ndx],"*") = 0) THEN
Abort(SOF$ + " is not a valid type")
END IF
Ndx -= 2
ELSE
vt = DataType(Stk$[2])
id = 0
SOF$ = GetVarTypeName$(vt)
END IF
Use_DynamicA = TRUE
UseFlag = TRUE
FOR i = 3 TO Ndx
CONCAT(ZZ$, Stk$[i])
NEXT
dms = TALLY(ZZ$,"][") + 1
IF dms > 1 THEN REPLACE "][" WITH "," IN ZZ$
RemoveAll(ZZ$,"[]")
IF vt = vt_STRVAR THEN
vt = vt_CHAR
SOF$ = "char"
dms++
CONCAT(ZZ$,",2048")
END IF
IF InFunc THEN
LocalDynArrCount++
LocalDynArrName$ [LocalDynArrCount] = "if (" + CVar$ + ") { DestroyArr((void **)" + CVar$ + "," + STR$(dms) + ", 1); " + CVar$ + "=NULL; }"
IF vt = vt_FILEPTR THEN
FPRINT Outfile,Scoot$,"FILE *";STRING$(dms,42);CVar$;"=0;"
ELSE
FPRINT Outfile,Scoot$,SOF$;" ";STRING$(dms,42);CVar$;"=0;"
END IF
CALL AddLocal(CVar$, vt, id,"",dms,0)
ELSE
IF Use_GenFree THEN
GlobalDynaCnt++
GlobalDynaStr$[GlobalDynaCnt] = "if (" + CVar$ + ") { DestroyArr((void **)" + CVar$ + "," + STR$(dms) + ", 1); " + CVar$ + "=NULL; }"
END IF
CALL AddGlobal(CVar$, vt, id,"",dms,0,0)
END IF
FPRINT Outfile,Scoot$,CVar$ ; "= ("; SOF$ ;STRING$(dms,42);")CreateArr ("; CVar$ ; ",sizeof(";SOF$;"),0,";TRIM$(STR$(dms));"," ; ZZ$ ; ");"
'***********************
CASE "redim"
'***********************
'REDIM b$ * 14
'REDIM PRESERVE b$ * 20
'REDIM a$[10]
'REDIM PRESERVE a$[20]
'***********************
DIM RAW IsPreserve = 0
DIM RAW SOF$
DIM RAW VI AS VarInfo PTR
DIM RAW vt1 = 0
DIM RAW IsSplat = 0
DIM RAW BC = 0
DIM RAW StartPoint
CALL HandleNonsense
IF iMatchWrd(Stk$[2],"preserve") THEN
IsPreserve = 1
vt1 = DataType(Stk$[3])
CVar$ = Clean$(Stk$[3])
IF Stk$[4] = "*" THEN IsSplat = 1
ELSE
vt1 = DataType(Stk$[2])
CVar$ = Clean$(Stk$[2])
IF Stk$[3] = "*" THEN IsSplat = 1
END IF
CALL ValidVar(CVar$)
IF Stk$[Ndx] = "*" THEN CALL PointerFix
'get info
vt = CheckLocal(CVar$, &id)
IF vt = vt_UNKNOWN THEN
vt = CheckGlobal(CVar$, &id)
IF vt = vt_UNKNOWN THEN
Abort("Can not REDIM " + CVar$ + " not previously dimensioned")
END IF
VI = &GlobalVars[id]
ELSE
VI = &LocalVars[id]
END IF
dms = VI->VarPntr
IF vt = vt_STRUCT OR vt = vt_UDT OR vt = vt_UNION THEN 'added vt_UNION 4.40
SOF$ = TypeDefs[VI->VarDef].VarName$
ELSE
SOF$ = GetVarTypeName$(vt)
END IF
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
IF SOF$ <> Stk$[Ndx] AND NOT iMatchWrd(Stk$[Ndx],"string") THEN
Abort("Can not change types for variable " + CVar$ + " previously defined as " + SOF$ + " on line" + STR$(VI->VarLine))
END IF
IF iMatchWrd(Stk$[Ndx],"string") THEN
Ndx--
Stk$[Ndx] = "["
Stk$[++Ndx] = "2048"
Stk$[++Ndx] = "]"
ELSE
Ndx -= 2
END IF
ELSE
IF (vt = vt_CHAR AND vt1 = vt_STRVAR AND IsSplat = 0) THEN
Ndx++
Stk$[Ndx] = "["
Stk$[++Ndx] = "2048"
Stk$[++Ndx] = "]"
END IF
END IF
IF (Stk$[3]="[" OR (IsPreserve AND Stk$[4] = "[")) THEN
IF IsPreserve THEN
StartPoint = 4
ELSE
FPRINT Outfile,Scoot$, "if (" + CVar$ + ") { DestroyArr((void **)" + CVar$ + "," + STR$(dms) + ", 1); " + CVar$ + "=NULL; }"
StartPoint = 3
END IF
Use_DynamicA =TRUE
UseFlag =TRUE
A = 0
ZZ$ = ""
FOR i = StartPoint TO Ndx
IF Stk$[i] = "[" THEN
A++
i++
BC = 1
WHILE BC > 0
IF Stk$[i] = "[" THEN
BC++
CONCAT(ZZ$, Stk$[i])
ELSE
IF Stk$[i] = "]" THEN
BC--
IF BC = 0 AND i < Ndx THEN
CONCAT(ZZ$, ",")
END IF
IF BC THEN
CONCAT(ZZ$, Stk$[i])
END IF
ELSE
CONCAT(ZZ$, Stk$[i])
END IF
END IF
i++
WEND
i--
END IF
NEXT
IF vt = vt_STRLIT OR vt = vt_DECFUNC OR vt = vt_NUMBER OR _
(vt = vt_VOID AND INCHR(Stk$[Ndx],"*") = 0) THEN
Abort(Stk$[Ndx] + " is not a valid type")
END IF
IF vt = vt_STRVAR THEN
SOF$ = "char"
A++
CONCAT(ZZ$,",2048")
END IF
IF A <> dms THEN
Abort("Mismatch in dimensions for " + CVar$ + ", orignally " + STR$(dms) + " found " + STR$(A))
END IF
FPRINT Outfile,Scoot$,CVar$ ; "= ("; SOF$ ;STRING$(dms,42);")CreateArr ("; CVar$ ; ",sizeof(";SOF$;"),";TRIM$(STR$(IsPreserve));",";dms;"," ; ZZ$ ; ");"
EXIT SELECT
END IF
IF Stk$[3]= "*" OR (IsPreserve AND Stk$[4]= "*") THEN ' DIM MySTRING$ * NumBytes
IF IsPreserve THEN
FPRINT Outfile,Scoot$ ; CVar$ ; "=(char*)realloc(";CVar$;",256+";
i = 5
ELSE
FPRINT Outfile,Scoot$ ; "free(" ; CVar$ ; ");"
FPRINT Outfile,Scoot$ ; CVar$ ; "=(char*)calloc(256+";
i = 4
END IF
FOR A = i TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
IF IsPreserve THEN
FPRINT Outfile,");"
ELSE
FPRINT Outfile,",1);"
END IF
EXIT SELECT
END IF
Abort("Invalid REDIM statement")
'*********************************************************
CASE "dim", "local", "raw", "static", "auto", "register"
'********************************************************
' DIM A$ * blah blah blah
' DIM a%[1000] (integer)
' DIM a![1000] (single)
' DIM a#[1000] (double)
' DIM a¦[1000] (long double)
' DIM A$[1000] (string)
' DIM r AS DATA_TYPE
' DIM r[1][2]...[n] AS DATA_TYPE
' DIM DYNAMIC A$[1000]
'********************************************************
DIM RAW w = 0
DIM RAW UseStatic$
IsSubOrFuncPtr = SubFuncTest()
CALL HandleNonsense
CVar$ = Clean$(Stk$[2])
CALL ValidVar(CVar$)
IF Stk$[Ndx] = "*" THEN CALL PointerFix
Cmd$ = LCASE$(Stk$[1])
VType = DataType(Stk$[2])
IsRegister = IsAuto = IsDim = IsLocal = IsStatic = IsRaw = FALSE
SELECT CASE Cmd$
CASE "dim" : IsDim = TRUE
CASE "local" : IsLocal = TRUE
CASE "static" : IsStatic = TRUE
CASE "raw" : IsRaw = TRUE
CASE "auto" : IsAuto = TRUE
CASE "register" : IsRegister = TRUE
END SELECT
'***********************************************************************
IF Stk$[3]= "*" THEN ' DIM MySTRING$ * NumBytes
CALL DimDynaString(CVar$, 0, 0)
EXIT SELECT
END IF
'*************************************************************************
IF IsSubOrFuncPtr THEN
CALL DimSubFunc(IsSubOrFuncPtr, 0, 0)
EXIT SELECT
END IF
'*************************************************************************
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
Var1$ = CVar$
IsPointer = TALLY(Stk$[Ndx],"*")
DimType$ = ""
lszTmp$ = ""
FOR i = 2 TO Ndx-2
CONCAT(lszTmp$, Stk$[i])
IF i > 2 THEN CONCAT(DimType$, Stk$[i])
NEXT
Var$ = REMOVE$(Stk$[Ndx],"*")
GetTypeInfo(Var$, &w, &id, &vt, &WorkingTypeDefsCnt)
IF vt = vt_STRVAR THEN
Stk$[Ndx] = "char"
Var$ = Stk$[Ndx]
CONCAT(DimType$, "[2048]")
CONCAT(lszTmp$, "[2048]")
END IF
IF InFunc OR InTypeDef THEN
IF IsRegister OR IsAuto THEN
IF IsRegister THEN
IF vt = vt_FILEPTR THEN
FPRINT Outfile,Scoot$,"register FILE* ";
ELSE
FPRINT Outfile,Scoot$,"register ";Stk$[Ndx];" ";
END IF
ELSE
IF vt = vt_FILEPTR THEN
FPRINT Outfile,Scoot$,"auto FILE* ";
ELSE
FPRINT Outfile,Scoot$,"auto ";Stk$[Ndx];" ";
END IF
END IF
ELSE
IF IsRaw = TRUE THEN
IF vt = vt_FILEPTR THEN
FPRINT Outfile,Scoot$,"static FILE* ";
ELSE
FPRINT Outfile,Scoot$,Stk$[Ndx];" ";
END IF
ELSE
IF InTypeDef THEN
UseStatic$ = ""
ELSE
UseStatic$ = "static "
END IF
IF vt = vt_STRUCT THEN
FPRINT Outfile,Scoot$,UseStatic$;"struct _" ; Stk$[Ndx]; " ";
ELSE
IF vt = vt_FILEPTR THEN
FPRINT Outfile,Scoot$,UseStatic$;"FILE *";
ELSE
FPRINT Outfile,Scoot$,UseStatic$;Stk$[Ndx] ; " ";
END IF
END IF
IF InTypeDef THEN
CALL AddTypedefElement(WorkingTypeDefsCnt,vt, CVar$, Var$)
END IF
END IF
END IF
IF InFunc AND NOT InTypeDef THEN
CALL AddLocal(Var1$, vt, id, DimType$, IsPointer,0)
END IF
FPRINT Outfile,Clean$(lszTmp$); ";"
IF NOT InTypeDef AND NOT IsStatic AND NOT IsRaw AND NOT IsRegister THEN
T$ = Clean$(EXTRACT$(lszTmp$,"["))
IF IsPointer THEN
FPRINT Outfile,Scoot$,"memset(&";T$;",0,sizeof(";Clean$(Var$) + " *";"));"
ELSE
FPRINT Outfile,Scoot$,"memset(&";T$;",0,sizeof(";T$;"));"
END IF
END IF
ELSE
CALL AddGlobal(Var1$, vt, id, DimType$,IsPointer,0,0)
END IF
EXIT SELECT
END IF
'*************************************************************************
IF InFunc OR InTypeDef THEN
lszTmp$ = ""
IF iMatchWrd(Stk$[3],"as") THEN
VType = CheckType(Stk$[4])
IF VType = vt_CHAR THEN
IF Stk$[5] = "*" THEN
lszTmp$ = "[" + Stk$[6] + "]"
END IF
END IF
ELSE
FOR i = 3 TO Ndx
CONCAT (lszTmp$, Stk$[i])
NEXT
lszTmp$ = LTRIM$(Clean$(lszTmp$))
IF VType = vt_STRVAR AND ((Stk$[3] = "" AND InTypeDef) OR (NOT InTypeDef)) THEN
IF lszTmp$ <> "[2048]" THEN CONCAT (lszTmp$, "[2048]")
END IF
END IF
j = (NOT InTypeDef AND NOT IsStatic AND NOT IsRaw AND NOT IsRegister)
IF j THEN
T$ = Clean$(EXTRACT$(CVar$,"["))
END IF
SELECT CASE VType
CASE vt_STRVAR
IF IsRaw THEN
FPRINT Outfile,Scoot$;"char ";CVar$;lszTmp$;";"
ELSEIF IsAuto THEN
FPRINT Outfile,Scoot$;"auto char ";CVar$;lszTmp$;";"
ELSEIF IsRegister THEN
FPRINT Outfile,Scoot$;"register char ";CVar$;lszTmp$;";"
ELSE
IF InTypeDef THEN
FPRINT Outfile,Scoot$;"char ";CVar$;lszTmp$;";"
ELSE
FPRINT Outfile,Scoot$;"static char ";CVar$;lszTmp$;";"
END IF
END IF
IF j THEN
FPRINT Outfile,Scoot$;"memset(&";T$;",0,sizeof(";T$;"));"
END IF
CASE vt_VarMin TO vt_VarMax
ZZ$ = GetVarTypeName$(VType)
ZZ$ = RPAD$(ZZ$, 7)
IF IsRaw THEN
FPRINT Outfile,Scoot$;ZZ$;" ";CVar$;lszTmp$;";"
ELSEIF IsAuto THEN
FPRINT Outfile,Scoot$;"auto ";ZZ$;" ";CVar$;lszTmp$;";"
ELSEIF IsRegister THEN
FPRINT Outfile,Scoot$;"register ";ZZ$;" ";CVar$;lszTmp$;";"
ELSE
IF InTypeDef THEN
FPRINT Outfile,Scoot$;ZZ$;" ";CVar$;lszTmp$;";"
ELSE
FPRINT Outfile,Scoot$;"static ";ZZ$;" ";CVar$;lszTmp$;";"
END IF
END IF
IF j THEN
FPRINT Outfile,Scoot$;"memset(&";T$;",0,sizeof(";T$;"));"
END IF
END SELECT
IF InFunc THEN
CALL AddLocal(CVar$, VType, 0, lszTmp$,0,0)
END IF
IF InTypeDef THEN
CALL AddTypedefElement(TypeDefsCnt,VType, CVar$,Var$)
END IF
EXIT SELECT
END IF
'************************************************************************
lszTmp$ = "" ' if we get here, we're creating with a GLOBAL variable
'************************************************************************
FOR i = 3 TO Ndx
CONCAT (lszTmp$, Stk$[i])
NEXT
IF VType = vt_STRVAR AND lszTmp$ <> "" THEN
CONCAT (lszTmp$, "[2048]")
END IF
CALL AddGlobal(CVar$, VType, 0,lszTmp$,0,0,0)
'***********************
CASE "extern"
'***********************
DIM RAW w = 0
DIM RAW x = 0
IsSubOrFuncPtr = SubFuncTest()
CALL HandleNonsense
CVar$ = Clean$(Stk$[2])
CALL ValidVar(CVar$)
IF Stk$[Ndx] = "*" THEN CALL PointerFix
IF Stk$[3] = "*" THEN
CALL DimDynaString(CVar$, 2, 0)
EXIT SELECT
END IF
IF IsSubOrFuncPtr THEN
CALL DimSubFunc(IsSubOrFuncPtr, 2, 0)
EXIT SELECT
END IF
Var$ = Clean$(Stk$[2])
CALL ValidVar(Var$)
IsPointer = 0
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
IF INCHR(Stk$[Ndx],"*") THEN
IsPointer = TALLY(Stk$[Ndx],"*")
Stk$[Ndx] = REMOVE$(Stk$[Ndx],"*")
END IF
DimType$ = ""
FOR i = 3 TO Ndx-2
CONCAT (DimType$, Stk$[i])
NEXT
GetTypeInfo(Stk$[Ndx], &w, &id, &vt, &x)
ELSE
DimType$ = ""
i = 3
WHILE i <= Ndx
CONCAT(DimType$,Stk$[i])
i++
WEND
vt = DataType(Stk$[2])
id = 0
END IF
IF vt = vt_STRVAR THEN ' AND DimType$ <> "" THEN
CONCAT (DimType$, "[2048]")
END IF
CALL AddGlobal(Var$, vt, id, DimType$, IsPointer,0,1)
'*************************
CASE "shared", "global"
'*************************
DIM RAW w = 0
DIM RAW x = 0
DIM RAW SOF$
DIM RAW IsShared
IsSubOrFuncPtr = SubFuncTest()
'
'CObjectTest()
'
CALL HandleNonsense
'? Stk$[2]
CVar$ = Clean$(Stk$[2])
'? CVar$
'? "1"
CALL ValidVar(CVar$)
IsShared = iMatchWrd(Stk$[1],"shared")
IF Stk$[Ndx] = "*" THEN CALL PointerFix
IF Stk$[3] = "*" THEN
CALL DimDynaString(CVar$, 1, IsShared)
EXIT SELECT
END IF
IF IsSubOrFuncPtr THEN
CALL DimSubFunc(IsSubOrFuncPtr, 1, IsShared)
EXIT SELECT
END IF
IF iMatchWrd(Stk$[2],"dynamic") THEN
CVar$ = Clean$(Stk$[3])
CALL ValidVar(CVar$)
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
SOF$ = Stk$[Ndx]
GetTypeInfo(SOF$, &w, &id, &vt, &x)
IF vt = vt_STRLIT OR _
vt = vt_DECFUNC OR _
vt = vt_NUMBER OR _
(vt = vt_VOID AND INCHR(Stk$[Ndx],"*") = 0) THEN
Abort(Stk$[Ndx] + " is not a valid type")
END IF
Ndx -= 2
ELSE
vt = DataType(Stk$[3])
id = 0
SOF$ = GetVarTypeName$(vt)
END IF
Use_DynamicA = TRUE
UseFlag = TRUE
ZZ$ = ""
FOR i = 4 TO Ndx
CONCAT(ZZ$, Stk$[i])
NEXT
dms = TALLY(ZZ$,"][") + 1
IF dms > 1 THEN REPLACE "][" WITH "," IN ZZ$
RemoveAll(ZZ$,"[]")
IF vt = vt_STRVAR THEN
vt = vt_CHAR
SOF$ = "char"
dms++
CONCAT(ZZ$,",2048")
END IF
IF Use_GenFree THEN
GlobalDynaCnt++
GlobalDynaStr$[GlobalDynaCnt] = "if (" + CVar$ + ") { DestroyArr((void **)" + CVar$ + "," + STR$(dms) + ", 1); " + CVar$ + "=NULL; }"
END IF
CALL AddGlobal(CVar$, vt, id,"",dms,0,0)
FPRINT Outfile,Scoot$,CVar$ ; "= ("; SOF$ ;STRING$(dms,42);")CreateArr ("; CVar$ ; ",sizeof(";SOF$;"),0,";TRIM$(STR$(dms));"," ; ZZ$ ; ");"
EXIT SELECT
END IF
Var$ = Clean$(Stk$[2])
CALL ValidVar(Var$)
IsPointer = 0
IF iMatchWrd(Stk$[Ndx-1],"as") THEN
IF INCHR(Stk$[Ndx],"*") THEN
IsPointer = TALLY(Stk$[Ndx],"*")
Stk$[Ndx] = REMOVE$(Stk$[Ndx],"*")
END IF
DimType$ = ""
FOR i = 3 TO Ndx-2
CONCAT (DimType$, Stk$[i])
NEXT
GetTypeInfo(Stk$[Ndx], &w, &id, &vt, &x)
ELSE
DimType$ = ""
i = 3
WHILE i <= Ndx
CONCAT(DimType$,Stk$[i])
i++
WEND
vt = DataType(Stk$[2])
id = 0
END IF
IF vt = vt_STRVAR THEN
CONCAT (DimType$, "[2048]")
END IF
IF IsShared THEN
CALL AddGlobal(Var$, vt, id, DimType$, IsPointer,0,2)
ELSE
CALL AddGlobal(Var$, vt, id, DimType$, IsPointer,0,0)
END IF
'*********************************************************************
CASE "while"
'*********************************************************************
' Speedup/Optimize for statements like ---> while a$ = "" THEN
' AND ---> while a$[1] = "" THEN
'*********************************************************************
DIM RAW sl = 0
TestString = DataType(Stk$[2])
IF TestString = vt_STRVAR THEN
IF Stk$[4] = DDQ$ THEN
Stk$[2] = Clean$(Stk$[2]) + "[0]"
Stk$[4] = "0"
END IF
END IF
IF TestString = vt_STRVAR THEN
IF Stk$[3] = "[" AND Stk$[7] = DDQ$ THEN
Stk$[2] = Clean$(Stk$[2])
CONCAT (Stk$[5],"[0]")
Stk$[7] = "0"
END IF
END IF
TestString = FALSE
FOR Tmp = 2 TO Ndx
IF Stk$[Tmp] <> "(" THEN EXIT FOR
NEXT
lszTmp$ = Stk$[Tmp]
A = DataType(lszTmp$)
IF A = vt_STRLIT OR A = vt_STRVAR THEN
IF Stk$[Tmp + 1] <> ")" THEN
TestString = TRUE
END IF
END IF
' '**************************
IF TestString THEN ' WHILE $ .. OR WHILE "" ..
IF USING_LINUX=1 THEN '**************************
FPRINT Outfile,Scoot$,"while(strcmp(";
ELSE
FPRINT Outfile,Scoot$,"while(str_cmp(";
END IF
Use_Str_Cmp = TRUE
UseFlag = TRUE
Tmp = 2
ZZ$ = ""
lbVarStr2:
DO
IF Stk$[Tmp] = "=" THEN
Stk$[Tmp] = ","
szTest$ = ")==0)"
sl = 4
ELSEIF Stk$[Tmp] = "!=" THEN
Stk$[Tmp] = ","
szTest$ = ")!=0)"
sl = 4
ELSEIF Stk$[Tmp] = ">" THEN
Stk$[Tmp] = ","
IF Stk$[Tmp+1] = "=" THEN
Stk$[Tmp+1] = ""
szTest$ = ")>=0)"
sl = 4
ELSE
szTest$ = ")>0)"
sl = 3
END IF
ELSEIF Stk$[Tmp] = "<" THEN
Stk$[Tmp] = ","
IF Stk$[Tmp+1] = "=" THEN
Stk$[Tmp+1] = ""
szTest$ = ")<=0)"
sl = 4
ELSE
szTest$ = ")<0)"
sl = 3
END IF
END IF
A = DataType(Stk$[Tmp+1]) ' look ahead
IF (A = vt_STRLIT OR A = vt_STRVAR) AND Stk$[Tmp+2] <> ")" THEN
Use_Str_Cmp = TRUE
UseFlag = TRUE
IF USING_LINUX=1 THEN
IF Stk$[Tmp]= "||" THEN Stk$[Tmp]= LEFT$(szTest$,sl) + " || strcmp("
IF Stk$[Tmp]= "&&" THEN Stk$[Tmp]= LEFT$(szTest$,sl) + " && strcmp("
ELSE
IF Stk$[Tmp]= "||" THEN Stk$[Tmp]= LEFT$(szTest$,sl) + " || str_cmp("
IF Stk$[Tmp]= "&&" THEN Stk$[Tmp]= LEFT$(szTest$,sl) + " && str_cmp("
END IF
ELSE
IF Stk$[Tmp]= "||" THEN
Stk$[Tmp]= LEFT$(szTest$,sl) + " || "
GOTO lbVarInt2
END IF
IF Stk$[Tmp]= "&&" THEN
Stk$[Tmp]= LEFT$(szTest$,sl) + " && "
GOTO lbVarInt2
END IF
END IF
FPRINT Outfile,Clean$(Stk$[Tmp]);
Tmp++
LOOP UNTIL Tmp > Ndx
FPRINT Outfile,szTest$
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
'*********
ELSE
'*********
FPRINT Outfile,Scoot$,"while(";
Tmp = 2
lbVarInt2:
DO
IF Stk$[Tmp] = "||" OR Stk$[Tmp] = "&&" THEN
A = DataType(Stk[Tmp+1])
IF (A = vt_STRLIT OR A = vt_STRVAR) AND Stk$[Tmp+2] <> ")" THEN
szTest$ = ""
GOTO lbVarStr2
END IF
END IF
IF Stk$[Tmp]= "!" THEN
FPRINT Outfile,Stk$[Tmp];
ELSE
FPRINT Outfile,Clean$(Stk$[Tmp]);
END IF
IF Stk$[Tmp] = "=" THEN
IF Stk$[Tmp-1] <> "<" AND Stk$[Tmp-1] <> ">" THEN
IF Stk$[Tmp+1] <> ">" AND Stk$[Tmp+1] <> "<" THEN
FPRINT Outfile,"=";
END IF
END IF
END IF
Tmp++
LOOP UNTIL Tmp > Ndx
FPRINT Outfile,")"
CALL BumpUp
FPRINT Outfile,Scoot$,"{"
CALL BumpUp
END IF
'***********************
CASE "wend","endwhile"
'***********************
CALL BumpDown
FPRINT Outfile,Scoot$,"}"
CALL BumpDown
'***********************
CASE "exit"
'***********************
IF CaseFlag THEN NoBreak2 = TRUE
IF iMatchWrd(Stk$[2],"sub") THEN
' bc.500_com
IF lc_COM_names_index > 0 THEN
' cleaning local COM objects if user forgot to call xxx = Nothing for each declared object
CALL BCX_FreeLocalCOMObjects(FALSE)
END IF
' bc.500_com
'*************************
' Clean up dynamic strings
'*************************
IF LocalDynaCnt <> 0 THEN
FOR j = 1 TO LocalDynaCnt
FPRINT Outfile,Scoot$,DynaStr$[j]
NEXT
END IF
'*********************************
' Clean up dynamic strings arrays
'*********************************
IF LocalDynArrCount <> 0 THEN
FOR i = 1 TO LocalDynArrCount
FPRINT Outfile,Scoot$, LocalDynArrName$[i]
NEXT
END IF
'*********************************
FPRINT Outfile,Scoot$,"return;"
EXIT SELECT
END IF
IF iMatchWrd(Stk$[2],"function") THEN
'*************************
' Clean up dynamic strings
'*************************
IF LocalDynaCnt <> 0 THEN
FOR j = 1 TO LocalDynaCnt
FPRINT Outfile,Scoot$,DynaStr$[j]
NEXT
END IF
'*********************************
' Clean up dynamic strings arrays
'*********************************
IF LocalDynArrCount <> 0 THEN
FOR i = 1 TO LocalDynArrCount
FPRINT Outfile,Scoot$, LocalDynArrName$[i]
NEXT
END IF
'*********************************
FPRINT Outfile,Scoot$,"return 0;"
ELSE
FPRINT Outfile,Scoot$,"break;"
END IF
'***********************
CASE "goto"
'***********************
IF CaseFlag THEN NoBreak2 = TRUE
FPRINT Outfile,Scoot$,"goto ";UCASE$(Stk$[2]);";"
'***********************
CASE "print"
'***********************
FPRINT Outfile,Scoot$ ; PrintWriteFormat$(0)
'***********************
CASE "write"
'***********************
FPRINT Outfile,Scoot$,PrintWriteFormat$(1)
'***********************
CASE "run"
'***********************
FPRINT Outfile,Scoot$,"Run (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,Scoot$,");"
'***********************
CASE "color"
'***********************
IF NoMain = TRUE OR MakeDLL = TRUE THEN
Use_Console = TRUE
FPRINT Outfile," hConsole = GetStdHandle (STD_OUTPUT_HANDLE);"
END IF
FPRINT Outfile,Scoot$,"color (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,Scoot$,");"
'***********************
CASE "locate"
'***********************
IF NoMain = TRUE OR MakeDLL = TRUE THEN
Use_Console = TRUE
FPRINT Outfile," hConsole = GetStdHandle (STD_OUTPUT_HANDLE);"
END IF
FPRINT Outfile,Scoot$,"locate (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,");"
'***********************
CASE "panel"
'***********************
IF NoMain = TRUE OR MakeDLL = TRUE THEN
Use_Console = TRUE
FPRINT Outfile," hConsole = GetStdHandle (STD_OUTPUT_HANDLE);"
END IF
FPRINT Outfile,Scoot$,"panel (";
FOR A = 2 TO Ndx
FPRINT Outfile,Clean$(Stk$[A]);
NEXT
FPRINT Outfile,");"
'***********************
CASE "cls"
'***********************
IF NoMain = TRUE OR MakeDLL = TRUE THEN
Use_Console = TRUE
FPRINT Outfile," hConsole = GetStdHandle (STD_OUTPUT_HANDLE);"
END IF
FPRINT Outfile,Scoot$,"cls();"
'**********************************************************************
CASE ELSE
'**********************************************************************
' "=" We MUST be processing an assignment statement if we get here!
' or perhaps calling a SUB without using the CALL keyword
'**********************************************************************
FOR B = 1 TO Ndx
IF Stk$[B]= "=" THEN EXIT FOR
NEXT
'*************************************************************************
'There's no "=" so we're either calling a SUB or this is a FUNCTION RETURN
'*************************************************************************
IF B-1 = Ndx THEN
lszTmp$ = ""
FOR Tmp = 1 TO Ndx
CONCAT(lszTmp$, Clean$(Stk$[Tmp]))
NEXT
CONCAT(lszTmp$, ";")
IF FuncRetnFlag = 2 THEN
FPRINT Outfile,lszTmp$
ELSE
FPRINT Outfile,Scoot$,lszTmp$
END IF
IF FuncRetnFlag = 2 THEN
FuncRetnFlag = 0
Stk$[1] = ""
EXIT SUB
END IF
EXIT SELECT
END IF
'*************************************************************************
' It can only be one thing now -- a normal assignment statement
'*************************************************************************
FOR i = 2 TO B-1
CONCAT(Stk$[1], Stk$[i]) ' IF present, build the Array Variable
NEXT
A = INCHR(Stk$[1], "*")
IF A THEN
IF NOT ( INCHR(Stk$[1], "$") AND A > 1 ) THEN 'Exclude strings BYREF
RemoveAll(Stk$[1], "$")
GOTO ProcessNumeric
END IF
END IF
'*************************************************************************
' 'processing a string equation
'*************************************************************************
LOCAL strtest, varid, vi AS VarInfo PTR, vr$, brcnt
strtest = DataType(Stk$[1])
IF strtest = vt_INTEGER THEN
brcnt = TALLY(Stk$[1], "[")
vr$ = EXTRACT$(Stk$[1], "[")
strtest = CheckLocal(vr$, &varid)
IF strtest = vt_UNKNOWN THEN
strtest = CheckGlobal(vr$, &varid)
vi = &(GlobalVars[varid])
ELSE
vi = &(LocalVars[varid])
END IF
IF strtest = vt_CHAR THEN
strtest = vt_STRVAR
END IF
IF strtest = vt_STRVAR THEN
IF vi->VarPntr <> 0 THEN
' string pointer
GOTO ProcessNumeric
END IF
IF TALLY(vi->VarDim,"[") = brcnt THEN
' the character within string
GOTO ProcessNumeric
END IF
IF TALLY(vi->VarDim,"[") <> brcnt+1 THEN
' string pointer
GOTO ProcessNumeric
END IF
END IF
END IF
IF strtest = vt_STRVAR THEN
'*************************************************************************
IF B+1 = Ndx THEN
IF Stk$[Ndx] = DDQ$ THEN
FPRINT Outfile,Scoot$,"*",Clean$(Stk$[1]),"=0;"
GOTO StringExit
END IF
END IF
' [ Speed up No. 1 ] ****************************************************
IF Ndx = 3 THEN
Stk$[1]=Clean$(Stk$[1])
Stk$[3]=Clean$(Stk$[3])
IF Stk$[1] = "BCX_RetStr" THEN
FPRINT Outfile,Scoot$,"BCX_RetStr=BCX_TmpStr(strlen(" ; Stk$[3] ; "));"
END IF
FPRINT Outfile,Scoot$,"strcpy(", Stk$[1], ",", Stk$[3], ");"
GOTO StringExit
END IF
'***********************
Arg$ = ""
lszTmp$ = ""
j=k=0
'***********************
IF iMatchLft(Stk$[3],"$$") THEN HasStorage = TRUE
Var$ = Clean$(Stk$[1])
IF Clean$(Stk$[B+1]) = Var$ THEN
k = TRUE
END IF
FOR A = B+1 TO Ndx ' B marks the position of the "=" char
IF Stk$[A]= "&" AND Stk$[A-1] <> "," AND Stk$[A-1] <> "(" THEN
INCR j
Arg$ = Arg$ + lszTmp$
lszTmp$ = ","
ELSE
CONCAT(lszTmp$, Clean$(Stk$[A]))
END IF
NEXT
IF *lszTmp <> 0 AND lszTmp$ <> "," THEN
Arg$ = Arg$ + lszTmp$
END IF
'*************************************************************************
' Rules
'*************************************************************************
' IF j = 0 & K = ANY THEN use strcpy
' IF j = 1 & K = TRUE THEN use strcat
' All else THEN use join
'*************************************************************************
RemoveAll(Var$, SPC$) 'Added this during the beta testing
'*** needs to be checked out still ***
'stk[++i] is getting here as stk [ + + i ]
IF j = 0 THEN
IF Var$ = "BCX_RetStr" THEN
IF HasStorage THEN
FPRINT Outfile,Scoot$,"BCX_RetStr=", Arg$, ";"
GOTO StringExit
ELSE
FPRINT Outfile,Scoot$,"BCX_RetStr=BCX_TmpStr(strlen(" , Arg$ , "));"
END IF
END IF
FPRINT Outfile,Scoot$,"strcpy(", Var$ , "," , Arg$, ");"
GOTO StringExit
END IF
'If we make it here then we should have 2 or more expressions
'
IF k = TRUE AND j = 1 THEN
FPRINT Outfile,Scoot$,"strcat(", Arg$ , ");"
GOTO StringExit
END IF
lszTmp$ = LTRIM$(STR$(++j))
Use_Join = UseFlag = TRUE
IF Var$ = "BCX_RetStr" THEN
FPRINT Outfile,Scoot$,"BCX_RetStr=join(" , lszTmp$ , "," , Arg$, ");"
ELSE
FPRINT Outfile,Scoot$,"strcpy(",Var$, ", join(" , lszTmp$ , "," , Arg$, "));"
END IF
StringExit:
EXIT SELECT
'***********************
ELSE
'***********************
ProcessNumeric:
'***********************
FOR i = 2 TO B
Stk$[i] = ""
NEXT
Stk$[B]= "=" 'This is necessary
' change x = x ? c to x ?= c
IF Stk$[B + 1] = Stk$[1] AND Ndx = 5 THEN
IF Inset(Stk$[B + 2], "+-*/") AND Stk$[B + 3] <> ">" THEN
Stk$[B] = Stk$[B + 2] + Stk$[B]
Stk$[B + 1] = ""
Stk$[B + 2] = ""
END IF
END IF
FPRINT Outfile,Scoot$,Clean$(Stk$[1]);
FOR A = 2 TO Ndx
IF Stk$[A] = "!" THEN
FPRINT Outfile,"!";
ELSE
FPRINT Outfile,Clean$(Stk$[A]);
END IF
NEXT
FPRINT Outfile,";"
END IF
END SELECT
IF FuncRetnFlag = 1 THEN
IF LocalDynaCnt <> 0 THEN
FOR j = 1 TO LocalDynaCnt
FPRINT Outfile,Scoot$,DynaStr$[j]
NEXT
END IF
'******************************************************************
FPRINT Outfile,Scoot$,"return BCX_RetStr;" ' $ FUNCTION Return
'******************************************************************
END IF
END SUB ' Emit
SUB Abort(Z$)
DIM RAW i = 0
DIM RAW j = 0
DIM RAW k = 0
DIM RAW varnum = 0
DIM RAW t$
DIM RAW frmt$
WarnMsg$ = ""
IF LEFT$(AbortSrc$,11) = "$BCXVERSION" THEN
CONCAT(WarnMsg$,Z$)
ELSE
WarnMsg$ = WarnMsg$ + Z$ + " at line" + STR$(ModuleLineNos[ModuleNdx]) + " in Module: " + TRIM$(Modules$[ModuleNdx]) + CRLF$
WarnMsg$ = WarnMsg$ + "Original line" + CRLF$
WarnMsg$ = WarnMsg$ + AbortSrc$ + CRLF$
WarnMsg$ = WarnMsg$ + "==============" + CRLF$
WarnMsg$ = WarnMsg$ + "Current Tokens" + CRLF$
WarnMsg$ = WarnMsg$ + "==============" + CRLF$
FOR k = 1 TO Ndx
j = LEN(Stk$[k])
IF j < 40 THEN
j = 40 - j
ELSE
j = 8 - IMOD(j,8)
END IF
frmt$ = LPAD$(STR$(k),3)
WarnMsg$ = WarnMsg$ + frmt$ + " " + Stk$[k] + STRING$(j,32) + CRLF$
t$ = Clean$(Stk$[k])
i = CheckLocal(t$, &varnum)
IF i <> vt_UNKNOWN THEN
WarnMsg$ = WarnMsg$ + "is a LOCAL defined at line" + STR$(LocalVars[varnum].VarLine)
WarnMsg$ = WarnMsg$ + " in Module: " + LocalVars[varnum].VarModule + CRLF$
ELSE
i = CheckGlobal(t$, &varnum)
IF i <> vt_UNKNOWN THEN
WarnMsg$ = WarnMsg$ + "is a GLOBAL defined at line" + STR$(GlobalVars[varnum].VarLine)
WarnMsg$ = WarnMsg$ + " in Module: " + GlobalVars[varnum].VarModule + CRLF$
WarnMsg$ = WarnMsg$ + " " + Stk$[k] & GlobalVars[varnum].VarDim$ + " as "
IF GlobalVars[varnum].VarDef THEN
WarnMsg$ = WarnMsg$ + TRIM$(TypeDefs[GlobalVars[varnum].VarDef].VarName$) + CRLF$
ELSE
WarnMsg$ = WarnMsg$ + TRIM$(GetVarTypeName$(GlobalVars[varnum].VarType)) + CRLF$
END IF
ELSE
IF Stk[k][0] = 34 THEN
WarnMsg$ = WarnMsg$ + "is a STRING LITERAL" + CRLF$
END IF
END IF
END IF
NEXT
WarnMsg$ = WarnMsg$ + "===============" + CRLF$
WarnMsg$ = WarnMsg$ + "Original Tokens" + CRLF$
WarnMsg$ = WarnMsg$ + "===============" + CRLF$
CALL XParse(AbortSrc$)
FOR k = 1 TO Ndx
j = LEN(Stk$[k])
IF j < 40 THEN
j = 40 - j
ELSE
j = 8 - IMOD(j,8)
END IF
frmt$ = LPAD$(STR$(k),3)
WarnMsg$ = WarnMsg$ + frmt$ + " " + Stk$[k] + STRING$(j,32) + CRLF$
t$ = Clean$(Stk$[k])
i = CheckLocal(t$, &varnum)
IF i <> vt_UNKNOWN THEN
WarnMsg$ = WarnMsg$ + "is a LOCAL defined at line" + STR$(LocalVars[varnum].VarLine)
WarnMsg$ = WarnMsg$ + " in Module: " + LocalVars[varnum].VarModule + CRLF$
ELSE
i = CheckGlobal(t$, &varnum)
IF i <> vt_UNKNOWN THEN
WarnMsg$ = WarnMsg$ + "is a GLOBAL defined at line" + STR$(GlobalVars[varnum].VarLine)
WarnMsg$ = WarnMsg$ + " in Module: " + GlobalVars[varnum].VarModule + CRLF$
WarnMsg$ = WarnMsg$ + " " + Stk$[k] & GlobalVars[varnum].VarDim$ + " as "
IF GlobalVars[varnum].VarDef THEN
WarnMsg$ = WarnMsg$ + TypeDefs[GlobalVars[varnum].VarDef].VarName$ + CRLF$
ELSE
WarnMsg$ = WarnMsg$ + GetVarTypeName$(GlobalVars[varnum].VarType) + CRLF$
END IF
ELSE
IF Stk[k][0] = 34 THEN
WarnMsg$ = WarnMsg$ + "is a string literal" + CRLF$
END IF
END IF
END IF
NEXT
END IF
WarnMsg$ = WarnMsg$ + CRLF$
CALL CloseAll
KILL ovrFile$
KILL FileOut$
KILL prcFile$
KILL udtFile$
KILL hdrFile$
KILL cstFile$
KILL datFile$
KILL setFile$
KILL enuFile$
KILL resFile$
KILL "$t$e$m$p"
IF ErrFile THEN
OPEN FileErr$ FOR APPEND AS fpErr
FPRINT fpErr, Z$ ; " at line" ; ModuleLineNos[ModuleNdx] ; " in Module: "; TRIM$(Modules$[ModuleNdx]) 'LinesRead
CLOSE fpErr
END IF
IF InfoBoxWarn THEN
INFOBOX("Error! " + FileIn$,WarnMsg$)
ELSE
PRINT "Error!",CRLF$, FileIn$,CRLF$, WarnMsg$
END IF
CALL FREEGLOBALS
END = 1
END SUB ' Abort
SUB BumpDown
Indent--
Indent--
IF Indent<0 THEN Indent = 0
Scoot$ = SPACE$(Indent)
END SUB ' BumpDown
SUB BumpUp
IF Indent<0 THEN Indent = 0
Indent++
Indent++
Scoot$ = SPACE$(Indent)
END SUB ' BumpUp
FUNCTION BraceCount( Arg$ )
DIM RAW p AS CHAR PTR
DIM RAW braces
p = Arg$
braces = 0
DO
IF *p = 0 THEN FUNCTION = braces
IF *p = c_DblQt THEN
p++
WHILE *p <> c_DblQt
IF *p = 0 THEN FUNCTION = braces
p++
WEND
END IF
IF *p = ASC("}") THEN braces--
IF *p = ASC("{") THEN braces++
p++
LOOP
FUNCTION = braces
END FUNCTION ' BraceCount
FUNCTION BracketHandler(Src$,l) AS CHAR PTR
DIM RAW s AS CHAR PTR
s = Src$
SELECT CASE l
CASE 0
DO
IF *s = 0 THEN EXIT LOOP
IF *s = c_DblQt THEN
s++
WHILE *s <> c_DblQt
IF *s = 0 THEN EXIT LOOP
s++
WEND
END IF
IF *s = c_LtBkt THEN
s++
s = BracketHandler(s,1)
END IF
IF *s = c_LPar THEN
s++
s = BracketHandler(s,2)
END IF
s++
LOOP
CASE 1
WHILE *s <> c_RtBkt
IF *s = c_DblQt THEN
s++
WHILE *s <> c_DblQt
IF *s = 0 THEN EXIT LOOP
s++
WEND
END IF
IF *s = c_LtBkt THEN
s++
s = BracketHandler(s, 1)
END IF
IF *s = c_LPar THEN
s++
s = BracketHandler(s, 2)
END IF
IF *s = c_Komma THEN *s = 1
IF *s = 0 THEN EXIT LOOP
s++
WEND
CASE 2
WHILE *s <> c_RPar
IF *s = c_DblQt THEN
s++
WHILE *s <> c_DblQt
IF *s = 0 THEN EXIT LOOP
s++
WEND
END IF
IF *s = c_LtBkt THEN
s++
s = BracketHandler(s, 1)
END IF
IF *s = c_LPar THEN
s++
s = BracketHandler(s, 2)
END IF
IF *s = 0 THEN EXIT LOOP
s++
WEND
END SELECT
IF l = 0 THEN
REPLACE CHR$(1) WITH "][" IN Src$
FUNCTION = Src
END IF
FUNCTION = s
END FUNCTION ' BracketHandler
SUB Push(Z$)
CaseStk$[++Pusher]= Z$
END SUB
SUB Pop(Z$)
Z$ = CaseStk$[--Pusher]
END SUB ' Pop
SUB EmitEpilog
IF Use_Wingui + MakeDLL + NoMain + EndOfProgram = 0 THEN
FPRINT Outfile," return 0; // End of main program"
FPRINT Outfile,"}"
FLUSH(Outfile)
CALL BumpDown
END IF
END SUB ' EmitEpilog
SUB EmitProlog
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: INCLUDE FILES"
ELSE
FPRINT Outfile,"// *************************************************************"
FPRINT Outfile,"// Created with BCX -- The BASIC To C Translator (ver ";
FPRINT Outfile,Version$;")"
FPRINT Outfile,"// BCX (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005 by Kevin Diggins"
FPRINT Outfile,"// *************************************************************"
END IF
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
FPRINT Outfile,"#include // Win32 Header File "
IF USING_LINUX=0 THEN FPRINT Outfile,"#include "
IF USING_LINUX=0 THEN FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
IF USING_LINUX=0 THEN FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
FPRINT Outfile,"#include "
IF USING_LINUX=0 THEN FPRINT Outfile,"#include "
FPRINT Outfile,""
IF Use_Library THEN
FPRINT Outfile,"// END BCXRTHEADER\n\n"
FPRINT Outfile,""
ELSE
FPRINT Outfile,"int main(int argc, char *argv[])"
'*****************************************************************************
' int main is conditionally removed later IN SUB AddProtos
'*****************************************************************************
END IF
FLUSH (Outfile)
END SUB ' EmitProlog
SUB DeclareVariables
DIM RAW i
DIM RAW A
DIM RAW P$
DIM RAW VAR$
DIM RAW VarName$
DIM RAW VarDim$
DIM RAW Storage$
OPEN FileOut$ FOR INPUT AS FP1
OPEN "$t$e$m$p" FOR OUTPUT AS Outfile
FOR A = 1 TO IncludeCount+4
LINE INPUT FP1,Z$
' added condition that Use_Project is false or $NOWIN is ignored
IF WinHeaders = FALSE AND Use_Project = FALSE THEN
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
IF INSTR(Z$,"#include ") THEN Z$ = ""
END IF
IF Z$ > "" THEN FPRINT Outfile,Z$
NEXT
OPEN cstFile$ FOR INPUT AS FP3
IF LOF(cstFile$) > 0 THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER DEFINED CONSTANTS"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_USR_CONST
FPRINT Outfile,"// *************************************************"
END IF
FPRINT Outfile,""
END IF
WHILE NOT EOF(FP3)
LINE INPUT FP3,Z$
FPRINT Outfile,LTRIM$(Z$)
WEND
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
CLOSE FP3
OPEN udtFile$ FOR INPUT AS FP3
IF LOF(udtFile$)>0 THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER DEFINED TYPES AND UNIONS"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_USR_TYPES
FPRINT Outfile,"// *************************************************"
END IF
WHILE NOT EOF(FP3)
LINE INPUT FP3,Z$
FPRINT Outfile,Scoot$,Z$
WEND
IF Use_Library THEN FPRINT FP3,"// END BCXRTHEADER\n\n"
END IF
CLOSE FP3
IF HFileCnt > 0 THEN
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// User Include Files"
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
A = 0
WHILE A < HFileCnt
FPRINT Outfile,HFiles$[A]
A++
WEND
END IF
IF Use_SingleFile = TRUE OR Use_Project = TRUE THEN
IF Use_Console OR _
Use_Findfirst OR _
Use_Findnext OR _
Use_Gosub OR _
UseFlag OR _
Use_Date OR _
Use_Crlf OR _
Use_Inputbox OR _
Use_Infobox OR _
Use_Inputbuffer OR _
Use_BCX_Splitter OR _
Use_Dynacall THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: SYSTEM VARIABLES"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// "+$BCX_STR_SYS_VARS
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
END IF
'IF Use_Wingui THEN CALL AddGUIGlobals
IF Use_BCX_Splitter THEN
FPRINT Outfile,"static COLORREF SplitBarFG=RGB(0,0,255);"
FPRINT Outfile,"static COLORREF SplitBarBG=RGB(212,212,212);"
FPRINT Outfile,"#define SPLITBAR_SIZE 2"
FPRINT Outfile,"#define MIN_PANESIZE 4"
FPRINT Outfile,""
FPRINT Outfile,"typedef struct _SPLITTERINFO"
FPRINT Outfile,"{"
FPRINT Outfile," int swsStyle;"
FPRINT Outfile," int splittype;"
FPRINT Outfile," HCURSOR hCursor;"
FPRINT Outfile," HWND hwPane1;"
FPRINT Outfile," HWND hwPane2;"
FPRINT Outfile," BOOL fMovingBar;"
FPRINT Outfile," int percent;"
FPRINT Outfile,"}SPLITTERINFO, *LPSPLITTERINFO;"
FPRINT Outfile,""
END IF
IF Use_Ldouble THEN
FPRINT Outfile,"#define LDOUBLE long double"
END IF
IF Use_Idxqsort THEN
FPRINT Outfile,"char*** pppStr;"
END IF
IF Use_Idxqsort OR Use_IdxqsortSt OR Use_PtrqsortSt THEN
FPRINT Outfile,"int Key;"
END IF
IF Use_IdxqsortSt THEN
FPRINT Outfile,"char* cmp1;"
FPRINT Outfile,"int StructSize;"
END IF
IF Use_PtrqsortSt THEN
FPRINT Outfile,"int OffSet;"
END IF
IF Use_Sound THEN
FPRINT Outfile,""
FPRINT Outfile,"#define SNDQUE 10000"
FPRINT Outfile,""
FPRINT Outfile,"typedef struct _soundtype"
FPRINT Outfile,"{"
FPRINT Outfile," FLOAT Freq;"
FPRINT Outfile," INT Dura;"
FPRINT Outfile," INT Vol;"
FPRINT Outfile," INT Voice;"
FPRINT Outfile," FLOAT Tempo;"
FPRINT Outfile," INT sndTid;"
FPRINT Outfile,"} soundtype, *LPSOUNDTYPE;"
FPRINT Outfile,""
IF Use_Project THEN
FPRINT Outfile,"soundtype SndPmtr[SNDQUE+1];"
FPRINT Outfile,"UINT gTenter;"
FPRINT Outfile,"UINT gTwait;"
FPRINT Outfile,"UINT gTexit;"
FPRINT Outfile,"UINT gTarray;"
FPRINT Outfile,"BOOL gTsig;"
FPRINT Outfile,"HANDLE gSThread=NULL;"
ELSE
FPRINT Outfile,"static soundtype SndPmtr[SNDQUE+1];"
FPRINT Outfile,"static UINT gTenter;"
FPRINT Outfile,"static UINT gTwait;"
FPRINT Outfile,"static UINT gTexit;"
FPRINT Outfile,"static UINT gTarray;"
FPRINT Outfile,"static BOOL gTsig;"
FPRINT Outfile,"static HANDLE gSThread=NULL;"
END IF
FPRINT Outfile,""
END IF
IF Use_BCX_Fontdlg THEN
FPRINT Outfile,""
FPRINT Outfile,"typedef struct _BCX_FONT_TYPE"
FPRINT Outfile,"{"
FPRINT Outfile," LOGFONT lf;"
FPRINT Outfile," int SIZE;"
FPRINT Outfile," int RGB;"
FPRINT Outfile,"} BCX_FONT_TYPE;"
FPRINT Outfile,""
IF Use_Project THEN
FPRINT Outfile,"BCX_FONT_TYPE BCX_FONT;"
ELSE
FPRINT Outfile,"static BCX_FONT_TYPE BCX_FONT;"
END IF
FPRINT Outfile,""
END IF
' bc.500_com
IF Use_COM THEN
EmitCOMSupportTypes()
END IF
' bc.500_com
IF Use_Date THEN
FPRINT Outfile,"char Date [2048];"
END IF
IF Use_Inputbox THEN
FPRINT Outfile,"char BCX_INPUTBOX_VAL[2048];"
END IF
IF Use_NUL THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char NUL [1]={0}; // Null"
END IF
IF Use_BEL THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char BEL [2]={7,0}; // Bell"
END IF
IF Use_BS THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char BS [2]={8,0}; // Back Space"
END IF
IF Use_TAB THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char TAB [2]={9,0}; // Horz Tab"
END IF
IF Use_LF THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char LF [2]={10,0}; // Line Feed"
END IF
IF Use_VT THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char VT [2]={11,0}; // Vert Tab"
END IF
IF Use_FF THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char FF [2]={12,0}; // Form Feed"
END IF
IF Use_CR THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char CR [2]={13,0}; // Carr Rtn"
END IF
IF Use_EOF THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char EF [2]={26,0}; // End-of-File"
END IF
IF Use_ESC THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char ESC [2]={27,0}; // Escape"
END IF
IF Use_SPC THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char SPC [2]={32,0}; // Space"
END IF
IF Use_DQ THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char DQ [2]={34,0}; // Double-Quote"
END IF
IF Use_DDQ THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char DDQ [3]={34,34,0}; // Double-Double-Quote"
END IF
IF Use_Crlf THEN
IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"char CRLF[3]={13,10,0}; // Carr Rtn & Line Feed"
END IF
IF Use_Console THEN
FPRINT Outfile,"COORD cursor;"
FPRINT Outfile,"HANDLE hConsole;"
'IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"int color_fg = 7;"
'IF Use_Project THEN FPRINT Outfile,"static ";
FPRINT Outfile,"int color_bg = 0;"
END IF
IF Use_Scan THEN
FPRINT Outfile,"int ScanError;"
END IF
IF Use_Inputbuffer = TRUE THEN
FPRINT Outfile,"char InputBuffer[1048576];"
END IF
IF Use_Hook THEN
FPRINT Outfile,"HHOOK CmDlgHook;"
END IF
IF Use_Findfirst OR Use_Findnext THEN
FPRINT Outfile,"HANDLE FileHandle;"
FPRINT Outfile,"WIN32_FIND_DATA FindData;"
END IF
IF Use_Gosub THEN
FPRINT Outfile,"jmp_buf GosubStack[32];"
FPRINT Outfile,"int GosubNdx;"
END IF
IF Use_Dynacall THEN
' IF DllCnt THEN
' Abort("Incompatible DLL function call methods detected")
' ELSE
FPRINT Outfile,"HINSTANCE BCX_DllStore[256];"
' END IF
END IF
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
END IF
IF GlobalVarCnt THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER GLOBAL VARIABLES"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_USR_VARS
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
END IF
'*************************************
'Add Declared Dll variables
'*************************************
IF DllCnt THEN
FOR INTEGER i = 1 TO DllCnt
FPRINT Outfile, "static BCXFPROT", LTRIM$(STR$(i)), " ", EXTRACT$(DllDecl$[i],"="), ";"
NEXT
END IF
'*************************************
'First we declare the simple Variables
'*************************************
FOR i = 1 TO GlobalVarCnt
IF "" = GlobalVars[i].VarDim$ AND GlobalVars[i].VarCondLevel = 0 THEN
P$ = ""
IF GlobalVars[i].VarPntr THEN P$ = STRING$(GlobalVars[i].VarPntr,42)
A = GlobalVars[i].VarType
IF GlobalVars[i].VarSF THEN
VarName$ = "(*" + GlobalVars[i].VarName$ + ")"
ELSE
VarName$ = GlobalVars[i].VarName$
END IF
Storage$ = VarStorage$[GlobalVars[i].VarExtn]
SELECT CASE A
' handle exceptions
CASE vt_FILEPTR
REMOVE "@" FROM VarName$
FPRINT Outfile,Storage$;"FILE *";P$;VarName$;";"
CASE vt_UDT, vt_STRUCT, vt_UNION
VAR$ = TypeDefs[GlobalVars[i].VarDef].VarName$
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;";"
CASE vt_LPSTRPTR
FPRINT Outfile,Storage$;"LPSTR *";VarName$;";"
CASE vt_LPSTR
FPRINT Outfile,Storage$;"LPSTR ";P$;VarName$;";"
CASE vt_BOOL
FPRINT Outfile,Storage$;"BOOL ";VarName$;";"
CASE vt_STRVAR
FPRINT Outfile,Storage$;"char ";P$;VarName$;"[2048];"
CASE vt_WNDCLASSEX
FPRINT Outfile,Storage$;"WNDCLASSEX ";P$;VarName$;";"
' handle normal
CASE vt_VarMin TO vt_VarMax
VAR$ = GetVarTypeName$(GlobalVars[i].VarType)
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;";"
END SELECT
END IF
NEXT
' Next, we declare the Arrays
FOR i = 1 TO GlobalVarCnt
IF "" <> GlobalVars[i].VarDim$ AND GlobalVars[i].VarCondLevel = 0 THEN
P$ = ""
IF GlobalVars[i].VarPntr THEN P$ = STRING$(GlobalVars[i].VarPntr,42)
A = GlobalVars[i].VarType
IF GlobalVars[i].VarSF THEN
VarName$ = "(*" + GlobalVars[i].VarName$ + ")"
ELSE
VarName$ = GlobalVars[i].VarName$
END IF
VarDim$ = GlobalVars[i].VarDim
Storage$ = VarStorage$[GlobalVars[i].VarExtn]
SELECT CASE A
' handle exceptions
CASE vt_STRVAR
FPRINT Outfile,Storage$;"char ";VarName$;VarDim$;";"
CASE vt_FILEPTR
REMOVE "@" FROM GlobalVars[i].VarName$
FPRINT Outfile,Storage$;"FILE *";VarName$;VarDim$;";"
CASE vt_LPSTR
FPRINT Outfile,Storage$;"LPSTR ";P$;VarName$;VarDim$;";"
CASE vt_BOOL
FPRINT Outfile,Storage$;"BOOL ";VarName$;VarDim$;";"
' handle normal
CASE vt_UDT, vt_STRUCT, vt_UNION
VAR$ = TypeDefs[GlobalVars[i].VarDef].VarName$
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;VarDim$;";"
CASE vt_VarMin TO vt_VarMax
VAR$ = GetVarTypeName$(GlobalVars[i].VarType)
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;VarDim$;";"
END SELECT
END IF
NEXT
DIM RAW LastDef$
DIM RAW LastLevel
LastDef$ = ""
LastLevel = 1
FOR i = 1 TO GlobalVarCnt
IF GlobalVars[i].VarCondLevel THEN
IF LastDef$ = "" THEN
LastDef$ = GlobalVars[i].VarCondDef$
LastLevel = GlobalVars[i].VarCondLevel
FPRINT Outfile,LastDef$
END IF
IF LastDef$ <> GlobalVars[i].VarCondDef$ THEN
IF GlobalVars[i].VarCondDef$ = "#else" THEN
WHILE LastLevel > GlobalVars[i].VarCondLevel
FPRINT Outfile,"#endif"
LastLevel--
WEND
FPRINT Outfile,"#else"
LastDef$ = GlobalVars[i].VarCondDef$
ELSE
WHILE LastLevel => GlobalVars[i].VarCondLevel
FPRINT Outfile,"#endif"
LastLevel--
WEND
LastDef$ = GlobalVars[i].VarCondDef$
LastLevel = GlobalVars[i].VarCondLevel
FPRINT Outfile,LastDef$
END IF
END IF
P$ = ""
IF GlobalVars[i].VarPntr THEN P$ = STRING$(GlobalVars[i].VarPntr,42)
A = GlobalVars[i].VarType
IF GlobalVars[i].VarSF THEN
VarName$ = "(*" + GlobalVars[i].VarName$ + ")"
ELSE
VarName$ = GlobalVars[i].VarName$
END IF
VarDim$ = GlobalVars[i].VarDim
Storage$ = VarStorage$[GlobalVars[i].VarExtn]
SELECT CASE A
' handle exceptions
CASE vt_STRVAR
FPRINT Outfile,Storage$;"char ";VarName$;VarDim$;";"
CASE vt_FILEPTR
REMOVE "@" FROM GlobalVars[i].VarName$
FPRINT Outfile,Storage$;"FILE *";VarName$;VarDim$;";"
CASE vt_LPSTR
FPRINT Outfile,Storage$;"LPSTR ";P$;VarName$;VarDim$;";"
CASE vt_BOOL
FPRINT Outfile,Storage$;"BOOL ";VarName$;VarDim$;";"
' handle normal
CASE vt_UDT, vt_STRUCT, vt_UNION
VAR$ = TypeDefs[GlobalVars[i].VarDef].VarName$
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;VarDim$;";"
CASE vt_VarMin TO vt_VarMax
VAR$ = GetVarTypeName$(GlobalVars[i].VarType)
VAR$ = RPAD$(VAR$, 7)
FPRINT Outfile,Storage$;VAR$;" ";P$;VarName$;VarDim$;";"
END SELECT
END IF
NEXT
IF *LastDef$ THEN
WHILE LastLevel
FPRINT Outfile,"#endif"
LastLevel--
WEND
END IF
FPRINT Outfile,""
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
'********************************
' Read In The Data Statement File
'********************************
OPEN datFile$ FOR INPUT AS FP5
IF LOF(datFile$) > 0 THEN
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// User Data Statements"
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
FPRINT Outfile,"char * DATA [] ="
FPRINT Outfile,"{"
WHILE NOT EOF(FP5)
LINE INPUT FP5,Z$
FPRINT Outfile,Z$
WEND
FPRINT Outfile,"};"
END IF
CLOSE FP5
WHILE NOT EOF(FP1)
LINE INPUT FP1,Z$
FPRINT Outfile,Z$
WEND
CALL CloseAll
KILL FileOut$
RENAME "$t$e$m$p", FileOut$
END SUB 'DeclareVariables
SUB PreParse(Arg$)
'********************************************
' Stk$[) AND Ndx must be declared GLOBAL
' and are re-initialized WITH each invocation
'*********************************************
DIM RAW szChar$
DIM RAW Strlit$
DIM RAW Anyword$
DIM RAW Counter
DIM RAW TT
DIM RAW Tmp
DIM RAW Arglen
DIM RAW A
DIM RAW j
'********************************************************************
Anyword$ = "" ' This is the only local that needs to be initialized
'********************************************************************
Ndx = 0
Arg$ = RTRIM$(Arg$)
IF Arg$ = "" THEN
Ndx = 0
EXIT SUB
END IF
'********************
FOR Tmp = 0 TO 15
Stk$[Tmp] = ""
NEXT
'********************
Arglen = LEN(Arg$)
Counter = 0
WHILE Counter <= Arglen
IF Ndx => 4096 THEN Abort("Overflowed Parse Stack")
Counter++
szChar[0] =Arg[Counter-1] 'This eliminates using MID$
szChar[1] = 0 'Remember to null terminate
TT = ASC(szChar$)
'***************************************
SELECT CASE TT
'***************************************
CASE 34 'Identify string literals
'****************************************
Strlit$ = szChar$
szChar$ = ""
DO
IF szChar$ = DQ$ THEN EXIT LOOP
Counter++
IF Counter = Arglen THEN
szChar[0] = Arg[Counter-1] 'This eliminates using MID$
szChar[1] = 0 'Remember to null terminate
CONCAT (Strlit$,szChar$)
IF szChar$ <> DQ$ THEN
CONCAT (Strlit$,DQ$) 'Allow unquoted END of string
END IF
EXIT LOOP
END IF
szChar[0] = Arg[Counter-1] 'This eliminates using MID$
szChar[1] = 0 'Remember to null terminate
CONCAT (Strlit$,szChar$)
LOOP
Ndx++
Stk$[Ndx]= Strlit$
'***************
CASE 32 ' SPACE
'***************
IF Anyword[0] THEN
Ndx++
Stk$[Ndx] = Anyword$
Anyword$ = ""
END IF
' *****************************************************************
' = & ( ) [ ] ' , + - * / ? < > ; | : ^
CASE 61,38,40,41,91,93,39,44,43,45,42,47,63,60,62,59,124,58,94
'******************************************************************
IF LEN(Anyword$) THEN
Ndx++
Stk$[Ndx]= Anyword$
Anyword$ = ""
END IF
Ndx++
Stk$[Ndx]= szChar$
'*****************
CASE ELSE
'*****************
A=LEN(Anyword$)
Anyword[A] = Arg[Counter-1] 'This eliminates using MID$
Anyword[A+1] = 0 'Remember to null terminate
'*****************
END SELECT
'*****************
WEND
IF LEN(Anyword$) THEN
Ndx++
Stk$[Ndx]= Anyword$
END IF
FOR j = 1 TO Ndx
SELECT CASE LCASE$(Stk$[j])
CASE "bor"
Stk$[j] = "|"
CASE "band"
Stk$[j] = "&"
END SELECT
NEXT
' FOR j = 1 TO Ndx
' IF Stk$[j]= "'" THEN
' Ndx = j-1
' EXIT SUB
' END IF
' NEXT
END SUB ' PreParse
FUNCTION GetNumArgs OPTIONAL(Strt, NdxPos AS INTEGER PTR=NULL)
DIM RAW CountR = 0 '() counter
DIM RAW CountS = 0 '[] counter
DIM RAW i 'loop counter
DIM RAW j = 0 'comma counter
DIM RAW k = 1 'function end flag
FOR i = Strt TO Ndx
IF Stk$[i] = "(" THEN
CountR++
k++
ELSEIF Stk$[i] = ")" THEN
CountR--
k--
IF k = 0 THEN EXIT FOR
ELSEIF Stk$[i] = "[" THEN
CountS++
ELSEIF Stk$[i] = "]" THEN
CountS--
ELSEIF Stk$[i] = "," AND CountR = 0 AND CountS = 0 THEN
j++
IF NdxPos THEN *NdxPos = i
END IF
NEXT
FUNCTION = j 'No. of commas = No. of args
END FUNCTION ' GetNumArgs
SUB GetVarCode(varcode AS VARCODE PTR)
DIM RAW CB$, PT$, PTH$, VAR$, vn, RF$
IF varcode->Method% = mt_Opts3 THEN
varcode->Proto$ = varcode->Proto$ + varcode->Token$
IF varcode->Token$ = "," THEN
varcode->Header$ = varcode->Header$ + varcode->Token$
END IF
EXIT SUB
END IF
IF varcode->Method% = mt_FuncSubx1 THEN
varcode->Proto$ = varcode->Proto$ + varcode->AsToken$ + "(*)("
varcode->Header$ = varcode->Header$ + varcode->AsToken$ + " (*" + varcode->Token$ + ")("
EXIT SUB
END IF
IF varcode->Method% = mt_FuncSubx2 THEN
varcode->Proto$ = varcode->Proto$ + varcode->AsToken$
varcode->Header$ = varcode->Header$ + varcode->AsToken$ + " " + varcode->Token$
EXIT SUB
END IF
IF IsCallBack THEN
CB$ = "CALLBACK "
ELSE
CB$ = ""
END IF
IF INCHR(varcode->Token$,"*") OR INCHR(varcode->AsToken$,"*") OR varcode->IsPtrFlag THEN
RemoveAll(varcode->Token$, "*")
RemoveAll(varcode->AsToken$, "*")
PT$ = STRING$(varcode->IsPtrFlag,42) + " "
PTH$ = PT$
ELSE
PTH$ = " "
PT$ = ""
END IF
IF INCHR(varcode->Token$,"&") THEN
RF$ = " &"
ELSE
RF$ = ""
END IF
vn = varcode->VarNo%
VAR$ = GetVarTypeName$(vn)
SELECT CASE vn
'************************************************************************
CASE vt_STRVAR
'************************************************************************
SELECT CASE varcode->Method%
CASE mt_ProcessSetCommand
varcode->StaticOut$ = "static char " + Clean$(varcode->Token$)
CASE mt_FuncSubDecC_Dec
varcode->Functype$ = "char * " + CB$
CASE mt_FuncSubDecC_Dec2
IF NOT INCHR(varcode->Token$, "[") THEN
varcode->Header$ = varcode->Header$ + "char *" + Clean$(varcode->Token$) + ", "
varcode->Proto$ = varcode->Proto$ + "char *, "
ELSE
varcode->Header$ = varcode->Header$ + "char " + REMOVE$(Clean$(varcode->Token$), "*") + ", "
varcode->Proto$ = varcode->Proto$ + "char [][2048], "
END IF
CASE mt_Opts
varcode->Functype$ = "char *"
CASE mt_Opts2
varcode->Header$ = varcode->Header$ + "char * " + Clean$(varcode->Token$)
varcode->Proto$ = varcode->Proto$ + "char* "
CASE mt_OverLoad
varcode->Functype$ = "char *"
CASE mt_OverLoad2
varcode->Header$ = varcode->Header$ + "char *" + Clean$(varcode->Token$) + ", "
END SELECT
'************************************************************************
CASE vt_BOOL,vt_BYTE,vt_COLORREF,vt_DOUBLE,vt_DWORD,vt_FARPROC,vt_HDC, _
vt_HANDLE,vt_HINSTANCE,vt_HWND,vt_INTEGER,vt_LONG,vt_LPBYTE,vt_LRESULT, _
vt_SHORT,vt_SINGLE,vt_UINT,vt_ULONG,vt_USHORT,vt_VARIANT,vt_VOID,vt_LDOUBLE
'************************************************************************
SELECT CASE varcode->Method%
CASE mt_ProcessSetCommand
varcode->StaticOut$ = "static " + VAR$ + " " + Clean$(varcode->Token$)
CASE mt_FuncSubDecC_Dec
varcode->Functype$ = VAR$ + PTH$ + CB$
CASE mt_FuncSubDecC_Dec2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$) + ", "
varcode->Proto$ = varcode->Proto$ + VAR$ + RF$ + PT$ + ", "
CASE mt_Opts
varcode->Functype$ = VAR$ + PTH$
CASE mt_Opts2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$)
varcode->Proto$ = varcode->Proto$ + VAR$ + RF$ + PT$
CASE mt_OverLoad
varcode->Functype$ = VAR$ + " "
CASE mt_OverLoad2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$) + ", "
END SELECT
'************************************************************************
CASE vt_FILEPTR, vt_CHAR
'************************************************************************
SELECT CASE varcode->Method%
CASE mt_FuncSubDecC_Dec
varcode->Functype$ = VAR$ + PTH$ + CB$
CASE mt_FuncSubDecC_Dec2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$) + ", "
varcode->Proto$ = varcode->Proto$ + VAR$ + PT$ + ", "
CASE mt_Opts
varcode->Functype$ = VAR$ + PTH$
CASE mt_Opts2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$)
varcode->Proto$ = varcode->Proto$ + VAR$ + PT$
CASE mt_OverLoad
varcode->Functype$ = VAR$ + " "
CASE mt_OverLoad2
varcode->Header$ = varcode->Header$ + VAR$ + PTH$ + Clean$(varcode->Token$) + ", "
END SELECT
'************************************************************************
CASE vt_UDT, vt_STRUCT, vt_UNION
'************************************************************************
SELECT CASE varcode->Method%
CASE mt_ProcessSetCommand
IF vn = vt_UNION THEN
varcode->StaticOut$ = "static union " + Clean$(varcode->Token$)
ELSE
varcode->StaticOut$ = "static struct _" + Clean$(varcode->Token$) + " "
END IF
CASE mt_FuncSubDecC_Dec
varcode->Functype$ = varcode->AsToken$ + PTH$ + CB$
CASE mt_FuncSubDecC_Dec2
varcode->Header$ = varcode->Header$ + varcode->AsToken$ + PTH$ + Clean$(varcode->Token$) + ", "
varcode->Proto$ = varcode->Proto$ + varcode->AsToken$ + RF$ + PT$ + ", "
CASE mt_Opts
varcode->Functype$ = varcode->AsToken$ + PTH$
CASE mt_Opts2
varcode->Header$ = varcode->Header$ + Clean$(varcode->AsToken$) + PTH$ + " " + Clean$(varcode->Token$)
varcode->Proto$ = varcode->Proto$ + Clean$(varcode->AsToken$) + RF$ + PT$
CASE mt_OverLoad
varcode->Functype$ = VAR$ + " "
CASE mt_OverLoad2
varcode->Header$ = varcode->Header$ + varcode->AsToken$ + PTH$ + Clean$(varcode->Token$) + ", "
END SELECT
'************************************************************************
CASE ELSE
'************************************************************************
SELECT CASE varcode->Method%
CASE mt_FuncSubDecC_Dec
varcode->Functype$ = varcode->AsToken$ + PTH$ + CB$
CASE mt_FuncSubDecC_Dec2
varcode->Header$ = varcode->Header$ + varcode->AsToken$ + PTH$ + Clean$(varcode->Token$) + ", "
varcode->Proto$ = varcode->Proto$ + varcode->AsToken$ + RF$ + PT$ + ", "
CASE mt_Opts
varcode->Functype$ = varcode->AsToken$ + PTH$
CASE mt_Opts2
varcode->Header$ = varcode->Header$ + Clean$(varcode->AsToken$) + " " + Clean$(varcode->Token$)
varcode->Proto$ = varcode->Proto$ + Clean$(varcode->AsToken$)
END SELECT
END SELECT
END SUB ' GetVarCode
SUB AddProtos
DIM RAW SaveMain$
DIM RAW ZZ$
DIM RAW A
SaveMain$ = ""
OPEN FileOut$ FOR INPUT AS FP1
OPEN "$t$e$m$p" FOR OUTPUT AS Outfile
WHILE NOT EOF(FP1)
LINE INPUT FP1,ZZ$
IF INSTR(ZZ$,"int main") THEN
SaveMain$ = ZZ$
EXIT LOOP
END IF
FPRINT Outfile, ZZ$
WEND
IF Use_Sysmacros OR Use_Wingui THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: STANDARD MACROS"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_STD_MACROS
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
END IF
'IF Use_Library THEN FPRINT Outfile,"BCXRTLIB: STANDARD MACROS"
IF Use_Wingui OR Use_Library THEN
IF NOT Use_Project THEN
FPRINT Outfile,"HFONT BcxFont=0;"
END IF
FPRINT Outfile,"#define DefaultFont ((BcxFont==0)?GetStockObject(DEFAULT_GUI_FONT):BcxFont)"
END IF
IF Use_Sysmacros THEN
IF Use_BCX_OlePicture THEN
FPRINT Outfile,"#define BCX_OLE_WIDTH(H) LOWORD(GetWindowLong(H,GWL_USERDATA))"
FPRINT Outfile,"#define BCX_OLE_HEIGHT(H) HIWORD(GetWindowLong(H,GWL_USERDATA))"
END IF
IF Use_BCX_Cursor THEN
FPRINT Outfile,"#define BCX_Cursor(x)SetCursor(LoadCursor(NULL,x))"
END IF
IF Use_Cbool THEN
FPRINT Outfile,"#define CBOOL(A)(A!=0)?1:0"
END IF
IF Use_Isptr THEN
FPRINT Outfile,"#define IsPtr(a)((DWORD)a)"
END IF
IF Use_Band THEN
FPRINT Outfile,"#define BAND &"
END IF
IF Use_Bor THEN
FPRINT Outfile,"#define BOR |"
END IF
IF Use_Bnot THEN
FPRINT Outfile,"#define BNOT ~(int)"
END IF
IF Use_Inp THEN
FPRINT Outfile,"#define Inp(port)_inp(port)"
END IF
IF Use_Inpw THEN
FPRINT Outfile,"#define Inpw(port)_inpw(port)"
END IF
IF Use_Outp THEN
FPRINT Outfile,"#define Outp(port,value)_outp(port,value)"
END IF
IF Use_Outpw THEN
FPRINT Outfile,"#define Outpw(port,value)_outpw(port,value)"
END IF
IF Use_Ubound THEN
FPRINT Outfile,"#define ubound(T)(sizeof((T))/sizeof((T[0]))-1)"
END IF
IF Use_Clear THEN
FPRINT Outfile,"#define Clear(arg)memset(&arg,0,sizeof(arg))"
END IF
IF Use_Imod THEN
FPRINT Outfile,"#define imod(a,b)((a)%(b))"
END IF
IF Use_Refresh THEN
FPRINT Outfile,"#define Refresh(A) RedrawWindow(A,NULL,NULL,RDW_ERASE|RDW_INVALIDATE|RDW_ALLCHILDREN|RDW_UPDATENOW);"
END IF
IF Use_ShowModal THEN
FPRINT Outfile,"#define ShowModal(Window)EnableWindow(GetWindow(Window,GW_OWNER),FALSE);Show(Window);"
END IF
IF Use_EndModal THEN
FPRINT Outfile,"#define EndModal(Window)EnableWindow(GetWindow(Window,GW_OWNER),TRUE);DestroyWindow(Window);"
END IF
IF Use_Show THEN
FPRINT Outfile,"#define Show(Window)RedrawWindow(Window,0,0,0);ShowWindow(Window,SW_SHOW);"
END IF
IF Use_Hide THEN
FPRINT Outfile,"#define Hide(Window)ShowWindow(Window,SW_HIDE)"
END IF
IF Use_Get THEN
FPRINT Outfile,"#define GET(A,B,C)fread(B,1,C,A)"
END IF
IF Use_Put THEN
FPRINT Outfile,"#define PUT(A,B,C)fwrite(B,1,C,A)"
END IF
IF Use_Strptr THEN
FPRINT Outfile,"#define STRPTR(A)((char*)&(A))"
END IF
IF Use_Val THEN
FPRINT Outfile,"#define VAL(a)(double)atof(a)"
END IF
IF Use_Vall THEN
FPRINT Outfile,"#if defined( __LCC__ ) || defined( __POCC__ )"
FPRINT Outfile," #define VALL(a) (long double)strtold(a,(char**)NULL)"
FPRINT Outfile,"#elif defined( __BCPLUSPLUS__ )"
FPRINT Outfile," #define VALL(a) (long double)_strtold(a,(char**)NULL)"
FPRINT Outfile,"#else"
FPRINT Outfile," #define VALL(a) (long double)strtod(a,(char**)NULL)"
FPRINT Outfile,"#endif"
END IF
IF Use_Getattr THEN
FPRINT Outfile,"#define GETATTR(a)(DWORD)GetFileAttributes(a)"
END IF
IF Use_Setattr THEN
FPRINT Outfile,"#define SETATTR(a,b)(DWORD)SetFileAttributes(a,b)"
END IF
IF Use_Fint THEN
FPRINT Outfile,"#define FINT(a)floor(a)"
END IF
IF Use_Frac THEN
FPRINT Outfile,"#define FRAC(a)(double)(a-FIX(a))"
Use_Fix = TRUE
END IF
IF Use_Fracl THEN
FPRINT Outfile,"#define FRACL(a)(long double)(a-FIX(a))"
Use_Fix = TRUE
END IF
IF Use_Fix THEN
FPRINT Outfile,"#define FIX(a)(int)((a))"
END IF
IF Use_Csng THEN
FPRINT Outfile,"#define CSNG(a)((float)(a))"
END IF
IF Use_Cdbl THEN
FPRINT Outfile,"#define CDBL(a)((double)(a))"
END IF
IF Use_Cldbl THEN
FPRINT Outfile,"#define CLDBL(a)((long double)(a))"
END IF
IF Use_Threads THEN
FPRINT Outfile,""
FPRINT Outfile,"#define BCX_THREAD(a) (HANDLE)BCX_DynaCall";
FPRINT Outfile,"(", ENC$("_beginthreadex"), ",", ENC$("msvcrt"), ",6,0,0,a,0,0,&BCX_Thread_ID)"
FPRINT Outfile,"#define BCX_THREADWAIT(a) while(WaitForSingleObject((a),0)==WAIT_TIMEOUT){}CloseHandle((a))"
FPRINT Outfile,"#define BCX_THREADSUSPEND(a) SuspendThread(a)"
FPRINT Outfile,"#define BCX_THREADRESUME(a) ResumeThread(a)"
FPRINT Outfile,"#define BCX_THREADKILL(a) TerminateThread(a,0); CloseHandle((a))"
FPRINT Outfile,"#define BCX_THREADEND BCX_DynaCall(", ENC$("_endthreadex"), ",", ENC$("msvcrt"), ",2,0,0)"
FPRINT Outfile,"DWORD BCX_Thread_ID = 0;"
FPRINT Outfile,""
END IF
FPRINT Outfile,""
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
END IF
IF Use_Project = FALSE THEN
IF UseFlag OR Use_Console OR Use_Proto THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: STANDARD PROTOTYPES"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_STD_PROTOS
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
END IF
' BEGIN BCX_GUI MODIFICATION
IF Use_GUINoMain OR Use_MDIGUINoMain OR Use_Wingui THEN
IF Use_BCX_FrameWnd THEN
FPRINT Outfile,"HWND BCX_FrameWnd (char* ,WNDPROC,char* ,HMENU=NULL,int=0,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=0,int=0);"
END IF
IF Use_BCX_Wnd THEN
FPRINT Outfile,"HWND BCX_Wnd (char*,WNDPROC,char* ,HWND=0,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=0,int=0,int=0);"
END IF
IF Use_BCX_SetBkGrdBrush THEN
FPRINT Outfile,"void BCX_SetBkGrdBrush (HWND, HBRUSH);"
END IF
IF Use_BCX_SetClassStyle THEN
FPRINT Outfile,"void BCX_SetClassStyle (HWND, long);"
END IF
IF Use_BCX_SetIcon THEN
FPRINT Outfile,"void BCX_SetIcon (HWND, int);"
END IF
IF Use_BCX_SetIconSm THEN
FPRINT Outfile,"void BCX_SetIconSm (HWND, int);"
END IF
IF Use_BCX_SetCursor THEN
FPRINT Outfile,"void BCX_SetCursor (HWND, char *);"
END IF
IF Use_BCX_SetMetric THEN
FPRINT Outfile,"void BCX_SetMetric (char *);"
END IF
IF Use_Library THEN
FPRINT Outfile,"int BCX_MsgPump (HACCEL=0);"
FPRINT Outfile,"int BCX_MDI_MsgPump (HACCEL=0);"
ELSE
IF Use_GUINoMain THEN
IF Use_BCX_MsgPump THEN
FPRINT Outfile,"int BCX_MsgPump (HACCEL=0);"
END IF
ELSEIF Use_MDIGUINoMain THEN
IF Use_BCX_MDI_MsgPump THEN
FPRINT Outfile,"int BCX_MDI_MsgPump (HACCEL=0);"
END IF
END IF
END IF
IF Use_BCX_RegWnd THEN
FPRINT Outfile,"void BCX_RegWnd (char *, WNDPROC);"
END IF
IF Use_BCX_InitGUI THEN
FPRINT Outfile,"void BCX_InitGUI (void);"
END IF
END IF
' END BCX_GUI MODIFICATION
IF Use_Acosh THEN
FPRINT Outfile,"#if !defined( __WATCOM_CPLUSPLUS__ )"
FPRINT Outfile,"double acosh(double);"
FPRINT Outfile,"#endif"
END IF
IF Use_Asinh THEN
FPRINT Outfile,"#if !defined( __WATCOM_CPLUSPLUS__ )"
FPRINT Outfile,"double asinh(double);"
FPRINT Outfile,"#endif"
END IF
IF Use_Atanh THEN
FPRINT Outfile,"#if !defined( __WATCOM_CPLUSPLUS__ )"
FPRINT Outfile,"double atanh(double);"
FPRINT Outfile,"#endif"
END IF
IF Use_Clng THEN
FPRINT Outfile,"long CLNG(double);"
END IF
IF Use_Cint THEN
FPRINT Outfile,"int Cint(double);"
END IF
IF Use_StartupCode THEN
FPRINT Outfile,"int BCX_StartupCode_(void);"
END IF
IF Use_ExitCode THEN
FPRINT Outfile,"int BCX_ExitCode_(void);"
END IF
IF Use_Str_Cmp THEN
IF USING_LINUX=1 THEN
'FPRINT Outfile,"int str_cmp(char*, char*);"
ELSE
FPRINT Outfile,"int str_cmp(char*, char*);"
END IF
END IF
IF Use_Eof THEN
FPRINT Outfile,"int EoF (FILE*);"
END IF
IF Use_AppActivate THEN
FPRINT Outfile,"int AppActivate (char *);"
END IF
IF Use_Inputbox OR Use_Infobox THEN
FPRINT Outfile,"LPWORD lpwAlign(LPWORD);"
END IF
IF Use_Inputbox THEN
FPRINT Outfile,"char* InputBox(char*,char*,char*);"
FPRINT Outfile,"LRESULT CreatePrompter(char*,char*,char*);"
FPRINT Outfile,"LRESULT CALLBACK Prompter(HWND,UINT,WPARAM,LPARAM);"
END IF
IF Use_VBS THEN
FPRINT Outfile,"HRESULT VBS_RUN_SCRIPT (char*);"
FPRINT Outfile,"HRESULT VBS_ADDCODE (char*);"
FPRINT Outfile,"double VBS_EVAL_NUM (char*);"
FPRINT Outfile,"char* VBS_EVAL_STR (char*);"
FPRINT Outfile,"BOOL VBS_START (void);"
FPRINT Outfile,"void VBS_STOP (void);"
FPRINT Outfile,"void VBS_RESET (void);"
FPRINT Outfile,"char* VBS_ERROR (void);"
END IF
IF Use_Infobox THEN
FPRINT Outfile,"void InfoBox(char*,char*,int=160,int=155);"
FPRINT Outfile,"LRESULT CALLBACK CB_InfoBox(HWND,UINT,WPARAM,LPARAM);"
END IF
IF Use_Mdigui THEN
FPRINT Outfile,"HWND BCX_MDICHILD (char *, char *,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,int=CW_USEDEFAULT,DWORD=0,LPARAM=0);"
FPRINT Outfile,"void BCX_MDICLASS (WNDPROC,PCHAR);"
FPRINT Outfile,"HWND BCX_MDICLIENT (HWND,int);"
END IF
IF Use_BCX_Colordlg THEN
FPRINT Outfile,"int BCX_ColorDlg (COLORREF=RGB(128,128,128),HWND=0);"
END IF
IF Use_BCXMDialog THEN
FPRINT Outfile,"int BCX_MDialog(DLGPROC,char*,HWND,int=0,int=0,int=250,int=150,int=0,int=0,char* =0,int=0);"
END IF
IF Use_BCXDialog THEN
FPRINT Outfile,"HWND BCX_Dialog(DLGPROC,char*,HWND,int=0,int=0,int=250,int=150,int=0,int=0,char* =0,int=0);"
END IF
IF Use_BCXDialog OR Use_BCXMDialog THEN
FPRINT Outfile,"void SetDialogScale (HWND, BOOL);"
END IF
IF Use_Form THEN
FPRINT Outfile,"HWND BCX_Form(char*,int=0,int=0,int=250,int=150,int=0,int=0);"
END IF
IF Use_Edit THEN
FPRINT Outfile,"HWND BCX_Edit(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_BCX_Input THEN
FPRINT Outfile,"HWND BCX_Input(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_Button THEN
FPRINT Outfile,"HWND BCX_Button(char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=-1);"
END IF
IF Use_BmpButton THEN
FPRINT Outfile,"HWND BCX_BmpButton(char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=-1);"
END IF
IF Use_Label THEN
FPRINT Outfile,"HWND BCX_Label(char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Group THEN
FPRINT Outfile,"HWND BCX_Group(char*,HWND,int,int,int,int,int,int=0,int=0);"
END IF
IF Use_Checkbox THEN
FPRINT Outfile,"HWND BCX_Checkbox(char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Radio THEN
FPRINT Outfile,"HWND BCX_Radio(char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Combobox THEN
FPRINT Outfile,"HWND BCX_Combobox(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_Listbox THEN
FPRINT Outfile,"HWND BCX_Listbox(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_Blackrect THEN
FPRINT Outfile,"HWND BCX_BlackRect(char*,HWND,int,int,int,int,int,int=0,int=0);"
END IF
IF Use_Whiterect THEN
FPRINT Outfile,"HWND BCX_WhiteRect(char*,HWND,int,int,int,int,int,int=0,int=0);"
END IF
IF Use_Grayrect THEN
FPRINT Outfile,"HWND BCX_GrayRect(char*,HWND,int,int,int,int,int,int=0,int=0);"
END IF
IF Use_Datepick THEN
FPRINT Outfile,"HWND BCX_DatePick(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_Richedit THEN
FPRINT Outfile,"HWND BCX_RichEdit (char*,HWND,int,int,int,int,int,int=0,int=-1);"
FPRINT Outfile,"void SetWindowRTFText (HWND, char *);"
END IF
IF Use_Status THEN
FPRINT Outfile,"HWND BCX_Status (char*,HWND,int=200,int=1,int* =0);"
END IF
IF Use_BCX_OlePicture THEN
FPRINT Outfile,"HWND BCX_OlePicture(char*,HWND=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Bitmap THEN
FPRINT Outfile,"HWND BCX_Bitmap(char*,HWND=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Icon THEN
FPRINT Outfile,"HWND BCX_Icon(char*,HWND=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_Listview THEN
FPRINT Outfile,"HWND BCX_ListView(char*,HWND,int,int,int,int,int,int=0,int=-1,int=15);"
END IF
IF Use_Treeview THEN
FPRINT Outfile,"HWND BCX_Treeview(char*,HWND,int,int,int,int,int,int=0,int=-1);"
END IF
IF Use_BCX_Control THEN
FPRINT Outfile,"HWND BCX_Control (char*,HWND,char*,int,int,int,int,int,int=0,int=0);"
END IF
IF Use_ProgressBar THEN
FPRINT Outfile,"HWND BCX_ProgressBar (char*,HWND,int=0,int=0,int=0,int=0,int=0,int=0,int=-1);"
END IF
IF Use_BCX_Slider THEN
FPRINT Outfile,"HWND BCX_Slider(char*,HWND,int,int,int,int,int,int=0,int=0,int=0);"
END IF
IF Use_BCX_Splitter THEN
FPRINT Outfile,"HWND BCX_Splitter (HWND,int,int=0,int=0,int=0,int=0,int=0,int=0);"
FPRINT Outfile,"void DrawXorBar (HWND, RECT *);"
FPRINT Outfile,"int BCX_SetSplitPos (HWND,int=50,int=0);"
FPRINT Outfile,"LRESULT CALLBACK SplitterWndProc (HWND, UINT, WPARAM, LPARAM);"
END IF
IF Use_BCX_Toolbar THEN
FPRINT Outfile,"HWND BCX_Toolbar (HWND,int,int,char* =0,int* =0,void* =0,int* =0,int=0,int=0,int=0,int=0);"
END IF
IF Use_BCX_Tab THEN
FPRINT Outfile,"HWND BCX_Tab (HWND, int, int, HWND *, char [][2048],int,int,int,int,HIMAGELIST=NULL,int=0,int=0);"
FPRINT Outfile,"HWND BCX_AddTab (HWND, int, char*, int=-1, int=0);"
FPRINT Outfile,"void BCX_RemTab (HWND, int);"
FPRINT Outfile,"int BCX_TabSelect (HWND, LPARAM);"
FPRINT Outfile,"LRESULT CALLBACK TabPageWndProc (HWND, UINT, WPARAM, LPARAM);"
FPRINT Outfile,"LRESULT CALLBACK TabCallback (HWND, UINT, WPARAM, LPARAM);"
FPRINT Outfile,"LRESULT CALLBACK TabSizeCallback(HWND, UINT, WPARAM, LPARAM);"
END IF
IF Use_Draw THEN
FPRINT Outfile,"HDC StartDraw (HWND);"
FPRINT Outfile,"HBITMAP EndDraw (HWND, HDC);"
END IF
IF Use_BCX_UpDown THEN
FPRINT Outfile,"HWND BCX_UpDown (HWND,int,int,int,int,int,int,int=0);"
END IF
IF Use_BCX_Get_UpDown THEN
FPRINT Outfile,"int BCX_Get_UpDown (HWND);"
END IF
IF Use_BCX_Print THEN
FPRINT Outfile,"int BCX_Print (HWND, int , int , char *, HDC=0);"
END IF
IF Use_SetFormColor THEN
FPRINT Outfile,"void BCX_Set_Form_Color (HWND,COLORREF);"
END IF
IF Use_BCX_Tile THEN
FPRINT Outfile,"void BCX_Tile (HWND,HBITMAP);"
END IF
IF Use_GetText THEN
FPRINT Outfile,"char* BCX_Get_Text(HWND);"
END IF
IF Use_GetResource THEN
FPRINT Outfile,"LPVOID GetResource(int, char*, DWORD*);"
END IF
IF Use_SetText THEN
FPRINT Outfile,"int BCX_Set_Text(HWND,char*);"
END IF
IF Use_Elf THEN
FPRINT Outfile,"void EditLoadFile (HWND, char*);"
END IF
IF Use_ListBoxLoadFile THEN
FPRINT Outfile,"void ListBoxLoadFile(HWND,char*,int=0,int=0);"
END IF
IF Use_ComboBoxLoadFile THEN
FPRINT Outfile,"void ComboBoxLoadFile(HWND,char*);"
END IF
IF Use_SetFont THEN
FPRINT Outfile,"HFONT BCX_Set_Font (char *,float,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_BCX_Preset THEN
FPRINT Outfile,"int BCX_Preset (HWND,int,int,HDC=0);"
END IF
IF Use_BCX_Line THEN
FPRINT Outfile,"int BCX_Line (HWND,int,int,int,int,int=0,HDC=0);"
END IF
IF Use_BCX_Lineto THEN
FPRINT Outfile,"int BCX_Lineto (HWND,int,int,int=0,HDC=0);"
END IF
IF Use_BCX_Polygon THEN
FPRINT Outfile,"int BCX_Polygon (HWND ,CONST POINT *,int,int=0,HDC=0);"
END IF
IF Use_BCX_PolyBezier THEN
FPRINT Outfile,"int BCX_PolyBezier (HWND,CONST POINT *,int,int=0,HDC=0);"
END IF
IF Use_BCX_Polyline THEN
FPRINT Outfile,"int BCX_Polyline (HWND ,CONST POINT *,int,int=0,HDC=0);"
END IF
IF Use_BCX_Circle THEN
FPRINT Outfile,"int BCX_Circle (HWND,int,int,int,int=0,int=0,HDC=0);"
END IF
IF Use_BCX_Ellipse THEN
FPRINT Outfile,"int BCX_Ellipse (HWND,int,int,int,int,int=0,int=0,HDC=0);"
END IF
IF Use_BCX_Rectangle THEN
FPRINT Outfile,"int BCX_Rectangle (HWND,int,int,int,int,int=0,int=0,HDC=0);"
END IF
IF Use_BCX_Roundrect THEN
FPRINT Outfile,"int BCX_Roundrect(HWND,int,int,int,int,int,int,int=0,int=0,HDC=0);"
END IF
IF Use_BCX_Arc THEN
FPRINT Outfile,"int BCX_Arc (HWND,int,int,int,int,int,int,int,int,int=0,HDC=0);"
END IF
IF Use_Set_BCX_Bitmap THEN
FPRINT Outfile,"void Set_BCX_Bitmap(HWND,char*,int=0,int=0,int=0);"
END IF
IF Use_Set_BCX_Bitmap2 THEN
FPRINT Outfile,"HBITMAP Set_BCX_Bitmap2(HWND,HBITMAP,int=1);"
END IF
IF Use_Set_BCX_BmpButton THEN
FPRINT Outfile,"void Set_BCX_BmpButton(HWND,char*,int=0);"
END IF
IF Use_Set_BCX_Icon THEN
FPRINT Outfile,"void Set_BCX_Icon(HWND,char*,int=0,int=0,int=0);"
END IF
IF Use_BCX_Fontdlg THEN
FPRINT Outfile,"int BCX_FontDlg (BOOL=0,HWND=0);"
END IF
IF Use_BCX_Pset THEN
FPRINT Outfile,"COLORREF BCX_Pset (HWND,int,int,int=0,HDC=0);"
END IF
IF Use_BCX_Floodfill THEN
FPRINT Outfile,"int BCX_FloodFill (HWND,int,int,int,int,HDC=0);"
END IF
IF Use_BCX_Getpixel THEN
FPRINT Outfile,"COLORREF BCX_Getpixel (HWND,int,int,HDC=0);"
END IF
IF Use_BCX_Get THEN
FPRINT Outfile,"HBITMAP BCX_Get (HWND,int,int,int,int,int=SRCCOPY,HDC=0);"
END IF
IF Use_BCX_Put THEN
FPRINT Outfile,"void BCX_Put (HWND,HBITMAP,int,int,int,int,int=SRCCOPY,HDC=0);"
END IF
IF Use_BCX_LoadBMP THEN
FPRINT Outfile,"HBITMAP BCX_LoadBMP (char *, int=0, int=0);"
END IF
IF Use_BCX_LoadImage THEN
FPRINT Outfile,"HBITMAP BCX_LoadImage (char *, int=0);"
END IF
IF Use_DrawTransBMP THEN
FPRINT Outfile,"void DrawTransBMP (HWND,HBITMAP,COLORREF,int,int,HDC=0);"
END IF
IF Use_BCX_BmpWidth THEN
FPRINT Outfile,"int BCX_BmpWidth (HBITMAP);"
END IF
IF Use_BCX_BmpHeight THEN
FPRINT Outfile,"int BCX_BmpHeight (HBITMAP);"
END IF
IF Use_QBColor THEN
FPRINT Outfile,"int qbcolor (int);"
END IF
IF Use_SetColor THEN
FPRINT Outfile,"LRESULT Set_Color (int,int,int,int);"
END IF
IF Use_PlayWav THEN
FPRINT Outfile,"void PlayWav (char *,int=0, int=SND_SYNC);"
END IF
IF Use_SaveBmp THEN
FPRINT Outfile,"void SaveBmp(LPVOID, LPTSTR);"
END IF
IF Use_GetBmp THEN
FPRINT Outfile,"HDC GetBmp (int, int, int, int, HWND);"
END IF
IF Use_Center THEN
FPRINT Outfile,"void Center (HWND,HWND=0,HWND=0);"
END IF
IF Use_Cls THEN
FPRINT Outfile,"void cls(void);"
END IF
IF Use_Color THEN
FPRINT Outfile,"void color (int,int);"
END IF
IF Use_Panel THEN
FPRINT Outfile,"void panel (int,int,int,int,int,int,int,int);"
END IF
IF Use_Locate THEN
FPRINT Outfile,"void locate (int,int,int=1,int=12);"
END IF
IF Use_Pos THEN
FPRINT Outfile,"int Pos (void);"
END IF
IF Use_Csrlin THEN
FPRINT Outfile,"int Csrlin (void);"
END IF
IF Use_Run THEN
FPRINT Outfile,"int Run (char*, int =1, int =0);"
END IF
IF Use_Doevents THEN
FPRINT Outfile,"void DoEvents(void);"
END IF
IF Use_Randomize THEN
FPRINT Outfile,"void randomize (unsigned int);"
END IF
IF Use_Midstr THEN
FPRINT Outfile,"void midstr (char*, int, int, char *);"
END IF
IF Use_Swap THEN
FPRINT Outfile,"void swap (char*,char*,int);"
END IF
IF UseFlag THEN
FPRINT Outfile,"char* BCX_TmpStr(size_t);"
END IF
IF Use_sziif THEN
FPRINT Outfile,"char* sziif (BOOL,char*,char*);"
END IF
IF Use_Using THEN
FPRINT Outfile,"char* Using (char*,double);"
END IF
IF Use_TempFileName THEN
FPRINT Outfile,"char* TempFileName (char*,char*);"
END IF
IF Use_AppExePath THEN
FPRINT Outfile,"char* AppExePath (void);"
END IF
IF Use_AppExeName THEN
FPRINT Outfile,"char* AppExeName (void);"
END IF
IF Use_Lcase THEN
FPRINT Outfile,"char* lcase (char*);"
END IF
IF Use_Ucase THEN
FPRINT Outfile,"char* ucase (char*);"
END IF
IF Use_Mid THEN
FPRINT Outfile,"char* mid (char*, int, int=-1);"
END IF
IF Use_Ltrim THEN
FPRINT Outfile,"char* ltrim (char*,char=32);"
END IF
IF Use_Rtrim THEN
FPRINT Outfile,"char* rtrim (char*,char=32);"
END IF
IF Use_Trim THEN
FPRINT Outfile,"char* trim (char*);"
END IF
IF Use_Strim THEN
FPRINT Outfile,"char* strim (char*);"
END IF
IF Use_Left THEN
FPRINT Outfile,"char* left (char*,int);"
END IF
IF Use_Right THEN
FPRINT Outfile,"char* right (char*,int);"
END IF
IF Use_Rpad THEN
FPRINT Outfile,"char* rpad (char*,int,int=32);"
END IF
IF Use_Lpad THEN
FPRINT Outfile,"char* lpad (char*,int,int=32);"
END IF
IF Use_String THEN
FPRINT Outfile,"char* string (int,int);"
END IF
IF Use_Repeat THEN
FPRINT Outfile,"char* repeat (int,char*);"
END IF
IF Use_Extract THEN
FPRINT Outfile,"char* extract (char*,char*);"
END IF
IF Use_Remain THEN
FPRINT Outfile,"char* remain (char*,char*);"
END IF
IF Use_Reverse THEN
FPRINT Outfile,"char* reverse (char*);"
END IF
IF Use_Command THEN
FPRINT Outfile,"char* command (int=-1);"
END IF
IF Use_Mcase THEN
FPRINT Outfile,"char* mcase (char*);"
END IF
IF Use_Replace THEN
FPRINT Outfile,"char* replace (char*,char*,char*);"
END IF
IF Use_iReplace THEN
FPRINT Outfile,"char* iReplace (char*,char*,char*);"
END IF
IF Use_Space THEN
FPRINT Outfile,"char* space (int a);"
END IF
IF Use_Str THEN
FPRINT Outfile,"char* str (double);"
END IF
IF Use_Strl THEN
FPRINT Outfile,"char* strl (long double);"
END IF
IF Use_Findfirst THEN
FPRINT Outfile,"char* findfirst (char*);"
END IF
IF Use_Findnext THEN
FPRINT Outfile,"char* findnext (void);"
END IF
IF Use_Curdir THEN
FPRINT Outfile,"char* curdir (void);"
END IF
IF Use_Windir THEN
FPRINT Outfile,"char* windir (void);"
END IF
IF Use_Sysdir THEN
FPRINT Outfile,"char* sysdir (void);"
END IF
IF Use_Tempdir THEN
FPRINT Outfile,"char* tempdir (void);"
END IF
IF Use_Environ THEN
FPRINT Outfile,"char* Environ (char*);"
END IF
IF Use_Boolstr THEN
FPRINT Outfile,"char* BoolStr (int);"
END IF
IF Use_Hex THEN
FPRINT Outfile,"char* hex (int);"
END IF
IF Use_Bin THEN
FPRINT Outfile,"char* Bin (int);"
END IF
IF Use_Oct THEN
FPRINT Outfile,"char* oct (int);"
END IF
IF Use_Now THEN
FPRINT Outfile,"char* now (void);"
END IF
IF Use_SearchPath THEN
FPRINT Outfile,"char* SEARCHPATH (char *);"
END IF
IF Use_BCX_Path THEN
FPRINT Outfile,"char* BcxPath (void);"
END IF
IF Use_LccPath THEN
FPRINT Outfile,"char* LccPath (void);"
END IF
IF Use_PellesPath THEN
FPRINT Outfile,"char* PellesPath (void);"
END IF
IF Use_Strtoken THEN
FPRINT Outfile,"char* StrToken (char*,char*,int);"
END IF
IF Use_RegString THEN
FPRINT Outfile,"char* RegString (HKEY,char*,char*);"
END IF
IF Use_CreateRegString THEN
FPRINT Outfile,"void CreateRegString (HKEY,char*,char*,char*);"
END IF
IF Use_DeleteRegKey THEN
FPRINT Outfile,"void DeleteRegKey (HKEY,char*);"
END IF
IF Use_CreateRegInt THEN
FPRINT Outfile,"void CreateRegInt (HKEY,char*,char*,int);"
END IF
IF Use_RegInt THEN
FPRINT Outfile,"int RegInt (HKEY,char*,char*);"
END IF
IF Use_FileLocked THEN
FPRINT Outfile,"int FileLocked (char*);"
END IF
IF Use_Bff THEN
FPRINT Outfile,"char* BFF (char*,int=0,char* =0);"
FPRINT Outfile,"int CALLBACK BFFCallBack (HWND, UINT, LPARAM, LPARAM);"
END IF
IF Use_FillArray THEN
FPRINT Outfile,"int fillarray (char *, int, int, void *);"
END IF
IF Use_Remove THEN
FPRINT Outfile,"char* RemoveStr (char*,char*);"
END IF
IF Use_IRemove THEN
FPRINT Outfile,"char* IRemoveStr (char*,char*);"
END IF
IF Use_Hook THEN
FPRINT Outfile,"LRESULT CALLBACK SBProc (int, WPARAM, LPARAM);"
END IF
IF Use_Getfilename THEN
FPRINT Outfile,"char* GetFileName (char*,char*,int=0,HWND=0,DWORD=0,char* =0,char* =0,int* =0);"
END IF
IF Use_GetTextSize THEN
FPRINT Outfile,"SIZE* GetTextSize (char*, HWND=0, HFONT=0);"
END IF
IF Use_Time THEN
FPRINT Outfile,"char* timef (int i=0);"
END IF
IF Use_Join THEN
FPRINT Outfile,"char* join (int, ... );"
END IF
IF Use_Enclose THEN
FPRINT Outfile,"char* enc (char*, int=0, int=0);"
END IF
IF Use_Chr THEN
FPRINT Outfile,"char* chr";
FPRINT Outfile,"(int,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0,int=0);"
END IF
IF Use_VChr THEN
FPRINT Outfile,"char* vchr (int,...);"
END IF
IF Use_Freefile THEN
FPRINT Outfile,"FILE* FreeFile (void);"
END IF
IF Use_PeekStr THEN
FPRINT Outfile,"char* peekstr (LPVOID,int);"
END IF
IF Use_Asc THEN
IF NOT Use_Library THEN FPRINT Outfile,"int asc (char *,int=0);"
END IF
IF Use_Instrrev THEN
FPRINT Outfile,"int InstrRev (char*,char*,int=0);"
END IF
IF Use_FirstInstance THEN
FPRINT Outfile,"BOOL FindFirstInstance (char*);"
END IF
IF Use_Instr THEN
FPRINT Outfile,"int instr(char*,char*,int=0,int=0);"
END IF
IF UseLCaseTbl AND USING_LINUX=0 THEN
FPRINT Outfile,"char *MakeLCaseTbl(void);"
END IF
IF Use_Stristr THEN
FPRINT Outfile,"char *_stristr_(char*,char*);"
END IF
IF Use_StrStr THEN
FPRINT Outfile,"char *_strstr_(char*,char*);"
END IF
IF Use_Verify THEN
FPRINT Outfile,"int Verify (char *, char *);"
FPRINT Outfile,"int VerifyInstr(char*,char*,int=0);"
END IF
IF Use_Retain THEN
FPRINT Outfile,"char* Retain (char*,char *);"
END IF
IF Use_LoadFile THEN
FPRINT Outfile,"char* LoadFile (char*);"
END IF
IF Use_Inchr THEN
FPRINT Outfile,"int inchr (char*,char*);"
END IF
IF Use_Idxqsort THEN
FPRINT Outfile,"int IdxCompare (const void *,const void *);"
END IF
IF Use_IdxqsortSt THEN
FPRINT Outfile,"int IdxCompareSt (const void *,const void *);"
END IF
IF Use_PtrqsortSt THEN
FPRINT Outfile,"int PtrCompareSt (const void *,const void *);"
END IF
IF Use_Strqsorta THEN
FPRINT Outfile,"int StrCompareA (const void *,const void *);"
END IF
IF Use_Strqsortd THEN
FPRINT Outfile,"int StrCompareD (const void *,const void *);"
END IF
IF Use_DynStrqsorta THEN
FPRINT Outfile,"int DynStrCompareA (const void *,const void *);"
END IF
IF Use_DynStrqsortd THEN
FPRINT Outfile,"int DynStrCompareD (const void *,const void *);"
END IF
IF Use_Numqsortaint THEN
FPRINT Outfile,"int NumCompareAint (const void *,const void *);"
END IF
IF Use_Numqsortdint THEN
FPRINT Outfile,"int NumCompareDint (const void *,const void *);"
END IF
IF Use_Numqsortafloat THEN
FPRINT Outfile,"int NumCompareAfloat (const void *,const void *);"
END IF
IF Use_Numqsortdfloat THEN
FPRINT Outfile,"int NumCompareDfloat (const void *,const void *);"
END IF
IF Use_Numqsortadouble THEN
FPRINT Outfile,"int NumCompareAdouble (const void *,const void *);"
END IF
IF Use_Numqsortddouble THEN
FPRINT Outfile,"int NumCompareDdouble (const void *,const void *);"
END IF
IF Use_Msgbox THEN
FPRINT Outfile,"int MsgBox (char*,char*,int);"
END IF
IF Use_Like THEN
FPRINT Outfile,"int like (char*,char*);"
END IF
IF Use_Textmode THEN
FPRINT Outfile,"int TextMode (int);"
END IF
IF Use_Tally THEN
FPRINT Outfile,"int tally (char*,char*);"
END IF
IF Use_Inkey THEN
FPRINT Outfile,"char* inkey (void);"
END IF
IF Use_InkeyD THEN
FPRINT Outfile,"int inkeyd (void);"
END IF
IF Use_Bin2dec THEN
FPRINT Outfile,"int Bin2Dec (char*);"
END IF
IF Use_Hex2Dec THEN
FPRINT Outfile,"int Hex2Dec (char*);"
END IF
IF Use_Download THEN
FPRINT Outfile,"int Download (char*,char*);"
END IF
IF Use_Exist AND USING_LINUX=0 THEN
FPRINT Outfile,"BOOL Exist (char*);"
FPRINT Outfile,"BOOL Exist_A (char*);"
FPRINT Outfile,"BOOL Exist_B (char*);"
END IF
IF Use_Ins THEN
FPRINT Outfile,"char* ins (char *S, int i, char *a);"
END IF
IF Use_Del THEN
FPRINT Outfile,"char* del (char*,int,int);"
END IF
IF Use_Screen THEN
FPRINT Outfile,"int Screen (int,int,int=0);"
END IF
IF Use_Pause THEN
FPRINT Outfile,"void Pause (void);"
END IF
IF Use_Keypress THEN
FPRINT Outfile,"int keypress (void);"
END IF
IF Use_Lof THEN
FPRINT Outfile,"DWORD lof (char*);"
END IF
IF Use_Sgn THEN
FPRINT Outfile,"double sgn (double);"
END IF
IF Use_Round THEN
FPRINT Outfile,"double Round (double,int);"
END IF
IF Use_Abs THEN
FPRINT Outfile,"double Abs (double);"
END IF
IF Use_Rnd THEN
FPRINT Outfile,"float rnd (void);"
END IF
IF Use_Exp THEN
FPRINT Outfile,"double Exp (double);"
END IF
IF Use_Min THEN
FPRINT Outfile,"double MIN (double,double);"
END IF
IF Use_Modstyle THEN
FPRINT Outfile,"BOOL ModStyle (HWND, DWORD=0, DWORD=0, BOOL=0);"
END IF
IF Use_Max THEN
FPRINT Outfile,"double MAX (double,double);"
END IF
IF Use_Timer THEN
FPRINT Outfile,"float timer (void);"
END IF
IF Use_Iif THEN
FPRINT Outfile,"double iif (BOOL,double,double);"
END IF
IF Use_Loc THEN
FPRINT Outfile,"int loc (FILE *fp, int fplen);"
END IF
IF Use_Rec THEN
FPRINT Outfile,"int rec (FILE *fp, int fplen);"
END IF
IF Use_RecCount THEN
FPRINT Outfile,"int reccount (FILE *fp, int fplen);"
END IF
IF Use_Scan THEN
FPRINT Outfile,"int scan (char *input, char *format, ... );"
END IF
IF Use_Split THEN
FPRINT Outfile,"int Split (char [][2048], char*, char*, int=0);"
END IF
IF Use_DSplit THEN
FPRINT Outfile,"int DSplit (LPSTR *, char*, char*, int=0);"
END IF
'IF Use_Library THEN
' FPRINT Outfile,"void FreeGlobals (void);"
'END IF
IF Use_SysStr THEN
FPRINT Outfile,"BSTR SysStr (char * szIn, int=0, int=0);"
END IF
IF Use_WideToAnsi THEN
FPRINT Outfile,"char* WideToAnsi (BSTR, UINT=CP_ACP, DWORD=0);"
END IF
IF Use_AnsiToWide THEN
FPRINT Outfile,"LPOLESTR AnsiToWide (char*,UINT=CP_ACP,DWORD=MB_PRECOMPOSED);"
END IF
IF Use_COM THEN
FPRINT Outfile, "// COM functions used internally by BCX"
FPRINT Outfile, "void bcx_ole_initialize(void);"
FPRINT Outfile, "void bcx_ole_uninitialize(void);"
FPRINT Outfile, "void bcx_catch_hr_error_desc(HRESULT hr, TCHAR* extra_info);"
FPRINT Outfile, "DISPID bcx_get_DISPID_of_dispatch(IDispatch* lpDispatch, LPOLESTR comsegment);"
FPRINT Outfile, "void bcx_get_next_dispatch(OBJECT* object, LPOLESTR comsegment);"
FPRINT Outfile, "void bcx_invoke_helper(OBJECT* object, LPOLESTR comsegment,WORD wFlags, VARIANT *pvResult);"
FPRINT Outfile, "void bcx_build_exception_info(HRESULT hr, EXCEPINFO* pexcep = NULL, UINT uiArgErr= 0);"
FPRINT Outfile, "void bcx_clean_parameter_list(void);"
FPRINT Outfile, "void bcx_reset_dispatch_chain(OBJECT* object);"
FPRINT Outfile, "void bcx_create_safe_array(void);"
IF build_com_trace_code OR Use_Library THEN ' used if com trace variable is set
IF Use_Library THEN
FPRINT Outfile, "char bcx_com_trace_line[2048];"
ELSE
FPRINT Outfile, "static char bcx_com_trace_line[2048];"
END IF
FPRINT Outfile, "void bcx_com_trace_dump_DISPPARAMS(DISPPARAMS* dp);"
FPRINT Outfile, "void bcx_com_trace_add_line(char* dp);"
FPRINT Outfile, "void bcx_com_trace_dump_indicators(OBJECT* object);"
FPRINT Outfile, "void bcx_com_trace_dump_flags(WORD wFlags);"
END IF
FPRINT Outfile, "// public COM support functions >>> "
FPRINT Outfile, "void BCX_SetNothing(OBJECT* object);"
FPRINT Outfile, "HRESULT BCX_GET_COM_ERROR_CODE(void);"
FPRINT Outfile, "char* BCX_GET_COM_ERROR_DESC(void);"
FPRINT Outfile, "BOOL BCX_GET_COM_SUCCESS(void);"
FPRINT Outfile, "void BCX_SHOW_COM_ERRORS(BOOL Show_err);"
IF Use_BCX_COM_CreateObject THEN FPRINT Outfile, "void BCX_CreateObject(TCHAR* objname, OBJECT* obj);"
IF Use_BCX_COM_GetObject THEN
FPRINT Outfile, "void BCX_GetObject(TCHAR* objname, OBJECT* obj);"
FPRINT Outfile, "void BCX_GetObjectMon(LPCOLESTR objname, OBJECT* obj);"
END IF
IF Use_BCX_COM_DispatchObject THEN FPRINT Outfile, "void BCX_DispatchObject(IUnknown* iobj, OBJECT* obj, BOOL b_release = TRUE);"
FPRINT Outfile, "// <<< public COM support functions "
IF Use_BCX_COM_UsesConversion THEN FPRINT Outfile, "HRESULT BCX_COM_AS2WS(LPCSTR ansi_string, UINT code_page = CP_ACP);"
IF Use_BCX_COM_UsesConversion THEN FPRINT Outfile, "HRESULT BCX_COM_WS2AS(LPCWSTR wide_string, UINT code_page = CP_ACP);"
FPRINT Outfile, "void BCX_COM_FREE_TEMP_ANSI_STRING(void);"
FPRINT Outfile, "void BCX_COM_FREE_TEMP_WIDE_STRING(void);"
END IF
IF Use_Cvi THEN
FPRINT Outfile,"short CVI (char*);"
END IF
IF Use_Mki THEN
FPRINT Outfile,"char* MKI (short);"
END IF
IF Use_Cvl THEN
FPRINT Outfile,"long CVL (char*);"
END IF
IF Use_Mkl THEN
FPRINT Outfile,"char* MKL (int);"
END IF
IF Use_Cvs THEN
FPRINT Outfile,"float CVS (char*);"
END IF
IF Use_Mks THEN
FPRINT Outfile,"char* MKS (float);"
END IF
IF Use_Cvd THEN
FPRINT Outfile,"double CVD (char*);"
END IF
IF Use_Cvld THEN
FPRINT Outfile,"long double CVLD (char*);"
END IF
IF Use_Mkd THEN
FPRINT Outfile,"char* MKD (double);"
END IF
IF Use_Mkld THEN
FPRINT Outfile,"char* MKLD (long double);"
END IF
IF Use_OSVersion THEN
FPRINT Outfile,"int OSVersion (void);"
END IF
IF Use_Sound THEN
FPRINT Outfile,"int Sound (float,int=0,int=127,int=0,float=1);"
FPRINT Outfile,"int PlaySnd (void);"
END IF
IF Use_Hscroll OR Use_Vscroll THEN
FPRINT Outfile,"void BCX_Scroll (HWND,int,int,int,int,int,int,int,int,int,int);"
END IF
IF Use_Dynacall THEN
FPRINT Outfile,"HINSTANCE BCX_LoadDll(char *);"
FPRINT Outfile,"void BCX_UnloadDll(void);"
FPRINT Outfile,"typedef int (CALLBACK *DYNACALL1)(void);"
FPRINT Outfile,"int BCX_DynaCall(char *, char *, int, ...);"
END IF
IF Use_DynamicA THEN
FPRINT Outfile,"void* CreateArr (void*,int,int,int,...);"
FPRINT Outfile,"void* CreateArr_internal(void*, int, int, int, va_list);"
FPRINT Outfile,"void DestroyArr (void**,int,int);"
END IF
IF Use_ContainedIn THEN
FPRINT Outfile,"int containedin(char * ,char **,int=0);"
END IF
IF Use_FindInType THEN
FPRINT Outfile,"int FindInType(char *,char *,int,int,int,int=0,int* =0);"
END IF
IF Use_SingleFile = FALSE THEN
OPEN HFile$ FOR OUTPUT AS fpHFile
END IF
IF Use_Printer THEN
FPRINT Outfile,"int PrinterOpen (void);"
FPRINT Outfile,"void PrinterWrite (char*);"
FPRINT Outfile,"void EjectPage (void);"
FPRINT Outfile,"void PrinterClose (void);"
END IF
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
END IF ' IF Use_Project = FALSE
IF ProtoCnt THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER PROTOTYPES"
ELSE
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_USR_PROTOS
FPRINT Outfile,"// *************************************************"
END IF
FPRINT Outfile,""
DIM RAW LastDef$
DIM RAW LastLevel
LastDef$ = ""
LastLevel = 1
FOR A = 1 TO ProtoCnt
IF LastDef$ = "" THEN
LastDef$ = ProtoType[A].Condition$
LastLevel = ProtoType[A].CondLevel
IF Use_SingleFile = FALSE THEN
IF LastDef$ > "" THEN FPRINT fpHFile, LastDef$
END IF
IF LastDef$ > "" THEN FPRINT Outfile, LastDef$
END IF
IF LastDef$ <> ProtoType[A].Condition$ THEN
IF ProtoType[A].Condition$ = "#else" THEN
WHILE LastLevel > ProtoType[A].CondLevel
IF Use_SingleFile = FALSE THEN
FPRINT fpHFile, "#endif"
END IF
FPRINT Outfile,"#endif"
LastLevel--
WEND
IF Use_SingleFile = FALSE THEN
FPRINT fpHFile, "#else"
END IF
FPRINT Outfile,"#else"
LastDef$ = ProtoType[A].Condition$
LastLevel = ProtoType[A].CondLevel
ELSE
WHILE LastLevel > ProtoType[A].CondLevel
IF Use_SingleFile = FALSE THEN
FPRINT fpHFile, "#endif"
END IF
FPRINT Outfile,"#endif"
LastLevel--
WEND
LastDef$ = ProtoType[A].Condition$
LastLevel = ProtoType[A].CondLevel
IF Use_SingleFile = FALSE THEN
IF LastDef$ > "" THEN FPRINT fpHFile, LastDef$
END IF
IF LastDef$ > "" THEN FPRINT Outfile, LastDef$
END IF
END IF
IF UseStdCall AND UseCpp THEN
IF LEFT$(ProtoType[A].Prototype$, 9) = "C_EXPORT " THEN
EmitExportDef(ProtoType[A].Prototype$)
END IF
END IF
T$ = EXTRACT$(ProtoType[A].Prototype$, SPC$)
T$ = RPAD$(T$, 7) + SPC$
ProtoType[A].Prototype$ = T$ + REMAIN$(ProtoType[A].Prototype$, SPC$)
IF Use_SingleFile = FALSE THEN
FPRINT fpHFile, ProtoType[A].Prototype$
END IF
FPRINT Outfile,ProtoType[A].Prototype$
NEXT A 'ProtoCnt
IF *LastDef$ THEN
WHILE LastLevel > 0
IF Use_SingleFile = FALSE THEN
FPRINT fpHFile, "#endif"
END IF
FPRINT Outfile,"#endif"
LastLevel--
WEND
END IF
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
END IF
FPRINT Outfile,""
IF Use_EnumFile THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER GLOBAL ENUM BLOCKS"
ELSE
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// User's GLOBAL ENUM blocks"
FPRINT Outfile,"// *************************************************"
END IF
OPEN enuFile$ FOR INPUT AS FP8
WHILE NOT EOF(FP8)
LINE INPUT FP8,ZZ$
FPRINT Outfile,ZZ$
WEND
CLOSE FP8
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
FPRINT Outfile,"\n\n"
END IF
IF Use_Overloaded THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER OVERLOADED SUBS AND FUNCTIONS"
ELSE
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// User's Overloaded Subs/Functions "
FPRINT Outfile,"// *************************************************"
END IF
OPEN ovrFile$ FOR INPUT AS FP8
WHILE NOT EOF(FP8)
LINE INPUT FP8,ZZ$
IF INSTR(ZZ$,"overloaded") THEN
FPRINT Outfile,"\n"
END IF
FPRINT Outfile,ZZ$
WEND
CLOSE FP8
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
FPRINT Outfile,"\n\n"
END IF
OPEN setFile$ FOR INPUT AS FP5
IF LOF(setFile$) > 0 THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: USER GLOBAL SET STATEMENTS"
ELSE
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// User GLOBAL SET Statements"
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
WHILE NOT EOF(FP5)
LINE INPUT FP5,Z$
FPRINT Outfile,Z$
WEND
FPRINT Outfile,""
END IF
CLOSE FP5
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIBHEADER: "
IF Use_SingleFile = FALSE THEN
CLOSE fpHFile
END IF
IF Use_Wingui = 0 AND NoMain = 0 THEN
IF Use_Library THEN
FPRINT Outfile,"// BCXRTHEADER: MAIN PROGRAM"
ELSE
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_MAIN_PROG
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
END IF
END IF
'**********************************************************************
IF Use_Wingui + MakeDLL + NoMain = FALSE THEN
FPRINT Outfile,SaveMain$ ' add the >> void main() back to the stream
FPRINT Outfile,"{" ' AND OPEN the main FUNCTION
END IF
'**********************************************************************
IF (NoMain + Use_Wingui + MakeDLL = FALSE) AND (Use_Console = TRUE) THEN
FPRINT Outfile," hConsole = GetStdHandle (STD_OUTPUT_HANDLE);"
END IF
WHILE NOT EOF(FP1)
LINE INPUT FP1,ZZ$
FPRINT Outfile,Scoot$,ZZ$
WEND
IF Use_Library THEN FPRINT Outfile,"// END BCXRTHEADER\n\n"
IF Use_SingleFile = TRUE AND Use_Project = FALSE THEN
CALL RunTimeFunctions
ELSE
IF Use_Project = FALSE THEN
CALL SetFlags
END IF
END IF
FLUSH(Outfile)
CALL CloseAll
KILL FileOut$
RENAME "$t$e$m$p", FileOut$
END SUB ' AddProtos
SUB RunTimeFunctions
FPRINT Outfile,""
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,"// " + $BCX_STR_RUNTIME
FPRINT Outfile,"// *************************************************"
FPRINT Outfile,""
IF UseFlag THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: BCX_TmpStr"
IF Use_Turbo THEN
FPRINT Outfile,"char *BCX_TmpStr (size_t Bites)"
FPRINT Outfile,"{"
FPRINT Outfile," static int StrCnt;"
FPRINT Outfile," static char *StrFunc[",TurboSize,"];"
FPRINT Outfile," StrCnt=(++StrCnt &",TurboSize-1,");"
FPRINT Outfile," StrFunc[StrCnt]=(char*)realloc(StrFunc[StrCnt],Bites + 128);"
FPRINT Outfile," return (char*)memset(StrFunc[StrCnt],0,Bites+128);"
FPRINT Outfile,"}\n\n"
ELSE
FPRINT Outfile,"char *BCX_TmpStr (size_t Bites)"
FPRINT Outfile,"{"
FPRINT Outfile," static int StrCnt;"
FPRINT Outfile," static char *StrFunc[2048];"
FPRINT Outfile," StrCnt=(StrCnt + 1) & 2047;"
FPRINT Outfile," if(StrFunc[StrCnt]) free (StrFunc[StrCnt]);"
FPRINT Outfile," return StrFunc[StrCnt]=(char*)calloc(Bites+128,sizeof(char));"
FPRINT Outfile,"}\n\n"
END IF
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Str_Cmp AND USING_LINUX = 0 THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: str_cmp"
FPRINT Outfile,"int str_cmp (char *a, char *b)"
FPRINT Outfile,"{"
FPRINT Outfile," register int counter=0;"
FPRINT Outfile," while(1)"
FPRINT Outfile," {"
FPRINT Outfile," if((a[counter]^b[counter]))"
FPRINT Outfile," {"
FPRINT Outfile," if((UINT) a[counter]>= (UINT) b[counter])"
FPRINT Outfile," return 1;"
FPRINT Outfile," return -1;"
FPRINT Outfile," }"
FPRINT Outfile," if(!a[counter]) return 0;"
FPRINT Outfile," counter++;"
FPRINT Outfile," }"
FPRINT Outfile,"#if !defined( __cplusplus )"
FPRINT Outfile," return 0;"
FPRINT Outfile,"#endif"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Eof THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: Eof"
FPRINT Outfile,"int EoF (FILE* stream)"
FPRINT Outfile,"{"
FPRINT Outfile," register int c, status = ((c = fgetc(stream)) == EOF);"
FPRINT Outfile," ungetc(c,stream);"
FPRINT Outfile," return status;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_AppActivate THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: AppActivate"
FPRINT Outfile,"int AppActivate (char *Z)"
FPRINT Outfile,"{"
FPRINT Outfile," int CurThread;"
FPRINT Outfile," int NewThread;"
FPRINT Outfile," int Rc;"
FPRINT Outfile," int ArgLen;"
FPRINT Outfile," char Buffer[2048];"
FPRINT Outfile," HWND hWnd;"
FPRINT Outfile," *Buffer = 0;"
FPRINT Outfile," ArgLen = strlen(Z);"
FPRINT Outfile," CurThread = GetCurrentThreadId();"
FPRINT Outfile," hWnd = GetForegroundWindow();"
FPRINT Outfile," for(Rc=0;Rc<=1000;Rc++)"
FPRINT Outfile," {"
FPRINT Outfile," hWnd=GetNextWindow(hWnd,GW_HWNDNEXT);"
FPRINT Outfile," GetWindowText(hWnd,Buffer,256);"
FPRINT Outfile," if(instr(left(lcase(Buffer),ArgLen),lcase(Z))) break;"
FPRINT Outfile," }"
FPRINT Outfile," if(Rc==1001) return 0;"
FPRINT Outfile," NewThread=GetWindowThreadProcessId(hWnd,NULL);"
FPRINT Outfile," AttachThreadInput(CurThread,NewThread,TRUE);"
FPRINT Outfile," SetActiveWindow(hWnd);"
FPRINT Outfile," return TRUE;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Cint THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: Cint"
FPRINT Outfile,"int Cint (double A)"
FPRINT Outfile,"{"
FPRINT Outfile," return (A >=0 ? (int)(A+0.5) : (int)(A-0.5));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Clng THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: CLNG"
FPRINT Outfile,"long CLNG (double A)"
FPRINT Outfile,"{"
FPRINT Outfile," float r=.5;"
FPRINT Outfile," double a=A-(long)A;"
FPRINT Outfile," if(A<0) { r=-.5; a=-a; }"
FPRINT Outfile," if(((long)A % 2)==0&&a<=.5)"
FPRINT Outfile," return (long)A;"
FPRINT Outfile," else"
FPRINT Outfile," return (long)(A+r);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Left THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: left"
FPRINT Outfile,"char *left (char *S, int length)"
FPRINT Outfile,"{"
FPRINT Outfile," register int tmplen = strlen(S);"
FPRINT Outfile," tmplen = (length>tmplen?tmplen:length);"
FPRINT Outfile," char *strtmp = BCX_TmpStr(tmplen);"
FPRINT Outfile," return (char*)memcpy(strtmp,S,tmplen*sizeof(char));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Right THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: right"
FPRINT Outfile,"char *right (char *S, int length)"
FPRINT Outfile,"{"
FPRINT Outfile," int tmplen = strlen(S);"
FPRINT Outfile," char *BCX_RetStr = BCX_TmpStr(tmplen);"
FPRINT Outfile," tmplen -= length;"
FPRINT Outfile," if (tmplen<0) tmplen = 0;"
FPRINT Outfile," return strcpy(BCX_RetStr, &S[tmplen]);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Rpad THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: rpad"
FPRINT Outfile,"char *rpad (char *a, int L, int c)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp;"
FPRINT Outfile," int s = strlen(a);"
FPRINT Outfile," if((L-s)<1) return a;"
FPRINT Outfile," strtmp=BCX_TmpStr(L);"
FPRINT Outfile," strcpy(strtmp,a);"
FPRINT Outfile," memset(&strtmp[s],c,(L-s)*sizeof(char));"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Lpad THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: lpad"
FPRINT Outfile,"char *lpad (char *a, int L, int c)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp;"
FPRINT Outfile," L=L-strlen(a);"
FPRINT Outfile," if(L<1) return a;"
FPRINT Outfile," strtmp = BCX_TmpStr(L);"
FPRINT Outfile," memset(strtmp,c,L*sizeof(char));"
FPRINT Outfile," return strcat(strtmp,a);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Mid THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: mid"
FPRINT Outfile,"char *mid (char *S, int start, int length)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp;"
FPRINT Outfile," register int tmplen = strlen(S);"
FPRINT Outfile," if(start>tmplen||start<1) return BCX_TmpStr(1);"
FPRINT Outfile," if (length<0 || length>(tmplen-start)+1)"
FPRINT Outfile," length = (tmplen-start)+1;"
FPRINT Outfile," strtmp = BCX_TmpStr(length);"
FPRINT Outfile," return (char*)memcpy(strtmp,&S[start-1],length*sizeof(char));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Trim THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: trim"
FPRINT Outfile,"char *trim (char *S)"
FPRINT Outfile,"{"
FPRINT Outfile," while(*S==32 || *S==9 || *S==10 || *S==11 || *S==13)"
' tab ,carriage return, vertical tab, newline, space
FPRINT Outfile," S++;"
FPRINT Outfile," register int i = strlen(S);"
FPRINT Outfile," while( i>0 && (S[i-1]==32 || S[i-1]==9 || S[i-1]==10"
FPRINT Outfile," || S[i-1]==11 || S[i-1]==13))"
FPRINT Outfile," i--;"
FPRINT Outfile," char *strtmp=BCX_TmpStr(i);"
FPRINT Outfile," return (char*)memcpy(strtmp,S,i*sizeof(char));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Ltrim THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: ltrim"
FPRINT Outfile,"char *ltrim (char *S, char c)"
FPRINT Outfile,"{"
FPRINT Outfile," if(S[0]==0) return S;"
FPRINT Outfile," while((*S==32 || *S==c) && *S !=0) S++;"
FPRINT Outfile," char *strtmp = BCX_TmpStr(strlen(S));"
FPRINT Outfile," return strcpy(strtmp,S);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Rtrim THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: rtrim"
FPRINT Outfile,"char *rtrim (char *S,char c)"
FPRINT Outfile,"{"
FPRINT Outfile," if(S[0]==0) return S;"
FPRINT Outfile," register int i = strlen(S);"
FPRINT Outfile," while(i>0 && (S[i-1]==c || S[i-1]==32))"
FPRINT Outfile," i--;"
FPRINT Outfile," char *strtmp = BCX_TmpStr(i);"
FPRINT Outfile," return (char*)memcpy(strtmp,S,i*sizeof(char));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Strim THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: strim"
FPRINT Outfile,"char *strim (char *src)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp = BCX_TmpStr(strlen(src));"
FPRINT Outfile," register char *dst = strtmp;"
FPRINT Outfile," while (isspace((unsigned char)*src)) src++;"
FPRINT Outfile," do"
FPRINT Outfile," {"
FPRINT Outfile," while (*src && !isspace((unsigned char)*src)) *dst++ = *src++;"
FPRINT Outfile," if (*src)"
FPRINT Outfile," {"
FPRINT Outfile," *dst++ = *src++;"
FPRINT Outfile," while (isspace((unsigned char)*src)) src++;"
FPRINT Outfile," }"
FPRINT Outfile," } while (*src);"
FPRINT Outfile," if (isspace((unsigned char)*(--dst))) *dst = 0;"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Command THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: command"
FPRINT Outfile,"char *command (int nArg)"
FPRINT Outfile," {"
FPRINT Outfile," register int i = 0;"
FPRINT Outfile," char *c, *retstr, *s = GetCommandLine();"
FPRINT Outfile," if(nArg < i) // return entire commandline"
FPRINT Outfile," {"
FPRINT Outfile," while(*s && *s != 32)"
FPRINT Outfile," {"
FPRINT Outfile," if(*s == 34)"
FPRINT Outfile," while(*++s && *s != 34);"
FPRINT Outfile," s++;"
FPRINT Outfile," }"
FPRINT Outfile," while(isspace((unsigned char)*s))s++;"
FPRINT Outfile," retstr = BCX_TmpStr(strlen(s)+1);"
FPRINT Outfile," strcpy(retstr, s);"
FPRINT Outfile," if(*(retstr+strlen(retstr)-1)==20) *retstr=0;"
FPRINT Outfile," return retstr;"
FPRINT Outfile," }"
FPRINT Outfile," while(i <= nArg)"
FPRINT Outfile," {"
FPRINT Outfile," while(isspace((unsigned char)*s)) s++; // skip whitespace"
FPRINT Outfile," c = s;"
FPRINT Outfile," if(*s == 34) // argument starts a quote"
FPRINT Outfile," {"
FPRINT Outfile," while(*++s && *s != 34); // skip till next quote"
FPRINT Outfile," if(*s) s++; // skip quote itself"
FPRINT Outfile," }"
FPRINT Outfile," else"
FPRINT Outfile," {"
FPRINT Outfile," while(*s && *s != 32)"
FPRINT Outfile," s++;"
FPRINT Outfile," }"
FPRINT Outfile," i++;"
FPRINT Outfile," }"
FPRINT Outfile," if(*c == 34)"
FPRINT Outfile," {"
FPRINT Outfile," c++; // skip leading quote"
FPRINT Outfile," if(*(s-1) == 34) s--; // skip any trailing quotes"
FPRINT Outfile," }"
FPRINT Outfile," retstr = BCX_TmpStr((s - c) + 1);"
FPRINT Outfile," strncpy(retstr, c, (s - c));"
FPRINT Outfile," retstr[s-c]=0;"
FPRINT Outfile," return retstr;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Extract THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: extract"
FPRINT Outfile,"char *extract (char *mane, char *match)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *a;"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(strlen(mane));"
FPRINT Outfile," if(*match!=0)"
FPRINT Outfile," {"
FPRINT Outfile," a=_strstr_(mane,match);"
FPRINT Outfile," if(a) return (char*)memcpy(strtmp,mane,a-mane);"
FPRINT Outfile," }"
FPRINT Outfile," return strcpy(strtmp,mane);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Remain THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: remain"
FPRINT Outfile,"char *remain (char *mane, char *mat)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *p = strstr(mane,mat);"
FPRINT Outfile," if(p)"
FPRINT Outfile," {"
FPRINT Outfile," p+=(strlen(mat));"
FPRINT Outfile," return p;"
FPRINT Outfile," }"
FPRINT Outfile," return mane;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Replace THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: replace"
FPRINT Outfile,"char *replace (char *src, char *pat, char *rep)"
FPRINT Outfile,"{"
FPRINT Outfile," register size_t patsz, repsz, tmpsz, delta;"
FPRINT Outfile," register char *strtmp, *p, *q, *r;"
FPRINT Outfile," if (!pat || !*pat)"
FPRINT Outfile," {"
FPRINT Outfile," strtmp = BCX_TmpStr(strlen(src));"
FPRINT Outfile," if (!strtmp) return NULL;"
FPRINT Outfile," return strcpy(strtmp, src);"
FPRINT Outfile," }"
FPRINT Outfile," repsz = strlen(rep);"
FPRINT Outfile," patsz = strlen(pat);"
FPRINT Outfile," for (tmpsz=0, p=src; (q=_strstr_(p,pat))!=0; p=q+patsz)"
FPRINT Outfile," tmpsz += (size_t) (q - p) + repsz;"
FPRINT Outfile," tmpsz += strlen(p);"
FPRINT Outfile," strtmp = BCX_TmpStr(tmpsz);"
FPRINT Outfile," if (!strtmp) return NULL;"
FPRINT Outfile," for (r=strtmp,p=src; (q=_strstr_(p,pat))!=0;p=q+patsz)"
FPRINT Outfile," {"
FPRINT Outfile," delta = (size_t) (q-p);"
FPRINT Outfile," memcpy(r,p,delta); r += delta;"
FPRINT Outfile," strcpy(r,rep); r += repsz;"
FPRINT Outfile," }"
FPRINT Outfile," strcpy(r,p);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Reverse THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: reverse"
FPRINT Outfile,"char *reverse (char *s)"
FPRINT Outfile,"{"
FPRINT Outfile," int j=strlen(s);"
FPRINT Outfile," register char *rstr = BCX_TmpStr(j);"
FPRINT Outfile," while(j) rstr[--j] = *(s++);"
FPRINT Outfile," return rstr;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Findfirst THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: findfirst"
FPRINT Outfile,"char *findfirst (char *S)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(strlen(S));"
FPRINT Outfile," if(FileHandle) FindClose(FileHandle);"
FPRINT Outfile," FileHandle = FindFirstFile(S,&FindData);"
FPRINT Outfile," if (FileHandle != INVALID_HANDLE_VALUE)"
FPRINT Outfile," strcpy(strtmp,FindData.cFileName);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Findnext THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: findnext"
FPRINT Outfile,"char *findnext (void)"
FPRINT Outfile,"{"
FPRINT Outfile," register int Found = FindNextFile(FileHandle,&FindData);"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(2048);"
FPRINT Outfile," if(Found)"
FPRINT Outfile," strcpy(strtmp,FindData.cFileName);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Ucase THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: ucase"
FPRINT Outfile,"char *ucase (char *S)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(strlen(S));"
FPRINT Outfile," register int t;"
FPRINT Outfile," for(t=0; S[t]; ++t) {"
FPRINT Outfile," S[t] = toupper(S[t]);"
FPRINT Outfile," }"
FPRINT Outfile," return strcpy(strtmp,S);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Lcase THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: lcase"
FPRINT Outfile,"char *lcase (char *S)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(strlen(S));"
FPRINT Outfile," return strlwr(strcpy(strtmp,S));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Mcase THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: mcase"
FPRINT Outfile,"char *mcase (char *S)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(strlen(S)+1);"
FPRINT Outfile," register char *s = strtmp;"
FPRINT Outfile," strlwr(strcpy(strtmp,S));"
FPRINT Outfile," while(*s)"
FPRINT Outfile," {"
FPRINT Outfile," if(islower(*s))"
FPRINT Outfile," {"
FPRINT Outfile," *s-=32;"
FPRINT Outfile," while(isalpha(*++s));"
FPRINT Outfile," }"
FPRINT Outfile," s++;"
FPRINT Outfile," }"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Remove THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: RemoveStr"
FPRINT Outfile,"char *RemoveStr (char *a, char *b)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp, *p, *d;"
FPRINT Outfile," int tmplen;"
FPRINT Outfile," strtmp = d = BCX_TmpStr(strlen(a));"
FPRINT Outfile," if(!b || !*b) return strcpy(strtmp,a);"
FPRINT Outfile," p=_strstr_(a,b); tmplen = strlen(b);"
FPRINT Outfile," while(p)"
FPRINT Outfile," {"
FPRINT Outfile," memcpy(d,a,p-a);"
FPRINT Outfile," d+= (p-a);"
FPRINT Outfile," a=p+tmplen;"
FPRINT Outfile," p=_strstr_(a,b);"
FPRINT Outfile," }"
FPRINT Outfile," strcpy(d,a);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_IRemove THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: IRemove"
FPRINT Outfile,"char *IRemoveStr (char *a, char *b)"
FPRINT Outfile,"{"
FPRINT Outfile," char *strtmp, *p, *d;"
FPRINT Outfile," int tmplen;"
FPRINT Outfile," strtmp = d = BCX_TmpStr(strlen(a));"
FPRINT Outfile," if(!b || !*b) return strcpy(strtmp,a);"
FPRINT Outfile," p=_stristr_(a,b); tmplen = strlen(b);"
FPRINT Outfile," while(p)"
FPRINT Outfile," {"
FPRINT Outfile," memcpy(d,a,p-a);"
FPRINT Outfile," d+= (p-a);"
FPRINT Outfile," a=p+tmplen;"
FPRINT Outfile," p=_stristr_(a,b);"
FPRINT Outfile," }"
FPRINT Outfile," strcpy(d,a);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Ins THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: ins"
FPRINT Outfile,"char *ins (char *S, int i, char *a)"
FPRINT Outfile,"{"
FPRINT Outfile," register int j = strlen(S);"
FPRINT Outfile," if(i<1 || i>j+1) return S;"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(j + strlen(a));"
FPRINT Outfile," memcpy(strtmp,S,--i);"
FPRINT Outfile," strcpy(&strtmp[i],a);"
FPRINT Outfile," return strcat(strtmp,&S[i]);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Del THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: del"
FPRINT Outfile,"char *del (char *S, int i, int j)"
FPRINT Outfile,"{"
FPRINT Outfile," int ln = strlen(S);"
FPRINT Outfile," if(i<1 || i>ln) return S;"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(ln);"
FPRINT Outfile," memcpy(strtmp,S,--i);"
FPRINT Outfile," return strcat(strtmp,&S[i+j]);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Str THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: str"
FPRINT Outfile,"char *str (double d)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(16);"
FPRINT Outfile," sprintf(strtmp,";D1$;",d);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Strl THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: strl"
FPRINT Outfile,"char *strl (long double d)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(27);"
FPRINT Outfile," sprintf(strtmp,";D2$;",d);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Curdir THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: curdir"
FPRINT Outfile,"char *curdir (void)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(2048);"
FPRINT Outfile," GetCurrentDirectory (1024,strtmp);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Hex THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: hex"
FPRINT Outfile,"char *hex (int a)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(16);"
FPRINT Outfile," sprintf(strtmp,";X1$;",a);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Tempdir THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: tempdir"
FPRINT Outfile,"char *tempdir (void)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(2048);"
FPRINT Outfile," GetTempPath (1024,strtmp);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Windir THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: windir"
FPRINT Outfile,"char *windir (void)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(2048);"
FPRINT Outfile," GetWindowsDirectory (strtmp,2048);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Sysdir THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: sysdir"
FPRINT Outfile,"char *sysdir (void)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(2048);"
FPRINT Outfile," GetSystemDirectory (strtmp,2048);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Repeat THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: repeat"
FPRINT Outfile,"char *repeat (int count, char *a)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr((1+count)*strlen(a));"
FPRINT Outfile," while(count-->0) strtmp = strcat(strtmp, a);"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_String THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: string"
FPRINT Outfile,"char *string (int count, int a)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(count);"
FPRINT Outfile," return (char*)memset(strtmp,a,count);"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Space THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: space"
FPRINT Outfile,"char *space (int a)"
FPRINT Outfile,"{"
FPRINT Outfile," register char *strtmp = BCX_TmpStr(a);"
FPRINT Outfile," return (char*)memset(strtmp,32,a*sizeof(char));"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Time THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: timef"
FPRINT Outfile,"char *timef (int t)"
FPRINT Outfile,"{"
FPRINT Outfile," time_t elapse_time;"
FPRINT Outfile," struct tm *tp;"
FPRINT Outfile," char *strtmp = BCX_TmpStr(256);"
FPRINT Outfile," time (&elapse_time);"
FPRINT Outfile," tp = localtime(&elapse_time);"
FPRINT Outfile," switch (t)"
FPRINT Outfile," {"
FPRINT Outfile," case 0:"
FPRINT Outfile," strftime(strtmp,256,",T0$, ",tp); break;"
FPRINT Outfile," case 1:"
FPRINT Outfile," strftime(strtmp,256,",T1$, ",tp); break;"
FPRINT Outfile," case 2:"
FPRINT Outfile," strftime(strtmp,256,",T2$, ",tp); break;"
FPRINT Outfile," case 3:"
FPRINT Outfile," strftime(strtmp,256,",T3$, ",tp); break;"
FPRINT Outfile," case 4:"
FPRINT Outfile," strftime(strtmp,256,",T4$, ",tp); break;"
FPRINT Outfile," case 5:"
FPRINT Outfile," strftime(strtmp,256,",T5$, ",tp); break;"
FPRINT Outfile," case 6:"
FPRINT Outfile," strftime(strtmp,256,",T6$, ",tp); break;"
FPRINT Outfile," case 7:"
FPRINT Outfile," strftime(strtmp,256,",T7$, ",tp); break;"
FPRINT Outfile," case 8:"
FPRINT Outfile," strftime(strtmp,256,",T8$, ",tp); break;"
FPRINT Outfile," case 9:"
FPRINT Outfile," strftime(strtmp,256,",T9$, ",tp); break;"
FPRINT Outfile," case 10:"
FPRINT Outfile," strftime(strtmp,256,",T10$, ",tp); break;"
FPRINT Outfile," case 11:"
FPRINT Outfile," strftime(strtmp,256,",T11$, ",tp); break;"
FPRINT Outfile," }"
FPRINT Outfile," return strtmp;"
FPRINT Outfile,"}\n\n"
IF Use_Library THEN FPRINT Outfile,"// ENDBCXRTLIB "
END IF
IF Use_Enclose THEN
IF Use_Library THEN FPRINT Outfile,"// BCXRTLIB: enc"
FPRINT Outfi