Код:
#SEPARATOR = ","
#MAX_ARGUMENTS = 256
#EXE_FILE_SIZE = 30720
Enumeration
#OP_SET
#OP_ADD
#OP_SUB
#OP_MUL
#OP_DIV
#OP_AND
#OP_OR
#OP_XOR
#OP_MOD
#OP_SHL
#OP_SHR
#OP_LABEL
#OP_GOTO
#OP_CreateThread
#OP_PauseThread
#OP_ResumeThread
#OP_KillThread
#OP_ThreadPriority
#OP_OpenConsole
#OP_Print
#OP_Input
#OP_INT
#OP_FRAC
#OP_SIN
#OP_COS
#OP_TAN
#OP_ARCSIN
#OP_ARCCOS
#OP_ARCTAN
#OP_ROUND
#OP_RANDOM
#OP_ELAPSED
EndEnumeration
Enumeration
#TYPE_INT
#TYPE_FLOAT
#TYPE_STRING
EndEnumeration
Structure COMMAND_STRUCT
Operation.i
Count.i
Arg$[#MAX_ARGUMENTS]
EndStructure
Global Dim Command.COMMAND_STRUCT(1)
Global *LastCommand
Global NewMap Var$()
Global NewMap Label()
Macro SetStr(Value)
*Command\Arg$[1] = Value
EndMacro
Macro SetInt(Value)
*Command\Arg$[1] = Str(Value)
EndMacro
Macro SetFloat(Value)
*Command\Arg$[1] = StrD(Value)
EndMacro
Procedure$ Expr(String$)
Length = Len(String$)
ch$ = Left(String$, 1)
If ch$ = "$"
ProcedureReturn Right(String$, Length - 1)
ElseIf (ch$ >= Chr(49) And ch$ <= Chr(57)) Or ch$ = "-"
ProcedureReturn StrD(ValD(String$))
EndIf
ProcedureReturn Var$(String$)
EndProcedure
Macro GetInt(Index)
Val(Expr(*Command\Arg$[Index]))
EndMacro
Macro GetStr(Index)
Expr(*Command\Arg$[Index])
EndMacro
Macro GetFloat(Index)
ValD(Expr(*Command\Arg$[Index]))
EndMacro
Macro Count()
*Command\Count
EndMacro
Procedure Interpreter(*Command.COMMAND_STRUCT)
Repeat
If (*Command > *LastCommand)
Break
EndIf
Select *Command\Operation
Case #OP_LABEL
*Command + SizeOf(COMMAND_STRUCT)
Continue
Case #OP_GOTO
*Command = Label(GetStr(1))
Continue
Case #OP_SET
SetStr(GetStr(1))
Case #OP_ADD
Float.d = GetFloat(1)
For i = 2 To Count()
Float + GetFloat(i)
Next
SetFloat(Float)
Case #OP_SUB
Float.d = GetFloat(1)
For i = 2 To Count()
Float - GetFloat(i)
Next
SetFloat(Float)
Case #OP_MUL
Float.d = GetFloat(1)
For i = 2 To Count()
Float * GetFloat(i)
Next
SetFloat(Float)
Case #OP_DIV
Float.d = GetFloat(1)
For i = 2 To Count()
Float / GetFloat(i)
Next
SetFloat(Float)
Case #OP_LABEL
*Command + SizeOf(COMMAND_STRUCT)
Continue
Case #OP_GOTO
*Command = Label(GetStr(1))
Continue
Case #OP_AND
Integer.i = GetInt(1)
For i = 2 To Count()
Integer & GetInt(i)
Next
SetInt(Integer)
Case #OP_OR
Integer.i = GetInt(1)
For i = 2 To Count()
Integer | GetInt(i)
Next
SetInt(Integer)
Case #OP_XOR
Integer.i = GetInt(1)
For i = 2 To Count()
Integer ! GetInt(i)
Next
SetInt(Integer)
Case #OP_MOD
Integer.i = GetInt(1)
For i = 2 To Count()
Integer % GetInt(i)
Next
SetInt(Integer)
Case #OP_SHL
Integer.i = GetInt(1)
For i = 2 To Count()
Integer << GetInt(i)
Next
SetInt(Integer)
Case #OP_SHR
Integer.i = GetInt(1)
For i = 2 To Count()
Integer >> GetInt(i)
Next
SetInt(Integer)
Case #OP_CreateThread
SetInt(CreateThread(@Interpreter(), Label(GetStr(2))))
Case #OP_PauseThread
PauseThread(GetInt(1))
Case #OP_ResumeThread
ResumeThread(GetInt(1))
Case #OP_KillThread
KillThread(GetInt(1))
Case #OP_ThreadPriority
ThreadPriority(Getint(1), GetInt(2))
Case #OP_OpenConsole
OpenConsole(GetStr(1))
Case #OP_Print
Print(GetStr(1))
Case #OP_Input
SetStr(Input())
EndSelect
*Command + SizeOf(COMMAND_STRUCT)
ForEver
EndProcedure
Macro GetCmdName()
StringField(Line$, 1, #SEPARATOR)
EndMacro
Macro GetCmdVal(Index)
StringField(Line$, Index+1, #SEPARATOR)
EndMacro
Procedure GenerateByteCode(String$)
Lines = CountString(String$, #CRLF$)+1
ReDim Command(Lines)
*LastCommand = @Command(Lines)
For i = 1 To Lines
Line$ = StringField(String$, i, #CRLF$)
Count = CountString(Line$, #SEPARATOR)
With Command(i)
Select GetCmdName()
Case "ПРИСВОИТЬ"
\Operation = #OP_SET
Case "СЛОЖИТЬ"
\Operation = #OP_ADD
Case "УМНОЖИТЬ"
\Operation = #OP_MUL
Case "ДЕЛИТЬ"
\Operation = #OP_DIV
Case "МЕТКА"
\Operation = #OP_LABEL
Label(GetCmdVal(1)) = (i - 1) * SizeOf(COMMAND_STRUCT)
Case "ПЕРЕЙТИ"
\Operation = #OP_GOTO
Case "ОТКРЫТЬКОНСОЛЬ"
\Operation = #OP_OpenConsole
Case "ВЫВОД"
\Operation = #OP_Print
Case "ВВОД"
\Operation = #OP_Input
Case "СОЗДАТЬПОТОК"
\Operation = #OP_CreateThread
Case "ПОСТАВИТЬПОТОКНАПАУЗУ"
\Operation = #OP_PauseThread
Case "ПРОДОЛЖИТЬПОТОК"
\Operation = #OP_ResumeThread
Case "ЗАВЕРШИТЬПОТОК"
\Operation = #OP_KillThread
Case "ПРИОРИТЕТПОТОКА"
\Operation = #OP_ThreadPriority
Case "СИНУС"
\Operation = #OP_SIN
Case "КОСИНУС"
\Operation = #OP_COS
Case "ТАНГЕНС"
\Operation = #OP_TAN
Case "АРКСИНУС"
\Operation = #OP_ARCSIN
Case "АРККОСИНУС"
\Operation = #OP_ARCCOS
Case "АРКТАНГЕНС"
\Operation = #OP_ARCTAN
Case "ОКРГУЛИТЬ"
\Operation = #OP_ROUND
Case "ЦЕЛОЕ"
\Operation = #OP_INT
EndSelect
For j = 1 To Count
\Arg$[j] = GetCmdVal(j)
Next
EndWith
Next
EndProcedure
Procedure$ ReadProgramFromExe()
*Buffer = AllocateMemory(1024)
If *Buffer
GetModuleFileName_(0, *Buffer, 1024)
ThisFileName$ = PeekS(*Buffer)
FreeMemory(*Buffer)
ThisFile = ReadFile(#PB_Any, ThisFileName$)
If ThisFile
ThisFileSize = Lof(ThisFile)
*Buffer = AllocateMemory(ThisFileSize)
If *Buffer
ReadData (ThisFile, *Buffer, ThisFileSize)
CloseFile (ThisFile)
ProgramData$ = PeekS(*Buffer + #EXE_FILE_SIZE, ThisFileSize - #EXE_FILE_SIZE, #PB_Ascii)
FreeMemory(*Buffer)
ProcedureReturn ProgramData$
EndIf
EndIf
EndIf
EndProcedure
Procedure$ FormatPath(String$)
l$ = Left(String$, 1)
r$ = Right(String$, 1)
If (l$ = "'" And r$ = "'") Or (l$ = Chr(34) And r$ = Chr(34))
ProcedureReturn Mid(String$, 2, Len(String$) - 2)
EndIf
ProcedureReturn String$
EndProcedure
Select CountProgramParameters()
Case 1
ProgramFileName$ = FormatPath(ProgramParameter(0))
Select FileSize(ProgramFileName$)
Case 0
MessageRequester("", "Указан пустой файл программы.")
End
Case -1, -2
MessageRequester("", "Указанный файл программы не найден.")
End
Default
ProgramFile = ReadFile(#PB_Any, ProgramFileName$)
If Not ProgramFile
MessageRequester("", "Невозможно прочитать файл программы.")
End
EndIf
ProgramFileSize = Lof(ProgramFile)
*Buffer = AllocateMemory(ProgramFileSize)
If *Buffer
ReadData (ProgramFile, *Buffer, ProgramFileSize)
CloseFile (ProgramFile)
ProgramData$ = PeekS(*Buffer, ProgramFileSize, #PB_Ascii)
FreeMemory(*Buffer)
GenerateByteCode(ProgramData$)
Interpreter(@Command(1))
EndIf
EndSelect
Default
EndSelectНа входе файл содержания:
ОТКРЫТЬКОНСОЛЬ,$Мояпрограмма
СОЗДАТЬПОТОК,А,ПЕЧАТЬА
СОЗДАТЬПОТОК,Б,ПЕЧАТЬБ
ВВОД,А
МЕТКА,А
ВЫВОД,0
ПЕРЕЙТИ,А
МЕТКА,Б
ВЫВОД,1
ПЕРЕЙТИ,Б
