PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Вы здесь » PureBasic - форум » PureBasic для Windows » Баг компилятора 6.01

Баг компилятора 6.01

Страница: 1 2  

Сообщений 1 страница 30 из 38

1

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10
Код:
#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
ПЕРЕЙТИ,Б

0

2

  • Автор: Smitis
  • Активный участник
  • Smitis
  • Откуда: Санкт-Петербург
  • Зарегистрирован: 30.08.2020
  • Приглашений: 0
  • Сообщений: 321
  • Уважение: [+3/-0]
  • Позитив: [+1/-2]
  • Пол: Мужской
  • Провел на форуме:
    3 дня 11 часов
  • Последний визит:
    Вчера 16:50:59

Баг компилятора 6.01

А в 6.02?
Глупо получится, если там бага нет.
Да и сам баг непонятно, что за баг. В чём заключается, то?

0

3

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59

В чем баг?
В процедуру Interpreter() передается нулевой указатель и это вовсе не баг компилятора, а ошибка в программе. Почему в ней нет проверки валидности указателя?
В начало процедуры Interpreter() добавьте

Код:
    If *Command=0
        ProcedureReturn
    EndIf

и замените этот участок кода

Код:
      Case  #OP_CreateThread
        SetInt(CreateThread(@Interpreter(), Label(GetStr(2))))

на такой

Код:
    Case  #OP_CreateThread
        l = Label(GetStr(2))
        If l<>0
            SetInt(CreateThread(@Interpreter(), l))
        Else
            CallDebugger
        EndIf

0

4

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

В программе нет ошибок, а при добавлении функций работы с графикой - возникют обращения к несуществующей памяти, как и нулевой указатель непонятно откуда то берётся. Придётся писать на C++ или ассемблере...

0

5

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59
PSY написал(а):

как и нулевой указатель непонятно откуда то берётся.

Вызов Label(GetStr(2)) возвращает 0. Отладчик предоставит больше информации.

Где вы заполняете ассоциативный массив Var$()? Есть только его объявление и чтение в процедуре Expr(). Записи в него нет. Так что это не баг компилятора, а ошибка в вашей программе.

0

6

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

В указанной программе А не заполняется.
Есть вариант такого же интепретатора и он тоже вылетает.

Код:
#SEPARATOR      = ","

InitSprite()

Global  NewMap  Program$()
Global  NewMap  Label()
Global  NewMap  Var$()
Global  MaxLine

