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:
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
SELECT Token_Type
CASE 0
messagebox 0, "0", ""
CASE 1
CASE 2
messagebox 0, "1 or 2", ""
ENDSELECT
Aha i see now ::)
Is same thing with DO WHILE LOOP i mean replace with WHILE / ENDWHILE.
OK I try and thanks sapero :)
Or possibly use the SELECT TRUE - ENDSELECT format:
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
Thanks GWS i try also your option.
Onother thing is this part of code:
$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
----------------------
And here is my unfinished attempt.UF looks complicated...
'$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
OK GWS you right might be very confusinig,no problem. :)
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 :)
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.