 |
HP OpenVMS RTL Library (LIB$) Manual
For 2-byte opcodes, the escape code (for example, hex FD) is in the
low-order byte. You must use this argument to examine the opcode
instead of reading the bytes pointed to by instr-PC.
This is because if a debugger breakpoint has been set on the
instruction, only opcode contains the original
instruction.
instr-PC
| OpenVMS usage: |
longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference |
Value of the PC for the instruction that caused the fault. The
instr-PC argument is the address of a longword that
contains the PC value.
Note the difference between this value and the contents of the
registers array element that corresponds to the PC.
R15 of the registers array element contains the
address of the byte after the instruction that caused the fault.
PSL
| OpenVMS usage: |
longword_unsigned |
| type: |
longword (unsigned) |
| access: |
modify |
| mechanism: |
by reference |
Processor status longword (PSL) at the time of the fault. The
PSL argument is the address of a longword that
contains this PSL. Your user action routine may modify this PSL within
the restrictions of the VAX architecture.
registers
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
modify |
| mechanism: |
by reference, array reference |
Contents of registers R0 through R15 (PC) at the time of the fault but
after operand addressing-mode processing. This includes any
autoincrements or autodecrements. The registers
argument is the address of this 16-longword array. Each longword of the
registers array contains the contents of one register.
Your user action routine may modify these values. If it does, the new
values will be reflected when instruction execution continues.
To modify vector registers, execute a vector instruction. Executing a
vector instruction in the handler modifies the state of the vector
processor. The state of the vector processor is not restored when the
handler returns. This has the effect of altering the state when the
execution continues.
R15 denotes the sixteenth longword in the registers
array, which corresponds to the PC. R15 contains the address of the
next byte after the current instruction. Unless this value is modified
by your user action routine, instruction execution will resume at that
address. An exception is for the CASEB, CASEW, and CASEL instructions;
R15 contains the address of the first displacement word. For these
instructions, your user action routine must modify R15 to point to the
next instruction to execute.
Upon instruction completion, registers R0-R15 are restored from this
array. However, if signal-procedure is used to cause a
fault or if instruction restart is specified by returning LIB$_RESTART,
original-registers is used instead.
operand-count
| OpenVMS usage: |
longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference |
Number of operands in the instruction currently being decoded. The
operand-count is the address of a longword that
contains this number.
operand-types
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference, array reference |
Array of longwords, one element for each operand, that contains the
type codes for the associated operand. The
operand-types argument is the address of this array.
The operand type codes are further defined in the section called
Instruction Operand Definition Codes.
read-operand-locations
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference, array reference |
Array of longwords, one element for each operand, that contains the
addresses of the operands to be read. The
read-operand-locations argument is the address of this
array.
The address given in the array may not be the actual address of the
operand if the operand is not a memory location. If the operand is a
register, the address indicates a copy of the register values at the
time of operand evaluation. If the operand access type is ADDRESS or
FIELD and the operand is not a register, the address is the address of
the item. If the operand access type is FIELD and the operand is a
register, the address refers to the appropriate element in the
registers array. If the operand access type is BRANCH,
the address is the destination PC of the branch. For WRITE access
operands, the address value is zero.
write-operand-locations
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference, array reference |
Array of longwords, one element for each operand, that contains the
addresses of operands that are to be written. The
write-operand-locations argument is the address of
this array. If the operand access type is not MODIFY, WRITE, ADDRESS,
or FIELD, the pointer value is zero.
signal-arguments
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference, array reference |
Signal arguments list of the original exception, as passed from OpenVMS
to your condition handler and then to LIB$DECODE_FAULT. The
signal-arguments argument is the address of an array
of longwords that contains these signal arguments.
signal-procedure
| OpenVMS usage: |
procedure |
| type: |
procedure value |
| access: |
call without stack unwinding |
| mechanism: |
by reference |
Entry mask of a routine that your user action routine must call if it
wants to report an exception for the instruction that faulted. The
signal-procedure argument is the address of this entry
mask.
For further information, see the section called Call Format for a Signal Routine.
context
| OpenVMS usage: |
context |
| type: |
unspecified |
| access: |
read only |
| mechanism: |
by value |
Context in which the exception occurs, including the register and PSL
contents, to be used when calling the signal-procedure. The
context argument contains the value of this context.
unspecified-user-argument
| OpenVMS usage: |
user_arg |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by value |
Optional argument passed to LIB$DECODE_FAULT. If the argument was not
specified, the value zero is substituted. The
unspecified-user-argument argument contains the value
of this optional argument.
original-registers
| OpenVMS usage: |
vector_longword_unsigned |
| type: |
longword (unsigned) |
| access: |
modify |
| mechanism: |
by reference, array reference |
Array containing the values of registers R0 through R15 (PC) at the
time of the fault, before operand processing. The
original-registers argument is the address of this
16-longword array.
If the action routine specifies that the instruction should restart or
that a fault should be generated, the registers are restored from
original-registers. See also the description of
registers above.
Condition Values Returned from the User Action Routine
The user action routine can return the following condition values to
LIB$DECODE_FAULT:
| Condition Value |
Description |
|
SS$_CONTINUE
|
If the user action routine returns a value of SS$_CONTINUE, instruction
execution will continue as specified by the current contents of the
registers element for the PC.
|
|
SS$_RESIGNAL
|
If the user action routine returns SS$_RESIGNAL, the original exception
is resignaled, with the only changes reflected being those specified by
registers elements for R0 and R1 (which are stored in
the mechanism arguments vector), PC, and PSL. All other registers are
restored from original registers.
|
|
LIB$_RESTART
|
If the user action routine returns LIB$_RESTART, the current
instruction is restarted with registers restored from
original-registers and a PSL from
PSL. This feature is useful for writing trace handlers.
|
Call Format for a Signal Routine
Your action routine calls the signal routine using this format:
signal-procedure fault-flag ,context ,signal-arguments
|
fault-flag
| OpenVMS usage: |
mask_longword |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference |
Longword flag whose low-order bit determines whether the exception is
to be signaled as a fault or as a trap. The fault-flag
argument contains the address of this longword.
If the low-order bit of fault-flag is set to 1, the
exception is signaled as a fault. If the low-order bit of
fault-flag is set to 0, the exception is signaled as a
trap; the current contents of the registers array are
used. In either case, the current contents of PSL are
used to set the exception PSL.
context
| OpenVMS usage: |
context |
| type: |
unspecified |
| access: |
read only |
| mechanism: |
by reference |
Context in which the new exception is to occur, as passed to your user
action routine by LIB$DECODE_FAULT. The context
argument is the address of this context value.
signal-arguments
| OpenVMS usage: |
arg_list |
| type: |
longword (unsigned) |
| access: |
read only |
| mechanism: |
by reference, array reference |
Signal arguments to be used. The signal-arguments
argument is the address of an array of longwords that contains these
signal arguments.
The first longword contains the number of following longwords; the
remainder of the list contains signal names and arguments. Unlike the
signal argument list passed to a condition handler, no PC or PSL is
present.
Before the exception is signaled, the stack frames are unwound back to
the original exception. You should be careful when causing a new signal
that a loop of faults is not inadvertently generated. For example, the
condition handler that called LIB$DECODE_FAULT will usually be called
for the second signal. If the handler does not analyze the second
signal as such, it may cycle through the identical path as for the
first signal.
To resignal the current exception, have the user action routine return
a value of SS$_RESIGNAL instead of calling the signal routine (unless
you want previously called condition handlers to be called again).
Condition Values Returned
|
SS$_RESIGNAL
|
Resignal condition to next handler. The exception described by
signal-arguments was not an instruction fault handled
by LIB$DECODE_FAULT. If LIB$DECODE_FAULT can process the fault, it does
not return to its caller.
|
Condition Value Signaled
|
LIB$_INVARG
|
Invalid argument to Run-Time Library. The instruction definition
contained more than 16 operands or an operand definition contained an
invalid data type or access code. This message is signaled after the
stack frames have been unwound so that it appears to have been signaled
from a routine that was called by the instruction that faulted.
|
Example
The following Fortran example implements a simple recovery scheme for
floating underflow and overflow faults, replacing the result of the
instruction with the correctly signed, smallest possible value for
underflows or largest possible value for overflows.
|
C+
C Example condition handler and user-action routine using
C LIB$DECODE_FAULT. This example demonstrates the use of
C most of the features of LIB$DECODE_FAULT. Its purpose
C is to handle floating underflow and overflow faults,
C replacing the result of the instruction with the correctly
C signed smallest possible value for underflows, or greatest
C possible value for overflows.
C
C For simplicity, faults involving the POLYx instructions are
C not handled.
C
C***
C FIXUP_RESULT is the condition handler enabled by the program
C desiring the fixup of overflows and underflows.
C***
C-
INTEGER*4 FUNCTION FIXUP_RESULT(SIGARGS, MECHARGS)
IMPLICIT NONE
INCLUDE '($SSDEF)' ! SS$_ symbols
INCLUDE '($LIBDCFDEF)' ! LIB$DECODE_FAULT symbols
INTEGER*4 SIGARGS(1:*) ! Signal arguments list
INTEGER*4 MECHARGS(1:*) ! Mechanism arguments list
C+
C This is a sample redefinition of MULH3 instruction.
C-
BYTE OPTABLE(8) /'FD'X,'65'X, ! MULH3 opcode
1 LIB$K_DCFOPR_RH, ! Read H_floating
2 LIB$K_DCFOPR_RH, ! Read H_floating
3 LIB$K_DCFOPR_WH, ! Write H_floating
4 LIB$K_DCFOPR_END, ! End of operands
5 'FF'X,'FF'X/ ! End of instructions
INTEGER*4 LIB$DECODE_FAULT ! External function
EXTERNAL FIXUP_ACTION ! Action routine to do the fixup
C+
C Determine if the exception is one we want to handle.
C-
IF ((SIGARGS(2) .EQ. SS$_FLTOVF_F) .OR.
1 (SIGARGS(2) .EQ. SS$_FLTUND_F)) THEN
C+
C We think we can handle the fault. Call
C LIB$DECODE_FAULT and pass it the signal arguments and
C the address of our action routine and opcode table.
C-
FIXUP_RESULT = LIB$DECODE_FAULT (SIGARGS,
1 MECHARGS, %DESCR(FIXUP_ACTION),, OPTABLE)
RETURN
END IF
C+
C We can only get here if we couldn't handle the fault.
C Resignal the exception.
C-
FIXUP_RESULT = SS$_RESIGNAL
RETURN
END
C+
C User action routine to handle the fault.
C-
INTEGER*4 FUNCTION FIXUP_ACTION (OPCODE,INSTR_PC,PSL,
1 REGISTERS,OP_COUNT,
2 OP_TYPES,READ_OPS,
3 WRITE_OPS,SIGARGS,
4 SIGNAL_ROUT,CONTEXT,
5 USER_ARG,ORIG_REGS)
IMPLICIT NONE
INCLUDE '($SSDEF)' ! SS$_ definitions
INCLUDE '($PSLDEF)' ! PSL$ definitions
INCLUDE '($LIBDCFDEF)' ! LIB$DECODE_FAULT
! definitions
INTEGER*4 OPCODE ! Instruction opcode
INTEGER*4 INSTR_PC ! PC of this instruction
INTEGER*4 PSL ! Processor status
! longword
INTEGER*4 REGISTERS(0:15) ! R0-R15 contents
INTEGER*4 OP_COUNT ! Number of operands
INTEGER*4 OP_TYPES(1:*) ! Types of operands
INTEGER*4 READ_OPS(1:*) ! Addresses of read operands
INTEGER*4 WRITE_OPS(1:*) ! Addresses of write operands
INTEGER*4 SIGARGS(1:*) ! Signal argument list
INTEGER*4 SIGNAL_ROUT ! Signal routine address
INTEGER*4 CONTEXT ! Signal routine context
INTEGER*4 USER_ARG ! User argument value
INTEGER*4 ORIG_REGS(0:15) ! Original registers
C+
C Declare and initialize table of class codes for each of the
C "real" opcodes. We'll index into this by the first byte of
C one-byte opcodes, the second byte of two-byte opcodes. The
C class codes will be used in a computed GOTO (CASE). The
C codes are:
C 0 - Unsupported
C 1 - ADD
C 2 - SUB
C 3 - MUL,DIV
C 4 - ACB
C 5 - CVT
C 6 - EMOD
C
C The class mainly determines how we compute the sign of the
C result, except for ACB.
C-
BYTE INST_CLASS_TABLE(0:255)
DATA INST_CLASS_TABLE /
1 48*0, ! 00-2F
2 0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0, ! 30-3F
3 1,1,2,2,3,3,3,3,0,0,0,0,0,0,0,4, ! 40-4F
4 0,0,0,0,6,0,0,0,0,0,0,0,0,0,0,0, ! 50-5F
5 1,1,2,2,3,3,3,3,0,0,0,0,0,0,0,4, ! 60-6F
6 0,0,0,0,6,0,5,0,0,0,0,0,0,0,0,0, ! 70-7F
7 112*0, ! 80-EF
8 0,0,0,0,0,0,5,5,0,0,0,0,0,0,0,0/ ! F0-FF
C+
C Table of operand sizes in 8-bit bytes, indexed by the
C datatype code contained in the OP_TYPES array. Only floating
C types matter.
C-
BYTE OP_SIZES(9) /0,0,0,0,0,4,8,8,16/
INTEGER*4 LIB$EXTV ! External function
INTEGER*4 RESULT_NEGATIVE ! -1 if result negative,
! 0 if positive
INTEGER*4 SIGN1,SIGN2,SIGN3 ! Signs of operands
INTEGER*4 INST_BYTE ! Current opcode byte
INTEGER*4 INST_CLASS ! Class of instruction
! from table
INTEGER*4 OP_DTYPE ! Datatype of operand
INTEGER*4 OP_SIZE ! Size of operand in
! 8-bit bytes
INTEGER*4 RESULT_OP ! Position of result
! in WRITE_OPS array
LOGICAL*4 OVERFLOW ! TRUE if SS$_FLTOVF_F
LOGICAL*4 SMALLER ! Function which
! compares operands
PARAMETER ESCD = '0FD'X ! First byte of G,H instructions
INTEGER*2 SMALL_F(2) ! Smallest F_floating
DATA SMALL_F /'0080'X,0/
INTEGER*2 SMALL_D(4) ! Smallest D_floating
DATA SMALL_D /'0080'X,0,0,0/
INTEGER*2 SMALL_G(4) ! Smallest G_floating
DATA SMALL_G /'0010'X,0,0,0/
INTEGER*2 SMALL_H(8) ! Smallest H_floating
DATA SMALL_H /'0001'X,0,0,0,0,0,0,0/
INTEGER*2 BIGGEST(8) ! Biggest value (all datatypes)
DATA BIGGEST /'7FFF'X,7*'FFFF'X/
INTEGER*4 SIGNAL_ARRAY(2) ! Array for signalling new
! exception
C+
C
C NOTE: Because the operands arrays contain the locations of
C the operands, rather than the operands themselves,
C we must call a routine using the %VAL function to
C "fool" the called routine into considering the
C contents of an operands array element as the address
C of an item. This would not be necessary in a
C language that understood the concept of pointer
C variables, such as PASCAL.
C
C
C If FPD is set in the PSL, signal SS$_ROPRAND (reserved operand). In
C reality this shouldn't happen since none of the instructions we
C handle can set FPD, but do it as an example.
C-
IF (BTEST(PSL,PSL$V_FPD)) THEN
SIGNAL_ARRAY(1) = 1 ! Count of signal arguments
SIGNAL_ARRAY(2) = SS$_ROPRAND ! Error status value
CALL SIGNAL_ROUT (
1 1, ! Fault flag - signal as fault
2 SIGNAL_ARRAY, ! Signal arguments array
3 CONTEXT) ! Context as passed to us
! Call will never return
END IF
C+
C Set OVERFLOW according to the exception type. We assume that
C the only alternatives are SS$_FLTOVF_F and SS$_FLTUND_F.
C-
OVERFLOW = (SIGARGS(2) .EQ. SS$_FLTOVF_F)
C+
C Determine the datatype of the instruction by that of its
C second operand, since that is always the type of the
C destination.
C-
OP_DTYPE = IBITS(OP_TYPES(2),LIB$V_DCFTYP,LIB$S_DCFTYP)
C+
C Get the size of the datatype in words.
C-
OP_SIZE = OP_SIZES (OP_DTYPE)
C+
C Determine the class of instruction and dispatch to the
C appropriate routine.
C-
INST_BYTE = IBITS(OPCODE,0,8) ! Get first byte
IF (INST_BYTE .EQ. ESCD) INST_BYTE = IBITS(OPCODE,8,8)
INST_CLASS = INST_CLASS_TABLE(INST_BYTE)
GO TO (1000,2000,3000,4000,5000,6000),INST_CLASS
C+
C If we get here, the instruction's entry in the
C INST_CLASS_TABLE is zero. This might happen if the instruction was
C a POLYx, or was some other unsupported instruction. Resignal the
C original exception.
C-
FIXUP_ACTION = SS$_RESIGNAL ! Resignal condition to next handler
RETURN ! Return to LIB$DECODE_FAULT
C+
C 1000 - ADDF2, ADDF3, ADDD2, ADDD3, ADDG2, ADDG3, ADDH2, ADDH3
C
C Result's sign is the same as that of the first operand,
C unless this is an underflow, in which case the magnitudes of
C the values may change the sign.
C-
1000 RESULT_NEGATIVE = LIB$EXTV (15,1,%VAL(READ_OPS(1)))
IF (.NOT. OVERFLOW) THEN
IF (SMALLER(OP_SIZE,%VAL(READ_OPS(1)),
1 %VAL(READ_OPS(2))))
2 RESULT_NEGATIVE = .NOT. RESULT_NEGATIVE
END IF
GO TO 9000
C+
C 2000 - SUBF2, SUBF3, SUBD2, SUBD3, SUBG2, SUBG3, SUBH2, SUBH3
C
C Result's sign is the opposite of that of the first operand,
C unless this is an underflow, in which case the magnitudes of
C the values may change the sign.
C-
2000 RESULT_NEGATIVE = .NOT. LIB$EXTV (15,1,%VAL(READ_OPS(1)))
IF (.NOT. OVERFLOW) THEN
IF (SMALLER(OP_SIZE,%VAL(READ_OPS(1)),
1 %VAL(READ_OPS(2))))
2 RESULT_NEGATIVE = .NOT. RESULT_NEGATIVE
END IF
GO TO 9000
C+
C 3000 - MULF2, MULF3, MULD2, MULD3, MULG2, MULG3, MULH2, MULH3,
C DIVF2, DIVF3, DIVD2, DIVD3, DIVG2, DIVG3, DIVH2, DIVH3,
C
C If the signs of the first two operands are the same, then the
C result's sign is positive, if they are not it is negative.
C-
3000 SIGN1 = LIB$EXTV (15,1,%VAL(READ_OPS(1)))
SIGN2 = LIB$EXTV (15,1,%VAL(READ_OPS(2)))
RESULT_NEGATIVE = SIGN1 .XOR. SIGN2
GOTO 9000
C+
C 4000 - ACBF, ACBD, ACBG, ACBH
C
C The result's sign is the same as that of the second operand
C (addend), unless this is underflow, in which case the
C magnitudes of the addend and index may change the sign.
C We must also determine if the branch is to be taken.
C-
4000 SIGN2 = LIB$EXTV (15,1,%VAL(READ_OPS(2)))
RESULT_NEGATIVE = SIGN2
IF (.NOT. OVERFLOW) THEN
IF (SMALLER(OP_SIZE,%VAL(READ_OPS(2)),
1 %VAL(READ_OPS(3))))
2 RESULT_NEGATIVE = .NOT. RESULT_NEGATIVE
END IF
C+
C If this is overflow, then the branch is not taken, since the
C result is always going to be greater or equal in magnitude
C to the limit, and will be the correct sign. If underflow,
C the branch is ALMOST always taken. The only case where the
C branch might not be taken is when the result is exactly
C equal to the limit. For this example, we are going to ignore
C this exceptional case.
C-
IF (.NOT. OVERFLOW)
1 REGISTERS(15) = READ_OPS(4) ! Branch destination
GO TO 9000
C+
C 5000 - CVTDF, CVTGF, CVTHF, CVTHD, CVTHG
C
C Result's sign is the same as that of the first operand.
C-
5000 RESULT_NEGATIVE = LIB$EXTV (15,1,%VAL(READ_OPS(1)))
GO TO 9000
C+
C 6000 - EMODF, EMODD, EMODG, EMODH
C
C If the signs of the first and third operands are the same, then the
C result's sign is positive, else it is negative.
C-
6000 SIGN1 = LIB$EXTV (15,1,%VAL(READ_OPS(1)))
SIGN2 = LIB$EXTV (15,1,%VAL(READ_OPS(3)))
RESULT_NEGATIVE = SIGN1 .XOR. SIGN2
GOTO 9000
C+
C All code paths merge here to store the result value. We also
C set the PSL appropriately. First, determine which operand is
C the result.
C-
9000 RESULT_OP = OP_COUNT
IF (INST_CLASS .EQ. 4)
1 RESULT_OP = RESULT_OP - 1 ! ACBx
C+
C Select result based on datatype and exception type.
C-
IF (OVERFLOW) THEN
CALL LIB$MOVC3 (OP_SIZE,BIGGEST,%VAL(WRITE_OPS(RESULT_OP)))
ELSE
GO TO (9100,9200,9300,9400), OP_DTYPE-(LIB$K_DCFTYP_F-1)
C+
C Should never get here. Resignal original exception.
C-
FIXUP_ACTION = SS$_RESIGNAL
RETURN
C+
C 9100 - F_floating result
C-
9100 CALL LIB$MOVC3 (OP_SIZE,SMALL_F,%VAL(WRITE_OPS(RESULT_OP)))
GOTO 9500
C+
C 9200 - D_floating result
C-
9200 CALL LIB$MOVC3 (OP_SIZE,SMALL_D,%VAL(WRITE_OPS(RESULT_OP)))
GOTO 9500
C+
C 9300 - G_floating result
C-
9300 CALL LIB$MOVC3 (OP_SIZE,SMALL_G,%VAL(WRITE_OPS(RESULT_OP)))
GOTO 9500
C+
C 9400 - H_floating result
C-
9400 CALL LIB$MOVC3 (OP_SIZE,SMALL_H,%VAL(WRITE_OPS(RESULT_OP)))
GOTO 9500
9500 END IF
C+
C Modify the PSL to reflect the stored result. If the result was
C negative, set the N bit. Clear the V (overflow) and Z (zero) bits.
C If the instruction was an ACBx, leave the C (carry) bit unchanged,
C otherwise clear it.
C-
IF (RESULT_NEGATIVE) THEN
PSL = IBSET (PSL,PSL$V_N) ! Set N bit
ELSE
PSL = IBCLR (PSL,PSL$V_N) ! Clear N bit
END IF
PSL = IBCLR (PSL,PSL$V_V) ! Clear V bit
PSL = IBCLR (PSL,PSL$V_Z) ! Clear Z bit
IF (INST_CLASS .NE. 4)
1 PSL = IBCLR (PSL,PSL$V_C) ! Clear C bit if not ACBx
C+
C Set the sign of result.
C-
IF (RESULT_NEGATIVE)
1 CALL LIB$INSV (1,15,1,%VAL(WRITE_OPS(RESULT_OP)))
C+
C Fixup is complete. Return to LIB$DECODE_FAULT.
C-
FIXUP_ACTION = SS$_CONTINUE
RETURN
END
C+
C Function which compares two floating values. It returns .TRUE. if
C the first argument is smaller in magnitude than the second.
C-
LOGICAL*4 FUNCTION SMALLER(NBYTES,VAL1,VAL2)
INTEGER*4 NBYTES ! Number of bytes in values
INTEGER*2 VAL1(*),VAL2(*) ! Floating values to compare
INTEGER*4 WORDA,WORDB
SMALLER = .TRUE. ! Initially return true
C+
C Zero extend to a longword for unsigned compares.
C Compare first word without sign bit.
C-
WORDA = IBCLR(ZEXT(VAL1(1)),15)
WORDB = IBCLR(ZEXT(VAL2(1)),15)
IF (WORDA .LT. WORDB) RETURN
DO I=2,NBYTES/2
WORDA = ZEXT(VAL1(I))
WORDB = ZEXT(VAL2(I))
IF (WORDA .LT. WORDB) RETURN
END DO
SMALLER = .FALSE. ! VAL1 not smaller than VAL2
RETURN
END
|
|
