OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Turbo Pascal v2 + cleanup

Browse Source
This commit is contained in:
davidly 2024-06-30 15:28:49 -07:00
parent 0aa762a607
commit 2c74a13660
26 changed files with 2790 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Borland Turbo Pascal v1/DT.BAK
View File

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

105
Borland Turbo Pascal v1/TIMEDIFF.BAK
View File

@ -1,105 +0,0 @@
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.


3
Borland Turbo Pascal v1/m.bat Normal file
View File

@ -0,0 +1,3 @@
rem there are no command-line tools for turbo pascal. Run the app and compile from within.

153
Borland Turbo Pascal v2/ART.PAS Normal file
View File

@ -0,0 +1,153 @@
const
Memory = 150;
var
Line: array [1..Memory] of record
LX1,LY1: integer;
LX2,LY2: integer;
LColor: integer;
end;
X1,X2,Y1,Y2,
CurrentLine,
ColorCount,
IncrementCount,
DeltaX1,DeltaY1,DeltaX2,DeltaY2,
I,Color: integer;
Ch: char;
procedure Check;
var
Ch: char;
begin
writeln('This program will only work if you have the color graphics adapter installed');
write('Continue Y/N ');
repeat read (Kbd,Ch) until Upcase(Ch) in ['Y','N'];
if Upcase(Ch)='N' then Halt;
end;
procedure Init;
begin
for I:=1 to Memory do
with Line[I] do
begin
LX1:=0; LX2:=0;
LY1:=0; LY2:=0;
end;
X1:=0; Y1:=0; X2:=0; Y2:=0;
CurrentLine:=1;
ColorCount:=0;
IncrementCount:=0;
Ch:=' ';
end;
procedure AdjustX(var X,DeltaX: integer);
var
TestX: integer;
begin
TestX:=X+DeltaX;
if (TestX<1) or (TestX>320) then
begin
TestX:=X;
DeltaX:=-DeltaX;
end;
X:=TestX;
end;
procedure AdjustY(var Y,DeltaY: integer);
var
TestY: integer;
begin
TestY:=Y+DeltaY;
if (TestY<1) or (TestY>190) then
begin
TestY:=Y;
DeltaY:=-DeltaY;
end;
Y:=TestY;
end;
procedure SelectNewColor;
begin
Color:=Random(3)+1;
ColorCount:=5*(1+Random(10));
end;
procedure SelectNewDeltaValues;
begin
DeltaX1:=Random(7)-3;
DeltaX2:=Random(7)-3;
DeltaY1:=Random(7)-3;
DeltaY2:=Random(7)-3;
IncrementCount:=4*(1+Random(9));
end;
procedure SaveCurrentLine;
begin
with Line[CurrentLine] do
begin
LX1:=X1;
LY1:=Y1;
LX2:=X2;
LY2:=Y2;
LColor:=Color;
end;
end;
procedure Regenerate;
var
I: integer;
begin
NoSound;
GraphColorMode; Palette(2);
for I:=1 to Memory do with Line[I] do Draw(LX1,LY1,LX2,LY2,LColor);
gotoxy(1,25);
write('Press any key to continue, ESC to stop');
read(Kbd,Ch);
end;
begin
Check;
Init;
GraphColorMode;
Palette(2);
Color:=2;
gotoxy(1,25);
write('Press any key to regenerate, ESC to stop');
repeat
with Line[CurrentLine] do Draw(LX1,LY1,LX2,LY2,0);
if ColorCount=0 then SelectNewColor;
if IncrementCount=0 then SelectNewDeltaValues;
AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);
Draw(X1,Y1,X2,Y2,Color);
SaveCurrentLine;
CurrentLine:=Succ(CurrentLine);
if CurrentLine>Memory then CurrentLine:=1;
ColorCount:=Pred(ColorCount); IncrementCount:=Pred(IncrementCount);
if KeyPressed then
begin
read(Kbd,Ch);
if Ch<>#27 then
begin
Regenerate;
gotoxy(1,25);
write('Press any key to regenerate, ESC to stop');
end;
end;
until Ch=#27;
TextMode;
end.


144
Borland Turbo Pascal v2/CALC.HLP Normal file
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. <--


1259
Borland Turbo Pascal v2/CALC.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
Borland Turbo Pascal v2/CALCDEMO.MCS Normal file
View File

