How replace ELSEIF

[aurelCB]

Hi guys...
I want convert one Power Basic console program to Creative but i'm find fwe problems.
Program is interesting example of small basic by Jim Klutho.
Is there a way how replace command ELSEIF?
Here is part of program:

Code Select Expand

SUB Eval_StrExp(TempStr AS STRING)
   LOCAL Result AS LONG
   LOCAL myStr AS STRING
   LOCAL NResult AS DOUBLE

   TempStr=""
   DO
   GetToken
   IF Token_Type=%SB_VARISTR THEN
     MyStr=Token
     Result = Find_Var(MyStr)
     TempStr=TempStr+MyStr
     GetToken
    ELSEIF Token_Type=%SB_QUOTE THEN
     TempStr=TempStr+Token
     GetToken
    ELSEIF Token_Type=%SB_VARIABLE OR Token_Type=%SB_NUMBER THEN
     PutBack
     eval_exp NResult
     TempStr=TempStr+FORMAT$(NResult,gSB_Format)
     GetToken
    ELSE
     Serror(%SB_SERROR)
     EXIT SUB
   END IF
   LOOP WHILE token = "+"
END SUB

[sapero]

Code Select Expand

SELECT Token_Type
CASE 0
messagebox 0, "0", ""
CASE 1
CASE 2
messagebox 0, "1 or 2", ""
ENDSELECT

[aurelCB]

Aha i see  now
Is same thing with DO WHILE LOOP i mean replace with WHILE / ENDWHILE.
OK I try and thanks sapero

[GWS]

Or possibly use the SELECT TRUE - ENDSELECT format:

Code Select Expand



select 1
case (Token_Type=%SB_VARISTR)
     MyStr=Token
     Result = Find_Var(MyStr)
     TempStr=TempStr+MyStr
     GetToken
case (Token_Type=%SB_QUOTE)
     TempStr=TempStr+Token
     GetToken
case (Token_Type=%SB_VARIABLE OR Token_Type=%SB_NUMBER)
     PutBack
     eval_exp NResult
     TempStr=TempStr+FORMAT$(NResult,gSB_Format)
     GetToken
default
     Serror(%SB_SERROR)
     EXIT SUB
endselect


all the best,

Graham

[aurelCB]

Thanks GWS i try also your option.
Onother thing is this part of code:

Code Select Expand

$DIM ALL
%SB_NUM_LAB=100
%SB_NUM_CMDS=20
%SB_NUM_ERRS=20
%SB_LAB_LEN=25
%SB_FOR_NEST=25
%SB_SUB_NEST=25
%SB_TABSTOP=8
'---------TOKEN TYPES-------------
%SB_UNDEFTOK=0
%SB_DELIMITER=1
%SB_NUMBER=2
%SB_VARIABLE=3
%SB_COMMAND=4
%SB_STRING=5
%SB_QUOTE=6
%SB_VARISTR=7
%SB_LABEL=8

Stig Johansen use in  EvalExpression command SETID but i'm in doubt maby is better way use INTEGERS.

-- edited GWS --
(Full Power Basic program listing removed )

Sorry Aurel - I felt we were pushing it to post a complete Power Basic program - it takes a lot of space, and might confuse other users into thinking it was some weird form of Creative .. 

If you'd like to append it as a zip file, I'm sure that would be OK ..

Thanks 

Graham
----------------------

[aurelCB]

And here is my unfinished attempt.UF looks complicated...

Code Select Expand

'$DIM ALL
CONST SB_NUM_LAB = 100
CONST SB_NUM_CMDS = 20
CONST SB_NUM_ERRS = 19
CONST SB_LAB_LEN = 25
CONST SB_FOR_NEST = 25
CONST SB_SUB_NEST = 25
CONST SB_TABSTOP=8
'---------TOKEN TYPES-------------
CONST SB_UNDEFTOK=0
CONST SB_DELIMITER=1
CONST SB_NUMBER=2
CONST SB_VARIABLE=3
CONST SB_COMMAND=4
CONST SB_STRING=5
CONST SB_QUOTE=6
CONST SB_VARISTR=7
CONST SB_LABEL=8
'-----------COMMAND TOKENS---------
CONST SB_UNKNCOM = 0
CONST SB_PRINT = 1
CONST SB_INPUT = 2
CONST SB_IF = 3
CONST SB_THEN = 4
CONST SB_FOR = 5
CONST SB_NEXT = 6
CONST SB_TO = 7
CONST SB_GOTO = 8
CONST SB_GOSUB = 9
CONST SB_RETURN = 10
CONST SB_EOL = 11
CONST SB_FORMAT = 12
CONST SB_FINISHED = 13
CONST SB_END = 14
'--------------RELATIONAL OPS---------
CONST SB_GE=1
CONST SB_NE=2
CONST SB_LE=3
'-------------ERROR TYPES--------------
CONST SB_SERROR=0
CONST SB_PARENS=1
CONST SB_NOEXP=2
CONST SB_DIV_ZERO=3
CONST SB_EQUAL_EXP=4
CONST SB_NOT_VAR=5
CONST SB_LAB_TAB_FULL=6
CONST SB_DUP_LAB=7
CONST SB_UNDEF_LAB=8
CONST SB_THEN_EXP=9
CONST SB_TO_EXP=10
CONST SB_TOO_MNY_FOR=11
CONST SB_NEXT_WO_FOR=12
CONST SB_TOO_MNY_GOSUB=13
CONST SB_RET_WO_GOSUB=14
CONST SB_MISS_QUOTE=15
CONST SB_BAD_FILE=16
CONST SB_STR_EXP=17
CONST SB_UNKNOWN_KEYWORD=18
'----------------TYPES---------
TYPE TAB_TYPE
   DEF Command[20] AS STRING
   DEF Tok AS INT
