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,%,,) 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.##,<,0,0,,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.##,<,0> SOJG F, FLAGS ;LOOP BACK FOR MORE FLAGS FUNCT FIN.## FUNCT OUT.##,<,0,0,,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.##,<,0,0,,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.##,<,0,0,,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 . . 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