proc main:
global mode%,lineno%,colno%,line$(255)
local f$(128)
f$="\"
dinit "Translator"
dfile f$,"",0
if dialog=0
stop
endif
translat:(f$,%T,"",addr(mode%),addr(lineno%),addr(colno%),addr(line$),0,0)
endp
rem Traslate OPL source by invoking the
rem system translator.
PROC translat:(file$,target%,readfun$,modeptr%,linoptr%,colptr%,qlinptr%,indata%,dbg%)
busy "translating..."
trans2:(file$,target%,readfun$,modeptr%,linoptr%,colptr%,qlinptr%,indata%,dbg%)
busy off
print "translation compleated"
get
endp
PROC trans2:(file$,target%,readfun$,modeptr%,linoptr%,colptr%,qlinptr%,indata%,dbg%)
rem file$=filename
rem target%= %T->3a or %t->3
rem readfun$ is THE NAME of a user function
rem that takes a line number and buffer
rem address as input and fills the buffer
rem with the raw text of the opl source line
rem and returns the length of the line.
rem its is an integer function defined as
rem readfun%:(lineno%,linebuf%)
rem and is called using "@".
rem It should be optimised to take account
rem of the fact that the translator makes
rem two passes over each procedure in turn.
rem the remaining parameters hold the location
rem of the first error encountered.
rem They should all be addresses of integer
rem variables:
rem modeptr% returns translator mode
rem linoptr% returns error line (from 0)
rem colptr% returns error column (from 0)
rem qlinptr% returns error line text
rem indata% is additional data that can be passed
rem through to the user read function -
rem it will usually be a file handle.
rem dbg% = switch to print diagnostics
rem The error value is returned and should
rem always be checked.
rem init msg handling
local qlinbuf$(255)
local clinbuf% rem line buffer - cstring
local qlinbuf% rem line buffer - qstring
local ptsrc%(3) rem translator source structure.
local ptstat%(4) rem translator status structure.
local pid% rem translator pid%
local msp% rem message block
local msgtype% rem message type
local linelen% rem length of OPL line
local lineno% rem line number
local readfn2$(8) rem function to read opl lines
local data%
global gtrerr%
rem if user has NOT supplied a function to
rem read opl lines use a default function
rem that just reads the filename.
rem @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
rem the following vars. are really static
rem variables for the default read function
global gnxtlin% rem last requested line number
global ghghlin% rem highest requested line no.
global ghghpos& rem highest file position
global ghandle% rem file handle
global goffset& rem calculated file offset
local handle% rem file handle
rem @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
rem onerr exit::
rem @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print "readfun$=<";readfun$;">"
if readfun$<>""
rem use user supplied read function
rem this is useful if the OPL is in memory
rem or you only want to compile selected
rem parts of a file
readfn2$=readfun$
data%=indata% :rem addtional user data
else
rem use built in read function
readfn2$="trrdopl"
rem open text file for random access
gTrErr%=ioopen(handle%,file$,$0220)
if gTrErr%<0 : raise gTrErr% : endif
data%=handle%
endif
if dbg%
print "readfn2$=<";readfn2$;">"
endif
qlinbuf%=addr(qlinbuf$)
clinbuf%=uadd(qlinbuf%,1)
rem initialise SOURCE
ptsrc%(1)=mypid%:
ptsrc%(2)=clinbuf%
ptsrc%(3)=addr(ptstat%())
qlinbuf$=file$
rem initialise message block
if dbg%
print "pminit" : dbgget:
endif
gTrErr%=pminit%:(1,64)
if gTrErr%<0 : raise gTrErr% : endif
if dbg%
print "starting translator" : dbgget:
endif
gTrErr%=startpt%:(target%,addr(ptsrc%()),addr(pid%))
if gTrErr%<0 : raise gTrErr% : endif
if dbg%
print "process started=" ,hex$(pid%): dbgget:
endif
do
rem msg receive with wait
if dbg%
print "begin pmrecw%"
endif
gTrErr% = call($0283,addr(msp%))
if gTrErr%<0 : raise gTrErr% : endif
lineno%=peekw(uadd(msp%,8))
if dbg%
msgtype%=peekw(uadd(msp%,4))
print "RECEIVED-REQ LINENO",lineno%
print "RECEIVED-REQ MSGTYP",msgtype%
endif
rem TODO trap non exixstance of read function
linelen%=@%(readfn2$):(lineno%,clinbuf%,data%)
if linelen%<-1 : raise linelen% : endif
if dbg%
if linelen%<>-1
rem for debugging
pokeb usub(ptsrc%(2),1),linelen%
print "check buf<";peek$(usub(ptsrc%(2),1));">",peekb(usub(ptsrc%(2),1))
endif
endif
REM messFree
if dbg%
print "beg pmfree ",msp%,linelen%
endif
call($0783,msp%,linelen%)
if dbg%
print "done pmfree"
showst%:(ptstat%(1),ptstat%(2),ptstat%(3),ptstat%(4))
endif
dbgget:
until linelen%=-1 or ptstat%(1)<>0
pokew modeptr%,ptstat%(2)
pokew linoptr%,ptstat%(3)
pokew colptr%,ptstat%(4)
if linelen%<>-1
linelen%=@%(readfn2$):(peekw(linoptr%)-1,uadd(qlinptr%,1),data%)
if linelen%<-1 : raise linelen% : endif
pokeb qlinptr%,linelen%
else
poke$ qlinptr%,""
endif
return ptstat%(1)
exit::
if dbg%
print "ABORTING" : dbgget:
kill%:(pid%)
endif
if handle% : ioclose(handle%) : endif
return ERR
ENDP
rem this is the standard function to read
rem the input file.
rem TRanslator ReaD OPL
rem need to find out how to open text file
rem for random access TODO
proc trrdopl%:(reqlnno%,buf%,handle%)
local bytes%
local tmppos&,i&
local tmplin%
rem print "trrdopl: request for line ",reqlnno%
if reqlnno%= gnxtlin%
rem read the next line
bytes%= ioread(handle%,buf%,255)
if bytes%<0 : return -1 : endif
gnxtlin%=gnxtlin%+1
endwh
if 1
print "trrdopl: finished at line ",gnxtlin%,"with",hex$(peekl(buf%))
get
endif
pokeb uadd(buf%,bytes%),0
return bytes%+1
endp
proc showst%:(status%,mode%,lineno%,erroff%)
print "RECIEVED-STATUS stat=",status%,err$(status%)
print "RECIEVED-STATUS trmode=",mode%
print "RECIEVED-STATUS lineno=",lineno%
print "RECIEVED-STATUS err offset=",erroff%
endp
rem init msg handling
proc pminit%:(slots%,size%)
local lerr%
print "begin pminit%"
lerr%=call($0083,$100*size%+slots%)
print "end pminit%=",lerr%
if lerr%<0 : raise lerr% : endif
return lerr%
endp
rem process pid
proc mypid%:
return call($0088)
endp
rem kill process
proc kill%:(pid%)
return call($0D88,pid%)
endp
rem start program translator
proc startpt%:(target%,ptsrc%,pidptr%)
local ax%,bx%,cx%,dx%,si%,di%
local bx$(20)
local i%
local cx$(10)
rem synchronous program execute
ax%=$0100
rem executable
bx$="ROM::SYS$PRGO.IMG"+chr$(0)
bx%=uadd(addr(bx$),1)
rem argument
cx$=chr$(target%)
i%=0
while i%<6
cx$=cx$+chr$(peekb(uadd(ptsrc%,i%)))
i%=i%+1
endwh
cx$=cx$+chr$(1)
cx%=addr(cx$)
print "args=<";cx$;">",len(cx$) : dbgget:
dx%=0
si%=0
di%=pidptr%
if os($87,addr(ax%)) and 1
print "Error in FilExecute",ax%
return ax%
endif
print "PID=",hex$(peekw(pidptr%)) : dbgget:
gTrErr%=call($0688,peekw(pidptr%))
if gTrErr%<0 : return gTrErr% : endif
print "Translator started ok pid=",peekw(pidptr%),hex$(peekw(pidptr%))
return gTrErr%
endp
proc dbgget:
rem print "?"
rem get
endp
|
|