ENDTYPE

TYPE LAB_TYPE
   DEF Lname[SB_LAB_LEN] AS STRING
   DEF p AS INT
ENDTYPE

TYPE FOR_STACK_TYPE
   DEF var AS INT
   DEF Target AS INT
   DEF Location AS INT
ENDTYPE
'-------------------DECLARE VARIABLES------------
DEF Variables() AS DOUBLE
DEF VarStrings() AS STRING
DEF ProgPtr AS INT : 'THIS IS THE POINTER
DEF Token AS STRING
DEF Token_Type AS INT
DEF Tok  AS INT
DEF Ftos AS INT
DEF Gtos AS INT
DEF Relops[8] AS STRING
DEF MyProg AS STRING
DEF Table AS TAB_TYPE
DEF Label_Table AS LAB_TYPE
DEF FStack AS FOR_STACK_TYPE
DEF GStack AS INT
DEF gLineCount AS INT
DEF ErrorFlag AS INT
DEF gSB_Format AS STRING

DEF MyFile:FILE

'----------------DECLARE FUNCTIONS--------------
DECLARE  Exec_PRINT()
DECLARE  Exec_GOTO()
DECLARE  Exec_IF()
DECLARE  Exec_FOR()
DECLARE  Exec_NEXT()
DECLARE  Exec_INPUT()
DECLARE  Exec_GOSUB()
DECLARE  Exec_RETURN()
DECLARE  Exec_FORMAT()
DECLARE  Exec_RUN(s AS STRING,op AS INT) AS INT

DECLARE gpush(L AS INT)
DEF  gpop() AS INT
DECLARE fpush(i AS FOR_STACK_TYPE)
DECLARE fPop(i AS FOR_STACK_TYPE)

DECLARE FindEOL()
DECLARE  GetNextLabel(s AS STRING) AS INT
DECLARE  FindLabel(s AS STRING) AS INT
DECLARE  Assignment()
DECLARE  ScanLabels()
'----------
DECLARE Eval_Exp(Result AS DOUBLE)
DECLARE  Eval_Exp1(Result AS DOUBLE)
DECLARE  Eval_Exp2(Result AS DOUBLE)
DECLARE Eval_Exp3(Result AS DOUBLE)
DECLARE  Eval_Exp4(Result AS DOUBLE)
DECLARE  Eval_Exp5(Result AS DOUBLE)
DECLARE  Eval_Exp6(Result AS DOUBLE)
DECLARE  Atom(Result AS DOUBLE)
DECLARE  Putback()
DECLARE  SError(Gerror AS INT)
DECLARE  GetToken() AS INT
DECLARE  LookUp(S AS STRING) AS INT
DECLARE  IsDelim(S AS STRING) AS INT
DECLARE IsDigit(S AS STRING) AS INT
DECLARE IsAlpha(S AS STRING) AS INT
DECLARE  Is_Space_Tab(S AS STRING) AS INT
DECLARE  Find_Var(S AS STRING) AS DOUBLE
DECLARE  Eval_StrExp(TempStr AS STRING)
'---------------FUNCTIONS-------------------------
OPENCONSOLE

DEF linenum AS INT
DEF s AS STRING
DEF thefile AS STRING
DEF doneflag AS INT
DEF counter AS INT
DEF result AS DOUBLE
DIM Variables[26] AS DOUBLE
DIM VarStrings[26] AS STRING
' DIM Table[20] AS TAB_TYPE
' DIM Label_Table[SB_NUM_LAB] AS LAB_TYPE
' DIM FStack[SB_FOR_NEST] AS FOR_STACK_TYPE
' DIM GStack[SB_SUB_NEST] AS INT
'-------------INTIALIZE VARIABLES-----------------
FOR Counter = 0 TO 25
  Variables[Counter] = 0
  VarStrings[Counter] = ""
NEXT Counter