Binary file not shown.

28
Borland Turbo Pascal v2/CALCMAIN.PAS Normal file
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
}


133
Borland Turbo Pascal v2/COLOR.PAS Normal file
View File

@ -0,0 +1,133 @@
program ColorDemo;
type
AnyString = string[40];
procedure Check;
var
Ch: char;
begin
writeln('This program will only work if you have the color graphics adapter installed');
write('Continue Y/N ');
repeat read (Kbd,Ch) until Upcase(Ch) in ['Y','N'];
if Upcase(Ch)='N' then Halt;
end;
procedure PaletteDemo;
var
Ch: Char;
PaletteNumber, Background: integer;
PaletteChange: boolean;
procedure DrawBoxes;
var
Y: integer;
begin
for Y:=1 to 24 do Draw(10,10*8+Y,320,10*8+Y,1);
for Y:=1 to 24 do Draw(10,13*8+Y,320,13*8+Y,2);
for Y:=1 to 24 do Draw(10,16*8+Y,320,16*8+Y,3);
end {DrawBoxes};
procedure Msg(X,Y: integer; S: AnyString);
{ write the string S at X,Y }
begin
GotoXY(X,Y);
Write(S);
end {Msg};
procedure Help;
begin { write the help text}
Msg(1,1,' TURBO COLOR DEMO ');
Msg(1,3,'Procedures used:');
Msg(1,6,' To make background: ');
Msg(1,7,' To select a palette: ');
Msg(1,9,'Colors in selected palette are:');
Msg(1,12,'1');
Msg(1,15,'2');
Msg(1,18,'3');
Msg(1,21,'Use arrows to change palette number');
Msg(1,22,'or press B to change Background');
GotoXY(1,25);
write('Press ESC twice to exit');
end {Help};
procedure Update;
begin
GotoXY(22,6); write('GraphBackground(',Background,') ');
GotoXY(22,7); write('Palette(',PaletteNumber,')');
GraphBackground(Background);
Palette(PaletteNumber);
if PaletteChange then
begin
GotoXY(1,21);
writeln('Use arrows to change palette number ');
write('Press B to change Background ');
end else
begin
GotoXY(1,21);
writeln('Use arrows to change background number');
write('or press P to change Palette ');
end;
end {Update};
begin {PaletteDemo}
GraphColorMode;
BackGround:=0;
PaletteNumber:=0;
GraphBackground(BackGround);
Palette(PaletteNumber);
DrawBoxes;
Help;
Update;
repeat
repeat read(Kbd,Ch) until Ch in ['P','p','B','b',#27];
case Upcase(Ch) of
'P': PaletteChange:=true;
'B': PaletteChange:=false;
#27: begin
read(Kbd,Ch);
case Ch of
'P': begin
if PaletteChange then
begin
PaletteNumber:=PaletteNumber-1;
if PaletteNumber<0 then PaletteNumber:=0;
end else
begin
Background:=BackGround-1;
if BackGround<0 then BackGround:=0;
end;
end;
'H': begin
if PaletteChange then
begin
PaletteNumber:=PaletteNumber+1;
if PaletteNumber>3 then PaletteNumber:=3;
end else
begin
Background:=BackGround+1;
if BackGround>15 then BackGround:=15;
end;
end;
end;
end;
end;
Update;
until Ch=#27;
end {Palettedemo};
begin {Main program}
Check;
PaletteDemo;
TextMode;
end.


48
Borland Turbo Pascal v2/DOSFCALL.DOC Normal file
View File

@ -0,0 +1,48 @@
{* WARNING WARNING WARNING WARNING WARNING WARNING WARNING
Do not try to use the MsDos function call unless you are
very familiar with the operating system and have technical
information available to you!
The following program uses the MsDos command in Turbo to
retrieve the system date. This is achieved via DOS function
call 42 (or 2A hex). The function call is placed in the AH
register according to the technical reference manual.
Type in the following code. The only output is the date
at the top of your screen.*}
program GetDate;
type
DateStr = string[10];
function Date: DateStr;
type
regpack = record
ax,bx,cx,dx,bp,si,ds,es,flags: integer;
end;
var
recpack: regpack; {record for MsDos call}
month,day: string[2];
year: string[4];
dx,cx: integer;
begin
with recpack do
begin
ax := $2a shl 8;
end;
MsDos(recpack); { call function }
with recpack do
begin
str(cx,year); {convert to string}
str(dx mod 256,day); { " }
str(dx shr 8,month); { " }
end;
date := month+'/'+day+'/'+year;
end;
begin
writeln(date);
end.

22
Borland Turbo Pascal v1/OUTCHAR.BAK → Borland Turbo Pascal v2/DOS_GT.PAS
View File

@ -1,29 +1,27 @@
program outchar;
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
procedure oc( var c : char );
procedure get_time( var tt : timetype );
var
recpack: regpack;
ah,al,ch,cl,dh: byte;
begin
ah := $8;
ah := $2c;
with recpack do
begin
ax := ah shl 8 + al;
dh := 87; {c;}
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;
var c : char;
begin { outchar }
c := 'W';
oc( c );
end. { outchar }


42
Borland Turbo Pascal v2/E.PAS Normal file
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.


89
Borland Turbo Pascal v2/EXTERNAL.DOC Normal file
View File

@ -0,0 +1,89 @@
; * WARNING WARNING WARNING WARNING WARNING WARNING WARNING *
; Please do not try to use external procedures
; unless you are familiar with assembly language.
;
; IMPORTANT: Externals must be written in assembly language.
;
; The following example translates a string to upper case.
;
; Place the following code in a file: "STU.ASM"
;
CODE SEGMENT
ASSUME CS:CODE
STU PROC NEAR
PUSH BP ; SAVE ENVIRONMENT
MOV BP,SP ; MANUAL PAGE 189
LES DI,[BP+4] ; GET PARAMETER
MOV CL,ES:[DI]
INC CL
L1: DEC CL
JZ L2
INC DI
CMP ES:BYTE PTR[DI],'a'
JB L1
CMP ES:BYTE PTR[DI],'z'
JA L1
SUB ES:BYTE PTR[DI],20H
JMP SHORT L1
L2: MOV SP,BP ; RESTORE ENVIRONMENT
POP BP ; MANUAL PAGE 190
RET 4
STU ENDP
CODE ENDS
END
; Now exit to PC-DOS and type:
;
; ASM STU
; LINK STU
; EXE2BIN STU.EXE STU.COM
;
; IGNORE MINOR ERRORS FROM ASM AND LINK
To use, write the following program:
type
AnyString = string[255];
var
S: AnyString;
I: integer;
procedure STU(var S: AnyString); external 'STU.COM';
begin
readln(S);
STU(S);
writeln(S);
end.
; The above external procedure is only an example. You
; can achieve the same result in Turbo-Pascal:
;
; procedure STU(var S: AnyString);
; var
; I: integer;
; begin
; for I:=1 to Length(S) do S[I]:=Upcase(S[I]);
; end;
;
; So why bother ?????


47
Borland Turbo Pascal v2/INTRPTCL.DOC Normal file
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,di,si,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.

26
Borland Turbo Pascal v2/READ.ME Normal file
View File

@ -0,0 +1,26 @@
RUN-TIME ERRORS IN OVERLAYS
---------------------------
Run-time errors occurring in overlays are found as usual,
and an address is issued by the error handling system. This
address, however, is an address within the overlay area, and
there is no way of knowing which overlay subprogram was actually
active when the error occurred.
Run-time errors in overlays can therefore not always be
readily found with the Options menu's 'Find run-time error'
facility. What 'Find run-time error' will point out is the first
occurrence of code at the specified address. This, of course, may
be the place of the error, but the error may as well occur in a
subsequent subprogram within the same overlay group.
This it not a serious limitation, however, as the type of
error and the way it occurs most often will indicate to you in
which subprogram the error happened. The way to locate the error
precisely is then to place the suspected subprogram as the first
subprogram of the overlay group. 'Find run-time error' will then
work.
THE BEST THING TO DO IS NOT TO PLACE SUBPROGRAMS IN OVERLAYS
UNTIL THEY HAVE BEEN FULLY DEBUGGED!


31
Borland Turbo Pascal v2/SIEVE.PAS Normal file
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.

76
Borland Turbo Pascal v2/SOUND.PAS Normal file
View File

@ -0,0 +1,76 @@
program SoundDemo;
type
NoteRecord = record
C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
end;
Const
Notes: NoteRecord =
(C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
procedure Play(Octave,Note,Duration: integer);
{ Play Note in Octave Duration milliseconds }
{ Frequency computed by first computing C in }
{ Octave then increasing frequency by Note-1 }
{ times the twelfth root of 2. (1.059463994) }
{ }
{ If Duration is zero Note will be played }
{ until you activate procedure NoSound }
var
Frequency: real;
I: integer;
begin
Frequency:=32.625;
{ Compute C in Octave }
for I:=1 to Octave do Frequency:=Frequency*2;
{ Increase frequency Note-1 times }
for I:=1 to Note-1 do Frequency:=Frequency*1.059463094;
if Duration<>0 then
begin
Sound(Round(Frequency));
Delay(Duration);
NoSound;
end else Sound(Round(Frequency));
end;
procedure SoftAlarm;
{ Play the notes G and D in octave three 7 times }
{ each with a duration of 70 milliseconds. }
var
I: integer;
begin
for I:=1 to 7 do with Notes do
begin
Play(4,G,70);
Play(4,D,70);
end;
Delay(1000);
end;
procedure Sirene;
var
Frequency: integer;
begin
for Frequency:= 500 to 2000 do begin Delay(1); Sound(Frequency); end;
for Frequency:=2000 downto 500 do begin Delay(1); Sound(Frequency); end;
end;
begin
writeln('Press any key to Stop');
repeat SoftAlarm until KeyPressed;
read(Kbd);
writeln('Press any key to Stop');
repeat Sirene until KeyPressed;
NoSound;
end.


65
Borland Turbo Pascal v2/TIMEUTIL.PAS Normal file
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;


BIN
Borland Turbo Pascal v2/TINST.COM Normal file
View File

Binary file not shown.

129
Borland Turbo Pascal v2/TINST.MSG Normal file
View File

@ -0,0 +1,129 @@
1 TURBO Pascal installation menu.
2 Choose installation item from the following:
3
4 [S]creen installation | [C]ommand installation | [Q]uit
5
6 Enter S, C, or Q:
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 Scroll down
28 Scroll up
29 Page up
30 Page down
31 To left on line
32 To right on line
33 To top of page
34 To bottom of page
35 To top of file
36 To end of file
37 To begining of block
38 To end of block
39 To last cursor position
15 INSERT & DELETE:
40 Insert mode on/off
41 Insert line
42 Delete line
43 Delete to end of line
44 Delete right word
45 Delete character under cursor
46 Delete left character
47 Alternative
16 BLOCK COMMANDS:
48 Mark block begin
49 Mark block end
50 Mark single word
51 Hide/display block
52 Copy block
53 Move block
54 Delete block
55 Read block from disk
56 Write block to disk
17 MISC. EDITING COMMANDS:
57 End edit
58 Tab
59 Auto tab on/off
60 Restore line
61 Find
62 Find & replace
63 Repeat last find
64 Control character prefix
101 Nothing
^Q: Quit, ^R: Last page, ^C: Next page, <RETURN>: Select terminal:
Wait Sorting Definitions
Change to:
(Y/N)?
y
n
Text file name:
Command:
Numeric entry expected
Legal range is
, please re-enter:
Choose one of the following terminals:
None of the above ( Max. 20 Characters )
Delete a definition ( Max. 20 Characters )
Which terminal? (Enter no. or ^Q to exit):
Delete terminal? (Enter no. or ^Q to exit):
Do you want to modify this definition before installation?
Terminal type:
Send an initialization string to the terminal?
Initializaion defined as a command string? (No = a file)
Send a reset string to the terminal
Reset defined as a command? (No = a file)
CURSOR LEAD-IN command:
CURSOR POSITIONING COMMAND to send between line and column:
CURSOR POSITIONING COMMAND to send after both line and column:
Column first
OFFSET to add to LINE:
OFFSET to add to COLUMN:
Binary address
Number of ASCII digits (2 or 3):
CLEAR SCREEN command:
Does CLEAR SCREEN also HOME cursor
HOME command:
DELETE LINE command:
INSERT LINE command:
ERASE TO END OF LINE command:
START HIGHLIGHTING command:
END HIGHLIGHTING command:
Number of rows (lines) on your screen:
Number of columns on your screen:
Delay after CURSOR ADDRESS (0-255 ms):
Delay after CLEAR, DELETE and INSERT (0-255 ms):
Delay after ERASE TO END OF LINE and HIGHLIGHT (0-255 ms):
Is this definition correct?
Hardware dependent information
Operating frequency of your microprocessor in MHz (for delays):
200 Choose one of the following displays:
201 Which display? (Enter no. or ^Q to exit):
202 Default display mode
203 Monochrome display
204 Color display 80x25
205 Color display 40x25
206 b/w display 80x25
207 b/w display 40x25


BIN
Borland Turbo Pascal v2/TLIST.COM Normal file
View File

Binary file not shown.

287
Borland Turbo Pascal v2/TTT.PAS Normal file
View File

@ -0,0 +1,287 @@
{ 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.

BIN
Borland Turbo Pascal v2/TURBO.COM Normal file
View File

Binary file not shown.

105
Borland Turbo Pascal v2/TURBO.MSG Normal file
View File

@ -0,0 +1,105 @@
 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
16PROCEDURE FUNCTION
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
76Overlays forwarded
77Overlays in direct mode
90 not found
91Unexpected end of source
92Unable to create overlay
93 compiler directive
96Nested include
97Too many nested WITH's
98Memory
99Compiler

112
Borland Turbo Pascal v2/WINDOW.PAS Normal file
View File

@ -0,0 +1,112 @@
program TestWindow;
{$C-}
const
Windows = 3;
Wtab : array[1..Windows,1..5] of Integer
= (( 5, 2, 35, 11, 1), { X0,Y0,X1,Y1,LineNo }
(45, 2, 75, 11, 1),
( 5, 15, 75, 23, 1)
);
type
String255 = String[255];
var
i : Integer;
Ch : Char;
procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);
var
i: Integer;
begin
GotoXY(UpperLeftX, UpperLeftY); Write(chr(218));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
Write(chr(191));
for i:=UpperLeftY+1 to LowerRightY-1 do
begin
GotoXY(UpperLeftX , i); Write(chr(179));
GotoXY(LowerRightX, i); Write(chr(179));
end;
GotoXY(UpperLeftX, LowerRightY);
Write(chr(192));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
Write(chr(217));
end { Frame };
function RanStr(Len: Integer): String255;
var
S: String255;
i: Integer;
begin
S[0]:=Chr(Len);
for Len:=1 to Len do
begin
repeat i:=Random(255) until not (Chr(I) in[^@,^G,^H,^J,^M]);
S[Len]:=Chr(i);
end;
RanStr:=S;
end { RanStr };
procedure SelectWindow(Win: Integer);
begin
Window(Wtab[Win,1], Wtab[Win,2], Wtab[Win,3], Wtab[Win,4])
end { SelectWindow };
procedure Window1;
begin
LowVideo;
SelectWindow(1);
GotoXY(1,1);
DelLine;
GotoXY(1, Wtab[1,4]-Wtab[1,2]+1);
Write('Line ', Wtab[1,5]:5,' ',chr(219),' ',RanStr(15));
Wtab[1,5]:=Succ(Wtab[1,5]);
NormVideo;
end { Window1 };
procedure Window2;
begin
LowVideo;
SelectWindow(2);
GotoXY(1,1);
DelLine;
GotoXY(1, Wtab[2,4]-Wtab[2,2]+1);
Write('Line ', Wtab[2,5]:5,' ',chr(219),' ',RanStr(15));
Wtab[2,5]:=Succ(Wtab[2,5]);
NormVideo;
end { Window2 };
procedure Window3;
begin
LowVideo;
SelectWindow(3);
GotoXY(1,1);
InsLine;
WriteLn('Line ', Wtab[3,5]:5,' ',chr(219),' ',RanStr(55));
Wtab[3,5]:=Succ(Wtab[3,5]);
NormVideo;
end { Window3 };
begin
GotoXY(15,25);
Write('TURBO PASCAL Window Demo - Press any key to stop');
for i:=1 to Windows do
Frame(Wtab[i,1]-1, Wtab[i,2]-1, Wtab[i,3]+1, Wtab[i,4]+1);
repeat
Window1;
Window2;
Window3;
until KeyPressed;
Read(KBD, Ch);
Window(1,1,80,25);
GotoXY(1,24);
end.


3
Borland Turbo Pascal v2/m.bat Normal file
View File

@ -0,0 +1,3 @@
rem there are no command-line tools for turbo pascal. Run the app and compile from within.