home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PASTUT34 / POINTERS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-14  |  7KB  |  164 lines
  1. program Job_Pointers;
  2.  
  3. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  4. { This program illustrates the use of Pointers and Records.               }
  5. { It also illustrates Variable Typecasts, so that the value of a pointer  }
  6. { variable can be evaluated and hence the segment and offset of the       }
  7. { variable pointed to can be found. The functions 'seg' and 'ofs' are     }
  8. { also used for this purpose. Then by changing to the OS shell, the user  }
  9. { can enter DEBUG and display (d Seg:Ofs) to check the location of the    }
  10. { records in memory. Note the apparent multiple storage with a 16-bit     }
  11. { machine with 1 Mbyte of memory and explain this paradox.                }
  12. { It is based on a program in the Turbo Pascal version 3 Manual, with     }
  13. { additional declarations and statements by Ron Shaw.                     }
  14. {                                                                         }
  15. { POINTERS.PAS  ->  POINTERS.EXE    R Shaw      20.1.90 & 7.2.91          }
  16. {_________________________________________________________________________}
  17.  
  18. uses Crt, hex;                    { Unit Crt for clear screen procedure    }
  19.                                   { Unit hex for decimal to hex conversion }
  20.  
  21. type
  22.    PersonPointer = ^PersonRecord;                { Pointer type declaration }
  23.  
  24.    { Read as 'PersonPointer is a pointer to the record called PersonRecord' }
  25.  
  26.    PersonRecord = record                          { Record type declaration }
  27.                     Name : string[50];
  28.                     Job  : string[50];
  29.                     Next : PersonPointer;         { Pointer to next record  }
  30.                   end;
  31.  
  32.    PtrRec       = record                       { Record type declaration to }
  33.                     ofs,seg : word;            { allow variable typecasting }
  34.                   end;
  35.  
  36. Var
  37.   HeapTop                                       : ^Integer;
  38.   FirstPerson, LastPerson, NewPerson            : PersonPointer;
  39.   Name                                          : string[50];
  40.   PersonLastSeg, PersonLastOfs                  : word;
  41.   HeapTopSeg, HeapTopOfs, HeapSeg, HeapOfs      : word;
  42.   SegmentAddress, OffsetAddress                 : array [1..10] of word;
  43.   SegmentAddressX, OffsetAddressX               : array [1..10] of string;
  44.   i,j                                           : integer;
  45.   PersonLastSegX, PersonLastOfsX                : string;
  46.   HeapSegX, HeapOfsX, HeapTopSegX, HeapTopOfsX  : string;
  47.   reply                                         : char;
  48.  
  49. begin
  50.   ClrScr;                                { Clear screen from Crt Unit       }
  51.   FirstPerson := nil;                    { First pointer initialized to nil }
  52.   Mark(HeapTop);
  53.   HeapSeg := seg(HeapTop^);              { Function seg - see Ref. Guide }
  54.   HeapOfs := ofs(HeapTop^);              { Function ofs - see Ref. Guide }
  55.   i := 1;
  56.   writeln('Please enter names and professions of between 3 and 7 persons');
  57.   writeln('and just press ENTER for a name to end entry');
  58.   writeln;
  59.   repeat
  60.     write('Enter name:       ');
  61.     readln(Name);
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.     if Name <> '' then
  72.                   begin
  73.                      New(NewPerson);      { Standard procedure 'New' for    }
  74.                                           { allocating new 'Heap' variables }
  75.                      SegmentAddress[i] := seg(NewPerson^);  { Function seg  }
  76.                      OffsetAddress[i] := ofs(NewPerson^);   { Function ofs  }
  77.                      NewPerson^.Name := Name;
  78.                      write('Enter profession: ');
  79.                      readln(NewPerson^.Job);
  80.                      writeln;
  81.                      if FirstPerson = nil then   { First entry by a pointer }
  82.                         FirstPerson := NewPerson    { to pointer assignment }
  83.                      else
  84.                         LastPerson^.Next := NewPerson; { Subsequent entries }
  85.                      LastPerson := NewPerson;
  86.                      LastPerson^.Next := nil;  { Last pointer assigned 'nil'}
  87.                      i := i + 1;
  88.                    end;
  89.     until Name='';
  90.     ClrScr;
  91.     writeln;
  92.     while FirstPerson <> nil do
  93.     with FirstPerson^ do            { With record pointed to by FirstPerson }
  94.     begin
  95.        writeln(Name,' is a ',Job);
  96.        FirstPerson := Next;          { Pointer reassignment for next record }
  97.     end;
  98.     writeln;
  99.     writeln('Press any key to continue');
  100.     reply := readkey;
  101.  
  102.  
  103. {  The remaining code is used to show the pointer and HeapTop values }
  104.  
  105.     writeln;
  106.     PersonLastSeg  := PtrRec(LastPerson).seg;        { Variable typecasting }
  107.     PersonLastOfs  := PtrRec(LastPerson).ofs;
  108.     HeapTopSeg     := PtrRec(HeapTop).seg;
  109.     HeapTopOfs     := PtrRec(HeapTop).ofs;          { End variable typecast }
  110.  
  111.     dec2hex(PersonLastSeg,PersonLastSegX);          { Decimal to hexadecimal}
  112.     dec2hex(PersonLastOfs,PersonLastOfsX);          { conversions using the }
  113.     dec2hex(HeapTopSeg,HeapTopSegX);                { unit HEX.TPU written  }
  114.     dec2hex(HeapTopOfs,HeapTopOfsX);                { by R. Shaw            }
  115.     if HeapTopOfsX = '' then HeapTopOfsX := '0';    { Should alter HEX.TPU }
  116.  
  117.     writeln;
  118.     writeln('--------------------------------------------- ');
  119.     writeln;
  120.     writeln('Last person segment ',PersonLastSegX,' and offset ',PersonLastOfsX);
  121.     writeln;
  122.     writeln('Heap top segment ',HeapTopSegX,' and offset ',HeapTopOfsX);
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139. { Segment and offset locations found by seg and ofs functions  }
  140.  
  141.     writeln;
  142.     writeln('---------------------------------------------  ');
  143.     writeln;
  144.     dec2hex(HeapSeg,HeapSegX);                 { Uses the unit HEX.TPU      }
  145.     dec2hex(HeapOfs,HeapOfsX);                 { written by R. Shaw         }
  146.     if HeapOfsX = '' then HeapOfsX := '0';
  147.     writeln('Heap top segment ',HeapSegX,'  and offset ',HeapOfsX,' -  check');
  148.     writeln;
  149.     writeln('No.  Segment   Offset');
  150.     writeln;
  151.     for j := 1 to i - 1 do
  152.         begin
  153.            dec2hex(SegmentAddress[j],SegmentAddressX[j]);    { Uses HEX.TPU }
  154.            dec2hex(OffsetAddress[j],OffsetAddressX[j]);      { to convert   }
  155.            if OffsetAddressX[j] = '' then OffsetAddressX[j] := '0';
  156.            writeln(j,'     ',SegmentAddressX[j],'       ',OffsetAddressX[j]);
  157.         end;
  158.     writeln;
  159.     writeln;
  160.     Release(HeapTop);
  161.     write('Press any key to continue..');
  162.     reply := readkey;
  163. end.
  164.