On 01/07/10 06:31, Rich Mellor wrote:
Although I have not seen the MasterBasic sources (and I am sure Davide
will correct me if I am wrong) - it uses the Turbo Toolkit commands for
deciphering the tokenised program in memory.
From memory, it cannot look at an external program file - it only works
on the Basic (or multibasic) loaded on the QL.
I wrote soem code a while back to detokenise a QSAVED program. This is
in the same for at as the internal format. Dilwyn recently took my code
and updated it to handle SBasic stuff like Binary, hex and
(new?)Floating point values - or similar - so maybe it's on his website?
If not, I'm sure he would be happy to let you have a copy.
Actually, the attached file is indeed the code, hope it helps.
Cheers,
Norman.
1000 REMark _SAV file decoder
1005 :
1010 CLS
1015 PRINT 'SAV File Decoder'\\
1020 INPUT 'Which _sav file ? ';sav$
1025 IF sav$ = '' THEN STOP: END IF
1030 :
1035 initialise
1040 decode_header
1045 IF NOT quit
1050decode_name_table
1055decode_program
1060 END IF
1065 RELEASE_HEAP float_buffer
1070 CLOSE #3
1075 :
1080 DEFine PROCedure decode_header
1085 LOCal head$(4), name_table_length
1090 quit = 0
1095 OPEN_IN #3,sav$
1100 head$ = FETCH_BYTES(#3, 4)
1105 IF (head$ 'Q1' CHR$(0) CHR$(0)) AND (head$ 'Q1' CHR$(2)
CHR$(192))
1110 PRINT head$, head$(1);head$(2)!!CODE(head$(3))!CODE(head$(4))\
1115 PRINT sav$ ' is not a SAV file, or has a new flag.'
1120 CLOSE #3
1125 quit = 1
1130 RETurn
1135 END IF
1140 name_table_entries = GET_WORD(#3)
1145 name_table_length = GET_WORD(#3)
1150 program_lines = GET_WORD(#3)
1155 max_name_size = name_table_length - (4 * name_table_entries) /
name_table_entries
1160 :
1165 PRINT sav$
1170 PRINT 'Number of name table entries : '; name_table_entries
1175 PRINT 'Name table length: '; name_table_length
1180 PRINT 'Number of program lines : '; program_lines
1185 PRINT
1190 :
1195 DIM name_table$(name_table_entries -1, max_name_size)
1200 float_buffer = RESERVE_HEAP(6)
1205 quit = (float_buffer 1)
1210 END DEFine decode_header
1215 :
1220 DEFine PROCedure decode_name_table
1225 LOCal x, name_type, line_no, name_length, name$, lose_it$(1)
1230 LOCal num_procs, num_fns
1235 num_procs = 0
1240 num_fns = 0
1245 FOR x = 0 TO name_table_entries -1
1250 name_type = GET_WORD(#3)
1255 line_no = GET_WORD(#3)
1260 name_length = GET_WORD(#3)
1265 name$ = FETCH_BYTES(#3, name_length)
1270 IF name_length 1
1275lose_it$ = INKEY$(#3)
1280 END IF
1285 IF name_type = 5122 THEN num_procs = num_procs + 1
1290 IF name_type = 5377 AND name_type = 5379
1295num_fns = num_fns + 1
1300 END IF
1305 PRINT x;' Name type = '; HEX$(name_type, 16) ' ';
1310 PRINT 'Line number = '; line_no ' ';
1315 PRINT 'Name length = '; name_length; ' ';
1320 PRINT 'Name = ' name$ ''
1325 name_table$(x) = name$
1330 END FOR x
1335 PRINT 'There are ' num_procs ' PROCs'
1340 PRINT 'There are ' num_fns ' FNs'
1345 END DEFine decode_name_table
1350 :
1355 :
1360 DEFine PROCedure decode_program
1365 LOCal x, type_byte, program_line
1370 :
1375 REMark WORD = size change
1380 REMark LONG = $8D00.line number
1385 REMark rest of line
1390 :
1395 REPeat program_line
1400 IF EOF(#3) THEN EXIT program_line: END IF
1405 line_size = line_size + GET_WORD(#3)
1410 IF line_size 65536 THEN line_size = line_size - 65536: END IF
1415 IF GET_WORD(#3) HEX('8d00')
1420PRINT 'Program out of step.'
1425CLOSE #3
1430STOP
1435 END IF
1440 PRINT GET_WORD(#3); ' ';
1445 line_done = 0
1450 REPeat line_contents
1455 type_byte = CODE(INKEY$(#3))
1460 SELect ON type_byte
1465 = HEX('80'): multi_spaces
1470 = HEX('81'): keywords
1475 = HEX('84'): symbols
1480 = HEX('85'): operators
1485 = HEX('86'): monadics
1490 = HEX('88'): names
1495 = HEX('8B'): strings
1500 = HEX('8C'): text
1505 = HEX('8E'): separators
1510 = REMAINDER : floating_points
1515 END SELect
1520 IF line_done THEN EXIT line_contents: END IF
1525 END REPeat line_contents
1530 END REPeat program_line
1535 END DEFine decode_program
1540 :
1545 :
1550 DEFine PROCedure multi_spaces
1555 :
1560 REMark $80.nn = print nn spaces
1565 :
1570 PRINT FILL$(' ', GET_BYTE(#3));
1575 END DEFine multi_spaces
1580 :
1585 :
1590 DEFine PROCedure keywords
1595 :
1600 REMark $81.nn = keyword$(nn)
1605 :
1610 PRINT keyword$(GET_BYTE(#3));' ';
1615 END DEFine keywords
1620 :
1625 :
1630 DEFine PROCedure symbols
1635 LOCal sym
1640 :
1645 REMark $84.nn = symbol$(nn)
1650 :
1655 sym = GET_BYTE(#3)
1660 PRINT symbol$(sym);
1665 line_done = (sym = 10)
1670 END DEFine symbols
1675 :
1680 :
1685 DEFine PROCedure operators
1690 :
1695 REMark $85.nn =
