turbo pascal v1

This commit is contained in:
davidly 2024-06-30 14:18:33 -07:00
parent 669ec48330
commit 15a91f0338
29 changed files with 32923 additions and 0 deletions

View File

@ -0,0 +1,144 @@
INTRODUCTION
MicroCalc is a tiny spread sheet program a la VisiCalc. It is
provided with the TURBO-Pascal system as an example program.
Since MicroCalc is only a demonstation program it has its limita-
tions (which you may have fun eliminating):
* You can not copy formulas from one cell to others.
* You can not insert and delete lines or columns.
In spite of its limitations MicroCalc does provide some interest-
ing features among which are:
* 11 digits floating point reals (Thanks to TURBO Pascal!)
* Full set of mathematical functions (SIN,COS,LN,EXP etc.)
* Built in line editor for text and formula editing.
* Text can be entered across cells.
* Once entered a formula is protected from accidental erasure.
.PA
In addition to this MicroCalc offers all the usual features of a
spread sheet program:
* Load a spread sheet from the disk.
* Save a spread sheet on the disk.
* Automatic recalculation after each entry. (May be disabled).
* Print the spread sheet on the printer.
* Clear the current spread sheet.
The spread sheet is an electronic piece of paper on which you can
enter text, numbers and formulas and have MicroCalc do calcula-
tions automatically.
The next page shows the electronic spread sheet.
.PA
----------------------------------------------------------------
A B C D ....
1 22.00
2 1.00
3 2.00
4 3.00
5 28.00
.
.
A 5 Formula:
(A1+A2+A3+A4+A5)
----------------------------------------------------------------- 
In the example the next last line shows that the active cell is
cell A5 and that A5 contains a formula: (A1+A2+A3+A4) which
means that the numbers in A1,A2,A3 and A4 should be added and
placed in A5.
The formula can be abbreviated to: (A1>A4) meaning: add all cells
from A1 to A4.
.PA
You move the cursor around just like you do in the TURBO editor:
(Up)
Ctrl-E
(Left) Ctrl-S Ctrl-G (Right)
Ctrl-X
(Down)
---> On the IBM-PC you may also use the arrows. <---
A cell may contain a number, a formula or some text. The type of the cell
and its coordinates are shown in the bottom left corner of the screen:
A 5 Formula: (Means that the current cell is A5 and that it
contains a formula)
A 1 Text (Cell A1 contains text)
A 2 Numeric (Cell A2 contains a number and no cell references)
.PA
Summary of MicroCalc
Cells are denoted A1 through G21 giving a total of 147 cells.
Summary of standard functions and operators:
ABS, SQRT, SQR, SIN, COS, ARCTAN, LN, LOG, EXP, FACT
+,-,*,/, ^ to raise to any power e.g. 2^3 = 8
Futhermore the operator '>' can be used to denote a range of cells to add.
Entering data
To enter data in any field move the cursor to the cell and enter the
data. MicroCalc automatically determines if the field is numeric or a
a text field.
When moving between fields:
^S,^D,^E,^X move left right up and down.
When editing a field
^S,^D moves left and right. ^A,^F moves to beginning/end of line.
DEL,^G deletes left or right character.
^V (or Ins on the PC) changes between insert-/overwrite mode.
ESC makes it possible to regret changes and to edit an existing cell.
.PA
Summary of commands
/ will restore the screen
Q will Quit MicroCalc
L will Load a spread sheet from the disk.
S will Save a spread sheet on the disk.
R will Recalculate
P will Print the spread sheet.
F makes it possible to change the output format for numbers.
A switches Autocalc ON and OFF
Note: to use scientific notation use the the F command and enter minus one
-1 for the number of decimals.
.PA
EXAMPLES
The following are examples of valid cell formulas:
(A1+(B2-C7)) subtract cell C7 from B2 and add the result to cell A1
(A1>A23) the sum of cells: A1,A2,A3..A23
(A1>B5) the sum of cells: A1..A5 and B1..B5
The formulas may be as complicated as you want: 
(SIN(A1)*COS(A2)/((1.2*A8)+LN(FACT(A8)+8.9E-3))+(C1>C5))
To edit an existing formula or text simply move to the cell and
press ESC, make your changes and press <RETURN>. If you make
a mistake you may press ESC again, the old value of the cell will
then be restored.
--> To try MicroCalc now use the /L command to <--
--> load the file: CALCDEMO. <--


File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -0,0 +1,28 @@
{ Compile this file if you get the error message: "Compiler overflow"
when compiling the file CALC.PAS.
When developing programs it is a good idea to split the program into
several include files, and then have a small main file containing the
global variables and Include directives for the different source code
modules.You may want to spit the file CALC.PAS into such modules.
If you want to edit the file CALC.PAS then select it as Work file using
the W command.
The calc demo prorgam CALC.PAS is now included:
}
{$ICALC.PAS}
{ If you have more than 128K RAM it is possible to have the following in
RAM at the same time:
Compiler and Editor
CALC.PAS
Object code generated for CALC.PAS
Data area for CALC.PAS
}


