Re: Save file check sums -- MI400

Here's a checksum-calculating program.  First create save file QTEMP/STDIN
and save a little program object into it; then create *empty* save file
QTEMP/STDOUT; then run this program.

This program reads from save file QTEMP/STDIN and strips off all checksums
and writes to user space QTEMP/SAVEFILE in 512-byte pages.  Then it pops up
a command line (where you can call some home-grown program to modify the
data in the user space).  Then it reads from the user space and
recalculates all the checksums and writes to save file QTEMP/STDOUT.  In
other words this is an alternative to system service tools
display/alter/dump.

/********************************************************************/
/*  PROCEDURE - PATCHSAVF                                           */
/*  PURPOSE   - allow patch of binary data in save file             */
/*  LANGUAGE  - REXX                                                */
/*  AUTHOR    - Gene Gaunt                                          */
/********************************************************************/

"OVRSAVF STDIN  TOFILE(QTEMP/STDIN)"
"OVRSAVF STDOUT TOFILE(QTEMP/STDOUT)"
userspace = "SAVEFILE  QTEMP     "

/*  copy from save file "STDIN" to user space "SAVEFILE"  */

big = ''
do total = 1 by 512
   parse linein record
   if record == '' then leave
   big = big || left( record, 512 )
end total
if total == 1 then return
big = overlay( substr( big, 65, 16 ), big, total - 16 )
big = overlay( copies( '00'x,   16 ), big, 65 )
"CALL QUSCRTUS (&userspace",
                "' '",
                "x'" || D2X( total - 1, 8 ) || "'",
                "x'00'",
                "'*ALL'",
                "'" || copies( ' ', 50 ) || "'",
                "'*YES'",
                "x'00000000')"
do X = 1 by 512 while X < total
   "CALL QUSCHGUS (&userspace",
                   "x'" || D2X( X, 8 ) || "'",
                   "x'00000200'",
                   "x'" || C2X( substr( big, X, 512 )) || "'",
                   "'0'",
                   "x'00000000')"
end X

/*  call external program to modify binary data in user space  */

"CALL QUSCMDLN"

/*  calculate 16-byte checksum over entire savefile data  */

big = ''
record = copies( '00'x, 512 )
do X = 1 by 512 while X < total
   "CALL QUSRTVUS (&userspace",
                   "x'" || D2X( X, 8 ) || "'",
                   "x'00000200'",
                   "&record",
                   "x'00000000')"
   big = big || record
end X
big = overlay( right( big, 16 ), big, 65 )
sum.0 = copies( '55'x, 8 );  count.0 = 1;    max.0 = 251
sum.8 = copies( 'AA'x, 8 );  count.8 = 121;  max.8 = 257
do X = 1 by 16 while X < total
   if X // 512 == 1 then "SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) ",
      "TOPGMQ(*EXT) MSGTYPE(*STATUS) MSGDTA('reading record",
      X % 512 + 1 || " of " || total % 512 || " . . .')"
   do R = 0 to 8 by 8
      snip = substr( big, X+R+7, 1 ) || substr( big, X+R, 8 )
      work = ''
      do N = 1 to 8
         char = bitand( '07FF'x, substr( snip, N, 2 ))
         work = work || sbox( C2D( char ) + 1 )
      end N
      bits  = X2B( C2X( bitxor( sum.R, work )))
      sum.R = X2C( B2X( substr( bits || bits, 30, 64 )))
      if count.R == max.R then do
         count.R = 0
         work = ''
         bits = X2B( C2X( sum.R ))
         do N = 1 to 32
            work = work || substr(bits, N, 1) || substr(bits, N+32, 1)
         end N
         sum.R = X2C( B2X( work ))
         if R == 8 then do
            swap  = sum.0
            sum.0 = left( sum.0, 4 ) || right( sum.8, 4 )
            sum.8 = left( sum.8, 4 ) || right( swap,  4 )
         end
      end
      count.R = count.R + 1
   end R
end X
big = overlay( sum.0 || sum.8, big, total - 16 )

/*  write the savefile records with new 12-byte record checksums  */

numeric digits 200
do X = 1 by 512 while X < total
   "SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) TOPGMQ(*EXT)",
             "MSGTYPE(*STATUS) MSGDTA('writing record",
              X % 512 + 1 || " of " || total % 512 || " . . .')"
   row = D2C( X % 512 + 1, 4 )
   pod = add( row || substr( big, X, 57 ), substr( big, X + 57, 62 ))
   pod = add( pod, substr( big, X + 119, 63 ))
   pod = add( pod, substr( big, X + 182, 64 ))
   pod = add( pod, substr( big, X + 246, 65 ))
   pod = add( pod, substr( big, X + 311, 66 ))
   pod = add( pod, substr( big, X + 445, 67 ))
   pod = add( pod, substr( big, X + 377, 68 ))
   sum = add( substr( pod, 1, 5 ), substr( pod, 6, 6 ))
   sum = add( sum, substr( pod, 12,  7 ))
   sum = add( sum, substr( pod, 19,  8 ))
   sum = add( sum, substr( pod, 27,  9 ))
   sum = add( sum, substr( pod, 36, 10 ))
   sum = add( sum, substr( pod, 58, 11 ))
   sum = add( sum, substr( pod, 46, 12 ))
   say substr( big, X, 512 ) ||,
       row ||,
       bitxor( left( sum, 8 ), left( big, 8 )) ||,
       right( sum, 4 )
