add pascal v2 add manual for v3, updae e.pas with better formatting

This commit is contained in:
davidly 2024-07-05 14:10:53 -07:00
parent d5452ab715
commit 11799f7f20
24 changed files with 664 additions and 6 deletions

View File

@ -33,7 +33,7 @@ begin
n := n - 1; n := n - 1;
end; end;
Write( x ); if x >= 10 then write( x:2 ) else write( x:1 );
end; end;
writeln; writeln;

BIN
Microsoft Pascal v2/C86.EXE Normal file

Binary file not shown.

42
Microsoft Pascal v2/E.PAS Normal file
View File

@ -0,0 +1,42 @@
(*$DEBUG- added, of course *)
program e( output );
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;
if x >= 10 then write( x:2 ) else write( x:1 );
end;
writeln;
writeln( 'done' );
end.

View File

@ -0,0 +1,205 @@
NAME ENTX
; Microsoft MS-DOS Computer Pascal runtime system control
; Version 1.00 (C) Copyright 1981 by Microsoft Corp
;Memory Layout:
;
; Hi -> COMMAND (may be overlayed)
; CONST segment
; DATA segment
; STACK segment
; MEMORY segment
; HEAP segment
; CODE segments
; Lo -> DOS code and data (fixed)
;
;The linker is told to load low and use DS allocation. Only 512 bytes
;of initial stack are allocated, and no heap at all. BEGXQQ moves all
;data to high memory, creating a gap in which the stack grows downward
;and the heap grows upward. The heap can grow downward over code too.
EXTRN ENTGQQ:FAR ;Main program entry point
EXTRN INIUQQ:FAR,ENDUQQ:FAR ;file system initialize/terminate
EXTRN ENDYQQ:FAR ;file system, close files
EXTRN BEGOQQ:FAR,ENDOQQ:FAR ;user system initialize/terminate
;First dummy code segment tells linker to load code lowest
;
INIXQQ SEGMENT 'CODE'
INIXQQ ENDS
;Heap segment definition (lowest of the data segments)
;
HEAP SEGMENT PUBLIC 'MEMORY'
MEMLO EQU THIS BYTE ;lowest data byte address
HEAP ENDS
;Memory segment definition (special purpose zero length)
;
MEMORY SEGMENT PUBLIC 'MEMORY'
MEMORY ENDS
;Stack segment definition (fixed initial minimal length)
;
STACK SEGMENT STACK 'STACK'
DB 256 DUP (?)
SKTOP EQU THIS BYTE
STACK ENDS
;FIRST resident public data
;
DATA SEGMENT PUBLIC 'DATA'
PUBLIC CSXEQQ ;pointer to sourcef context list
CSXEQQ DW 0
PUBLIC CLNEQQ ;last line number encountered
CLNEQQ DW 0
PUBLIC PNUXQQ ;pointer to unit initialization list
PNUXQQ DW 0
PUBLIC HDRFQQ ;Pascal open file list header
HDRFQQ DW 0
PUBLIC HDRVQQ ;Unit V open file list header
HDRVQQ DW 0
PUBLIC RESEQQ ;machine error context, stack ptr
RESEQQ DW 0
PUBLIC REFEQQ ;machine error context, frame ptr
REFEQQ DW 0
PUBLIC REPEQQ ;machine error context, program offset
REPEQQ DW 0
PUBLIC RECEQQ ;machine error context, program segment
RECEQQ DW 0
PUBLIC BEGHQQ ;first header word in heap
BEGHQQ DW 0
PUBLIC CURHQQ ;pointer to current heap item
CURHQQ DW 0
PUBLIC ENDHQQ ;just past end of the heap
ENDHQQ DW 0
PUBLIC STKBQQ ;stack start, to fix long GOTO
STKBQQ DW 0
PUBLIC STKHQQ ;stack limit, to check overflow
STKHQQ DW 0
PUBLIC CRCXQQ ;value of CX for DOS call
CRCXQQ DW 0
PUBLIC CRDXQQ ;value of DX for DOS call
CRDXQQ DW 0
PUBLIC CESXQQ ;DOS saved ES value (for command line)
DOSOFF DW 0 ;DOS exit offset, 0
CESXQQ DW 0 ;DOS saved ES value
DATA ENDS
;Constant segment definition
;
CONST SEGMENT PUBLIC 'CONST'
CONST ENDS
;Code for this module
;
ENTXQQ SEGMENT 'CODE'
DGROUP GROUP DATA,STACK,CONST,HEAP,MEMORY
ASSUME CS:ENTXQQ,DS:DGROUP,ES:DGROUP,SS:DGROUP
PUBLIC BEGXQQ,ENDXQQ,DOSXQQ ;main entry and exit points
;BEGXQQ: Initialization code
; - move DGROUP up as much as possible to get gap
; - set initial stackpointer, framepointer, STKBQQ
; - clear RESEQQ (machine error context)
; - clear CSXEQQ (sourcef error context)
; - clear PNUXQQ (unit init list header)
; - clear HDRFQQ and HDRVQQ (open file headers)
; - set BEGHQQ, CURHQQ, ENDHQQ, STKHQQ (heap init)
; - call INIUQQ (file initialization)
; - call BEGOQQ (user initialization)
; - call ENTGQQ (main program entry)
;
BEGXQQ PROC FAR
MOV AX,DGROUP ;get assumed data segment value
MOV DS,AX ;only need to address CESXQQ
MOV CESXQQ,ES ;save incomming ES value
MOV DX,OFFSET DGROUP:MEMLO ;DS offset to lowest data
SHR DX,1 ;make into word offset address
MOV CX,32768 ;highest word address possible
SUB CX,DX ;count of words in data segment
SHR DX,1 ;make count
SHR DX,1 ; into paragraph
SHR DX,1 ; (segment) address
INC DX ;round to next paragraph address
ADD DX,AX ;DX is start-of-data paragraph
MOV BX,2 ;[assembler rejects ES:2]
MOV BP,ES:[BX] ;DOS end paragraph
MOV BX,DX ;save to initialize heap later
ADD DX,4096 ;optimal end-of-data paragraph
CMP DX,BP ;enough memory for 64K data ?
JLE MEMA ;yes, can use optimal address
MOV DX,BP ;no, must use highest address
MEMA: SUB DX,4096 ;DX is final DS (may be negative)
STD ;set direction flag
MOV DS,AX ;source segment
MOV SI,65534 ;source offset
MOV ES,DX ;target segment
MOV DI,SI ;target offset
REP MOVSW ;move DS:SI-- to ES:DI-- until CX-=0
MOV DS,DX ;final DS value (may be negative)
CLI ;no interrupts (no stack)
MOV SS,DX ;initialize stack segment
MOV SP,OFFSET DGROUP:SKTOP ;set stackpointer
STI ;interrupts ok (stack ok)
MOV STKBQQ,SP ;to re-init SP after long GOTO
SUB BP,BP ;initial frame pointer zero
MOV RESEQQ,BP ;machine error context zero
MOV CSXEQQ,BP ;sourcef error context NIL
MOV PNUXQQ,BP ;unit init list header NIL
MOV HDRFQQ,BP ;Pascal open file header NIL
MOV HDRVQQ,BP ;Unit V open file header NIL
SUB BX,DX ;para addr of start of heap
SHL BX,1 ;make
SHL BX,1 ;into
SHL BX,1 ;offr
SHL BX,1 ;addr
MOV BEGHQQ,BX ;start of heap address
MOV CURHQQ,BX ;current heap item adr
MOV WORD PTR[BX],1 ;current header; free
ADD BX,2 ;byte after end of heap
MOV ENDHQQ,BX ;address after end of heap
ADD BX,384 ;comfortable boundary
MOV STKHQQ,BX ;stack overflow address
CALL INIUQQ ;initialize file system
CALL BEGOQQ ;initialize user system
CALL ENTGQQ ;call main program
;ENDXQQ: Termination code
; - call ENDOQQ (user termination)
; - call ENDYQQ (close open files)
; - call ENDUQQ (file termination)
; - return to operating system
;
ENDXQQ LABEL FAR ;termination entry point
CALL ENDOQQ ;user system termination
CALL ENDYQQ ;close all open files
CALL ENDUQQ ;file system termination
MOV DOSOFF,0 ;make sure jump offset zero
JMP DWORD PTR DOSOFF ;return to DOS
BEGXQQ ENDP
;DOSXQQ: Call DOS Operating System
;
DOSXQQ PROC FAR
POP SI ;get return ads
POP DI ;get return ads
POP DX ;get address parameter
POP AX ;get function parameter
MOV AH,AL ;must be in high half
MOV CX,CRCXQQ ;need CX for some functions
PUSH DI ;save return ads
PUSH SI ;save return ads
PUSH BP ;have to save this one
INT 33 ;onward to DOS
MOV CRCXQQ,CX ;return CX value
MOV CRDXQQ,DX ;return DX value
POP BP ;restore frame pointer
RET ;return (DOS ret in AX)
DOSXQQ ENDP
ENTXQQ ENDS
END BEGXQQ