Table[1].Command = "PRINT": Table[1].Tok = SB_PRINT
Table[2].Command = "INPUT": Table[2].Tok = SB_INPUT
Table[3].Command = "IF": Table[3].Tok = SB_IF
Table[4].Command = "THEN": Table[4].Tok = SB_THEN
Table[5].Command = "GOTO": Table[5].Tok = SB_GOTO
Table[6].Command = "FOR": Table[6].Tok = SB_FOR
Table[7].Command = "NEXT": Table[7].Tok = SB_NEXT
Table[8].Command = "TO": Table[8].Tok = SB_TO
Table[9].Command = "GOSUB": Table[9].Tok = SB_GOSUB
Table[10].Command = "RETURN": Table[10].Tok = SB_RETURN
Table[11].Command = "FORMAT": Table[11].Tok = SB_FORMAT
Table[12].Command = "END": Table[12].Tok = SB_END
Table[13].Command = "*": Table[13].Tok = SB_END

Relops= CHR$(SB_GE) + CHR$(SB_NE)+CHR$(SB_LE)+"<"+">"+"="+CHR$(0)+CHR$(0)
gSB_Format="#.00"

OPENCONSOLE
'------------------------------------------------
CLS
doneflag=0
ProgPtr=1
MyProg=" "
PRINT "Type 'Exit' to exit program"

WHILE doneflag=0
   ErrorFlag=0
   INPUT "Ready> ",MyProg
   s = UCASE$(RTRIM$((LTRIM$(MyProg))))
   MyProg=MyProg+CHR$(13)+CHR$(10)

   ProgPtr=1
   IF LEFT$(s,3)="RUN"
      thefile=RTRIM$(LTRIM$(MID$(s,4)))
      s=LEFT$(s,3)
   ENDIF
  SELECT  s
         CASE "RUN"
              Counter = Exec_Run(thefile,1)
         CASE "EXIT"
              doneflag=1
         DEFAULT
              Counter=Exec_Run(MyProg,0)
  ENDSELECT
ENDWHILE
'WAITKEY$
DO:UNTIL INKEY$<>""
CLOSECONSOLE
END


SUB Is_Space_Tab(S AS STRING) AS INT
   Is_Space_Tab=0
   IF S=CHR$(32) THEN Is_Space_Tab=1
   IF S=CHR$(9) THEN Is_Space_Tab=1
RETURN

SUB SError(Gerror AS INT)
     DEF  SErrorS[SB_NUM_ERRS] AS STRING :'
     DEF TempPtr AS INT
     DEF TempStr AS STRING
     DEF char AS STRING
     DEF MyLine AS INT

     SErrorS[0]="Syntax Error"
     SErrorS[1]="Unbalanced Parentheses"
     SErrorS[2]="No Expression Present"
     SErrorS[3]="Division by Zero"
     SErrorS[4]="Equal Sign Expected"
     SErrorS[5]="Not a Variable"
     SErrorS[6]="Label Table Full"
     SErrorS[7]="Duplicate Label"
     SErrorS[8]="Undefined Label"
     SErrorS[9]="THEN Expected"
     SErrorS[10]="TO Expected"
     SErrorS[11]="Too Many Nested GOSUBs"
     SErrorS[12]="NEXT Without FOR"
     SErrorS[13]="Too Many GOSUBs"
     SErrorS[14]="Return Without GOSUB"
     SErrorS[15]="Missing Quote"
     SErrorS[16]="Bad File Name"
     SErrorS[17]="String Expected"
     SErrorS[18]="Unknown Keyword"

     TempPtr=ProgPtr
     TempStr=""
     char=" "
     ProgPtr=1
     MyLine=1

     WHILE (ProgPtr < TempPtr) & (char <> CHR$(0))
       char=MID$(MyProg,ProgPtr,1)
       IF (char = CHR$(13)) & (MID$(MyProg,ProgPtr+1,1)=CHR$(10))
           ProgPtr= ProgPtr+1
           MyLine=MyLine+1
       ENDIF
       ProgPtr= ProgPtr+1
     ENDWHILE

     PRINT "[Error] " + RTRIM$(LTRIM$(SErrorS[Gerror])) + " in line " + STR$(MyLine-1)
     ProgPtr = TempPtr
     Errorflag = 1
RETURN

SUB Assignment
    DEF var AS INT
    DEF MyStr AS STRING
    DEF TempStr AS STRING
    DEF Result AS DOUBLE

    GetToken()
    IF isAlpha(Token)=0
       Serror(SB_NOT_VAR)
       RETURN
    ENDIF
    MyStr=UCASE$(LEFT$(Token,1))
    TempStr = Token

    GetToken()
    IF Token <>"="
       Serror(SB_EQUAL_EXP)
       RETURN
    ENDIF

    IF RIGHT$(TempStr,1)<>"$"
      eval_exp Result
      Variables(ASC(MyStr)-65 + 1)=Result
    ELSE
      eval_StrExp (TempStr)
      VarStrings(ASC(MyStr)-65 + 1)=TempStr
    ENDIF