end X
"CALL QUSDLTUS (&userspace x'00000000')"
"SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Done.')"
return

ADD: return D2C( 2 * C2D(arg(1)) + C2D(arg(2)), length(arg(2)))

SBOX: return substr(,
'90ACA3F7E3E620BE686E0935EA4EFD6C'x ||,
'5C1BDA4A1C277BC2C045D0C4DF81D4F3'x ||,
'F40EE162B2C8DBA722F52F33D1511DF6'x ||,
'44A81F4B3861BFB48B5269D2EBD8CA26'x ||,
'96FAB1E08E8C9A1AA1070CA232461506'x ||,
'767805B0084953BA4C5D91F1239D13E8'x ||,
'5AF81485A5CD01B51957983C65501E82'x ||,
'9B9754022A165B6D708473E7C118959F'x ||,
'D94279B89EF98A66B3877A31E23756DD'x ||,
'D700CF28C9C3ECD68389FC715F21643B'x ||,
'807F127D0A47553FA048B9A9102CDEFF'x ||,
'3039FBA41725F0B604ABAAD5BB2D0D43'x ||,
'6BD3BC0F72F292DC592488674FCCAF2E'x ||,
'3D7763CB7CB7EEAE11416AE575AD9C5E'x ||,
'C7033A604D407E368D3474C63ECEEDE4'x ||,
'0B8FBD8693FEE92994EF2B6FA658C599'x ||,
'862693B4A1808FBEF1EF7996C436DA4B'x ||,
'BFFE84410E0D05B911D1E0D390337C9E'x ||,
'925E7034092B288827DFA04AF41CA519'x ||,
'C97D138B66C23523089D6429B2585125'x ||,
'F94F3BA67EBBF3C00769CE38D04699BD'x ||,
'838C715B9A30763997A27B54814EA452'x ||,
'7455F549E2DCF7D7C62D0FB3B1601D06'x ||,
'633E8EE56C2E5C9F14C1D6CD6DCB15D8'x ||,
'785A161F9B95ACD57F00C82FB5BC3D1E'x ||,
'EB5077ED6AEE0AB668DE72CA61A8AF3C'x ||,
'734D7AF8A3D9EAD4043F2124FF22E145'x ||,
'822CDD91A9A7C73A6B9CE7D2BADB320B'x ||,
'3120CC44015F62574218E9B0560CFDE6'x ||,
'6747C5B840FBFA378502C353AAF02A94'x ||,
'CFEC5D75F2E86FF64CB7AD031AAE8998'x ||,
'8D106517591B6EE3AB871243E4488AFC'x ||,
'AF7FECFD34E7A79B264FA26A80876000'x ||,
'DE6469A1D237A5C3868136A42DE3E268'x ||,
'B75D14C795294D66D133AD572AC13B32'x ||,
'52CAEF488E515EAA3F412256C45CD809'x ||,
'03E4AEA902C6E824658F946BD4CCB2CD'x ||,
'B11884973AFC28E5D5546225BBEE433E'x ||,
'21B57D05A8B0116F729198CEFBB3C296'x ||,
'01B65FA692EB751B705BC51042D3FE44'x ||,
'9A5A764661770F2F4583F406DC8BD01E'x ||,
'0DAB7BBEBA070CAC20C0FF041C30BD31'x ||,
'F939FA15D9DAA340799C23F7A04B6EB4'x ||,
'D6CF1ACBD7EAE6E9BF2E9959ED359E8A'x ||,
'53E0718DDBF22CBC934908DF1778850A'x ||,
'C82B891967384A82C9F8134CDD4E0E50'x ||,
'3C7455B89FF56C587EF69D7AB9E18827'x ||,
'8C73F1161FF36D3D0B7C6390471DF012'x ||,
'8C09A4537C78A64AFF20B4698F6CFE75'x ||,
'08B13CA9F06F3AD1B83D16D7B685AC54'x ||,
'E74BBE3B70CD023810D0C10BC749872E'x ||,
'AD6E0CC4C9341541847EA7E15EA32959'x ||,
'446A4E6B363EE0DA149A04DD880A67A0'x ||,
'58246118A50755D31D45C01FAEE29617'x ||,
'A1D964E38625CEB59C749B5AEBC692AA'x ||,
'5D482DFC800EA2681B2F5651D866FAF9'x ||,
'225CC52C7265B71AE871762B8D30D5B3'x ||,
'EA5BBBF6912795CB7B31E635239EC2B9'x ||,
'7FEE90EFC82AE5E93F7342BD4CF7CC06'x ||,
'57C319F51E83D279B0D6975040993993'x ||,
'46A8818A370D9D477ACADBFD82608BAB'x ||,
'89DED4E49F1CB24FF8F252ED7D00F443'x ||,
'7701281362056D5F4D2621BF3233BA12'x ||,
'BC8E63F1ECAF94980FDCDF03FBCFF311'x ||,
'8D6C2B37A77B7586224E356D71C54470'x ||,
'03B7E1D52709A206B37A8131C04BCF9E'x ||,
'112C884F841EEE8759B2681383891F0D'x ||,
'40A69CB9CC4DCA50325B7DEFA8D23025'x ||,
'FCEB964267771A1CE5BDC71B65EA72AC'x ||,
'5FAB5A499992044AE8D957D6AFF99473'x ||,
'647CF8FDC33E14F421B1A0B833A1009F'x ||,
'9352AE3C2654F7DE91DF18289B5EE461'x ||,
'5CD3E6ECD0763FF1B05655C12E19F338'x ||,
'DA076AED8F021D20410AF6582A4C7F3B'x ||,
'BB8034056B166E46F52FE7DBC9D1A53A'x ||,
'36E93D29FA9D0E23F2FEFF698ABFDD6F'x ||,
'74471017E20824C401B6A90C5D537945'x ||,
'856366951551ADCD98B4A39ACED478E0'x ||,
'62F0B560DC8BC2C8BAA482C639BC7E0B'x ||,
'BECB2D1248E3D7FB0F4397AAD88C908E'x ||,
'2E29C59A4FA9D792E0D88232C4CB1D5E'x ||,
'7A64B79E63EBB6AC10169C132A21D0DF'x ||,
'E76548D92D7B9846AAFDE3B51EB4BC43'x ||,
'07A47F879F4A67972CDB3DF3EA3CFCD1'x ||,
'279D256FF652DEAD40A69BA81ABE0DE6'x ||,
'2641BF386C20E174ED2B5C96B2E4C11F'x ||,
'280049FBBDA06D2336A18A458D1B7D44'x ||,
'F5542F536A4EBBFE1108937266174BC2'x ||,
'71847E894D3ACF83FAE9DC24570C8F81'x ||,
'8CD57076475D229419885B3EE81C8B02'x ||,
'99AE805514068615733439C004953B8E'x ||,
'0EA2C3B16075C969A3CA595A8533E5D4'x ||,
'0BF0AFD356CED27C3FB912EE5FE2F2FF'x ||,
'F7CC37ABDD42C801F809CDC7A75158D6'x ||,
'B0BA030A05F17931F478EC4C91A56890'x ||,
'62355030C6776E180FDAB3B8F96B61EF'x ||,
'1DFD3920DB8DF8D6F3FE5D5F9F612338'x ||,
'64B550F0B61C136EE4212BAF53C2F4E1'x ||,
'48FB6A305B78FFFCA6CC91B9E9696CF6'x ||,
'288E09CD7943257CED0AEF7F98451B34'x ||,
'DE2F8AEC08527146C99759D860BAD3B2'x ||,
'338F5104C51F5E2ED7A5735AC1D92647'x ||,
'CE7D7BF249DD704457A817279AC64C3F'x ||,
'ABA936628811DA89416B80AC6DBB372D'x ||,
'860CAAA7AE35B1DCB4745C96314E1602'x ||,
'F19D19B8653D9E7E0E752AD43CE57A01'x ||,
'9205565829B3EBE34D5495228163D532'x ||,
'071EA4A315CAE2CF9018A26F42EA3E1A'x ||,
'9B724FD04B83A0B03AA106949CE03BD2'x ||,
'E7BD84BF67BE93B79987BC0012C4DF4A'x ||,
'EED1E80D8276F5E62414C355CB770F68'x ||,
'858C8BAD2C10F740FAC76603F90BC8C0'x ||,
'E11DEB76B4ED9AAE978E416F3F2029FF'x ||,
'A2032470FED3F97E3575376A339DF2DA'x ||,
'52791E81CA3D54995948CF1BA74DE7E3'x ||,
'7702D51096A05B3C0468DB5DDEAAC594'x ||,
'C87BAD0AABF85E86280E2E57BB430BA3'x ||,
'49DF826417B52122BCC3AFA127140525'x ||,
'384012C2453A116EB2CB69BF6142CE85'x ||,
'3480EF90C0607C4CE26C5C445072FD4F'x ||,
'DD7F4788832FB995EC3E74D25A2B235F'x ||,
'BDA4D007C94A3B78F636A6AC19E0E413'x ||,
'C6D7F0847158EE7A9C890F8CB60CB0F7'x ||,
'46565500FB0DFAA887C765668B9373D6'x ||,
'E55108E6A59FB31C7DE8F332D9018D2D'x ||,
'C1F1CD4B061509532CF4B16DFC92B79B'x ||,
'BAF5161A8A39DCD4268F181FBE6BE9CC'x ||,
'63EA3067B8A9912A989ED8C431D14E62'x, arg( 1 ), 1 )