Topspeed_JPI/TS-V3/SAVE/PMD.LST

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