BIN
Microsoft Pascal v2/FINK Normal file

Binary file not shown.

BIN
Microsoft Pascal v2/FINKXM Normal file

Binary file not shown.

BIN
Microsoft Pascal v2/FINU Normal file

Binary file not shown.

BIN
Microsoft Pascal v2/LIB.EXE Normal file

Binary file not shown.

Binary file not shown.

BIN
Microsoft Pascal v2/M86.EXE Normal file

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
Microsoft Pascal v2/PASKEY Normal file

Binary file not shown.

View File

@ -0,0 +1,31 @@
(* BYTE Benchmark, 9/81, Eratosthenes Sieve Prime Maker *)
PROGRAM prime (output); (*$DEBUG- added, of course *)
CONST
size = 8190;
VAR
flags : ARRAY [0..size] OF boolean;
i,prime,k,count,iter : integer;
PROCEDURE fillc (loc: adrmem; len: word; val: char); extern;
BEGIN
writeln ('10 iterations');
FOR iter := 1 TO 10 DO BEGIN
count := 0;
fillc (adr flags, sizeof(flags), chr(true));
FOR i := 0 TO size DO
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;
(* writeln(prime) *)
END;
END;
writeln(count,' primes')
END.


View File

@ -0,0 +1,29 @@
MEMO
To: MS-DOS Users of MS-Pascal
From: Microsoft OEM Support
Date: January 5, 1982
Files on this distribution:
README This Memo
PAS1.EXE Pascal Compiler Pass 1
PAS2.EXE Pascal Compiler Pass 2
LINK.EXE Microsoft Linker for .OBJ files
M86.EXE Microsoft MACRO-86 assembler
C86.EXE Assembler cross-reference generator
LIB.EXE Microsoft library manager (note: same as
LIB86.EXE specified in User Manual)
PASCAL.LIB MS-Pascal runtime library
PASKEY MS-Pascal predeclarations
FINU Declarations of low level file system
routines (the Unit U interface)
FINK Declaration of the common fields of the
generic file control block type, FCBFQQ
FINKXM Declaration of the version specific file
control block
ENTX6L.ASM Assembler source of the execution control
module which initializes and terminates
every program
PASCAL.MAP Map of the MS-Pascal runtime library
PRIMES.PAS Prime number generator program


