[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]
UNIT Vector;
{$F+,O+}
{$DEFINE Englisch} { language for error messages Englisch/Deutsch }
{ An example how to program variable sized arrays on the heap. Some of the
routines are programmed in 80x87 assembler for speed. (See R. Startz:
8087/80287/80387 for the IBM PC & Compatibles, 3rd ed., New York (Brady)
1988, ISBN 0-13-246604-X for an introduction to 80x87 assembler)
Copyright (c) 1997 by Dr. Engelbert Buxbaum. This code may be freely
distributed and used for non-commercial purposes. All other rights reserved.
I have left in calls to some libraries I normally use for IO and error
handling (see USES-clause for details). It should not be difficult to
replace them with your own. }
INTERFACE
USES CRT,
Windows, { handle windows for I/O. Source: Chip-Spezial - Das
Allerbeste, Wuerzburg (Vogel) 1989, ISBN 3-8023-1008-X
Used in WriteVector. Defines also
FUNCTION Error (Msg : STRING) : CHAR; for error handling.
This function opens a window, prints Msg, waits for a key
to be pressed, closes the window and returns the key }
ReadExt, { protected keyboard input. Defines functions ReadByte,
ReadReal ect with their obvious meaning. Argument of
these function is the number of significant places. Also
from Chip Special }
MathFunc; { simple math routines like logarithms ect. }
CONST MaxVector = 8000; { so as not to exceed 64 KB }
VectorXPos : WORD = 1; { position for screen output }
VectorYPos : WORD = 1;
VectorError : BOOLEAN = FALSE; { flag for error handling, can be
checked and reset by calling unit }
TYPE VectorStruc = RECORD
Column : WORD;
Data : ARRAY [1..MaxVector] of DOUBLE;
END;
VectorTyp = ^VectorStruc;
MedString = string[14]; { name of I/O device }
PROCEDURE ReadVector (MedStr : MedString; var Vector : VectorTyp);
{ read vector from device given by MedString. Can be a file, CON or PRN.
Vector will be created inside this routine and should not exist when the
function is entered. First line contains the number of Vector-elements (may
be preceeded by '#' for compatibility with GnuPlot), followed by each element
on a separate line }
PROCEDURE WriteVector (MedStr : MedString; Vector : VectorTyp; Places : BYTE);
{ Write vector to device. See comment above for details of file format }
PROCEDURE InitVector (VAR Vector : VectorTyp; len : WORD);
{ create vector, contents will be undefined }
PROCEDURE KillVector (VAR Vector : VectorTyp);
{ reclaim memory occupied by vector }
FUNCTION VectorLength (Vector : VectorTyp) : WORD;
FUNCTION GetVectorElement (Vector : VectorTyp; n : WORD) : DOUBLE;
PROCEDURE PutVectorElement (Vector : VectorTyp; n : WORD; c : DOUBLE);
PROCEDURE CopyVector (Source, Target : VectorTyp);
{ use instead of Target := Source to copy contents of vector }
PROCEDURE LoadConstant (Vector : VectorTyp; C : DOUBLE);
{ load all vector elements with C }
PROCEDURE AddConstant (A, B : VectorTyp; C : DOUBLE);
{ add C to all elements in A and save result in B. A and B may be identical }
PROCEDURE SubConstant (A, B : VectorTyp; C : DOUBLE);
PROCEDURE MulConstant (A, B : VectorTyp; C : DOUBLE);
PROCEDURE DivConstant (A, B : VectorTyp; C : DOUBLE);
PROCEDURE VectorAdd (A, B, C : VectorTyp);
{ Add corresponding elements of A and B, save result in C. A, B and C may
be identical. }
PROCEDURE VectorSub (A, B, C : VectorTyp);
FUNCTION VectorInnerProduct (A, B : VectorTyp) : DOUBLE;
{ Inner product of 2 vectors (sum of the product of corresponding elements) }
FUNCTION GSum (Vector : VectorTyp) : DOUBLE;
{ GSum := a[1] + a[2] + ... + a[n]. Divide this sum by Vector.Len to get the
arithmetic mean. }
FUNCTION HarmonicAverage (Vector : VectorTyp) : DOUBLE;
{ n-th root of the product of all elements, implemented by dividing the sums
of the logarithms of all elements by n. The elements must be > 0 }
FUNCTION VectorAbsolute (Vector : VectorTyp) : DOUBLE;
{ Euclidian vector length, sqrt of the sum of the squares of all elements }
FUNCTION Angle (A, B : VectorTyp) : DOUBLE;
{ arccos(InnerProduct(A, B) / (len(A)*len(B))) }
IMPLEMENTATION
TYPE PtrParts = RECORD
Ofs, Seg : WORD; { Address to which Vector points }
END;
VAR ch : CHAR; { dummy variable for error handling }
PROCEDURE InitVector (VAR Vector : VectorTyp; len : WORD);
{$IFDEF Deutsch}
CONST Text = ' nicht genuegend (zusammenhaengender) Speicher';
{$ENDIF}
{$IFDEF Englisch}
CONST Text = ' not enough (continuous) memory';
{$ENDIF}
BEGIN
IF (len > MaxVector) OR (len*SizeOf(DOUBLE)+4 > MaxAvail)
THEN
BEGIN
ch := Windows.Error(Text);
VectorError := TRUE;
EXIT;
END;
GetMem(Vector, len*SizeOf(DOUBLE)+4);
Vector^.Column := len;
END;
PROCEDURE KillVector (VAR Vector : VectorTyp);
BEGIN
FreeMem(Vector, Vector^.Column*SizeOf(DOUBLE)+4);
Vector := nil; { so it may not be used by mistake }
END;
FUNCTION VectorLength (Vector : VectorTyp) : WORD;
BEGIN
VectorLength := Vector^.Column;
END;
FUNCTION GetVectorElement (Vector : VectorTyp; n : WORD) : DOUBLE;
{$IFDEF Deutsch}
CONST Text = ' Lesender Zugriff auf nicht existierendes Vektor-Element';
{$ENDIF}
{$IFDEF Englisch}
CONST Text = ' Attempt to read non-existend vector element';
{$ENDIF}
BEGIN
IF (n <= Vector^.Column)
THEN
GetVectorElement := Vector^.Data[n]
ELSE
BEGIN
ch := Windows.Error(Text);
VectorError := TRUE;
END;
END;
PROCEDURE PutVectorElement (Vector : VectorTyp; n : WORD; C : DOUBLE);
{$IFDEF Deutsch}
CONST Text = ' Schreibender Zugriff auf nicht existierendes Vektor-Element';
{$ENDIF}
{$IFDEF Englisch}
CONST Text = ' Attempt to Write to non-existing vector element';
{$ENDIF}
BEGIN
IF (n <= Vector^.Column)
THEN
Vector^.Data[n] := C
ELSE
BEGIN
ch := Windows.Error(Text);
VectorError := TRUE;
END;
END;
PROCEDURE CopyVector (Source, Target : VectorTyp);
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE Source;
q : PtrParts ABSOLUTE Target;
BEGIN
IF (Source^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
InitVector(Target, Source^.Column);
if VectorError then exit;
ASM
PUSH DS
MOV AX,i { SizeOf(DOUBLE) into AX }
MOV ES,k
MOV BX,j { instead of LES Vector^ }
MOV CX,WORD PTR ES:[BX] { vector length into CX }
ADD BX,2 { ES:[BX] => Source.Data[1] }
MOV SI,l
MOV DS,m
ADD SI,2 { DS:[SI] = Target.Data[1] }
@VecLoop:
FLD QWORD PTR ES:[BX] { Copy Source.Data[j] into ST(0) }
FSTP QWORD PTR DS:[SI] { Move ST(0) into Target.Data[j] }
ADD BX,AX { ES:[BX] to next element of Source }
ADD SI,AX { DS:[SI] to next element of Target }
LOOP @VecLoop
POP DS
END;
END;
PROCEDURE ReadVector (MedStr : MedString; var Vector : VectorTyp);
{$IFDEF Deutsch}
CONST TitelStr = ' Vektor einlesen ';
Text1 = ' Datei mit Vektor nicht gefunden';
Text2 = ' Vektor zu gross';
Text3 = ' Unbekanntes Datei-Format';
Namen : array [1..2] of string[10] = ('Laenge: ', 'Element: ');
{$ENDIF}
{$IFDEF Englisch}
CONST TitelStr = ' Read vector ';
Text1 = ' File with vector not found';
Text2 = ' Vector too large';
Text3 = ' Unknown file format';
Namen : array [1..2] of string[10] = ('Length: ', 'Element: ');
{$ENDIF}
VAR j, k, l : WORD;
code : integer;
Medium : text;
Window : WindowType;
hst : string[5];
BEGIN
FOR k := 1 TO Length(MedStr) DO
MedStr[k] := UpCase(MedStr[k]);
IF MedStr = 'CON'
THEN
BEGIN
Window := Windows.NormWindow;
Window.Titel := TitelStr;
Windows.OpenWindowType(1, 1, 80, 25, Window);
Write(Namen[1]);
l := ReadExt.ReadByte(3);
WriteLn;
END
ELSE
BEGIN
Assign(Medium, MedStr);
Reset(Medium);
IF IOResult <> 0
THEN
BEGIN
ch := Windows.Error(Text1);
VectorError := TRUE;
EXIT;
END;
ReadLn(Medium, hst);
if hst[1] = '#' then hst := copy(hst, 2, length(hst)); { for compatibility with gnuplot }
Val(hst, l, code);
if code <> 0
then
begin
VectorError := True;
ch := Windows.Error(Text3);
exit;
end;
END;
InitVector(Vector, l);
IF VectorError THEN EXIT;
IF MedStr = 'CON'
THEN
WriteLn(' ----------------- ');
IF (Vector^.Column > MaxVector)
THEN
BEGIN
ch := Windows.Error(Text2);
VectorError := TRUE;
EXIT;
END;
IF MedStr = 'CON'
THEN
FOR j := 1 TO l DO
BEGIN
Write(j, '. ', Namen[2]);
Vector^.Data[j] := ReadExt.ReadReal(12, 5);
WriteLn;
END
ELSE
BEGIN
FOR j := 1 TO l DO
BEGIN
IF EOF(Medium)
THEN
BEGIN
ch := Windows.Error(Text3);
VectorError := TRUE;
EXIT;
END;
ReadLn(Medium, Vector^.Data[j]);
IF IOResult <> 0
THEN
BEGIN
ch := Windows.Error(Text3);
VectorError := TRUE;
EXIT;
END;
END;
END;
IF MedStr = 'CON'
THEN
Windows.CloseWindow
ELSE
Close(Medium);
END;
PROCEDURE WriteVector (MedStr : MedString; Vector : VectorTyp; Places : BYTE);
VAR j, k : WORD;
Medium : TEXT;
Window : WindowType;
BEGIN
FOR k := 1 TO length(MedStr) DO
MedStr[k] := UpCase(MedStr[k]);
IF (MedStr = 'CON')
THEN
BEGIN
Window.TextAtt := 23;
Window.RahmenAtt := 23;
Window.Rahmen := NoFrame;
Window.Titel := '';
OpenWindowType(VectorXPos, VectorYPos, VectorXPos+Places+1,
VectorYPos+Vector^.Column+2, Window);
END
ELSE
assign(Medium, MedStr);
IF NOT ((MedStr = 'LST') OR (MedStr = 'CON'))
THEN
BEGIN
ReWrite(Medium);
WriteLn(Medium, '#', Vector^.Column);
END
ELSE
IF (MedStr = 'LST') THEN ReWrite(Medium);
FOR j := 1 TO Vector^.Column DO
IF (MedStr <> 'CON')
THEN
WriteLn(Medium, MathFunc.FloatStr(Vector^.Data[j], Places))
ELSE
Write(MathFunc.FloatStr(Vector^.Data[j], Places));
IF MedStr <> 'CON' THEN close(Medium);
END;
PROCEDURE LoadConstant (Vector : VectorTyp; C : DOUBLE);
VAR i, j, k : WORD;
p : PtrParts ABSOLUTE Vector;
BEGIN
IF (Vector^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
ASM
mov ax,i
mov es,k
mov bx,j
mov cx,WORD ptr es:[bx]
add bx,2
fld qword ptr C { put C into ST(0) }
@ConstLoop:
fst qword ptr ES:[BX] { copy C from ST(0) into A[j] }
add bx,ax { ES:[BX] to next element }
loop @ConstLoop
fstp st(0) { clean up Coprocessor-Stack }
END;
END;
PROCEDURE AddConstant (A, B : VectorTyp; C : DOUBLE);
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE A;
q : PtrParts ABSOLUTE B;
BEGIN
IF (A^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
B^.Column := A^.Column;
ASM
PUSH DS
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
MOV SI,l
MOV DS,m
ADD SI,2
FLD QWORD PTR C { load constant C into ST(0) }
@AddLoop:
FLD QWORD PTR ES:[BX] { A.Data[j] into ST(0) }
FADD ST,St(1) { ST(0) = A.Data[j] + C }
FSTP QWORD PTR DS:[SI] { move result into B.Data[j] }
ADD BX,AX
ADD SI,AX
loop @AddLoop
FSTP ST(0)
POP DS
END;
END;
PROCEDURE SubConstant (A, B : VectorTyp; C : DOUBLE);
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE A;
q : PtrParts ABSOLUTE B;
BEGIN
IF (A^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
B^.Column := A^.Column;
ASM
PUSH DS
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
MOV SI,l
MOV DS,m
ADD SI,2
FLD QWORD PTR C
@SubLoop:
FLD QWORD PTR ES:[BX]
FSUB ST,ST(1)
FSTP QWORD PTR DS:[SI]
ADD BX,AX
ADD SI,AX
LOOP @SubLoop
FSTP ST(0)
POP DS
END;
END;
PROCEDURE MulConstant (A, B : VectorTyp; C : DOUBLE);
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE A;
q : PtrParts ABSOLUTE B;
BEGIN
IF (A^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
B^.Column := A^.Column;
ASM
PUSH DS
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
MOV SI,l
MOV DS,m
ADD SI,2
FLD QWORD PTR C
@MulLoop:
FLD QWORD PTR ES:[BX]
FMUL ST,ST(1)
FSTP QWORD PTR DS:[SI]
ADD BX,AX
ADD SI,AX
LOOP @MulLoop
FSTP ST(0)
POP DS
END;
END;
PROCEDURE DivConstant (A, B : VectorTyp; C : DOUBLE);
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE A;
q : PtrParts ABSOLUTE B;
BEGIN
IF (A^.Column = 0) THEN EXIT;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
B^.Column := A^.Column;
ASM
PUSH DS
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
MOV SI,l
MOV DS,m
ADD SI,2
FLD QWORD PTR C
@DivLoop:
FLD QWORD PTR ES:[BX]
FDIV ST,ST(1)
FSTP QWORD PTR DS:[SI]
ADD BX,AX
ADD SI,AX
LOOP @DivLoop
FSTP ST(0)
POP DS
END;
END;
PROCEDURE VectorAdd (A, B, C : VectorTyp);
{$IFDEF Deutsch}
CONST Text = ' Vektor-Addition: ungleiche Vektorlaenge';
{$ENDIF}
{$IFDEF Englisch}
CONST Text = ' Addition of vectors: vectors of different lengths';
{$ENDIF}
VAR i : WORD;
BEGIN
IF (A^.Column <= 0) OR (A^.Column <> B^.Column) or (C^.Column <> A^.Column)
THEN
BEGIN
ch := Windows.Error(text);
VectorError := TRUE;
EXIT;
END;
FOR i := 1 TO A^.Column DO
c^.Data[i] := a^.Data[i] + b^.Data[i];
END;
PROCEDURE VectorSub (A, B, C : VectorTyp);
{$IFDEF Deutsch}
CONST Text = ' Vektor-Subtraktion: ungleiche Vektorlaenge';
{$ENDIF}
{$IFDEF Englisch}
CONST Text = ' Subtraction of vectors: vectors of different lengths';
{$ENDIF}
VAR i : WORD;
BEGIN
IF (A^.Column = 0) OR (B^.Column <> A^.Column) or (C^.Column <> A^.Column)
THEN
BEGIN
ch := Windows.Error(text);
VectorError := TRUE;
EXIT;
END;
FOR i := 1 TO A^.Column DO
c^.Data[i] := a^.Data[i] - b^.Data[i];
END;
FUNCTION GSum (Vector : VectorTyp) : DOUBLE;
VAR i, j, k : WORD;
p : PtrParts ABSOLUTE Vector;
BEGIN
IF (Vector^.Column = 0)
THEN
BEGIN
GSum := 0;
EXIT;
END;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
ASM
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
FLDZ { 0 into ST(0), serves as accumulator }
@AddLoop:
FADD QWORD PTR ES:[BX] { add vector element to sum in ST(0) }
ADD BX,AX
LOOP @AddLoop
FSTP QWORD PTR @Result { ST(0) is result of this function }
END;
END;
FUNCTION HarmonicAverage (Vector : VectorTyp) : DOUBLE;
VAR i, j, k, l : WORD;
p : PtrParts ABSOLUTE Vector;
x : DOUBLE;
BEGIN
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := Vector^.Column;
ASM
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
FLDZ
@MulLoop:
FLDLN2 { ST(0) = ln(2) }
FLD QWORD PTR ES:[BX] { Vector element in ST(0) }
FYL2X { ST(0) = ln(2) * ld(Element) = ln(Element) }
FADDP ST(1),ST(0) { add ln(Element) to sum in ST(1) and pop ST(0)}
ADD BX,AX
LOOP @MulLoop
FIDIV l { divide by vector length }
FSTP x { ln(Average) into variable x }
END;
HarmonicAverage := exp(x); { this would be lengthy in Assembler }
END;
FUNCTION VectorAbsolute (Vector : VectorTyp) : DOUBLE;
VAR i, j, k : WORD;
p : PtrParts ABSOLUTE Vector;
BEGIN
IF (Vector^.Column = 0)
THEN
BEGIN
VectorAbsolute := 0;
EXIT;
END;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
ASM
MOV AX,i
MOV ES,k
MOV BX,j
MOV CX,WORD PTR ES:[BX]
ADD BX,2
FLDZ { ST(0) = 0 (Sum of squares of elements) }
@MulLoop:
FLD QWORD PTR ES:[BX] { A[j] into ST(0), => Summe into ST(1) }
FMUL ST,ST { ST(0) = A[j]^2 }
FADDP ST(1),ST { Sum into ST(0) }
ADD BX,AX
LOOP @MulLoop
FSQRT { ST(0) := sqrt(ST(0)) }
FSTP QWORD PTR @Result
END;
END;
FUNCTION VectorInnerProduct (A, B : VectorTyp) : DOUBLE;
{$IFDEF Deutsch}
CONST Text1 = 'Vektor-Error: Inneres Produkt ungleich langer Vektoren';
{$ENDIF}
{$IFDEF Englisch}
CONST Text1 = 'Vector error: Inner Product of vectors of unequal length';
{$ENDIF}
VAR i, j, k, l, m : WORD;
p : PtrParts ABSOLUTE A;
q : PtrParts ABSOLUTE B;
BEGIN
IF (A^.Column = 0)
THEN
BEGIN
VectorInnerProduct := 0;
EXIT;
END;
IF (B^.Column <> A^.Column)
THEN
BEGIN
ch := Windows.Error(Text1);
VectorError := TRUE;
EXIT;
END;
i := SizeOf(DOUBLE);
j := p.Ofs;
k := p.Seg;
l := q.Ofs;
m := q.Seg;
ASM
PUSH DS
MOV ES,k
MOV SI,j
MOV CX,WORD PTR ES:[SI];
ADD SI,2
MOV DS,m
MOV DI,l
ADD DI,2
MOV BX,0
FLDZ
@AddLoop:
FLD QWORD PTR ES:[BX][SI]
FMUL QWORD PTR DS:[BX][DI]
FADDP ST(1),ST
ADD BX,i
LOOP @AddLoop
FSTP QWORD PTR @Result
POP DS
END;
END;
FUNCTION Angle (A, B : VectorTyp) : DOUBLE;
{$IFDEF Deutsch}
CONST Text1 = 'Vektor-Error: Winkel zwischen Vektoren ungleicher Dimension';
{$ENDIF}
{$IFDEF Englisch}
CONST Text1 = 'Vector error: Angle between vectors of unequal dimension';
{$ENDIF}
BEGIN
IF (A^.Column = 0) AND (B^.Column = 0)
THEN
BEGIN
Angle := 0;
EXIT;
END;
IF (A^.Column) <> (B^.Column)
THEN
BEGIN
ch := Windows.Error(Text1);
VectorError := TRUE;
EXIT;
END;
Angle := MathFunc.ArcCos(VectorInnerProduct(A, B) /
(VectorAbsolute(A) * VectorAbsolute(B)));
END;
END. { unit vector }
{ This program can be used to test the above units }
PROGRAM VectorTest;
uses crt, windows, mathfunc, vector;
CONST Kurz = 4;
VAR x : DOUBLE;
A, B, C : VectorTyp;
Fenster : WindowType;
Speicher1,
Speicher2,
Speicher3 : LONGINT;
BEGIN
Speicher1 := MemAvail;
Fenster.TextAtt := 23;
Fenster.RahmenAtt := 23;
Fenster.Rahmen := NoFrame;
Fenster.Titel := '';
ClrScr;
InitVector(A, kurz);
InitVector(B, kurz);
InitVector(C, kurz);
Speicher2 := MemAvail;
LoadConstant(A, 3.0);
AddConstant(A, B, 4.5);
VectorAdd(A, B, C);
VectorXPos := 1;
WriteVector('CON', A, 9);
VectorXPos := 15;
OpenWindowType(VectorXPos, VectorYPos+1, vectorXPos+3, vectorYPos+3, Fenster);
Write('+');
VectorXPos := 20;
WriteVector('CON', B, 9);
VectorXPos := 34;
OpenWindowType(vectorXPos, vectorYPos+1, vectorXPos+3, vectorYPos+3, Fenster);
Write('=');
VectorXPos := 40;
WriteVector('CON', C, 9);
ReadLn;
WHILE MaxScreen > 0 DO CloseWindow;
x := VectorInnerProduct(A, B);
vectorXPos := 1;
WriteVector('CON', A, 9);
VectorXPos := 15;
OpenWindowType(vectorXPos, vectorYPos+1, vectorXPos+3, vectorYPos+3, Fenster);
Write('*');
VectorXPos := 20;
WriteVector('CON', B, 9);
VectorXPos := 34;
OpenWindowType(vectorXPos, vectorYPos+1, vectorXPos+3, vectorYPos+3, Fenster);
Write('=');
VectorXPos := 40;
OpenWindowType(vectorXPos, vectorYPos+1, vectorxPos+10, vectoryPos+3, Fenster);
Write(x:5:1);
ReadLn;
WHILE MaxScreen > 0 DO CloseWindow;
x := GSum(A);
VectorXPos := 1;
x := VectorAbsolute(A);
VectorXPos := 1;
OpenWindowType(vectorXPos, vectorYPos+1, vectorXPos+8, vectorYPos+3, Fenster);
Write('Betrag');
VectorXPos := 11;
WriteVector('CON', A, 9);
VectorXPos := 26;
OpenWindowType(vectorXPos, vectorYPos+1, vectorxPos+15, vectoryPos+3, Fenster);
Write(' = ', FloatStr(x, 9));
ReadLn;
WHILE MaxScreen > 0 DO CloseWindow;
KillVector(A);
KillVector(B);
KillVector(C);
Speicher3 := MemAvail;
WriteLn('Original free memory ', Speicher1:10, ' Byte');
WriteLn('Free memory after creation of vectors ', Speicher2:10, ' Byte');
WriteLn('Free memory after destruction of vectors: ', Speicher3:10, ' Byte');
ReadLn;
END.
[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]