Topspeed_JPI/TS-V3/SRC/PMD.LST

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