RETURN

SUB LookUp(S AS STRING) AS INT
      DEF  Counter AS INT
      DEF  MyStr[20] AS STRING
      MyStr=S
      Counter=1
      MyStr=UCASE$(MyStr)
      LookUP=SB_UNKNCOM : 'DEFAULT VALUE
      WHILE (MID$(Table[Counter].Command,1,1) <> "*" ) & (Counter < SB_NUM_CMDS)
         IF RTRIM$(LTRIM$(Table[Counter].Command)) = RTRIM$(LTRIM$(MyStr))
           LookUp = Table[Counter].Tok
           Counter = SB_NUM_CMDS
         ENDIF
          Counter=Counter+1
      ENDWHILE
RETURN

SUB IsDelim(S AS STRING) AS INT
   DEF  Temp AS INT
      IsDelim=0
      Temp=INSTR(1," ;,+-<>^=(*)/",S)
      IF Temp > 0 THEN IsDelim=1
      IF S=CHR$(9) THEN IsDelim=1
      IF S=CHR$(13) THEN IsDelim=1
      IF S=CHR$(10) THEN IsDelim=1
      IF S=CHR$(0) THEN IsDelim=1
RETURN

SUB IsDigit(S AS STRING) AS INTEGER
     IsDigit=0
     IF (S > CHR$(47)) & (S < CHR$(58)) | (S=CHR$(46))THEN IsDigit=1
RETURN

SUB IsAlpha(S AS STRING) AS INT
     IsAlpha=0
     IF (UCASE$(MID$(S,1,1)) > CHR$(64)) & (UCASE$(MID$(S,1,1)) < CHR$(91)) THEN IsAlpha=1
RETURN

SUB Putback()
  DEF  Mylen AS INT

   Mylen=LEN(Token)
   ProgPtr=ProgPtr - Mylen
   IF Token_Type=SB_QUOTE THEN ProgPtr=ProgPtr-2
RETURN

SUB Find_Var(S AS STRING) AS DOUBLE
  DEF  MyStr AS STRING
  MyStr=LEFT$(S,1)
  IF IsAlpha(MyStr)=0
     Find_Var=0
     RETURN
  ENDIF
  MyStr=UCASE$(MyStr)
  IF Token_Type=SB_VARISTR :   'Result is returned in parameter for strings
     S=VarStrings(ASC(MyStr)-65 + 1)
     Find_Var=-2
   ELSE
     Find_Var=Variables(ASC(MyStr)-65 + 1) : 'Result is returned by function for doubles
  ENDIF
RETURN

SUB Eval_StrExp(TempStr AS STRING)
   DEF Result AS INT
   DEF myStr AS STRING
   DEF NResult AS DOUBLE

   TempStr=""
   DO
   GetToken()
    IF Token_Type = SB_VARISTR
      MyStr = Token
      Result = Find_Var(MyStr)
      TempStr = TempStr+MyStr
      GetToken()
    IF Token_Type = SB_QUOTE
      TempStr = TempStr+Token
      GetToken()
    IF (Token_Type=SB_VARIABLE) | (Token_Type=SB_NUMBER)
      PutBack()
      eval_exp NResult
      TempStr=TempStr+FORMAT$(NResult,gSB_Format)
      GetToken()
    ELSE
      Serror(SB_SERROR)
      RETURN
    ENDIF
ENDIF
ENDIF
   UNTIL token = "+"
RETURN

'----------------------------------------------------
       ' Entrance to Parser
SUB Eval_Exp(Result AS DOUBLE)   :'ENTRY
     GetToken()
     IF Token = "EOF"
         SError SB_NOEXP
         RETURN
      ELSE
       CALL  Eval_Exp1(result)
       Putback()
     ENDIF
RETURN

SUB Eval_Exp1(Result AS DOUBLE)  : 'RELATIONAL
   DEF  Temp AS DOUBLE
   DEF  Op AS STRING
   DEF  which AS INT
   DEF  temp2 AS INT

   CALL  Eval_Exp2(result)
   op=token
   which = INSTR(1,Relops,op)
   IF which > 0
      GetToken()
      CALL Eval_Exp1(Temp)

      SELECT   op
          CASE "<"
            Result=(Result < Temp)
          CASE CHR$(SB_LE)
            Result=(Result <= Temp)
          CASE ">"
            Result=(Result > Temp)
          CASE CHR$(SB_GE)
            Result=(Result >= Temp)
          CASE "="
            Result=(Result = Temp)
          CASE CHR$(SB_NE)
            Result=(Result <> Temp)
      ENDSELECT
   ENDIF
RETURN

