Program Example1;
{ Program to demonstrate the Abs function. }
Var
r : real;
i : integer;
begin
r:=abs(-1.0); { r:=1.0 }
i:=abs(-21); { i:=21 }
end.
Program Example2;
{ Program to demonstrate the Addr function. }
Const Zero : integer = 0;
Var p : pointer;
i : Integer;
begin
p:=Addr(p); { P points to itself }
p:=Addr(I); { P points to I }
p:=Addr(Zero); { P points to 'Zero' }
end.
Program Example3;
{ Program to demonstrate the Append function. }
Var f : text;
begin
Assign (f,'test.txt');
Rewrite (f); { file is opened for write, and emptied }
Writeln (F,'This is the first line of text.txt');
close (f);
Append(f); { file is opened for write, but NOT emptied.
any text written to it is appended.}
Writeln (f,'This is the second line of text.txt');
close (f);
end.
Program Example4;
{ Program to demonstrate the ArcTan function. }
Var R : Real;
begin
R:=ArcTan(0); { R:=0 }
R:=ArcTan(1)/pi; { R:=0.25 }
end.
Program Example5;
{ Program to demonstrate the Assign function. }
Var F : text;
begin
Assign (F,'');
Rewrite (f);
{ The following can be put in any file by redirecting it
from the command line.}
Writeln (f,'This goes to standard output !');
Close (f);
Assign (F,'Test.txt');
rewrite (f);
writeln (f,'This doesn''t go to standard output !');
close (f);
end.
Program example81;
{ Program to demonstrate the BinStr function }
Const Value = 45678;
Var I : longint;
begin
For I:=8 to 20 do
Writeln (BinStr(Value,I):20);
end.
Program Example6;
{ Program to demonstrate the BlockRead and BlockWrite functions. }
Var Fin, fout : File;
NumRead,NumWritten : Word;
Buf : Array[1..2048] of byte;
Total : Longint;
begin
Assign (Fin, Paramstr(1));
Assign (Fout,Paramstr(2));
Reset (Fin,1);
Rewrite (Fout,1);
Total:=0;
Repeat
BlockRead (Fin,buf,Sizeof(buf),NumRead);
BlockWrite (Fout,Buf,NumRead,NumWritten);
inc(Total,NumWritten);
Until (NumRead=0) or (NumWritten<>NumRead);
Write ('Copied ',Total,' bytes from file ',paramstr(1));
Writeln (' to file ',paramstr(2));
close(fin);
close(fout);
end.
Program Example7;
{ Program to demonstrate the ChDir function. }
begin
{$I-}
ChDir (ParamStr(1));
if IOresult<>0 then
Writeln ('Cannot change to directory : ',paramstr (1));
end.
Program Example8;
{ Program to demonstrate the Chr function. }
begin
Write (chr(10),chr(13)); { The same effect as Writeln; }
end.
Program Example9;
{ Program to demonstrate the Close function. }
Var F : text;
begin
Assign (f,'Test.txt');
ReWrite (F);
Writeln (F,'Some text written to Test.txt');
close (f); { Flushes contents of buffer to disk,
closes the file. Omitting this may
cause data NOT to be written to disk.}
end.
Program Example10;
{ Program to demonstrate the Concat function. }
Var
S : String;
begin
S:=Concat('This can be done',' Easier ','with the + operator !');
end.
Program Example11;
{ Program to demonstrate the Copy function. }
Var S,T : String;
begin
T:='1234567';
S:=Copy (T,1,2); { S:='12' }
S:=Copy (T,4,2); { S:='45' }
S:=Copy (T,4,8); { S:='4567' }
end.
Program Example12;
{ Program to demonstrate the Cos function. }
Var R : Real;
begin
R:=Cos(Pi); { R:=-1 }
R:=Cos(Pi/2); { R:=0 }
R:=Cos(0); { R:=1 }
end.
Program Example13;
{ Program to demonstrate the CSeg function. }
var W : word;
begin
W:=CSeg; {W:=0, provided for comppatibility,
FPC is 32 bit.}
end.
Program Example14;
{ Program to demonstrate the Dec function. }
Var
I : Integer;
L : Longint;
W : Word;
B : Byte;
Si : ShortInt;
begin
I:=1;
L:=2;
W:=3;
B:=4;
Si:=5;
Dec (i); { i:=0 }
Dec (L,2); { L:=0 }
Dec (W,2); { W:=1 }
Dec (B,-2); { B:=6 }
Dec (Si,0); { Si:=5 }
end.
Program Example15;
{ Program to demonstrate the Delete function. }
Var
S : String;
begin
S:='This is not easy !';
Delete (S,9,4); { S:='This is easy !' }
end.
Program Example16;
{ Program to demonstrate the Dispose and New functions. }
Type SS = String[20];
AnObj = Object
I : integer;
Constructor Init;
Destructor Done;
end;
Var
P : ^SS;
T : ^AnObj;
Constructor Anobj.Init;
begin
Writeln ('Initializing an instance of AnObj !');
end;
Destructor AnObj.Done;
begin
Writeln ('Destroying an instance of AnObj !');
end;
begin
New (P);
P^:='Hello, World !';
Dispose (P);
{ P is undefined from here on !}
New(T,Init);
T^.i:=0;
Dispose (T,Done);
end.
Program Example17;
{ Program to demonstrate the DSeg function. }
Var
W : Word;
begin
W:=DSeg; {W:=0, This function is provided for compatibility,
FPC is a 32 bit comiler.}
end.
Program Example18;
{ Program to demonstrate the Eof function. }
Var T1,T2 : text;
C : Char;
begin
{ Set file to read from. Empty means from standard input.}
assign (t1,paramstr(1));
reset (t1);
{ Set file to write to. Empty means to standard output. }
assign (t2,paramstr(2));
rewrite (t2);
While not eof(t1) do
begin
read (t1,C);
write (t2,C);
end;
Close (t1);
Close (t2);
end.
Program Example19;
{ Program to demonstrate the Eoln function. }
begin
{ This program waits for keyboard input. }
{ It will print True when an empty line is put in,
and false when you type a non-empty line.
It will only stop when you press enter.}
Writeln (eoln);
end.
Program Example20;
{ Program to demonstrate the Erase function. }
Var F : Text;
begin
{ Create a file with a line of text in it}
Assign (F,'test.txt');
Rewrite (F);
Writeln (F,'Try and find this when I''m finished !');
close (f);
{ Now remove the file }
Erase (f);
end.
Program Example21;
{ Program to demonstrate the Exit function. }
Procedure DoAnExit (Yes : Boolean);
{ This procedure demonstrates the normal Exit }
begin
Writeln ('Hello from DoAnExit !');
If Yes then
begin
Writeln ('Bailing out early.');
exit;
end;
Writeln ('Continuing to the end.');
end;
Function Positive (Which : Integer) : Boolean;
{ This function demonstrates the extra FPC feature of Exit :
You can specify a return value for the function }
begin
if Which>0 then
exit (True)
else
exit (False);
end;
begin
{ This call will go to the end }
DoAnExit (False);
{ This call will bail out early }
DoAnExit (True);
if Positive (-1) then
Writeln ('The compiler is nuts, -1 is not positive.')
else
Writeln ('The compiler is not so bad, -1 seems to be negative.');
end.
Program Example22;
{ Program to demonstrate the Exp function. }
begin
Writeln (Exp(1):8:2); { Should print 2.72 }
end.
Program Example23;
{ Program to demonstrate the FilePos function. }
Var F : File of Longint;
L,FP : longint;
begin
{ Fill a file with data :
Each position contains the position ! }
Assign (F,'test.dat');
Rewrite (F);
For L:=0 to 100 do
begin
FP:=FilePos(F);
Write (F,FP);
end;
Close (F);
Reset (F);
{ If ll goes well, nothing is displayed here. }
While not (Eof(F)) do
begin
FP:=FilePos (F);
Read (F,L);
if L<>FP then
Writeln ('Something is wrong here ! : Got ',l,' on pos ',FP);
end;
Close (F);
Erase (f);
end.
Program Example24;
{ Program to demonstrate the FileSize function. }
Var F : File Of byte;
L : File Of Longint;
begin
Assign (F,paramstr(1));
Reset (F);
Writeln ('File size in bytes : ',FileSize(F));
Close (F);
Assign (L,paramstr (1));
Reset (L);
Writeln ('File size in Longints : ',FileSize(L));
Close (f);
end.
Program Example25;
{ Program to demonstrate the FillChar function. }
Var S : String[10];
I : Byte;
begin
For i:=10 downto 0 do
begin
{ Fill S with i spaces }
FillChar (S,SizeOf(S),' ');
{ Set Length }
S[0]:=chr(i);
Writeln (s,'*');
end;
end.
Program Example76;
{ Program to demonstrate the FillWord function. }
Var W : Array[1..100] of Word;
begin
{ Quick initialization of array W }
FillWord(W,100,0);
end.
Program Example26;
{ Program to demonstrate the Flush function. }
Var F : Text;
begin
{ Assign F to standard output }
Assign (F,'');
Rewrite (F);
Writeln (F,'This line is written first, but appears later !');
{ At this point the text is in the internal pascal buffer,
and not yet written to standard output }
Writeln ('This line appears first, but is written later !');
{ A writeln to 'output' always causes a flush - so this text is
written to screen }
Flush (f);
{ At this point, the text written to F is written to screen. }
Write (F,'Finishing ');
Close (f); { Closing a file always causes a flush first }
Writeln ('off.');
end.
Program Example27;
{ Program to demonstrate the Frac function. }
Var R : Real;
begin
Writeln (Frac (123.456):0:3); { Prints O.456 }
Writeln (Frac (-123.456):0:3); { Prints -O.456 }
end.
Program Example28;
{ Program to demonstrate the FreeMem and GetMem functions. }
Var P : Pointer;
MM : Longint;
begin
{ Get memory for P }
MM:=MemAvail;
Writeln ('Memory available before GetMem : ',MemAvail);
GetMem (P,80);
MM:=MM-Memavail;
Write ('Memory available after GetMem : ',MemAvail);
Writeln (' or ',MM,' bytes less than before the call.');
{ fill it with spaces }
FillChar (P^,80,' ');
{ Free the memory again }
FreeMem (P,80);
Writeln ('Memory available after FreeMem : ',MemAvail);
end.
Program Example29;
{ Program to demonstrate the GetDir function. }
Var S : String;
begin
GetDir (0,S);
Writeln ('Current directory is : ',S);
end.
Program Example30;
{ Program to demonstrate the Halt function. }
begin
Writeln ('Before Halt.');
Halt (1); { Stop with exit code 1 }
Writeln ('After Halt doesn''t get executed.');
end.
Program example81;
{ Program to demonstrate the HexStr function }
Const Value = 45678;
Var I : longint;
begin
For I:=1 to 10 do
Writeln (HexStr(Value,I));
end.
Program Example31;
{ Program to demonstrate the Hi function. }
var
L : Longint;
W : Word;
begin
L:=1 Shl 16; { = $10000 }
W:=1 Shl 8; { = $100 }
Writeln (Hi(L)); { Prints 1 }
Writeln (Hi(W)); { Prints 1 }
end.
Program example80;
{ Example to demonstrate the High and Low functions. }
Type TEnum = ( North, East, South, West );
TRange = 14..55;
TArray = Array [2..10] of Longint;
Function Average (Row : Array of Longint) : Real;
Var I : longint;
Temp : Real;
begin
Temp := Row[0];
For I := 1 to High(Row) do
Temp := Temp + Row[i];
Average := Temp / (High(Row)+1);
end;
Var A : TEnum;
B : TRange;
C : TArray;
I : longint;
begin
Writeln ('TEnum goes from : ',Ord(Low(TEnum)),' to ', Ord(high(TEnum)),'.');
Writeln ('A goes from : ',Ord(Low(A)),' to ', Ord(high(A)),'.');
Writeln ('TRange goes from : ',Ord(Low(TRange)),' to ', Ord(high(TRange)),'.');
Writeln ('B goes from : ',Ord(Low(B)),' to ', Ord(high(B)),'.');
Writeln ('TArray index goes from : ',Ord(Low(TArray)),' to ', Ord(high(TArray)),'.');
Writeln ('C index goes from : ',Low(C),' to ', high(C),'.');
For I:=Low(C) to High(C) do
C[i]:=I;
Writeln ('Average :',Average(c));
end.
Program Example32;
{ Program to demonstrate the Inc function. }
Const
C : Cardinal = 1;
L : Longint = 1;
I : Integer = 1;
W : Word = 1;
B : Byte = 1;
SI : ShortInt = 1;
CH : Char = 'A';
begin
Inc (C); { C:=2 }
Inc (L,5); { L:=6 }
Inc (I,-3); { I:=-2 }
Inc (W,3); { W:=4 }
Inc (B,100); { B:=101 }
Inc (SI,-3); { Si:=-2 }
Inc (CH,1); { ch:='B' }
end.
Program Example33;
{ Program to demonstrate the Insert function. }
Var S : String;
begin
S:='Free Pascal is difficult to use !';
Insert ('NOT ',S,pos('difficult',S));
writeln (s);
end.
Program Example34;
{ Program to demonstrate the Int function. }
begin
Writeln (Int(123.456):0:1); { Prints 123.0 }
Writeln (Int(-123.456):0:1); { Prints -123.0 }
end.
Program Example35;
{ Program to demonstrate the IOResult function. }
Var F : text;
begin
Assign (f,paramstr(1));
{$i-}
Reset (f);
{$i+}
If IOresult<>0 then
writeln ('File ',paramstr(1),' doesn''t exist')
else
writeln ('File ',paramstr(1),' exists');
end.
Program Example36;
{ Program to demonstrate the Length function. }
Var S : String;
I : Integer;
begin
S:='';
for i:=1 to 10 do
begin
S:=S+'*';
Writeln (Length(S):2,' : ',s);
end;
end.
Ln returns the natural logarithm of the Real parameter X. X must be positive.
Program Example37;
{ Program to demonstrate the Ln function. }
begin
Writeln (Ln(1)); { Prints 0 }
Writeln (Ln(Exp(1))); { Prints 1 }
end.
Program Example38;
{ Program to demonstrate the Lo function. }
Var L : Longint;
W : Word;
begin
L:=(1 Shl 16) + (1 Shl 4); { $10010 }
Writeln (Lo(L)); { Prints 16 }
W:=(1 Shl 8) + (1 Shl 4); { $110 }
Writeln (Lo(W)); { Prints 16 }
end.
LongJmp jumps to the adress in the env jmp_buf, and resores the registers that were stored in it at the corresponding SetJmp call. In effect, program flow will continue at the SetJmp call, which will return value instead of 0. If you pas a value equal to zero, it will be converted to 1 before passing it on. The call will not return, so it must be used with extreme care. This can be used for error recovery, for instance when a segmentation fault occurred.
Program Example73;
{ Program to demonstrate the Lowercase function. }
Var I : Longint;
begin
For i:=ord('A') to ord('Z') do
write (lowercase(chr(i)));
Writeln;
Writeln (Lowercase('ABCDEFGHIJKLMNOPQRSTUVWXYZ'));
end.
Program Example39;
{ Program to demonstrate the Mark and Release functions. }
Var P,PP,PPP,MM : Pointer;
begin
Getmem (P,100);
Mark (MM);
Writeln ('Getmem 100 : Memory available : ',MemAvail,' (marked)');
GetMem (PP,1000);
Writeln ('Getmem 1000 : Memory available : ',MemAvail);
GetMem (PPP,100000);
Writeln ('Getmem 10000 : Memory available : ',MemAvail);
Release (MM);
Writeln ('Released : Memory available : ',MemAvail);
{ At this point, PP and PPP are invalid ! }
end.
Program Example40;
{ Program to demonstrate the MaxAvail function. }
Var
P : Pointer;
I : longint;
begin
{ This will allocate memory until there is no more memory}
I:=0;
While MaxAvail>=1000 do
begin
Inc (I);
GetMem (P,1000);
end;
{ Default 4MB heap is allocated, so 4000 blocks
should be allocated.
When compiled with the -Ch10000 switch, the program
will be able to allocate 10 block }
Writeln ('Allocated ',i,' blocks of 1000 bytes');
end.
Program Example41;
{ Program to demonstrate the MemAvail function. }
Var
P, PP : Pointer;
begin
GetMem (P,100);
GetMem (PP,10000);
FreeMem (P,100);
{ Due to the heap fragmentation introduced
By the previous calls, the maximum amount of memory
isn't equal to the maximum block size available. }
Writeln ('Total heap available (Bytes) : ',MemAvail);
Writeln ('Largest block available (Bytes) : ',MaxAvail);
end.
Program Example42;
{ Program to demonstrate the Move function. }
Var S1,S2 : String [30];
begin
S1:='Hello World !';
S2:='Bye, bye !';
Move (S1,S2,Sizeof(S1));
Writeln (S2);
end.
Program Example43;
{ Program to demonstrate the Odd function. }
begin
If Odd(1) Then
Writeln ('Everything OK with 1 !');
If Not Odd(2) Then
Writeln ('Everything OK with 2 !');
end.
Program Example44;
{ Program to demonstrate the Ofs function. }
Var W : Pointer;
begin
W:=Pointer(Ofs(W)); { W contains its own offset. }
end.
Program Example45;
{ Program to demonstrate the Ord,Pred,Succ functions. }
Type
TEnum = (Zero, One, Two, Three, Four);
Var
X : Longint;
Y : TEnum;
begin
X:=125;
Writeln (Ord(X)); { Prints 125 }
X:=Pred(X);
Writeln (Ord(X)); { prints 124 }
Y:= One;
Writeln (Ord(y)); { Prints 1 }
Y:=Succ(Y);
Writeln (Ord(Y)); { Prints 2}
end.
Program Example46;
{ Program to demonstrate the ParamCount and ParamStr functions. }
Var
I : Longint;
begin
Writeln (paramstr(0),' : Got ',ParamCount,' command-line parameters: ');
For i:=1 to ParamCount do
Writeln (ParamStr (i));
end.
Program Example47;
{ Program to demonstrate the Pi function. }
begin
Writeln (Pi); {3.1415926}
Writeln (Sin(Pi));
end.
Program Example48;
{ Program to demonstrate the Pos function. }
Var
S : String;
begin
S:='The first space in this sentence is at position : ';
Writeln (S,pos(' ',S));
S:='The last letter of the alphabet doesn''t appear in this sentence ';
If (Pos ('Z',S)=0) and (Pos('z',S)=0) then
Writeln (S);
end.
Power returns the value of base to the power expon. Base and expon can be of type Longint, in which case the result will also be a Longint.
The function actually returns Exp(expon*Ln(base))
Program Example78;
{ Program to demonstrate the Power function. }
begin
Writeln (Power(exp(1.0),1.0):8:2); { Should print 2.72 }
end.
Program example80;
{ Example to demonstrate the High and Low functions. }
Type TEnum = ( North, East, South, West );
TRange = 14..55;
TArray = Array [2..10] of Longint;
Function Average (Row : Array of Longint) : Real;
Var I : longint;
Temp : Real;
begin
Temp := Row[0];
For I := 1 to High(Row) do
Temp := Temp + Row[i];
Average := Temp / (High(Row)+1);
end;
Var A : TEnum;
B : TRange;
C : TArray;
I : longint;
begin
Writeln ('TEnum goes from : ',Ord(Low(TEnum)),' to ', Ord(high(TEnum)),'.');
Writeln ('A goes from : ',Ord(Low(A)),' to ', Ord(high(A)),'.');
Writeln ('TRange goes from : ',Ord(Low(TRange)),' to ', Ord(high(TRange)),'.');
Writeln ('B goes from : ',Ord(Low(B)),' to ', Ord(high(B)),'.');
Writeln ('TArray index goes from : ',Ord(Low(TArray)),' to ', Ord(high(TArray)),'.');
Writeln ('C index goes from : ',Low(C),' to ', high(C),'.');
For I:=Low(C) to High(C) do
C[i]:=I;
Writeln ('Average :',Average(c));
end.
Ptr returns a pointer, pointing to the address specified by segment Sel and offset Off. Remark 1: In the 32-bit flat-memory model supported by Free Pascal, this function is obsolete. Remark 2: The returned address is simply the offset. If you recompile the RTL with -dDoMapping defined, then the compiler returns the following : ptr := pointer($e0000000+sel shl 4+off) under DOS, or ptr := pointer(sel shl 4+off) on other OSes.
Program Example59;
{ Program to demonstrate the Ptr function. }
Var P : ^String;
S : String;
begin
S:='Hello, World !';
P:=Ptr(Seg(S),Longint(Ofs(S)));
{P now points to S !}
Writeln (P^);
end.
Program Example49;
{ Program to demonstrate the Random and Randomize functions. }
Var I,Count,guess : Longint;
R : Real;
begin
Randomize; { This way we generate a new sequence every time
the program is run}
Count:=0;
For i:=1 to 1000 do
If Random>0.5 then inc(Count);
Writeln ('Generated ',Count,' numbers > 0.5');
Writeln ('out of 1000 generated numbers.');
count:=0;
For i:=1 to 5 do
begin
write ('Guess a number between 1 and 5 : ');
readln(Guess);
If Guess=Random(5)+1 then inc(count);
end;
Writeln ('You guessed ',Count,' out of 5 correct.');
end.
Program Example50;
{ Program to demonstrate the Read(Ln) function. }
Var S : String;
C : Char;
F : File of char;
begin
Assign (F,'ex50.pp');
Reset (F);
C:='A';
Writeln ('The characters before the first space in ex50.pp are : ');
While not Eof(f) and (C<>' ') do
Begin
Read (F,C);
Write (C);
end;
Writeln;
Close (F);
Writeln ('Type some words. An empty line ends the program.');
repeat
Readln (S);
until S='';
end.
Program Example77;
{ Program to demonstrate the Rename function. }
Var F : Text;
begin
Assign (F,paramstr(1));
Rename (F,paramstr(2));
end.
Program Example51;
{ Program to demonstrate the Reset function. }
Function FileExists (Name : String) : boolean;
Var F : File;
begin
{$i-}
Assign (F,Name);
Reset (F);
{$I+}
FileExists:=(IoResult=0) and (Name<>'');
Close (f);
end;
begin
If FileExists (Paramstr(1)) then
Writeln ('File found')
else
Writeln ('File NOT found');
end.
Program Example52;
{ Program to demonstrate the Rewrite function. }
Var F : File;
I : longint;
begin
Assign (F,'Test.dat');
{ Create the file. Recordsize is 4 }
Rewrite (F,Sizeof(I));
For I:=1 to 10 do
BlockWrite (F,I,1);
close (f);
{ F contains now a binary representation of
10 longints going from 1 to 10 }
end.
Program Example53;
{ Program to demonstrate the MkDir and RmDir functions. }
Const D : String[8] = 'TEST.DIR';
Var S : String;
begin
Writeln ('Making directory ',D);
Mkdir (D);
Writeln ('Changing directory to ',D);
ChDir (D);
GetDir (0,S);
Writeln ('Current Directory is : ',S);
WRiteln ('Going back');
ChDir ('..');
Writeln ('Removing directory ',D);
RmDir (D);
end.
Program Example54;
{ Program to demonstrate the Round function. }
begin
Writeln (Round(123.456)); { Prints 124 }
Writeln (Round(-123.456)); { Prints -124 }
Writeln (Round(12.3456)); { Prints 12 }
Writeln (Round(-12.3456)); { Prints -12 }
end.
Program Example55;
{ Program to demonstrate the RunError function. }
begin
{ The program will stop end emit a run-error 106 }
RunError (106);
end.
Program Example56;
{ Program to demonstrate the Seek function. }
Var
F : File;
I,j : longint;
begin
{ Create a file and fill it with data }
Assign (F,'test.dat');
Rewrite(F); { Create file }
Close(f);
FileMode:=2;
ReSet (F,Sizeof(i)); { Opened read/write }
For I:=0 to 10 do
BlockWrite (F,I,1);
{ Go Back to the begining of the file }
Seek(F,0);
For I:=0 to 10 do
begin
BlockRead (F,J,1);
If J<>I then
Writeln ('Error: expected ' ,i,', got ',j);
end;
Close (f);
end.
Program Example57;
{ Program to demonstrate the SeekEof function. }
Var C : Char;
begin
{ this will print all characters from standard input except
Whitespace characters. }
While Not SeekEof do
begin
Read (C);
Write (C);
end;
end.
Program Example58;
{ Program to demonstrate the SeekEoln function. }
Var
C : Char;
begin
{ This will read the first line of standard output and print
all characters except whitespace. }
While not SeekEoln do
Begin
Read (c);
Write (c);
end;
end.
Program Example60;
{ Program to demonstrate the Seg function. }
Var
W : Word;
begin
W:=Seg(W); { W contains its own Segment}
end.
SetJmp fills env with the necessary data for a jump back to the point where it was called. It returns zero if called in this way. If the function returns nonzero, then it means that a call to LongJmp with env as an argument was made somewhere in the program.
program example79;
{ Program to demonstrate the setjmp, longjmp functions }
procedure dojmp(var env : jmp_buf; value : longint);
begin
value:=2;
Writeln ('Going to jump !');
{ This will return to the setjmp call,
and return value instead of 0 }
longjmp(env,value);
end;
var env : jmp_buf;
begin
if setjmp(env)=0 then
begin
writeln ('Passed first time.');
dojmp(env,2);
end
else
writeln ('Passed second time.');
end.
Program Example85;
{ Program to demonstrate the SetLength function. }
Var S : String;
begin
FillChar(S[1],100,#32);
Setlength(S,100);
Writeln ('"',S,'"');
end.
Program Example61;
{ Program to demonstrate the SetTextBuf function. }
Var
Fin,Fout : Text;
Ch : Char;
Bufin,Bufout : Array[1..10000] of byte;
begin
Assign (Fin,paramstr(1));
Reset (Fin);
Assign (Fout,paramstr(2));
Rewrite (Fout);
{ This is harmless before IO has begun }
{ Try this program again on a big file,
after commenting out the following 2
lines and recompiling it. }
SetTextBuf (Fin,Bufin);
SetTextBuf (Fout,Bufout);
While not eof(Fin) do
begin
Read (Fin,ch);
write (Fout,ch);
end;
Close (Fin);
Close (Fout);
end.
Program Example62;
{ Program to demonstrate the Sin function. }
begin
Writeln (Sin(Pi):0:1); { Prints 0.0 }
Writeln (Sin(Pi/2):0:1); { Prints 1.0 }
end.
Program Example63;
{ Program to demonstrate the SizeOf function. }
Var
I : Longint;
S : String [10];
begin
Writeln (SizeOf(I)); { Prints 4 }
Writeln (SizeOf(S)); { Prints 11 }
end.
Program Example64;
{ Program to demonstrate the SPtr function. }
Var
P :Longint;
begin
P:=Sptr; { P Contains now the current stack position. }
end.
Program Example65;
{ Program to demonstrate the Sqr function. }
Var i : Integer;
begin
For i:=1 to 10 do
writeln (Sqr(i):3);
end.
Program Example66;
{ Program to demonstrate the Sqrt function. }
begin
Writeln (Sqrt(4):0:3); { Prints 2.000 }
Writeln (Sqrt(2):0:3); { Prints 1.414 }
end.
Program Example67;
{ Program to demonstrate the SSeg function. }
Var W : Longint;
begin
W:=SSeg;
end.
Program Example68;
{ Program to demonstrate the Str function. }
Var S : String;
Function IntToStr (I : Longint) : String;
Var S : String;
begin
Str (I,S);
IntToStr:=S;
end;
begin
S:='*'+IntToStr(-233)+'*';
Writeln (S);
end.
Program Example69;
{ Program to demonstrate the Swap function. }
Var W : Word;
L : Longint;
begin
W:=$1234;
W:=Swap(W);
if W<>$3412 then
writeln ('Error when swapping word !');
L:=$12345678;
L:=Swap(L);
if L<>$56781234 then
writeln ('Error when swapping Longint !');
end.
Program Example54;
{ Program to demonstrate the Trunc function. }
begin
Writeln (Trunc(123.456)); { Prints 123 }
Writeln (Trunc(-123.456)); { Prints -123 }
Writeln (Trunc(12.3456)); { Prints 12 }
Writeln (Trunc(-12.3456)); { Prints -12 }
end.
Program Example71;
{ Program to demonstrate the Truncate function. }
Var F : File of longint;
I,L : Longint;
begin
Assign (F,'test.dat');
Rewrite (F);
For I:=1 to 10 Do
Write (F,I);
Writeln ('Filesize before Truncate : ',FileSize(F));
Close (f);
Reset (F);
Repeat
Read (F,I);
Until i=5;
Truncate (F);
Writeln ('Filesize after Truncate : ',Filesize(F));
Close (f);
end.
Program Example72;
{ Program to demonstrate the Upcase function. }
Var I : Longint;
begin
For i:=ord('a') to ord('z') do
write (upcase(chr(i)));
Writeln;
{ This doesn't work in TP, but it does in Free Pascal }
Writeln (Upcase('abcdefghijklmnopqrstuvwxyz'));
end.
Program Example74;
{ Program to demonstrate the Val function. }
Var I, Code : Integer;
begin
Val (ParamStr (1),I,Code);
If Code<>0 then
Writeln ('Error at position ',code,' : ',Paramstr(1)[Code])
else
Writeln ('Value : ',I);
end.
Program Example75;
{ Program to demonstrate the Write(ln) function. }
Var
F : File of Longint;
L : Longint;
begin
Write ('This is on the first line ! '); { No CR/LF pair! }
Writeln ('And this too...');
Writeln ('But this is already on the second line...');
Assign (f,'test.dat');
Rewrite (f);
For L:=1 to 10 do
write (F,L); { No writeln allowed here ! }
Close (f);
end.