Topspeed_JPI/TS-V3/MODBASE/GENLISTS.LST

Listing:

    1  IMPLEMENTATION MODULE GenLists;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/genlists.mov   1.6   30 Dec 1990 17:41:34   coleb  $
   12   *
   13   *)
   14  
   15  
   16  (*EntryDiag:
   17  IMPORT Diagnostics;
   18  :EntryDiag*)
   19  
   20  IMPORT ErrorManager;
   21  IMPORT LowLevel;
   22  IMPORT M2Strings;
   23  IMPORT Numbers;
   24  IMPORT NumTypes;
   25  IMPORT PosUtils;
   26  IMPORT StrEdit;
   27  IMPORT StrConv;
   28  IMPORT SYSTEM;
   29  IMPORT VStorage;
   30  
   31  VAR
   32    ModInitialized : BOOLEAN;
   33  
   34    PROCEDURE Init();
   35      BEGIN
   36        IF ModInitialized THEN
   37          RETURN;
   38        ELSE
   39          ModInitialized := TRUE;
   40        END;
   41  (*EntryDiag:
   42        Diagnostics.Init();
   43  :EntryDiag*)
   44  
   45        ErrorManager.Init();
*****        ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   46        LowLevel.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   47        M2Strings.Init();
*****        ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   48        Numbers.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   49        NumTypes.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   50        PosUtils.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   51        StrEdit.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   52        StrConv.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   53        VStorage.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   54  (*EntryDiag:
   55        Diagnostics.diagS( 'Entering GenLists', '' );
   56  :EntryDiag*)
   57  
   58        ErrorFlag := NoListError;
*****        ^ undeclared identifier
*****                     ^ undeclared identifier
   59        DiagMode := FALSE;
*****        ^ undeclared identifier
   60  
   61  (*EntryDiag:
   62        Diagnostics.diagS( 'Exiting GenLists', '' );
   63  :EntryDiag*)
   64      END Init;
*****          ^ not supported yet
   65  
   66    CONST
   67      InitKey = 53304;
   68      NoMemErStr = "Lack Memory";
*****                   ^ not supported yet
   69      RangeErStr = "GenList ref. out of range";
*****                   ^ not supported yet
   70      Circularity = "Can't insert a list into itself";
*****                    ^ not supported yet
   71  
   72    TYPE
   73      GenList = POINTER TO GenListRec;
*****                           ^ undeclared identifier
   74      ElmtPtr = POINTER TO GenElmt;
*****                           ^ undeclared identifier
   75      GenElmt =
   76        RECORD
   77          FromBlock : BOOLEAN;
   78          (*We have to track this because the BlockToList procedure
   79            could assign addresses and sizes to a data area that it
   80            did not get from the Storage module.*)
   81          size : CARDINAL;
   82          prv, nxt : ElmtPtr;
   83          type : CARDINAL;
   84          CASE : CARDINAL OF
