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

dr mt+86 pascal v3.1.1

Browse Source
This commit is contained in:
davidly 2024-06-30 11:44:12 -07:00
parent e866cd3978
commit 3bdae09a1d
58 changed files with 3348 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Digital Research MT+86 Pascal v311/87REALS.R86 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/87TRANS.R86 Normal file
View File

Binary file not shown.

124
Digital Research MT+86 Pascal v311/ASMERS.TXT Normal file
View File

@ -0,0 +1,124 @@
101 Non-identifier in column 1
102 Label identifier preceding colon has been declared before
103 Only DD, DW, and DB allowed within a structure definition
104 Segment identifier declared before
105 Too many nested segments
106 Group identifier declared before
107 Proc identifier declared before
108 Illegal symbol in proc directive
109 Structure identifier declared before
110 No symbol may follow STRUC
111 identifier on ENDS does not match the corresponding SEGMENT command
112 More ENDS commands than Segment commands
113 identifier on RECORD previously defined
114 identifer on DB previously defined
115 Group directive must have an identifier
116 PROC directive must have an identifier
117 STRUC directive must have an identifier
118 LABEL directive must have an identifier
119 Label identifier on LABEL statement has been declared before
120 EXTRN directive must not have a label
121 EXTRN directive must be followed by list of "id : type" pairs
122 identifier in EXTRN list declared previously
123 identifier must be follow by ":" in EXTRN list
124 type in EXTRN list must be ABS, BYTE, WORD, DWORD, NEAR, or FAR
125 type after LABEL must be BYTE, WORD, DWORD, NEAR, or FAR
126 Bad token in SEGMENT directive
127 EQU statements must have a label
128 Label on EQU statement previously defined
129 Improper matching of SEGMENT, ENDS pairs
130 Program name must be a unique identifier
131 NAME directive has only one argument
132 Token following INCLUDE must be a string
133 Include file name must end the INCLUDE directive
134 Nexted include files are not allowed
135 Argument to IF must be an equated symbol
136 Mismatch of IF, ELSE, ENDIF directives
137 Extra tokens following IF, ELSE, or ENDIF
138 End of file encountered
139 Only one program name may be declared
140 Label type must end the LABEL statement
141 Name directive can not have a label
201 This opcode must have no operands
202 Assume requires a segment register name
203 Segment register in assume must be followed by ":"
204 Segment name, group name, SEG expression or NOTHING required
205 SEG operator in assume must be followed by an identifier
206 SEG operator in assume must be followed by a variable or label
207 Identifier must follow ":" in assume list
208 Comma expected in assume list
209 Only one operand allowed with this opcode
210 Two operands required with this opcode
211 Only two operands allowed with this opcode
212 Index expression not closed with right bracket
213 PTR expected
214 override symbol must be group or segment
215 ":" expected
216 no fundamental value may start this way
217 Right bracket expected
218 Invalid symbol for dot operator
219 Right paren expected
220 Inproper argument to length operator
221 Improper argument to size operator
222 Improper argument to width operator
223 Improper argument to mask operator
224 Improper argument to offset operator
225 Improper argument to seg operator
226 Improper argument to type operator
227 THIS must be followed by BYTE, WORD, DWORD, NEAR, or FAR
228 Index register encountered outside brackets
229 Nested indexing not allowed
230 Bad operands to addition operator
231 More than one base in expression
232 More than one index in expression
233 Bad operands to subtraction operator
234 Index registers may not be subtracted
235 Relative labels in subtraction must have the same base
236 Relative number in subtraction must be offsets of the same base
237 Invalid id in expression
238 Invalid symbol type in type operator
239 Low and high are invalid for relocatable segment bases
240 Operands must be non-indexed, absolute numbers to this operator
241 Operand types not compatable with this opcode
242 Nested procedures not allowed
243 ENDP not preceded by PROC
244 At expression must be an absolute number
245 List elements in PUBLIC must be identifiers
246 List elements in PUBLIC must be seperated by a comma
247 DUP factor in DB, DW, and DD must be an absolute number
248 Expressions in list for DB, DW, and DD must be seperated by a comma
249 DUP must be followed by a parenthesized expression list
250 Bad expression in DUP list
251 Relocatable bytes are not allowed
252 Only CODE or DATA relative references are allowed
253 Can not generate code for group overrides
254 Can not generate code for this relocatable number
255 No segment register assumed for this segment
256 Operand must be accessable through ES for this opcode
257 Improper call to Modrm_formal
258 Incompatable operans to relation operator
259 Argument to OFFSET operator must be a variable or label
260 Relative byte out of range (not short)
261 CS may not be popped
262 Too many expressions to DB, DW, or DD
263 Can not generate code for a relocatable segment base
264 Can not generate code for relocatable bytes or segment bases
265 Relocatables must be CODE or DATA relative
266 External references must be from the CODE segment
267 Publics must reside in the CODE or DATA segment
268 Publics must be labels, variables, or procedures
269 Externals must reside in the CODE or DATA segment
270 Externals must only be referenced from the CODE segment
271 EQU's must be defined before being used.
272 Literal strings within expression may not be longer than 2 characters
273 Illegal token in opcode field
274 END statement may not have a label
275 END may only be followed by one code label
276 ORG accepts only one expression as an argument
277 Expression to ORG must be completely previously defined
279 Expression following DUP must be within parenthesis
300 Phase 2 location of label does not match phase 3 location
400 Illegal character in text
401 Illegal digit in number
402 Numbers may not terminate with '$'
403 Strings may not be greater than one line long

BIN
Digital Research MT+86 Pascal v311/ASMT86.001 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/ASMT86.002 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/ASMT86.003 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/ASMT86.004 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/ASMT86.EXE Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/BCDREALS.R86 Normal file
View File

Binary file not shown.

120
Digital Research MT+86 Pascal v311/CALC.SRC Normal file
View File

@ -0,0 +1,120 @@
(* AS OF 03/12/82 *)
(* This program ia a sample PASCAL MT+86 program. It makes your *)
(* computed function as a pocket calculator. To use this program *)
(* simply compile it, link it with TRANCEND.R86, FPREALS.R86 and *)
(* PASLIB. The compiler control command is: *)
(* MT+86 CALC *)
(* The linker command is: *)
(* LINKMT CALC,TRANCEND,FPREALS,PASLIB/S *)
(* To execute enter: *)
(* CALC *)
PROGRAM CALCULATE;
CONST
RCONST = -2.5;
RCONST1= 65535.5;
VAR R1,R2,TEMP:REAL;
X : ARRAY [1..2] OF REAL;
CH1,OP:CHAR;
FUNCTION SUBREAL(R1,R2:REAL) : REAL;
BEGIN
SUBREAL := R1 - R2
END;
PROCEDURE ADDREAL(VAR R1:REAL; R2:REAL);
BEGIN
R1 := R1 + R2
END;
PROCEDURE TF(B:BOOLEAN);
BEGIN
IF B THEN
WRITELN('TRUE')
ELSE
WRITELN('FALSE')
END;
PROCEDURE CALC;
BEGIN
CASE OP OF
'S': WRITELN(SIN(R1));
'C': WRITELN(COS(R1));
'A': WRITELN(ARCTAN(R1));
'L': WRITELN(LN(R1));
'E': WRITELN(EXP(R1));
'+': BEGIN ADDREAL(X[1],X[2]); WRITELN(X[1]:10:4) END;
'-': WRITELN(SUBREAL(X[1],X[2]):10:2);
'*': WRITELN(R1 * R2);
'/': WRITELN(R1 / R2);
'M': WRITELN(-R1);
'=': TF(R1 = R2);
'N': TF(R1 <> R2);
'$': WRITELN(SQRT(R1):10:3,SQRT(R2):10:3);
'<': TF(R1 < R2);
'>': TF(R1 > R2);
'Z': TF(R1 <= R2);
'G': TF(R1 >=R2);
'1': WRITELN(SQR(R1),' ',SQR(R2));
'2': WRITELN(R1 + 1);
'3': WRITELN(1+R1);
'4': WRITELN(TRUNC(R1));
'5': WRITELN(ROUND(R1));
'6': WRITELN(RCONST);
'7': WRITELN(RCONST1);
'8': BEGIN R1 := -2.234; X[1] := 3.456; WRITELN(R1,' ',X[1]); END;
END;
END; (* CALCULATOR *)
PROCEDURE MENU;
BEGIN
WRITE('S:SIN ');
WRITE('C:COS ');
WRITE('A:ARCTAN ');
WRITE('L:LN ');
WRITE('E:EXP ');
WRITE('1:SQR ');
WRITELN('$:SQRT ');
WRITELN('+, -, *, / ARITHMETIC OPERATORS');
WRITELN('M:NEGATE');
WRITE('= : EQUAL ');
WRITELN('N : NOT EQUAL');
WRITE('<:LESS THAN ');
WRITELN('>:GREATER THAN ');
WRITELN('Z:LESS THAN OR EQUAL TO');
WRITELN('G:GREATER THAN OR EQUAL TO');
WRITE('4:TRUNC ');
WRITELN('5:ROUND');
END;
BEGIN (* MAIN PROGRAM *)
REPEAT
WRITE('ENTER FIRST OPERAND? ');
READ(R1);
X[1] := R1;
WRITELN('R1=',R1); WRITELN;
WRITE('ENTER SECOND OPERAND? ');
READ(R2);
X[2] := R2;
WRITELN('R2=',R2); WRITELN;
WRITELN('ENTER OPERATOR:');
MENU;
WRITE('? ');
READ(OP);
WRITELN;
CALC;
WRITELN('Type <ESCAPE> to stop. Any other characer to repeat.');
READ(CH1);
UNTIL CH1 = CHR(27)
END.


43
Digital Research MT+86 Pascal v311/CPMGET.SRC Normal file
View File

