QLiberator v3.38

Anything QL Software or Programming Related.
EmmBee
Trump Card
Posts: 184
Joined: Fri Jan 13, 2012 5:29 pm
Location: Kent

Re: QLiberator v3.38

Postby EmmBee » Tue Apr 21, 2020 10:04 pm

Here is my names re-order program ...

names_order.zip
(1.5 KiB) Downloaded 8 times

Code: Select all

REMark Program to Re-order names to match the original order
:
dev$ = "ram5_" : REMark change to suit
:
REMark dev$ & "QLIB_origina_obj"  46158 bytes
REMark add in CLEAR somewhere to below BAS file, before LIBERATE / QSAVE ing
REMark dev$ & "QLIB_BAS"
REMark dev$ & "QLIB_BAS_wrk"    to update by overwriting
REMark dev$ & "QLIB_BAS_wrk_a"  to input from - A COPY made from above file
:
COPY_O dev$ & "QLIB_BAS_wrk" TO dev$ & "QLIB_BAS_wrk_a"
a = FOP_IN(dev$ & "QLIB_BAS_wrk_a") : IF a<0 : REPORT a : STOP
b = FOPEN (dev$ & "QLIB_BAS_wrk")   : IF b<0 : REPORT b : STOP
:
OPEN_IN #9,dev$ & "QLIB_origina_obj" : L = 673
SET_POSITION #9,44746 : orig$ = INPUT$(#9,L) : x$ = orig$
CLOSE #9 : L = 1
FOR ct = 1 TO 1E9: k = L+CODE(x$(L))+1: x$(L)=" ": L = k: IF L>LEN(x$): EXIT ct
OPEN_OVER #9,dev$ & "orig_names" : CLS
PRINT    "QLIB_origina_obj" !!! LEN(x$) ! "bytes" !!! ct ! "names"\ x$ \""
PRINT #9,"QLIB_origina_obj" !!! LEN(x$) ! "bytes" !!! ct ! "names"\ x$ \""
CLOSE #9
:                                 REMark 23456
REMark (5)CLEAR     L = 5 the length of "CLEAR" orig$(2 TO 6)
:
max_i = ct-1 : REMark 101 names counted from origina_obj file
DIM redirect%(max_i)
GET #b\10 : REMark start of name table
REMark Re-order names to match the order in the original file
FOR i = 0 TO max_i
  L = CODE(orig$(1))
  name$ = orig$(2 TO L+1)
  orig$ = orig$(L+2 TO LEN(orig$))
  transfer (i),(name$)
