Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * PMD.MOD - Post-mortem debugging * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*# call(seg_name=>null) *) 12 (*# name(prefix=>c) *) 13 (*# module(implementation=>off) *) 14 (*# check(stack=>off, 15 index=>off, 16 range=>off, 17 overflow=>off, 18 nil_ptr=>off) *) 19 20 IMPLEMENTATION MODULE PMD; 21 22 (*%F _OS2 *) 23 IMPORT Str, CoreSig, CoreIO, CorePMD, CoreMain; 24 (*%E *) 25 (*%T _OS2 *) 26 IMPORT Str, Dos, CoreSig, CoreIO, CorePMD, CoreMain; 27 FROM SYSTEM IMPORT Ret; 28 (*%E *) 29 30 TYPE SegHeader = RECORD 31 frame: CARDINAL; 32 SegSize: CARDINAL; 33 FilePos: LONGCARD; ***** ^ undeclared identifier 34 BucketSizes: ARRAY [0..15] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 35 END; ***** ^ not supported yet 36 37 (*%T _OS2 *) 38 SelInfo = RECORD 39 selector, size: CARDINAL; 40 END; ***** ^ not supported yet 41 42 CONST 43 MAX_SELS = 256; 44 VAR 45 selectors: ARRAY [0..MAX_SELS] OF SelInfo; ***** ^ not supported yet ***** ^ not supported yet 46 (*%E *) 47 48 CONST 49 ErrMsg ="Runtime Error - Creating PM_DUMP.$$$"; ***** ^ not supported yet 50 51 (*%T _OS2 *) 52 PROCEDURE Os2Write(handle: CARDINAL; buffer: FarADDRESS; count: CARDINAL): CARDINAL; ***** ^ undeclared identifier 53 54 VAR 55 NumWrit: CARDINAL; 56 BEGIN 57 IF Dos.Write(handle, buffer, count, NumWrit) = 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 58 RETURN NumWrit; 59 END; 60 RETURN MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 61 END Os2Write; ***** ^ not supported yet 62 63 TYPE A8 = ARRAY[0..7] OF SHORTCARD; ***** ^ not supported yet ***** ^ not supported yet 64 INLINE PROCEDURE lsl(seg: CARDINAL): CARDINAL 65 = A8(00FH,003H,0C0H,074H,002H,029H,0C0H,Ret); ***** ^ not supported yet ***** ^ not supported yet 66 67 PROCEDURE GetSelectors(): CARDINAL; 68 69 VAR 70 CurSel: CARDINAL; 71 attempt, size: CARDINAL; 72 BEGIN 73 CurSel:=0; 74 attempt:=0FH; 75 WHILE attempt # 0FFFFH DO 76 size := lsl(attempt); ***** ^ not supported yet ***** ^ not supported yet 77 IF size # 0 THEN 78 selectors[CurSel].size:=size+1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 79 selectors[CurSel].selector:=attempt; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 INC(CurSel); ***** ^ undeclared identifier ***** ^ not supported yet 81 IF CurSel = MAX_SELS THEN 82 RETURN CurSel; 83 END; 84 END; 85 INC(attempt, 10H); ***** ^ undeclared identifier ***** ^ not supported yet 86 END; 87 attempt:=07H; 88 WHILE attempt # 0FFF7H DO 89 size := lsl(attempt); ***** ^ not supported yet ***** ^ not supported yet 90 IF size # 0 THEN 91 selectors[CurSel].size:=size+1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 selectors[CurSel].selector:=attempt; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 93 INC(CurSel); ***** ^ undeclared identifier ***** ^ not supported yet 94 IF CurSel = MAX_SELS THEN 95 RETURN CurSel; 96 END; 97 END; 98 INC(attempt, 10H); ***** ^ undeclared identifier ***** ^ not supported yet 99 END; 100 RETURN CurSel; 101 END GetSelectors; ***** ^ not supported yet 102 103 PROCEDURE WriteStruct(VAR State: ProcessState; fh: INTEGER): INTEGER; ***** ^ undeclared identifier 104 105 BEGIN 106 IF Os2Write(fh, FarADR(State), SIZE(ProcessState)) # SIZE(ProcessState) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 107 RETURN -1; 108 END; 109 RETURN 0; 110 END WriteStruct; ***** ^ not supported yet 111 (*%E *) 112 113 (*%F _OS2 *) 114 PROCEDURE WriteStruct(VAR State: ProcessState; fh: INTEGER): INTEGER; 115 116 BEGIN 117 IF CoreIO._write(fh, ADR(State), SIZE(ProcessState)) # SIZE(ProcessState) THEN 118 RETURN -1; 119 END; 120 RETURN 0; 121 END WriteStruct; 122 (*%E *) 123 124 PROCEDURE compress(VAR header: SegHeader; fh: INTEGER): INTEGER; 125 126 VAR 127 SegSize: LONGINT; 128 offset: CARDINAL; 129 OutSize, BucketNo, BucketSize, NumWritize, NumWrit: CARDINAL; 130 BEGIN 131 SegSize:= LONGCARD(header.SegSize); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 132 IF SegSize = 0 THEN 133 SegSize:=10000H; 134 END; 135 offset:=0; 136 BucketNo:=0; 137 WHILE SegSize > 0 DO 138 IF SegSize > 1000H THEN 139 OutSize:=1000H; 140 ELSE 141 OutSize:= CARDINAL(SegSize); ***** ^ not supported yet 142 END; 143 BucketSize:= CorePMD._Pack(OutSize, [header.frame: offset]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 144 header.BucketSizes[BucketNo]:=BucketSize; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 (*%F _OS2 *) 146 IF CoreIO._dos_write(fh, FarADR(CorePMD._p), BucketSize, NumWrit) # 0 THEN 147 (*%E *) 148 (*%T _OS2 *) 149 IF Os2Write(fh, FarADR(CorePMD._p), BucketSize) # BucketSize THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 150 (*%E *) 151 RETURN -1; 152 END; 153 DEC(SegSize, 1000H); ***** ^ undeclared identifier ***** ^ not supported yet 154 INC(offset, 1000H); ***** ^ undeclared identifier ***** ^ not supported yet 155 INC(BucketNo); ***** ^ undeclared identifier ***** ^ not supported yet 156 END; 157 RETURN 0; 158 END compress; ***** ^ not supported yet 159 160 (*%F _OS2 *) 161 PROCEDURE WriteCore(fh: INTEGER; top, bottom: CARDINAL); 162 163 VAR 164 h: SegHeader; 165 TotalParas: CARDINAL; 166 Segment: CARDINAL; 167 SegTotal: CARDINAL; 168 SegNum: CARDINAL; 169 NumToWrite: CARDINAL; 170 BEGIN 171 Segment:=bottom; 172 SegNum:=0; 173 TotalParas:=top-bottom; 174 SegTotal:=(TotalParas+0FFFH) DIV 01000H; 175 IF CoreIO.lseek(fh, LONGCARD((SIZE(ProcessState)+SIZE(CARDINAL)+(SIZE(SegHeader)*SegTotal))-1), 0) # 0 THEN END; 176 CoreIO._write(fh, ADR(Segment), 1); 177 LOOP 178 IF TotalParas = 0 THEN EXIT END; 179 h.frame:=Segment; 180 IF TotalParas < 1000H THEN 181 NumToWrite:=TotalParas 182 ELSE 183 NumToWrite:= 1000H; 184 END; 185 h.SegSize:=NumToWrite<<4; 186 h.FilePos:=CoreIO.lseek(fh, 0, 2); 187 IF compress(h, fh) = -1 THEN 188 SegTotal:=0; 189 EXIT; 190 END; 191 IF CoreIO.lseek(fh, LONGCARD(SIZE(ProcessState)+SIZE(CARDINAL)+SIZE(SegHeader)*SegNum), 0) # 0 THEN END; 192 INC(SegNum); 193 CoreIO._write(fh, ADR(h), SIZE(SegHeader)); 194 INC(Segment, NumToWrite); 195 DEC(TotalParas, NumToWrite); 196 END; 197 IF CoreIO.lseek(fh, (SIZE(ProcessState)), 0) # 0 THEN END; 198 CoreIO._write(fh, ADR(SegTotal), SIZE(CARDINAL)); 199 RETURN; 200 END WriteCore; 201 202 PROCEDURE _PMDbody(VAR state: ProcessState); 203 204 TYPE 205 A2 = ARRAY [0..1] OF CHAR; 206 VAR 207 fh: INTEGER; 208 Ln: A2; 209 BEGIN 210 Ln[0]:= CHAR(0DH); 211 Ln[1]:= CHAR(0AH); (* NB *) 212 IF CoreMain._argc # 0 THEN 213 Str.Copy(state.ProgName, CoreMain._argv[0]^); 214 END; 215 fh:=CoreIO._creat_trunc("PM_DUMP.$$$", 0); 216 IF fh >= 0 THEN 217 IF CoreIO._write(2, ADR(ErrMsg), Str.Length(ErrMsg)) # 0 THEN END; 218 IF CoreIO._write(2, ADR(Ln), 2) # 0 THEN END; 219 IF WriteStruct(state, fh) = 0 THEN 220 WriteCore(fh, state.TopLim, state.PSP); 221 END; 222 IF CoreIO._close(fh) # 0 THEN END; 223 END; 224 RETURN; 225 END _PMDbody; 226 (*%E *) 227 228 (*%T _OS2 *) 229 PROCEDURE WriteCore(fh: INTEGER); 230 231 VAR 232 h: SegHeader; ***** ^ not supported yet 233 Segment, SegTotal: CARDINAL; 234 235 BEGIN 236 Segment:=0; 237 SegTotal:=GetSelectors(); ***** ^ not supported yet ***** ^ not supported yet 238 IF CoreIO.lseek(fh, LONGCARD((SIZE(ProcessState)+SIZE(CARDINAL)+(SIZE(SegHeader)*SegTotal))-1), 0) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 239 IF Os2Write(fh, FarADR(Segment), 1) # 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 240 LOOP 241 IF Segment = SegTotal THEN EXIT END; 242 h.frame:=selectors[Segment].selector; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 h.SegSize:=selectors[Segment].size; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 244 h.FilePos:=CoreIO.lseek(fh, 0, 2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 245 IF compress(h, fh) = -1 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 SegTotal:=0; 247 EXIT; 248 END; 249 IF CoreIO.lseek(fh, LONGCARD(SIZE(ProcessState)+SIZE(CARDINAL)+SIZE(SegHeader)*Segment), 0) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 250 IF Os2Write(fh, FarADR(h), SIZE(SegHeader)) # 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 251 INC(Segment); ***** ^ undeclared identifier ***** ^ not supported yet 252 END; 253 IF CoreIO.lseek(fh, (SIZE(ProcessState)), 0) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 254 IF Os2Write(fh, FarADR(SegTotal), SIZE(CARDINAL)) # 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 255 RETURN; 256 END WriteCore; ***** ^ not supported yet 257 258 PROCEDURE _PMDbody(VAR state: ProcessState); ***** ^ undeclared identifier 259 260 TYPE 261 A2 = ARRAY [0..1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 262 VAR 263 fh: CARDINAL; 264 action: CARDINAL; 265 Ln: A2; ***** ^ not supported yet 266 BEGIN 267 Ln[0]:= CHAR(0DH); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 268 Ln[1]:= CHAR(0AH); (* NB *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 269 IF CoreMain._argc # 0 THEN ***** ^ not supported yet ***** ^ not supported yet 270 Str.Copy(state.ProgName, CoreMain._argv[0]^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 END; 272 IF Dos.Open("PM_DUMP.$$$", fh, action, LONGCARD(0), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 273 0, 012H, 012H, LONGCARD(0)) = 0 THEN ***** ^ undeclared identifier ***** ^ not supported yet 274 IF Os2Write(2, FarADR(ErrMsg), Str.Length(ErrMsg)) # 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 275 IF Os2Write(2, FarADR(Ln), 2) # 0 THEN END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 276 IF WriteStruct(state, fh) = 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 277 WriteCore(fh); ***** ^ not supported yet ***** ^ not supported yet 278 END; 279 IF CoreIO._close(fh) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 280 END; 281 RETURN; 282 END _PMDbody; ***** ^ not supported yet 283 (*%E *) 284 285 PROCEDURE UserFatalError(ErrorCode: CARDINAL); 286 287 BEGIN 288 CoreSig._FatalError(CoreSig._FatalErrorPos(), ErrorCode); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 289 END UserFatalError; ***** ^ not supported yet 290 291 292 BEGIN 293 includePMD:=1; ***** ^ undeclared identifier 294 END PMD. ***** ^ not supported yet 198 errors