SUB Eval_Exp2(Result AS DOUBLE)  : 'ADD OR SUBTRACT
   DEF  Temp AS DOUBLE
   DEF  Op AS STRING

  GOSUB Eval_Exp3(result)
    OP=token
    WHILE (op="+" OR op="-") & (op <> CHR$(0))
      GetToken()
      CALL Eval_Exp3(Temp)

      SELECT op
         CASE "-"
           Result=(Result-Temp)
         CASE "+"
           Result=(Result+Temp)
      ENDSELECT

      OP=token
    ENDWHILE
RETURN

SUB Eval_Exp3(Result AS DOUBLE)   :'DIVIDE OR MULTIPLY
   DEF  Temp AS DOUBLE
   DEF Op AS STRING

   GOSUB Eval_Exp4(result)
    OP=token
    WHILE (op="*" OR op="/") & (op <> CHR$(0))
      GetToken()
      CALL Eval_Exp4(Temp)

      SELECT  op
         CASE "*"
           Result=(Result*Temp)
         CASE "/"
           IF Temp = 0
              SError(SB_DIV_ZERO)
              RETURN
           ENDIF
           Result=(Result/Temp)
      ENDSELECT

      Op=token
    ENDWHILE
RETURN

SUB Eval_Exp4(Result AS DOUBLE) : 'PROCESS EXPONENT
    DEF  Temp AS DOUBLE
    DEF  Count AS INT
    DEF  Ex AS DOUBLE
      Eval_Exp5(result):'call
    IF token ="^"
      GetToken()
       Eval_Exp4(Temp):'call
      IF Temp=0
          Result=1
          RETURN
      ENDIF
      Result=Result^Temp
    ENDIF
RETURN

SUB Eval_Exp5(Result AS DOUBLE): 'UNARY + OR -
   DEF Op AS STRING
   Op=""
   IF (Token_Type = SB_DELIMITER) & (Token="+") | (Token="-")
       Op=Token
       GetToken()
   ENDIF
    Eval_Exp6(result):'call
   IF op ="-" THEN Result= -Result
RETURN

SUB Eval_Exp6(Result AS DOUBLE)  :'PARENS
  IF Token="("
     GetToken()
        Eval_Exp2(result) :'call
     IF Token <>")" THEN SError(SB_PARENS)
     GetToken()
   ELSE
     atom(result) :'call

ENDIF
RETURN

SUB Atom(Result AS DOUBLE)  :     'PRIMITIVE
     SELECT  Token_Type
         CASE SB_VARIABLE
            Result = Find_Var(Token)
            GetToken()
         CASE SB_NUMBER
            Result = VAL(Token)
            GetToken()
         DEFAULT
            SError(SB_SERROR)
     ENDSELECT
RETURN
'-----------------END OF PARSER---------------------------
SUB GetToken() AS INT
DEF MyStr AS STRING
DEF i AS INT

Token_Type = SB_UNDEFTOK
Tok = SB_UNDEFTOK
Token = ""

IF (ASC(MyProg)=0) & (ProgPtr=0): 'END OF PROG?
   Token = "EOF"  :'CHR$(0)
   Tok = SB_FINISHED
   Token_Type = SB_DELIMITER
   GetToken = SB_DELIMITER
   RETURN
ENDIF

WHILE Is_Space_Tab(MID$(MyProg,ProgPtr,1))=1 :   'GO PAST WHITE SPACES
    ProgPtr=ProgPtr+1
ENDWHILE

IF ASC(MyProg,ProgPtr)=39 : '  We have a comment
     FindEOL()
ENDIF

IF (ASC(MyProg)=13) & (ASC(MyProg)=10)&((ProgPtr+1)=10):'END OF LINE?
   ProgPtr=ProgPtr+2
   Tok=SB_EOL
   Token="EL" :'CHR$(13)
    gLineCount=gLineCount+1
   Token_Type=SB_DELIMITER
   GetToken=SB_DELIMITER
   RETURN
ENDIF

IF (ASC(MyProg)=ASC("<")) | (ASC(MyProg)=ASC(">")) :'DOUBLE OPS
   IF ASC(MyProg)=ASC("<")
     Token="<"
      ProgPtr=ProgPtr+1
     IF ASC(MyProg,ProgPtr+1)=ASC(">")
        Token=CHR$(SB_NE)
        ProgPtr=ProgPtr+1
     ENDIF
     IF ASC(MyProg,ProgPtr+1)=ASC("=")
        Token=CHR$(SB_LE)
        ProgPtr=ProgPtr+1
     ENDIF
   ENDIF

   IF ASC(MyProg,ProgPtr)=ASC(">")
     Token=">"
     'INCR ProgPtr
     IF ASC(MyProg,ProgPtr+1) = ASC("=")
        Token=CHR$(SB_GE)
        ProgPtr=ProgPtr+1
     ENDIF
   ENDIF
   Token_Type=SB_DELIMITER
   GetToken=SB_DELIMITER
   RETURN
ENDIF

