├── OMFVIEW.EXE ├── OMFVIEW.PNG ├── RDFVIEW.EXE ├── RDFVIEW.PNG ├── MAKEFILE ├── README.MD ├── LICENSE ├── STRUTIL.PAS ├── OBJ.PAS ├── SCR.PAS ├── OMFVIEW.PAS └── RDFVIEW.PAS /OMFVIEW.EXE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DosWorld/objview/HEAD/OMFVIEW.EXE -------------------------------------------------------------------------------- /OMFVIEW.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DosWorld/objview/HEAD/OMFVIEW.PNG -------------------------------------------------------------------------------- /RDFVIEW.EXE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DosWorld/objview/HEAD/RDFVIEW.EXE -------------------------------------------------------------------------------- /RDFVIEW.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DosWorld/objview/HEAD/RDFVIEW.PNG -------------------------------------------------------------------------------- /MAKEFILE: -------------------------------------------------------------------------------- 1 | all: OMFVIEW.EXE RDFVIEW.EXE 2 | 3 | RDFVIEW.EXE: RDFVIEW.PAS SCR.PAS STRUTIL.PAS 4 | TPC -B RDFVIEW.PAS 5 | 6 | OMFVIEW.EXE: OMFVIEW.PAS OBJ.PAS SCR.PAS STRUTIL.PAS 7 | TPC -B OMFVIEW.PAS 8 | 9 | clean: 10 | DEL *.tpu 11 | DEL *.bak 12 | -------------------------------------------------------------------------------- /README.MD: -------------------------------------------------------------------------------- 1 | # Object file viewers 2 | 3 | Here is MS-DOS tools for investigation object formats: 4 | 5 | * omfview - OBJ/LIB files in OMF format. 6 | * rdfview - OBJ files in RDOFF2 format (NASM version 0.98.39). 7 | 8 | # Using 9 | 10 | omfview objfile.obj 11 | rdfview rdffile.rdf 12 | 13 | or 14 | 15 | omfview "Long file name.obj" 16 | rdfview "Long file name.rdf" 17 | 18 | # Screenshots 19 | 20 | OMFView : 21 | 22 | ![Image Screenshot - OMFVIEW main screen](https://github.com/DosWorld/omfview/raw/main/OMFVIEW.PNG) 23 | 24 | RDFView : 25 | 26 | ![Image Screenshot - RDFVIEW main screen](https://github.com/DosWorld/omfview/raw/main/RDFVIEW.PNG) 27 | 28 | # Dependencies 29 | 30 | Requires System2 library: 31 | 32 | https://github.com/DosWorld/libsystem2 33 | 34 | # Build 35 | 36 | You need Turbo Pascal and my small make in path. 37 | Just type: 38 | 39 | make 40 | 41 | # License 42 | 43 | MIT License 44 | 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 DosWorld 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /STRUTIL.PAS: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2022 Viacheslav Komenda 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {G-,S-,R-,I-} 25 | unit strutil; 26 | 27 | interface 28 | 29 | function hexb(b : byte):string; 30 | function hexw(w : word):string; 31 | function hexdw(dw : longint):string; 32 | function hexp(p : pchar):string; 33 | 34 | function binb(b : byte):string; 35 | function bindw(l : longint):string; 36 | 37 | function octb(b : byte):string; 38 | 39 | implementation 40 | 41 | function hexb(b : byte):string; 42 | const a : string[16] = '0123456789ABCDEF'; 43 | begin 44 | hexb := a[((b shr 4) and $0f) + 1] + a[(b and $0f) + 1]; 45 | end; 46 | 47 | function hexw(w : word):string; 48 | begin 49 | hexw := hexb(hi(w)) + hexb(lo(w)); 50 | end; 51 | 52 | function hexdw(dw : longint):string; 53 | begin 54 | hexdw := hexw((dw shr 16) and $ffff) + hexw(dw and $ffff); 55 | end; 56 | 57 | function hexp(p : pchar):string; 58 | begin 59 | hexp := hexw(seg(p[0])) + ':' + hexw(ofs(p[0])); 60 | end; 61 | 62 | function binb(b:byte):string; 63 | var s : string[8]; 64 | i : integer; 65 | begin 66 | s[0] := #8; 67 | for i := 7 downto 0 do if (b and (1 shl i)) <> 0 then s[8-i] := '1' else s[8-i] := '0'; 68 | binb := s; 69 | end; 70 | 71 | function bindw(l : longint):string; 72 | begin 73 | bindw := concat(binb(l shr 24), binb(l shr 16), binb(l shr 8), binb(l)); 74 | end; 75 | 76 | function octb(b : byte):string; 77 | var s : string[4]; 78 | begin 79 | s := ' '; 80 | s[3] := chr($30 + (b and 7)); 81 | b := b shr 3; 82 | s[2] := chr($30 + (b and 7)); 83 | b := b shr 3; 84 | s[1] := chr($30 + (b and 3)); 85 | octb := s; 86 | end; 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /OBJ.PAS: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2022 Viacheslav Komenda 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {$G-,A-,S-,R-,I-,Q-} 25 | UNIT obj; 26 | 27 | INTERFACE 28 | 29 | CONST 30 | 31 | OBJ_THEADER = $80; 32 | OBJ_LHEADER = $F0; 33 | OBJ_COMMENT = $88; 34 | OBJ_PUBDEF = $90; 35 | OBJ_LINNUM = $94; 36 | OBJ_LNAMES = $96; 37 | OBJ_SEGDEF = $98; 38 | OBJ_GRPDEF = $9A; 39 | OBJ_FIXUP = $9C; 40 | OBJ_COMDEF = $B0; 41 | OBJ_LEDATA = $A0; 42 | OBJ_LIDATA = $A2; 43 | OBJ_EXTDEF = $8C; 44 | OBJ_MODEND = $8A; 45 | OBJ_LIBEND = $F1; 46 | 47 | FIXUP_P_16BIT = 0; 48 | FIXUP_P_32BIT = 1; 49 | FIXUP_M_SELF_REL = 0; 50 | FIXUP_M_SELF_DIR = 1; 51 | FIXUP_ONE_SUBREC = 1; 52 | FIXUP_ONE_THREAD = 0; 53 | FIXUP_METHOD_T0 = 0; 54 | FIXUP_METHOD_T1 = 1; 55 | FIXUP_METHOD_T2 = 2; 56 | FIXUP_METHOD_T3 = 3; 57 | FIXUP_METHOD_F0 = 0; 58 | FIXUP_METHOD_F1 = 1; 59 | FIXUP_METHOD_F2 = 2; 60 | FIXUP_METHOD_F3 = 3; 61 | FIXUP_METHOD_F4 = 4; 62 | FIXUP_METHOD_F5 = 5; 63 | FIXUP_METHOD_F6 = 6; 64 | FIXUP_D_THREAD = 0; 65 | FIXUP_D_FRAME = 1; 66 | FIXUP_ZERO_SUBREC = 1; 67 | FIXUP_ZERO_THREAD = 0; 68 | 69 | TYPE 70 | 71 | PObj = ^TObj; 72 | TObj = RECORD 73 | t : BYTE; 74 | count : WORD; 75 | mem : PCHAR; 76 | ofs : LONGINT; 77 | module : PObj; 78 | next : PObj; 79 | END; 80 | 81 | FUNCTION load(fname : STRING):PObj; 82 | PROCEDURE save(obj : PObj; fname : STRING); 83 | FUNCTION lookup(obj : PObj; t : BYTE):PObj; 84 | PROCEDURE free(obj : PObj); 85 | 86 | FUNCTION create(t : BYTE; count : WORD; parent : PObj):PObj; 87 | FUNCTION is_type(obj : PObj; t : BYTE):BOOLEAN; 88 | PROCEDURE merge_fixup(obj : PObj); 89 | 90 | FUNCTION get_str(obj : PObj; ofs, len : WORD):STRING; 91 | PROCEDURE set_str(obj : PObj; ofs : WORD; s : STRING); 92 | 93 | PROCEDURE getFixupAttr(bval : CHAR; VAR p : INTEGER; VAR B : INTEGER; VAR C : INTEGER; VAR A : INTEGER); 94 | PROCEDURE setFixupAttr(p : INTEGER; B : INTEGER; C : INTEGER; A : INTEGER; VAR bval : CHAR); 95 | PROCEDURE getFixupLocat(b1, b2 : CHAR; VAR ofs:WORD; VAR location : INTEGER; VAR m : INTEGER; VAR one : INTEGER); 96 | PROCEDURE getFixupFixData(bval : CHAR; VAR target : INTEGER; VAR P : INTEGER; VAR T : INTEGER; 97 | VAR Frame : INTEGER; VAR F : INTEGER); 98 | PROCEDURE getFixupTrDat(bval : CHAR; VAR Thread : INTEGER; VAR Method : INTEGER; VAR D : INTEGER; VAR Zero : INTEGER); 99 | 100 | IMPLEMENTATION 101 | 102 | USES System2; 103 | 104 | FUNCTION create(t : BYTE; count : WORD; parent : PObj) : PObj; 105 | VAR r : PObj; 106 | BEGIN 107 | GetMem(r, SizeOf(TObj)); 108 | r^.t := t; 109 | r^.count := count; 110 | r^.next := NIL; 111 | GetMem(r^.mem, count); 112 | IF parent <> NIL THEN parent^.next := r; 113 | create := r; 114 | END; 115 | 116 | FUNCTION load(fname : STRING) : PObj; 117 | VAR r, last : PObj; 118 | f : BFILE; 119 | crc, b : BYTE; 120 | w : WORD; 121 | p : LONGINT; 122 | islib : BOOLEAN; 123 | module : PObj; 124 | BEGIN 125 | islib := FALSE; 126 | r := NIL; last := NIL; module := NIL; 127 | Assign(f, fname); 128 | Reset(f); 129 | IF f.ioresult <> 0 THEN BEGIN load := NIL; exit; end; 130 | WHILE NOT eof(f) DO BEGIN 131 | p := FilePos(f); 132 | BlockRead(f, b, 1); 133 | BlockRead(f, w, 2); 134 | dec(w, 1); 135 | last := create(b, w, last); 136 | last^.ofs := p; 137 | last^.module := module; 138 | BlockRead(f, last^.mem[0], w); 139 | IF r = NIL THEN r := last; 140 | BlockRead(f, crc, 1); 141 | IF b = OBJ_THEADER THEN module := last; 142 | IF b = OBJ_LHEADER THEN islib := true; 143 | IF b = OBJ_MODEND THEN BEGIN 144 | IF NOT islib THEN break; 145 | p := FilePos(f); 146 | IF p AND $0f <> 0 THEN Seek(f, FilePos(f) + 16 - (p AND $0F)); 147 | module := NIL; 148 | END; 149 | IF b = OBJ_LIBEND THEN break; 150 | END; 151 | Close(f); 152 | load := r; 153 | END; 154 | 155 | FUNCTION crc(t : BYTE; count : WORD; mem : PCHAR; len : WORD):BYTE; 156 | VAR i : WORD; 157 | r : BYTE; 158 | BEGIN 159 | r := t; 160 | inc(r, lo(count)); 161 | inc(r, hi(count)); 162 | FOR i := 0 to len DO inc(r, ORD(mem[i])); 163 | crc := (-r) AND $FF; 164 | END; 165 | 166 | PROCEDURE save(obj : PObj; fname : STRING); 167 | VAR f : BFILE; 168 | b : BYTE; 169 | w : WORD; 170 | islib : BOOLEAN; 171 | m : ARRAY[1..16] OF BYTE; 172 | p : LONGINT; 173 | BEGIN 174 | islib := FALSE; 175 | Assign(f, fname); 176 | ReWrite(f); 177 | IF f.ioresult <> 0 THEN exit; 178 | WHILE obj <> NIL DO BEGIN 179 | IF obj^.t = OBJ_LHEADER THEN islib := true; 180 | w := obj^.count + 1; 181 | BlockWrite(f, obj^.t, 1); 182 | BlockWrite(f, w, 2); 183 | BlockWrite(f, obj^.mem[0], obj^.count); 184 | b := crc(obj^.t, w, obj^.mem, obj^.count); 185 | BlockWrite(f, b, 1); 186 | IF islib AND (obj^.t = OBJ_MODEND) THEN BEGIN 187 | p := FilePos(f); 188 | IF p AND $0f <> 0 THEN BlockWrite(f, m, 16 - (p AND $0F)); 189 | END; 190 | obj := obj^.next; 191 | END; 192 | Close(f); 193 | END; 194 | 195 | FUNCTION is_type(obj : PObj; t : BYTE):BOOLEAN; 196 | BEGIN 197 | IF obj = NIL THEN is_type := FALSE ELSE is_type := obj^.t=t; 198 | END; 199 | 200 | PROCEDURE merge_fixup(obj:PObj); 201 | VAR cur, old : PObj; 202 | w : WORD; 203 | m : PCHAR; 204 | BEGIN 205 | cur := obj; 206 | WHILE cur <> NIL DO BEGIN 207 | IF is_type(cur, OBJ_FIXUP) AND is_type(cur^.next, OBJ_FIXUP) THEN BEGIN 208 | old := cur^.next; 209 | cur^.next := cur^.next^.next; 210 | w := cur^.count + old^.count; 211 | GetMem(m, w); 212 | Move(cur^.mem^, m^, cur^.count); 213 | Move(old^.mem^, m[cur^.count], old^.count); 214 | FreeMem(cur^.mem, cur^.count); 215 | cur^.count := w; 216 | cur^.mem := m; 217 | FreeMem(old^.mem, old^.count); 218 | FreeMem(old, SizeOf(TObj)); 219 | END ELSE cur := cur^.next; 220 | END; 221 | END; 222 | 223 | PROCEDURE free(obj:PObj); 224 | VAR next : PObj; 225 | BEGIN 226 | WHILE obj <> NIL DO BEGIN 227 | next := obj^.next; 228 | FreeMem(obj^.mem, obj^.count); 229 | FreeMem(obj, SizeOf(TObj)); 230 | obj := next; 231 | END; 232 | END; 233 | 234 | FUNCTION lookup(obj:PObj; t:BYTE):PObj; 235 | VAR r : PObj; 236 | BEGIN 237 | r := NIL; 238 | WHILE obj <> NIL DO BEGIN 239 | IF obj^.t = t THEN BEGIN r := obj; break; end; 240 | obj := obj^.next; 241 | END; 242 | lookup := r; 243 | END; 244 | 245 | FUNCTION get_str(obj:PObj; ofs, len:WORD):STRING; 246 | VAR r : STRING; 247 | i : INTEGER; 248 | BEGIN 249 | r := ''; 250 | dec(len); 251 | FOR i := 0 to len DO BEGIN 252 | r := r + obj^.mem[ofs + i]; 253 | END; 254 | get_str := r; 255 | END; 256 | 257 | PROCEDURE set_str(obj:PObj; ofs:WORD; s:STRING); 258 | VAR i, l : INTEGER; 259 | BEGIN 260 | l := length(s); 261 | FOR i := 1 to l DO BEGIN 262 | obj^.mem[ofs + i - 1] := s[i]; 263 | END; 264 | END; 265 | 266 | PROCEDURE getFixupAttr(bval:CHAR; VAR p:INTEGER; VAR B:INTEGER; VAR C:INTEGER; VAR A:INTEGER); 267 | BEGIN 268 | p := (ORD(bval) SHR 7) AND 1; 269 | b := (ORD(bval) SHR 6) AND 1; 270 | c := (ORD(bval) SHR 3) AND $07; 271 | a := ORD(bval) AND $07; 272 | END; 273 | 274 | PROCEDURE setFixupAttr(p:INTEGER; B:INTEGER; C:INTEGER; A:INTEGER; VAR bval:CHAR); 275 | BEGIN 276 | bval := #0; 277 | bval := CHR(ORD(bval) or (p AND 1) SHL 7); 278 | bval := CHR(ORD(bval) or (b AND 1) SHL 6); 279 | bval := CHR(ORD(bval) or (c AND 7) SHL 3); 280 | bval := CHR(ORD(bval) or (a AND 7)); 281 | END; 282 | 283 | PROCEDURE getFixupLocat(b1, b2:CHAR; VAR ofs:WORD; VAR location:INTEGER; VAR m:INTEGER; VAR one:INTEGER); 284 | VAR w : WORD; 285 | BEGIN 286 | w := (ORD(b1) AND $ff) or ((ORD(b2) AND $ff) SHL 8); 287 | ofs := (w SHR 6) AND $3f; 288 | location := (w SHR 2) AND $f; 289 | m := (w SHR 1) AND $1; 290 | one := w AND $1; 291 | END; 292 | 293 | PROCEDURE getFixupFixData(bval:CHAR; VAR target:INTEGER; VAR P:INTEGER; VAR T:INTEGER; VAR Frame:INTEGER; VAR F:INTEGER); 294 | BEGIN 295 | target := (ORD(bval) SHR 6) AND $03; 296 | P := (ORD(bval) SHR 5) AND $01; 297 | T := (ORD(bval) SHR 4) AND $01; 298 | Frame := (ORD(bval) SHR 1) AND $07; 299 | F := ORD(bval) AND $01; 300 | END; 301 | 302 | PROCEDURE getFixupTrDat(bval:CHAR; VAR Thread:INTEGER; VAR Method:INTEGER; VAR D:INTEGER; VAR Zero:INTEGER); 303 | BEGIN 304 | Thread := (ORD(bval) SHR 6) AND $03; 305 | Method := (ORD(bval) SHR 3) AND $07; 306 | D := (ORD(bval) SHR 1) AND $01; 307 | Zero := ORD(bval) AND $01; 308 | END; 309 | 310 | END. 311 | -------------------------------------------------------------------------------- /SCR.PAS: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2022 Viacheslav Komenda 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {$G-,B-,F+,S-,R-,I-} 25 | unit scr; 26 | 27 | interface 28 | 29 | var 30 | screen : pchar; 31 | cursor : word; 32 | 33 | procedure cls(clr : byte); 34 | procedure cln(x, y : integer; clr : byte); 35 | procedure print(x, y : integer; clr : byte; s : string); 36 | procedure printhl(x, y : integer; clr, hlclr : byte; s : string); 37 | procedure hprint(x, y:integer; clr : byte; c : char; len : integer); 38 | procedure vprint(x, y:integer; clr : byte; c : char; len : integer); 39 | procedure chcolor(x, y:integer; clr : byte; len: integer); 40 | function is_monochrome:boolean; 41 | 42 | procedure push; 43 | procedure pop; 44 | procedure pick; 45 | procedure show; 46 | 47 | procedure locate(x, y:integer); 48 | 49 | procedure cursor_off; 50 | procedure cursor_on; 51 | procedure cursor_big; 52 | 53 | function get_cursor:word; 54 | procedure set_cursor(w : word); 55 | 56 | procedure set_blink(on : boolean); 57 | 58 | function getwidth:integer; 59 | function getheight:integer; 60 | 61 | function getx:integer; 62 | function gety:integer; 63 | 64 | implementation 65 | 66 | uses kminput; 67 | 68 | const vseg : word = 0; 69 | 70 | type 71 | 72 | PScr=^TScr; 73 | TScr=record 74 | prev : PScr; 75 | size : word; 76 | x, y : integer; 77 | buf : byte; 78 | end; 79 | 80 | const 81 | 82 | last_scr_buf : PScr = nil; 83 | 84 | var screen_size, line_size : word; 85 | 86 | function getheight:integer;assembler; 87 | asm 88 | push ds 89 | mov ax, seg0040 90 | mov ds, ax 91 | mov al, byte ptr[$0084] 92 | xor ah, ah 93 | inc ax 94 | pop ds 95 | end; 96 | 97 | function getwidth:integer;assembler; 98 | asm 99 | push ds 100 | mov ax, seg0040 101 | mov ds, ax 102 | mov ax, word ptr[$004a] 103 | pop ds 104 | end; 105 | 106 | { in: ax = x, cx = y } 107 | { out: es:di } 108 | procedure buf_es_di;assembler; 109 | asm 110 | mov bx, ax 111 | mov ax, line_size 112 | mul cx 113 | xchg bx, ax 114 | shl ax, 1 115 | add ax, bx 116 | les di, screen 117 | add di, ax 118 | end; 119 | 120 | procedure cls(clr : byte);assembler; 121 | asm 122 | push es 123 | 124 | mov ax, screen_size 125 | shr ax, 1 126 | xchg ax, cx 127 | mov ah, clr 128 | mov al, ' ' 129 | les di, screen 130 | cld 131 | repz stosw 132 | 133 | pop es 134 | end; 135 | 136 | procedure cln(x, y : integer; clr : byte);assembler; 137 | asm 138 | push es 139 | 140 | call getwidth 141 | push ax 142 | mov ax, x 143 | mov cx, y 144 | call buf_es_di 145 | pop cx 146 | sub cx, x 147 | mov ah, clr 148 | mov al, ' ' 149 | cld 150 | repz stosw 151 | 152 | pop es 153 | end; 154 | 155 | procedure hprint(x, y : integer; clr : byte; c : char; len : integer);assembler; 156 | asm 157 | push es 158 | mov ax, x 159 | mov cx, y 160 | call buf_es_di 161 | xor ch, ch 162 | mov cx, len 163 | xor ch, ch 164 | mov ah, clr 165 | mov al, c 166 | cld 167 | repz stosw 168 | pop es 169 | end; 170 | 171 | procedure chcolor(x, y : integer; clr : byte; len : integer);assembler; 172 | asm 173 | push es 174 | mov ax, x 175 | mov cx, y 176 | call buf_es_di 177 | inc di 178 | mov cx, len 179 | mov al, clr 180 | cld 181 | or cl, cl 182 | jz @end 183 | @cont: 184 | stosb 185 | inc di 186 | dec cl 187 | jnz @cont 188 | @end: 189 | pop es 190 | end; 191 | 192 | procedure vprint(x, y : integer; clr : byte; c : char; len : integer);assembler; 193 | asm 194 | push es 195 | mov ax, x 196 | mov cx, y 197 | call buf_es_di 198 | mov bx, line_size 199 | sub bx, 2 200 | mov cx, len 201 | mov ah, clr 202 | mov al, c 203 | cld 204 | or cl, cl 205 | jz @end 206 | @cont: 207 | stosw 208 | add di, bx 209 | dec cl 210 | jnz @cont 211 | @end: 212 | pop es 213 | end; 214 | 215 | procedure print(x, y:integer; clr : byte; s : string);assembler; 216 | asm 217 | push es 218 | push ds 219 | 220 | mov ax, x 221 | mov cx, y 222 | call buf_es_di 223 | mov ah, clr 224 | lds si, s 225 | lodsb 226 | or al, al 227 | jz @end 228 | mov cl, al 229 | cld 230 | @cont: 231 | lodsb 232 | stosw 233 | dec cl 234 | jnz @cont 235 | @end: 236 | pop ds 237 | pop es 238 | end; 239 | 240 | procedure printhl(x, y : integer; clr, hlclr : byte; s : string);assembler; 241 | asm 242 | push es 243 | push ds 244 | 245 | mov ax, x 246 | mov cx, y 247 | call buf_es_di 248 | 249 | mov ah, clr 250 | mov bh, hlclr 251 | lds si, s 252 | lodsb 253 | or al, al 254 | jz @end 255 | mov cl, al 256 | cld 257 | @cont: 258 | lodsb 259 | cmp al, '~' 260 | jnz @print 261 | xchg ah, bh 262 | jmp @cont2 263 | @print: 264 | stosw 265 | @cont2: 266 | dec cl 267 | jnz @cont 268 | @end: 269 | pop ds 270 | pop es 271 | end; 272 | 273 | procedure show;assembler; 274 | asm 275 | call mouse_hide 276 | 277 | push es 278 | push ds 279 | 280 | 281 | mov ax, vseg 282 | mov es, ax 283 | mov cx, screen_size 284 | lds si, screen 285 | xor di, di 286 | cld 287 | repz movsb 288 | 289 | pop ds 290 | pop es 291 | 292 | call mouse_show 293 | end; 294 | 295 | procedure locate(x, y : integer);assembler; 296 | asm 297 | push ds 298 | mov ax, word ptr [seg0040] 299 | mov ds, ax 300 | mov bh, byte ptr [$0062] 301 | pop ds 302 | 303 | mov dl, byte ptr [x] 304 | mov dh, byte ptr [y] 305 | mov ah, 2 306 | int $10 307 | end; 308 | 309 | function getx:integer;assembler; 310 | asm 311 | push ds 312 | mov ax, word ptr [seg0040] 313 | mov ds, ax 314 | mov bh, byte ptr [$0062] 315 | pop ds 316 | 317 | mov ah, 3 318 | int $10 319 | mov al,dl 320 | xor ah,ah 321 | end; 322 | 323 | function gety:integer;assembler; 324 | asm 325 | push ds 326 | mov ax, word ptr [seg0040] 327 | mov ds, ax 328 | mov bh, byte ptr [$0062] 329 | pop ds 330 | 331 | mov ah, 3 332 | int $10 333 | mov al,dh 334 | xor ah,ah 335 | end; 336 | 337 | procedure push; 338 | var p : PScr; 339 | begin 340 | getmem(p, screen_size + sizeof(TScr) - 1); 341 | p^.size := screen_size; 342 | p^.prev := last_scr_buf; 343 | p^.x := getx; 344 | p^.y := gety; 345 | move(screen[0], p^.buf, p^.size); 346 | last_scr_buf := p; 347 | end; 348 | 349 | procedure pop; 350 | var p : PScr; 351 | begin 352 | if last_scr_buf = nil then exit; 353 | move(last_scr_buf^.buf, screen[0], last_scr_buf^.size); 354 | p := last_scr_buf; 355 | last_scr_buf := last_scr_buf^.prev; 356 | scr.locate(p^.x, p^.y); 357 | freemem(p, p^.size + sizeof(TScr) - 1); 358 | end; 359 | 360 | procedure pick; 361 | begin 362 | if last_scr_buf = nil then exit; 363 | move(last_scr_buf^.buf, screen[0], last_scr_buf^.size); 364 | scr.locate(last_scr_buf^.x, last_scr_buf^.y); 365 | end; 366 | 367 | procedure set_cursor(w : word);assembler; 368 | asm 369 | mov cx, w 370 | mov ah, 1 371 | int $10 372 | end; 373 | 374 | function get_cursor:word;assembler; 375 | asm 376 | mov ah, $0f 377 | int $10 378 | mov ah, 3 379 | int $10 380 | mov ax, cx 381 | end; 382 | 383 | 384 | procedure cursor_off; 385 | begin 386 | set_cursor($2020); 387 | end; 388 | 389 | procedure cursor_on; 390 | begin 391 | set_cursor(cursor); 392 | end; 393 | 394 | procedure cursor_big; 395 | begin 396 | set_cursor(cursor and $FF); 397 | end; 398 | 399 | procedure set_blink(on : boolean);assembler; 400 | asm 401 | mov bl, byte ptr [on] 402 | mov ax, $1003 403 | int $10 404 | end; 405 | 406 | function is_monochrome:boolean;assembler; 407 | asm 408 | push ds 409 | mov ax, word ptr [seg0040] 410 | mov ds, ax 411 | mov al, byte ptr [$0065] 412 | pop ds 413 | and al, 4 414 | end; 415 | 416 | begin 417 | cursor := get_cursor; 418 | if is_monochrome then vseg := segb000 else vseg := segb800; 419 | set_blink(false); 420 | screen_size := (getwidth * getheight) shl 1; 421 | line_size := getwidth shl 1; 422 | getmem(screen, screen_size); 423 | move(mem[vseg:0], screen[0], screen_size); 424 | mouse_show; 425 | end. 426 | -------------------------------------------------------------------------------- /OMFVIEW.PAS: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2022 Viacheslav Komenda 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {$G-,A-,D-,L-,R-,S-,Q-} 25 | {$M 32000, 128000, 650000} 26 | 27 | USES System2, kminput, scr, str, strutil, obj; 28 | 29 | CONST 30 | BGCOLOR = $07; 31 | 32 | type 33 | 34 | PViewItem =^ TViewItem; 35 | TViewItem = record 36 | o : PObj; 37 | next : PViewItem; 38 | alloc : word; 39 | name : string; 40 | end; 41 | 42 | var h, w : word; 43 | 44 | function type2name(t : byte):string; 45 | var s : string; 46 | begin 47 | case t of 48 | OBJ_THEADER: s := 'THEADER'; 49 | OBJ_LHEADER: s := 'LHEADER'; 50 | OBJ_COMMENT: s := 'COMMENT'; 51 | OBJ_PUBDEF: s := 'PUBDEF'; 52 | OBJ_LNAMES: s := 'LNAMES'; 53 | OBJ_LINNUM: s := 'LINNUM'; 54 | OBJ_SEGDEF: s := 'SEGDEF'; 55 | OBJ_GRPDEF: s := 'GRPDEF'; 56 | OBJ_FIXUP: s := 'FIXUP'; 57 | OBJ_LEDATA: s := 'LEDATA'; 58 | OBJ_LIDATA: s := 'LIDATA'; 59 | OBJ_COMDEF: s := 'COMDEF'; 60 | OBJ_EXTDEF: s := 'EXTDEF'; 61 | OBJ_MODEND: s := 'MODEND'; 62 | OBJ_LIBEND: s := 'LIBEND'; 63 | else s := 'UNKNOWN' 64 | end; 65 | type2name := hexb(t) + '-' + s; 66 | end; 67 | 68 | procedure freeall(root : PViewItem); 69 | var item : PViewItem; 70 | begin 71 | while root <> nil do begin 72 | item := root; 73 | root := root^.next; 74 | freemem(item, item^.alloc); 75 | end; 76 | end; 77 | 78 | function getc(hl : boolean; cur : PViewItem):byte; 79 | var c : byte; 80 | begin 81 | c := BGCOLOR; 82 | if hl then c:=$20 83 | else if cur^.o <> nil then begin 84 | case cur^.o^.t of 85 | OBJ_LHEADER: c := $02; 86 | OBJ_THEADER: c := $02; 87 | OBJ_LEDATA: c := $03; 88 | OBJ_MODEND: c := $06; 89 | OBJ_LIBEND: c := $06; 90 | end; 91 | end; 92 | getc := c; 93 | end; 94 | 95 | function mem2str(ofs : longint; m : pchar; len : byte):string; 96 | var s2, s3 : string; 97 | i : byte; 98 | begin 99 | s2 := ''; s3 := ''; 100 | for i:= 0 to len-1 do begin 101 | s2 := s2 + ' '+hexb(ord(m[i])); 102 | s3 := s3 + m[i]; 103 | if (i and $3) = 3 then s2 := s2 + ' '; 104 | end; 105 | mem2str := ' ' + hexdw(ofs) + ' ' + rpad(s2, 17*3) + ' ' + s3; 106 | end; 107 | 108 | function view_list(title : string; 109 | vroot : PViewItem; 110 | var current : PViewItem; 111 | total : word; 112 | var scr_start, scr_pos : word):word; 113 | var vcur : PViewItem; 114 | k, i : word; 115 | c : byte; 116 | needredraw : boolean; 117 | s1, s2 :string; 118 | begin 119 | needredraw := true; 120 | system.str(total, s2); 121 | while true do begin 122 | if needredraw then begin 123 | scr.cls(BGCOLOR); 124 | current := nil; 125 | system.str(scr_pos + scr_start + 1, s1); 126 | vcur := vroot; i := 0; 127 | while (vcur <> nil) and (i < scr_start) do begin 128 | inc(i); 129 | vcur := vcur^.next; 130 | end; 131 | while (vcur <> nil) and (i <= scr_start + h - 2) do begin 132 | c := getc(i = (scr_start + scr_pos), vcur); 133 | if i = (scr_start + scr_pos) then current := vcur; 134 | if i = (scr_start + scr_pos) then scr.cln(0, i - scr_start + 1, c); 135 | scr.print(0, i - scr_start + 1, c, vcur^.name); 136 | inc(i); 137 | vcur := vcur^.next; 138 | end; 139 | scr.cln(0, 0, $70); 140 | printhl(0, 0, $70, $74, title + ' ' + lpad(s1, 5) + ' / ' + s2); 141 | end; 142 | scr.show; 143 | k := kbd_getkey; 144 | case hi(k) of 145 | SCAN_HOME: begin 146 | scr_pos := 0; 147 | scr_start := 0; 148 | needredraw := true; 149 | end; 150 | SCAN_END: begin 151 | if total < h - 1 then begin 152 | scr_pos := total - 1; 153 | end else begin 154 | scr_start := total - h + 1; 155 | scr_pos := h - 2; 156 | end; 157 | needredraw := true; 158 | end; 159 | SCAN_PGUP: begin 160 | if scr_pos <> 0 then scr_pos := 0 161 | else if scr_start + scr_pos < h-1 then begin 162 | scr_start := 0; 163 | end else begin 164 | dec(scr_start, h - 1); 165 | end; 166 | needredraw := true; 167 | end; 168 | SCAN_PGDN: begin 169 | if (scr_pos <> h - 2) then begin 170 | if scr_start + h - 2 < total then scr_pos := h - 2 171 | else scr_pos := total - scr_start - 1; 172 | end else if scr_start + (h - 1) * 2 < total then begin 173 | inc(scr_start, h - 1); 174 | end else begin 175 | scr_start := total - h + 1; 176 | scr_pos := h - 2; 177 | end; 178 | needredraw := true; 179 | end; 180 | SCAN_UP: if scr_start+scr_pos <> 0 then begin 181 | if scr_pos<>0 then dec(scr_pos) else dec(scr_start); 182 | needredraw := true; 183 | end; 184 | SCAN_DOWN: if scr_pos + scr_start + 1 < total then begin 185 | if scr_pos + 2 < h then inc(scr_pos) else inc(scr_start); 186 | needredraw := true; 187 | end; 188 | else break; 189 | end; 190 | end; 191 | view_list := k; 192 | end; 193 | 194 | procedure view_entry(title : string; o : PObj); 195 | var vroot, vlast, vcur : PViewItem; 196 | ofs : longint; 197 | key, i, l, total : word; 198 | scr_start, scr_pos : word; 199 | s, s1 : string; 200 | name : string; 201 | alloc : word; 202 | begin 203 | vroot := nil; vlast := nil; 204 | total := 0; 205 | 206 | if o^.t = OBJ_LNAMES then begin 207 | i := 1; 208 | while i < o^.count do begin 209 | inc(total, 1); 210 | s := obj.get_str(o, i + 1, ord(o^.mem[i])); 211 | name := ' ' + lpad(wtoa(total), 8) + ': ' + s + '(' + wtoa(ord(o^.mem[i])) + ')'; 212 | alloc := sizeof(TViewItem) - 256 + length(name) + 1; 213 | getmem(vcur, alloc); 214 | vcur^.name := name; 215 | vcur^.o := nil; 216 | vcur^.alloc := alloc; 217 | vcur^.next := nil; 218 | if vroot = nil then vroot := vcur; 219 | if vlast <> nil then vlast^.next := vcur; 220 | vlast := vcur; 221 | inc(i, length(s)+1); 222 | end; 223 | end; 224 | 225 | i := 0; 226 | ofs := o^.ofs; 227 | title := title + ' ~' + type2name(o^.t) + '~'; 228 | while i < o^.count do begin 229 | l := o^.count - i; 230 | if l > 16 then l := 16; 231 | name := mem2str(ofs, o^.mem + i, l); 232 | alloc := sizeof(TViewItem) - 256 + length(name) + 1; 233 | getmem(vcur, sizeof(TViewItem)); 234 | vcur^.name := name; 235 | vcur^.o := nil; 236 | vcur^.alloc := alloc; 237 | vcur^.next := nil; 238 | if vroot = nil then vroot := vcur; 239 | if vlast <> nil then vlast^.next := vcur; 240 | vlast := vcur; 241 | inc(i, l); 242 | inc(total, 1); 243 | inc(ofs, l); 244 | end; 245 | scr_start := 0; 246 | scr_pos := 0; 247 | while true do begin 248 | key := hi(view_list(title, vroot, vcur, total, scr_start, scr_pos)); 249 | if key = SCAN_ESC then break; 250 | if key = SCAN_LEFT then break; 251 | if key = SCAN_BS then break; 252 | if key = SCAN_ENTER then break; 253 | end; 254 | freeall(vroot); 255 | end; 256 | 257 | procedure view(fname : string; o : PObj); 258 | var vroot, vlast, vcur : PViewItem; 259 | selected, k : PObj; 260 | s : string; 261 | i, total, key : word; 262 | scr_start, scr_pos : word; 263 | c : byte; 264 | s1, s2 : string[10]; 265 | title : string; 266 | name : string; 267 | alloc : word; 268 | begin 269 | vroot := nil; vlast := nil; 270 | k := o; total := 0; 271 | while k <> nil do begin 272 | name := ' ' + hexdw(k^.ofs) + 273 | ' ' + #$B3 + ' ' + hexw(k^.count) + 274 | ' ' + #$B3 + ' ' + type2name(k^.t); 275 | if k^.t = OBJ_THEADER then begin 276 | if k^.count > 1 then begin 277 | title := obj.get_str(k, 1, ord(k^.mem[0])); 278 | name := name + ' ' + title; 279 | end; 280 | end; 281 | if length(name) >= w then name := copy(name, 1, w - 1); 282 | alloc := sizeof(TViewItem) - 256 + length(name) + 1; 283 | getmem(vcur, sizeof(TViewItem)); 284 | vcur^.name := name; 285 | vcur^.next := nil; 286 | vcur^.o := k; 287 | vcur^.alloc := alloc; 288 | if vroot = nil then vroot := vcur; 289 | if vlast <> nil then vlast^.next := vcur; 290 | vlast := vcur; 291 | inc(total); 292 | k := k^.next; 293 | end; 294 | scr_start := 0; 295 | scr_pos := 0; 296 | title := ' ' + fname + ' '; 297 | 298 | while true do begin 299 | key := hi(view_list(title, vroot, vcur, total, scr_start, scr_pos)); 300 | case key of 301 | SCAN_ESC: break; 302 | SCAN_F3: break; 303 | SCAN_F4: break; 304 | SCAN_RIGHT, SCAN_ENTER: begin view_entry(title, vcur^.o); kbd_reset; end; 305 | end; 306 | end; 307 | freeall(vroot); 308 | end; 309 | 310 | var 311 | o : PObj; 312 | fname : string; 313 | BEGIN 314 | System.writeln('OmfView (c) 2022 by DosWorld. MIT License'); 315 | IF ParamCount <> 1 THEN BEGIN 316 | fname := basename(paramstr(0)); 317 | upstr(fname); 318 | System.writeln; 319 | System.writeln('Usage:'); 320 | System.writeln(#9, fname, ' file.obj'); 321 | Halt(1); 322 | END; 323 | fname := ParamStr(1); 324 | o:=obj.load(fname); 325 | IF o = NIL THEN BEGIN 326 | WriteLnErr('Could not read '+ fname); 327 | Halt(1); 328 | END; 329 | h := getheight; 330 | w := getwidth; 331 | scr.push; 332 | fname := basename(fname); 333 | upstr(fname); 334 | view(fname, o); 335 | scr.pop; 336 | scr.show; 337 | obj.free(o); 338 | kbd_reset; 339 | Halt(0); 340 | END. 341 | -------------------------------------------------------------------------------- /RDFVIEW.PAS: -------------------------------------------------------------------------------- 1 | { 2 | MIT License 3 | 4 | Copyright (c) 2022 Viacheslav Komenda 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | } 24 | {$G-,A-,D-,L-,R-,S-,Q-} 25 | {$M 32000, 128000, 650000} 26 | 27 | USES System2, kminput, scr, str, strutil; 28 | 29 | TYPE 30 | 31 | PViewItem = ^TViewItem; 32 | TViewItem = RECORD 33 | next : PViewItem; 34 | name : STRING[80]; 35 | END; 36 | 37 | CONST 38 | BGCOLOR = $17; 39 | 40 | VAR 41 | h, w : WORD; 42 | vroot, vlast : PViewItem; 43 | 44 | PROCEDURE freeall(root : PViewItem); 45 | VAR item : PViewItem; 46 | BEGIN 47 | WHILE root <> NIL DO BEGIN 48 | item := root; 49 | root := root^.next; 50 | FreeMem(item, SizeOf(TViewItem)); 51 | END; 52 | END; 53 | 54 | PROCEDURE Append(s : STRING); 55 | VAR item : PViewItem; 56 | BEGIN 57 | GetMem(item, SizeOf(TViewItem)); 58 | item^.name := s; 59 | item^.next := NIL; 60 | IF vlast <> NIL THEN vlast^.next := item; 61 | IF vroot = NIL THEN vroot := item; 62 | vlast := item; 63 | END; 64 | 65 | FUNCTION getc(hl : BOOLEAN; cur : PViewItem) : BYTE; 66 | VAR c : BYTE; 67 | BEGIN 68 | c := BGCOLOR; 69 | IF hl THEN c:=$20 ELSE BEGIN 70 | IF Length(cur^.name) > 0 THEN BEGIN 71 | IF cur^.name[1] = ' ' THEN c := $13 72 | ELSE IF cur^.name[1] = '*' THEN c := $14 73 | ELSE IF cur^.name[1] = '-' THEN c := $12; 74 | END; 75 | END; 76 | getc := c; 77 | END; 78 | 79 | FUNCTION view_list(title : STRING; 80 | vroot : PViewItem; 81 | VAR current : PViewItem; 82 | total : WORD; 83 | VAR scr_start, scr_pos : WORD) : WORD; 84 | VAR vcur : PViewItem; 85 | k, i : WORD; 86 | c : BYTE; 87 | needredraw : BOOLEAN; 88 | s1, s2 : STRING; 89 | BEGIN 90 | needredraw := TRUE; 91 | system.str(total, s2); 92 | WHILE TRUE DO BEGIN 93 | IF needredraw THEN BEGIN 94 | scr.cls(BGCOLOR); 95 | current := NIL; 96 | system.str(scr_pos + scr_start + 1, s1); 97 | vcur := vroot; i := 0; 98 | WHILE (vcur <> NIL) AND (i < scr_start) DO BEGIN 99 | inc(i); 100 | vcur := vcur^.next; 101 | END; 102 | WHILE (vcur <> NIL) AND (i <= scr_start + h - 2) DO BEGIN 103 | c := getc(i = (scr_start + scr_pos), vcur); 104 | IF i = (scr_start + scr_pos) THEN current := vcur; 105 | IF i = (scr_start + scr_pos) THEN scr.cln(0, i - scr_start + 1, c); 106 | scr.print(0, i - scr_start + 1, c, vcur^.name); 107 | inc(i); 108 | vcur := vcur^.next; 109 | END; 110 | scr.cln(0, 0, $70); 111 | printhl(0, 0, $70, $74, title + ' ' + lpad(s1, 5) + ' / ' + s2); 112 | END; 113 | scr.show; 114 | k := kbd_getkey; 115 | CASE hi(k) OF 116 | SCAN_HOME: BEGIN 117 | scr_pos := 0; 118 | scr_start := 0; 119 | needredraw := TRUE; 120 | END; 121 | SCAN_END: BEGIN 122 | IF total < h - 1 THEN BEGIN 123 | scr_pos := total - 1; 124 | END ELSE BEGIN 125 | scr_start := total - h + 1; 126 | scr_pos := h - 2; 127 | END; 128 | needredraw := TRUE; 129 | END; 130 | SCAN_PGUP: BEGIN 131 | IF scr_pos <> 0 THEN scr_pos := 0 132 | ELSE IF scr_start + scr_pos < h-1 THEN BEGIN 133 | scr_start := 0; 134 | END ELSE BEGIN 135 | dec(scr_start, h - 1); 136 | END; 137 | needredraw := TRUE; 138 | END; 139 | SCAN_PGDN: BEGIN 140 | IF (scr_pos <> h - 2) THEN BEGIN 141 | IF scr_start + h - 2 < total THEN scr_pos := h - 2 142 | ELSE scr_pos := total - scr_start - 1; 143 | END ELSE IF scr_start + (h - 1) * 2 < total THEN BEGIN 144 | inc(scr_start, h - 1); 145 | END ELSE BEGIN 146 | scr_start := total - h + 1; 147 | scr_pos := h - 2; 148 | END; 149 | needredraw := TRUE; 150 | END; 151 | SCAN_UP: IF scr_start+scr_pos <> 0 THEN BEGIN 152 | IF scr_pos<>0 THEN dec(scr_pos) ELSE dec(scr_start); 153 | needredraw := TRUE; 154 | END; 155 | SCAN_DOWN: IF scr_pos + scr_start + 1 < total THEN BEGIN 156 | IF scr_pos + 2 < h THEN inc(scr_pos) ELSE inc(scr_start); 157 | needredraw := TRUE; 158 | END; 159 | ELSE BREAK; 160 | END; 161 | END; 162 | view_list := k; 163 | END; 164 | 165 | PROCEDURE view(fname : STRING; vroot : PViewItem); 166 | VAR vcur : PViewItem; 167 | s : STRING; 168 | i, total, key : WORD; 169 | scr_start, scr_pos : WORD; 170 | name, title : STRING; 171 | BEGIN 172 | scr_start := 0; 173 | scr_pos := 0; 174 | vcur := vroot; 175 | title := ' ' + fname + ' '; 176 | total := 0; 177 | vlast := vroot; 178 | WHILE vlast <> NIL DO BEGIN 179 | Inc(total); 180 | vlast := vlast^.next; 181 | END; 182 | 183 | WHILE TRUE DO BEGIN 184 | key := hi(view_list(title, vroot, vcur, total, scr_start, scr_pos)); 185 | case key of 186 | SCAN_ESC: break; 187 | SCAN_F3: break; 188 | SCAN_F4: break; 189 | END; 190 | END; 191 | freeall(vroot); 192 | END; 193 | 194 | TYPE 195 | PLONGINT = ^LONGINT; 196 | PWORD = ^WORD; 197 | 198 | FUNCTION WriteRelo(VAR rdata:STRING):STRING; 199 | VAR r : STRING; 200 | BEGIN 201 | r := 'SEG: ' + hexb(ORD(rdata[1])); 202 | r := r + ', OFS: ' + hexdw(PLONGINT(@rdata[2])^); 203 | r := r + ', LEN: ' + hexb(ORD(rdata[6])); 204 | r := r + ', RSEG: ' + hexw(PWORD(@rdata[7])^); 205 | WriteRelo := r; 206 | END; 207 | 208 | FUNCTION WriteImport(VAR rdata:STRING):STRING; 209 | VAR 210 | i : INTEGER; 211 | r : STRING; 212 | BEGIN 213 | r := 'FLG: ' + hexb(ORD(rdata[1])); 214 | r := r + ', SEG: ' + hexw(ORD(rdata[2])); 215 | r := r + ', '; 216 | i := 4; 217 | WHILE (i < 256) AND (rdata[i] <> #0) DO BEGIN 218 | r := r + rdata[i]; 219 | Inc(i); 220 | END; 221 | WriteImport := r; 222 | END; 223 | 224 | FUNCTION WriteGlobal(VAR rdata:STRING):STRING; 225 | VAR 226 | i : INTEGER; 227 | r : STRING; 228 | BEGIN 229 | r := ''; 230 | r := 'FLG: ' + hexb(ORD(rdata[1])); 231 | r := r + ', SEG: ' + hexb(ORD(rdata[2])); 232 | r := r + ', OFS: ' + hexdw(PLONGINT(@rdata[3])^); 233 | r := r + ', '; 234 | i := 7; 235 | WHILE (i < 256) AND (rdata[i] <> #0) DO BEGIN 236 | r := r + rdata[i]; 237 | Inc(i); 238 | END; 239 | WriteGlobal := r; 240 | END; 241 | 242 | FUNCTION WriteBSS(VAR rdata:STRING):STRING; 243 | BEGIN 244 | WriteBSS := hexdw(PLONGINT(@rdata[1])^); 245 | END; 246 | 247 | FUNCTION WriteDefault(VAR rdata:STRING):STRING; 248 | VAR 249 | i, l : INTEGER; 250 | r : STRING; 251 | BEGIN 252 | r := ''; 253 | l := Length(rdata); 254 | IF l > 32 THEN l := 32; 255 | FOR i := 1 TO l DO r := r + hexb(ORD(rdata[i])) + ' '; 256 | WriteDefault := r; 257 | END; 258 | 259 | FUNCTION DumpRec(rtype : BYTE; VAR rdata : STRING) : STRING; 260 | VAR r : STRING; 261 | BEGIN 262 | CASE rtype OF 263 | 1: BEGIN 264 | { reloc } 265 | r := 'RELO ' + WriteRelo(rdata); 266 | END; 267 | 2: BEGIN 268 | { import } 269 | r := 'IMPORT ' + WriteImport(rdata); 270 | END; 271 | 3: BEGIN 272 | { global } 273 | r := 'GLOBAL ' + WriteGlobal(rdata); 274 | END; 275 | 4: BEGIN 276 | { dll } 277 | r := 'DLL ' + rdata; 278 | END; 279 | 5: BEGIN 280 | { bss } 281 | r := 'BSS ' + WriteBSS(rdata); 282 | END; 283 | 6: BEGIN 284 | { seg relo } 285 | r := 'SEGRELO ' + WriteRelo(rdata); 286 | END; 287 | 7: BEGIN 288 | { far import } 289 | r := 'FARIMPORT ' + WriteImport(rdata); 290 | END; 291 | 8: BEGIN 292 | { mod name } 293 | r := 'MODNAME ' + rdata; 294 | END ELSE BEGIN 295 | r := '??? ' + WriteDefault(rdata); 296 | END; 297 | END; 298 | DumpRec := r; 299 | END; 300 | 301 | PROCEDURE DumpSegs(VAR f : BFILE; modlen : LONGINT); 302 | VAR 303 | segtype : WORD; 304 | segnum : WORD; 305 | reserv : WORD; 306 | seglen : LONGINT; 307 | s : STRING; 308 | havesegs : BOOLEAN; 309 | BEGIN 310 | havesegs := FALSE; 311 | WHILE NOT eof(f) DO BEGIN 312 | havesegs := TRUE; 313 | segtype := ReadWord(f); 314 | segnum := ReadWord(f); 315 | reserv := ReadWord(f); 316 | seglen := ReadDWord(f); 317 | s := ''; 318 | s := s + hexdw(FilePos(f)) + ' '; 319 | s := s + hexdw(seglen) + ' '; 320 | s := s + hexb(segtype) + '-'; 321 | IF segtype = 1 THEN s := s + 'CODE ' 322 | ELSE IF segtype = 2 THEN s := s + 'DATA ' 323 | ELSE s := s + '?? '; 324 | s := s + ' NUM: ' + hexw(segnum) + ' '; 325 | s := s + ' RES: ' + hexw(reserv); 326 | Append(s); 327 | IF segtype = 0 THEN BREAK; 328 | Seek(f, FilePos(f) + seglen); 329 | END; 330 | IF not havesegs THEN Append('*** Here is no any segments ***'); 331 | END; 332 | 333 | VAR 334 | f : BFILE; 335 | sign : STRING; 336 | fullen : LONGINT; 337 | modlen : LONGINT; 338 | hdrlen : LONGINT; 339 | hdrrecs : BOOLEAN; 340 | rtype : BYTE; 341 | rdata : STRING; 342 | i : INTEGER; 343 | fname : STRING; 344 | st : STRING; 345 | BEGIN 346 | System.WriteLn('RDFVIEW for NASM-0.98.39 (c) 2022 by DosWorld. MIT License'); 347 | IF ParamCount <> 1 THEN BEGIN 348 | fname := basename(paramstr(0)); 349 | upstr(fname); 350 | System.WriteLn; 351 | System.WriteLn('Usage:'); 352 | System.WriteLn(#9, fname, ' file.rdf'); 353 | Halt(1); 354 | END; 355 | fname := ParamStr(1); 356 | vroot := NIL; 357 | vlast := NIL; 358 | Assign(f, fname); 359 | Reset(f); 360 | i := f.ioResult; 361 | IF i <> 0 THEN BEGIN 362 | WriteLnErr('Could not read ' + fname); 363 | Halt(1); 364 | END; 365 | 366 | fullen := FileSize(f); 367 | FillChar(sign, SizeOf(sign), #0); 368 | BlockRead(f, sign[1], 6); 369 | modlen := ReadDWord(f); 370 | hdrlen := ReadDWord(f); 371 | sign[0] := #6; 372 | Append(' File size: ' + hexdw(fullen) + ' ' + itoa(fullen)); 373 | Append(' Signature: ' + sign); 374 | Append(' Module size: ' + hexdw(modlen) + ' ' + itoa(modlen)); 375 | Append(' Header size: ' + hexdw(hdrlen) + ' ' + itoa(hdrlen)); 376 | Append(''); 377 | IF sign = 'RDOFF2' THEN BEGIN 378 | Append('- Header records'); 379 | hdrrecs := FALSE; 380 | WHILE hdrlen <> 0 DO BEGIN 381 | st := hexdw(FilePos(f)) + ' '; 382 | rtype := ReadByte(f); 383 | FillChar(rdata, SizeOf(rdata), #0); 384 | BlockRead(f, rdata[0], 1); 385 | Dec(hdrlen, 2); 386 | BlockRead(f, rdata[1], ORD(rdata[0])); 387 | Dec(hdrlen, ORD(rdata[0])); 388 | Append(st + hexb(ORD(rdata[0])) + ' ' + hexb(rtype) + '-' + DumpRec(rtype, rdata)); 389 | hdrrecs := TRUE; 390 | END; 391 | IF not hdrrecs THEN Append('*** Here is no any records ***'); 392 | Append('') ; 393 | Append('- Segments'); 394 | DumpSegs(f, modlen); 395 | Append(''); 396 | END ELSE BEGIN 397 | Append('*** File have no RDOFF2 signature, so it seems like not a RDF. ***'); 398 | END; 399 | Close(f); 400 | h := getheight; 401 | w := getwidth; 402 | 403 | scr.push; 404 | fname := basename(fname); 405 | upstr(fname); 406 | view(fname, vroot); 407 | scr.pop; 408 | scr.show; 409 | kbd_reset; 410 | IF sign <> 'RDOFF2' THEN Halt(1); 411 | END. 412 | --------------------------------------------------------------------------------