View File

@ -0,0 +1,27 @@
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
procedure get_time( var tt : timetype );
var
recpack: regpack;
ah,al,ch,cl,dh: byte;
begin
ah := $2c;
with recpack do
begin
ax := ah shl 8 + al;
end;
intr( $21, recpack );
with recpack do
begin
tt.h := cx shr 8;
tt.m := cx mod 256;
tt.s := dx shr 8;
tt.l := dx mod 256;
end;
end;

View File

@ -0,0 +1,10 @@
program dt;
var
h, m, s, s100: word;
begin
GetTime( h, m, s, s100 );
Write( 'time: ' );
Write( h, ':', m, s, s100 );
end.

View File

@ -0,0 +1,10 @@
program dt;
var
h, m, s, s100: word;
begin
GetTime( h, m, s, s100 );
Write( 'time: ' );
Write( h, ':', m, s, s100 );
end.

View File

@ -0,0 +1,42 @@
program e;
const
DIGITS = 200;
type
arrayType = array[ 0..DIGITS ] of integer;
var
high, n, x : integer;
a : arrayType;
begin
high := DIGITS;
x := 0;
n := high - 1;
while n > 0 do begin
a[ n ] := 1;
n := n - 1;
end;
a[ 1 ] := 2;
a[ 0 ] := 0;
while high > 9 do begin
high := high - 1;
n := high;
while 0 <> n do begin
a[ n ] := x MOD n;
x := 10 * a[ n - 1 ] + x DIV n;
n := n - 1;
end;
Write( x );
end;
writeln;
writeln( 'done' );
end.


View File