IF ASC(MyProg,ProgPtr)=34  :  'QUOTED STRING
       'INCR ProgPtr
       WHILE (ASC(MyProg,ProgPtr)<> 34)  & (ASC(MyProg,ProgPtr)<> 13)
         Token=Token+MID$(MyProg,ProgPtr,1)
         ProgPtr=ProgPtr+1
       ENDWHILE
       IF (ASC(MyProg)=13)
          SError(SB_MISS_QUOTE)
           ProgPtr = ProgPtr + 1
       ENDIF
   ProgPtr = ProgPtr + 1:'get by last quote
   Token_Type=SB_QUOTE
   GetToken=SB_QUOTE
   RETURN
ENDIF

IF INSTR(1," ;,+-<>^=(*)/",MID$(MyProg,ProgPtr,1))<>0
   Token=MID$(MyProg,ProgPtr,1)
   ProgPtr = ProgPtr + 1
   Token_Type=SB_DELIMITER
   GetToken=SB_DELIMITER
   RETURN
ENDIF

IF IsDigit(MID$(MyProg,ProgPtr,1)) =1
    WHILE IsDelim(MID$(MyProg,ProgPtr,1)) = 0
      Token=Token+MID$(MyProg,ProgPtr,1)
      ProgPtr = ProgPtr + 1
    ENDWHILE
      Token_Type = SB_NUMBER
      GetToken = SB_NUMBER
      RETURN
ENDIF

IF IsAlpha(MID$(MyProg,ProgPtr,1)) =1 
   WHILE IsDelim(MID$(MyProg,ProgPtr,1)) = 0
      Token=Token+MID$(MyProg,ProgPtr,1)
      ProgPtr = ProgPtr + 1
      Token_Type=SB_STRING
      GetToken=SB_STRING
   ENDWHILE
ENDIF

IF Token_Type=SB_STRING   : 'IS COMMAND OR VARIABLE
   Tok=LookUp(Token)
   IF Tok=SB_UNDEFTOK
      IF RIGHT$(Token,1)="$"
           Token_Type=SB_VARISTR
ELSE
          IF RIGHT$(Token,1)=":"
            Token_Type=SB_LABEL
           ' Tok=%SB_LABEL
            i=LEN(token)
            token=MID$(token,1,i-1): 'strip ":"
         ELSE
           Token_Type = SB_VARIABLE
       ENDIF
     ELSE
       Token_Type = SB_COMMAND
   ENDIF
   GetToken=Token_Type
ENDIF
RETURN :'GetToken

SUB Exec_RUN(s AS STRING,op AS INT) AS INT
  DEF MyFile AS STRING
  DEF TempStr AS STRING
  DEF count AS INT
  'op = 1 run from file  op<>1 then run from command line

IF op=1
  'MyFile=DIR$(s)
  IF LEN(MyFile)=0
    Serror(SB_BAD_FILE)
    FUNCTION = 16
    RETURN
   ELSE
    MyProg=""
    OPENFILE(MyFile,"C:\CBASICTEST.TXT","R")
       WHILE NOT EOF(1)
        INPUT "",TempStr
        IF LEN(TempStr)>0 THEN MyProg=MyProg+TempStr+CHR$(13)+CHR$(10)
       ENDWHILE
       MyProg=MyProg+"00000000000000000000"
    CLOSEFILE MyFile
  ENDIF
  ELSE
   MyProg=s
ENDIF
  Tok=0
  Ftos=0
  GTos=0

  FOR count=1 TO SB_NUM_LAB
      Label_Table[count].Lname=""
      Label_Table[count].p=0
  NEXT count

  ScanLabels()

  WHILE (Tok<>SB_FINISHED) & (ErrorFlag=0)
    'Token_Type=GetToken
GetToken
    IF (Token_Type=SB_VARIABLE) | (Token_Type=SB_VARISTR) : 'a variable
      PutBack()
      Assignment()
     IF Token_Type=SB_LABEL
        'Do Nothing
     ELSE :'a command
      SELECT Tok

         CASE SB_PRINT
           Exec_PRINT()
           ENDSELECT

         CASE SB_INPUT
           Exec_INPUT
           ENDSELECT

         CASE SB_GOTO
           Exec_GOTO
            ENDSELECT

         CASE SB_GOSUB
           Exec_GOSUB
           ENDSELECT

         CASE SB_RETURN
           Exec_RETURN
           ENDSELECT

         CASE SB_FOR
           Exec_FOR
           ENDSELECT

         CASE SB_NEXT
           Exec_NEXT
           ENDSELECT

         CASE SB_IF
           Exec_IF
           ENDSELECT

         CASE SB_FORMAT
           Exec_FORMAT
           ENDSELECT

         CASE SB_END
           Tok=0
           ENDSELECT

         CASE SB_EOL
           'do nothing
          ENDSELECT

CASE SB_LABEL
'do nothing
          ENDSELECT

