Microsoft Fortran v5.1
This commit is contained in:
davidly
parent
a0eb239680
commit
e3ef41d1a6
BIN
Microsoft Fortran v51/BIN/CV.EXE
Normal file
BIN
Microsoft Fortran v51/BIN/CV.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/FIXSHIFT.COM
Normal file
BIN
Microsoft Fortran v51/BIN/FIXSHIFT.COM
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/HIMEM.SYS
Normal file
BIN
Microsoft Fortran v51/BIN/HIMEM.SYS
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/MSHERC.COM
Normal file
BIN
Microsoft Fortran v51/BIN/MSHERC.COM
Normal file
Binary file not shown.
3
Microsoft Fortran v51/BIN/NEW-CONF.SYS
Normal file
3
Microsoft Fortran v51/BIN/NEW-CONF.SYS
Normal file
@ -0,0 +1,3 @@
|
||||
files=20
|
||||
buffers=10
|
||||
device=C:\FORTRAN\BIN\himem.sys
|
||||
6
Microsoft Fortran v51/BIN/NEW-VARS.BAT
Normal file
6
Microsoft Fortran v51/BIN/NEW-VARS.BAT
Normal file
@ -0,0 +1,6 @@
|
||||
SET PATH=C:\FORTRAN\BIN\;C:\FORTRAN\BINB\;Z:\
|
||||
SET LIB=C:\FORTRAN\LIB\
|
||||
SET INCLUDE=C:\FORTRAN\INCLUDE\
|
||||
SET HELPFILES=C:\FORTRAN\HELP\*.HLP
|
||||
SET INIT=C:\FORTRAN\INIT\
|
||||
SET TMP=C:\FORTRAN\BINB\
|
||||
BIN
Microsoft Fortran v51/BIN/NMAKE.EXE
Normal file
BIN
Microsoft Fortran v51/BIN/NMAKE.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/NMK.COM
Normal file
BIN
Microsoft Fortran v51/BIN/NMK.COM
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/QH.EXE
Normal file
BIN
Microsoft Fortran v51/BIN/QH.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/RAMDRIVE.SYS
Normal file
BIN
Microsoft Fortran v51/BIN/RAMDRIVE.SYS
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BIN/SMARTDRV.SYS
Normal file
BIN
Microsoft Fortran v51/BIN/SMARTDRV.SYS
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/CVPACK.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/CVPACK.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/DECOMP.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/DECOMP.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/EXEHDR.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/EXEHDR.EXE
Normal file
Binary file not shown.
577
Microsoft Fortran v51/BINB/F1.ERR
Normal file
577
Microsoft Fortran v51/BINB/F1.ERR
Normal file
@ -0,0 +1,577 @@
|
||||
G
|
||||
W
|
||||
4
|
||||
0
|
||||
0
|
||||
maximum memory-allocation size exceeded
|
||||
program too large for memory
|
||||
%fs : array bound used function call
|
||||
%fs : array bound used intrinsic call
|
||||
%fs : array bound used array reference
|
||||
%fs : array bound used illegal variable
|
||||
%fs : array bound used illegal variable
|
||||
%fs : already dimensioned
|
||||
%fs : allocatable variable cannot be AUTOMATIC
|
||||
%fs : ALLOCATABLE : bounds must be omitted
|
||||
%fs : array bounds missing
|
||||
%fs : more than 7 array bounds
|
||||
%s : attributes illegal on array bounds
|
||||
%fs : variable was declared automatic
|
||||
%fs : variable was declared automatic
|
||||
%fs : * : not last array bound
|
||||
%fs : bound size too small
|
||||
%fs : adjustable-size array not in subprogram
|
||||
%fs : NEAR array bigger than segment
|
||||
attributes are nonstandard
|
||||
%fs : %s attribute repeated
|
||||
%fs : %s illegal with attributes specified in same list
|
||||
%fs : %s attribute mismatch with earlier NEAR/FAR/HUGE
|
||||
%fs : %s illegal with attributes specified in earlier list
|
||||
%fs : NEAR/FAR/HUGE attribute mismatches default
|
||||
%fs : %s illegal on COMMON statements
|
||||
%fs : %s illegal on formal arguments
|
||||
%fs : %s illegal on ENTRY statements
|
||||
%fs : %s illegal on subprogram statements
|
||||
%fs : %s illegal on variable declarations
|
||||
%fs : %s illegal on NAMELIST declarations
|
||||
%fs : %s illegal on STRUCTURE declarations
|
||||
%fs : %s illegal on type declarations
|
||||
%fs : language attributes illegal on formal arguments
|
||||
%fs : %s only legal on formal arguments
|
||||
%fs : ALLOCATABLE : common block variable illegal
|
||||
%fs : ALLOCATABLE : equivalenced variable illegal
|
||||
%fs : illegal bound type
|
||||
%s : bound not integer
|
||||
%fs : substring on noncharacter item
|
||||
%fs : upper substring bound exceeds string length
|
||||
%fs : lower substring bound exceeds upper bound
|
||||
%fs : lower substring bound not positive
|
||||
concatenation with CHARACTER*(*)
|
||||
cannot pass CHARACTER*(*) by value
|
||||
label %ld : redefined in program unit
|
||||
no ASSIGN statements for assigned %s
|
||||
IF or ELSEIF missing
|
||||
expression type not LOGICAL
|
||||
statement stack underflow
|
||||
statement-nesting limit exceeded
|
||||
label %ld : used across blocks
|
||||
no assigned GOTO or FMT= for ASSIGN statement
|
||||
ASSIGN target not an INTEGER variable
|
||||
%fs : ASSIGN : variable not INTEGER
|
||||
%fs : ASSIGN : too many INTEGER*1 variables
|
||||
expression must be integer, character, or logical
|
||||
SELECT CASE : character expression must be of length 1
|
||||
no matching SELECT CASE statement
|
||||
no matching SELECT CASE statement
|
||||
only one CASE DEFAULT allowed
|
||||
CASE values must be constant expressions
|
||||
CASE value type does not match SELECT CASE expression type
|
||||
LOGICAL case value ranges illegal
|
||||
lower value exceeds upper value in case value range
|
||||
overlapping case values
|
||||
no matching DO loop
|
||||
DO-loop label %ld : out of order
|
||||
DO-loop expression not INTEGER or REAL
|
||||
zero illegal as increment
|
||||
DO-loop variable : not a variable
|
||||
%fs : illegal use of active DO-loop variable
|
||||
DO-loop variable not INTEGER or REAL
|
||||
ENDIF missing
|
||||
DO-loop label %ld : not seen
|
||||
DO-loop ENDDO : not seen
|
||||
END SELECT missing
|
||||
IF, ELSEIF, or ELSE missing
|
||||
too many assigned GOTO statements
|
||||
only variables allowed in assigned GOTO statements
|
||||
assigned GOTO variable not INTEGER
|
||||
computed GOTO variable not INTEGER
|
||||
expression type not INTEGER or REAL
|
||||
illegal statement after logical IF
|
||||
label %ld : previously used as FORMAT label
|
||||
label %ld : previously used as executable label
|
||||
block label %ld : must not be referenced
|
||||
label %ld : must not be referenced
|
||||
DO-loop label %ld : out of order
|
||||
assigned and unconditional GOTO illegal here
|
||||
block and arithmetic IF illegal here
|
||||
statement illegal as DO-loop termination
|
||||
%s : maximum of 5 digits
|
||||
%s : illegal expression
|
||||
%fs : EQUIVALENCE : enclosing class too big
|
||||
%fs : %s : attributes on items illegal
|
||||
%fs : EQUIVALENCE : formal argument illegal
|
||||
%fs : EQUIVALENCE : not array
|
||||
%fs : EQUIVALENCE : array subscripts missing
|
||||
%fs : EQUIVALENCE : nonconstant offset illegal
|
||||
%fs : EQUIVALENCE : nonconstant upper substring expression ignored
|
||||
%fs : nonconstant lower substring expression illegal
|
||||
%fs : EQUIVALENCE : structure elements illegal
|
||||
%s : NAMELIST : array bounds illegal
|
||||
%s : %s : length specification illegal
|
||||
%s : %s : attributes on items illegal
|
||||
%s : %s : %s name illegal
|
||||
%s : %s : preinitialization illegal
|
||||
%s : %s : allocatable array illegal
|
||||
%s : %s : structure illegal
|
||||
%s : %s : automatic variable illegal
|
||||
%s : %s : formal argument illegal
|
||||
%s : %s : not an array or variable
|
||||
%fs : COMMON : character and noncharacter items mixed
|
||||
%fs : COMMON : too big
|
||||
%fs : COMMON : array size nonconstant or zero
|
||||
%fs, %fs : EQUIVALENCE : character and noncharacter items mixed
|
||||
%fs, %fs : EQUIVALENCE : both in blank common block
|
||||
%s, %s : EQUIVALENCE : both in common block %fs
|
||||
%fs, %fs : EQUIVALENCE : in different common blocks
|
||||
%fs : EQUIVALENCE : extends blank common block forward
|
||||
%fs : EQUIVALENCE : extends common block %fs forward
|
||||
%fs, %fs : EQUIVALENCE : conflicting offsets
|
||||
%fs : EQUIVALENCE : two different common blocks
|
||||
%fs : NEAR/FAR/HUGE equivalence attribute conflict
|
||||
%fs : item in equivalence or common block crosses segment
|
||||
%fs : COMMON : size changed
|
||||
%fs : COMMON : size changed
|
||||
%fs : NEAR common block has HUGE item
|
||||
blank common can not be HUGE
|
||||
%fs : COMMON : too big to be NEAR
|
||||
%s : COMMON : function or subroutine name
|
||||
%fs : already in COMMON
|
||||
NAMELIST : group name required
|
||||
%fs : already typed
|
||||
NAMELIST : group name required
|
||||
%s : already in this namelist group
|
||||
%fs : EQUIVALENCE : needs at least two items
|
||||
DATA : iteration count not positive
|
||||
%s : DATA : illegal address expression
|
||||
%s : cannot initialize formal argument
|
||||
%s : cannot initialize item in blank common block
|
||||
%s : can only initialize common block in BLOCK DATA subprogram
|
||||
%s : DATA : not an array or variable
|
||||
%s : variable was declared automatic
|
||||
%s : cannot initialize allocatable array
|
||||
%fs : repeat count not positive integer
|
||||
%fs : DATA : nonconstant item in initializer list
|
||||
%fs : DATA : too few constants to initialize item
|
||||
%s : nonstatic address illegal in initialization
|
||||
%s : bound or increment not constant
|
||||
%s : bound or increment not INTEGER
|
||||
%s : DATA : zero increment
|
||||
%fs : DATA : active implied-DO variable
|
||||
%s : DATA : implied-DO variable not INTEGER
|
||||
%s : DATA : not array-element name
|
||||
DATA : too few constants to initialize names
|
||||
DATA : more constants than names
|
||||
%s : nonstandard statement
|
||||
%s : already declared %s
|
||||
%s : illegal use of %s
|
||||
%s : %s variable cannot be AUTOMATIC
|
||||
%fs : element name conflicts with operator
|
||||
%fs : already typed
|
||||
%s : already typed
|
||||
%s : types illegal on BLOCK DATA/COMMON/PROGRAM/SUBROUTINE
|
||||
%s : cannot initialize in type statements
|
||||
%s : length specifier illegal
|
||||
%s : STRUCTURE : preinitialization illegal
|
||||
%fs : CHARACTER*(*) type illegal
|
||||
%fs : STRUCTURE : too big
|
||||
%s : EQUIVALENCE : preinitialization illegal
|
||||
%s : COMMON : preinitialization illegal
|
||||
IMPLICIT NONE already seen
|
||||
IMPLICIT already seen
|
||||
RECORD : structure type illegal in IMPLICIT statement
|
||||
%s : IMPLICIT : only single letter allowed
|
||||
%c, %c : IMPLICIT : lower limit exceeds upper limit
|
||||
%c : already IMPLICIT
|
||||
%s : INTRINSIC : unknown name
|
||||
%s : PARAMETER : nonconstant expression
|
||||
formal argument %s: cannot be SAVE or AUTOMATIC
|
||||
syntax error
|
||||
STRUCTURE : not a name
|
||||
%s : already typed
|
||||
%fs : STRUCTURE: intrinsic type name
|
||||
no matching [END] STRUCTURE/UNION/MAP statement
|
||||
no matching [END] STRUCTURE/UNION/MAP statement
|
||||
%fs : STRUCTURE has no elements
|
||||
UNION : not in a STRUCTURE
|
||||
no matching [END] STRUCTURE/UNION/MAP statement
|
||||
no matching [END] STRUCTURE/UNION/MAP statement
|
||||
MAP : no enclosing UNION statement
|
||||
no matching [END] STRUCTURE/UNION/MAP statement
|
||||
too many symbols
|
||||
%s : declared with wrong type
|
||||
%fs : intrinsic function illegal as actual argument
|
||||
LEN : illegal expression
|
||||
%s : multiple arguments
|
||||
%s : cannot convert FAR address to NEAR
|
||||
%s : incorrect use of intrinsic function
|
||||
%s : cannot convert to %s
|
||||
%s : incorrect use of intrinsic function
|
||||
%c : illegal separator
|
||||
%s : cannot open include file
|
||||
octal value too big for byte
|
||||
%s : nonstandard character string delimiter
|
||||
closing quote missing
|
||||
CHARACTER constant too long
|
||||
zero-length CHARACTER constant
|
||||
empty escape sequence
|
||||
integer string too long
|
||||
alternate bases illegal
|
||||
illegal base value
|
||||
INTEGER constant must follow #
|
||||
illegal REAL constant
|
||||
%s : include file nested too deeply
|
||||
INTEGER value overflow
|
||||
FORMAT string too long
|
||||
missing ] following attribute string
|
||||
%s : attribute repeated
|
||||
colon expected following ALIAS
|
||||
opening quote missing
|
||||
unrecognized attribute
|
||||
%s : name too long; truncated
|
||||
%s : already specified in $%sLARGE
|
||||
INCLUDE : argument must be character constant
|
||||
INCLUDE : quoted string missing
|
||||
metacommands are nonstandard
|
||||
$DEBUG:'<debug-list>' illegal with $FREEFORM
|
||||
%c : nonalphabetic character in $DEBUG ignored
|
||||
$DEBUG:'<debug-list>' : string expected
|
||||
$DECMATH not supported
|
||||
no matching $IF
|
||||
no matching $IF
|
||||
no matching $IF
|
||||
$INCLUDE:'<filename>' : string expected
|
||||
$%s : integer constant out of range
|
||||
$%s:<integer constant> : integer constant expected
|
||||
$%sLARGE already set
|
||||
$%sLARGE illegal in executable statements
|
||||
$MESSAGE:'<message>' : string expected
|
||||
$STORAGE:<number> : 2 or 4 expected
|
||||
$SUBTITLE:'<subtitle>' : string expected
|
||||
$TITLE:'<title>' : string expected
|
||||
unrecognized metacommand
|
||||
metacommand already set
|
||||
metacommand must come before all FORTRAN statements
|
||||
characters following metacommand ignored
|
||||
Hollerith constant exceeds 1313 characters
|
||||
zero-length Hollerith constant
|
||||
Hollerith constant : text length disagrees with given length
|
||||
Hollerith not allowed
|
||||
%s : non-FORTRAN character
|
||||
%s : error closing file
|
||||
illegal label field
|
||||
zero-value label field
|
||||
free-form label too long
|
||||
label on continuation line
|
||||
$IF : no matching $ENDIF
|
||||
first statement line must have ' ' or '0' in column 6
|
||||
too many continuation lines
|
||||
label on blank line
|
||||
relational operator expected
|
||||
relational operator expected
|
||||
invalid integer constant
|
||||
%c : unrecognized character
|
||||
%s : defined with no value
|
||||
%s : not defined
|
||||
logical operator expected
|
||||
logical operator expected
|
||||
syntax error
|
||||
syntax error
|
||||
operand expected
|
||||
invalid expression in metacommand
|
||||
invalid integer constant
|
||||
unmatched parenthesis
|
||||
%c : unrecognized character
|
||||
%c : unrecognized character
|
||||
unmatched parenthesis
|
||||
%s : defined with no value
|
||||
%s : not defined
|
||||
%c : unrecognized character
|
||||
syntax error
|
||||
$DEFINE : %s : already defined
|
||||
$UNDEFINE : %s : not defined
|
||||
invalid integer constant
|
||||
%c : unrecognized character
|
||||
%s : defined with no value
|
||||
%c : unexpected characters at end of expression
|
||||
illegal %s flag, would overwrite %s with %s
|
||||
too many %s flags, %s
|
||||
%s : unknown option (%c)
|
||||
%s : illegal number in switch
|
||||
illegal command-line option
|
||||
out of disk space for compiler internal file
|
||||
write error on compiler internal file
|
||||
%s : cannot open file
|
||||
%s : name too long
|
||||
cannot open internal files
|
||||
-4Y and -4N : both options used for argument
|
||||
-4Y and -4N : both options used; -4Y assumed
|
||||
syntax error
|
||||
END missing
|
||||
%s : unrecognized option
|
||||
-4I2 or -4I4 expected
|
||||
illegal -A option
|
||||
-W%d : illegal warning level ignored
|
||||
-Zp%d : illegal pack value ignored
|
||||
program too large for memory
|
||||
RETURN : integer or character expression required
|
||||
%fs : alternate RETURN missing
|
||||
%s : DIMENSION : not array
|
||||
statement illegal with INTERFACE
|
||||
statement illegal in INTERFACE
|
||||
statement illegal in BLOCK DATA
|
||||
a CASE statement must follow a SELECT CASE statement
|
||||
statement illegal in STRUCTURE declaration
|
||||
%s : formal argument not local variable
|
||||
%s : formal argument not a variable
|
||||
%s : repeated in formal-argument list
|
||||
%s : statement function already declared
|
||||
%s : statement function : too few actual arguments
|
||||
%s : statement function : too many actual arguments
|
||||
%fs : formal argument %fs : never used
|
||||
%fs : formal argument %fs : subprogram passed by VALUE
|
||||
%fs : formal argument %fs : symbol-class mismatch
|
||||
%fs : language attribute mismatch
|
||||
%fs : type redefined
|
||||
%fs : type redefined
|
||||
%fs : length redefined
|
||||
%fs : NEAR/FAR attribute mismatch
|
||||
%fs : VARYING attribute mismatch
|
||||
%fs : previously called near
|
||||
%fs : previously called far
|
||||
%fs : defined with different number of arguments
|
||||
%fs : formal argument %fs : Hollerith passed to CHARACTER formal argument
|
||||
%fs : formal argument %fs : VALUE/REFERENCE mismatch
|
||||
%fs : formal argument %fs : NEAR/FAR/HUGE mismatch
|
||||
%fs : formal argument %fs : previously passed by value, now by reference
|
||||
%fs : formal argument %fs : previously passed by reference, now by value
|
||||
%fs : formal argument %fs : previously passed with NEAR, now with FAR or HUGE
|
||||
%fs : formal argument %fs : previously passed with FAR or HUGE, now with NEAR
|
||||
%fs : formal argument %fs : CHARACTER *(*) cannot pass by value
|
||||
%s : formal argument redefined
|
||||
%s : illegal as formal argument
|
||||
%s : formal argument previously initialized
|
||||
%s : EQUIVALENCE : formal argument illegal
|
||||
%s : COMMON : formal argument illegal
|
||||
ENTRY : formal argument %s : attribute %s : mismatch
|
||||
alternate RETURN only legal within SUBROUTINE
|
||||
ENTRY seen before FUNCTION or SUBROUTINE
|
||||
ENTRY not in function or subroutine
|
||||
too many PROGRAM statements
|
||||
%s : formal argument used as ENTRY
|
||||
%s : PROGRAM : name redefined
|
||||
%s : used or declared before ENTRY statement
|
||||
%fs : RECORD : illegal FUNCTION type
|
||||
%s : subprogram used or declared before INTERFACE
|
||||
%s : already defined
|
||||
%s : already used or declared with different symbol class
|
||||
%s : ENTRY : CHARACTER lengths differ
|
||||
%s : ENTRY : CHARACTER and non-CHARACTER types mixed in ENTRY statements
|
||||
too many ENTRY statements
|
||||
%fs : INTERFACE : not formal argument
|
||||
%fs : ALLOCATABLE : dummy argument illegal
|
||||
%fs : ALLOCATABLE : must be an array
|
||||
%fs : assumed-size array : cannot pass by value
|
||||
%fs : adjustable-size array : cannot pass by value
|
||||
statement out of order or END missing
|
||||
statement out of order
|
||||
no state transition for root of tree
|
||||
%fs : name too long; truncated
|
||||
%s : truncated to 6 characters
|
||||
%s : not previously declared
|
||||
label %ld : undefined
|
||||
%fs : FUNCTION : return variable not set
|
||||
%fs : variable declared but not used
|
||||
%fs : variable used but not defined
|
||||
%fs : COMMON not defined
|
||||
%fs : assumed-size array : not reference argument
|
||||
%fs : adjustable-size array : not reference argument
|
||||
%fs : CHARACTER*(*) type illegal
|
||||
%fs : VARYING illegal on symbol class
|
||||
%fs : $ illegal in C name
|
||||
%s : illegal length
|
||||
value %ld : INTEGER : range error
|
||||
CHARACTER*(*) in multi-thread may not work
|
||||
integer constant expression expected
|
||||
length specification illegal
|
||||
length %ld : illegal type length
|
||||
only C attribute legal on INTEGER type
|
||||
%s : not a STRUCTURE name
|
||||
attributes illegal on non-INTEGER types
|
||||
length specification illegal
|
||||
attributes illegal on non-INTEGER types
|
||||
DOUBLE PRECISION : length specifier illegal
|
||||
DOUBLE COMPLEX : length specifier illegal
|
||||
%fs : missing type
|
||||
illegal use of Hollerith constant
|
||||
illegal type conversion
|
||||
cannot convert between CHARACTER and non-CHARACTER constants
|
||||
cannot convert type to %s
|
||||
%fs : element is an array
|
||||
unknown primitive type
|
||||
missing symbol reference
|
||||
unknown constant type
|
||||
%fs : array expression : cannot be adjustable-size array
|
||||
%fs : array expression : cannot be assumed-size array
|
||||
%fs : array expression : cannot be allocatable array
|
||||
%fs : array expression : argument does not conform
|
||||
%fs : array expression : argument does not conform
|
||||
%fs : subscript %ld out of range
|
||||
%fs : subscript %ld out of range
|
||||
%fs : subscript %d : not integer
|
||||
%fs : too few array subscripts
|
||||
%fs : too many array subscripts
|
||||
%fs : array subscripts missing
|
||||
%fs : adjustable-size array : used before definition
|
||||
%s : not an element of %fs
|
||||
%fs : variable : argument list illegal
|
||||
%fs : substring on noncharacter item
|
||||
%fs : not a structure
|
||||
%s : not previously declared
|
||||
%s : symbolic constant : subscript illegal
|
||||
%s : symbolic constant : substring illegal
|
||||
%s : variable : argument list illegal
|
||||
%s : function : argument list missing
|
||||
%s : not a variable
|
||||
%s : not a variable
|
||||
%s : not a structure
|
||||
%s : substring on noncharacter item
|
||||
%s : function : substring operator illegal
|
||||
left side of assignment illegal
|
||||
%fs : assignment using active DO variable illegal
|
||||
incompatible types in assignment
|
||||
%fs : formal argument %fs : Hollerith illegal with CHARACTER
|
||||
%fs : formal argument %fs : type mismatch
|
||||
%fs : formal argument %fs : type mismatch
|
||||
%fs : formal argument %fs : length mismatch
|
||||
%fs : formal argument %fs : length mismatch
|
||||
%fs : alternate RETURN statement missing
|
||||
%fs : formal argument * : actual not alternate-return label
|
||||
%fs : formal argument %fs : not alternate-return label
|
||||
%fs : formal argument %fs : actual not subprogram
|
||||
%fs : formal argument %fs : subprogram mismatch
|
||||
%fs : formal argument %fs : not subprogram
|
||||
%fs : NEAR formal argument %fs : actual has FAR or HUGE address
|
||||
%fs : formal argument %s : passed FAR/HUGE
|
||||
%fs : formal argument %fs : length mismatch
|
||||
%fs : formal argument %fs : type mismatch
|
||||
%fs : not function or subroutine
|
||||
%fs : illegal use of function or subroutine
|
||||
%fs : type redefined
|
||||
%fs : length redefined
|
||||
%fs : too few actual arguments
|
||||
%fs : too many actual arguments
|
||||
%fs : directly recursive
|
||||
%fs : Hollerith constant passed by value
|
||||
%fs : assumed-size array %fs : cannot pass by value
|
||||
%fs : adjustable-size array %fs : cannot pass by value
|
||||
%fs : value argument bigger than segment
|
||||
%fs : formal argument %fs : CHARACTER expressions cannot be passed by VALUE
|
||||
nonconstant CHARACTER length : cannot pass by value
|
||||
incompatible types for formal and actual arguments
|
||||
%fs : formal argument %fs : length mismatch
|
||||
%fs : FAR formal argument %fs : passed HUGE array
|
||||
%fs : procedure must be EXTERNAL
|
||||
%fs : cannot use CHARACTER *(*) function
|
||||
consecutive arithmetic operators illegal
|
||||
negative exponent with zero base
|
||||
division by zero
|
||||
nonlogical operand
|
||||
operand type must be logical or integer
|
||||
non-numeric operand
|
||||
exponentiation of COMPLEX and DOUBLE PRECISION together illegal
|
||||
non-numeric operand
|
||||
operand types do not match
|
||||
invalid operator for structure variable operands
|
||||
operands of relation not numeric or character
|
||||
one numeric, one character operand
|
||||
only comparisons by .EQ. and .NE. allowed for complex items
|
||||
concatenation of expressions illegal
|
||||
noncharacter operand
|
||||
consecutive relational operators illegal
|
||||
illegal implied-DO list in expression
|
||||
illegal Xxprep node type
|
||||
%s : COMPLEX : type conversion error
|
||||
%s : REAL : type conversion error
|
||||
%s : operation error with COMPLEX operands
|
||||
%s : operation error with REAL operands
|
||||
%fs : symbol class illegal here
|
||||
DO : too many expressions
|
||||
label %ld : not between 1 and 99999
|
||||
I/O implied-DO list : list empty
|
||||
I/O implied-DO list : too many expressions
|
||||
I/O implied-DO list : illegal assignment
|
||||
I/O implied-DO list : too few expressions
|
||||
I/O implied-DO list : assigment missing
|
||||
assignments in COMPLEX constant illegal
|
||||
illegal assignment in parenthesized expression
|
||||
numeric constant expected
|
||||
%s : not symbolic constant
|
||||
component of COMPLEX number not INTEGER or REAL
|
||||
parser stack overflow, statement too complex
|
||||
syntax error
|
||||
%s : not %s
|
||||
%s : noncharacter array nonstandard
|
||||
%s : array subscript missing
|
||||
%s : not a variable or array element
|
||||
label %ld : not between 1 and 99999
|
||||
UNIT = * illegal for this statement
|
||||
illegal unit specifier
|
||||
illegal format specifier
|
||||
HUGE format illegal
|
||||
FAR format illegal in medium model
|
||||
%s : illegal statement label
|
||||
%s : NML= : not a namelist group name
|
||||
NML= : namelist group name missing
|
||||
%s : appears twice
|
||||
I/O option %ld : <keyword>= missing
|
||||
%s : option illegal for this statement
|
||||
%s : option nonstandard
|
||||
INQUIRE : either UNIT= or FILE= needed
|
||||
UNIT= missing
|
||||
UNIT=* : unformatted I/O illegal
|
||||
format specification illegal when namelist specified
|
||||
END= : illegal when REC= present
|
||||
REC= : illegal when FMT= *
|
||||
illegal I/O formatting for internal unit
|
||||
REC= illegal for internal unit
|
||||
FORMAT : label missing
|
||||
ASSIGN : too many format labels
|
||||
no ASSIGN statements for FMT=<integer variable>
|
||||
initial left parenthesis expected in format
|
||||
repeat count on nonrepeatable descriptor
|
||||
integer expected preceding H, X, or P edit descriptor
|
||||
positive integer expected in format
|
||||
N or Z expected after B in format
|
||||
format nesting limit exceeded
|
||||
%c or $ : nonstandard edit descriptor in format
|
||||
Z : nonstandard edit descriptor in format
|
||||
M field exceeds W field in I edit descriptor
|
||||
'.' : expected in format
|
||||
unexpected end of format
|
||||
'%c' : unexpected character in format
|
||||
unexpected character in format
|
||||
integer expected in format
|
||||
separator expected in format
|
||||
RECL= : out of range
|
||||
UNIT= : not between -32767 and 32767
|
||||
%s : unrecognized value in option
|
||||
ACCESS= : nonstandard option value
|
||||
RECL= required to open direct-access file
|
||||
%fs : too few array subscripts
|
||||
%s : attributes illegal on array bounds
|
||||
%fs : * : illegal bound
|
||||
%fs : too many array subscripts
|
||||
%s : STAT= must be last parameter
|
||||
%s : STAT= variable must be scalar integer
|
||||
%s : %s : not allocatable array
|
||||
illegal input list item
|
||||
%s : * illegal with this option
|
||||
%fs : assumed-size array illegal here
|
||||
%fs : HUGE internal units illegal
|
||||
%fs : record length too large for internal unit
|
||||
%s : I/O of entire structures illegal
|
||||
FAR or HUGE I/O item illegal in medium model
|
||||
%fs : cannot modify active DO variable
|
||||
I/O item illegal in namelist I/O
|
||||
LOCKING : nonstandard
|
||||
%s : lowercase in string nonstandard
|
||||
BIN
Microsoft Fortran v51/BINB/F1.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/F1.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/F1L.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/F1L.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/F2.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/F2.EXE
Normal file
Binary file not shown.
68
Microsoft Fortran v51/BINB/F23.ERR
Normal file
68
Microsoft Fortran v51/BINB/F23.ERR
Normal file
@ -0,0 +1,68 @@
|
||||
/* fatals */
|
||||
|
||||
1001 "Internal Compiler Error\n\t\t(compiler file '%s', line %d)\n\t\tContact Microsoft Technical Support"
|
||||
1002 "out of heap space"
|
||||
1003 "error count exceeds %d; stopping compilation"
|
||||
1004 "unexpected EOF"
|
||||
1005 "string too big for buffer"
|
||||
1006 "write error on compiler intermediate file"
|
||||
1007 "unrecognized flag '%s' in '%s'"
|
||||
1027 "DGROUP data allocation exceeds 64K"
|
||||
1028 "infinite recursion in cnstrpush"
|
||||
1029 "there are > 512 bytes of arguments"
|
||||
1030 "there are > 512 bytes of local variables"
|
||||
1031 "limit exceeded for nesting function calls"
|
||||
1032 "cannot open object listing file '%s'"
|
||||
1033 "cannot open assembly language output file '%s'"
|
||||
1034 "cannot open source file '%s'"
|
||||
1035 "expression too complex, please simplify"
|
||||
1036 "cannot open source listing file '%s'"
|
||||
1037 "cannot open object file '%s'"
|
||||
1038 "unexpected end of file in Pass 3"
|
||||
1039 "unrecoverable heap overflow in Pass 3"
|
||||
1040 "unexpected EOF in source file '%s'"
|
||||
1041 "cannot open compiler intermediate file - no more files"
|
||||
1042 "cannot open compiler intermediate file - no such file or directory"
|
||||
1043 "cannot open compiler intermediate file"
|
||||
1044 "out of disk space for compiler intermediate file"
|
||||
1045 "floating-point overflow"
|
||||
1046 "bad %s flag, would overwrite '%s' with '%s'"
|
||||
1047 "too many %s flags, '%s'"
|
||||
1048 "unknown option '%c' in '%s'"
|
||||
1049 "invalid numerical argument '%s'"
|
||||
1050 "%s : code segment too large\n"
|
||||
1051 "program too complex"
|
||||
1000 "UNKNOWN FATAL ERROR\n\t\tContact Microsoft Technical Support"
|
||||
|
||||
/* errors */
|
||||
|
||||
2023 "divide by 0"
|
||||
2024 "mod by 0"
|
||||
2124 "CODE GENERATION ERROR\n\t\tContact Microsoft Technical Support"
|
||||
2125 "%s : allocation exceeds 64K"
|
||||
2126 "%s : automatic allocation exceeds %s"
|
||||
2127 "parameter allocation exceeds 32K"
|
||||
2128 "%s : huge array cannot be aligned to segment boundary"
|
||||
2129 "static function '%s' not found\n"
|
||||
2000 "UNKNOWN ERROR\n\t\tContact Microsoft Technical Support"
|
||||
|
||||
/* warnings */
|
||||
|
||||
4056 "overflow in constant arithmetic"
|
||||
4057 "overflow in constant multiplication"
|
||||
4058 "address of frame variable taken, DS != SS"
|
||||
4059 "segment lost in conversion"
|
||||
4060 "conversion of long address to short address"
|
||||
4061 "long/short mismatch in argument : conversion supplied"
|
||||
4062 "near/far mismatch in argument : conversion supplied"
|
||||
4063 "%s : function too large for post-optimizer\n"
|
||||
4064 "procedure too large, skipping %s optimization and continuing\n"
|
||||
4065 "recoverable heap overflow in post-optimizer - some optimizations may be missed\n"
|
||||
4066 "local symbol table overflow - some local symbols may be missing in listings\n"
|
||||
4069 "conversion of near pointer to long integer"
|
||||
4070 "function called as procedure"
|
||||
4072 "Insufficient memory to process debugging information"
|
||||
4073 "scoping too deep, deepest scoping merged when debugging"
|
||||
4186 "string too long - truncated to %d characters"
|
||||
4187 "Debugging information exceeds 64K - extra ignored"
|
||||
4000 "UNKNOWN WARNING\n\t\tContact Microsoft Technical Support"
|
||||
BIN
Microsoft Fortran v51/BINB/F3.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/F3.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/F3S.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/F3S.EXE
Normal file
Binary file not shown.
30
Microsoft Fortran v51/BINB/FL.ERR
Normal file
30
Microsoft Fortran v51/BINB/FL.ERR
Normal file
@ -0,0 +1,30 @@
|
||||
/* error messages */
|
||||
|
||||
2001 "too many symbols predefined with /D"
|
||||
2002 "memory-model conflict"
|
||||
2003 "missing source filename"
|
||||
2008 "limit of %s exceeded at '%s'"
|
||||
2011 "only one floating-point option allowed"
|
||||
2012 "too many linker arguments"
|
||||
2016 "%s and %s are incompatible"
|
||||
2018 "cannot create linker response file"
|
||||
2019 "cannot overwrite source or object file '%s'"
|
||||
2021 "invalid numeric argument '%s'"
|
||||
2022 "cannot open '%s'"
|
||||
2027 "cannot execute '%s'"
|
||||
2031 "too many command-line arguments"
|
||||
2000 "UNKNOWN COMMAND-LINE ERROR\n\t\tContact Microsoft Product Support Services"
|
||||
|
||||
/* warning messages */
|
||||
|
||||
4001 "listing overrides assembly output"
|
||||
4002 "ignoring unknown option '%s'"
|
||||
4003 "processor-option conflict"
|
||||
4005 "cannot find '%s';\nPlease enter new filename (full path) or CTRL+C to quit: "
|
||||
4008 "nonstandard model; assuming large model"
|
||||
4009 "threshold only for far or huge data; ignored"
|
||||
4013 "combined listing overrides object listing"
|
||||
4014 "invalid value '%d' for '%s'; assuming '%d'"
|
||||
4018 ".DEF files supported for segmented executable files only"
|
||||
4019 "string too long; truncated to %d characters"
|
||||
4000 "UNKNOWN COMMAND-LINE WARNING\n\t\tContact Microsoft Product Support Services"
|
||||
BIN
Microsoft Fortran v51/BINB/FL.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/FL.EXE
Normal file
Binary file not shown.
95
Microsoft Fortran v51/BINB/FL.MSG
Normal file
95
Microsoft Fortran v51/BINB/FL.MSG
Normal file
@ -0,0 +1,95 @@
|
||||
FORTRAN COMPILER OPTIONS
|
||||
-METACOMMAND-
|
||||
/4cc<string> conditional compilation
|
||||
/4I{2|4} default integer size
|
||||
/4{y|n}6 FORTRAN 66
|
||||
/4{Y|N}a make variables AUTOMATIC
|
||||
/4{Y|N}b debug
|
||||
/4{Y|N}d declare
|
||||
/4{Y|N}f free-form format
|
||||
/4{Y|N}i conform to IBM extensions
|
||||
/4{Y|N}s strict syntax
|
||||
/4{Y|N}t truncate variable names
|
||||
/4{Y|N}v conform to VAX extensions
|
||||
/4{y|N}V enable IBM VS compatibility
|
||||
-SOURCE LISTINGS-
|
||||
/Sl<number> listing page width
|
||||
/St<title> listing title
|
||||
/Sp<number> listing page size
|
||||
/Ss<sub-title> Listing sub-title
|
||||
-MEMORY MODEL-
|
||||
/AM medium model
|
||||
/AL large model
|
||||
/AH huge model
|
||||
-OPTIMIZATION-
|
||||
/O enable optimization (same as /Ot)
|
||||
/Od disable optimizations
|
||||
/Ol enable loop optimizations
|
||||
/Op enable precision optimizations
|
||||
/Os optimize for space
|
||||
/Ot optimize for speed
|
||||
/Ox max. optimization (/Olt /Gs)
|
||||
-CODE GENERATION-
|
||||
/G0 8086 instructions
|
||||
/G1 186 instructions
|
||||
/G2 286 instructions
|
||||
/Gb backward compatibility
|
||||
/Ge enable stack checking
|
||||
/Gi incremental linking
|
||||
/Gs disable stack checking
|
||||
/Gt[<number>] data size threshold
|
||||
/Gw Windows calls
|
||||
-OUTPUT FILES-
|
||||
/Fa[<assembly listing file>]
|
||||
/Fb[<bound executable file>]
|
||||
/Fc[<mixed object/source listing file>]
|
||||
/Fe<executable file>
|
||||
/Fl[<object listing file>]
|
||||
/Fm[<map file>]
|
||||
/Fo<object file>
|
||||
/Fr add basic Source Browser info
|
||||
/FR add expanded Source Browser info
|
||||
/Fs[<source listing file>]
|
||||
-LANGUAGE-
|
||||
/Zc ignore case of PASCAL routines
|
||||
/Zd line number information
|
||||
/Zi symbolic debugging information
|
||||
/Zl remove default library info
|
||||
/Zp[n] pack struct on n-byte boundary
|
||||
/Zs syntax check only
|
||||
-FLOATING POINT-
|
||||
/FPa calls with altmath
|
||||
/FPc calls with emulator
|
||||
/FPc87 calls with 8087 library
|
||||
/FPi inline with emulator
|
||||
/FPi87 inline with 8087
|
||||
-MISCELLANEOUS-
|
||||
/Aw Windows DLL
|
||||
/c compile only, no link
|
||||
/D<name>[=text] define macro
|
||||
/H<number> external name length
|
||||
/help display online help
|
||||
/I<name> add "include file" path
|
||||
/MD support DLL
|
||||
/MT support multi-threads
|
||||
/MW support Windows
|
||||
/ND<name> set data segment's name
|
||||
/NM<name> set text segment's name
|
||||
/nologo suppress logo display
|
||||
/NT<name> set text segment's name
|
||||
/Tf<file> compile file without .for
|
||||
/V<string> set version string
|
||||
/W<number> warning level
|
||||
/Wx make all warnings fatal
|
||||
/X ignore "include file" paths
|
||||
/? display this information
|
||||
-MASM SUPPORT-
|
||||
/MA<switch> set MASM switch
|
||||
/Ta<file> assemble file without .asm
|
||||
/Fx[cross reference file]
|
||||
-LINKING-
|
||||
/F<hex_number> stack size (hex. bytes)
|
||||
/Lc link compatibility mode executable
|
||||
/Lr link compatibility mode executable
|
||||
/Lp link protect mode executable
|
||||
/link <linker options and libraries>
|
||||
BIN
Microsoft Fortran v51/BINB/HELPMAKE.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/HELPMAKE.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/ILINK.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/ILINK.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/ILINKSTB.OVL
Normal file
BIN
Microsoft Fortran v51/BINB/ILINKSTB.OVL
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/IMPLIB.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/IMPLIB.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/LIB.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/LIB.EXE
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/BINB/LINK.EXE
Normal file
BIN
Microsoft Fortran v51/BINB/LINK.EXE
Normal file
Binary file not shown.
449
Microsoft Fortran v51/BINB/README.DOC
Normal file
449
Microsoft Fortran v51/BINB/README.DOC
Normal file
@ -0,0 +1,449 @@
|
||||
README.DOC File
|
||||
Release notes for the Microsoft(R) FORTRAN
|
||||
Professional Development System, Version 5.1
|
||||
|
||||
This document contains release notes for version 5.1 of the Microsoft
|
||||
FORTRAN Professional Development System for MS-DOS(R) and the Microsoft
|
||||
Operating System/2 (MS(R) OS/2). The information in this document is
|
||||
more up-to-date than that in the manuals and the Microsoft Advisor
|
||||
(online help).
|
||||
|
||||
Microsoft improves its languages documentation at the time of reprinting,
|
||||
so some of the information in this file may already be in your manuals.
|
||||
|
||||
|
||||
|
||||
=================================< Contents >==================================
|
||||
|
||||
|
||||
This file has 5 parts:
|
||||
|
||||
Part Contents
|
||||
---- --------
|
||||
1 The SETUP Program
|
||||
2 FORTRAN Programming with Microsoft Windows
|
||||
3 Additions to the Microsoft FORTRAN Reference
|
||||
4 Additions to the Microsoft FORTRAN Environment and Tools
|
||||
5 Miscellaneous
|
||||
|
||||
|
||||
|
||||
=============================< The SETUP Program >=============================
|
||||
|
||||
|
||||
Disk Space for Additional Libraries
|
||||
-----------------------------------
|
||||
|
||||
Each library for a different combination of memory model and floating-
|
||||
point arithmetic requires a minimum of 220K of disk space. If you intend
|
||||
to create more than one library when running SETUP, be sure to take into
|
||||
account the additional disk space required.
|
||||
|
||||
|
||||
DECOMP.EXE
|
||||
----------
|
||||
|
||||
The files on the FORTRAN 5.1 disks are compressed. SETUP uses a utility
|
||||
called DECOMP.EXE to decompress the files before copying them to your hard
|
||||
disk. Normally you should use SETUP to copy files, and they will be
|
||||
decompressed automatically.
|
||||
|
||||
Occasionally, however, you may want to copy a file from the SETUP disks
|
||||
directly to your hard disk without using the SETUP program. In that case,
|
||||
you will have to use the DECOMP.EXE utility to decompress the file. The
|
||||
syntax for DECOMP.EXE is:
|
||||
|
||||
DECOMP filename.ab$ filename.abc
|
||||
|
||||
where filename.abc is the decompressed filename.
|
||||
|
||||
All compressed files end with $. If the filename extension is three
|
||||
characters long, the final character will be replaced with a $. If the
|
||||
extension is two characters, the two characters will be retained and a
|
||||
$ will be placed in the third position. If the extension has one
|
||||
character, then that character will be retained and followed by a $. If
|
||||
there is no extension, then the filename will be given a suffix of a
|
||||
single $.
|
||||
|
||||
For example:
|
||||
|
||||
f1.ex$ -> f1.exe
|
||||
source.do$ -> source.doc
|
||||
flib.fd$ -> flib.fd
|
||||
mulmix.c$ -> mulmix.c
|
||||
makefile.$ -> makefile
|
||||
|
||||
|
||||
|
||||
================< FORTRAN Programming with Microsoft Windows >================
|
||||
|
||||
|
||||
Requirement for Windows Dynamic-Link Libraries
|
||||
----------------------------------------------
|
||||
|
||||
All FORTRAN 5.1 dynamic-link libraries (DLLs) must explicitly export the
|
||||
symbol WEP. To do this, the statement
|
||||
|
||||
EXPORTS
|
||||
WEP
|
||||
|
||||
should be added to the DLL's module definition file. The WEP routine is
|
||||
included in the FORTRAN 5.1 startup code. If a DLL already has a user-
|
||||
defined WEP routine (for example, in a mixed-language DLL with existing C
|
||||
code), the WEP routine should be renamed _WEP. The FORTRAN 5.1 startup
|
||||
code will call _WEP, if present, during DLL termination. For additional
|
||||
information concerning the WEP function, see the Windows 3.0 SDK
|
||||
documentation.
|
||||
|
||||
|
||||
Close All Files Before Exiting a Windows DLL
|
||||
--------------------------------------------
|
||||
|
||||
When a Windows DLL written in FORTRAN terminates, any information
|
||||
left in a file output buffer will be lost. This is a result of how DLLs
|
||||
are terminated in Windows. To insure that all data is written to a
|
||||
file, explicitly CLOSE any open files in a DLL before the DLL is terminated.
|
||||
One way of doing this is by adding a function to the DLL code that closes all
|
||||
files, and calling this function just before the application terminates.
|
||||
|
||||
|
||||
MessageBox Support
|
||||
-------------------
|
||||
|
||||
FORTRAN supports two modes of MessageBox for QuickWin applications,
|
||||
TASKMODAL and SYSTEMMODAL. TASKMODAL requires that you respond to the
|
||||
message box before the application will perform any further calculations;
|
||||
however, all other applications currently running will not be affected.
|
||||
SYSTEMMODAL requires you to respond before any application may run.
|
||||
|
||||
|
||||
Maximizing Windows
|
||||
------------------
|
||||
|
||||
To maximize the frame window of a QuickWin application, place the
|
||||
following statement in the WIN.INI file:
|
||||
|
||||
[<appname>]
|
||||
QWINMaximized=1
|
||||
|
||||
where <appname> is the base name of your executable file. For example, if
|
||||
the executable file is called PROGRAM.EXE, the value for <appname> would
|
||||
be PROGRAM.
|
||||
|
||||
|
||||
Windows DLLs and Subprograms with String Arguments
|
||||
--------------------------------------------------
|
||||
|
||||
Don't pass char*(*) arguments to a subprogram residing in a Windows DLL.
|
||||
This is because the runtime in the calling DLL or EXE cannot communicate
|
||||
the length of the string with the runtime in the called DLL.
|
||||
|
||||
|
||||
|
||||
==============< Additions to the Microsoft FORTRAN Reference >=================
|
||||
|
||||
/Gt option
|
||||
----------
|
||||
|
||||
The /Gt, or data threshold, compiler option can remedy a number of link-
|
||||
time and run-time errors in FORTRAN 5.1. The /Gt option sets a threshold
|
||||
value that determines where data items are stored in memory. Data items
|
||||
that are greater in size than the threshold value, and that would normally
|
||||
be stored in the default data segment, or DGROUP, are moved to a far
|
||||
segment of data. This frees up more room in DGROUP for variables less
|
||||
than the threshold value and for other uses, such as the program STACK
|
||||
and NEAR HEAP.
|
||||
|
||||
Using the /Gt switch can often help eliminate the LINK errors:
|
||||
|
||||
L1070: 'segment name':Segment exceeds 64K
|
||||
|
||||
where segment can be _BSS or _DATA
|
||||
|
||||
L2041: Stack Plus Data exceeds 64K
|
||||
|
||||
and the run-time error:
|
||||
|
||||
F6700: Heap Space Limit Exceeded
|
||||
|
||||
In each of these cases, too much data is being stored in DGROUP, and using
|
||||
the /Gt switch may free up the required space. See Section 7.6 of the
|
||||
FORTRAN 5.1 Reference for more information.
|
||||
|
||||
|
||||
/Oc Option
|
||||
----------
|
||||
|
||||
When you use the /Oc (default common subexpression optimization), the
|
||||
compiler examines only short sections of code for common subexpressions.
|
||||
You can disable default common subexpression optimization with the /Od
|
||||
option.
|
||||
|
||||
|
||||
Special Device Names
|
||||
--------------------
|
||||
|
||||
The list of special device names in the FORTRAN Reference Manual is
|
||||
incomplete. The complete list of special device names is:
|
||||
|
||||
Device Name Comments
|
||||
=========== ========
|
||||
CON stdout, stdin
|
||||
USER stdout, stdin
|
||||
COM1 COM1 port
|
||||
AUX COM1 alias
|
||||
LINE COM1 alias
|
||||
LPT1 stdprn
|
||||
PRN stdprn
|
||||
LPT2
|
||||
LPT3
|
||||
LPT4
|
||||
ERR stderr
|
||||
NUL null device
|
||||
|
||||
Note that COM2, COM3, and COM4 are not special device names in FORTRAN
|
||||
5.1.
|
||||
|
||||
To access these devices, use an OPEN statement of the form:
|
||||
|
||||
OPEN (10, FILE='lpt1')
|
||||
|
||||
For connections to LPT2 or COM2, you are also required to specify
|
||||
STATUS='old'. These two devices are not treated as standard devices
|
||||
like LPT1 and COM1. Output to these devices is of the same form as to a
|
||||
file, i.e. the output is buffered and carriage control characters in
|
||||
column 1 are ignored.
|
||||
|
||||
|
||||
/ND Option
|
||||
----------
|
||||
|
||||
When using the /ND option in a module, you must also set the loadds
|
||||
attribute on all subprograms called from outside the module.
|
||||
|
||||
|
||||
Restrictions on String Assignment
|
||||
---------------------------------
|
||||
|
||||
The right and left sides of a string assignment may not reference the
|
||||
same memory location. For example, the following may fail because the
|
||||
generated code overlays the input as it produces the output:
|
||||
|
||||
character *10 string/'0123456789'
|
||||
string = '#' // string
|
||||
write (*,*) 'string = ' string
|
||||
end
|
||||
|
||||
|
||||
IBM VS Extensions in Microsoft FORTRAN
|
||||
-----------------------------------------
|
||||
|
||||
Microsoft FORTRAN supports only the following IBM VS FORTRAN
|
||||
extensions:
|
||||
|
||||
- 31-character names
|
||||
- Allowing integer arrays to contain FORMAT specifications
|
||||
- DO statements without specified labels
|
||||
- DO WHILE statement
|
||||
- END DO statement
|
||||
- Equivalence of character and non character items
|
||||
- Mixing of character and non-character items in COMMON
|
||||
- NAMELIST
|
||||
- Specification of common block items in DATA outside block data
|
||||
subprograms
|
||||
- Initialization on the declaration line
|
||||
- IMPLICIT NONE
|
||||
- INCLUDE
|
||||
- Length specification within declarations
|
||||
- Noninteger array subscripts
|
||||
- Z edit descriptor
|
||||
- ! comments
|
||||
- $ and _ in identifiers
|
||||
|
||||
|
||||
$NOTRUNCATE Metacommand
|
||||
-----------------------
|
||||
|
||||
$NOTRUNCATE is now the default. As a result, it is possible to create
|
||||
variable names, common block names, and function or subroutine names that
|
||||
are longer than the 26-character space allotted in a .LST file. If these
|
||||
identifiers do not differ in the first 26 characters, the .LST file shows
|
||||
them with the same name.
|
||||
|
||||
|
||||
New NINT Functions
|
||||
------------------
|
||||
|
||||
Three NINT intrinsic functions have been added: NINT1, NINT2, and NINT4.
|
||||
These return integer values of one, two, and four bytes respectively.
|
||||
|
||||
|
||||
The /4I2 Switch and the INT and NINT Functions
|
||||
----------------------------------------------
|
||||
|
||||
The length of the value returned by the INT and NINT intrinsic functions
|
||||
is determined by the integer storage switch: two bytes if /4I2 is used,
|
||||
four bytes if /4I4 (the default) is used.
|
||||
|
||||
If you want these functions to return a value with a length different
|
||||
from the length set by the integer storage switch, use INT1, INT2, or
|
||||
INT4 instead of INT, and use NINT1, NINT2, or NINT4 instead of NINT.
|
||||
|
||||
|
||||
80387 Coprocessor Instructions
|
||||
------------------------------
|
||||
|
||||
The run-time libraries recognize the presence of an 80387 coprocessor. If
|
||||
you are not using the alternate math package, the library uses the 80387
|
||||
SIN and COS instructions, rather than deriving sines and cosines from the
|
||||
FPTAN instruction.
|
||||
|
||||
|
||||
Array Conformity in Functions and Subroutines
|
||||
---------------------------------------------
|
||||
|
||||
A formal array argument in a subroutine or function does not have to have
|
||||
the same number of dimensions or total size as the actual array argument
|
||||
passed to it. This permits the procedure to contain a formal array that
|
||||
is as large as you think you will ever need; the calling program can then
|
||||
pass any array of the same size or smaller.
|
||||
|
||||
Note, however, that if the formal and actual dimensions do not match in
|
||||
quantity and size, the formal array elements do not point to the same
|
||||
memory locations as the actual array elements with the same subscripts.
|
||||
In this case, your program has to calculate the correct subscripts.
|
||||
|
||||
|
||||
"Out of Memory" Error Message
|
||||
-----------------------------
|
||||
|
||||
This compiler error does not have an error number. It occurs when the FL
|
||||
program does not have sufficient memory, as in the following cases:
|
||||
|
||||
1. You used wildcard characters to specify the files to be compiled (for
|
||||
example, FL *.FOR) and there were too many files. The exact number of
|
||||
files that can be handled depends on the amount of system memory.
|
||||
|
||||
2. The computer did not have enough free memory. This may occur when
|
||||
other processes are running under Microsoft Windows or OS/2.
|
||||
|
||||
|
||||
Additional Compiler Error Messages
|
||||
----------------------------------
|
||||
|
||||
F2399: <name> : COMMON (or EQUIVALENCE) : automatic variable illegal.
|
||||
|
||||
A variable previously declared as AUTOMATIC cannot appear in a COMMON
|
||||
block or an EQUIVALENCE statement.
|
||||
|
||||
|
||||
F4187: Debugging information exceeds 64K - extra ignored.
|
||||
|
||||
There was more debugging information than could fit in the allotted 64K
|
||||
space. The additional information (which is usually symbols) was
|
||||
discarded.
|
||||
|
||||
|
||||
Revised Compiler Error Message
|
||||
------------------------------
|
||||
|
||||
The <attribute> in error message F2384 can be "common block" or
|
||||
"equivalenced," in addition to ALLOCATABLE, EXTERN, FAR, or HUGE.
|
||||
|
||||
|
||||
Linker Path Specification
|
||||
-------------------------
|
||||
|
||||
The /link option does not allow you to specify the linker's path. FL
|
||||
assumes the linker is in the same directory as the compiler.
|
||||
|
||||
|
||||
FL Switch Default Values
|
||||
------------------------
|
||||
|
||||
If no switches appear in the FL command line, the source code is compiled
|
||||
with the following defaults:
|
||||
|
||||
1. The Large memory model is used
|
||||
2. The 8086/8088 instruction set is used
|
||||
3. 8087/287/387 in-line instructions are used for floating-point
|
||||
calculations
|
||||
4. Variable, subroutine, or function names are not truncated
|
||||
5. All integer and single-precision floating-point numbers are four bytes
|
||||
6. All Microsoft extensions to FORTRAN are enabled
|
||||
7. FORTRAN 66-style DO statements are disabled
|
||||
8. Full optimization is performed
|
||||
9. Debugging (extended run-time error handling) is disabled
|
||||
|
||||
Any metacommands in a source code file override these defaults.
|
||||
|
||||
|
||||
Compiling Extremely Large Programs
|
||||
----------------------------------
|
||||
|
||||
This release contains the file F1L.EXE, which is an alternate form of the
|
||||
Compiler Pass 1 disk if you need it.
|
||||
|
||||
This compiler pass is used to compile programs that receive error message
|
||||
"F1901: program too large for memory." The F1L.EXE pass is invoked by
|
||||
adding the /B1 option to the FL command line, as follows:
|
||||
|
||||
FL /B1 F1L.EXE <sourcefile>.FOR
|
||||
|
||||
where <path> is the path (including drive and directory) where F1L.EXE
|
||||
resides, and <sourcefile> is the name of the FORTRAN source file you are
|
||||
compiling. Alternatively, you can rename F1L.EXE to F1.EXE to make the
|
||||
high-capacity version the default.
|
||||
|
||||
|
||||
Compiler Errors and Warnings Generated by $DEBUG and /4Yb
|
||||
---------------------------------------------------------
|
||||
|
||||
In addition to the expanded run-time error handling and testing
|
||||
that $DEBUG and /4Yb enable, there are a number of compiler errors and
|
||||
warnings that appear if $DEBUG or /4Yb are used. They are:
|
||||
|
||||
Error F2367: INTEGER : range error
|
||||
Error F2533: lower substring bound exceeds upper bound
|
||||
Error F2534: upper substring bound exceeds string length
|
||||
Error F2535: lower substring bound not positive
|
||||
Error F2536: subscript out of range
|
||||
Warning F4501: subscript out of range (array argument)
|
||||
|
||||
|
||||
|
||||
======< Additions to the Microsoft FORTRAN Environment and Tools >======
|
||||
|
||||
|
||||
Displaying FORTRAN Arrays in CodeView
|
||||
-------------------------------------
|
||||
|
||||
CodeView allows you to expand arrays and examine the individual elements
|
||||
of an array. This feature, however, only works on one-dimensional arrays.
|
||||
Arrays of two dimensions or more cannot be expanded in CodeView.
|
||||
|
||||
Another limitation of CodeView is that it cannot keep track of elements
|
||||
of HUGE arrays beyond the first 64K, or first segment, of the array. An
|
||||
attempt to display an array element beyond the first segment will fail to
|
||||
give the proper value.
|
||||
|
||||
|
||||
TXTONLY.OBJ
|
||||
-----------
|
||||
|
||||
TXTONLY.OBJ is useful for programs that may use _clearscreen, _outtext,
|
||||
_settextcolor, _settextwindow, and so on, but do not use graphics. If you
|
||||
have a program that never has to work in or switch into graphics modes and
|
||||
never changes the palette, linking TXTONLY.OBJ into your DOS .EXE file (in
|
||||
the .OBJ field) will save about 12K of .EXE size.
|
||||
|
||||
|
||||
|
||||
================================< Miscellaneous >=============================
|
||||
|
||||
APPEND.EXE
|
||||
----------
|
||||
|
||||
Do not use the APPEND.EXE utility (shipped with DOS 4.01 and later
|
||||
versions) with FORTRAN applications. FORTRAN 5.1 does not set the
|
||||
APPEND path and the results are unpredictable.
|
||||
36
Microsoft Fortran v51/E.FOR
Normal file
36
Microsoft Fortran v51/E.FOR
Normal file
@ -0,0 +1,36 @@
|
||||
program e
|
||||
integer*2 high, n, x
|
||||
integer*2 a(200)
|
||||
|
||||
high = 200
|
||||
x = 0
|
||||
n = high - 1
|
||||
|
||||
150 if ( n .le. 0 ) goto 200
|
||||
a( n + 1 ) = 1
|
||||
n = n - 1
|
||||
goto 150
|
||||
|
||||
200 a( 2 ) = 2
|
||||
a( 1 ) = 0
|
||||
220 if ( high .le. 9 ) goto 400
|
||||
high = high - 1
|
||||
n = high
|
||||
240 if ( n .eq. 0 ) goto 300
|
||||
a( n + 1 ) = MOD( x, n )
|
||||
x = ( 10 * a( n ) ) + ( x / n )
|
||||
n = n - 1
|
||||
goto 240
|
||||
300 if ( x .ge. 10 ) goto 320
|
||||
write( *, 2000 ) x
|
||||
goto 220
|
||||
320 write( *, 2001 ) x
|
||||
goto 220
|
||||
400 write( *, 2010 )
|
||||
2000 format( '+', I1 )
|
||||
2001 format( '+', I2 )
|
||||
2010 format( ' done' )
|
||||
end
|
||||
|
||||
|
||||
|
||||
113
Microsoft Fortran v51/FOREXEC.INC
Normal file
113
Microsoft Fortran v51/FOREXEC.INC
Normal file
@ -0,0 +1,113 @@
|
||||
c FOREXEC.INC - interface file for C library routines
|
||||
|
||||
c This include file along with the CEXEC.LIB library has been included
|
||||
c with your FORTRAN 3.30 to show you how easy it is to call routines
|
||||
c written in our new C 3.00 release. The CEXEC.LIB contains several
|
||||
c routines from the C library which we think you will find useful in
|
||||
c extending the power of your FORTRAN programs.
|
||||
c
|
||||
c The new Microsoft FORTRAN 3.30, PASCAL 3.30, and C 3.00 releases
|
||||
c have been designed so that libraries or subprograms can be written
|
||||
c in any one of these languages and used in any other.
|
||||
c
|
||||
c Try compiling and running the demonstration program DEMOEXEC.FOR
|
||||
c to see some actual examples.
|
||||
|
||||
c C function
|
||||
c
|
||||
c int system(string)
|
||||
c char *string;
|
||||
c
|
||||
c The system() function passes the given C string (00hex terminated)
|
||||
c to the DOS command interpreter (COMMAND.COM), which interprets and
|
||||
c executes the string as an MS-DOS command. This allows MS-DOS commands
|
||||
c (i.e., DIR or DEL), batch files, and programs to be executed.
|
||||
c
|
||||
c Example usage in FORTRAN
|
||||
c
|
||||
c integer*2 system (the return type must be declared)
|
||||
c ...
|
||||
c i = system('dir *.for'c) (notice the C literal string '...'c)
|
||||
c
|
||||
c The interface to system is given below. The [c] attribute is given
|
||||
c after the function name. The argument string has the attribute
|
||||
c [reference] to indicate that the argument is passed by reference.
|
||||
c Normally, arguments are passed to C procedures by value.
|
||||
|
||||
interface to integer*2 function system [c]
|
||||
+ (string[reference])
|
||||
character*1 string
|
||||
end
|
||||
|
||||
|
||||
c C function
|
||||
c
|
||||
c int spawnlp(mode,path,arg0,arg1,...,argn)
|
||||
c int mode; /* spawn mode */
|
||||
c char *path; /* pathname of program to execute */
|
||||
c char *arg0; /* should be the same as path */
|
||||
c char *arg1,...,*argn; /* command line arguments */
|
||||
c /* argn must be NULL */
|
||||
c
|
||||
c The spawnlp (to be referenced in FORTRAN as spawn) creates and
|
||||
c executes a new child process. There must be enough memory to load
|
||||
c and execute the child process. The mode argument determines which
|
||||
c form of spawn is executed as follows:
|
||||
c
|
||||
c Value Action
|
||||
c
|
||||
c 0 Suspend parent program and execute the child program.
|
||||
c When the child program terminates, the parent program
|
||||
c resumes execution. The return value from spawn is -1
|
||||
c if an error has occured or if the child process has
|
||||
c run, the return value is the child processes return
|
||||
c code.
|
||||
c
|
||||
c 2 Overlay parent program with the child program. The
|
||||
c child program is now the running process and the
|
||||
c parent process is terminated. spawn only returns
|
||||
c a value if there has been a recoverable error. Some
|
||||
c errors can not be recovered from and execution will
|
||||
c terminate by safely returning to DOS. This might
|
||||
c happen if there is not enough memory to run the new
|
||||
c process.
|
||||
c
|
||||
c The path argument specifies the file to be executed as the child
|
||||
c process. The path can specify a full path name (from the root
|
||||
c directory \), a partial path name (from the current working directory),
|
||||
c or just a file name. If the path argument does not have a filename
|
||||
c extension or end with a period (.), the spawn call first appends
|
||||
c the extension ".COM" and searches for the file; if unsuccessful, the
|
||||
c extension ".EXE" is tried. The spawn routine will also search for
|
||||
c the file in any of the directories specified in the PATH environment
|
||||
c variable (using the same procedure as above).
|
||||
c
|
||||
c Example usage in FORTRAN
|
||||
c
|
||||
c integer*2 spawn (the return type must be declared)
|
||||
c ...
|
||||
c i = spawn(0, loc('exemod'c), loc('exemod'c),
|
||||
c + loc('demoexec.exe'c), int4(0)) (execute as a child)
|
||||
c
|
||||
c The interface to spawnlp is given below. The [c] attribute is given
|
||||
c after the function name. The [varying] attribute indicates that a
|
||||
c variable number of arguments may be given to the function. The
|
||||
c [alias] attribute has to be used because the C name for the function
|
||||
c spawnlp has 7 characters. Names in FORTRAN are only significant to
|
||||
c 6 characters, so we 'alias' the FORTRAN name spawn to the actual C
|
||||
c name spawnlp. Notice in the example above the C strings are passed
|
||||
c differently from the system function. This is because the string
|
||||
c arguments to spawn are undeclared in the interface below and assumed
|
||||
c to be passed by value. The C spawnlp function is expecting the
|
||||
c addresses of the strings (not the actual characters), so we use the
|
||||
c LOC() function to pass the address (remember that functions with the
|
||||
c [c] attribute pass arguments by value). The last parameter to the
|
||||
c spawn routine must be a C NULL pointer which is a 32-bit integer 0,
|
||||
c so we use the INT4(0) function to pass this number by value as the
|
||||
c last parameter.
|
||||
|
||||
interface to integer*2 function spawn
|
||||
+ [c,varying,alias:'spawnlp']
|
||||
+ (mode)
|
||||
integer*2 mode
|
||||
end
|
||||
BIN
Microsoft Fortran v51/HELP/CV.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/CV.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/FL.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/FL.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/FORLANG.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/FORLANG.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/LINK.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/LINK.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/PWB.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/PWB.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/QH.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/QH.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/UTILERR.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/UTILERR.HLP
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/HELP/UTILS.HLP
Normal file
BIN
Microsoft Fortran v51/HELP/UTILS.HLP
Normal file
Binary file not shown.
334
Microsoft Fortran v51/INCLUDE/FGRAPH.FD
Normal file
334
Microsoft Fortran v51/INCLUDE/FGRAPH.FD
Normal file
@ -0,0 +1,334 @@
|
||||
*fgraph.fd - declare constants and functions for graphics library
|
||||
*
|
||||
* Copyright (c) 1987-1991 Microsoft Corporation. All rights reserved.
|
||||
*
|
||||
*Purpose:
|
||||
* This file declares the graphics library functions and
|
||||
* the manifest constants that are used with them.
|
||||
*
|
||||
*******************************************************************************
|
||||
|
||||
$NOTRUNCATE ! required for some names to be significant
|
||||
$NOTSTRICT ! uses structures which are non-standard conforming
|
||||
|
||||
* user-visible declarations for FORTRAN Graphics Library
|
||||
|
||||
* structure for getvideoconfig() as visible to user
|
||||
STRUCTURE/videoconfig/
|
||||
INTEGER*2 numxpixels ! number of pixels on X axis
|
||||
INTEGER*2 numypixels ! number of pixels on Y axis
|
||||
INTEGER*2 numtextcols ! number of text columns available
|
||||
INTEGER*2 numtextrows ! number of text rows available
|
||||
INTEGER*2 numcolors ! number of actual colors
|
||||
INTEGER*2 bitsperpixel ! number of bits per pixel
|
||||
INTEGER*2 numvideopages ! number of available video pages
|
||||
INTEGER*2 mode ! current video mode
|
||||
INTEGER*2 adapter ! active display adapter
|
||||
INTEGER*2 monitor ! active display monitor
|
||||
INTEGER*2 memory ! adapter video memory in K bytes
|
||||
END STRUCTURE
|
||||
|
||||
* return value of getcurrentposition(), etc.
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
|
||||
* structure for text position
|
||||
STRUCTURE/rccoord/
|
||||
INTEGER*2 row
|
||||
INTEGER*2 col
|
||||
END STRUCTURE
|
||||
|
||||
* ERROR HANDLING
|
||||
|
||||
* status info returned by grstatus()
|
||||
INTEGER*2 $GRPARAMETERALTERED,$GRCLIPPED,$GRNOOUTPUT,$GROK,
|
||||
+ $GRERROR,$GRMODENOTSUPPORTED,$GRNOTINPROPERMODE,
|
||||
+ $GRINVALIDPARAMETER,$GRFONTFILENOTFOUND,
|
||||
+ $GRINVALIDFONTFILE,$GRCORRUPTEDFONTFILE,
|
||||
+ $GRINSUFFICIENTMEMORY,$GRINVALIDIMAGEBUFFER
|
||||
* successful
|
||||
PARAMETER($GROK = 0) ! success
|
||||
* warnings
|
||||
PARAMETER($GRNOOUTPUT = 1) ! nothing drawn
|
||||
PARAMETER($GRCLIPPED = 2) ! output was partially clipped
|
||||
PARAMETER($GRPARAMETERALTERED = 3) ! input parameters adjusted
|
||||
* errors
|
||||
PARAMETER($GRERROR = -1) ! generic graphics error
|
||||
PARAMETER($GRMODENOTSUPPORTED = -2) ! video mode not supported
|
||||
PARAMETER($GRNOTINPROPERMODE = -3) ! not supported in current mode
|
||||
PARAMETER($GRINVALIDPARAMETER = -4) ! bad parameter
|
||||
PARAMETER($GRFONTFILENOTFOUND = -5) ! font file not found
|
||||
PARAMETER($GRINVALIDFONTFILE = -6) ! not a font file
|
||||
PARAMETER($GRCORRUPTEDFONTFILE = -7) ! inconsistent font file
|
||||
PARAMETER($GRINSUFFICIENTMEMORY = -8) ! out of memory
|
||||
PARAMETER($GRINVALIDIMAGEBUFFER = -9) ! bad image buffer detected
|
||||
|
||||
* SETUP AND CONFIGURATION
|
||||
|
||||
* arguments to setvideomode()
|
||||
INTEGER*2 $MAXRESMODE,$MAXCOLORMODE,$DEFAULTMODE,$TEXTBW40,
|
||||
+ $TEXTC40,$TEXTBW80,$TEXTC80,$MRES4COLOR,$MRESNOCOLOR,
|
||||
+ $HRESBW,$TEXTMONO,$HERCMONO,$MRES16COLOR,$HRES16COLOR,
|
||||
+ $ERESNOCOLOR,$ERESCOLOR,$VRES2COLOR,$VRES16COLOR,
|
||||
+ $MRES256COLOR,$ORESCOLOR
|
||||
PARAMETER($MAXRESMODE =-3) ! graphics mode with highest resolution
|
||||
PARAMETER($MAXCOLORMODE =-2) ! graphics mode with most colors
|
||||
PARAMETER($DEFAULTMODE =-1) ! restore screen to original mode
|
||||
PARAMETER($TEXTBW40 =0) ! 40 x 25 text, 16 grey
|
||||
PARAMETER($TEXTC40 =1) ! 40 x 25 text, 16/8 color
|
||||
PARAMETER($TEXTBW80 =2) ! 80 x 25 text, 16 grey
|
||||
PARAMETER($TEXTC80 =3) ! 80 x 25 text, 16/8 color
|
||||
PARAMETER($MRES4COLOR =4) ! 320 x 200, 4 color
|
||||
PARAMETER($MRESNOCOLOR =5) ! 320 x 200, 4 grey
|
||||
PARAMETER($HRESBW =6) ! 640 x 200, BW
|
||||
PARAMETER($TEXTMONO =7) ! 80 x 25 text, BW
|
||||
PARAMETER($HERCMONO =8) ! 720 x 348, BW for HGC
|
||||
PARAMETER($MRES16COLOR =13) ! 320 x 200, 16 color
|
||||
PARAMETER($HRES16COLOR =14) ! 640 x 200, 16 color
|
||||
PARAMETER($ERESNOCOLOR =15) ! 640 x 350, BW
|
||||
PARAMETER($ERESCOLOR =16) ! 640 x 350, 4 or 16 color
|
||||
PARAMETER($VRES2COLOR =17) ! 640 x 480, BW
|
||||
PARAMETER($VRES16COLOR =18) ! 640 x 480, 16 color
|
||||
PARAMETER($MRES256COLOR =19) ! 320 x 200, 256 color
|
||||
PARAMETER($ORESCOLOR =64) ! 640 x 400, 1 of 16 colors (Olivetti)
|
||||
|
||||
* videoconfig adapter values
|
||||
* these manifest constants can be used to determine the type of the active
|
||||
* adapter, using either simple comparisons or the bitwise-AND operator
|
||||
INTEGER*2 $MDPA,$CGA,$EGA,$MCGA,$VGA,$HGC,$OCGA,$OEGA,$OVGA
|
||||
PARAMETER($MDPA =#0001) ! Monochrome Display Adapter (MDPA)
|
||||
PARAMETER($CGA =#0002) ! Color Graphics Adapter (CGA)
|
||||
PARAMETER($EGA =#0004) ! Enhanced Graphics Adapter (EGA)
|
||||
PARAMETER($VGA =#0008) ! Video Graphics Array (VGA)
|
||||
PARAMETER($MCGA =#0010) ! MultiColor Graphics Array (MCGA)
|
||||
PARAMETER($HGC =#0020) ! Hercules Graphics Card (HGC)
|
||||
PARAMETER($OCGA =#0042) ! Olivetti Color Graphics Adapter (OCGA)
|
||||
PARAMETER($OEGA =#0044) ! Olivetti Enhanced Graphics Adapter (OEGA)
|
||||
PARAMETER($OVGA =#0048) ! Olivetti Video Graphics Array (OVGA)
|
||||
|
||||
* videoconfig monitor values
|
||||
* these manifest constants can be used to determine the type of monitor in
|
||||
* use, using either simple comparisons or the bitwise-AND operator
|
||||
INTEGER*2 $MONO,$COLOR,$ENHCOLOR,$ANALOGMONO,
|
||||
+ $ANALOGCOLOR,$ANALOG
|
||||
PARAMETER($MONO =#0001) ! Monochrome
|
||||
PARAMETER($COLOR =#0002) ! Color (or Enhanced emulating color)
|
||||
PARAMETER($ENHCOLOR =#0004) ! Enhanced Color
|
||||
PARAMETER($ANALOGMONO =#0008) ! Analog Monochrome only
|
||||
PARAMETER($ANALOGCOLOR=#0010) ! Analog Color only
|
||||
PARAMETER($ANALOG =#0018) ! Analog
|
||||
|
||||
* COORDINATE SYSTEMS
|
||||
|
||||
* OUTPUT ROUTINES
|
||||
|
||||
* control parameters for rectangle(), polygon(), ellipse(), and pie()
|
||||
INTEGER*2 $GBORDER,$GFILLINTERIOR
|
||||
PARAMETER($GBORDER =2) ! draw outline only
|
||||
PARAMETER($GFILLINTERIOR =3) ! fill using current fill mask
|
||||
|
||||
* parameters for clearscreen()
|
||||
INTEGER*2 $GCLEARSCREEN,$GVIEWPORT,$GWINDOW
|
||||
PARAMETER($GCLEARSCREEN =0)
|
||||
PARAMETER($GVIEWPORT =1)
|
||||
PARAMETER($GWINDOW =2)
|
||||
|
||||
* TEXT
|
||||
|
||||
* parameters for displaycursor()
|
||||
INTEGER*2 $GCURSOROFF,$GCURSORON
|
||||
PARAMETER($GCURSOROFF =0)
|
||||
PARAMETER($GCURSORON =1)
|
||||
|
||||
* parameters for wrapon()
|
||||
INTEGER*2 $GWRAPOFF,$GWRAPON
|
||||
PARAMETER($GWRAPOFF =0)
|
||||
PARAMETER($GWRAPON =1)
|
||||
|
||||
* parameters for scrolltextwindow()
|
||||
INTEGER*2 $GSCROLLUP,$GSCROLLDOWN
|
||||
PARAMETER($GSCROLLUP =1)
|
||||
PARAMETER($GSCROLLDOWN =-1)
|
||||
|
||||
* request maximum number of rows in _settextrows() and _setvideomoderows()
|
||||
INTEGER*2 $MAXTEXTROWS
|
||||
PARAMETER($MAXTEXTROWS =-1)
|
||||
|
||||
* "action verbs" for putimage(), setwritemode()
|
||||
INTEGER*2 $GPSET,$GPRESET,$GAND,$GOR,$GXOR
|
||||
PARAMETER($GPSET =3)
|
||||
PARAMETER($GPRESET =2)
|
||||
PARAMETER($GAND =1)
|
||||
PARAMETER($GOR =0)
|
||||
PARAMETER($GXOR =4)
|
||||
|
||||
* Color values are used with setbkcolor in graphics modes and also by
|
||||
* remappalette abd remapallpalette. Also known as palette colors.
|
||||
* Not to be confused with color indices (aka. color attributes).
|
||||
|
||||
* universal color values (all color modes):
|
||||
INTEGER*4 $BLACK,$BLUE,$GREEN,$CYAN,$RED,$MAGENTA,$BROWN,
|
||||
+ $WHITE,$GRAY,$LIGHTBLUE,$LIGHTGREEN,$LIGHTCYAN,
|
||||
+ $LIGHTRED,$LIGHTMAGENTA,$YELLOW,$BRIGHTWHITE
|
||||
PARAMETER($BLACK =#000000)
|
||||
PARAMETER($BLUE =#2a0000)
|
||||
PARAMETER($GREEN =#002a00)
|
||||
PARAMETER($CYAN =#2a2a00)
|
||||
PARAMETER($RED =#00002a)
|
||||
PARAMETER($MAGENTA =#2a002a)
|
||||
PARAMETER($BROWN =#00152a)
|
||||
PARAMETER($WHITE =#2a2a2a)
|
||||
PARAMETER($GRAY =#151515)
|
||||
PARAMETER($LIGHTBLUE =#3F1515)
|
||||
PARAMETER($LIGHTGREEN =#153f15)
|
||||
PARAMETER($LIGHTCYAN =#3f3f15)
|
||||
PARAMETER($LIGHTRED =#15153f)
|
||||
PARAMETER($LIGHTMAGENTA =#3f153f)
|
||||
PARAMETER($YELLOW =#153f3f)
|
||||
PARAMETER($BRIGHTWHITE =#3f3f3f)
|
||||
|
||||
* the following is obsolescent and defined only for backwards compatibility
|
||||
INTEGER*4 $LIGHTYELLOW
|
||||
PARAMETER($LIGHTYELLOW =#153f3f)
|
||||
|
||||
* mono mode F ($ERESNOCOLOR) color values:
|
||||
INTEGER*4 $MODEFOFF,$MODEFOFFTOON,$MODEFOFFTOHI,$MODEFONTOOFF,
|
||||
+ $MODEFON,$MODEFONTOHI,$MODEFHITOOFF,$MODEFHITOON,
|
||||
+ $MODEFHI
|
||||
PARAMETER($MODEFOFF =0)
|
||||
PARAMETER($MODEFOFFTOON =1)
|
||||
PARAMETER($MODEFOFFTOHI =2)
|
||||
PARAMETER($MODEFONTOOFF =3)
|
||||
PARAMETER($MODEFON =4)
|
||||
PARAMETER($MODEFONTOHI =5)
|
||||
PARAMETER($MODEFHITOOFF =6)
|
||||
PARAMETER($MODEFHITOON =7)
|
||||
PARAMETER($MODEFHI =8)
|
||||
|
||||
* mono mode 7 ($TEXTMONO) color values:
|
||||
INTEGER*4 $MODE7OFF,$MODE7ON,$MODE7HI
|
||||
PARAMETER($MODE7OFF =0)
|
||||
PARAMETER($MODE7ON =1)
|
||||
PARAMETER($MODE7HI =2)
|
||||
|
||||
* external function declarations
|
||||
|
||||
INTEGER*2 grstatus[EXTERN]
|
||||
INTEGER*2 setvideomode[EXTERN]
|
||||
INTEGER*2 setvideomoderows[EXTERN]
|
||||
INTEGER*2 setactivepage[EXTERN]
|
||||
INTEGER*2 setvisualpage[EXTERN]
|
||||
INTEGER*2 getactivepage[EXTERN]
|
||||
INTEGER*2 getvisualpage[EXTERN]
|
||||
EXTERNAL getvideoconfig
|
||||
EXTERNAL setvieworg
|
||||
EXTERNAL getviewcoord
|
||||
EXTERNAL getphyscoord
|
||||
EXTERNAL setcliprgn
|
||||
EXTERNAL setviewport
|
||||
EXTERNAL clearscreen
|
||||
EXTERNAL moveto
|
||||
EXTERNAL getcurrentposition
|
||||
INTEGER*2 lineto[EXTERN]
|
||||
INTEGER*2 rectangle[EXTERN]
|
||||
INTEGER*2 polygon[EXTERN]
|
||||
INTEGER*2 ellipse[EXTERN]
|
||||
INTEGER*2 arc[EXTERN]
|
||||
INTEGER*2 pie[EXTERN]
|
||||
INTEGER*2 getarcinfo[EXTERN]
|
||||
INTEGER*2 setpixel[EXTERN]
|
||||
INTEGER*2 getpixel[EXTERN]
|
||||
INTEGER*2 floodfill[EXTERN]
|
||||
INTEGER*2 setcolor[EXTERN]
|
||||
INTEGER*2 getcolor[EXTERN]
|
||||
|
||||
EXTERNAL setlinestyle
|
||||
INTEGER*2 getlinestyle[EXTERN]
|
||||
INTEGER*2 setwritemode[EXTERN]
|
||||
INTEGER*2 getwritemode[EXTERN]
|
||||
EXTERNAL setfillmask
|
||||
EXTERNAL getfillmask
|
||||
INTEGER*4 setbkcolor[EXTERN]
|
||||
INTEGER*4 getbkcolor[EXTERN]
|
||||
INTEGER*4 remappalette[EXTERN]
|
||||
INTEGER*2 remapallpalette[EXTERN]
|
||||
INTEGER*2 selectpalette[EXTERN]
|
||||
INTEGER*2 settextrows[EXTERN]
|
||||
EXTERNAL settextwindow
|
||||
EXTERNAL gettextwindow
|
||||
EXTERNAL scrolltextwindow
|
||||
EXTERNAL outtext
|
||||
INTEGER*2 wrapon[EXTERN]
|
||||
INTEGER*2 displaycursor[EXTERN]
|
||||
INTEGER*2 settextcursor[EXTERN]
|
||||
INTEGER*2 gettextcursor[EXTERN]
|
||||
EXTERNAL settextposition
|
||||
EXTERNAL gettextposition
|
||||
INTEGER*2 settextcolor[EXTERN]
|
||||
INTEGER*2 gettextcolor[EXTERN]
|
||||
EXTERNAL getimage
|
||||
EXTERNAL putimage
|
||||
INTEGER*4 imagesize[EXTERN]
|
||||
|
||||
* WINDOW COORDINATE SYSTEM
|
||||
|
||||
* structure for window coordinate pair
|
||||
STRUCTURE/wxycoord/
|
||||
DOUBLE PRECISION wx ! window x coordinate
|
||||
DOUBLE PRECISION wy ! window y coordinate
|
||||
END STRUCTURE
|
||||
|
||||
INTEGER*2 setwindow[EXTERN]
|
||||
|
||||
EXTERNAL getwindowcoord
|
||||
EXTERNAL getviewcoord_w
|
||||
EXTERNAL getcurrentposition_w
|
||||
|
||||
* window coordinate entry points for graphics output routines
|
||||
|
||||
INTEGER*2 arc_w[EXTERN]
|
||||
INTEGER*2 ellipse_w[EXTERN]
|
||||
INTEGER*2 floodfill_w[EXTERN]
|
||||
INTEGER*2 getpixel_w[EXTERN]
|
||||
INTEGER*2 lineto_w[EXTERN]
|
||||
EXTERNAL moveto_w
|
||||
INTEGER*2 pie_w[EXTERN]
|
||||
INTEGER*2 rectangle_w[EXTERN]
|
||||
INTEGER*2 polygon_w[EXTERN]
|
||||
INTEGER*2 setpixel_w[EXTERN]
|
||||
EXTERNAL getimage_w
|
||||
INTEGER*4 imagesize_w[EXTERN]
|
||||
EXTERNAL putimage_w
|
||||
|
||||
STRUCTURE/fontinfo/
|
||||
INTEGER*2 type ! b0 set = vector,clear = bit map
|
||||
INTEGER*2 ascent ! pix dist from top to baseline
|
||||
INTEGER*2 pixwidth ! character width in pixels, 0=prop
|
||||
INTEGER*2 pixheight ! character height in pixels
|
||||
INTEGER*2 avgwidth ! average character width in pixels
|
||||
CHARACTER*81 filename ! file name including path
|
||||
CHARACTER*32 facename ! font name
|
||||
END STRUCTURE
|
||||
|
||||
* Font parameters
|
||||
|
||||
INTEGER*2 $NO_SPACE,$FIXED_SPACE,$PROP_SPACE
|
||||
PARAMETER ($NO_SPACE = 0)
|
||||
PARAMETER ($FIXED_SPACE = 1)
|
||||
PARAMETER ($PROP_SPACE = 2)
|
||||
|
||||
INTEGER*2 $NO_FONT_MAP,$VECTOR_MAP,$BIT_MAP
|
||||
PARAMETER ($NO_FONT_MAP = 0)
|
||||
PARAMETER ($VECTOR_MAP = 1)
|
||||
PARAMETER ($BIT_MAP = 2)
|
||||
|
||||
INTEGER*2 registerfonts[EXTERN]
|
||||
EXTERNAL unregisterfonts
|
||||
INTEGER*2 setfont[EXTERN]
|
||||
INTEGER*2 getfontinfo[EXTERN]
|
||||
EXTERNAL outgtext
|
||||
INTEGER*2 getgtextextent[EXTERN]
|
||||
EXTERNAL setgtextvector
|
||||
EXTERNAL getgtextvector
|
||||
485
Microsoft Fortran v51/INCLUDE/FGRAPH.FI
Normal file
485
Microsoft Fortran v51/INCLUDE/FGRAPH.FI
Normal file
@ -0,0 +1,485 @@
|
||||
***
|
||||
*fgraph.fi - declare constants and functions for graphics library
|
||||
*
|
||||
* Copyright (c) 1987-1991 Microsoft Corporation. All rights reserved.
|
||||
*
|
||||
*Purpose:
|
||||
* This file declares the graphics library functions and
|
||||
* the manifest constants that are used with them.
|
||||
*
|
||||
*******************************************************************************
|
||||
|
||||
$NOTRUNCATE
|
||||
$NOTSTRICT
|
||||
|
||||
* user-visible declarations for FORTRAN Graphics Library
|
||||
|
||||
INTERFACE TO FUNCTION arc(x1,y1,x2,y2,x3,y3,x4,y4)
|
||||
INTEGER*2 arc[FAR,C,ALIAS:"__arc"],x1,y1,x2,y2,x3,y3,x4,y4
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION arc_w(wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4)
|
||||
INTEGER*2 arc_w[FAR,C,ALIAS:"__arc_w"]
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getarcinfo(lpstart,lpend,lppaint)
|
||||
INTEGER*2 getarcinfo[FAR,C,ALIAS:"__getarcinfo"]
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/lpstart[FAR,REFERENCE]
|
||||
RECORD/xycoord/lpend[FAR,REFERENCE]
|
||||
RECORD/xycoord/lppaint[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ clearscreen[FAR,C,ALIAS:"__clearscreen"](area)
|
||||
INTEGER*2 area
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION displaycursor(toggle)
|
||||
INTEGER*2 displaycursor[FAR,C,ALIAS:"__displaycursor"],toggle
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION ellipse(control,x1,y1,x2,y2)
|
||||
INTEGER*2 ellipse[FAR,C,ALIAS:"__ellipse"],control,x1,y1,x2,y2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION ellipse_w(control,wx1,wy1,wx2,wy2)
|
||||
INTEGER*2 ellipse_w[FAR,C,ALIAS:"__ellipse_w"],control
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION floodfill(x,y,boundary)
|
||||
INTEGER*2 floodfill[FAR,C,ALIAS:"__floodfill"],x,y,boundary
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION floodfill_w(wx1,wy1,boundary)
|
||||
INTEGER*2 floodfill_w[FAR,C,ALIAS:"__floodfill_w"],boundary
|
||||
DOUBLE PRECISION wx1,wy1
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getactivepage()
|
||||
INTEGER*2 getactivepage[FAR,C,ALIAS:"__getactivepage"]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getbkcolor()
|
||||
INTEGER*4 getbkcolor[FAR,C,ALIAS:"__getbkcolor"]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getcolor()
|
||||
INTEGER*2 getcolor[FAR,C,ALIAS:"__getcolor"]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getcurrentposition[FAR,C,ALIAS:"__f_getcurrentposition"](s)
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getcurrentposition_w[FAR,C,ALIAS:"__f_getcurrentposition_wxy"](s)
|
||||
STRUCTURE/wxycoord/
|
||||
DOUBLE PRECISION wx
|
||||
DOUBLE PRECISION wy
|
||||
END STRUCTURE
|
||||
RECORD/wxycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getfillmask[FAR,C,ALIAS:"__getfillmask"](mask)
|
||||
INTEGER*1 mask[FAR,REFERENCE](8)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getimage[FAR,C,ALIAS:"__getimage"](x1,y1,x2,y2,image)
|
||||
INTEGER*2 x1,y1,x2,y2
|
||||
INTEGER*1 image[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getimage_w[FAR,C,ALIAS:"__getimage_w"](wx1,wy1,wx2,wy2,image)
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2
|
||||
INTEGER*1 image[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getlinestyle()
|
||||
INTEGER*2 getlinestyle[FAR,C,ALIAS:"__getlinestyle"]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getphyscoord[FAR,C,ALIAS:"__f_getphyscoord"](x,y,s)
|
||||
INTEGER*2 x,y
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getpixel(x,y)
|
||||
INTEGER*2 getpixel[FAR,C,ALIAS:"__getpixel"],x,y
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getpixel_w(wx,wy)
|
||||
INTEGER*2 getpixel_w[FAR,C,ALIAS:"__getpixel_w"]
|
||||
DOUBLE PRECISION wx,wy
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION gettextcolor()
|
||||
INTEGER*2 gettextcolor[FAR,C,ALIAS:"__gettextcolor"]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION gettextcursor()
|
||||
INTEGER*2 gettextcursor[FAR,C,ALIAS:"__gettextcursor"]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ gettextposition[FAR,C,ALIAS:"__f_gettextposition"](s)
|
||||
STRUCTURE/rccoord/
|
||||
INTEGER*2 row
|
||||
INTEGER*2 col
|
||||
END STRUCTURE
|
||||
RECORD/rccoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ gettextwindow[FAR,C,ALIAS:"__gettextwindow"](r1,c1,r2,c2)
|
||||
INTEGER*2 r1[FAR,REFERENCE],c1[FAR,REFERENCE]
|
||||
INTEGER*2 r2[FAR,REFERENCE],c2[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getvideoconfig[FAR,C,ALIAS:"__getvideoconfig"](s)
|
||||
STRUCTURE/videoconfig/
|
||||
INTEGER*2 numxpixels ! number of pixels on X axis
|
||||
INTEGER*2 numypixels ! number of pixels on Y axis
|
||||
INTEGER*2 numtextcols ! number of text columns available
|
||||
INTEGER*2 numtextrows ! number of text rows available
|
||||
INTEGER*2 numcolors ! number of actual colors
|
||||
INTEGER*2 bitsperpixel ! number of bits per pixel
|
||||
INTEGER*2 numvideopages ! number of available video pages
|
||||
INTEGER*2 mode ! current video mode
|
||||
INTEGER*2 adapter ! active display adapter
|
||||
INTEGER*2 monitor ! active display monitor
|
||||
INTEGER*2 memory ! adapter video memory in K bytes
|
||||
END STRUCTURE
|
||||
RECORD/videoconfig/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getviewcoord[FAR,C,ALIAS:"__f_getviewcoord"](x,y,s)
|
||||
INTEGER*2 x,y
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getviewcoord_w[FAR,C,ALIAS:"__f_getviewcoord_w"](wx,wy,s)
|
||||
DOUBLE PRECISION wx,wy
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getvisualpage()
|
||||
INTEGER*2 getvisualpage[FAR,C,ALIAS:"__getvisualpage"]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getwindowcoord[FAR,C,ALIAS:"__f_getwindowcoord"](x,y,s)
|
||||
INTEGER*2 x,y
|
||||
STRUCTURE/wxycoord/
|
||||
DOUBLE PRECISION wx
|
||||
DOUBLE PRECISION wy
|
||||
END STRUCTURE
|
||||
RECORD/wxycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getwritemode()
|
||||
INTEGER*2 getwritemode[FAR,C,ALIAS:"__getwritemode"]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION grstatus()
|
||||
INTEGER*2 grstatus[FAR,C,ALIAS:"__grstatus"]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION imagesize(x1,y1,x2,y2)
|
||||
INTEGER*4 imagesize[FAR,C,ALIAS:"__imagesize"]
|
||||
INTEGER*2 x1,y1,x2,y2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION imagesize_w(wx1,wy1,wx2,wy2)
|
||||
INTEGER*4 imagesize_w[FAR,C,ALIAS:"__imagesize_w"]
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION lineto(x,y)
|
||||
INTEGER*2 lineto[FAR,C,ALIAS:"__lineto"],x,y
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION lineto_w(wx,wy)
|
||||
INTEGER*2 lineto_w[FAR,C,ALIAS:"__lineto_w"]
|
||||
DOUBLE PRECISION wx,wy
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ moveto[FAR,C,ALIAS:"__f_moveto"](x,y,s)
|
||||
INTEGER*2 x,y
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ moveto_w[FAR,C,ALIAS:"__f_moveto_w"](wx,wy,s)
|
||||
DOUBLE PRECISION wx,wy
|
||||
STRUCTURE/wxycoord/
|
||||
DOUBLE PRECISION wx
|
||||
DOUBLE PRECISION wy
|
||||
END STRUCTURE
|
||||
RECORD/wxycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ outtext[FAR,C,ALIAS:"__f_outtext"](text)
|
||||
CHARACTER*(*) text[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION pie(i,x1,y1,x2,y2,x3,y3,x4,y4)
|
||||
INTEGER*2 pie[FAR,C,ALIAS:"__pie"],i,x1,y1,x2,y2,x3,y3,x4,y4
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION pie_w(i,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4)
|
||||
INTEGER*2 pie_w[FAR,C,ALIAS:"__pie_w"],i
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION polygon(control,lppoints,cpoints)
|
||||
INTEGER*2 polygon[FAR,C,ALIAS:"__polygon"],control,cpoints
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/lppoints[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION polygon_w(control,lppoints,cpoints)
|
||||
INTEGER*2 polygon_w[FAR,C,ALIAS:"__polygon_w"],control,cpoints
|
||||
STRUCTURE/wxycoord/
|
||||
DOUBLE PRECISION wx
|
||||
DOUBLE PRECISION wy
|
||||
END STRUCTURE
|
||||
RECORD/wxycoord/lppoints[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ putimage[FAR,C,ALIAS:"__putimage"](x,y,image,action)
|
||||
INTEGER*2 x,y,action
|
||||
INTEGER*1 image[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ putimage_w[FAR,C,ALIAS:"__putimage_w"](wx,wy,image,action)
|
||||
DOUBLE PRECISION wx,wy
|
||||
INTEGER*1 image[FAR,REFERENCE](*)
|
||||
INTEGER*2 action
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION rectangle(control,x1,y1,x2,y2)
|
||||
INTEGER*2 rectangle[FAR,C,ALIAS:"__rectangle"]
|
||||
INTEGER*2 control,x1,y1,x2,y2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION rectangle_w(control,wx1,wy1,wx2,wy2)
|
||||
INTEGER*2 rectangle_w[FAR,C,ALIAS:"__rectangle_w"],control
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION remappalette(index,color)
|
||||
INTEGER*4 remappalette[FAR,C,ALIAS:"__remappalette"],color
|
||||
INTEGER*2 index
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION remapallpalette(colors)
|
||||
INTEGER*2 remapallpalette[FAR,C,ALIAS:"__remapallpalette"]
|
||||
INTEGER*4 colors[FAR,REFERENCE](*)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ scrolltextwindow[FAR,C,ALIAS:"__scrolltextwindow"](rows)
|
||||
INTEGER*2 rows
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION selectpalette(number)
|
||||
INTEGER*2 selectpalette[FAR,C,ALIAS:"__selectpalette"],number
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setactivepage(page)
|
||||
INTEGER*2 setactivepage[FAR,C,ALIAS:"__setactivepage"],page
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setbkcolor(color)
|
||||
INTEGER*4 setbkcolor[FAR,C,ALIAS:"__setbkcolor"],color
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setcliprgn[FAR,C,ALIAS:"__setcliprgn"](x1,y1,x2,y2)
|
||||
INTEGER*2 x1,y1,x2,y2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setcolor(color)
|
||||
INTEGER*2 setcolor[FAR,C,ALIAS:"__setcolor"]
|
||||
INTEGER*2 color
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setfillmask[FAR,C,ALIAS:"__setfillmask"](mask)
|
||||
INTEGER*1 mask[FAR,REFERENCE](8)
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setlinestyle[FAR,C,ALIAS:"__setlinestyle"](mask)
|
||||
INTEGER*2 mask
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setpixel(x,y)
|
||||
INTEGER*2 setpixel[FAR,C,ALIAS:"__setpixel"],x,y
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setpixel_w(wx,wy)
|
||||
INTEGER*2 setpixel_w[FAR,C,ALIAS:"__setpixel_w"]
|
||||
DOUBLE PRECISION wx,wy
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION settextcolor(index)
|
||||
INTEGER*2 settextcolor[FAR,C,ALIAS:"__settextcolor"],index
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION settextcursor(attr)
|
||||
INTEGER*2 settextcursor[FAR,C,ALIAS:"__settextcursor"],attr
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ settextposition[FAR,C,ALIAS:"__f_settextposition"](row,col,s)
|
||||
INTEGER*2 row,col
|
||||
STRUCTURE/rccoord/
|
||||
INTEGER*2 row
|
||||
INTEGER*2 col
|
||||
END STRUCTURE
|
||||
RECORD/rccoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION settextrows(rows)
|
||||
INTEGER*2 settextrows[FAR,C,ALIAS:"__settextrows"],rows
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ settextwindow[FAR,C,ALIAS:"__settextwindow"](r1,c1,r2,c2)
|
||||
INTEGER*2 r1,c1,r2,c2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setvideomode(mode)
|
||||
INTEGER*2 setvideomode[FAR,C,ALIAS:"__setvideomode"],mode
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setvideomoderows(mode,rows)
|
||||
INTEGER*2 setvideomoderows[FAR,C,ALIAS:"__setvideomoderows"]
|
||||
INTEGER*2 mode,rows
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setvieworg[FAR,C,ALIAS:"__f_setvieworg"](x,y,s)
|
||||
INTEGER*2 x,y
|
||||
STRUCTURE/xycoord/
|
||||
INTEGER*2 xcoord
|
||||
INTEGER*2 ycoord
|
||||
END STRUCTURE
|
||||
RECORD/xycoord/s[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setviewport[FAR,C,ALIAS:"__setviewport"](x1,y1,x2,y2)
|
||||
INTEGER*2 x1,y1,x2,y2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setvisualpage(page)
|
||||
INTEGER*2 setvisualpage[FAR,C,ALIAS:"__setvisualpage"],page
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setwindow(finvert,wx1,wy1,wx2,wy2)
|
||||
INTEGER*2 setwindow[FAR,C,ALIAS:"__setwindow"]
|
||||
LOGICAL*2 finvert
|
||||
DOUBLE PRECISION wx1,wy1,wx2,wy2
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setwritemode(wmode)
|
||||
INTEGER*2 setwritemode[FAR,C,ALIAS:"__setwritemode"],wmode
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION wrapon(option)
|
||||
INTEGER*2 wrapon[FAR,C,ALIAS:"__wrapon"],option
|
||||
END
|
||||
|
||||
* FONTS
|
||||
|
||||
INTERFACE TO FUNCTION getfontinfo(fi)
|
||||
INTEGER*2 getfontinfo[FAR,C,ALIAS:"__f_getfontinfo"]
|
||||
STRUCTURE/fontinfo/
|
||||
INTEGER*2 type ! b0 set = vector,clear = bit map
|
||||
INTEGER*2 ascent ! pix dist from top to baseline
|
||||
INTEGER*2 pixwidth ! character width in pixels, 0=prop
|
||||
INTEGER*2 pixheight ! character height in pixels
|
||||
INTEGER*2 avgwidth ! average character width in pixels
|
||||
CHARACTER*81 filename ! file name including path
|
||||
CHARACTER*32 facename ! font name
|
||||
END STRUCTURE
|
||||
RECORD/fontinfo/fi[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION getgtextextent(text)
|
||||
INTEGER*2 getgtextextent[FAR,C,ALIAS:"__f_getgtextextent"]
|
||||
CHARACTER*(*) text[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ getgtextvector[FAR,C,ALIAS:"__f_getgtextvector"](x,y)
|
||||
INTEGER*2 x[FAR,REFERENCE],y[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ outgtext[FAR,C,ALIAS:"__f_outgtext"](text)
|
||||
CHARACTER*(*) text[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION registerfonts(filename)
|
||||
INTEGER*2 registerfonts[FAR,C,ALIAS:"__f_registerfonts"]
|
||||
CHARACTER*(*) filename[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO FUNCTION setfont(options)
|
||||
INTEGER*2 setfont[FAR,C,ALIAS:"__f_setfont"]
|
||||
CHARACTER*(*) options[FAR,REFERENCE]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ setgtextvector[FAR,C,ALIAS:"__setgtextvector"](x,y)
|
||||
INTEGER*2 x,y
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE
|
||||
+ unregisterfonts[FAR,C,ALIAS:"__unregisterfonts"]()
|
||||
END
|
||||
|
||||
298
Microsoft Fortran v51/INCLUDE/FLIB.FD
Normal file
298
Microsoft Fortran v51/INCLUDE/FLIB.FD
Normal file
@ -0,0 +1,298 @@
|
||||
C****************************** Module Header ******************************
|
||||
C*
|
||||
C* Copyright (c) 1990 Microsoft Corporation
|
||||
C*
|
||||
C* Module Name: FLIB.FD
|
||||
C*
|
||||
C* This module provides parameter and structure type declarations
|
||||
C* needed to communicate with subprograms found in the various FORTRAN
|
||||
C* libraries. Each of the functional areas covered by this include file
|
||||
C* are small enough that separate include files for each are not warranted.
|
||||
C*
|
||||
C* The functional areas covered are the following.
|
||||
C*
|
||||
C* Math error support.
|
||||
C*
|
||||
C* Signal handling.
|
||||
C*
|
||||
C* Intdos/Intdosx.
|
||||
C*
|
||||
C***************************************************************************
|
||||
C -----------------------------------------------------------------
|
||||
C Data Tyoe Codes.
|
||||
C -----------------------------------------------------------------
|
||||
C Only of interest for math errors currently.
|
||||
INTEGER TY$REAL4
|
||||
INTEGER TY$REAL8
|
||||
INTEGER TY$CMPLX8
|
||||
INTEGER TY$CMPLX16
|
||||
|
||||
PARAMETER (TY$REAL4 = 1)
|
||||
PARAMETER (TY$REAL8 = 2)
|
||||
PARAMETER (TY$CMPLX8 = 3)
|
||||
PARAMETER (TY$CMPLX16 = 4)
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Math Error Support
|
||||
C -----------------------------------------------------------------
|
||||
C Codes for function failure.
|
||||
INTEGER MTH$E_DOMAIN ! Argument domain error
|
||||
INTEGER MTH$E_SINGULARITY ! Argument Singularity
|
||||
INTEGER MTH$E_OVERFLOW ! Overflow range error
|
||||
INTEGER MTH$E_UNDERFLOW ! Underflow range error
|
||||
INTEGER MTH$E_TLOSS ! Total loss of precision
|
||||
INTEGER MTH$E_PLOSS ! Partial loss of precision
|
||||
|
||||
PARAMETER (MTH$E_DOMAIN = 1)
|
||||
PARAMETER (MTH$E_SINGULARITY = 2)
|
||||
PARAMETER (MTH$E_OVERFLOW = 3)
|
||||
PARAMETER (MTH$E_UNDERFLOW = 4)
|
||||
PARAMETER (MTH$E_TLOSS = 5)
|
||||
PARAMETER (MTH$E_PLOSS = 6)
|
||||
|
||||
C Math error information structure.
|
||||
STRUCTURE /MTH$E_INFO/
|
||||
INTEGER*2 ERRCODE ! INPUT : One of the MTH$ values above
|
||||
INTEGER*2 FTYPE ! INPUT : One of the TY$ values above
|
||||
UNION
|
||||
MAP
|
||||
REAL*4 R4ARG1 ! INPUT : FIrst argument
|
||||
REAL*4 R4ARG2 ! INPUT : Second argument (if any)
|
||||
REAL*4 R4RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
REAL*8 R8ARG1 ! INPUT : FIrst argument
|
||||
REAL*8 R8ARG2 ! INPUT : Second argument (if any)
|
||||
REAL*8 R8RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
COMPLEX*8 C8ARG1 ! INPUT : FIrst argument
|
||||
COMPLEX*8 C8ARG2 ! INPUT : Second argument (if any)
|
||||
COMPLEX*8 C8RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
COMPLEX*16 C16ARG1 ! INPUT : FIrst argument
|
||||
COMPLEX*16 C16ARG2 ! INPUT : Second argument (if any)
|
||||
COMPLEX*16 C16RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
END UNION
|
||||
END STRUCTURE
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Signal support
|
||||
C -----------------------------------------------------------------
|
||||
INTEGER SIG$ERR ! SIGNALQQ return value
|
||||
INTEGER SIG$NSIG
|
||||
INTEGER SIG$INT
|
||||
INTEGER SIG$ILL
|
||||
INTEGER SIG$FPE
|
||||
INTEGER SIG$SEGV
|
||||
INTEGER SIG$TERM
|
||||
INTEGER SIG$USR1
|
||||
INTEGER SIG$USR2
|
||||
INTEGER SIG$USR3
|
||||
INTEGER SIG$BREAK
|
||||
INTEGER SIG$ABORT
|
||||
|
||||
PARAMETER (SIG$ERR = -1)
|
||||
PARAMETER (SIG$NSIG = 23)
|
||||
PARAMETER (SIG$INT = 2)
|
||||
PARAMETER (SIG$ILL = 4)
|
||||
PARAMETER (SIG$FPE = 8)
|
||||
PARAMETER (SIG$SEGV = 11)
|
||||
PARAMETER (SIG$TERM = 15)
|
||||
PARAMETER (SIG$USR1 = 16)
|
||||
PARAMETER (SIG$USR2 = 17)
|
||||
PARAMETER (SIG$USR3 = 20)
|
||||
PARAMETER (SIG$BREAK = 21)
|
||||
PARAMETER (SIG$ABORT = 22)
|
||||
|
||||
INTEGER FPE$INVALID
|
||||
INTEGER FPE$DENORMAL
|
||||
INTEGER FPE$ZERODIVIDE
|
||||
INTEGER FPE$OVERFLOW
|
||||
INTEGER FPE$UNDERFLOW
|
||||
INTEGER FPE$INEXACT
|
||||
INTEGER FPE$UNEMULATED
|
||||
INTEGER FPE$SQRTNEG
|
||||
INTEGER FPE$STACKOVERFLOW
|
||||
INTEGER FPE$STACKUNDERFLOW
|
||||
INTEGER FPE$EXPLICITGEN ! RAISEQQ( SIGFPE )
|
||||
|
||||
PARAMETER (FPE$INVALID = #81)
|
||||
PARAMETER (FPE$DENORMAL = #82)
|
||||
PARAMETER (FPE$ZERODIVIDE = #83)
|
||||
PARAMETER (FPE$OVERFLOW = #84)
|
||||
PARAMETER (FPE$UNDERFLOW = #85)
|
||||
PARAMETER (FPE$INEXACT = #86)
|
||||
PARAMETER (FPE$UNEMULATED = #87)
|
||||
PARAMETER (FPE$SQRTNEG = #88)
|
||||
PARAMETER (FPE$STACKOVERFLOW = #8a)
|
||||
PARAMETER (FPE$STACKUNDERFLOW = #8b)
|
||||
PARAMETER (FPE$EXPLICITGEN = #8c)
|
||||
|
||||
INTEGER SIGNALQQ[EXTERN]
|
||||
INTEGER*2 RAISEQQ[EXTERN]
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Intdos/Intdosx support.
|
||||
C -----------------------------------------------------------------
|
||||
STRUCTURE /REGS$WORD/
|
||||
INTEGER*2 AX
|
||||
INTEGER*2 BX
|
||||
INTEGER*2 CX
|
||||
INTEGER*2 DX
|
||||
INTEGER*2 SI
|
||||
INTEGER*2 DI
|
||||
INTEGER*2 CFLAG
|
||||
END STRUCTURE
|
||||
|
||||
STRUCTURE /REGS$BYTE/
|
||||
INTEGER*1 AL
|
||||
INTEGER*1 AH
|
||||
INTEGER*1 BL
|
||||
INTEGER*1 BH
|
||||
INTEGER*1 CL
|
||||
INTEGER*1 CH
|
||||
INTEGER*1 DL
|
||||
INTEGER*1 DH
|
||||
END STRUCTURE
|
||||
|
||||
STRUCTURE /REGS$INFO/
|
||||
UNION
|
||||
MAP
|
||||
RECORD /REGS$WORD/ WREGS
|
||||
END MAP
|
||||
MAP
|
||||
RECORD /REGS$BYTE/ BREGS
|
||||
END MAP
|
||||
END UNION
|
||||
END STRUCTURE
|
||||
|
||||
STRUCTURE /SREGS$INFO/
|
||||
INTEGER*2 ES
|
||||
INTEGER*2 CS
|
||||
INTEGER*2 SS
|
||||
INTEGER*2 DS
|
||||
END STRUCTURE
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C FORTRAN QuickWin App Support
|
||||
C -----------------------------------------------------------------
|
||||
INTEGER*2 ABOUTBOXQQ[EXTERN]
|
||||
|
||||
C Clicking on menus.
|
||||
INTEGER*2 QWIN$STATUS
|
||||
INTEGER*2 QWIN$TILE
|
||||
INTEGER*2 QWIN$CASCADE
|
||||
INTEGER*2 QWIN$ARRANGE
|
||||
|
||||
PARAMETER (QWIN$STATUS = 1)
|
||||
PARAMETER (QWIN$TILE = 2)
|
||||
PARAMETER (QWIN$CASCADE = 3)
|
||||
PARAMETER (QWIN$ARRANGE = 4)
|
||||
|
||||
INTEGER*2 CLICKQQ[EXTERN]
|
||||
|
||||
C Get/Set unit focus.
|
||||
INTEGER*2 FOCUSQQ[EXTERN]
|
||||
INTEGER*2 INQFOCUSQQ[EXTERN]
|
||||
|
||||
C Size/Move a window
|
||||
STRUCTURE /QWINFO/
|
||||
INTEGER*2 TYPE ! request type
|
||||
INTEGER*2 X ! x coordinate for upper left
|
||||
INTEGER*2 Y ! y coordinate for upper left
|
||||
INTEGER*2 H ! window height
|
||||
INTEGER*2 W ! window width
|
||||
END STRUCTURE
|
||||
|
||||
INTEGER*2 QWIN$MIN
|
||||
INTEGER*2 QWIN$MAX
|
||||
INTEGER*2 QWIN$RESTORE
|
||||
INTEGER*2 QWIN$SET
|
||||
|
||||
PARAMETER (QWIN$MIN = 1)
|
||||
PARAMETER (QWIN$MAX = 2)
|
||||
PARAMETER (QWIN$RESTORE = 3)
|
||||
PARAMETER (QWIN$SET = 4)
|
||||
|
||||
INTEGER*2 SETWSIZEQQ[EXTERN]
|
||||
|
||||
INTEGER*2 QWIN$FRAMEMAX
|
||||
INTEGER*2 QWIN$FRAMECURR
|
||||
INTEGER*2 QWIN$CHILDMAX
|
||||
INTEGER*2 QWIN$CHILDCURR
|
||||
|
||||
PARAMETER (QWIN$FRAMEMAX = 1)
|
||||
PARAMETER (QWIN$FRAMECURR = 2)
|
||||
PARAMETER (QWIN$CHILDMAX = 3)
|
||||
PARAMETER (QWIN$CHILDCURR = 4)
|
||||
|
||||
INTEGER*2 GETWSIZEQQ[EXTERN]
|
||||
|
||||
C Message Boxes
|
||||
INTEGER*2 MB$ABORTRETRYIGNORE
|
||||
INTEGER*2 MB$DEFBUTTON1
|
||||
INTEGER*2 MB$DEFBUTTON2
|
||||
INTEGER*2 MB$DEFBUTTON3
|
||||
INTEGER*2 MB$ICONASTERISK
|
||||
INTEGER*2 MB$ICONEXCLAMATION
|
||||
INTEGER*2 MB$ICONHAND
|
||||
INTEGER*2 MB$ICONINFORMATION
|
||||
INTEGER*2 MB$ICONQUESTION
|
||||
INTEGER*2 MB$ICONSTOP
|
||||
INTEGER*2 MB$OK
|
||||
INTEGER*2 MB$OKCANCEL
|
||||
INTEGER*2 MB$RETRYCANCEL
|
||||
INTEGER*2 MB$SYSTEMMODAL
|
||||
INTEGER*2 MB$TASKMODAL
|
||||
INTEGER*2 MB$YESNO
|
||||
INTEGER*2 MB$YESNOCANCEL
|
||||
|
||||
PARAMETER (MB$ABORTRETRYIGNORE = #0002)
|
||||
PARAMETER (MB$DEFBUTTON1 = #0000)
|
||||
PARAMETER (MB$DEFBUTTON2 = #0100)
|
||||
PARAMETER (MB$DEFBUTTON3 = #0200)
|
||||
PARAMETER (MB$ICONASTERISK = #0040)
|
||||
PARAMETER (MB$ICONEXCLAMATION = #0030)
|
||||
PARAMETER (MB$ICONHAND = #0010)
|
||||
PARAMETER (MB$ICONINFORMATION = #0040)
|
||||
PARAMETER (MB$ICONQUESTION = #0020)
|
||||
PARAMETER (MB$ICONSTOP = #0010)
|
||||
PARAMETER (MB$OK = #0000)
|
||||
PARAMETER (MB$OKCANCEL = #0001)
|
||||
PARAMETER (MB$RETRYCANCEL = #0005)
|
||||
PARAMETER (MB$SYSTEMMODAL = #1000)
|
||||
PARAMETER (MB$TASKMODAL = #2000)
|
||||
PARAMETER (MB$YESNO = #0004)
|
||||
PARAMETER (MB$YESNOCANCEL = #0003)
|
||||
|
||||
INTEGER*2 MB$IDOK
|
||||
INTEGER*2 MB$IDCANCEL
|
||||
INTEGER*2 MB$IDABORT
|
||||
INTEGER*2 MB$IDRETRY
|
||||
INTEGER*2 MB$IDIGNORE
|
||||
INTEGER*2 MB$IDYES
|
||||
INTEGER*2 MB$IDNO
|
||||
|
||||
PARAMETER (MB$IDOK = 1)
|
||||
PARAMETER (MB$IDCANCEL = 2)
|
||||
PARAMETER (MB$IDABORT = 3)
|
||||
PARAMETER (MB$IDRETRY = 4)
|
||||
PARAMETER (MB$IDIGNORE = 5)
|
||||
PARAMETER (MB$IDYES = 6)
|
||||
PARAMETER (MB$IDNO = 7)
|
||||
|
||||
INTEGER*2 MESSAGEBOXQQ[EXTERN]
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Time and Date Support
|
||||
C -----------------------------------------------------------------
|
||||
LOGICAL SETTIM[EXTERN]
|
||||
LOGICAL SETDAT[EXTERN]
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Command Line Arguments
|
||||
C -----------------------------------------------------------------
|
||||
INTEGER*4 NARGS[EXTERN]
|
||||
252
Microsoft Fortran v51/INCLUDE/FLIB.FI
Normal file
252
Microsoft Fortran v51/INCLUDE/FLIB.FI
Normal file
@ -0,0 +1,252 @@
|
||||
C****************************** Module Header ******************************
|
||||
C*
|
||||
C* Copyright (c) 1990 Microsoft Corporation
|
||||
C*
|
||||
C* Module Name: FLIB.FI
|
||||
C*
|
||||
C* This module provides interface descriptions for subprograms found
|
||||
C* in the various FORTRAN libraries. Each of the functional areas
|
||||
C* covered by these interfaces are small enough that separate include
|
||||
C* files for each are not warranted.
|
||||
C*
|
||||
C* The functional areas covered are the following.
|
||||
C*
|
||||
C* Math error support.
|
||||
C*
|
||||
C* Signal handling.
|
||||
C*
|
||||
C* Intdos/Intdosx.
|
||||
C*
|
||||
C* Windows Applications Suuport.
|
||||
C*
|
||||
C* Date and Time
|
||||
C*
|
||||
C* Command Line Arguments
|
||||
C*
|
||||
C* Random Numbers
|
||||
C*
|
||||
C***************************************************************************
|
||||
C -----------------------------------------------------------------
|
||||
C Math Error Support
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO SUBROUTINE MATHERRQQ[alias:'FMATHERRQQ']
|
||||
+ (NAME, NLEN, INFO, RETCODE)
|
||||
INTEGER*2 NLEN
|
||||
CHARACTER NAME(NLEN) ! INPUT : Name of function causing error.
|
||||
STRUCTURE /MTH$E_INFO/
|
||||
INTEGER*2 ERRCODE ! INPUT : One of the MTH$ values in flib.fd
|
||||
INTEGER*2 FTYPE ! INPUT : One of the TY$ values in flib.fd
|
||||
UNION
|
||||
MAP
|
||||
REAL*4 R4ARG1 ! INPUT : FIrst argument
|
||||
REAL*4 R4ARG2 ! INPUT : Second argument (if any)
|
||||
REAL*4 R4RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
REAL*8 R8ARG1 ! INPUT : FIrst argument
|
||||
REAL*8 R8ARG2 ! INPUT : Second argument (if any)
|
||||
REAL*8 R8RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
COMPLEX*8 C8ARG1 ! INPUT : FIrst argument
|
||||
COMPLEX*8 C8ARG2 ! INPUT : Second argument (if any)
|
||||
COMPLEX*8 C8RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
MAP
|
||||
COMPLEX*16 C16ARG1 ! INPUT : FIrst argument
|
||||
COMPLEX*16 C16ARG2 ! INPUT : Second argument (if any)
|
||||
COMPLEX*16 C16RES ! OUTPUT : Desired result
|
||||
END MAP
|
||||
END UNION
|
||||
END STRUCTURE
|
||||
RECORD /MTH$E_INFO/ INFO
|
||||
INTEGER*2 RETCODE ! OUTPUT : 0 for failure, non 0 for success
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Signal support
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO INTEGER FUNCTION SIGNALQQ[c,loadds,alias:'_signal']
|
||||
+ (SIGNAL, HANDLER)
|
||||
INTEGER*2 SIGNAL[value]
|
||||
EXTERNAL HANDLER
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION RAISEQQ(SIGNAL)
|
||||
INTEGER*2 SIGNAL[value]
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Intdos/Intdosx support.
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO SUBROUTINE INTDOSQQ[c,alias:'_intdos']
|
||||
+ (REGS1, REGS2)
|
||||
STRUCTURE /REGS$WORD/
|
||||
INTEGER*2 AX
|
||||
INTEGER*2 BX
|
||||
INTEGER*2 CX
|
||||
INTEGER*2 DX
|
||||
INTEGER*2 SI
|
||||
INTEGER*2 DI
|
||||
INTEGER*2 CFLAG
|
||||
END STRUCTURE
|
||||
STRUCTURE /REGS$BYTE/
|
||||
INTEGER*1 AL
|
||||
INTEGER*1 AH
|
||||
INTEGER*1 BL
|
||||
INTEGER*1 BH
|
||||
INTEGER*1 CL
|
||||
INTEGER*1 CH
|
||||
INTEGER*1 DL
|
||||
INTEGER*1 DH
|
||||
END STRUCTURE
|
||||
STRUCTURE /REGS$INFO/
|
||||
UNION
|
||||
MAP
|
||||
RECORD /REGS$WORD/ WREGS
|
||||
END MAP
|
||||
MAP
|
||||
RECORD /REGS$BYTE/ BREGS
|
||||
END MAP
|
||||
END UNION
|
||||
END STRUCTURE
|
||||
RECORD /REGS$INFO/ REGS1[reference]
|
||||
RECORD /REGS$INFO/ REGS2[reference]
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE INTDOSXQQ[c,alias:'_intdosx']
|
||||
+ (REGS1, REGS2, SREGS)
|
||||
STRUCTURE /REGS$WORD/
|
||||
INTEGER*2 AX
|
||||
INTEGER*2 BX
|
||||
INTEGER*2 CX
|
||||
INTEGER*2 DX
|
||||
INTEGER*2 SI
|
||||
INTEGER*2 DI
|
||||
INTEGER*2 CFLAG
|
||||
END STRUCTURE
|
||||
STRUCTURE /REGS$BYTE/
|
||||
INTEGER*1 AL
|
||||
INTEGER*1 AH
|
||||
INTEGER*1 BL
|
||||
INTEGER*1 BH
|
||||
INTEGER*1 CL
|
||||
INTEGER*1 CH
|
||||
INTEGER*1 DL
|
||||
INTEGER*1 DH
|
||||
END STRUCTURE
|
||||
STRUCTURE /REGS$INFO/
|
||||
UNION
|
||||
MAP
|
||||
RECORD /REGS$WORD/ WREGS
|
||||
END MAP
|
||||
MAP
|
||||
RECORD /REGS$BYTE/ BREGS
|
||||
END MAP
|
||||
END UNION
|
||||
END STRUCTURE
|
||||
STRUCTURE /SREGS$INFO/
|
||||
INTEGER*2 ES
|
||||
INTEGER*2 CS
|
||||
INTEGER*2 SS
|
||||
INTEGER*2 DS
|
||||
END STRUCTURE
|
||||
RECORD /REGS$INFO/ REGS1
|
||||
RECORD /REGS$INFO/ REGS2
|
||||
RECORD /SREGS$INFO/ SREGS
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C FORTRAN Windows App Support
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO INTEGER*2 FUNCTION ABOUTBOXQQ(STR)
|
||||
CHARACTER*(*) STR
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION CLICKQQ(ITEM)
|
||||
INTEGER*2 ITEM
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION FOCUSQQ(IUNIT)
|
||||
INTEGER*2 IUNIT
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION INQFOCUSQQ(IUNIT)
|
||||
INTEGER*2 IUNIT
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION SETWSIZEQQ(IUNIT,WINFO)
|
||||
STRUCTURE /QWINFO/
|
||||
INTEGER*2 TYPE ! request type
|
||||
INTEGER*2 X ! x coordinate for upper left
|
||||
INTEGER*2 Y ! y coordinate for upper left
|
||||
INTEGER*2 H ! window height
|
||||
INTEGER*2 W ! window width
|
||||
END STRUCTURE
|
||||
INTEGER*2 IUNIT
|
||||
RECORD /QWINFO/ WINFO
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION GETWSIZEQQ(IUNIT,IREQ,WINFO)
|
||||
STRUCTURE /QWINFO/
|
||||
INTEGER*2 TYPE ! request type
|
||||
INTEGER*2 X ! x coordinate for upper left
|
||||
INTEGER*2 Y ! y coordinate for upper left
|
||||
INTEGER*2 H ! window height
|
||||
INTEGER*2 W ! window width
|
||||
END STRUCTURE
|
||||
INTEGER*2 IUNIT
|
||||
INTEGER*2 IREQ
|
||||
RECORD /QWINFO/ WINFO
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION MESSAGEBOXQQ(MSG,CAPTION,MTYPE)
|
||||
CHARACTER*(*) MSG
|
||||
CHARACTER*(*) CAPTION
|
||||
INTEGER*2 MTYPE
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE YIELDQQ()
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Time and Date Support
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO SUBROUTINE GETTIM(IHR, IMIN, ISEC, I100TH)
|
||||
INTEGER*2 IHR, IMIN, ISEC, I100TH
|
||||
END
|
||||
|
||||
INTERFACE TO LOGICAL FUNCTION SETTIM(IHR, IMIN, ISEC, I100TH)
|
||||
INTEGER*2 IHR, IMIN, ISEC, I100TH
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE GETDAT(IYR, IMON, IDAY)
|
||||
INTEGER*2 IYR, IMON, IDAY
|
||||
END
|
||||
|
||||
INTERFACE TO LOGICAL FUNCTION SETDAT(IYR, IMON, IDAY)
|
||||
INTEGER*2 IYR, IMON, IDAY
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Command Line Arguments
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO INTEGER*4 FUNCTION NARGS()
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE GETARG(N, BUFFER, STATUS)
|
||||
INTEGER*2 N
|
||||
CHARACTER*(*) BUFFER
|
||||
INTEGER*2 STATUS
|
||||
END
|
||||
|
||||
C -----------------------------------------------------------------
|
||||
C Random Numbers
|
||||
C -----------------------------------------------------------------
|
||||
INTERFACE TO SUBROUTINE RANDOM(ARG)
|
||||
REAL*4 ARG
|
||||
END
|
||||
|
||||
INTERFACE TO SUBROUTINE SEED(ARG)
|
||||
INTEGER*2 ARG
|
||||
END
|
||||
BIN
Microsoft Fortran v51/LIB/COURB.FON
Normal file
BIN
Microsoft Fortran v51/LIB/COURB.FON
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/GRAPHICS.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/GRAPHICS.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/HELVB.FON
Normal file
BIN
Microsoft Fortran v51/LIB/HELVB.FON
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/LLIBCE.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/LLIBCE.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/LLIBF7R.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/LLIBF7R.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/LLIBFER.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/LLIBFER.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/LLIBFOR7.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/LLIBFOR7.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/LLIBFORE.lib
Normal file
BIN
Microsoft Fortran v51/LIB/LLIBFORE.lib
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/MLIBF7R.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/MLIBF7R.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/MLIBFER.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/MLIBFER.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/MLIBFOR7.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/MLIBFOR7.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/MLIBFORE.LIB
Normal file
BIN
Microsoft Fortran v51/LIB/MLIBFORE.LIB
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/MODERN.FON
Normal file
BIN
Microsoft Fortran v51/LIB/MODERN.FON
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/NBUILD.OBJ
Normal file
BIN
Microsoft Fortran v51/LIB/NBUILD.OBJ
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/ROMAN.FON
Normal file
BIN
Microsoft Fortran v51/LIB/ROMAN.FON
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/SCRIPT.FON
Normal file
BIN
Microsoft Fortran v51/LIB/SCRIPT.FON
Normal file
Binary file not shown.
BIN
Microsoft Fortran v51/LIB/TMSRB.FON
Normal file
BIN
Microsoft Fortran v51/LIB/TMSRB.FON
Normal file
Binary file not shown.
64
Microsoft Fortran v51/LIB/XLIBLOGX.XYZ
Normal file
64
Microsoft Fortran v51/LIB/XLIBLOGX.XYZ
Normal file
@ -0,0 +1,64 @@
|
||||
***SETUP LIB LOG FILE***
|
||||
|
||||
This file contains the output of the LIB utility
|
||||
|
||||
|
||||
Microsoft (R) Library Manager Version 3.18
|
||||
Copyright (C) Microsoft Corp 1983-1991. All rights reserved.
|
||||
|
||||
Library name: C:\FORTRAN\LIB\MLIBFER.LIB
|
||||
Library does not exist. Create? (y/n) Y
|
||||
Operations: +C:\FORTRAN\LIB\LIBH.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFOR.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\EM.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MGRAPHFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFOR1.LIB;
|
||||
LIB : warning U4150: qcwindow : module redefinition ignored
|
||||
LIB : warning U4150: grfpinit : module redefinition ignored
|
||||
LIB : warning U4150: grwindow : module redefinition ignored
|
||||
|
||||
Microsoft (R) Library Manager Version 3.18
|
||||
Copyright (C) Microsoft Corp 1983-1991. All rights reserved.
|
||||
|
||||
Library name: C:\FORTRAN\LIB\MLIBF7R.LIB
|
||||
Library does not exist. Create? (y/n) Y
|
||||
Operations: +C:\FORTRAN\LIB\LIBH.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFOR.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\87.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MGRAPHFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MLIBFOR1.LIB;
|
||||
LIB : warning U4150: qcwindow : module redefinition ignored
|
||||
LIB : warning U4150: grfpinit : module redefinition ignored
|
||||
LIB : warning U4150: grwindow : module redefinition ignored
|
||||
|
||||
Microsoft (R) Library Manager Version 3.18
|
||||
Copyright (C) Microsoft Corp 1983-1991. All rights reserved.
|
||||
|
||||
Library name: C:\FORTRAN\LIB\LLIBFER.LIB
|
||||
Library does not exist. Create? (y/n) Y
|
||||
Operations: +C:\FORTRAN\LIB\LIBH.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFOR.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\EM.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MGRAPHFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFOR1.LIB;
|
||||
LIB : warning U4150: qcwindow : module redefinition ignored
|
||||
LIB : warning U4150: grfpinit : module redefinition ignored
|
||||
LIB : warning U4150: grwindow : module redefinition ignored
|
||||
|
||||
Microsoft (R) Library Manager Version 3.18
|
||||
Copyright (C) Microsoft Corp 1983-1991. All rights reserved.
|
||||
|
||||
Library name: C:\FORTRAN\LIB\LLIBF7R.LIB
|
||||
Library does not exist. Create? (y/n) Y
|
||||
Operations: +C:\FORTRAN\LIB\LIBH.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFOR.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\87.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\MGRAPHFP.LIB &
|
||||
Operations: +C:\FORTRAN\LIB\LLIBFOR1.LIB;
|
||||
LIB : warning U4150: qcwindow : module redefinition ignored
|
||||
LIB : warning U4150: grfpinit : module redefinition ignored
|
||||
LIB : warning U4150: grwindow : module redefinition ignored
|
||||
File diff suppressed because one or more lines are too long
28
Microsoft Fortran v51/SIEVE.FOR
Normal file
28
Microsoft Fortran v51/SIEVE.FOR
Normal file
@ -0,0 +1,28 @@
|
||||
C Eratosthenes Sieve from BYTE magazine
|
||||
program sieve
|
||||
logical flags( 8191 )
|
||||
integer*2 i, prime, k, count
|
||||
integer*2 iter
|
||||
|
||||
write( *, 50 )
|
||||
50 format( ' 10 iterations' )
|
||||
do 92 iter = 1, 10
|
||||
count = 0
|
||||
do 10 i = 0, 8190
|
||||
10 flags( i ) = .true.
|
||||
do 91 i = 0, 8190
|
||||
if ( .not. flags( i ) ) go to 91
|
||||
prime = i + i + 3
|
||||
k = i + prime
|
||||
20 if ( k .gt. 8190 ) go to 90
|
||||
flags( k ) = .false.
|
||||
k = k + prime
|
||||
go to 20
|
||||
90 count = count + 1
|
||||
91 continue
|
||||
92 continue
|
||||
write( *, 200 ) count
|
||||
200 format( 1X, I6, ' primes' )
|
||||
stop
|
||||
100 format( 1X, I6 )
|
||||
end
|
||||
62
Microsoft Fortran v51/SOURCE/SAMPLES/ANIMATE.FOR
Normal file
62
Microsoft Fortran v51/SOURCE/SAMPLES/ANIMATE.FOR
Normal file
@ -0,0 +1,62 @@
|
||||
CC ANIMATE.FOR - Illustrates animation functions including:
|
||||
CC imagesize getimage putimage
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*1 buffer[ALLOCATABLE] (:)
|
||||
INTEGER*2 status, x, y, error, action(5)
|
||||
INTEGER*4 imsize
|
||||
CHARACTER*6 descrip(5)
|
||||
RECORD /rccoord/ curpos
|
||||
|
||||
DATA action / $GPSET, $GPRESET, $GXOR, $GOR, $GAND /
|
||||
DATA descrip / 'PSET ', 'PRESET', 'XOR ', 'OR ', 'AND ' /
|
||||
|
||||
C
|
||||
C Find graphics mode.
|
||||
C
|
||||
IF( setvideomode( $MAXRESMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set graphics mode'
|
||||
|
||||
status = setcolor( 3 )
|
||||
y = 30
|
||||
DO i = 1, 5
|
||||
x = 50
|
||||
y = y + 40
|
||||
C
|
||||
C Display action type.
|
||||
C
|
||||
CALL settextposition( 1, 1, curpos )
|
||||
CALL outtext( descrip(i) )
|
||||
C
|
||||
C Draw and measure ellipse, allocate memory for image.
|
||||
C
|
||||
status = ellipse( $GFILLINTERIOR, x - 15, y - 15, x + 15,
|
||||
+ y + 15 )
|
||||
imsize = imagesize( x - 16, y - 16, x + 16, y + 16 )
|
||||
ALLOCATE( buffer( imsize ), STAT = error )
|
||||
IF( error .NE. 0 ) THEN
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
STOP 'Error: insufficient memory'
|
||||
END IF
|
||||
C
|
||||
C Get master copy of ellipse.
|
||||
C
|
||||
CALL getimage( x - 16, y - 16, x + 16, y + 16, buffer )
|
||||
C
|
||||
C Copy row of ellipses with specified action.
|
||||
C
|
||||
DO x = 55, 255, 5
|
||||
CALL putimage( x - 16, y - 16, buffer, action(i) )
|
||||
END DO
|
||||
|
||||
C
|
||||
C Free memory, wait for ENTER key to continue.
|
||||
C
|
||||
DEALLOCATE( buffer )
|
||||
READ (*,*)
|
||||
END DO
|
||||
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
64
Microsoft Fortran v51/SOURCE/SAMPLES/ANNUITY1.FOR
Normal file
64
Microsoft Fortran v51/SOURCE/SAMPLES/ANNUITY1.FOR
Normal file
@ -0,0 +1,64 @@
|
||||
C
|
||||
C ANNUITY1.FOR - Generates annuity table. Contains intentional errors.
|
||||
C Use with PWB section of "Environment & Tools" manual.
|
||||
REAL*8 Pv, Rate, Pmt, RatePct
|
||||
ONTEGER Nper, ActNper
|
||||
|
||||
C
|
||||
C Get input from the user.
|
||||
C
|
||||
WRITE ( *, '(1X, A \)' ) 'Enter Present Value: '
|
||||
READ ( *, * ) Pv
|
||||
WRITE ( *, '(1X, A \)' ) 'Enter Interest Rate in Percent: '
|
||||
READ ( *, * ) Rate
|
||||
WRITE ( *, '(1X, A \)' ) 'Enter Number of Periods in Years:
|
||||
READ ( *, * ) Nper
|
||||
|
||||
C
|
||||
C Calculate periodic percentage as a fraction (RatePct),
|
||||
C number of periods in months (ActNper). Then, calculate
|
||||
C the monthly payment (Pmt).
|
||||
C
|
||||
RatePct = Rate / 1200.0
|
||||
ActNper = Nper * 12
|
||||
Pmt = Pv * (RatePct / (1.0 - (1.0 / ((1.0 + RatePct) **
|
||||
+ ActNper))))
|
||||
|
||||
C
|
||||
C Write a summary of the annuity to the screen (*) device.
|
||||
C
|
||||
WRITE( *,
|
||||
+'( 1X, /,
|
||||
+1X, 10HPrincipal:, T20, F13.2, /,
|
||||
+1X, 14HInterest Rate:, T20, F13.2, /,
|
||||
+1X, 16HNumber of Years:, T20, I13, /,
|
||||
+1X, 16HMonthly Payment:, T20, F13.2, /,
|
||||
+1X, 15HTotal Payments:, T20, F13.2, /
|
||||
+1X, 15HTotal Interest:, T20, F13.2 )' )
|
||||
+Pv, Rate, Nper, Pmt, Pmt * Nper * 12.0,
|
||||
+Pmt * Nper * 12.0 - Pv
|
||||
|
||||
C
|
||||
C Write headings for an amortization table to the screen
|
||||
C
|
||||
WRITE( *, '(1X, /, 1X, 6HPeriod, 2X, 6H Year, 2X, 9HPrincipal, 2X,
|
||||
+ 9H Interest,
|
||||
+ /, 1X, 6H------, 2X, 6H ----, 2X, 9H---------, 2X,
|
||||
+ 9H -------- )' )
|
||||
|
||||
C
|
||||
C Loop for the actual number of periods printing the period, year,
|
||||
C interest portion and principal portion of the payment
|
||||
C
|
||||
DO iPeriod = 1, ActNper
|
||||
PerInterest = Pv * RatePct
|
||||
PerPrin = Pmt - PerInterest
|
||||
WRITE( *, '(1X, I6, 2X, I6, 2X, F9.2, 2X, F9.2 )' )
|
||||
+iPeriod,
|
||||
+iPeriod / 12,
|
||||
+PerPrin,
|
||||
+PerInterest
|
||||
Pv = Pv - PerPrin
|
||||
END DO
|
||||
|
||||
END
|
||||
20
Microsoft Fortran v51/SOURCE/SAMPLES/ARC.FOR
Normal file
20
Microsoft Fortran v51/SOURCE/SAMPLES/ARC.FOR
Normal file
@ -0,0 +1,20 @@
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 status
|
||||
RECORD / xycoord / xystart, xyend, xyfill
|
||||
|
||||
status = setvideomode( $MRES16COLOR )
|
||||
status = arc( 80, 50, 240, 150, 80, 50, 240, 150 )
|
||||
|
||||
status = getarcinfo( xystart, xyend, xyfill )
|
||||
CALL moveto( xystart.xcoord, xystart.ycoord, xyfill )
|
||||
status = lineto( xyend.xcoord, xyend.ycoord )
|
||||
status = floodfill( xyfill.xcoord, xyfill.ycoord, getcolor() )
|
||||
|
||||
READ( *, * ) ! Press ENTER to exit
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
|
||||
END
|
||||
|
||||
|
||||
39
Microsoft Fortran v51/SOURCE/SAMPLES/CGA.FOR
Normal file
39
Microsoft Fortran v51/SOURCE/SAMPLES/CGA.FOR
Normal file
@ -0,0 +1,39 @@
|
||||
CC CGA.FOR - Demonstrates CGA colors.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 dummy2, i, j, k
|
||||
INTEGER*4 dummy4
|
||||
INTEGER*4 bkcolor(8) /
|
||||
+ $BLACK, $BLUE , $GREEN, $CYAN,
|
||||
+ $RED , $MAGENTA, $BROWN, $WHITE /
|
||||
|
||||
CHARACTER*7 bkcolorname(8) /
|
||||
+ 'BLACK', 'BLUE' , 'GREEN', 'CYAN',
|
||||
+ 'RED' , 'MAGENTA', 'BROWN', 'WHITE' /
|
||||
|
||||
RECORD / rccoord / curpos
|
||||
|
||||
IF( setvideomode( $MRES4COLOR ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set CGA graphics mode'
|
||||
|
||||
DO i = 0, 3
|
||||
dummy2 = selectpalette( i )
|
||||
DO k = 1, 8
|
||||
dummy4 = setbkcolor( bkcolor(k) )
|
||||
DO j = 0, 3
|
||||
CALL settextposition( 1, 1, curpos )
|
||||
WRITE (*, 9000) bkcolorname(k), i, j
|
||||
dummy2 = setcolor( INT4( j ) )
|
||||
dummy2 = rectangle( $GFILLINTERIOR, 160, 100, 320, 200 )
|
||||
READ (*,*) ! Wait for ENTER key to be pressed
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
dummy2 = setvideomode( $DEFAULTMODE )
|
||||
|
||||
9000 FORMAT( ' background color: ', A / ' palette:', I3 /
|
||||
+ ' color: ', I3 / )
|
||||
|
||||
END
|
||||
52
Microsoft Fortran v51/SOURCE/SAMPLES/CGAPAL.FOR
Normal file
52
Microsoft Fortran v51/SOURCE/SAMPLES/CGAPAL.FOR
Normal file
@ -0,0 +1,52 @@
|
||||
CC CGAPAL.FOR - Illustrates CGA palettes using:
|
||||
CC selectpalette
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 status2
|
||||
INTEGER*4 status4, bkcolor(8)
|
||||
CHARACTER*7 bkname(8)
|
||||
CHARACTER*40 str
|
||||
RECORD /rccoord/ curpos
|
||||
|
||||
DATA bkcolor / $BLACK , $BLUE , $GREEN , $CYAN ,
|
||||
+ $RED , $MAGENTA , $BROWN , $WHITE /
|
||||
DATA bkname / 'BLACK', 'BLUE' , 'GREEN', 'CYAN' ,
|
||||
+ 'RED' , 'MAGENTA', 'BROWN', 'WHITE' /
|
||||
C
|
||||
C Set video mode.
|
||||
C
|
||||
IF( setvideomode( $MRES4COLOR ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set CGA color mode'
|
||||
C
|
||||
C Palette loop
|
||||
C
|
||||
DO i = 0, 3
|
||||
status2 = selectpalette( i )
|
||||
C
|
||||
C Background color loop
|
||||
C
|
||||
DO k = 1, 8
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
status4 = setbkcolor( bkcolor(k) )
|
||||
CALL settextposition( 1, 1, curpos )
|
||||
WRITE (str, 9000) bkname(k), i
|
||||
CALL outtext( str )
|
||||
C
|
||||
C Foreground color loop
|
||||
C
|
||||
DO j = 1, 3
|
||||
status2 = setcolor( INT4( j ) )
|
||||
status2 = ellipse( $GFILLINTERIOR, 100, j * 30, 220,
|
||||
+ 80 + (j * 30))
|
||||
END DO
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
END DO
|
||||
END DO
|
||||
|
||||
status2 = setvideomode( $DEFAULTMODE )
|
||||
|
||||
9000 FORMAT ('Background: ', A, 10x, 'Palette: ', I2)
|
||||
|
||||
END
|
||||
25
Microsoft Fortran v51/SOURCE/SAMPLES/COLOR.FOR
Normal file
25
Microsoft Fortran v51/SOURCE/SAMPLES/COLOR.FOR
Normal file
@ -0,0 +1,25 @@
|
||||
CC COLOR.FOR - Sets a medium resolution mode
|
||||
CC with maximum color choices.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 dummy
|
||||
RECORD /videoconfig/ vc
|
||||
|
||||
C
|
||||
C Set mode for maximum number of colors.
|
||||
C
|
||||
IF( setvideomode( $MAXCOLORMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: no color graphics capability'
|
||||
CALL getvideoconfig( vc )
|
||||
|
||||
WRITE (*, 9000) vc.numcolors, vc.numxpixels, vc.numypixels
|
||||
READ (*,*) ! Wait for ENTER key to be pressed
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
dummy = setvideomode( $DEFAULTMODE )
|
||||
|
||||
9000 FORMAT( ' available colors: ', I5 / ' horizontal pixels:', I5 /
|
||||
+ ' vertical pixels: ', I5 )
|
||||
|
||||
END
|
||||
39
Microsoft Fortran v51/SOURCE/SAMPLES/COLTEXT.FOR
Normal file
39
Microsoft Fortran v51/SOURCE/SAMPLES/COLTEXT.FOR
Normal file
@ -0,0 +1,39 @@
|
||||
CC COLTEXT.FOR - Displays text color with various color or
|
||||
CC monochrome attributes.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 dummy2, blink, fgd
|
||||
INTEGER*4 dummy4, bgd
|
||||
CHARACTER*2 str
|
||||
RECORD / rccoord / curpos
|
||||
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
CALL outtext( 'Text color/monochrome attributes:' )
|
||||
|
||||
DO blink = 0, 16, 16
|
||||
DO bgd = 0, 7
|
||||
dummy4 = setbkcolor( bgd )
|
||||
CALL settextposition( INT2( bgd ) +
|
||||
+ (( blink / 16 ) * 9) + 3, 1, curpos )
|
||||
dummy2 = settextcolor( 15 )
|
||||
WRITE (str, '(I2)') bgd
|
||||
CALL outtext( 'Back:' // str // ' Fore:' )
|
||||
C
|
||||
C Loop through 16 foreground colors. For monochrome,
|
||||
C these will be underscore and low/high intensity.
|
||||
C
|
||||
DO fgd = 0, 15
|
||||
dummy2 = settextcolor( fgd + blink )
|
||||
WRITE (str, '(I2)') fgd + blink
|
||||
CALL outtext( ' ' // str )
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
CALL settextposition( 25, 1, curpos )
|
||||
CALL outtext( 'Press ENTER to exit' )
|
||||
READ (*,*)
|
||||
dummy2 = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
58
Microsoft Fortran v51/SOURCE/SAMPLES/CURSOR.FOR
Normal file
58
Microsoft Fortran v51/SOURCE/SAMPLES/CURSOR.FOR
Normal file
@ -0,0 +1,58 @@
|
||||
CC CURSOR.FOR - Illustrates cursor functions including:
|
||||
CC displaycursor gettextcursor settextcursor
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 status, oldcursor, newcursor,
|
||||
+ curs_start, curs_end, block
|
||||
CHARACTER*40 str
|
||||
RECORD /rccoord/ curpos
|
||||
RECORD /videoconfig/ vc
|
||||
|
||||
C
|
||||
C Save old cursor shape and make sure cursor is on.
|
||||
C
|
||||
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
oldcursor = gettextcursor()
|
||||
status = displaycursor( $GCURSORON )
|
||||
CALL settextposition( 1, 1, curpos )
|
||||
CALL outtext( 'Press ENTER to continue . . .' )
|
||||
C
|
||||
C Change cursor shape.
|
||||
C Cursor uses scan lines 0-7.
|
||||
C
|
||||
CALL getvideoconfig( vc )
|
||||
block = 7
|
||||
curs_start = 0
|
||||
DO curs_end = block, 0, -1
|
||||
CALL settextposition( 10, 1, curpos )
|
||||
WRITE (str, 9000) curs_start, curs_end
|
||||
CALL outtext( str )
|
||||
newcursor = (curs_start * 256) + curs_end
|
||||
status = settextcursor( newcursor )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
curs_start = curs_start + 1
|
||||
END DO
|
||||
|
||||
WRITE (str, '(A13)') 'Cursor off: '
|
||||
CALL settextposition( 12, 1, curpos )
|
||||
CALL outtext( str )
|
||||
status = displaycursor( $GCURSOROFF )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
WRITE (str, '(A13)') 'Cursor on : '
|
||||
CALL settextposition( 13, 1, curpos )
|
||||
CALL outtext( str )
|
||||
status = settextcursor( block )
|
||||
status = displaycursor( $GCURSORON )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Restore original cursor shape.
|
||||
C
|
||||
status = settextcursor( oldcursor )
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
|
||||
9000 FORMAT ( 'Start line:', I4, 8x, 'Endline:', I4, 3x )
|
||||
|
||||
END
|
||||
37
Microsoft Fortran v51/SOURCE/SAMPLES/DEMOEXEC.FOR
Normal file
37
Microsoft Fortran v51/SOURCE/SAMPLES/DEMOEXEC.FOR
Normal file
@ -0,0 +1,37 @@
|
||||
CC DEMOEXEC.FOR - Demonstration program for calling C system and
|
||||
CC spawnp library functions. These functions are included in the
|
||||
CC FORTRAN library. They are discussed in Chapter 3 of the Advanced
|
||||
CC Topics manual.
|
||||
CC
|
||||
CC To compile and link DEMOEXEC.FOR type the command:
|
||||
CC
|
||||
CC FL DEMOEXEC.FOR
|
||||
|
||||
C
|
||||
C Include file containing interfaces for system and spawnlp.
|
||||
C
|
||||
|
||||
$INCLUDE: 'EXEC.FI'
|
||||
|
||||
C
|
||||
C Declare return types
|
||||
C
|
||||
INTEGER*2 SYSTEM, SPAWNLP
|
||||
|
||||
C
|
||||
C Invoke COMMAND.COM with the command line:
|
||||
C
|
||||
C dir *.for
|
||||
C
|
||||
I = SYSTEM( 'dir *.for'C )
|
||||
IF( I .EQ. -1 ) STOP 'Could not run COMMAND.COM'
|
||||
|
||||
C
|
||||
C Invoke a child process:
|
||||
C
|
||||
C EXEHDR DEMOEXEC.EXE
|
||||
C
|
||||
I = SPAWNLP( 0, LOC( 'exehdr'C ), LOC( 'exehdr'C ),
|
||||
+ LOC( 'demoexec.exe'C ), INT4( 0 ) )
|
||||
IF( I .EQ. -1 ) STOP 'Could not spawn EXEHDR program'
|
||||
END
|
||||
3
Microsoft Fortran v51/SOURCE/SAMPLES/DIFFHLP.DEF
Normal file
3
Microsoft Fortran v51/SOURCE/SAMPLES/DIFFHLP.DEF
Normal file
@ -0,0 +1,3 @@
|
||||
LIBRARY DOSCALLS
|
||||
EXPORTS __AHSHIFT @135
|
||||
EXPORTS __AHINCR @136
|
||||
361
Microsoft Fortran v51/SOURCE/SAMPLES/DWHET.FOR
Normal file
361
Microsoft Fortran v51/SOURCE/SAMPLES/DWHET.FOR
Normal file
@ -0,0 +1,361 @@
|
||||
CC DWHET.FOR - Double precision Whetstone program.
|
||||
CC Measures FORTRAN and CPU performance in
|
||||
CC Whetstone-instructions per second.
|
||||
CC
|
||||
CC
|
||||
CC References on Whetstones:
|
||||
CC
|
||||
CC - Computer Journal Feb 76
|
||||
CC pg 43-49 vol 19 no 1.
|
||||
CC Curnow and Wichmann.
|
||||
CC
|
||||
CC - Timing Studies Using a
|
||||
CC Synthetic Whetstone Benchmark,
|
||||
CC S. Harbaugh & J. Forakris
|
||||
CC
|
||||
CC References on FORTRAN Benchmarks:
|
||||
CC
|
||||
CC - Computer Languages, Jan 1986
|
||||
CC - EDN, Oct 3, 1985, Array Processors
|
||||
CC for PCs
|
||||
CC - Byte, Feb 1984.
|
||||
CC
|
||||
|
||||
INTEGER*4 j, k, l, i, isave
|
||||
INTEGER*4 n2, n3, n4, n6, n7, n8, n9, n11
|
||||
INTEGER*4 inner, outer, kount, npass, max_pass
|
||||
|
||||
REAL*8 x, y, z, t1, t2, t3, e1(4)
|
||||
REAL*8 whet_save, dif_save, kilowhet
|
||||
REAL*8 begin_time, end_time, dif_time
|
||||
REAL*8 error, whet_err, percent_err
|
||||
REAL*8 secnds
|
||||
|
||||
COMMON t1, t2, t3, e1, j, k, l
|
||||
|
||||
|
||||
C
|
||||
C Initialize pass-control variables. DWHET must make at least
|
||||
C two passes to calculate sensitivity terms. NPASS counts passes;
|
||||
C MAX_PASS is the maximum number of passes. Currently the program
|
||||
C is written such that MAX_PASS should have a value of 2. For higher
|
||||
C values of MAX_PASS, modifications to the program are required.
|
||||
C
|
||||
npass = 0
|
||||
max_pass = 2
|
||||
|
||||
WRITE (*,9000)
|
||||
READ (*,*) inner
|
||||
WRITE (*,9100)
|
||||
READ (*,*) outer
|
||||
|
||||
DO WHILE( npass .LT. max_pass)
|
||||
WRITE (*,9200) npass + 1, outer, inner
|
||||
WRITE (*,*) ('=', j = 1, 60)
|
||||
kount = 0
|
||||
begin_time = secnds()
|
||||
|
||||
C
|
||||
C Beginning of timed interval
|
||||
C
|
||||
|
||||
DO WHILE( kount .LT. outer )
|
||||
|
||||
C
|
||||
C Whetstone code begins here. First initialize variables
|
||||
C and loop counters based on the number of inner loops.
|
||||
C
|
||||
C Loops 2 and 3 (described below) use variations of the
|
||||
C following transformation statements:
|
||||
C
|
||||
C x1 = ( x1 + x2 + x3 - x4) * 0.5
|
||||
C x2 = ( x1 + x2 - x3 + x4) * 0.5
|
||||
C x3 = ( x1 - x2 + x3 + x4) * 0.5
|
||||
C x4 = (-x1 + x2 + x3 + x4) * 0.5
|
||||
C
|
||||
C Theoretically this set tends to the solution
|
||||
C
|
||||
C x1 = x2 = x3 = x4 = 1.0
|
||||
C
|
||||
C The variables t1, t2, and t3 are terms designed to limit
|
||||
C convergence of the set.
|
||||
C
|
||||
t1 = 0.499975D00
|
||||
t2 = 0.50025D00
|
||||
t3 = 2.0D00
|
||||
|
||||
C
|
||||
C The variables n2-n11 are counters for Loops 2-11.
|
||||
C Based on earlier statistical work (Wichmann, 1970),
|
||||
C loops 1, 5, and 10 are omitted from the program.
|
||||
C
|
||||
isave = inner
|
||||
n2 = 12 * inner
|
||||
n3 = 14 * inner
|
||||
n4 = 345 * inner
|
||||
n6 = 210 * inner
|
||||
n7 = 32 * inner
|
||||
n8 = 899 * inner
|
||||
n9 = 616 * inner
|
||||
n11 = 93 * inner
|
||||
|
||||
C
|
||||
C The values in array e1 are arbitrary.
|
||||
C
|
||||
e1(1) = 1.0D00
|
||||
e1(2) = -1.0D00
|
||||
e1(3) = -1.0D00
|
||||
e1(4) = -1.0D00
|
||||
|
||||
C
|
||||
C Loop 1 - Convergence test using real numbers. The
|
||||
C execution of this loop was found to be statistically
|
||||
C invalid, but is included here for completeness.
|
||||
C
|
||||
C DO i = 1, n1
|
||||
C x1 = ( x1 + x2 + x3 - x4) * t1
|
||||
C x2 = ( x1 + x2 - x3 + x4) * t1
|
||||
C x3 = ( x1 - x2 + x3 + x4) * t1
|
||||
C x4 = (-x1 + x2 + x3 + x4) * t1
|
||||
C END DO
|
||||
|
||||
C
|
||||
C Loop 2 - Convergence test using array elements.
|
||||
C
|
||||
DO i = 1, n2
|
||||
e1(1) = ( e1(1) + e1(2) + e1(3) - e1(4)) * t1
|
||||
e1(2) = ( e1(1) + e1(2) - e1(3) + e1(4)) * t1
|
||||
e1(3) = ( e1(1) - e1(2) + e1(3) + e1(4)) * t1
|
||||
e1(4) = (-e1(1) + e1(2) + e1(3) + e1(4)) * t1
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 3 - Convergence test using subroutine calls.
|
||||
C
|
||||
DO i = 1, n3
|
||||
CALL sub1( e1 )
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 4 - Conditional jumps. Repeated iterations
|
||||
C alternate the value of j between 0 and 1.
|
||||
C
|
||||
j = 1
|
||||
DO i = 1, n4
|
||||
IF( j - 1 ) 20, 10, 20
|
||||
10 j = 2
|
||||
GOTO 30
|
||||
20 j = 3
|
||||
30 IF( j - 2 ) 50, 50, 40
|
||||
40 j = 0
|
||||
GOTO 60
|
||||
50 j = 1
|
||||
60 IF( j - 1 ) 70, 80, 80
|
||||
70 j = 1
|
||||
GOTO 100
|
||||
80 j = 0
|
||||
100 END DO
|
||||
|
||||
C
|
||||
C Loop 6 - Integer arithmetic and array addressing.
|
||||
C The values of integers j, k, and l remain unchanged
|
||||
C through iterations of loop.
|
||||
C
|
||||
j = 1
|
||||
k = 2
|
||||
l = 3
|
||||
DO i = 1, n6
|
||||
j = j * (k - j) * (l - k)
|
||||
k = l * k - (l - j) * k
|
||||
l = (l - k) * (k + j)
|
||||
e1(l - 1) = j + k + l
|
||||
e1(k - 1) = j * k * l
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 7 - Trigonometric functions. The following loop
|
||||
C almost transforms x and y into themselves and produces
|
||||
C results that slowly vary. (The value of t1 ensures
|
||||
C slow convergence, as described above.)
|
||||
C
|
||||
x = 0.5D00
|
||||
y = 0.5D00
|
||||
DO i = 1, n7
|
||||
x = t1 * DATAN( t3 * DSIN( x ) * DCOS( x ) /
|
||||
+ (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
|
||||
y = t1 * DATAN( t3 * DSIN( y ) * DCOS( y ) /
|
||||
+ (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 8 - Subroutine calls. Values of x, y, and z
|
||||
C are arbitrary.
|
||||
C
|
||||
x = 1.0D00
|
||||
y = 1.0D00
|
||||
z = 1.0D00
|
||||
DO i = 1, n8
|
||||
CALL sub2( x, y, z )
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 9 - Array references and subroutine calls.
|
||||
C
|
||||
j = 1
|
||||
k = 2
|
||||
l = 3
|
||||
e1(1) = 1.0D00
|
||||
e1(2) = 2.0D00
|
||||
e1(3) = 3.0D00
|
||||
DO i = 1, n9
|
||||
CALL sub3
|
||||
END DO
|
||||
|
||||
C
|
||||
C Loop 10 - Simple integer arithmetic. The execution
|
||||
C of this loop was found to be statistically invalid,
|
||||
C but is included here for completeness.
|
||||
C
|
||||
C j = 2
|
||||
C k = 3
|
||||
C DO i = 1, n10
|
||||
C j = j + k
|
||||
C k = j + k
|
||||
C j = j - k
|
||||
C k = k - j - j
|
||||
C END DO
|
||||
|
||||
C
|
||||
C Loop 11 - Standard functions DSQRT, DEXP, and DLOG.
|
||||
C
|
||||
x = 0.75D00
|
||||
DO i = 1, n11
|
||||
x = DSQRT( DEXP( DLOG( x ) / t2 ) )
|
||||
END DO
|
||||
|
||||
C
|
||||
C End of Whetstone code.
|
||||
C
|
||||
|
||||
inner = isave
|
||||
kount = kount + 1
|
||||
END DO
|
||||
|
||||
C
|
||||
C End of timed interval
|
||||
C
|
||||
|
||||
|
||||
end_time = secnds()
|
||||
dif_time = end_time - begin_time
|
||||
|
||||
C
|
||||
C 1000 whetstones (kilowhetstones) = 100 * loops per second
|
||||
C
|
||||
|
||||
kilowhet = 100.0D+00 * DBLE( outer * inner ) / dif_time
|
||||
|
||||
WRITE (*,9300) dif_time, kilowhet
|
||||
|
||||
C
|
||||
C Repeat with inner count doubled.
|
||||
C
|
||||
npass = npass + 1
|
||||
IF( npass .LT. max_pass ) THEN
|
||||
dif_save = dif_time
|
||||
whet_save = kilowhet
|
||||
inner = inner * max_pass
|
||||
ENDIF
|
||||
END DO
|
||||
|
||||
C
|
||||
C Compute sensitivity.
|
||||
C
|
||||
error = dif_time - (dif_save * max_pass )
|
||||
whet_err = whet_save - kilowhet
|
||||
percent_err = whet_err * 100.0D+00 / kilowhet
|
||||
WRITE (*,*)
|
||||
WRITE (*,*)
|
||||
WRITE (*,*) ('=', j = 1, 60)
|
||||
WRITE (*,9400) error, whet_err, percent_err
|
||||
IF( dif_time .LT. 10.0D00 )
|
||||
+ WRITE (*,*) 'TIME is less than 10 seconds -- ',
|
||||
+ 'suggest larger inner loop'
|
||||
|
||||
|
||||
9000 FORMAT( '0Number of inner loops (suggest more than 3): ' \ )
|
||||
9100 FORMAT( ' Number of outer loops (suggest more than 1): ' \ )
|
||||
9200 FORMAT( //' Pass #', I3.2, ': ', I10, ' outer loop(s),', I10,
|
||||
+ ' inner loop(s)' )
|
||||
9300 FORMAT( ' Elapsed time =', F12.2, ' seconds' /
|
||||
+ ' Whetstones =', F12.2,
|
||||
+ ' double-precision kilowhets/second' )
|
||||
9400 FORMAT( ' Time error =', F12.2, ' seconds' /
|
||||
+ ' Whet error =', F12.2, ' kwhets/sec' /
|
||||
+ ' % error =', F12.2, ' % whet error' )
|
||||
|
||||
END
|
||||
|
||||
|
||||
|
||||
C Subroutines for arithmetic, array assignments
|
||||
C
|
||||
|
||||
SUBROUTINE sub1( e )
|
||||
|
||||
REAL*8 t1, t2, t3, e(4)
|
||||
COMMON t1, t2, t3
|
||||
|
||||
DO i = 1, 6
|
||||
e(1) = (e(1) + e(2) + e(3) - e(4)) * t1
|
||||
e(2) = (e(1) + e(2) - e(3) + e(4)) * t1
|
||||
e(3) = (e(1) - e(2) + e(3) + e(4)) * t1
|
||||
e(4) = (-e(1) + e(2) + e(3) + e(4)) / t3
|
||||
END DO
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
|
||||
SUBROUTINE sub2( x, y, z )
|
||||
|
||||
REAL*8 t1, t2, t3, x1, y1, x, y, z
|
||||
COMMON t1, t2, t3
|
||||
|
||||
x1 = x
|
||||
y1 = y
|
||||
x1 = (x1 + y1) * t1
|
||||
y1 = (x1 + y1) * t1
|
||||
z = (x1 + y1) / t3
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
|
||||
SUBROUTINE sub3
|
||||
|
||||
REAL*8 t1, t2, t3, e1(4)
|
||||
COMMON t1, t2, t3, e1, j, k, l
|
||||
|
||||
e1(j) = e1(k)
|
||||
e1(k) = e1(l)
|
||||
e1(l) = e1(j)
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
|
||||
CC SECNDS - Calls GETTIM function to find current time.
|
||||
CC
|
||||
CC Return: Number of seconds since midnight.
|
||||
CC
|
||||
|
||||
REAL*8 FUNCTION secnds()
|
||||
|
||||
INTEGER*2 hour, minute, second, hundredth
|
||||
|
||||
CALL GETTIM( hour, minute, second, hundredth )
|
||||
secnds = ((DBLE( hour ) * 3600.0) + (DBLE( minute) * 60.0) +
|
||||
+ DBLE( second) + (DBLE( hundredth ) / 100.0))
|
||||
END
|
||||
|
||||
41
Microsoft Fortran v51/SOURCE/SAMPLES/EGA.FOR
Normal file
41
Microsoft Fortran v51/SOURCE/SAMPLES/EGA.FOR
Normal file
@ -0,0 +1,41 @@
|
||||
CC EGA.FOR - Demonstrates use of EGA palettes.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 dummy2
|
||||
INTEGER*4 dummy4
|
||||
RECORD /xycoord/ xy
|
||||
|
||||
dummy2 = setvideomode( $ERESCOLOR )
|
||||
dummy2 = setcolor( 4 )
|
||||
dummy2 = rectangle( $GFILLINTERIOR, 50, 50, 200, 200 )
|
||||
C
|
||||
C Display normal palette message.
|
||||
C
|
||||
CALL settextposition( 1, 1, xy )
|
||||
CALL outtext( 'Normal palette ' )
|
||||
CALL outtext( 'Press ENTER to continue' )
|
||||
READ (*,*) ! Wait for ENTER key to be pressed
|
||||
dummy4 = remappalette( 4, $BLUE )
|
||||
C
|
||||
C Display new palette message.
|
||||
C
|
||||
CALL settextposition( 1, 1, xy )
|
||||
CALL outtext( 'Remapped palette ' )
|
||||
CALL outtext( 'Press ENTER to continue' )
|
||||
READ (*,*)
|
||||
dummy4 = remappalette( 4, $RED )
|
||||
C
|
||||
C Display original palette message.
|
||||
C
|
||||
CALL settextposition( 1, 1, xy )
|
||||
CALL outtext( 'Restored palette ' )
|
||||
CALL outtext( 'Press ENTER to clear the screen' )
|
||||
READ (*,*)
|
||||
C
|
||||
C Return to original video mode.
|
||||
C
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
dummy2 = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
55
Microsoft Fortran v51/SOURCE/SAMPLES/EXEC.FI
Normal file
55
Microsoft Fortran v51/SOURCE/SAMPLES/EXEC.FI
Normal file
@ -0,0 +1,55 @@
|
||||
$LIST
|
||||
C EXEC.FI - Interface file for C system and spawnlp routines
|
||||
|
||||
C These functions are discussed in Chapter 3 of the Advanced Topics
|
||||
C manual. The program DEMOEXEC.FOR illustrates how to use the include
|
||||
C file and the functions.
|
||||
|
||||
|
||||
C Function: SYSTEM
|
||||
C
|
||||
C Purpose: Starts a child copy of the DOS system shell
|
||||
C program--COMMAND.COM
|
||||
C
|
||||
C Argument: string - A string (in C format) consisting
|
||||
C of a DOS command, program, or batch file name
|
||||
C followed optionally by arguments
|
||||
C
|
||||
C Return: INTEGER*2 - 0 for success, or -1 for fail
|
||||
C
|
||||
C Example: dummy2 = SYSTEM( 'dir *.for'C )
|
||||
|
||||
INTERFACE TO FUNCTION SYSTEM[C] (STRING)
|
||||
INTEGER*2 SYSTEM
|
||||
CHARACTER*1 STRING[REFERENCE]
|
||||
END
|
||||
|
||||
|
||||
C Function: SPAWNLP
|
||||
C
|
||||
C Purpose: Starts a child copy of a specified program
|
||||
C
|
||||
C Arguments: mode - Must be 0
|
||||
C
|
||||
C path - Address of a string (in C format) containing
|
||||
C path name of program to be executed (may be partial
|
||||
C if the program is in PATH or current directory)
|
||||
C
|
||||
C arg0 - Must be same as path
|
||||
C
|
||||
C arg1,...,argn - Addresses of command-line argument
|
||||
C strings (in C format) to be passed to the program.
|
||||
C Last argument must be INT4(0)
|
||||
C
|
||||
C Return: INTEGER*2 - return code of process or -1 for fail
|
||||
C
|
||||
C Example: dummy2 = SPAWNLP( 0,
|
||||
C + LOC( 'format'C ),
|
||||
C + LOC( 'format''C ),
|
||||
C + LOC( 'a:'C ),
|
||||
C + INT4( 0 ) )
|
||||
C
|
||||
C
|
||||
INTERFACE TO FUNCTION SPAWNLP [C,VARYING] (MODE)
|
||||
INTEGER*2 MODE,SPAWNLP
|
||||
END
|
||||
55
Microsoft Fortran v51/SOURCE/SAMPLES/FDLLOBJS.CMD
Normal file
55
Microsoft Fortran v51/SOURCE/SAMPLES/FDLLOBJS.CMD
Normal file
@ -0,0 +1,55 @@
|
||||
@echo off
|
||||
setlocal
|
||||
if %1.==. goto Message
|
||||
set DESTIN=%1
|
||||
set DLLNAME=%2
|
||||
if %2.==. set DLLNAME=frtlib
|
||||
if not %3.==. set LIBF=%3
|
||||
if not %3.==. goto Start
|
||||
for %%A in (%LIB%) do if exist %%A\FRTLIB.OBJ set LIBF=%%A& goto Start
|
||||
echo Can't find components in LIB directory
|
||||
goto Exit
|
||||
:Start
|
||||
echo.
|
||||
echo Build dynamic link library.
|
||||
echo.
|
||||
echo LINK %LIBF%\FRTLIB.OBJ,%DESTIN%\%DLLNAME%.DLL,,%LIBF%\FDLLOBJS/NOE,FDLLOBJS.DEF;
|
||||
LINK %LIBF%\FRTLIB.OBJ,%DESTIN%\%DLLNAME%.DLL,,%LIBF%\FDLLOBJS/NOE,FDLLOBJS.DEF;
|
||||
echo.
|
||||
echo Build imports library.
|
||||
echo.
|
||||
for %%A in (%PATH%) do if exist %%A\IMPLIB.EXE goto Skip2
|
||||
echo Can't find IMPLIB.EXE in PATH
|
||||
goto Exit
|
||||
:Skip2
|
||||
echo IMPLIB %LIBF%\%DLLNAME%.LIB FDLLOBJS.DEF DIFFHLP.DEF
|
||||
IMPLIB %LIBF%\%DLLNAME%.LIB FDLLOBJS.DEF DIFFHLP.DEF
|
||||
goto Exit
|
||||
:Message
|
||||
echo This batch file creates a dynamic link library and a corresponding
|
||||
echo imports library containing the FORTRAN run-time. The imports library
|
||||
echo (which is invoked at link time) specifies the symbols and routines
|
||||
echo that will be imported from the dynamic link library at run time.
|
||||
echo Your PATH should point to the directory containing IMPLIB.EXE. Your
|
||||
echo LIB environment variable should have a pathname for OS2.LIB.
|
||||
echo The files FDLLOBJS.DEF, DIFFHLP.DEF and FDLLOBJS.LIB should be in the
|
||||
echo same directory as FDLLOBJS.CMD.
|
||||
echo.
|
||||
echo Syntax:
|
||||
echo FDLLOBJS destin [dllname] [libdir]
|
||||
echo.
|
||||
echo Arguments:
|
||||
echo destin Specify destination directory (should be in LIBPATH
|
||||
echo in CONFIG.SYS). Use . for current directory.
|
||||
echo dllname Default is FRTLIB (extension is .DLL for dynalink
|
||||
echo library or .LIB for imports library)
|
||||
echo libdir Default is LIB environment variable
|
||||
echo.
|
||||
echo Examples:
|
||||
echo FDLLOBJS C:\BINP
|
||||
echo Puts FRTLIB.DLL in C:\BINP and FRTLIB.LIB
|
||||
echo in LIB directory.
|
||||
echo FDLLOBJS . DYNAF D:\LIBF
|
||||
echo Puts DYNAF.DLL in current and DYNAF.LIB in D:\LIBF
|
||||
:Exit
|
||||
endlocal
|
||||
518
Microsoft Fortran v51/SOURCE/SAMPLES/FDLLOBJS.DEF
Normal file
518
Microsoft Fortran v51/SOURCE/SAMPLES/FDLLOBJS.DEF
Normal file
@ -0,0 +1,518 @@
|
||||
LIBRARY FRTLIB
|
||||
DESCRIPTION 'Microsoft FORTRAN 5.0 Dynamically-Linked FORTRAN Run-time Library'
|
||||
DATA MULTIPLE
|
||||
PROTMODE
|
||||
EXPORTS
|
||||
__FCclenv
|
||||
|
||||
_exit
|
||||
__CRT_INIT
|
||||
_system
|
||||
_spawnlp
|
||||
|
||||
BEGINTHREAD
|
||||
ENDTHREAD
|
||||
GETARG
|
||||
GETDAT
|
||||
GETTIM
|
||||
ICLRER
|
||||
IGETER
|
||||
NARGS
|
||||
RANDOM
|
||||
SEED
|
||||
SETDAT
|
||||
SETTIM
|
||||
THREADID
|
||||
|
||||
LCWRQQ
|
||||
SCWRQQ
|
||||
SSWRQQ
|
||||
|
||||
__FFalloc
|
||||
__FFasfmt
|
||||
__FFbak
|
||||
__FFcls
|
||||
__FFdeall
|
||||
__FFenf
|
||||
__FFeof
|
||||
__FFfmtcr
|
||||
__FFinq
|
||||
__FFlok
|
||||
__FFnSTOP
|
||||
__FFopn
|
||||
__FFpPAUSE
|
||||
__FFrd
|
||||
__FFrd2
|
||||
__FFrew
|
||||
__FFsSTOP
|
||||
__FFuio
|
||||
__FFwr
|
||||
__FFwr2
|
||||
|
||||
__FCchfr
|
||||
__FClccheck
|
||||
__FClccmp
|
||||
__FClcconc
|
||||
__FClccop
|
||||
__FClindex
|
||||
__FCl8index
|
||||
__FCllentrim
|
||||
__FClscan
|
||||
__FClverify
|
||||
__FCmccheck
|
||||
__FCmccmp
|
||||
__FCmcconc
|
||||
__FCmccop
|
||||
__FCmindex
|
||||
__FCm8index
|
||||
__FCmlentrim
|
||||
__FCmscan
|
||||
__FCmverify
|
||||
|
||||
__FF_BINI
|
||||
__FF_BINO
|
||||
__FF_DECFLT
|
||||
__FF_ENCFLT
|
||||
__FF_FMTIN
|
||||
__FF_FMTOUT
|
||||
__FF_GETCHN
|
||||
__FF_GETCHNT
|
||||
__FF_GETNUM
|
||||
__FF_GETNUMT
|
||||
__FF_HEX
|
||||
__FF_LDIN
|
||||
__FF_LDOUT
|
||||
__FF_LOGIN
|
||||
__FF_NLIN
|
||||
__FF_NLOUT
|
||||
__FF_NRECFDI
|
||||
__FF_NRECFDO
|
||||
__FF_NRECFSI
|
||||
__FF_NRECFSO
|
||||
__FF_NRECINI
|
||||
__FF_NRECINO
|
||||
__FF_NRECTMI
|
||||
__FF_NRECTMO
|
||||
__FF_POS
|
||||
__FF_PUTBIN
|
||||
__FF_PUTBINT
|
||||
__FF_UFDIRI
|
||||
__FF_UFDIRO
|
||||
__FF_UFSEQI
|
||||
__FF_UFSEQO
|
||||
|
||||
__FHAGOTO
|
||||
__FHovfl
|
||||
__FHRNG
|
||||
__FFFILE
|
||||
__FFLINE
|
||||
|
||||
__FXABS
|
||||
__FXACOS
|
||||
__FXAIMAG
|
||||
__FXAINT
|
||||
__FXALOG
|
||||
__FXALOG10
|
||||
__FXAMOD
|
||||
__FXANINT
|
||||
__FXASIN
|
||||
__FXATAN
|
||||
__FXATAN2
|
||||
__FXBTEST1
|
||||
__FXBTEST2
|
||||
__FXCABS
|
||||
__FXCCOS
|
||||
__FXCDABS
|
||||
__FXCDCOS
|
||||
__FXCDEXP
|
||||
__FXCDLOG
|
||||
__FXCDSIN
|
||||
__FXCDSQRT
|
||||
__FXCEXP
|
||||
__FXCLOG
|
||||
__FXCONJG
|
||||
__FXCOS
|
||||
__FXCOSH
|
||||
__FXCOTAN
|
||||
__FXCSIN
|
||||
__FXCSQRT
|
||||
__FXDABS
|
||||
__FXDACOS
|
||||
__FXDASIN
|
||||
__FXDATAN
|
||||
__FXDATAN2
|
||||
__FXDCONJG
|
||||
__FXDCOS
|
||||
__FXDCOSH
|
||||
__FXDCOTAN
|
||||
__FXDDIM
|
||||
__FXDEXP
|
||||
__FXDIM
|
||||
__FXDIMAG
|
||||
__FXDINT
|
||||
__FXDLOG
|
||||
__FXDLOG10
|
||||
__FXDMOD
|
||||
__FXDNINT
|
||||
__FXDPROD
|
||||
__FXDSIGN
|
||||
__FXDSIN
|
||||
__FXDSINH
|
||||
__FXDSQRT
|
||||
__FXDTAN
|
||||
__FXDTANH
|
||||
__FXEXP
|
||||
__FXIABS2
|
||||
__FXIABS4
|
||||
__FXIAND2
|
||||
__FXIAND4
|
||||
__FXIBCHNG2
|
||||
__FXIBCHNG4
|
||||
__FXIBCLR2
|
||||
__FXIBCLR4
|
||||
__FXIBSET2
|
||||
__FXIBSET4
|
||||
__FXIDIM2
|
||||
__FXIDIM4
|
||||
__FXIDNINT2
|
||||
__FXIDNINT4
|
||||
__FXIEOR2
|
||||
__FXIEOR4
|
||||
__FXINDEX2
|
||||
__FXINDEX4
|
||||
__FXIOR2
|
||||
__FXIOR4
|
||||
__FXISHA2
|
||||
__FXISHC2
|
||||
__FXISHC4
|
||||
__FXISHFT2
|
||||
__FXISHL2
|
||||
__FXISIGN2
|
||||
__FXISIGN4
|
||||
__FXLEN2
|
||||
__FXLEN4
|
||||
__FXMOD2
|
||||
__FXMOD4
|
||||
__FXNINT2
|
||||
__FXNINT4
|
||||
__FXNOT2
|
||||
__FXNOT4
|
||||
__FXSIGN
|
||||
__FXSIN
|
||||
__FXSINH
|
||||
__FXSQRT
|
||||
__FXTAN
|
||||
__FXTANH
|
||||
|
||||
__aFFovalmul
|
||||
__aFllrot
|
||||
__aFlrrot
|
||||
__aFNovalmul
|
||||
__aFovlmul
|
||||
__aFovulmul
|
||||
|
||||
__aFFaldiv
|
||||
__aFFalmul
|
||||
__aFFalrem
|
||||
__aFFalshl
|
||||
__aFFalshr
|
||||
__aFFauldiv
|
||||
__aFFaulmul
|
||||
__aFFaulrem
|
||||
__aFFaulshr
|
||||
__aFahdiff
|
||||
__aFldiv
|
||||
__aFlmul
|
||||
__aFlrem
|
||||
__aFlshl
|
||||
__aFlshr
|
||||
__aFNaldiv
|
||||
__aFNalmul
|
||||
__aFNalrem
|
||||
__aFNalshl
|
||||
__aFNalshr
|
||||
__aFNauldiv
|
||||
__aFNaulmul
|
||||
__aFNaulrem
|
||||
__aFNaulshr
|
||||
__aFuldiv
|
||||
__aFulmul
|
||||
__aFulrem
|
||||
__aFulshr
|
||||
|
||||
__eaddd
|
||||
__eadds
|
||||
__edivd
|
||||
__edivdr
|
||||
__edivs
|
||||
__edivsr
|
||||
__eldd
|
||||
__eldl
|
||||
__eldq
|
||||
__elds
|
||||
__eldw
|
||||
__emuld
|
||||
__emuls
|
||||
__estd
|
||||
__estdp
|
||||
__ests
|
||||
__estsp
|
||||
__esubd
|
||||
__esubdr
|
||||
__esubs
|
||||
__esubsr
|
||||
__fadd
|
||||
__faddd
|
||||
__fadds
|
||||
__fchs
|
||||
__fcmp
|
||||
__fcompp
|
||||
__fdiv
|
||||
__fdivd
|
||||
__fdivdr
|
||||
__fdivr
|
||||
__fdivs
|
||||
__fdivsr
|
||||
__fdup
|
||||
__FF_DBGMSG
|
||||
__FF_ftranexit
|
||||
__FF_intrin_err
|
||||
__FF_math_err_off
|
||||
__FF_math_err_on
|
||||
__FF_writestring
|
||||
|
||||
__FHcchs
|
||||
__FHceaddcd
|
||||
__FHceaddcs
|
||||
__FHcecmpcd
|
||||
__FHcecmpcs
|
||||
__FHcecmpd
|
||||
__FHcecmpl
|
||||
__FHcecmps
|
||||
__FHcecmpw
|
||||
__FHcedivcd
|
||||
__FHcedivcs
|
||||
__FHcedivd
|
||||
__FHcedivl
|
||||
__FHcedivrcd
|
||||
__FHcedivrcs
|
||||
__FHcedivrd
|
||||
__FHcedivrl
|
||||
__FHcedivrs
|
||||
__FHcedivrw
|
||||
__FHcedivs
|
||||
__FHcedivw
|
||||
__FHceldcd
|
||||
__FHceldcs
|
||||
__FHceldd
|
||||
__FHceldl
|
||||
__FHcelds
|
||||
__FHceldw
|
||||
__FHcemulcd
|
||||
__FHcemulcs
|
||||
__FHcemuld
|
||||
__FHcemull
|
||||
__FHcemuls
|
||||
__FHcemulw
|
||||
__FHcestcd
|
||||
__FHcestcdp
|
||||
__FHcestcs
|
||||
__FHcestcsp
|
||||
__FHcesubcd
|
||||
__FHcesubcs
|
||||
__FHcesubrcd
|
||||
__FHcesubrcs
|
||||
__FHcfaddcd
|
||||
__FHcfaddcs
|
||||
__FHcfaddct
|
||||
__FHcfcmpcd
|
||||
__FHcfcmpcs
|
||||
__FHcfcmpct
|
||||
__FHcfcmpd
|
||||
__FHcfcmpl
|
||||
__FHcfcmps
|
||||
__FHcfcmpw
|
||||
__FHcfdivcd
|
||||
__FHcfdivcs
|
||||
__FHcfdivct
|
||||
__FHcfdivd
|
||||
__FHcfdivl
|
||||
__FHcfdivrcd
|
||||
__FHcfdivrcs
|
||||
__FHcfdivrct
|
||||
__FHcfdivrd
|
||||
__FHcfdivrl
|
||||
__FHcfdivrs
|
||||
__FHcfdivrw
|
||||
__FHcfdivs
|
||||
__FHcfdivw
|
||||
__FHcfexp
|
||||
__FHcfexpl
|
||||
__FHcfexpw
|
||||
__FHcfldcd
|
||||
__FHcfldcs
|
||||
__FHcfldct
|
||||
__FHcfldd
|
||||
__FHcfldl
|
||||
__FHcflds
|
||||
__FHcfldw
|
||||
__FHcfmulcd
|
||||
__FHcfmulcs
|
||||
__FHcfmulct
|
||||
__FHcfmuld
|
||||
__FHcfmull
|
||||
__FHcfmuls
|
||||
__FHcfmulw
|
||||
__FHcfstcd
|
||||
__FHcfstcdp
|
||||
__FHcfstcs
|
||||
__FHcfstcsp
|
||||
__FHcfstctp
|
||||
__FHcfsubcd
|
||||
__FHcfsubcs
|
||||
__FHcfsubct
|
||||
__FHcfsubrcd
|
||||
__FHcfsubrcs
|
||||
__FHcfsubrct
|
||||
__FHcsaddcd
|
||||
__FHcsaddcs
|
||||
__FHcsaddct
|
||||
__FHcscmpcd
|
||||
__FHcscmpcs
|
||||
__FHcscmpct
|
||||
__FHcscmpd
|
||||
__FHcscmpl
|
||||
__FHcscmps
|
||||
__FHcscmpw
|
||||
__FHcsdivcd
|
||||
__FHcsdivcs
|
||||
__FHcsdivct
|
||||
__FHcsdivd
|
||||
__FHcsdivl
|
||||
__FHcsdivrcd
|
||||
__FHcsdivrcs
|
||||
__FHcsdivrct
|
||||
__FHcsdivrd
|
||||
__FHcsdivrl
|
||||
__FHcsdivrs
|
||||
__FHcsdivrw
|
||||
__FHcsdivs
|
||||
__FHcsdivw
|
||||
__FHcsldcd
|
||||
__FHcsldcs
|
||||
__FHcsldct
|
||||
__FHcsldd
|
||||
__FHcsldl
|
||||
__FHcslds
|
||||
__FHcsldw
|
||||
__FHcsmulcd
|
||||
__FHcsmulcs
|
||||
__FHcsmulct
|
||||
__FHcsmuld
|
||||
__FHcsmull
|
||||
__FHcsmuls
|
||||
__FHcsmulw
|
||||
__FHcsstcd
|
||||
__FHcsstcdp
|
||||
__FHcsstcs
|
||||
__FHcsstcsp
|
||||
__FHcsstctp
|
||||
__FHcssubcd
|
||||
__FHcssubcs
|
||||
__FHcssubct
|
||||
__FHcssubrcd
|
||||
__FHcssubrcs
|
||||
__FHcssubrct
|
||||
__FHctof
|
||||
|
||||
__FHexpl
|
||||
__FHexpw
|
||||
__FHfexp
|
||||
__FHfexpl
|
||||
__FHfexpw
|
||||
__FHnewamax1
|
||||
__FHnewamin1
|
||||
__FIacos
|
||||
__FIaimag
|
||||
__FIaint
|
||||
__FIalog10
|
||||
__FIamod
|
||||
__FIanint
|
||||
__FIasin
|
||||
__FIatan
|
||||
__FIatan2
|
||||
__FIbtest4
|
||||
__FIcabs
|
||||
__FIccos
|
||||
__FIcexp
|
||||
__FIclog
|
||||
__FIconjg
|
||||
__FIcos
|
||||
__FIcosh
|
||||
__FIcotan
|
||||
__FIcsin
|
||||
__FIcsqrt
|
||||
__FIdim
|
||||
__FIdprod
|
||||
__FIexp
|
||||
__FIibchg4
|
||||
__FIibclr4
|
||||
__FIibset4
|
||||
__FIlog
|
||||
__FInint
|
||||
__FIsign
|
||||
__FIsin
|
||||
__FIsinh
|
||||
__FIsqrt
|
||||
__FItan
|
||||
__FItanh
|
||||
__FISNEAREST
|
||||
__FIDNEAREST
|
||||
__fldd
|
||||
__fldl
|
||||
__fldq
|
||||
__flds
|
||||
__fldt
|
||||
__fldw
|
||||
__fldz
|
||||
__fmul
|
||||
__fmuld
|
||||
__fmuls
|
||||
__fstd
|
||||
__fstdp
|
||||
__fsts
|
||||
__fstsp
|
||||
__fsttp
|
||||
__fsub
|
||||
__fsubd
|
||||
__fsubdr
|
||||
__fsubr
|
||||
__fsubs
|
||||
__fsubsr
|
||||
__ftol
|
||||
__ftolr
|
||||
__ftst
|
||||
__fxch
|
||||
__saddd
|
||||
__sadds
|
||||
__sdivd
|
||||
__sdivdr
|
||||
__sdivs
|
||||
__sdivsr
|
||||
__sldd
|
||||
__sldl
|
||||
__sldq
|
||||
__slds
|
||||
__sldt
|
||||
__sldw
|
||||
__smuld
|
||||
__smuls
|
||||
__sstd
|
||||
__sstdp
|
||||
__ssts
|
||||
__sstsp
|
||||
__ssttp
|
||||
__ssubd
|
||||
__ssubdr
|
||||
__ssubs
|
||||
__ssubsr
|
||||
82
Microsoft Fortran v51/SOURCE/SAMPLES/FIGURE.FOR
Normal file
82
Microsoft Fortran v51/SOURCE/SAMPLES/FIGURE.FOR
Normal file
@ -0,0 +1,82 @@
|
||||
CC FIGURE.FOR - Illustrates graphics drawing functions including:
|
||||
CC arc ineto pie setpixel
|
||||
CC ellipse moveto rectangle
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 status, x, y
|
||||
INTEGER*4 ncolor
|
||||
RECORD /xycoord/ xy
|
||||
|
||||
C
|
||||
C Find graphics mode.
|
||||
C
|
||||
IF ( setvideomode( $MAXRESMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set graphics mode'
|
||||
|
||||
WRITE (*,*) ' Press ENTER to continue'
|
||||
C
|
||||
C Draw pixels.
|
||||
C
|
||||
ncolor = 2
|
||||
status = setcolor( ncolor )
|
||||
x = 10
|
||||
DO y = 50, 89, 3
|
||||
status = setpixel( x, y )
|
||||
x = x + 2
|
||||
END DO
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Draw lines.
|
||||
C
|
||||
ncolor = ncolor + 1
|
||||
status = setcolor( ncolor )
|
||||
x = 60
|
||||
DO y = 50, 89, 3
|
||||
CALL moveto( x, y, xy )
|
||||
status = lineto( x + 20, y )
|
||||
END DO
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Draw rectangles.
|
||||
C
|
||||
ncolor = ncolor + 1
|
||||
status = setcolor( ncolor )
|
||||
x = 110
|
||||
y = 70
|
||||
status = rectangle( $GBORDER, x - 20, y - 20, x, y )
|
||||
status = rectangle( $GFILLINTERIOR, x + 20, y + 20, x, y )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Draw ellipses.
|
||||
C
|
||||
ncolor = ncolor + 1
|
||||
status = setcolor( ncolor )
|
||||
x = 160
|
||||
status = ellipse( $GBORDER, x - 20, y - 20, x, y )
|
||||
status = ellipse( $GFILLINTERIOR, x + 20, y + 20, x, y )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Draw arcs.
|
||||
C
|
||||
ncolor = ncolor + 1
|
||||
status = setcolor( ncolor )
|
||||
x = 210
|
||||
status = arc( x - 20, y - 20, x, y, x, y - 10, x - 10, y )
|
||||
status = arc( x + 20, y + 20, x, y, x + 10, y + 20, x + 20,
|
||||
+ y + 10 )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
C
|
||||
C Draw pies.
|
||||
C
|
||||
ncolor = ncolor + 1
|
||||
status = setcolor( ncolor )
|
||||
x = 260
|
||||
status = pie( $GBORDER, x - 20, y - 20, x, y, x,
|
||||
+ y - 10, x - 10, y)
|
||||
status = pie( $GFILLINTERIOR, x + 20, y + 20, x, y, x + 10,
|
||||
+ y + 20, x + 20, y + 10 )
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
92
Microsoft Fortran v51/SOURCE/SAMPLES/FILL.FOR
Normal file
92
Microsoft Fortran v51/SOURCE/SAMPLES/FILL.FOR
Normal file
@ -0,0 +1,92 @@
|
||||
CC FILL.FOR - Illustrates color, filling, and linestyle functions
|
||||
CC including: floodfill setfillmask
|
||||
CC getlinestyle setlinestyle
|
||||
CC setcolor
|
||||
CC
|
||||
CC The getfillmask function is not shown, but its use is similar
|
||||
CC to getlinestyle.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*1 fill(8)
|
||||
INTEGER*2 status, xinc, yinc, i,
|
||||
+ irand, xwid, ywid, rseed
|
||||
INTEGER*4 ncolor
|
||||
REAL*4 rand
|
||||
RECORD /xycoord/ xy
|
||||
RECORD /videoconfig/ vc
|
||||
|
||||
C
|
||||
C Find graphics mode.
|
||||
C
|
||||
IF( setvideomode( $MAXRESMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set graphics mode'
|
||||
CALL getvideoconfig( vc )
|
||||
|
||||
C
|
||||
C Size variables to mode.
|
||||
C
|
||||
xinc = vc.numxpixels / 8.0
|
||||
yinc = vc.numypixels / 8.0
|
||||
xwid = (xinc / 2.0) - 4.0
|
||||
ywid = (yinc / 2.0) - 4.0
|
||||
|
||||
C
|
||||
C Seed random-number generator.
|
||||
C
|
||||
CALL GETTIM( status, status, status, rseed)
|
||||
CALL SEED( rseed )
|
||||
|
||||
C
|
||||
C Draw ellipses and lines with different patterns.
|
||||
C
|
||||
DO x = xinc, (vc.numxpixels - xinc), xinc
|
||||
DO y = yinc, (vc.numypixels - yinc), yinc
|
||||
C
|
||||
C Randomize fill and color. Array FILL holds
|
||||
C random numbers between 0 and 255.
|
||||
C
|
||||
DO i = 1, 8
|
||||
CALL RANDOM( rand )
|
||||
fill(i) = INT1( rand * 256.0 )
|
||||
END DO
|
||||
|
||||
CALL setfillmask( fill )
|
||||
irand = rand * 256.0
|
||||
ncolor = MOD( irand, vc.numcolors ) + 1
|
||||
status = setcolor( ncolor )
|
||||
C
|
||||
C Draw ellipse and fill with random color.
|
||||
C
|
||||
status = ellipse( $GBORDER, x - xwid, y - ywid,
|
||||
+ x + xwid, y + ywid )
|
||||
CALL RANDOM( rand )
|
||||
irand = rand * 256.0
|
||||
i = ncolor
|
||||
ncolor = MOD( irand, vc.numcolors ) + 1
|
||||
status = setcolor( ncolor )
|
||||
status = floodfill( x, y, i )
|
||||
C
|
||||
C Draw vertical and horizontal lines. Vertical line style
|
||||
C is anything other than horizontal style. Since lines
|
||||
C are overdrawn with several line styles, this has the
|
||||
C effect of combining colors and styles.
|
||||
C
|
||||
CALL RANDOM( rand )
|
||||
irand = rand * 256.0
|
||||
CALL setlinestyle( irand )
|
||||
CALL moveto( 0, y + ywid + 4, xy )
|
||||
status = lineto( vc.numxpixels - 1, y + ywid + 4 )
|
||||
C
|
||||
C Get linestyle, invert bits, and reset linestyle.
|
||||
C
|
||||
CALL setlinestyle( 255 - getlinestyle() )
|
||||
CALL moveto( x + xwid + 4, 0, xy )
|
||||
status = lineto( x + xwid + 4, vc.numypixels - 1 )
|
||||
END DO
|
||||
END DO
|
||||
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
125
Microsoft Fortran v51/SOURCE/SAMPLES/FMHELLO.FOR
Normal file
125
Microsoft Fortran v51/SOURCE/SAMPLES/FMHELLO.FOR
Normal file
@ -0,0 +1,125 @@
|
||||
CC The FMHELLO program illustrates how to use multiple threads.
|
||||
CC
|
||||
CC Use this command line to compile:
|
||||
CC
|
||||
CC FL -MT fmhello.for
|
||||
CC
|
||||
CC Or build the FORTRAN run-time DLL (using the FDLLOBJS batch file)
|
||||
CC and compile with this command:
|
||||
CC
|
||||
CC FL -MD fmhello.for frtexe.obj frtlib.lib
|
||||
CC
|
||||
CC To run, specify the number of times you want each thread to say
|
||||
CC hello. For example, to start three threads speaking 5, 7, and 9
|
||||
CC times, respectively, use this command:
|
||||
CC
|
||||
CC FMHELLO 5 7 9
|
||||
CC
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION BEGINTHREAD(rtn, stk, size, arg)
|
||||
INTEGER*4 rtn [value]
|
||||
INTEGER*1 stk(*)
|
||||
INTEGER*4 size
|
||||
INTEGER*4 arg
|
||||
END
|
||||
|
||||
INTERFACE TO INTEGER*2 FUNCTION DosSleep( time )
|
||||
INTEGER*4 time [value]
|
||||
END
|
||||
|
||||
CC Routine for each thread to say 'hello world'
|
||||
CC
|
||||
SUBROUTINE child( loopcnt )
|
||||
|
||||
INTEGER*4 loopcnt
|
||||
INTEGER*4 i, result(2:32)
|
||||
INTEGER*2 DosSleep, threadid, tid
|
||||
LOGICAL*2 ready
|
||||
AUTOMATIC tid, i
|
||||
COMMON ready, result
|
||||
|
||||
tid = threadid()
|
||||
|
||||
DO WHILE( .NOT. ready )
|
||||
i = DosSleep( 0 )
|
||||
END DO
|
||||
|
||||
DO i = 1, loopcnt
|
||||
WRITE (*,*) 'Hello world from thread ', tid
|
||||
END DO
|
||||
|
||||
C
|
||||
C Let the main program (thread 1) know thread is done.
|
||||
C
|
||||
result(tid) = 1
|
||||
END
|
||||
|
||||
|
||||
CC Main code to launch threads.
|
||||
CC
|
||||
INTEGER*4 result(2:32), hellocnt(31)
|
||||
INTEGER*2 i, next, lastid, rc
|
||||
INTEGER*2 BEGINTHREAD, DosSleep
|
||||
INTEGER*1 stack [allocatable](:,:)
|
||||
LOGICAL*2 ready
|
||||
CHARACTER*10 argbuf
|
||||
EXTERNAL child
|
||||
COMMON ready, result
|
||||
|
||||
i = NARGS() - 1
|
||||
IF( i .GE. 32) STOP 'Error: Too many arguments'
|
||||
|
||||
C
|
||||
C Allocate a 2K stack for each thread specified on the command line.
|
||||
C
|
||||
IF( i .GT. 0) ALLOCATE( stack(2048, i) )
|
||||
C
|
||||
C Bring up one thread for each argument.
|
||||
C
|
||||
ready = .FALSE.
|
||||
lastid = 0
|
||||
|
||||
DO next = 1, i
|
||||
CALL GETARG( next, argbuf, rc )
|
||||
READ (argbuf, '(I10)') hellocnt(next)
|
||||
C
|
||||
C Bring up the new thread and pass the corresponding argument.
|
||||
C
|
||||
rc = BEGINTHREAD( LOCFAR( child ),
|
||||
+ stack(1,next),
|
||||
+ 2048,
|
||||
+ hellocnt(next) )
|
||||
|
||||
C
|
||||
C Keep track of how many threads were brought up.
|
||||
C
|
||||
IF( rc .GT. lastid ) lastid = rc
|
||||
|
||||
END DO
|
||||
|
||||
C
|
||||
C Tell the user how many threads were brought up.
|
||||
C
|
||||
WRITE (*,*) 'Number of threads = ', next - 1
|
||||
WRITE (*,*) 'Maximum thread ID = ', lastid
|
||||
|
||||
C
|
||||
C Let the threads begin execution and wait for them to complete.
|
||||
C
|
||||
ready = .TRUE.
|
||||
|
||||
DO j = 1, next - 1
|
||||
i = 2
|
||||
C
|
||||
C Check until a thread signals completion. Clear flag and
|
||||
C start over, until all threads have finished.
|
||||
C
|
||||
DO WHILE( result(i) .EQ. 0 )
|
||||
rc = DosSleep( 0 )
|
||||
i = i + 1
|
||||
IF( i .GT. lastid ) i = 2
|
||||
END DO
|
||||
result(i) = 0
|
||||
END DO
|
||||
|
||||
END
|
||||
5
Microsoft Fortran v51/SOURCE/SAMPLES/FMTDLL.DEF
Normal file
5
Microsoft Fortran v51/SOURCE/SAMPLES/FMTDLL.DEF
Normal file
@ -0,0 +1,5 @@
|
||||
LIBRARY FMTDLL
|
||||
DESCRIPTION 'Sample Dynalink Library written in Microsoft FORTRAN'
|
||||
PROTMODE
|
||||
EXPORTS dynalibtest
|
||||
DATA MULTIPLE
|
||||
29
Microsoft Fortran v51/SOURCE/SAMPLES/FMTDLL.FOR
Normal file
29
Microsoft Fortran v51/SOURCE/SAMPLES/FMTDLL.FOR
Normal file
@ -0,0 +1,29 @@
|
||||
CC FMTDLL dynamic link library. To be linked with FMTMAIN at run time.
|
||||
CC
|
||||
CC Compile FMTDLL.FOR and link to create a dynamic-link-library.
|
||||
CC FMTDLL.DEF lists the routines which FMTDLL.DLL will export.
|
||||
CC
|
||||
CC Assuming that the example dynamic-link FORTRAN runtime library is on
|
||||
CC your LIBPATH (see FDLLOBJS.CMD), compile with the following command:
|
||||
CC
|
||||
CC FL -MD -Fefmtdll.dll fmtdll.for frtdll.obj frtlib.lib fmtdll.def
|
||||
CC
|
||||
CC Note that this example DLL requires runtime support.
|
||||
CC If the WRITE statement is removed, then specification of a dynamically
|
||||
CC linked FORTRAN runtime library on the above command-line is unneccesary.
|
||||
CC
|
||||
|
||||
SUBROUTINE dynalibtest [LOADDS] ( a1, a2 )
|
||||
|
||||
INTEGER*4 a1, a2
|
||||
INTEGER*4 temp
|
||||
|
||||
WRITE (*,*) 'inside dynalibtest()...swapping arguments'
|
||||
|
||||
C
|
||||
C Swap the values of the arguments.
|
||||
C
|
||||
temp = a1
|
||||
a1 = a2
|
||||
a2 = temp
|
||||
END
|
||||
2
Microsoft Fortran v51/SOURCE/SAMPLES/FMTMAIN.DEF
Normal file
2
Microsoft Fortran v51/SOURCE/SAMPLES/FMTMAIN.DEF
Normal file
@ -0,0 +1,2 @@
|
||||
NAME FMTMAIN
|
||||
IMPORTS FMTDLL.dynalibtest
|
||||
32
Microsoft Fortran v51/SOURCE/SAMPLES/FMTMAIN.FOR
Normal file
32
Microsoft Fortran v51/SOURCE/SAMPLES/FMTMAIN.FOR
Normal file
@ -0,0 +1,32 @@
|
||||
CC FMTMAIN program to illustrate calling a multithread dynamic link
|
||||
CC library routine. To be linked with FMTDLL.DLL at run time.
|
||||
CC
|
||||
CC Compile FMTMAIN.FOR and link to create an executable file.
|
||||
CC FMTMAIN.DEF lists the routines imported from FMTDLL.DLL.
|
||||
CC
|
||||
CC Assuming that the example dynamic-link FORTRAN runtime library is on
|
||||
CC your LIBPATH (see FDLLOBJS.CMD), compile with the following command:
|
||||
CC
|
||||
CC FL -MD fmtmain.for frtexe.obj frtlib.lib fmtmain.def
|
||||
CC
|
||||
INTERFACE TO SUBROUTINE dynalibtest [LOADDS] ( i, j )
|
||||
INTEGER*4 i, j
|
||||
END
|
||||
|
||||
INTEGER*4 init, noinit
|
||||
|
||||
init = 10101010
|
||||
WRITE (*,*) 'in main code...'
|
||||
WRITE (*,*) 'INIT = ', init
|
||||
WRITE (*,*) 'NOINIT = ', noinit
|
||||
WRITE (*,*)
|
||||
C
|
||||
C Call dynamic link library to swap values in arguments.
|
||||
C
|
||||
CALL dynalibtest( init, noinit )
|
||||
|
||||
WRITE (*,*)
|
||||
WRITE (*,*) 'back in main code...'
|
||||
WRITE (*,*) 'INIT = ', init
|
||||
WRITE (*,*) 'NOINIT = ', noinit
|
||||
END
|
||||
91
Microsoft Fortran v51/SOURCE/SAMPLES/FONTS.FOR
Normal file
91
Microsoft Fortran v51/SOURCE/SAMPLES/FONTS.FOR
Normal file
@ -0,0 +1,91 @@
|
||||
CC FONTS.FOR - Illustrates fonts functions including:
|
||||
CC getfontinfo setfont unregisterfonts
|
||||
CC getgtextextent registerfonts
|
||||
CC outgtext setgtextvector
|
||||
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
PARAMETER ( NFONTS = 6 )
|
||||
|
||||
INTEGER*2 dummy, x, y, iend
|
||||
INTEGER*4 ifont
|
||||
CHARACTER*11 face(NFONTS)
|
||||
CHARACTER*10 options(NFONTS)
|
||||
CHARACTER*20 list
|
||||
CHARACTER*64 fontpath
|
||||
RECORD /videoconfig/ vc
|
||||
RECORD /xycoord/ xy
|
||||
RECORD /fontinfo/ fi
|
||||
|
||||
DATA face / "Courier" , "Helvetica" , "Times Roman",
|
||||
+ "Modern" , "Script" , "Roman" /
|
||||
DATA options / "t'courier'", "t'helv'" , "t'tms rmn'" ,
|
||||
+ "t'modern'" , "t'script'" , "t'roman'" /
|
||||
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
WRITE (*,*) 'Enter file specification for .FON files'
|
||||
WRITE (*,*) '[pathname\*.FON]:'
|
||||
WRITE (*,*)
|
||||
READ (*, '(A)') fondir
|
||||
C
|
||||
C Locate .FON files, then register fonts by reading header
|
||||
C information from all files.
|
||||
C
|
||||
IF( registerfonts( '*.FON' ). LT. 0 ) THEN
|
||||
WRITE (*, '(A/)') ' Enter directory for .FON files:'
|
||||
READ (*, '(A )') fontpath
|
||||
iend = INDEX( fontpath, ' ' )
|
||||
fontpath( iend:iend + 5 ) = '\*.FON'
|
||||
IF( registerfonts( fontpath ). LT. 0 )
|
||||
+ STOP 'Error: cannot find font files'
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C Find graphics mode.
|
||||
C
|
||||
IF( setvideomode( $MAXRESMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set graphics mode'
|
||||
CALL getvideoconfig( vc )
|
||||
|
||||
C
|
||||
C Display each font name centered on screen.
|
||||
C
|
||||
DO ifont = 1, NFONTS
|
||||
|
||||
C
|
||||
C Build options string.
|
||||
C
|
||||
list = options(ifont) // 'h30w24b'
|
||||
|
||||
CALL clearscreen( $GCLEARSCREEN )
|
||||
IF( setfont( list ) .GE. 0 ) THEN
|
||||
C
|
||||
C Use length of text and height of font to center text.
|
||||
C
|
||||
x = (vc.numxpixels-getgtextextent
|
||||
+ (face( ifont))) / 2
|
||||
IF( getfontinfo( fi ) .NE. 0 ) THEN
|
||||
CALL outtext( 'Error: cannot get font info' )
|
||||
READ (*,*)
|
||||
END IF
|
||||
y = (vc.numypixels - fi.ascent) / 2
|
||||
CALL moveto( x, y, xy )
|
||||
IF( vc.numcolors .GT. 2 ) dummy = setcolor( ifont )
|
||||
CALL setgtextvector( 1, 0 )
|
||||
CALL outgtext( face(ifont))
|
||||
CALL setgtextvector( 0, 1 )
|
||||
CALL outgtext( face(ifont))
|
||||
CALL setgtextvector( -1, 0 )
|
||||
CALL outgtext( face(ifont))
|
||||
CALL setgtextvector( 0, -1 )
|
||||
CALL outgtext( face(ifont))
|
||||
ELSE
|
||||
CALL outtext( 'Error: cannot set font' )
|
||||
END IF
|
||||
READ (*,*)
|
||||
END DO
|
||||
CALL unregisterfonts()
|
||||
dummy = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
75
Microsoft Fortran v51/SOURCE/SAMPLES/GRAPHIC.FOR
Normal file
75
Microsoft Fortran v51/SOURCE/SAMPLES/GRAPHIC.FOR
Normal file
@ -0,0 +1,75 @@
|
||||
CC GRAPHIC.FOR - Displays every graphics mode.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 key
|
||||
EXTERNAL printmenu
|
||||
EXTERNAL showmode
|
||||
|
||||
CALL printmenu( key )
|
||||
DO WHILE( key .NE. 0 )
|
||||
CALL showmode( key )
|
||||
END DO
|
||||
END
|
||||
|
||||
|
||||
|
||||
SUBROUTINE printmenu( key )
|
||||
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 dummy, key
|
||||
|
||||
key = -1
|
||||
DO WHILE( (key .LT. 0) .OR. (key .GT. 12) )
|
||||
dummy = setvideomode( $DEFAULTMODE )
|
||||
WRITE (*, 9000)
|
||||
READ (*,*) key
|
||||
END DO
|
||||
|
||||
9000 FORMAT( ' Please ENTER a graphics mode.' /
|
||||
+ ' (To exit, ENTER 0.)' /// ' 0 Exit' /
|
||||
+ ' 1 MRES4COLOR' / ' 2 MRESNOCOLOR' /
|
||||
+ ' 3 HRESBW' / ' 4 HERCMONO' /
|
||||
+ ' 5 MRES16COLOR' / ' 6 HRES16COLOR' /
|
||||
+ ' 7 ERESNOCOLOR' / ' 8 ERESCOLOR' /
|
||||
+ ' 9 VRES2COLOR' / ' 10 VRES16COLOR' /
|
||||
+ ' 11 MRES256COLOR' / ' 12 ORESCOLOR' / )
|
||||
|
||||
END
|
||||
|
||||
|
||||
SUBROUTINE showmode( which )
|
||||
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 which, dummy, i, height, width
|
||||
INTEGER*2 modes(12) /
|
||||
+ $MRES4COLOR , $MRESNOCOLOR, $HRESBW , $HERCMONO ,
|
||||
+ $MRES16COLOR, $HRES16COLOR, $ERESNOCOLOR , $ERESCOLOR ,
|
||||
+ $VRES2COLOR , $VRES16COLOR, $MRES256COLOR, $ORESCOLOR /
|
||||
|
||||
RECORD /videoconfig/ screen
|
||||
|
||||
IF( setvideomode( modes(which) ) .NE. 0 ) THEN
|
||||
CALL getvideoconfig( screen )
|
||||
width = screen.numxpixels / screen.numcolors
|
||||
height = screen.numypixels / 2
|
||||
DO i = 0, screen.numcolors - 1
|
||||
dummy = setcolor( INT4( i ) )
|
||||
dummy = rectangle( $GFILLINTERIOR, i * width, 0,
|
||||
+ ( i + 1 ) * width, height )
|
||||
END DO
|
||||
ELSE
|
||||
WRITE (*, 9000)
|
||||
END IF
|
||||
|
||||
READ (*,*) ! Wait for ENTER key to be pressed
|
||||
dummy = setvideomode( $DEFAULTMODE )
|
||||
CALL printmenu( which )
|
||||
|
||||
9000 FORMAT ( ' Video mode is not available.' /
|
||||
+ ' Please press ENTER. ' \ )
|
||||
|
||||
END
|
||||
63
Microsoft Fortran v51/SOURCE/SAMPLES/HORIZON.FOR
Normal file
63
Microsoft Fortran v51/SOURCE/SAMPLES/HORIZON.FOR
Normal file
@ -0,0 +1,63 @@
|
||||
CC HORIZON.FOR - Illustrates VGA graphics with cycling of 256 colors.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 MYRED, MYBLU, MYWHT, STEP
|
||||
PARAMETER ( MYRED = #000003FF )
|
||||
PARAMETER ( MYBLU = #003F0000 )
|
||||
PARAMETER ( MYWHT = #003F3F3F )
|
||||
PARAMETER ( STEP = 21 )
|
||||
|
||||
INTEGER*2 dummy, i, j
|
||||
INTEGER*4 rainbow(0:511), col, ngray
|
||||
RECORD /rccoord/ curpos
|
||||
RECORD /xycoord/ xy
|
||||
|
||||
C
|
||||
C Check to see if adapter can handle 256 colors.
|
||||
C
|
||||
IF( setvideomode( $MRES256COLOR ) .EQ. 0 )
|
||||
+ STOP 'This program requires a VGA card.'
|
||||
C
|
||||
C Create the colors.
|
||||
C
|
||||
DO col = 0, 63
|
||||
ngray = (col .OR. ISHFT( col,8 )) .OR. ISHFT( col,16 )
|
||||
rainbow(col) = MYBLU .AND. ngray
|
||||
rainbow(col + 256) = rainbow(col)
|
||||
rainbow(col + 64) = MYBLU .OR. ngray
|
||||
rainbow(col + 64 + 256) = rainbow(col + 64)
|
||||
rainbow(col + 128) = MYRED .OR.
|
||||
+ ( MYWHT .AND. .NOT. ngray )
|
||||
rainbow(col + 128 + 256) = rainbow( 64 + 128)
|
||||
rainbow(col + 192) = MYRED .AND. .NOT. ngray
|
||||
rainbow(col + 192 + 256) = rainbow(col + 192)
|
||||
END DO
|
||||
CALL setvieworg( 160, 85, xy )
|
||||
C
|
||||
C Draw shapes on screen.
|
||||
C
|
||||
DO i = 0, 254
|
||||
dummy = setcolor( INT4( 255 - i ) )
|
||||
CALL moveto( i, i - 255, xy )
|
||||
dummy = lineto( -i, 255 - i )
|
||||
CALL moveto( -i, i - 255, xy )
|
||||
dummy = lineto( i, 255 - i )
|
||||
dummy = ellipse( $GBORDER, -i, -i / 2, i, i / 2 )
|
||||
END DO
|
||||
C
|
||||
C Cycle through the colors.
|
||||
C
|
||||
i = 0
|
||||
DO j = 1, 256
|
||||
dummy = remapallpalette( rainbow(i) )
|
||||
i = MOD( i + STEP, 256 )
|
||||
END DO
|
||||
|
||||
dummy = settextcolor( 15 )
|
||||
CALL settextposition( 25, 1, curpos )
|
||||
CALL outtext( 'Press ENTER to exit' )
|
||||
READ (*,*)
|
||||
dummy = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
134
Microsoft Fortran v51/SOURCE/SAMPLES/MAGNIFY.FOR
Normal file
134
Microsoft Fortran v51/SOURCE/SAMPLES/MAGNIFY.FOR
Normal file
@ -0,0 +1,134 @@
|
||||
CC MAGNIFY.FOR - Illustrates translation between window and view
|
||||
CC coordinate systems using the following functions:
|
||||
CC getphyscoord getviewcoord getviewcoord_w
|
||||
CC getwindowcoord lineto moveto
|
||||
CC rectangle rectangle_w settextposition
|
||||
CC setwindow setviewport
|
||||
CC
|
||||
CC Although not all illustrated here, functions ending in _w
|
||||
CC are similar to rectangle_w.
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
INTEGER*2 status, rseed, j, k, m, n
|
||||
INTEGER*2 coord(3,2,2), fill(2)
|
||||
INTEGER*4 i
|
||||
REAL*4 rand
|
||||
DOUBLE PRECISION x(2), y(2)
|
||||
CHARACTER*18 text
|
||||
RECORD / xycoord / xy, xy1
|
||||
RECORD / wxycoord / wxy
|
||||
RECORD / rccoord / curpos
|
||||
RECORD / videoconfig / vc
|
||||
DATA text / 'magnification: 1x' /
|
||||
DATA fill / $GFILLINTERIOR, $GBORDER /
|
||||
|
||||
C
|
||||
C Find graphics mode.
|
||||
C
|
||||
IF( setvideomode( $MAXRESMODE ) .EQ. 0 )
|
||||
+ STOP 'Error: cannot set graphics mode'
|
||||
CALL getvideoconfig( vc )
|
||||
|
||||
C
|
||||
C Find physical (pixel) coordinates for windows 1, 2, and 3.
|
||||
C
|
||||
coord(1,1,1) = vc.numxpixels * 3 / 16
|
||||
coord(1,1,2) = vc.numypixels * 7 / 32
|
||||
coord(1,2,1) = coord(1,1,1) + vc.numxpixels / 8
|
||||
coord(1,2,2) = coord(1,1,2) + vc.numypixels / 16
|
||||
coord(2,1,1) = vc.numxpixels * 9 / 16
|
||||
coord(2,1,2) = vc.numypixels * 5 / 32
|
||||
coord(2,2,1) = coord(2,1,1) + vc.numxpixels * 3 / 8
|
||||
coord(2,2,2) = coord(2,1,2) + vc.numypixels * 3 / 16
|
||||
coord(3,1,1) = 0
|
||||
coord(3,1,2) = vc.numypixels / 2
|
||||
coord(3,2,1) = vc.numxpixels - 1
|
||||
coord(3,2,2) = vc.numypixels - 1
|
||||
|
||||
C
|
||||
C Connect windows with lines.
|
||||
C
|
||||
status = setcolor( 4 )
|
||||
DO i = 1, 2
|
||||
DO j = 1, 2
|
||||
DO k = 1, 2
|
||||
CALL moveto( coord(i,j,1), coord(i,k,2), xy )
|
||||
status = lineto( coord(i + 1,j,1), coord(i + 1,k,2) )
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
C
|
||||
C Label windows and frame with rectangles.
|
||||
C
|
||||
DO i = 1, 3
|
||||
status = setcolor( i )
|
||||
row = ( coord(i,1,2) * 25 ) / vc.numypixels
|
||||
column = ( coord(i,1,1) * 80 ) / vc.numxpixels
|
||||
CALL settextposition( row, column, curpos )
|
||||
CALL outtext( text )
|
||||
text(17:17) = '3'
|
||||
|
||||
IF( i .EQ. 2 ) text(17:17) = '8'
|
||||
CALL setviewport( coord(i,1,1), coord(i,1,2) ,
|
||||
+ coord(i,2,1), coord(i,2,2) )
|
||||
CALL getviewcoord( coord(i,1,1), coord(i,1,2), xy )
|
||||
CALL getviewcoord( coord(i,2,1), coord(i,2,2), xy1 )
|
||||
status = rectangle( $GBORDER, xy.xcoord, xy.ycoord,
|
||||
+ xy1.xcoord, xy1.ycoord )
|
||||
END DO
|
||||
|
||||
C
|
||||
C Seed random number generator.
|
||||
C
|
||||
CALL GETTIM( status, status, status, rseed )
|
||||
CALL SEED( rseed )
|
||||
C
|
||||
C Get random window coordinates (x, y) for rectangles,
|
||||
C where x and y are between 0 and 1000.
|
||||
C
|
||||
DO i = 8, 15
|
||||
status = setcolor( i )
|
||||
CALL RANDOM( rand )
|
||||
x(1) = rand * 980.0
|
||||
x(2) = rand * ( 999.0 - x(1) ) + x(1)
|
||||
CALL RANDOM( rand )
|
||||
y(1) = rand * 980.0
|
||||
y(2) = rand * ( 999.0 - y(1) ) + y(1)
|
||||
k = rand + 1.5
|
||||
|
||||
C
|
||||
C Display rectangles in normal and magnified views.
|
||||
C
|
||||
DO j = 1, 3
|
||||
CALL setviewport( coord(j,1,1), coord(j,1,2) ,
|
||||
+ coord(j,2,1), coord(j,2,2) )
|
||||
status = setwindow( .TRUE., 0.0, 0.0, 1000.0, 1000.0 )
|
||||
status = rectangle_w( fill(k), x(1), y(1), x(2), y(2) )
|
||||
C
|
||||
C In last window, make rectangle sides 2 pixels wide by
|
||||
C encasing unfilled rectangles with another rectangle.
|
||||
C Convert window coords (x, y) to physical coords,
|
||||
C adjust, and translate back into window coords.
|
||||
C
|
||||
IF( (j .EQ. 3) .AND. (k .EQ. 2) ) THEN
|
||||
m = -1
|
||||
DO n = 1, 2
|
||||
CALL getviewcoord_w(x(n), y(n), xy)
|
||||
CALL getphyscoord(xy.xcoord, xy.ycoord, xy)
|
||||
CALL getviewcoord(xy.xcoord+m, xy.ycoord+m, xy)
|
||||
CALL getwindowcoord(xy.xcoord, xy.ycoord, wxy)
|
||||
x(n) = wxy.wx
|
||||
y(n) = wxy.wy
|
||||
m = 1
|
||||
END DO
|
||||
status = rectangle_w( fill(k), x(1), y(1), x(2), y(2) )
|
||||
END IF
|
||||
END DO
|
||||
END DO
|
||||
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
11
Microsoft Fortran v51/SOURCE/SAMPLES/MATLIB.DEF
Normal file
11
Microsoft Fortran v51/SOURCE/SAMPLES/MATLIB.DEF
Normal file
@ -0,0 +1,11 @@
|
||||
; MATLIB.DEF -- Definition file for MATLIB.DLL
|
||||
|
||||
LIBRARY MATLIB
|
||||
DESCRIPTION 'DLL for MTRX_WD program'
|
||||
APPLOADER '__MSLANGLOAD'
|
||||
EXETYPE WINDOWS 3.0
|
||||
CODE PRELOAD MOVEABLE DISCARDABLE
|
||||
DATA PRELOAD MOVEABLE SINGLE
|
||||
HEAPSIZE 1024
|
||||
EXPORTS MultMatrices
|
||||
WEP
|
||||
20
Microsoft Fortran v51/SOURCE/SAMPLES/MATLIB.FOR
Normal file
20
Microsoft Fortran v51/SOURCE/SAMPLES/MATLIB.FOR
Normal file
@ -0,0 +1,20 @@
|
||||
C
|
||||
C Multiply the matrices
|
||||
C
|
||||
|
||||
SUBROUTINE MultMatrices( rows, prods, cols, a, b, c [REFERENCE])
|
||||
|
||||
INTEGER*2 i, j, k, rows, prods, cols
|
||||
REAL*8 a(rows, prods), b(prods, cols), c(rows, cols)
|
||||
|
||||
DO 3000, j = 1, cols
|
||||
DO 3100, i = 1, rows
|
||||
c(i, j) = 0.0
|
||||
DO 3200, k = 1, prods
|
||||
c(i, j) = c(i, j) + (a(i, k) * b(k, j))
|
||||
3200 CONTINUE
|
||||
3100 CONTINUE
|
||||
3000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
57
Microsoft Fortran v51/SOURCE/SAMPLES/MKFDLL.CMD
Normal file
57
Microsoft Fortran v51/SOURCE/SAMPLES/MKFDLL.CMD
Normal file
@ -0,0 +1,57 @@
|
||||
@echo off
|
||||
setlocal
|
||||
if %1.==. goto Message
|
||||
set DESTIN=%1
|
||||
set FDLL=%2
|
||||
if %2.==. set FDLL=FRTLIB
|
||||
if not %3.==. set LIBF=%3
|
||||
if not %3.==. goto Start
|
||||
for %%A in (%LIB%) do if exist %%A\FRTEXE.OBJ set LIBF=%%A& goto Start
|
||||
echo Can't find components in LIB directory
|
||||
goto Exit
|
||||
:Start
|
||||
for %%A in (%PATH%) do if exist %%A\FL.EXE goto Skip2
|
||||
echo Can't find FL.EXE in PATH
|
||||
goto Exit
|
||||
:Skip2
|
||||
echo.
|
||||
echo Build FMTMAIN.EXE
|
||||
echo.
|
||||
echo FL -MD FMTMAIN.FOR %LIBF%\FRTEXE.OBJ %LIBF%\%FDLL%.LIB FMTMAIN.DEF
|
||||
|
||||
FL -MD FMTMAIN.FOR %LIBF%\FRTEXE.OBJ %LIBF%\%FDLL%.LIB FMTMAIN.DEF
|
||||
|
||||
echo.
|
||||
echo Build FMTDLL.DLL
|
||||
echo.
|
||||
echo FL -MD -Fe%DESTIN%\FMTDLL.DLL FMTDLL.FOR %LIBF%\FRTDLL.OBJ %LIBF%\%FDLL%.LIB FMTDLL.DEF
|
||||
|
||||
FL -MD -Fe%DESTIN%\FMTDLL.DLL FMTDLL.FOR %LIBF%\FRTDLL.OBJ %LIBF%\%FDLL%.LIB FMTDLL.DEF
|
||||
|
||||
goto Exit
|
||||
:Message
|
||||
echo This batch file demonstrates dynamic linking using Microsoft FORTRAN.
|
||||
echo It is assumed that you have built the example dynalink FORTRAN runtime
|
||||
echo library (see FDLLOBJS.CMD). Your PATH should point to a directory
|
||||
echo containing the Microsoft FORTRAN compiler and linker. Your LIB
|
||||
echo environment variable should have a pathname for OS2.LIB.
|
||||
echo.
|
||||
echo Syntax:
|
||||
echo MKFDLL destin [frtdll] [libdir]
|
||||
echo.
|
||||
echo Arguments:
|
||||
echo destin Specify destination directory (should be in LIBPATH in
|
||||
echo CONFIG.SYS) for FMTDLL.DLL. Use . for current directory.
|
||||
echo frtdll Specify the base name of the dynamically linked FORTRAN
|
||||
echo library built with FDLLOBJS.CMD. Default is FRTLIB.
|
||||
echo libdir Specify directory containing special startup object files
|
||||
echo and FORTRAN runtime imports library built with FDLLOBJS.CMD.
|
||||
echo Default is LIB environment variable
|
||||
echo.
|
||||
echo Example:
|
||||
echo MKFDLL C:\BINP MYLIB D:\LIBF
|
||||
echo Puts FMTDLL.DLL in C:\BINP. Uses a FORTRAN runtime imports library
|
||||
echo named MYLIB.LIB found in D:\LIBF and a dynalink FORTRAN runtime named
|
||||
echo MYLIB.DLL in C:\BINP. Finds support files in D:\LIBF.
|
||||
:Exit
|
||||
endlocal
|
||||
88
Microsoft Fortran v51/SOURCE/SAMPLES/MODES.FOR
Normal file
88
Microsoft Fortran v51/SOURCE/SAMPLES/MODES.FOR
Normal file
@ -0,0 +1,88 @@
|
||||
CC MODES.FOR - Illustrates configuration and text window
|
||||
CC functions including:
|
||||
CC getvideoconfig outtext settextwindow
|
||||
CC setvideomoderows setvideomode
|
||||
|
||||
INCLUDE 'FGRAPH.FI'
|
||||
INCLUDE 'FGRAPH.FD'
|
||||
|
||||
PARAMETER ( NUM_ROWS = 5 )
|
||||
PARAMETER ( NUM_MODE = 17 )
|
||||
|
||||
INTEGER*2 status, irow, x, y
|
||||
INTEGER*2 modes(NUM_MODE), rows(NUM_ROWS)
|
||||
CHARACTER*12 names(NUM_MODE), str
|
||||
RECORD / videoconfig / vc
|
||||
|
||||
DATA modes / $TEXTBW40 , $TEXTC40 , $TEXTBW80 ,
|
||||
+ $TEXTC80 , $MRES4COLOR , $MRESNOCOLOR ,
|
||||
+ $HRESBW , $TEXTMONO , $HERCMONO ,
|
||||
+ $MRES16COLOR , $HRES16COLOR , $ERESNOCOLOR ,
|
||||
+ $ERESCOLOR , $VRES2COLOR , $VRES16COLOR ,
|
||||
+ $MRES256COLOR , $ORESCOLOR /
|
||||
|
||||
DATA names / ' $TEXTBW40', ' $TEXTC40', ' $TEXTBW80',
|
||||
+ ' $TEXTC80', ' $MRES4COLOR', '$MRESNOCOLOR',
|
||||
+ ' $HRESBW', ' $TEXTMONO', ' $HERCMONO',
|
||||
+ '$MRES16COLOR', '$HRES16COLOR', '$ERESNOCOLOR',
|
||||
+ ' $ERESCOLOR', ' $VRES2COLOR', '$VRES16COLOR',
|
||||
+ '$MRES256COLOR', ' $ORESCOLOR' /
|
||||
|
||||
DATA rows / 60, 50, 43, 30, 25 /
|
||||
|
||||
status = displaycursor( $GCURSOROFF )
|
||||
C
|
||||
C Try each mode.
|
||||
C
|
||||
DO i = 1, NUM_MODE
|
||||
DO j = 1, NUM_ROWS
|
||||
C
|
||||
C Try each possible number of rows.
|
||||
C
|
||||
irow = setvideomoderows( modes(i), rows(j) )
|
||||
IF( ( irow .EQ. 0 ) .OR. (rows(j) .NE. irow) ) THEN
|
||||
GOTO 100
|
||||
ELSE
|
||||
CALL getvideoconfig( vc )
|
||||
y = (vc.numtextrows - 12) / 2
|
||||
x = (vc.numtextcols - 25) / 2
|
||||
END IF
|
||||
C
|
||||
C Use text window to place output in middle of screen.
|
||||
C
|
||||
CALL settextwindow( y, x, vc.numtextrows - y,
|
||||
+ vc.numtextcols - x - 2 )
|
||||
C
|
||||
C Display all information on the screen.
|
||||
C
|
||||
CALL outtext( 'Video mode: ' // names(i) )
|
||||
WRITE (str, '(I12)') vc.numxpixels
|
||||
CALL outtext( 'X pixels: ' // str )
|
||||
WRITE (str, '(I12)') vc.numypixels
|
||||
CALL outtext( 'Y pixels: ' // str )
|
||||
WRITE (str, '(I12)') vc.numtextcols
|
||||
CALL outtext( 'Text columns:' // str )
|
||||
WRITE (str, '(I12)') vc.numtextrows
|
||||
CALL outtext( 'Text rows: ' // str )
|
||||
WRITE (str, '(I12)') vc.numcolors
|
||||
CALL outtext( 'Colors: ' // str )
|
||||
WRITE (str, '(I12)') vc.bitsperpixel
|
||||
CALL outtext( 'Bits/pixel: ' // str )
|
||||
WRITE (str, '(I12)') vc.numvideopages
|
||||
CALL outtext( 'Video pages: ' // str )
|
||||
WRITE (str, '(I12)') vc.mode
|
||||
CALL outtext( 'Mode: ' // str )
|
||||
WRITE (str, '(I12)') vc.adapter
|
||||
CALL outtext( 'Adapter: ' // str )
|
||||
WRITE (str, '(I12)') vc.monitor
|
||||
CALL outtext( 'Monitor: ' // str )
|
||||
WRITE (str, '(I12)') vc.memory
|
||||
CALL outtext( 'Memory: ' // str )
|
||||
|
||||
READ (*,*) ! Wait for ENTER to be pressed
|
||||
100 END DO
|
||||
END DO
|
||||
|
||||
status = displaycursor( $GCURSORON )
|
||||
status = setvideomode( $DEFAULTMODE )
|
||||
END
|
||||
113
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX.FOR
Normal file
113
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX.FOR
Normal file
@ -0,0 +1,113 @@
|
||||
PROGRAM MATRIX
|
||||
C
|
||||
C This program calculates the product of two matrices. The product
|
||||
C matrix has
|
||||
C
|
||||
C - the same number of rows as the first matrix
|
||||
C - the same number of columns as the second matrix
|
||||
C
|
||||
C The number of rows in the second matrix must equal the number of
|
||||
C columns in the first matrix. This is the number of products that are
|
||||
C summed for each element in the product matrix.
|
||||
C
|
||||
|
||||
REAL*8 a[ALLOCATABLE] (:,:), b[ALLOCATABLE] (:,:),
|
||||
+ c[ALLOCATABLE] (:,:)
|
||||
INTEGER*2 rows, cols, prods
|
||||
C
|
||||
C Get dimensions of matrices
|
||||
C
|
||||
WRITE (*, '(A)' ) ' This program multiplies two matrices.'
|
||||
WRITE (*, '(A \)')
|
||||
+ ' Enter dimensions of first matrix (rows, columns): '
|
||||
READ (*, *) rows, prods
|
||||
|
||||
WRITE (*, '(A, I2, A)') ' Second matrix has ', prods, ' rows.'
|
||||
WRITE (*, '(A \)') ' Enter number of columns: '
|
||||
READ (*, *) cols
|
||||
C
|
||||
C Allocate matrices
|
||||
C
|
||||
ALLOCATE (a(rows, prods))
|
||||
ALLOCATE (b(prods, cols ))
|
||||
ALLOCATE (c(rows, cols ))
|
||||
C
|
||||
C Get matrix elements
|
||||
C
|
||||
WRITE (*, *) 'Enter first matrix'
|
||||
CALL GetMatrix (rows, prods, a)
|
||||
|
||||
WRITE (*, *) 'Enter second matrix'
|
||||
CALL GetMatrix (prods, cols, b)
|
||||
C
|
||||
C Multiply them
|
||||
C
|
||||
CALL MultMatrices(rows, prods, cols, a, b, c )
|
||||
C
|
||||
C Show results
|
||||
C
|
||||
WRITE (*, *) 'First matrix:'
|
||||
CALL ShowMatrix (rows, prods, a)
|
||||
|
||||
WRITE (*, *) 'Second matrix:'
|
||||
CALL ShowMatrix (prods, cols, b)
|
||||
|
||||
WRITE (*, *) 'Product matrix: '
|
||||
CALL ShowMatrix (rows, cols, c)
|
||||
END
|
||||
|
||||
C
|
||||
C Begin subroutines
|
||||
C
|
||||
|
||||
C
|
||||
C Get a matrix from the user
|
||||
C
|
||||
SUBROUTINE GetMatrix(rows, cols, mtrx [REFERENCE])
|
||||
INTEGER*2 rows, cols, i, j
|
||||
REAL*8 mtrx (rows, cols)
|
||||
|
||||
DO 1000, i = 1, rows
|
||||
|
||||
WRITE (*, '(A \, I2 \, A \, I2 \, A \)')
|
||||
+ ' Row ', i, ' (', cols, ' values): '
|
||||
READ (*, *) (mtrx(i,j), j = 1, cols)
|
||||
1000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
C
|
||||
C Display the matrix
|
||||
C
|
||||
SUBROUTINE ShowMatrix (rows, cols, mtrx)
|
||||
INTEGER*2 rows, cols, i, j
|
||||
REAL*8 mtrx (rows,cols)
|
||||
|
||||
DO 2000, i = 1, rows
|
||||
WRITE (*, '(A\)') ' '
|
||||
DO 2100, j = 1, cols
|
||||
WRITE (*, '(A \, F6.1\)') ' ', mtrx (i, j)
|
||||
2100 CONTINUE
|
||||
WRITE (*, *) ' '
|
||||
2000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
C
|
||||
C Multiply the matrices
|
||||
C
|
||||
|
||||
SUBROUTINE MultMatrices( rows, prods, cols, a, b, c [REFERENCE])
|
||||
|
||||
INTEGER*2 i, j, k, rows, prods, cols
|
||||
REAL*8 a(rows, prods), b(prods, cols), c(rows, cols)
|
||||
|
||||
DO 3000, j = 1, cols
|
||||
DO 3100, i = 1, rows
|
||||
c(i, j) = 0.0
|
||||
DO 3200, k = 1, prods
|
||||
c(i, j) = c(i, j) + (a(i, k) * b(k, j))
|
||||
3200 CONTINUE
|
||||
3100 CONTINUE
|
||||
3000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
116
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_W.FOR
Normal file
116
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_W.FOR
Normal file
@ -0,0 +1,116 @@
|
||||
INCLUDE 'FLIB.FI'
|
||||
|
||||
PROGRAM MTRX_W
|
||||
|
||||
INCLUDE 'FLIB.FD'
|
||||
|
||||
REAL*8 a[ALLOCATABLE] (:,:), b[ALLOCATABLE] (:,:),
|
||||
+ c[ALLOCATABLE] (:,:)
|
||||
INTEGER*2 rows, cols, prods, dummy
|
||||
|
||||
C
|
||||
C Set the About Box message
|
||||
C
|
||||
dummy = ABOUTBOXQQ ('Matrix Multiplier\r Version 1.0'C)
|
||||
C
|
||||
C Get dimensions of matrices
|
||||
C
|
||||
WRITE (*, '(A)' ) ' This program multiplies two matrices.'
|
||||
WRITE (*, '(A \)')
|
||||
+ ' Enter dimensions of first matrix (rows, columns): '
|
||||
READ (*, *) rows, prods
|
||||
|
||||
WRITE (*, '(A, I2, A)') ' Second matrix has ', prods, ' rows.'
|
||||
WRITE (*, '(A \)') ' Enter number of columns: '
|
||||
READ (*, *) cols
|
||||
C
|
||||
C Allocate matrices
|
||||
C
|
||||
ALLOCATE (a(rows, prods))
|
||||
ALLOCATE (b(prods, cols ))
|
||||
ALLOCATE (c(rows, cols ))
|
||||
C
|
||||
C Get matrix elements
|
||||
C
|
||||
CALL YIELDQQ
|
||||
|
||||
OPEN (UNIT = 10, FILE = 'USER', TITLE = 'Matrix 1')
|
||||
WRITE (10, *) 'Enter first matrix'
|
||||
CALL GetMatrix (rows, prods, a, 10)
|
||||
CLOSE (10, STATUS = 'KEEP')
|
||||
|
||||
OPEN (UNIT = 11, FILE = 'USER', TITLE = 'Matrix 2')
|
||||
WRITE (11, *) 'Enter second matrix'
|
||||
CALL GetMatrix (prods, cols, b, 11)
|
||||
CLOSE (11, STATUS = 'KEEP')
|
||||
C
|
||||
C Multiply them
|
||||
C
|
||||
CALL MultMatrices(rows, prods, cols, a, b, c )
|
||||
C
|
||||
C Show results
|
||||
C
|
||||
OPEN (UNIT = 12, FILE = 'USER', TITLE = 'Product Matrix')
|
||||
WRITE (12, *) 'Product matrix: '
|
||||
CALL ShowMatrix (rows, cols, c, 12)
|
||||
CLOSE (12, STATUS = 'KEEP')
|
||||
END
|
||||
|
||||
C
|
||||
C Begin subroutines
|
||||
C
|
||||
|
||||
C
|
||||
C Get a matrix from the user
|
||||
C
|
||||
SUBROUTINE GetMatrix(rows, cols, mtrx [REFERENCE], unitnum)
|
||||
INTEGER*2 rows, cols, i, j
|
||||
INTEGER unitnum
|
||||
REAL*8 mtrx (rows, cols)
|
||||
|
||||
DO 1000, i = 1, rows
|
||||
|
||||
WRITE (unitnum, '(A \, I2 \, A \, I2 \, A \)')
|
||||
+ ' Row ', i, ' (', cols, ' values): '
|
||||
READ (unitnum, *) (mtrx(i,j), j = 1, cols)
|
||||
1000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
C
|
||||
C Display the matrix
|
||||
C
|
||||
SUBROUTINE ShowMatrix (rows, cols, mtrx, unitnum)
|
||||
INTEGER*2 rows, cols, i, j
|
||||
INTEGER unitnum
|
||||
REAL*8 mtrx (rows,cols)
|
||||
|
||||
DO 2000, i = 1, rows
|
||||
WRITE (unitnum, '(A\)') ' '
|
||||
DO 2100, j = 1, cols
|
||||
WRITE (unitnum, '(A \, F6.1\)') ' ', mtrx (i, j)
|
||||
2100 CONTINUE
|
||||
WRITE (unitnum, *) ' '
|
||||
2000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
C
|
||||
C Multiply the matrices
|
||||
C
|
||||
|
||||
SUBROUTINE MultMatrices( rows, prods, cols, a, b, c [REFERENCE])
|
||||
|
||||
INTEGER*2 i, j, k, rows, prods, cols
|
||||
REAL*8 a(rows, prods), b(prods, cols), c(rows, cols)
|
||||
|
||||
DO 3000, j = 1, cols
|
||||
DO 3100, i = 1, rows
|
||||
c(i, j) = 0.0
|
||||
DO 3200, k = 1, prods
|
||||
c(i, j) = c(i, j) + (a(i, k) * b(k, j))
|
||||
3200 CONTINUE
|
||||
3100 CONTINUE
|
||||
3000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
24
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_WD.DEF
Normal file
24
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_WD.DEF
Normal file
@ -0,0 +1,24 @@
|
||||
; MTRX_WD.DEF
|
||||
; Module-definition file for FORTRAN QuickWin
|
||||
; program using DLL
|
||||
|
||||
NAME MTRX_WD ; application's module name
|
||||
|
||||
DESCRIPTION 'FORTRAN 5.1 QuickWin Program with DLL'
|
||||
|
||||
APPLOADER '__MSLANGLOAD' ; described in FL.DEF
|
||||
|
||||
EXETYPE WINDOWS 3.0 ; required for all Windows applications
|
||||
|
||||
STUB 'WINSTUB.EXE' ; Generates error message if application
|
||||
; is run without Windows
|
||||
|
||||
;CODE can be moved in memory and discarded/reloaded
|
||||
CODE PRELOAD MOVEABLE DISCARDABLE
|
||||
|
||||
DATA PRELOAD MOVEABLE
|
||||
|
||||
HEAPSIZE 1024
|
||||
STACKSIZE 5120 ; recommended minimum for Windows applications
|
||||
|
||||
IMPORTS MATLIB.MultMatrices
|
||||
97
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_WD.FOR
Normal file
97
Microsoft Fortran v51/SOURCE/SAMPLES/MTRX_WD.FOR
Normal file
@ -0,0 +1,97 @@
|
||||
INCLUDE 'FLIB.FI'
|
||||
|
||||
PROGRAM MTRX
|
||||
|
||||
INCLUDE 'FLIB.FD'
|
||||
|
||||
REAL*8 a[ALLOCATABLE] (:,:), b[ALLOCATABLE] (:,:),
|
||||
+ c[ALLOCATABLE] (:,:)
|
||||
INTEGER*2 rows, cols, prods, dummy
|
||||
|
||||
C
|
||||
C Set the About Box message
|
||||
C
|
||||
dummy = ABOUTBOXQQ ('Matrix Multiplier\r Version 1.0'C)
|
||||
C
|
||||
C Get dimensions of matrices
|
||||
C
|
||||
WRITE (*, '(A)' ) ' This program multiplies two matrices.'
|
||||
WRITE (*, '(A \)')
|
||||
+ ' Enter dimensions of first matrix (rows, columns): '
|
||||
READ (*, *) rows, prods
|
||||
|
||||
WRITE (*, '(A, I2, A)') ' Second matrix has ', prods, ' rows.'
|
||||
WRITE (*, '(A \)') ' Enter number of columns: '
|
||||
READ (*, *) cols
|
||||
C
|
||||
C Allocate matrices
|
||||
C
|
||||
ALLOCATE (a(rows, prods))
|
||||
ALLOCATE (b(prods, cols ))
|
||||
ALLOCATE (c(rows, cols ))
|
||||
C
|
||||
C Get matrix elements
|
||||
C
|
||||
CALL YIELDQQ
|
||||
|
||||
OPEN (UNIT = 10, FILE = 'USER', TITLE = 'Matrix 1')
|
||||
WRITE (10, *) 'Enter first matrix'
|
||||
CALL GetMatrix (rows, prods, a, 10)
|
||||
CLOSE (10, STATUS = 'KEEP')
|
||||
|
||||
OPEN (UNIT = 11, FILE = 'USER', TITLE = 'Matrix 2')
|
||||
WRITE (11, *) 'Enter second matrix'
|
||||
CALL GetMatrix (prods, cols, b, 11)
|
||||
CLOSE (11, STATUS = 'KEEP')
|
||||
C
|
||||
C Multiply them
|
||||
C
|
||||
CALL MultMatrices(rows, prods, cols, a, b, c )
|
||||
C
|
||||
C Show results
|
||||
C
|
||||
OPEN (UNIT = 12, FILE = 'USER', TITLE = 'Product Matrix')
|
||||
WRITE (12, *) 'Product matrix: '
|
||||
CALL ShowMatrix (rows, cols, c, 12)
|
||||
CLOSE (12, STATUS = 'KEEP')
|
||||
END
|
||||
|
||||
C
|
||||
C Begin subroutines
|
||||
C
|
||||
|
||||
C
|
||||
C Get a matrix from the user
|
||||
C
|
||||
SUBROUTINE GetMatrix(rows, cols, mtrx [REFERENCE], unitnum)
|
||||
INTEGER*2 rows, cols, i, j
|
||||
INTEGER unitnum
|
||||
REAL*8 mtrx (rows, cols)
|
||||
|
||||
DO 1000, i = 1, rows
|
||||
|
||||
WRITE (unitnum, '(A \, I2 \, A \, I2 \, A \)')
|
||||
+ ' Row ', i, ' (', cols, ' values): '
|
||||
READ (unitnum, *) (mtrx(i,j), j = 1, cols)
|
||||
1000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
C
|
||||
C Display the matrix
|
||||
C
|
||||
SUBROUTINE ShowMatrix (rows, cols, mtrx, unitnum)
|
||||
INTEGER*2 rows, cols, i, j
|
||||
INTEGER unitnum
|
||||
REAL*8 mtrx (rows,cols)
|
||||
|
||||
DO 2000, i = 1, rows
|
||||
WRITE (unitnum, '(A\)') ' '
|
||||
DO 2100, j = 1, cols
|
||||
WRITE (unitnum, '(A \, F6.1\)') ' ', mtrx (i, j)
|
||||
2100 CONTINUE
|
||||
WRITE (unitnum, *) ' '
|
||||
2000 CONTINUE
|
||||
RETURN
|
||||
END
|
||||
|
||||
23
Microsoft Fortran v51/SOURCE/SAMPLES/MULC.C
Normal file
23
Microsoft Fortran v51/SOURCE/SAMPLES/MULC.C
Normal file
@ -0,0 +1,23 @@
|
||||
// mulmix.c
|
||||
// Mixed-language program example for demonstrating
|
||||
// Windows support in Microsoft FORTRAN 5.1
|
||||
|
||||
#include <stdio.h>
|
||||
#ifdef NULL
|
||||
#undef NULL
|
||||
#endif
|
||||
|
||||
#include <windows.h>
|
||||
|
||||
void _fortran PRINTRESULTS( long *, long *, long * );
|
||||
|
||||
void _fortran PRINTRESULTS( long *Num1, long *Num2, long *Result )
|
||||
{
|
||||
char szBuffer[128];
|
||||
|
||||
wsprintf( szBuffer, "%ld * %ld = %ld",
|
||||
*Num1, *Num2, *Result );
|
||||
MessageBox ( NULL, szBuffer, "Result", MB_OK );
|
||||
|
||||
return;
|
||||
}
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user