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