View File

@ -0,0 +1,32 @@
(*$DEBUG- added, of course *)
program sieve( OUTPUT );
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.

297
Microsoft Pascal v2/TTT.PAS Normal file
View File

@ -0,0 +1,297 @@
{ App to prove you can't win at Tic-Tac-Toe }
{ coded for Microsoft Pascal. Tested on v1.0, v3.3, and v4.0. }
{ requires djldos.obj, built from djldos.asm }
(*$DEBUG- *)
program ttt( output );
function getticks : word; External;
function pspbyte( offset : word ) : integer; External;
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;
var
evaluated: integer;
board: boardType;
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, val, pieceMove, score : integer;
begin
evaluated := evaluated + 1;
val := scoreInvalid;
if depth >= 4 then
begin
p := winner2( move ); { lookForWinner; }
if p <> pieceBlank then
begin
if p = pieceX then
val := scoreWin
else
val := scoreLose
end
else if depth = 8 then
val := scoreTie;
end;
if val = scoreInvalid then
begin
if Odd( depth ) then
begin
val := scoreMin;
pieceMove := pieceX;
end
else
begin
val := 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 > val ) then
begin
val := score;
if ( val = scoreWin ) or ( val >= beta ) then p := 10
else if ( val > alpha ) then alpha := val;
end;
end
else
begin
if ( score < val ) then
begin
val := score;
if ( val = scoreLose ) or ( val <= alpha ) then p := 10
else if ( val < beta ) then beta := val;
end;
end;
end;
p := p + 1;
until p > 8;
end;
minmax := val;
end;
function firstArgAsInt : integer;
var
psp, offset : word;
c, result : integer;
location : ads of byte;
begin
result := 0;
offset := 128;
c := pspbyte( offset );
if c > 0 then begin
offset := offset + 2; { past length and space }
c := pspbyte( offset );
while ( ( c >= 48 ) and ( c <= 57 ) ) do
begin
result := result * 10;
result := result + c - 48;
offset := offset + 1;
c := pspbyte( offset );
end;
end;
firstArgAsInt := result;
end;
procedure runit( move : integer );
var
score: integer;
begin
board[move] := pieceX;
score := minmax( scoreMin, scoreMax, 0, move );
board[move] := pieceBlank;
end;
var
i, loops : integer;
startTicks, endTicks: word;
begin
i := firstArgAsInt;
if 0 <> i then loops := i
else loops := Iterations;
for i := 0 to 8 do
board[i] := pieceBlank;
WriteLn( 'begin' );
startTicks := getticks;
for i := 1 to loops do
begin
evaluated := 0; { once per loop to prevent overflow }
runit( 0 );
runit( 1 );
runit( 4 );
end;
endTicks := getticks;
WriteLn( 'end ticks: ', endTicks );
WriteLn( 'start ticks: ', startTicks );
WriteLn( 'difference in hs: ', endTicks - startTicks );
if startTicks > endTicks then begin { passed a 10 minute mark }
endTicks := endTicks + 60000;
WriteLn( 'corrected in hs: ', endTicks - startTicks );
end;
WriteLn( 'moves evaluated: ', evaluated );
WriteLn( 'iterations: ', loops );
end.

