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

microsoft pascal v3.31

Browse Source
This commit is contained in:
davidly 2024-07-01 06:10:13 -07:00
parent 663a14d010
commit 78276e2457
35 changed files with 2293 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Microsoft Pascal v3.31/8087.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/ALTMATH.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/CEXEC.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/DECMATH.LIB Normal file
View File

Binary file not shown.

54
Microsoft Pascal v3.31/DEMOEXEC.PAS Normal file
View File

@ -0,0 +1,54 @@
{* DEMOEXEC.PAS - demonstration progam for calling C library functions
*
* Microsoft Pascal release 3.30 can call large model C functions.
* Please read PASEXEC.INC for more details on interlanguage calling.
*
* To compile and link DEMOEXEC.PAS
*
* pas1 demoexec;
* pas2
* link demoexec,,,cexec; (must search CEXEC.LIB)
*}
program demoexec(input,output);
{$include : 'pasexec.inc'}
var
i : integer;
NULL : integer4;
value
NULL := 0;
begin
{* invoke command.com with a command line
*
* dir *.for
*}
i := system(ads('dir *.pas'*chr(0)));
writeln (output,'system return code = ',i);
writeln (output,' ');
{* invoke a child process
*
* exemod (display usage line only)
*}
i := spawnlp(0,ads('exemod'*chr(0)),ads('exemod'*chr(0)),NULL);
writeln (output,'spawnlp return code =',i);
writeln (output,' ');
{* invoke an overlay process (chaining)
*
* exemod demoexec.exe
*}
i := spawnlp(2,ads('exemod'*chr(0)),ads('exemod'*chr(0)),
ads('demoexec.exe'*chr(0)),NULL);
{* we should never see this if spawnlp (overlay) is successful
*}
writeln (output,'spawnlp return code =',i);
writeln (output,' ');
end.

42
Microsoft Pascal v3.31/E.PAS Normal file
View File

@ -0,0 +1,42 @@
program e;
(*$DEBUG- *)
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.

396
Microsoft Pascal v3.31/EMOEM.ASM Normal file
View File