CASE SB_FINISHED
'do nothing
          ENDSELECT

         DEFAULT
           Serror(SB_UNKNOWN_KEYWORD)
      ENDSELECT
    ENDIF

   FUNCTION=0 :'return value not used yet
  ENDWHILE
RETURN

SUB ScanLabels:' SCAN LABELS
   DEF i AS INT

   ProgPtr=1
   GetToken()

   IF Token_Type = SB_LABEL
      Label_Table[1].Lname = Token
      Label_Table[1].p = ProgPtr
   ENDIF

   FindEOL()

   WHILE  Tok <> SB_FINISHED
     GetToken()
     IF Token_Type = SB_LABEL
        i = GetNextLabel(token)
        IF i=-1 :SError(SB_LAB_TAB_FULL) :RETURN:ENDIF
        IF i=-2 : SError(SB_DUP_LAB) :RETURN:ENDIF
        Label_Table[i].LName=token
        Label_Table[i].p = ProgPtr
     ENDIF
     IF Tok <> SB_EOL THEN FindEOL()
   ENDWHILE

   ProgPtr=1
   Tok=0
RETURN

SUB GetNextLabel(s AS STRING) AS INT
   DEF count AS INT

   GetNextLabel = -1 :'Assume table is full
   FOR count=1 TO SB_NUM_LAB
      IF Label_Table(count).p=0
        FUNCTION = count
        RETURN
       ELSE Label_Table(count).LName=s
        FUNCTION = -2 :'Duplicate
        RETURN
      ENDIF
   NEXT count
RETURN

SUB FindLabel(s AS STRING) AS INT
   DEF count AS INT
   DEF mystr[SB_LAB_LEN] AS STRING
   mystr=s

   FUNCTION=0 :'Assume Failure

   FOR count=1 TO SB_NUM_LAB
      IF Label_Table[count].LName = mystr
        FUNCTION=Label_Table[count].p : 'Found it
        RETURN
      ENDIF
   NEXT count

RETURN

SUB FindEOL
  WHILE (MID$(MyProg,ProgPtr,1) <> CHR$(13)) & (MID$(MyProg,ProgPtr,1) <> CHR$(0))  : 'END OF LINE OR EOF?
    INCR ProgPtr
  ENDWHILE
   IF MID$(MyProg,ProgPtr,1) <> CHR$(0) THEN  ProgPtr = ProgPtr+2  :'if not EOF then get by CHR$(10)
RETURN

SUB Exec_PRINT
   DEF Result AS DOUBLE
   DEF mylen AS INT
   DEF spaces AS INT
   DEF lastdelim AS STRING
   DEF TempStr AS STRING

   mylen=0
DO
   GetToken()
   IF (Tok=SB_EOL) | (Tok=SB_FINISHED)
       PRINT
       RETURN
   ENDIF

   IF (Token_Type=SB_QUOTE) | (Token_Type=SB_VARISTR)
     PutBack()
     Eval_StrExp TempStr
     PRINT TempStr
     mylen=mylen+LEN(TempStr)
   ELSE  : 'expression
     PutBack()
     eval_exp result
     GetToken()
     TempStr=STR$(Result)
     PRINT TempStr
     mylen=mylen+LEN(TempStr)
   ENDIF

   lastdelim=token

   IF token=","
      spaces=SB_TABSTOP-(mylen MOD SB_TABSTOP)
      mylen=mylen+ spaces
      PRINT SPACE$(spaces);
    ELSE
token=";"
      mylen=mylen+ 1
      PRINT " ";
    ELSE(tok<>SB_EOL) | (tok <> SB_FINISHED)
      SError(SB_SERROR)
   ENDIF
'------------------------------------------------------------------
    UNTIL (token=",") | (token=";")

IF (tok=SB_EOL) | (tok=SB_FINISHED)
IF (lastdelim <> ";") & (lastdelim <> ",") THEN PRINT
ELSE
SError(SB_SERROR)
ENDIF
ENDWHILE
RETURN
'-------------------------------------------------------------------
SUB Exec_GOTO
   DEF NewProgPtr AS INT
   GetToken()
   NewProgPtr=FindLabel(Token)

   IF NewProgPtr=0
      Serror(SB_UNDEF_LAB)
     ELSE
      ProgPtr=NewProgPtr
   ENDIF
RETURN
'-----------------------------
SUB Exec_GOSUB
   DEF Location AS INT

   GetToken()
   Location = FindLabel(Token)
   IF Location=0
      Serror(SB_UNDEF_LAB)
    ELSE
      gPush(ProgPtr)
      ProgPtr=Location
   ENDIF
RETURN
'---------------------------------
SUB Exec_RETURN
   ProgPtr=gPop
   PRINT "the return is",ProgPtr
RETURN
'----------------------------------
SUB gPush(Location AS INT)

   'INCR gtos
   IF gtos=SB_SUB_NEST
      Serror(SB_TOO_MNY_GOSUB)
   ELSE
      gStack(gtos)=Location
   ENDIF

