/* NT ooREXX */ /* Check physical drive partition table and any FAT boot records. */ /* There is no "fix" mode; this is not a repair tool. The script */ /* tries to identify unused sectors within existing partitions. */ /* MBR (master boot record), EBRs (MBRs of extended partitions), */ /* and FAT or NTFS boot sectors are copied to the log file. */ /* Limitations: */ /* - ooREXX 3.2 can seek to 2**31 -1 (maximal sector 2**22 -1). */ /* Beyond this 2GB limit the script reads chunks of 1 MB to */ /* emulate seek. Unfortunately this procedure is *VERY* slow. */ /* ooREXX 4.0.1 identified as REXX language level 6.03 does */ /* not have this problem. */ /* - The CHS output format is suited for disks up to 766 GB with */ /* a geometry of 255 heads and 63 sectors. It still works up */ /* to 7660 GB. Beyond that cylinder numbers are truncated. */ /* - The CHS input format for cylinder numbers treats 99999 as a */ /* "don't care" value; more cylinders are reduced to 99999. */ /* Any unpartitioned space at the end of a disk is only shown */ /* if CHS is specified with a cylinder number C < 99999. The */ /* script does not determine or check the physical disk size. */ /* - The sector size is fixed (512). Modify GSS = 512 below for */ /* other sector sizes (DVD: 2048; RAM disk: 32, 64, 128, etc.). */ /* Sector size 32 needs FAT12 cluster size 2 for DOS 5 RMDIR. */ /* - FORMAT /A:128K and FORMAT /A:256K require sector size 1024 */ /* or 2048 for the maximal FAT or NTFS cluster size 128 (80h). */ /* Fixes and features added in 2011-07 */ /* - The max. cluster numbers for FAT12/16/32 were "off by one", */ /* the limits are now hardwired as 4084, 65524, and 268435444. */ /* - Added partition type 27h "WinRE" for hidden windows recovery */ /* partition and file system NTFS. */ /* - exFAT uses ID 07 also used by NTFS. This is unsupported and */ /* should result in lots of "NTFS errors" for exFAT (untested). */ /* - UEFI disks start with a protective MBR (partition type EE), */ /* this is now reported, but checkMBR analyzes only MBR disks. */ /* - VFD (virtual floppy disk) and fixed VHD (virtual hard disk) */ /* files can now be given instead of a physical driver number. */ /* - The VHD footer CHS values are used to populate CHS if no CHS */ /* values are specified. Typically this will not match the CHS */ /* geometry of the raw disk image in the VHD. The warning for */ /* this mismatch can be ignored. Use CHS 99999 255 63 to avoid */ /* this warning for a (virtual) disk geometry * 255 63. */ /* - Hidden "+140" FreeDOS FDISK 0.9x IDs removed; 1.2x uses the */ /* known IDs for many years (notably no hidden extended 15/1F). */ /* - Hidden Linux extended partition ID 85 added, allowed in MBR */ /* for second or hidden chain of extended partitions: UNTESTED. */ /* - Errors for a broken unpartitioned FAT with seven sectors now */ /* handled. Don't try to fill removable media with dummy FATs, */ /* it triggers odd bugs in Windows 7 diskpart.exe among others. */ /* Fixes and features added in 2011-08 */ /* - Accept maximal CHS 1023 255 63, 1023 254 63, or 16383 15 63 */ /* for INT 13h geometries 1024 256|255 63 or ATA-5 16384 16 63. */ /* - The CHS geometry "guess" now picks the first plausible value */ /* instead of the "max. C+1 H+1 S values seen in MBR" geometry. */ /* - FAT32 and NTFS backup boot sector now checked, and reported */ /* if different. FAT32 info sector backup not checked. */ /* */ /* FAT considerations: */ /* Cluster numbers for FAT32 use 28 bits. This results in up to */ /* x2d( 0FFF FFF6 ) = 268435446 clusters including the two start */ /* entries for 0 and 1. Each FAT32 entry occupies 32 bits for a */ /* maximum of 2097152 FAT sectors. With x2d( 200000 ) = 2097152 */ /* the number of sectors per FAT in the boot sector does not fit */ /* into two bytes at offset 22 and was moved to offset 36 (32bit */ /* directly after the BIGFAT 32bit number of sectors). */ /* NTFS stores the number of sectors (excl. boot) as 64bit value */ /* at offset 40. FAT32 version 0 sticks to 32bit values and is */ /* therefore limited to max. 2048 GB (2 TB) for cluster size 16: */ /* FAT12 1 .. 4084 clusters: 1 .. 12 FAT sectors */ /* FAT16 4085 .. 65524 clusters: 16 .. 256 FAT sectors */ /* FAT32 65525 .. 268435444 clusters: 512 .. 2097152 FAT sectors */ /* FAT12 min.: 1 * 1 512 ( 0.5 KB) */ /* FAT16 min.: 1 * 4085 2,091,520 ( 2043 KB) */ /* FAT32 min.: 1 * 65525 33,548,800 (32763 KB) */ /* FAT12 max.: 64 * 4084 133,824,512 (~ 127 MB) */ /* [FAT12 max.: 128 * 4084 267,694,024 (~ 255 MB)] */ /* FAT16 max.: 64 * 65524 2,147,090,432 (~2147 MB) */ /* [FAT16 max.: 128 * 65524 4,294,180,864 (~4095 MB)] */ /* FAT32 max.: 8 * 268435444 1,099,511,578,624 (~1024 GB) */ /* FAT32 max.: 16 * 268173557 2,196,877,778,944 (~2046 GB) */ /* [FAT32 max.: 32 * 134152181 2,197,949,333,504 (~2047 GB)] */ /* [FAT32 max.: 64 * 67092469 2,198,486,024,192 (~2047 GB)] */ /* [FAT32 max.: 128 * 33550325 2,198,754,099,200 (~ 2 TB)] */ /* CHS considerations */ /* In 2002 ATA-6 stated that CHS addressing is obsolete. In fact */ /* the 24=10+8+6 INT 13h CHS bits or the 24=14+4+6 ATA-5 bits are */ /* pointless for disks with more than 8064 MB (sic!). Worse, the */ /* 32 bits LBA values in the MBR partition table can handle disks */ /* up to 2 TB for sector size 512. The "advanced format" using */ /* sector size 4096 still emulates logical size 512 (aka "512e"). */ /* MBRs don't record the disk geometry and sector size, therefore */ /* disks larger than 2 TB (2 TeraByte=2*1024*1024*1024*512 bytes) */ /* require the newer UEFI partitioning scheme. */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP /* ----------------- check arguments ------------------------- */ parse upper arg P C H S X ; numeric digits 20 GNOS = 0 ; GSPT = 0 GNOT = 99999 ; GSS = 512 EXPO = 'GPHYS GSEEK GNOT GNOS GSPT GSS' N = length( P ) select when N = 0 | sign( pos( '?', P )) then exit USAGE() when N = 1 then do if verify( P, '0123456789' ) then exit USAGE( P ) GPHYS = '\\.\PHYSICALDRIVE' || P end when sign( wordpos( P, '/h -h' )) then exit USAGE() otherwise if abbrev( P, '"' ) then parse arg '"' N '"' C H S X else parse arg N C H S X GPHYS = stream( strip( N ), 'c', 'query exists' ) if GPHYS = '' then exit USAGE( 'found no' N ) N = translate( substr( GPHYS, lastpos( '.', GPHYS ))) select when N = '.VHD' then do /* VHD requires ooREXX 4.x */ N = stream( GPHYS, 'c', 'query size' ) if wordpos( N // 512, 0 511 ) = 0 then exit usage( 'VHD size' N ) N = charin( GPHYS, N - 512 + 1 + sign( N // 512 ), 511 ) if C = '' then do C = c2d( substr( N, 56 + 1, 2 )) /* C in VHD C H S */ H = c2d( substr( N, 56 + 3, 1 )) /* H in VHD C H S */ S = c2d( substr( N, 56 + 4, 1 )) /* S in VHD C H S */ end N = c2d( substr( N, 56 + 5, 4 )) /* assert fixed 2 */ if N <> 2 then exit USAGE( 'not a fixed VHD' N ) end when N = '.VFD' then do N = stream( GPHYS, 'c', 'query size' ) if sign( N // GSS ) then exit USAGE( 'VFD size' N ) end otherwise exit USAGE( P 'is not a VFD/VHD or 0..9' ) end end if C <> '' then do if datatype( C, 'w' ) = 0 | C <= 0 then exit USAGE( C ) if datatype( H, 'w' ) = 0 | H <= 0 then exit USAGE( H ) if datatype( S, 'w' ) = 0 | S <= 0 then exit USAGE( S ) if S > 63 then exit USAGE( S '- use 1..63' ) if H > 256 then exit USAGE( H '- use 1..256' ) if X <> '' then exit USAGE( X ) if C > 1024 & C <= 16384 then do if H > 16 then exit USAGE( H '- use 1..16 for ATA' ) end GNOT = min( C, GNOT ) /* truncate to dummy 99999 */ GNOS = H ; GSPT = S end /* ----------------- read master boot record ----------------- */ INSEC = IN55AA( 0, 'partition table' ) if INSEC = '' then exit 1 /* access error not logged */ IN.1 = 0 BASE64( INSEC ) ; IN.0 = 1 EXPO = EXPO OPENLOG( arg( 1 )) /* open and expose LOGFILE */ if sign( wordpos( c2x( left( INSEC, 1 )), 'EB E9' )) then do X = substr( INSEC, 55, 8 ) /* check FAT12, FAT16, FAT */ N = abbrev( X, 'FAT' ) & right( X, 3 ) == ' ' X = substr( INSEC, 83, 8 ) /* check FAT32 (offset 82) */ if X == 'FAT32 ' | N then do if BOOTFAT( INSEC ) then exit STOPLOG() end /* unpartitioned FAT drive */ end if GSPT = 0 then do /* guessing drive geometry */ do N = 1 to 4 while GSPT = 0 X = DEPART( substr( INSEC, 431 + 16 * N, 16 )) parse var X . P C H S R D I T L if P = 00 | L = 0 | S = 0 | T = 0 | C = D then iterate N P = R + L - 1 do GNOS = 256 to 1 by -1 /* C <> D permits a guess, */ do GSPT = 63 to 8 by -1 /* assume 8 <= GSPT <= 63 */ if ( C H S R ) <> GEOPLUS( C H S, 0 ) then iterate X = GEOPLUS( C H S, L - 1 ) if ( D I T P ) = X then leave N if D < 1023 | GSPT <> 63 then iterate if ( D I T P ) = 1023 subword( X, 2 ) then leave N if GNOS <> I + 1 | GSPT <> T then iterate X = 1024 * 255 * 63 /* erroneous INT 13h limit */ if ( D I T ) = ( 1023 254 63 ) & P > X then leave N X = 1024 * 256 * 63 /* ATA-5 and INT 13h limit */ if ( D I T ) = ( 1023 255 63 ) & P > X then leave N if ( D I T ) = ( 16383 15 63 ) & P > X then leave N end GSPT end GNOS GSPT = 0 end N if GSPT < 8 then exit USAGE( 'try C H S = 99999 255 63' ) end X = right( GNOT, 5 ) right( GNOS, 3 ) right( GSPT, 2 ) N = c2x( reverse( substr( INSEC, 431 + 10, 4 ))) N = '[' || left( N, 4 ) || '-' || right( N, 4 ) || ']' IN.. = N ; X = X || ') id.' IN.. call OUTPUT DRIVE19( GPHYS ) '(assuming geometry CHS' X call OUTPUT ' MBR' LINEND( 0 0 1 0 0 0 1 1 ) /* ----------------- check partition table ------------------- */ BASE = 0 ; START = 0 NEXT = 1 ; EXTRA = 0 ID85 = 0 ; LINUX = 0 PART = 4 /* for extended partitions */ call DECODE INSEC, 0 ; S.0 = 0 do N = 1 to 4 parse var PART.N B ID C H S R D I T L X ERR = GEOPART( NEXT, R, ID, BASE ) select /* if start partition flag */ when START = 0 & B == 80 then do START = X ; X = X || ':*' || ID || ':' end when B <> 00 then do ERR = 1 ; X = X || ':?' || ID || ':' end otherwise X = X || ': ' || ID || ':' end if ID <> 00 then do Y = GEOTEST( C H S R D I T L, BASE ) parse var Y C H S D I T ; NEXT = R + L end else ERR = ERR | ( C + H + S + R + D + I + T + L <> 0 ) if FSTYPE( ID ) == '=> EXT' | ID == 85 then select when ID <> 85 & EXTRA <> 0 then ERR = 1 when ID == 85 & LINUX <> 0 then ERR = 1 when ID == 85 then do /* Linux (second) extended */ LINUX = R ; ID85 = NEXT end otherwise /* note extended partition */ EXTRA = R ; EXEND = NEXT end X = X LINEND( C H S R D I T L ) if ERR = 0 then do call OUTPUT X FSTYPE( ID ) ; K = S.0 + 1 S.K = ID C H S R D I T L BASE ; S.0 = K end else call OUTPUT X 'bad' /* dubious: skip TESTFAT() */ end N X = '' if GNOT <> 99999 then do /* assume GNOT is no dummy */ C = GNOT - 1 ; H = GNOS - 1 parse value GEOPLUS( C H GSPT, 1 ) with C H S R if GEOPART( NEXT, R, -1, BASE ) then X = 'bad' else NEXT = R end EXTRA = TOTALS( EXTRA, BASE, NEXT, X ) NEXT = 1 /* relative sector numbers */ /* ----------------- get extended partitions ----------------- */ do PART = PART while EXTRA <> 0 /* shown as 5+6, 6+7, etc. */ INSEC = IN55AA( EXTRA, 'extended partition' ) if INSEC = '' then leave PART parse value GEOPLUS( 0 0 1, EXTRA ) with C H S BASE call OUTPUT '=> EXT' LINEND( C H S 0 C H S 1 ) call DECODE INSEC, PART ; EXTRA = 0 N = IN.0 + 1 ; IN.0 = N IN.N = BASE BASE64( INSEC ) do N = 1 to 4 parse var PART.N B ID C H S R D I T L X ERR = GEOPART( NEXT, R, ID, BASE ) if B <> 00 then do /* dubious start partition */ ERR = 1 ; X = X || ':?' || ID || ':' end else X = X || ': ' || ID || ':' if ID <> 00 then do Y = GEOTEST( C H S R D I T L, BASE ) parse var Y C H S D I T ; NEXT = R + L end else ERR = ERR | ( C + H + S + R + D + I + T + L <> 0 ) if FSTYPE( ID ) = '=> EXT' then if EXTRA = 0 then EXTRA = R ; else ERR = 1 select /* expect one non-extended */ when N > 2 & ID <> 00 then ERR = 1 when N = 2 & ID == 00 then nop when N = 2 & EXTRA = 0 then ERR = 1 otherwise nop end X = X LINEND( C H S R D I T L ) select /* display partition entry */ when ERR then call OUTPUT X 'bad' when N > 2 then nop /* skip good empty entries */ otherwise /* only for good partition */ call OUTPUT X FSTYPE( ID ) K = S.0 + 1 ; S.0 = K S.K = ID C H S R D I T L BASE end end N X = '' if EXTRA = 0 then do /* check last unused space */ R = EXEND - BASE /* relative to actual BASE */ if GEOPART( NEXT, R, -1, BASE ) then X = 'bad' else NEXT = R end EXTRA = TOTALS( EXTRA, BASE, NEXT, X ) NEXT = 1 /* relative sector numbers */ end PART /* UNTESTED duplicated PART loop for Linux extended partition: */ EXTRA = LINUX ; EXEND = ID85 do PART = PART while EXTRA <> 0 /* shown as 5+6, 6+7, etc. */ INSEC = IN55AA( EXTRA, 'extended partition' ) if INSEC = '' then leave PART parse value GEOPLUS( 0 0 1, EXTRA ) with C H S BASE call OUTPUT '=> EXT' LINEND( C H S 0 C H S 1 ) call DECODE INSEC, PART ; EXTRA = 0 N = IN.0 + 1 ; IN.0 = N IN.N = BASE BASE64( INSEC ) do N = 1 to 4 parse var PART.N B ID C H S R D I T L X ERR = GEOPART( NEXT, R, ID, BASE ) if B <> 00 then do /* dubious start partition */ ERR = 1 ; X = X || ':?' || ID || ':' end else X = X || ': ' || ID || ':' if ID <> 00 then do Y = GEOTEST( C H S R D I T L, BASE ) parse var Y C H S D I T ; NEXT = R + L end else ERR = ERR | ( C + H + S + R + D + I + T + L <> 0 ) if FSTYPE( ID ) = '=> EXT' then if EXTRA = 0 then EXTRA = R ; else ERR = 1 select /* expect one non-extended */ when N > 2 & ID <> 00 then ERR = 1 when N = 2 & ID == 00 then nop when N = 2 & EXTRA = 0 then ERR = 1 otherwise nop end X = X LINEND( C H S R D I T L ) select /* display partition entry */ when ERR then call OUTPUT X 'bad' when N > 2 then nop /* skip good empty entries */ otherwise /* only for good partition */ call OUTPUT X FSTYPE( ID ) K = S.0 + 1 ; S.0 = K S.K = ID C H S R D I T L BASE end end N X = '' if EXTRA = 0 then do /* check last unused space */ R = EXEND - BASE /* relative to actual BASE */ if GEOPART( NEXT, R, -1, BASE ) then X = 'bad' else NEXT = R end EXTRA = TOTALS( EXTRA, BASE, NEXT, X ) NEXT = 1 /* relative sector numbers */ end PART /* ----------------- check FAT and NTFS boot records --------- */ X = 1 do N = 1 to S.0 if X then call OUTPUT ; X = TESTFAT( S.N ) end N exit STOPLOG() STOPLOG: procedure expose (EXPO) IN. /* save collected sectors */ if symbol( 'LOGFILE' ) = 'VAR' then do if symbol( 'IN..' ) = 'VAR' then do do N = 1 to IN.0 parse var IN.N K X ; K = right( K, 11 ) call lineout LOGFILE, '' ; K = K 'volume' IN.. || ':' call lineout LOGFILE, 'base 64 backup of sector' || K do until X == '' call lineout LOGFILE, ' ' left( X, 76 ) X = substr( X, 77 ) end end N call lineout LOGFILE ; X = chars( LOGFILE ) say IN.. 'output added to' LOGFILE '(size' X || ')' end end return 0 BOOTFAT: procedure expose (EXPO) IN. /* unpartitioned FAT drive */ parse arg INSEC /* TOTAL incl. boot sector */ X = '20 33 41' ; LEN = 1 do N = 1 to 3 until TOTAL <> 0 OFS = word( X, N ) ; LEN = 2 * LEN TOTAL = c2d( reverse( substr( INSEC, OFS, LEN ))) end if TOTAL = 0 then return 0 /* maybe not a boot sector */ if GSPT = 0 then do /* undefined disk geometry */ GSPT = c2d( reverse( substr( INSEC, 25, 2 ))) GNOS = c2d( reverse( substr( INSEC, 27, 2 ))) end if GSPT = 0 | GSPT > 63 | GNOS = 0 | GNOS > 256 then return 0 X = right( GNOT, 5 ) right( GNOS, 3 ) right( GSPT, 2 ) X = DRIVE19( GPHYS ) '(assuming geometry CHS' X || ')' call OUTPUT X 'UNPARTITIONED' parse value GEOPLUS( 0 0 1, TOTAL ) with C H S X return TESTFAT( '??' 0 0 1 0 C H S TOTAL 0 ) /* ?? for TESTFAT */ DRIVE19: procedure /* truncates long VHD path */ parse arg N /* (for first output line) */ if length( N ) > 19 then N = '...' || right( N, 16 ) return right( N, 19 ) FSTYPE: procedure /* simplified file system */ parse arg X /* names (often ambiguous) */ if X == 00 then return 'unused' if X == 01 | X == 11 then return 'FAT12' /* 11: hidden 01 */ if X == 04 | X == 14 then return 'FAT16' /* 14: hidden 04 */ if X == 05 | X == 0F then return '=> EXT' /* 05 CHS, 0F LBA */ if X == 06 | X == 16 then return 'bigFAT' /* 16: hidden 06 */ if X == 07 | X == 17 then return 'NTFS' /* could be HPFS */ if X == 27 then return 'NTFS' /* WinRE (hidden) */ if X == 0A then return 'bootOS' /* OS/2 manager */ if X == 0B | X == 1B then return 'FAT32' /* CHS (C < 1024) */ if X == 0C | X == 1C then return 'FAT32' /* LBA FAT32 */ if X == 0E | X == 1E then return 'VFAT' /* LBA bigFAT */ if X == 12 | X == 98 then return 'ROMDOS' /* (98 can be 0C) */ if X == 42 then return 'W2Kdyn' /* (could be SFS) */ if X == 80 | X == 81 then return 'Minix' /* 80: NTFT (?) */ if X == 85 then return 'LinEXT' /* Linux extended */ if X == 'A8' then return 'Darwin' /* Darwin UFS (?) */ if X == 'DB' then return 'CP/M' /* concurrent DOS */ if X == 'DE' then return 'DELL' /* apparently FAT */ if X == 'EE' then return '(EFI)' /* EFI pseudo-MBR */ if X == 'EF' then return 'EFIFAT' /* EFI (12/16/32) */ if sign( wordpos( X, '82 83 8E' )) then return 'Linux' if sign( wordpos( X, '63 A5 A6 A9' )) then return 'Unix' if sign( wordpos( X, '65 67 68 69' )) then return 'Novell' if sign( wordpos( X, 'BE BF' )) then return 'SolSun' if sign( wordpos( X, ' C0 D0' )) then return 'Real32' if sign( wordpos( X, ' CF C5 D5' )) then return 'SecExt' if sign( wordpos( X, ' C1 D1 E1' )) then return 'FAT12' if sign( wordpos( X, '84 C4 D4 E4' )) then return 'FAT16' if sign( wordpos( X, '86 B6 C6 D6' )) then return 'bigFAT' if sign( wordpos( X, '87 B7 C7 D7' )) then return 'NTFS' if sign( wordpos( X, '8B 8C BC CB CC' )) then return 'FAT32' if sign( wordpos( X, 'E2 E3' )) then return 'r/oDOS' if sign( wordpos( X, '02 03 FF' )) then return 'Xenix' return '' TESTFAT: procedure expose (EXPO) IN. /* check FATxx boot sector */ arg P C H S R D I T L AS ; AS = AS + R Q = P /* keep original ID in P */ if sign( wordpos( Q, '12 98 C0 D0 DB DE E2 E3 EF' )) then Q = '??' /* undetermined FAT values */ N = '1B 1C 1E CB CC CE' /* hidden form of 0B 0C 0E */ N = N '8B 8C BC CB CC' /* handle as 0B 0C FAT32 ? */ N = N '11 E1 C1 D1' /* interpret as 01 FAT12 */ N = N '14 E4 84 C4 D4' /* interpret as 04 FAT16 */ N = N '16 E6 86 B6 C6 D6' /* interpret as 06 BIGFAT */ N = N '17 27 87 B7 C7' /* interpret as 07 NTFS */ N = wordpos( Q, N ) if 0 < N then Q = overlay( 0, Q ) /* 0[1467BCE] : ?[1467BCE] */ FAT = ( Q <> 07 ) /* 0: NTFS or HPFS, 1: FAT */ if FAT > pos( Q, '01 04 06 0B 0C 0E ??' ) then return 0 PRINT = xrange( x2c( 20 ), x2c( 7E )) /* ----------------- read FAT boot sector -------------------- */ TAG = right( FSTYPE( P ), 6 ) call OUTPUT TAG LINEND( C H S AS D I T L ) INSEC = IN55AA( AS, TAG 'boot record' ) if INSEC = '' then return 1 /* 1: some lines written */ select /* FAT32 or NTFS are HUGE: */ when sign( wordpos( Q, '07 0B 0C' )) then HUGE = 1 when sign( wordpos( Q, '01 04 06 0E' )) then HUGE = 0 otherwise HUGE = ( 'FAT' <> substr( INSEC, 55, 3 )) end /* ----------------- collect BPB values ---------------------- */ EB = c2x( ( substr( INSEC, 1, 1 ))) /* EB (jmp short) */ EC = ( ( substr( INSEC, 2, 2 ))) /* EB offset, nop */ XT = ( ( substr( INSEC, 4, 8 ))) /* NTFS / OEM id. */ SL = c2d( reverse( substr( INSEC, 12, 2 ))) /* sector length */ CS = c2d( ( substr( INSEC, 14, 1 ))) /* cluster size */ BS = c2d( reverse( substr( INSEC, 15, 2 ))) /* res. sectors */ FN = c2d( ( substr( INSEC, 17, 1 ))) /* FAT copies */ RN = c2d( reverse( substr( INSEC, 18, 2 ))) /* root entries */ VS = c2d( reverse( substr( INSEC, 20, 2 ))) /* 16bit sectors */ F8 = c2x( ( substr( INSEC, 22, 1 ))) /* F8 (media id.) */ FS = c2d( reverse( substr( INSEC, 23, 2 ))) /* FAT1x sectors */ TS = c2d( reverse( substr( INSEC, 25, 2 ))) /* track sectors */ HN = c2d( reverse( substr( INSEC, 27, 2 ))) /* head number */ HS = c2d( reverse( substr( INSEC, 29, 4 ))) /* hid. sectors */ WS = c2d( reverse( substr( INSEC, 33, 4 ))) /* 32bit sectors */ FX = c2d( reverse( substr( INSEC, 37, 4 ))) /* FAT32 sectors */ FF = ( reverse( substr( INSEC, 41, 2 ))) /* FAT32 flags */ VX = c2d( reverse( substr( INSEC, 43, 2 ))) /* FAT32 version */ RX = c2d( reverse( substr( INSEC, 45, 4 ))) /* FAT32 root (2) */ IX = c2d( reverse( substr( INSEC, 49, 2 ))) /* FAT32 info (1) */ BX = c2d( reverse( substr( INSEC, 51, 2 ))) /* FAT32 copy (6) */ R1 = c2x( ( substr( INSEC, 53, 12 ))) /* FAT32 reserved */ DL = c2x( ( substr( INSEC, 65, 1 ))) /* INT13 DL 00/80 */ CD = c2d( ( substr( INSEC, 66, 1 ))) /* chkdsk 0,1,2,3 */ MX = c2x( ( substr( INSEC, 67, 1 ))) /* magic 29 or 28 */ SX = c2x( reverse( substr( INSEC, 68, 4 ))) /* volume serial */ LX = ( ( substr( INSEC, 72, 11 ))) /* volume label */ TX = ( ( substr( INSEC, 83, 8 ))) /* volume FSType */ IP = 91 - 1 /* normal boot code offset */ if FAT & HUGE & FS = 0 then FS = FX /* FAT32 sectors */ if FAT < HUGE then do /* adjust values for NTFS: */ TX = XT /* no OEM id.: "NTFS " */ drop MX LX /* no magic, no vol. label */ DL = c2x( substr( INSEC, 37, 1 )) /* INT13 DL 00/80 */ CD = c2d( substr( INSEC, 38, 1 )) /* chkdsk 0,1,2,3 */ X = c2x( substr( INSEC, 39, 2 )) /* boot code data */ if WS + VS = 0 then do /* 64bit sectors: */ WS = c2d( reverse( substr( INSEC, 41, 8 ))) end /* not used here: */ X = c2d( reverse( substr( INSEC, 49, 8 ))) /* cl. to MFT1 */ X = c2d( reverse( substr( INSEC, 57, 8 ))) /* cl. to MFT2 */ X = c2d( reverse( substr( INSEC, 65, 4 ))) /* cl. per FRS */ X = c2d( reverse( substr( INSEC, 69, 4 ))) /* cl. per IB */ SX = c2x( reverse( substr( INSEC, 73, 4 ))) /* vol. serial */ X = c2x( ( substr( INSEC, 77, 4 ))) /* unclear */ X = c2d( reverse( substr( INSEC, 81, 4 ))) /* (0) unclear */ IP = 85 - 1 /* normal boot code offset */ end if FAT > HUGE then do /* adjust values for FAT1x */ DL = c2x( substr( INSEC, 37, 1 )) /* INT13 DL 00/80 */ CD = c2d( substr( INSEC, 38, 1 )) /* chkdsk 0,1,2,3 */ MX = c2x( substr( INSEC, 39, 1 )) /* magic 29 or 28 */ SX = c2x( reverse( substr( INSEC, 40, 4 ))) /* vol. serial */ LX = ( substr( INSEC, 44, 11 )) /* volume label */ TX = ( substr( INSEC, 55, 8 )) /* volume FSType */ if MX = 29 | MX = 28 then IP = 63 - 1 /* DOS 4+ offset */ else IP = 39 - 1 /* DOS 3.x offset */ end /* ----------------- plausibility checks --------------------- */ if EB <> 'EB' & EB <> 'E9' then do X = 'boot record does not start with jump EBxxxx, got' call OUTPUT X EB || c2x( EC ) /* unusual CD 18 (INT 18h) */ end /* not yet supported here */ else do if EB = 'EB' then N = 2 + c2d( left( EC, 1 ), 1 ) else N = 3 + c2d( reverse( EC ), 2 ) if N < IP then do /* zero-based code offsets */ X = 'unexpected boot code offset' N '<' IP 'in' call OUTPUT X EB || c2x( EC ) end end if TS <> GSPT | HN <> GNOS then do /* (not necessarily fatal) */ X = 'CHS *' HN TS 'does not match geometry CHS *' GNOS GSPT call OUTPUT X end N = wordpos( CS, 1 2 4 8 16 32 64 128 ) if N = 0 then do /* cluster size (critical) */ X = 'expected cluster size 1, 2, 4, ..., 128; got' CS if F8 <> 'F8' | ( EB <> 'EB' & EB <> 'E9' ) then return OUTPUT( 'analysis aborted:' X ) call OUTPUT X /* continue if F8 + EB ok. */ end if SL <> GSS then do /* 1024 for 128 KB cluster */ X = 'sector length' SL 'wrong or unsupported, assuming' GSS call OUTPUT X end if HUGE | FAT then do /* assume NTFS or any FAT: */ if WS = 0 | VS = 0 then nop ; else do X = 'inconsistent or redundant 16/32/64-bit sectors' VS WS call OUTPUT X end if WS = 0 then WS = VS ; VS = sign( VS ) RS = ( 32 * RN + GSS - 1 ) % GSS /* FAT1x root dir. sectors */ if FAT then DS = WS - BS - FN * FS - RS else if BS + FN + RN + VS + FS = 0 then do DS = WS - 1 ; WS = WS + 1 BS = 1 /* get FAT values for NTFS */ end else do /* unexpected HPFS or NTFS */ X = 'expected (offset 14)' right( F8, 16, 0 ) || '0000,' call OUTPUT X 'got' c2x( substr( INSEC, 15, 10 )) X = 'unexpected non-zero values in NTFS / HPFS boot sector' return OUTPUT( 'analysis aborted:' X ) end if HS <> R | WS <> L then do /* (not necessarily fatal) */ X = 'hidden or total sectors' HS WS 'do not match' R L call OUTPUT X end if CD > 3 | ( DL <> 00 & DL <> 80 ) then do X = 'expected INT 13 disk 80' /* just for the records... */ X = X 'or 00 and AUTOCHK flags 00..03, got' DL d2x( CD, 2 ) call OUTPUT X end if DS < 0 then do X = 'less than 0 NTFS or FAT data sectors are not possible' return OUTPUT( 'analysis aborted:' X ) end MC = DS % CS + 1 ; U2 = L - WS U1 = DS + CS - MC * CS ; DS = DS - U1 end /* ----------------- check FAT type -------------------------- */ if FAT then do select when DS = 0 & FS = 0 & RS = 0 then nop when DS > 0 & FS > 0 & RS > 0 then nop when DS = 0 then do X = 'no data:' FN * FS + RS 'unused FAT + dir. sectors' call OUTPUT X end when FS = 0 then do call OUTPUT 'missing FAT sectors (' || FN 'copies)' end when HUGE then nop when RS = 0 then do X = 'missing root directory for' DS 'data sectors' call OUTPUT X end end /* otherwise raise SYNTAX */ select /* -------------- 4084 --- */ when MC < x2d( 00FF6 ) then do Q = FSMATCH( MC, P, Q, 01 ) M = 3 * ( MC + 2 ) % 2 - 1 /* M bytes per FAT, Q = 12 */ end /* ------------- 65524 --- */ when MC < x2d( 0FFF6 ) & VS then do Q = FSMATCH( MC, P, Q, 04 ) M = 2 * ( MC + 1 ) /* M bytes per FAT, Q = 16 */ end /* ------------- 65524 --- */ when MC < x2d( 0FFF6 ) then do Q = FSMATCH( MC, P, Q, 06, 0E ) M = 2 * ( MC + 1 ) /* M bytes per FAT, Q = 16 */ end /* --------- 268435444 --- */ when MC < x2d( 0FFFFFF6 ) then do Q = FSMATCH( MC, P, Q, 0B, 0C ) M = 4 * ( MC + 1 ) /* M bytes per FAT, Q = 32 */ end /* ------- FAT32 limit --- */ otherwise /* FAT32 uses only 28 bits */ Q = FSMATCH( MC, P, Q, 0B, 0C ) J = MC ; MC = x2d( 0FFFFFF5 ) N = CS * ( J - MC ) ; DS = DS - N X = 'max. cluster' J 'too big for' FSTYPE( 0B ) call OUTPUT X || ', assuming' MC X = N 'data sectors added to' U1 'unused sectors' call OUTPUT X ; U1 = U1 + N M = 4 * ( MC + 1 ) /* M bytes per FAT assumed */ end M = FS - ( M + GSS - 1 ) % GSS ; J = ( FS * GSS * 8 ) % Q if M > 0 then do X = 'the last' M 'of' FS 'FAT' || Q 'sectors are not used' call OUTPUT X end if M < 0 then do M = CS * ( MC - J ) ; DS = DS - M X = 'max. cluster' MC 'exceeds' FS 'FAT' || Q 'sectors:' call OUTPUT X call OUTPUT M 'data sectors added to' U1 'unused sectors' MC = J ; U1 = U1 + M end if MC > J then exit TRAP( 'assertion' MC '<=' J 'failed' ) end /* ----------------- check filesystem name ------------------- */ select /* FAT32 always has FSType */ when FAT < HUGE then X = 'NTFS' when FAT & HUGE then X = 'FAT32' when FAT & ( MX = 29 | MX = 28 ) then X = 'FAT' || Q otherwise X = '' end /* FAT1x only for MX 29/28 */ if X = '' then LX = '' ; else do J = FAT & TX = left( 'FAT', 8 ) ; X = left( X, 8 ) if 0 = ( TX = X | J ) then do X = 'expected FSType string "' || X || '", got' if sign( verify( TX, PRINT )) then call OUTPUT X 'non-ASCII' c2x( TX ) else call OUTPUT X '"' || TX || '"' end /* maybe critical for NTFS */ SX = '[' || left( SX, 4 ) || '-' || right( SX, 4 ) || ']' select /* NTFS: LX + MX undefined */ when FAT = 0 then LX = SX when sign( verify( LX, PRINT )) then LX = SX when LX = '' | LX = 'NO NAME' then LX = SX otherwise nop /* use meaningful label LX */ end /* or put decoded SX in LX */ end /* DOS 3.x had no SX or LX */ /* ----------------- FAT32 checks ---------------------------- */ if FAT & ( HUGE | Q = 32 ) then do N = 0 /* spurious error counter */ if RX < 2 | MC <= RX then do /* is FAT1x RX = 0 legal ? */ X = 'FAT32 root dir. cluster' RX 'outside of 2..' || MC N = N + OUTPUT( X ) end if BX = 65535 then BX = -1 /* allegedly -1 is allowed */ if IX = 65535 then IX = -1 /* maybe 0 is not allowed */ if BX <= 0 & IX <= 0 then do /* ----------------------- */ X = 'no FAT32 info (' || IX || ')' X = X 'and backup (' || BX || ') sectors' N = N + OUTPUT( X ) end else if BX <= 0 then do X = 'no FAT32 backup sectors (' || BX || ')' N = N + OUTPUT( X ) end else if IX <= 0 then do X = 'no FAT32 info sector (' || IX || ')' N = N + OUTPUT( X ) end /* ----------------------- */ if 0 < BX then X = BX ; else X = BS if X <= IX & 0 < IX then do X = 'FAT32 info sector' ( 1 + IX ) 'outside of 1..' || X N = N + OUTPUT( X ) /* show BX <= IX if 0 < BX */ end /* show BS <= IX if BX < 1 */ if BS < 2 * BX then do X = ( 1 + BX ) || '..' || ( 2 * BX ) X = 'FAT32 backup sectors' X 'outside of 1..' || BS N = N + OUTPUT( X ) end if VX <> 0 then do X = 'FAT32 version' VX 'wrong or unsupported, assuming 0' N = N + OUTPUT( X ) end else if R1 <> 0 then do X = 'FAT32 reserved bytes not zero, got hex.:' R1 N = N + OUTPUT( X ) end if bitand( FF, x2c( 'FF78' )) <> x2c( 0000 ) then do X = 'FAT32 reserved mirroring bits not zero, got' c2x( FF ) N = N + OUTPUT( X ) end X = c2d( bitand( FF, x2c( 0007 ))) + 1 if bitand( FF, x2c( 0080 )) = x2c( 0080 ) & X > FN then do X = 'FAT32 active FAT' X 'greater than number of FATs' FN N = N + OUTPUT( X ) end if HUGE <> ( Q = 32 ) then do /* Q = 32 can be wrong for */ if sign( N ) /* invalid max. cluster MC */ then X = 'ignore' N 'reported FAT32 issues if n/a' else X = 'all FAT32 tests confirm file system FAT32' call OUTPUT X /* Q = 32 can be valid for */ end /* erroneous partition id. */ end /* ----------------- show volume layout ---------------------- */ TAG = 'boot' ; R = AS SEC = 0 if FAT & HUGE & 0 < BX & 2 * BX <= BS then do parse value GEOAREA( C H S AS BX TAG ) with C H S AS TAG = 'backup boot' ; BS = BS - BX SEC = AS parse value GEOAREA( C H S AS BX TAG ) with C H S AS TAG = 'rest boot' ; BS = BS - BX end parse value GEOAREA( C H S AS BS TAG ) with C H S AS do N = 1 to FN TAG = 'FAT' || Q '#'|| N parse value GEOAREA( C H S AS FS TAG ) with C H S AS end N if RS * GSS = RN * 32 then TAG = 'dir.' right( RN, 6 ) else TAG = 'dirty' right( RN, 6 ) parse value GEOAREA( C H S AS RS TAG ) with C H S AS parse value GEOAREA( C H S AS DS 'data' ) with C H S AS parse value GEOAREA( C H S AS U1 'unused' ) with C H S AS N = ( HUGE > FAT ) ; if N then SEC = AS parse value GEOAREA( C H S AS N 'backup boot' ) with C H S AS if SEC > 0 then do X = right( FSTYPE( P ), 6 ) 'backup boot' if IN55AA( SEC, X ) <> INSEC then do call OUTPUT 'backup boot sector does not match boot sector' end end /* ----------------- cluster summary ------------------------- */ N = right( LX '(cluster size' right( CS, 3 ), 29 ) N = left( N || ', number' right( MC - 1, 10 ) || ')', 55 ) call OUTPUT N 'total' || right( WS, 11 ) parse value GEOAREA( C H S AS U2 'unused raw' ) with C H S AS if symbol( 'IN..' ) = 'VAR' then do N = IN.0 + 1 ; IN.0 = N IN.N = R BASE64( INSEC ) /* backup of boot sector R */ end else if LX <> '' then IN.. = SX /* unpartitioned volume SX */ else IN.. = left( 'DOS 3.x', 11 ) /* unpartitioned garbage ? */ return 1 /* 1: some lines written */ FSMATCH: procedure expose (EXPO) /* check expected FAT type */ parse arg MC, P, Q, ID, ID2 /* if given ID2 is for LBA */ if Q <> '??' & Q <> ID & Q <> ID2 then do Q = ID overlay( 1, ID ) /* add hidden 1x to id. 0x */ if arg() = 5 then Q = Q ID2 overlay( 1, ID2 ) Q = space( Q, 1, '/' ) /* 0x/1x/... for 0x 1x ... */ Q = 'max. cluster' MC 'requires type' Q Q = Q '(' || FSTYPE( ID ) || '), got' P call OUTPUT Q end select when ID = 01 then return 12 when ID = 04 | ID = 06 | ID = 0E then return 16 when ID = 0B | ID = 0C then return 32 end /* otherwise raise SYNTAX */ IN55AA: procedure expose (EXPO) /* seek, read, test sector */ parse arg SECTOR, MAGIC ; S = GSS * SECTOR + 1 signal on halt name IN55AA.? ; signal off notready if symbol( 'GSEEK' ) <> 'VAR' then do call charin GPHYS, 1, 0 ; L = stream( GPHYS, 'd' ) if L == 'ERROR:0' then call charin GPHYS, 1, 0 GSEEK = ( 'READY' == stream( GPHYS )) end if S <> GSEEK & GSEEK > 0 then do parse version . L . /* ooREXX 3.2 limit 2 GB */ if 6.03 <= L then L = S /* ooREXX 4.0.1 unlimited */ else L = min( S, 2 ** 31 - GSS + 1 ) if S < GSEEK | GSEEK < L then GSEEK = stream( GPHYS, 'c', 'seek' L ) else L = GSEEK if L < S & L = GSEEK then do N = 20 to 6 by -1 L = 2 ** N do while GSEEK + L <= S /* call stream GPHYS, 'c', 'seek + ' L */ /* if stream( GPHYS ) <> 'READY' then leave N */ if length( charin( GPHYS,, L )) <> L then leave N GSEEK = GSEEK + L P = right((( GSEEK - 1 ) % GSS ), 37 ) call charout 'stderr', d2c( 13 ) || P || d2c( 13 ) end end N /* S = GSEEK or seek error */ end if S = GSEEK then do INSEC = charin( GPHYS,, GSS ) if length( INSEC ) = GSS then do GSEEK = S + GSS /* save new GSEEK position */ if right( INSEC, 2 ) == x2c( 55AA ) then return INSEC MAGIC = MAGIC 'magic 55AA not found' call OUTPUT MAGIC ; return '' end end /* else drop to seek error */ IN55AA.?: /* catch HALT during seek, */ signal on halt name TRAP /* show state + condition: */ S = stream( GPHYS, 'd' ) condition( 'c' ) call OUTPUT '' GPHYS 'sector' || right( SECTOR, 11 ) S call stream GPHYS, 'c', 'close' ; call charin GPHYS, 1, 0 GSEEK = 'READY' == stream( GPHYS ) ; return '' TOTALS: procedure expose LOGFILE /* next extended partition */ arg E, B, N ; X = left( '', 55 ) if E <> 0 then do E = E + B /* show abs. sector number */ X = right( '(extended offset' || right( E, 11 ), 37 ) X = left( X || ')', 55 ) end X = X 'total' || right( N, 11 ) ; call OUTPUT X return E /* sector number (0 first) */ DECODE: procedure expose PART. /* decode and sort part.s: */ parse arg INSEC, PART do N = 1 to 4 /* decode PART.1 .. PART.4 */ X = DEPART( substr( INSEC, 431 + 16 * N, 16 )) PART.N = X ( PART + N ) ; R = word( X, 6 ) if R > 0 then do K = 1 to N - 1 /* sort by start sector R: */ X = word( PART.K, 6 ) ; if X < R then iterate K R = X ; X = PART.N PART.N = PART.K ; PART.K = X end K end N return /* result PART.1 .. PART.4 */ DEPART: procedure /* decode partition entry: */ parse arg 1 B 2 H 3 S 4 C 5 P 6 I 7 T 8 D 9 R 13 L 17 B = c2x( B ) ; P = c2x( P ) H = c2d( H ) ; I = c2d( I ) S = x2b( c2x( S )) ; T = x2b( c2x( T )) C = x2b( c2x( C )) ; D = x2b( c2x( D )) C = left( S, 2 ) || C ; D = left( T, 2 ) || D S = overlay( 00, S ) ; T = overlay( 00, T ) S = x2d( b2x( S )) ; T = x2d( b2x( T )) C = b2x( 0000 00 || C ) ; D = b2x( 0000 00 || D ) C = x2d( C ) ; D = x2d( D ) R = c2d( reverse( R )) ; L = c2d( reverse( L )) return B P C H S R D I T L LINEND: procedure /* unique CHS text format */ arg C H S R D I T L R = right( R, 11 ) ; L = right( L, 11 ) C = right( C, 6 ) ; D = right( D, 6 ) C = C right( H, 3 ) ; D = D right( I, 3 ) C = C right( S, 2 ) ; D = D right( T, 2 ) return 'CHS' || C 'at' || R || ', end' || D || ', size' || L GEOTEST: procedure expose (EXPO) /* adjust C H S above 8 GB */ arg C H S R D I T L, BASE ; E = R + L - 1 M = 1023 ; G = M 255 63 if M < GNOT & GSPT = 63 then select when GNOS = 255 then G = M 254 63 when GNOS <> 16 then G = M 255 63 otherwise M = 16383 ; G = M 15 63 end /* 16383 for ATA-5 GNOS 16 */ X = GEOPLUS( 0 0 1, BASE + R ) /* ignore G = C H S start: */ X = subword( X, 1, 3 ) ; parse var X W V if V = ( H S ) & C < W & C = M then C = W if G = ( C H S ) & C < W then parse var X C H S Y = GEOPLUS( 0 0 1, BASE + E ) /* ignore G = D I T end: */ Y = subword( Y, 1, 3 ) ; parse var Y W V if V = ( I T ) & D < W & D = M then D = W if G = ( D I T ) & D < W then parse var Y D I T if X <> ( C H S ) | Y <> ( D I T ) then do call OUTPUT 'adjust' LINEND( C H S R D I T L ) '?' end return X Y GEOPART: procedure expose (EXPO) /* detect reserved sectors */ arg NEXT, R, ID, BASE, TAG /* linear relative to BASE */ if R < NEXT then return ID <> 00 if R = NEXT then return 0 /* 0: no overlap or ID 00 */ parse value GEOPLUS( 0 0 1, BASE + NEXT ) with C H S . parse value GEOPLUS( 0 0 1, BASE + R - 1 ) with D I T . call OUTPUT 'unused' LINEND( C H S NEXT D I T ( R - NEXT )) TAG return 0 GEOAREA: procedure expose (EXPO) /* BS sectors start at CHS */ parse arg C H S AS BS TAG NOTE /* asserts linear AS = CHS */ if BS = 0 then return C H S AS /* BS = 0 silently ignored */ parse value GEOPLUS( C H S, ( BS - 1 )) with D I T L X = right( TAG, 6 ) LINEND( C H S AS D I T BS ) NOTE call OUTPUT X if L + 1 <> AS + BS then exit TRAP( 'LBA' L + 1 ) return GEOPLUS( D I T, 1 ) GEOPLUS: procedure expose (EXPO) /* CHS + N sectors to CHS */ call trace 'O' ; arg C H S, N N = GNOS * GSPT * C + GSPT * H + ( S - 1 ) + N S = N // GSPT ; C = ( N - S ) % GSPT H = C // GNOS ; C = ( C - H ) % GNOS if N < 0 then exit TRAP( 'LBA' N ) ; return C H ( S + 1 ) N OUTPUT: procedure expose LOGFILE /* add output to a LOGFILE */ signal on notready name TRAP ; say arg( 1 ) if symbol( 'LOGFILE' ) = 'VAR' /* else LOGFILE not opened */ then call lineout LOGFILE, strip( arg( 1 ), 'T' ) return 1 /* 1: some lines written */ OPENLOG: procedure expose LOGFILE /* create / append LOGFILE */ parse source . . THIS ; L = lastpos( '.', THIS ) if L > 0 then L = left( THIS, L ) || 'log' else L = THIS || '.log' signal off notready /* example: read-only disk */ if lineout( L, copies( '-', 79 )) then do signal on notready name TRAP /* stderr write error trap */ call lineout 'stderr', 'no write access on logfile' L return '' /* LOGFILE stays undefined */ end signal on notready name TRAP ; LOGFILE = L parse value date( 'S' ) time() with I 5 S 7 O T call lineout LOGFILE, I || '-' || S || '-' || O T THIS arg( 1 ) return 'LOGFILE' /* add this to EXPO string */ USAGE: procedure say if arg( 1 ) <> '' then say 'error:' arg( 1 ) parse source . . THIS say 'usage:' THIS '0..9|VHD [C H S]' say 'for physical drive 0..9 or a fixed VHD' say 'virtual hard disk with geometry C H S.' say say 'Use S = 1..63 (sectors per track) and' say 'H = 1..256 heads. You can omit C H S;' say 'the script can "guess" values for H S.' say 'Use C = 99999 if only H + S are clear.' return 1 BASE64: procedure /* trace Off for trusted B64.O */ call trace 'O' ; return B64.O( arg( 1 )) /* see REXX (version 1.6) */ B64.O: procedure /* string to (unlimited) base64: */ B64 = 'abcdefghijklmnopqrstuvwxyz' B64 = translate( B64 ) || B64 || '0123456789+/' SRC = x2b( c2x( arg( 1 ))) ; DST = '' ADD = ( length( SRC ) / 4 ) // 3 SRC = SRC || copies( '00', ADD ) do while SRC <> '' parse var SRC N 7 SRC ; N = x2d( b2x( N )) DST = DST || substr( B64, N + 1, 1 ) end return DST || copies( '=', ADD ) /* see , (c) F. Ellermann */ TRAP: /* select REXX exception handler */ call trace 'O' ; trace N /* don't trace interactive */ parse source TRAP /* source on separate line */ TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A ) TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */ TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' )) select when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do if condition( 'd' ) > '' /* need an additional line */ then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP '(RC' rc || ')' /* any system error codes */ if condition( 'c' ) = 'FAILURE' then rc = -3 end when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do if condition( 'c' ) = 'HALT' then rc = 4 if condition( 'd' ) > '' & condition( 'd' ) <> rc then do if condition( 'd' ) <> errortext( rc ) then do TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP errortext( rc ) end /* future condition( 'd' ) */ end /* may use errortext( rc ) */ else TRAP = TRAP errortext( rc ) rc = -rc /* rc < 0: REXX error code */ end when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */ when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */ otherwise /* force non-zero whole rc */ if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1 if rc = 0 then rc = 1 if condition() = '' then TRAP = TRAP arg( 1 ) end /* direct: TRAP( message ) */ TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 ) signal on syntax name TRAP.SIGL /* throw syntax error 3... */ if 0 < sigl & sigl <= sourceline() /* if no handle for source */ then TRAP = TRAP '*-*' strip( sourceline( sigl )) else TRAP = TRAP '+++ (source line unavailable)' TRAP.SIGL: /* ...catch syntax error 3 */ if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc end select when 0 then do /* in pipes STDERR: output */ parse version TRAP.REXX /* REXX/Personal: \dev\con */ if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ , 6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR' else TRAP.REXX = '\dev\con' signal on syntax name TRAP.FAIL call lineout TRAP.REXX , TRAP /* fails if no more handle */ end when 1 then do /* OS/2 PM or ooREXX on NT */ signal on syntax name TRAP.FAIL call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ , 'Trap' time(),, 'ERROR' end otherwise say TRAP ; trace ?L /* interactive Label trace */ end if condition() = 'SIGNAL' then signal TRAP.EXIT TRAP.CALL: return rc /* continue after CALL ON */ TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */ TRAP.EXIT: exit rc /* exit for any SIGNAL ON */