@ -0,0 +1,307 @@
{.HE}
{.L-}
*****************************************************************
* *
* Print this document in the following way: *
* *
* 1. Exit Turbo Pascal *
* 2. Activate the TLIST program *
* 3. Answer ERROR.DOC and press <RETURN> *
* 4. Press <RETURN> to question about Options. *
* *
* *
* If you want to change the left margin use the directive: *
* PO (Page Offset E.g. PO8) (the dot must be in column one). *
* *
* You may also use the PL directive to set Page Length *
* *
*****************************************************************
{.L+}
{.PO8}
{.PL66}
Addendum to TURBO REFERENCE MANUAL
IBM-PC Version
November 1983
(C) Copyright 1983 Borland International Inc.
{.HEAddendum to the TURBO Pascal Reference Manual page: # \First printing November 1983 }
{.PA}
-----------------------------------------------------------------
GET STARTED RIGHT NOW
-----------------------------------------------------------------
1. Make a copy of the distribution disk to a fresh system disk.
2. Start TURBO. Press Y for Yes. (Include error messages)
If you have 128K RAM or less do the following:
3. Press M for Main file
4. Answer: CALCMAIN and press RETURN
5. Press R for Run
If you have more than 128K RAM do the following:
3. Press R for Run
4. Answer: CALC and press RETURN
The compiler will now compile the file CALC.PAS. The object code
is placed directly in memory for immediate execution.
To make a COM file do the following:
1. select O for Options
2. Press C for Com file
3. Press Q to Quit the Options menu
4. Now press C for Compile.
{.PA}
-----------------------------------------------------------------
FILES ON THE DISTRIBUTION DISK
-----------------------------------------------------------------
----------------------------------------------------------------
! THE FILE YOU MUST HAVE TO DEVELOP AND COMPILE PROGRAMS !
----------------------------------------------------------------
! TURBO.COM Compiler and Editor !
----------------------------------------------------------------
----------------------------------------------------------------
! OPTIONAL FILES WHEN DEVELOPING PROGRAMS !
----------------------------------------------------------------
! TURBOMSG.OVR Error messages (You may omit this file) !
! TLIST.COM Program lister (You may omit this file) !
----------------------------------------------------------------
----------------------------------------------------------------
! FILES YOU ONLY NEED WHEN YOU INSTALL TURBO !
----------------------------------------------------------------
! TINST.COM Installation program !
! TINSTMSG.OVR Message file for TINST !
---------------------------------------------------------------
You only need these files if you want to modify the editor com-
mands or, if for any reason, you do not want TURBO to select the
default display on your PC.
-----------------------------------------------------------------
! FILES WITH DEMONSTRATION PROGRAMS !
-----------------------------------------------------------------
! CALCMAIN.PAS Root demo program demonstating include!
! CALC.PAS MicroCalc (spread sheet demo program) !
! CALC.HLP On-line manual for MicroCalc !
! CALCDEMO.MCS Example spread sheet definition !
-----------------------------------------------------------------
{.PA}
-----------------------------------------------------------------
INSTALLATION
-----------------------------------------------------------------
First of all, INSTALLATION IS USUALLY NOT NECESSARY. When you
start TURBO, the default display mode will automatically be
selected. This depends on ther type of board in your PC
(monochrome, color, or b/w graphics).
You may, however, use TINST to force TURBO to use another display
mode, provided, of course, that the relevant hardware is installed.
Invoke TINST and select Screen installation. Instead of the
screen selection menu shown on page 229, you will have the
following menu:
-----------------------------------------------------------------
0) Default display mode
1) Monochrome display
2) Color display 80x25
3) Color display 40x25
4) B/w display 80x25
5) B/w display 40x25
Which display? (Enter no. or ^X to exit)
-----------------------------------------------------------------
You may now select the desired display mode which will then be
used when you invoke TURBO.
{.PA}
----------------------------------------------------------------
CORRECTIONS TO THE MANUAL:
----------------------------------------------------------------
PAGE 66
Examples of string comparisons:
'A' < 'B' is TRUE
'A' > 'b' is FALSE
PAGE 126
The Init procedure should be CRTinit, and the Exit procedure
should be CRTexit.
PAGE 213
The X compiler directive is valid for the CP/M-80 implementation
only.
PAGE 193 / 197
The parameter for function calls should be defined as follows:
RegPack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: Integer;
end;
{.PA}
---------------------------------------------------------------
MURPHY DELETED THE FOLLOWING FROM THE MANUAL:
---------------------------------------------------------------
Procedure Halt;
This procedure will stop execution of the Turbo pascal program
and return to the point where the program was activated .
Function UpCase(Ch: Char): Char;
This function returns the uppercase equivalent of the parameter
Ch. Example: if C1 has the value 'a' then UpCase(C1) has the
value 'A'.
Function Chr(I: IExpr): Char;
This function returns the character with the ASCII value I.
Example: Chr(65) has the value 'A'.
Procedure Intr(InterruptNumber: IConstant; var Result: RecPack);
This procedure initializes the registers and flags as specified
in the parameter "RecPack" and then makes a software interrupt
corresponding to the parameter "InterruptNumber" which must be a
constant. When the interrupt service routine returns control to
your program "RegPack" will contain any returned values form the
service routine.
{.PA}
-----------------------------------------------------------------
LIST OF COMMON QUESTIONS AND ANSWERS
-----------------------------------------------------------------
Q: How do I use the system?
A: Please read the manual.
Q: Is TURBO an interpreter like UCSD?
A: No, it generates ultra-fast machine code.
Q: Do I need TURBO to run programs developed in TURBO pascal?
A: No make a .COM or .CMD file.
Q: How many lines of code can the compiler handle.
A: No limit (The object code however cannot excede 64 KB)
Q: How many significant digits does TURBO support in floating
point?
A: 11.
Q: Why do I get garbage on the screen when starting the TURBO
editor.
A: You have not installed TURBO for your system.
Q: What do I do when I run out of space using the editor?
A: Split your source code (see manual $I directive.)
Q: What do I do when I run out of space while compiling?
A: Use the $I directive and/or generate a .COM or .CMD file.
Q: How do I make a .COM or .CMD file?
A: Type O from the main menu then type C.
Q: What do I do when the compiler generates too much code?
A: Read the appendicies about compiler switches and .CHN files.
{.PA}
----------------------------------------------------------------
A special note to IBM-PC users:
----------------------------------------------------------------
Notice that TURBO makes it easy to do cursor addressing, delete
line, insert line etc. through built in procedures.
We have also made it easier for you to use the editing and
function keys in your programs:
--------------------------------------------------------
Edit Key Returns Function Key Returns
--------------------------------------------------------
Home <ESC> G F1 <ESC> ;
Arrow Up <ESC> H F2 <ESC> <
PgUp <ESC> I F3 <ESC> =
Arrow Left <ESC> K F4 <ESC> >
Arrow Right <ESC> M F5 <ESC> ?
End <ESC> O F6 <ESC> @
Arrow Down <ESC> P F7 <ESC> A
PgDn <ESC> Q F8 <ESC> B
Ins <ESC> R F9 <ESC> C
Del <ESC> S F10 <ESC> D
--------------------------------------------------------


View File

