(!******************************************************* * Mosel Example Programs * * ====================== * * * * file mdbg.mos * * ````````````` * * Example for the use of the Mosel language * * (use of the Remote Invocation Protocol) * * * * Implements a debugger written in Mosel * * * * (c) 2015 Fair Isaac Corporation * * author: Y. Colombani, 2015 * *******************************************************!) model mdbg uses 'mmjobs','mmsystem' parameters SRC="qsort.mos" end-parameters declarations LINEMASK=16777215 FILESHIFT=-24 EVENT_DBG=32770 MO:Mosel M:Model lineset:range modset:range s_src=record fname:string nbl:integer lines:array(lineset) of text end-record s_msrc=record nbi:integer lndx:array(lineset) of integer src:array(modset) of s_src end-record allmods:range allsrc:dynamic array(allmods) of s_msrc end-declarations forward procedure intcmd(stat:integer) forward procedure cmdprint(m:integer,toprint:text) forward procedure cmdbreak(m:integer,toprint:text) forward procedure cmdstack(m:integer,args:text) forward procedure cmdstat forward procedure cmdfct(m:integer,fct:text) forward procedure cmdinfo(m:integer,args:text) forward procedure cmdlsloc(m:integer,args:text) forward procedure cmdlsattr forward procedure lslib forward function dbgopcode(v:real):integer forward function dbgoparg(v:real):integer forward function loadfile(f:string):s_src forward procedure showlocation(m:integer) forward procedure loadsrc(m:integer) forward procedure lndxlist(m:integer) forward function vers2str(sv:string):string forward function vers2str(v:integer):string forward function str2date(sd:string):string forward function getndx(v:integer):integer forward procedure showtyp(typs:array(range) of string, args:string, ta:textarea) forward procedure showhelp if connect(MO,"")<0 then exit(1) end-if if compile("G",SRC,"tmp:bimfile")<>0 then writeln("Compilation failed") exit(1) end-if nid:=getid(MO) load(MO,M,"rmt:[-1]tmp:bimfile") loadsrc(0) ! switch model to debug mode setcontrol(M,"runmode","1") run(M) ! execution will stop just before 1st statement repeat wait ev:=getnextevent if ev.class=EVENT_DBG then case dbgopcode(ev.value) of 1: do ! submodel starting writeln("model ",dbgoparg(ev.value)," starting") end-do 2: do ! submodel ending writeln("model ",dbgoparg(ev.value)," ending") if exists(allsrc(dbgoparg(ev.value))) then delcell(allsrc(dbgoparg(ev.value))) end-if end-do 3: intcmd(dbgoparg(ev.value)) ! Interruption else writeln("Unexpected DBG event: ",dbgopcode(ev.value),"-",dbgoparg(ev.value)) end-case end-if until ev.class=EVENT_END !********************************** ! Interactive command interpreter !********************************** ! Model flow control is achieved using the 'dbgctrl' parameter that ! can be set using 'setcontrol': ! dbgctrl=B => suspend execution ! dbgctrl=E => terminate execution ! Following can be used only on a suspended model: ! dbgctrl=C => continue ! dbgctrl=N [s] => next statement (on submodel 's') ! dbgctrl=S [s] => step into (on submodel 's') ! dbgctrl=F [s] => continue up to end of routine (on submodel 's') ! dbgctrl=T s lndx => continue up to 'lndx' on submodel 's' ! Other useful parameters: ! flushdso => force unloading of unused modules ! realfmt=string => change format used for displaying reals ! zerotol=real => zero tolerance for real comparison procedure intcmd(stat:integer) declarations l:text RT_OK=0 RT_ENDING=2 RT_BREAK=14 RT_NIFCT=15 end-declarations case stat of RT_OK : showlocation(0) RT_ENDING : writeln("Ending...") RT_BREAK : do writeln("Breakpoint at:"); showlocation(0); end-do RT_NIFCT : do writeln("In NIFct:"); showlocation(0); end-do else write("Stat: ",stat," at:") showlocation(0) end-case repeat write("> "); fflush nbc:=readtextline(l) trim(l,SYS_RIGHT) if nbc<=0 or l="end" then setcontrol(M,"dbgctrl","E") break elif l="cont" then setcontrol(M,"dbgctrl","C") break elif l="next" then setcontrol(M,"dbgctrl","N") break elif l="step" then setcontrol(M,"dbgctrl","S") break elif l="fin" then setcontrol(M,"dbgctrl","F") break elif startswith(l,"to ") then setcontrol(M,"dbgctrl","T 0 "+copytext(l,4,l.size)) break elif startswith(l,"info") then cmdinfo(0,copytext(l,5,l.size)) elif startswith(l,"lsloc") then cmdlsloc(0,copytext(l,6,l.size)) elif l="lsattr" then cmdlsattr elif l="list" then lndxlist(0) elif l="lslib" then lslib elif l="flushdso" then setcontrol(MO,"flushdso","") elif startswith(l,"print ") then cmdprint(0,copytext(l,7,l.size)) elif startswith(l,"break") then cmdbreak(0,copytext(l,6,l.size)) elif startswith(l,"stack") then cmdstack(0,copytext(l,6,l.size)) elif l="status" then cmdstat elif startswith(l,"fct ") then cmdfct(0,copytext(l,4,l.size)) elif l="help" then showhelp else writeln("Unknown command (try 'help')") end-if until false end-procedure !****************** !* Command 'print' !****************** ! Request 'eval' (evaluate an expression): ! mcmd:eval@M[.s] lab:expr lab:expr... ! M: master model ! s: submodel (0<=>master model) ! if 'lab'=='.' => label is expression itself ! expression may be ended with 1 or several data amount limit(s) ! [ maxelt ] : return at most 'maxelt' entries ! [ maxelt skip ] : return at most 'maxelt' entries after skipping 'skip' procedure cmdprint(m:integer,toprint:text) declarations v:text end-declarations trim(toprint) (! setparam("ioctrl",true) initialisations from "rmt:["+nid+"]mcmd:eval-t@1."+m+" v:"+toprint v end-initialisations setparam("ioctrl",false) if getparam("iostatus")=0 then writeln(" ",v) else writeln("Evaluation failed or value cannot be displayed") end-if !) fcopy("rmt:["+nid+"]mcmd:eval-t@1."+m+" :"+toprint,"") end-procedure !****************** !* Command 'break' !****************** ! Request 'dbgbrkp' (get/set/update/delete breakpoint): ! mcmd:dbgbrkp@M[.s] ! mcmd:dbgbrkp@M[.s] lndx ! mcmd:dbgbrkp@M[.s] lndx cond ! M: master model ! s: submodel (0<=>master model) ! no parameter: return list of breakpoints ! lndx: delete breakpoint. if lndx=*: delete all breakpoints ! lndx cond: add or modify breakpoint at lndx (cond='*' <=> no cond) procedure cmdbreak(m:integer,args:text) declarations Rlndx:range lndx:dynamic array(Rlndx) of integer cond:dynamic array(Rlndx) of string end-declarations trim(args) setparam("ioctrl",true) initialisations from "bin:rmt:["+nid+"]mcmd:dbgbrkp@1."+m+" "+args Rlndx lndx cond end-initialisations setparam("ioctrl",false) if getparam("iostatus")=0 then loadsrc(m) forall(b in Rlndx) do l:=bittest(allsrc(m).lndx(lndx(b)),LINEMASK) f:=bitshift(allsrc(m).lndx(lndx(b)),FILESHIFT) write("Break at (",lndx(b),") ",allsrc(m).src(f).fname,":",l) if cond(b)<>"" then writeln(" if ",cond(b)) else writeln end-if end-do else writeln("Failed to set breakpoint") end-if end-procedure !****************** !* Command 'stack' !****************** ! Request 'dbgstlev' (get/set stack level): ! mcmd:dbgstlev@M[.s] ! mcmd:dbgstlev@M[.s] stlev [maxlev] ! M: master model ! s: submodel (0<=>master model) ! stlev=='*' => get current stack level ! stlev>=0 => set stack level ! if 'maxlev' not provided => maxlev=10 procedure cmdstack(m:integer,args:text) declarations Rlndx:range lndx:dynamic array(Rlndx) of integer end-declarations trim(args) setparam("ioctrl",true) initialisations from "bin:rmt:["+nid+"]mcmd:dbgstlev@1."+m+" "+args Rlndx lndx end-initialisations setparam("ioctrl",false) if getparam("iostatus")=0 then loadsrc(m) forall(b in Rlndx) do write(" ",b,": ") i:=lndx(b) if i<0 then writeln("no location information") else l:=bittest(allsrc(m).lndx(i),LINEMASK) f:=bitshift(allsrc(m).lndx(i),FILESHIFT) if l=0 then writeln("in package ",allsrc(m).src(f).fname) else writeln(allsrc(m).src(f).fname,":",l," ",allsrc(m).src(f).lines(l)) end-if end-if end-do else writeln("Failed to get stack trace") end-if end-procedure !*************************************** !* Display status of all running models !*************************************** ! Request 'dbgstat' (status and location): ! mcmd:dbgstat@M ! mcmd:dbgstat@M.s ! M: master model (if no submodel => status of all running models) ! s: submodel (0<=>master model) procedure cmdstat declarations Rid:range id,stat,stlev,lndx:array(Rid) of integer end-declarations initialisations from "bin:rmt:["+nid+"]mcmd:dbgstat@1" Rid id stat stlev lndx end-initialisations forall(j in Rid) do m:=id(j) i:=lndx(j) if stat(j)=2 then writeln("[",m,"] ending") elif stat(j)=15 then writeln("[",m,"] in native function") elif i<0 then writeln("[",m,"] no location information") else loadsrc(m) l:=bittest(allsrc(m).lndx(i),LINEMASK) f:=bitshift(allsrc(m).lndx(i),FILESHIFT) if l=0 then writeln("[",m,"] in package ",allsrc(m).src(f).fname) else writeln("[",m,"] ",allsrc(m).src(f).fname,":",l," ",allsrc(m).src(f).lines(l)) end-if end-if end-do end-procedure !***************** !* Command 'fct' !***************** ! Request 'dbgflndx' (line index of a subroutine): ! mcmd:dbgflndx@M[.s] [fctname|*] ! M: master model ! s: submodel (0<=>master model) ! several line indices are returned if the function is overloaded ! with option 'N', result is sorted by function names ! with option 'L', result is sorted by line indices procedure cmdfct(m:integer,fct:text) declarations Rsign:range sign:array(Rsign) of string lndx:array(Rsign) of integer name:array(Rsign) of string end-declarations setparam("ioctrl",true) initialisations from "bin:rmt:["+nid+"]mcmd:dbgflndx-N@1."+m+fct Rsign sign lndx name end-initialisations setparam("ioctrl",false) trim(fct) if getparam("iostatus")=0 then forall(i in Rsign) writeln(" ",name(i),"(",sign(i),") -> ",lndx(i)) else writeln("Subroutine '",fct,"' not found") end-if end-procedure !****************** !* Command 'info' !****************** ! Request 'info' (model/package/module/Mosel information): ! mcmd:info@M[.s] ! mcmd:info ! mcmd:info modulename ! M: master model ! s: submodel (0<=>master model) ! 1st form is for a loaded model/package ! 2d form returns Mosel information ! 3d form is used for a module (the module is loaded if necessary) procedure cmdinfo(m:integer,args:text) declarations fmt:integer hdr:array(Rhdr:range) of string deps:array(Rdeps:range) of string depsvers,depstyp:array(Rdeps) of integer typs:array(Rtyps:range) of string typscod:array(Rtyps) of integer parms,parmsdesc:array(Rparms:range) of string parmsval:array(Rparms) of integer consts:array(Rconsts:range) of string conststyp:array(Rconsts) of integer cstint:array(Rcstint:range) of integer cststr:array(Rcststr:range) of string cstdbl:array(Rcstdbl:range) of real vars:array(Rvars:range) of string varstyp:array(Rvars) of integer arrndx:array(Rarrndx:range) of string fct,fctsign:array(Rfct:range) of string fcttyp:array(Rfct) of integer dtyp:array(Rdtyp:range) of string dtyptyp:array(Rdtyp) of integer recsstart:array(Rrecsstart:range) of integer recfield:array(Rrecfield:range) of string recftype:array(Rrecfield) of integer iodrv,iodrvinfo:array(Riodrv:range) of string annsident:array(Rannsident:range) of string annsstart:array(Rannsstart:range) of integer anns: array(Ranns:range) of string ! Format decoding SYMB_FMT_MOD=0 SYMB_FMT_PKG=1 SYMB_FMT_DSO=2 SYMB_FMT_MOS=3 SYMB_MSK_FMT=3 ! Format options (for models/packages) SYMB_FMT_CRYPTED=4 SYMB_FMT_SIGNED=8 SYMB_FMT_VERIFIED=16 SYMB_FMT_UNVERIFIED=32 ! Basic types SYMB_TYP_NOT=0 SYMB_TYP_INT=1 SYMB_TYP_REAL=2 SYMB_TYP_STRING=3 SYMB_TYP_BOOL=4 SYMB_TYP_MPVAR=5 SYMB_TYP_LINCTR=6 ! Masks for type decoding SYMB_MSK_TYP=4095 ! 0xFFF 12 bits [ 0-11] SYMB_MSK_STR=61440 ! 0xF000 4 bits [12-15] SYMB_MSK_OPT=983040 ! 0xF0000 4 bits [16-19] SYMB_MSK_NDX=-1048576 ! 0xFFF00000 12 bits [20-31] ! Shift length for type decoding SYMB_SHT_STR=12 SYMB_SHT_OPT=16 SYMB_SHT_NDX=20 ! Entity structure SYMB_STR_SCA=0 ! (0<<SYMB_SHT_STR) SYMB_STR_ARR=4096 SYMB_STR_SET=8192 SYMB_STR_LST=12288 SYMB_STR_REC=16384 SYMB_STR_PROB=20480 SYMB_STR_CSREF=24576 SYMB_STR_UNION=28672 Parameter flags SYMB_OPT_READ=65536 SYMB_OPT_WRITE=131072 tag SYMB_OPT_REQMT=65536 SYMB_OPT_PTR=131072 SYMB_OPT_PRIV=262144 Native type properties SYMB_MTP_CREAT=1 SYMB_MTP_DELET=2 SYMB_MTP_TOSTR=4 SYMB_MTP_FRSTR=8 SYMB_MTP_PRTBL=16 SYMB_MTP_RFCNT=32 SYMB_MTP_COPY=64 SYMB_MTP_APPND=128 SYMB_MTP_ORSET=256 SYMB_MTP_PROB=512 SYMB_MTP_CMP=1024 SYMB_MTP_SHARE=2048 SYMB_MTP_TFBIN=4096 SYMB_MTP_ORD=8192 SYMB_MTP_CONST=16384 ta:textarea end-declarations if args.size=0 then fname:="rmt:[" elif args="*" else +nid+]mcmd:info-t="+args
 end-if
 setparam(" initialisations from fname fmt Rhdr hdr Rdeps deps depsvers depstyp Rtyps typs typscod Rparms parms parmsval parmsdesc Rconsts consts conststyp Rcstint cstint Rcststr cststr Rcstdbl cstdbl Rvars vars varstyp Rarrndx arrndx Rfct fct fctsign fcttyp Rdtyp dtyp dtyptyp Rrecsstart recsstart Rrecfield recfield recftype Riodrv iodrv iodrvinfo Rannsident annsident Rannsstart annsstart Ranns anns end-initialisations getparam("iostatus")=0 Header case of do Model or Package writeln(if(bittest(fmt,SYMB_MSK_FMT)=SYMB_FMT_MOD,"Model ,Package="),
	 				hdr(0)," version=",vers2str(hdr(4)))
	 writeln(" sys.com:=",hdr(1))
	 writeln(" usr.com:=",hdr(2))
	 write(" security:=")
	 if bittest(fmt,SYMB_FMT_CRYPTED+SYMB_FMT_SIGNED)=0 then
	  writeln(">0 then write(" encrypted"); end-if if bittest(fmt,SYMB_FMT_SIGNED)<>0 then write(" signed ",hdr(3)) if bittest(fmt,SYMB_FMT_VERIFIED)<>0 then write(" verified") elif bittest(fmt,SYMB_FMT_UNVERIFIED)<>0 then write(" unverified") else write(" unchecked") end-if end-if writeln end-if if Rdeps.size>0 then j:=0 forall(i in Rdeps) do if depstyp(i)=0 and j=0 then write(" modules:") j:=1 elif depstyp(i)<2 and j<2 then if i>0 then writeln; end-if write(" pkg. req.:") j:=2 elif depstyp(i)>1 and j<3 then if i>0 then writeln; end-if write(" pkg. imp.:") j:=3 end-if write(" ",deps(i)," (",vers2str(depsvers(i)),")") end-do writeln end-if end-do SYMB_FMT_DSO: do ! Module writeln("Module ",hdr(0)," version ",vers2str(hdr(4))," (",hdr(1),")") writeln(" file:",hdr(5)+"/"+hdr(0)+".dso") writeln(" date:",str2date(hdr(6))) writeln(" priority:",hdr(7)) if Rdeps.size>0 then write(" modules:") forall(i in Rdeps) do write(" ",deps(i)) end-do writeln end-if end-do SYMB_FMT_MOS: do ! Mosel core functionality writeln("Mosel ",hdr(7),"-bit version ",vers2str(hdr(4))) writeln(" Link date: ",hdr(2)) writeln(" Libpath: ",hdr(5)) writeln(" dsopath: ",hdr(1)) end-do end-case writeln !------------------- Constants -------- if Rconsts.size>0 then writeln("Constants:") forall(i in Rconsts) do write(" ",consts(i),"=") j:=getndx(conststyp(i))-1 case bittest(conststyp(i),SYMB_MSK_TYP) of SYMB_TYP_INT: write(cstint(j)) SYMB_TYP_REAL: write(cstdbl(j)) SYMB_TYP_STRING: write(cststr(j)) SYMB_TYP_BOOL: write(if(cstint(j)<>0,"true","false")) end-case if bittest(conststyp(i),SYMB_OPT_PRIV)<>0 then writeln(" [priv]") else writeln end-if end-do writeln end-if !------------------- Types ------------ if Rdtyp.size>0 then writeln("Types:") forall(i in Rdtyp) do type:=bittest(dtyptyp(i),SYMB_MSK_TYP) if type=0 then ! dso type write(" ",dtyp(i)," (") flag:=bitshift(dtyptyp(i),-SYMB_SHT_STR) if bittest(flag,SYMB_MTP_PROB)<>0 then write("problem") if bittest(flag,SYMB_MTP_CREAT)<>0 then write(",create"); end-if else if bittest(flag,SYMB_MTP_CREAT)<>0 then write("create"); end-if end-if if bittest(flag,SYMB_MTP_DELET)<>0 then write(",delete"); end-if if bittest(flag,SYMB_MTP_RFCNT)<>0 then write(",refcnt"); end-if if bittest(flag,SYMB_MTP_TOSTR)<>0 then write(",tostring"); end-if if bittest(flag,SYMB_MTP_PRTBL)<>0 then write("+"); end-if if bittest(flag,SYMB_MTP_FRSTR)<>0 then write(",fromstring"); end-if if bittest(flag,SYMB_MTP_ORSET)<>0 then write(",reset"); end-if if bittest(flag,SYMB_MTP_COPY)<>0 then write(",copy"); end-if if bittest(flag,SYMB_MTP_APPND)<>0 then write("+"); end-if if bittest(flag,SYMB_MTP_CMP)<>0 then write(",cmp"); end-if if bittest(flag,SYMB_MTP_TFBIN)<>0 then write(",bin"); end-if if bittest(flag,SYMB_MTP_SHARE)<>0 then write(",share"); end-if if bittest(flag,SYMB_MTP_ORD)<>0 then write(",ord"); end-if if bittest(flag,SYMB_MTP_CONST)<>0 then write(",const"); end-if writeln(")") else write(" ",dtyp(i),if(bittest(dtyptyp(i),SYMB_OPT_PRIV)<>0,"[priv]",""),"=") if bittest(typscod(type),SYMB_MSK_STR)=SYMB_STR_REC then j:=getndx(typscod(type)) writeln("record") forall(k in recsstart(j)..(recsstart(j+1)-1)) writeln(" ",recfield(k),":", typs(bittest(recftype(k),SYMB_MSK_TYP)), if(bittest(recftype(k),SYMB_OPT_PRIV)<>0," [priv]","")) writeln(" end-record") elif bittest(typscod(type),SYMB_MSK_STR)=SYMB_STR_UNION then j:=getndx(typscod(type)) write(typs(recftype(recsstart(j)))) forall(k in recsstart(j)+1..(recsstart(j+1)-1)) write(" or ",if(recftype(k)=0,"any",typs(recftype(k)))) writeln elif bittest(typscod(type),SYMB_MSK_STR)=SYMB_STR_PROB then writeln("problem:",typs(type)) else writeln(typs(type)) end-if end-if end-do writeln end-if !------------------- Parameters ------- if Rparms.size>0 then writeln("Control Parameters:") forall(i in Rparms) do type:=parmsval(i) write(" ",parms(i)," (",typs(bittest(type,SYMB_MSK_TYP))) if bittest(type,SYMB_OPT_READ)<>0 then if bittest(type,SYMB_OPT_WRITE)<>0 then write(",read/write") else write(",read only"); end-if else if bittest(type,SYMB_OPT_WRITE)<>0 then write(",write only"); end-if end-if if parmsdesc(i)<>"" then write(",",parmsdesc(i),")") else write(")") end-if j:=getndx(type)-1 if j>=0 then case bittest(type,SYMB_MSK_TYP) of SYMB_TYP_INT: writeln("=",cstint(j)) SYMB_TYP_REAL: writeln("=",cstdbl(j)) SYMB_TYP_STRING: writeln("=",cststr(j)) SYMB_TYP_BOOL: writeln("=",if(cstint(j)<>0,"true","false")) end-case else writeln end-if end-do writeln end-if !------------------- Variables -------- if Rvars.size>0 then writeln("Variables:") forall(i in Rvars) do write(" ",vars(i),":") case bittest(varstyp(i),SYMB_MSK_STR) of SYMB_STR_ARR: do j:=getndx(varstyp(i)) if j>0 then write("array (",arrndx(j-1),") of ") else write("array of ") end-if end-do SYMB_STR_SET: write("set of ") SYMB_STR_LST: write("list of ") end-case writeln(typs(bittest(varstyp(i),SYMB_MSK_TYP)),if(bittest(varstyp(i),SYMB_OPT_REQMT)<>0," [reqmt]",""),if(bittest(varstyp(i),SYMB_OPT_PRIV)<>0," [priv]","")) end-do writeln end-if !------------------- Subroutines ------ if Rfct.size>0 then writeln("Procedures and Functions:") forall(i in Rfct) do write(" ",if(bittest(fcttyp(i),SYMB_MSK_TYP)=0,"procedure ","function "),fct(i)) if fctsign(i)<>"" then write("("); ta.start:=1 ta.succ:=1 showtyp(typs,fctsign(i),ta) while(ta.succ<fctsign(i).size) do end-do end-if if>0 then write(":",typs(bittest(fcttyp(i),SYMB_MSK_TYP))) end-if if bittest(fcttyp(i),SYMB_OPT_REQMT)<>0 then write(" [reqmt]"); end-if if bittest(fcttyp(i),SYMB_OPT_PRIV)<>0 then write(" [priv]"); end-if if bittest(fcttyp(i),SYMB_OPT_PTR)<>0 then write(" [ptr]"); end-if writeln end-do writeln end-if !------------------- IO drivers ------- if Riodrv.size>0 then writeln("I/O drivers:") forall(i in Riodrv) do writeln(" ",iodrv(i),":",iodrvinfo(i)) end-do writeln end-if !------------------- Annotations ------ if Rannsident.size>0 then writeln("Annotations:") forall(i in Rannsident) do writeln(" ",if(annsident(i)<>"",annsident(i),"[global]"),"->") forall(k in annsstart(i)..(annsstart(i+1)-1) div 2,kk=2*k) do writeln(" ",anns(kk),":",anns(kk+1)) end-do end-do writeln end-if else writeln("Operation failed") end-if end-procedure !****************** !* Command 'lsloc' !****************** ! Request 'lsloc' (list of local variables): ! mcmd:info@M[.s] ! M: master model ! s: submodel (0<=>master model) procedure cmdlsloc(m:integer,args:text) declarations typs:array(Rtyps:range) of string typscod:array(Rtyps) of integer vars:array(Rvars:range) of string varstyp:array(Rvars) of integer arrndx:array(Rarrndx:range) of string ! Basic types SYMB_TYP_NOT=0 SYMB_TYP_INT=1 SYMB_TYP_REAL=2 SYMB_TYP_STRING=3 SYMB_TYP_BOOL=4 SYMB_TYP_MPVAR=5 SYMB_TYP_LINCTR=6 ! Masks for type decoding SYMB_MSK_TYP=4095 ! 0xFFF 12 bits [ 0-11] SYMB_MSK_STR=61440 ! 0xF000 4 bits [12-15] SYMB_MSK_OPT=983040 ! 0xF0000 4 bits [16-19] SYMB_MSK_NDX=-1048576 ! 0xFFF00000 12 bits [20-31] ! Shift length for type decoding SYMB_SHT_STR=12 SYMB_SHT_OPT=16 SYMB_SHT_NDX=20 ! Entity structure SYMB_STR_SCA=0 ! (0<<SYMB_SHT_STR) SYMB_STR_ARR=4096 SYMB_STR_SET=8192 SYMB_STR_LST=12288 SYMB_STR_REC=16384 SYMB_STR_PROB=20480 SYMB_STR_CSREF=24576 SYMB_STR_UNION=28672 ta:textarea end-declarations initialisations from="rmt:[" Rtyps typs typscod Rvars vars varstyp Rarrndx arrndx end-initialisations if getparam("iostatus")=0 then Variables Rvars.size>0 then writeln("Variables:") forall(i in Rvars) do write(" ",vars(i),":") case bittest(varstyp(i),SYMB_MSK_STR) of SYMB_STR_ARR: do j:=getndx(varstyp(i)) if j>0 then write("array (",arrndx(j-1),") of ") else write("array of ") end-if end-do SYMB_STR_SET: write("set of ") SYMB_STR_LST: write("list of ") end-case writeln(typs(bittest(varstyp(i),SYMB_MSK_TYP))) end-do writeln end-if else writeln("Operation failed") end-if end-procedure !****************** !* Command 'lsattr' !****************** ! Request 'lsattr' (list of attributes): ! mcmd:lsattr@M[.s] ! M: master model ! s: submodel (0<=>master model) procedure cmdlsattr declarations typs:array(Rtyps:range) of string attrs:array(Rattrs:range) of string attrsntyp:array(Rattrs) of integer attrsatyp:array(Rattrs) of integer end-declarations setparam("ioctrl",true) initialisations from "rmt:["+nid+"]mcmd:lsattr-t@1" Rattrs attrs attrsntyp attrsatyp end-initialisations ! Get the type names (from lsloc) initialisations from "rmt:["+nid+"]mcmd:lsloc-t@1" Rtyps typs end-initialisations setparam("ioctrl",false) lasttyp:=0; forall(a in Rattrs) do if attrsntyp(a)<>lasttyp then writeln(typs(attrsntyp(a)),":") lasttyp:=attrsntyp(a) end-if writeln(" ",attrs(a),":",typs(attrsatyp(a))) end-do end-procedure !****************** !* Command 'lslib' !****************** ! Request 'lslib' (list of available libraries [packages+modules]): ! mcmd:lslib ! with option 'p', packages are listed with their full path procedure lslib declarations pkgs:array(Rpkgs:range) of string dsos:array(Rdsos:range) of string end-declarations initialisations from "rmt:["+nid+"]mcmd:lslib-pt" Rpkgs pkgs Rdsos dsos end-initialisations if pkgs.size>0 then writeln(" Packages:") forall(p in Rpkgs) writeln(" ",pkgs(p)) end-if if pkgs.size>0 then writeln(" Modules:") forall(p in Rdsos) writeln(" ",dsos(p)) end-if end-procedure !********************************************** !* Return operation code of a dbg event value !********************************************** function dbgopcode(v:real):integer returned:=bitshift(integer(v),-16) end-function !********************************************** !* Return operation arg of a dbg event value !********************************************** function dbgoparg(v:real):integer returned:=bittest(integer(v),65535) end-function !********************** !* Load a source file !********************** function loadfile(f:string):s_src declarations l:text end-declarations returned.fname:=f setparam("ioctrl",true) fopen(f,F_INPUT+F_SILENT) setparam("ioctrl",false) if getparam("iostatus")=0 then while(readtextline(l)>=0) do returned.nbl+=1 trim(l,SYS_RIGHT) returned.lines(returned.nbl):=l end-do fclose(F_INPUT) end-if end-function !*************************************** !* Display current location of a model !*************************************** ! Request 'dbgstat' (status and location): ! mcmd:dbgstat@M ! mcmd:dbgstat@M.s ! M: master model (if no submodel => status of all running models) ! s: submodel (0<=>master model) procedure showlocation(m:integer) declarations Rid:range id,stat,stlev,lndx:array(Rid) of integer end-declarations initialisations from "bin:rmt:["+nid+"]mcmd:dbgstat@1."+m Rid id stat stlev lndx end-initialisations i:=lndx(0) if stat(0)=2 then writeln("[",m,"] ending") elif i<0 then writeln("[",m,"] no location information") else loadsrc(m) l:=bittest(allsrc(m).lndx(i),LINEMASK) f:=bitshift(allsrc(m).lndx(i),FILESHIFT) if l=0 then writeln("[",m,"] in package ",allsrc(m).src(f).fname) else writeln("[",m,"] ",allsrc(m).src(f).fname,":",l," ",allsrc(m).src(f).lines(l)) end-if end-if end-procedure !*************************** !* Load source for a model !*************************** ! Request 'dbglndx' (all line indices): ! mcmd:dbglndx@M[.s] ! M: master model ! s: submodel (0<=>master model) procedure loadsrc(m:integer) declarations lines:array(Rlines:range) of integer files:array(Rfiles:range) of string end-declarations if not exists(allsrc(m)) then initialisations from "bin:rmt:["+nid+"]mcmd:dbglndx@1."+m Rfiles files Rlines lines end-initialisations allsrc(m).nbi:=Rlines.size forall(i in Rlines) allsrc(m).lndx(i):=lines(i) forall(f in Rfiles) do allsrc(m).src(f):=loadfile(files(f)) end-do end-if end-procedure !********************************************************** !* Display correspondance between line indices and source !********************************************************** procedure lndxlist(m:integer) loadsrc(m) forall(i in 0..allsrc(m).nbi-1) do l:=bittest(allsrc(m).lndx(i),LINEMASK) f:=bitshift(allsrc(m).lndx(i),FILESHIFT) if l=0 then writeln("package ",allsrc(m).src(f).fname) else writeln(i,":",allsrc(m).src(f).fname,'-',l," ",allsrc(m).src(f).lines(l)) end-if end-do end-procedure !*************************************** !* Convert a version number to a string !*************************************** function vers2str(sv:string):string returned:=vers2str(integer(sv)) end-function function vers2str(v:integer):string m0:=v mod 1000 v:=v div 1000 m1:=v mod 1000 v:=v div 1000 returned:=string(v)+"."+m1+"."+m0 end-function !************************************ !* Convert a Unix time into a string !************************************ function str2date(sd:string):string dt:=datetime(integer(sd)) returned:=string(dt) end-function !*************************************** !* Return index value of an identifier !*************************************** function getndx(v:integer):integer declarations SYMB_SHT_NDX=20 end-declarations returned:=bitshift(v,-SYMB_SHT_NDX) end-function !********************************* !* Display a subroutine argument !********************************* procedure showtyp(typs:array(range) of string, args:string, ta:textarea) ta.start:=ta.succ ta.succ:=ta.succ+1 case getchar(args,ta.start) of 105: write("integer") ! 'i' 114: write("real") ! 'r' 83: write("string") ! 'S' 115: write("string") ! 's' 98: write("boolean") ! 'b' 118:write("mpvar") ! 'v' 99: write("linctr") ! 'c' 73: write("range") ! 'I' 97: write("array") ! 'a' 101:write("set") !' e' 108:write("list") ! 'l' 33: do ! '!' i:=findtext(args,"!",ta.succ) write(copytext(args,ta.succ,i-1)) ta.succ:=i+1 end-do 124: do ! '|' i:=findtext(args,"|",ta.succ) write(copytext(args,ta.succ,i-1)) ta.succ:=i+1 end-do 37: do ! '%' i:=integer("0x"+substr(args,ta.succ,ta.succ+2)) write(typs(i)) ta.succ:=ta.succ+3 end-do 65: do ! 'A' write("array (") while(getchar(args,ta.succ)<>46) do showtyp(typs,args,ta) end-do ta.succ:=ta.succ+1 write(") of ") showtyp(typs,args,ta) end-do 69: do ! 'E' write("set of ") showtyp(typs,args,ta) end-do 76: do ! 'L' write("list of ") showtyp(typs,args,ta) end-do 42: write("...") ! '*' else write("?") end-case end-procedure !************************* !* Display some help !************************* procedure showhelp write(` Available commands: cont : continue execution end : abort execution next : continue to next statement step : step into fin : continue up to end of routine to lndx: continue up to given line index list : display all line indices of current model fct fname: display line indices of given function lslib : list available modules and packages info [mod|*]: symbols of the model, a module (mod) or Mosel (*) lsattr : list of attributes lsloc : list of current local symbols flushdso: unload unused modules print expr: evaluate expression break : list breakpoints break lndx|*: remove breakpoints at line index lndx (*=> all breakpoints) break lndx cond|*: set/change breakpoint at line index lndx status : report status of all running models stack [stlev [maxlev]]: set/check stack level `) end-procedure end-model