SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00016 POINTERS, LINKING, LISTS, TREES 1 05-28-9313:54ALL SWAG SUPPORT TEAM DLLIST1.PAS IMPORT 9 ╙═√d { > Does anybody have any good source/Units For Turboπ > Pascal 6.0/7.0 For doing Double Linked List Fileπ > structures?π}ππTypeππ DLinkPtr = ^DLinkRecord;ππ DLinkRecord = Recordπ Data : Integer;π Next : DLinkPtr;π Last : DLinkPtr;π end;ππVarπ Current,π First,π Final,π Prev : DLinkPtr;π X : Byte;ππProcedure AddNode;πbeginπ if First = Nil thenπ beginπ New(Current);π Current^.Next:=Nil;π Current^.Last:=Nil;π Current^.Data:=32;π First:=Current;π Final:=Current;π endπ elseπ beginπ Prev:=Current;π New(Current);π Current^.Next:=Nil;π Current^.Last:=Prev;π Current^.Data:=54;π Prev^.Next:=Current;π Final:=Current;π end;πend;ππbeginπ First:=Nil;π For X:=1 to 10 Do AddNode;π Writeln('First: ',first^.data);π Writeln('Final: ',final^.data);π Writeln('Others:');π Writeln(first^.next^.data);ππend.π 2 05-28-9313:54ALL SWAG SUPPORT TEAM LINKLIST.PAS IMPORT 63 ╙═╖─ {πThe following is the LinkList Unit written by Peter Davis in his wonderfulπbut, unFortunately, short-lived newsletter # PNL002.ZIP. I have used thisπUnit to Write tests of three or four of the Procedures but have stumped my toeπon his DELETE_HERE Procedure, the last one in the Unit. I will post my testsπin the next message For any who may wish to see it: Pete's Unit is unmodified.π I almost think there is some kind of error in DELETE_HERE but he was tooπthorough For that. Can you, or someone seeing this show me how to use thisπProcedure? It will help me both With Pointers and With Units.ππHere is the Unit:π}ππUnit LinkList;ππ{ This is the linked list Unit acCompanying The Pascal NewsLetter, Issue #2.π This Unit is copyrighted by Peter Davis.π It may be freely distributed in un-modified Form, or modified For use inπ your own Programs. Programs using any modified or unmodified Form of thisπ(107 min left), (H)elp, More? Unit must include a run-time and source visible recognition of the author,π Peter Davis.π}ππ{ The DataType used is Integer, but may be changed to whatever data Typeπ that you want.π}ππInterfaceπππTypeπ DataType = Integer; { Change this data-Type to whatever you want }ππ Data_Ptr = ^Data_Rec; { Pointer to our data Records }ππ Data_Rec = Record { Our Data Record Format }π OurData : DataType;π Next_Rec : Data_Ptr;π end;πππProcedure Init_List(Var Head : Data_Ptr);πProcedure Insert_begin(Var Head : Data_Ptr; Data_Value : DataType);πProcedure Insert_end(Var Head : Data_Ptr; Data_Value : DataType);πProcedure Insert_In_order(Var Head : Data_Ptr; Data_Value : DataType);πFunction Pop_First(Var Head : Data_Ptr) : DataType;πFunction Pop_Last(Var Head : Data_Ptr) : DataType;πProcedure Delete_Here(Var Head : Data_Ptr; Our_Rec : Data_Ptr);ππππImplementationππProcedure Init_List(Var Head : Data_Ptr);ππbeginπ Head := nil;πend;ππProcedure Insert_begin(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will insert a link and value into theπ beginning of a linked list. }ππVarπ Temp : Data_Ptr; { Temporary Pointer. }ππbeginπ new(Temp); { Allocate our space in memory. }π Temp^.Next_Rec := Head; { Point to existing list. }π Head:= Temp; { Move head to new data item. }π Head^.OurData := Data_Value; { Insert Data_Value. }πend;ππProcedure Insert_end(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will insert a link and value into theπ end of the linked list. }ππVarπ Temp1, { This is where we're going to put new data }π Temp2 : Data_Ptr; { This is to move through the list. }ππbeginπ new(Temp1);π Temp2 := Head;π if Head=nil thenπ beginπ Head := Temp1; { if list is empty, insert first }π Head^.OurData := Data_Value; { and only Record. Add value and }π Head^.Next_Rec := nil; { then put nil in Next_Rec Pointer }π endπ elseπ beginπ { Go to the end of the list. Since Head is a Variable parameter,π we can't move it through the list without losing Pointer to theπ beginning of the list. to fix this, we use a third Variable:π Temp2.π }π While Temp2^.Next_Rec <> nil do { Find the end of the list. }π Temp2 := Temp2^.Next_Rec;ππ Temp2^.Next_Rec := Temp1; { Insert as last Record. }π Temp1^.Next_Rec := nil; { Put in nil to signify end }π Temp1^.OurData := Data_Value; { and, insert the data }π end;πend;ππProcedure Insert_In_order(Var Head : Data_Ptr; Data_Value : DataType);ππ{ This Procedure will search through an ordered linked list, findπ out where the data belongs, and insert it into the list. }ππVarπ Current, { Where we are in the list }π Next : Data_Ptr; { This is what we insert our data into. }ππbeginπ New(Next);π Current := Head; { Start at the top of the list. }ππ if Head = Nil thenπ beginπ Head:= Next;π Head^.OurData := Data_Value;π Head^.Next_Rec := Nil;π endπ elseπ { Check to see if it comes beFore the first item in the list }π if Data_Value < Current^.OurData thenπ beginπ Next^.Next_Rec := Head; { Make the current first come after Next }π Head := Next; { This is our new head of the list }π Head^.OurData := Data_Value; { and insert our data value. }π endπ elseπ beginπ { Here we need to go through the list, but always looking one stepπ ahead of where we are, so we can maintain the links. The methodπ we'll use here is: looking at Current^.Next_Rec^.OurDataπ A way to explain that in english is "what is the data pointed toπ by Pointer Next_Rec, in the Record pointed to by Pointerπ current." You may need to run that through your head a few timesπ beFore it clicks, but hearing it in English might make it a bitπ easier For some people to understand. }ππ While (Data_Value >= Current^.Next_Rec^.OurData) andπ (Current^.Next_Rec <> nil) doπ Current := Current^.Next_Rec;π Next^.OurData := Data_Value;π Next^.Next_Rec := Current^.Next_Rec;π Current^.Next_Rec := Next;π end;πend;ππFunction Pop_First(Var Head : Data_Ptr) : DataType;ππ{ Pops the first item off the list and returns the value to the caller. }ππVarπ Old_Head : Data_Ptr;ππbeginπ if Head <> nil then { Is list empty? }π beginπ Old_Head := Head;π Pop_First := Head^.OurData; { Nope, so Return the value }π Head := Head^.Next_Rec; { and increment head. }π Dispose(Old_Head); { Get rid of the old head. }π endπ elseπ beginπ Writeln('Error: Tried to pop an empty stack!');π halt(1);π end;πend;πππFunction Pop_Last(Var Head : Data_Ptr) : DataType;ππ{ This Function pops the last item off the list and returns theπ value of DataType to the caller. }ππVarπ Temp : Data_Ptr;ππbeginπ Temp := Head; { Start at the beginning of the list. }π if head = nil then { Is the list empty? }π beginπ Writeln('Error: Tried to pop an empty stack!');π halt(1);π endπ elseπ if head^.Next_Rec = Nil then { if there is only one item in list, }π beginπ Pop_Last := Head^.OurData; { Return the value }π Dispose(Head); { Return the memory to the heap. }π Head := Nil; { and make list empty. }π endπ elseπ beginπ While Temp^.Next_Rec^.Next_Rec <> nil do { otherwise, find the end }π Temp := Temp^.Next_rec;π Pop_Last := Temp^.Next_Rec^.OurData; { Return the value }π Dispose(Temp^.Next_Rec); { Return the memory to heap }π Temp^.Next_Rec := nil; { and make new end of list. }π end;πend;πππProcedure Delete_Here(Var Head : Data_Ptr; Our_Rec : Data_Ptr);πππ{ Deletes the node Our_Rec from the list starting at Head. The Procedureπ does check For an empty list, but it assumes that Our_Rec IS in the list.π}ππVarπ Current : Data_Ptr; { Used to move through the list. }ππbeginπ Current := Head;π if Current = nil then { Is the list empty? }π beginπ Writeln('Error: Cant delete from an empty stack.');π halt(1);π endπ elseπ begin { Go through list Until we find the one to delete. }π While Current^.Next_Rec <> Our_Rec doπ Current := Current^.Next_Rec;π Current ^.Next_Rec := Our_Rec^.Next_Rec; { Point around old link. }π Dispose(Our_Rec); { Get rid of the link.. }π end;πend;πππend.π 3 05-28-9313:54ALL SWAG SUPPORT TEAM LL-INSRT.PAS IMPORT 13 ╙═#t { The following Program yields output that indicates that I have it set upπcorrectly but With my scanty understanding of exactly how to handle a linkedπlist I would be surprised if it is. This is one difficult area in which Swanπis not quite as expansive as he might be.ππ I will appreciate critique and commentary on this if you are anybodyπwould be so kind as to give it:π}ππProgram InsertLink;πUses Crt;ππTypeπ Str15 = String[15];π Aptr = ^Link;π Link = Recordπ Data : Str15;π Node : Aptr;π end;ππVarπ FirstItem, NewItem, OldItem : Aptr;ππProcedure CreateList;πbeginπ Writeln('Linked list BEForE insertion of node.');π Writeln;π New(FirstItem);π FirstItem^.Data := 'inSERT ';π Write(FirstItem^.Data);π Write(' ');π New(FirstItem^.Node);π FirstItem^.Node^.Data := 'HERE';π Writeln(FirstItem^.Node^.Data);π FirstItem^.Node^.Node := NIL;πend;ππProcedure InsertALink;πbeginπ Writeln; Writeln;π Writeln('Linked list AFTER insertion of node.');π Writeln;π Write(FirstItem^.Data);π New(NewItem);π NewItem^.Node := OldItem^.Node;π OldItem^.Node := NewItem;π FirstItem^.Node^.Data := 'inSERTEDLinK';π Write(FirstItem^.Node^.Data);π New(FirstItem^.Node^.Node);π FirstItem^.Node^.Node^.Data := ' HERE';π Writeln(FirstItem^.Node^.Node^.Data);π FirstItem^.Node^.Node^.Node := NIL;πend;ππProcedure DisposeList;πbeginπ Dispose(FirstItem^.Node^.Node);π FirstItem^.Node := NIL;πend;ππbeginπ ClrScr;π CreateList;π Writeln;π InsertALink;π DisposeList;πend.π 4 05-28-9313:54ALL SWAG SUPPORT TEAM LL_TEST.PAS IMPORT 20 ╙═±O {πThis is the test Program that I drew up to test the Procedures in PeteπDavis' LinkList.Pas posted in the previous message. It could be a little moreπdressed up but it does work and offers some insight, I think, into the use ofπPointers and linked lists: note that I ran a little manual test to locate aπdesignated Pointer in a given list. Here it is:π}ππUsesπ Crt, LinkList;ππVarπ AList1, AList2, AList3, AList4 : Data_Ptr;π ANum : DataType;π Count : Integer;ππbeginπ ClrScr;π Init_List(AList1);π Writeln('Results of inserting links at the beginning of a list: ');π For Count := 1 to 20 doπ beginπ ANum := Count;π Write(' ',ANum);π Insert_begin(AList1, ANum); {pay out first link (1) to last (20) like}π {a fishing line With #-cards. You end up}π end; {with 20 in your hand going up to 1}π Writeln;π Writeln('Watch - Last link inserted is the highest number.');π Writeln('You are paying out the list like reeling out a fishing line,');π Writeln('Foot 1, Foot 2, Foot 3, etc. - last one is Foot 20.');π Writeln('Now, mentally reel in the line to the fourth number.');π Writeln(' ',alist1^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);π Writeln;π Writeln('Now insert one additional number at beginning of list');π beginπ ANum := 21;π Insert_begin(AList1,ANum);π end;π Writeln(' ',AList1^.OurData);π Writeln;πππ Init_List(Alist2);π Writeln('Results of Inserting links in turn at the end of a list: ');π For Count := 1 to 20 doπ beginπ ANum := Count;π Write(' ',ANum);π Insert_end(Alist2,ANum);π end;π Writeln;π Writeln('note, just the reverse situation of the process above.');π Writeln('Reel in the line to the fourth number.');π Writeln(' ',Alist2^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);π {We inserted at the end so we are now going out toward the 20}ππππ Init_List(Alist3);π Writeln('Results of Inserting links in turn in orDER');π For Count := 1 to 20 doπ beginπ Anum := Count;π Write(' ',ANum);π Insert_In_order(Alist3,ANum);π end;π Writeln;π Writeln(' ',Alist3^.Next_Rec^.Next_Rec^.Next_Rec^.OurData);ππend.π{π In Case anybody missed Pete Davis' Linklist Unit in the previousπmessage but may have it in her/his library (PNL002.ZIP) what I was asking isπsome help With writing code to test the Procedure DELETE_HERE which is the lastπProcedure in the Unit.π} 5 05-28-9313:54ALL SWAG SUPPORT TEAM OOP-LLST.PAS IMPORT 90 ╙═û┴ Program Linked;ππTypeπ FileDescriptor =π Objectπ Fpt : File;π Name : String[80];π HeaderSize: Word;π RecordSize: Word;π RecordPtr : Pointer;π SoftPut : Boolean;π IsOpen : Boolean;π CurRec : LongInt;ππ Constructor Init(Nam : String; Hdr : Word; Size : Word; Buff : Pointer;πPut : Boolean);π Destructor Done; Virtual;π Procedure OpenFile; Virtual;π Procedure CloseFile; Virtual;π Procedure GetRecord(Rec : LongInt);π Procedure PutRecord(Rec : LongInt);π end;ππ FileLable =π Recordπ Eof : LongInt;π MRD : LongInt;π Act : LongInt;π Val : LongInt;π Sync: LongInt;π end;ππ LabeledFile =π Object(FileDescriptor)π Header : FileLable;ππ Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Destructor Done; Virtual;π Procedure OpenFile; Virtual;π Procedure CloseFile; Virtual;π Procedure WriteHeader;π Procedure ReadHeader;π Procedure AddRecord;π Procedure DelRecord(Rec : LongInt);π end;ππ DetailHeaderPtr = ^DetailHeader;π DetailHeader =π Recordπ Master : LongInt;π Prev : LongInt;π Next : LongInt;π end;ππ MasterHeaderPtr = ^MasterHeader;π MasterHeader =π Recordπ First : LongInt;π Last : LongInt;π end;ππ DetailFileDetailPtr = ^DetailFileDetail;π DetailFileDetail =π Object(LabeledFile)π Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Procedure LinkChain(MR, Last, Curr : LongInt);π Procedure DelinkChain(Rec : LongInt);π end;ππ DetailFileMaster =π Object(LabeledFile)π Constructor Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π Procedure LinkDetail(DF : DetailFileDetailPtr);π Procedure DelinkDetail(DF : DetailFileDetailPtr; DR : LongInt);π Procedure GetFirst(DF : DetailFileDetailPtr);π Procedure GetLast(DF : DetailFileDetailPtr);π Procedure GetNext(DF : DetailFileDetailPtr);π Procedure GetPrev(DF : DetailFileDetailPtr);π end;ππ{---------------------------------------------------------------------------}ππConstructor FileDescriptor.Init(Nam : String; Hdr : Word; Size : Word; Buff :π Pointer; Put : Boolean);π beginπ IsOpen := False;π Name := Nam;π HeaderSize := Hdr;π RecordSize := Size;π RecordPtr := Buff;π SoftPut := Put;π CurRec := -1;π end;ππDestructor FileDescriptor.Done;π beginπ if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π if IsOpen thenπ CloseFile;π end;ππProcedure FileDescriptor.OpenFile;π beginπ if IsOpen thenπ Exit;π Assign(Fpt,Name);π {$I-}π Reset(Fpt,1);π if IoResult <> 0 thenπ ReWrite(Fpt,1);π if IoResult = 0 thenπ IsOpen := True;π {$I+}π CurRec := -1;π end;ππProcedure FileDescriptor.CloseFile;π beginπ if not IsOpen thenπ Exit;π {$I-}π Close(Fpt);π if IoResult = 0 thenπ IsOpen := False;π {$I+}π CurRec := -1;π end;ππProcedure FileDescriptor.GetRecord(Rec : LongInt);π Varπ Result : Word;π beginπ if not IsOpen thenπ Exit;π if CurRec = Rec thenπ Exit;π if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π {$I-}π if Rec = 0 thenπ beginπ Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,RecordPtr^,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π endπ elseπ beginπ Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,RecordPtr^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π end;π end;π {$I+}π CurRec := Rec;π end;ππProcedure FileDescriptor.PutRecord(Rec : LongInt);π Varπ Result : Word;π beginπ if not IsOpen thenπ Exit;π {$I-}π if Rec = 0 thenπ beginπ Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,RecordPtr^,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π endπ elseπ beginπ Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,RecordPtr^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π end;π end;π CurRec := Rec;π {$I+}π end;ππ{---------------------------------------------------------------------------}ππConstructor LabeledFile.Init(Nam : String; Size : Word; Buff : Pointer; Put :πBoolean);π beginπ if Size < 4 thenπ beginπ WriteLN('Record size must be 4 or larger');π Fail;π end;π FileDescriptor.Init(Nam,Sizeof(Header),Size,Buff,Put);π Header.Eof := 0;π Header.MRD := 0;π Header.Act := 0;π Header.Val := 0;π Header.Sync:= 0;π end;ππDestructor LabeledFile.Done;π beginπ CloseFile;π FileDescriptor.Done;π end;ππProcedure LabeledFile.OpenFile;π beginπ FileDescriptor.OpenFile;π if IsOpen thenπ ReadHeader;π end;ππProcedure LabeledFile.CloseFile;π beginπ {$I-}π if IsOpen thenπ beginπ if SoftPut and (CurRec <> -1) thenπ PutRecord(CurRec);π Header.Val := 0;π WriteHeader;π CurRec := -1;π end;π FileDescriptor.CloseFile;π {$I+}π end;ππProcedure LabeledFile.ReadHeader;π Varπ Result : Word;π beginπ {$I-}π Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,Header,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π {$I+}π end;ππProcedure LabeledFile.WriteHeader;π Varπ Result : Word;π beginπ {$I-}π Seek(Fpt,0);π if IoResult = 0 thenπ beginπ BlockWrite(Fpt,Header,HeaderSize,Result);π if (Result <> HeaderSize) or (IoResult <> 0) thenπ {Error Routine};π end;π {$I+}π end;ππProcedure LabeledFile.AddRecord;π Varπ TmpRec : Pointer;π Result : Word;π Next : LongInt;π beginπ {$I-}π if Header.MRD <> 0 thenπ beginπ GetMem(TmpRec,RecordSize);π Seek(Fpt,HeaderSize + (Header.MRD - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,TmpRec^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π Next := LongInt(TmpRec^);π PutRecord(Header.MRD);π Header.MRD := Next;π Header.Act := Header.Act + 1;π end;π FreeMem(TmpRec,RecordSize);π endπ elseπ beginπ PutRecord(Header.Eof);π Header.Eof := Header.Eof + 1;π Header.Act := Header.Act + 1;π end;π WriteHeader;π {$I+}π end;ππProcedure LabeledFile.DelRecord(Rec : LongInt);π Varπ TmpRec : Pointer;π Result : Word;π beginπ {$I-}π GetMem(TmpRec,RecordSize);π Seek(Fpt,HeaderSize + (Rec - 1) * RecordSize);π if IoResult = 0 thenπ beginπ BlockRead(Fpt,TmpRec^,RecordSize,Result);π LongInt(TmpRec^) := Header.MRD;π BlockWrite(Fpt,TmpRec^,RecordSize,Result);π if (Result <> RecordSize) or (IoResult <> 0) thenπ {Error Routine};π Header.MRD := Rec;π Header.Act := Header.Act - 1;π WriteHeader;π end;π {$I+}π end;ππ{---------------------------------------------------------------------------}ππConstructor DetailFileDetail.Init(Nam : String; Size : Word; Buff : Pointer;πPut : Boolean);π beginπ if Size < 12 thenπ beginπ WriteLn('Detail File Records must be 12 Bytes or more');π Fail;π end;π LabeledFile.Init(Nam,Size,Buff,Put);π end;ππProcedure DetailFileDetail.LinkChain(MR, Last, Curr : LongInt);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := RecordPtr;π if Last <> 0 thenπ beginπ GetRecord(Last);π Hdr^.Next := Curr;π PutRecord(Last);π end;π GetRecord(Curr);π Hdr^.Prev := Last;π Hdr^.Master := MR;π Hdr^.Next := 0;π PutRecord(Curr);π end;ππProcedure DetailFileDetail.DelinkChain(Rec : LongInt); Varπ Hdr : DetailHeaderPtr;π Tmp : LongInt;π beginπ Hdr := RecordPtr;π GetRecord(Rec);π if Hdr^.Next <> 0 thenπ beginπ Tmp := Hdr^.Prev;π GetRecord(Hdr^.Next);π Hdr^.Prev := Tmp;π PutRecord(CurRec);π GetRecord(Rec);π end;π if Hdr^.Prev <> 0 thenπ beginπ Tmp := Hdr^.Next;π GetRecord(Hdr^.Prev);π Hdr^.Next := Tmp;π PutRecord(CurRec);π GetRecord(Rec);π end;π Hdr^.Master := 0;π Hdr^.Next := 0;π Hdr^.Prev := 0;π PutRecord(Rec);π end;ππ{---------------------------------------------------------------------------}ππConstructor DetailFileMaster.Init(Nam : String; Size : Word; Buff : Pointer;πPut : Boolean);π beginπ if Size < 8 thenπ beginπ WriteLn('Master File Records must be 8 Bytes or more');π Fail;π end;π LabeledFile.Init(Nam,Size,Buff,Put);π end;ππProcedure DetailFileMaster.LinkDetail(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π DF^.AddRecord;π DF^.LinkChain(CurRec,Hdr^.Last,DF^.CurRec);π Hdr^.Last := DF^.CurRec;π if Hdr^.First = 0 then Hdr^.First := DF^.CurRec;π PutRecord(CurRec);π end;ππProcedure DetailFileMaster.DelinkDetail(DF : DetailFileDetailPtr; DR :πLongInt);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π DF^.GetRecord(DR);π if Hdr^.Last = DR thenπ Hdr^.Last := DetailHeader(DF^.RecordPtr^).Prev;π if Hdr^.First = DR thenπ Hdr^.First := DetailHeader(DF^.RecordPtr^).Next;π DF^.DelinkChain(DR);π PutRecord(CurRec);π end;ππProcedure DetailFileMaster.GetFirst(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π if Hdr^.First = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.First);π end;ππProcedure DetailFileMaster.GetLast(DF : DetailFileDetailPtr);π Varπ Hdr : MasterHeaderPtr;π beginπ Hdr := RecordPtr;π if Hdr^.Last = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Last);π end;ππProcedure DetailFileMaster.GetNext(DF : DetailFileDetailPtr);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := DF^.RecordPtr;π if Hdr^.Next = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Next);π end;ππProcedure DetailFileMaster.GetPrev(DF : DetailFileDetailPtr);π Varπ Hdr : DetailHeaderPtr;π beginπ Hdr := DF^.RecordPtr;π if Hdr^.Prev = 0 thenπ beginπ FillChar(DF^.RecordPtr^,DF^.RecordSize,#0);π DF^.CurRec := -1;π Exit;π end;π DF^.GetRecord(Hdr^.Prev);π end;ππ{---------------------------------------------------------------------------}ππbeginπend.ππ 6 05-28-9313:54ALL SWAG SUPPORT TEAM PTR-MEM.PAS IMPORT 5 ╙═ñ5 Program Test_Pointers;ππTypeπ Array_Pointer = ^MyArray;π MyArray = Array[1..10] of String;ππVarπ MyVar : Array_Pointer;ππbeginπ Writeln('Memory beFore initializing Variable : ',MemAvail);ππ New(MyVar);ππ Writeln('Memory after initializiation : ',MemAvail);ππ MyVar^[1] := 'Hello';π MyVar^[2] := 'World!';ππ Writeln(MyVar^[1], ' ', MyVar^[2]);ππ Dispose(MyVar);ππ Writeln('Memory after Variable memory released : ',MemAvail);πend.π 7 05-28-9313:54ALL SWAG SUPPORT TEAM PTRARRAY.PAS IMPORT 13 ╙═x DS> Hi, I've recently encountered a problem With not having enough memoryπDS> to open a large sized Array [ie: 0..900]. Is there any way toπDS> allocate more memory to the Array as to make larger ArraysππArray of what? if the total size of the Array (i.e. 901 *πsizeof(whatever_it_is_you're_talking_about)) is less than 64K, it's a snap.πRead your dox on Pointers and the heap. You'll end up doing something likeπthis:ππTypeπ tWhatever : whatever_it_is_you're_talking_about;π tMyArray : Array[0..900] of tWhatever;π tPMyArray : ^MyArray;ππVarπ PMyArray : tPMyArray;ππbeginπ getmem(PMyArray,sizeof(tMyArray));ππ { now access your Array like this:π PMyArray^[IndexNo] }ππif your Array is >64K, you can do something like this:ππTypeπ tWhatever : whatever_it_is_you're_talking_about;π tPWhatever : ^tWhatever;ππVarπ MyArray : Array[0..900] of tPWhatever;π i : Word;ππbeginπ For i := 0 to 900 doπ getmem(MyArray[i],sizeof(tWhatever));ππ { now access your Array like this:π MyArray[IndexNo]^ }ππif you don't have enough room left in your data segment to use this latterπapproach (and I'll bet you do), you'll just need one more level of indirection.πDeclare one Pointer in the data segment that points to the Array of Pointers onπthe heap, which in turn point to your data.ππif you're a beginner, this may seem impossibly Complex (it did to me), but keepπat it and it will soon be second nature.π 8 05-28-9313:54ALL SWAG SUPPORT TEAM TREEHITE.PAS IMPORT 7 ╙═£ {πAuthors: Chet Kress and Jerome Tonnesonππ>Help !!! I need a Function or Procedure in standard pascal that willπ>calculate the height of a binary tree. It must be able to calculate theπ>height of the tree if the tree is either balanced, unbalanced or full.π>The Procedure must be recursive.ππHere are the only two Functions you will need.π}ππFunction Max(A, B : Integer) : Integer;πbegin {Max}π If A > B thenπ Max := A;π elseπ Max := B;πend; {Max}ππFunction Height (Tree : TreeType) : Integer;πbegin {Height}π If Tree = Nil thenπ Height := 0π elseπ Height := Max(Height(Tree^.Right), Height(Tree^.Left)) + 1;πend; {Height}π 9 06-22-9309:20ALL SWAG SUPPORT TEAM Generic Linked List IMPORT 34 ╙═]D UNIT LinkList;ππ{-------------------------------------------------π Generic linked list object -π-------------------------------------------------}ππ{***************************************************************}π INTERFACEπ{***************************************************************}ππTYPEππ { Generic Linked List Handler Definition }ππ NodeValuePtr = ^NodeValue;ππ NodeValue = OBJECTπ CONSTRUCTOR Init;π DESTRUCTOR Done; VIRTUAL;π END;ππ NodePtr = ^Node;π Node = RECORDπ Retrieve : NodeValuePtr;π Next : NodePtr;π END;πππ { Specific Linked List Handler Definition }ππ NodeListPtr = ^NodeList;ππ NodeList = OBJECTπ Items : NodePtr;π CONSTRUCTOR Init;π DESTRUCTOR Done; VIRTUAL;π PROCEDURE Add (A_Value : NodeValuePtr);ππ (* Iterator Functions *)ππ PROCEDURE StartIterator (VAR Ptr : NodePtr);π PROCEDURE NextValue (VAR Ptr : NodePtr);π FUNCTION AtEndOfList (Ptr : NodePtr) : Boolean;π END;ππ{***************************************************************}π IMPLEMENTATIONπ{***************************************************************}πππCONSTRUCTOR NodeValue.Init;πBEGINπEND;ππDESTRUCTOR NodeValue.Done;πBEGINπEND;ππCONSTRUCTOR NodeList.Init;πBEGINπ Items := NIL;πEND;ππDESTRUCTOR NodeList.Done;π VARπ Temp : NodePtr;πBEGINπ WHILE Items <> NIL DOπ BEGINπ Temp := Items;π IF Temp^.Retrieve <> NIL THENπ Dispose (Temp^.Retrieve, Done);π Items := Items^.Next;π Dispose (Temp);π END;πEND;ππPROCEDURE NodeList.Add (A_Value : NodeValuePtr);π VARπ Cell : NodePtr;π Temp : NodePtr;πBEGINπ (* Go TO the END OF the linked list. *)π Cell := Items;π IF Cell <> NIL THENπ WHILE Cell^.Next <> NIL DOπ Cell := Cell^.Next;ππ New (Temp);π Temp^.Retrieve := A_Value;π Temp^.Next := NIL;π IF Items = NILπ THENπ Items := Tempπ ELSEπ Cell^.Next := Temp;πEND;ππPROCEDURE NodeList.StartIterator (VAR Ptr : NodePtr);πBEGINπ Ptr := Items;πEND;ππPROCEDURE NodeList.NextValue (VAR Ptr : NodePtr);πBEGINπ IF Ptr <> NIL THENπ Ptr := Ptr^.Next;πEND;ππFUNCTION NodeList.AtEndOfList (Ptr : NodePtr) : Boolean;πBEGINπ AtEndOfList := (Ptr = NIL);πEND;ππEND.ππ{ DEMO PROGRAM }ππPROGRAM LL_Demo;ππUSES LinkList;ππ{ Turbo Pascal Linked List Object Example }ππTYPEππ DataValuePtr = ^DataValue;ππ DataValue = OBJECT (NodeValue)π Value : Real;π CONSTRUCTOR Init (A_Value : Real);π FUNCTION TheValue : Real;π END;ππ DataList = OBJECT (NodeList)π FUNCTION CurrentValue (Ptr : NodePtr) : Real;π PROCEDURE SetCurrentValue (Ptr : NodePtr; Value : Real);π END;ππVARπ Itr : NodePtr;π TestLink : DataList;ππ{------ Unique methods to create for your linked list type -----}ππCONSTRUCTOR DataValue.Init (A_Value : Real);πBEGINπ Value := A_Value;πEND;ππFUNCTION DataValue.TheValue : Real;πBEGINπ TheValue := Value;πEND;ππFUNCTION DataList.CurrentValue (Ptr : NodePtr) : Real;πBEGINπ CurrentValue := DataValuePtr (Ptr^.Retrieve)^.TheValue;πEND;ππPROCEDURE DataList.SetCurrentValue (Ptr : NodePtr; Value : Real);πBEGINπ DataValuePtr (Ptr^.Retrieve)^.Value := Value;πEND;πππBEGINπ TestLink.Init; {Create the list then add 5 values to it}ππ TestLink.Add (New (DataValuePtr, Init (1.0)));π TestLink.Add (New (DataValuePtr, Init (2.0)));π TestLink.Add (New (DataValuePtr, Init (3.0)));π TestLink.Add (New (DataValuePtr, Init (4.0)));π TestLink.Add (New (DataValuePtr, Init (5.0)));ππ TestLink.StartIterator (Itr); {Display the list on screen}π WHILE NOT TestLink.AtEndOfList (Itr) DO BEGINπ Write (TestLink.CurrentValue (Itr) : 5 : 1);π TestLink.NextValue (Itr);π END;π WriteLn;ππ TestLink.StartIterator (Itr); {Change some values in the list}π TestLink.SetCurrentValue (Itr, 0.0);π TestLink.NextValue (Itr);π TestLink.SetCurrentValue (Itr, -1.0);ππ TestLink.StartIterator (Itr); {Redisplay the list values}π WHILE NOT TestLink.AtEndOfList (Itr) DO BEGINπ Write (TestLink.CurrentValue (Itr) : 5 : 1);π TestLink.NextValue (Itr);π END;π WriteLn;π ReadLn;πEND.π 10 08-17-9308:39ALL SWAG SUPPORT TEAM Binary Tree - Linked ListIMPORT 73 ╙═╙¡ Unit BinTree;ππInterfaceππConst TOTAL_NODES = 100;ππType BTreeStr = String[40];π ShiftSet = (TiltL_Tilt, neutral, TiltR_Tilt);π BinData = Recordπ Key : BTreeStr;π End;π BinPtr = ^Bin_Tree_Rec;π Bin_Tree_Rec = Recordπ BTreeData : BinData;π Shift : ShiftSet;π TiltL, TiltR : BinPtr;π End;π BTreeRec = Array[1..TOTAL_NODES] of BinData;ππProcedure Ins_BinTreeπ (Var Rt : BinPtr;π Node : BinData);ππFunction Srch_BinTreeπ (Rt : BinPtr;π Node : BinData;π Index1 : Word) : Word;ππProcedure BSortArrayπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππProcedure Del_BinTreeπ (Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππImplementationππProcedure Move_TiltR(Var Rt : BinPtr);ππ Varπ Ptr1, Ptr2 : BinPtr;ππ Beginπ Ptr1 := Rt^.TiltR;π If Ptr1^.Shift = TiltR_Tilt Then Beginπ Rt^.TiltR := Ptr1^.TiltL;π Ptr1^.TiltL := Rt;π Rt^.Shift := neutral;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltL;π Ptr1^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Ptr1;π Rt^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Rt;π If Ptr2^.Shift = TiltL_Tiltπ Then Ptr1^.Shift := TiltR_Tiltπ Else Ptr1^.Shift := neutral;π If Ptr2^.Shift = TiltR_Tiltπ Then Rt^.Shift := TiltL_Tiltπ Else Rt^.Shift := neutral;π Rt := Ptr2π End;π Rt^.Shift := neutralπ End;ππProcedure Move_TiltL(Var Rt : BinPtr);ππ Varπ Ptr1, Ptr2 : BinPtr;ππ Beginπ Ptr1 := Rt^.TiltL;π If Ptr1^.Shift = TiltL_Tilt Then Beginπ Rt^.TiltL := Ptr1^.TiltR;π Ptr1^.TiltR := Rt;π Rt^.Shift := neutral;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltR;π Ptr1^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Ptr1;π Rt^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Rt;π If Ptr2^.Shift = TiltR_Tiltπ Then Ptr1^.Shift := TiltL_Tiltπ Else Ptr1^.Shift := neutral;π If Ptr2^.Shift = TiltL_Tiltπ Then Rt^.Shift := TiltR_Tiltπ Else Rt^.Shift := neutral;π Rt := Ptr2;π End;π Rt^.Shift := neutralπ End;ππProcedure Ins_Bin(Var Rt : BinPtr;π Node : BinData;π Var InsOK : Boolean);ππ Beginπ If Rt = NIL Then Beginπ New(Rt);π With Rt^ Do Beginπ BTreeData := Node;π TiltL := NIL;π TiltR := NIL;π Shift := neutralπ End;π InsOK := TRUEπ Endπ Else If Node.Key <= Rt^.BTreeData.Key Then Beginπ Ins_Bin(Rt^.TiltL, Node, InsOK);π If InsOK Thenπ Case Rt^.Shift Ofπ TiltL_Tilt : Beginπ Move_TiltL(Rt);π InsOK := FALSEπ End;π neutral : Rt^.Shift := TiltL_Tilt;π TiltR_Tilt : Beginπ Rt^.Shift := neutral;π InsOK := FALSEπ End;π End;π Endπ Else Beginπ Ins_Bin(Rt^.TiltR, Node, InsOK);π If InsOK Thenπ Case Rt^.Shift Ofπ TiltL_Tilt : Beginπ Rt^.Shift := neutral;π InsOK := FALSEπ End;π neutral : Rt^.Shift := TiltR_Tilt;π TiltR_Tilt : Beginπ Move_TiltR(Rt);π InsOK := FALSEπ End;π End;π End;π End;ππProcedure Ins_BinTree(Var Rt : BinPtr;π Node : BinData);ππ Var Ins_ok : Boolean;ππ Beginπ Ins_ok := FALSE;π Ins_Bin(Rt, Node, Ins_ok)π End;ππFunction Srch_BinTree(Rt : BinPtr;π Node : BinData;π Index1 : Word)π : Word;ππ Varπ Index : Word;ππ Beginπ Index := 0;π While (Rt <> NIL) AND (Index < Index1) Doπ If Node.Key > Rt^.BTreeData.Key Then Rt := Rt^.TiltRπ Else if Node.Key < Rt^.BTreeData.Key Then Rt := Rt^.TiltLπ Else Beginπ Inc(Index);π Rt := Rt^.TiltLπ End;π Srch_BinTree := Indexπ End;ππProcedure Tvrs_Treeπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππ Beginπ If Rt <> NIL Then Beginπ Tvrs_Tree(Rt^.TiltL, SortNode, Index);π Inc(Index);π If Index <= TOTAL_NODES Thenπ SortNode[Index].Key := Rt^.BTreeData.Key;π Tvrs_Tree(Rt^.TiltR, SortNode, Index);π End;π End;ππProcedure BSortArrayπ (Var Rt : BinPtr;π Var SortNode : BTreeRec;π Var Index : Word);ππ Beginπ Index := 0;π Tvrs_Tree(Rt, SortNode, Index);π End;ππProcedure Shift_TiltRπ (Var Rt : BinPtr;π Var DelFlag : Boolean);ππ Varπ Ptr1, Ptr2 : BinPtr;π balnc2, balnc3 : ShiftSet;ππ Beginπ Case Rt^.Shift Ofπ TiltL_Tilt : Rt^.Shift := neutral;π neutral : Beginπ Rt^.Shift := TiltR_Tilt;π DelFlag := FALSEπ End;π TiltR_Tilt : Beginπ Ptr1 := Rt^.TiltR;π balnc2 := Ptr1^.Shift;π If NOT (balnc2 = TiltL_Tilt) Then Beginπ Rt^.TiltR := Ptr1^.TiltL;π Ptr1^.TiltL := Rt;π If balnc2 = neutral Then Beginπ Rt^.Shift := TiltR_Tilt;π Ptr1^.Shift := TiltL_Tilt;π DelFlag := FALSEπ Endπ Else Beginπ Rt^.Shift := neutral;π Ptr1^.Shift := neutral;π End;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltL;π balnc3 := Ptr2^.Shift;π Ptr1^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Ptr1;π Rt^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Rt;π If balnc3 = TiltL_Tilt Thenπ Ptr1^.Shift := TiltR_Tiltπ Elseπ Ptr1^.Shift := neutral;π If balnc3 = TiltR_Tilt Thenπ Rt^.Shift := TiltL_Tiltπ Elseπ Rt^.Shift := neutral;π Rt := Ptr2;π Ptr2^.Shift := neutral;π End;π End;π End;π End;ππProcedure Shift_TiltLπ (Var Rt : BinPtr;π Var DelFlag : Boolean);ππ Varπ Ptr1, Ptr2 : BinPtr;π balnc2, balnc3 : ShiftSet;ππ Beginπ Case Rt^.Shift Ofπ TiltR_Tilt : Rt^.Shift := neutral;π neutral : Beginπ Rt^.Shift := TiltL_Tilt;π DelFlag := Falseπ End;π TiltL_Tilt : Beginπ Ptr1 := Rt^.TiltL;π balnc2 := Ptr1^.Shift;π If NOT (balnc2 = TiltR_Tilt) Then Beginπ Rt^.TiltL := Ptr1^.TiltR;π Ptr1^.TiltR := Rt;π If balnc2 = neutral Then Beginπ Rt^.Shift := TiltL_Tilt;π Ptr1^.Shift := TiltR_Tilt;π DelFlag := FALSEπ Endπ Else Beginπ Rt^.Shift := neutral;π Ptr1^.Shift := neutral;π End;π Rt := Ptr1π Endπ Else Beginπ Ptr2 := Ptr1^.TiltR;π balnc3 := Ptr2^.Shift;π Ptr1^.TiltR := Ptr2^.TiltL;π Ptr2^.TiltL := Ptr1;π Rt^.TiltL := Ptr2^.TiltR;π Ptr2^.TiltR := Rt;π If balnc3 = TiltR_Tilt Thenπ Ptr1^.Shift := TiltL_Tiltπ Elseπ Ptr1^.Shift := neutral;π If balnc3 = TiltL_Tilt Thenπ Rt^.Shift := TiltR_Tiltπ Elseπ Rt^.Shift := neutral;π Rt := Ptr2;π Ptr2^.Shift := neutral;π End;π End;π End;π End;ππProcedure Kill_Lo_Nodesπ (Var Rt,π Ptr : BinPtr;π Var DelFlag : Boolean);ππ Beginπ If Ptr^.TiltR = NIL Then Beginπ Rt^.BTreeData := Ptr^.BTreeData;π Ptr := Ptr^.TiltL;π DelFlag := TRUEπ Endπ Else Beginπ Kill_Lo_Nodes(Rt, Ptr^.TiltR, DelFlag);π If DelFlag Then Shift_TiltL(Ptr,DelFlag);π End;π End;ππProcedure Del_Bin(Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππ Varπ Ptr : BinPtr;ππ Beginπ If Rt = NIL Thenπ DelFlag := Falseπ Elseπ If Node.Key < Rt^.BTreeData.Key Then Beginπ Del_Bin(Rt^.TiltL, Node, DelFlag);π If DelFlag Then Shift_TiltR(Rt, DelFlag);π Endπ Else Beginπ If Node.Key > Rt^.BTreeData.Key Then Beginπ Del_Bin(Rt^.TiltR, Node, DelFlag);π If DelFlag Then Shift_TiltL(Rt, DelFlag);π Endπ Else Beginπ Ptr := Rt;π If Rt^.TiltR = NIL Then Beginπ Rt := Rt^.TiltL;π DelFlag := TRUE;π Dispose(Ptr);π Endπ Else If Rt^.TiltL = NIL Then Beginπ Rt := Rt^.TiltR;π DelFlag := TRUE;π Dispose(Ptr);π Endπ Else Beginπ Kill_Lo_Nodes(Rt, Rt^.TiltL, DelFlag);π If DelFlag Then Shift_TiltR(Rt, DelFlag);π Dispose(Rt^.TiltL);π End;π End;π End;π End;ππProcedure Del_BinTreeπ (Var Rt : BinPtr;π Node : BinData;π Var DelFlag : Boolean);ππ Beginπ DelFlag := FALSE;π Del_Bin(Rt, Node, DelFlag)π End;πEnd. 11 08-27-9320:11ALL SWAG SUPPORT TEAM AVL Binary Trees IMPORT 52 ╙═ . {π> Does anyone have code(preferably TP) the implements AVL trees?π> I'm having trouble With the insertion part of it. I'm writing a smallπ> parts inventory Program For work(although I'm not employed as aπ> Programmer) and the AVL tree would be very fast For it.π}πππProgram avl;ππTypeπ nodeptr = ^node;π node = Recordπ key : Char;π bal : -1..+1; { bal = h(right) - h(left) }π left,π right : nodeptrπ end;ππ tree = nodeptr;ππVarπ t : tree;π h : Boolean; { insert & delete parameter }πππProcedure maketree(Var t : tree);πbeginπ t := nil;πend;ππFunction member(k : Char; t : tree) : Boolean;πbegin { member }π if t = nil thenπ member := Falseπ elseπ if k = t^.key thenπ member := Trueπ elseπ if k < t^.key thenπ member := member(k, t^.left)π elseπ member := member(k, t^.right);πend;ππProcedure ll(Var t : tree);πVarπ p : tree;πbeginπ p := t^.left;π t^.left := p^.right;π p^.right := t;π t := p;πend;ππProcedure rr(Var t : tree);πVarπ p : tree;πbeginπ p := t^.right;π t^.right := p^.left;π p^.left := t;π t := p;πendππProcedure lr(Var t : tree);πbeginπ rr(t^.left);π ll(t);πend;ππProcedure rl(Var t : tree);πbeginπ ll(t^.right);π rr(t);πend;ππProcedure insert(k : Char; Var t : tree; Var h : Boolean);ππ Procedure balanceleft(Var t : tree; Var h : Boolean);π beginπ Writeln('balance left');π Case t^.bal ofπ +1 :π beginπ t^.bal := 0;π h := False;π end;π 0 : t^.bal := -1;π -1 :π begin { rebalance }π if t^.left^.bal = -1 thenπ begin { single ll rotation }π Writeln('single ll rotation');π ll(t);π t^.right^.bal := 0;π endπ else { t^.left^.bal = +1 }π begin { double lr rotation }π Writeln('double lr rotation');π lr(t);π if t^.bal = -1 thenπ t^.right^.bal := +1π elseπ t^.right^.bal := 0;π if t^.bal = +1 thenπ t^.left^.bal := -1π elseπ t^.left^.bal := 0;π end;π t^.bal := 0;π h := False;π end;π end;π end;ππ Procedure balanceright(Var t : tree; Var h : Boolean);π beginπ Writeln('balance right');π Case t^.bal ofπ -1 :π beginπ t^.bal := 0;π h := False;π end;π 0 : t^.bal := +1;π +1 :π begin { rebalance }π if t^.right^.bal = +1 thenπ begin { single rr rotation }π Writeln('single rr rotation');π rr(t);π t^.left^.bal := 0π endπ else { t^.right^.bal = -1 }π begin { double rl rotation }π Writeln('double rl rotation');π rl(t);π if t^.bal = -1 thenπ t^.right^.bal := +1π elseπ t^.right^.bal := 0;π if t^.bal = +1 thenπ t^.left^.bal := -1π elseπ t^.left^.bal := 0;π end;π t^.bal := 0;π h := False;π end;π end;π end;ππbegin { insert }π if t = nil thenπ beginπ new(t);π t^.key := k;π t^.bal := 0;π t^.left := nil;π t^.right := nil;π h := True;π endπ elseπ if k < t^.key thenπ beginπ insert(k, t^.left, h);π if h thenπ balanceleft(t, h);π endπ elseπ if k > t^.key thenπ beginπ insert(k, t^.right, h);π if h thenπ balanceright(t, h);π end;πend;ππProcedure delete(k : Char; Var t : tree; Var h : Boolean);ππ Procedure balanceleft(Var t : tree; Var h : Boolean);π beginπ Writeln('balance left');π Case t^.bal ofπ -1 :π beginπ t^.bal := 0;π h := True;π end;π 0 :π beginπ t^.bal := +1;π h := False;π end;π +1 :π begin { rebalance }π if t^.right^.bal >= 0 thenπ beginπ Writeln('single rr rotation'); { single rr rotation }π if t^.right^.bal = 0 thenπ beginπ rr(t);π t^.bal := -1;π h := False;π endπ elseπ beginπ rr(t);π t^.left^.bal := 0;π t^.bal := 0;π h := True;π end;π endπ else { t^.right^.bal = -1 }π beginπ Writeln('double rl rotation');π rl(t);π t^.left^.bal := 0;π t^.right^.bal := 0;π h := True;π end;π end;π end;π end;ππ Procedure balanceright(Var t : tree; Var h : Boolean);π beginπ Writeln('balance right');π Case t^.bal ofπ +1 :π beginπ t^.bal := 0;π h := True;π end;π 0 :π beginπ t^.bal := -1;π h := False;π end;π -1 :π begin { rebalance }π if t^.left^.bal <= 0 thenπ begin { single ll rotation }π Writeln('single ll rotation');π if t^.left^.bal = 0 thenπ beginπ ll(t);π t^.bal := +1;π h := False;π endπ elseπ beginπ ll(t);π t^.left^.bal := 0;π t^.bal := 0;π h := True;π end;π endπ else { t^.left^.bal = +1 }π begin { double lr rotation }π Writeln('double lr rotation');π lr(t);π t^.left^.bal := 0;π t^.right^.bal := 0;π h := True;π end;π end;π end;π end;ππ Function deletemin(Var t : tree; Var h : Boolean) : Char;π begin { deletemin }π if t^.left = nil thenπ beginπ deletemin := t^.key;π t := t^.right;π h := True;π endπ elseπ beginπ deletemin := deletemin(t^.left, h);π if h thenπ balanceleft(t, h);π end;π end;ππbegin { delete }π if t <> nil thenπ beginπ if k < t^.key thenπ beginπ delete(k, t^.left, h);π if h thenπ balanceleft(t, h);π endπ elseπ if k > t^.key thenπ beginπ delete(k, t^.right, h);π if h thenπ balanceright(t, h);π endπ elseπ if (t^.left = nil) and (t^.right = nil) thenπ beginπ t := nil;π h := True;π endπ elseπ if t^.left = nil thenπ beginπ t := t^.right;π h := True;π endπ elseπ if t^.right = nil thenπ beginπ t := t^.left;π h := True;π endπ elseπ beginπ t^.key := deletemin(t^.right, h);π if h thenπ balanceright(t, h);π end;π end;πend;ππbeginπend.π 12 09-26-9308:50ALL GARRY J. VASS Linked Lists in EMS IMPORT 111 ╙═Çù {π PROTOTYPE PROCEDURES FOR CREATING AND ACCESSING SORTEDπ LINKED LISTS IN EXPANDED MEMORYππ GARRY J. VASS [72307,3311]ππThe procedures and functions given below present a prototypeπmethod for creating and accesing linked lists in expanded memory.πAlthough pointer variables are used in a way that appears toπconform to the TPascal pointer syntax, there are several majorπdifferences:ππ - there are none of the standard NEW, GETMEM,π MARK, RELEASE, DISPOSE, FREEMEM, and MAXAVAILπ calls made. These are bound to the program'sπ physical location in memory, and have noπ effect in expanded memory. Attempting toπ use these here, or to implement standardπ linked procedures by altering the HeapPtrπ standard variable is dangerous and highlyπ discouraged.π - pointer variables are set and queried byπ a simulation of TPascal's internal proceduresπ that is specially customized to the EMSπ page frame segment.π - the MEMAVAIL function is useless here. Theseπ procedures will support a list of up to 64K.ππThe general pseudo-code for creating a linked list in expandedπmemory is:ππ 1. Get a handle and allocate memory from the EMM.π 2. Get the page frame segment for the handle toπ mark the physical beginning of the list inπ expanded memory.π 3. Initialize the root pointer to the page frameπ segment.π 4. For each new record (or list member):ππ a. Calculate a new physical location for theπ record using a simulated normalizationπ procedure.π b. Set the appropriate values to theπ pointers using a simulated pointerπ assignment procedure.π c. Assure that the last logical recordπ contains a pointer value of NIL.ππAccessing the list is basically the same as the standard algorithms.ππThe procedures here assume that each list record (or member) is composedπof three elements:ππ - a pointer to the next logical record. If the member is theπ last logical record, this pointer is NIL.π - an index, or logical sort key. This value determines theπ logical position of the record in the list. These routinesπ and the demo use an integer type for index. The index,π however, can be of any type where ordinal comparisonsπ can be made, including pointers.π - an area for the actual data in each record. These routinesπ and the demo use a string of length 255, but this area canπ be of any type, including pointers to other lists.ππPlease note that these routines are exploratory and prototype. In no wayπare they intended to be definitive, accurate, efficient, or exemplary.ππAreas for further analysis are:ππ 1. A reliable analog to the MEMAVAIL function.π 2. Creating linked lists that cross handle boundaries.π 3. Creating linked lists that begin in heapspace andπ extend to expanded memory.π 4. A reliable method for assigning the standardπ variable, HeapPtr, to the base page.ππPlease let me know of your progress in these areas, or improvementsπto the routines below via the BORLAND SIG [72307,3311] or my PASCAL/πPROLOG SIG at the POLICE STATION BBS (201-963-3115).ππ}πPROGRAM LINKED_LISTS;πUses dos,crt;πCONSTπ ALLOCATE_MEMORY = $43;π EMS_SERVICES = $67;π FOREVER:BOOLEAN = FALSE;π GET_PAGE_FRAME = $41;π LOGICAL_PAGES = 5;π MAP_MEMORY = $44;π RELEASE_HANDLE = $45;πTYPEπ ANYSTRING = STRING[255];π LISTPTR = ^LISTREC;π LISTREC = RECORDπ NEXT_POINTER : LISTPTR;π INDEX_PART : INTEGER;π DATA_PART : ANYSTRING;π END;πVARπ ANYINTEGER : INTEGER;π ANYSTR : ANYSTRING;π HANDLE : INTEGER; { HANDLE ASSIGNED BY EMM }π LIST : LISTREC;π NEWOFFSET : INTEGER; { PHYSICAL OFFSET OF RECORD }π NEWSEGMENT : INTEGER; { PHYSICAL SEGMENT OF RECORD }π REGS1 : Registers;π ROOT : LISTPTR; { POINTER TO LIST ROOT }π SEGMENT : INTEGER; { PAGE FRAME SEGMENT }ππ{--------------------- GENERAL SUPPORT ROUTINES ----------------------}πFUNCTION HEXBYTE(N:INTEGER):ANYSTRING;πCONST H:ANYSTRING='0123456789ABCDEF';πBEGINπ HEXBYTE:=H[((LO(N)DIV 16)MOD 16)+1]+H[(LO(N) MOD 16)+1];πEND;ππFUNCTION HEXWORD(N:INTEGER):ANYSTRING;πBEGINπ HEXWORD:= HEXBYTE(HI(N))+HEXBYTE(LO(N));πEND;ππFUNCTION CARDINAL(I:INTEGER):REAL;πBEGINπ CARDINAL:=256.0*HI(I)+LO(I);πEND;ππPROCEDURE PAUSE;πVAR CH:CHAR;πBEGINπ WRITELN;WRITELN('-- PAUSING FOR KEYBOARD INPUT...');π READ(CH);π WRITELN;πEND;ππPROCEDURE DIE(M:ANYSTRING);πBEGINπ WRITELN('ERROR IN: ',M);π WRITELN('HALTING HERE, SUGGEST REBOOT');π HALT;πEND;πFUNCTION EXIST(FILENAME:ANYSTRING):BOOLEAN;VAR FILVAR:FILE;BEGIN ASSIGN(FILVAR,FILENAME);{$I-}πRESET(FILVAR);{$I+}EXIST := (IORESULT = 0);END;π{--------------------- END OF GENERAL SUPPORT ROUTINES ----------------}ππ{---------------------- EMS SUPPORT ROUTINES -------------------------}ππFUNCTION EMS_INSTALLED:BOOLEAN; { RETURNS TRUE IF EMS IS INSTALLED }πBEGIN { ASSURED DEVICE NAME OF EMMXXXX0 }π EMS_INSTALLED := EXIST('EMMXXXX0');{ BY LOTUS/INTEL/MS STANDARDS }πEND;ππFUNCTION NEWHANDLE(NUMBER_OF_LOGICAL_PAGES_NEEDED:INTEGER):INTEGER;πBEGINπ REGS1.AH := ALLOCATE_MEMORY;π REGS1.BX := NUMBER_OF_LOGICAL_PAGES_NEEDED;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('ALLOCATE MEMORY');π NEWHANDLE := REGS1.DX;πEND;ππPROCEDURE KILL_HANDLE(HANDLE_TO_KILL:INTEGER); { RELEASES EMS HANDLE. }πBEGIN { THIS MUST BE DONE IF }π REPEAT { OTHER APPLICATIONS ARE }π WRITELN('RELEASING EMS HANDLE'); { TO USE THE EM ARES. DUE}π REGS1.AH := RELEASE_HANDLE; { TO CONCURRENT PROCESSES,}π REGS1.DX := HANDLE_TO_KILL; { SEVERAL TRIES MAY BE }π INTR(EMS_SERVICES, REGS1); { NECESSARY. }π UNTIL REGS1.AH = 0;π WRITELN('HANDLE RELEASED');πEND;ππFUNCTION PAGE_FRAME_SEGMENT:INTEGER; { RETURNS PFS }πBEGINπ REGS1.AH := GET_PAGE_FRAME;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('GETTING PFS');π PAGE_FRAME_SEGMENT := REGS1.BX;πEND;ππPROCEDURE MAP_MEM(HANDLE_TO_MAP:INTEGER); {MAPS HANDLE TO PHYSICAL}πCONST PHYSICAL_PAGE = 0; {PAGES.}πBEGINπ REGS1.AH := MAP_MEMORY;π REGS1.AL := PHYSICAL_PAGE;π REGS1.BX := PHYSICAL_PAGE;π REGS1.DX := HANDLE_TO_MAP;π INTR(EMS_SERVICES, REGS1);π IF REGS1.AH <> 0 THEN DIE('MAPPING MEMORY');πEND;ππPROCEDURE GET_EMS_MEMORY(NUMBER_OF_16K_LOGICAL_PAGES:INTEGER);πVAR TH:INTEGER; { REQUESTS EM FROM EMM IN 16K INCREMENTS }πBEGINπ HANDLE := NEWHANDLE(NUMBER_OF_16K_LOGICAL_PAGES);π SEGMENT := PAGE_FRAME_SEGMENT;π MAP_MEM(HANDLE);πEND;π{----------------- END OF EMS SUPPORT ROUTINES -----------------------}ππ{----------------- CUSTOMIZED LINKED LIST SUPPORT ---------------------}πFUNCTION ABSOLUTE_ADDRESS(S, O:INTEGER):REAL; { RETURNS THE REAL }πBEGIN { ABSOLUTE ADDRESS }π ABSOLUTE_ADDRESS := (CARDINAL(S) * $10) { FOR SEGMENT "S" }π + CARDINAL(O); { AND OFFSET "O". }πEND;ππPROCEDURE NORMALIZE(VAR S, O:INTEGER); { SIMULATION OF TURBO'S INTERNAL }πVAR { NORMALIZATION ROUTINES FOR }π NEW_SEGMENT: INTEGER; { POINTER VARIABLES. }π NEW_OFFSET : INTEGER; { NORMALIZES SEGMENT "S" AND }πBEGIN { OFFSET "O" INTO LEGITAMATE }π NEW_SEGMENT := S; { POINTER VALUES. }π NEW_OFFSET := O;π REPEATπ CASE NEW_OFFSET OFπ $00..$0E : NEW_OFFSET := SUCC(NEW_OFFSET);π $0F..$FF : BEGINπ NEW_OFFSET := 0;π NEW_SEGMENT := SUCC(NEW_SEGMENT);π END;π END;π UNTIL (ABSOLUTE_ADDRESS(NEW_SEGMENT, NEW_OFFSET) >π ABSOLUTE_ADDRESS(S, O) + SIZEOF(LIST));π S := NEW_SEGMENT;π O := NEW_OFFSET;πEND;ππFUNCTION VALUEOF(P:LISTPTR):ANYSTRING; { RETURNS A STRING IN }π { SEGMENT:OFFSET FORMAT }π { WHICH CONTAINS VALUE }πBEGIN { OF A POINTER VARIABLE }π VALUEOF := HEXBYTE(MEM[SEG(P):OFS(P) + 3]) +π HEXBYTE(MEM[SEG(P):OFS(P) + 2]) +':'+π HEXBYTE(MEM[SEG(P):OFS(P) + 1]) +π HEXBYTE(MEM[SEG(P):OFS(P) + 0]);πEND;ππPROCEDURE SNAP(P:LISTPTR); { FOR THE RECORD BEING }πBEGIN { POINTED TO BY "P", THIS }π WRITELN(VALUEOF(P):10, { PRINTS THE SEGMENT/OFFSET }π VALUEOF(P^.NEXT_POINTER):20, { LOCATION, THE SEGMENT/ }π P^.INDEX_PART:5, { OFFSET OF THE RECORD PONTER, }π ' ',P^.DATA_PART); { RECORD INDEX, AND DATA. }πEND;ππPROCEDURE PROCESS_LIST; { GET AND PRINT MEMBERS OF A LIST }πVAR M1:LISTPTR; { SORTED IN INDEX ORDER. }πBEGINπ PAUSE;π M1 := ROOT;π WRITELN;π WRITELN('---------------- LINKED LIST ---------------------------------');π WRITELN('MEMBER LOCATION MEMBER CONTENTS');π WRITELN('IN MEMORY POINTER INDEX DATA ');π WRITELN('--------------- -----------------------------------------');π WRITELN;π REPEATπ SNAP(M1);π M1 := M1^.NEXT_POINTER;π UNTIL M1 = NIL;π WRITELN('------------ END OF LIST----------');πEND;ππPROCEDURE LOAD_MEMBER_HIGH (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;π P:LISTPTR; { INSERTS A RECORD AT THE HIGH }πBEGIN { END OF THE LIST. }π M1 := ROOT;π REPEATπ IF M1^.NEXT_POINTER <> NIL THEN M1 := M1^.NEXT_POINTER;π UNTIL M1^.NEXT_POINTER = NIL;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π M1^.NEXT_POINTER := PTR(NEWSEGMENT, NEWOFFSET);π P := M1^.NEXT_POINTER;π P^.INDEX_PART := IND;π P^.DATA_PART := DAT;π P^.NEXT_POINTER := NIL;πEND;ππPROCEDURE LOAD_MEMBER_MIDDLE (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;π M2:LISTPTR;π P :LISTPTR;π T :LISTPTR;πBEGIN { INSERTS A MEMBER INTO THE MIDDLE }π M1 := ROOT; { OF A LIST. }π REPEATπ M2 := M1;π IF M1^.NEXT_POINTER <> NIL THEN M1 := M1^.NEXT_POINTER;π UNTIL (M1^.NEXT_POINTER = NIL) OR (M1^.INDEX_PART >= IND);π IF (M1^.NEXT_POINTER = NIL) ANDπ (M1^.INDEX_PART < IND) THENπ BEGINπ LOAD_MEMBER_HIGH (IND, DAT);π EXIT;π END;π T := M2^.NEXT_POINTER;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π M2^.NEXT_POINTER := PTR(NEWSEGMENT, NEWOFFSET);π P := M2^.NEXT_POINTER;π P^.INDEX_PART := IND;π P^.DATA_PART := DAT;π P^.NEXT_POINTER := T;πEND;ππPROCEDURE LOAD_MEMBER (IND:INTEGER; DAT:ANYSTRING);πVAR M1:LISTPTR;πBEGINπ WRITELN('ADDING: ',DAT,' WITH AGE OF ',IND);π WRITELN('TURBO`S HEAP POINTER: ',VALUEOF(HEAPPTR),π ', MEMAVAIL = ',MEMAVAIL * 16.0:8:0);π WRITELN;π PAUSE;π WRITELN('... SEARCHING FOR ADD POINT ...');π IF ROOT^.INDEX_PART <= IND THEN { ENTRY POINT ROUTINE FOR }π BEGIN { ADDING NEW LIST MEMBERS }π LOAD_MEMBER_MIDDLE(IND, DAT); { ACTS ONLY IF NEW MEMBER }π EXIT; { SHOULD REPLACE CURRENT }π END; { ROOT. }π M1 := ROOT;π NORMALIZE(NEWSEGMENT, NEWOFFSET);π ROOT := PTR(NEWSEGMENT, NEWOFFSET);π ROOT^.INDEX_PART := IND;π ROOT^.DATA_PART := DAT;π ROOT^.NEXT_POINTER := M1;πEND;ππPROCEDURE INITIALIZE_ROOT_ENTRY(IND:INTEGER; DAT:ANYSTRING);πBEGINπ ROOT := PTR(NEWSEGMENT, NEWOFFSET); { INITIALIZES A LIST AND }π ROOT^.INDEX_PART := IND; { ADDS FIRST MEMBER AS }π ROOT^.DATA_PART := DAT; { "ROOT". }π ROOT^.NEXT_POINTER := NIL;πEND;ππBEGINπ TEXTCOLOR(15);π IF NOT EMS_INSTALLED THEN DIE('LOCATING EMS DRIVER');π CLRSCR;π WRITELN('DEMO OF LINKED LIST IN EXPANDED MEMORY...');π WRITELN('SETTING UP EMS PARAMETERS...');π GET_EMS_MEMORY(LOGICAL_PAGES);π WRITELN;π WRITELN('ASSIGNED HANDLE: ',HANDLE);π NEWSEGMENT := SEGMENT;π NEWOFFSET := 0;π WRITELN('EMS PARAMETERS SET. BASE PAGE IS: ',HEXWORD(SEGMENT));π WRITELN;π WRITELN('TURBO`S HEAP POINTER IS ',VALUEOF(HEAPPTR));π WRITELN('READY TO ADD RECORDS...');π PAUSE;ππ{ Demo: Create a linked list of names and ages with age as the index/sortπ key. Use random numbers for the ages so as to get a different sequenceπ each time the demo is run.}ππ INITIALIZE_ROOT_ENTRY(RANDOM(10) + 20, 'Anne Baxter (original root)');π LOAD_MEMBER(RANDOM(10) + 20, 'Rosie Mallory ');π LOAD_MEMBER(RANDOM(10) + 20, 'Sue Perkins ');π LOAD_MEMBER(RANDOM(10) + 20, 'Betty Williams ');π LOAD_MEMBER(RANDOM(10) + 20, 'Marge Holly ');π LOAD_MEMBER(RANDOM(10) + 20, 'Lisa Taylor ');π LOAD_MEMBER(RANDOM(10) + 20, 'Carmen Abigail ');π LOAD_MEMBER(RANDOM(10) + 20, 'Rhonda Perlman ');π PROCESS_LIST;π KILL_HANDLE(HANDLE);πEND.π 13 01-27-9412:12ALL WARREN PORTER Linked List Queues IMPORT 32 ╙═m' {π│ I'm trying to understand the rudiments of linked listsππ│ 4) What are common uses for linked lists? Is any one particular formπ│ (oneway, circular etc ) preferred or used over any other form?ππOne use is to maintain queues. New people, requests, or jobs come in atπthe end of the line (or break in with priority), but once the head ofπthe line has been serviced, there is no need to maintain its location inπthe queue. I wrote the following last semester:π---------------------------------------------------------------πPurpose:π Maintains a queue of jobs and priorities of those jobs in a linked list.π The user will be prompted for job number and priority and can list theπ queue, remove a job from the front of the queue (as if it ran), and stopπ the program. A count of jobs outstanding at the end will be displayed. }ππtypeπ PriRange = 0 .. 9;π JobPnt = ^JobNode;π Jobnode = RECORDπ Numb : integer;π Priority : PriRange;π Link : JobPntπ END;ππprocedure addrec(var Start : JobPnt; comprec : Jobnode);πvarπ curr,π next,π this : JobPnt;π found : boolean;πbeginπ new(this);π this^.Numb := comprec.Numb;π this^.Priority := comprec.Priority;π if Start = NIL thenπ beginπ Start := this; {Points to node just built}π Start^.Link := NIL; {Is end of list}π endπ else {Chain exists, find a place to insert it}π if comprec.Priority > Start^.Priority thenπ beginπ this^.Link := Start; {Prep for a new beg of chain}π Start := thisπ end {Condition for insert at beg of chain}π elseπ begin {Begin loop to insert after beg of chain}π found := false; {To initialize}π curr := start;π while not found doπ beginπ next := curr^.link;π if (next = NIL) or (comprec.Priority > next^.Priority) thenπ found := true;π if not found thenπ curr:= next {another iteration needed}π end;π {Have found this^ goes after curr^ and before next^}π this^.Link := next; {Chain to end (even if NIL)}π curr^.Link := this; {Insertion complete}π end;πend;ππprocedure remove(Var Start : JobPnt);πvarπ hold : JobPnt;πbeginπ if Start = NIL thenπ Writeln('Cannot remove from empty queue', chr(7))π elseπ beginπ hold := Start^.Link; {Save 1st node of new chain}π dispose(Start); {Delete org from chain}π Start := hold; {Reset to new next job}π end;πend;ππprocedure list(Start : JobPnt); {List all jobs in queue. "var" omitted}πbeginπ if Start = NIL thenπ Writeln('No jobs in queue')π elseπ beginπ Writeln('Job No Priority');π Writeln;π while Start <> NIL doπ beginπ Writeln(' ',Start^.Numb : 3, ' ', Start^.Priority);π Start:=Start^.Linkπ end;π Writeln;π Writeln('End of List');π end;πend;ππ{Main Procedure starts here}πvarπ cntr : integer;π build : JobNode;π work,π Start : JobPnt;π Achar : char;ππbeginπ Start := NIL; {Empty at first}π cntr := 0;π REPEATπ Write('Enter (S)top, (R)emove, (L)ist, or A jobnumb priority to');π Writeln(' add to queue');π Read(Achar);ππ CASE Achar ofπ 'A', 'a' :π beginπ Read(build.Numb);π REPEATπ Readln(build.Priority);π if (build.Priority < 0) or (build.priority > 9) thenπ Write(chr(7), 'Priority between 0 and 9, try again ');π UNTIL (build.Priority >= 0) and (build.Priority <= 9);π addrec(Start, build);π end;ππ 'R', 'r' :π beginπ Readln;π remove(Start);π end;ππ 'L', 'l' :π beginπ Readln;π list(Start);π end;ππ 'S', 's' : Readln; {Will wait until out of CASE loop}ππ elseπ beginπ Readln;π Writeln('Invalid option',chr(7))π end;π end;ππ UNTIL (Achar = 's') or (Achar = 'S');π work := start;π while work <> NIL doπ beginπ cntr := cntr + 1;π work := work^.linkπ end;π Writeln('Number of jobs remaining in queue: ', cntr);πend.π 14 02-03-9416:08ALL KEN BURROWS Linked List of Text IMPORT 24 ╙═══ {πFrom: KEN BURROWSπSubj: Linked List Problemπ---------------------------------------------------------------------------πHere is a short Linked List example. It loads a file, and lets you traverse theπlist in two directions. It's as simple as it gets. You may also want to lookπinto the TCollection objects associated with the Objects unit of Borlandsπversion 6 and 7.π}ππ{$A+,B-,D+,E-,F+,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}π{$M 16384,0,655360}πProgram LinkedListOfText; {tested}πUses Dos,CRT;πTypeπ TextListPtr = ^TextList;π TextList = Recordπ line : string;π next,π prev : TextListPtr;π end;πConstπ first : TextListPtr = nil;π last : TextListPtr = nil;ππProcedure FreeTheList(p:TextListPtr);π var hold:TextListPtr;π beginπ while p <> Nil doπ beginπ hold := p;π p := p^.next;π dispose(hold);π end;π end;ππProcedure ViewForward(p:TextListPtr);π beginπ clrscr;π while p <> nil doπ beginπ writeln(p^.line);π p := p^.next;π end;π end;ππProcedure ViewReverse(p:TextListPtr);π beginπ clrscr;π while p <> nil doπ beginπ writeln(p^.line);π p := p^.prev;π end;π end;ππProcedure Doit(fname:string);π var f :Text;π s :string;π curr,π hold : TextListPtr;π stop : boolean;π beginπ assign(f,fname);π reset(f);π if ioresult <> 0 then exit;π curr := nil;π hold := nil;ππ while (not eof(f)) andπ (maxavail > SizeOf(TextList)) doπ begin {load the list forward and link the prev fields}π readln(f,s);π new(curr);π curr^.prev := hold;π curr^.next := nil;π curr^.line := s;π hold := curr;π end;π close(f);ππ while curr^.prev <> nil do {traverse the list backwards}π begin {and link the next fields}π hold := curr;π curr := curr^.prev;π curr^.next := hold;π end;ππ first := curr; {set the first and last records}π while curr^.next <> Nil do curr := curr^.next;π last := curr;ππ Repeat {test it}π clrscr;π writeln(' [F]orward view : ');π writeln(' [R]everse view : ');π writeln(' [S]top : ');π write('enter a command : ');π readln(s);π stop := (s = '') or (upcase(s[1]) = 'S');π if not stopπ then case upcase(s[1]) ofπ 'F' : ViewForward(first);π 'R' : ViewReverse(last);π end;π Until Stop;ππ FreeTheList(First);π end;ππvar m:longint;πBeginπ m := memavail;π if paramcount > 0π then doit(paramstr(1))π else writeln('you need to supply a filename');π if m <> memavailπ then writeln('memory error of ',m-memavail,' bytes');πEnd.π 15 05-25-9408:21ALL ALEXANDER STAUBO Buffer Streams SWAG9405 45 ╙═°≡ π{πJB> AS>Use buffered streams. That way you can access fairly many records onπJB> AS>disk without noticable speed degradation.πJB> ^^^^^^^^^^^^^^^^^^^^^^^^^^^πJB> Do you mean from RAM?? Whoah! How do you go about using bufferedπJB> streams?ππActually, you should write a local "cache" for your records. Ie.,πyour implement an array of records, say 1..50, or, 1..MaxCacheSize,πwhere MaxCacheSize is a defined constant. Then you have a couple ofπgeneralized procedures for putting/getting records; now, the point is,πwhenever the program asks for a record -that is in the cache-, thatπrecord is read directly from RAM. If the record is -not- in theπcache, the record is read, and, if there is space in the cache, theπrecord is inserted into the cache.ππLet's try a Pascal implementation.π}ππ constπ MaxCacheSize = 50; (* cache can hold 50 records *)ππ typeπ (* this is the cache item *)π PCacheItem = ^TCacheItem;π TCacheItem =π recordπ Offset : Longint; (* file offset of cache record *)π Rec : TRecord; (* use your own record type here *)π end;ππ varπ Cache : array[1..MaxCacheSize] of PCacheItem;π CacheSize : Word;ππ procedure InitCache;π {-Resets cache}π beginπ CacheSize:=0;π end;ππ function FindCache (Offset : Longint) : PCacheItem;π {-Returns cache item for Offset if found, otherwise nil}π varπ W : Word;π beginπ for W:=1 to CacheSize doπ if Cache[W]^.Offset = Offset thenπ beginπ FindCache:=Cache[W];π Exit;π end;π FindCache:=nil;π end;ππ varπ F : file of TRecord; (* file in question *)ππ procedure PutRecord (Offset : Longint; var Rec : TRecord);π {-Put record into cache and file}π varπ P : PCacheItem;π beginπ Write(F, Rec);ππ (* if exists in RAM (cache), update it *)π P:=FindCache(Offset);π if P <> nil thenπ P^.Rec:=Recπ elseπ beginπ (* put into cache *)π Inc(CacheSize);π New(Cache[CacheSize]);π Cache[CacheSize]^.Offset:=Offset;π Cache[CacheSize]^.Rec:=Rec;π end;π end;ππ procedure GetRecord (Offset : Longint; var Rec : TRecord);π {-Get record from cached file}π varπ P : PCacheItem;π beginπ (* if exists in RAM (cache), get it *)π P:=FindCache(Offset);π if P <> nil thenπ Rec:=P^.Recπ else if CacheSize < MaxCacheSize thenπ beginπ (* read record from file *)π Read(F, Rec);ππ (* put into cache *)π Inc(CacheSize);π New(Cache[CacheSize]);π Cache[CacheSize]^.Offset:=Offset;π Cache[CacheSize]^.Rec:=Rec;π end;π end;ππTo use the routines:ππ Assign(F, 'MYFILE.DAT');π Reset(F);π GetRecord(FilePos(F), MyRec);π GetRecord(FilePos(F), MyRec);π GetRecord(FilePos(F), MyRec);π PutRecord(FilePos(F), MyRec);π Close(F);ππOr something like that, anyway.ππNow, there is a simpler way; "simpler" in this case means "some guyπhas already spent hours writing it just for you". The concept isπcalled streams. Now, I don't know how "novice" a programmer you are,πbut knowledge of streams requires knowledge of OOP. I suggest youπread about OOP right away.ππStreams work in a very simple way. You have a basic, "abstract"πobject, which provides some simple I/O tools. A stream is a type ofπ(abstract) file, an input/output mechanism, that you may manipulate;πmost often it's on a hierarchical level, ie., the high-levelπprocedures call low-level procedures, just like DOS. Think of streamsπas the Pascal type "file", except now the stream is a shell forπanything.ππThe shell implements a -standard- interface for any kind ofπinformation area. You have file streams, buffered streams (streamsπthat caches areas of the file in memory to optimize accessπefficiency), EMS streams (yes, you can have a "virtual file" that liesπin EMS memory and may be used just like a file), and so on. Theπstandardization implies that you may write more flexible programs.ππA tiny example:ππ varπ S : TBufStream;π T : TRecord;π Str : string;π beginπ S.Init('MYFILE.DAT', stOpen, 2048);π (* | | |π file name file mode buffer sizeπ *)π S.Read(T, SizeOf(T));π S.Write(T, SizeOf(T));π Str:=S.ReadStr^;ππ S.Done;π end;ππThe corresponding boring-old-Dos example'd be:ππ varπ F : file;π T : TRecord;π Str : string;π beginπ (* note: no buffering -> slower! *)π Assign(F, 'MYFILE.DAT');π Reset(F, 1);ππ BlockRead(F, T, SizeOf(T));π BlockWrite(F, T, SizeOf(T));π Read(F, Str[0]);π BlockRead(F, Str[1], Ord(Str[0]));ππ Close(F);π end;ππIn the end, streams -are- simpler, too. And they are extremely fast;πa friend of mine is writing a mail reader and is using object streamsπfor the message/conference/etc. databases. Now, personally I useπindexed, light-speed B-tree databases. And his work -just fine-.π 16 05-26-9411:06ALL BILL ZECH Linked List Routine IMPORT 65 ╙═≤ π{ Links Unit - Turbo Pascal 5.5π Patterned after the list processing facility in Simula class SIMSET.π Simula fans will note the same naming conventions as Simula-67.ππ Written by Bill Zech @CIS:[73547,1034]), May 16, 1989.ππ The Links unit defines objects and methods useful for implementingπ list (set) membership in your own objects.ππ Any object which inherits object <Link> will acquire the attributesπ needed to maintain that object in a doubly-linked list. Because theπ Linkage object only has one set of forward and backward pointers, aπ given object may belong to only one list at any given moment. Thisπ is sufficient for many purposes. For example, a task control blockπ might belong in either a ready list, a suspended list, or a swappedπ list, but all are mutually exclusive.ππ A list is defined as a head node and zero or more objects linkedπ to the head node. A head node with no other members is an emptyπ list. Procedures and functions are provided to add members to theπ end of the list, insert new members in position relative to anπ existing member, determine the first member, last member, sizeπ (cardinality) of the list, and to remove members from the list.ππ Because your object inherits all these attributes, your programπ need not concern itself with allocating or maintaining pointersπ or other stuff. All the actual linkage mechanisms will beπ transparent to your object.ππ *Note*π The following discussion assumes you have defined your objectsπ as static variables instead of pointers to objects. For mostπ programs, dynamic objects manipulated with pointers will beπ more useful. Some methods require pointers as arguments.π Example program TLIST.PAS uses pointer type variables.ππ Define your object as required, inheriting object Link:ππ typeπ myObjType = object(Link)π xxx.....xxxxπ end;ππ To establish a new list, declare a variable for the head nodeπ as a type Head:ππ varπ Queue1 :Head;π Queue2 :Head;ππ Define your object variables:ππ varπ X : myObjType;π Y : myObjType;π Z : myObjType;π P :^myObjType;ππ Make sure the objects have been Init'ed as required for dataπ initialization, VMT setup, etc.ππ Queue1.Init;π Queue2.Init;π X.Init;π Y.Init;π Z.Init;ππ You can add your objects to a list with <Into>:π (Note the use of the @ operator to make QueueX a pointer to theπ object.)ππ beginπ X.Into(@Queue1);π Y.Into(@Queue2);ππ You can insert at a specific place with <Precede> or <Follow>:ππ Z.Precede(@Y);π Z.Follow(@Y);ππ Remove an object with <Out>:ππ Y.Out;ππ Then add it to another list:ππ Y.Into(@Queue1);ππ Note that <Into>, <Precede> and <Follow> all have a built-inπ call to Out, so to move an object from one list to another canπ be had with a single operation:ππ Z.Into(@Queue1);ππ You can determine the first and last elements with <First> and <Last>:π (Note the functions return pointers to objects.)ππ P := Queue1.First;π P := Queue1.Last;ππ The succcessor or predecessor of a given member can be found withπ fucntions <Suc> and <Pred>:ππ P := X.Pred;π P := Y.Suc;π P := P^.Suc;ππ The number of elements in a list is found with <Cardinal>:ππ N := Queue1.Cardinal;ππ <Empty> returns TRUE is the list has no members:ππ if Queue1.Empty then ...ππ You can remove all members from a list with <Clear>:ππ Queue1.Clear;ππ GENERAL NOTES:ππ The TP 5.5 type compatibility rules allow a pointer to aπ descendant be assigned to an ancestor pointer, but not vice-versa.π So although it is perfectly legal to assign a pointer toπ type myObjType to a pointer to type Linkage, it won't letπ us do it the opposite.ππ We would like to be able to assign returned values fromπ Suc, Pred, First, and Last to pointers of type myObjType,π and the least fussy way is to define these pointer typesπ internal to this unit as untyped pointers. This works fineπ because all we are really doing is passing around pointersπ to Self, anyway. The only down-side to this I have noticedπ is you can't do: P^.Suc^.Pred because the returned pointerπ type cannot be dereferenced without a type cast.π}ππunit Links;ππinterfaceππtypeππ pLinkage = ^Linkage;π pLink = ^Link;π pHead = ^Head;ππ Linkage = objectπ prede :pLinkage;π succ :pLinkage;π function Suc :pointer;π function Pred :pointer;π constructor Init;π end;ππ Link = object(Linkage)π procedure Out;π procedure Into(s :pHead);π procedure Follow (x :pLinkage);π procedure Precede(x :pLinkage);π end;ππ Head = object(Linkage)π function First :pointer;π function Last :pointer;π function Empty :boolean;π function Cardinal :integer;π procedure Clear;π constructor Init;π end;ππππimplementationππconstructor Linkage.Init;πbeginπ succ := NIL;π prede := NIL;πend;ππfunction Linkage.Suc :pointer;πbeginπ if TypeOf(succ^) = TypeOf(Head) thenπ Suc := NILπ else Suc := succ;πend;ππfunction Linkage.Pred :pointer;πbeginπ if TypeOf(prede^) = TypeOf(Head) thenπ Pred := NILπ else Pred := prede;πend;ππprocedure Link.Out;πbeginπ if succ <> NIL thenπ beginπ succ^.prede := prede;π prede^.succ := succ;π succ := NIL;π prede := NIL;π end;πend;ππprocedure Link.Follow(x :pLinkage);πbeginπ Out;π if x <> NIL thenπ beginπ if x^.succ <> NIL thenπ beginπ prede := x;π succ := x^.succ;π x^.succ := @Self;π succ^.prede := @Self;π end;π end;πend;πππprocedure Link.Precede(x :pLinkage);πbeginπ Out;π if x <> NIL thenπ beginπ if x^.succ <> NIL thenπ beginπ succ := x;π prede := x^.prede;π x^.prede := @Self;π prede^.succ := @Self;π end;π end;πend;ππprocedure Link.Into(s :pHead);πbeginπ Out;π if s <> NIL thenπ beginπ succ := s;π prede := s^.prede;π s^.prede := @Self;π prede^.succ := @Self;π end;πend;πππfunction Head.First :pointer;πbeginπ First := suc;πend;ππfunction Head.Last :pointer;πbeginπ Last := Pred;πend;ππfunction Head.Empty :boolean;πbeginπ Empty := succ = prede;πend;ππfunction Head.Cardinal :integer;πvarπ i :integer;π p :pLinkage;πbeginπ i := 0;π p := succ;π while p <> @Self doπ beginπ i := i + 1;π p := p^.succ;π end;π Cardinal := i;πend;ππprocedure Head.Clear;πvarπ x : pLink;πbeginπ x := First;π while x <> NIL doπ beginπ x^.Out;π x := First;π end;πend;ππconstructor Head.Init;πbeginπ succ := @Self;π prede := @Self;πend;ππend.ππ{------------------------ DEMO PROGRAM --------------------- }ππprogram tlist;ππuses Links;ππtypeπ NameType = string[10];π person = object(link)π name :NameType;π constructor init(nameArg :NameType);π end;π Pperson = ^person;ππconstructor person.init(nameArg :NameType);πbeginπ name := nameArg;π link.init;πend;ππvarπ queue : Phead;π man : Pperson;π man2 : Pperson;π n : integer;π tf : boolean;ππbeginπ new(queue,Init);π tf := queue^.Empty;π new(man,Init('Bill'));π man^.Into(queue);π new(man,Init('Tom'));π man^.Into(queue);π new(man,Init('Jerry'));π man^.Into(queue);ππ man := queue^.First;π writeln('First man in queue is ',man^.name);π man := queue^.Last;π writeln('Last man in queue is ',man^.name);ππ n := queue^.Cardinal;π writeln('Length of queue is ',n);π if not queue^.Empty then writeln('EMPTY reports queue NOT empty');ππ new(man2,Init('Hugo'));π man2^.Precede(man);ππ new(man2,Init('Alfonso'));π man2^.Follow(man);π { should now be: Bill Tom Hugo Jerry Alfonso }π writeln('After PRECEDE and FOLLOW calls, list should be:');π writeln(' {Bill, Tom, Hugo, Jerry, Alfonso}');π writeln('Actual list is:');ππ man := queue^.First;π while man <> NIL doπ beginπ write(man^.name,' ');π man := man^.Suc;π end;π writeln;ππ man := queue^.Last;π writeln('The same list backwards is:');π while man <> NIL doπ beginπ write(man^.name,' ');π man := man^.Pred;π end;π writeln;ππ n := queue^.Cardinal;π writeln('Queue size should be 5 now, is: ', n);ππ queue^.Clear;π writeln('After clear operation,');π n := queue^.Cardinal;π writeln(' Queue size is ',n);π tf := queue^.Empty;π if tf then writeln(' and EMTPY reports queue is empty.');π writeln;π writeln('Done with test.');πend.ππ
