Chead
From Pickwiki
Jump to navigationJump to search
Back to BasicSource
This is a QM-only utility to display information about compiled code. It can display the header information and the flags set in the header.
It can also show the local and common variables used, the line concordance, and a dump of the code using decimal or hexadecimal output, but these are not accurate if the DEBUGGING compile option was used.
It can also be used to display the opcodes QM uses (as at version 2.6).
program chead
*
* To investigate QMBASIC object code. Version 1.0
*
copyright = 'Copyright Keith Robert Johnson 2008'
*v This data is from the open source OPCODES.H - Version 2.6
* Simple opcodes
opcodes = "STOP]ABORT]RETURN]JMP]JPO]JPZ]JNG]JZE"
opcodes := "]JNZ]]GOSUB]RETURNTO]CALL]ONGOTO]ONGOSUB]RUN"
opcodes := "]LDSINT]LDLINT]LDSTR]LDNULL]LDLCL]LDCOM]STOR]POP"
opcodes := "]DUP]LDSLCL]LDSYS]LD0]LD1]NULL]EXCH]VALUE"
opcodes := "]ADD]SUB]MUL]DIV]NEG]INT]INC]DEC"
opcodes := "]MOD]PWR]ABS]REM]LN]EXP]REUSE]IDIV"
opcodes := "]DSP]DSPNL]LDUNASS]AT]PROFF]PRON]PAGE]BREAKCT"
opcodes := "]KEYRDY]KEYIN]PRINTERR]PROMPT]GETPROMPT]KEYINC]BREAK]LOCATE"
opcodes := "]LEN]SUBSTR]SUBSTRE]CAT]REMOVE]CHAR]SEQ]EXTRACT"
opcodes := "]REPLACE]INS]DEL]LOCATES]SPACE]STR]DNCASE]UPCASE"
opcodes := "]RMVTKN]INSERT]FIELD]COL1]COL2]FLDSTOR]FMT]ICONV"
opcodes := "]OCONV]SUBSTRA]TRIM]TRIMF]TRIMB]COUNT]DCOUNT]INDEX"
opcodes := "]EQ]NE]GT]LT]NOT]AND]OR]BITAND"
opcodes := "]BITOR]BITNOT]GE]LE]SHIFT]BITXOR]BITSET]BITRESET"
opcodes := "]OPEN]READ]READV]WRITEV]DELETE]WRITE]CLOSE]QUOTIENT"
opcodes := "]FORLOOPS][[FOR1S]]]KEYINR]OPENPATH]SYSDIR]KEYINT]KEYINCT]TRANS"
opcodes := "]DIMLCL]DIMCOM]INDX1]INDX2]INMAT]INMATA]KEYINRT]MATCOPY"
opcodes := "]MATFILL]MATPARSE]MATBUILD]DELCOM]MATREAD]GETREM]SETREM]COMMON"
opcodes := "]STATUS]ONERROR]NOWAIT]SETMODE]CLRMODE]SETSTAT]SWAP]FOLD3"
opcodes := "]FILEINFO]OSPATH]TIME]DATE]TIMEDATE]EXECUTE]]ITYPE"
opcodes := "]ALPHA]NUM]APPEND]TRIMX]SOUNDEX]MATCHES]RAISE]LOWER"
opcodes := "]SUM]CONVERT]FCONVERT]COMPARE]FLDSTORF]MATCHFLD]QUOTE]RMVF"
opcodes := "]SELECT]CLEARSEL]CLEARALL]SLCTINFO]READNEXT]RDNXEXP]RDNXPOS]SSELECT"
opcodes := "]FORMLIST]READLIST]SYSMSG]]]]JFALSE]JTRUE"
opcodes := "]ACOS]ASIN]ATAN]COS]SIN]TAN]SQRT]RND"
opcodes := "]LDFLOAT]REP]STZ]STNULL]LDSYSV]UNASS]BITTEST]PREFIX"
opcodes := "]FORINIT]FORLOOP]FOR1]SLEEP]CLRFILE]QUIT]LOCK]UNLOCK"
opcodes := "]RELEASE]RECLCKD]FILELOCK]FLUNLOCK]LOCKREC]RLSALL]GETLOCKS]FOLD"
opcodes := "]SAVESCRN]RSTSCRN]TRACE]PRECISION]CHKCAT]CLEAR]CLRCOM]CHAIN"
opcodes := "]ULOCK]LLOCK]MVD]MVDS]MVDSS]MVDSSS]ASS]MVDD"
opcodes := "]CLRINPUT]HUSH]DATA]TESTLOCK]HEADING]FOOTING]PRNT]PRNL"
opcodes := "]PSET]PRCLOSE]PRFILE]SH]DEBUG]DBGINF]DBGBRK]KERNEL"
convert ']' to @vm in opcodes
* Extended opcodes
excodes = "PABORT]NAP]TOTAL]IFS]SETNLS]GETNLS]ITYPE2]CALLV"
excodes := "]ABORTMSG]PWCRYPT]LOGIN]UMASK]TERMINFO]KEYCODE]ERRMSG]VARTYPE"
excodes := "]CROP]FIND]CHANGE]VSLICE]FINDSTR]SUBSTRNG]SWAPCASE]REPADD"
excodes := "]REPSUB]REPMUL]REPDIV]REPCAT]MAXIMUM]MINIMUM]CHANGED]REPSUBST"
excodes := "]DBGON]DBGOFF]UNLOAD]CAPTURE]PHANTOM]RTNLIST]SYSTEM]ABTCAUSE"
excodes := "]LOGOUT]USERNO]ISSUBR]LISTCOM]DBGWATCH]EVENTS]DBGSET]PCONFIG"
excodes := "]TTYGET]TTYSET]INPUTAT]INPUT]PRNAME]PRDISP]COMO]PTERM"
excodes := "]HEADINGN]PRRESET]EBCDIC]ASCII]DTX]GETLIST]SAVELIST]GETPU"
excodes := "]RDIV]SUMMATION]SEED]SETPU]OPTION]ENV]CONFIG]SENDMAIL"
excodes := "]SQUOTE]DELLIST]SORTDATA]SELECTV]SELECTE]PASSLIST]BINDKEY]CHECKSUM"
excodes := "]SEEK]READBLK]WRITEBLK]ANALYSE]CONFIGFL]FLUSH]CREATESQ]UNLK"
excodes := "]UNLKFL]OSRENAME]GRPSTAT]SETTRIG]KEYCODET]KEYEDIT]KEYEXIT]KEYTRAP"
excodes := "]OPENSEQ]READSEQ]WRITESEQ]WEOFSEQ]WRITESEQF]OPENSEQP]CREATEAK]AKRELEASE"
excodes := "]AKWRITE]AKREAD]AKDELETE]DELETEAK]SELINDX]SELINDXV]AKCLEAR]AKENABLE"
excodes := "]CREATEDH]CREATET1]MAPMARKS]SELLEFT]SELRIGHT]SETLEFT]SETRIGHT]INDICES1"
excodes := "]INDICES2]TXNBGN]TXNCMT]TXNEND]TXNRBK]OSERROR]NOBUF]XTD"
excodes := "]BTINIT]BTADD]BTSCAN]BTRESET]BTADDA]BTMODIFY]BTFIND]BTSCANA"
excodes := "]LOADOBJ]LOADED]SPLICE]PACKAGE]LOCATEF]LISTINDX]MIN]MAX"
excodes := "]SORTINIT]SORTADD]SORTNEXT]SORTCLR]RLSFILE]DIR]PMATRIX]DIMLCLP"
excodes := "]LOGMSG]SHCAP]PROCREAD]DEREF]IADD]ISUB]IMUL]SCALE"
excodes := "]READPKT]WRITEPKT]CHGPHANT]ONGOTOP]ONGOSUBP]READONLY]PICKREAD]STORSYS"
excodes := "]SUBST]PSUBSTRA]SAVEADDR]COMPREP]COMPINS]COMPINSRT]COMPREPLC]FCONTROL"
excodes := "]GETPORT]SETPORT]CCALL]ENTER]SETFLAGS]GETMSG]CSVDQ]OJOIN"
excodes := "]EXPANDHF]LOCAL]DELLCL]AKMAP]SRVRADDR]OBJECT]OBJMAP]OBJREF"
excodes := "]OPENSKT]CLOSESKT]READSKT]WRITESKT]SRVRSKT]ACCPTSKT]SKTINFO]SETSKT"
excodes := "]FORMCSV]ISMV]SETUNASS]TIMEOUT]IN]ME]GET]SET"
excodes := "]ARGCT]ARG]RTRANS]PAUSE]WAKE]PSUBSTRB]DELSEQ]CNCTPORT"
excodes := "]LGNPORT]OBJINFO]INHERIT]DISINH]CREATESH]LDLSTR]RDNXINT]ENCRYPT"
excodes := "]DECRYPT]CRYPT]INPUTBLK]NEGS]ABSS]LENS]SPACES]TRIMS"
excodes := "]TRIMFS]TRIMBS]NOTS]NUMS]SOUNDEXS]STRS]FMTS]ICONVS"
excodes := "]OCONVS]COUNTS]FOLDS]INDEXS]FOLDS3]TRIMXS]FIELDS]MODS"
excodes := "]CATS]EQS]NES]GTS]LTS]ANDS]ORS]GES"
excodes := "]LES"
convert ']' to @vm in excodes
* Extended opcode values
values = "52992]52993]52994]52995]52996]52997]52998]52999"
values := "]53000]53001]53002]53003]53004]53005]53006]53007"
values := "]53008]53009]53010]53011]53012]53013]53014]53015"
values := "]53016]53017]53018]53019]53020]53021]53022]53023"
values := "]53024]53025]53026]53027]53028]53029]53030]53031"
values := "]53032]53033]53034]53035]53036]53037]53038]53039"
values := "]53040]53041]53042]53043]53044]53045]53046]53047"
values := "]53048]53049]53050]53051]53052]53053]53054]53055"
values := "]53056]53057]53058]53059]53060]53061]53062]53063"
values := "]53064]53065]53066]53067]53068]53069]53070]53071"
values := "]53072]53073]53074]53075]53076]53077]53078]53079"
values := "]53080]53081]53082]53083]53084]53085]53086]53087"
values := "]53088]53089]53090]53091]53092]53093]53094]53095"
values := "]53096]53097]53098]53099]53100]53101]53102]53103"
values := "]53104]53105]53106]53107]53108]53109]53110]53111"
values := "]53112]53113]53114]53115]53116]53117]53118]53119"
values := "]53120]53121]53122]53123]53124]53125]53126]53127"
values := "]53128]53129]53130]53131]53132]53133]53134]53135"
values := "]53136]53137]53138]53139]53140]53141]53142]53143"
values := "]53144]53145]53146]53147]53148]53149]53150]53151"
values := "]53152]53153]53154]53155]53156]53157]53158]53159"
values := "]53160]53161]53162]53163]53164]53165]53166]53167"
values := "]53168]53169]53170]53171]53172]53173]53174]53175"
values := "]53176]53177]53178]53179]53180]53181]53182]53183"
values := "]53184]53185]53186]53187]53188]53189]53190]53191"
values := "]53192]53193]53194]53195]53196]53197]53198]53199"
values := "]53200]53201]53202]53203]53204]53205]53206]53207"
values := "]53208]53209]53210]53211]53212]53213]53214]53215"
values := "]53216]53217]53218]59940]59946]59968]59980]59994"
values := "]59995]59996]60004]60065]60068]60237]60246]60247"
values := "]60248]60253]60383]60511]60567]60579]60754]61224"
values := "]61251]61280]61281]61282]61283]61285]61286]61290"
values := "]61291"
convert ']' to @vm in values
* Simple and extended opcode modes
smodes = "AAABBBBBB.BBCMMACDFAEHAAANCAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABBAAAAAAAAAAAAAAAAAAAAAIAAAAAAAAAAAAAC.AAAAAAAAAAAAAAAAAAAAAAAAAAAC...BBAAAAAAAAGAAACAAKABBAAAAAAAAAAAAAAAAAAAAAAALLLLALAAAAAAAAAAAAJAAA"
xmodes = "AACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAAAAAAAAAAAAMMAAAAAAAAAAAAAAAPAAAAQEAACRCAAAAAAAAAAAAAACCAAAAAAAAAAAAASAAAAA............................."
*^ End of data derived from OPCODES.H
* Parse the command line
comd = @sentence
comd = trim(comd)
convert ' ' to @am in comd
loop
this = comd<1>
del comd<1>
until upcase(this) eq 'CHEAD' or comd eq '' do
repeat
* Help
if comd<2> eq '' then
crt
crt 'Program to display information about compiled code.'
crt '---------------------------------------------------'
crt 'syntax: [RUN file] CHEAD FILE ITEM'
crt
crt 'This program will display information about'
crt 'the object code and about QMBASIC opcodes.'
crt
crt 'The output can be printed using P toggle.'
crt
crt 'NOTE: Incorrect if DEBUGGING option used.'
crt
stop
end
namf = comd<1>
name = comd<2>
* Get the source code if possible
if namf[4] eq '.OUT' then namf = namf[1,len(namf)-4]
sourcode = ''
open namf to srs.file then
read sourcode from srs.file,name else null
end
* Get the object code
namf = namf:'.OUT'
open namf to obj.file else
crt 'Cannot open object file ':namf
stop
end
read this from obj.file,name else
crt 'Cannot read object code ':name
stop
end
* Calculate the object size from the header information
* NOTE: LEN(THIS) is too short for big programs!
blen = oconv(this[25,4],'IL')
* The standard read converts char(10) to attribute marks
* Get item with a block sequential read to avoid this
openseq namf,name to code then
readblk this from code,blen else null
closeseq code
end
crt
* Get the header
lenh = 164
head = this[1,lenh]
begn = lenh+2
* Get the various variables we are interested in
nolocvar = oconv(head[13,2],'IS')
nosubarg = oconv(head[11,2],'IS')
symtabof = oconv(head[17,4],'IL')
lcordoff = oconv(head[21,4],'IL')
code.len = oconv(head[25,4],'IL')
hdrflags = oconv(head[29,2],'IS')
compiled = oconv(head[31,4],'IL')
d = int(compiled/86400)
t = rem(compiled,86400)
compiled = oconv(d,'D'):' ':oconv(t,'MTS')
* Change for later version
vers = seq(this[2,1])
if vers > 0 and symtabof then
lcordoff = symtabof + 4
symtabof += oconv(this[symtabof+2,2],'is')+4
end
* Some more for thoroughness
hdroffst = oconv(head[7,4],'IL')
stakdeep = oconv(head[15,2],'IS')
headrefs = oconv(head[35,2],'IS')
progname = head[37,128]
progname = trim(progname)
progname = trim(progname,char(0))
* Get the symbol table
symtable = ''
if symtabof then symtable = this[symtabof+1,blen]
symtable = trim(symtable,char(1),'T')
* Get the line table
lintable = ''
if lcordoff then
if symtabof
then lintable = this[lcordoff+2,symtabof-lcordoff-1]
else lintable = this[lcordoff+2,blen]
end
loclvars = ''
commvars = ''
commnumb = ''
if symtable ne '' then
loclvars = trim(symtable<1>,@vm,'T')
commvars = symtable
del commvars<1>
xxno = dcount(commvars,@am)
for xx = 1 to xxno
commnumb<-1> = commvars<xx,1>+1
next xx
end
* Get the code
begin case
case lcordoff
this = this[begn,lcordoff-lenh-1]
case symtabof
this = this[begn,symtabof-lenh-1]
case 1
this = this[begn,blen]
end case
* Present the user with a menu
prompt ''
pout = @false
plen = system(3) - 1
loop
crt @(-1),namf,name
crt
crt ' H - Header information'
crt ' F - Flags set in header'
crt ' V - Variables (local)'
crt ' C - Common variables'
crt ' L - Line concordance'
crt ' O - Opcodes'
crt ' E - Extended opcodes'
crt ' D - Dump of code'
crt ' X - heXadecimal code dump'
crt
if pout
then crt ' P - Print output now ON turn OFF'
else crt ' P - Print output now OFF turn ON'
crt
crt ' Q - Quit'
crt
loop
crt @(0):@(-3):
* You can take the boy out of Mangere...
if rnd(20)
then crt ' Press choice key :':
else crt ' Cuzzy Bro - Press [[C_H_O_I_C_E]] key, eh?':
answ = upcase(keycode())
until answ ne '' and index('DXVCLHFPQOE',answ,1) do repeat
crt
if answ eq 'D' then gosub show.code
if answ eq 'X' then gosub show.code
if answ eq 'V' then gosub show.local
if answ eq 'C' then gosub show.common
if answ eq 'L' then gosub show.lines
if answ eq 'H' then gosub show.header
if answ eq 'F' then gosub show.flags
if answ eq 'P' then pout = not(pout)
if answ eq 'O' then gosub show.opcodes
if answ eq 'E' then gosub show.extended.opcodes
until answ eq 'Q' do repeat
crt
stop
************************ SUBROUTINES ********************************
show.code:
if answ eq 'D' then decm = @true else decm = @false
if this eq ''
then disp = 'THERE IS NO CODE TO SHOW'
else disp = 'DUMP OF CODE':@am
cntr = 0
size = 16
loop
part = this[cntr+1,size]
until part eq '' do
line = cntr 'R%4':':'
for xx = 1 to size
bite = part[xx,1]
if bite = '' then
bite = ' '
end else
if decm
then bite = seq(bite) 'R#3'
else bite = ' ':(dtx(seq(bite)) 'R%2')
end
line := bite
next xx
line := ' - ':oconv(part,'MCP')
disp<-1> = line
cntr += size
repeat
gosub display
return
show.local:
disp = ' Local Variables':@am
xxno = dcount(loclvars,@vm)
for xx = 1 to xxno
varb = loclvars<1,xx>
void = space(14-rem(len(varb),10))
locate(xx,commnumb;posn) then
if varb = '$'
then varb := void:'******* common block *******'
else varb := void:'****** labelled common ******'
end
begin case
case varb matches '"__"1[[N0X]]'
varb := void:'***** Temporary Variable ****'
case varb[1,2] eq '__'
varb := void:'******* FILE Variable *******'
case varb[1,1] eq '_'
varb := void:'***** Call to Subroutine ****'
case varb[1,1] eq '~'
varb := void:'******** Object code ********'
case varb[1,1] eq '*'
varb := void:'****** Object Argument ******'
end case
disp<-1> = xx 'R#5':' ':varb
next xx
if loclvars eq '' then disp = 'THERE IS NO VARIABLE INFORMATION'
gosub display
return
show.common:
disp = 'COMMON BLOCK DISPLAY':@am
xxno = dcount(commvars,@am)
for xx = 1 to xxno
line = commvars<xx>
comm = line<1,1>
del line<1,1>
comm += 1
comm = loclvars<1,comm>
if comm = '$'
then disp<-1> = ' Common Block'
else disp<-1> = ' ':comm:' - Labelled common'
yyno = dcount(line,@sm)
for yy = 1 to yyno
disp<-1> = yy 'R#5':' ':line<1,1,yy>
next yy
if xx ne xxno then disp<-1> = ' '
next xx
if commvars eq '' then disp = 'THERE ARE NO COMMON BLOCKS, OR THERE IS NO INFORMATION'
gosub display
return
show.lines:
disp = 'LINE CONCORDANCE TABLE'
disp<-1> = ' Line# Length of object in line'
xx = 0
line = 0
loop
xx += 1
part = lintable[xx,1]
until part eq '' do
seqn = seq(part)
if seqn = 255 then
xx += 1 ; seqn = seq(lintable[xx,1])
xx += 1 ; seqn += seq(lintable[xx,1])*256
end
line += 1
if seqn then disp<-1> = line 'R#6':' ':seqn
repeat
if lintable eq '' then disp = 'THERE IS NO LINE INFORMATION'
gosub display
return
show.header:
disp = 'HEADER INFORMATION - ':progname:@am
disp<-1> = 'Endian hint' 'R#35':' ': seq(head[1,1])
disp<-1> = 'Header Revision' 'R#35':' ': seq(head[2,1])
disp<-1> = 'Header Offset' 'R#35':' ': hdroffst
disp<-1> = 'Number of local variables' 'R#35':' ': nolocvar
disp<-1> = 'Number of subroutine arguments' 'R#35':' ': nosubarg
disp<-1> = 'Stack Depth' 'R#35':' ': stakdeep
disp<-1> = 'Symbol table offset' 'R#35':' ': symtabof
disp<-1> = 'Line concordance offset' 'R#35':' ': lcordoff
disp<-1> = 'Line concordance table size' 'R#35':' ': len(lintable)
disp<-1> = 'Object size' 'R#35':' ': code.len
disp<-1> = 'Code size' 'R#35':' ': len(this)
disp<-1> = 'When compiled' 'R#35':' ': compiled
disp<-1> = 'Header References' 'R#35':' ': headrefs
gosub display
return
show.flags:
disp = 'FLAG INFORMATION':@am
disp<-1> = 'Command processor' 'R#35':' ': bittest(hdrflags,0)
disp<-1> = 'Internal mode program' 'R#35':' ': bittest(hdrflags,1)
disp<-1> = 'Compiled in debug mode' 'R#35':' ': bittest(hdrflags,2)
disp<-1> = 'Debugger' 'R#35':' ': bittest(hdrflags,3)
disp<-1> = 'Case insensitive string operations' 'R#35':' ': bittest(hdrflags,4)
disp<-1> = 'Basic function' 'R#35':' ': bittest(hdrflags,5)
disp<-1> = 'Variable arg count (hdr.args = max)' 'R#35':' ': bittest(hdrflags,6)
disp<-1> = 'Is a recursive program' 'R#35':' ': bittest(hdrflags,7)
disp<-1> = 'Is an A[[/S/C/I]]-type' 'R#35':' ': bittest(hdrflags,8)
disp<-1> = 'Allow break in recursive' 'R#35':' ': bittest(hdrflags,9)
disp<-1> = 'Trusted program' 'R#35':' ': bittest(hdrflags,10)
disp<-1> = 'Allow remote files by NFS' 'R#35':' ': bittest(hdrflags,11)
disp<-1> = 'Program uses case sensitive names' 'R#35':' ': bittest(hdrflags,12)
disp<-1> = 'Can be called using QMCall()' 'R#35':' ': bittest(hdrflags,13)
disp<-1> = 'Is a C-type' 'R#35':' ': bittest(hdrflags,14)
disp<-1> = 'Is CLASS module' 'R#35':' ': bittest(hdrflags,15)
gosub display
return
show.opcodes:
disp = 'Simple OPCODES':@am
xxno = dcount(opcodes,@vm)
for xx = 1 to xxno
numb = xx-1
hexn = dtx(numb) 'R%2'
mode = smodes[xx,1]
gosub get.mode.show
disp<-1> = numb 'R#5':' ':hexn:' ':opcodes<1,xx> 'l#10':show
next xx
if opcodes eq '' then disp = 'THERE ARE NO SIMPLE OPCODES'
gosub display
return
show.extended.opcodes:
disp = 'Extended OPCODES':@am
xxno = dcount(excodes,@vm)
for xx = 1 to xxno
numb = values<1,xx>
hexn = dtx(numb) 'R%4'
mode = xmodes[xx,1]
gosub get.mode.show
line = numb:' ':hexn:' ':excodes<1,xx> 'L#10':show
disp<-1> = line
next xx
if excodes eq '' then disp = 'THERE ARE NO EXTENDED OPCODES'
gosub display
return
get.mode.show:
begin case
case mode eq 'A' ; show = 'Opcode Byte' ; show = '' ; * Tidier
case mode eq 'B' ; show = 'Jump Address'
case mode eq 'C' ; show = 'One Byte Value'
case mode eq 'D' ; show = 'Four Byte Value'
case mode eq 'E' ; show = 'Local Variable'
case mode eq 'F' ; show = 'String Value'
case mode eq 'G' ; show = 'Float Value'
case mode eq 'H' ; show = 'Common Variable'
case mode eq 'I' ; show = 'Common Dcl'
case mode eq 'J' ; show = 'Debug Reference'
case mode eq 'K' ; show = 'Opcode Prefix'
case mode eq 'L' ; show = 'Multivalue Opcode'
case mode eq 'M' ; show = 'Address List'
case mode eq 'N' ; show = 'Short Local'
case mode eq 'O' ; show = 'Pmatdata'
case mode eq 'P' ; show = 'Two Byte Value'
case mode eq 'Q' ; show = 'Local Dcl'
case mode eq 'R' ; show = 'Object Map Data'
case mode eq 'S' ; show = 'Long String Value'
case 1 ; show = ''
end case
return
display:
xxno = dcount(disp,@am)
if pout and xxno gt 1 then gosub print.output ; return
pags = int(xxno/plen)
last = pags * plen
pags += (rem(xxno,plen) ne 0)
dawn = 1
loop
dusk = dawn + plen - 1
for here = dawn to dusk
crt disp<here>
next here
begin case
case xxno le plen
crt 'Press any key to retun to menu ':
wait = upcase(keycode())
return
case here gt last
crt 'Press any key to return to menu or <T>op <P>revious ':
wait = upcase(keycode())
if wait ne 'T' and wait ne 'P' then return
case dusk le plen
crt 'Press any key to continue or <Q> to return to menu ':
wait = upcase(keycode())
if wait eq 'T' or wait eq 'P' then wait = 'C'
case 1
crt 'Press any key to continue or <T>op <P>revious <Q>uit to return to menu ':
wait = upcase(keycode())
end case
begin case
case wait eq 'T' ; dawn = 1
case wait eq 'P' ; dawn -= plen
case 1 ; dawn += plen
end case
crt
until dawn gt xxno or wait eq 'Q' do repeat
return
print.output:
crt
crt disp<1>
loop
crt 'ARE YOU SURE YOU WANT TO PRINT?':
answ = upcase(keycode())
until answ eq 'Y' or answ eq 'N' do
crt 'Please answer "Y" or "N"'
repeat
if answ eq 'Y' then
printer on
print 'Details for ':name:' in ':namf
print
for xx = 1 to xxno
print disp<xx>
next xx
printer off
end
return
end