Binary file not shown.

22
Microsoft Pascal v2/m.bat Normal file
View File

@ -0,0 +1,22 @@
@echo off
setlocal
del %1.exe 2>nul
del %1.lst 2>nul
del %1.map 2>nul
del %1.obj 2>nul
del %1.cod 2>nul
ntvdm -c pas1 %1,%1,%1,%1
ntvdm -c pas2
ntvdm -c link %1 djldos,,,,
del %1.lst
del %1.map
del %1.obj
del %1.cod
rem -h is required due to a bug in generated code that assumes the app is loaded on a 64k boundary
ntvdm -h -p %1

View File

@ -1,5 +1,5 @@
(*$DEBUG- added, of course *)
program e( output ); program e( output );
(*$DEBUG- *)
const const
DIGITS = 200; DIGITS = 200;
@ -33,7 +33,7 @@ begin
n := n - 1; n := n - 1;
end; end;
Write( x ); if x >= 10 then write( x:2 ) else write( x:1 );
end; end;
writeln; writeln;

View File

@ -1,4 +1,5 @@
program e; (*$DEBUG- added, of course *)
program e( output );
const const
DIGITS = 200; DIGITS = 200;
@ -32,11 +33,10 @@ begin
n := n - 1; n := n - 1;
end; end;
Write( x ); if x >= 10 then write( x:2 ) else write( x:1 );
end; end;
writeln; writeln;
writeln( 'done' ); writeln( 'done' );
end. end.