RETURN

SUB FUNCTION_gPop() AS INT

   IF gtos=0
      Serror(%SB_RET_WO_GOSUB)
   ELSE
      FUNCTION=gStack(gtos)
      DECR gtos
   ENDIF
RETURN
'--------------------------------------------
SUB Exec_FOR
   DEF i AS FOR_STACK_TYPE
   DEF Result AS DOUBLE
'----------------------
   GetToken()
   IF RIGHT$(Token,1)="$"
      Serror(SB_Serror)
      RETURN
   ENDIF

   IF isAlpha(Token)=0
      Serror(SB_NOT_VAR)
      RETURN
   ELSE
      i.var=ASC(UCASE$(MID$(Token,1,1)))-64
   ENDIF
'-----------
   GetToken()
   IF Token <> "="
      Serror(SB_EQUAL_EXP)
      RETURN
   ENDIF

   eval_exp Result
   Variables(i.var)=INT(Result)
'------------
   GetToken()
   IF Token <> "TO"
      Serror(SB_TO_EXP)
      RETURN
   ENDIF

   eval_exp Result
   i.Target=INT(Result)

   IF Result >= Variables(i.var)
     i.location=ProgPtr
     fpush i
    ELSE
      WHILE tok <> SB_NEXT
        GetToken()
      ENDWHILE
   ENDIF

RETURN

SUB Exec_NEXT
   DEF i AS FOR_STACK_TYPE
   DEF Result AS DOUBLE
   DEF counter AS INT

   fpop i
   Variables(i.var)=Variables(i.var)+1
   IF Variables(i.var) > i.target
        RETURN
      ELSE
        fpush i
        ProgPtr=i.Location
   ENDIF
RETURN

SUB Exec_FORMAT
   GetToken()
   IF Token_Type <> SB_QUOTE
       Serror(SB_STR_EXP)
    ELSE
       gSB_Format=Token
   ENDIF

RETURN

SUB Exec_IF
  DEF x AS DOUBLE

  Eval_Exp x

  IF x=-1
    GetToken()
    IF Tok <> SB_THEN THEN Serror(SB_THEN)
   ELSE
     FindEOL()
  ENDIF
RETURN

SUB Exec_INPUT
    DEF s AS STRING
    DEF i AS INT

    GetToken()
    IF Token_Type=SB_QUOTE
        PRINT Token + "  ";
        GetToken()
        IF Token <> "," : Serror(SB_SError) : RETURN : ENDIF
        GetToken()
      ELSE
         PRINT "?  "
    ENDIF

    i=ASC(UCASE$(MID$(Token,1,1)))-64
    INPUT "", s

    IF Token_Type=SB_VARIABLE
       Variables(i)=VAL(s)
      ELSE
       VarStrings[i]=s
    ENDIF
RETURN

SUB fPush(i AS FOR_STACK_TYPE)
   IF ftos > SB_FOR_NEST
       Serror(%SB_TOO_MNY_FOR)
     ELSE
        fStack(ftos)=i
        INCR ftos
   ENDIF
RETURN

SUB fPop(i AS FOR_STACK_TYPE)
   DECR ftos
   IF ftos < 0
       Serror(SB_NEXT_WO_FOR)
     ELSE
       i=fStack(ftos)
   ENDIF
RETURN

------------------------------------------------------


'Example for Small Basic  - by Jim Klutho
'PRINT "This is my first program"
'INPUT "Input your Name",A$
'PRINT
'PRINT "Hello "+A$
'j=56.4567890
'c$=j
'PRINT "Number to 2 Decimals (Default) ",c$
'Format "0.0000"    'Change the decimals
'c$=j
'PRINT
'PRINT "Number Changed to 4 Decimals ",c$
'INPUT "Input a number from 1 to 3",mynumber
'IF mynumber > 2 THEN PRINT "Greater than 2"
'IF mynumber < 2 THEN PRINT "Less than 2"
'IF mynumber = 2 THEN GOTO theend
'FOR x= 1 TO 5
'   PRINT "Test  ",x
'NEXT
'PRINT 3^3.45/6+2
'theend:
'END

[aurelCB]

OK GWS you right might be very confusinig,no problem.

[aurelCB]

I dont know that James Klutho is present on IWind forum.
So ,James ,is there a chance that you convert your basic interpreter to Creative Basic or maby to
Emergance Basic ,that would be great
regards
zlatko

[James Klutho]

I am afraid that I have no time no to port Small Basic to Ebasic or Creative Basic.  I do very little programming in Ebasic at this time but would love to find time to use the language more.  A note (if I remember right), I think it may be important that parameters get passed by reference in the Eval_Exp recursive routines.  I have not looked at this code in years but you might make a mental note of that.  I can't remember what the default is in Creative Basic.  In PowerBasic the default is by reference.