diff --git a/Digital Research MT+86 Pascal v311/87REALS.R86 b/Digital Research MT+86 Pascal v311/87REALS.R86 new file mode 100644 index 0000000..e0f1320 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/87REALS.R86 differ diff --git a/Digital Research MT+86 Pascal v311/87TRANS.R86 b/Digital Research MT+86 Pascal v311/87TRANS.R86 new file mode 100644 index 0000000..cea662e Binary files /dev/null and b/Digital Research MT+86 Pascal v311/87TRANS.R86 differ diff --git a/Digital Research MT+86 Pascal v311/ASMERS.TXT b/Digital Research MT+86 Pascal v311/ASMERS.TXT new file mode 100644 index 0000000..5ad1946 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/ASMERS.TXT @@ -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 \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/ASMT86.001 b/Digital Research MT+86 Pascal v311/ASMT86.001 new file mode 100644 index 0000000..aa26aa9 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ASMT86.001 differ diff --git a/Digital Research MT+86 Pascal v311/ASMT86.002 b/Digital Research MT+86 Pascal v311/ASMT86.002 new file mode 100644 index 0000000..3c9846d Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ASMT86.002 differ diff --git a/Digital Research MT+86 Pascal v311/ASMT86.003 b/Digital Research MT+86 Pascal v311/ASMT86.003 new file mode 100644 index 0000000..198128a Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ASMT86.003 differ diff --git a/Digital Research MT+86 Pascal v311/ASMT86.004 b/Digital Research MT+86 Pascal v311/ASMT86.004 new file mode 100644 index 0000000..baa9c0c Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ASMT86.004 differ diff --git a/Digital Research MT+86 Pascal v311/ASMT86.EXE b/Digital Research MT+86 Pascal v311/ASMT86.EXE new file mode 100644 index 0000000..4668b9c Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ASMT86.EXE differ diff --git a/Digital Research MT+86 Pascal v311/BCDREALS.R86 b/Digital Research MT+86 Pascal v311/BCDREALS.R86 new file mode 100644 index 0000000..b7da2c0 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/BCDREALS.R86 differ diff --git a/Digital Research MT+86 Pascal v311/CALC.SRC b/Digital Research MT+86 Pascal v311/CALC.SRC new file mode 100644 index 0000000..9984b99 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/CALC.SRC @@ -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 to stop. Any other characer to repeat.'); + READ(CH1); + UNTIL CH1 = CHR(27) +END. + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/CPMGET.SRC b/Digital Research MT+86 Pascal v311/CPMGET.SRC new file mode 100644 index 0000000..70934ae --- /dev/null +++ b/Digital Research MT+86 Pascal v311/CPMGET.SRC @@ -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. + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/CPMINI.SRC b/Digital Research MT+86 Pascal v311/CPMINI.SRC new file mode 100644 index 0000000..ee7c8b3 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/CPMINI.SRC differ diff --git a/Digital Research MT+86 Pascal v311/DBUGHELP.TXT b/Digital Research MT+86 Pascal v311/DBUGHELP.TXT new file mode 100644 index 0000000..25c30bc --- /dev/null +++ b/Digital Research MT+86 Pascal v311/DBUGHELP.TXT @@ -0,0 +1,22 @@ + = ( or ) +/- + = or $ or $: + = or : + +Display commands: +D? 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 - display all var names associated with this proc +SB - Set breakpoint +RB - 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 SEt +T Trace Pascal statements and return + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/DEBUGGER.R86 b/Digital Research MT+86 Pascal v311/DEBUGGER.R86 new file mode 100644 index 0000000..86a397d Binary files /dev/null and b/Digital Research MT+86 Pascal v311/DEBUGGER.R86 differ diff --git a/Digital Research MT+86 Pascal v311/DIS86.EXE b/Digital Research MT+86 Pascal v311/DIS86.EXE new file mode 100644 index 0000000..6c319a0 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/DIS86.EXE differ diff --git a/Digital Research MT+86 Pascal v311/E.PAS b/Digital Research MT+86 Pascal v311/E.PAS new file mode 100644 index 0000000..9290430 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/E.PAS @@ -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. + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/ECHO.SRC b/Digital Research MT+86 Pascal v311/ECHO.SRC new file mode 100644 index 0000000..ead360e --- /dev/null +++ b/Digital Research MT+86 Pascal v311/ECHO.SRC @@ -0,0 +1,17 @@ +program echo; + +type + pstrg = ^string; + +var + p : pstrg; + +external function @cmd : pstrg; + +begin (* echo *) + + p := @cmd; + writeln(p^) +end. + +: \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/ECHOCODE.EXE b/Digital Research MT+86 Pascal v311/ECHOCODE.EXE new file mode 100644 index 0000000..e36d1ed Binary files /dev/null and b/Digital Research MT+86 Pascal v311/ECHOCODE.EXE differ diff --git a/Digital Research MT+86 Pascal v311/FIBDEF.LIB b/Digital Research MT+86 Pascal v311/FIBDEF.LIB new file mode 100644 index 0000000..f7f221b --- /dev/null +++ b/Digital Research MT+86 Pascal v311/FIBDEF.LIB @@ -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; + + +. \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/FLOAT.PAS b/Digital Research MT+86 Pascal v311/FLOAT.PAS new file mode 100644 index 0000000..4ff90f6 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/FLOAT.PAS @@ -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 } diff --git a/Digital Research MT+86 Pascal v311/FPREALS.R86 b/Digital Research MT+86 Pascal v311/FPREALS.R86 new file mode 100644 index 0000000..ff09b55 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/FPREALS.R86 differ diff --git a/Digital Research MT+86 Pascal v311/FULLHEAP.R86 b/Digital Research MT+86 Pascal v311/FULLHEAP.R86 new file mode 100644 index 0000000..11a0306 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/FULLHEAP.R86 differ diff --git a/Digital Research MT+86 Pascal v311/HLTPC.I86 b/Digital Research MT+86 Pascal v311/HLTPC.I86 new file mode 100644 index 0000000..80938e5 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/HLTPC.I86 @@ -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 + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/INIPC.I86 b/Digital Research MT+86 Pascal v311/INIPC.I86 new file mode 100644 index 0000000..188a2c5 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/INIPC.I86 @@ -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 + + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/IOALONE.DOC b/Digital Research MT+86 Pascal v311/IOALONE.DOC new file mode 100644 index 0000000..fdaf5e4 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/IOALONE.DOC @@ -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. + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/IOMOD.SRC b/Digital Research MT+86 Pascal v311/IOMOD.SRC new file mode 100644 index 0000000..466ad17 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/IOMOD.SRC @@ -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. + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/LIBMT.EXE b/Digital Research MT+86 Pascal v311/LIBMT.EXE new file mode 100644 index 0000000..c4875a0 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/LIBMT.EXE differ diff --git a/Digital Research MT+86 Pascal v311/LINKMT.001 b/Digital Research MT+86 Pascal v311/LINKMT.001 new file mode 100644 index 0000000..07af7ed Binary files /dev/null and b/Digital Research MT+86 Pascal v311/LINKMT.001 differ diff --git a/Digital Research MT+86 Pascal v311/LINKMT.002 b/Digital Research MT+86 Pascal v311/LINKMT.002 new file mode 100644 index 0000000..ca0ae1b Binary files /dev/null and b/Digital Research MT+86 Pascal v311/LINKMT.002 differ diff --git a/Digital Research MT+86 Pascal v311/LINKMT.EXE b/Digital Research MT+86 Pascal v311/LINKMT.EXE new file mode 100644 index 0000000..bdcee00 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/LINKMT.EXE differ diff --git a/Digital Research MT+86 Pascal v311/MOD1.SRC b/Digital Research MT+86 Pascal v311/MOD1.SRC new file mode 100644 index 0000000..a70dabe --- /dev/null +++ b/Digital Research MT+86 Pascal v311/MOD1.SRC @@ -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. + + + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/MOD2.SRC b/Digital Research MT+86 Pascal v311/MOD2.SRC new file mode 100644 index 0000000..bd25262 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/MOD2.SRC @@ -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. + + + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/MT2INT.EXE b/Digital Research MT+86 Pascal v311/MT2INT.EXE new file mode 100644 index 0000000..0516e43 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT2INT.EXE differ diff --git a/Digital Research MT+86 Pascal v311/MT86.000 b/Digital Research MT+86 Pascal v311/MT86.000 new file mode 100644 index 0000000..b291b6e Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.000 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.001 b/Digital Research MT+86 Pascal v311/MT86.001 new file mode 100644 index 0000000..61bd610 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.001 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.002 b/Digital Research MT+86 Pascal v311/MT86.002 new file mode 100644 index 0000000..7a295da Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.002 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.003 b/Digital Research MT+86 Pascal v311/MT86.003 new file mode 100644 index 0000000..dfa7fb1 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.003 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.004 b/Digital Research MT+86 Pascal v311/MT86.004 new file mode 100644 index 0000000..a278197 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.004 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.005 b/Digital Research MT+86 Pascal v311/MT86.005 new file mode 100644 index 0000000..5f58b98 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.005 differ diff --git a/Digital Research MT+86 Pascal v311/MT86.EXE b/Digital Research MT+86 Pascal v311/MT86.EXE new file mode 100644 index 0000000..8a84551 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/MT86.EXE differ diff --git a/Digital Research MT+86 Pascal v311/MTERRS.TXT b/Digital Research MT+86 Pascal v311/MTERRS.TXT new file mode 100644 index 0000000..e937c50 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/MTERRS.TXT @@ -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 + 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 (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 type must be scalar or subrange +111 Incompatible with 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 + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/NM.EXE b/Digital Research MT+86 Pascal v311/NM.EXE new file mode 100644 index 0000000..a9ded3d Binary files /dev/null and b/Digital Research MT+86 Pascal v311/NM.EXE differ diff --git a/Digital Research MT+86 Pascal v311/OVLMGRPC.I86 b/Digital Research MT+86 Pascal v311/OVLMGRPC.I86 new file mode 100644 index 0000000..05fba59 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/OVLMGRPC.I86 @@ -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 + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/PASCALMT-311-PROGRAMMERS-GUIDE.pdf b/Digital Research MT+86 Pascal v311/PASCALMT-311-PROGRAMMERS-GUIDE.pdf new file mode 100644 index 0000000..4f9d1fe Binary files /dev/null and b/Digital Research MT+86 Pascal v311/PASCALMT-311-PROGRAMMERS-GUIDE.pdf differ diff --git a/Digital Research MT+86 Pascal v311/PASCALMT-311-REFERENCE-MANUAL.pdf b/Digital Research MT+86 Pascal v311/PASCALMT-311-REFERENCE-MANUAL.pdf new file mode 100644 index 0000000..fbd0aa4 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/PASCALMT-311-REFERENCE-MANUAL.pdf differ diff --git a/Digital Research MT+86 Pascal v311/PASLIB.R86 b/Digital Research MT+86 Pascal v311/PASLIB.R86 new file mode 100644 index 0000000..0378400 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/PASLIB.R86 differ diff --git a/Digital Research MT+86 Pascal v311/PROG.SRC b/Digital Research MT+86 Pascal v311/PROG.SRC new file mode 100644 index 0000000..0b27054 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/PROG.SRC @@ -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. + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/RANDOMIO.R86 b/Digital Research MT+86 Pascal v311/RANDOMIO.R86 new file mode 100644 index 0000000..55c9233 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/RANDOMIO.R86 differ diff --git a/Digital Research MT+86 Pascal v311/READ.ME b/Digital Research MT+86 Pascal v311/READ.ME new file mode 100644 index 0000000..dd0907e --- /dev/null +++ b/Digital Research MT+86 Pascal v311/READ.ME @@ -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 =/O:,/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 + + + \ No newline at end of file diff --git a/Digital Research MT+86 Pascal v311/SIEVE.PAS b/Digital Research MT+86 Pascal v311/SIEVE.PAS new file mode 100644 index 0000000..b4053d7 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/SIEVE.PAS @@ -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. diff --git a/Digital Research MT+86 Pascal v311/STRIP.EXE b/Digital Research MT+86 Pascal v311/STRIP.EXE new file mode 100644 index 0000000..d909c29 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/STRIP.EXE differ diff --git a/Digital Research MT+86 Pascal v311/SZ.EXE b/Digital Research MT+86 Pascal v311/SZ.EXE new file mode 100644 index 0000000..63ab40b Binary files /dev/null and b/Digital Research MT+86 Pascal v311/SZ.EXE differ diff --git a/Digital Research MT+86 Pascal v311/TAP.PAS b/Digital Research MT+86 Pascal v311/TAP.PAS new file mode 100644 index 0000000..de99d04 --- /dev/null +++ b/Digital Research MT+86 Pascal v311/TAP.PAS @@ -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 } + diff --git a/Digital Research MT+86 Pascal v311/TRANCEND.R86 b/Digital Research MT+86 Pascal v311/TRANCEND.R86 new file mode 100644 index 0000000..f9677c1 Binary files /dev/null and b/Digital Research MT+86 Pascal v311/TRANCEND.R86 differ diff --git a/Digital Research MT+86 Pascal v311/m.bat b/Digital Research MT+86 Pascal v311/m.bat new file mode 100644 index 0000000..e7ffb1a --- /dev/null +++ b/Digital Research MT+86 Pascal v311/m.bat @@ -0,0 +1,4 @@ +ntvdm mt86 %1 +ntvdm linkmt %1 paslib.r86 fpreals.r86 + +ntvdm -c -p %1 diff --git a/Digital Research MT+86 Pascal v311/mm.pas b/Digital Research MT+86 Pascal v311/mm.pas new file mode 100644 index 0000000..4d2d2eb --- /dev/null +++ b/Digital Research MT+86 Pascal v311/mm.pas @@ -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 } + diff --git a/Digital Research MT+86 Pascal v311/mtpas3.exe b/Digital Research MT+86 Pascal v311/mtpas3.exe new file mode 100644 index 0000000..793135d Binary files /dev/null and b/Digital Research MT+86 Pascal v311/mtpas3.exe differ diff --git a/Digital Research MT+86 Pascal v311/ttt.pas b/Digital Research MT+86 Pascal v311/ttt.pas new file mode 100644 index 0000000..2b364dd --- /dev/null +++ b/Digital Research MT+86 Pascal v311/ttt.pas @@ -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.