@ -0,0 +1,43 @@
(*$S+*) (* rmx/udi version *)
MODULE GETREC;
(*$I FIBDEF.LIB*)
VAR
@LFB: EXTERNAL ^FIB;
EXTERNAL PROCEDURE @RNB;
PROCEDURE GET(VAR F:FIB; SZ:INTEGER);
VAR
IS_EOLN : BOOLEAN;
BEGIN
F.FEOLN := FALSE; (* DEFAULT IS THAT WE RESET IT *)
@LFB := ADDR(F);
IF F.FEOF THEN
BEGIN
F.FEOLN := TRUE;
EXIT
END;
@RNB; (* GO READ FROM THE FILE/CONSOLE *)
IF F.FTEXT THEN (* TEXT FILE, EOLN/EOF MUST BE SET *)
BEGIN
F.FEOF := (F.FBUFFER[0] = CHR($1A)) OR (F.FEOF);
IS_EOLN := (F.FBUFFER[0] = CHR($0D)); (* $0D for rmx/udi *)
IF (IS_EOLN) OR (F.FEOF) THEN
F.FEOLN := TRUE;
IF (IS_EOLN) AND (F.OPTION = FRDWR) THEN (* GOBBLE LF *)
@RNB;
IF F.FEOF OR F.FEOLN THEN
F.FBUFFER[0] := ' ';
END
END;
MODEND.


BIN
Digital Research MT+86 Pascal v311/CPMINI.SRC Normal file
View File

Binary file not shown.

22
Digital Research MT+86 Pascal v311/DBUGHELP.TXT Normal file
View File

@ -0,0 +1,22 @@
<parm> = (<name> or <num>) +/- <num>
<num> = <int> or $ <hexnum> or $<hexnum>:<hexnum>
<name> = <varname> or <procname> : <varname>
Display commands:
D? <parm> where ? is as follows
I - INTEGER C - CHAR L - BOOLEAN R - REAL
B - BYTE W - WORD S - STRING X - EXTENDED
V - var by name
VN - display ALL variable names
PN - display procnames
VN <procname> - display all var names associated with this proc
SB <procname> - Set breakpoint
RB <procname> - Remove breakpoint
E+ Entry/Exit display on
E- Entry/Exit display off
BE Begin exec at start of user prog
GO Continue exec from breakpont
TR Exec one Pascal statement and return
SE <parm> SEt <parm>
T<num> Trace <num> Pascal statements and return


BIN
Digital Research MT+86 Pascal v311/DEBUGGER.R86 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/DIS86.EXE Normal file
View File

Binary file not shown.

42
Digital Research MT+86 Pascal v311/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.


17
Digital Research MT+86 Pascal v311/ECHO.SRC Normal file
View File

@ -0,0 +1,17 @@
program echo;
type
pstrg = ^string;
var
p : pstrg;
external function @cmd : pstrg;
begin (* echo *)
p := @cmd;
writeln(p^)
end.
:

BIN
Digital Research MT+86 Pascal v311/ECHOCODE.EXE Normal file
View File

Binary file not shown.

26
Digital Research MT+86 Pascal v311/FIBDEF.LIB Normal file
View File

@ -0,0 +1,26 @@
(* VERSION 0001 *)
(* DATE 03/17/82*)
(* definition of file info block for unix/udi *)
type
fibpaoc = packed array [0..0] of char;
fib = record
fname : string[37]; (* 0 *)
dummy, (* to align everything on word boundary *)
option: (notopen,fwrite,frdwr,frandom, (* 38 *)
fconio,ftrmio,flstout,fauxio)
buflen: integer; (* 40 *)
bufidx: integer; (* 42 *)
iosize: integer; (* 44 *)
feoln, (* 47 *)
feof : boolean; (* 46 *)
fbufadr:^fibpaoc; (* 48 *)
nosectrs, (* 53 *)
ftext : boolean; (* 52 *)
sysid: integer; (*fileid on unix, conn for udi 54 *)
fbuffer: fibpaoc (* 56 *)
end;
.

52
Digital Research MT+86 Pascal v311/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
Digital Research MT+86 Pascal v311/FPREALS.R86 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/FULLHEAP.R86 Normal file
View File

Binary file not shown.

29
Digital Research MT+86 Pascal v311/HLTPC.I86 Normal file
View File

@ -0,0 +1,29 @@
NAME HLT
ASSUME CS:CODE,DS:DATA
DATA SEGMENT PUBLIC
DATA ENDS
CODE SEGMENT PUBLIC
;
; @HLT FOR PCDOS ... ALSO INCLUDES @BDOS
;
; MODIFIED 12-11-81 BY MGL TO SAVE/RESTORE BP AROUND A SYSTEM CALL
;
PUBLIC @HLT
EXTRN JTABLE:NEAR ;DEFINED IN PCINT.I86
@HLT PROC NEAR
xor ax,ax ;zero AX
mov si,ax
jmp jtable
@HLT ENDP
;
; NEVER RETURNS
;
CODE ENDS
END


154
Digital Research MT+86 Pascal v311/INIPC.I86 Normal file
View File

@ -0,0 +1,154 @@
; VERSION 0002
NAME INIT3
ASSUME CS:CODE,DS:DATA
DATA SEGMENT PUBLIC
DATA ENDS
CODE SEGMENT PUBLIC
EXTRN @HLT : NEAR
PUBLIC INIPC
PUBLIC @INI3
INIPC PROC FAR
;
; this routine is adapted for PCDOS.
;
MOV AX,CS
ADD AX,CS:WORD PTR [3] ;ADD CODE SIZE
ADD AX,CS:WORD PTR [5] ;ADD DATA SIZE
ADD AX,CS:WORD PTR [7] ;ADD STACK SIZE
ADD AX,CS:WORD PTR [9] ;ADD EXTRA SIZE
CMP AX,DS:WORD PTR [2] ;COMPARE WITH MAX MEMORY
JNA MEMOK
PUSH DS ;SAVE ADDRESS OF PSP
CALL OUTOFMEM
DB 'OUT OF MEMORY'
DB 0AH
DB 0DH
DB '$'
OUTOFMEM:
MOV AX,CS ;SET OF DS:DX TO POINT TO MESSAGE
MOV DS,AX
POP DX
MOV AH,09 ;DO PRINT STRING
INT 021H
XOR AX,AX ;SEGMENT ADDRESS OF PSP IS ON STACK BECAUSE WE
;PUSHED DS ABOVE
PUSH AX ;PUSH OFFSET=0 ONTO STACK
RET ;AND TERMINATE THROUGH PSP
MEMOK:
;
; MEMORY IS AVAILABLE. SET UP BASE PAGE
;
; DETERMINE DS LOCATION
MOV AX,CS
ADD AX,CS:WORD PTR [3] ;ADD CODE SIZE TO GET BASE OF DATA
; COPY PROGRAM SEGMENT PREFIX TO BASE PAGE
MOV ES,AX
MOV DI,0
MOV SI,DI
CLD
MOV CX,100H
REP
MOVSB
; SAVE PSP ADDRESS IN BASE PAGE
MOV ES:WORD PTR [40H],DS
; SET UP DS REGISTER
MOV DS,AX
; SAVE ADDRESS OF DATA IN BASE PAGE
MOV WORD PTR [09H],DS
; COMPUTE BASE OF EXTRA SEGMENT
ADD AX,CS:WORD PTR [5] ;ADD SIZE OF DATA
MOV WORD PTR [0FH],AX
;COMPUTE BASE OF STACK
ADD AX,CS:WORD PTR [09H] ;ADD LENGTH OF EXTRA
MOV WORD PTR [15H],AX
MOV CX,4 ;CONVERT STACK SIZE FROM PARA TO BYTES
MOV BX,CS:WORD PTR [07H]
SHL BX,CL
MOV WORD PTR [12H],BX ;SAVE IN BASE PAGE
;SET UP STACK POINTERS
PUSHF
POP DX
CLI
MOV SS,AX
MOV SP,BX
STI
PUSH DX
POPF
;
;NOW CHANGE SIZES TO BYTES NOT PARAGRAPHS.
; AND SAVE IN BASE PAGE
;
MOV AX,CS:WORD PTR [5] ;GET DATA SIZE
MOV CL,04
SHL AX,CL
MOV WORD PTR [06],AX
MOV AX,CS:WORD PTR [09H] ;GET EXTRA SIZE
MOV BX,AX ;SAVE SIZE
MOV CL,04
SHL AX,CL
MOV WORD PTR [0CH],AX ;SAVE LOW ORDER BYTES
MOV AX,BX
MOV CL,12
SHR AX,CL
MOV BYTE PTR [0EH],AL ;SAVE TOP BYTE
MOV AX,CS
ADD AX,8
PUSH AX
XOR AX,AX
PUSH AX
RET ;RETURN TO MAIN PROGRAM
INIPC ENDP
@INI3 PROC NEAR
MOV AX,DS
MOV ES,AX ;NOW ES:0 IS START OF DATA AREA
MOV DI,6 ;6 IS OFFSET OF DSEG LENGTH
MOV CX,ES:WORD PTR [DI]
SUB CX,100H ;SEGMENT LENGTH IS IN BYTES
MOV DI,100H ;START ADDRESS OF FILL
XOR AX,AX ;DATA TO FILL WITH
REP
STOSB ;ZERO IT ALL
;
; NOW IF OVERLAYS ARE LINKED INTO THE ROOT ZERO THE FIRST
; BYTE OF THE OVERLAY AREAS
;
MOV AX,CS
MOV ES,AX ;NOW CS:0 IS START OF CODE
MOV DI,0CH ;0C IS OFFSET OF NAME CONTROL BLOCK
MOV AX,ES:WORD PTR [DI]
MOV BX,ES:WORD PTR 2[DI]
;
; IF AX=BX THEN OVERLAYS WERE NOT LINKED INTO THIS PROGRAM
;
CMP AX,BX
JZ XIT
MOV DI,BX ;ELSE EI:DI NOW POINTS TO OVERLAY AREA TABLE
MOV CX,16 ;NUMBER OF ENTRIES IN THE TABLE
LP: MOV SI,ES:WORD PTR [DI] ;GET OFFSET OF OVERLAY AREA
MOV ES:BYTE PTR [SI],0 ;PUT A ZERO THERE
INC DI ;AND BUMP TO NEXT OFFSET IN TABLE
INC DI
LOOP LP ;DO IT 16 TIMES
XIT: RET
@INI3 ENDP
CODE ENDS
END


