Commit d7f5781e authored by kollo's avatar kollo

cosmetic corrections to the example programs

cosmetic corrections on example programs
parent a856e92b
......@@ -4,7 +4,7 @@
' This is an example how to produce .o linkabel object files and
' shared object files (.so) under linux (UNIX or MAC-OSX) with X11-Basic:
'
' Do a
' Do a
' xbc -l -c library.bas
' or
' xbc -l -c -virtualm library.bas (for faster code)
......
......@@ -38,9 +38,9 @@ WHILE LEN(PARAM$(i))
ENDIF
INC i
WEND
if (WIN32? or ANDROID?) and (len(inputfile$)=0 or inputfile$="bas2x11basic.bas")
fileselect "Load ANSI basic program","./*.bas","ANSI.bas",inputfile$
endif
IF (WIN32? OR ANDROID?) AND (LEN(inputfile$)=0 OR inputfile$="bas2x11basic.bas")
FILESELECT "Load ANSI basic program","./*.bas","ANSI.bas",inputfile$
ENDIF
IF LEN(inputfile$)
rumpf$=inputfile$
WHILE LEN(rumpf$)
......@@ -55,7 +55,7 @@ IF LEN(inputfile$)
ELSE
@convert
ENDIF
ELSE
ELSE
PRINT f$+": file not recognized: File format not recognized"
ENDIF
ELSE
......@@ -78,10 +78,10 @@ PROCEDURE convert
anzprocs=0
anzline=0
OPEN "O",#2,outputfilename$
! xxx original header:
# PRINT #2,"' bas2x11basic V.1.10 ("+f$+")"
# PRINT #2,"' (c) Markus Hoffmann "+date$+" "+time$
! xxx new suggested header:
' xxx original header:
' PRINT #2,"' bas2x11basic V.1.10 ("+f$+")"
' PRINT #2,"' (c) Markus Hoffmann "+date$+" "+time$
' xxx new suggested header:
PRINT #2,"' "+outputfilename$
PRINT #2,"' ";@iso_time$()
PRINT #2,"' Automatic conversion of "+f$+" to X11-Basic"
......@@ -112,10 +112,10 @@ PROCEDURE convert
PRINT #2,"' ";anzlabel;" labels."
PRINT #2,"' ";anzprocs;" procs."
PRINT #2,"' ----- Start of program -----"
' PASS 2
' PASS 2
PRINT "PASS 2"
pass=2
FOR i=0 TO anzline-1
flag=0
lln=linenr(i)
......@@ -169,10 +169,10 @@ PROCEDURE processline(t$)
RETURN
PROCEDURE processifline(t$)
LOCAL ifauf,a$,b$
' xxx why is this in the original?, it seems debugging code:
' IF pass<>1
' PRINT #2,"' "+t$
' ENDIF
' xxx why is this in the original?, it seems debugging code:
' IF pass<>1
' PRINT #2,"' "+t$
' ENDIF
t$=REPLACE$(t$,", ",",")
WHILE LEN(t$)
WORT_SEP t$,":",1,b$,t$
......@@ -192,34 +192,34 @@ PROCEDURE processifline(t$)
IF UPPER$(b$)="IF"
WORT_SEP a$,"THEN ",1,a$,c$
IF LEN(c$)=0
WORT_SEP a$," ",1,a$,c$
WORT_SEP a$," ",1,a$,c$
ENDIF
IF pass<>1
PRINT #2,"IF "+a$
PRINT #2,"IF "+a$
ENDIF
IF LEN(c$)
WORT_SEP c$,"ELSE ",1,c$,d$
IF c$=STR$(VAL(c$))
WORT_SEP c$,"ELSE ",1,c$,d$
IF c$=STR$(VAL(c$))
@processcommand("GOTO "+c$)
ELSE
ELSE
@processcommand(c$)
ENDIF
IF LEN(d$)
IF pass<>1
PRINT #2,"ELSE"
ENDIF
IF d$=STR$(VAL(d$))
IF LEN(d$)
IF pass<>1
PRINT #2,"ELSE"
ENDIF
IF d$=STR$(VAL(d$))
@processcommand("GOTO "+d$)
ELSE
ELSE
@processcommand(d$)
ENDIF
ENDIF
ENDIF
ifauf=1
ENDIF
ENDIF
ELSE
@processcommand(b$+" "+a$)
ENDIF
ENDIF
WEND
IF ifauf
IF pass<>1
......@@ -238,7 +238,7 @@ PROCEDURE processcommand(b$)
labeling(anzlabel)=VAL(a$)
INC anzlabel
ELSE
PRINT #2,b$;" L";a$+" "+c$
PRINT #2,b$;" L";a$+" "+c$
ENDIF
ELSE IF UPPER$(b$)="GOSUB"
WORT_SEP a$," ",1,a$,c$
......@@ -246,36 +246,36 @@ PROCEDURE processcommand(b$)
procs(anzprocs)=VAL(a$)
INC anzprocs
ELSE
PRINT #2,"@P";a$+" "+c$
PRINT #2,"@P";a$+" "+c$
ENDIF
ELSE IF UPPER$(b$)="IF"
# PRINT #2,"' ERROR: No if here !" ! xxx original
' PRINT #2,"' ERROR: No if here !" ! xxx original
@processifline(b$+" "+a$) ! xxx new
ELSE
IF pass>1
PRINT #2,b$;" ";a$
ENDIF
ENDIF
ENDIF
RETURN
function yyyymmddhhmmss$() ! xxx new, only for debugging
local year$,month$,day$,hour$,minute$,second$
year$=right$(date$,4)
month$=left$(date$,2)
day$=mid$(date$,4,2)
hour$=left$(time$,2)
minute$=mid$(time$,4,2)
second$=right$(time$,2)
return year$+month$+day$+hour$+minute$+second$
endfunction
FUNCTION yyyymmddhhmmss$() ! xxx new, only for debugging
LOCAL year$,month$,day$,hour$,minute$,second$
year$=RIGHT$(date$,4)
month$=LEFT$(date$,2)
day$=MID$(date$,4,2)
hour$=LEFT$(time$,2)
minute$=MID$(time$,4,2)
second$=RIGHT$(time$,2)
RETURN year$+month$+day$+hour$+minute$+second$
ENDFUNCTION
function iso_time$() ! xxx new, just a suggestion
local year$,month$,day$,hour$,minute$,second$
year$=right$(date$,4)
month$=left$(date$,2)
day$=mid$(date$,4,2)
hour$=left$(time$,2)
minute$=mid$(time$,4,2)
second$=right$(time$,2)
return year$+"-"+month$+"-"+day$+" "+hour$+":"+minute$+":"+second$
endfunction
FUNCTION iso_time$() ! xxx new, just a suggestion
LOCAL year$,month$,day$,hour$,minute$,second$
year$=RIGHT$(date$,4)
month$=LEFT$(date$,2)
day$=MID$(date$,4,2)
hour$=LEFT$(time$,2)
minute$=MID$(time$,4,2)
second$=RIGHT$(time$,2)
RETURN year$+"-"+month$+"-"+day$+" "+hour$+":"+minute$+":"+second$
ENDFUNCTION
......@@ -69,19 +69,19 @@ PROCEDURE convert
CLR comcount
CLR comment$
' Leerzeichen vorne und hinten entfernen.
WHILE left$(t$)=" " OR left$(t$)=CHR$(9)
WHILE left$(t$)=" " OR LEFT$(t$)=CHR$(9)
t$=RIGHT$(t$,LEN(t$)-1)
WEND
WHILE right$(t$)=" " OR right$(t$)=CHR$(9)
WHILE right$(t$)=" " OR RIGHT$(t$)=CHR$(9)
t$=LEFT$(t$,LEN(t$)-1)
WEND
IF left$(t$)<>"'" AND left$(t$)<>"#" AND left$(t$)<>"!"
IF left$(t$)<>"'" AND LEFT$(t$)<>"#" AND LEFT$(t$)<>"!"
' Nach Kommentaren hinter der Zeile suchen.
SPLIT t$,"!",1,w1$,w2$ ! Hier ist ein Kommentar hinter der Zeile
IF len(w2$)
' Zaehle die Leerzeichen vor dem Kommentar
t$=w1$
WHILE right$(t$)=" " OR right$(t$)=CHR$(9)
WHILE right$(t$)=" " OR RIGHT$(t$)=CHR$(9)
IF right$(t$)=CHR$(9)
ADD comcount,7
ENDIF
......@@ -95,16 +95,16 @@ PROCEDURE convert
@lineout(t$) ! Kommentar rausschreiben
ENDIF
IF len(t$)
IF left$(t$)="#" OR left$(t$)="'" OR left$(t$)="!"
IF left$(t$)="#" OR LEFT$(t$)="'" OR LEFT$(t$)="!"
ELSE
IF left$(t$)="&" OR left$(t$)="@" OR left$(t$)="~"
IF left$(t$)="&" OR LEFT$(t$)="@" OR LEFT$(t$)="~"
@lineout(t$)
ELSE
SPLIT t$," ",TRUE,a$,t$
IF len(t$) AND left$(t$)="="
IF len(t$) AND LEFT$(t$)="="
a$=a$+t$
ENDIF
IF upper$(a$)="REM" OR upper$(a$)="DATA"
IF upper$(a$)="REM" OR UPPER$(a$)="DATA"
@lineout(upper$(a$)+" "+t$)
ELSE
FOR i=0 TO DIM?(levelin$())-1
......@@ -119,11 +119,11 @@ PROCEDURE convert
BREAK
ENDIF
NEXT i
IF upper$(a$)="RETURN" AND len(t$)
IF upper$(a$)="RETURN" AND LEN(t$)
INC level
ENDIF
IF len(t$)=0
IF INSTR(a$,"=") OR right$(a$)=":"
IF INSTR(a$,"=") OR RIGHT$(a$)=":"
@lineout(@rep$(a$))
ELSE
@lineout(UPPER$(a$))
......
......@@ -22,7 +22,7 @@ OPEN "I",#1,inputfile$
WHILE NOT eof(#1)
LINEINPUT #1,t$
t$=TRIM$(t$)
if LEN(t$)
IF LEN(t$)
iz$(anziz)=t$
INC anziz
ENDIF
......@@ -51,15 +51,15 @@ WHILE count<anziz
ENDIF
SPLIT t$," ",1,typ$,t$
IF UPPER$(typ$)="TREE"
IF t$="{"
@dotree(name$)
ENDIF
IF t$="{"
@dotree(name$)
ENDIF
ELSE IF UPPER$(typ$)="FREESTR"
@dofreestr(t$)
ELSE IF UPPER$(typ$)="RSC"
IF t$="{"
@dorsc(name$)
ENDIF
IF t$="{"
@dorsc(name$)
ENDIF
ELSE
DEC count
@dotree("FREETREE_"+name$)
......@@ -103,15 +103,15 @@ PROCEDURE dotree(n$)
ENDIF
PRINT "PROCEDURE formular"+STR$(anztree)
PRINT " LOCAL ret,x,y,w,h"
~@doit2(-1)
' while count<anziz
' t$=iz$(count)
' inc count
' exit if t$="}"
' ~@doit2(-1)
' print t$
' wend
@addtree(aobj,anzobj-1)
~@doit2(-1)
' while count<anziz
' t$=iz$(count)
' inc count
' exit if t$="}"
' ~@doit2(-1)
' print t$
' wend
@addtree(aobj,anzobj-1)
PRINT "RETURN"
INC anztree
RETURN
......@@ -130,14 +130,14 @@ PROCEDURE dofreestr(b$)
LOCAL text$
text$=@getval$(b$,"STRING")
IF LEFT$(text$)=CHR$(34)
text$=DECLOSE$(text$)
text$=DECLOSE$(text$)
ENDIF
fSTR$(anzfreestring)=text$
INC anzfreestring
RETURN
FUNCTION doit2(parent)
LOCAL t$,klammer,idx,typ$,label$,obnext,obtail,obhead,parameter$
' print "'# DOIT2: ",parent,count
' print "'# DOIT2: ",parent,count
idx=-1
WHILE count<anziz
t$=iz$(count)
......@@ -149,7 +149,7 @@ FUNCTION doit2(parent)
idx=anzobj
INC anzobj
IF RIGHT$(t$)="{"
klammer=1
klammer=1
t$=TRIM$(LEFT$(t$,LEN(t$)-1))
ELSE
klammer=0
......@@ -167,12 +167,12 @@ FUNCTION doit2(parent)
IF klammer=1
obhead=anzobj
obtail=@doit2(idx)
IF obtail=-1
obhead=-1
ENDIF
IF obtail=-1
obhead=-1
ENDIF
ELSE
obtail=-1
obhead=-1
obhead=-1
ENDIF
IF iz$(count)="}" OR count=anziz
obnext=parent
......@@ -185,7 +185,7 @@ FUNCTION doit2(parent)
@doobj(idx,obnext,obhead,obtail,typ$,t$)
ENDIF
WEND
' print "'# END DOIT2: ",parent,count
' print "'# END DOIT2: ",parent,count
RETURN idx
ENDFUNC
......@@ -195,35 +195,35 @@ FUNCTION doit(par1,par2,countee)
t$=iz$(countee)
PRINT "# DOIT ",par1,par2,t$
IF RIGHT$(t$)="{"
klammer=1
klammer=1
t$=TRIM$(LEFT$(t$,LEN(t$)-1))
ELSE
klammer=0
ENDIF
SPLIT t$,":",1,label$,t$
if LEN(t$)
else
IF LEN(t$)
ELSE
t$=label$
label$=""
ENDIF
SPLIT t$,"(",1,typ$,t$
typ$=TRIM$(typ$)
if RIGHT$(t$)=")"
IF RIGHT$(t$)=")"
t$=LEFT$(t$,LEN(t$)-1)
endif
ENDIF
idx=anzobj
INC anzobj
obhead=anzobj
parameter$=t$
IF klammer=1
ss=@suchende(countee+1,idx)
ss=@suchende(countee+1,idx)
obtail=anzobj-1
ELSE
obhead=-1
obtail=-1
obtail=-1
ENDIF
IF par1=1
obnext=par2
ELSE
......@@ -267,7 +267,7 @@ PROCEDURE doobj(idx,obnext,obhead,obtail,a$,b$)
IF UPPER$(a$)="FREESTR"
text$=@getval$(b$,"STRING")
IF LEFT$(text$)=CHR$(34)
text$=DECLOSE$(text$)
text$=DECLOSE$(text$)
ENDIF
fSTR$(anzfreestring)=text$
INC anzfreestring
......@@ -296,42 +296,42 @@ PROCEDURE doobj(idx,obnext,obhead,obtail,a$,b$)
bgcol=VAL(@getval$(b$,"BGCOL"))
pattern=VAL(@getval$(b$,"PATTERN"))
textmode=VAL(@getval$(b$,"TEXTMODE"))
obspec=cvl(chr$(16*(bgcol and 15)+2*(pattern and 7)+(textmode and 1))+chr$((framecol and 15)+16*(textcol and 15))+chr$(frame)+chr$(char))
print "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
print "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(";obspec;")";
ELSE IF UPPER$(a$)="TEXT" OR UPPER$(a$)="FTEXT" OR UPPER$(a$)="BOXTEXT"
obspec=cvl(CHR$(16*(bgcol AND 15)+2*(pattern AND 7)+(textmode AND 1))+CHR$((framecol AND 15)+16*(textcol AND 15))+CHR$(frame)+CHR$(char))
PRINT "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
PRINT "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(";obspec;")";
ELSE IF UPPER$(a$)="TEXT" OR UPPER$(a$)="FTEXT" OR UPPER$(a$)="BOXTEXT"
obtype=21*abs(UPPER$(a$)="TEXT")+29*abs(UPPER$(a$)="FTEXT")+22*abs(UPPER$(a$)="BOXTEXT")
text$=@getval$(b$,"TEXT")
if left$(text$)=chr$(34)
text$=DECLOSE$(text$)
endif
IF left$(text$)=CHR$(34)
text$=DECLOSE$(text$)
ENDIF
ptmp$=@getval$(b$,"PTMP")
if left$(ptmp$)=chr$(34)
ptmp$=DECLOSE$(ptmp$)
endif
IF left$(ptmp$)=CHR$(34)
ptmp$=DECLOSE$(ptmp$)
ENDIF
pvalid$=@getval$(b$,"PVALID")
if left$(pvalid$)=chr$(34)
pvalid$=DECLOSE$(pvalid$)
endif
IF left$(pvalid$)=CHR$(34)
pvalid$=DECLOSE$(pvalid$)
ENDIF
font=VAL(@getval$(b$,"FONT"))
if @getval$(b$,"FONT")=""
IF @getval$(b$,"FONT")=""
font=3
endif
ENDIF
just=VAL(@getval$(b$,"JUST"))
color=VAL(@getval$(b$,"COLOR"))
border=VAL(@getval$(b$,"BORDER"))
@addtedinfo(text$,ptmp$,pvalid$,font,just,color,border)
print "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
print "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(varptr(tedinfo";anztedinfo-1;"$))";
PRINT "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
PRINT "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(varptr(tedinfo";anztedinfo-1;"$))";
ELSE IF UPPER$(a$)="STRING" OR UPPER$(a$)="TITLE" OR UPPER$(a$)="BUTTON"
obtype=28*abs(UPPER$(a$)="STRING")+32*abs(UPPER$(a$)="TITLE")+26*abs(UPPER$(a$)="BUTTON")
text$=@getval$(b$,"TEXT")
if left$(text$)=chr$(34)
text$=DECLOSE$(text$)
endif
IF left$(text$)=CHR$(34)
text$=DECLOSE$(text$)
ENDIF
@addstring(text$)
print "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
print "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(varptr(string";anzstring-1;"$))";
PRINT "obj"+STR$(idx)+"$=mki$(";obnext;")+mki$(";obhead;")+mki$(";obtail;")";
PRINT "+mki$(";obtype;")+mki$(";obflags;")+mki$(";obstate;")+mkl$(varptr(string";anzstring-1;"$))";
ELSE IF UPPER$(a$)="IMAGE"
data$=@getval$(b$,"DATA")
iw=VAL(@getval$(b$,"IW"))
......@@ -358,7 +358,7 @@ PROCEDURE doobj(idx,obnext,obhead,obtail,a$,b$)
wtext=VAL(@getval$(b$,"WTEXT"))
htext=VAL(@getval$(b$,"HTEXT"))
IF LEFT$(text$)=CHR$(34)
text$=DECLOSE$(text$)
text$=DECLOSE$(text$)
ENDIF
@addiconblk(data$,mask$,text$,char,xchar,ychar,xicon,yicon,wicon,hicon,xtext,ytext,wtext,htext)
......@@ -383,7 +383,7 @@ PROCEDURE addtree(aob,oobj)
PRINT SPACE$(spaces*2)+t$
t$="tree"+STR$(anztree)+"$=tree"+STR$(anztree)+"$+"
ELSE
t$=t$+"+"
t$=t$+"+"
ENDIF
ENDIF
NEXT i
......@@ -450,14 +450,14 @@ FUNCTION doflags(t$)
LOCAL ret,a$
ret=0
IF LEFT$(t$)="("
t$=RIGHT$(t$,LEN(t$)-1)
t$=RIGHT$(t$,LEN(t$)-1)
ENDIF
IF RIGHT$(t$)=")"
t$=LEFT$(t$,LEN(t$)-1)
t$=LEFT$(t$,LEN(t$)-1)
ENDIF
SPLIT t$,"+",1,a$,t$
WHILE LEN(a$)
if a$="NONE"
IF a$="NONE"
ELSE IF a$="SELECTABLE"
ret=ret OR 1
ELSE IF a$="DEFAULT"
......@@ -487,10 +487,10 @@ FUNCTION dostate(t$)
LOCAL ret,a$
ret=0
IF LEFT$(t$)="("
t$=RIGHT$(t$,LEN(t$)-1)
t$=RIGHT$(t$,LEN(t$)-1)
ENDIF
IF RIGHT$(t$)=")"
t$=LEFT$(t$,LEN(t$)-1)
t$=LEFT$(t$,LEN(t$)-1)
ENDIF
SPLIT t$,"+",1,a$,t$
WHILE LEN(a$)
......
......@@ -28,7 +28,7 @@ WHILE LEN(PARAM$(i))
outputfilename$=PARAM$(i)
ENDIF
ELSE
collect$=collect$+PARAM$(i)+" "
collect$=collect$+PARAM$(i)+" "
ENDIF
ELSE
inputfile$=PARAM$(i)
......@@ -77,11 +77,11 @@ PROCEDURE doit(f$)
l=LEN(g$)
PRINT "' output of inline.bas for X11-Basic "+date$
IF comp=1
PRINT "' ";f$;" ";ll;" Bytes. (compressed: ";l;" Bytes, ";int(l/ll*100);"%)"
PRINT "' ";f$;" ";ll;" Bytes. (compressed: ";l;" Bytes, ";INT(l/ll*100);"%)"
ELSE
PRINT "' ";f$;" ";l;" Bytes."
ENDIF
SPLIT f$,".",0,n$,b$
SPLIT f$,".",0,n$,b$
IF RINSTR(n$,"/")
n$=RIGHT$(n$,LEN(n$)-RINSTR(n$,"/"))
ENDIF
......@@ -91,8 +91,8 @@ PROCEDURE doit(f$)
pointer=0
WHILE l>=3
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0xfc)/4)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0x3)*16+(PEEK(VARPTR(g$)+pointer*3+1) and 0xf0)/16)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf)*4+(PEEK(VARPTR(g$)+pointer*3+2) and 0xc0)/64)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0x3)*16+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf0)/16)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf)*4+(PEEK(VARPTR(g$)+pointer*3+2) AND 0xc0)/64)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+2) AND 0x3f))
SUB l,3
INC pointer
......@@ -100,24 +100,24 @@ PROCEDURE doit(f$)
PRINT n$+"$="+n$+"$+"+ENCLOSE$(t$)
t$=""
ENDIF
WEND
WEND
IF l ! handle the last 1 or 2 bytes
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0xfc)/4)
IF l=1
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0x3)*16)
ELSE
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0x3)*16+(PEEK(VARPTR(g$)+pointer*3+1) and 0xf0)/16)
ELSE
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3) AND 0x3)*16+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf0)/16)
IF l=2
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf)*4)
ELSE
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf)*4+(PEEK(VARPTR(g$)+pointer*3+2) and 0xc0)/64)
ELSE
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+1) AND 0xf)*4+(PEEK(VARPTR(g$)+pointer*3+2) AND 0xc0)/64)
t$=t$+CHR$(36+(PEEK(VARPTR(g$)+pointer*3+2) AND 0x3f))
ENDIF
ENDIF
ENDIF
if len(t$)
ENDIF
IF len(t$)
PRINT n$+"$="+n$+"$+"+ENCLOSE$(t$)
endif
ENDIF
IF comp
PRINT n$+"_"+b$+"$=UNCOMPRESS$(INLINE$("+n$+"$))"
ELSE
......
......@@ -23,35 +23,35 @@ IF NOT EXIST("xbvm.prg")
QUIT
ENDIF
WHILE LEN(param$(i))
IF LEFT$(param$(i))="-"
IF param$(i)="--help" OR param$(i)="-h"
WHILE LEN(PARAM$(i))
IF LEFT$(PARAM$(i))="-"
IF param$(i)="--help" OR PARAM$(i)="-h"
@intro
@using
ELSE IF param$(i)="--version"
ELSE IF PARAM$(i)="--version"
@intro
QUIT
ELSE IF param$(i)="--dynamic"
ELSE IF PARAM$(i)="--dynamic"
dyn=TRUE
ELSE IF param$(i)="-b"
ELSE IF PARAM$(i)="-b"
precomponly=TRUE
compileonly=TRUE
ELSE IF param$(i)="-c"
ELSE IF PARAM$(i)="-c"
compileonly=TRUE
ELSE IF param$(i)="-l"
ELSE IF PARAM$(i)="-l"
lflag=TRUE
ELSE IF param$(i)="-q"
ELSE IF PARAM$(i)="-q"
qflag=TRUE
ELSE IF param$(i)="-o"
ELSE IF PARAM$(i)="-o"
INC i
IF LEN(param$(i))
outputfilename$=param$(i)
IF LEN(PARAM$(i))
outputfilename$=PARAM$(i)
ENDIF
ELSE
collect$=collect$+param$(i)+" "
collect$=collect$+PARAM$(i)+" "
ENDIF
ELSE
inputfile$=param$(i)
inputfile$=PARAM$(i)
IF NOT EXIST(inputfile$)
PRINT "xbc: "+inputfile$+": file or path not found"
CLR inputfile$
......@@ -85,7 +85,7 @@ IF LEN(inputfile$)
t$=t$+"3. only produce the bytecode,|"
t$=t$+"4. pseudo compile, then use tcc.|"
t$=t$+"|Option 1 is recommended.|For options 2 and 4 tcc needs to be installed.|"
t$=t$+"][ 1 | 2 | 3 | 4 |CANCEL]"
IF qflag=0
COLOR weiss,schwarz
......@@ -103,7 +103,7 @@ IF LEN(inputfile$)
~FORM_ALERT(1,"[3][xbc: ERROR: xb2c.ttp not found.][CANCEL]")
PRINT "xbc: ERROR: xb2c.ttp not found."
QUIT
ENDIF
ENDIF
SYSTEM "xb2c "+bfile$+" -o "+cfile$
IF EXIST(cfile$)
IF qflag=0
......@@ -122,7 +122,7 @@ IF LEN(inputfile$)
ELSE
QUIT
ENDIF
' Now compilation should have been successful
' Now compilation should have been successful
IF qflag=0
IF EXIST(outputfilename$)
a=FORM_ALERT(1,"[0][done.| |The program was stored under:|"+outputfilename$+".|Do you want to run it?][RUN|QUIT]")
......@@ -134,7 +134,7 @@ IF LEN(inputfile$)
ENDIF
ENDIF
ELSE
~FORM_ALERT(1,"[3][Ups...|compilation was not successful!][ OH ]")
~FORM_ALERT(1,"[3][Ups...|compilation was not successful!][ OH ]")
ENDIF
ENDIF
ELSE
......@@ -191,7 +191,6 @@ PROCEDURE make_bytecode(file$,bfile$)
ENDIF
RETURN
PROCEDURE packvm(bfile$)
LOCAL t$,l,lb,p,u$
OPEN "I",#1,"xbvm.prg"
......@@ -205,15 +204,15 @@ PROCEDURE packvm(bfile$)
PRINT p
MEMDUMP VARPTR(t$)+p-1,16
IF p=0
IF qflag=0
~FORM_ALERT(1,"[3][xbc: FATAL ERROR: something is wrong.][CANCEL]")
ENDIF
PRINT "xbc: FATAL ERROR: something is wrong."
QUIT
IF qflag=0
~FORM_ALERT(1,"[3][xbc: FATAL ERROR: something is wrong.][CANCEL]")
ENDIF
PRINT "xbc: FATAL ERROR: something is wrong."
QUIT
ENDIF
PRINT "poking"
u$=using$(LEN(t$),"#######")
print u$,p
PRINT u$,p
FOR i=0 TO LEN(u$)-1
POKE VARPTR(t$)+p-1+i,PEEK(VARPTR(u$)+i)
NEXT i
......@@ -227,11 +226,11 @@ PROCEDURE packvm(bfile$)
t$=t$+SPACE$(lb)
BLOAD bfile$,VARPTR(t$)+l
MEMDUMP VARPTR(t$)+l,lb
oagain:
if qflag=0
default$=right$(inputfile$,len(inputfile$)-rinstr(inputfile$,"/"))
default$=right$(default$,len(default$)-rinstr(default$,"\"))
default$=replace$(default$,".bas",".prg")
oagain:
IF qflag=0
default$=RIGHT$(inputfile$,LEN(inputfile$)-rinstr(inputfile$,"/"))
default$=RIGHT$(default$,LEN(default$)-rinstr(default$,"\"))
default$=REPLACE$(default$,".bas",".prg")
FILESELECT "select filename to write to","./*.prg",default$,outputfilename$
IF LEN(outputfilename$)=0
QUIT
......@@ -283,18 +282,18 @@ PROCEDURE pseudo
IF LEFT$(t$)<>"'"
SPLIT t$," !",1,t$,b$
IF LEFT$(t$,6)="PRINT "
t$="? "+right$(t$,len(t$)-6)
t$="? "+RIGHT$(t$,LEN(t$)-6)
ELSE IF LEFT$(t$,6)="GOSUB "
t$="@"+right$(t$,len(t$)-6)
t$="@"+RIGHT$(t$,LEN(t$)-6)
ELSE IF LEFT$(t$,5)="VOID "
t$="~"+right$(t$,len(t$)-5)
t$="~"+RIGHT$(t$,LEN(t$)-5)
ENDIF
t$=REPLACE$(t$,chr$(34),"##AN"+"F##")