Dilwyn,
attached is a file that decodes a SAV file - as promised. Hope you can
read my code after all these years!
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
1050 decode_name_table
1055 decode_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
1275 lose_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
1295 num_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')
1420 PRINT 'Program out of step.'
1425 CLOSE #3
1430 STOP
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 = operator$(nn)
1700 :
1705 PRINT operator$(GET_BYTE(#3));
1710 END DEFine operators
1715 :
1720 :
1725 DEFine PROCedure monadics
1730 :
1735 REMark $86.nn = monadic$(nn)
1740 :
1745 PRINT monadic$(GET_BYTE(#3));
1750 END DEFine monadic
1755 :
1760 :
1765 DEFine PROCedure names
1770 LOCal ignore
1775 :
1780 REMark $8800.nnnn = name_table$(nnnn)
1785 :
1790 ignore = GET_BYTE(#3)
1795 ignore = GET_WORD(#3)
1800 IF ignore > 32768 THEN ignore = ignore - 32768: END IF
1805 PRINT name_table$(ignore);
1810 END DEFine names
1815 :
1820 :
1825 DEFine PROCedure strings
1830 LOCal delim$(1), size
1835 :
1840 REMark $8B.delim.string_size = 'delim'; string; 'delim'
1845 :
1850 delim$ = INKEY$(#3)
1855 size = GET_WORD(#3)
1860 PRINT delim$; FETCH_BYTES(#3, size); delim$;
1865 IF size && 1
1870 size = GET_BYTE(#3)
1875 END IF
1880 END DEFine strings
1885 :
1890 :
1895 DEFine PROCedure text
1900 LOCal size
1905 :
1910 REMark $8C00.size = text
1915 :
1920 size = GET_BYTE(#3)
1925 size = GET_WORD(#3)
1930 PRINT FETCH_BYTES(#3, size);
1935 IF size && 1
1940 size = GET_BYTE(#3)
1945 END IF
1950 END DEFine text
1955 :
1960 :
1965 DEFine PROCedure separators
1970 :
1975 REMark $8E.nn = separator$(nn)
1980 :
1985 PRINT separator$(GET_BYTE(#3));
1990 END DEFine separators
1995 :
2000 :
2005 DEFine PROCedure floating_points
2010 LOCal number$(6)
2015 :
2020 REMark $Fx.xx.xx.xx.xx.xx - need to mask out the first $F !
2025 :
2030 MOVE_POSITION #3, -1: REMark back up to the first byte
2035 number$ = FETCH_BYTES(#3, 6)
2040 number$(1) = CHR$( CODE(number$(1)) && 15)
2045 POKE_STRING float_buffer, number$
2050 PRINT PEEK_FLOAT(float_buffer);
2055 END DEFine floating_points
2060 :
2065 :
2070 DEFine PROCedure initialise
2075 LOCal x
2080 :
2085 quit = 0
2090 last_line_size = 0
2095 line_size = 0
2100 name_table_entries = 0
2105 :
2110 RESTORE 2125
2115 DIM keyword$(31, 9)
2120 FOR x = 1 TO 31: READ keyword$(x): END FOR x
2125 DATA 'END', 'FOR', 'IF', 'REPeat', 'SELect', 'WHEN', 'DEFine'
2130 DATA 'PROCedure', 'FuNction', 'GO', 'TO', 'SUB', '', 'ERRor', ''
2135 DATA '', 'RESTORE', 'NEXT', 'EXIT', 'ELSE', 'ON', 'RETurn'
2140 DATA 'REMAINDER', 'DATA', 'DIM', 'LOCal', 'LET', 'THEN', 'STEP'
2145 DATA 'REMark', 'MISTake'
2150 :
2155 DIM symbol$(10)
2160 symbol$ = '=:#,(){} ' & CHR$(10)
2165 :
2170 DIM operator$(22, 5)
2175 FOR x = 1 TO 22: READ operator$(x): END FOR x
2180 DATA '+', '-', '*', '/', '>=', '>', '==', '=', '<>', '<=', '<'
2185 DATA '||', '&&', '^^', '^', '&', 'OR', 'AND', 'XOR', 'MOD'
2190 DATA 'DIV', 'INSTR'
2195 :
2200 DIM monadic$(4, 3)
2205 FOR x = 1 TO 4: READ monadic$(x): END FOR x
2210 DATA '+', '-', '~~', 'NOT'
2215 :
2220 DIM separator$(5, 2)
2225 FOR x = 1 TO 5: READ separator$(x): END FOR x
2230 DATA ',', ';', '\', '!', 'TO'
2235 :
2240 END DEFine initialise
2245 :
2250 :
2255 DEFine PROCedure sa
2260 SAVE 'win2_decode_sav_file_bas'
2265 QSAVE 'win2_decode_sav_file'
2270 END DEFine sa
_______________________________________________
QL-Users Mailing List
http://www.q-v-d.demon.co.uk/smsqe.htm