@ -0,0 +1,51 @@
program tf;
procedure phi;
var
prev2, prev1, i, next : integer;
v : real;
begin
writeln( 'should tend towards 1.618033988749...' );
prev1 := 1;
prev2 := 1;
for i := 1 to 21 do begin { integer overflow beyond this }
next := prev1 + prev2;
prev2 := prev1;
prev1 := next;
v := prev1 / prev2;
writeln( ' at ', i, ' iterations: ', v );
end;
end;
var
r, a, b, c : real;
i, x : integer;
begin { tf }
a := 1.1;
b := 2.2;
c := 3.3;
for i := 1 to 10 do begin
a := b * c;
b := a * c;
r := arctan( a );
r := cos( a );
{ r := exp( a ); }
r := frac( a );
if a <= 32727.0 then r := int( a );
r := ln( a );
r := sin( a );
r := sqr( a );
r := sqrt( a );
if a <= 32767.0 then x := round( a );
if a <= 32767.0 then x := trunc( a );
end;
writeln;
writeln( 'a, b, c: ', a, b, c );
phi;
end. { tf }


View File

@ -0,0 +1,47 @@
{* WARNING WARNING WARNING WARNING WARNING WARNING WARNING
In order to use the Intr procedure in Turbo Pascal you
must be familiar with interrupts and have access to a
technical reference manual.
The following program uses the Intr function in Turbo to
get the time. Registers have to be set correctly according
to the DOS technical reference manual before the function
is called.
The program simply returns the time in a string at the top
of the screen.*}
program TimeInterrupt;
type
TimeString = string[8];
function time: TimeString;
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
var
recpack: regpack; {assign record}
ah,al,ch,cl,dh: byte;
hour,min,sec: string[2];
begin
ah := $2c; {initialize correct registers}
with recpack do
begin
ax := ah shl 8 + al;
end;
intr($21,recpack); {call interrupt}
with recpack do
begin
str(cx shr 8,hour); {convert to string}
str(cx mod 256,min); { " }
str(dx shr 8,sec); { " }
end;
time := hour+':'+min+':'+sec;
end;
begin
writeln(time);
end.

View File

@ -0,0 +1,81 @@
{ BYTE magazine October 1982. Jerry Pournelle. }
{ various bugs not found because dimensions are square fixed by David Lee }
{ expected result: 4.65880E+05 }
{ array range checking off }
{$R- }
{ runtime exception checking off }
{$X- }
program matrix( output );
const
l = 20; { rows in A and resulting matrix C }
m = 20; { columns in A and rows in B (must be identical) }
n = 20; { columns in B and resulting matrix C }
var
A : array [ 1 .. l, 1 .. m ] of real; { [row,col] }
B : array [ 1 .. m, 1 .. n ] of real;
C : array [ 1 .. l, 1 .. n ] of real;
Summ: real;
procedure filla;
var
i, j : integer;
begin { filla }
for i := 1 to l do
for j := 1 to m do
A[ i, j ] := i + j;
end; { filla }
procedure fillb;
var
i, j : integer;
begin { fillb }
for i := 1 to m do
for j := 1 to n do
B[ i, j ] := trunc( ( i + j ) / j );
end; { fillb }
procedure fillc;
var
i, j : integer;
begin { fillc }
for i := 1 to l do
for j := 1 to n do
C[ i, j ] := 0;
end; { fillc }
procedure matmult;
var
i, j, k : integer;
begin { matmult }
for i := 1 to l do
for j := 1 to n do
for k := 1 to m do
C[ i, j ] := C[ i, j ] + A[ i, k ] * B[ k, j ];
end; { matmult }
procedure summit;
var
i, j : integer;
begin { summit }
for i := 1 to l do
for j := 1 to n do
Summ := Summ + C[ i, j ];
end; { summit }
begin { matrix }
Summ := 0;
filla;
fillb;
fillc;
matmult;
summit;
Writeln( 'summ is :', Summ );
end. { matrix }

View File

@ -0,0 +1,29 @@
program outchar;
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
procedure oc( var c : char );
var
recpack: regpack;
ah,al,ch,cl,dh: byte;
begin
ah := $8;
with recpack do
begin
ax := ah shl 8 + al;
dh := 87; {c;}
end;
intr( $21, recpack );
end;
var c : char;
begin { outchar }
c := 'W';
oc( c );
end. { outchar }


Binary file not shown.

View File

@ -0,0 +1,29 @@
program outchar;
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
procedure oc( var c : char );
var
recpack: regpack;
ah,al,ch,cl,dh: byte;
begin
ah := $8;
with recpack do
begin
ax := ah shl 8 + al;
dx := ord( c );
end;
intr( $21, recpack );
end;
var c : char;
begin { outchar }
c := 'W';
oc( c );
end. { outchar }


View File

@ -0,0 +1,31 @@
program sieve;
const
size = 8190;
type
flagType = array[ 0..size ] of boolean;
var
i, k, prime, count, iter : integer;
flags : flagType;
begin
for iter := 1 to 10 do begin
count := 0;
for i := 0 to size do flags[ i ] := true;
for i := 0 to size do begin
if flags[ i ] then begin
prime := i + i + 3;
k := i + prime;
while k <= size do begin
flags[ k ] := false;
k := k + prime;
end;
count := count + 1;
end;
end;
end;
writeln( 'count of primes: ', count );
end.

View File

@ -0,0 +1,80 @@
program tap;
function gcd( m : integer; n : integer ) : integer;
var
a, b, r : integer;
begin { gcd }
a := 0;
if ( m > n ) then begin
b := m;
r := n;
end
else begin
b := n;
r := m;
end;
while ( 0 <> r ) do begin
a := b;
b := r;
r := a MOD b;
end;
gcd := b;
end; { gcd }
procedure first_implementation;
var
total, i, prev : integer;
sofar, ri, iq : real;
begin
total := 10000;
sofar := 0.0;
prev := 1;
for i := 1 to total do begin
ri := i;
iq := ri * ri * ri;
sofar := sofar + ( 1.0 / iq );
if ( i = ( prev * 10 ) ) then begin
prev := i;
writeln( ' at ', i, ' iterations: ', sofar );
end;
end;
end;
var
loops, i, rsf, prev, total, greatest, a, b, c : integer;
v, ri, rtotal : real;
begin { tap }
writeln( 'tap starting, should tend towards 1.2020569031595942854...' );
writeln( 'first implementation...' );
first_implementation;
writeln( 'second implementation...' );
loops := 10000;
total := 0;
prev := 1;
for i := 1 to loops do begin
a := Random( 32767 );
b := Random( 32767 );
c := Random( 32767 );
greatest := gcd( a, gcd( b, c ) );
if ( 1 = greatest ) then total := total + 1;
if ( i = ( prev * 10 ) ) then begin
prev := i;
rtotal := total;
ri := i;
v := ri / rtotal;
writeln( ' at ', i, ' iterations: ', v );
end;
end;
writeln( 'tap completed with great success' );
end. { tap }


View File

@ -0,0 +1,105 @@
program TimeDifference;
type
timetype = record h, m, s, l : integer; end;
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
var
ta, tb, tdiff: timetype;
i, j, x: integer;
sh, sm, ss, sl: string[2];
procedure time_difference( var tStart, tEnd, tDiff : timetype );
begin
if ( tEnd.l >= tStart.l ) then
tDiff.l := tEnd.l - tStart.l
else
begin
tDiff.l := 100 + tEnd.l - tStart.l;
tStart.s := tStart.s + 1;
end;
if ( tEnd.s >= tStart.s ) then
tDiff.s := tEnd.s - tStart.s
else
begin
tDiff.s := 60 + tEnd.s - tStart.s;
tStart.m := tStart.m + 1;
end;
if ( tend.m >= tStart.m ) then
tDiff.m := tEnd.m - tStart.m
else
begin
tDiff.m := 60 + tEnd.m - tStart.m;
tStart.h := tStart.h + 1;
end;
if ( tEnd.h >= tStart.h ) then
tDiff.h := tEnd.h - tStart.h
else
tDiff.h := 12 - tEnd.h - tStart.h;
end;
procedure get_time( var tt : timetype );
var
recpack: regpack; {assign record}
ah,al,ch,cl,dh: byte;
begin
ah := $2c; {initialize correct registers}
with recpack do
begin
ax := ah shl 8 + al;
end;
intr($21,recpack); {call interrupt}
with recpack do
begin
tt.h := cx shr 8;
tt.m := cx mod 256;
tt.s := dx shr 8;
tt.l := dx mod 256;
end;
end;
procedure print_time( var t: timetype );
var sval : string[2];
begin
if ( t.h < 10 ) then write( '0' );
write( t.h, ':' );
if ( t.m < 10 ) then write( '0' );
write( t.m, ':' );
if ( t.s < 10 ) then write( '0' );
write( t.s, '.' );
if ( t.l < 10 ) then write( '0' );
write( t.l );
end;
begin
get_time( ta );
write( 'start time: ' );
print_time( ta );
writeln;
for j := 1 to 300 do
for i := 1 to 30000 do
x := i * 4 * 4 + x;
get_time( tb );
write( 'end time: ' );
print_time( tb );
writeln;
time_difference( ta, tb, tdiff );
write( 'difference: ' );
print_time( tdiff );
writeln;
writeln( 'done' );
end.


Binary file not shown.

View File

@ -0,0 +1,31 @@
program TimeDifference;
{$I timeutil.pas}
var
ta, tb, tdiff: timetype;
i, j, x: integer;
begin
get_time( ta );
write( 'start time: ' );
print_time( ta );
writeln;
for j := 1 to 3000 do
for i := 1 to 30000 do
x := i * 4 * 4 + x;
get_time( tb );
write( 'end time: ' );
print_time( tb );
writeln;
time_difference( ta, tb, tdiff );
write( 'elapsed time: ' );
print_time( tdiff );
writeln;
writeln( 'done' );
end.

View File

@ -0,0 +1,65 @@
type
timetype = record h, m, s, l : integer; end;
procedure time_difference( var tStart, tEnd, tDiff : timetype );
var
startSecond, startMinute, startHour : integer;
begin { time_difference }
startSecond := tStart.s;
startMinute := tStart.m;
startHour := tStart.h;
tDiff.l := tEnd.l - tStart.l;
if ( tDiff.l < 0 ) then
begin
tDiff.l := tDiff.l + 100;
startSecond := startSecond + 1;
end;
tDiff.s := tEnd.s - startSecond;
if ( tDiff.s < 0 ) then
begin
tDiff.s := tDiff.s + 60;
startMinute := startMinute + 1;
end;
tDiff.m := tEnd.m - startMinute;
if ( tDiff.m < 0 ) then
begin
tDiff.m := tDiff.m + 60;
startHour := startHour + 1;
end;
tDiff.h := tEnd.h - startHour;
if ( tDiff.h < 0 ) then
tDiff.h := tDiff.h + 12;
end;
procedure print_time_part( num : integer );
begin
if ( num < 10 ) then write( '0' );
write( num );
end;
procedure print_time( var t: timetype );
begin
print_time_part( t.h );
write( ':' );
print_time_part( t.m );
write( ':' );
print_time_part( t.s );
write( '.' );
print_time_part( t.l );
end;
procedure print_elapsed_time( var timeStart, timeEnd: timetype );
var
timeDiff: timetype;
begin
time_difference( timeStart, timeEnd, timeDiff );
write( 'elapsed time: ' );
print_time( timeDiff );
writeln;
end;


Binary file not shown.

View File

@ -0,0 +1,65 @@
1 TURBO Pascal installation menu.
2 Choose installation item from the following:
3 [S]creen installation | [C]ommand installation | e[X]it
4 Enter S, C, or X:
10 Duplicate definition. Error occurred between question
11 Commands starting with the same letter must have the same length.
Error occurred between question
12 The total maximum length of commands are execeeded
13 ->
14 CURSOR MOVEMENTS:
20 Character left
21 Alternative
22 Character right
23 Word left
24 Word right
25 Line up
26 Line down
27 Page up
28 Page down
29 To top of file
30 To end of file
31 To left on line
32 To right on line
33 To last position
15 INSERT & DELETE:
34 Insert mode on/off
35 Insert line
36 Delete line
37 Delete to end of line
38 Delete right word
39 Delete character under cursor
40 Delete left character
41 Alternative
16 BLOCK COMMANDS:
42 Begin block
43 End block
44 Mark single word
45 Copy block
46 Move block
47 Delete block
48 Read block from file
49 Write block to file
17 MISC. EDITING COMMANDS:
50 End edit
51 Tab
52 Auto tab on/off
53 Restore line
54 Find
55 Find & replace
56 Repeat last find
57 Control character prefix
101 Nothing
200 Choose one of the following displays
201 Which display? (Enter no. or ^X to exit):


Binary file not shown.

View File

@ -0,0 +1,288 @@
{ App to prove you can't win at Tic-Tac-Toe }
program ttt;
{$I timeutil.pas}
{$I dos_gt.pas }
const
scoreWin = 6;
scoreTie = 5;
scoreLose = 4;
scoreMax = 9;
scoreMin = 2;
scoreInvalid = 0;
pieceBlank = 0;
pieceX = 1;
pieceO = 2;
iterations = 1;
type
boardType = array[ 0..8 ] of integer;
CommandString = string[127];
var
evaluated: integer;
board: boardType;
timeStart, timeEnd: timetype;
procedure dumpBoard;
var
i : integer;
begin
Write( '{' );
for i := 0 to 8 do
Write( board[i] );
Write( '}' );
end;
function lookForWinner : integer;
var
t, p : integer;
begin
{dumpBoard;}
p := pieceBlank;
t := board[ 0 ];
if pieceBlank <> t then
begin
if ( ( ( t = board[1] ) and ( t = board[2] ) ) or
( ( t = board[3] ) and ( t = board[6] ) ) ) then
p := t;
end;
if pieceBlank = p then
begin
t := board[1];
if ( t = board[4] ) and ( t = board[7] ) then
p := t
else
begin
t := board[2];
if ( t = board[5] ) and ( t = board[8] ) then
p := t
else
begin
t := board[3];
if ( t = board[4] ) and ( t = board[5] ) then
p := t
else
begin
t := board[6];
if ( t = board[7] ) and ( t = board[8] ) then
p := t
else
begin
t := board[4];
if ( ( ( t = board[0] ) and ( t = board[8] ) ) or
( ( t = board[2] ) and ( t = board[6] ) ) ) then
p := t
end;
end;
end;
end;
end;
lookForWinner := p;
end;
function winner2( move: integer ) : integer;
var
x : integer;
begin
case move of
0: begin
x := board[ 0 ];
if not ( ( ( x = board[1] ) and ( x = board[2] ) ) or
( ( x = board[3] ) and ( x = board[6] ) ) or
( ( x = board[4] ) and ( x = board[8] ) ) )
then x := PieceBlank;
end;
1: begin
x := board[ 1 ];
if not ( ( ( x = board[0] ) and ( x = board[2] ) ) or
( ( x = board[4] ) and ( x = board[7] ) ) )
then x := PieceBlank;
end;
2: begin
x := board[ 2 ];
if not ( ( ( x = board[0] ) and ( x = board[1] ) ) or
( ( x = board[5] ) and ( x = board[8] ) ) or
( ( x = board[4] ) and ( x = board[6] ) ) )
then x := PieceBlank;
end;
3: begin
x := board[ 3 ];
if not ( ( ( x = board[4] ) and ( x = board[5] ) ) or
( ( x = board[0] ) and ( x = board[6] ) ) )
then x := PieceBlank;
end;
4: begin
x := board[ 4 ];
if not ( ( ( x = board[0] ) and ( x = board[8] ) ) or
( ( x = board[2] ) and ( x = board[6] ) ) or
( ( x = board[1] ) and ( x = board[7] ) ) or
( ( x = board[3] ) and ( x = board[5] ) ) )
then x := PieceBlank;
end;
5: begin
x := board[ 5 ];
if not ( ( ( x = board[3] ) and ( x = board[4] ) ) or
( ( x = board[2] ) and ( x = board[8] ) ) )
then x := PieceBlank;
end;
6: begin
x := board[ 6 ];
if not ( ( ( x = board[7] ) and ( x = board[8] ) ) or
( ( x = board[0] ) and ( x = board[3] ) ) or
( ( x = board[4] ) and ( x = board[2] ) ) )
then x := PieceBlank;
end;
7: begin
x := board[ 7 ];
if not ( ( ( x = board[6] ) and ( x = board[8] ) ) or
( ( x = board[1] ) and ( x = board[4] ) ) )
then x := PieceBlank;
end;
8: begin
x := board[ 8 ];
if not ( ( ( x = board[6] ) and ( x = board[7] ) ) or
( ( x = board[2] ) and ( x = board[5] ) ) or
( ( x = board[0] ) and ( x = board[4] ) ) )
then x := PieceBlank;
end;
end;
winner2 := x;
end;
function minmax( alpha: integer; beta: integer; depth: integer; move: integer ): integer;
var
p, value, pieceMove, score : integer;
begin
evaluated := evaluated + 1;
value := scoreInvalid;
if depth >= 4 then
begin
{ p := lookForWinner; } { this is much slower }
p := winner2( move );
if p <> pieceBlank then
begin
if p = pieceX then
value := scoreWin
else
value := scoreLose
end
else if depth = 8 then
value := scoreTie;
end;
if value = scoreInvalid then
begin
if Odd( depth ) then
begin
value := scoreMin;
pieceMove := pieceX;
end
else
begin
value := scoreMax;
pieceMove := pieceO;
end;
p := 0;
repeat
if board[ p ] = pieceBlank then
begin
board[ p ] := pieceMove;
score := minmax( alpha, beta, depth + 1, p );
board[ p ] := pieceBlank;
if Odd( depth ) then
begin
if ( score > value ) then
begin
value := score;
if ( value = scoreWin ) or ( value >= beta ) then p := 10
else if ( value > alpha ) then alpha := value;
end;
end
else
begin
if ( score < value ) then
begin
value := score;
if ( value = scoreLose ) or ( value <= alpha ) then p := 10
else if ( value < beta ) then beta := value;
end;
end;
end;
p := p + 1;
until p > 8;
end;
minmax := value;
end;
procedure runit( move : integer );
var
score: integer;
begin
board[move] := pieceX;
score := minmax( scoreMin, scoreMax, 0, move );
board[move] := pieceBlank;
end;
function Trim( intext : CommandString ): CommandString;
var FirstPos, LastPos: integer;
begin
FirstPos := 1;
while ( FirstPos <= Length( intext ) ) and ( intext[FirstPos] = #32 ) do
FirstPos := FirstPos + 1;
LastPos := Length( intext );
while ( LastPos >= 1 ) and ( intext[LastPos] = #32 ) do
LastPos := LastPos - 1;
Trim := Copy( intext, FirstPos, LastPos - FirstPos + 1 );
end;
var
i, loops, errpos: integer;
strArg : CommandString;
cmdTail : CommandString absolute Cseg : $80;
begin
loops := Iterations;
{ not available on TP v1
if 0 <> Length( ParamStr( 1 ) ) then Val( ParamStr( 1 ), loops, errpos );
}
if Length( cmdTail ) > 0 then
begin
{ trim the space at the start that's always there }
strArg := Trim( cmdTail );
Val( strArg, loops, errpos );
end;
for i := 0 to 8 do
board[i] := pieceBlank;
WriteLn( 'begin' );
get_time( timeStart );
for i := 1 to loops do
begin
evaluated := 0; { once per loop to prevent overflow }
runit( 0 );
runit( 1 );
runit( 4 );
end;
get_time( timeEnd );
print_elapsed_time( timeStart, timeEnd );
WriteLn( 'moves evaluated: ', evaluated );
WriteLn( 'iterations: ', loops );
end.


View File

@ -0,0 +1,113 @@
type
timetype = record h, m, s, l : integer; end;
regpac = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
tustr = string[30];
procedure time_difference( var tStart, tEnd, tDiff : timetype );
var
startSecond, startMinute, startHour : integer;
begin { time_difference }
startSecond := tStart.s;
startMinute := tStart.m;
startHour := tStart.h;
tDiff.l := tEnd.l - tStart.l;
if ( tDiff.l < 0 ) then
begin
tDiff.l := tDiff.l + 100;
startSecond := startSecond + 1;
end;
tDiff.s := tEnd.s - startSecond;
if ( tDiff.s < 0 ) then
begin
tDiff.s := tDiff.s + 60;
startMinute := startMinute + 1;
end;
tDiff.m := tEnd.m - startMinute;
if ( tDiff.m < 0 ) then
begin
tDiff.m := tDiff.m + 60;
startHour := startHour + 1;
end;
tDiff.h := tEnd.h - startHour;
if ( tDiff.h < 0 ) then
tDiff.h := tDiff.h + 12;
end;
procedure oc( var c : char );
var
recpack: regpac;
ah,al,ch,cl,dh: byte;
begin
ah := $8;
with recpack do
begin
ax := ah shl 8 + al;
dx := ord( c );
end;
intr( $21, recpack );
end;
procedure ostr( var s: tustr );
var
i, l : integer;
begin { ostr }
l := Length( s );
for i := 1 to l do begin
oc( s[ i ] );
end;
end;
procedure onum( var n: integer );
var
s : tustr;
begin { onum }
Str( n, s );
ostr( s );
end;
procedure print_time_part( num : integer );
var c : char;
begin
c := '0';
if ( num < 10 ) then oc( c );
onum( num );
end;
procedure print_time( var t: timetype );
var c : char;
begin
print_time_part( t.h );
c := ':';
oc( c );
print_time_part( t.m );
oc( c );
print_time_part( t.s );
c := '.';
oc( c );
print_time_part( t.l );
end;
procedure print_elapsed_time( var timeStart, timeEnd: timetype );
var
timeDiff: timetype;
s : tustr;
c : char;
begin
time_difference( timeStart, timeEnd, timeDiff );
s := 'elapsed time: ';
ostr( s );
print_time( timeDiff );
c := Chr( 10 );
oc( c );
c := Char( 13 );
oc( c );
end;


Binary file not shown.

View File

@ -0,0 +1,99 @@
 are not allowed
 can not be
 constant
 does not
 expression
 identifier
 file
 here
Integer
File
Illegal
 or
Undefined
 match
 real
String
Textfile
 out of range
 variable
 overflow
 expected
 type
Invalid
 pointer
01';'
02':'
03','
04'('
05')'
06'='
07':='
08'['
09']'
10'.'
11'..'
12BEGIN
13DO
14END
15OF
17THEN
18TO DOWNTO
20Boolean
21 
22 
23 
24 
25 
26 
27 
28Pointer
29Record
30Simple
31Simple
32
33
34
35
36Type
37Untyped
40 label
41Unknown syntax error
42 in preceding definitions
43Duplicate label
44Type mismatch
45
46 and CASE selector
47Operand(s) operator
48 result
49  length
50 length
51 subrange base
52Lower bound > upper bound
53Reserved word
54 assignment
55 exceeds line
56Error in integer
57Error in
58 character in
60s
61 s ands
62Structureds
63s
64s and untypeds
65Untypeds
66I/O
67 s must be parameters
68 componentss
69dering of fields
70Set base
71 GOTO
72Label not within current block
73 FORWARD procedure(s)
74INLINE error
75 use of ABSOLUTE
90 not found
91Unexpected end of source
97Too many nested WITH's
98Memory
99Compiler

File diff suppressed because one or more lines are too long