*****          ^ not supported yet
*****                          ^ 'POINTER' expected
   85          (* Changed from tagged to untagged variant 14 Nov 87
   86             because Stony Brook actually enforces matched
   87             references.  Making type a tag never did anything for
   88             us anyway. *)
   89            0 :
   90            elem : SYSTEM.ADDRESS;
   91          | ListCode :
   92            Lelem : POINTER TO GenList;
   93          | StrCode :
   94            Selem : POINTER TO ARRAY [0..255] OF CHAR;
   95          (*Using extremely large strings here seem to blow the
   96            RTD's workspace, for some reason.*)
   97          | 65530 :
   98            handle : VStorage.MemHandle;
   99          | 65529 :
  100            Ielem : POINTER TO INTEGER;
  101          | 65528 :
  102            Celem : POINTER TO CARDINAL;
  103          | 65527 :
  104            Belem : POINTER TO BOOLEAN;
  105          | 65526 :
  106            Chelem : POINTER TO CHAR;
  107          END;
  108        END;
  109  
  110      BlockDescriptor =
  111        RECORD
  112          ElmtRecsAddr : SYSTEM.ADDRESS;
  113          ElmtRecsSize : CARDINAL;
  114          DataAddr : VStorage.MemHandle;
  115          DataSize : CARDINAL;
  116        END;
  117  
  118      GenListRec =
  119        RECORD
  120          ParentList : GenList;
  121        (*This has to be the first field in the record.*)
  122          InitCheck : CARDINAL;
  123          BlockList : GenList;
  124        (*A list of BlockDescriptors.  Used only when the list is
  125          allocated with BlockToList.*)
  126          current, lngth : CARDINAL;
  127          first, now, last : ElmtPtr;
  128        END;
  129  
  130  
  131    PROCEDURE AdrOfList(VAR TheList : GenList) : SYSTEM.ADDRESS;
  132      BEGIN
  133        RETURN SYSTEM.ADR(TheList);
  134      END AdrOfList;
  135  
  136  
  137    PROCEDURE AdrToList(TheAddr : SYSTEM.ADDRESS; TheSize : CARDINAL; VAR
  138        TheList : GenList) : BOOLEAN;
  139      BEGIN
  140        IF TheSize # SYSTEM.TSIZE(GenList) THEN
  141          RETURN FALSE;
  142        ELSE
  143          LowLevel.Move(TheAddr, SYSTEM.ADR(TheList), TheSize);
  144          RETURN TRUE;
  145        END;
  146      END AdrToList;
  147  
  148  
  149  
  150    PROCEDURE ListMove(TheList : GenList; spot : CARDINAL) : BOOLEAN;
  151      VAR
  152        dist1, dist2, dist3, SmallestDist : INTEGER;
  153      BEGIN
  154        IF spot=0 THEN
  155        (*diag*)
  156          ErrorFlag := RefToZero;
  157          RETURN FALSE;
  158        END;
  159        WITH TheList^ DO
  160          IF spot>lngth THEN
  161            current := lngth;
  162            now := last;
  163            ErrorFlag := RefPastEnd;
  164            RETURN FALSE;
  165          ELSE
  166            dist1 := INTEGER(spot)-1;
  167            dist2 := INTEGER(spot)-INTEGER(lngth);
  168            dist3 := INTEGER(spot)-INTEGER(current);
  169          (*Now we need to know which of these is smallest.*)
  170            IF ABS(dist1)>ABS(dist2) THEN
  171              IF ABS(dist2)>ABS(dist3) THEN
  172                SmallestDist := dist3;
  173              ELSE
  174                now := last;
  175                current := lngth;
  176                SmallestDist := dist2;
  177              END;
  178            ELSE
  179              IF ABS(dist1)>ABS(dist3) THEN
  180                SmallestDist := dist3;
  181              ELSE
  182                now := first;
  183                current := 1;
  184                SmallestDist := dist1;
  185              END;
  186            END;
  187            IF SmallestDist>0 THEN
  188              WHILE (current<spot) AND (now#NIL) DO
  189                now := now^.nxt;
  190                INC(current);
  191              END;
  192            ELSE
  193              WHILE (current>spot) AND (now#NIL) DO
  194                now := now^.prv;
  195                DEC(current);
  196              END;
  197            END;
  198          END;
  199        END;
  200        ErrorFlag := NoListError;
  201        RETURN TRUE;
  202      END ListMove;
  203  
  204  
  205    PROCEDURE MoveToSpot(TheList : GenList; spot : CARDINAL);
  206      VAR
  207        TmpStr: ARRAY [0..47] OF CHAR;
  208      BEGIN
  209        IF NOT ListMove(TheList,spot) THEN
  210          StrConv.CardinalToStr( spot, 0, TmpStr );
  211          M2Strings.Insert( "Can't move to list spot ", TmpStr, 0 );
  212          ErrorManager.WARN(TmpStr);
  213        END;
  214      END MoveToSpot;
  215  
  216  
  217    PROCEDURE GetChildList(TheList : GenList; spot : CARDINAL; VAR
  218        Child : GenList);
  219      BEGIN
  220        MoveToSpot( TheList, spot );
  221        IF (TheList^.now^.type#ListCode) OR (TheList^.now^.size# SYSTEM.TSIZE(
  222            GenList)) THEN
  223          ErrorFlag := NoSuchList;
  224          ErrorManager.WARN('Non-list passed to GetChildList');
  225          RETURN;
  226        END;
  227        VStorage.ReadMem(TheList^.now^.handle, 0,
  228            SYSTEM.ADR(Child), SYSTEM.TSIZE(GenList));
  229        ErrorFlag := NoListError;
  230      END GetChildList;
  231  
  232  
  233    PROCEDURE CircularLinkage( ElmtAdr: SYSTEM.ADDRESS; ElmtSize:
  234        CARDINAL; BigList : GenList; GoingUp: BOOLEAN ): BOOLEAN;
  235      (*Here we are trying to detect attempts to insert a list into
  236        itself, or into one of its own sublists, or into a list
  237        into which it has already been inserted.*)
  238      VAR
  239        tmpsize, cnt, TypeCode, ListEnd : CARDINAL;
  240        tmpadr : SYSTEM.ADDRESS;
  241        SubList, SmallList: GenList;
  242      BEGIN
  243        IF (NOT DiagMode) OR (BigList = NIL) THEN
  244          RETURN FALSE;
  245        END;
  246        IF NOT AdrToList( ElmtAdr, ElmtSize, SmallList ) THEN
  247          RETURN FALSE;
  248        END;
  249        IF SmallList = NIL THEN
  250          (*Note that it's okay to have more than one NIL list
  251            in a list.*)
  252          RETURN FALSE;
  253        END;
  254        IF (SmallList = BigList) THEN
  255          ErrorFlag := corruption;
  256          RETURN TRUE;
  257        END;
  258        IF GoingUp AND (BigList^.ParentList # NIL) THEN
  259          IF CircularLinkage( ElmtAdr, ElmtSize, BigList^.ParentList, TRUE ) THEN
  260            RETURN TRUE;
  261          END;
  262        END;
  263        ListEnd := ListLength( BigList );
  264        FOR cnt := 1 TO ListEnd DO
  265          GetElmtAdr( BigList, cnt, tmpadr, tmpsize, TypeCode );
  266          IF TypeCode = ListCode THEN
  267            GetChildList( BigList, cnt, SubList );
  268            IF (SmallList = SubList) THEN
  269              ErrorFlag := corruption;
  270              RETURN TRUE;
  271            ELSE
  272              IF CircularLinkage( ElmtAdr, ElmtSize, SubList, FALSE ) THEN
  273                RETURN TRUE;
  274              END;
  275            END;
  276          END;
  277        END;
  278        RETURN FALSE;
  279      END CircularLinkage;
  280  
  281  
  282    PROCEDURE InitResponse(msg : ARRAY OF CHAR);
  283    (*All calls to InitResponse are diagnostic.  Remove them from
  284      finished programs.*)
  285      VAR
  286        TmpStr : ARRAY [0..79] OF CHAR;
  287      BEGIN
  288        StrEdit.AssignStr('Uninit. list passed to ', TmpStr);
  289        StrEdit.Append(TmpStr, msg);
  290        ErrorManager.WARN(TmpStr);
  291      END InitResponse;
  292  
  293  
  294  (* ===========================
  295     Exported procedures.
  296     =========================== *)
  297  
  298  
  299    PROCEDURE NewList(VAR TheList : GenList);
  300      VAR
  301        size : CARDINAL;
  302      BEGIN
  303        IF (NOT ModInitialized) THEN Init() END;
  304        size := SYSTEM.TSIZE(GenListRec);
  305        VStorage.DosAlloc(TheList, SYSTEM.TSIZE(GenListRec));
  306        TheList^.InitCheck := InitKey;
  307        TheList^.ParentList := NIL;
  308        TheList^.BlockList := NIL;
  309        TheList^.current := 0;
  310        TheList^.lngth := 0;
  311        TheList^.first := NIL;
  312        TheList^.now := NIL;
  313        TheList^.last := NIL;
  314        ErrorFlag := NoListError;
  315      END NewList;
  316  
  317  
  318    PROCEDURE BlockToList(TheAddr: SYSTEM.ADDRESS; BlockSize: CARDINAL;
  319        delimiter1, delimiter2: ARRAY OF CHAR; RecSize, TypeCode:
  320        CARDINAL; VAR TheList: GenList);
  321  
  322    (*We're doing a lot of stuff to avoid problems with disposing
  323      of lists created this way.  The problems tend to arise
  324      because the Storage module doesn't know that any of this stuff
  325      has been allocated except the big contiguous areas for the
  326      data and the list.*)
  327  
  328    VAR
  329      cnt, spot1, spot2, Delim1Len, Delim2Len, elements: CARDINAL;
  330      TmpBlockDescr: BlockDescriptor;
  331      TmpList: GenList;
  332      TwoDelimiters, FixedLengthRecs: BOOLEAN;
  333      BlockAdr: SYSTEM.ADDRESS;
  334  
  335      PROCEDURE MakeOneList(TheList: GenList);
  336      VAR
  337        Tmptr, OldPtr: ElmtPtr;
  338        CheckStr: ARRAY [0..15] OF CHAR;
  339        SubList: GenList;
  340        EndFound : BOOLEAN;
  341        tmpadr: SYSTEM.ADDRESS;
  342      BEGIN
  343        IF (NOT FixedLengthRecs) AND TwoDelimiters THEN
  344          spot2 := spot1;
  345          IF TypeCode < 65000 THEN
  346            (* getting type from file, so make room for it *)
  347            INC(spot2, 2);
  348          END;
  349          IF 0 = PosUtils.PosAdr(delimiter2, LowLevel.AddAddr(BlockAdr, spot2),
  350                   BlockSize - spot2) THEN
  351            (* If an ending delimiter starts this list, it is a null
  352              list, so exit without putting any elements in it *)
  353            spot1 := spot2;
  354            RETURN;
  355          END;
  356        END;
  357        OldPtr := NIL;
  358        EndFound := FALSE;
  359        WHILE (cnt <= (elements - 1)) AND (NOT EndFound) DO
  360          Tmptr := ElmtPtr( LowLevel.AddAddr(TmpBlockDescr.ElmtRecsAddr,
  361              (cnt * SYSTEM.TSIZE(GenElmt))));
  362            (*Tmptr gets the address of the next unused area of the
  363              list block.*)
  364          INC(cnt);
  365          IF TwoDelimiters AND (Delim1Len > 0) THEN
  366            spot1 := PosUtils.PosAdr(delimiter1,
  367                LowLevel.AddAddr(BlockAdr, spot1), BlockSize -
  368                spot1) + Delim1Len + spot1;
  369            IF spot1 > BlockSize THEN
  370              spot1 := BlockSize;
  371            END;
  372            (*We've found the next delimiter1*)
  373          END;
  374          IF TypeCode < 65000 THEN
  375            (*Any type code above 65000 REPERTOIRE considers one of
  376              its own.  Because it doesn't know what this type code
  377              is, we leave room to get it from the block.*)
  378            tmpadr := LowLevel.AddAddr(BlockAdr, spot1);
  379            LowLevel.Move( tmpadr, SYSTEM.ADR(Tmptr^.type), 2);
  380            IF Tmptr^.type = ListCode THEN
  381              (*Now we call ourselves recursively.*)
  382              NewList(SubList);
  383              LowLevel.Move(SYSTEM.ADR(SubList), LowLevel.AddAddr(BlockAdr,
  384                  spot1 - 2), SYSTEM.TSIZE(GenList));
  385              (*We're using an unused part of the data block for
  386                the data area of SubList.*)
  387              Tmptr^.elem := LowLevel.AddAddr(BlockAdr, spot1 - 2);
  388              SubList^.ParentList := TheList;
  389              MakeOneList(SubList);
  390              INC(spot1, Delim2Len);
  391            ELSE
  392              Tmptr^.elem := LowLevel.AddAddr(BlockAdr, spot1 + 2);
  393            END;
  394          ELSE
  395            (*We do know what the type code is--we assume it's not in
  396              the block.*)
  397            Tmptr^.elem := LowLevel.AddAddr(BlockAdr, spot1);
  398              (*Tmptr^.elem gets the address of some area of the data
  399                block.*)
  400            Tmptr^.type := TypeCode;
  401          END;
  402          IF NOT FixedLengthRecs THEN
  403            IF Tmptr^.type = ListCode THEN
  404              RecSize := 4;
  405            ELSE
  406              spot2 := PosUtils.PosAdr(delimiter2,
  407                  LowLevel.AddAddr(BlockAdr, spot1), BlockSize -
  408                  spot1) + spot1;
  409              IF TypeCode < 65000 THEN
  410                (*We don't know what the type code is--we want to get
  411                  it from the block--so we assume the first two bytes
  412                  contain it.*)
  413                IF (spot1 + 2) > spot2 THEN
  414                  (*Something is horribly wrong; try to slip out
  415                    without being noticed.*)
  416                  RETURN;
  417                END;
  418                RecSize := (spot2 - spot1) - 2;
  419              ELSE
  420                (*We know what the type code is, so we assume it's not
  421                  in the block.*)
  422                RecSize := spot2 - spot1;
  423              END;
  424              spot1 := spot2 + Delim2Len;
  425              (*spot1 should now be pointing at the byte
  426                immediately following the delimiter2 that we just found.*)
  427            END;
  428            LowLevel.Fill(SYSTEM.ADR(CheckStr), HIGH(CheckStr) + 1, 0C);
  429  (*
  430  IF cnt >= 171 THEN
  431    Diagnostics.diagA( 'BlockAdr', BlockAdr );
  432    Diagnostics.diagC( 'spot1', spot1 );
  433    Diagnostics.diagC( 'BlockSize', BlockSize );
  434    Diagnostics.diagS( 'CheckStr', CheckStr );
  435  END;
  436  *)
  437            IF (spot1+Delim2Len) >= BlockSize THEN
  438              (* Corrects an OS/2 segmentation fault. *)
  439              EndFound := TRUE;
  440            ELSE
  441              tmpadr := LowLevel.AddAddr(BlockAdr, spot1);
  442              LowLevel.Move( tmpadr, SYSTEM.ADR(CheckStr), Delim2Len);
  443              IF TwoDelimiters AND (M2Strings.CompareStr(CheckStr, delimiter2) = 0) THEN
  444                (*We've found two delimiter2's in a row, so this list
  445                  is ended.*)
  446                EndFound := TRUE;
  447              END;
  448            END;
  449          ELSE
  450            spot1 := cnt * RecSize;
  451          END;
  452          Tmptr^.FromBlock := TRUE;
  453          Tmptr^.size := RecSize;
  454          Tmptr^.prv := OldPtr;
  455          IF OldPtr = NIL THEN
  456            TheList^.current := 1;
  457            TheList^.first := Tmptr;
  458            TheList^.now := Tmptr;
  459          ELSE
  460            OldPtr^.nxt := Tmptr;
  461          END;
  462          OldPtr := Tmptr;
  463          INC(TheList^.lngth);
  464        END;
  465        Tmptr^.nxt := NIL;
  466        TheList^.last := Tmptr;
  467      END MakeOneList;
  468  
  469    BEGIN
  470      IF (NOT ModInitialized) THEN Init() END;
  471      (*BlockToList*)
  472      IF NOT Initialized(TheList) THEN
  473      (*diag*)
  474        InitResponse('BlockToList');
  475        RETURN;
  476      END;
  477      Delim1Len := M2Strings.Length(delimiter1);
  478      Delim2Len := M2Strings.Length(delimiter2);
  479      TwoDelimiters := FALSE;
  480      IF VStorage.InEms( VStorage.MemHandle(TheAddr) ) THEN
  481        BlockAdr := VStorage.LockMem( VStorage.MemHandle(TheAddr) );
  482        VStorage.UnLockMem( VStorage.MemHandle(TheAddr) );
  483      ELSE
  484        BlockAdr := TheAddr;
  485      END;
  486      IF ((Delim1Len>0) OR (Delim2Len>0)) AND (RecSize>0) THEN
  487        (*diag*)
  488        ErrorManager.WARN("Delim-RecSize conflict");
  489        RETURN;
  490      END;
  491        (*Next determine how many elements are in the block.*)
  492      FixedLengthRecs := RecSize > 0;
  493      IF FixedLengthRecs THEN
  494        elements := BlockSize DIV RecSize;
  495      ELSE
  496        (*The records are going to be of variable length.*)
  497        IF M2Strings.CompareStr(delimiter1, delimiter2) # 0 THEN
  498          TwoDelimiters := TRUE;
  499        END;
  500        cnt := 0;
  501        elements := 0;
  502        REPEAT
  503          (*We count the delimiter2s in the block to determine how
  504            many list elements there will be.*)
  505          spot1 := PosUtils.PosAdr(delimiter2, LowLevel.AddAddr(BlockAdr, cnt),
  506              BlockSize - cnt);
  507          IF spot1 < (BlockSize - cnt) THEN
  508            INC(elements);
  509          END;
  510          INC(cnt, spot1 + Delim2Len);
  511        UNTIL cnt >= BlockSize;
  512      END;
  513  (*
  514  Diagnostics.diagC( 'elements', elements );
  515  *)
  516      IF (VAL(LONGINT, elements) * VAL(LONGINT,
  517          SYSTEM.TSIZE(GenElmt))) > NumTypes.L65535 THEN
  518        ErrorManager.WARN('RecSize too small');
  519        (*User has probably reduced RecNameLength to the point
  520          that the list's controlling records will take up more
  521          space than its data.  If so, user needs to reduce size of
  522          ThisChunk in NdxBones.ReadNdx.*)
  523        RETURN;
  524      END;
  525      NewList(TmpList);
  526      TheList^.BlockList := TmpList;
  527      WITH TmpBlockDescr DO
  528        DataAddr := VStorage.MemHandle(TheAddr);
  529        DataSize := BlockSize;
  530        ElmtRecsSize := elements * SYSTEM.TSIZE(GenElmt);
  531        VStorage.DosAlloc(ElmtRecsAddr, ElmtRecsSize);
  532          (*Allocates a contiguous area of memory for the GenList.
  533            Note that we can't just append a list element for every
  534            RecSize'd area of the block using ListInsert because
  535            that would allocate an unnecessary, fragmented copy of
  536            the block.*)
  537      END;
  538      ListInsert(TmpBlockDescr, 0, TheList^.BlockList, 65535);
  539        (*Insert the BlockDescriptor into the BlockList, using 0 as
  540          the type code.*)
  541      IF elements = 0 THEN
  542        RETURN;
  543      END;
  544      (*From here down we're actually building TheList.*)
  545      spot1 := 0;
  546        (*spot1 tracks the position of the last delimiter1 we've
  547          found.*)
  548      spot2 := 0;
  549        (*spot2 tracks the position of the last delimiter2 we've
  550          found.*)
  551      cnt := 0;
  552        (*cnt tracks the number of elements we've processed.*)
  553      MakeOneList(TheList);
  554        (*MakeOneList processes elements until all elements have
  555        been processed or until two delimiter2's are found in a row.*)
  556      IF FixedLengthRecs AND ((BlockSize MOD RecSize) # 0) THEN
  557        (*Note that we may already have allocated lots of memory
  558          for the list.  If you're sure it's invalid, you have to
  559          DisposeList(TheList) when BlockToList returns FALSE.*)
  560        ErrorFlag := underflow;
  561        ErrorManager.WARN('Bad Recsize');
  562        RETURN;
  563      END;
  564      ErrorFlag := NoListError;
  565    END BlockToList;
  566  
  567  
  568  
  569    PROCEDURE ChangeTypeCode(VAR TheList : GenList; spot, NewTypeCode :
  570        CARDINAL);
  571      BEGIN
  572        MoveToSpot( TheList, spot );
  573        TheList^.now^.type := NewTypeCode;
  574      END ChangeTypeCode;
  575  
  576  
  577    PROCEDURE CopyList(InList : GenList; VAR OutList : GenList);
  578      VAR
  579        spot, OldSize, OldType, lngth : CARDINAL;
  580        OldAdr : SYSTEM.ADDRESS;
  581        OldChild, NewChild : GenList;
  582      BEGIN
  583        IF (NOT ModInitialized) THEN Init() END;
  584        ErrorFlag := NoListError;
  585        IF NOT Initialized(InList) THEN
  586        (*diag*)
  587          InitResponse('Copy');
  588          RETURN;
  589        END;
  590        NewList(OutList);
  591        lngth := ListLength(InList);
  592        FOR spot := 1 TO lngth DO
  593          GetElmtAdr(InList, spot, OldAdr, OldSize, OldType);
  594          IF OldType=ListCode THEN
  595            VStorage.ReadMem(InList^.now^.handle, 0,
  596                SYSTEM.ADR(OldChild), SYSTEM.TSIZE(GenList));
  597            IF OldChild = NIL THEN
  598              NewChild := NIL;
  599            ELSE
  600              CopyList(OldChild, NewChild);
  601                (*recursive call*)
  602            END;
  603            OldAdr := SYSTEM.ADR(NewChild);
  604            OldSize := SYSTEM.TSIZE(GenList);
  605          END;
  606          ListInsertAdr(OldAdr, OldSize, OldType, OutList, spot);
  607        END;
  608        IF NOT ListMove( OutList, 1 ) THEN
  609          (*Do nothing; point is just to reset current to 1 for
  610            convenience of screen system.*)
  611        END;
  612      END CopyList;
  613  
  614  
  615    PROCEDURE DisconnectLists( VAR sublist, mainlist: GenList );
  616      VAR
  617        ListEnd, cnt, TypeCode, tmpsize: CARDINAL;
  618        tmpadr: SYSTEM.ADDRESS;
  619        tmplist: GenList;
  620      BEGIN
  621        ListEnd := ListLength( mainlist );
  622        FOR cnt := 1 TO ListEnd DO
  623          GetElmtAdr( mainlist, cnt, tmpadr, tmpsize, TypeCode );
  624          IF (TypeCode = ListCode) AND AdrToList( tmpadr, tmpsize, tmplist ) THEN
  625            IF (sublist = tmplist) THEN
  626              mainlist^.now^.type := 0;
  627              sublist^.ParentList := NIL;
  628            ELSE
  629              IF Initialized( tmplist ) THEN
  630                DisconnectLists( sublist, tmplist );
  631              END;
  632            END;
  633          END;
  634        END;
  635      END DisconnectLists;
  636  
  637  
  638    PROCEDURE DisposeList(VAR TheList : GenList);
  639      VAR
  640        TmpBlockDescr : BlockDescriptor;
  641        TypeCode : CARDINAL;
  642      BEGIN
  643        IF NOT Initialized(TheList) THEN
  644          (*diag*)
  645  (*
  646          InitResponse('DisposeList');
  647    If you want to guarantee that your code is free of needless
  648    calls to DisposeList, you may want to reinsert this.
  649    Reinsertion may also help you avoid subtle design problems.
  650    For people just learning to use REPERTOIRE, though, this causes
  651    needless irritations, so we commented it out.
  652  *)
  653          RETURN;
  654        END;
  655        IF TheList^.ParentList # NIL THEN
  656          ErrorManager.WARN("Disposal of sublist before parent");
  657        END;
  658        ListDelete(TheList, 1, TheList^.lngth);
  659        WITH TheList^ DO
  660          InitCheck := 0;
  661            (*This zeroes the InitCheck in what will become phantom
  662              memory.  It's not strictly necessary, but it helps
  663              detect cases where two GenLists point at the same
  664              thing.*)
  665          IF BlockList#NIL THEN
  666            WHILE ListLength(BlockList)>0 DO
  667              GetElmt(BlockList, 1, TmpBlockDescr, TypeCode);
  668              WITH TmpBlockDescr DO
  669                VStorage.DosDealloc(ElmtRecsAddr, ElmtRecsSize);
  670                VStorage.DeallocMem( VStorage.MemHandle(DataAddr), DataSize );
  671              END;
  672              ListDelete(BlockList, 1, 1);
  673            END;
  674            VStorage.DosDealloc(BlockList, SYSTEM.TSIZE(GenListRec));
  675          END;
  676        END;
  677        VStorage.DosDealloc(TheList, SYSTEM.TSIZE(GenListRec));
  678        TheList := NIL;
  679        ErrorFlag := NoListError;
  680      END DisposeList;
  681  
  682  
  683    PROCEDURE ElmtNow(TheList : GenList) : CARDINAL;
  684      BEGIN
  685        IF NOT Initialized(TheList) THEN
  686        (*diag*)
  687          RETURN 0;
  688        END;
  689        RETURN TheList^.current;
  690      END ElmtNow;
  691  
  692  
  693    PROCEDURE GetElmt(TheList : GenList; spot : CARDINAL; VAR TheElmt :
  694      ARRAY OF SYSTEM.BYTE; VAR TypeCode : CARDINAL);
  695      VAR
  696        DestSize : CARDINAL;
  697      BEGIN
  698        IF NOT Initialized(TheList) THEN
  699          (*diag*)
  700          InitResponse('Get');
  701          RETURN;
  702        END;
  703        MoveToSpot( TheList, spot );
  704        TypeCode := TheList^.now^.type;
  705        DestSize := HIGH(TheElmt)+1;
  706        WITH TheList^.now^ DO
  707          IF size<=DestSize THEN
  708            (*We test for this first because we're not going to
  709              allow overflows.*)
  710            VStorage.ReadMem(handle, 0, SYSTEM.ADR(TheElmt), size);
  711            IF size<DestSize THEN
  712              ErrorFlag := underflow;
  713              IF TypeCode=StrCode THEN
  714                LowLevel.PokeByte(0C,
  715                    LowLevel.seg(SYSTEM.ADR(TheElmt)),
  716                    LowLevel.ofs(SYSTEM.ADR(TheElmt))+size);
  717                  (*We do this to make sure we have a null
  718                    terminator at the end of our string.*)
  719  (*
  720              ELSE
  721                  WARN('Underflow in GetElmt.');
  722                  You may want to reinsert this message
  723                  if you encounter problems with confused
  724                  data types in your lists, but it is
  725                  cumbersome in most situations.
  726  *)
  727              END;
  728              RETURN;
  729            END;
  730          ELSE
  731            VStorage.ReadMem(handle, 0, SYSTEM.ADR(TheElmt), DestSize);
  732            IF (TypeCode = StrCode) AND (size> (DestSize + 1)) THEN
  733              IF INTEGER(DestSize) > LowLevel.ScanEQ( DestSize, 0C,
  734                  SYSTEM.ADR(TheElmt) ) THEN
  735                (* We found a null somewhere in TheElmt; no need to worry. *)
  736                ErrorFlag := NoListError;
  737                RETURN;
  738              END;
  739            END;
  740            IF (TypeCode#StrCode) OR (size> (DestSize + 1)) THEN
  741              (*If it's a string, we're not going to signal an
  742                overflow if size exceeds DestSize by only one,
  743                because the difference is just the null terminator
  744                that we probably appended in the ListInsert.*)
  745              ErrorFlag := overflow;
  746              ErrorManager.WARN('GetElmt Overflow');
  747              RETURN;
  748            END;
  749          END;
  750        END;
  751        ErrorFlag := NoListError;
  752      END GetElmt;
  753  
  754  
  755    PROCEDURE GetElmtAdr(TheList : GenList; spot : CARDINAL; VAR
  756        ReadAddr : SYSTEM.ADDRESS; VAR TheSize : CARDINAL; VAR TypeCode :
  757        CARDINAL);
  758      BEGIN
  759        IF NOT Initialized(TheList) THEN
  760        (*diag*)
  761          InitResponse('Get');
  762          RETURN;
  763        END;
  764        MoveToSpot( TheList, spot );
  765        WITH TheList^.now^ DO
  766          ReadAddr := VStorage.LockMem(handle);
  767          VStorage.UnLockMem(handle);
  768        (* since we unlock here, the returned address is not
  769           guaranteed to be good after the calling program does
  770           anything that affects VStorage memory allocation *)
  771          TypeCode := type;
  772          TheSize := size;
  773        END;
  774        ErrorFlag := NoListError;
  775      END GetElmtAdr;
  776  
  777  
  778    PROCEDURE GetParentList(TheList : GenList; VAR Parent : GenList);
  779      BEGIN
  780        IF TheList^.ParentList=NIL THEN
  781          ErrorFlag := NoSuchList;
  782          ErrorManager.WARN("No parent");
  783          RETURN;
  784        END;
  785        Parent := TheList^.ParentList;
  786        ErrorFlag := NoListError;
  787      END GetParentList;
  788  
  789  
  790    PROCEDURE Initialized(TheList : GenList) : BOOLEAN;
  791      BEGIN
  792        IF (NOT ModInitialized) THEN Init() END;
  793        IF TheList=NIL THEN
  794          ErrorFlag := NoInit;
  795          RETURN FALSE;
  796        ELSIF TheList^.InitCheck=InitKey THEN
  797          ErrorFlag := NoListError;
  798          RETURN TRUE;
  799        ELSE
  800          ErrorFlag := NoInit;
  801          RETURN FALSE;
  802        END;
  803      END Initialized;
  804  
  805  
  806    PROCEDURE JoinLists(VAR MergedList, SurvivingList : GenList; spot :
  807        CARDINAL);
  808      VAR
  809        TmpList1, TmpList2 : GenList;
  810        len1, len2 : LONGINT;
  811      BEGIN
  812        IF (NOT Initialized(MergedList)) OR (NOT Initialized(
  813            SurvivingList)) THEN
  814        (*diag*)
  815          InitResponse('Join');
  816        END;
  817        len1 := Numbers.Lc(ListLength(MergedList));
  818        len2 := Numbers.Lc(ListLength(SurvivingList));
  819        IF (len1+len2)> NumTypes.L65535 THEN
  820        (*diag*)
  821          ErrorManager.WARN("Join too long");
  822          RETURN;
  823        END;
  824        IF len1> NumTypes.L0 THEN
  825          IF len2=NumTypes.L0 THEN
  826            SurvivingList^ := MergedList^;
  827            SurvivingList^.lngth := 0;
  828            (*Because it's going to by INCed by MergedList^.lngth
  829              below.*)
  830            SurvivingList^.BlockList := NIL;
  831            (*Because MergedList^.BlockList is going to be joined
  832              to it below.*)
  833          ELSIF spot>SurvivingList^.lngth THEN
  834            SurvivingList^.last^.nxt := MergedList^.first;
  835            MergedList^.first^.prv := SurvivingList^.last;
  836            SurvivingList^.last := MergedList^.last;
  837          ELSIF spot<=1 THEN
  838            MergedList^.last^.nxt := SurvivingList^.first;
  839            SurvivingList^.first^.prv := MergedList^.last;
  840            SurvivingList^.first := MergedList^.first;
  841          ELSE
  842            IF ListMove(SurvivingList,spot) THEN
  843            END;
  844            WITH SurvivingList^ DO
  845              now^.prv^.nxt := MergedList^.first;
  846              MergedList^.first^.prv := now^.prv;
  847              MergedList^.last^.nxt := now;
  848              now^.prv := MergedList^.last;
  849            END;
  850          END;
  851          INC(SurvivingList^.lngth, MergedList^.lngth);
  852          SurvivingList^.now := SurvivingList^.first;
  853          SurvivingList^.current := 1;
  854        END;
  855        IF (MergedList^.BlockList#NIL)
  856            AND (ListLength(MergedList^.BlockList)>0) THEN
  857          IF SurvivingList^.BlockList=NIL THEN
  858            NewList(TmpList1);
  859            SurvivingList^.BlockList := TmpList1;
  860          ELSE
  861            TmpList1 := SurvivingList^.BlockList;
  862          END;
  863          TmpList2 := MergedList^.BlockList;
  864          JoinLists(TmpList2, TmpList1, 65535);
  865        (*recursive call*)
  866        END;
  867        VStorage.DosDealloc(MergedList, SYSTEM.TSIZE(GenListRec));
  868        MergedList := NIL;
  869      END JoinLists;
  870  
  871  
  872    PROCEDURE ListDelete(TheList : GenList; spot, HowMany : CARDINAL);
  873      VAR
  874        ElementsDeleted : CARDINAL;
  875        NewPrv, NewNxt : ElmtPtr;
  876        SubList : GenList;
  877      BEGIN
  878        IF NOT Initialized(TheList) THEN
  879          (*diag*)
  880          InitResponse('Delete');
  881          RETURN;
  882        END;
  883        IF HowMany=0 THEN
  884          ErrorFlag := NoListError;
  885          RETURN;
  886        ELSIF spot>TheList^.lngth THEN
  887          ErrorFlag := RefPastEnd;
  888          ErrorManager.WARN(RangeErStr);
  889          RETURN;
  890        END;
  891        MoveToSpot( TheList, spot );
  892        ElementsDeleted := 0;
  893        NewPrv := TheList^.now^.prv;
  894        LOOP
  895          WITH TheList^.now^ DO
  896            IF type=ListCode THEN
  897              VStorage.ReadMem(handle, 0, SYSTEM.ADR(SubList),
  898                  SYSTEM.TSIZE(GenList));
  899                (*We can't use GetChildList for this operation
  900                  because the list is corrupt between deletion of
  901                  the first and last elements.*)
  902              IF Initialized(SubList) THEN
  903                SubList^.ParentList := NIL;
  904                  (*DisposeList normally checks for a non-NIL
  905                    ParentList to detect disposals of sublists before
  906                    parents.  This disables the check.*)
  907                DisposeList(SubList);
  908              END;
  909            END;
  910              (* 8 Jul 88:  took following statement out of ELSIF clause
  911                 so as to deallocate the 4-byte pointer to the GenListRec.  We
  912                 were previously leaking memory 4 bytes per sublist. *)
  913            IF NOT FromBlock THEN
  914              (*We can't deallocate the data area if it was
  915                allocated as part of a big block.  Instead, we'll
  916                deallocate it in DisposeList.*)
  917              VStorage.DeallocMem(handle, size);
  918            END;
  919            INC(ElementsDeleted);
  920            NewNxt := nxt;
  921          END;
  922          IF (ElementsDeleted<HowMany) AND (NewNxt#NIL) THEN
  923            TheList^.now := NewNxt;
  924            IF (NewNxt^.prv#NIL) AND (NOT NewNxt^.prv^.FromBlock) THEN
  925              VStorage.DosDealloc(NewNxt^.prv, SYSTEM.TSIZE(GenElmt));
  926            END;
  927          ELSE
  928            WITH TheList^ DO
  929              DEC(lngth, ElementsDeleted);
  930              IF NOT now^.FromBlock THEN
  931                VStorage.DosDealloc(now, SYSTEM.TSIZE(GenElmt));
  932              END;
  933              IF NewPrv#NIL THEN
  934                (*Establish the forward link.*)
  935                NewPrv^.nxt := NewNxt;
  936              ELSE
  937                (*We've deleted the first element of TheList.*)
  938                first := NewNxt;
  939              END;
  940              IF NewNxt#NIL THEN
  941                (*Establish the backward link.*)
  942                NewNxt^.prv := NewPrv;
  943                now := NewNxt;
  944              ELSE
  945                (*We've deleted the last element of TheList.*)
  946                now := NewPrv;
  947                last := NewPrv;
  948                DEC(current);
  949                (*Note that current will go to zero here if we delete
  950                  the only remaining element of TheList.  That should
  951                  be correct, since it's initialized to zero.*)
  952              END;
  953              EXIT;
  954            END;
  955          END;
  956        END;
  957        ErrorFlag := NoListError;
  958      END ListDelete;
  959  
  960  
  961    PROCEDURE ListInsert(Element : ARRAY OF SYSTEM.BYTE; TypeCode : CARDINAL;
  962        TheList : GenList; spot : CARDINAL);
  963      BEGIN
  964        ListInsertAdr(SYSTEM.ADR(Element), HIGH(Element)+1, TypeCode, TheList,
  965            spot);
  966      END ListInsert;
  967  
  968  
  969    PROCEDURE ListInsertAdr(ReadAddr : SYSTEM.ADDRESS; TheSize : CARDINAL;
  970        TypeCode : CARDINAL; TheList : GenList; spot : CARDINAL);
  971    (* inserts a unit TheSize long starting at ReadAddr *)
  972      VAR
  973        tmp : ElmtPtr;
  974        TmpElmt : GenElmt;
  975        TmpAdr : SYSTEM.ADDRESS;
  976        Indirector : POINTER TO GenList;
  977        DiagSize : CARDINAL;
  978  
  979      BEGIN
  980        IF (TypeCode = ListCode) AND DiagMode THEN
  981          IF CircularLinkage( ReadAddr, TheSize, TheList, TRUE ) THEN
  982            ErrorManager.WARN( Circularity );
  983          END;
  984        END;
  985        ErrorFlag := NoListError;
  986        IF NOT Initialized(TheList) THEN
  987        (*diag*)
  988          InitResponse('Insert');
  989          RETURN;
  990        END;
  991        IF TypeCode=StrCode THEN
  992          TmpElmt.size := 1+ LowLevel.ScanEQ(TheSize,0C,ReadAddr);
  993        (*This makes sure the null terminator gets included with
  994          the string, if there is one.  If the string completely
  995          fills its array, there won't be a null terminator, so
  996          we have to put one in when we copy out of the list in
  997          GetElmt and NextElmt.*)
  998        ELSE
  999          TmpElmt.size := TheSize;
 1000          (*Store the size of the data area to be allocated.*)
 1001        END;
 1002        IF NOT VStorage.AllocMem(TmpElmt.handle,TmpElmt.size) THEN
 1003        (*Allocate the data area.*)
 1004          ErrorFlag := InsuffMem;
 1005          ErrorManager.WARN(NoMemErStr);
 1006          RETURN;
 1007        END;
 1008        TmpAdr := VStorage.LockMem(TmpElmt.handle);
 1009      (* locks the allocated area into memory (allows us to use
 1010         expanded memory) *)
 1011        LowLevel.Move(ReadAddr, TmpAdr, TmpElmt.size);
 1012        (*Copy the element into the data area.*)
 1013        IF TypeCode=StrCode THEN
 1014          LowLevel.Fill( LowLevel.AddAddr(TmpAdr, TmpElmt.size-1), 1, 0C);
 1015        (* if string, store null terminator *)
 1016        END;
 1017        VStorage.UnLockMem(TmpElmt.handle);
 1018        WITH TheList^ DO
 1019          IF (NOT ListMove(TheList,spot)) AND (ErrorFlag=RefToZero) THEN
 1020          (*diag*)
 1021            ErrorManager.WARN(RangeErStr);
 1022            RETURN;
 1023          END;
 1024          DiagSize := SYSTEM.TSIZE(GenElmt);
 1025          VStorage.DosAlloc(tmp, DiagSize);
 1026          tmp^.type := TypeCode;
 1027          IF TypeCode=ListCode THEN
 1028            Indirector := ReadAddr;
 1029            IF Initialized(Indirector^) THEN
 1030              (* 23 Dec 88:  added this check for NIL to fix bug discovered
 1031                 by the people at LaserMaster Corp. *)
 1032              Indirector^^.ParentList := TheList;
 1033            END;
 1034          END;
 1035          IF now=NIL THEN
 1036          (*This only happens when we have a null list.  Otherwise
 1037            ListMove will have stopped before going past the last
 1038            element in the list.*)
 1039            tmp^.nxt := NIL;
 1040            tmp^.prv := NIL;
 1041            last := tmp;
 1042            first := tmp;
 1043            current := 1;
 1044          ELSE
 1045            IF (spot>lngth) THEN
 1046              tmp^.prv := now;
 1047              tmp^.nxt := NIL;
 1048              now^.nxt := tmp;
 1049              INC(current);
 1050              last := tmp;
 1051            ELSE
 1052              tmp^.prv := now^.prv;
 1053              now^.prv := tmp;
 1054              tmp^.nxt := now;
 1055              IF tmp^.prv#NIL THEN
 1056              (*We know we're not on the first element of the list.*)
 1057                tmp^.prv^.nxt := tmp;
 1058              ELSE
 1059              (*tmp is the new first element of the list.*)
 1060                first := tmp;
 1061              END;
 1062             END;
 1063          END;
 1064          tmp^.elem := TmpElmt.elem;
 1065          tmp^.size := TmpElmt.size;
 1066          tmp^.FromBlock := FALSE;
 1067          now := tmp;
 1068          INC(lngth);
 1069        END;
 1070        IF ErrorFlag = RefPastEnd THEN
 1071          ErrorFlag := NoListError;
 1072        END;
 1073      END ListInsertAdr;
 1074  
 1075  
 1076    PROCEDURE ListLength(TheList : GenList) : CARDINAL;
 1077      (*Number of elements at this node of the list.*)
 1078      BEGIN
 1079        IF NOT Initialized(TheList) THEN
 1080          (*diag*)
 1081          InitResponse('ListLength');
 1082          RETURN 0;
 1083        END;
 1084        ErrorFlag := NoListError;
 1085                                  (*added 30 Oct 86*)
 1086        RETURN TheList^.lngth;
 1087      END ListLength;
 1088  
 1089  
 1090    PROCEDURE ListReplace(Element : ARRAY OF SYSTEM.BYTE; TypeCode : CARDINAL;
 1091        TheList : GenList; spot : CARDINAL);
 1092      BEGIN
 1093        ListReplaceAdr(SYSTEM.ADR(Element), HIGH(Element)+1, TypeCode, TheList,
 1094            spot);
 1095      END ListReplace;
 1096  
 1097  
 1098    PROCEDURE ListReplaceAdr(ReadAddr : SYSTEM.ADDRESS; TheSize, TypeCode :
 1099        CARDINAL; TheList : GenList; spot : CARDINAL);
 1100      VAR
 1101        StrLen, DestSize : CARDINAL;
 1102        ChildList, CheckList : GenList;
 1103        tmp : ElmtPtr;
 1104        Indirector : POINTER TO GenList;
 1105        TmpAdr : SYSTEM.ADDRESS;
 1106      BEGIN
 1107        ErrorFlag := NoListError;
 1108        IF NOT Initialized(TheList) THEN
 1109        (*diag*)
 1110          InitResponse('Replace');
 1111          RETURN;
 1112        END;
 1113        MoveToSpot( TheList, spot );
 1114        WITH TheList^.now^ DO
 1115          IF (type = ListCode) THEN
 1116            (*Now we have to dispose of the old list UNLESS it's
 1117              identical to what replaces it.*)
 1118            GetChildList(TheList, spot, ChildList);
 1119            IF (TypeCode # ListCode) OR (NOT AdrToList( ReadAddr,
 1120                TheSize, CheckList )) THEN
 1121              CheckList := NIL;
 1122            END;
 1123            IF (CheckList # ChildList) AND (ChildList # NIL) THEN
 1124              ChildList^.ParentList := NIL;
 1125                (*We do this to prevent DisposeList from warning us
 1126                  about premature disposal of children.*)
 1127              IF (CheckList # NIL) AND DiagMode THEN
 1128                IF CircularLinkage( ReadAddr, TheSize, TheList, TRUE ) THEN
 1129                  ErrorManager.WARN( Circularity );
 1130                END;
 1131                IF NOT ListMove(TheList,spot) THEN
 1132                  (*Have to make sure we're still in the same spot.*)
 1133                  RETURN;
 1134                END;
 1135              END;
 1136                (*Check for circularity first so you won't find
 1137                  the disposed sublist.*)
 1138              DisposeList(ChildList);
 1139                (*DisposeList won't mind if ChildList is NIL.*)
 1140            END;
 1141          END;
 1142          IF (TypeCode=StrCode) THEN
 1143          (*We know here that we're dealing with strings, so an
 1144            underflow won't matter.  If the new string is shorter
 1145            than the size of the old element's data area, we can
 1146            copy over it without ALLOCATING and DEALLOCATING.*)
 1147            StrLen := 1 + LowLevel.ScanEQ(TheSize,0C,ReadAddr);
 1148          (*This makes sure the null terminator gets included with
 1149              the string.*)
 1150            IF StrLen<=size THEN
 1151              TmpAdr := VStorage.LockMem(handle);
 1152              LowLevel.Move(ReadAddr, TmpAdr, StrLen);
 1153              LowLevel.PokeByte(0C, LowLevel.seg(TmpAdr),
 1154                  LowLevel.ofs(TmpAdr)+StrLen-1);
 1155              (*We do this to guarantee that constant strings
 1156                passed to open arrays will be stored with null
 1157                terminators.*)
 1158              VStorage.UnLockMem(handle);
 1159              IF StrLen<size THEN
 1160              (*We do this to let the user determine whether a
 1161                longer string has been replaced with a shorter one,
 1162                although it's not clear why any user would want to
 1163                know that.*)
 1164                ErrorFlag := underflow;
 1165              END;
 1166              type := TypeCode;
 1167              RETURN;
 1168            ELSE
 1169              TheSize := StrLen;
 1170            END;
 1171          END;
 1172          DestSize := size;
 1173        END;
 1174      (* We have to end the WITH here because we may change the
 1175        TheList^.now pointer in the next few lines.*)
 1176        IF DestSize#TheSize THEN
 1177          IF TheList^.now^.FromBlock THEN
 1178            VStorage.DosAlloc(tmp, SYSTEM.TSIZE(GenElmt));
 1179            tmp^ := TheList^.now^;
 1180            TheList^.now := tmp;
 1181            TheList^.now^.FromBlock := FALSE;
 1182          (*We do this because we know at this point that FromBlock
 1183            has to be FALSE--the new data won't fit in the old
 1184            area--and since FromBlock tells ListDelete whether it
 1185            can dispose of memory allocated both to the data area
 1186            and the controlling record, we can't let them get out
 1187            of sync.*)
 1188          (* Next, correct nxt, prv, first, and last pointers
 1189             if affected *)
 1190            IF spot=1 THEN
 1191              TheList^.first := tmp;
 1192            ELSE
 1193              TheList^.now^.prv^.nxt := tmp;
 1194            END;
 1195            IF spot>=TheList^.lngth THEN
 1196              TheList^.last := tmp;
 1197            ELSE
 1198              TheList^.now^.nxt^.prv := tmp;
 1199            END;
 1200          ELSE
 1201            VStorage.DeallocMem(TheList^.now^.handle, TheList^.now^.size);
 1202          END;
 1203          TheList^.now^.size := TheSize;
 1204          IF NOT VStorage.AllocMem( TheList^.now^.handle,
 1205              TheList^.now^.size ) THEN
 1206            ErrorFlag := InsuffMem;
 1207            ErrorManager.WARN(NoMemErStr);
 1208            RETURN;
 1209          END;
 1210        END;
 1211        WITH TheList^.now^ DO
 1212          TmpAdr := VStorage.LockMem(handle);
 1213          LowLevel.Move(ReadAddr, TmpAdr, TheSize);
 1214          type := TypeCode;
 1215          IF TypeCode=ListCode THEN
 1216            Indirector := ReadAddr;
 1217            IF Initialized(Indirector^) THEN
 1218              (* 23 Dec 88:  added this check for NIL to fix bug discovered
 1219                 by the people at LaserMaster Corp. *)
 1220              Indirector^^.ParentList := TheList;
 1221            END;
 1222          ELSIF TypeCode=StrCode THEN
 1223            LowLevel.PokeByte(0C, LowLevel.seg(TmpAdr),
 1224                LowLevel.ofs(TmpAdr) + TheSize - 1 );
 1225          END;
 1226          VStorage.UnLockMem(handle);
 1227        END;
 1228      END ListReplaceAdr;
 1229  
 1230  
 1231    PROCEDURE ListSize(TheList : GenList; VAR TotalElements : LONGINT;
 1232      VAR TotalSubLists : CARDINAL; VAR TotalListSize : LONGINT) : LONGINT;
 1233      VAR
 1234        SubList : GenList;
 1235        SubListTotal : CARDINAL;
 1236        SubElements, DataSize, SubSize : LONGINT;
 1237        firstime : BOOLEAN;
 1238      BEGIN
 1239        TotalElements := NumTypes.L0;
 1240        TotalSubLists := 0;
 1241        DataSize := NumTypes.L0;
 1242        TotalListSize := NumTypes.L0;
 1243        IF NOT Initialized(TheList) THEN
 1244        (*diag*)
 1245          RETURN DataSize;
 1246        END;
 1247        IF NOT ListMove(TheList,1) THEN
 1248          RETURN DataSize;
 1249        END;
 1250        firstime := TRUE;
 1251        REPEAT
 1252          IF firstime THEN
 1253            firstime := FALSE;
 1254          ELSE
 1255            IF NOT ListMove(TheList,TheList^.current+1) THEN
 1256            END;
 1257          END;
 1258          IF TheList^.now^.type=ListCode THEN
 1259            GetChildList(TheList, TheList^.current, SubList);
 1260            DataSize := DataSize+ListSize(SubList,SubElements,
 1261                SubListTotal,SubSize);
 1262            INC(TotalElements);
 1263            (*We increment our TotalElements one for the sublist.*)
 1264            TotalElements := TotalElements+SubElements;
 1265            (*And again for the sublist's elements.*)
 1266            INC(TotalSubLists);
 1267            (*We increment it one for the sublist itself.*)
 1268            INC(TotalSubLists, SubListTotal);
 1269            (*And again for all the sublist's sublists.*)
 1270            TotalListSize := TotalListSize+SubSize;
 1271          ELSE
 1272            INC(TotalElements);
 1273            DataSize := DataSize + Numbers.Lc(TheList^.now^.size);
 1274            TotalListSize := TotalListSize + Numbers.Lc( TheList^.now^.size );
 1275            INC(TotalListSize, SYSTEM.TSIZE(GenListRec));
 1276          END;
 1277        UNTIL TheList^.current=TheList^.lngth;
 1278        ErrorFlag := NoListError;
 1279        RETURN DataSize;
 1280      END ListSize;
 1281  
 1282  
 1283    PROCEDURE ListToAdr(TheList : GenList; TheAddr : SYSTEM.ADDRESS; TheSize :
 1284        CARDINAL) : BOOLEAN;
 1285      BEGIN
 1286        IF TheSize # SYSTEM.TSIZE(GenList) THEN
 1287          RETURN FALSE;
 1288        ELSE
 1289          LowLevel.Move(SYSTEM.ADR(TheList), TheAddr, TheSize);
 1290          RETURN TRUE;
 1291        END;
 1292      END ListToAdr;
 1293  
 1294  
 1295    PROCEDURE ListToBlock(TheList : GenList; delimiter1, delimiter2 :
 1296      ARRAY OF CHAR; VAR TheAddr : SYSTEM.ADDRESS; VAR BlockSize, RecSize :
 1297        CARDINAL);
 1298      (*Note that the calling program is responsible for
 1299        deallocating the memory allocated by ListToBlock.*)
 1300      VAR
 1301        DelimSpace, BlockPtr, SubLists : CARDINAL;
 1302        tmpl, elements, TotalData, TotalListSize : LONGINT;
 1303        TwoDelimiters : BOOLEAN;
 1304  
 1305      PROCEDURE CopyOut(TheList : GenList);
 1306      (*This procedure has to be split out from the rest of
 1307        ListToBlock because it needs to call itself recursively
 1308        when it encounters a SubList.  Note that it operates on the
 1309        BlockPtr variable, which is global to the ListToBlock
 1310        procedure. The purpose of that is to prevent the recursive
 1311        calls from writing back over the start of the block.*)
 1312        VAR
 1313          SubList : GenList;
 1314          NilList: BOOLEAN;
 1315        BEGIN
 1316          IF NOT Initialized( TheList ) THEN
 1317            NewList( TheList );
 1318            NilList := TRUE;
 1319          ELSE
 1320            NilList := FALSE;
 1321          END;
 1322          IF NOT ListMove(TheList,1) THEN
 1323            ErrorFlag := RefPastEnd;
 1324            RETURN;
 1325          END;
 1326          WHILE ErrorFlag#RefPastEnd DO
 1327            WITH TheList^.now^ DO
 1328              IF TwoDelimiters THEN
 1329                LowLevel.Move(SYSTEM.ADR(delimiter1),
 1330                    LowLevel.AddAddr(TheAddr, BlockPtr),
 1331                    M2Strings.Length(delimiter1));
 1332                INC(BlockPtr, M2Strings.Length(delimiter1));
 1333                  (*These next two statements make the kind of block
 1334                    produced by ListToBlock match the structure of an
 1335                    NdxFile.  You may want to delete them if you use
 1336                    ListToBlock for other purposes.*)
 1337                LowLevel.Move(SYSTEM.ADR(type),
 1338                    LowLevel.AddAddr(TheAddr, BlockPtr), 2);
 1339                INC(BlockPtr, 2);
 1340              END;
 1341              IF type=ListCode THEN
 1342                GetChildList(TheList, TheList^.current, SubList);
 1343                CopyOut(SubList);
 1344              ELSE
 1345                VStorage.ReadMem(handle, 0,
 1346                    LowLevel.AddAddr(TheAddr, BlockPtr), size);
 1347                INC(BlockPtr, size);
 1348              END;
 1349            END;
 1350            LowLevel.Move(SYSTEM.ADR(delimiter2),
 1351                LowLevel.AddAddr(TheAddr, BlockPtr),
 1352                M2Strings.Length(delimiter2));
 1353            INC(BlockPtr, M2Strings.Length(delimiter2));
 1354            IF ListMove(TheList,TheList^.current+1) THEN
 1355            END;
 1356          END;
 1357          IF NilList THEN
 1358            DisposeList( TheList );
 1359          END;
 1360        END CopyOut;
 1361  
 1362      BEGIN
 1363        IF (NOT ModInitialized) THEN Init() END;
 1364      (*ListToBlock*)
 1365        TotalData := ListSize(TheList,elements,SubLists,TotalListSize);
 1366        IF (TotalData> NumTypes.L65535)  THEN
 1367        (*We've got too much data in the list to store in a
 1368          contiguous area of memory.*)
 1369          ErrorFlag := InsuffMem;
 1370          RETURN;
 1371        END;
 1372        TwoDelimiters := FALSE;
 1373        IF (M2Strings.Length(delimiter1)>0) OR
 1374            (M2Strings.Length(delimiter2)>0) THEN
 1375          IF elements> NumTypes.L65535 THEN
 1376            ErrorFlag := InsuffMem;
 1377            RETURN;
 1378          END;
 1379          DelimSpace := Numbers.C(elements *
 1380              Numbers.Lc(M2Strings.Length(delimiter1)));
 1381          IF NOT PosUtils.Equal(delimiter1,delimiter2) THEN
 1382          (*We're supposed to use a separate delimiter to mark the
 1383            start and end of each element.*)
 1384            DelimSpace := DelimSpace + Numbers.C(elements *
 1385                Numbers.Lc(M2Strings.Length(delimiter2)+2));
 1386            (*It's +2 to allow room for record types.  See the
 1387              comment above.*)
 1388            TwoDelimiters := TRUE;
 1389          END;
 1390        ELSE
 1391          DelimSpace := 0;
 1392        END;
 1393        BlockSize := Numbers.C(TotalData)+DelimSpace;
 1394       (* size of block created *)
 1395        VStorage.DosAlloc(TheAddr, BlockSize);
 1396        tmpl := elements-Numbers.Lc(SubLists);
 1397        (*We use tmpl to avoid a bug in Logitech's v3.0 LongInts.*)
 1398        IF (elements > Numbers.Lc(SubLists)) AND
 1399            ((Numbers.Lc(BlockSize) MOD (tmpl))=NumTypes.L0) THEN
 1400          RecSize := BlockSize DIV Numbers.C(tmpl);
 1401        (* size of each record if they're fixed-length *)
 1402        ELSE
 1403          RecSize := 0;
 1404        END;
 1405        BlockPtr := 0;
 1406        CopyOut(TheList);
 1407        ErrorFlag := NoListError;
 1408      END ListToBlock;
 1409  
 1410  
 1411    PROCEDURE NextElmt(TheList : GenList; HowFar : INTEGER; VAR
 1412        TheElmt : ARRAY OF SYSTEM.BYTE; VAR TypeCode : CARDINAL);
 1413      VAR
 1414        DestSize, cnt : CARDINAL;
 1415      BEGIN
 1416        IF NOT Initialized(TheList) THEN
 1417        (*diag*)
 1418          InitResponse('Next');
 1419          RETURN;
 1420        END;
 1421        WITH TheList^ DO
 1422          cnt := ABS(HowFar);
 1423          IF (TheList^.now#NIL) AND (HowFar<0) THEN
 1424            WHILE (cnt>0) AND (TheList^.now^.prv#NIL) DO
 1425              TheList^.now := TheList^.now^.prv;
 1426              DEC(cnt);
 1427              DEC(TheList^.current);
 1428            END;
 1429          ELSE
 1430            WHILE (cnt>0) AND (TheList^.now^.nxt#NIL) DO
 1431              TheList^.now := TheList^.now^.nxt;
 1432              DEC(cnt);
 1433              INC(TheList^.current);
 1434            END;
 1435          END;
 1436        END;
 1437        TypeCode := TheList^.now^.type;
 1438        DestSize := HIGH(TheElmt)+1;
 1439        WITH TheList^.now^ DO
 1440          IF size<=DestSize THEN
 1441          (*We test for this first because we're not going to
 1442            allow overflows.*)
 1443            VStorage.ReadMem(handle, 0, SYSTEM.ADR(TheElmt), size);
 1444            IF size<DestSize THEN
 1445              ErrorFlag := underflow;
 1446              IF TypeCode=StrCode THEN
 1447                LowLevel.PokeByte(0C,
 1448                    LowLevel.seg(SYSTEM.ADR(TheElmt)),
 1449                    LowLevel.ofs(SYSTEM.ADR(TheElmt))+size);
 1450                (*We do this to make sure we have a null
 1451                  terminator at the end of our string.*)
 1452                RETURN;
 1453              ELSE
 1454            (*
 1455              WARN('Underflow in NextElmt');
 1456                Commented out, 30 Oct 86
 1457            *)
 1458                RETURN;
 1459              END;
 1460            ELSE
 1461              ErrorFlag := NoListError;
 1462              RETURN;
 1463            END;
 1464          ELSE
 1465            VStorage.ReadMem(handle, 0, SYSTEM.ADR(TheElmt), DestSize);
 1466            ErrorFlag := overflow;
 1467            ErrorManager.WARN('Overflow in NextElmt');
 1468            RETURN;
 1469          END;
 1470        END;
 1471        ErrorFlag := NoListError;
 1472      END NextElmt;
 1473  
 1474  
 1475    PROCEDURE NilList(VAR TheList : GenList);
 1476      BEGIN
 1477        TheList := NIL;
 1478      END NilList;
 1479  
 1480  
 1481    PROCEDURE SameList( list1, list2: GenList ): BOOLEAN;
 1482      VAR
 1483        tmpadr: SYSTEM.ADDRESS;
 1484        tmpsize: CARDINAL;
 1485      BEGIN
 1486        IF (NOT ModInitialized) THEN Init() END;
 1487        IF (list1 = list2) THEN
 1488          RETURN TRUE;
 1489        END;
 1490        tmpsize := 4;
 1491        IF NOT ListToAdr( list1, SYSTEM.ADR(tmpadr), tmpsize ) THEN
 1492          RETURN FALSE;
 1493        END;
 1494        RETURN CircularLinkage( SYSTEM.ADR(tmpadr), tmpsize, list2, TRUE );
 1495      END SameList;
 1496  
 1497  
 1498    PROCEDURE ScanList(TheStr : ARRAY OF CHAR; TheList : GenList;
 1499        StartingAt, EndingAt : CARDINAL; VAR FoundSpot : CARDINAL) :
 1500        CARDINAL;
 1501      VAR
 1502        spot : CARDINAL;
 1503        TmpAdr : SYSTEM.ADDRESS;
 1504      BEGIN
 1505      (*ScanList*)
 1506        IF NOT Initialized(TheList) THEN
 1507        (*diag*)
 1508          RETURN 0;
 1509        END;
 1510        IF NOT ListMove(TheList,StartingAt) THEN
 1511          RETURN 0;
 1512        END;
 1513        IF TheList^.now=NIL THEN
 1514          ErrorFlag := NoListError;
 1515          RETURN (0);
 1516        END;
 1517        WITH TheList^ DO
 1518          IF (EndingAt>StartingAt) THEN
 1519            WHILE (StartingAt<=EndingAt) AND (now#NIL) DO
 1520              TmpAdr := VStorage.LockMem(now^.handle);
 1521              spot := PosUtils.PosAdr(TheStr,TmpAdr,now^.size);
 1522            (* We could use a ScanMem function here if it existed*)
 1523              VStorage.UnLockMem(now^.handle);
 1524              IF (spot<now^.size) THEN
 1525                FoundSpot := spot;
 1526                ErrorFlag := NoListError;
 1527                RETURN (current);
 1528              END;
 1529              INC(StartingAt);
 1530              INC(current);
 1531              now := now^.nxt;
 1532            END;
 1533            IF now=NIL THEN
 1534              now := last;
 1535            END;
 1536          ELSE
 1537            WHILE (StartingAt>=EndingAt) AND (now#NIL) DO
 1538              TmpAdr := VStorage.LockMem(now^.handle);
 1539              spot := PosUtils.PosAdr(TheStr,TmpAdr,now^.size);
 1540              VStorage.UnLockMem(now^.handle);
 1541              IF (spot<now^.size) THEN
 1542                FoundSpot := spot;
 1543                RETURN (current);
 1544              END;
 1545              DEC(StartingAt);
 1546              DEC(TheList^.current);
 1547              TheList^.now := TheList^.now^.prv;
 1548            END;
 1549            IF now=NIL THEN
 1550              now := first;
 1551            END;
 1552          END;
 1553        END;
 1554        RETURN (0);
 1555       (*TheStr not found between StartingAt and EndingAt.*)
 1556      END ScanList;
 1557  
 1558  
 1559    PROCEDURE Swap2Elmts(elmt1, elmt2 : ElmtPtr);
 1560      (* Former version swapped by exchanging list elements. It's
 1561         easier to swap by exchanging the pointers to the data
 1562         elements. (Makes the sort algorithm easier, too.) This
 1563         routine is a good place to start optimizing, or even put
 1564         it inline.
 1565      *)
 1566      VAR
 1567        AuxElmt : GenElmt;
 1568        AuxPtr1, AuxPtr2 : ElmtPtr;
 1569      BEGIN
 1570        IF elmt1=elmt2 THEN
 1571          RETURN;
 1572        END;
 1573        (* first swap everything, both ptrs and data *)
 1574        AuxElmt := elmt1^;
 1575        elmt1^ := elmt2^;
 1576        elmt2^ := AuxElmt;
 1577        (* then put ptrs back in their original place *)
 1578        WITH elmt1^ DO
 1579          AuxPtr1 := prv;
 1580          prv := elmt2^.prv;
 1581          AuxPtr2 := nxt;
 1582          nxt := elmt2^.nxt;
 1583        END;
 1584        WITH elmt2^ DO
 1585          prv := AuxPtr1;
 1586          nxt := AuxPtr2;
 1587        END;
 1588      END Swap2Elmts;
 1589  
 1590  
 1591    PROCEDURE ShellSortList(TheList: GenList; CompResult: Comparator) ;
 1592      (*
 1593        Tri de liste suivant le tri SHELL plus rapide que le
 1594        QuickSort dans le cas o— l'on a des listes presque tri‚es.
 1595      *)
 1596        VAR
 1597          Data1Adr, Data2Adr : SYSTEM.ADDRESS;
 1598          Ptr1, Ptr2 : ElmtPtr;
 1599          Elem1, Elem2 : CARDINAL;
 1600          NbElements, saut, borneSup : CARDINAL;
 1601  
 1602      BEGIN
 1603        NbElements := ListLength(TheList);
 1604        saut := NbElements;
 1605        LOOP
 1606          saut := saut DIV 2;
 1607          IF saut # 0 THEN
 1608            borneSup := NbElements - saut;
 1609            Elem1  := 1;
 1610            Ptr1 := TheList^.first;
 1611            Elem2 := saut + 1;
 1612            IF ListMove(TheList, Elem2) THEN END;
 1613            Ptr2 := TheList^.now;
 1614            WHILE Elem1 <= borneSup DO
 1615              Data1Adr := VStorage.LockMem( Ptr1^.handle );
 1616              VStorage.UnLockMem( Ptr1^.handle );
 1617              Data2Adr := VStorage.LockMem( Ptr2^.handle );
 1618              VStorage.UnLockMem( Ptr2^.handle );
 1619              IF CompResult(Data1Adr, Ptr1^.size, Data2Adr,
 1620                  Ptr2^.size) > 0 THEN
 1621                Swap2Elmts(Ptr1, Ptr2);
 1622                IF Elem1 > saut THEN
 1623                  Ptr2  := Ptr1;
 1624                  Elem2 := Elem1;
 1625                  DEC(Elem1, saut);
 1626                  IF ListMove(TheList, Elem1) THEN END;
 1627                  Ptr1 := TheList^.now;
 1628                ELSE
 1629                  INC(Elem1);
 1630                  Ptr1 := Ptr1^.nxt;
 1631                  INC(Elem2);
 1632                  Ptr2 := Ptr2^.nxt;
 1633                END;
 1634              ELSE
 1635                INC(Elem1);
 1636                Ptr1 := Ptr1^.nxt;
 1637                INC(Elem2);
 1638                Ptr2 := Ptr2^.nxt;
 1639              END (* if *);
 1640            END (* while *);
 1641          ELSE
 1642            EXIT;
 1643          END (* if *);
 1644        END (* loop *);
 1645      END ShellSortList;
 1646  
 1647  
 1648    PROCEDURE SortList(TheList : GenList; CompResult : Comparator);
 1649     (*28 July 87:  replaced old SortList, which used a bubble
 1650       sort, with Torbjorn Sund's version, which uses a quicksort.
 1651       Performance: With a list size of N, bubble sort runs as
 1652       b*N*N, QuickSort as q*N*log2(N). On a Kaypro AT at 8 MHz,
 1653       b = 0.5 msec, q = 3.5 msec.
 1654     *)
 1655  
 1656      PROCEDURE QSortList(lwr, upr : ElmtPtr);
 1657        VAR
 1658          Pivot, Curnt : SYSTEM.ADDRESS;
 1659          PivotSize, CurntSize : CARDINAL;
 1660          i, m : ElmtPtr;
 1661          LwrCount, UprCount : CARDINAL;
 1662        BEGIN
 1663          LOOP
 1664            (* there goes the tail recursion *)
 1665            IF lwr=upr THEN
 1666              EXIT;
 1667            END;
 1668            WITH lwr^ DO
 1669              (* could be any, preferrably a random element *)
 1670              Pivot := VStorage.LockMem(handle);
 1671                (* 6 Jan 88:  inserted this lock to correct
 1672                   oversight pointed out by Dr. Michael Anderson;
 1673                   SortList wasn't working when EMS was installed. *)
 1674              VStorage.UnLockMem(handle);
 1675                (* We go ahead and unlock here because we know we
 1676                   will be finished with this address before
 1677                   something else gets swapped into its place. *)
 1678              PivotSize := size;
 1679            END;
 1680            m := lwr;
 1681            i := lwr;
 1682            LwrCount := 0;
 1683            UprCount := 0;
 1684            WHILE i#upr DO
 1685              i := i^.nxt;
 1686                (* no need to worry about NIL here *)
 1687              WITH i^ DO
 1688                Curnt := VStorage.LockMem(handle);
 1689                  (* 6 Jan 88:  Lock/UnLock inserted.  See above. *)
 1690                VStorage.UnLockMem(handle);
 1691                CurntSize := size;
 1692              END;
 1693              IF CompResult(Pivot,PivotSize,Curnt,CurntSize)>0 THEN
 1694                INC(LwrCount);
 1695                m := m^.nxt;
 1696                Swap2Elmts(m, i);
 1697              ELSE
 1698                INC(UprCount);
 1699              END;
 1700            END;
 1701            Swap2Elmts(lwr, m);
 1702              (* sort shortest interval first; this minimizes recursion depth *)
 1703            IF LwrCount<UprCount THEN
 1704              (* the IF is strictly necessary only with "fat" partitioning *)
 1705              IF LwrCount>0 THEN
 1706                QSortList(lwr, m^.prv);
 1707              END;
 1708              (* Instead of QSortList( m^.nxt, upr); *)
 1709              lwr := m^.nxt;
 1710            ELSE
 1711              IF UprCount>0 THEN
 1712                QSortList(m^.nxt, upr);
 1713              END;
 1714              (* instead of QSortList( lwr, m^.prv); *)
 1715              upr := m^.prv;
 1716            END;
 1717          END;
 1718        END QSortList;
 1719  
 1720      BEGIN
 1721        WITH TheList^ DO
 1722          QSortList(first, last);
 1723        END;
 1724      END SortList;
 1725  
 1726  
 1727    PROCEDURE SplitList(InList : GenList; where : CARDINAL; VAR
 1728        OutList : GenList);
 1729      VAR
 1730        InLength : CARDINAL;
 1731      BEGIN
 1732        IF NOT Initialized(InList) THEN
 1733        (*diag*)
 1734          InitResponse('Split');
 1735        END;
 1736        NewList(OutList);
 1737        InLength := ListLength(InList);
 1738        IF (where>InLength) OR (InLength=0) OR (where=0) THEN
 1739          RETURN;
 1740        END;
 1741        IF ListMove(InList,where) THEN
 1742        END;
 1743        WITH InList^ DO
 1744          OutList^.first := now;
 1745          OutList^.current := 1;
 1746          OutList^.now := now;
 1747          OutList^.last := last;
 1748          OutList^.lngth := (lngth-where)+1;
 1749          OutList^.ParentList := ParentList;
 1750          now := now^.prv;
 1751          last := now;
 1752          lngth := where-1;
 1753          current := where-1;(* added -1 per ukah 9/15/91 *)
 1754          IF lngth=0 THEN
 1755            first := NIL;
 1756          ELSE  (* added else clause per ukah 9/15/91 *)
 1757  	  last^.nxt :=NIL;
 1758          END;
 1759  	OutList^.first^.prv:=NIL; (* ukah *)
 1760        END;
 1761      (*Note that we're leaving InList in charge of the
 1762        BlockList.  OutList may have a lot of FromBlock elements
 1763        but nothing in its BlockList.*)
 1764      END SplitList;
 1765  
 1766  
 1767  BEGIN
 1768    ModInitialized := FALSE;
 1769  END GenLists.

   38 errors