Thursday 30 November 2017

SMSQ/E modules again

Here below is a further development of the SBASIC program written by Tony Tebby to explain the modular structure of smsqe. This time the program not only lists the modules in a version of smsq/e it also allows the extraction of a given module and/or its header element. Why - simply to see how it works.

The first image below shows how a module is selected, then when selected the second image shows the extraction menu.

The bottom window in the image shows how the screen shots were captured as gifs using a program called engif. This is an amazing little program. It only understands mode 4 and mode 8 colours but it can cope with display sizes more that 512x256. It comes in a package with ungif which can show a gif on a mode4 or mode 8 QL display.

Finally below is the listing.





1000 REMark - scan bootloader file
1010 DIM version$(4): version$(0)=4 :
1020 OPEN #0,CON_512x420a20x16: CLS#0: BORDER#0,1,4
1030 height = 52 : DIM d$(height,84) : pg=1
1040 INPUT#0,'SMSQ file>';f$ : IF f$="":QUIT
1050 OPEN_IN #3,f$
1060 fln = FLEN(#3) : PRINT#0,CHR$(10)&HEX$(fln,32)&" length of file"&CHR$(10)
1070 LGET #3\fln-$18+$4,mod_ptr : REMark - get length of host module
1080 PRINT#0,HEX$(mod_ptr,32)&" length of host module"&CHR$(10)
1090 LGET #3\fln-$18+$14,bln    : REMark - length of bootloader file
1100 PRINT#0,HEX$(bln,32)&" length of bootloader file"&CHR$(10)
1110 IF bln: mod_ptr = mod_ptr + fln - bln
1120 FOR i=1 TO 9999
1130   LGET #3\(mod_ptr),mbase,mlength
1140   IF NOT mbase: modules=i-1:EXIT              : REMark - end of file
1150   IF NOT i MOD height: Inc : pg=pg+1 : INPUT a$;  : REMark - pause at screen full
1160   WGET#3\(mod_ptr+$16),name_rel: REMark - relative pointer to name
1170   GET#3\(mod_ptr+$16+name_rel),name$  : REMark - fetch module name
1180   IF LEN (name$)&&1: BGET#3,a : REMark - odd length name is padded
1190   BGET #3,version$(1 TO 4)    : REMark - get version, if any
1200   PRINT#0,HEX$(mod_ptr,32) !!!! HEX$(mbase,24) !! HEX$(mlength,24) !! version$ ! name$
1210   d$(i)=HEX$(mod_ptr,32)&"    "&HEX$(mbase,24)&"  "&HEX$(mlength,24)&"  "&version$&" "&name$
1220   mod_ptr = mod_ptr + mbase + mlength
1230 END FOR i
1240 CLOSE #3 : PRINT#0,CHR$(10)&HEX$(mod_ptr,32)&" end of file"
1250 PRINT#0,\"Save data as text file (S/s), Extract a module (X/x), Header Info (I/i)"
1256 PRINT#0,\"                   or ESC to Quit program"
1260 REPeat Main
1264   in=INKEY$(#0,-1) INSTR 'SsQqxXIi'&CHR$(27): REMark wait to close program
1270   SELect ON in
1280     =1,2
1284            OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
1286            AT#1,1,1:INPUT#1,'save file name>';sf$ : IF sf$="":QUIT
1288            WREST#1
1290     =5,6 : SelectModule
1300     =7,8 : SelectModule
1310     =9   : QUIT
1320   END SELect
1324   IF sf$<>""
1330     OPEN_NEW#3,sf$ : PRINT#3,f$\\HEX$(fln,32)&" length of file"&CHR$(10)
1340     FOR i=1 TO height : IF d$(i)<>"": PRINT#3,d$(i) : END FOR i
1350     PRINT#3,\\HEX$(mod_ptr,32)&" end of file"
1360     CLOSE#3 :sf$=""
1366   END IF
1378 END REPeat main
1370 :
1380 DEFine PROCedure Inc
1390   LOCal z$(height*pg),j
1400   FOR j=1 TO height*pg : z$(j)=d$(j)
1410   DIM d$(height*pg)
1420   FOR j=1 TO height*pg :d$(j)=z$(j)
1430 END DEFine
1440 :
1450 DEFine PROCedure SelectModule
1460 wndoline=8 : txtline=1 : up=208 : dn=216
1470 REPeat choose
1480   key=CODE(INKEY$(#0))
1490   SELect ON key
1500     = 27 : EXIT choose
1510     = up
1520       AT#0,wndoline,0 : INK#0,4:PRINT#0,d$(txtline)
1530       wndoline=wndoline-1 : IF wndoline<8 : wndoline=modules+7
1540       txtline=txtline-1 : IF txtline<1 : txtline=modules
1550     = dn
1560       AT#0,wndoline,0 : INK#0,4:PRINT#0,d$(txtline)
1570       wndoline=wndoline+1 : IF wndoline>modules+7 : wndoline=8
1580       txtline=txtline+1 : IF txtline>modules : txtline=1
1590     =10,32
1600       SELect ON in
1610         = 5,6 : DoExtraction
1620         = 7,8 : ShowHeaderInfo
1630       END SELect
1634       AT#0,wndoline,0 : INK#0,4:PRINT#0,d$(txtline)
1636       RETurn
1640   END SELect
1650   AT#0,wndoline,0 : INK#0,7: PRINT#0,d$(txtline)
1660 END REPeat choose
1670 END DEFine eXtractModule
1680 :
1690 DEFine PROCedure DoExtraction
1700 ptr=HEX(d$(txtline,1 TO 8)):hdr=HEX(d$(txtline,13 TO 18)):sze=HEX(d$(txtline,21 TO 26))
1710 strngmax=32000 : Xmod$=GetName
1720 OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
1730 AT#1,1,2: INK#1,7: PRINT#1,"Module:- ";Xmod$
1740 AT#1,3,5: PRINT#1,"a: Extract header and module"
1750 AT#1,5,5: PRINT#1,"h: Extract header only"
1760 AT#1,7,5: PRINT#1,"m: Extract module only"
1770 AT#1,9,5: PRINT#1,"Q: Back to list without extraction"
1780 ky=INKEY$(#1,-1) INSTR 'AaHhMmQq'&CHR$(27)
1790   SELect ON ky
1800     =1,2 : all=hdr+sze
1810     =3,4 : all=hdr
1820     =5,6 : all=sze : ptr=ptr+hdr : REMark move pointer to module
1830   END SELect
1840   IF ky>0 AND ky <7 :AT#1,12,2 : INPUT#1,'save file name>';mf$ : IF mf$="": WREST#1 : RETurn
1850 WREST#1
1854 IF ky < 7
1858   OPEN_IN#3,f$ : OPEN_OVER#4,mf$
1860   IF all <= strngmax
1870     DIM mod$(all) : BGET#3\ptr,mod$(1 TO all) : PRINT#4,mod$(1 TO all);
1880   ELSE
1890     DIM mod$(strngmax)
1900       REPeat getbits
1910        BGET#3\ptr,mod$(1 TO strngmax) : PRINT#4,mod$(1 TO strngmax); : IF all=0 : EXIT getbits
1920        all=all-strngmax : IF all <strngmax : strngmax=all :all=0
1930      END REPeat
1940   END IF
1950   CLOSE#3 : CLOSE#4
1956 END IF
1960 END DEFine DoExtraction
1970 :
1980 DEFine FuNction GetName
1990 LOCal first,last,j,t$,md$
2000 m$=d$(txtline,29 TO ) : j=1
2010 REPeat first
2020   IF m$(j)<>" " : m$=m$(j TO) : EXIT first
2030   j=j+1
2040 END REPeat first
2050 j=LEN(m$)
2060 REPeat last
2070   IF m$(j)<>" " : m$=m$(1 TO j) : EXIT last
2080   j=j-1
2090 END REPeat last
2100 RETurn m$
2110 END DEFine GetName
2120 :
2130 DEFine PROCedure ShowHeaderInfo
2140 Xmod$=GetName : DIM mod$(24)
2150 ptr=HEX(d$(txtline,1 TO 8))
2160 OPEN_IN#3,f$ : rem BGET#3\ptr,mod$(1 to 24)
2162 LGET#3\ptr,hl,ml,rl,ck,sl
2166 BGET#3\(ptr),lvl : WGET#3\(ptr+2),nme
2170 OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
2180 AT#1,1,2: INK#1,7: PRINT#1,"Header Info:- ";Xmod$
2190 AT#1,3,5: PRINT#1,"Header Length",HEX$(hl,32),hl
2200 AT#1,5,5: PRINT#1,"Module Length",HEX$(ml,32),ml
2210 AT#1,7,5: PRINT#1,"Relocate Length",HEX$(rl,32),rl
2220 AT#1,9,5: PRINT#1,"Checksum     ",HEX$(ck,32),ck
2230 AT#1,11,5: PRINT#1,"Select Code Offset",HEX$(sl,32),sl
2240 AT#1,13,5: PRINT#1,"Module Level",HEX$(lvl,8),,lvl
2250 AT#1,15,5: PRINT#1,"Offset to Name",HEX$(nme,16),,nme
2256 AT#1,19,5: PRINT#1,,"To return ESC or eXit"
2260 rt=INKEY$(#1,-1) INSTR "xX"&CHR$(27)
2270 WREST#1
2280 END DEFine


No comments:

Post a Comment