Mrifk_memmap.hs

{-
Mrifk, a decompiler for Glulx story files.
Copyright 2004 Ben Rudiak-Gould.

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You can read the GNU General Public License at this URL:
     http://www.gnu.org/copyleft/gpl.html
-}


module Mrifk_memmap (
	informCode, informObjectTable, informGrammarTable,
	numAttribBytes,
	commonPropNames, indivPropNames,
	attribNames, actionNames, arrayNames
) where


import Mrifk_storyfile
import Mrifk_strings

import Data.Array (Array,listArray)
import Data.Bits (shiftR)
import Data.Maybe (mapMaybe)
import Numeric (showHex)


{-

Here I use various heuristics to try to figure out
the addresses of Inform data structures.

This is the Glulx memory layout generated by Inform:

        +---------------------+ 000000
Read-   |       header        |
 only   +=====================+ 000024
memory  |  memory layout id   |
        +---------------------+ hdrStartFunc
        |        code         |
        +---------------------+ hdrDecodingTbl
        | string decode table |
        + - - - - - - - - - - +
        |       strings       |
        +=====================+ hdrRAMStart
Dynamic |  global variables   |
memory  + - - - - - - - - - - +
        |       arrays        |
        +---------------------+
        | printing variables  |
        +---------------------+
        |       objects       |
        + - - - - - - - - - - +
        |   property values   |
        + - - - - - - - - - - +
        |  property defaults  |
        + - - - - - - - - - - +
        | class numbers table |
        + - - - - - - - - - - +
        |   id names table    |
        +=====================+
Readable|    grammar table    |
memory  + - - - - - - - - - - +
        |       actions       |
        +---------------------+
        |     dictionary      |
        +---------------------+ hdrExtStart

globals: array of longs, no length info
arrays: raw data, no length info (sigh...)
printing variables: long count, followed by count*long absolute string addresses
	should be able to get addr from string decode table
objects, property values: see technical.txt
property defaults: array of longs, length is count of common properties below
class numbers: array of long absolute ptrs to objects, 0-terminated
id names table:
	header of 8 longs:
		absaddr,count of common properties
		absaddr,count of individual properties (#s starting with 256)
		absaddr,count of attributes
		absaddr,count of actions
		(note: addr of common props is always just past the header,
		  addr of indiv props just past common, etc.)
	count+count+count+count long (possibly null) abs ptrs to strings
	count, string ptrs for array names (but no array addresses???)

I try to find the id names table first. The grammar table follows it.
The object table can be found by pattern (using the known count of attributes)

-}


indivPropStart = 256	-- FIXME: make this variable?


informCode = fromTo hdrStartFunc hdrDecodingTbl


informIdNamesTable :: Int

commonPropNames, indivPropNames, attribNames, actionNames, arrayNames :: Array Int (Maybe String)

(informIdNamesTable, informGrammarTable, numAttribBytes,
        commonPropNames, indivPropNames, attribNames, actionNames, arrayNames) =
  case possibleIdNamesTables of
    [x] -> x
    []  -> error "No identifier names table found (not compiled with Inform 6.21?)"
    xs  -> error ("More than one candidate for identifier names table. File offsets:\n"
                    ++ concat ['\t' : showHex addr "\n" | (addr,_,_,_,_,_,_,_) <- xs])


possibleIdNamesTables =
  mapMaybe maybeIdNamesTableAt [hdrRAMStart .. hdrExtStart-32]

maybeIdNamesTableAt addr =
  if addrCommon == expectCommon && addrIndiv == expectIndiv
      && addrAttrib == expectAttrib && addrAction == expectAction
      && all isStringPtr (dwordsFromTo expectCommon expectArray)
      && all isStringPtr (dwordsFromTo addrArray addrArrayEnd)
  then
    Just (addr, addrArrayEnd, (numAttrib + 7) `shiftR` 3,
          nameTable addrCommon numCommon 0,
          nameTable addrIndiv numIndiv indivPropStart,
          nameTable addrAttrib numAttrib 0,
          nameTable addrAction numAction 0,
          nameTable addrArray numArray 0)
  else
    Nothing

  where
    addrCommon = dwordAt addr
    numCommon  = dwordAt (addr+4)
    addrIndiv  = dwordAt (addr+8)
    numIndiv   = dwordAt (addr+12)
    addrAttrib = dwordAt (addr+16)
    numAttrib  = dwordAt (addr+20)
    addrAction = dwordAt (addr+24)
    numAction  = dwordAt (addr+28)
    expectCommon = addr + 32
    expectIndiv  = expectCommon + 4 * numCommon
    expectAttrib = expectIndiv + 4 * numIndiv
    expectAction = expectAttrib + 4 * numAttrib
    expectArray  = expectAction + 4 * numAction
    numArray     = dwordAt expectArray
    addrArray    = expectArray + 4
    addrArrayEnd = addrArray + 4 * numArray

nameTable addr count base =
  listArray (base,base+count-1)
            [maybeStringAt (dwordAt (addr + n * 4)) | n <- [0..count-1]]


{-----------}


-- take the earliest match for the object table, because the list
-- starting with any subsequent object also looks like a valid
-- object table

informObjectTable =
  case mapMaybe couldBeObjectTable [hdrRAMStart .. informIdNamesTable-25] of
    []        -> fromTo 0 0
    ((a,b):_) -> fromTo a b

couldBeObjectTable addr =
  if byteAt addr == 0x70 && isStringPtr (dwordAt (addr+numAttribBytes+5)) then
    if dwordAt (addr+numAttribBytes+1) == 0 then
      Just (addr,expectNextAddr)
    else if dwordAt (addr+numAttribBytes+1) == expectNextAddr then
      case couldBeObjectTable expectNextAddr of
        Just (from,to) -> Just (addr,to)
        Nothing        -> Nothing
    else
      Nothing
  else
    Nothing
  where expectNextAddr = addr + numAttribBytes + 25


{-----------}


isStringPtr p =
  p == 0 || (p >= hdrDecodingTbl && p < hdrExtStart && byteAt p `elem` [0xE0,0xE1,0xE2])

maybeStringAt 0 = Nothing
maybeStringAt addr = Just (evalFrom addr decodeString)

dwordsFromTo n k = evalFromTo n k (repeatUntilEmpty getDword)