@ -0,0 +1,396 @@
title emoem.asm - OEM dependent code for 8087
;--------------------------------------------------------------------
;
; OEM customization routines for 8087/80287 coprocessor
;
; Copyright (C) 1985 by Microsoft Corporation
;
; This module is designed to work with the following
; Microsoft language releases:
;
; Microsoft C 3.00 and later
; Microsoft FORTRAN 77 3.30 and later
; Microsoft Pascal 3.30 and later
;
; This module supercedes the OEMR7.ASM module used in earlier
; versions of Microsoft FORTRAN 77 and Pascal. The documentation
; provided with the FORTRAN and Pascal releases refers to the old
; OEMR7.ASM module and is only slightly relevant to this module.
;
; The following routines need to be written to properly handle the
; 8087/808287 installation, termination, and interrupt handler
;
; __FPINSTALL87 install 8087 interrupt handler
; __FPTERMINATE87 deinstall 8087 interrupt handler
; __fpintreset reset OEM hardware if an 8087 interrupt
;
; This module should be assembled with the Microsoft Macro Assembler
; as follows:
;
; masm emoem/r;
;
; Most hardware handles the 8087/80287 in one of the following
; three ways -
;
; 1. NMI - IBM PC and clones all handle the interrupt this way
; 2. single 8259
; 3. master/slave 8259
;
; Manufacturer specific initialization is supported for these 3
; machine configurations either by modifying this file and replacing
; the existing EMOEM module in the math libraries or by patching
; the .LIB and .EXE files directly.
;
; Microsoft FORTRAN and Pascal Release 3.30
;
; LIB MATH-+EMOEM;
; LIB 8087-+EMOEM;
;
; Microsoft C Release 3.00
;
; LIB 87-+EMOEM;
; LIB EM-+EMOEM;
;
;--------------------------------------------------------------------
ifndef PCDOS ; if PCDOS is nonzero, then the 8087
PCDOS= 0 ; handler may only work on IBM PCs
endif ; and clones
;---------------------------------------------------------------------
; Assembly constants.
;---------------------------------------------------------------------
; MS-DOS OS calls
OPSYS EQU 21H
SETVECOP EQU 25H
GETVECOP EQU 35H
DOSVERSION EQU 30h
CTLCVEC EQU 23h
EMULATOR_DATA segment public 'FAR_DATA'
assume ds:EMULATOR_DATA
; User may place data here if DS is setup properly.
; Recommend keeping the data items in the code segment.
EMULATOR_DATA ends
EMULATOR_TEXT segment public 'CODE'
assume cs:EMULATOR_TEXT
public __FPINSTALL87 ; DO NOT CHANGE THE CASE ON
public __FPTERMINATE87 ; THESE PUBLIC DEFINITIONS
extrn __FPEXCEPTION87:near ; DO NOT CHANGE CASE
;***********************************************************************
;
; Hardware dependent parameters in the 8087 exception handler.
;
; For machines using 2 8259's to handle the 8087 exception, be sure that
; the slave 8259 is the 1st below and the master is the 2nd.
;
; The last 4 fields allow you to enable extra interrupt lines into the
; 8259s. It should only be necessary to use these fields if the 8087
; interrupt is being masked out by the 8259 PIC.
;
; The ocw2's (EOI commands) can be either non-specific (20H) or
; specific (6xH where x=0 to 7). If you do not know which interrupt
; request line on the 8259 the 8087 exception uses, then you should issue
; the non-specific EOI (20H). Interrupts are off at this point in the
; interrupt handler so a higher priority interrupt will not be seen.
oeminfo struc
oemnum db 0 ; MS-DOS OEM number (IBM is 00h)
intnum db 2 ; IBM PC clone interrupt number
share db 0 ; nonzero if original vector should be taken
a8259 dw 0 ; 1st 8259 (A0=0) port #
aocw2 db 0 ; 1st 8259 (A0=0) EOI command
b8259 dw 0 ; 2nd 8259 (A0=0) port #
bocw2 db 0 ; 2nd 8259 (A0=0) EOI command
a8259m dw 0 ; 1st 8259 (A0=1) port #
aocw1m db 0 ; 1st 8259 (A0=1) value to mask against IMR
b8259m dw 0 ; 2nd 8259 (A0=1) port #
bocw1m db 0 ; 2nd 8259 (A0=1) value to mask against IMR
oeminfo ends
if PCDOS eq 0
;-----------------------------------------------------------------------
; OEM specific 8087 information
;
; If the OEM number returned from the DOS version call matches,
; this information is automatically moved into the oem struc below.
oemtab label byte ; Table of OEM specific values for 8087
; OEM#, int, shr, a59, acw2,b59, bcw2,a59m,acw1,b59m,bcw1
;TI Professional Computer
TI_prof oeminfo <028h,047h,000h,018h,020h,0000,0000,0000,0000,0000,0000>
db 0 ; end of table
endif ;PCDOS eq 0
; Unique pattern that can be searched for with the debugger so that
; .LIB or .EXE files can be patched with the correct values.
; If new values are patched into .LIB or .EXE files, care must be
; taken in insure the values are correct. In particular, words and
; bytes are intermixed in oeminfo structure. Remember words are
; stored low byte - high byte in memory on the 8086 family.
db '<<8087>>' ; older versions used '<8087>'
; Some manufacturer's machines can not be differentiated by the
; OEM number returned by the MS-DOS version check system call.
; For these machines it is necessary to replace the line below
oem oeminfo <> ; default values for IBM PC & clones
; with one of the following. If your machine has an 8087 capability
; and it is not in the list below, you should contact your hardware
; manufacturer for the necessary information.
;ACT Apricot
;oem oeminfo <000h,055h,000h,000h,020h,000h,000h,000h,000h,000h,000h>
;NEC APC3 and PC-9801 (OEM number returned by NEC MS-DOS's is different)
;oem oeminfo <000h,016h,000h,008h,066h,000h,067h,00Ah,0BFh,002h,07Fh>
;---------------------------------------------------------------------
statwd dw 0 ; Temporary for status word
oldvec dd 0 ; Old value in 8087 exception interrupt vector
ctlc dd 0 ; Old value of Control-C vector (INT 23h)
aoldIMR db 0 ; 1st 8259 original IMR value
boldIMR db 0 ; 2nd 8259 original IMR value
page
;---------------------------------------------------------------------
;
; Perform OEM specific initialization of the 8087.
;
__FPINSTALL87:
push ds ; DS = EMULATOR_DATA
push cs ; Move current CS to DS for opsys calls.
pop ds
assume ds:EMULATOR_TEXT
if PCDOS eq 0
push ds
pop es ; CS = DS = ES
mov ah,DOSVERSION
int OPSYS ; bh = OEM#
cld
mov si,offset oemtab ; start of OEM 8087 info table
mov di,offset oem+1
mov cx,(size oem)-1
OEMloop:
lodsb ; get OEM#
or al,al
jz OEMdone ; OEM# = 0 - did not find OEM
cmp al,bh ; correct OEM#
je OEMfound
add si,cx ; skip over OEM information
jmp OEMloop
OEMfound:
rep movsb ; move the information
OEMdone: ; done with automatic customization
endif
; Save old interrupt vector.
; Ask operating system for vector.
mov al,[oem].intnum ; Interrupt vector number.
mov ah,GETVECOP ; Operating system call interrupt.
int OPSYS ; Call operating system.
mov word ptr [oldvec],bx ; Squirrel away old vector.
mov word ptr [oldvec+2],es
; Have operating system install interrupt vectors.
mov dx,offset __fpinterrupt87 ; Load DX with 8087 interrupt handler.
mov ah,SETVECOP ; Set interrupt vector code in AH.
mov al,[oem].intnum ; Set vector number.
int OPSYS ; Install vector.
; Intercept Control-C vector to guarentee cleanup
mov ax,GETVECOP shl 8 + CTLCVEC
int OPSYS
mov word ptr [ctlc],bx
mov word ptr [ctlc+2],es
mov dx,offset ctlcexit
mov ax,SETVECOP shl 8 + CTLCVEC
int OPSYS
; set up 8259's so that 8087 interrupts are enabled
mov ah,[oem].aocw1m ; get mask for 1st 8259 IMR
or ah,ah ; if 0, don't need to do this
jz installdone ; and only 1 8259
mov dx,[oem].a8259m ; get port number for 1st 8259 (A0=1)
in al,dx ; read old IMR value
mov [aoldIMR],al ; save it to restore at termination
and al,ah ; mask to enable interrupt
jmp short $+2 ; for 286's
out dx,al ; write out new mask value
mov ah,[oem].bocw1m ; get mask for 2nd 8259 IMR
or ah,ah ; if 0, don't need to do this
jz installdone ;
mov dx,[oem].b8259m ; get port number for 2nd 8259 (A0=1)
in al,dx ; read old IMR value
mov [boldIMR],al ; save it to restore at termination
and al,ah ; mask to enable interrupt
jmp short $+2 ; for 286's
out dx,al ; write out new mask value
installdone:
assume ds:EMULATOR_DATA
pop ds
ret
page
; __FPTERMINATE87
;
; This routine should do the OEM 8087 cleanup. This routine is called
; before the program exits.
;
; DS = EMULATOR_DATA
__FPTERMINATE87:
push ds
push ax
push dx
mov ah,SETVECOP
mov al,[oem].intnum
lds dx,[oldvec]
int OPSYS
; reset 8259 IMR's to original state
push cs
pop ds ; DS = CS
assume ds:EMULATOR_TEXT
cmp [oem].aocw1m,0 ; did we have to change 1st 8259 IMR
je term2nd8259 ; no - check 2nd 8259
mov al,[aoldIMR] ; get old IMR
mov dx,[oem].a8259m ; get 1st 8259 (A0=1) port #
out dx,al ; restore IMR
term2nd8259:
cmp [oem].bocw1m,0 ; did we have to change 2nd 8259 IMR
je terminatedone ; no
mov al,[boldIMR] ; get old IMR
mov dx,[oem].b8259m ; get 2nd 8259 (A0=1) port #
out dx,al ; restore IMR
terminatedone:
pop dx
pop ax
pop ds
assume ds:EMULATOR_DATA
ret
; Forced cleanup of 8087 exception handling on Control-C
ctlcexit:
push ax
push dx
push ds
call __FPTERMINATE87 ; forced cleanup of exception handler
lds dx,[ctlc] ; load old control C vector
mov ax,SETVECOP shl 8 + CTLCVEC
int OPSYS
pop ds
pop dx
pop ax
jmp [ctlc] ; go through old vector
page
; __fpinterrupt87
;
; This is the 8087 exception interrupt routine.
;
; All OEM specific interrupt and harware handling should be done in
; __fpintreset because __FPEXCEPTION87 (the OEM independent 8087
; exception handler) may not return. __FPEXCEPTION87 also turns
; interrupts back on.
;
PENDINGBIT= 80h ; Bit in status word for interrupt pending
__fpinterrupt87:
assume ds:nothing
nop
fnstsw [statwd] ; Store out exceptions
push ax ; waste time
pop ax
jmp short $+2
test byte ptr [statwd],PENDINGBIT ; Test for 8087 interrupt
jz not87int ; Not an 8087 interrupt.
call __fpintreset ; OEM interrupt reset routine
call __FPEXCEPTION87 ; 8087 error handling - may not return
; this routine turns interrupts back on
cmp [oem].share,0 ; Should we execute the old interrupt routine?
jz done8087 ; if not then return
; If you fall through here to do further hardware resetting, things
; may not always work because __FPEXCEPTION87 does not always return
; This only happens when the 8087 handler gets an exception that is
; a fatal error in the language runtimes. I.e., divide by zero
; is a fatal error in all the languages, unless the control word has
; set to mask out divide by zero errors.
not87int:
jmp [oldvec] ; We should never return from here.
done8087:
iret
__fpintreset:
push ax
push dx
mov al,[oem].aocw2 ; Load up EOI instruction.
or al,al ; Is there at least one 8259 to be reset?
jz Reset8259ret ; no
mov dx,[oem].a8259
out dx,al ; Reset (master) 8259 interrupt controller.
mov al,[oem].bocw2 ; Load up EOI instruction.
or al,al ; Is there a slave 8259 to be reset?
jz Reset8259ret
mov dx,[oem].b8259
out dx,al ; Reset slave 8259 interrupt controller.
Reset8259ret:
pop dx
pop ax
ret
EMULATOR_TEXT ends
end

BIN
Microsoft Pascal v3.31/EXEMOD.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/EXEPACK.EXE Normal file
View File

Binary file not shown.

82
Microsoft Pascal v3.31/FINK Normal file
View File

@ -0,0 +1,82 @@
{MS-Pascal / MS-FORTRAN FCB Declaration Include File}
INTERFACE; UNIT
FILKQQ (FCBFQQ,
accessmodes,
am_read,
am_readwrite,
am_write,
am_default,
SHAREMODES,
sm_compat,
sm_denyrw,
sm_denywr,
sm_denyrd,
sm_denynone,
FILEMODES,
SEQUENTIAL,
TERMINAL,
DIRECT,
fm_sequential,
fm_direct,
fm_terminal);
TYPE
FILEMODES = (SEQUENTIAL, TERMINAL, DIRECT);
SHAREMODES = (sm_compat, sm_denyrw, sm_denywr, sm_denyrd, sm_denynone);
accessmodes = (am_read, am_write, am_readwrite, am_default);
FCBFQQ = RECORD {byte offsets start every field comment}
{fields accessible by Pascal user as <file variable>.<field>}
TRAP: BOOLEAN; {00 Pascal user trapping errors if true}
ERRS: WRD(0)..18; {01 error status, set only by all units}
MODE: FILEMODES; {02 user file mode; not used in unit U}
SHARE:SHAREMODES; {03 pad to word bound, special user use}
{fields shared by units F, V, U; ERRC / ESTS are write-only}
ERRC: WORD; {04 error code, error exists if nonzero}
{1000..1099: set for unit U errors}
{1100..1199: set for unit F errors}
{1200..1299: set for unit V errors}
ESTS: WORD; {06 error specific data usually from OS}
CMOD: FILEMODES; {08 system file mode; copied from MODE}
{fields set / used by units F and V, and read-only in unit U}
TXTF: BOOLEAN; {09 true: formatted / ASCII / TEXT file}
{false: not formatted / binary file}
SIZE: WORD; {10 record size set when file is opened}
{DIRECT: always fixed record length}
{others: max buffer variable length}
IERF: BOOLEAN; {12 Unit U Incomplete End Of Record }
{Kluge. Set false by opnuqq and }
{pccuqq, and true by peruqq. Thus }
{if true in wefuqq, it means that }
{there is an incomplete line, and }
{pccuqq should be called to flush }
{it. Only applies to terminal files}
access: accessmodes;{13 controls read/write modes }
OLDF: boolean; {14 true: must exist before open; RESET}
{false: can create on open; REWRITE}
INPT: BOOLEAN; {15 true: user is now reading from file}
{false: user is now writing to file}
RECL: WORD; {16 DIRECT record number, lo order word}
RECH: WORD; {18 DIRECT record number, hi order word}
USED: WORD; {20 number bytes used in current record}
{fields used internally by units F or V not needed by unit U}
LINK: ADR OF FCBFQQ;{22 DS offset address of next open file}
BADR: ADRMEM; {24 F: DS offset address for buffer var}
TMPF: BOOLEAN; {26 F: is a temp file; delete on CLOSE}
FULL: BOOLEAN; {27 F: buffer variable lazy eval status}
UNFM: BOOLEAN; {28 V: for unformatted binary file mode}
OPEN: BOOLEAN; {29 F: file opened (by RESET / REWRITE)}
FUNT: INTEGER; {30 V: FORTRAN unit number (1 to 32767)}
ENDF: BOOLEAN; {32 V: last I/O statement was a ENDFILE}
{fields set / used by unit U, and read-only in units F and V}
REDY: BOOLEAN; {33 buffer ready if true; set by F / U}
BCNT: WORD; {34 number of data bytes actually moved}
EORF: BOOLEAN; {36 true if end of record read, written}
EOFF: BOOLEAN; {37 end of file flag set after EOF read}
{unit U (operating system) information starts here}
{end of section for unit U specific OS information}
END;
const fm_sequential = sequential;
fm_direct = direct;
fm_terminal = terminal;
END;

96
Microsoft Pascal v3.31/FINKXU Normal file
View File

@ -0,0 +1,96 @@
{MS-Pascal / MS-FORTRAN FCB Declaration Include File}
INTERFACE; UNIT
FILKQQ (FCBFQQ,
FILEMODES, SEQUENTIAL, TERMINAL, DIRECT,
fm_sequential, fm_terminal, fm_direct,
accessmodes,
am_read,
am_readwrite,
am_write,
am_default,
SHAREMODES,
sm_compat,
sm_denyrw,
sm_denywr,
sm_denyrd,
sm_denynone,
BUFFER_SIZE,
ADRFIELDS);
const
BUFFER_SIZE = 512;
ADRFIELDS = 2; {* Two ADR fields in the FCB, see NEWUQQ. *}
TYPE
FILEMODES = (SEQUENTIAL, TERMINAL, DIRECT);
SHAREMODES = (sm_compat, sm_denyrw, sm_denywr, sm_denyrd, sm_denynone);
accessmodes = (am_read, am_write, am_readwrite, am_default);
FCBFQQ = RECORD {byte offsets start every field comment}
{fields accessible by Pascal user as <file variable>.<field>}
TRAP: BOOLEAN; {00 Pascal user trapping errors if true}
ERRS: WRD(0)..18; {01 error status, set only by all units}
MODE: FILEMODES; {02 user file mode; not used in unit U}
SHARE:SHAREMODES; {03 pad to word bound, special user use}
{fields shared by units F, V, U; ERRC / ESTS are write-only}
ERRC: WORD; {04 error code, error exists if nonzero}
{1000..1099: set for unit U errors}
{1100..1199: set for unit F errors}
{1200..1299: set for unit V errors}
ESTS: WORD; {06 error specific data usually from OS}
CMOD: FILEMODES; {08 system file mode; copied from MODE}
{fields set / used by units F and V, and read-only in unit U}
TXTF: BOOLEAN; {09 true: formatted / ASCII / TEXT file}
{false: not formatted / binary file}
SIZE: WORD; {10 record size set when file is opened}
{DIRECT: always fixed record length}
{others: max buffer variable length}
IERF: BOOLEAN; {12 Unit U Incomplete End Of Record }
{Kluge. Set false by opnuqq and }
{pccuqq, and true by peruqq. Thus }
{if true in wefuqq, it means that }
{there is an incomplete line, and }
{pccuqq should be called to flush }
{it. Only applies to terminal files}
access: accessmodes;{13 Controls actual open mode }
OLDF: boolean; {14 true :must exist before open; RESET}
{false :can create on open; REWRITE}
INPT: BOOLEAN; {15 true: user is now reading from file}
{false: user is now writing to file}
RECL: WORD; {16 DIRECT record number, lo order word}
RECH: WORD; {18 DIRECT record number, hi order word}
USED: WORD; {20 number bytes used in current record}
{fields used internally by units F or V not needed by unit U}
LINK: ADR OF FCBFQQ;{22 DS offset address of next open file}
BADR: ADRMEM; {24 F: DS offset address for buffer var}
TMPF: BOOLEAN; {26 F: is a temp file; delete on CLOSE}
FULL: BOOLEAN; {27 F: buffer variable lazy eval status}
UNFM: BOOLEAN; {28 V: for unformatted binary file mode}
OPEN: BOOLEAN; {29 F: file opened (by RESET / REWRITE)}
FUNT: INTEGER; {30 V: FORTRAN unit number (1 to 32767)}
ENDF: BOOLEAN; {32 V: last I/O statement was a ENDFILE}
{fields set / used by unit U, and read-only in units F and V}
REDY: BOOLEAN; {33 buffer ready if true; set by F / U}
BCNT: WORD; {34 number of data bytes actually moved}
EORF: BOOLEAN; {36 true if end of record read, written}
EOFF: BOOLEAN; {37 end of file flag set after EOF read}
{unit U (operating system) information starts here}
{**********************************************************}
FILE_NAME : ^STRING; {* 38 points to file name *}
FDSCP : INTEGER; {* 42 actual ZEUS file number *}
PREDEFINED : BOOLEAN; {* 44 True if file is a device. *}
FNER : BOOLEAN; {* 45 True if File name error. *}
BEGIN_BUFFER : INTEGER; {* 46 Start loc of buffer. *}
END_BUFFER : INTEGER; {* 48 top loc of buffer. *}
IEOF : BOOLEAN; {* 50 Flag if EOF ever seen. For ^Zs. *}
BUFFER : STRING(512); {* 52 Internal buffering. *}
PADBUF : STRING(65); {*564 Make same size as MS-Dos. *}
{*630 + 4 = 634, see newuqq *}
{**********************************************************}
{end of section for unit U specific OS information}
END;
const fm_sequential = sequential;
fm_direct = direct;
fm_terminal = terminal;
END;

137
Microsoft Pascal v3.31/FINU Normal file
View File

@ -0,0 +1,137 @@
{MS-Pascal and Fortran OS Dependent File System Interface Unit}
INTERFACE; UNIT
FILUQQ (FNSUQQ, INPUQQ, OUTUQQ,
INIUQQ, OPNUQQ, CLSUQQ, CLDUQQ, ENDUQQ,
GETUQQ, PUTUQQ, PERUQQ, PCCUQQ, SEKUQQ,
GTYUQQ, PLYUQQ, PTYUQQ, GFNUQQ, PFNUQQ,
BUFUQQ, NEWUQQ, TFNUQQ, PPMUQQ,
NEFUQQ, DIFUQQ, IOCUQQ, DSNUQQ,
FPSUQQ, TFDUQQ, EOFUQQ, LKGUQQ );
USES FILKQQ;
TYPE
ERRORET = WORD; {return code, error if non-zero}
VAR
FNSUQQ: SET OF CHAR; {allowed chars in a filename}
INPUQQ, OUTUQQ: STRING (8); {filenames for user terminal}
PROCEDURE INIUQQ;
{Overall initialization call; set FNSUQQ, INPUQQ, and OUTUQQ}
FUNCTION OPNUQQ (VAR F: FCBFQQ): ERRORET;
{Open a file; INPT determines whether for input or output;
if OLDF true and file not found, error, else create file;
DIRECT mode record length is in SIZE;
file's mode is in CMOD, but if mode is SEQUENTIAL and
file is a terminal (or printer) reset CMOD to TERMINAL;
set EORF true; set EOFF to NOT INPT}
FUNCTION CLSUQQ (VAR F: FCBFQQ): ERRORET;
{CLOSE; close the file (if error occurs file assumed closed)}
FUNCTION CLDUQQ (VAR F: FCBFQQ): ERRORET;
{CLOSE DELETE; close the file and delete it (errors ignored)}
PROCEDURE DSNUQQ (VAR F:FCBFQQ);
{dispose a file name - noop on dos 1.25 unit U}
PROCEDURE ENDUQQ;
{Overall termination, all files should already be closed}
FUNCTION GETUQQ (VAR F: FCBFQQ; LEN: WORD; DST: ADSMEM): ERRORET;
{Copy bytes from the file to the string until the string fills,
an error occurs, or the end of record or end of file is found.
Set EOFF if last byte of file has already been read (not an error);
else copy from zero to UPPER(S) characters from the file to S.
Set BCNT to actual number of bytes copied (zero to UPPER(S));
value of bytes in S from BCNT+1 to UPPER(S) is undefined.
USED is always the number of bytes read from this record.
Use TXTF and CMOD as appropriate for various kinds of files:
If CMOD=SEQUENTIAL or TERMINAL and TXTF is true,
set EORF if last byte of record read and BCNT < UPPER (S).
If CMOD=TERMINAL, reading user line from a console:
If TXTF, read whole line with user editing and echo,
If NOT TXTF, read characters as typed, without echo.}
FUNCTION PUTUQQ (VAR F: FCBFQQ; LEN: WORD; SRC: ADSMEM): ERRORET;
{Copy bytes from string to file, at end of current record;
USED is always the number of bytes written to this record.
Set EORF false iff (CMOD=SEQUENTIAL or DIRECT) and TXTF true}
FUNCTION PERUQQ (VAR F: FCBFQQ): ERRORET;
{End writing the current record and setup to write the next;
Set EORF true iff CMOD=SEQUENTIAL or TERMINAL and TXTF true}
FUNCTION PCCUQQ (VAR F: FCBFQQ; CH: CHAR): ERRORET;
{Start of line carriage control; CMOD is TERMINAL;
CC is one of:
' ': single space (normal) '0': double space
'+': no spacing (overprint) '1': new page
EORF will always be true, set it false}
FUNCTION SEKUQQ (VAR F: FCBFQQ; LREC, HREC: WORD): ERRORET;
{Reposition direct-access file to record number LREC/HREC.}
FUNCTION GTYUQQ (LEN: WORD; DST: ADSMEM): WORD;
{Read up to LEN chars from user's terminal to DST, return number read}
PROCEDURE PLYUQQ;
{Output an end of record (crlf or equivalent) to the user's console}
PROCEDURE PTYUQQ (LEN: WORD; SRC: ADSMEM);
{Output LEN chars from SRC}
FUNCTION GFNUQQ (VAR F: FCBFQQ; LEN: WORD; DST: ADSMEM): WORD;
{Move filename to DST, max of LEN chars, return actual length}
PROCEDURE PFNUQQ (VAR F: FCBFQQ; LEN: WORD; SRC: ADSMEM);
{Get filename from SRC of length LEN, for use in later OPNUQQ calls}
{Pascal-only calls}
PROCEDURE BUFUQQ (VAR F: FCBFQQ);
{Wait for I/O transfer to finish, set REDY true (defer errors)}
PROCEDURE NEWUQQ (VAR F: FCBFQQ);
{Initialize OS dependent fields; SIZE and TXTF set (defer errors)}
PROCEDURE TFNUQQ (VAR F: FCBFQQ);
{Set the NAME field to a unique OS temporary filename (defer errors)}
FUNCTION PPMUQQ (LEN: WORD; ADRP: ADRMEM; VAR DST: LSTRING): ERRORET;
{Like GETUQQ, but used to read program parameters from user.
String P is a user prompt, which may or may not be used.
If user input string is shorter than UPPER(S), blank pad;
if it is longer, either re-prompt or give an error.
Called once per program parameter requested}
{Fortran-only calls}
FUNCTION NEFUQQ: ADRMEM;
{If possible, allocate a file of size BOFFQQ, initialize OS dependent
fields, and return the address of the FCB; else return zero}
PROCEDURE DIFUQQ (F: ADRMEM);
{Deallocate the file at address F of size BOFFQQ}
FUNCTION IOCUQQ (VAR F: FCBFQQ): ERRORET;
{Change from read to write or vice versa, based on new INPT value;
CMOD is SEQUENTIAL or TERMINAL; set EORF and EOFF as in OPNUQQ}
FUNCTION FPSUQQ (VAR F: FCBFQQ; RELPOS: INTEGER): ERRORET;
{Position RELPOS bytes forward(+), backward(-), or rewind(0).
If INPT is false, write eof first. Set EORF and EOFF as in OPNUQQ}
FUNCTION TFDUQQ (VAR F: FCBFQQ): ERRORET;
{Truncate DIRECT file before current record; CMOD is always DIRECT.
If truncation is difficult, ignore operation. Set EOFF true}
FUNCTION EOFUQQ (VAR F: FCBFQQ; VAR FEOF: BOOLEAN): ERRORET;
{Set FEOF true if next GETUQQ would return with EOFF true,
else set it false. If difficult to detect, just set it false}
function lkguqq (var f:fcbfqq; lkgmode: word; lrec, hrec: word;
recnum: integer4): erroret;
END;

52
Microsoft Pascal v3.31/FLOAT.PAS Normal file
View File

@ -0,0 +1,52 @@
program tf( INPUT, OUTPUT );
var
r, a, b, c : real;
i, x : integer;
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;
begin { tf }
a := 1.1;
b := 2.2;
c := 3.3;
for i := 1 to 8 do begin
writeln( 'a, b, c, i: ', a, b, c, i );
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 }

BIN
Microsoft Pascal v3.31/LIB.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/LINK.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/LVARSTCK.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/MATH.LIB Normal file
View File

Binary file not shown.

76
Microsoft Pascal v3.31/MM.PAS Normal file
View File

@ -0,0 +1,76 @@
{ BYTE magazine October 1982. Jerry Pournelle. }
{ various bugs not found because dimensions are square fixed by David Lee }
{ expected result: 4.65880E+05 }
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 }

BIN
Microsoft Pascal v3.31/NULE6.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/PAS1.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/PAS2.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/PAS3.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/PASCAL.LIB Normal file
View File

Binary file not shown.

101
Microsoft Pascal v3.31/PASEXEC.INC Normal file
View File

@ -0,0 +1,101 @@
{ PASEXEC.INC - interface file for C library routines
This include file along with the CEXEC.LIB library has been included
with your Pascal 3.30 to show you how easy it is to call routines
written in our new C 3.00 release. The CEXEC.LIB contains several
routines from the C library which we think you will find useful in
extending the power of your Pascal programs.
The memory model that Pascal uses is basically medium model (16-bit
data pointers) with some extensions for large model addressing
(32-bit data pointers). The CEXEC.LIB routines are from the large
model C library. This means that you should be careful interfacing
to these routines. You should use ADS or VARS instead of ADR or VAR
so that 32-bit addressed get constructed.
The new Microsoft FORTRAN 3.30, PASCAL 3.30, and C 3.00 releases
have been designed so that libraries or subprograms can be written
in any one of these languages and used in any other.
Try compiling and running the demonstration program DEMOEXEC.PAS
to see some actual examples.
}
{ C function
int system(string)
char *string;
The system() function passes the given C string (00hex terminated)
to the DOS command interpreter (COMMAND.COM), which interprets and
executes the string as an MS-DOS command. This allows MS-DOS commands
(i.e., DIR or DEL), batch files, and programs to be executed.
Example usage in Pascal
i := system(ads('dir *.for'*chr(0)));
The interface to system is given below. The [c] attribute is given
after the function return type. The [varying] attribute says the
function has an undetermined number of parameters; in this case, 1.
}
function system : integer [c,varying]; extern;
{ C function
int spawnlp(mode,path,arg0,arg1,...,argn)
int mode; /* spawn mode */
char *path; /* pathname of program to execute */
char *arg0; /* should be the same as path */
char *arg1,...,*argn; /* command line arguments */
/* argn must be NULL */
The spawnlp creates and executes a new child process. There must be
enough memory to load and execute the child process. The mode
argument determines which form of spawnlp is executed as follows:
Value Action
0 Suspend parent program and execute the child program.
When the child program terminates, the parent program
resumes execution. The return value from spawnlp is -1
if an error has occured or if the child process has
run, the return value is the child processes return
code.
2 Overlay parent program with the child program. The
child program is now the running process and the
parent process is terminated. spawnlp only returns
a value if there has been a recoverable error. Some
errors can not be recovered from and execution will
terminate by safely returning to DOS. This might
happen if there is not enough memory to run the new
process.
The path argument specifies the file to be executed as the child
process. The path can specify a full path name (from the root
directory \), a partial path name (from the current working directory),
or just a file name. If the path argument does not have a filename
extension or end with a period (.), the spawnlp call first appends
the extension ".COM" and searches for the file; if unsuccessful, the
extension ".EXE" is tried. The spawnlp routine will also search for
the file in any of the directories specified in the PATH environment
variable (using the same procedure as above).
Example usage in Pascal
var NULL : integer4;
value NULL := 0;
...
i := spawnlp(0, ads('exemod'*chr(0)), ads('exemod'*chr(0)),
ads('demoexec.exe'*chr(0)), NULL);
The C spawnlp function is expecting the addresses of the strings
(not the actual characters), so we use the ADS() function to pass
the address of the strings. The last parameter to the spawnlp
routine must be a C NULL pointer which is a 32-bit integer 0, so
we use an INTEGER4 variable NULL set to 0 as the last parameter.
}
function spawnlp : integer [c,varying]; extern;

30
Microsoft Pascal v3.31/PRIMES.PAS Normal file
View File

@ -0,0 +1,30 @@
{ Prime number generator }
{ Generates all the primes between 0 and 10000 }
program primes(output);
var
prime: integer;
rprime: real4;
i: integer;
sqrtp: integer;
notprime: boolean;
begin
writeln(' 2');
writeln(' 3');
prime := 5;
repeat
rprime := prime;
sqrtp := trunc(sqrt(rprime) + 1.0);
i := 1;
notprime := false;
while (i < sqrtp) and (not notprime) do
begin
i := i + 2;
notprime := (prime mod i = 0);
end;
if (not notprime) then writeln(prime:6);
prime := prime + 2;
until (prime > 10000);
end.


630
Microsoft Pascal v3.31/README.DOC Normal file
View File

@ -0,0 +1,630 @@
Pascal v 3.31 - README File
10/10/85
This document presents product information that supercedes
or is not covered in the regular documentation. In
particular, this document covers product changes and
enhancements made immediately prior to release. It is
recommended that the user review the document immediately.
------------------------------------------------------------
Differences between version 3.31 and version 3.30
------------------------------------------------------------
A. Stack size of the compiler has been increased. By using
the included EXEMOD utility, you can specify the amount of
stack space to be available during compilation. If you
specify a bigger stack, you can compile larger programs,
but you will need more memory for the compiler to run.
The compiler comes initially configured with a 40K stack.
If the compiler does not run on your machine, because of
limited memory, you may wish to change the stack size to
some smaller amount. For many programs, a stack size of
10K proves to be ample. You can use EXEMOD to decrease
the stack size.
If the compiler fails with an "out of memory" error, it is
likely that the stack is too small for the program you are
attempting to compile. You can use EXEMOD to increase the
stack size.
B. The linker has been changed so that if it is directed to
combine code segments into a physical segment whose size
is more than 65499 bytes, it will issue a warning message:
"Segment longer than reliable size." The message is only
a warning. The executible file will still be created. An
attempt to build any segment, code or data, longer than
64K will still result in a fatal error.
C. FOR LOOP control variables are no longer set to the unde-
fined value when the loop terminates. See the Reference
Manual, page 322, "$initck-" metacommand, second item #2,
which states that $initck generates code to set the value
of INTEGER range FOR-loop control variables uninitialized
when the loop terminates normally. This is NO LONGER done.
D. Files and versions are as follows:
PAS1.EXE Pascal Compiler version 3.31
LINK.EXE 8086 Object Linker version 3.04
LIB.EXE Library Manager version 3.02
EXEPACK.EXE EXE File Compression Utility version 3.00
EXEMOD.EXE EXE File Header Utility version 3.00
------------------------------------------------------------
Memory Management Details
------------------------------------------------------------
MEMAVL returns the number of bytes from the top of the
heap to the end of DGROUP. If the heap needs to grow, it
will use this space. It should be noted that the space
allocated for the heap can only grow and NEVER SHRINK.
Therefore, during the course of a program, the value re-
turned by MEMAVL can only DECREASE (as the heap grows) and
NEVER INCREASE. The following diagram illustrates this
concept:
--------------------------------- DGROUP:MAX
! FREE SPACE NOT IN HEAP !
---------------------------------
! HEAP !
---------------------------------
! STACK !
---------------------------------
!STATICALLY ALLOCATED PART OF DS!
--------------------------------- DGROUP:0
FREECT(0)*2 returns the number of free bytes in the heap
plus the value returned by MEMAVL.
FREECT(0)*2-MEMAVL returns the number of free bytes in the
heap itself.
In version 3.2, a Pascal program allocates all of free
memory to itself. In version 3.3x, a Pascal program re-
turns space it doesn't need to DOS. Therefore, in version
3.3x, DGROUP is at the top of the allocated space, and
offset 2 in the MS-DOS data area returns the segment para-
graph for the top of DGROUP. See also page 164 of the Mi-
crosoft Pascal Compiler User's Guide for further discuss-
ion of the "upper memory limit."
------------------------------------------------------------
Differences between version 3.30 and version 3.20
------------------------------------------------------------
A. The following sections have been modified or added to the
Microsoft Pascal User's Guide.
Update: Microsoft Pascal 3.3
Appendix A - Differences Between Versions 3.2 and 3.3
Appendix E - Mixed-Language Programming
Appendix F - Error Messages
Microsoft LIB - Library Manager Reference Manual
B. The following files are provided with the Pascal v 3.3
release, but are not completely documented in the User's
Guide. Whatever (additional) information is required to
use these files is provided in this document.
EXEPACK.EXE - Utility for packing .EXE files in order to
reduce their size and allow faster loading (refer to
subsection A.10 of the Microsoft Pascal User's Guide).
EXEMOD.EXE - Utility for viewing and modifying certain
header information in .EXE files (refer to subsection
A.11 of the Microsoft Pascal User's Guide).
CEXEC.LIB - Portion of Microsoft C library providing
routines to support the use of the MS-DOS 'exec'
function (function call 4B hex).
PASEXEC.INC - Interface declarations and documentation for
routines in CEXEC.LIB
DEMOEXEC.PAS - Example program demonstrating how to use
the routines provided in CEXEC.LIB.
EMOEM.ASM - Customization for the 8087.
LVARSTK.OBJ - This object file provides a variable stack.
Note: The version of LINK.EXE is actually v 3.02 (not 3.01,
as documented).
Please refer to the update notice at the beginning of the
User's Guide for a complete list of the files which have
been added to the Pascal v 3.3 release.
C. If your machine has an 8087 or an 80287, you should read
this closely to see if this pertains to your hardware
configuration. All Microsoft languages which support the
8087 need to intercept 8087 exceptions in order to
properly detect error conditions and provide reliable and
accurate results. The math libraries which contain the
8087 exception handler and emulator (MATH.LIB and
8087.LIB) are designed to work without modification with
the following machines:
IBM PC family and compatibles, Wang PC
(any machine which uses NMI for 8087 exceptions)
Texas Instruments Professional Computer
There is a source file EMOEM.ASM included with the release
that can be modified. Any machine which sends the 8087
exception to an 8259 Priority Interrupt Controller (master
or master/slave) should be easily supported by a simple
table change to the EMOEM.ASM module. In the file there
are further instructions on how to modify the file and
patch libraries and executables.
If your computer is not listed, and you need to modify the
EMOEM.ASM program, please contact your hardware
manufacturer for the specific information on the 8087 and
what needs to be modified. If your hardware manufacturer
is not aware of the changes that need to be made they
should contact the Microsoft OEM Group.
The Microsoft Retail Product Support Group is not equipped
to help out in the customization of the EMOEM.ASM program.
D. The library file, CEXEC.LIB, contains the following
routines extracted from the Microsoft C compiler library
(Version 3.0).
system - Invokes COMMAND.COM with a user-specified command
line.
spawn - Loads and executes a specified .COM or .EXE file
(i.e., executes a child process).
The file PASEXEC.INC contains INTERFACE declarations
allowing these routines to be called from Pascal and
extensive comments explaining how to use them.
The file DEMOEXEC.PAS contains an example program
demonstrating the use of these routines.
E. The following is an updated list of language features,
noted in the User's Guide or Reference Manual, that are
not implemented in this release.
1. MARKAS and RELEAS are not supported in the release.
2. The $initchk metacommand does not check for
uninitialized REAL variables.
3. OTHERWISE is not accepted in RECORD declarations.
4. Code is generated for PURE functions, but no checking
is done.
5. The extend level operators SHL, SHR and ISR are not
available.
6. No checking is done for invalid GOTOs.
7. READ, READLN, and DECODE cannot have M and N
parameters.
8. Enumerated I/O, permitting the reading and writing of
enumerated constants as strings, is not available.
9. The metacommands $tagck, $standard, $extend, and
$system can be given, but have no effect.
10. The $inconst metacommand does not accept string
constants.
F. This section documents product features which are not
described in the User's Guide or Reference Manual.
1. Both the Pascal compiler and the runtime library
associate the name "ERR" with the MS-DOS standard error
device handle (generally abbreviated as stderr). Recall
that stderr is mapped to the physical console and,
unlike stdin and stdout, is not redirectable. Thus, the
command syntax:
PAS1 ERR;
will cause the Pascal compiler to expect source code
from the keyboard rather than a file named ERR.PAS.
Similarly, the command syntax:
PAS1 TEST,,ERR;
will cause the source listing output to written to the
console screen rather than a file named ERR.LST.
Finally, note that a file variable may be explicitly
attached to 'ERR' with, say, the ASSIGN procedure and,
thereby, attached to stderr.
2. Both the compiler and the runtime use the Xenix
compatible I/O system in MS-DOS 2.xx/3.xx (MS-DOS 1.xx
is no longer supported). Thus, both the compiler and the
user's program will access files in other directories if
the proper pathnames are specified.
Since MS-DOS has a limit on the number of 'handles' that
may be simultaneously open for I/O, the user may
occasionally encounter an error 1034 ("too many open
files"). This may happen during execution of PAS1.EXE,
if there are nested include files. It may also occur at
runtime if the user tries to have too many files open at
the same time. In most cases, the problem is easily
circumvented using the "FILES = <number>" statement in
the CONFIG.SYS file (see your MS-DOS manual for
details). However, there is a fixed upper limit in MS-
DOS of 20 handles (five preassigned plus 15 others) that
any single program may have open simultaneously.
3. There have been several recent changes to the behavior
and capabilities of the EXEMOD and EXEPACK utilities
provided on this release which are not covered in the
printed manuals.
EXEPACK attempts to prevent you from compressing a file
onto itself. It is not infallible - it can be fooled by
a statement of the form:
EXEPACK TEST.EXE .\TEST.EXE
If it detects an attempt to compress a file onto itself
it will issue the message:
exepack: cannot pack file onto itself
and exit with return code 1. Also, when using EXEPACK
to compress an .EXE file with overlays, the compressed
file should be renamed back to the original name of the
linked file to avoid the overlay manager prompt (see
Overlays in the User Guide).
EXEMOD has an undocumented switch, /h, which can be seen
in the usage prompt (it is not shown in the Users Guide
description of the usage prompt). This option CANNOT be
used with any of the other options, and it is equivalent
to typing:
EXEMOD PROG.EXE
That is, it simply displays the header fields of the
.EXE file without modifying them.
EXEMOD has also been modified to work correctly on
packed (via EXEPACK) files. When it recognizes a packed
file, it will print the message:
exemod: (warning) packed file
If the stack value is changed, it modifies the value
that SP will have AFTER expansion. If either min or
stack is set, min will be corrected as necessary to
accomodate unpacking or stack. Setting max operates as
it would for unpacked files.
If the header of a packed file is displayed, the CS:IP
and SS:SP values are displayed as they will be after
expansion, which is not the same as the actual values in
the header.
The compiler executable files (PAS1, PAS2, and PAS3) are
not packed on the distribution diskettes. We recommend
that when you set up your own diskettes (as recommended
in the manual or otherwise), you run EXEPACK on all the
compiler executable files. You'll notice that the
savings is not great on most of them.
Note: Refer to the MS-DOS Programmer's Reference manual
for further information on .EXE file headers.
4. Controlling the Stack Size - the /STACK Linker option:
/STACK:number
The /STACK option allows you to specify the size of the
stack for your program. The number is any positive
value (decimal, octal, or hexadecimal) up to 65,536
(decimal). It represents the size, in bytes, of the
stack.
Note: The EXEMOD utility, can also be used to change the
default stack size.
5. The allocation of memory for the stack is somewhat more
flexible than a simple fixed stack.
In the User's manual, there is a warning that the
compiler front end and back end now use a fixed stack
and that, since the ratio of stack and symbol table
space varies from one compilation to another, some
programs that used to compile with previous versions,
will now fail for lack of memory. This is not strictly
the case. There is still a maximum amount of stack
space, but when the initial allocation of space for
symbol tables is exhausted, space will be allocated from
the area reserved for the stack. This will cause a
slight reduction in compilation rate if your program is
big enough for this to happen. If, however, your
program fails to compile because of lack of stack space,
(usually as a result of a very complex expression), you
can use EXEMOD on the compiler itself to increase the
space initially reserved for the stack.
Your code compiled with this version will, by default,
use a fixed stack and you may see changes in its
behavior if it tends to use a lot of heap space or a lot
of stack. On the other hand, the fixed stack makes it
much safer to compile with stack checking disabled.
If you want your program to use the stack space for
excess heap items, link with the object module,
LVARSTK.OBJ. Then, your program will have the same
flexibility in its stack allocation as do the compiler
passes themselves. If you further use EXEMOD to change
the default stack size to a much larger number, your
program will behave pretty much as it did with previous
versions, although allocation from the stack space is
not as efficient as from the initial heap space. In this
case, you should also compile with stack checking
enabled since unprotected collisions between the stack
and the heap can lead to unpredictable behavior.
6. The SIZEOF function has been enhanced. It is now
permissable to omit the second parameter if the variable
is a pointer to a super array. Thus, SIZEOF(P^), where P
is a pointer to a super array, is now a valid
expression. Note, however, that if in P^ has not been
allocated (with a NEW), SIZEOF(P^) is undefined. It is
the programmer's responsibility to check that P^ has
actually been allocated before using this form of the
SIZEOF function.
G. This section notes corrections to the documentation.
1. Microsoft User's Guide - Appendix A.8 - page 149:
The 5th paragraph starts out:
"The memory allocation is preset to 6144 (6K)
bytes...."
This paragraph is actually referring to the Stack size,
and the 6K is incorrect. To verify the actual size of
the stack of the compiler passes that you have received,
please use the EXEMOD utility which displays the header
fields of an .exe file.
2. Microsoft Pascal User's Guide - Appendix A.12 - Page
156:
The segment contents for a Pascal program in memory are
listed below (from the highest memory location to the
lowest).
Heap - The "heap" is the area of the default data
segment (DGROUP) that is available for dynamic
allocation at runtime via the NEW procedure. It does not
belong to a named segment and will not show up on a link
map.
STACK - The STACK segment contains the user's stack,
which is used for all LOCAL data items.
_BSS - The _BSS segment contains all UNINITIALIZED
STATIC DATA.
EEND, EDATA - Defined and used by the runtime library.
CONST - The CONST segment contains all CONSTANTS.
P3CE, P3C, P3CB, P2CE, P2C, P2CB, P1CE, P1C, P1CB, P3IE,
P3I, P3IB, P2IE, P2I, P2IB, P1IE, P1I, P1IB, XCE, XC,
XCB, XIE, XI, XIB - Defined and used by the runtime
library.
COMADS - Not used. Part of FORTRAN runtime support.
_DATA - The DATA segment is the default data segment.
All INITIALIZED GLOBAL and STATIC data reside in this
segment.
NULL - The NULL segment is a special purpose segment
that occurs at the beginning of DGROUP. The NULL segment
contains the compiler copyright notice. This segment is
checked before and after the program executes. If the
contents of the NULL segment change in the course of
program execution, it means that the program has written
to this area. This is usually caused by the use of an
uninitialized adr variable, ads variable or pointer. The
error message "Null pointer assignment" is displayed to
notify the user.
__FBSS - Not used. Part of C runtime support.
C_ETEXT - The C_ETEXT segment marks the end of the code
segments. It contains no data and is therefore a segment
of zero length.
Code segments (listed as "module" in the illustration
on page 156) - Each module is allocated its own code
segment (also called a text segment). Code segments are
not combined, so there are multiple code segments.
However, all code segments have class CODE.
It should be noted that segmented memory above DGROUP
may be accessed by the Pascal user via the long heap
allocator. Please refer to Section 8.2.1 in the Pascal
User's Guide for a decription of the necessary library
procedures.
When implementing an assembly language routine to call
or be called from a Pascal program, you will probably
refer to the code and _DATA segments most frequently.
The code for the assembly language routine should be
placed in a user-defined segment with class CODE. Data
should be placed in whichever segment is appropriate to
their use, as described above. Usually this is the
default segment _DATA.
If linking with MS-FORTRAN (3.30) routines, segments for
COMMON blocks or LARGE data items occur between __FBSS
and NULL. Each COMMON block has its own segment(s) and
class. Segments allocated for LARGE data items all have
class LARGE. In the case of a COMMON block with the NEAR
attribute, the segment occurs between EEND and _BSS,
which is then combined in DGROUP.
If linking with MS-C (3.0) routines, data segments,
outside of DGROUP, required for the C routines are
occur between __FBSS and NULL. These segments will have
class name FAR_DATA or FAR_BSS depending on whether they
hold initialized C variables or uninitialized C
variables.
3. Microsoft Pascal User's Guide - Appendix A.12 - Page
158:
The following instructions in the entry and exit
sequences are NOT required:
inc bp
dec bp
The following instructions are included in order to
maintain compatibility with XENIX C, and therefore they
are OPTIONAL:
extrn __chkstk:far
call __chkstk
The following instructions are included in order to
maintain compatibility with MS-DOS C modules, and
therefore they are OPTIONAL:
push di
push si
pop di
pop si
4. Microsoft Pascal User's Guide - Appendix D.2 - page
176:
It is not permitted to mask the invalid operation bit on
the 8087 control word.
5. Microsoft Pascal Reference Manual, Chapter 8.4.1 - page
92:
A TERMINAL mode file should be accessed as a file of
TEXT if input is to be READ from it. In particular,
since the console/keyboard is always treated as a
TERMINAL mode file, it should always be accessed as a
file of TEXT for READing. If single character,
unbuffered, unechoed input from the keyboard is
necessary, the function DOSXQQ should be used to call
for this service from MS-DOS directly (see Appendix B,
Version Specifics, of the Microsoft Pascal User's
Guide).
6. Microsoft Pascal Reference Manual, Chapter 15.2 - page
240:
The function, LMULOK, is the very function ultimately
called to perform the multiplication in any integer4
product (e.g., the code generated for i := j * k;, where
i,j,k: integer4, will invoke LMULOK). Direct access to
this routine is supported so that the user can perform
an integer4 multiplication which overflows without
having the program abort with a fatal runtime error.
The value of the product is well-defined only in the
case where the product does not overflow (i.e., LMULOK
returns TRUE). The reason for this is that the overflow
condition is generally detected before the
multiplication is complete and computation ceases as
soon as the overflow is detected. The documentation
indicates that the product is always computed and
returned and this is clearly incorrect!
H. The following public variables, defined in entx6l.asm in
earlier versions of MS-Pascal, no longer exist in version
3.3.
BEGHQQ
BEGMQQ
CURHQQ
ENDHQQ
ENDMQQ
MAXMQQ
The following public variables, defined in entx6l.asm in
earlier versions of MS-Pascal, still exist in version
3.30. Note, however, that only CESXQQ, CRCXQQ, CRDXQQ and
DOSEQQ are intended for direct access by the user.
CESXQQ - DOS saved ES value (for command line)
CLNEQQ - last line number encountered
CRCXQQ - value of CX for DOS call
CRDXQQ - value of DX for DOS call
CSXEQQ - pointer to sourcef context list
DGRMQQ - segment of DGROUP
DOSEQQ - DOS return code
HDRFQQ - Unit F open file list header
HDRVQQ - Unit V open file list header
PNUXQQ - pointer to unit initialization list
RECEQQ - machine error context, program segment
REFEQQ - machine error context, frame ptr
REPEQQ - machine error context, program offset
RESEQQ - machine error context, stack ptr
STKBQQ - stack start, to fix long GOTO
STKHQQ - stack limit, to check overflow
UPCX87 - offset address of 8087 error context
I. When reporting a suspected problem with the compiler to
the Retail Product Support Group, we ask that you please
provide the following information to help us in tracking
down the problem.
1. The shortest possible example which can be used to
demonstrate the alleged problem (the example should be
provided in source code, on a standard 5 1/4" MS-DOS
disk or a hard copy listing if it is very short).
2. A complete description of the symptoms of the problem
including complete directions on reproducing these
effects with the supplied example (compilation options
used, libraries linked with,...,etc.).
3. The compiler version number (from the logo that is
printed out when you run PAS1).
4. Your system configuration, both hardware (machine,
total memory, coprocessor,...,etc.) and software
(version of DOS, terminate-and-stay-resident utilities
or unusual system software, free memory as indicated by
chkdsk,...,etc.).
Having this information will be of immense help to us in
our effort to diagnose and solve your problem.


32
Microsoft Pascal v3.31/SIEVE.PAS Normal file
View File

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

59
Microsoft Pascal v3.31/SORT.PAS Normal file
View File

@ -0,0 +1,59 @@
{ Bubble Sort Demonstration Program }
{ Microsoft Pascal 3.1 }
{ The main routine reads from the terminal an array }
{ of ten real numbers and calls the procedure BUBBLE }
{ to sort them. }
program BubbleSort(input,output);
const
TABLEN = 10; { Length of reals table }
type
TABLE = array[1 .. TABLEN] of real4;
{ Table of reals type }
var
R: TABLE; { The table itself }
i: integer; { Table index }
procedure Bubble(var t: TABLE); { The sorting routine }
var
i: integer; { Index variable }
j: integer; { Index variable }
temp: real4; { Exchange variable }
begin
for i := 1 to 9 do { Outer loop }
begin
for j := i + 1 to 10 do { Inner loop }
begin
if (t[i] > t[j]) then { Sort in ascending order }
begin
temp := t[i]; { Perform the }
t[i] := t[j]; { exchange of }
t[j] := temp; { table elememts }
end;
end;
end;
end;
begin
writeln(' Bubble Sort Demonstration Program.');
for i := 1 to 10 do { Loop to read in reals }
begin
writeln(' Please input real number no. ',i:2);
{ Prompt user }
readln(R[i]); { Read response }
end;
Bubble(R); { Sort the array }
writeln; { Skip a line }
writeln(' The sorted ordering from lowest to highest is:');
{ Print a header }
for i := 1 to 10 do { Loop to print array }
begin
write(R[i]); { Write a number }
if (i mod 5 = 0) then writeln;
{ Five numbers per line }
end;
end.

82
Microsoft Pascal v3.31/TAP.PAS Normal file
View File

@ -0,0 +1,82 @@
program tap( output );
var
loops, i, rsf, prev, total, greatest, a, b, c : integer;
v, ri, rtotal : real;
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;
write( ' at ', i );
writeln( ' iterations: ', sofar );
end;
end;
end;
begin { tap }
writeln( 'tap starting, should tend towards 1.2020569031595942854...' );
writeln( 'first implementation...' );
first_implementation;
{ no Random
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 }

297
Microsoft Pascal v3.31/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.

BIN
Microsoft Pascal v3.31/djldos.OBJ Normal file
View File

Binary file not shown.

121
Microsoft Pascal v3.31/djldos.asm Normal file
View File

@ -0,0 +1,121 @@
; utility functions for calling into DOS from Microsoft Pascal v1 through v4
;
; function dostime : word; External;
; var startTicks: word;
; startTicks := dostime;
;
; function getpsp : word; External;
; var psp : word;
; psp := getpsp;
;
; function pspbyte( offset : word ) : integer; External;
; var result : integer;
; result := pspbyte( 80 ); { get command tail length }
;
.model large
code segment
assume cs:code
; returns a count of hundredths of a second in ax
; only uses hs, seconds, and the low digit of minutes since that's all that fits in two bytes
; 54000 = 9 * 60 * 100
; + 5900 = 59 * 100
; + 99
; --------
; 59999
public getticks
getticks PROC FAR
push bx
push cx
push dx
push di
push si
mov ah, 2ch
int 21h
push dx
mov ah, 0
mov al, dh
mov bx, 100
mul bx
pop dx
mov dh, 0
add ax, dx
push ax
mov ax, cx
and ax, 0ffh
mov cx, 10
mov dx, 0
div cx
mov ax, dx
mov cx, 6000
mul cx
pop bx
add ax, bx
pop si
pop di
pop dx
pop cx
pop bx
ret
getticks ENDP
public getpsp
getpsp PROC FAR
push bx
push cx
push dx
push di
push si
mov ah, 062h
int 21h
mov ax, bx
pop si
pop di
pop dx
pop cx
pop bx
ret
getpsp ENDP
public pspbyte
pspbyte PROC FAR
push bx
push cx
push dx
push di
push si
push es
push bp
mov bp, sp
mov ah, 062h
int 21h
mov es, bx
; the argument is here. 7 pushes above + 2 for the return address = 9 * 2 = 18.
mov bx, word ptr[ bp + 18 ]
xor ah, ah
mov al, byte ptr es: [ bx ]
pop bp
pop es
pop si
pop di
pop dx
pop cx
pop bx
ret
pspbyte ENDP
code ends
end

6
Microsoft Pascal v3.31/m.bat Normal file
View File

@ -0,0 +1,6 @@
ntvdm -c pas1 %1,%1,%1,%1
ntvdm -c pas2
ntvdm -c pas3
ntvdm -c link %1 djldos,,,,
ntvdm -p %1

BIN
Microsoft Pascal v3.31/mspv3.exe Normal file
View File

Binary file not shown.

BIN
Microsoft Pascal v3.31/tttmsp10.exe Normal file
View File

Binary file not shown.