Trailing-Edge
-
PDP-10 Archives
-
BB-D480C-SB_1981
-
formsc.mac
There are 19 other files named formsc.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FORMSC Miscellaneous routines ,6(2031)
SUBTTL Sue Godsell/EDS/EGM 16-Mar-81
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1977,1981 BY DIGITAL EQUIPMENT CORPORATION
COMMENT \
***** Begin Revision History *****
BEGIN V6
1100 SWG 15-Aug-75
CLEANUP FOR V6 - REMOVE ALL F40, KA THINGS. JSYSIZE
THOSE ROUTINES WHICH DO MONITOR CALLS: TIME,TIM2G0,DATE
SSWTCH
REMOVE .MXFOR AND FORX40;TAKE KA CONDITIONALS OUT OF UNIVERSAL;
REMOVE UNNECESSARY AC DEFS FROM FLOAT. AND IFIX.
Add OUTSTR macro for TOPS-20 IN FDDT.
1175 JLC 12-Dec-80
Fixed LSNGET routine, did not like nulls in line number
and did not clear digit AC, always returned error (-1).
1256 DAW 5-FEB-81
Use new calling sequence for FOROP.
1260 DAW 6-Feb-81
LSNGET smashed ACs 2 and 3.
1266 DAW 11-Feb-81
Changes to support extended addressing in DUMP & PDUMP, TIME,
and DATE routines.
1300 DAW 24-Feb-81
Get FIN. calls and IOLISTS correct again in DUMP and PDUMP.
1302 JLC 24-Feb-81
Changed LSNGET to have channel # as arg.
1335 EDS 12-Mar-81 Q10-05759
Use symbols when testing output of ODCNV% jsys in TIME.
Make TIME return the arguments correctly.
1342 EDS 13-Mar-81 Q10-05075
Make routines TRACEable change everything to HELLO macros.
Fix TWOSEG and RELOC problems. Clean up TITLEs.
1351 EDS 16-Mar-81 Q10-04786
Fix TWOSEG and RELOC problems.
1372 EGM 30-Mar-81 ________
Make OVERFL compatible with 5A, and eliminate TIME JSYS conflict.
1425 BL 14-Apr-81 Q10-05076
Make OVERFL functionality include 'logical function'.
Returns T0=0 if OVERFLOW=NO, T0=-1 if OVERLFOW=YES.
Original functionality unchanged.
1464 DAW 12-May-81
Error messages.
1500 DAW 27-May-81
Edit 1464 made it get "E" error.
1517 BL 18-Jun-81 Q10-05075
Use HELLO macro at CLRDIV (FORMSC).
1532 DAW 14-Jul-81
OPEN rewrite: Base level 1
1560 DAW 28-Jul-81
OPEN rewrite: Base level 2
1615 DAW 19-Aug-81
Get rid of 2-word BP option.
1656 DAW 2-Sep-81
Get rid of magic numbers.
1720 JLC 16-Sep-81
Added test in DIVERT to make sure unit is open for FORMATTED I/O.
1747 DAW 28-Sep-81
Got rid of FORPRM dependency in DIVERT.
1767 DAW 8-Oct-81
Explain "magic" numbers in OVERFL.
2020 DAW 21-Oct-81
Change DATE to return SPACE as last character instead of NULL,
so it will match a literal generated by the compiler.
***** End Revision History *****
\
PRGEND
TITLE ADJ1.
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
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).
TWOSEG 400000
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.
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
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)
TWOSEG 400000
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. 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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 VERSION V.032(323)
;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
TWOSEG 400000
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
RELOC ;DATA
OFFSET: BLOCK 1
ACFLD: BLOCK 1 ;HOLD 0 IF DOUBLE PRECISION OR COMPLEX
SAV2: BLOCK 1 ;TEMP STORAGE FOR AC 2
RELOC
PRGEND
TITLE PROAR. ARRAY BOUNDS CHECKING ROUTINE
SUBTTL SARA MURPHY 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,1981 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
TWOSEG 400000
HELLO (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,PERR ; 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
PERR: 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
LERR (SRE,%,<Subscript range error on line $D at $1L
Subscript $D of array $S = $D>,<T2,-12(P),T3,T1,T4>)
POP P,T4
POP P,T3
POP P,T2
POPJ P,
;ADJUSTABLY DIMENSIONED FORMAL ARRAY ERROR DETETCTED
ERR1: LERR (VDM,?,Variably dimensioned array not formal - internal bug - abort)
JRST EXIT.##
; ADJUSTABLY DIMENSIONED ARRAY THAT WAS
; NOT FORMAL - HAVE AN INTERNAL BUG - ABORT
PRGEND
TITLE FORDMP DUMP AND PDUMP
SUBTTL /DMN/SWG 21-AUG-79
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM 1 MAY 1966 ED YOURDON, 2/12/68 NSR
;THE PROGRAMS DUMP AND PDUMP MAY BE CALLED BY A FORTRAN PROGRAM
;IN THE FOLLOWING MANNER:
; CALL DUMP(A(1),B(1),F(1),. . .,A(N),B(N),F(N))
; CALL PDUMP(A(1),B(1),F(1),.. .,A(N),B(N),F(N))
;BOTH PROGRAMS CAUSE CORE TO BE DUMPED BETWEEN THE LIMITS A(I)
;AND B(I), AS SPECIFIED BY THE MODE PARAMETER F(I). EITHER
;A(I) OR B(I) MAY BE UPPER OR LOWER CORE LIMITS. DUMP CALLS
;[SIXBIT /EXIT/] WHEN DONE, WHILE PDUMP RESTORES THE STATE
;OF THE MACHINE AND RETURNS TO THE USERS PROGRAM. BOTH
;PROGRAMS INDICATE THE CONTNETS OF THE ACCUMULATORS AND THE
;FOLLOWING FLAGS BEFORE BEGINNING THE ACTUAL CORE DUMP:
; AR OV FLAG
; AR CRY0 FLAG
; AR CRY1 FLAG
; PC CHANGE FLAG - FLOATING OVERFLOW
; BIS FLAG
;THE MODE OF THE DUMP IS CONTROLLED BY THE PARAMETER F(I), WHICH
;MAY BE ONE OF THE FOLLOWING NUMBERS:
; 0 OCTAL (O12 FORMAT)
; 1 FLOATING POINT (G12.5 FORMAT)
; 2 INTEGER (I12 FORMAT)
; 3 ASCII (A12 FORMAT)
; 4 DOUBLE PRECISION (G25.16)
;THE FOLLOWING CONVENTIONS HAVE BEEN ADOPTED FOR UNUSUAL
;ARGUMENT LISTS:
; 1. IF NO ARGUMENTS ARE GIVEN, THE ENTIRE USER AREA
; IS DUMPED IN OCTAL.
; 2. IF THE LAST MODE ASSIGNMENT, F(N), IS MISSING,
; THAT SECTION OF CORE IS DUMPED IN OCTAL.
; 3. IF THE LAST TWO ARGUMENTS, B(N) AND F(N), ARE MISSING
; AN OCTAL DUMP IS MADE FROM A(N) TO THE END OF USER AREA
; 4. AN ILLEGAL MODE ASSIGNMENT CAUSES THE DUMP TO BE
; MADE IN OCTAL.
;IF A GROUP OF REGISTERS HAVE THE SAME CONTENTS, DUMP AND
;PDUMP WILL FINISH PRINTING THE CURRENT LINE, THEN INDICATE THE NUMBER OF
;OF REPEATED LINES WITH A COMMENT
;LOCATION XXXXXX THROUGH XXXXXX CONTAIN XXXXXXXXXXXX
;ACCUMULATOR ASSIGNMENTS AND PARAMETER ASSIGNMENTS
P= 17 ;PUSHDOWN POINTER
B= 3 ;SCRATCH
C= 4 ;...
S= 5 ;ADDRESS OF LOCATION CURRENTLY DUMPED
F= 6 ;ADDRESS OF HIGH LOCATION TO BE DUMPED
I= 7 ;ARGUMENT INDICATOR
LL= 10 ;LOOP COUNTER
FRMT= 11 ;HOLDS FORMAT FOR REPEATED LINES
PP= 15 ;BLT AC, ALSO HOLDS A FORMAT ADDRESS
ARC= 12 ;-Number of args left
N==12 ;SIZE OF AC BLOCK TO BE SAVED ON PD LIST
DEVICE==-3 ;DEVICE ASSIGNMENT FOR PRINT
NLIST= 5 ;NO. OF DIFFERENT FORMAT DUMPS AVAILABLE
SEARCH FORPRM
FSRCH
TWOSEG 400000
HELLO (DUMP) ;BEGINNING OF DUMP ROUTINE
SETOM ENTFLG ;FLAG DUMP ENTRY = -1
JRST DUMPA ;HOP DOWN TO COMMON CODE
HELLO (PDUMP) ;BEGINNING OF PDUMP ROUTINE
SETZM ENTFLG ;FLAG PDUMP ENTRY = 0
;Note: The following "POP" is used to get the PC flags. This
; does not work if the program is running in a non-zero section.
; But we will check for that case a couple instructions later.
DUMPA: POP P,FLGLOC ;NEED FLAGS OUT OF PC WORD
PUSH P,FLGLOC ;RESTORE TO TOP OF STACK
IF20,< ;Get PC flags differently?
PUSH P,T1 ;Save an AC
XMOVEI T1,. ;What section are we running in?
TLNE T1,-1 ;Non-zero?
XSFM FLGLOC ;Yes, save PC flags the extended way.
POP P,T1 ;Restore T1
>;end IF20
PUSH P,P
PUSH P, PP ;SAVE BLT AC
HRRZI PP, 1(P) ;SET UP BLT POINTER IN AC PP
ADD P, NUMBER ;MAKE ROOM ON PUSHDOWN LIST
BLT PP, (P) ;BLT ACS ONTO PUSHDOWN LIST
PUSH P,L ;SAVE THE LINK OVER THE I/O CALLS
FUNCT OUT.##,<<XWD 0,DEVICE>,0,0,<IFIW MESS1>,25>
MOVE C, BYTEP ;GET BYTE POINTER FOR FLAGS
MOVEI F, 5 ;LOOP FOR FIVE FLAGS
FLAGS: ILDB B, C ;GET FLAG BIT STORED BY JSR
MOVE S, OFFON(B) ;GET EITHER "OFF" OR "ON"
FUNCT IOLST.##,<<XWD 001100,S>,0>
SOJG F, FLAGS ;LOOP BACK FOR MORE FLAGS
FUNCT FIN.##
FUNCT OUT.##,<<XWD 0,DEVICE>,0,0,<IFIW MESS2>,6>
CLEARB S, I ;AC0-AC7, SET INDICATOR TO ZERO
XMOVEI L,1+[XWD -2,0 ;2 args
XWD 001100,S
XWD 0,0] ;OUTPUT IT
D1: PUSHJ P,IOLST.##
CAIGE S, 7 ;WHICH CONTAINS 0,1,2,3,4,5,6,7
AOJA S, D1 ;LOOP BACK UNTIL DONE
XMOVEI F, -N(P) ;GET CONTENTS OF AC0-AC7 OFF PD
XMOVEI L,1+[XWD -2,0 ;2 args
XWD 001100,(F)
XWD 0,0] ;OUTPUT IT
MOVEI S,^D8 ;# of accumulators
D2: PUSHJ P,IOLST.##
SOJLE S,D2A ;Loop for 8 accumulators
AOJA F, D2
D2A: MOVEI S, 10 ;PRINT AC10 - AC17
XMOVEI L,1+[XWD -2,0 ;2 args
XWD 001100,S
XWD 0,0] ;OUTPUT IT
D3: PUSHJ P,IOLST.##
CAIGE S, 17 ;LOOP FOR 8 ACS
AOJA S, D3
XMOVEI S,-N-1(P) ;GET BLT AC ADDR
XMOVEI F,(P) ;GET L ADDR
XMOVEI C,-N-2(P) ;GET P ADDR ON ENTRY TO THIS ROUTINE
XMOVEI L,1+[XWD -7,0 ;7 args
XWD 002000,5
XWD 0,1
XWD 100,10
XWD 001100,(S)
XWD 001100,(F)
XWD 001100,(C)
XWD 004000,0]
PUSHJ P,IOLST.##
POP P,L ;RESTORE THE LINK FOR ARGUMENT PROCESSING
;ARGUMENT PROCESSOR
HLRE ARC,-1(L) ;Get -arg count
JUMPE ARC,ENDCHK ;No args: go dump all of core
;Come here to process a set of 3 args.
;L points to arg list
;ARC is -number of args left
SGET: SETZ I, ;Set to 1 if whole group of 3 args present
FUNCT OUT.##,<<XWD 0,DEVICE>,0,0,<IFIW MESS3>,1>
FUNCT FIN.##
AOJG ARC,SDOUT ;If no more args, quit
XMOVEI S,@0(L) ;Yes, pick up the address
AOJG ARC,ENDCK2 ;End of arg list
XMOVEI F,@1(L) ;No, F:= end address
AOJG ARC,ENDCK3 ;Jump if end of arg list
MOVE C,@2(L) ;No, C:= format type code
AOJ I, ;INDICATE THAT ALL 3 ARGUMENTS HAVE BEEN SEEN
CAIL C,NLIST ;IS THIS A LEGAL ARGUMENT?
JRST ENDCK3 ;No, DUMP IN OCTAL MODE
;Come here with:
;C = type of dump (0= Octal, 1= floating, etc.)
;S = Lowest location to be dumped
;F = Highest location to be dumped
;I = 0 if we defaulted any args because they were missing,
; = 1 if all three args were present.
SCHEK: CAML S, F ;ARE ARGUMENTS IN ORDER?
EXCH S, F ;NO, SWITCH THEM
MOVE PP,C ;COPY ARG TO PP FOR USE IN ARG BLOCKS
MOVE B,TABLE(C) ;V6 SET UP FORTRAN DATA UUO
DPB B,[POINT 4,IOLSTC,12] ;V6 DEPOSIT POINTER
DPB B,[POINT 4,IOLSTS,12] ;V6 ....
;MAIN DUMP PROCESSOR
DPROC: PUSH P,L ;SAVE THE LINK AFTER ARGUMENT PROCESSING
DPROC1: MOVE B, S ;GET CURRENT ADDRESS IN B
MOVE LL, S ;POINTER IN REPETITION CHECK
;** Be careful here with indexing when GLOBAL addresses are allowed.
; If LH of index word is zero, effective address is "current section".
MOVE C,@S ;MEMORY WORD FOR REPETITION CHECK
LOOK: CAMN C,@LL ;DO WORDS MATCH?
CAMGE F,LL ;Yes, Finished this section of code?
JRST DIFF ;GO COMPUTE REPEATED LINES
XMOVEI T1,@S ;"end of a line"
ADDI T1,7 ; . .
CAML LL,T1 ;Finished checking a line?
ADDI S, 10 ;YES, INCREMENT S TO NEXT LINE
CAMG S,F ;STILL IN RANGE
AOJA LL, LOOK ;INCREMENT POINTER, CHECK MORE
DIFF: CAMN B, S ;WERE ANY LINES REPEATED?
JRST OLOOP0 ;NO, DUMP THIS LINE INDIVIDUALLY
;"Locations n thru m contain "
PUSH P,C ;Save the contents of the word to print
MOVE C,S ;Last loc
SUBI C,1 ; Off by one
FUNCT OUT.##,<<XWD 0,DEVICE>,0,0,<IFIW MESS4>,12>
XMOVEI L,1+[XWD -3,0 ;3 args
XWD 001100,B ;PRINT PART ABOUT ADDRESSES
XWD 001100,C ;FIRST LOCATION THAT REPEATED
XWD 004000,0] ;LAST LOCATION, S WAS ONE OFF
PUSHJ P,IOLST.## ;END OF REPETITION MESSAGE
POP P,C ;Get back contents
;..contain . <output the word>.
XMOVEI L,ARG1 ;YES GET FORMAT FOR MESSAGE
PUSHJ P,OUT.##
XMOVEI L,IOLSTC ;OUTPUT REPEATED WORD
PUSHJ P,IOLST.##
;LOOP FOR OUTPUTTING WORDS
OLOOP0: MOVE C,LIST2(PP) ;PICK UP FORMAT TYPE
OLOOP1: CAMLE S, F ;ALL DONE DUMPING?
JRST NEXT1 ;YES, CHECK ARGUMENTS
XMOVEI L,ARG2 ;NO, OUTPUT FOR 8 WORDS/LINE
PUSHJ P,OUT.##
MOVEI B,^D8 ;LOOP COUNTER
XMOVEI L,1+[XWD -2,0 ;2 args
XWD 001100,S
XWD 0,0]
PUSHJ P,IOLST.##
OLOOP2: XMOVEI L,IOLSTS ;ADDRESS FOR THIS LINE
PUSHJ P,IOLST.## ;MEMORY WORD
CAML S, F ;ALL DONE DUMPING
JRST NEXT ;YES, CHECK ARGUMENTS
CAIE PP,DFMNM ;Double precision?
AOJA S,OLOOP3 ;NO, MOVE POINTER TO NEXT WORD
ADDI S,2 ;YES, ADVANCE POINTER ONE WORD
SOJ B, ;OUTPUTS ONLY 4 WORDS
OLOOP3: SOJG B,OLOOP2 ;DONE WITH THIS LINE?
PUSHJ P,FIN.## ;YES, FINISH OFF FORMAT STATEMENT
JRST DPROC1 ;SCAN NEXT LINE
;ARGUMENT BLOCKS
XWD -5,0
ARG1: XWD 0,DEVICE
XWD 0
XWD 0
XWD 410035,LIST1 ;IFIW, INDIRECT BIT ON AND PP(R15) AS INDEX REG
XWD 4
XWD -2,0
IOLSTC: XWD 001100,C
XWD 004000,0
XWD -5,0
ARG2: XWD 0,DEVICE
XWD 0
XWD 0
XWD 410035,LIST2 ;IFIW, INDIRECT BIT ON AND PP(R15) AS INDEX REG
XWD 4
XWD -2,0
IOLSTS: XWD 001120,S ;INDIRECT BIT ON
XWD 0,0
;ROUTINES THAT ARE CALLED AT TERMINATION OF ARGUMENT STRINGS,
;AND END OF CORE SECTION DUMPS
;** Note: Upper, lower limits for "all of core" must be changed
; when extended addressing is implemented:
; these are GLOBAL addresses, not LOCAL section addresses!
ENDCHK: HRRZI S, 20 ;DUMP FROM 20
ENDCK2: HRRZ F, .JBFF ;TO END OF USER AREA
SUBI F,1 ;DO NOT DUMP FIRST FREE
ENDCK3: SETZ C, ;Set OCTAL mode
JRST SCHEK ;FIX EXIT, CHECK CORE LIMITS
;Here when done dumping all args
SDOUT:
MOVEM L, L+1-N(P) ;SAVE EXIT ACCUMULATOR
HRLZI PP, 1-N(P) ;FIX BLT POINT AC
BLT PP, N-1 ;GET ACS BACK FROM PD LIST
SUB P, NUMBER ;FIX UP PUSHDOWN POINTER
POP P, PP ;RESTORE BLT AC
POP P,(P) ;DECREMENT STACK POINTER BY ONE
SKIPE ENTFLG ;IS IT THE PDUMP ENTRY?
JRST SDOUT1 ;NO - DUMP
GOODBY ;PDUMP - RETURN TO USER
SDOUT1: FUNCT (EXIT.) ;DUMP - EXIT
;Here when this dump is finished.
NEXT: PUSHJ P,FIN.## ;FINISH FORMAT
NEXT1: POP P,L ;RESTORE THE LINK
JUMPE I, SDOUT ;MORE ARGUMENTS TO COME?
ADDI L,3 ;Yes, saw 3 args last time, Bump arg ptr.
JRST SGET ;GO GET SOME MORE ARGUMENTS
;FORMAT STATEMENTS FOR OUTPUT
MESS1: ASCII "(1H148X9HCORE DUMP/1H 7HOv flag17X9HCry0"
ASCII " flag15X9HCry1 flag15x12HFlt ov flag 13X"
ASCII "8HFPD flag/1H 5(A9,15X))"
MESS2: ASCII "(2(1H-8(9X3HAC O2)/7X8O14/))"
MESS3: ASCII "(1H-)"
MESS4: ASCII "(11H+Locations O10,9H through O10,9H contain /1H )"
;MORE FORMAT STATEMENTS AND SOME CONSTANTS, TOO
OFRMT: ASCII "(1H0,O10,8O14)"
EFRMT: ASCII "(1H0,O10,8G14.5)"
IFRMT: ASCII "(1H0,O10,8I14)"
AFRMT: ASCII "(1H0,O10,8A14)"
DFRMT: ASCII "(1H0,O10,4G25.16)"
OFRMT2: ASCII "(1H0,40X,O14)"
EFRMT2: ASCII "(1H0,40X,G14.5)"
IFRMT2: ASCII "(1H0,40X,I14)"
AFRMT2: ASCII "(1H0,40X,A14)"
DFRMT2: ASCII "(1H0,40X,G25.16)"
LIST1: IFIW OFRMT2
IFIW EFRMT2
IFIW IFRMT2
IFIW AFRMT2
IFIW DFRMT2
LIST2: IFIW OFRMT
IFIW EFRMT
IFIW IFRMT
IFIW AFRMT
IFIW DFRMT
DFMNM==.-LIST2-1 ;D format index
OFFON: ASCII "OFF "
ASCII "ON "
TABLE: EXP TP%SPO,TP%SPR,TP%INT,TP%LIT,TP%DPR
BYTEP: POINT 1,FLGLOC
NUMBER: XWD N, N
RELOC ;DATA
FLGLOC: BLOCK 1 ;TO STORE PC WORD FROM TOP OF STACK
ENTFLG: BLOCK 1 ;FLAG FOR WHICH ENTRY
RELOC
PRGEND
TITLE ILL ZERO INPUT WORD ON ILLEG. CHARACTERS
SUBTTL D. TODD /DRT/DMN/TWE/SWG 20-Aug-79
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 VERSION V.032(323)
;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 FOROTS. AT THE END
;OF EACH FORMAT STATEMENT.
;THE CALLING SEQUENCE IS PUSHJ P,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 PUSHJ P,LEGAL
SEARCH FORPRM
EXTERNAL FOROP.
TWOSEG 400000
HELLO (ILL)
MOVEI T0,FO$ILL ;Function code in T0
XMOVEI T1,ILLEG ;FOROP. returns addr. here
PUSHJ P,FOROP. ;FOROP RETURNS ADDRESS
SETOM @ILLEG ;SET ILL CH FLAG
GOODBY
HELLO (LEGAL)
MOVEI T0,FO$ILL ;T0:= function code
XMOVEI T1,ILLEG ;T1:= Address to return adr in
PUSHJ P,FOROP. ;GET ADDRESS OF ILLEGAL FLAG
SETZM @ILLEG ;CLEAR ILL CH FLAG
GOODBY
RELOC 0 ;SEPARATE DATA
ILLEG: BLOCK 1
PRGEND
TITLE SAVFMT
;CODE TO ENCODE THE FORMAT IN AN ARRAY
;CALLS FOROP TO CALL %FMTSV IN FOROTS
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (SAVFMT)
MOVEI T0,FO$FSV ;Function code
;No arg used
PUSHJ P,FOROP.
GOODBY
PRGEND
TITLE CLRFMT
;CODE TO THROW AWAY THE ENCODING OF A FORMAT IN AN ARRAY
;CALLS FOROP TO CALL %FMTCL IN FOROTS
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (CLRFMT)
MOVEI T0,FO$FCL ;SETUP FOR FOROP
;No arg used
PUSHJ P,FOROP.
GOODBY
PRGEND
TITLE LSNGET
;FUNCTION WHICH RETURNS THE INTEGER VALUE OF THE LINE SEQUENCE NUMBER
;OF THE CURRENT LINE FOR MODE=LINED
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (LSNGET)
MOVEI T0,FO$GLN ;Return current line number
MOVE T1,@(L) ;GET CHANNEL #
PUSHJ P,FOROP. ;Returns line number in T0
DMOVEM T2,SAVE2 ;SAVE 2 AC'S
MOVEI T3,5 ;5 CHARS IN LSN
SETZB T1,T2 ;CLEAR THE NUMBER
LSNLP: ROTC T0,7 ;GET A CHAR
JUMPE T1,LSNENL ;SKIP NULLS
CAIN T1," " ;CONVERT SPACE TO "0"
MOVEI T1,"0"
CAIG T1,"9" ;MAKE SURE IT'S LEGAL
CAIGE T1,"0"
JRST LSNILL ;NOT LEGAL
IMULI T2,^D10 ;MUL PREVIOUS BY 10
ADDI T2,-"0"(T1) ;ACCUMULATE NUMBER
SETZ T1, ;AND CLEAR FOR NEW DIGIT
LSNENL: SOJG T3,LSNLP
MOVE T0,T2 ;RETURN THE INTEGER
DMOVE T2,SAVE2 ;Restore acs
GOODBY
LSNILL: MOVNI T0,1 ;-1=ILLEGAL CHAR IN LSN
DMOVE T2,SAVE2 ;Restore acs
GOODBY
RELOC ;DATA
SAVE2: BLOCK 2 ;FOR THE AC'S
PRGEND
TITLE DATE TODAY'S DATE
SUBTTL D. TODD /DRT/KK/DMN/SWG 15-AUG-79
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 VERSION V.32(433)
;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:
; MOVEI L,ARGBLK
; PUSHJ P,DATE
SEARCH FORPRM
FSRCH
TWOSEG 400000
HELLO (DATE) ;ENTRY TO DATE ROUTINE.
IF10,<
MOVEI T1,@(L) ;GET ADDRESS OF 2 WORD ARRAY
MOVEM T2,0(T1) ;SAVE THE CONTENTS OF AC T2.
MOVEM T3,1(T1) ;SAVE THE CONTENTS OF AC T3.
CALLI T1,14 ;GET THE DATE FROM THE MONITOR.
IDIVI T1,^D31 ;DIV. BY 31 TO OBTAIN THE DAY-1.
ADDI T2,1 ;TO OBTAIN THE DAY.
IDIVI T2,^D10 ;CONVERT INTO TWO DEC. DIGITS.
SKIPN T2 ;IS THE DAY .LT. 10?
MOVNI T2,20 ;YES, OUTPUT BLANK.
MOVEI T0,"0"(T2) ;GET FIRST DIGIT
LSH T0,7 ;MAKE SPACE
ADDI T0,"0"(T3) ;ADD IN 2ND DIGIT
IDIVI T1,^D12 ;TO OBTAIN THE MONTH
EXCH T1,T2 ;SAVE YEAR IN T2
MOVE T1,TABLE(T1) ;GET MONTH IN T1
LSHC T0,3*7 ;LEFT JUSTIFY 0 & 1
LSH T0,1 ;0 = ASCII /DD-MO/
;1 = ASCII /N-/
MOVEI T2,^D64(2) ;GET THE YEAR
IDIVI T2,^D10 ;CONVERT INTO TWO DEC. DIGITS
ADDI T2,"0" ;MAKE ASCII
ADDI T3,"0"
LSH T2,2*7+1 ;SHIFT TO CHAR 3
LSH T3,7+1 ;SHIFT TO CHAR 4
ADD T3,T2 ;ADD IN TO T3
ADD T3,T1 ;SO LOW WORD IS IN T3
ADDI T3,40*2 ;Make space for last character instead of NULL;
; this allows compare of literal to work, since
; FORTRAN pads the word with spaces.
MOVE T2,T0 ;PUT HIGH ORDER RESULT IN 2
MOVEI T1,@(L) ;USER ADDRESS
EXCH T2,0(T1) ;RESTORE T2
EXCH T3,1(T1) ;AND T3 WHILE STORING RESULT
POPJ P,
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-/
> ;END IF10
IF20,< ;BEGIN -20 ONLY CODE
HRROI T1,SVDT ;Point to address for result
SETO T2, ;ASK FOR TODAY'S DATE
MOVX T3,OT%NTM ;DO NOT WANT TIME
ODTIM% ;DO THE JSYS
DMOVE T1,SVDT ;Get returned date
ADDI T2,40*2 ;Change NULL to SPACE
; This allows compare of literal to work, since
; FORTRAN pads the word with spaces.
DMOVEM T1,@0(L) ; Store in user's array.
POPJ P, ;AND RETURN
RELOC ;DATA
SVDT: BLOCK 2 ;Place to store ODTIM% results
> ;END IF20
PRGEND
TITLE TIM2GO RETURN TIME LIMIT IN SECONDS
SUBTTL H. P. WEISS/SWG 20-AUG-79
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
FSRCH
TWOSEG 400000
IF10,< ;BEGIN TOPS-10 CODE
HELLO (TIM2GO) ;DEFINE ENTRY POINT
PUSH P,T1 ;GRAB A REGISTER
MOVE T1,[44,,11] ;DETERMINE JIFFIES PER SECOND
GETTAB T1, ;VIA GETTAB
JRST NEVER ;UNIMPLEMENTED
FSC T1,233 ;CONVERT TO FLOATING POINT
MOVE T0,[-1,,40] ;DETERMINE TIME LIMIT
GETTAB T0, ;VIA GETTAB
JRST NEVER ;UNIMPLEMENTED
TLZ T0,777700 ;CLEAR EXTRA BITS
JUMPE T0,NEVER ;RETURN INFINITY IF 0
FSC T0,233 ;CONVERT TO FLOATING POINT
FDVR T0,T1 ;COMPUTE SECONDS TILL EXPIRATION
DONE: POP P,T1 ;RESTORE REGISTER USED
GOODBY (0) ;RETURN
NEVER: HRLOI T0,377777 ;SET LIMIT TO INFINITY
JRST DONE
> ;END IF10
IF20,< ;TOPS-20 CODE
ENTRY TIM2GO
TIM2GO: PUSH P,T1 ;SAVE ACS
PUSH P,T2
PUSH P,T3
SETO T1, ;SET T1 TO -1 TO GET THIS JOB'S TIME
MOVE T2,[-3,,TBLK] ;SET UP POINTER TO BLOCK FOR RETURN VALS
MOVX T3,.JIRT ;START AT RUNTIME FIELD IN STRUCTURE
GETJI% ;DO THE JSYS
JRST NEVER
SKIPN T1,TBLK+2 ;PICK UP TIME LIMIT
JRST NEVER ;LIMIT IS 0 THEREFORE INFINITY
MOVE T2,TBLK ;PICK UP RUNTIME
SUB T1,T2 ;GET DIFFERENCE BETWEEN RUNTIME AND TIME LIMIT
FLTR T0,T1 ;AND FLOAT IT
FDVRI T0,(1000.0) ;CONVERT MILLISECONDS TO SECONDS
DONE: POP P,T3 ;RESTORE ACS
POP P,T2
POP P,T1
POPJ P,
NEVER: HRLOI T0,377777
JRST DONE
RELOC ;DATA
TBLK: BLOCK 3
RELOC
> ;END IF20
PRGEND ;END OF TIM2GO
TITLE TIME TIME OF DAY
SUBTTL /KK/SWG/EDS/EGM
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 %2.(120)
;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:
; XMOVEI L,ARGBLK
; PUSHJ P,TIME
;ON THE -10, TIME OBTAINS THE TIME FROM THE MONITOR IN THE FORM:
; TIME=THE NUMBER OF MILLISECONDS SINCE MIDNIGHT.
;ON THE -20, TIME OBTAINS THE INTERNAL TIME FROM THE MONITOR AND
;CONVERTS IT INTO MILLISECONDS SINCE MIDNIGHT, DOES THE SAME CONVERSION
;FROM THERE AS ON THE -10, BUT ALSO HAS TO CORRECT FOR GREENWICH MEAN TIME
;WHICH IS THE TIME THE -20 INTERNAL TIME IS STORED IN.
SEARCH FORPRM
TWOSEG 400000
SALL ;FOR HELLO MACRO - SEE BELOW
HELLO (TIME)
FSRCH ;MUST FOLLOW HELLO MACRO TO AVOID OLD TIME JSYS
PUSH P,T2 ;SAVE AC 2
PUSH P,T3 ;SAVE AC 3
IF10,<
MSTIME T1, ;GET TIME IN MILLISECS FROM THE MONITOR.
> ;END IF10
IF20,<
GTAD% ;GET INTERNAL TIME
HRLZ T1,T1 ;Put into left half
LSH T1,-1 ;
MUL T1,[^D86400000] ;COMPUTE NO OF MS SINCE MIDNIGHT
;INTO AC1 -
> ;END IF20
IDIVI T1,^D60000 ;TOTAL MINS. IN 1, LEFTOVER MSECS. IN 2.
MOVEM T2,TEMP1 ;SAVE THE LEFTOVER MS
IDIVI T1,^D60 ;HOURS IN 1, MINUTES IN 2.
IF20,< ;CORRECT FOR TIME ZONE ON -20
SKIPE T3,TZCOR ;PICK UP TIME ZONE CORRECTION IF IT'S SET
JRST TIME01 ;YES - IT'S SET - KEEP ON TRUCKIN
PUSH P,T4 ;NEED ANOTHER AC FOR THIS JSYS
PUSH P,T2 ;SAVE T2 WHICH IS USED FOR JSYS
SETO T2, ;T2 gets -1
SETZ T4, ;ZERO T4 FOR JSYS TO SAY LOCAL TIME
ODCNV% ;USE THIS JSYS TO FIND TIME ZONE
HLRZ T3,T4 ;PICK UP LEFT HALF WHICH HAS INTERESTING INFO
TRZ T3,<^-<(IC%TMZ)>> ;ZERO EVERYTHING EXCEPT TIME ZONE (B12-B17)
TRZE T3,40 ;IS TIME ZONE NEGATIVE? (RANGE IS -12 to +12)
MOVN T3,T3 ;YES - NEGATE IT
TXNE T4,IC%ADS ;IS DAYLIGHT SAVINGS IN EFFECT?
SUBI T3,1 ;YES - SUBTRACT ONE HOUR
MOVEM T3,TZCOR ;STORE TIME ZONE CORRECTION FACTOR FOR NEXT TIME
POP P,T2 ;RESTORE T2 WHICH HOLDS MINUTES
POP P,T4 ;RESTORE T4
TIME01: SUB T1,T3 ;CORRECT FOR TIMEZONE AND DAYLIGHT SAVINGS
SKIPGE T1 ;DID TIME GO NEGATIVE?
ADDI T1,^D24 ;YES, GET IT MOD 24 HOURS
> ;END IF20
MOVEM T2,TEMP2 ;SAVE THE MINUTES.
XMOVEI T0,@0(L) ;Get address of first argument
$BLDBP T0 ;Build a byte pointer
MOVEM T0,HLDBP ;Save it away
JSP T3,SUB1 ;GO TO SUBR. TO SET UP HR. IN ASCII.
MOVEI T1,":" ;SET UP ":".
IDPB T1,HLDBP ;Deposit ":" in the word.
MOVE T1,TEMP2 ;PICK UP THE MINUTES.
JSP T3,SUB1 ;GO TO SUBR. TO SET UP MIN. IN ASCII.
HLRZ T3,-1(L) ;FORTRAN-10 - GET ARGUMENT COUNT
CAIE T3,-2 ;TWO ARGUMENTS?
JRST OUT1 ;NO - RETURN NOW
TIME02:
XMOVEI T0,@1(L) ;Get address of second argument
$BLDBP T0 ;Build a byte pointer
MOVEM T0,HLDBP ;Save it away
MOVEI T1," " ;PUT IN A BLANK AS THE FIRST
IDPB T1,HLDBP ;CHARACTER IN THE 2ND WORD.
MOVE T1,TEMP1 ;PICK UP THE MSECONDS.
IDIVI T1,^D1000 ;SECONDS IN 1, LEFTOVER MSECS. IN 2.
MOVEM T2,TEMP1 ;SAVE THE MSECS.
JSP T3,SUB1 ;GO TO SUBR. TO SET UP THE SECS. IN ASCII.
MOVEI T1,"." ;SET UP "."
IDPB T1,HLDBP ;IN THE WORD.
MOVE T2,TEMP1 ;PICK UP THE MSECS.
IDIVI T2,^D100 ;GET THE TENTH OF A SECOND.
MOVEI T2,"0"(2) ;MAKE IT ASCII
IDPB T2,HLDBP ;PUT IT IN THE SECOND WORD.
OUT1: POP P,T2 ;RESTORE AC 2.
POP P,T3 ;RESTORE AC 3.
POPJ P, ;RETURN
SUB1: IDIVI T1,^D10 ;SUBROUTINE ENTRY POINT.
MOVEI T1,"0"(T1) ;MAKE IT ASCII
IDPB T1,HLDBP ;DEPOSIT IT IN THE WORD.
MOVEI T2,"0"(T2) ;MAKE IT ASCII
IDPB T2,HLDBP ;DEPOSIT IT IN THE WORD.
JRST (T3) ;RETURN TO MAIN SEQUENCE.
RELOC ;DATA
TZCOR: BLOCK 1 ;SAVE TIME ZONE CORRECTION HERE
TEMP1: 0
TEMP2: 0
HLDBP: BLOCK 1 ;Saved byte ptr
RELOC
PRGEND
TITLE SLITE SENSE LITE SETTING AND TESTING FUNCTION
SUBTTL D. TODD /DRT/TWE/SWG 20-AUG-1979
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 VERSION V.032(323)
;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:
; MOVEI L,ARGBLK
; PUSHJ P,SLITET
;IT TAKES TWO ARGUMENTS I AND 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:
; MOVEI L,ARGBLK
; PUSHJ P,SLITE
;SLITE TAKES ONE ARGUMENT 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
TWOSEG 400000
HELLO (SLITE) ;ENTRY TO SLITE PROGRAM
MOVN T1, @(L) ;GET ARGUMENT
JUMPE T1, SLITE2 ;IS IT ZERO?
MOVSI T0, 400000 ;NO, PUT A ONE IN BIT 0
ROT T0, 1(T1) ;ROTATE IT INTO POSITION
MOVE T1, LITES ;GET THE SENSE LIGHTS
TDO T1, T0 ;TURN ON PROPER LIGHT
SLITE2: MOVEM T1, LITES ;SAVE NEW SENSE LIGHTS
GOODBY (1) ;RETURN
HELLO (SLITET) ;ENTRY TO SENSE TESTING PROGRAM
MOVN T1, @(L) ;PICK UP ARGUMENT
MOVSI T0, 400000 ;PUT A ONE IN BIT 0
ROT T0, 1(T1) ;ROTATE IT INTO POSITION
MOVEI T1, 1 ;SET ANSWER TO ONE FOR NOW
MOVEM T1, @1(L) ;...
MOVE T1, LITES ;PICK UP SENSE LIGHTS
TDZN T1,T0 ;IS THE PROPER LIGHT ON?
AOS @1(L) ;NO, CHANGE ANSWER TO 2
MOVEM T1,LITES ;RESTORE WITH TESTED LIGHT OFF
GOODBY (2) ;RETURN
RELOC ;DATA
LITES: 0
RELOC
PRGEND
TITLE SSWTCH DATA SWITCH TESTING FUNCTION
SUBTTL D. TODD /DRT/TWE/SWG/EDS 16-Mar-81
;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,1981 BY DIGITAL EQUIPMENT CORPORATION
;FROM LIB40 VERSION V.032(323)
; DATA SWITCH TESTING PROGRAM
;THIS PROGRAM IS CALLED IN THE FOLLOWING MANNER:
; MOVEI L, ARGBLK
; PUSHJ P,SSWTCH
;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.
;ON TOPS-20, THE SWITCHES ARE NOT AVAILABLE, THEREFORE SSWTCH WILL
; ALWAYS RETURN AN ANSWER OF 1. WE ARE KEEPING THE ROUTINE AROUND
;FOR COMPATIBILITY
SEARCH FORPRM
FSRCH
TWOSEG 400000
HELLO (SSWTCH) ;ENTRY TO SSWTCH PROGRAM
IF10,< ;ONLY MAKES SENSE ON A -10
MOVN T1, @(L) ;PICK UP ARGUMENT
MOVSI T0, 400000 ;PUT A ONE IN BIT 0
ROT T0,(T1) ; ROTATE BIT INTO POSITION
MOVEI T1,2 ; SET ANSWER TO 2 FOR NOW
MOVEM T1, @1(L) ;...
SWITCH T1, ;GET DATA SWITCHES FROM MONITOR
MOVEI T1,2 ; SET ANSWER TO 2 FOR NOW
SOS @1(L) ; NO, CHANGE ANSWER TO ONE
> ;END IF10
IF20,<
MOVEI T1,1 ;ALWAYS SAY NO
MOVEM T1,@1(L) ;STORE IN USER'S VARIABLE
> ;END IF20
GOODBY (2) ;RETURN
PRGEND
TITLE ERRSET SET APR TRAP PARAMETERS
SUBTTL CHRIS SMITH/CKS
;Call:
; CALL ERRSET (N)
;or CALL ERRSET (N, I)
;or CALL ERRSET (N, I, SUBR)
;
;where N = max number of error messages to type
;
; I = which error this call applies to. One of:
; -1 any of the following
; 0 integer overflow
; 1 integer divide check
; 4 floating overflow
; 5 floating divide check
; 6 floating underflow
; 8 library routine error
; 9 output field width too small
; if I is not specified, -1 is assumed
;
; SUBR = routine to call on the trap
; The effect is as if
; CALL SUBR (I, IPC)
; were placed in the program just after the instruction causing
; the trap.
; I = error number of trap, same as above
; IPC = PC of trap instruction
; (or if error number= 9, IPC = PC of PUSHJ 17,IOLST.)
; if SUBR is not specified, no routine is called on the APR trap.
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (ERRSET)
MOVEI T0,FO$APR ;T0:= function code
XMOVEI T1,APRCT ;Read apr table addresses to here
PUSHJ P,FOROP. ;READ THEM
MOVSI T1,(IFIW (T2)) ;MAKE INDIRECT WORDS INDEXED BY T2
HLLM T1,APRCT ;POINTING TO ERROR COUNT TABLE
HLLM T1,APRLM ;AND ERROR MESSAGE LIMIT TABLE
HLLM T1,APRSB ;AND SUBROUTINE ADDRESS TABLE
HLL L,-1(L) ;GET ARG COUNT
SETO T2, ;DEFAULT IS ALL ERRORS
SETZ T3, ;DEFAULT SUBROUTINE IS NONE
MOVE T1,@(L) ;GET ERR MESSAGE LIMIT
AOBJP L,ERSET1 ;IF OUT OF ARGS, GO STORE THEM
MOVE T2,@(L) ;GET ERROR NUMBER
AOBJP L,ERSET1 ;IF OUT OF ARGS, GO STORE THEM
MOVEI T3,@(L) ;GET ROUTINE TO CALL
ERSET1: CAILE T2,.ETLST ;REASONABLE ERROR NUMBER?
SETO T2, ;NO, SET TO DEFAULT
CAIGE T2,0 ;DID USER SPECIFY ALL ERRORS?
MOVSI T2,-<.ETNUM> ;YES, GET AOBJN POINTER
ERSETL: MOVE T4,T1 ;GET ERR MESSAGE LIMIT
ADD T4,@APRCT ;ADD TO NUMBER THAT ALREADY HAPPENED
MOVEM T4,@APRLM ;STORE ERR MESSAGE LIMIT
MOVEM T3,@APRSB ;STORE SUBROUTINE ADDRESS OR 0
AOBJN T2,ERSETL ;SET ALL ERRORS IF THAT'S WHAT HE WANTS
POPJ P, ;DONE
RELOC ;DATA
APRCT: BLOCK 1 ;ADDRESS OF APR ERROR COUNTS
APRLM: BLOCK 1 ;ADDRESS OF APR ERROR LIMITS
APRSB: BLOCK 1 ;ADDRESS OF APR ERROR SUBROUTINES
RELOC
PRGEND
TITLE ERRSNS READ LAST IO ERROR
SUBTTL CHRIS SMITH/CKS
;Call:
; CALL ERRSNS (I,J)
;or CALL ERRSNS (I,J,MSG)
;
;I and J are returned with the First number and the Second number
;for the last error
;
;MSG, if present, is a 16-word array returned holding the text
;of the message for the last error
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (ERRSNS)
MOVEI T0,FO$ERR ;Read error numbers
XMOVEI T1,ERRNUM ;To block beginning here
PUSHJ P,FOROP. ;READ THEM
HLRE T1,-1(L) ;GET ARG COUNT
MOVN T1,T1 ;MAKE POSITIVE
MOVE T2,ERRNUM ;STORE ERR NUMBERS
CAIL T1,1
HLRZM T2,@0(L)
CAIL T1,2
JRST [HRRZ T2,T2 ;Get RH only
CAIN T2,-1 ;-1?
SETO T2, ;Yes, make full word
MOVEM T2,@1(L) ;Store 2nd ERR number
JRST .+1]
CAIGE T1,3 ;STRING SPECIFIED?
POPJ P, ;NO, DONE
MOVE T1,ERRMSA ;GET MSG ADDRESS
HRLI T1,(POINT 7,)
MOVEI T2,@2(L) ;GET STRING ADDRESS
HRLI T2,(POINT 7,)
MOVEI T3,^D80 ;COUNT 80 CHARS
ERRLP: ILDB T4,T1 ;GET CHAR
JUMPE T4,ERREND ;NULL IS END
IDPB T4,T2 ;STORE CHAR
SOJG T3,ERRLP
ERREND: JUMPLE T3,ERRRET ;IF 80 CHARS, DONE
MOVEI T1," " ;PAD WITH TRAILING SPACES
IDPB T1,T2
SOJG T3,.-1
ERRRET: POPJ P, ;DONE
RELOC ;DATA
ERRNUM: BLOCK 1 ;ERR NUMBERS
ERRMSA: BLOCK 1 ;ERR MSG ADDRESS
RELOC
PRGEND
TITLE DIVERT DIVERT ERROR MESSAGE OUTPUT
SUBTTL CHRIS SMITH/CKS
;Call:
;
; CALL DIVERT (U)
;where U is the unit number of an open unit, sends error messages
;to U instead of to the TTY. If U is -1, the diversion is ended.
;
; CALL CHKDIV (U)
;sets U to the unit number where errors are diverted, or -1 if none
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (CLRDIV)
SETO T1, ;Same as saying "UNIT=-1"
JRST DIV01 ; (Should always return status 0)
HELLO (DIVERT)
MOVE T1,@(L) ;Get unit number
DIV01: MOVEI T0,FO$DIV ;Do diversion
PUSHJ P,FOROP.
;Status is returned in T1.
;T1: = 0 means ok.
; = 1 means ?Illegal unit number.
; = 2 means ?unit not open
; = 3 means ?Not open for FORMATTED IO
; = 4 means ?Can't write to unit.
PJRST @DIVRT(T1)
;Indexed by status value
DIVRT: IFIW DIVRET ;(0) OK, return
IFIW ILLDV ;(1) Illegal unit
IFIW UNO ;(2) Unit not open
IFIW NOF ;(3) Not open for FORMATTED IO
IFIW CWU ;(4) Can't write to unit
ILLDV: LERR (LIB,?,DIVERT: illegal to divert to unit $D,<@(L)>,DIVRET)
UNO: LERR (LIB,?,DIVERT: unit $D is not open,<@(L)>,DIVRET)
NOF: LERR (LIB,?,DIVERT: unit $D is not open for FORMATTED I/O,<@(L)>,DIVRET)
CWU: LERR (LIB,?,DIVERT: Can't write to unit $D,<@(L)>,DIVRET)
DIVRET: POPJ P, ;DONE
HELLO (CHKDIV)
MOVEI T0,FO$GDV ;Get divert unit
PUSHJ P,FOROP.
MOVEM T1,@(L) ;Return unit number
POPJ P, ;Done
PRGEND
TITLE OVERFL RETURN OVERFLOW INFO
SUBTTL CHRIS SMITH/CKS/EGM
;Call:
;
; CALL OVERFL (IANS)
;
;If any overflow, underflow, or divide check has occurred since the last
;call to OVERFL, IANS is set to 1 and T0 is set to -1; if not, IANS is
;set to 2 and T0 is set to 0.
;
; Note to maintainers: The "magic" number 8 that appears in this routine
;is because APR counts 0 thru 7 are various arithmetic traps.
;The entry number is determined by 3 PC flag bits in combination.
SEARCH FORPRM
EXTERN FOROP.
TWOSEG 400000
HELLO (OVERFL)
PUSH P,T2 ;SAVE
PUSH P,T3 ; REGS
MOVEI T0,FO$APR ;Read APR table addresses
XMOVEI T1,APRCT ;Into here
PUSHJ P,FOROP. ;READ THEM
MOVSI T1,(IFIW (T1)) ;MAKE INDIRECT WORD INDEXED BY T1
HLLM T1,APRCT ;POINTING TO COUNT TABLE
MOVSI T1,-8 ;MAKE AOBJN POINTER TO TABLES
MOVEI T2,2 ;INIT ANSWER TO 2 (NO OVERFLOWS)
OVLP: MOVE T3,@APRCT ;GET CURRENT COUNT
CAMLE T3,OLDCT ;GREATER THAN OLD COUNT?
MOVEI T2,1 ;YES, SET ANSWER TO 1 (OVERFLOW OCCURRED)
AOBJN T1,OVLP ;LOOK THROUGH WHOLE TABLE
MOVEM T2,@0(L) ;STORE ANSWER FOR CALLER
HRLZ T1,APRCT ;BLT TABLE VALUES FOR NEXT CALL
HRRI T1,OLDCT
BLT T1,OLDCT+7
SETZM T0 ;ASSUME NO OVERFLOW, T0=FALSE
CAIN T2,1 ;WAS THERE?
SETOM T0 ; YES, SET T0=TRUE
POP P,T3 ;RESTORE
POP P,T2 ; REGS
POPJ P, ;DONE
RELOC ;DATA
OLDCT: BLOCK 8 ;PREVIOUS APR COUNTS
APRCT: BLOCK 1 ;ADDRESS OF CURRENT APR COUNTS
APRLM: BLOCK 1 ;ADDRESS OF LIMITS
APRSB: BLOCK 1 ;ADDRESS OF SUBROUTINES
RELOC
PRGEND
TITLE TRACE DUMMY ROUTINE DEFINES 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,1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH FORPRM
NOSYM
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 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,1981 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 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,1981 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 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,1981 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 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,1981 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 LOGOVL SUBROUTINE TO SET LOG 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,1981 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY LOGOVL
LOGOVL=LOGOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE TMPOVL SUBROUTINE TO SET WRITABLE 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,1981 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY TMPOVL
TMPOVL=TMPOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE SAVOVL SUBROUTINE TO MARK LINK AS WRITABLE
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,1981 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY SAVOVL
SAVOVL=SAVOV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE CLROVL SUBROUTINE TO MARK LINK AS NOT WRITABLE
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,1981 BY DIGITAL EQUIPMENT CORPORATION
VERWHO==0 ;EDITOR
VERVER==1 ;MAJOR VERSION NUMBER
VERUPD==0 ;MINOR VERSION NUMBER
VEREDT==1 ;EDIT NUMBER
ENTRY CLROVL
CLROVL=CLROV.## ;REAL SUBROUTINE IS IN OVRLAY
PRGEND
TITLE FDDT - DUMMY FORDDT
SUBTTL D. M. NIXON/DNM/CKS 10-Jan-80
SEARCH FORPRM
FSRCH
IF20,<
DEFINE OUTSTR (X) <
HRROI T1,X
PSOUT%
>
>
HELLO (FDDT.)
PUSHJ P,.+1 ;FIRST TIME IN
OUTSTR [ASCIZ /%FORDDT not loaded
/]
PUSH P,[CAI] ;REPLACE WITH NO-OP
POP P,FDDT. ;SO WE ONLY SEE MESSAGE ONCE
POPJ P, ;RETURN
PRGEND
TITLE RELEAS
;CALL:
; CALL RELEAS (U)
;ACTION IS SAME AS
; CLOSE (UNIT=U)
;WHICH SHOULE BE USED INSTEAD
NOSYM
ENTRY RELEAS
RELEAS==RELEA.##
PRGEND
TITLE EXIT
;LINK 4A(1120) has bug wherein SYMBOL=:VALUE## in overlays can lose
NOSYM
ENTRY EXIT
EXIT: JRST EXIT.## ;GO EXIT
END