Macro Get(Index)
  StringField(Program$(i$),  Index,  #SEPARATOR)
EndMacro
Macro Set(String)
  Var$(Get(2))  = String
EndMacro
Macro Count()
  CountString(Program$(i$), #SEPARATOR) + 1
EndMacro



Procedure$  FormatString(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

Procedure$  Expr(String$)
  ch$  =  Left(String$, 1)
  If ch$  = "$"
    String$ = ReplaceString(String$,  "<запятая>",  ",")
    String$ = ReplaceString(String$,  "<перевод строки>", #CRLF$)
    ProcedureReturn Right(String$,  Len(String$)-1)
  ElseIf  (Asc(ch$) >=48  And Asc(ch$)  <=57) Or  ch$ = "-"
    ProcedureReturn String$
  Else
    ProcedureReturn Var$(String$)
  EndIf
EndProcedure

Procedure Interpreter(i)
  Repeat
    If  i > MaxLine
      Break
    EndIf
    i$  = Str(i)
    If  Left(Program$(i$),  1)  = ";"
      i + 1
      Continue
    EndIf
    Select  Get(1)
      Case  "Метка"
        i + 1
        Continue
      Case  "Переход"
        i = Label(Get(2))
        Continue
      Case  "Сложить"
        Float.d = 0
        For a = 3 To  Count()
          Float + ValD(Expr(Get(a)))
        Next
        Set(StrD(Float))
      Case  "Вычесть"
        Float = ValD(Expr(Get(3)))
        For a = 4 To  Count()
          Float - ValD(Expr(Get(a)))
        Next
        Set(StrD(Float))
      Case  "Умножить"
        Float = 1
        For a = 3 To  Count()
          Float * ValD(Expr(Get(a)))
        Next
        Set(StrD(Float))
      Case  "Делить"
        Float = ValD(Expr(Get(3)))
        For a = 4 To  Count()
          Float1.d  = ValD(Expr(Get(a)))
          If  Float1  = 0
            Set("Бесконечность")
            Break
          EndIf
          Float / Float1
        Next
        Set(StrD(Float))
      Case  "И"
        Integer.i = Val(Expr(Get(3)))
        For a = 4 To  Count()
          Integer & Val(Expr(Get(a)))
        Next
        Set(Str(Integer))
      Case  "Или"
        Integer = Val(Expr(Get(3)))
        For a = 4 To  Count()
          Integer | Val(Expr(Get(a)))
        Next
        Set(Str(Integer))
      Case  "ИсключающееИли"
        Integer = Val(Expr(Get(3)))
        For a = 4 To  Count()
          Integer ! Val(Expr(Get(a)))
        Next
        Set(Str(Integer))
      Case  "СдвигВлево"
         Integer = Val(Expr(Get(3)))
        For a = 4 To  Count()
          Integer << Val(Get(a))
        Next
        Set(Str(Integer))
      Case  "СдвигВправо"
        Integer = Val(Expr(Get(3)))
        For a = 4 To  Count()
          Integer >> Val(Expr(Get(a)))
        Next
        Set(Str(Integer))
      Case  "Не"
        Set(Str(~Val(Expr(Get(3)))))
      Case  "Равно"
        Integer = #True
        String$ = Expr(Get(3))
        For a = 4 To  Count()
          If  String$ <> Expr(Get(a))
            Integer = #False
            Break
          EndIf
        Next
        If  Integer
          i = Label(Get(2)) + 1
          Continue
        EndIf
      Case  "НеРавно"
        Integer = #True
        String$ = Expr(Get(3))
        For a = 4 To  Count()
          If  String$ = Expr(Get(a))
            Integer   = #False
            Break
          EndIf
        Next
        If  Integer
          i = Label(Get(2))
          Continue
        EndIf
      Case  "БольшеИлиРавно"
        If  ValD(Expr(Get(3))) >= ValD(Expr(Get(4)))
          i = Label(Get(3))
          Continue
        EndIf
      Case  "МеньшеИлиРавно"
        If  ValD(Expr(Get(3)))  <=  ValD(Expr(Get(4)))
          i = Label(Get(3))
          Continue
        EndIf
      Case  "ОткрытьКонсоль"
        OpenConsole(Expr(Get(2)))
      Case  "Вывод"
        Print(Expr(Get(2)))
      Case  "Ввод"
        Set(Input())
      Case  "Присвоить"
        Set(Expr(Get(3)))
      Case  "Соединить"
        String$ = Expr(Get(3))
        For a= 4 To  Count()
          String$ + Expr(Get(a))
        Next
        Set(String$)
      Case  "Слева"
        Set(Left(Expr(Get(3)),  Val(Expr(Get(4)))))
      Case  "Справа"
        Set(Right(Expr(Get(3)), Val(Expr(Get(4)))))
      Case  "Субстрока"
        Set(Mid(Expr(Get(3)), Val(Expr(Get(4))), Val(Expr(Get(5)))))
      Case  "ЦелаяЧасть"
        Set(Str(Int(ValD((Expr(Get(3)))))))
      Case  "ДробнаяЧасть"
        Float = ValD(Expr(Get(3)))
        Set(StrD(Float  - Int(Float)))
      Case  "Модуль"
        Set(StrD(Abs(ValD(Expr(Get(3))))))
      Case  "Синус"
        Set(StrD(Sin(ValD(Expr(Get(3))))))
      Case  "Косинус"
        Set(StrD(Cos(ValD(Expr(Get(3))))))
      Case  "Тангенс"
        Set(StrD(Tan(ValD(Expr(Get(3))))))
      Case  "Арксинус"
        Set(StrD(ASin(ValD(Expr(Get(3)))))) 
      Case  "Арккосинус"
        Set(StrD(ACos(ValD(Expr(Get(3))))))
      Case  "Арктангенс"
        Set(StrD(ATan(ValD(Expr(Get(3))))))
      Case  "Округлить"
        Set(StrD(Round(ValD(Expr(Get(3))),  #PB_Round_Nearest)))
      Case  "ОткрытьФайл"
        Set(Str(OpenFile(#PB_Any,Expr(Get(3)))))
      Case  "ЧитатьФайл"
        Set(Str(ReadFile(#PB_Any,Expr(Get(3)))))
      Case  "ЗакрытьФайл"
        CloseFile(Val(Expr(Get(2))))
      Case  "ЧитатьСтроку"
        Set(ReadString(Val(Expr(Get(3)))))
      Case  "ПисатьСтроку"
        WriteString(Val(Expr(Get(2))),  Expr(Get(3)))
      Case  "СлучайноеЧисло"
        Random(Val(Expr(Get(3))), Val(Expr(Get(2))))
      Case  "Поток"
        CreateThread(@Interpreter(),  Label(Get(2)))
      Case  "Длина"
        Set(Str(Len(Expr(Get(3)))))
      Case  "Количество"
        Set(Str(CountString(Expr(Get(3)), Expr(Get(4)))))
      Case  "Прошло"
        Set(Str(ElapsedMilliseconds()))
      Case  "Ждать"
        Sleep_(Val(Expr(Get(2))))
      Case  "Заменить"
        Set(ReplaceString(Expr(Get(3)), Expr(Get(4)), Expr(Get(5))))
      Case  "Удалить"
        Set(RemoveString(Expr(Get(3)),  Expr(Get(4))))
      Case  "ПолныйЭкран"
        Set(Str(OpenScreen(Val(Expr(Get(3))), Val(Expr(Get(4))),  Val(Expr(Get(5))),  Expr(Get(6)))))
      Case  "ПеревернутьБуферы"
        FlipBuffers()
      Case  "Рисовать"
        StartDrawing(Val(Expr(Get(2))))
      Case  "Показать"
        StopDrawing()
      Case  "Цвет"
        Set(Str(Point(Val(Expr(Get(3))),  Val(Expr(Get(4))))))
      Case  "Точка"
        Plot(Val(Expr(Get(2))), Val(Expr(Get(3))),  Val(Expr(Get(4))))
      Case  "Линия"
        LineXY(Val(Expr(Get(2))), Val(Expr(Get(3))),  Val(Expr(Get(4))),  Val(Expr(Get(5))),  Val(Expr(Get(6))))
      Case  "Окружность"
        Circle(Val(Expr(Get(2))), Val(Expr(Get(3))),  Val(Expr(Get(4))),  Val(Expr(Get(5))))
      Case  "Эллипс"
        Ellipse(Val(Expr(Get(2))),  Val(Expr(Get(3))),  Val(Expr(Get(4))),  Val(Expr(Get(5))),  Val(Expr(Get(6))))
      Case  "Прямоугольник"
        Box(Val(Expr(Get(2))),  Val(Expr(Get(3))),  Val(Expr(Get(4))),  Val(Expr(Get(5))),  Val(Expr(Get(6))))
      Case  "ОчиститьЭкран"
        ClearScreen(Val(Expr(Get(2))))
      Case  "ВыводНаЭкран"
        Set(Str(ScreenOutput()))
      Case  "Выход"
        End
    EndSelect
    i + 1
    Debug Var$("б")
  ForEver
EndProcedure

Select  CountProgramParameters()
  Case  1
    ProgramFileName$  = FormatString(ProgramParameter(0))
    If  FileSize(ProgramFileName$)  < 0
      OpenConsole()
      PrintN("Файл '"+ProgramFileName$+"' не найден.")
      Input()
      End
    EndIf
    ProgramFile   = ReadFile(#PB_Any, ProgramFileName$)
    If  Not ProgramFile
      OpenConsole()
      PrintN("Невозможно открыть программу из файла '"+ProgramFileName$+"'")
      End
    EndIf
    i = 0
    While Not Eof(ProgramFile)
      i + 1
      String$ = ReadString(ProgramFile)
      Program$(Str(i)) = String$
      If  Left(String$, 5) = "Метка"
        Label(Right(String$,  Len(String$)  - 6)) = i
      EndIf
    Wend
    MaxLine = i
    CloseFile(ProgramFile)
    String$ = ""
    
    Interpreter(1)
   
  Default
    OpenConsole()
    PrintN("Интепретатор языка программирования 'СЛОВО'.")
    PrintN("Использование: 'script ИмяФайлаПрограммы.'")
    Input()
EndSelect

Программа для него:

Код:
;ПолныйЭкран,а,1280,720,32,$Заголовок
Присвоить,а,1
Присвоить,б,1
;ВыводНаЭкран,Экран
Метка,Рисование
;Рисовать,Экран
;Точка,а,б,16777215
;Показать
;ПеревернутьБуферы
Равно,Завершение,б,32
Равно,УвеличитьБ,а,24
Сложить,а,а,1
Переход,Рисование
Метка,УвеличитьБ
Присвоить,а,1
Сложить,б,б,1
Метка,Завершение
Выход

В результате проходят не все циклы по заполнению переменных А и Б.
Если раскоментировать вывод графики - то всё завершается при попытке нарисовать точку на экране.
Поставил версию 6.02 - тоже самое "вылетает".
Память течёт.

Отредактировано PSY (02.09.2023 20:18:23)

0

7

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59
PSY написал(а):

Если раскоментировать вывод графики - то всё завершается при попытке нарисовать точку на экране.

Я получил такой лог

Код:
1
ScreenOutput 37714816
1
StartDrawing 37714816
1
1
StopDrawing
1
1
1
1
StartDrawing 37714816      <- Где ScreenOutput????
1

Программа должна быть такой и тогда не вылетает при рисовании точки.

Код:
ПолныйЭкран,а,1280,720,32,$Заголовок
Присвоить,а,1
Присвоить,б,1
Метка,Рисование
ВыводНаЭкран,Экран
Рисовать,Экран
Точка,а,б,16777215
Показать
ПеревернутьБуферы
Равно,Завершение,б,32
Равно,УвеличитьБ,а,24
Сложить,а,а,1
Переход,Рисование
Метка,УвеличитьБ
Присвоить,а,1
Сложить,б,б,1
Метка,Завершение
Выход

0

8

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

Отлаживал и смотрел. Иногда теряются значения переменных, иногда появляются значения из другой памяти. Реализовал вручную ассоциатиыне массивы - всё работает, а при использовании NewMap - вылетает и меняет из ниоткуда значения переменных.

0

9

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59

Надеюсь поддержка многопоточности включена?

0

10

  • Автор: Webarion
  • Активный участник
  • Откуда: Москва
  • Зарегистрирован: 19.12.2021
  • Приглашений: 0
  • Сообщений: 300
  • Уважение: [+6/-0]
  • Позитив: [+20/-1]
  • Пол: Мужской
  • Возраст: 42 [1983-06-03]
  • Провел на форуме:
    9 дней 4 часа
  • Последний визит:
    15.05.2025 19:19:15
PSY написал(а):

В программе нет ошибок, а при добавлении функций работы с графикой - возникют обращения к несуществующей памяти, как и нулевой указатель непонятно откуда то берётся. Придётся писать на C++ или ассемблере...

Я дебажил ваш код и увидел всё то же самое, что вам написал Пётр. Это не баг компилятора, а баг в вашей разработке.
Если кажется, что вы обнаружили баг компилятора, скорее всего это не так, хоть это и возможно. Проштудируйте свою разработку, несколько десятков раз. И если не будет результата, то стоит подумать об изменении архитектуры и начать всё заново.

Отредактировано Webarion (04.09.2023 05:50:55)

0

11

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

Программа простейшая - заменяет команды на опкод и выполняет действия в зависимости от команды. Разбор строки проще некуда. Память течёт при приведении типов и ассоциативном массиве. Ставишь переходы по меткам - а выполнение начинается откуда попало или пропускаются условия...

0

12

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59

Нужно под отладчиком смотреть как выполняется программа и возможно найдется причина.
В коде создаются потоки поэтому мой вопрос

Пётр написал(а):

Надеюсь поддержка многопоточности включена?

актуален.
Если выполняется несколько потоков, а поддержка многопоточности не включена, нормальная работа не гарантируется.

PSY написал(а):

Память течёт при приведении типов и ассоциативном массиве.

В большинстве случаев это из-за ошибки в программе и очень редко из-за бага в компиляторе. Нужно полностью исключить ошибку в коде.

0

13

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

многопоточность конечно же включена. просто такие глюки были ещё со времён версии 3.7 компилятора при использовании StringField и приведениях типов...

0

14

  • Автор: AZJIO
  • Активный участник
  • Зарегистрирован: 07.08.2020
  • Приглашений: 0
  • Сообщений: 1288
  • Уважение: [+18/-0]
  • Позитив: [+15/-0]
  • Провел на форуме:
    26 дней 14 часов
  • Последний визит:
    Сегодня 20:10:08

Может вместо StringField использовать SplitL?
Вообще для таких вещей как "баг" нужно раскладывать код на минимальный, то есть предоставить файл, который открывает код, на котором спотыкается, обрезать его выслеживая сбойную часть, потом обрезать свой код, чтобы в лучшем случае оставить одну функцию, которая вернёт не ожидаемый результат. А тут много разгадывать надо. И вообще многопоточность тут обязательна? Если поток отработает быстрее или медленнее без семафоров, он может внести этим ошибку, если только генерируются какие-то независимые ветви структуры не мешающие продолжению основного кода.
Многие используют фетиш "баг", чтобы заставить других людей отлаживать их код.

0

15

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59
PSY написал(а):

просто такие глюки были ещё со времён версии 3.7 компилятора при использовании StringField и приведениях типов

Много лет использую PB и ни с чем подобным не сталкивался. Да баги бывают, но утечки памяти из-за StringField и приведения типов не замечал.
Можете разместить на форуме предельно упрощенный код показывающий этот баг?

0

16

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

к сожалению не осталось, это было более 10 лет назад, а с выходом новой версии - работало нормально.

0

17

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59

Может больше 10 лет назад был какой-то баг который исправили, но зачем сейчас об этом вспоминать в контексте версии 6.01?

0

18

  • Автор: Webarion
  • Активный участник
  • Откуда: Москва
  • Зарегистрирован: 19.12.2021
  • Приглашений: 0
  • Сообщений: 300
  • Уважение: [+6/-0]
  • Позитив: [+20/-1]
  • Пол: Мужской
  • Возраст: 42 [1983-06-03]
  • Провел на форуме:
    9 дней 4 часа
  • Последний визит:
    15.05.2025 19:19:15
PSY написал(а):

Программа простейшая - заменяет команды на опкод и выполняет действия в зависимости от команды. Разбор строки проще некуда. Память течёт при приведении типов и ассоциативном массиве. Ставишь переходы по меткам - а выполнение начинается откуда попало или пропускаются условия...

Так то простейшая. Но "чёрт ногу сломит", чего вы там накодировали :canthearyou:  (воспринимать, как шутку, в которой есть правда  :D)

1. В первом вашем примере, в процедуре Interpreter, требуется указатель. Но в Label вы записываете смещение, относительно начального адреса массива а не указатель. Решение:

Код:
        Case  "МЕТКА"
          \Operation  = #OP_LABEL
          ; Если в Interpreter нужен указатель, то и записывать в Label нужно указатель, а не смещение
          ; Label(GetCmdVal(1)) = (i - 1) * SizeOf(COMMAND_STRUCT) 
          Label(GetCmdVal(1)) = @Command() + i * SizeOf(COMMAND_STRUCT)

       
2. В поток на процедуру Interpreter у вас отправляется не указатель, и даже не смещение, а значение некой переменной, которая даже не записана. В итоге в потоке, Interpreter получает указатель 0. Решение:

Код:
      Case  #OP_CreateThread ; 13
        ; в поток, нужно отправлять указатель на структуру COMMAND_STRUCT
        ; SetInt( CreateThread(@Interpreter(), Label(GetStr(2) ) ) )
        SetInt( CreateThread(@Interpreter(), Label(*Command\Arg$[1]) ) )

3. В #OP_GOTO интерпретатор снова пытается получить указатель не там, где надо и снова в *Command оказывается 0. Решение:

Код:
      Case  #OP_GOTO ; 12
        ; *Command  = Label( GetStr(1) ) ; тут надо получать указатель на метку
        *Command  = Label( *Command\Arg$[1] ) ; вот так

4. Что значит ПЕРЕЙТИ,А? Если, это значит перейти на МЕТКА,А то, в приведённом вами коде - это вечный цикл..............

5. Непонятно, как устроена логика операндов ПЕЧАТЬА, ПЕЧАТЬБ, они теряются, так как в интерпретаторе, ничего не сделано для того, чтобы их обработать.

6. Вот это, я тоже не понял в Interpreter ( кажется это фундментальная штука и у меня сложилось впечатление, что это всё портировано с другого языка, но неправильно понята портируемая структура данных ):

Код:
Case  #OP_CreateThread
  SetInt( ...

В данном случае, изменяется операнд собранного для интерпретации массива, на номер потока. Для чего это? Лучше оставьлять собранный массив команд неизменным. Но, если вам нужны связи, то создавайте эти связи отдельно.

7. В вашем примере, не логичны макросы SetStr и GetStr.
SetStr - пишет в одну область, в массив команд;  GetStr - читает, совсем из другой области, вообще из хэш карты переменных. Как так, почему!?

8. В общем вот пример, на сколько я понял эту логику:
только, я заменил ПЕРЕЙТИ,А на ПЕРЕЙТИ,Выход для выхода, а в конце добавил МЕТКА,Выход, добавил дополнительный ВВОД,Б для основного потока:
Файл данных:

Код:
ОТКРЫТЬКОНСОЛЬ,$Мояпрограмма
СОЗДАТЬПОТОК,А,ПЕЧАТЬА
СОЗДАТЬПОТОК,Б,ПЕЧАТЬБ
ВВОД,А
ВВОД,Б
ПЕРЕЙТИ,Выход
МЕТКА,А
ВЫВОД,0
ПЕРЕЙТИ,Выход
МЕТКА,Б
ВЫВОД,1
МЕТКА,Выход

Интерпретатор из первого поста. Изменённое, обозначено !!!:

Код:
;- Constants
#SEPARATOR      = ","
#MAX_ARGUMENTS  = 256
#EXE_FILE_SIZE  = 30720
#MARKER         = 194782711 ; маркер, по которому будет определено, что указатель является нужной нам структурой (может быть любым)

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

;- Struct and Vars
Structure COMMAND_STRUCT
  Marker.i
  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\Operation <> #OP_LABEL
      Static numDebug = 0
      Debug Str(numDebug) + ">" + *Command\Arg$[0]+","+*Command\Arg$[1]+","+*Command\Arg$[2] ; промотр этапов, для отладки
      numDebug+1
    EndIf
    
    If  (*Command > *LastCommand)
      Break
    EndIf
    Select  *Command\Operation
      Case  #OP_LABEL ; 11
        *Command  + SizeOf(COMMAND_STRUCT)
        Continue
      Case  #OP_GOTO ; 12
        ; *Command  = Label( GetStr(1) ) ; !!! тут надо получать указатель на метку
        *Command  = Label( *Command\Arg$[1] ) ; вот так
        Continue
      Case  #OP_SET ; 0
        SetStr(GetStr(1))
      Case  #OP_ADD ; 1
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float + GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_SUB ; 2
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float - GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_MUL ; 3
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float * GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_DIV ; 4
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float / GetFloat(i)
        Next
        SetFloat(Float)
;       Case  #OP_LABEL ; 11 !!! - это не нужно, уже есть, в начале
;         *Command  + SizeOf(COMMAND_STRUCT)
;         Continue
;       Case  #OP_GOTO ; 12 !!! - это не нужно, уже есть, в начале
;         *Command  = Label(GetStr(1))
;         Continue
      Case  #OP_AND ; 5
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer & GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_OR ; 6
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer | GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_XOR ; 7
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer ! GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_MOD ; 8
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer % GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_SHL ; 9
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer << GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_SHR ; 10
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer >> GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_CreateThread ; 13
        ; !!! в поток, нужно отправлять указатель на структуру COMMAND_STRUCT
        ; SetInt( CreateThread(@Interpreter(), Label(GetStr(2) ) ) )
        PrintN( "Начало потока" )
        SetInt( CreateThread(@Interpreter(), Label(*Command\Arg$[1]) ) )
      Case  #OP_PauseThread ; 14
        PauseThread(GetInt(1))
      Case  #OP_ResumeThread ; 15
        ResumeThread(GetInt(1))
      Case  #OP_KillThread ; 16
        KillThread(GetInt(1))
      Case  #OP_ThreadPriority ; 17
        ThreadPriority(Getint(1), GetInt(2))
      Case  #OP_OpenConsole ; 18
        OpenConsole(GetStr(1))
      Case  #OP_Print ; 19
        ; !!! не понял, для чего здесь GetStr, возможно не понял логику этой команды. Если тут нужно показывать данные из указанной переменной, то да, тогда правильно.
        ; непонятно только причём здесь ВЫВОД,0 и ВЫВОД,1 в коде файла.
;       PrintN(GetStr(1))
        PrintN( "ВЫВОД:"+*Command\Arg$[1])
      Case  #OP_Input ; 20
        SetStr(Input())
    EndSelect

    *Command + SizeOf(COMMAND_STRUCT)
    
  ; Until здесь для более удобной отладки. Использование While усложнит отладку
  Until *Command\Marker <> #MARKER ; если указатель не является нужной нам структурой, выходим из обработчика
  
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)
      \Marker = #MARKER
      Select  GetCmdName() ; имя команды, первый элемент в строке
        Case  "ПРИСВОИТЬ"
          \Operation  = #OP_SET
          \Arg$[0] = "ПРИСВОИТЬ" ; !!! - для удобной отладки
        Case  "СЛОЖИТЬ"
          \Operation  = #OP_ADD
          \Arg$[0] = "СЛОЖИТЬ" 
        Case  "УМНОЖИТЬ"
          \Operation  = #OP_MUL
          \Arg$[0] = "УМНОЖИТЬ" 
        Case  "ДЕЛИТЬ"
          \Operation  = #OP_DIV
          \Arg$[0] = "ДЕЛИТЬ" 
        Case  "МЕТКА"
          \Operation  = #OP_LABEL
          \Arg$[0] = "МЕТКА" 
          ;!!! Если в Interpreter нужен указатель, то и записывать в Label нужно указатель, а не смещение
          ; Label(GetCmdVal(1)) = (i - 1) * SizeOf(COMMAND_STRUCT) 
          Label(GetCmdVal(1)) = @Command() + i * SizeOf(COMMAND_STRUCT)
        Case  "ПЕРЕЙТИ"
          \Operation  = #OP_GOTO
          \Arg$[0] = "ПЕРЕЙТИ" 
        Case  "ОТКРЫТЬКОНСОЛЬ"
          \Operation  = #OP_OpenConsole
          \Arg$[0] = "ОТКРЫТЬКОНСОЛЬ" 
        Case  "ВЫВОД"
          \Operation  = #OP_Print
          \Arg$[0] = "ВЫВОД" 
        Case  "ВВОД"
          \Operation  = #OP_Input
          \Arg$[0] = "ВВОД" 
        Case  "СОЗДАТЬПОТОК"
          \Operation  = #OP_CreateThread
          \Arg$[0] = "СОЗДАТЬПОТОК" 
        Case  "ПОСТАВИТЬПОТОКНАПАУЗУ"
          \Operation  = #OP_PauseThread
          \Arg$[0] = "ПОСТАВИТЬПОТОКНАПАУЗУ" 
        Case  "ПРОДОЛЖИТЬПОТОК"
          \Operation  = #OP_ResumeThread
          \Arg$[0] = "ПРОДОЛЖИТЬПОТОК" 
        Case  "ЗАВЕРШИТЬПОТОК"
          \Operation  = #OP_KillThread
          \Arg$[0] = "ЗАВЕРШИТЬПОТОК" 
        Case  "ПРИОРИТЕТПОТОКА"
          \Operation  = #OP_ThreadPriority
          \Arg$[0] = "ПРИОРИТЕТПОТОКА" 
        Case  "СИНУС"
          \Operation  = #OP_SIN
          \Arg$[0] = "СИНУС" 
        Case  "КОСИНУС"
          \Operation  = #OP_COS
          \Arg$[0] = "КОСИНУС" 
        Case  "ТАНГЕНС"
          \Operation  = #OP_TAN
          \Arg$[0] = "ТАНГЕНС" 
        Case  "АРКСИНУС"
          \Operation  = #OP_ARCSIN
          \Arg$[0] = "АРКСИНУС" 
        Case  "АРККОСИНУС"
          \Operation  = #OP_ARCCOS
          \Arg$[0] = "АРККОСИНУС" 
        Case  "АРКТАНГЕНС"
          \Operation  = #OP_ARCTAN
          \Arg$[0] = "АРКТАНГЕНС" 
        Case  "ОКРГУЛИТЬ"
          \Operation  = #OP_ROUND
          \Arg$[0] = "ОКРГУЛИТЬ" 
        Case  "ЦЕЛОЕ"
          \Operation  = #OP_INT
          \Arg$[0] = "ЦЕЛОЕ"
      EndSelect
      ; пишем все элементы строки в массив
      For j = 1 To  Count
        \Arg$[j]  = GetCmdVal(j)
      Next
      
    EndWith
  Next
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


;- LoadFile
; Select  CountProgramParameters()
;   Case  1
;     ProgramFileName$  = FormatPath(ProgramParameter(0))

; файл D:\test1.txt, следующего содержания
; ОТКРЫТЬКОНСОЛЬ,$Мояпрограмма
; СОЗДАТЬПОТОК,А,ПЕЧАТЬА
; СОЗДАТЬПОТОК,Б,ПЕЧАТЬБ
; ВВОД,А
; ВВОД,Б
; ПЕРЕЙТИ,Выход
; МЕТКА,А
; ВЫВОД,0
; ПЕРЕЙТИ,Выход
; МЕТКА,Б
; ВЫВОД,1
; МЕТКА,Выход

Define ProgramFileName$  = "D:\test1.txt" ; !!! просто подгрузим файл в Ascii кодировке

Select  FileSize(ProgramFileName$)
  Case  0
    MessageRequester("",  "Указан пустой файл программы.")
    End
  Case  -1, -2
    MessageRequester("",  "Указанный файл программы не найден.")
    End
  Default

    Define ProgramFile = ReadFile(#PB_Any, ProgramFileName$, #PB_Ascii)
    If  Not ProgramFile
      MessageRequester("",  "Невозможно прочитать файл программы.")
      End
    EndIf
    
    Define ProgramData$ = ""
    While Not Eof(ProgramFile)
      ProgramData$ = ReadString(ProgramFile, #PB_File_IgnoreEOL)  
    Wend
    CloseFile(ProgramFile)  

    If ProgramData$
      GenerateByteCode(ProgramData$)
      Interpreter( @Command(1) )
    EndIf
  
EndSelect

;   Default
;     
; EndSelect

Больше отладочной информации по потокам:

Код:
;- Constants
#SEPARATOR      = ","
#MAX_ARGUMENTS  = 256
#EXE_FILE_SIZE  = 30720
#MARKER         = 194782711 ; маркер, по которому будет определено, что указатель является нужной нам структурой (может быть любым)

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

;- Struct and Vars
Structure COMMAND_STRUCT
  Marker.i
  Operation.i
  Count.i
  Arg$[#MAX_ARGUMENTS]
EndStructure

Structure INTERPRETER ; такая структура будет помогать в отладке. Будем видеть в каком потоке работает интерпретатор
  *Command.COMMAND_STRUCT
  NumThread.a
EndStructure


Global NewList thrInterpreter.INTERPRETER()

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( *Interpreter.INTERPRETER ) ; *Command.COMMAND_STRUCT )
  
  Protected *Command.COMMAND_STRUCT = *Interpreter\Command
  
  Repeat

    If *Command\Operation <> #OP_LABEL
      Static numDebug = 1
      Protected NumThread = *Interpreter\NumThread
      Debug Str(numDebug) + ") Поток" + Str(NumThread) + ": " + *Command\Arg$[0]+","+*Command\Arg$[1]+","+*Command\Arg$[2] ; промотр этапов, для отладки
      numDebug+1
    EndIf
    
    If  (*Command > *LastCommand)
      Break
    EndIf
    Select  *Command\Operation
      Case  #OP_LABEL ; 11
        *Command  + SizeOf(COMMAND_STRUCT)
        Continue
      Case  #OP_GOTO ; 12
        ; *Command  = Label( GetStr(1) ) ; !!! тут надо получать указатель на метку
        *Command  = Label( *Command\Arg$[1] ) ; вот так
        Continue
      Case  #OP_SET ; 0
        SetStr(GetStr(1))
      Case  #OP_ADD ; 1
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float + GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_SUB ; 2
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float - GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_MUL ; 3
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float * GetFloat(i)
        Next
        SetFloat(Float)
      Case  #OP_DIV ; 4
        Float.d = GetFloat(1)
        For i = 2 To  Count()
          Float / GetFloat(i)
        Next
        SetFloat(Float)
;       Case  #OP_LABEL ; 11 !!! - это не нужно, уже есть, в начале
;         *Command  + SizeOf(COMMAND_STRUCT)
;         Continue
;       Case  #OP_GOTO ; 12 !!! - это не нужно, уже есть, в начале
;         *Command  = Label(GetStr(1))
;         Continue
      Case  #OP_AND ; 5
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer & GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_OR ; 6
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer | GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_XOR ; 7
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer ! GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_MOD ; 8
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer % GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_SHL ; 9
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer << GetInt(i)
        Next
        SetInt(Integer)
      Case  #OP_SHR ; 10
        Integer.i = GetInt(1)
        For i = 2 To  Count()
          Integer >> GetInt(i)
        Next
        SetInt(Integer)
        ;- #OP_CreateThread
      Case  #OP_CreateThread ; 13
        ; !!! в поток, нужно отправлять указатель на структуру COMMAND_STRUCT
        ; SetInt( CreateThread(@Interpreter(), Label(GetStr(2) ) ) )
        
        ; для отладки
        AddElement( thrInterpreter() )
        thrInterpreter()\Command = Label( *Command\Arg$[1] )
        thrInterpreter()\NumThread = ListSize( thrInterpreter() )
;         PrintN( "Начало потока " + Str( ListSize( thrInterpreter() ) ) )
        ;
        SetInt( CreateThread(@Interpreter(), @thrInterpreter() ) )
        
      Case  #OP_PauseThread ; 14
        PauseThread(GetInt(1))
      Case  #OP_ResumeThread ; 15
        ResumeThread(GetInt(1))
      Case  #OP_KillThread ; 16
        KillThread(GetInt(1))
      Case  #OP_ThreadPriority ; 17
        ThreadPriority(Getint(1), GetInt(2))
      Case  #OP_OpenConsole ; 18
        OpenConsole(GetStr(1))
      Case  #OP_Print ; 19
        ; !!! не понял, для чего здесь GetStr. Возможно тут нужно извлекать данные из переменной.
        ;       PrintN(GetStr(1))

        PrintN( "ВЫВОД:"+*Command\Arg$[1])
      Case  #OP_Input ; 20
        SetStr(Input())
    EndSelect

    *Command + SizeOf(COMMAND_STRUCT)
    
  ; Until здесь для более удобной отладки. Использование While усложнит отладку
  Until *Command\Marker <> #MARKER ; если указатель не является нужной нам структурой, выходим из обработчика
  
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)
      \Marker = #MARKER
      Select  GetCmdName() ; имя команды, первый элемент в строке
        Case  "ПРИСВОИТЬ"
          \Operation  = #OP_SET
          \Arg$[0] = "ПРИСВОИТЬ" ; !!! - для удобной отладки
        Case  "СЛОЖИТЬ"
          \Operation  = #OP_ADD
          \Arg$[0] = "СЛОЖИТЬ" 
        Case  "УМНОЖИТЬ"
          \Operation  = #OP_MUL
          \Arg$[0] = "УМНОЖИТЬ" 
        Case  "ДЕЛИТЬ"
          \Operation  = #OP_DIV
          \Arg$[0] = "ДЕЛИТЬ" 
        Case  "МЕТКА"
          \Operation  = #OP_LABEL
          \Arg$[0] = "МЕТКА" 
          ;!!! Если в Interpreter нужен указатель, то и записывать в Label нужно указатель, а не смещение
          ; Label(GetCmdVal(1)) = (i - 1) * SizeOf(COMMAND_STRUCT) 
          Label(GetCmdVal(1)) = @Command() + i * SizeOf(COMMAND_STRUCT)
        Case  "ПЕРЕЙТИ"
          \Operation  = #OP_GOTO
          \Arg$[0] = "ПЕРЕЙТИ" 
        Case  "ОТКРЫТЬКОНСОЛЬ"
          \Operation  = #OP_OpenConsole
          \Arg$[0] = "ОТКРЫТЬКОНСОЛЬ" 
        Case  "ВЫВОД"
          \Operation  = #OP_Print
          \Arg$[0] = "ВЫВОД" 
        Case  "ВВОД"
          \Operation  = #OP_Input
          \Arg$[0] = "ВВОД" 
        Case  "СОЗДАТЬПОТОК"
          \Operation  = #OP_CreateThread
          \Arg$[0] = "СОЗДАТЬПОТОК" 
        Case  "ПОСТАВИТЬПОТОКНАПАУЗУ"
          \Operation  = #OP_PauseThread
          \Arg$[0] = "ПОСТАВИТЬПОТОКНАПАУЗУ" 
        Case  "ПРОДОЛЖИТЬПОТОК"
          \Operation  = #OP_ResumeThread
          \Arg$[0] = "ПРОДОЛЖИТЬПОТОК" 
        Case  "ЗАВЕРШИТЬПОТОК"
          \Operation  = #OP_KillThread
          \Arg$[0] = "ЗАВЕРШИТЬПОТОК" 
        Case  "ПРИОРИТЕТПОТОКА"
          \Operation  = #OP_ThreadPriority
          \Arg$[0] = "ПРИОРИТЕТПОТОКА" 
        Case  "СИНУС"
          \Operation  = #OP_SIN
          \Arg$[0] = "СИНУС" 
        Case  "КОСИНУС"
          \Operation  = #OP_COS
          \Arg$[0] = "КОСИНУС" 
        Case  "ТАНГЕНС"
          \Operation  = #OP_TAN
          \Arg$[0] = "ТАНГЕНС" 
        Case  "АРКСИНУС"
          \Operation  = #OP_ARCSIN
          \Arg$[0] = "АРКСИНУС" 
        Case  "АРККОСИНУС"
          \Operation  = #OP_ARCCOS
          \Arg$[0] = "АРККОСИНУС" 
        Case  "АРКТАНГЕНС"
          \Operation  = #OP_ARCTAN
          \Arg$[0] = "АРКТАНГЕНС" 
        Case  "ОКРГУЛИТЬ"
          \Operation  = #OP_ROUND
          \Arg$[0] = "ОКРГУЛИТЬ" 
        Case  "ЦЕЛОЕ"
          \Operation  = #OP_INT
          \Arg$[0] = "ЦЕЛОЕ"
      EndSelect
      ; пишем все элементы строки в массив
      For j = 1 To  Count
        \Arg$[j]  = GetCmdVal(j)
      Next
      
    EndWith
  Next
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


;- LoadFile
; Select  CountProgramParameters()
;   Case  1
;     ProgramFileName$  = FormatPath(ProgramParameter(0))

; файл D:\test1.txt, следующего содержания
; ОТКРЫТЬКОНСОЛЬ,$Мояпрограмма
; СОЗДАТЬПОТОК,А,ПЕЧАТЬА
; СОЗДАТЬПОТОК,Б,ПЕЧАТЬБ
; ВВОД,А
; ВВОД,Б
; ПЕРЕЙТИ,Выход
; МЕТКА,А
; ВЫВОД,0
; ПЕРЕЙТИ,Выход
; МЕТКА,Б
; ВЫВОД,1
; МЕТКА,Выход

Define ProgramFileName$  = "D:\test1.txt" ; !!! просто подгрузим файл в Ascii кодировке

Select  FileSize(ProgramFileName$)
  Case  0
    MessageRequester("",  "Указан пустой файл программы.")
    End
  Case  -1, -2
    MessageRequester("",  "Указанный файл программы не найден.")
    End
  Default

    Define ProgramFile = ReadFile(#PB_Any, ProgramFileName$, #PB_Ascii)
    If  Not ProgramFile
      MessageRequester("",  "Невозможно прочитать файл программы.")
      End
    EndIf
    
    Define ProgramData$ = ""
    While Not Eof(ProgramFile)
      ProgramData$ = ReadString(ProgramFile, #PB_File_IgnoreEOL)  
    Wend
    CloseFile(ProgramFile)  

    If ProgramData$
      GenerateByteCode(ProgramData$)
      
      Define Interpreter.INTERPRETER
      Interpreter\Command = @Command(1) 
      
      Debug "--- Программа:" + #CRLF$
      Debug ProgramData$ + #CRLF$
      Debug "--- Работа: " + #CRLF$
      
      Interpreter( @Interpreter )
    EndIf
  
EndSelect

;   Default
;     
; EndSelect

Отредактировано Webarion (07.09.2023 05:29:38)

0

19

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

ну да я давно исправил уже, а глюки остались. не работают условия и пишутся в переменные значения из ниоткуда. писал машину тьюринга, а там такие же глюки при использовании stringfield и ассоциативного массива в виде ленты

0

20

  • Автор: Smitis
  • Активный участник
  • Smitis
  • Откуда: Санкт-Петербург
  • Зарегистрирован: 30.08.2020
  • Приглашений: 0
  • Сообщений: 321
  • Уважение: [+3/-0]
  • Позитив: [+1/-2]
  • Пол: Мужской
  • Провел на форуме:
    3 дня 11 часов
  • Последний визит:
    Вчера 16:50:59
PSY написал(а):

В программе нет ошибок

Главное правило начинающего программиста - если программа написана правильно, а компилятор глючный и не хочет правильно компилировать, значит всё с точностью до наоборот - компилятор работает правильно, это в программе баги.

0

21

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59
PSY написал(а):

а там такие же глюки при использовании stringfield и ассоциативного массива

Нужен простой код показывающий эти глюки.

0

22

  • Автор: AZJIO
  • Активный участник
  • Зарегистрирован: 07.08.2020
  • Приглашений: 0
  • Сообщений: 1288
  • Уважение: [+18/-0]
  • Позитив: [+15/-0]
  • Провел на форуме:
    26 дней 14 часов
  • Последний визит:
    Сегодня 20:10:08

Занят был, но не терпелось написать что StringField() настолько простая функция, что написать её можно самому. Обычное перечисление символов до разделителя с подсчётом нужного. То есть если указан 7-й, то встретив первый добавляем +1 и так до 6-го, запоминаем позицию в переменную, далее ищем 7-й и берём текст между 6-ым и 7-ым разделителями, то есть считываем PeekS() от найденной позиции +1, указав длину как разницу между 7-й и 6-й позиции и -1. Пользуйтесь ))) собственным не глючным.

И также посмотрите здесь функции с префиксом Split, в отличии от StringField() преимущество что они не пробегают за каждым полем по всему тексту, а сразу не отходя от кассы читают следующий элемент от текущей позиции. И показан перебор символов, движение по строке.

Отредактировано AZJIO (06.09.2023 14:45:11)

0

23

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3123
  • Уважение: [+100/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 12 дней
  • Последний визит:
    Сегодня 15:58:59
AZJIO написал(а):

StringField() настолько простая функция, что написать её можно самому.

Можно только в данном случае это не даст результата. В StringField() нет бага из-за которого происходит утечка памяти.
Скорее дело в ошибке в программе из-за которой в ассоциативном массиве добавляются лишние элементы, что может выглядеть как утечка памяти.

0

24

  • Автор: AZJIO
  • Активный участник
  • Зарегистрирован: 07.08.2020
  • Приглашений: 0
  • Сообщений: 1288
  • Уважение: [+18/-0]
  • Позитив: [+15/-0]
  • Провел на форуме:
    26 дней 14 часов
  • Последний визит:
    Сегодня 20:10:08

Пётр
я знаю что не даст, но исчезнет претензия к функции и винить придётся уже свой код.

0

25

  • Автор: Sergeihik
  • Активный участник
  • Зарегистрирован: 27.07.2021
  • Приглашений: 0
  • Сообщений: 184
  • Уважение: [+3/-3]
  • Позитив: [+0/-0]
  • Провел на форуме:
    2 дня 19 часов
  • Последний визит:
    04.01.2025 20:48:25

Да не код а косяки вот что это.

Код:
s$="1234567890"
Global  NewMap  Var$()
Debug s$
Debug Len(s$)
Debug @s$
;Debug Len(@s$)
;=====================

Structure COMMANDSTRUCT
  Operation.i
  Count.i
  Arg$[12];у вас конкретное пространство памяти есть ли уверенность что последний символ (null, конец строки) строки юнекода по 2 байта на символ
EndStructure
Global Dim Command.COMMANDSTRUCT(0)
Procedure Setnull_Terminator(*adres_struct)
;Protected n.i=*adres_struct+20
;PokeW(n,0);типа гарантирован null=конец строки) что не работает у меня

!add dword [p.p_adres_struct],20
!mov word [p.p_adres_struct],0
EndProcedure 
;Setnull_Terminator(@Command(0)\Arg$);типа гарантирован null=конец строки  в структуре)




Command(0)\Arg$=s$;запись строки в структуру


Debug "============"
Debug *Command;туфта вы память сами не выделяли
Debug @Command;адрес всей структуры
Debug Command(0)\Arg$;наша строка
Debug @Command(0)\Arg$;адрес строки в структуре
Debug PeekS(@Command(0)\Arg$,-1,#PB_Unicode);строка полученная по адресу
Debug PeekS(10+@Command(0)\Arg$,-1,#PB_Unicode);строка полученная по адресу+ индекс

Debug "============"
Procedure$ Expr(String$); в эту не вникал
  Debug "====Expr==="
  
  Debug  Len(String$)
  Length  = Len(String$);с этим явно не будет Expr(*Command\Arg$[Index]) работать так как пытаетесь передать указатель да ещё непойми какой
  
  
  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

Procedure$ GetStr(Index)
  Index*2
  Debug PeekS(Index+@Command(0)\Arg$,-1,#PB_Unicode)
  ProcedureReturn Expr(PeekS(Index+@Command(0)\Arg$,-1,#PB_Unicode));так строка с позиции передаётся в Procedure$ Expr(String$)
  ;ProcedureReturn Expr(Index+@Command(0)\Arg$);тогда указатель передаётся и нужно менять код Procedure$ Expr(String$)
EndProcedure  


Debug GetStr(5)
Код:
s$="1234567890"
Global  NewMap  Var$()
Debug s$
Debug Len(s$)
Debug @s$
;Debug Len(@s$)
;=====================

Structure COMMANDSTRUCT
  Operation.i
  Count.i
  Arg$[12];у вас конкретное пространство памяти есть ли уверенность что последний символ (null, конец строки) строки юнекода по 2 байта на символ
EndStructure
Global Dim Command.COMMANDSTRUCT(0)
Procedure Setnull_Terminator(*adres_struct)
;Protected n.i=*adres_struct+20
;PokeW(n,0);типа гарантирован null=конец строки) что не работает у меня

!add dword [p.p_adres_struct],20
!mov word [p.p_adres_struct],0
EndProcedure 
;Setnull_Terminator(@Command(0)\Arg$);типа гарантирован null=конец строки  в структуре)




Command(0)\Arg$=s$;запись строки в структуру


Debug "============"
Debug *Command;туфта вы память сами не выделяли
Debug @Command;адрес всей структуры
Debug Command(0)\Arg$;наша строка
Debug @Command(0)\Arg$;адрес строки в структуре
Debug PeekS(@Command(0)\Arg$,-1,#PB_Unicode);строка полученная по адресу
Debug PeekS(10+@Command(0)\Arg$,-1,#PB_Unicode);строка полученная по адресу+ индекс

Debug "============"
Procedure$ Expr(String$);работа с входящей строкой но в эту не вникал до сего момента
  Debug "====Expr==="
  
  Debug  Len(String$)
  Length  = Len(String$);с этим явно не будет Expr(*Command\Arg$[Index]) работать так как пытаетесь передать указатель да ещё непойми какой
  
  
  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
Procedure$ Expr2(*String);работа процедуры по указателю на строку
  Debug "====Expr2==="
  Protected Length.i;переменная для количества символов юникод
  
  !cmp word [p.p_String],'$';это наш символ по адресу на первый входящий символ 
  !jnz noy;нет это не символ "$"
  ;================
  ;ок это он далее код для этого блока(поля строки) где в его начале символ $
  ProcedureReturn PeekS(2+*String,-1,#PB_Unicode);;берём тогда значение поля до конца строки(Null)без первого символа $
  ;
  ;===================
  !noy:
  ;дальше эта проверка ElseIf  (ch$  >=  Chr(49)  And ch$  <=  Chr(57))  Or  ch$ = "-"
  ;вобщем если символы цифр в строке в формате юникод от 1 до 9 или символ "-" то выполняем этот блок
  !cmp word [p.p_String],'-';это первый символ блока ch$ = "-"
  !jnz netneon
  ;значит он ch$ = "-"
  ProcedureReturn StrD(ValD(PeekS(*String,-1,#PB_Unicode)))
  
  
  !netneon:
  ;а может это цифры?;сейчас проверим
  !cmp word [p.p_String],'9';так как символов выше 57("9") больше чем до нуля сделаем эту проверку певым тактом
  !ja netnetotrasklad;значе символа больше 57(символ 9)выше 57 цифр нет значит блок кода выхода
  ;что меньше?значит проверим диапозон на цифры....
  !cmp word [p.p_String],47;диапоз выше от символа 0?
  !jl netnetotrasklad;он ниже и символов цифр нет в первом байте строки по указателю
  ;о да это же цифры! надо срочно брать число,но только вот по условию StrD(ValD(String$)) ну как миниму String$ до конца строки(null) а если там чёрт ногу сломишь?
  ;
  ;эксперементс
  Debug StrD(ValD("0.123456789"))
  Debug StrD(ValD("0,123456789"))
  ;вобщем  с этим StrD(ValD(String$)) недоразумение,зачем строку симолов цифр из цифр(условно так как нет конца по записи символов цифр а тупо до конца строки)
  ;переводить в число и опять в эти же строковые символы числа, когда это значение числа и так изначально в символах строки?
  ProcedureReturn StrD(ValD(PeekS(*String,-1,#PB_Unicode)))
  
  
  
  
  !netnetotrasklad:;значит оконцовка кода по условию  ProcedureReturn Var$(String$)
  ProcedureReturn Var$(String$);правда что за процедура Var$()?не знаю и уменя это не работает....
  
  
  ;;;;=============================конец процедурки...EndProcedure
  
  
  ;Debug  Len(String$)
  ;Length  = Len(String$);с этим явно не будет Expr(*Command\Arg$[Index]) работать так как пытаетесь передать указатель на адрес в строке да ещё непойми какой
  
  
  ;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

Procedure$ GetStr(Index)
  Index*2
  Debug PeekS(Index+@Command(0)\Arg$,-1,#PB_Unicode)
  ;ProcedureReturn Expr(PeekS(Index+@Command(0)\Arg$,-1,#PB_Unicode));так строка с позиции передаётся в Procedure$ Expr(String$)
  ProcedureReturn Expr2(Index+@Command(0)\Arg$);тогда указатель передаётся и нужно менять код Procedure$ Expr(String$)
EndProcedure  


Debug GetStr(5)

Отредактировано Sergeihik (08.09.2023 06:22:49)

0

26

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

*Command - указатель на массив.
Вместо PokeW - PokeC...

0

27

  • Автор: Sergeihik
  • Активный участник
  • Зарегистрирован: 27.07.2021
  • Приглашений: 0
  • Сообщений: 184
  • Уважение: [+3/-3]
  • Позитив: [+0/-0]
  • Провел на форуме:
    2 дня 19 часов
  • Последний визит:
    04.01.2025 20:48:25
PSY написал(а):

*Command - указатель на массив.
Вместо PokeW - PokeC...

Так в том и дело что во первых  * указатель когда память выделяешь сам с помощью функций выделения например allocatememory()
а у вас массив(и его память) создан программой а для этого указатель обозначается @
во вторых вы передаёте (пытаетесь,смотрим выше) указатель в процедуру а аргумент у вас там string$(как бы опть строка по условию компилятора)
в третьих допустим вам каким то боком удалось его передать через стек в процедуру expr() а дальше в ней у вас функции для работы с строкой(в пурике так заложено)а вы допустим
пихаете указатель в len(@"1234567890")что будет у вас debug len(@"1234567890")?у меня лично компилятор bad  пишет да можно конечно и с указателем работать но для этого нужны другие функции что работают по указателю или другие конструкции кода(не обязательно на фасм)!

Код:

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]);забыли что массив структур создали?как минимум *Command(0)\(опять же * это другая история и должно быть @)
EndMacro

Ps: Purebasic на столько крут что супер умы вам тычат что баг ваш код а не компилятор но фишку не раскрывают что бы язык оставался не популярен для масс а для избранных... :D

Отредактировано Sergeihik (08.09.2023 15:39:20)

0

28

  • Автор: AZJIO
  • Активный участник
  • Зарегистрирован: 07.08.2020
  • Приглашений: 0
  • Сообщений: 1288
  • Уважение: [+18/-0]
  • Позитив: [+15/-0]
  • Провел на форуме:
    26 дней 14 часов
  • Последний визит:
    Сегодня 20:10:08
Sergeihik написал(а):

но фишку не раскрывают

для фишки надо разбирать код, угадывать цель по коду и код по цели, но кому это интересно, у каждого своих проблем навалом в том числе и с кодом. Я вот, пока вы обсуждаете проблему, накидал код для SpiderBasic для предпросмотра гаджетов, написал статейку установки, подготовил проблемы поиска в виде html-страницы, и вопрос по изменению шрифта, вместо того чтобы ковырять чужой код. Причём хак на хаке, доступ к массиву по указателю, рекурсивные потоки. Для начала убрать потоки, отладить без потоков, когда начнёт работать включить потоки, а то нагородить всего ивыложить почему не работает. Так проверь каждый шаг, выдают ли первые строки кода адекватные данные, просмотри память, находится ли там информация которая должна находиться.

0

29

  • Автор: PSY
  • Активный участник
  • PSY
  • Откуда: Город Пенза
  • Зарегистрирован: 26.10.2021
  • Приглашений: 0
  • Сообщений: 192
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 36 [1988-09-17]
  • Провел на форуме:
    1 день 12 часов
  • Последний визит:
    25.04.2025 06:21:10

Разницы никакой: выделяешь ли ты память или по-указателю к массиву обращаешься...
Исправил у себя указатели, индексы параметров и всё заработало. А глюк был в версии 3.7, в 4 не замечал такого.

Отредактировано PSY (11.09.2023 21:01:13)

0

30

  • Автор: Sergeihik
  • Активный участник
  • Зарегистрирован: 27.07.2021
  • Приглашений: 0
  • Сообщений: 184
  • Уважение: [+3/-3]
  • Позитив: [+0/-0]
  • Провел на форуме:
    2 дня 19 часов
  • Последний визит:
    04.01.2025 20:48:25

У вас массив comand(),+ в каждом этом массиве массив строк command!()\arg$[ index] =типа сюда
Записываете аргументы в виде строки только зачем-то лишние преобразования делаете строка в число и обратно строка а после типа при выполнении опять строку преобразует в число?
опять же comand()\count типа количество аргументов не ставите негде?

Сделайте лучше
Structure arg
zadanie.a;типа указать что это за аргумет строка или некое число
hislo.a
hislo.b
hislo.i
hislo.l
hislo.q
hislo.f
hislo.d
stroka$[1];если строка в аргументе
Endstructure
Structure comanda
operaciy.i
count.a;количество аргументов в команде
arg.arg[100];типа до ста аргументов
Endstructure

Ну и сразу записывать а после выполнять

0

Страница: 1 2  

Вы здесь » PureBasic - форум » PureBasic для Windows » Баг компилятора 6.01