96
Digital Research MT+86 Pascal v311/IOALONE.DOC Normal file
View File

@ -0,0 +1,96 @@
If you wish to use MT+86 programs in a stand-alone mode, you
must rewrite @RNC, @WNC, GET and PUT. Skeletons for these routines
are provided below.
Copyright 1982 by Digital Research, Inc.
(*$I FIBDEF.LIB*)
TYPE
PTR = ^BYTE;
var
@lfb : external ^fib;
@SYSIN : EXTERNAL PTR;
@SYSOU : EXTERNAL PTR;
EXTERNAL PROCEDURE @PUTCH(CH:CHAR);
EXTERNAL FUNCTION @GETCH : CHAR;
EXTERNAL PROCEDURE @RNB;
EXTERNAL PROCEDURE @WNB;
FUNCTION @RNC:CHAR;
(* this function returns the first character in the file buffer. *)
(* It is used for TEXT and File of Char input. *)
BEGIN
IF @LFB^.OPTION > FRANDOM THEN (* DON'T GIVE BUFFER, BUT READ DIRECTLY *)
(* IF CONSOLE/TERMINAL FILE *)
BEGIN
GET(@LFB^,@LFB^.BUFLEN); (* fill input buffer *)
@RNC := @LFB^.FBUFFER[0] (* return window variable *)
END
ELSE
BEGIN
@RNC := @LFB^.FBUFFER[0]; (* @RNC := F^ *)
GET(@LFB^,@LFB^.BUFLEN); (* GET(F) *)
END
END;
PROCEDURE @WNC(CH:CHAR);
(* The oposite of RNC *)
BEGIN
@LFB^.FBUFFER[0] := CH; (* F^ := CH *)
PUT(@LFB^,@LFB^.BUFLEN) (* PUT(F) *)
END;
PROCEDURE GET(VAR F:FIB; SZ:INTEGER);
(* This routine fills the buffer in the FIB and checks for *)
(* EOF and EOLN. @RNB must be written by the user. IOSIZE *)
(* is the window size in bytes *)
VAR
IS_EOLN : BOOLEAN;
BEGIN
F.FEOLN := FALSE; (* DEFAULT IS THAT WE RESET IT *)
@LFB := ADDR(F);
IF F.FEOF THEN
BEGIN
F.FEOLN := TRUE;
EXIT
END;
@RNB; (* GO READ FROM THE FILE/CONSOLE *)
(* into f.fbuffer *)
IF F.FTEXT THEN (* TEXT FILE, EOLN/EOF MUST BE SET *)
BEGIN
F.FEOF := (F.FBUFFER[0] = CHR($1A)) OR (F.FEOF);
IS_EOLN := (F.FBUFFER[0] = CHR($0D)); (* $0D for rmx/udi/cpm *)
IF (IS_EOLN) OR (F.FEOF) THEN
F.FEOLN := TRUE;
IF (IS_EOLN) AND (F.OPTION = FRDWR) THEN (* GOBBLE LF *)
@RNB;
IF F.FEOF OR F.FEOLN THEN
F.FBUFFER[0] := ' ';
END
END;
PROCEDURE PUT(VAR F:FIB; SZ:INTEGER);
BEGIN
@LFB := ADDR(F);
@WNB (* GO WRITE BUFFER OUT *)
END;
Sample routines for @RNB and @WNB can be found in IOMOD.
Licensed users are granted the right to use these skeleton
routines.
Pascal/MT+86 is a trademark of Digital Research. Inc.
All information Presented Here Is Proprietary to Digital Research.


487
Digital Research MT+86 Pascal v311/IOMOD.SRC Normal file
View File

@ -0,0 +1,487 @@
(* VERSION 0019 *)
(* Release 3.0 - April 1, 1982 - MGL *)
(* 06/08/81 *)
(* 08/11/81 *)
(* 12/01/81 FIXED @RNB TO SET IOSIZE *)
(* 01/14/82 FIXED @CLOSE TO FLUSH BUFFER IF BUFIDX = SIZEOF(SECTOR) *)
(* 03/07/82 ADDED maxfcbs and list device i/o, also blockw sets foption *)
(* 03/11/82 Added code to handle multi extent files in block i/o *)
(* 03/12/82 Split block i/o out into a separate file "blkio.src" *)
(* 03/17/82 Added RDR: and PUN: devices *)
(*$S+*)
MODULE IOMODULE;
(* INTERFACE TO CP/M-86 FOR PASCAL/MT+86 *)
(*$I FIBDEF.LIB*)
const
maxfcbs = 9;
TYPE
FPTR = ^FIB;
FCBLK = PACKED ARRAY [0..36] OF CHAR;
SECTOR = PACKED ARRAY [0..127] OF CHAR;
DUMMY = PACKED ARRAY[0..0] OF CHAR;
PTR = ^DUMMY;
FCBREC = RECORD
ACTIVE : BOOLEAN;
FCB : FCBLK;
BUFIDX : INTEGER;
BUFFER : SECTOR;
ENDFILE: BOOLEAN
END;
PTRIX = RECORD
CASE BOOLEAN OF
TRUE : (LO_VAL:INTEGER;
HI_VAL:INTEGER);
FALSE: (P:PTR)
END;
VAR
@LFB : FPTR;
RESULTI : INTEGER;
@FCBS : ARRAY [0..maxfcbs] OF FCBREC;
(* ALLOWS 10 SIMULTANEOUSLY OPEN FILES *)
(* THE CONSOLE TAKES TWO FILE SLOTS *)
(* FOR CON: AS INPUT AND CON: AS OUTPUT *)
EXTERNAL FUNCTION @BDOS86(FUNC:INTEGER; PARM:PTR):BYTE;
EXTERNAL FUNCTION @BDOS86A(FUNC:INTEGER; FIRST,SECOND:INTEGER):BYTE;
(* @BDOS86A WILL RESOLVE TO @BDOS86 AT LINK TIME BUT USE DIFFERENT PARMS *)
EXTERNAL PROCEDURE @BDOSX(FUNC:INTEGER; CH:CHAR);
EXTERNAL PROCEDURE @CHN(P:PTR);
EXTERNAL PROCEDURE @HLT;
(*$E-*)
FUNCTION GET_AN_FCB:INTEGER;
VAR
I : INTEGER;
BEGIN
I := 0;
WHILE I <= maxfcbs+1 DO
BEGIN
IF NOT(@FCBS[I].ACTIVE) THEN (* WE FOUND ONE! *)
BEGIN
GET_AN_FCB := I;
@FCBS[I].ACTIVE := TRUE;
EXIT
END
ELSE
I := I + 1
END;
I := -1;
WRITELN('FCB Table Exhausted!');
@HLT;
END;
PROCEDURE FREE_AN_FCB(FCBNUM:INTEGER);
BEGIN
@FCBS[FCBNUM].ACTIVE := FALSE
END;
PROCEDURE PUTSECTOR(I:INTEGER);
BEGIN
RESULTI := @BDOS86(26,ADDR(@FCBS[I].BUFFER));
RESULTI := @BDOS86(21,ADDR(@FCBS[I].FCB));
END;
FUNCTION GETSECTOR(I:INTEGER):BOOLEAN;
BEGIN
GETSECTOR := TRUE; (* FALSE MEANS EOF *)
RESULTI := @BDOS86(26,ADDR(@FCBS[I].BUFFER));
RESULTI := @BDOS86(20,ADDR(@FCBS[I].FCB));
IF RESULTI <> 0 THEN
GETSECTOR := FALSE;
END;
FUNCTION @SPN(VAR F:FIB):BOOLEAN;
BEGIN
@SPN := FALSE;
IF F.FNAME = 'CON:' THEN
BEGIN
F.OPTION := FCONIO;
@SPN := TRUE
END
ELSE
IF F.FNAME = 'LST:' THEN
BEGIN
F.OPTION := FLSTOUT;
@SPN := TRUE
END
ELSE
IF (F.FNAME = 'KBD:') OR (F.FNAME = 'TRM:') THEN
BEGIN
F.OPTION := FTRMIO;
@SPN := TRUE
END
ELSE
IF (F.FNAME = 'RDR:') OR (F.FNAME = 'PUN:') THEN
BEGIN
F.OPTION := FAUXIO;
@SPN := TRUE
END
END;
FUNCTION @NOK(VAR S:STRING):BOOLEAN;
VAR
I : INTEGER;
ST: SET OF CHAR;
BEGIN
@NOK := FALSE;
ST := [' '..CHR($7E)];
IF (LENGTH(S) > 14) OR (LENGTH(S) < 1) THEN
EXIT;
FOR I := 1 TO LENGTH(S) DO
IF NOT(S[I] IN ST) THEN
EXIT;
@NOK := TRUE
END;
FUNCTION UPPERCASE(CH:CHAR):CHAR;
BEGIN
IF (CH >= 'a') AND (CH <= 'z') THEN
CH := CHR(CH & $DF);
UPPERCASE := CH
END;
(*$E+*)
PROCEDURE @PARSE(VAR F:FCBLK;VAR S:STRING);
VAR
DISK : CHAR;
NAME : PACKED ARRAY [1..8] OF CHAR;
EXT : PACKED ARRAY [1..3] OF CHAR;
I,J,MAX: INTEGER;
BEGIN
(* PARSE CP/M FILE NAME *)
WHILE (LENGTH(S) <> 0) AND (S[1] = ' ') DO
DELETE(S,1,1); (* REMOVE LEADING BLANKS *)
IF LENGTH(S) <> 0 THEN
BEGIN
DISK := '@'; (* DEFAULT *)
NAME := ' ';
EXT := ' ';
IF S[2] = ':' THEN
BEGIN
I := 3;
DISK := UPPERCASE(S[1])
END
ELSE
I := 1;
MAX := I + 8;
J := 1;
WHILE (NOT(S[I] IN ['.',':'])) AND (I < MAX)
AND (I <= LENGTH(S)) DO
BEGIN
NAME[J] := UPPERCASE(S[I]);
J := J + 1;
I := I + 1
END; (* WHILE *)
IF (S[I] = '.') AND (I <= LENGTH(S)) THEN
BEGIN
I := I + 1;
J := 1;
WHILE (J < 4) AND (I <= LENGTH(S)) DO
BEGIN
EXT[J] := UPPERCASE(S[I]);
J := J + 1;
I := I + 1
END (* WHILE *)
END; (* IF *)
FILLCHAR(F,SIZEOF(FCBLK)-18,CHR(0));
F[0] := CHR(ORD(DISK) - ORD('@'));
MOVE(NAME,F[1],8);
MOVE(EXT,F[9],3);
END (* IF *)
END;
PROCEDURE @INI2; (* INIT @FCBS *)
BEGIN
FILLCHAR(@FCBS,SIZEOF(@FCBS),CHR(0))
END;
FUNCTION @OPEN(VAR F:FIB; MODE:INTEGER):INTEGER;
(* NOTE: THIS CODE IS DEPENDENT UPON THE FACT THAT THE FIRST FIELD *)
(* OF THE FIB DEFINITION IS FNAME! *)
VAR
I : INTEGER;
BEGIN
I := GET_AN_FCB;
@OPEN := I;
IF I <> -1 THEN
BEGIN
FILLCHAR(@FCBS[I].FCB,36,CHR(0));
@PARSE(@FCBS[I].FCB,F.FNAME);
IF NOT @NOK(F.FNAME) THEN
BEGIN
@OPEN := -1;
RESULTI := 255;
FREE_AN_FCB(I); (* DONT NEED FCB IF BAD NAME *)
EXIT
END;
IF @SPN(F) THEN
BEGIN
RESULTI := 0;
@FCBS[I].FCB[0] := CHR($FF); {MARK SPECIAL FILE}
{FREE_AN_FCB(I); (* DONT NEED AN FCB ON SPECIAL FILES *)}
{since on 1/16/82 we implemented i/o redirection }
{special files now need an fcb allocated to them! }
EXIT
END;
RESULTI := @BDOS86(15,ADDR(@FCBS[I].FCB));
IF RESULTI = 255 THEN
BEGIN
@OPEN := -1;
FREE_AN_FCB(I); (* DONT NEED FCB IF NOT FOUND *)
END
ELSE
BEGIN
@FCBS[I].BUFIDX := SIZEOF(SECTOR);
@FCBS[I].ENDFILE:= FALSE
END
END
ELSE
RESULTI := 255
END; (* @OPEN *)
FUNCTION @CREAT(VAR F:FIB; MODE:INTEGER):INTEGER;
VAR
I : INTEGER;
BEGIN
I := GET_AN_FCB;
@CREAT := I;
IF I <> -1 THEN
BEGIN
FILLCHAR(@FCBS[I].FCB,36,CHR(0));
@PARSE(@FCBS[I].FCB,F.FNAME);
IF NOT @NOK(F.FNAME) THEN
BEGIN
@CREAT := -1;
RESULTI := 255;
FREE_AN_FCB(I); (* DONT NEED FCB IF BAD NAME *)
EXIT
END;
IF @SPN(F) THEN
BEGIN
RESULTI := 0;
@FCBS[I].FCB[0] := CHR($FF); {MARK SPECIAL FILE}
{FREE_AN_FCB(I); (* DONT NEED AN FCB ON SPECIAL FILES *)}
{since on 1/16/82 we implemented i/o redirection }
{special files now need an fcb allocated to them! }
EXIT
END;
RESULTI := @BDOS86(19,ADDR(@FCBS[I].FCB)); (* DELETE ANY OLD ONES *)
RESULTI := @BDOS86(22,ADDR(@FCBS[I].FCB)); (* AND CREATE A NEW ONE *)
IF RESULTI = 255 THEN
BEGIN
@CREAT := -1;
FREE_AN_FCB(I); (* DONT NEED FCB IF ERROR *)
END;
@FCBS[I].BUFIDX := 0;
END
ELSE
RESULTI := 255
END; (* @CREAT *)
FUNCTION @UNLINK(VAR F:FIB):INTEGER;
BEGIN
IF F.SYSID = 0 THEN (* WE MUST ALLOCATE AN FCB FIRST *)
F.SYSID := @OPEN(F,2);
IF F.SYSID <> -1 THEN (* VALID FILE *)
BEGIN
IF F.OPTION <= FRANDOM THEN (* IT IS A DISK FILE *)
RESULTI := @BDOS86(19,ADDR(@FCBS[F.SYSID].FCB));
@UNLINK := 0;
FREE_AN_FCB(F.SYSID)
END;
END;
PROCEDURE @CLOSE(I:INTEGER; an_infile:boolean);
VAR
J : INTEGER;
BEGIN
if (not an_infile) and (@FCBS[I].FCB[0] <> CHR($FF)) then
begin (* check to see if stuff to flush *)
IF (@FCBS[I].BUFIDX <> 0) THEN
BEGIN
IF (@FCBS[I].BUFIDX <> SIZEOF(SECTOR)) THEN
(* STILL SPACE LEFT TO FILL WITH CTRL/Z'S *)
WITH @FCBS[I] DO
FILLCHAR(BUFFER[BUFIDX],SIZEOF(SECTOR)-BUFIDX,CHR($1A));
PUTSECTOR(I) (* ALWAYS OUTPUT BUFFER IF IDX <> 0 *)
END;
RESULTI := @BDOS86(16,ADDR(@FCBS[I].FCB))
end;
FREE_AN_FCB(I); (* WE ALWAYS DO THIS! *)
END;
PROCEDURE @SFB(P:FPTR);
BEGIN
@LFB := P
END;
(*$E-*)
FUNCTION GETBYTE(I:INTEGER; VAR ENDFIL : BOOLEAN):BYTE;
BEGIN
WITH @FCBS[I] DO
BEGIN
IF BUFIDX >= SIZEOF(SECTOR) THEN (* GOT TO GO READ SOME DATA *)
BEGIN
ENDFIL := NOT GETSECTOR(I);
BUFIDX := 0
END;
GETBYTE := BUFFER[BUFIDX];
BUFIDX := BUFIDX + 1
END
END;
PROCEDURE PUTBYTE(B:BYTE; I:INTEGER);
BEGIN
WITH @FCBS[I] DO
BEGIN
IF BUFIDX >= SIZEOF(SECTOR) THEN
BEGIN
PUTSECTOR(I);
BUFIDX := 0
END;
BUFFER[BUFIDX] := B;
BUFIDX := BUFIDX + 1
END
END;
(*$E+*)
PROCEDURE @RNB;
VAR
I : INTEGER;
J : INTEGER;
CH: CHAR;
ENDFILE:BOOLEAN;
BEGIN
RESULTI := 0;
IF @LFB^.OPTION = FCONIO THEN (* READ CONSOLE NOT A DISK FILE *)
BEGIN
CH := @BDOS86(1,ADDR(I)); (* SECOND PARM IS A DUMMY *)
IF CH = CHR(8) THEN
BEGIN
@BDOSX(2,' ');
@BDOSX(2,CHR(8))
END
ELSE
IF CH = CHR($0D) THEN
@BDOSX(2,CHR($0A));
@LFB^.FBUFFER[0] := CH;
@LFB^.FEOF := (CH = CHR($1A));
EXIT
END;
IF @LFB^.OPTION = FTRMIO THEN
BEGIN
CH := @BDOS86A(6,$FFFF,$FFFF);
@LFB^.FBUFFER[0] := CH;
EXIT
END;
IF @LFB^.OPTION = FAUXIO THEN
BEGIN
CH := @BDOS86(3,ADDR(I));
@LFB^.FBUFFER[0] := CH;
EXIT
END;
(* ELSE NON-CONSOLE, READ USING GETBYTE *)
I := @LFB^.SYSID;
ENDFILE := @LFB^.FEOF;
J := 1;
WHILE (J <= @LFB^.BUFLEN) AND (NOT ENDFILE) DO
BEGIN
WITH @LFB^ DO
FBUFFER[J-1] := GETBYTE(I,ENDFILE);
J := J + 1
END;
@LFB^.FEOF := ENDFILE;
@LFB^.IOSIZE := J-1; (* THIS IS SO GNB CAN TELL THE DIFFERENCE *)
(* BETWEEN A PARTIALLY FULL BUFFER AND *)
(* TRUE EOF *)
END;
PROCEDURE @WNB;
VAR
I : INTEGER;
J : INTEGER;
CH: CHAR;
BEGIN
RESULTI := 0;
IF @LFB^.OPTION = FCONIO THEN (* WRITE TO THE CONSOLE *)
BEGIN
@BDOSX(2,@LFB^.FBUFFER[0]);
EXIT
END;
IF @LFB^.OPTION = FTRMIO THEN (* USE FUNCTION 6 *)
BEGIN
@BDOSX(6,@LFB^.FBUFFER[0]);
EXIT
END;
if @lfb^.option = flstout then (* use function 5 *)
begin
@bdosx(5,@lfb^.fbuffer[0]);
exit
end;
if @lfb^.option = fauxio then (* use function 4 *)
begin
@bdosx(4,@lfb^.fbuffer[0]);
exit
end;
(* ELSE NON-CONSOLE, WRITE USING PUTBYTE *)
I := @LFB^.SYSID;
FOR J := 1 TO @LFB^.BUFLEN DO
WITH @LFB^ DO
PUTBYTE(FBUFFER[J-1],I);
@LFB^.BUFIDX := 0; (* SO CLOSE ON A WNB FILE WORKS PROPERLY *)
END;
PROCEDURE CHAIN(VAR F:FIB; SZ:INTEGER);
BEGIN
@CHN(ADDR(@FCBS[F.SYSID].FCB))
END;
MODEND.


BIN
Digital Research MT+86 Pascal v311/LIBMT.EXE Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/LINKMT.001 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/LINKMT.002 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/LINKMT.EXE Normal file
View File

Binary file not shown.

15
Digital Research MT+86 Pascal v311/MOD1.SRC Normal file
View File

@ -0,0 +1,15 @@
MODULE OVERLAY1;
VAR
I : EXTERNAL INTEGER; (* LOCATED IN THE ROOT *)
PROCEDURE OVL1; (* ONE OF POSSIBLY MANY PROCEDURES IN THIS MODULE *)
BEGIN
WRITELN('In overlay area 1, Overlay number =',I)
END;
MODEND.


15
Digital Research MT+86 Pascal v311/MOD2.SRC Normal file
View File

@ -0,0 +1,15 @@
MODULE OVERLAY2;
VAR
I : EXTERNAL INTEGER; (* LOCATED IN THE ROOT *)
PROCEDURE OVL2; (* ONE OF POSSIBLY MANY PROCEDURES IN THIS MODULE *)
BEGIN
WRITELN('In overlay 1, I=',I)
END;
MODEND.


BIN
Digital Research MT+86 Pascal v311/MT2INT.EXE Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.000 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.001 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.002 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.003 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.004 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.005 Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/MT86.EXE Normal file
View File

Binary file not shown.

134
Digital Research MT+86 Pascal v311/MTERRS.TXT Normal file
View File

@ -0,0 +1,134 @@
1 Error in simple type
2 Identifier expected
3 'PROGRAM' expected
4 ')' expected
5 ':' expected
6 Illegal symbol (possibly missing ';' on line above)
7 Error in parameter list
8 'OF' expected
9 '(' expected
10 Error in type
11 '[' expected
12 ']' expected
13 'END' expected
14 ';' expected (possibly on line above)
15 Integer expected
16 '=' expected
17 'BEGIN' expected
18 Error in declaration part
19 error in <field-list>
20 '.' expected
21 '*' expected
50 Error in constant
51 ':=' expected
52 'THEN' expected
53 'UNTIL' expected
54 'DO' expected
55 'TO' or 'DOWNTO' expected in FOR statement
56 'IF' expected
57 'FILE' expected
58 Error in <factor> (bad expression)
59 Error in variable
99 MODEND expected
101 Identifier declared twice
102 Low bound exceeds high bound
103 Identifier is not of the appropriate class
104 Undeclared identifier
105 sign not allowed
106 Number expected
107 Incompatible subrange types
108 File not allowed here
109 Type must not be real
110 <tagfield> type must be scalar or subrange
111 Incompatible with <tagfield> part
112 Index type must not be real
113 Index type must be a scalar or a subrange
114 Base type must not be real
115 Base type must be a scalar or a subrange
116 Error in type of standard procedure parameter
117 Unsatisified forward reference
118 Forward reference type identifier in variable declaration
119 Re-specified params not OK for a forward declared procedure
120 Function result type must be scalar, subrange or pointer
121 File value parameter not allowed
122 A forward declared function's result type can't be re-specified
123 Missing result type in function declaration
125 Error in type of standard procedure parameter
126 Number of parameters does not agree with declaration
127 Illegal parameter substitution
128 Result type does not agree with declaration
129 Type conflict of operands
130 Expression is not of set type
131 Tests on equality allowed only
133 File comparison not allowed
134 Illegal type of operand(s)
135 Type of operand must be boolean
136 Set element type must be scalar or subrange
137 Set element types must be compatible
138 Type of variable is not array
139 Index type is not compatible with the declaration
140 Type of variable is not record
141 Type of variable must be file or pointer
142 Illegal parameter solution
143 Illegal type of loop control variable
144 Illegal type of expression
145 Type conflict
146 Assignment of files not allowed
147 Label type incompatible with selecting expression
148 Subrange bounds must be scalar
149 Index type must be integer
150 Assignment to standard function is not allowed
151 Assignment to formal function is not allowed
152 No such field in this record
153 Type error in read
154 Actual parameter must be a variable
155 Control variable cannot be formal or non-local
156 Multidefined case label
157 Too many cases in case statement
158 No such variant in this record
159 Real or string tagfields not allowed
160 Previous declaration was not forward
161 Again forward declared
162 Parameter size must be constant
163 Missing variant in declaration
164 Substition of standard proc/func not allowed
165 Multidefined label
166 Multideclared label
167 Undeclared label
168 Undefined label
169 Error in base set
170 Value parameter expected
171 Standard file was re-declared
172 Undeclared external file
174 Pascal function or procedure expected
183 External declaration not allowed at this nesting level
187 Attempt to open library unsuccessful
191 No private files
193 Not enough room for this operation
194 Comment must appear at top of program
201 Error in real number - digit expected
202 String constant must not exceed source line
203 Integer constant exceeds range
206 Illegal real number
250 Too many scopes of nested identifiers
251 Too many nested procedures or functions
253 Procedure too long
256 Too many external references
257 Too many externals
258 Too many local files
259 Expression too complicated
398 Implementation restriction
399 Implementation restriction
400 Illegal character in text
401 Unexpected end of input
402 Error in writing code file, not enough room
403 Error in reading include file
404 Error in writing list file, not enough room
405 Call not allowed in separate procedure
406 Include file not legal
407 *** HEAP OVERFLOW ***
496 Invalid argument to INLINE pseudo procedure
497 Error in closing code file.
500 Non-ISO extension being used!
599 Implementation Restriction


BIN
Digital Research MT+86 Pascal v311/NM.EXE Normal file
View File

Binary file not shown.

582
Digital Research MT+86 Pascal v311/OVLMGRPC.I86 Normal file
View File

@ -0,0 +1,582 @@
NAME OVERLAY_MANAGER
ASSUME CS:CODE,DS:DATA
DATA SEGMENT PUBLIC
DMAPTR DW ? ;DMA ADDRESS FOR INPUT XFER
PROCNAME DB 8 DUP(?) ;NAME OF PROCEDURE WHICH WE ARE CALLI
NG
OVLGNUM DB ? ;OVERLAY NUMBER
PROCADR DW ? ;PROCEDURE ADDRESS
MYFCB DB 36 DUP(?) ;FCB FOR FILE OPENING
;
; USRRET STACK CONTAINS RETURN ADDRESS AND
; SAVED OVERLAY AREA ADDRESS
; AND OVERLAY GROUP NUMBER ;(MAX NESTING 25
DB 129 DUP(?) ;SAVED RETURN ADDRESSES
USRRET:
OVLAREA DW ? ;LOC OF MOST RECENT OVL AREA
DATA ENDS
CODE SEGMENT PUBLIC
M EQU Byte Ptr 0[BX]
;---------------------------------------------------------------;
; ;
; Overlay Management Module for Pascal/MT+ under PCDOS ;
; ;
; Created: March 18, 1981 ;
; Updated: February 24, 1983 ;
; ;
;---------------------------------------------------------------;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
; equates for pertinant information ;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
;
; THE FOLLOWING THREE EQUATES DESCRIBE DATA PLACED AT THE
; BEGINNING OF THE .CMD FILE BY LINK/MT+86 AFTER THE
; STACK POINTER INITIALIZATION CODE.
; THEY MUST BE REFERENCED WITH A CS OVERRIDE
;
NCBPTR EQU 000CH
ovlbase EQU 0001h ;base prefix for file name
namelen EQU 0000h ;length of names (6 or 7 characters)
@XXXX1 EQU 000EH ;PTR TO BASE OF OVL_AREA_TAB
TRUE EQU -1
FALSE EQU 0 ;FOR CONDITIONAL ASSEMBLY
RELOAD EQU OFF ;NON-RECURSIVE OVERLAY CALLING
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
; PUBLIC AND EXTRN SYMBOLS ;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
PUBLIC @OVL ;OVERLAY LOADER
PUBLIC @OVS ;OVERLAY DISK SET
extrn @hlt : near
;###############################################################;
; ;
; MAIN ROUTINE - @OVL ;
; PURPOSE - LOAD OVERLAY AND CALL PROCEDURE ;
;---------------------------------------------------------------;
; ON ENTRY TO @OVL, RETURN ADDRESS POINTS TO OVERLAY CALL ;
; DATA BLOCK: ;
; ;
; +0 : OVERLAY GROUP NUMBER --- 1 BYTE ;
; +1 : OVERLAY PROCEDURE NAME-- 8 BYTES ;
; ;
;###############################################################;
@OVL PROC NEAR
POP BX
MOV AL,CS:M
MOV Byte Ptr OVLGNUM,AL
INC BX
MOV CH,8
MOV DX,(Offset PROCNAME)
OVL1:
MOV AL,CS:M
INC BX
MOV SI,DX
MOV BYTE PTR [SI],AL
INC DX
DEC CH
JNZ OVL1
CALL PSHUSRRET ;SAVE USER'S RETURN ADDRESSES
CALL LOADOVLY ;GO LOAD IT (IF NECESSARY)
CALL FINDPROC ;GO SEARCH FOR AND FIND PROCNAME
;DOES NOT RETURN IF PROC NOT FOUND
MOV BX,(Offset OURRET);PUSH OUR RETURN ADDRESS ON THE STACK
PUSH BX
MOV BX,Word Ptr PROCADR ;GET ADDRESS OF PROC WITHIN OVERLAY AREA
JMP BX ;AND OFF TO USER ROUTINE
OURRET:
PUSH AX
PUSH BX ;SAVE POSSIBLE RETURN VALUES
CALL POPUSRRET ;MAY RELOAD OLD OVERLAY GROUP
POP BX
POP AX ;GET POSSIBLE RETURN VALUES BACK AGAIN
JMP CX ;AND BACK TO THE USER (SIMPLE CASE)
@OVL ENDP
;###############################################################;
; ;
; MAIN ROUTINE - @OVS ;
; PURPOSE - SET DRIVE NUMBER FOR A SPECIFIC OVERLAY ;
; INPUT - ON STACK : OVLNUM,DRIVE ;
; OVLNUM : 1..50 ;
; DRIVE : '@'..'O' ;
; ;
; PASCAL DEFINITION: ;
; ;
; EXTERNAL PROCEDURE @OVS(OVNUM:INTEGER; DRNUM:CHAR); ;
; ;
;###############################################################;
@OVS PROC NEAR
POP BX ;RET ADR
POP CX ;DRIVE NUMBER
POP DX ;OVERLAY NUMBER
PUSH BX
MOV AL,CL
SUB AL,'@' ;MAKE 0..19
DEC DX ;ADJUST OVLNUM (COUNT FROM 0)
MOV BX,(Offset DRIVETAB)
ADD BX,DX
MOV CS:M,AL
RET
@OVS ENDP
;===============================================================;
; SUBROUTINE: CALCADDR ;
; PURPOSE : CALC OVERLAY AREA ADDRESS BASED ON OVLGNUM ;
;===============================================================;
CALCADDR PROC NEAR
MOV AL,Byte Ptr OVLGNUM ;GET REQUESTED GROUP NUMBER
DEC AL
RCR AL,1
RCR AL,1
RCR AL,1 ;DIVIDE BY 8
AND AL,1EH
MOV DL,AL
MOV DH,0
MOV BX,CS:Word Ptr @XXXX1 ;GET ADDR OF OVERLAY AREA TABLE
;POINT TO TABLE ENTRY
ADD BX,DX
MOV DX,CS:WORD PTR [BX]
XCHG BX,DX ;BX NOW POINTS TO OVERLAY AREA
MOV Word Ptr OVLAREA,BX ;SAVE IT FOR LATER
RET
CALCADDR ENDP
;===============================================================;
; SUBROUTINE: PSHUSRRET ;
; PURPOSE : SAVE CONTENTS OF HL, OVERLAY AREA ADDR ;
; AND OVERLAY GROUP NUMBER ON USRRET STACK ;
;===============================================================;
; PUBLIC PSHUSRRET
PSHUSRRET PROC NEAR
PUSH BX
CALL CALCADDR
MOV CX,BX
POP DX
MOV BX,CS:Word Ptr USRSP ;GET STACK POINTER
DEC BX
MOV M,DH ;STORE RET ADDR
DEC BX
MOV M,DL
DEC BX
MOV M,CH ;STORE OVERLAY AREA ADDR
DEC BX
MOV M,CL
DEC BX
MOV SI,CX ;GET OVERLAY NUMBER
MOV AL,CS:BYTE PTR [SI]
MOV M,AL
MOV CS:Word Ptr USRSP,BX
RET
PSHUSRRET ENDP
;===============================================================;
; SUBROUTINE: POPUSRRET ;
; PURPOSE : POP RET ADDR, OVERLAY AREA ADDR AND NUMBER ;
; IF RECURSE IS SET TO TRUE THEN THIS ROUTINE ;
; WILL CALL LOADOVLY TO RE-LOAD PREVIOUS ;
; OVERLAY IF NECESSARY ;
;===============================================================;
; PUBLIC POPUSRRET
POPUSRRET PROC NEAR
MOV BX,CS:Word Ptr USRSP
MOV AL,M
MOV Byte Ptr OVLGNUM,AL ;SAVE OVERLAY GROUP NUMBER
INC BX
MOV DL,M
INC BX
MOV DH,M
INC BX ;DE NOW CONTAINS OVERLAY AREA ADDRESS
XCHG BX,DX
MOV Word Ptr OVLAREA,BX
XCHG BX,DX
MOV DL,M
INC BX
MOV DH,M ;DE NOW CONTAINS CALLERS RET ADDRESS
INC BX
MOV CS:Word Ptr USRSP,BX
XCHG BX,DX ;PUT REAL ADDR INTO HL
;----------------------------------------------------------------
IF RELOAD ; THEN RELOAD OLD OVERLAY IF NECESSARY
PUSH BX
MOV AL,Byte Ptr OVLGNUM
OR AL,AL
JZ L@1
CALL LOADOVLY ;ELSE GO LOAD IT IN AGAIN
L@1:
POP BX ;GET RET ADDR BACK AGAIN
ENDIF
;----------------------------------------------------------------
MOV CX,BX ;RETURN IT IN CX (1/17/82)
RET ;BACK TO MAIN @OVL ROUTINE
POPUSRRET ENDP
;===============================================================;
; SUBROUTINE: LOADOVLY ;
; PURPOSE : USING OVLADDR AND OVLBASE LOAD THE OVERLAY ;
;===============================================================;
LOADOVLY PROC NEAR
CALL CALCADDR ;SETS OVLAREA AND HL-REG
MOV AL,Byte Ptr OVLGNUM ;GET GROUP NUMBER BACK AGAIN
CMP AL,CS:M ;IS REQUESTED OVERLAY IN THE AREA?
JNZ L@2
RET ;RETURN IF ALREADY LOADED
L@2:
;
; IF NOT LOADED THEN CONSTRUCT NAME AND LOAD IT
;
; MOVE OVLBASE,MYFCB+1,8
MOV BX,CS:WORD PTR NCBPTR
ADD BX,OVLBASE
MOV DX,(Offset MYFCB)+1
MOV CH,8
?1: MOV AL,CS:M ;GET BYTE OF NAME FROM CODE SEG
MOV SI,DX
MOV BYTE PTR [SI],AL ;AND STORE IN DATA SEG
INC BX
INC DX
DEC CH
JNZ ?1
MOV AL,Byte Ptr OVLGNUM
DEC AL
MOV DL,AL
MOV DH,0
MOV BX,(Offset DRIVETAB)
ADD BX,DX
MOV AL,CS:M ;GET DRIVE NUMBER FROM TABLE
MOV Byte Ptr MYFCB,AL ;FOR NOW DEFAULT DRIVE ONLY
MOV AL,'0'
MOV Byte Ptr MYFCB+9,AL
MOV AL,Byte Ptr OVLGNUM
RCR AL,1
RCR AL,1
RCR AL,1
RCR AL,1
CALL CV2HX ;CONVERT HIGH NIBBLE
MOV Byte Ptr MYFCB+10,AL
MOV AL,Byte Ptr OVLGNUM
CALL CV2HX ;CONVERT LOW NIBBLE
MOV Byte Ptr MYFCB+11,AL
MOV BX,(Offset MYFCB)+12
MOV CH,23 ;NUMBER OF EXTRA BYTES
LO2:
MOV M,0
INC BX
DEC CH
JNZ LO2
MOV DX,80H ;SET DEFAULT DMA ADDRESS
call setdma
MOV DX,(Offset MYFCB)
call open
CMP AL,255
JNZ L@3
JMP NOFILE ;BR IF FILE NOT FOUND
L@3:
;
; OK, NOW LOAD IT UNTIL EOF
;
LO3:
MOV DX,Word Ptr OVLAREA ;GET OVERLAY AREA ADDRESS
mov bx,ds ;save ds
mov ax,cs
mov ds,ax
call setdma
mov ds,bx ;RESTORE DS
MOV DX,(Offset MYFCB)
mov DI,DX
mov AX,word ptr [DI+16] ;get file size in bytes
mov CL,7 ;set up to divide by 128
shr AX,CL ;do divide by shifting
mov CX,AX ;move number of records into CX
call rdran
RET
LOADOVLY ENDP
pcdos PROC NEAR ; the call to PCDOS
push es
int 21h
pop es
ret
pcdos endp
open: ; file open (#15)
mov ah,15
jmp pcdos
rdran: ;random read (#39)
mov ah,39
jmp pcdos
setdma: ;set DMA offset (#26) PCDOS style
mov ah,26 ; load function number
jmp pcdos
;
; INTERNAL ROUTINE - CV2HX
; LOW ORDER 4-BITS OF A-REG CONTAIN BINARY NUMBER
; RETURN ASCII CHAR IN A-REG
;
CV2HX PROC NEAR
AND AL,0FH
ADD AL,'0'
CMP AL,03AH
JNB L@4
RET ;RETURN IF A VAILD DIGIT
L@4:
ADD AL,7
RET
CV2HX ENDP
;===============================================================;
; SUBROUTINE: FINDPROC ;
; PURPOSE : GIVEN PROCEDURE NAME IN PROCNAME ;
; RETURN ADDRESS OF THIS PROCEDURE IN ;
; PROCADR ;
;===============================================================;
FINDPROC PROC NEAR
MOV BX,Word Ptr OVLAREA ;GET ADDR OF OVERLAY AREA
INC BX
MOV DL,CS:M
INC BX
MOV DH,CS:M ;POINT TO TABLE
XCHG BX,DX
FP1:
MOV AL,CS:M
OR AL,AL
JNZ L@5
JMP NOPROC
L@5:
MOV DX,(Offset PROCNAME)
MOV SI,CS:WORD PTR NCBPTR
MOV AL,CS:BYTE PTR [SI]
MOV CH,AL
PUSH BX ;SAVE ADDR OF TABLE ENTRY
FP2:
MOV SI,DX
MOV AL,BYTE PTR [SI]
CMP AL,CS:M
JNZ FP3 ;BR IF NO MATCH
INC BX
INC DX
DEC CH
JNZ FP2 ;BR IF MORE TO COMPARE
;
; WE FOUND IT......
;
POP BX ;GET BASE ADDR OF TABLE ENTRY
MOV DX,8 ;BYPASS NAME
ADD BX,DX
MOV DL,CS:M
INC BX
MOV DH,CS:M
XCHG BX,DX
MOV Word Ptr PROCADR,BX
RET ;AND EXIT
FP3:
POP BX
MOV DX,10
ADD BX,DX
JMP SHORT FP1
FINDPROC ENDP
;===============================================================;
; ERROR MESSAGE PRINTING ROUTINES ;
;===============================================================;
NOFILE: ;***OVERLAY FILE NOT FOUND***
; MOVE MYFCB+1,NFMSG1+2,8 ;MOVE IN NAME
MOV BX,(Offset MYFCB)+1
MOV DX,(Offset NFMSG1)+2
MOV CX,8
?2:
MOV AL,M
INC BX
MOV SI,DX
MOV CS:BYTE PTR [SI],AL
INC DX
DEC CX
MOV AL,CH
OR AL,CL
JNZ ?2
; MOVE MYFCB+9,NFMSG1+11,3 ;MOVE IN EXTENSION
MOV BX,(Offset MYFCB)+9
MOV DX,(Offset NFMSG1)+11
MOV CX,3
?3:
MOV AL,M
INC BX
MOV SI,DX
MOV CS:BYTE PTR[SI],AL
INC DX
DEC CX
MOV AL,CH
OR AL,CL
JNZ ?3
MOV AL,Byte Ptr MYFCB
ADD AL,'@'
MOV CS:Byte Ptr NFMSG1,AL
MOV DX,(Offset NFMSG)
CMP AL,'@'
JNZ WMSG
MOV BX,' '
MOV Word Ptr NFMSG1,BX ;CHANGE "@:" TO " "
WMSG:
PUSH DS
MOV AX,CS
MOV DS,AX
mov ah,9
call pcdos
POP DS
call @hlt
NFMSG:
DB 13,10,'Unable to open: '
NFMSG1 DB 40H,': . '
DB 13,10
DB '$'
NOPROC: ;***PROCEDURE NAME NOT FOUND***
; MOVE MYFCB+1,NPMSG2+2,8 ;MOVE IN NAME
MOV BX,(Offset MYFCB)+1
MOV DX,(Offset NPMSG2)+2
MOV CX,8
?4:
MOV AL,M
INC BX
MOV SI,DX
MOV CS:BYTE PTR [SI],AL
INC DX
DEC CX
MOV AL,CH
OR AL,CL
JNZ ?4
; MOVE MYFCB+9,NPMSG2+11,3 ;MOVE IN EXTENSION
MOV BX,(Offset MYFCB)+9
MOV DX,(Offset NPMSG2)+11
MOV CX,3
?5:
MOV AL,M
INC BX
MOV SI,DX
MOV CS:BYTE PTR [SI],AL
INC DX
DEC CX
MOV AL,CH
OR AL,CL
JNZ ?5
MOV AL,Byte Ptr MYFCB
ADD AL,'@'
MOV CS:Byte Ptr NPMSG2,AL
CMP AL,'@'
JNZ NP1
MOV BX,' '
MOV CS:Word Ptr NPMSG2,BX
NP1:
; MOVE PROCNAME,NPMSG1,8
MOV BX,(Offset PROCNAME)
MOV DX,(Offset NPMSG1)
MOV CX,8
?6:
MOV AL,M
INC BX
MOV SI,DX
MOV CS:BYTE PTR [SI],AL
INC DX
DEC CX
MOV AL,CH
OR AL,CL
JNZ ?6
MOV DX,(Offset NPMSG)
JMP WMSG
NPMSG DB 13,10,'Proc: "'
NPMSG1 DB ' " not found ovl:'
NPMSG2 DB 40H,': . '
DB 13,10
DB '$'
;***************************************************************;
; ;
; DATA AREA FOR OVERLAY MANAGER ;
; ;
;***************************************************************;
;
; NOTE THIS TABLE MUST BE IN THE CSEG AREA BECAUSE IS MUST
; BE INITIALIZED VIA DB AND LINKMT WILL NOT SUPPORT INITIALIZED
; DATA IN THE DSEG
;
DRIVETAB: ;DRIVE TABLES FOR 50 OVERLAYS
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
DB 0
USRSP DW (Offset USRRET) ;USRRET STACK POINTER
;THIS MUST ALSO BE IN CODE SEG
CODE ENDS
END


BIN
Digital Research MT+86 Pascal v311/PASCALMT-311-PROGRAMMERS-GUIDE.pdf Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/PASCALMT-311-REFERENCE-MANUAL.pdf Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/PASLIB.R86 Normal file
View File

Binary file not shown.

34
Digital Research MT+86 Pascal v311/PROG.SRC Normal file
View File

@ -0,0 +1,34 @@
PROGRAM DEMO_PROG;
VAR
I : INTEGER; (* TO BE ACCESSED BY THE OVERLAYS *)
CH: CHAR;
EXTERNAL [1] PROCEDURE OVL1; (* COULD HAVE HAD PARAMETERS *)
EXTERNAL [2] PROCEDURE OVL2; (* ALSO COULD HAVE HAD PARAMETERS *)
(* EITHER COULD ALSO HAVE BEEN A FUNCTION IF DESIRED *)
BEGIN
REPEAT
WRITE('Enter character, A/B/Q: ');
READ(CH);
CASE CH OF
'A','a' : BEGIN
I := 1; (* TO DEMONSTRATE ACCESS OF GLOBALS *)
OVL1 (* FROM AN OVERLAY *)
END;
'B','b' : BEGIN
I := 2;
OVL2
END
ELSE
IF NOT(CH IN ['Q','q'])THEN
WRITELN('Enter only A or B')
END (* CASE *)
UNTIL CH IN ['Q','q'];
WRITELN('End of program')
END.


BIN
Digital Research MT+86 Pascal v311/RANDOMIO.R86 Normal file
View File

Binary file not shown.

859
Digital Research MT+86 Pascal v311/READ.ME Normal file
View File

@ -0,0 +1,859 @@
****************************
* R E L E A S E N O T E S *
****************************
Pascal/MT+ Version 3.1.1
For The IBM Personal Computer
Disk Operating System Version 1.1
Copyright (c) 1983 by Digital Research
1-1
Pascal/MT+ Release Notes
These release notes pertain to both the software and
the documentation set for the Digital Research
product:
Pascal/MT+
For the IBM Personal Computer
Disk Operating System Version 1.1 (IBMDOS)
They provide the most current information regarding:
o changes to the software, or bugs that have been
identified since the product was released.
o errors or omissions in the documentation set
that could not be corrected because of the lead
time needed for production and printing.
Note: These release notes have been formatted so
that you can print them on your own printer, cut them
to size (6 1/2 x 8 1/2), and then place them in the
back of your manuals.
1-2
Pascal/MT+ Release Notes
RUNNING UNDER IBMDOS
Under IBMDOS, the space available for the transient
program area is not as large as under CP/M-86. If
your system has a total memory size of 150K or less,
the compiler will have a smaller symbol table, and
the linker will have both a smaller symbol table and
code buffer. Both programs have messages that inform
you of the size of their respective tables. No other
programs are affected.
Note: Under IBMDOS, the utility programs NM and SZ do
not accept ambiguous filenames as they do under CP/M-
86. Only one name is allowed, and it must be unique.
For example,
FPREALS.R86 is valid
FPREALS.* is invalid
????.R86 is invalid
SOFTWARE CHANGES FROM THE PREVIOUS VERSION
There are four new functions in the run-time library,
PASLIB: @SETDATE, @SETTIME, @GETDATE, AND @GETTIME.
These functions set and access the system date and
time. The SET functions return a completion code
exactly as it is set by IBMDOS. Please see your
systems manual for return code values and legal
values for each parameter.
To use these functions, declare each as an EXTERNAL
PROCEDURE with the following syntax:
@GETTIME(HOUR,MINUTE,SECOND,HUND : INTEGER);
@GETDATE(MONTH,DAY,YEAR : INTEGER);
@SETTIME(HOUR,MINUTE,SECOND,HUND : INTEGER) : INTEGER;
@SETDATE(MONTH,DAY,YEAR : INTEGER) : INTEGER;
1-3
Pascal/MT+ Release Notes
SOFTWARE BUGS
The following software bugs have been identified in
the current release (3.1.1):
o There are errors in allocating array bounds for
conformant arrays of two or more dimensions.
One-dimensional conformant arrays work
correctly.
Solution: There is no fix available at this
time. Work is in progress, and the problem will
be fixed by the next release.
o Sometimes, expressions used as procedure
parameters do not result in the correct values
being passed to the procedure.
Solution: First assign the value of the
expression to a variable, and then pass the
variable to the procedure.
o When using the OUT function, the port number and
the value are inadvertently swapped.
Solution: Use OUT as follows:
OUT[(value to put out)] := PORT number
o After the compiler reports a syntax error it
asks if you want to continue or abort.
Occasionally, attempting to continue will hang
the system and require a reboot.
Solution: If this error occurs, correct the
reported syntax error before attempting to
recompile. This error will be corrected in the
next release.
1-4
Pascal/MT+ Release Notes
o Some users have reported an incompatibality
between some CP/M-86 implementations and the
IBMDOS version. IBMDOS V1.1 does not interpret
ANSI standard escape sequences. Consequently,
programs that attempt to handle displays via
escape sequences for cursor control will not
execute properly.
Solution: There is no fix available at this
time.
1-5
Pascal/MT+ Release Notes
DOCUMENTATION ERRATA
The following are errors in the Pascal/MT+ Language
Reference Manual (February 1983 edition):
Page 3-3. Change WORD(x) to WRD(x)
Page 6-2. Change the third paragraph to read:
"The data type for a function must be a
simple type. Put the type name after a
colon at the end of the function heading.
Page 6-8. In Table 6-1, change the Returns type for
the Function ABS from REAL to "same as
NUM".
Page 6-10. In Table 6-1, the Function @HERR returns
a BOOLEAN type, and the the Function ADDR
returns a POINTER not an INTEGER type.
Also change FUNCTION @RLS to PROCEDURE
@RLS.
Page 6-12. Change the first sentence in the second
paragraph to read:
"You can use ADDR to reference external
variables."
Page 6-13. Change the example to ARCTAN(1) = 0.78539
Page 6-19. Change the first sentence in the second
paragraph to read:
"CLOSEDEL closes and deletes files after
use." In the last paragraph, change File
Control Blocks (FCBs) to File Information
Blocks (FIBs).
1-6
Pascal/MT+ Release Notes
Page 6-68. Change the fifth paragraph to read:
"WRITE and WRITELN treat strings as
arrays of characters. They do not write
the length byte to TEXT files."
Page 7-2. In the second paragraph, change F2 to F3
in:
F2^ := 45;
puts the integer value 45 in the buffer
of the file variable F2.
1-7
Pascal/MT+ Release Notes
The following are errors in the Pascal/MT+
Programmer's Guide for the IBM Personal Computer Disk
Operating System (April 1983 edition):
Page 1-5. Delete the following files from Table 1-
2. They are NOT distributed with the
product:
o CONCAT.EXE
o 8087.I86
o 87XOP.I86
o 87TRS.I86
o 87REALS.BLD
Page 1-6. The second paragraph states you can use
the distribution disks just as they are.
This is not true; they are write-
protected. You must copy them onto
backup disks.
Page 2-3. Change the first paragraph to read:
"During Phase 0, When the compiler finds
a syntax error, it displays the line
containing the error. If you are using
the MTERRS.TXT file, the compiler also
displays an error description. In all
other Phases, if you are not using the
MTERRS.TXT file, or you have a nonsyntax
error, the compiler displays the line
number and an error identification
number."
Page 2-15. Table 2-5 is incomplete. Add the
following Linker error messages:
Unable to open input file: xxxxxxxx
Explanation: The linker cannot find the
specified input file.
1-8
Pascal/MT+ Release Notes
Incompatible relocatable file format
Explanation: Either the R86 file is
corrupted or it has a format that is
incompatible with the format expected by
LINK/MT+86.
Initialization of DSEG not allowed
Explanation: The linker has encountered a
DB or DW instruction in the Data segment.
Undefined symbol: xxxxxxxxx
Explanation: The specified symbol is
referenced but not defined in the module.
Page 3-8. The explanation of the /O option is
incorrect. Change as follows:
"/O:n tells the linker that the previous
file is a SYM file and that n is the
overlay number, in hexadecimal. You must
specify the overlay filename and number
in the link command line. This option is
for overlays only."
Page 3-10. Change the command line for linking an
overlay to:
LINKMT <prog.00n>=<sym file>/O:,<modules|libraries>/P:mmmm/X:ssss
Page 3-11. Change section 3.2.5 to 3.2.6. Insert
section 3.2.5 as follows:
3.2.5 Overlay Symbol Table
LINKMT creates a symbol table at the end
of the code segment for each overlay
1-9
Pascal/MT+ Release Notes
module. This symbol table can be very
large because it includes all the symbols
in the overlay and the root. However,
not all the entries in the symbol table
are required by the overlay. The overlay
requires only those entries called from
the root or another overlay. Therefore,
after linking each overlay module, you
should use the STRIP utility to reduce
the size of the symbol table.
Note: LINKMT provides the size of the
code segment which does not include the
symbol table for overlay modules. Thus,
the total code size required for an
overlay module will be much larger than
the size given by LINKMT if you do not
use STRIP.
To use STRIP, enter the command
A>strip
Once invoked, STRIP asks for the name of
the file to strip, the location of the
symbol table (the same number used with
the P parameter when you link the
overlay), and the name of each entry
point you want to retain in the symbol
table. You must enter the entry points
in reverse order of their declaration.
STRIP searches the symbol table for the
first entry point and deletes all others
it encounters until it finds the correct
one. STRIP then requests another entry
point and continues. When the last one
is found, you enter a dummy entry point
such as ZZZ and then STRIP continues to
delete the other entries until it finds
1-10
Pascal/MT+ Release Notes
the end to the table.
After deleting all the unused entry
points, STRIP lists the remaining entry
points and asks if it should replace the
original version with the stripped
version. You must answer with "YESDOIT"
to replace the original. Any other
response terminates STRIP and does not
change the original.
Page 3-13. The example command lines for linking
overlays 1 and 2 are incorrect. They
should be:
A>LINKMT DEMOPROG.001=DEMOPROG/O.1,MOD1,PASLIB,/S/P:4000/L
A>LINKMT DEMOPROG.002=DEMOPROG/O.2,MOD2,PASLIB,/S/P:4000/L
Page 3-14. Insert the following before paragraph 6:
"To chain from one EXE file to another,
you must perform the following steps:
1) Using the linker, determine the code
size of the largest program you want
to chain to.
2) Round the value of the code size to
the nearest multiple of 512 bytes
(200H), and then add 512 bytes.
3) Use this new value for the code size
of the root program, unless the root
is already larger.
Page 3-14. Add the following to paragraph 6
concerning shared variables:
1-11
Pascal/MT+ Release Notes
"You must also rewrite the initialization
routine in PASLIB because it zeros out
the data area. Change @INI3.I86 to
reflect the size of the common area. For
example,
SUB CX, 100H + common area size
MOV DI, 100H + " " "
Page 4-7. Delete the third paragraph, and insert the
following:
"Floating-point real numbers are returned
in the DX, CX, BX, and AX registers. BCD
reals are returned in DI, DX, CX, BX, and
AX. The high-order byte is in DX (or
DI), and the low-order is always in AX."
Page 4-14. In the paragraph under Listing 4-6 add
the sentence:
"An extra eight bytes of code is
generated here, but the amount can vary
depending on the number and type of
parameters. There is no empirical
formula for determining the extra
amount."
Page 4-18. Add the following to the explanation of
MEMAVAIL:
"FULLHEAP.R86 has been extended to make
available up to 1 megabyte of heap space.
MEMAVAIL and MAXAVAIL both return INTEGER
values, so if you are using more than 32K
of heap space, you must declare them as
follows:
1-12
Pascal/MT+ Release Notes
EXTERNAL FUNCTION LMEMAVAIL : LONGINT;
EXTERNAL FUNCTION LMAXAVAIL : LONGINT;
These functions are both in PASLIB.
Page 5-1. The first paragraph in Section 5.1 refers
to the Intel publication named "MCS-86
Macro Assembly Language Reference
Manual." This manual is no longer in
print, but has been replaced by the
"ASM86 Language Reference Manual". The
Intel order number for this new manual is
121703-002.
Page 5-3. In Table 5-1, add the following to the
explanation of the Pd option:
Unlike the similar MT86 compiler option,
P does not send output to the printer.
Page 5-9. In Table 5-3, 320 bytes should be 32
bytes.
1-13


31
Digital Research MT+86 Pascal v311/SIEVE.PAS Normal file
View File

@ -0,0 +1,31 @@
program sieve( INPUT, 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.

BIN
Digital Research MT+86 Pascal v311/STRIP.EXE Normal file
View File

Binary file not shown.

BIN
Digital Research MT+86 Pascal v311/SZ.EXE Normal file
View File

Binary file not shown.

82
Digital Research MT+86 Pascal v311/TAP.PAS Normal file
View File

@ -0,0 +1,82 @@
program tap;
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 }

BIN
Digital Research MT+86 Pascal v311/TRANCEND.R86 Normal file
View File

Binary file not shown.

4
Digital Research MT+86 Pascal v311/m.bat Normal file
View File

@ -0,0 +1,4 @@
ntvdm mt86 %1
ntvdm linkmt %1 paslib.r86 fpreals.r86
ntvdm -c -p %1

76
Digital Research MT+86 Pascal v311/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
Digital Research MT+86 Pascal v311/mtpas3.exe Normal file
View File

Binary file not shown.

304
Digital Research MT+86 Pascal v311/ttt.pas Normal file
View File

@ -0,0 +1,304 @@
{ App to prove you can't win at Tic-Tac-Toe }
{ Written to target MT+86 - Pascal V3.1.1 }
program ttt;
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;
PSTRING = ^STRING;
var
evaluated: integer;
board: boardType;
var
i, loops, code: integer;
startTicks, endTicks, elapsedTicks : longint;
external function @cmd : PSTRING;
external procedure @GETTIME( var hour,minute,second,hund : integer );
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 := winner2( move ); { lookForWinner; }
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;
function argAsInt : integer;
var
offset, x, len, result : integer;
CommandString : STRING[ 127 ];
PTR : PSTRING;
begin
result := 0;
PTR := @CMD;
CommandString := PTR^;
len := ORD( CommandString[ 0 ] );
if 0 <> len then
begin
offset := 2;
x := ORD( CommandString[ 2 ] );
while ( ( x >= 48 ) and ( x <= 57 ) ) do
begin
result := result * 10;
result := result + x - 48;
offset := offset + 1;
x := ORD( CommandString[ offset ] );
end;
end;
argAsInt := result;
end;
function tickCount : longint;
var
h, m, s, hu : integer;
lh, lm, ls, lhu, result : longint;
begin
@gettime( h, m, s, hu );
lh := long( h );
lm := long( m );
ls := long( s );
lhu := long( hu );
result := lhu + ( ls * #100 ) + ( lm * #6000 ) + ( lh * #360000 );
tickCount := result;
end;
procedure runit( move : integer );
var
score: integer;
begin
board[move] := pieceX;
score := minmax( scoreMin, scoreMax, 0, move );
board[move] := pieceBlank;
end;
begin
loops := argAsInt;
if 0 = loops then loops := Iterations;
WriteLn( 'begin' );
for i := 0 to 8 do
board[i] := pieceBlank;
startTicks := tickCount;
for i := 1 to loops do
begin
evaluated := 0; { once per loop to prevent overflow }
runit( 0 );
runit( 1 );
runit( 4 );
end;
endTicks := tickCount;
elapsedTicks := endTicks - startTicks;
WriteLn( 'hundredths of a second: ', short( elapsedTicks ) );
WriteLn( 'moves evaluated: ', evaluated );
WriteLn( 'iterations: ', loops );
end.