include lexi.e
constant TRUE=1 , FALSE = 0
sequence termtab={},partab={},stacktab={}
constant opcode={"EXIT","LIT","PUNC","TEXT","NUM","TERM","BRK","REP","CALL","RTE","RET","BRE","BRF","BRS"}
integer pc=1,opc,suc,nbr
constant P_CODE=1,P_VALUE=2,P_TEXT=3
sequence P_result={0,0,0}
sequence opexec={}
constant ident={"ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"}
constant num ={"0123456789","0123456789"}
constant punctuation = {"?/()#$*-+:=<>&{}[]@!,;'.^\"",{}}
constant terminals={ident,num,punctuation}
constant IDENT=1,NUMBER=2,PUNCT=3
function readf()
sequence result={}, dec
sequence terminals_read=terminals&{"\n"}
L_in(terminals_read)
while L_result[L_INDEX]!=4 do
if L_result[L_INDEX]=1 then result=append(result,L_result[L_SEARCH])
elsif L_result[L_INDEX]=2 then dec =value(L_result[L_SEARCH])
result=append(result,dec[2])
elsif L_result[L_INDEX]=3 then result=append(result,L_result[L_SEARCH])
elsif L_result[L_INDEX]<0 then result = -1 exit
else L_error("Onbekend teken")
end if
L_in(terminals_read)
end while
return result
end function
procedure P_load(integer file)
sequence num_term,result
if not L_init(file) then puts(1,"syntax File not there\n") abort(1) end if
L_any(" ")
num_term=readf()
printf(1,"Terminal Table (length=%i)\n",num_term)
for i=1 to num_term[1] do
result=readf()
termtab=append(termtab,result[1])
end for
puts(1,"Program code ")
result=readf()
while sequence(result) do
partab&=result[1..2]
result=readf()
end while
printf(1,"(length=%i)\n",{length(partab)})
if L_end()
then puts(1,"End failed , stil work to do\n")
else puts(1,"End successfull\n")
end if
close(file)
end procedure
procedure P_dias()
while pc<=length(partab) do
opc=partab[pc]
printf(1,"%4d %6s ",{pc,opcode[opc+1]})
pc+=1
if opc=5 then
printf(1,"%10s S(%d)F(%d)\n",{termtab[partab[pc]],partab[pc+1],partab[pc+2]})
pc+=2
elsif opc=8 then
printf(1,"%10d S(%d)F(%d)\n",{partab[pc],partab[pc+1],partab[pc+2]})
pc+=2
else
printf(1,"%10d\n",{partab[pc]})
end if
pc+=1
end while
end procedure
function EXIT()
P_result[P_VALUE]=partab[pc]
P_result[P_CODE] =0
pc+=1
return FALSE
end function
function LIT()
P_result[P_VALUE]=partab[pc]
P_result[P_CODE] =1
pc+=1
return FALSE
end function
function PUNC()
if PUNCT = L_result[L_INDEX]
then suc = TRUE
P_result[P_TEXT]=L_result[L_SEARCH]
L_in(terminals)
pc+=1
else
suc = FALSE
pc = partab[pc]
end if
return TRUE
end function
function TEXT()
if IDENT = L_result[L_INDEX]
then suc = TRUE
P_result[P_TEXT]=L_result[L_SEARCH]
L_in(terminals)
pc+=1
else
suc = FALSE
pc = partab[pc]
end if
return TRUE
end function
function NUM()
if NUMBER = L_result[L_INDEX]
then suc = TRUE
P_result[P_TEXT]=L_result[L_SEARCH]
P_result[P_VALUE]=value(L_result[L_SEARCH])
P_result[P_VALUE]=P_result[P_VALUE][2]
L_in(terminals)
pc+=1
else
suc = FALSE
pc = partab[pc]
end if
return TRUE
end function
function TERM()
if termtab[partab[pc]] = L_result[L_SEARCH]
then suc = TRUE
P_result[P_TEXT]=L_result[L_SEARCH]
if nbr then L_in(terminals) end if
pc=partab[pc+1]
else
suc = FALSE
pc = partab[pc+2]
end if
return TRUE
end function
function BRK()
if nbr
then nbr=FALSE
P_result[P_TEXT]=L_result[L_SEARCH]
pc+=1
else
if suc
then nbr=TRUE
pc=partab[pc]
else L_in(terminals)
P_result[P_TEXT]=L_result[L_SEARCH]
pc+=1
end if
end if
return TRUE
end function
function REP()
if suc
then pc=partab[pc]
else suc=TRUE
pc+=1
end if
return TRUE
end function
function CALL()
stacktab=prepend(stacktab,pc+1)
pc=partab[pc]
return TRUE
end function
function RTE()
suc = TRUE
pc=stacktab[1]
remove(stacktab,1)
pc=partab[pc]
return TRUE
end function
function RET()
pc=stacktab[1]
remove(stacktab,1)
if suc
then pc=partab[pc]
else pc=partab[pc+1]
end if
return TRUE
end function
function BRE()
suc=TRUE
pc=partab[pc]
return TRUE
end function
function BRF()
if suc
then pc+=1
else pc=partab[pc]
end if
return TRUE
end function
function BRS()
if suc
then pc=partab[pc]
else pc+=1
end if
return TRUE
end function
procedure P_init(integer file;pc_start)
if not L_init(file) then puts(1,"No input File there\n") abort(1) end if
for i=1 to length(opcode) do
opexec=append(opexec,routine_id(opcode[i]))
end for
L_any(" \n")
pc=pc_start
suc=TRUE
nbr=TRUE
L_in(terminals)
end procedure
procedure P_get()
opc=partab[pc]+1
pc+=1
while call_func(opexec[opc],{})
do opc = partab[pc] + 1
pc+=1
end while
end procedure
sequence file=open("d:/basic/syntax/in7.sct","r")
P_load(file)
P_dias()
file=open("in7.syn","r")
P_init(file,1)
puts(1,"execute !\n")
P_get()
printf(1,"code=%d value=%d text=%s\n",P_result)
while P_result[P_CODE] !=0 and not(P_result[P_CODE]=1 and P_result[P_VALUE]=1) do
P_get()
printf(1,"code=%d value=%d text=%s\n",P_result)
end while