END FOR i
IF orig$<>"" : PRINT #0,"More names found than expected" : STOP
update_program_name_indexes
CLOSE #a,#b
PRINT #0,dev$ & "QLIB_BAS_wrk successfully patched"
STOP
:
REMark transfer:
REMark   search through #a name table to find the entry
REMark   write that entry to #b - overwriting existing details
REMark   redirect%(that entry) = i   so can update names in program
:
DEFine PROCedure transfer(i%, name$)
LOCal n%, num1%, num2%, n$(255)
  GET #a\10
  FOR n% = 0 TO max_i
    GET #a, num1%, num2%, n$ : IF n$ = name$ : EXIT n%
    IF LEN(n$) && 1 : n$ = INKEY$(#a)
  END FOR n%
  PUT #b, num1%, num2%, n$
  IF LEN(n$) && 1 : PRINT #b, CHR$(0);
  redirect%(n%) = i%
END DEFine transfer
:
DEFine PROCedure update_program_name_indexes
LOCal s, scan, token, length%
  GET #a\6, length%    : REMark length of name table
  s = 10 + length% + 2 : REMark start address of program
  REPeat scan
    GET #a\s : IF EOF(#a) : EXIT scan
    token = CODE(INKEY$(#a))
    SELect ON token
    = 132 : REMark symbol
      s = s+2 : token = CODE(INKEY$(#a)) : IF token = 10 : s = s+2
    = 136 : REMark name
      GET #a\s+2, i% : IF i% <= max_i : PUT #b\s+2, redirect%(i%)
      s = s+4
    = 138, 141   : s = s+4 : REMark integer, line_num
    = 208 TO 255 : s = s+6 : REMark float, hex, bin
    = 139, 140 : GET #a\(s+2), length% : REMark string, text
      s = s+4 + length% + (length% && 1)
    = REMAINDER : s = s+2
    END SELect
  END REPeat scan
END DEFine update_program_name_indexes

Here is how I used this ...

First, I got the files QLIB_BAS and the original QLIB_obj (46158 bytes) into ram5_
LOAD in ram5_QLIB_BAS and make any changes
LIBERATE ram5_QLIB_BAS ... to get the message work file created
LOAD in my attached program
RUN ... to get the message ram5_QLIB_BAS_wrk successfully patched
LIBERATE
Enter in ram5_QLIB_BAS
COMPILE
... compiles to ram5_QLIB_obj

For best results, run the above in Q-emuLator. I have used Minerva 1.97. There are earlier versions of Minerva on Dilwyn's site that might give better results.


Martin_Head
Super Gold Card
Posts: 528
Joined: Tue Dec 17, 2013 1:17 pm

Re: QLiberator v3.38

Postby Martin_Head » Wed Apr 22, 2020 11:23 am

Without ploughing through your program. I take it you are altering the list of names in the _wrk file. I thought about doing this, but as I don't know how a _wrk file works, I thought I world probably just screw it up.

Here is the program that I wrote for comparing _obj files

Code: Select all

100 REMark A program for comparing QLiberator object files
110 REMark 07/01/2020
111 REMark 10/04/2020
150 :
180 IF refBase<>0 THEN RECHP(refBase)
190 IF tstBase<>0 THEN RECHP(tstBase)
200 REMark Load the two files
210 INPUT#0,"Enter the reference filename : ";ref$
220 IF FTEST(ref$)<>0 THEN
230  PRINT#0,"File not found"
240  STOP
250 END IF
260 INPUT#0,"Enter the test filename : ";tst$
270 IF FTEST(tst$)<>0 THEN
280  PRINT#0,"File not found"
290  STOP
300 END IF
310 :
320 refSize=FLEN(\ref$)
330 tstSize=FLEN(\tst$)
340 refBase=ALCHP(refSize)
350 tstBase=ALCHP(tstSize)
360 :
370 LBYTES ref$,refBase
380 LBYTES tst$,tstBase
390 key$="012345678xX"
400 REPeat loop
410  CLS
420  PRINT "Select Option"
430  PRINT "0 - Full test"
440  PRINT "1 - Header section"
450  PRINT "2 - Initialazion code"
460  PRINT "3 - BASIC program"
465  PRINT "4 - SuperBASIC extensions"
470  PRINT "5 - Line number list"
480  PRINT "6 - Name list"
490  PRINT "7 - Externals"
500  PRINT "8 - Name table"
600  PRINT "X - Exit"
610  PRINT
620  REPeat getoption
630   x$=INKEY$(-1)
640   IF x$ INSTR key$ THEN EXIT getoption
650  END REPeat getoption
660  :
700  y=CODE(x$)
710  SELect ON y
720   ON y=88,120
730    REMark Exit
740    EXIT loop
800   ON y=48
810    d$="Entire program"
820    s=refSize
830    IF s>tstSize THEN s=tstSize
840    CompareBlock refBase,tstBase,s,d$
850    NEXT loop
900   ON y=49
910    d$="Header Section"
920    r=refBase
930    t=tstBase
940    s=132
950    CompareBlock r,t,s,d$
960    NEXT loop
1000   ON y=50
1010    d$="Initialazion code"
1020    r=refBase+132
1030    t=tstBase+132
1040    s=(PEEK_L(refBase+32)+refBase)-r
1050    CompareBlock r,t,s,d$
1060    NEXT loop
1100   ON y=51
1110    d$="BASIC program"
1120    r=PEEK_L(refBase+32)+refBase
1130    t=PEEK_L(tstBase+32)+tstBase
1140    a=PEEK_L(refBase+40)
1150    IF a=0 THEN a=PEEK_L(refBase+64)
1160    a=a+refBase
1170    s=a-r
1180    CompareBlock r,t,s,d$
1190    NEXT loop
1200   ON y=52
1210    d$="SuperBASIC extensions"
1220    IF PEEK_L(refBase+68)=0 THEN
1230     PRINT "No SuperBASIVC extensions exist"
1240     PAUSE -1
1250     NEXT loop
1260    END IF
1270    r=PEEK_L(refBase+68)+refBase
1280    t=PEEK_L(tstBase+68)+tstBase
1290    s=(PEEK_L(refBase+40)+refBase)-r
1300    CompareBlock r,t,s,d$
1310    NEXT loop
1400   ON y=53
1410    d$="Line number list"
1420    IF PEEK_L(refBase+40)=0 THEN
1430     PRINT "Line number table does not exist"
1440     PAUSE -1
1450     NEXT loop
1460    END IF
1470    r=PEEK_L(refBase+40)+refBase
1480    t=PEEK_L(tstBase+40)+tstBase
1490    s=(PEEK_L(refBase+64)+refBase)-r
1500    CompareBlock r,t,s,d$
1510    NEXT loop
1600   ON y=54
1610    d$="Name list"
1620    r=PEEK_L(refBase+64)+refBase
1630    t=PEEK_L(tstBase+64)+tstBase
1640    s=(PEEK_L(refBase+82)+refBase)-r
1650    CompareBlock r,t,s,d$
1660    NEXT loop
1670   ON y=55
1680    d$="Externals"
1690    IF PEEK_L(refBase+82)=0 THEN
1700     PRINT "No External Procedures/Functions exist"
1710     PAUSE -1
1720     NEXT loop
1730    END IF
1740    r=PEEK_L(refBase+82)+refBase
1750    t=PEEK_L(tstBase+82)+tstBase
1760    s=(PEEK_L(refBase+36)+refBase)-r
1770    CompareBlock r,t,s,d$
1780    NEXT loop
1790   ON y=56
1800    d$="Name table"
1810    r=PEEK_L(refBase+36)+refBase
1820    t=PEEK_L(tstBase+36)+tstBase
1830    s=refSize
1840    IF s>tstSize THEN s=tstSize
1850    s=s-r
1860    CompareBlock r,t,s,d$
1870    NEXT loop
9000  END SELect
9010 END REPeat loop
10000 REMark ****** Procedures and Functions ******
10010 DEFine PROCedure CompareBlock (refStart,tstStart,length,title$)
10020 REMark Compares a reference block of memory with a test block
10030 REMark Reports any differences
10090 LOCal x,flag
10095 flag=0
10100 PRINT "Testing, ";title$
10110 FOR x=0 TO length-1
10130  IF PEEK(refStart+x) <> PEEK(tstStart+x) THEN
10140   REMark Found a missmatch
10145   flag=1
10150   PRINT refStart+x-refBase;"($";HEX$(refStart+x-refBase,24);")",
10155   PRINT "Should be $";HEX$(PEEK(refStart+x),8)!!!CHR$(PEEK(refStart+x)),"Is $";HEX$(PEEK(tstStart+x),8)!!!CHR$(PEEK(tstStart+x))
10160  END IF
10170 END FOR x
10172 IF NOT(flag) THEN PRINT "No discrepancies found"
10175 PRINT#0,"Press a key to continue" : PAUSE -1
10180 END DEFine CompareBlock
10190 :
10200 :
10210 DEFine PROCedure SaveMe
10220  SAVE dos3_QLibObjComp_bas
10230 END DEFine SaveMe
10240 :
10250 :


and a Zipped copy
Attachments
QlibObjComp2.zip
(1.7 KiB) Downloaded 10 times


EmmBee
Trump Card
Posts: 184
Joined: Fri Jan 13, 2012 5:29 pm
Location: Kent

Re: QLiberator v3.38

Postby EmmBee » Wed Apr 22, 2020 8:23 pm

A nice program. May I suggest ...

10145 flag = flag+1
10172 PRINT flag ! "discrepancies found over" ! length ! "bytes"

would give some useful additional information. I find that length goes negative sometimes. Perhaps there is a mistake in your code.



Who is online

Users browsing this forum: No registered users and 2 guests