Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/formsc.mac
There are 19 other files named formsc.mac in the archive. Click here to see a list.
TITLE FORDBM %.4C(475) - DUMMY DBMS% FOR FORLIB
SUBTTL Mike Gilbert/JNG 22-Nov-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1975,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM ;GET FOROTS SYMBOLS
SEGMENT ;PUT INTO THE HIGH SEGMENT
ENTRY DBMS% ;IN CASE REAL DBPORT NOT IN FORLIB
DBMS%: SETZ 0, ;INDICATE ERROR TO DBMS ROUTINES
POPJ P,
PRGEND
TITLE .MXFOR FOR FORTRAN-10 & F40 SUBROUTINES
SUBTTL D.M. NIXON 23-OCT-73
;LINK-10 IF REQUESTED TO, WILL CHANGE ALL FORTRAN ENTRY POINTS TO
; CAIA
; PUSHJ 17,.MXFOR## ;F40 ENTRY
; PUSHJ 17,.SAV15## ;FORTRAN-10 ENTRY
;
;THESE ROUTINES ALLOW ALL COMBINATIONS OF F40 AND FORTRAN-10
;MAIN PROGRAMS AND SUBROUTINES TO BE LOADED AND RUN TOGETHER.
;.JRA16## HANDLES MULTIPLE RETURNS
ENTRY .MXFOR
<SIXBIT /.MXFOR/>
.MXFOR: POP 17,TEMP# ;POP RETURN OFF STACK
AOS TEMP# ;SKIP RETURN (OVER PUSHJ CALL)
PUSH 17,[0] ;INCASE NEW STYLE MULTIPLE RETURNS
PUSH 17,15 ;INCASE FORTRAN-10
PUSHJ 17,@TEMP# ;AND GO TO REQUIRED ROUTINE
CAIA ;SINGLE RETURN
JRST MULRET ;MULTIPLE RETURN
POP 17,15 ;RESTORE AC15
SKIPE 0(17) ;NON-ZERO FOR MULTIPLE RETURN
HRR 16,0(17) ;SO GET RETURN ADDRESS
POP 17,(17) ;RESTORE STACK
HLRM 16,.+3 ;STORE THE ENTRY POINT
HRLI 16,(CAIA) ;SET UP THE SKIP INS
HRRM 16,.+2 ;STORE THE RETURN ADDRESS
EXCH 16,.-. ;RESTORE 16 AND THE SKIP INS
JRST .-. ;RETURN TO THE CALLER
MULRET: POP 17,15 ;RESTORE AC15
POP 17,(17) ;RESTORE STACK
HLRM 16,.+3 ;STORE THE ENTRY POINT
HRLI 16,(CAIA) ;SET UP THE SKIP INS
HRRM 16,.+2 ;STORE THE RETURN ADDRESS
EXCH 16,.-. ;RESTORE 16 AND THE SKIP INS
JRST @.-. ;RETURN TO THE CALLER
ENTRY .SAV15
SIXBIT /.SAV15/
.SAV15: POP 17,TEMP# ;GET RETURN OFF STACK
PUSH 17,15 ;SAVE AC 15
PUSHJ 17,@TEMP# ;GO TO REQUIRED ROUTINE
CAIA ;SINGLE RETURN
JRST [POP 17,15 ;RESTORE AC 15
POP 17,(17) ;RESTORE STACK
JRST @(16)] ;RETURN TO USER
POP 17,15 ;RESTORE 15
POPJ 17, ;RETURN
ENTRY .JRA16
SIXBIT /.JRA16/
.JRA16: AOS 0(17) ;RETURN TO MULTIPLE RETURN ADDRESS
POPJ 17, ;GO TO IT
IF2,<PURGE TEMP,MULRET>
PRGEND
UNIVERSAL FORMSC %4.(120) UNIVERSAL FILE TO ASSEMBLE THE FIX/FLOAT FUNCTIONS
SUBTTL D. TODD /DRT 15-FEB-1973
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
IF1,< ;PASS 1 ASSEMBLY ONLY
DEFINE FLT(X)<
ENTRY FLT.'X
SIXBIT /FLT.'X/
FLT.'X:
IFE CPU-KA10,<
HLRE X+1,X ;COPY THE HI HALT OF X TO LOW X+1
HLL X,X+1 ;FILL UPPER PART OF X WITH THE SIGH
FSC X,233 ;FLOAT THE LOW HALT OF THE INTEGER
SKIPGE X ;FOR NEGATIVE NUMBERS
AOJE X+1,FLT.XT ;CHANGE HIGH PART TO 2'S COMPLEMENT
FSC X+1,255 ;FLOAT THE HIGH PART
FADR X,X+1 ;COMBINE THE TWO PARTS
>
IFE CPU-KI10,<
FLTR X,X ;USE THE HARDWARE
>
FLT.XT: POPJ P, ;RETURN X=THE FLOATING POINT NUMBER
>
DEFINE IFX(X)<
ENTRY IFX.'X
SIXBIT /IFX.'X/
IFX.'X:
IFE CPU-KA10,<
MULI X,400 ;SEPERATE THE FRACTION AND EXPONENT
EXCH X,X+1 ;PUT PARTICAL RESULT IN X
JUMPGE X+1,IFX.XT ;JUMP IF POSITIVE
TRC X+1,-1 ;NEGATE THE EXPONENT
MOVNS X ;POSITIVE FRACTION
IFX.XT: ASH X,-243(X+1) ;USE EXPONENT AS INDEX
SKIPGE X+1 ;SKIP IF POSITIVE
MOVNS X ;NEGATE THE RESULT
>
IFE CPU-KI10,<
FIX X,X
>
POPJ P, ;RETRURN X=FIXED NUMBER
>
> ;END OF IF1,
PRGEND
TITLE FLOAT %4.(235) INTEGER TO REAL CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY FLOAT
EXTERN FLOAT.
FLOAT=FLOAT.
PRGEND
TITLE FLOAT. %4.(235) INTEGER TO REAL CONVERSION
SUBTTL D. TODD /DRT 15-FEB-1973
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V32.(415)
;36 BIT FLOAT FUNCTION
;CONVERTS A SIGNED FIXED POINT INTEGER TO FLOATING POINT
;BY BREAKING THE INTEGER INTO HIGH ORDER AND LOW ORDER
;FRACTIONS, CALCULATING AN EXPONENT, THEN ADDING THE TWO
;TOGETHER. SINGLE CONVERSION.
;THE ROUTINE IS CALLED AS FOLLOWS:
; JSA Q, FLOAT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (FLOAT,.) ;[235] ENTRY TO FLOAT ROUTINE
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST FLT.0## ;USE FLT.0 ROUTINE
PRGEND
TITLE IFIX %4.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY IFIX
EXTERN IFIX.
IFIX=IFIX.
PRGEND
TITLE INT %4.(235) REAL TO INTEGER CONVERSION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY INT
EXTERN INT.
INT=INT.
PRGEND
TITLE IFIX. %4.(235) REAL TO INTEGER CONVERSION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK/TWE/DMN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(415)
;36 BIT FIX FUNCTION
;AN INTEGER RESULT IS OBTAINED BY SEPARATING FRACTION AND
;EXPONENT. THE FRACTION IS SHIFTED N PLACES RIGHT, WHERE
;N = 43 - (EXPONENT-200) (OCTAL)
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; JSA Q, IFIX
; EXP ARG
;OR
; JSA Q,INT
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (INT,.) ;[235] ENTRY TO INT ROUTINE.
JRST IFIX1 ;GO TO MAIN ROUTINE.
HELLO (IFIX,.) ;[235] ENTRY TO IFIX ROUTINE
IFIX1:
MOVE T0,@(L) ;GET THE ARGUMENT
PJRST IFX.0## ;USE IFX.0
PRGEND
TITLE FLT.0
SEARCH FORMSC,FORPRM
FLT 0
PRGEND
TITLE FLT.1
SEARCH FORMSC,FORPRM
FLT 1
PRGEND
TITLE FLT.2
SEARCH FORMSC,FORPRM
FLT 2
PRGEND
TITLE FLT.3
SEARCH FORMSC,FORPRM
FLT 3
PRGEND
TITLE FLT.4
SEARCH FORMSC,FORPRM
FLT 4
PRGEND
TITLE FLT.5
SEARCH FORMSC,FORPRM
FLT 5
PRGEND
TITLE FLT.6
SEARCH FORMSC,FORPRM
FLT 6
PRGEND
TITLE FLT.7
SEARCH FORMSC,FORPRM
FLT 7
PRGEND
TITLE FLT.10
SEARCH FORMSC,FORPRM
FLT 10
PRGEND
TITLE FLT.11
SEARCH FORMSC,FORPRM
FLT 11
PRGEND
TITLE FLT.12
SEARCH FORMSC,FORPRM
FLT 12
PRGEND
TITLE FLT.13
SEARCH FORMSC,FORPRM
FLT 13
PRGEND
TITLE FLT.14
SEARCH FORMSC,FORPRM
FLT 14
PRGEND
TITLE FLT.15
SEARCH FORMSC,FORPRM
FLT 15
PRGEND
TITLE IFX.0
SEARCH FORMSC,FORPRM
IFX 0
PRGEND
TITLE IFX.1
SEARCH FORMSC,FORPRM
IFX 1
PRGEND
TITLE IFX.2
SEARCH FORMSC,FORPRM
IFX 2
PRGEND
TITLE IFX.3
SEARCH FORMSC,FORPRM
IFX 3
PRGEND
TITLE IFX.4
SEARCH FORMSC,FORPRM
IFX 4
PRGEND
TITLE IFX.5
SEARCH FORMSC,FORPRM
IFX 5
PRGEND
TITLE IFX.6
SEARCH FORMSC,FORPRM
IFX 6
PRGEND
TITLE IFX.7
SEARCH FORMSC,FORPRM
IFX 7
PRGEND
TITLE IFX.10
SEARCH FORMSC,FORPRM
IFX 10
PRGEND
TITLE IFX.11
SEARCH FORMSC,FORPRM
IFX 11
PRGEND
TITLE IFX.12
SEARCH FORMSC,FORPRM
IFX 12
PRGEND
TITLE IFX.13
SEARCH FORMSC,FORPRM
IFX 13
PRGEND
TITLE IFX.14
SEARCH FORMSC,FORPRM
IFX 14
PRGEND
TITLE IFX.15
SEARCH FORMSC,FORPRM
IFX 15
PRGEND
TITLE ADJ1. %4.(142)
SEARCH FORPRM
;AC ASSIGNMENTS
ARG==L ;ARG POINTER
TEMOFF==T0 ;HOLDS OFFSET COMPUTATION
;T1==1 ;HOLDS LOOP DOUNTER (DIMENSIONALITY)
;T2==2 ;HOLDS MULTIPLIER COMPUTED
TABREG==T3 ;HOLDS DESTROYED ARG POINTER
;THE FOLLOWING ALGORITHM IS IMPLEMENTED TO
;COMPUTE ARRAY FACTORS, OFFSET AND SIZE FOR THE
;SPECIAL CASE WHEN ALL LOWER BOUNDS ARE A
;CONSTANT 1 AND ALL DIMENSIONS ARE ADJUSTABLE.
;MULT(I) ARE MULTIPLIERS
;U(I) ARE UPPER BOUNDS (EQUIVALENT TO RANGE)
;OFFSET=MULT(1)
;ARRAYSIZ=MULT(1)
;DO 10 I=2,NUMBER OF DIMENSIONS-1
;ARRAYSIZ=ARRAYSIZ*U(I-1)
;MULT(I)=MULT(I-1)*U(I-1)
;OFFSET=OFFSET+MULT(I)
;10 CONTINUE
;OFFSET=-OFFSET+BASE ADDRESS OF ARRAY
;THE PARAMTERS PASSED ARE (INORDER):
;POINTER TO NUMBER OF DIMENSIONS
;POINTER TO TEMP FOR ARRAYSIZ
;BASE ADDRESS OF ARRAY
;POINTER TO TEMP FOR OFFSET
;MULT(1)
;U(1)
;MULT(2)
;U(2)
; .
; .
; .
;MULT(N)
;U(N)
;**NOTE THAT THE DOUBLE PRECISION/SINGLE PRECISION
;IS HANDLED BY PASSING A 2/1 AS MULT(1).
HELLO (ADJ1.)
PUSH P,T2 ;SAVE REGISTERS USED
PUSH P,TABREG ;
MOVE T1,@0(ARG) ;FETCH DIMENSIONALITY
MOVE TABREG,ARG ;COPY ARG REGISTER
MOVE TEMOFF,@4(ARG) ;GET OFFSET WITH MULT(1)
MOVE T2,TEMOFF ;GET MULT(1) WITH MULT(1)
MOVEM T2,@1(ARG) ;INITIALIZE ARRAYSIZ
LOOP1: SOJLE T1,LUPDUN ;QUIT IF DONE
MOVE T2,@5(TABREG) ;FETCH U(I-1)
IMULM T2,@1(ARG) ;MULTIPLY INTO ARRAYSIZ
IMUL T2,@4(TABREG) ;MULT BY MULT(I-1)
MOVEM T2,@6(TABREG) ;FORMING MULT(I)
ADDI TEMOFF,0(T2) ;KEEP SUM OF OFFSET FACTORS
ADDI TABREG,2 ;ADVANCE POINTER
JRST LOOP1 ;GO AROUND AGAIN
LUPDUN: MOVN TEMOFF,TEMOFF ;NEGATE OFFSET
ADDI TEMOFF,@2(ARG) ;ADD ARRAY BASE ADDRESS
MOVEM TEMOFF,@3(ARG) ;STORE VALUE OF OFFSET
MOVE T2,@5(TABREG) ;FETCH U(I) FOR LAST ARRAYSIZE MULTIPLY
IMULM T2,@1(ARG) ;MULTIPLY TO MEM IT IN
POP P,TABREG ;RESTORE REGISTERS
POP P,T2
GOODBY
PRGEND
TITLE ADJG. %4.(324)
;REVISION HISTORY
;----------------
;EDIT SPR COMMENT
;---- --- -------
;
SEARCH FORPRM
;AC ASSIGNMENTS
ARG==L ;ARGUMENT LIST
TEMOFF==T0 ;USED TO COMPUTE OFFSET
;T1==1 ;USED TO HOLD LOOP COUNT (DIMENSIONALITY)
;T2==2 ;USED TO HOLD MULTIPLIERS
TABREG==T3 ;USED TO HOLD DESTROYED ARG PTR
;THE FOLLOWING ALGORITHM IS IMPLEMENTED TO COMPUTE
;ARRAY FACTORS AND OFFSET AND SIZE FOR THE
;GENERAL CASE.
;A PARTIALLY COMPUTED OFFSET MAY BE INPUT
;THE ALGORITHM MAY START IN AN ARBITRARY PLACE AND MULT(1)
;MAY BE 1 (STARTING FROM SCRATCH) OR ANOTHER VALUE.
;THE ABILITY TO START ANYWHERE IS NECESSARY SINCE
;FACTOR AND OFFSET INFO MAY ALREADY HAVE BEEN
;COMPUTED FOR CONSTANT ARRAY BOUNDS APPEARING IN THE
;LIST FIRST.
;MULT(I) ARE THE FACTORS
;U(I) ARE THE UPPER BOUNDS
;L(I) ARE THE LOWER BOUNDS
;OFFSET=MULT(1)*L(1)
;ARRAYSIZ=MULT(1)
;DO 10 I=2,NUMBER OF DIMENSIONS-1
;TEMP=U(I-1)-L(I-1)+1
;MULT(I)=MULT(I-1)*TEMP
;OFFSET=OFFSET+MULT(I)
;ARRAYSIZ=ARRAYSIZ*TEMP
;10 CONTINUE
;OFFSET=-OFFSET+BASE ADDRESS OF ARRAY
;TEMP=U(I)-L(I)+1
;ARRAYSIZ=ARRAYSIZ*TEMP
;THE PARAMTERS ARE (IN ORDER OF APPEARANCE)
;POINTER TO NUMBER OF DIMENSIONS
;POINTER TO ARRAY SIZE
;BASE ADDRESS OF ARRAY
;POINTER TO TEMP CONTAINING OFFSET
;MULT(1)
;U(1)
;L(1)
;MULT(2)
;U(2)
;L(2)
; .
; .
; .
;MULT(N)
HELLO (ADJG.)
PUSH P,T2 ;SAVE REGISTERS USED
PUSH P,TABREG ;
MOVE T1,@0(ARG) ;FETCH DIMENSIONALITY
MOVE TABREG,ARG ;COPY ARG REGISTER
SETZ TEMOFF, ;[324] CLEAR OFFSET
MOVE T2,@4(ARG) ;MULT(1) - (PASSED IN)
MOVEM T2,@1(ARG) ;INITIALIZE ARRAYSIZ
LOOP1: IMUL T2,@6(TABREG) ;MULT(1)*L(1)
ADDI TEMOFF,0(T2) ;ADD TO INITIAL OFFSET
SOJLE T1,LUPDUN ;QUIT IF DONE
MOVE T2,@5(TABREG) ;U(I-1)
SUB T2,@6(TABREG) ;MINUS L(I-1)
ADDI T2,1 ;PLUS 1
IMULM T2,@1(ARG) ;MULTIPLY INTO ARRAYSIZ
IMUL T2,@4(TABREG) ;TIMES MULT(I-1)
MOVEM T2,@7(TABREG) ;EQUALS MULT(I)
ADDI TABREG,3 ;INCREMENT TO NEXT BUNCH
JRST LOOP1 ;GO AROUND AGAIN
LUPDUN: MOVN TEMOFF,TEMOFF ;NEGATE OFFSET
ADDI TEMOFF,@2(ARG) ;ADD BASE ADDRESS OF ARRAY
MOVEM TEMOFF,@3(ARG) ;STOR OFFSET
MOVE T2,@5(TABREG) ;GET U(I) FOR LAST ARRAYSIZ MULT
SUB T2,@6(TABREG) ;-L(I)
ADDI T2,1 ;ADD ONE OF COURSE
IMULM T2,@1(ARG) ;MULT AND STACH IN ARRAY SIZE
POP P,TABREG ;RESTORE REGISTERS USED
POP P,T2
GOODBY
PRGEND
TITLE ADJ. %4.(120) ;FROM LIB40 VERSION V.032(323) VARIABLE DIMENSION SUBSCRIPT CALCULATOR
SUBTTL D. TODD /DRT 15-FEB-1973 TOM OSTEN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;ADJ. IS A PROGRAM CALLED AT RUN-TIME BY A FORTRAN PROGRAM
;TO CALCULATE THE MULTIPLIERS AND OFFSET FOR SUBSCRIPT CALCULATIONS
;FOR DIMENSIONS DECLARED AS SUBROUTINE ARGUMENTS. THE COMPILER
;GENERATES THE FOLLOWING SEQUENCE:
; JSA 16, ADJ.
; EXP N ;DIMENSIONALITY OF ARRAY
; ARG X, TEMP+N+1 ;ARG IS A NO-OP, X IS THE TYPE
;OF THE ARGUMENT,TEMP IS A PNTR
;TYPE,TEMP+N+1 POINTS TO END OF
;MULTIPLIER TABLE
; EXP U1 ;ADDRESS OF NUMBER WHICH IS THE
; ;UPPER BOUND FOR FIRST SUBSCRIPT
; EXP L1 ;ADDRESS OF NUMBER WHICH IS THE
; ;LOWER BOUND FOR FIRST SUBSCRIPT
; .
; .
; .
; EXP LN ;LAST LOWER BOUND ADDRESS
;THE TEMP BLOCK IS CONSTRUCTED AS FOLLOWS:
;TEMP: SIZE OF ARRAY (EQUAL TO MULTIPLIER N)
; OFFSET
; MULTIPLIER N-1
; .
; .
; .
; MULTIPLIER 1
; MULTIPLIER 0
;THE I-TH MULTIPLIER, P(I), IS DESCRIBED BY:
; P(0) = 1
; P(I) = P(I-1) * (U(I) - L(I) + 1)
;THE OFFSET IS DESCRIBED BY
; OFFSET = SUM FROM 1 TO N OF P(I-1)*L(I)
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (ADJ.) ;ENTRY TO ADJ. ROUTINE
MOVEM 2,SAV2 ;SAVE AC 2
LDB C,[POINT 3,1(Q),11] ;GET HI 3 BITS OF ARG TYPE
SUBI C,3 ;0 RESULT MEANS D.P. OR COMPLEX
MOVEM C,ACFLD ;SAVE THE RESULT
MOVNI C, @(Q) ;GET MINUS COUNT OF DIMENSIONS
MOVEI B, @1(Q) ;GET TOP ADDRESS OF TEMP BLOCK
ADDI B, -1(C) ;SET B BACK TO BEGINNING OF TEMP BLOCK
HRL B, C ;AOBJN WORD IS (-CNT)ADDR
MOVEI A, 1 ;INITIALIZE P(0) = 1
SETZM OFFSET ;INITIALIZE OFFSET=0
ADJ.1: MOVEM A, (B) ;STORE P(N)
ADDI Q, 2 ;SET FOR NEXT PAIR OF DIMENSIONS
MOVE C, A ;COPY P(N)
IMUL C, @1(Q) ;P(N-1)*L(N)
ADDM C,OFFSET ;ADD INTO OFFSET
MOVE C, @(Q) ;GET U(N)
SUB C, @1(Q) ;U(N) - L(N)
IMULI A, 1(C) ;P(N-1)*(U(N) -L(N) +1)
AOBJN B, ADJ.1 ;N=N+1, GO AROUND LOOP
MOVE C,OFFSET ;GET OFFSET BACK
SKIPN ACFLD ;WAS TYPE D.P. OR COMPLEX?
ASH C,1 ;YES, MULTIPLY OFFSET BY 2 FOR
;COMPLEX OR DOUBLE PRECISION ARG.
MOVEM C, (B) ;OFFSET TO NEXT TO LAST ENTRY
MOVEM A, 1(B) ;SIZE TO LAST ENTRY
MOVE 2,SAV2 ;RESTORE AC 2
GOODBY (2) ;RETURN
OFFSET: BLOCK 1
ACFLD: BLOCK 1 ;HOLD 0 IF DOUBLE PRECISION OR COMPLEX
SAV2: BLOCK 1 ;TEMP STORAGE FOR AC 2
PRGEND
TITLE PROAR. %4.(250) ARRAY BOUNDS CHECKING ROUTINE
SUBTTL SARA MURPHY/HPW 30-JAN-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
VERNO==3 ;MAJOR VERSION NUMBER
VEDIT==21 ;MAJOR EDIT NUMBER
VWHO==0 ;EDITOR
VMINOR==0 ;MINOR VERSION NUMBER
PROAV==BYTE(3)VWHO(9)VERNO(6)VMINOR(18)VEDIT
PURGE VWHO,VERNO,VMINOR,VEDIT
SEARCH FORPRM ;DEFINE GLOBAL SYMBOLS
;ROUTINE TO PERFORM FORTRAN ARRAY BOUNDS CHECKING AT RUN TIME
;CALLED WITH AN ARGUMENT BLOCK OF THE FORM:
; -------------------------------------------------
; ! ! PTR TO SEQ NUMB OF ST !
; -------------------------------------------------
; ! ! PTR TO DIMENSION INF !
; -------------------------------------------------
; ! ! PTR TO 1ST SUBSCRIPT !
; -------------------------------------------------
; ! ! PTR TO 2ND SUBSCRIPT !
;
; ETC
; WHERE DIMENSION INFORMATION IS REPRESENTED BY A BLOCK OF THE FORM:
; -------------------------------------------------
; ! ARRAY NAME (IN SIXBIT) !
; -------------------------------------------------
; ! DIM CT ! !I! ! BASE ADDRESS !
; -------------------------------------------------
; !A!F! ! PTR TO OFFSET !
; -------------------------------------------------
; ! ! PTR TO 1ST LOWER BND !
; -------------------------------------------------
; ! ! PTR TO 1ST UPPER BND !
; -------------------------------------------------
; ! ! PTR TO 1ST FACTOR !
; -------------------------------------------------
; ! ! PTR TO 2ND UPPER BND !
;
; ETC
; WHERE A IS A FLAG FOR "ADJUSTABLY DIMENSIONED ARRAY"
; F IS A FLAG FOR "FORMAL ARRAY"
;
;COMPUTES THE ADDRESS OF THE SPECIFIED ARRAY ELEMENT AND
; RETURNS THAT ADDRESS IN AC 0. IF ANY OF THE BOUNDS ARE
; EXCEEDED, AN ERROR MESSAGE IS GIVEN BEFORE PROCEEDING
;THE ADDRESS OF THE ARRAY ELEMENT IS COMPUTED BY THE
; FORMULA:
; BASE ADDR + OFFSET + (1ST SS)*(1ST FACTOR) +
; (2ND SS)*(2ND FACTOR) + .....
;IF AN ARRAY IS NOT A FORMAL, THE BASE ADDR+OFFSET WILL BE ADDED
; IN TO THE RESULT OF THIS ROUTINE BY THE FORTRAN PROGRAM CALLING
; THIS ROUTINE - THEREFORE THESE 2 TERMS ARE NOT INCLUDED IN THE RESULT
; UNLESS THE ARRAY IS FORMAL.
;IF AN ARRAY IS ADJUSTABLY DIMENSIONED, THE "OFFSET" CALCULATED UPON
; ENTRY TO THE SUBROUTINE IN WHICH THE ARRAY IS DECLARED ALREADY
; INCLUDES THE BASE ADDRESS - THEREFORE FOR ADJUSTABLY DIMENSIONED
; ARRAYS NEED NOT HAVE THE BASE ADDRESS ADDED IN SEPARATELY.
;
VREG=0 ;REG IN WHICH THE RESULT IS RETURNED
DP=15 ;PTR INTO THE BLOCK OF DIMENSION INFORMATION. POINTS
; TO THE SUB-BLOCK OF INFORMATION FOR A GIVEN DIMENSION
SSP=14 ;AOBJN POINTER INTO THE LIST OF SUBSCRIPTS - LEFT
; HALF IS CT OF SUBSCRIPTS, RH IS PTR TO THE ENTRY
; FOR A GIVEN SUBSCRIPT
SS=13 ;THE SUBSCRIPT BEING PROCESSED
SUM=12 ;COMPUTED SUM OF SUBSCRIPTS WITH FACTORS USED TO
; COMPUTE THE ADDRESS
;DEFINE FIELDS IN THE ARG-BLOCK FOR THIS ROUTINE
ISNWD=0 ;WD 0 CONTAINS THE SEQ NUMBER OF THE STMNT
; CONTAINING THIS ARRAY REF
DBLKP=1 ;WD 1 CONTAINS PTR TO THE DIMENSION BLOCK
; FOR THIS ARRAY
ARNAMP=1 ;SINCE 1ST WD OF DIMENSION BLOCK IS THE ARRAY
; NAME, WD 1 OF ARG BLOCK PTS TO THE ARRAY NAME
SS1WD=2 ;WD 2 CONTAINS PTR TO THE 1ST SS
;DEFINE FIELDS IN THE DIMENSION BLOCK
DCTSIZ=9 ;NUMBER OF BITS IN THE DIMENSION CT FIELD IN
; THE DIMENSION DESCRIPTOR BLOCK
DCTPOS=8 ;LAST BIT IN THE DIMENSION CT FIELD IS BIT 8
DCTWD=1 ;DIMENSION CT FIELD IS IN WD 1 OF THE BLOCK
DFLGWD=2 ;DIMENSION BLOCK FLAGS ARE IN WD 2 OF DIM BLO
DFLSIZ=2 ;DIMENSION BLOCK FLAGS ARE 2 BITS
DFLPOS=1 ; BITS 0-1
DNAMWD=0 ;ARRAY NAME IS IN WD 0 OF THE DIMENS BLOCK
DBASWD=1 ;BASE ADDR IS IN WD 1 OF THE BLOCK
DOFFWD=2 ;OFFSET IS IN WD 2 OF THE BLOCK
D1WD=3 ;SUB-BLOCK FOR THE 1ST DIMENSION STARTS
; IN WD 3
;DEFINE FIELDS IN THE SUB-BLOCKS FOR EACH DIMENSION
DLBWD=0 ;PTR TO LOWER BOUND IS IN WD 0 OF A SUB-BLOCK
; FOR A GIVEN DIMENSION
DUBWD=1 ;PTR TO UPPER BOUND IS IN WD 1 OF A SUB-BLOCK
DFACWD=2 ;PTR TO FACTOR IS IN WD 2 OF A SUB-BLOCK
DSBSIZ=3 ;NUMBER OF WDS IN THE SUB-BLOCK FOR EACH DIMEN
ENTRY PROAR. ;DEFINE ENTRY FOR LOADER
SIXBIT /PROAR./ ;DEFINE ROUTINE NAME FOR TRACE%
PROAR.: PUSH P,DP ;SAVE AC'S
PUSH P,SSP
PUSH P,SS
PUSH P,SUM
MOVE DP,DBLKP(L) ;PTR TO START OF DIMENSION BLOCK
HRRI SSP,SS1WD(L) ;SET UP AOBJN PTR TO THE SS LIST
;LOAD DIMENSION COUNT
LDB T1,[POINT DCTSIZ,DCTWD(DP),DCTPOS]
MOVN T1,T1 ; NEGATED GOES IN
HRL SSP,T1 ; LEFT HALF
LDB T1,[POINT DFLSIZ,DFLGWD(DP),DFLPOS] ;FLAGS FOR
; ADJ-DIM AND FOR FORMAL
XCT [ ;INIT ADDR COMPUTED TO:
MOVEI SUM,0 ; 0 FOR A NON-FORMAL
MOVEI SUM,@DBASWD(DP) ; THE ARRAY BASE FOR A FORMAL NOT
; ADJUSTABLY DIMENSIONED
PUSHJ P,ERR1 ; (ADJ BUT NOT FORMAL SHOULD
; NEVER OCCUR)
MOVE SUM,@DOFFWD(DP) ; THE COMPUTED OFFSET FOR AN
; ADJUSTABLY DIMENSIONED ARRAY
](T1)
MOVEI DP,D1WD(DP) ;PTR TO INFO ON 1ST DIMENSION
LP: MOVE SS,@0(SSP) ;1ST SUBSCRIPT
CAML SS,@DLBWD(DP) ;IF LESS THAN LOWER BOUND
CAMLE SS,@DUBWD(DP) ; OR GTR THAN UPPER BOUND
PUSHJ P,ERR ; GIVE A MESSAGE
IMUL SS,@DFACWD(DP) ;MULTIPLY BY FACTOR
ADD SUM,SS ;ADD INTO THE ADDRESS BEING COMPUTED
ADDI DP,DSBSIZ ;GO ON TO NEXT DIMENSION
AOBJN SSP,LP ;GO ON TO NEXT SS AND LOOP
MOVE VREG,SUM ;RESULT
POP P,SUM ;RESTORE ACS
POP P,SS
POP P,SSP
POP P,DP
POPJ P, ;RETURN
;ROUTINE CALLED WHEN A BOUNDS VIOLATION HAS BEEN DETECTED
ERR: PUSH P,T2 ;USE T1,T2,T3 FOR PASSING ARGS TO FORER
PUSH P,T3 ; MUST PRESERVE T2,T3 BECAUSE THE FORTRAN
PUSH P,T4 ; PROGRAM CALLING "PROAR." ASSUMES REGS
; 2-15 ARE PRESERVED
MOVEI T3,-SS1WD+1(SSP) ;SET T3 TO THE DIMENSION BEING PROCESSED
SUB T3,L
MOVE T1,@ARNAMP(L) ;ARRAY NAME IN SIXBIT
MOVE T2,@ISNWD(L) ;ISN OF STMNT CONTAINING THIS ARRAY REF
MOVE T4,SS ;VALUE OF ILLEGAL SUBSCRIPT
ERROR (SRE,0,0,.+1) ;CALL FORER TO GIVE THE ERROR MESSAGE
POP P,T4
POP P,T3
POP P,T2
POPJ P,
;ADJUSTABLY DIMENSIONED FORMAL ARRAY ERROR DETETCTED
ERR1: ERROR(SYS,0,0) ;IF DIMENSION BLOCK SPECIFIED AN
; ADJUSTABLY DIMENSIONED ARRAY THAT WAS
; NOT FORMAL - HAVE AN INTERNAL BUG - ABORT
PRGEND
TITLE ILL %4.(120) ;FROM LIB40 VERSION V.032(323) ZERO INPUT WORD ON ILLEG. CHARACTERS
SUBTTL D. TODD /DRT 15-FEB-1973 /DMN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;WHEN THE FLAG ILLEG. IS SET (BY CALLING ILL),
;FLOATING POINT INPUT WORDS WILL BE CLEARED IF
;ANY ILLEGAL CHARACTERS ARE SCANNED FOR THAT WORD.
;THE ILLEG. FLAG IS CLEARED BY FORSE. AT THE END
;OF EACH FORMAT STATEMENT.
;THE CALLING SEQUENCE IS JSA Q,ILL
;THE ROUTINE 'LEGAL' ALLOWS ONE TO CLEAR THE
;ILLEG. FLAG SO THAT ILLEGAL CHARACTERS WILL
;RESULT IN THE NORMAL ILLEGAL CHARACTER RETURN.
;THE CALLING SEQUENCE IS JSA Q,LEGAL
ENTRY ILL,LEGAL
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (ILL)
HRRZ T1,.JBOPS ;GET THE LOW SEG POINTER
SETOM ILLEG.(T1) ;SET ILL CH FLAG
GOODBY
HELLO (LEGAL)
HRRZ T1,.JBOPS
SETZM ILLEG.(T1) ;CLEAR ILL CH FLAG
GOODBY
PRGEND
TITLE ABS %4.(235) SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ABS
EXTERN ABS.
ABS=ABS.
PRGEND
TITLE IABS %4.(235) SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY IABS
EXTERN IABS.
IABS=IABS.
PRGEND
TITLE ABS. %4.(235) SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;SINGLE PRECISION ABSOLUTE VALUE FUNCTION
;ABS AND IABS RETURN THE ABSOLUTE VALUE OF A SINGLE PRECISION
;ARGUMENT.
;THE CALLING SEQUENCE FOR THE ROUTINES IS
; JSA Q, ABS
; EXP ARG
;THE ANSWER IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (ABS,.) ;[235] ENTRY TO ABS ROUTINE
MOVM A,@(Q) ;GET /ARG/.
GOODBY (1) ;RETURN
HELLO (IABS,.) ;[235] ENTRY TO IABS ROUTINE.
MOVM A,@(Q) ;GET /ARG/.
JFCL 1,[HRLOI A,377777 ;/-INFIN/ IS SET TO +INFIN,
GOODBY (1)] ;AND AN ERROR MESSAGE IS RETURNED.
GOODBY (1) ;RETURN
PRGEND
TITLE RESET %4.(410) ;FROM LIB40 VERSION V.032(323) RESETS ALL I/O DEVICES
SUBTTL D. TODD /DRT/MD 01-NOV-74 DICK GRUEN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;410 14339 RESET ROUTINE FAILS
SEARCH FORPRM
;**;[410],RESET,MD,11/01/74
HELLO (RESET)
PUSH P,P4 ;[410] SAVE REGISTERS
PUSH P,P3 ;[410]
PUSH P,L ;[410]
PUSH P,T1 ;[410]
PUSH P,T2 ;[410]
HRRZ P4,.JBOPS ;[410] GET DATA BASE ADDRESS
MOVSI T1,-17 ;[410] CHECK 15. CHANNELS
HRRI T1,CHN.TB+1(P4) ;[410] ENTRIES IN CHN.TB TABLE
RES.1: SKIPE P3,(T1) ;[410] CHANNEL NOT ASSIGNED
CAMN P3,[-1] ;[410] OR BY USER
JRST RES.3 ;[410] DONT RESET
LDB T2,[POINT 4,DD.UNT(P3),12] ;[410] GET CHAN NUMBER
RESDV. T2, ;[410] CALL MONITOR TO RESET CHAN
JRST RES.ER ;[410] ERROR
RES.2: HRRZS P3 ;[410] GET ADDRESS OF DDB
MOVEI L,RESARG ;[410] AND ARGUMENT BLOCK
PUSHJ P,DECOR.## ;[410] GO DEALLOCATE CORE
;[410] DDB AND BUFFERS
SETZM (T1) ;[410] INDICATE CHAN AVAILABLE
RES.3: AOBJN T1,RES.1 ;[410] CONTINUE FOR ALL CHANNELS
SETZM RER.SV(P4) ;[410] CLEAR REREAD INFO
RES.4: POP P,T2 ;[410] RESTORE REGISTERS
POP P,T1 ;[410]
POP P,L ;[410]
POP P,P3 ;[410]
POP P,P4 ;[410]
GOODBY () ;[410]
RES.ER: SKIPGE T2 ;[410] RESDV. UUO IMPLEMENTED
JRST RES.2 ;[410] YES - IGNORE ERROR RETURN
OUTSTR [ASCIZ /
%FRSRES NO RESDV. UUO - RESET LIBRARY ROUTINE ABORTED
/] ;[410] GIVE MESSAGE TO USER
JRST RES.4 ;[410] AND LEAVE
-1,,0 ;[410] COUNTER
RESARG: 0,,P3 ;[410]
PRGEND
TITLE DIM %4.(235) SINGLE PRECISION POSITIVE DIFFERENCE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY DIM
EXTERN DIM.
DIM=DIM.
PRGEND
TITLE DIM. %4.(235) SINGLE PRECISION DIFFERENCE FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;SINGLE PRECISION DIM FUNCTION
;DIM(A,B) IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, DIM
; EXP A
; EXP B
;DIM RETURNS THE POSITIVE DIFFERENCE OF A AND B:
;IF (A-B)>0, THEN DIM(A,B) = A-B
;IF (A-B) .LE. 0, THEN DIM(A,B) = 0
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (DIM,.) ;[235] ENTRY TO DIM ROUTINE
MOVE A, @(Q) ;PICK UP FIRST ARGUMENT
CAMG A,@1(Q) ;IF A > B, GO TO SUBTRACT.
TDZA A,A ;O'E, ZERO A AND GO TO EXIT.
FSBR A,@1(Q) ;CALC A - B.
GOODBY (2) ;RETURN
PRGEND
TITLE IDIM %4.(235) INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY IDIM
EXTERN IDIM.
IDIM=IDIM.
PRGEND
TITLE IDIM. %4.(235) INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;SINGLE PRECISION INTEGER DIM FUNCTION
;IDIM(A,B) IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, IDIM
; EXP A
; EXP B
;IDIM RETURNS THE POSITIVE DIFFERENCE OF A AND B:
;IF (A-B) .LE. 0, THEN DIM(A,B)=0
;IF(A-B) .G. 0 , THEN DIM(A,B)=(A-B)
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (IDIM,.) ;[235] ENTRY TO IDIM ROUTINE
MOVE A, @(Q) ;PICK UP FIRST ARGUMENT
CAMG A,@1(Q) ;IF A <= B,
MOVE A,@1(Q) ;ANS WILL = 0.
SUB A,@1(Q) ;IF A > B,
JFCL 1,[HRLOI A,377777 ;ANS = A - B,
GOODBY (2)] ;+ OVERFLOW MAY OCCUR.
GOODBY (2) ;RETURN
PRGEND
TITLE SIGN %4.(235) SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY SIGN
EXTERN SIGN.
SIGN=SIGN.
PRGEND
TITLE ISIGN %4.(235) SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY ISIGN
EXTERN ISIGN.
ISIGN=ISIGN.
PRGEND
TITLE SIGN. %4.(235) SINGLE PRECISION AND INTEGER XFER OF SIGN FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;SIGN(A,B) AND ISIGN(A,B) ARE CALLED IN THE FOLLOWING MANNER:
; JSA Q, SIGN
; EXP A
; EXP B
;IF B .GE. 0, THEN ABSF(A) IS RETURNED IN ACCUMULATOR A
;IF B .L. 0, THEN -ABSF(A) IS RETURNED IN ACCUMULATOR A
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (SIGN,.) ;[235] ENTRY TO SIGN
MOVM A, @(Q) ;GET MAGNITUDE OF FIRST ARGUMENT
SKIPGE @1(Q) ;IS SECOND ARGUMENT POSITIVE?
MOVNS A ;NO, NEGATE RESULT
GOODBY (2) ;RETURN
HELLO (ISIGN,.) ;[235] ENTRY TO ISIGN
MOVE A,@(Q) ;FIRST ARG TO A.
XOR A,@1(Q) ;IF FIRST AND SECOND HAVE
JUMPL A,.+3 ;DIFFERENT SIGNS, GO TO .+3.
MOVE A,@(Q) ;O'E, THE ANSWER = FIRST ARG.
GOODBY (2) ;RETURN
MOVN A,@(Q) ;ANSWER=-FIRST ARG.
JFCL 1,.+2 ;IF OVERFLOW, GO TO .+2.
GOODBY (2) ;RETURN
HRLOI A,377777 ;ANSWER IS SET TO +INFINITY.
GOODBY (2) ;RETURN
PRGEND
TITLE AINT %4.(235) FLOATING POINT TRUNCATION FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AINT
EXTERN AINT.
AINT=AINT.
PRGEND
TITLE AINT. %4.(235) FLOATING POINT TRUNCATION FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON /KK/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;FLOATING POINT TRUNCATION FUNCTION.
;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER
;AND RETURNS ANSWER AS A FLOATING POINT NUMBER.
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q,AINT
; EXP ARG
;THE ANSWER IS RETURNED IN AC 0.
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (AINT,.) ;[235] ENTRY TO AINT ROUTINE.
MOVE B,@(Q) ;ARG. TO AC 1.
MOVM A,B ;/ARG./ TO AC 0.
CAML A,MOD1 ;IS /ARG/<2**26?
JRST AINT1 ;NO, NO FRACTION BITS, EXIT.
FAD A,MOD1 ;YES, REMOVE
FSB A,MOD1 ;THE FRACTION BITS.
AINT1: SKIPGE B ;SET THE
MOVNS A ;CORRECT SIGN AND
GOODBY (1) ;RETURN
MOD1: 233400000000 ;2**26
PRGEND
TITLE AMOD %4.(235) SINGLE PRECISION MOD FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY AMOD
EXTERN AMOD.
AMOD=AMOD.
PRGEND
TITLE AMOD. %4.(235) SINGLE PRECISION MOD FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK/DMN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;FLOATING POINT SINGLE PRECISION MOD FUNCTION
;MODF(A,B) = A-[A/B]*B, WHERE [A/B] IS THE GREATEST INTEGER
;IN THE MAGNITUDE OF A/B. THE TERM A/B MUST BE LESS THAN
;2**26 IN MAGNITUDE.
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q,AMOD
; EXP A
; EXP B
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (AMOD,.) ;[235] ENTRY TO AMOD ROUTINE.
MOVEM C,SAVEC ;SAVE AC 2.
MOVE A,@(Q) ;PICK UP FIRST ARG.
MOVE B,@1(Q) ;PICK UP SECOND ARG.
MOVM C,B ;GET ABSF(B) IN C.
FDVM A,B ;CALCULATE A/B.
JFCL DETRMN ;IF OVER/UNDER FLOW, GO TO DETRMN VIA OVTRAP.
MOVMS B ;CALC. ABSF(A/B).
CAML B,MOD1 ;IF A/B GE 2**26,
JRST TOOLRG ;GO TO ERROR RETURN.
FAD B,MOD1 ;OTHERWISE, TRUNCATE TO
FSB B,MOD1 ;INTEGER.
FMP C,B ;C=B**ABSF([A/B])
SKIPGE A ;RESTORE
MOVNS C ;THE SIGN.
FSB A,C ;CALC. A-[A/B]*B.
OUT: MOVE C,SAVEC ;RESTORE AC 2.
GOODBY (2) ;RETURN
DETRMN: MOVE B,.JBTPC ;PICK UP FLAGS.
TLNE B,000100 ;IF OVERFLOW, GO TO TOOLRG.
JRST OUT ;UNDERFLOW, A IS RESULT.
TOOLRG: ERROR (APR,5,1,.+1) ;TYPE AN OVERFLOW MESSAGE
SETZ A, ;ZERO A.
JRST OUT ;GO TO EXIT.
SAVEC: 0
MOD1: 233400000000 ;2**26.
PRGEND
TITLE MOD %4.(235) INTEGER MOD FUNCTION
SUBTTL H. P. WEISS/HPW 11-DEC-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY MOD
EXTERN MOD.
MOD=MOD.
PRGEND
TITLE MOD. %4.(235) INTEGER MOD FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 ED YOURDON/KK
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 V.32(323)
;INTEGER MOD FUNCTION
;MOD(A,B) = A-[A/B]*B, WHERE [A/B] IS THE GREATEST (IN
;MAGNITUDE) INTEGER IN A/B. THAT IS, THE MOD FUNCTION
;RETURNS THE REMAINDER OF THE QUOTIENT OF A AND B. HENCE,
;9 MOD 2 IS 1, AND SO FORTH.
;THE CALLING SEQUENCE FOR THE ROUTINE IS:
; JSA Q,MOD
; ARG 0,A
; ARG 0,B
;WHERE ARG MAY BE ANY OPCODE, THE 0 IS THE AC FIELD AND USUALLY
;DESIGNATES THE TYPE OF ARGUMENT. A AND B ARE THE ADDRESSES
;OF THE TWO ARGUMENTS TO THE PROGRAM.
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (MOD,.) ;[235] ENTRY TO MOD ROUTINE
MOVE A,@(Q) ;FIRST ARG TO AC 0.
IDIV A,@1(Q) ;DIVIDE, REMAINDER IN AC 1.
MOVE A,A+1 ;PUT THE ANSWER IN AC 0.
GOODBY (2) ;RETURN
PRGEND
TITLE DATE %4.(120) ;FROM LIB40 VERSION V.32(433) TODAY'S DATE FORTRAN IV
SUBTTL D. TODD /DRT 15-FEB-1973 /KK/DMN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS SUBROUTINE PUTS TODAY'S DATE INTO A
;DIMENSIONED TWO-WORD ARRAY.
;THE DATE WILL BE IN THE FORM:
; 17-Aug-66
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA 16,DATE
; ARG A
;"DATE" OBTAINS THE DATE FROM THE MONITOR IN THE FORM:
; ( (YEAR-1964)*12 + (MONTH-1) )*31 + (DAY-1)
SEARCH FORPRM
HELLO (DATE) ;ENTRY TO DATE ROUTINE.
MOVEI 1,@(16) ;GET ADDRESS OF 2 WORD ARRAY
MOVEM 2,0(1) ;SAVE THE CONTENTS OF AC 2.
MOVEM 3,1(1) ;SAVE THE CONTENTS OF AC 3.
CALLI 1,14 ;GET THE DATE FROM THE MONITOR.
IDIVI 1,^D31 ;DIV. BY 31 TO OBTAIN THE DAY-1.
ADDI 2,1 ;TO OBTAIN THE DAY.
IDIVI 2,^D10 ;CONVERT INTO TWO DEC. DIGITS.
SKIPN 2 ;IS THE DAY < 10?
MOVNI 2,20 ;YES, OUTPUT BLANK.
MOVEI 0,"0"(2) ;GET FIRST DIGIT
LSH 0,7 ;MAKE SPACE
ADDI 0,"0"(3) ;ADD IN 2ND DIGIT
IDIVI 1,^D12 ;TO OBTAIN THE MONTH
EXCH 1,2 ;SAVE YEAR IN 2
MOVE 1,TABLE(1) ;GET MONTH IN 1
LSHC 0,3*7 ;LEFT JUSTIFY 0 & 1
LSH 0,1 ;0 = ASCII /DD-MO/
;1 = ASCII /N-/
MOVEI 2,^D64(2) ;GET THE YEAR
IDIVI 2,^D10 ;CONVERT INTO TWO DEC. DIGITS
ADDI 2,"0" ;MAKE ASCII
ADDI 3,"0"
LSH 2,2*7+1 ;SHIFT TO CHAR 3
LSH 3,7+1 ;SHIFT TO CHAR 4
ADD 3,2 ;ADD IN TO 3
ADD 3,1 ;SO LOW WORD IS IN 3
MOVE 2,0 ;PUT HIGH ORDER RESULT IN 2
MOVEI 1,@(16) ;USER ADDRESS
EXCH 2,0(1) ;RESTORE 2
EXCH 3,1(1) ;AND 3 WHILE STORING RESULT
GOODBY (1) ;RETURN
;SUB1 CONVERTS THE DAY AND THE YEAR INTO ASCII CHARS, AND
;DEPOSITS THEM IN THE TWO WORD ARRAY.
SUB1: ADDI 2,60 ;CONVERT FIRST DIGIT TO ASCII
IDPB 2,0 ;DEPOSIT FIRST DIGIT
ADDI 3,60 ;CONVERT SECOND DIGIT TO ASCII
TABLE: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
PRGEND
TITLE TIM2GO %4.(264) RETURN TIME LIMIT IN SECONDS
SUBTTL H. P. WEISS/HPW 11-FEB-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
HELLO (TIM2GO) ;[264] DEFINE ENTRY POINT
PUSH P,T1 ;[264] GRAB A REGISTER
MOVE T1,[44,,11] ;[264] DETERMINE JIFFIES PER SECOND
GETTAB T1, ;[264] VIA GETTAB
JRST NEVER ;[264] UNIMPLEMENTED
FSC T1,233 ;[264] CONVERT TO FLOATING POINT
MOVE T0,[-1,,40] ;[264] DETERMINE TIME LIMIT
GETTAB T0, ;[264] VIA GETTAB
JRST NEVER ;[264] UNIMPLEMENTED
TLZ T0,777700 ;[264] CLEAR EXTRA BITS
JUMPE T0,NEVER ;[264] RETURN INFINITY IF 0
FSC T0,233 ;[264] CONVERT TO FLOATING POINT
FDVR T0,T1 ;[264] COMPUTE SECONDS TILL EXPIRATION
DONE: POP P,T1 ;[264] RESTORE REGISTER USED
GOODBY (0) ;[264] RETURN
NEVER: HRLOI T0,377777 ;[264] SET LIMIT TO INFINITY
JRST DONE
PRGEND ;[264] END OF TIM2GO
TITLE TIME %4.(203) TIME OF DAY FOR F40 AND FORTRAN-10
SUBTTL D. TODD /DRT/KK/HPW 22-AUG-73
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;FROM %2.(120)
;FROM LIB40 VERSION V.017.5
;THIS SUBROUTINE PUTS THE TIME OF DAY INTO TWO WORDS.
;
;THE WORDS CONTAIN THE HOUR, THE MINUTE, THE SECOND, AND THE
;TENTH OF A SECOND.
;THE FIRST WORD IS OF THE FORM:
; 02:15 (FOR A.M. TIME)
; 14:15 (FOR P.M. TIME)
;THE SECOND WORD IS OF THE FORM:
; 37.4
;
;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA 16,TIME
; ARG A
; ARG B
;SINCE THE OLD VERSION OF TIME HAD ONLY ONE ARGUMENT,
;TIME CHECKS TO BE SURE A SECOND ARGUMENT IS EXPECTED
;BEFORE RETURNING IT. THE OPCODE OF THE SECOND ARGUMENT
;MUST BE 320.
;TIME OBTAINS THE TIME FROM THE MONITOR IN THE FORM:
; TIME=THE NUMBER OF MILLISECONDS SINCE MIDNIGHT.
SEARCH FORPRM
HELLO (TIME) ;ENTRY TO ROUTINE TIME
MOVEM 2,SAVE2 ;SAVE AC 2
MOVEM 3,SAVE3 ;SAVE AC 3
CALLI 1,23 ;GET TIME IN MILLISECS FROM THE MONITOR.
IDIVI 1,^D60000 ;TOTAL MINS. IN 1, LEFTOVER MSECS. IN 2.
MOVEM 2,TEMP1 ;SAVE THE LEFTOVER MSECONDS.
IDIVI 1,^D60 ;HOURS IN 1, MINUTES IN 2.
MOVEM 2,TEMP2 ;SAVE THE MINUTES.
HRLZI 0,440736 ;SET UP POINTER
JSP 3,SUB1 ;GO TO SUBR. TO SET UP HR. IN ASCII.
MOVEI 1,":" ;SET UP ":".
IDPB 1,0 ;DEPOSIT ":" IN THE WORD.
MOVE 1,TEMP2 ;PICK UP THE MINUTES.
JSP 3,SUB1 ;GO TO SUBR. TO SET UP MIN. IN ASCII.
HLRZ 3,0(16) ;%203% F40 OR FORTRAN-10 CALLING?
LSH 3,-^D9 ;%203% F40 OR FORTRAN-10 CALLING?
JUMPN 3,TIME01 ;%203% F40 CALLING
HLRZ 3,-1(16) ;%203% FORTRAN-10 - GET ARGUMENT COUNT
CAIE 3,-2 ;%203% TWO ARGUMENTS?
JRST OUT1 ;%203% NO - RETURN NOW
JRST TIME02 ;%203% CONTINUE DEPOSITING BYTES
TIME01: MOVE 3,1(16) ;%203% CHECK TO SEE
TLC 3,320000 ;IF A SECOND
TLNE 3,777000 ;ARG. IS EXPECTED.
JRST OUT1 ;IF NOT, GO TO OUT1.
TIME02: MOVEI 1," " ;PUT IN A BLANK AS THE FIRST
IDPB 1,0 ;CHARACTER IN THE 2ND WORD.
MOVE 1,TEMP1 ;PICK UP THE MSECONDS.
IDIVI 1,^D1000 ;SECONDS IN 1, LEFTOVER MSECS. IN 2.
MOVEM 2,TEMP1 ;SAVE THE MSECS.
JSP 3,SUB1 ;GO TO SUBR. TO SET UP THE SECS. IN ASCII.
MOVEI 1,"." ;SET UP "."
IDPB 1,0 ;IN THE WORD.
MOVE 2,TEMP1 ;PICK UP THE MSECS.
IDIVI 2,^D100 ;GET THE TENTH OF A SECOND.
MOVEI 2,"0"(2) ;%203% MAKE IT ASCII
IDPB 2,0 ;PUT IT IN THE SECOND WORD.
MOVE 2,SAVE2 ;RESTORE AC 2.
MOVE 3,SAVE3 ;RESTORE AC 3.
GOODBY (2) ;RETURN
OUT1: MOVE 2,SAVE2 ;RESTORE AC 2.
MOVE 3,SAVE3 ;RESTORE AC 3.
GOODBY (1) ;RETURN
SUB1: IDIVI 1,^D10 ;SUBROUTINE ENTRY POINT.
MOVEI 1,"0"(1) ;%203% MAKE IT ASCII
IDPB 1,0 ;DEPOSIT IT IN THE WORD.
MOVEI 2,"0"(2) ;%203% MAKE IT ASCII
IDPB 2,0 ;DEPOSIT IT IN THE WORD.
JRST (3) ;RETURN TO MAIN SEQUENCE.
SAVE2: 0
SAVE3: 0
TEMP1: 0
TEMP2: 0
PRGEND
TITLE SLITE %4.(120) ;FROM LIB40 VERSION V.032(323) SENSE LITE SETTING AND TESTING FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 /TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;SENSE LIGHT SETTING AND TESTING PROGRAM
;THIS PROGRAM CAN BE ENTERED AT TWO PLACES. THE SENSE LIGHT
;TESTING PROGRAM IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, SLITET
; EXP I
; EXP J
;I IS THE ADDRESS OF AN INTEGER ARGUMENT, AND J IS THE ADDRESS
;OF THE ANSWER. IF SENSE LIGHT I IS ON, THE ANSWER IS ONE, AND
;IF IT IS OFF, THE ANSWER IS 2.
;THE SENSE LIGHT SETTING PROGRAM IS CALLED IN THE FOLLOWING
;MANNER:
; JSA Q, SLITE
; EXP I
;I IS THE ADDRESS OF AN INTEGER ARGUMENT WHOSE VALUE IS
;BETWEEN 0 AND 36. IF I=0, ALL SENSE LIGHTS ARE TURNED OFF.
;OTHERWISE, SENSE LIGHT I IS TURNED ON.
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (SLITE) ;ENTRY TO SLITE PROGRAM
MOVN B, @(Q) ;GET ARGUMENT
JUMPE B, SLITE2 ;IS IT ZERO?
MOVSI A, 400000 ;NO, PUT A ONE IN BIT 0
ROT A, 1(B) ;ROTATE IT INTO POSITION
MOVE B, LITES ;GET THE SENSE LIGHTS
TDO B, A ;TURN ON PROPER LIGHT
SLITE2: MOVEM B, LITES ;SAVE NEW SENSE LIGHTS
GOODBY (1) ;RETURN
HELLO (SLITET) ;ENTRY TO SENSE TESTING PROGRAM
MOVN B, @(Q) ;PICK UP ARGUMENT
MOVSI A, 400000 ;PUT A ONE IN BIT 0
ROT A, 1(B) ;ROTATE IT INTO POSITION
MOVEI B, 1 ;SET ANSWER TO ONE FOR NOW
MOVEM B, @1(Q) ;...
MOVE B, LITES ;PICK UP SENSE LIGHTS
TDZN B,A ;IS THE PROPER LIGHT ON?
AOS @1(Q) ;NO, CHANGE ANSWER TO 2
MOVEM B,LITES ;RESTORE WITH TESTED LIGHT OFF
GOODBY (2) ;RETURN
LITES: 0
PRGEND
TITLE SSWTCH %4.(120) ;FROM LIB40 VERSION V.032(323) DATA SWITCH TESTING FUNCTION
SUBTTL D. TODD /DRT 15-FEB-1973 /TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
; DATA SWITCH TESTING PROGRAM
;THIS PROGRAM IS CALLED IN THE FOLLOWING MANNER:
; JSA Q, SSWTCH
; EXP I
; EXP J
;I IS THE ADDRESS OF AN INTEGER ARGUMENT AND J IS THE ADDRESS
; OF THE ANSWER . IF DATA SWITCH I IS UP,THE ANSWER IS 2 , AND
; IF IT IS DOWN, THE ANSWER IS 1.
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (SSWTCH) ;ENTRY TO SSWTCH PROGRAM
MOVN B, @(Q) ;PICK UP ARGUMENT
MOVSI A, 400000 ;PUT A ONE IN BIT 0
ROT A,(B) ; ROTATE BIT INTO POSITION
MOVEI B,2 ; SET ANSWER TO 2 FOR NOW
MOVEM B, @1(Q) ;...
SWITCH B, ;GET DATA SWITCHES FROM MONITOR
TDNN B, A ;IS PROPER SWITCH ON?
SOS @1(Q) ; NO, CHANGE ANSWER TO ONE
GOODBY (2) ;RETURN
PRGEND
TITLE RAN %5A.(637) ;FROM LIB40 VERSION V.032(323) GENERATE RANDOM NUMBER FUNCTION
SUBTTL 18-JAN-1977 BRUNO G. DUERR/KK/TWE/SWG
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;PSEUDO RANDOM NUMBER GENERATOR AND INITIALIZING ROUTINE
;METHOD SUGGESTED BY D. H. LEHMER
;CALLING SEQUENCE FOR FUNCTION RAN:
;JSA Q,RAN
;EXP ARG (DUMMY ARGUMENT)
;ANSWER IS RETURNED IN ACCUMULATOR A AS A SINGLE
;PRECISION FLOATING POINT NUMBER IN THE RANGE
;0<X<1
;CALLING SEQUENCE FOR INITIALIZING SUBROUTINE SETRAN:
;JSA Q,SETRAN
;EXP ARG (ARG IS THE ADDRESS OF A POSITIVE INTEGER <2**31)
;NOTE: IF ARG CONTAINS 0 A STANDARD STARTING VALUE IS TAKEN INSTEAD
;CALLING SEQUENCE FOR SAVRAN
SUBTTL D. TODD /DRT 15-FEB-1973
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;JSA Q,SAVRAN
;EXP ARG (WHERE ARG IS THE ADDRESS FOR THE LAST RANDOM
; NUMBER TO BE STORED IN INTEGER MODE)
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (RAN)
MOVE A,K ;GET K [14**29(MOD2**31 -1)]
MUL A,XN ;MULTIPLY WITH LAST RANDOM NUMBER
ASHC A,4 ;SEPARATE RESULT IN TWO 31 BIT WORDS
LSH B,-4
ADD A,B ;ADD THEM TOGETHER
TLZE A,760000 ;SKIP IF RESULT < 31 BITS
ADDI A,1
MOVEM A,XN ;STORE NEW RN IN INTEGER MODE
HLRZ B,A ;CONVERT TO FP IN TWO STEPS IN
FSC B,216 ;ORDER TO LOOSE NO LOW ORDER
;**; [637] CHANGE AT K-4 SWG 18-JAN-77
HRLI A,0 ;[637] BITS
FSC A,174
FAD A,B
GOODBY (1) ;RETURN TO CALLING PROGRAM
K: ^D630360016 ;14**29(MOD 2**31 -1)
XN: ^D524287 ;STARTING VALUE
HELLO (SETRAN)
MOVE A,@0(Q) ;GET ARGUMENT FROM CALLING PROGRAM
TLZ A,760000 ;MASK 5 BITS FOR SAFETY
CAIN A,0 ;SKIP IF ARGUMENT NONZERO
MOVE A,X0 ;GET STANDARD STARTING VALUE
MOVEM A,XN
GOODBY (1) ;RETURN
X0: ^D524287 ;STANDARD STARTING VALUE FOR RAN
HELLO (SAVRAN)
MOVE A,XN ;LAST RANDOM NUMBER TO AC0
MOVEM A,@0(Q) ;STORE IN INTEGER MODE
GOODBY (1) ;RETURN
PRGEND
TITLE ERRSET %4.(120) ;FROM LIB40 VERSION V.032(323) SET MAXIMUM ERROR COUNT
SUBTTL D. TODD /DRT 15-FEB-1973 T EGGERS/DMN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
HELLO (ERRSET)
HRRZ T1,.JBOPS ;GET THE LOW SEG POINTER
MOVE A,@(Q) ;GET MAXIMUM ERROR NUMBER
MOVEM A,ERRMX.(T1) ; AND STORE AWAY
GOODBY (1) ;RETURN
PRGEND
TITLE OVERFL %4.(120) ;FROM LIB40 VERSION V.032(323) ARITHMETIC OVEFLOW TESTING PROGRAM
SUBTTL D. TODD /DRT 15-FEB-1973 T. EGGERS/DMN/TWE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
;THIS ROUTINE IS CALLED IN THE FOLLOWING MANNER:
; JSA Q,OVERFL
; EXP J
;IF OVERFLOWS HAVE OCCURRED, THE ANSWER IS SET TO 1, AND THE
;COUNTER IS CLEARED. IF THE OVERFLOW COUNTER IS 0, THE ANSWER
;IS SET TO 2.
SEARCH FORPRM
A=0
B=1
C=2
D=3
E=4
F=5
G=6
Q=16
P=17
ENTRY OVERFL
HELLO (OVERFL)
HRRZ T1,.JBOPS ;GET THE LOW SEG POINTER
SETZM @(Q) ;CLEAR OUT ANSWER WORD
AOS @(Q) ;SET ANSWER TO 1
SKIPN OVCNT.(T1) ;ANY OVERFLOWS?
AOS @(Q) ;NO, SET ANSWER TO 2
SETZM OVCNT.(T1) ;RESET OVERFLOW COUNTER
GOODBY (1) ;RETURN
PRGEND
TITLE TRACE DUMMY ROUTINE TO DEFINE THE TRACE ENTRY IN FOROTS (FORERR)
SUBTTL D. TODD /DRT 05-APR-1973
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
ENTRY TRACE ;HELLO MACRO CAN NOT BE USED
;SIXBIT NAME DEFINED IN TRACE (FORERR)
TRACE=TRACE.## ;DEFINE THE EXTERNAL TRACE NAME
;TRACE.=TRACE% IN (FORINI)
PRGEND
TITLE INIOVL %4.(311)- SUBROUTINE TO SET PRINCIPAL OVERLAY FILE
SUBTTL D. M. NIXON 10-MAY-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY INIOVL
INIOVL=INIOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE GETOVL %4.(311)- SUBROUTINE TO GET LINKS INTO CORE
SUBTTL D. M. NIXON 10-MAY-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY GETOVL
GETOVL=GETOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE REMOVL %4.(311)- SUBROUTINE TO REMOVE LINKS FROM CORE
SUBTTL D. M. NIXON 10-MAY-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY REMOVL
REMOVL=REMOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE RUNOVL %4.(311)- SUBROUTINE TO JUMP TO START ADDRESS OF LINK
SUBTTL D. M. NIXON 10-MAY-74
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY RUNOVL
RUNOVL=RUNOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE