SEARCH MTHPRM,FORPRM TV FORMSC Miscellaneous routines ,11(5025) SUBTTL Sue Godsell/SRM/EDS/EGM/CDM/AHM/RVM/PLB/MRB/TGS 1-Feb-86 ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1977, 1987 ;ALL RIGHTS RESERVED. ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. COMMENT \ ***** Begin Revision History ***** ***** Begin Version 6 ***** 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. ***** Begin Version 6A ***** 2077 RJD 31-Aug-82 In OVERFL, index OLDCT for a correct comparison between the tables containing the current APR counts and the old counts. 2103 MRB 13-Sep-82 20-18016 Time function will return incorrect results for european time zones. Use the TOPS-20 JSYS ODTIM to get correct time. ***** Begin Version 7 ***** 3000 CDM 19-Oct-81 Added character routines ADJC1., ADJCG. 3001 AHM 2-Oct-81 Make ADJ1. and ADJG. work under extended addressing. Also, redefine array dimension field from 777B8 to 177B8 so that array bounds checking blocks in section 0 will hopefully look more like the final version to be redefined for extended addressing. Finally, create a PROTA. entry point which is the same as PROAR. for now to match the symbol that FORTRA 7(1250) requests. 3025 AHM 18-Nov-81 Fix a bug in the trailing space edit to DATE (2020) that I introduced when merging it into the V7 sources, and change two MOVEIs to XMOVEIs for extended addressing support for good measure. 3052 AHM 1-Mar-82 Make PROAR. work for extended addressing by widening the flag field in the dimension block to the upper 4 bits. Delete PROTA. entry point since it is not needed for extended addressing after all. 3066 RVM 27-Mar-82 Fix ADJ1., ADJG., ADJC1., and ADJCG. to not calculate the size of assumed-size arrays. 3073 JLC 31-Mar-82 Remove RELEAS routine; it was for F40. 3122 JLC 28-May-82 Segment FORMSC. Changed LERRs to $FCALLs, and move error msgs to a separate module FORMSL in FORMSC. 3124 AHM 6-Jun-82 Added a SEGMENT macro to FDDT so that everything goes into .CODE. and .DATA. under FTXLIB. Also, preserve T1 around the PSOUT for "%FORDDT not loaded" under Tops-20. 3125 JLC 3-Jun-82 Moved the error character to the beginning of the error macro calls. 3131 JLC 11-Jun-82 Allow character string argument for ERRSNS error string return. 3132 CKS 11-Jun-82 Add PROSB. to do substring bounds checking. 3140 JLC 2-Jul-82 Fix ERRSET so that -1 for error number gets the entire table instead of just the V6-defined traps. 3141 JLC 2-Jul-82 Install FFUNIT. 3142 AHM 3-Jul-82 Install PRGEND in FFUNIT. 3161 JLC 16-Aug-82 Fixed ERRSNS for extended addressing multi-sections. 3165 JLC 28-Aug-82 Separate bounds check errors from others. 3205 AHM 18-Nov-82 Insert error message texts for TMA, CGP, CRP, NSS, CFS, CGS. Change VDM and ICF to "Should not happen" errors. Reword AQS. 3206 CDM 5-Nov-82/17-Jan-83 Allow character arguments for DATE and TIME. 3257 AHM 14-Jan-83 Fix DUMP and PDUMP - FUNCT macro made OTSZERWRD I/O list elements non-zero, FIN word was in wrong half of an I/O list, change positional OUT. argument lists to keyword form, correct change in carriage control semantics between V6 and V7. ***** End V7 Development ***** 3311 AHM 21-Apr-83 The dummy FDDT module that resolves XCT FDDT.## requests from /DEBUG:TRACE when FORDDT isn't loaded was in the hiseg instead of the lowseg. Unfortunately, FDDT. contains self-modifying code, and write-locking the high segment made it die. 3322 TGS 6-Jun-83 SPR:20-19252 Calling ERRSET with a subroutine argument not declared EXTERNAL in the calling program unit jumps into an empty variable when the user subroutine is called. Test for this case and ABORT if so. 3362 TGS 28-Oct-83 SPR:20-19293 New TOPMEM and SRTINI calls to set ENDP/STARTP to force memory allocation from a user-supplied page number downward and, for SRTINI, preallocate pages 600:677 for SORT. Insert new error messages for IPN (Illegal page number) and CPP (Can't preallocate pages) errors. 3405 TGS 24-Jan-84 SPR:20-19857 TIME subroutine will round minutes early (09:13 59.6 to 09:14 59.9 if called in a loop, for example.) Do not use ODTIM% to return hours and minutes, since this JSYS uses a totally different algorithm for rounding on minute boundaries. 3407 TGS 31-Jan-84 SPR:20-19929 QUIETX should suppress library routine error summaries as well as CPU summaries. (FORMSC comment change only). ***** Begin Version 10 ***** 4007 RJD 24-Mar-83 Eliminate extra PUSH and POP in OVLP. 4012 PLB 1-Jun-83 Fix ERRSET to work with user code and OTS in different sections. 4023 JLC 23-Jun-83 Search MTHPRM also. 4030 PLB 6-Jul-83 Fix OVERFL to remove AOBJN & BLT. 4044 JLC 19-Sep-83 Changed F.MED so it uses $N for the subroutine name, and thus can be called by any subroutine. 4060 JLC 1-Nov-83 Removed EXTEND error messages, mistakenly placed (by me) in FORMSL. 4065 JLC 6-Dec-83 Add subroutine PA1050 to allow PA1050 in core for V10 programs running on TOPS-20. 4074 RVM 28-Jan-84 Add the Mil. Spec/VAX FORTRAN bit manipulation functions. 4100 MRB 9-Feb-84 Added code to do compatibility flagging in FORLIB. Outputs a warning message for usage of non compatible language features like CALLing an external function. 4101 CDM 16-Feb-84 Create and expand the character stack differently when running in extended addressing. Give the stack its own section(s) so that it has plenty of room. Also add user subroutine ALCCHR. 4110 CDM 8-Mar-84 Reworked DUMP and PDUMP to work under extended addressing. Changed how the AC's are stored to be dumped out (used to be stored on the stack, with AC's being PUSH-ed and POP-ed everywhere, even though this is a subroutine and doesn't need to preserve any AC's). Corrected I/O calls to the ots to work in non-zero sections. For now, not giving both upper and lower bounds for dumping will give a warning message. Lots of comments added. Grouped together argument lists to make them look coherent. Changed "-" to "///" in format statements to make then standard conforming (/FLAG will flag this). 4121 AHM 30-Apr-84 Made QUIETX use HELLO macro, since it is now user callable, and supported. Module: FORMSC 4130 MRB 6-Jun-84 Add check for compatibility flagger to routine FFUNIT. 4155 JLC 2-Oct-84 Moved %SVCNV, a routine to manipulate symbol table pointers, to here so it can be accessed by FORDDT with OTS:SHARE, the LINKing of sharable FOROTS, and OTS:NONSHARE. Separate system-dependent code in %SVCNV. 4162 RVM 2-Nov-84 Define VAX FORTRAN INTEGER*2 and INTEGER*4 INTRINSIC function names. 4163 RVM 2-Nov-84 Define the undotted names of the bit functions. 4165 MRB 15-Nov-84 Change the equates for the undotted names to the dotted names to equate 30 bit addresses instead of just 18 bit addresses. 4170 JLC 19-Nov-84 Fix FORSYM: put in a SEGMENT CODE so the code isn't obliterated on TOPS-10. 4171 JLC 29-Nov-84 Fix some documentation in ERRSET. 4172 MRB 4-Dec-84 Fix-up some flagger stuff for the routines DATE, TIME, ERRSET, ERRSNS. 4174 JLC 9-Jan-85 Fix %SVCNV for symbol tables up to 511 pages as IOWDs. 4206 CDM 29-Mar-85 QAR 853072 Fix ISHFTC to work correctly when rotate index is negative. 4207 CDM 29-Mar-85 QAR 853038 Add SECNDS function for VMS compatability. ***** End V10 Development ***** ***** Begin Version 11 ***** 5007 MRB 15-APR-86 Add 4TH argument to ERRSNS for RMS STV values. 5015 MRB 5-JUN-86 In routine PROSB. added a check to see if the symbol name is a long symbol name. If it is a long symbol then we pass the address of the sixbitz string otherwise we pass a sixbit word to the error routine. 5024 MRB 20-Nov-86 Moved routine DUMON here from FORCOM. Routines contained in this module need the global symbol FLGON. or they will get undefinds when LINKing. 5025 MRB 7-Jan-87 When calling the error message routine (SSE) from PROSB. T5 must contain the 30 bit address of a string. But, the compiler only has an 18 bit address so we will figure it out. We will assume that the address of the PROSB. argument list is in register L (this is a full 30 bit address). The sixbit string will ALWAYS be in the same section as the PROSB. argument list. We will get the section number of the argument list and use that when calling the error routine. ***** 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. SEARCH MTHPRM,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 PARAMETERS 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). SEGMENT CODE 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) ADD TEMOFF,T2 ;[3001] Keep (30 bit) sum of offset factors ADDI TABREG,2 ;ADVANCE POINTER JRST LOOP1 ;GO AROUND AGAIN LUPDUN: MOVN TEMOFF,TEMOFF ;NEGATE OFFSET XMOVEI T2,@2(ARG) ;[3001] Get 30 bit array base address ADD TEMOFF,T2 ;[3001] Add it in MOVEM TEMOFF,@3(ARG) ;STORE VALUE OF OFFSET MOVE T2,@5(TABREG) ;FETCH U(I) FOR LAST ARRAYSIZE MULTIPLY CAME T2,[1B0-1] ;[3066] Don't multiply for assumed-size array 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. SEARCH MTHPRM,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 PARAMETERS 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) SEGMENT CODE 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) ADD TEMOFF,T2 ;[3001] Add (30 bits) 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 XMOVEI T2,@2(ARG) ;[3001] Get 30 bit array base address ADD TEMOFF,T2 ;[3001] Add it in MOVEM TEMOFF,@3(ARG) ;STORE OFFSET MOVE T2,@5(TABREG) ;GET U(I) FOR LAST ARRAYSIZ MULT CAMN T2,[1B0-1] ;[3066] Assumed-size array case? JRST BYE ;[3066] Yes, don't calculate size SUB T2,@6(TABREG) ;-L(I) ADDI T2,1 ;ADD ONE OF COURSE IMULM T2,@1(ARG) ;MULT AND STACH IN ARRAY SIZE BYE: POP P,TABREG ;RESTORE REGISTERS USED POP P,T2 GOODBY PRGEND TITLE ADJC1. Adjustable dimension with start of 1 SEARCH MTHPRM,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. Modeled from ADJ1. ; MULT(I) are multipliers. ; U(I) are upper bounds (equivalent to range). ; MULT(1)= ; 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 ; The parameters passed are (inorder): ; Pointer to number of dimensions ; Pointer to temp for ARRAYSIZ ; Descriptor of array ; Pointer to temp for OFFSET ; MULT(1) ; U(1) ; MULT(2) ; U(2) ; . ; . ; . ; MULT(N) ; U(N) ; **Note that MULT1(1) is assigned from the descriptor's size ; unlike for numeric arrays (ADJ1) which has a constant passed. SEGMENT CODE HELLO (ADJC1.) PUSH P,T2 ;Save registers used PUSH P,TABREG ; DMOVE T1,@2(ARG) ;Get array descriptor, t2=size of array MOVEM T2,@4(ARG) ;Assign MULT(1) MOVEM T2,@1(ARG) ;Initialize ARRAYSIZ MOVE TEMOFF,T2 ;Get offset with MULT(1) MOVE T1,@0(ARG) ;Fetch dimensionality MOVE TABREG,ARG ;Copy arg register 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) ADD TEMOFF,T2 ;Keep sum of OFFSET factors ADDI TABREG,2 ;Advance pointer JRST LOOP1 ;Go around again LUPDUN: MOVNM TEMOFF,@3(ARG) ;Negate OFFSET and store it MOVE T2,@5(TABREG) ;Fetch U(I) for last arraysize multiply CAME T2,[1B0-1] ;[3066] Don't multiply for assumed-size array IMULM T2,@1(ARG) ;Multiply to mem it in POP P,TABREG ;Restore registers POP P,T2 GOODBY PRGEND TITLE ADJCG. General adjustable dimension array SEARCH MTHPRM,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. It is modeled after ADJG. ; 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 ; MULT(1)= ; 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 ; 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 ; Descriptor for array ; Pointer to temp containing offset ; MULT(1) ; U(1) ; L(1) ; MULT(2) ; U(2) ; L(2) ; . ; . ; . ; MULT(N) SEGMENT CODE HELLO (ADJCG.) PUSH P,T2 ;SAVE REGISTERS USED PUSH P,TABREG ; DMOVE T1,@2(ARG) ;Descriptor, T2 is size of array MOVEM T2,@4(ARG) ;Assign MULT(1) MOVEM T2,@1(ARG) ;INITIALIZE ARRAYSIZ MOVE T1,@0(ARG) ;FETCH DIMENSIONALITY MOVE TABREG,ARG ;COPY ARG REGISTER SETZ TEMOFF, ;CLEAR OFFSET LOOP1: IMUL T2,@6(TABREG) ;MULT(1)*L(1) ADD TEMOFF,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: MOVNM TEMOFF,@3(ARG) ;NEGATE OFFSET and store it MOVE T2,@5(TABREG) ;GET U(I) FOR LAST ARRAYSIZ MULT CAMN T2,[1B0-1] ;[3066] Assumed-size array case? JRST BYE ;[3066] Yes, don't calculate size SUB T2,@6(TABREG) ;-L(I) ADDI T2,1 ;ADD ONE OF COURSE IMULM T2,@1(ARG) ;MULT AND STACH IN ARRAY SIZE BYE: 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;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 MTHPRM,FORPRM A=0 B=1 C=2 D=3 E=4 F=5 G=6 Q=16 P=17 SEGMENT CODE 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 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 SEGMENT DATA OFFSET: BLOCK 1 ACFLD: BLOCK 1 ;HOLD 0 IF DOUBLE PRECISION OR COMPLEX SAV2: BLOCK 1 ;TEMP STORAGE FOR AC 2 PRGEND TITLE PROAR. ARRAY BOUNDS CHECKING ROUTINE SUBTTL SARA MURPHY/AHM 1-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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. SEARCH MTHPRM,FORPRM ;DEFINE GLOBAL SYMBOLS FSRCH ;[3052] Search MACTEN or MACSYM ; Routine to perform FORTRAN array bounds checking at run time. ; Called with an argument block of the form: ; ------------------------------------------------- ; !1!0! ! PTR TO SEQ NUMB OF ST ! ; ------------------------------------------------- ; !1!0! ! PTR TO DIMENSION INF ! ; ------------------------------------------------- ; !1!0! ! PTR TO 1ST SUBSCRIPT ! ; ------------------------------------------------- ; !1!0! ! PTR TO 2ND SUBSCRIPT ! ; Etc. ; ; Where dimension information is represented by a block of the form: ; ------------------------------------------------- ; ! ARRAY NAME (IN SIXBIT) ! ; ------------------------------------------------- ; !1!0! DIM CT ! !I! ! BASE ADDRESS ! ; ------------------------------------------------- ; V6 !A!F!0!0! ! PTR TO OFFSET ! ; V7 !1!0!A!F! ! PTR TO OFFSET ! ; ------------------------------------------------- ; !1!0! ! PTR TO 1ST LOWER BND ! ; ------------------------------------------------- ; !1!0! ! PTR TO 1ST UPPER BND ! ; ------------------------------------------------- ; !1!0! ! PTR TO 1ST FACTOR ! ; ------------------------------------------------- ; !1!0! ! PTR TO 2ND UPPER BND ! ; ; ETC ; WHERE A IS A FLAG FOR "ADJUSTABLY DIMENSIONED ARRAY" ; F IS A FLAG FOR "FORMAL ARRAY" ; ; Note that the argument list is created in the compiler routine ; PROARRXPN in the file ARRXPN.BLI and the dimension block is created ; and written in CGDIMBLK in DEBUG.BLI. ; ;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. ; Note that there are two formats for the adjustably dimensioned array ; and formal array flags. The old format used for V6 and before used ; the two high order bits of the flag word. The pattern "10" was ; illegal for V6 because it means "adjustably dimensioned but not ; formal" - a non-sequitur for Fortran. Which is just as well, ; because the two high order bits of the flag word had to be forced to ; "10" for V7 in order to make the flag word an IFIW for extended ; addressing. The definitions of the bits were just shifted over by 2 ; places for extended addressing. DP=P4 ;PTR INTO THE BLOCK OF DIMENSION INFORMATION. POINTS ; TO THE SUB-BLOCK OF INFORMATION FOR A GIVEN DIMENSION SSP=P1 ;[3052] Pointer to the arg block entry for a subscript SS=P2 ;Value of the subscript being processed COUNT=P3 ;[3052] The number of subscripts left to go SUM=0 ;[3052] Computed sum of subscripts with factors ;[3052] (Used to compute the element 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 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 DCTSIZ=7 ;[3001] Number of bits in the dimension count ;[3001] 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 TYPWRD==1 ;[3052] Dim block word that contains the array type TYPMSK== ;[3052] Type field is the AC field DFLGWD=2 ;DIMENSION BLOCK FLAGS ARE IN WD 2 OF DIM BLO DFLSIZ=4 ;[3052] Dimension block flags are 4 bits DFLPOS=3 ;[3052] Bits 0-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 SEGMENT CODE EXTERN ABORT. ;[3205] FOROTS fatal error entry point HELLO (PROAR.) PUSH P,DP ;SAVE ACs PUSH P,SSP PUSH P,SS PUSH P,COUNT ;[3052] Save the count AC XMOVEI DP,@DBLKP(L) ;[3052] Pointer to dimension block XMOVEI SSP,SS1WD(L) ;[3052] Set up pointer to the SS list LDB COUNT,[POINT DCTSIZ,DCTWD(DP),DCTPOS] ;Load dimension count ; Get flags to see how to compute the base address of the array. LDB T1,[POINT DFLSIZ,DFLGWD(DP),DFLPOS] ; Adj-dim and formal flags LDB SUM,[POINTR (TYPWRD(DP),TYPMSK)] ;[3052] Get the array type CAIN SUM,TP%CHR ;[3052] Is it a character variable ? MOVEI T1,^B1011 ;[3052] Yes, they act like an adjustable formal ;[3052] (The main program "adds in" the array ;[3052] base with an ADJBP, but we are ;[3052] responsible for starting off with the ;[3052] offset pointed to by DOFFWD(DP)) XCT PXCTAB(T1) ;Execute table entry (indexed by T1) XMOVEI DP,D1WD(DP) ;[3052] Pointer 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 ADDI SSP,1 ;[3052] Go on to next SS SOJG COUNT,LP ;[3052] Loop back for more POP P,COUNT ;[3052] Restore ACs POP P,SS POP P,SSP POP P,DP POPJ P, ;RETURN ;EXECUTE TABLE ; There are presently 4 bits - this implies a 16 word table. PXCTAB: MOVEI SUM,0 ;[3052] |0000| V6 Non-formal $FCALL SNH,ABORT. ;[3052] |0001| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |0010| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |0011| Flags for V7 set by V6 XMOVEI SUM,@DBASWD(DP) ;[3052] |0100| V6 Non-adj formal $FCALL SNH,ABORT. ;[3052] |0101| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |0110| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |0111| Flags for V7 set by V6 MOVEI SUM,0 ;[3052] |1000| V7 Non-formal XMOVEI SUM,@DBASWD(DP) ;[3052] |1001| V7 Non-adj formal $FCALL SNH,ABORT. ;[3052] |1010| V7 Adj but not formal ;[3052] should never occur MOVE SUM,@DOFFWD(DP) ;[3052] |1011| V7 Computed offset for ;[3052] an adjustable array MOVE SUM,@DOFFWD(DP) ;[3052] |1100| V6 Computed offset for ;[3052] an adjustable array $FCALL SNH,ABORT. ;[3052] |1101| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |1110| Flags for V7 set by V6 $FCALL SNH,ABORT. ;[3052] |1111| Flags for V7 set by V6 ;END OF EXECUTE TABLE ;ROUTINE CALLED WHEN A BOUNDS VIOLATION HAS BEEN DETECTED PERR: XMOVEI T1,1-SS1WD(SSP) ;[3052] Set T1 to the dimension SUB T1,L ;[3052] being processed PUSH P,T2 ;SAVE T2,T3 PUSH P,T3 MOVE T2,@ARNAMP(L) ;GET THE ARRAY NAME MOVE T3,@ISNWD(L) ;GET THE ISN ;(SRE,21,101,%,,) $FCALL SRE ;ISSUE MESSAGE, CONTINUE POP P,T3 ;RESTORE T2,T3 POP P,T2 POPJ P, ;@ISNWD(L)[T3]/ ISN of statement containing this array ref ;T1/ Dimension number being processed ;@ARNAMP(L)[T2]/ Array name in SIXBIT ;SS[P2]/ Value of illegal subscript PRGEND TITLE FORDMP - DUMP and PDUMP Dump memory routines SUBTTL /DMN/SWG/DAW/AHM ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;FROM 1 MAY 1966 ED YOURDON, 2/12/68 NSR ;++ ; FUNCTIONAL DESCRIPTION: ; ; Both DUMP and PDUMP output core to a line printer between the ; optional locations passed by the user. DUMP calls "EXIT." when ; done, while PDUMP returns to the users program. The code is ; shared, ENTFLG is used to determine whether DUMP or PDUMP was ; entered. ; ; First to be dumped are following PC flags and then the contents ; of the accumulators. ; ; AR OV FLAG ; AR CRY0 FLAG ; AR CRY1 FLAG ; PC CHANGE FLAG - FLOATING OVERFLOW ; BIS FLAG ; ; Following this are any memory locations the user has specified. ; ; If a group of memory locations have the same contents, DUMP and ; PDUMP will finish printing the current line, then indicate the ; repeated locations by: ; ; Locations xx through yy contain zz ; ; CALLING SEQUENCE: ; ; 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)) ; ; INPUT PARAMETERS: ; ; Arguments are in triplets, each triplet taken separately. ; ; A(n) First element to be dumped. ; ; B(n) Last element to be dumped. ; ; 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. ; ; F(n) Mode to dump the elements in. ; ; 0 octal (O12 format) ; 1 floating point (G12.5 format) ; 2 integer (I12 format) ; 3 ascii (A12 format) ; 4 double precision (G25.16) ; ; An illegal or missing mode assignment causes the dump to ; be made in octal. ; ; where A, B, and F are optional sets of triplet arguments. ; ; If no arguments are given, the entire user area is dumped in ; octal. Under extended addressing, both A(n) and B(n) must be ; given. ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; None ; ; SIDE EFFECTS: ; ; Used as Fortran subroutine, does NOT save AC values. ; ;-- ;Accumulator assignments and parameter assignments 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 ARC==12 ;-Number of args left PP==15 ;BLT AC, ALSO HOLDS A FORMAT ADDRESS P==17 ;PUSHDOWN POINTER 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 MTHPRM,FORPRM FSRCH SEGMENT CODE 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 ;Common code to DUMP and PDUMP. Dump the PC flags and save away the ;AC's. DUMPA: DMOVEM T0,ACSAVE ;[4110] Save AC0, AC1 MOVEM T2,ACSAVE+2 ;[4110] Save AC2 ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message IF20,< XMOVEI T1,. ;What section are we running in? TLNN T1,-1 ;[4110] Is section non-zero? JRST DPNZER ;[4110] No, in section 0 ;Running in non-zero section. Get and Save PC flags ;differently. XSFM FLGLOC ;Save PC flags the extended way. ;Save AC3 through AC17 MOVEI T0,20-3 ;[4110] Number of AC's to move. XMOVEI T1,T3 ;[4110] AC3 is start of what to move XMOVEI T2,ACSAVE+3 ;[4110] Where to put the saved AC's EXTEND T0,[XBLT] ;[4110] Save AC 3 thru AC 17 JRST DPPRFL ;[4110] Ready to dump flags >; End IF20 ;Get PC flags and save AC's away. DPNZER: POP P,FLGLOC ;[4110] Get PC flags out. The PUSHJ to ; call us loaded them in the left half ; of the return address pushed on the ; stack. PUSH P,FLGLOC ;Restore to top of stack ;Save AC3 through AC17 HRLI T1,T3 ;[4110] [Source=AC3,,0] HRRI T1,ACSAVE+3 ;[4110] [source,,Destination] BLT T1,ACSAVE+20-1 ;[4110] Save AC's ;[4110] Destination + n -1 ;Print headers for PC flags DPPRFL: XMOVEI L,ARG3 ;[4110] PUSHJ P,OUT.## ;[3257] Set up for output ;Put out the actual PC flags, "ON"/"OFF" 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" XMOVEI L,ARG4 ;[4110] PUSHJ P,IOLST.## ;[3257] Do the output SOJG F,FLAGS ;LOOP BACK FOR MORE FLAGS FUNCT FIN.## ;Finish outputting ;Output the values in the AC's. ;Setup the format for printing "ACnn" headers and the AC values XMOVEI L,ARG5 ;[4110] Output S PUSHJ P,OUT.## ;[3257] Set up for more output CLEARB S,I ;AC0-AC7, SET INDICATOR TO ZERO ;Output "AC 00 ... AC 07" D1: XMOVEI L,ARG4 ;[4110] Output S PUSHJ P,IOLST.## CAIGE S,7 ;For registers 0 thru 7 AOJA S,D1 ;Loop back until done ;Output the contents of AC0 through AC7 XMOVEI L,ARG6 ;[4110] ACSAVE through ACSAVE+7 PUSHJ P,IOLST.## ;Output "AC 10 ... AC 17" MOVEI S,10 ;Start with AC 10 D3: XMOVEI L,ARG4 ;[4110] Output S PUSHJ P,IOLST.## CAIGE S,17 ;Done AC17 yet? AOJA S,D3 ;No, Loop again ;Output contents of AC10 through AC17 XMOVEI L,ARG7 ;[4110] ACSAVE+10 through ACSAVE+17 PUSHJ P,IOLST.## ;Argument processor. See how many arguments we have. MOVE L,ACSAVE+L ;[4110] Restore argument pointer HLRE ARC,-1(L) ;Get -arg count JUMPE ARC,ENDCHK ;No arguments: Dump all of core ;Come here to process a set of 3 args. We have at least one. If less ;than three, then we must set up defaults. ; ; L points to arg list ; ARC is -number of args left SGET: SETZ I, ;Set to 1 if whole group of 3 args present XMOVEI L,ARG8 ;[4110] PUSHJ P,OUT.## ;[3257] Go set up for output and do it FUNCT FIN.## ;[3257] All done! AOJG ARC,SDOUT ;If no more args, quit MOVE L,ACSAVE+L ;[4110] Restore argument pointer XMOVEI S,@0(L) ;Yes, pick up the address of beginning 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 ;Now we dump some memory out. Check the arguments ;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) ;Get ots code for the mode specified DPB B,[POINT 4,IOLSTC,12] ;Put mode in the format for IO call DPB B,[POINT 4,IOLSTS,12] ;"" ;Main dump processor DPROC: MOVE B,S ;[4110] GET CURRENT ADDRESS IN B MOVE LL,S ;POINTER IN REPETITION CHECK ;Look for repeating words in the dump. If we can find multiple line(s) ;(8 or more words) that repeat, then output them in groups rather than ;every word separately. ; C is the location to compare against. ; LL is incremented every time through the loop to be the ; next memory location to look at. MOVE C,@S ;Word to check against for repetition 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 ;Where to begin dumping ADDI T1,7 ;Above + 7 = "end of a line" CAML LL,T1 ;Finished checking a line? ADDI S,10 ;Yes, increment S to next line ; Unless incremented, we don't have any matches CAMG S,F ;Beyond the end of what to dump? AOJA LL,LOOK ;No, increment pointer, check more ;End of checking for repetition. Either have reached the end of ;memory to dump or have found a non-identical line. DIFF: CAMN B,S ;WERE ANY LINES REPEATED? JRST OLOOP0 ;NO, DUMP THIS LINE INDIVIDUALLY ;Found identical line(s). "Locations n thru m contain " MOVE T1,S ;[4110] Last loc SUBI T1,1 ;[4110] Off by one XMOVEI L,ARG9 ;[4110] PUSHJ P,OUT.## ;[3257] Set up for output XMOVEI L,ARG10 ;[4110] Output B, T1 PUSHJ P,IOLST.## ;END OF REPETITION MESSAGE ;Output the common word that is repeated. XMOVEI L,ARG1 ;GET FORMAT FOR MESSAGE PUSHJ P,OUT.## XMOVEI L,IOLSTC ;OUTPUT REPEATED WORD -> C PUSHJ P,IOLST.## ;Loop for outputting words. Start outputting a regular line ;here. 8 words per line. OLOOP0: MOVE C,LIST2(PP) ;PICK UP FORMAT TYPE OLOOP1: CAMLE S,F ;ALL DONE DUMPING? JRST NEXT1 ;YES, CHECK for more ARGUMENTS XMOVEI L,ARG2 ;NO, OUTPUT FOR 8 WORDS/LINE PUSHJ P,OUT.## XMOVEI L,ARG4 ;[4110] Output S PUSHJ P,IOLST.## ;Each time through loop output one location. MOVEI B,^D8 ;LOOP COUNTER - Output 8 memory locations OLOOP2: XMOVEI L,IOLSTS ;ADDRESS FOR THIS LINE PUSHJ P,IOLST.## ;MEMORY WORD CAML S,F ;ALL DONE DUMPING JRST NEXT ;YES, CHECK for more 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 DPROC ;[4110] SCAN NEXT LINE ;One or more arguments missing. Set defaults, then dump the memory. ;No arguments given. ENDCHK: HRRZI S,20 ;DUMP FROM 20 (after registers) ;Ending and mode not given ENDCK2: HRRZ F,.JBFF ;TO END OF USER AREA SUBI F,1 ;DO NOT DUMP FIRST FREE IF20,< ;If running in non-zero section, user must give beginning and ;ending arguments to dump memory. Extended adressing means too ;much memory to dump everything on an innocent line printer. XMOVEI T1,T0 ;[4110] Section that AC 0 is in JUMPE T1,ENDCK3 ;[4110] If section zero, then ok $FCALL DMA ;[4110] Warning - Give me some arguments!! JRST SDOUT ;[4110] Exit, don't do anything. > ;End IF20 ;Mode not given ENDCK3: SETZ C, ;Set OCTAL mode JRST SCHEK ;FIX EXIT, CHECK CORE LIMITS ;Dump is finished. Process next triplet of arguments (if there is any). NEXT: PUSHJ P,FIN.## ;FINISH FORMAT NEXT1: JUMPE I,SDOUT ;MORE ARGUMENTS TO COME? MOVEI T0,3 ;[4110] ADDM T0,ACSAVE+L ;[4110] Yes, saw 3 args last time, Bump arg ptr. JRST SGET ;GO GET SOME MORE ARGUMENTS ;Here when done dumping all arguments. Get ready to return to caller or ;jump to EXIT. . SDOUT: SKIPE ENTFLG ;[4110] IS IT THE PDUMP ENTRY? JRST SDOUT1 ;NO - DUMP GOODBY ;PDUMP - RETURN TO USER SDOUT1: FUNCT (EXIT.) ;DUMP - Exit and stop the program ;Format statements for output EXP MESS1L ;[3257] FMTSIZ= MESS1: ASCII "(1H148X9HCORE DUMP/1H 7HOv flag17X9HCry0" ASCII " flag15X9HCry1 flag15x12HFlt ov flag 13X" ASCII "8HFPD flag/1H 5(A9,15X))" MESS1L==.-MESS1 ;[3257] Compute size of FORMAT statement EXP MESS2L ;[3257] FMTSIZ= MESS2: ASCII "(2(/// 8(9X 3HAC O2) /7X8O14/))" ;[4110] "AC nn" MESS2L==.-MESS2 ;[3257] Compute size of FORMAT statement EXP MESS3L ;[3257] FMTSIZ= MESS3: ASCII "(///)" ;[4110] Skip three lines MESS3L==.-MESS3 ;[3257] Compute size of FORMAT statement EXP MESS4L ;[3257] FMTSIZ= MESS4: ASCII "(///' Locations 'O10,9H through O10,9H contain /1H )" ;[4110] MESS4L==.-MESS4 ;[3257] Compute size of FORMAT statement ;Argument blocks for OUT./IOLST. calls XWD -2,0 ARG1: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)35 (18)LIST1 ;[4110] @LIST1(PP) XWD -2,0 ARG2: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)35 (18)LIST2 ;[4110] @LIST2(PP) XWD -2,0 ;[3257] Arg count ARG3: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)0 (18)MESS1 ;[4110] FMT= XWD -2,0 ;[3257] Arg count ARG4: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)S ;[4110] S 0 ;[4110] End of list XWD -2,0 ;[3257] Arg count ARG5: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)0 (18)MESS2 ;[4110] FMT= XWD -4,0 ;[4110] 4 args ARG6: BYTE (2)^B10 (7)2 (4)TP%INT (5)0 (18)[10] ;[4110] 10 words BYTE (2)^B10 (7)0 (4)TP%INT (5)0 (18)[1] ;[4110] Incr by 1 BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)ACSAVE ;[4110] Start here 0 ;[4110] EOL XWD -4,0 ;[4110] 4 args ARG7: BYTE (2)^B10 (7)2 (4)TP%INT (5)0 (18)[10] ;[4110] 10 words BYTE (2)^B10 (7)0 (4)TP%INT (5)0 (18)[1] ;[4110] Incr by 1 BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)ACSAVE+10 ;[4110] Start here BYTE (2)^B10 (7)4 (27)0 ;[4110] Fin XWD -2,0 ;[3257] Arg count ARG8: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)0 (18)MESS3 ;[4110] FMT= XWD -2,0 ;[3257] Arg count ARG9: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)[DEVICE] ;[4110] UNIT= BYTE (2)^B10 (7)2 (4)TP%LBL (5)0 (18)MESS4 ;[4110] FMT= XWD -3,0 ;3 args ARG10: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)B ;[4110] Addresses BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)T1 ;[4110] First location rep'ed BYTE (2)^B10 (7)4 (27)0 ;[4110] Last ;More format statements and some constants, too EXP 4 ;[3257] Size of FORMAT OFRMT: ASCII "(1H0,O10,8O14)" EXP 4 ;[3257] EFRMT: ASCII "(1H0,O10,8G14.5)" EXP 4 ;[3257] IFRMT: ASCII "(1H0,O10,8I14)" EXP 4 ;[3257] AFRMT: ASCII "(1H0,O10,8A14)" EXP 4 ;[3257] DFRMT: ASCII "(1H0,O10,4G25.16)" EXP 4 ;[3257] OFRMT2: ASCII "(1H0,40X,O14)" EXP 4 ;[3257] EFRMT2: ASCII "(1H0,40X,G14.5)" EXP 4 ;[3257] IFRMT2: ASCII "(1H0,40X,I14)" EXP 4 ;[3257] AFRMT2: ASCII "(1H0,40X,A14)" EXP 4 ;[3257] 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 " ;Flag is off ASCII "ON " ;Flag is on TABLE: EXP TP%SPO,TP%SPR,TP%INT,TP%LIT,TP%DPR BYTEP: POINT 1,FLGLOC ;Byte pointer for PC flags SEGMENT DATA ;** IOLSTC and IOLSTS have their dump "mode" (specified by user) written ;** into them, so they must be writable. XWD -2,0 IOLSTC: BYTE (2)^B10 (7)1 (4)TP%INT (5)0 (18)C ;[4110] C BYTE (2)^B10 (7)4 (29)0 ;[4110] Fin XWD -2,0 IOLSTS: BYTE (2)^B10 (7)1 (4)TP%INT (1)1 (4)0 (18)S ;[4110] Indirect bit on 0 ;End of list FLGLOC: BLOCK 1 ;TO STORE PC WORD flags ENTFLG: BLOCK 1 ;Flag for which entry WAS taken ; 0 = DUMP ; 1 = PDUMP ACSAVE: BLOCK 20 ;[4110] Save the AC's 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;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 MTHPRM,FORPRM EXTERNAL FOROP. SEGMENT CODE HELLO (ILL) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 SEGMENT DATA ILLEG: BLOCK 1 PRGEND TITLE SAVFMT ;CODE TO ENCODE THE FORMAT IN AN ARRAY ;CALLS FOROP TO CALL %FMTSV IN FOROTS SEARCH MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (SAVFMT) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (CLRFMT) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (LSNGET) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 SEGMENT DATA SAVE2: BLOCK 2 ;FOR THE AC'S PRGEND TITLE DATE TODAY'S DATE SUBTTL D. TODD /DRT/KK/DMN/SWG/AHM/CDM 5-Nov-82 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;FROM LIB40 VERSION V.32(433) ;This subroutine puts today's date into a numeric dimensioned two-word ;array or a character variable. ;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 MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (DATE) ;ENTRY TO DATE ROUTINE. ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4172]Is compatbility flagging on? $FCALL CFX ;[4172]Yes; display the compatibility message PUSH P,T2 ;[3206] Save ac's PUSH P,T3 ;[3206] ; Put time into SVDT IF10,< XMOVEI T1,@0(L) ;[3025] Get address of 2 word array 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(T2) ;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 T1,T3 ;[3206] So low word is in T1 ADDI T1," "_1 ;[3206] Make space for last character instead ;[2020] of NULL; this allows compare of ;[2020] literal to work, since FORTRAN pads ;[2020] the word with spaces. DMOVEM T0,SVDT ;[3206] Store away date to return > ;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 MOVEI T1," "_1 ;[3206] Change NULL to SPACE ;[2020] This allows compare of literal to ;[2020] work, since FORTRAN pads the word ;[2020] with spaces. IORM T1,SVDT+1 ;[3206] Store away date to return > ;END IF20 ; Return date to caller LDB T0,[POINTR (0(L),ARGTYP)] ;[3206] Type of argument CAIE T0,TP%CHR ;[3206] Is it character? JRST NOTCHR ;[3206] No ; Argument is character. Rather than worrying how to handle the ; length of the character descriptor, and how to pad with ; blanks, let the move sludge handle this. MOVEI T0,^D10 ;[3206] Move 2 words of source MOVE T1,[POINT 7,SVDT] ;[3206] Make a byte pointer for source DMOVE T3,@0(L) ;[3206] Arg's BP and length EXCH T3,T4 ;[3206] Reverse order EXTEND T0,[MOVSLJ " "] ;[3206] Put the date in the argument JFCL ;[3206] NOP JRST EXDATE ;[3206] Return NOTCHR: ; Argument is numeric DMOVE T0,SVDT ;[3206] Get date DMOVEM T0,@0(L) ;[3206] Return date calculated above EXDATE: POP P,T3 ;[3206] Return ac's POP P,T2 ;[3206] POPJ P, ;[3206] Return to caller IF10,< 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-/ > SEGMENT DATA SVDT: BLOCK 2 ;Place to store results from monitor call 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE IF10,< ;BEGIN TOPS-10 CODE HELLO (TIM2GO) ;DEFINE ENTRY POINT ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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: ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 SEGMENT DATA TBLK: BLOCK 3 > ;END IF20 PRGEND ;END OF TIM2GO TITLE TIME TIME OF DAY SUBTTL /KK/SWG/EDS/EGM/CDM ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;FROM LIB40 %2.(120) ;This subroutine returns the time of day in two single word arguments or ;a character variable. ; ;The first argument gets the hour and minute, and the optional second ;argument gets the second and tenth of a second. ;The first argument is given in military time: ; 02:15 (for a.m. time) ; 14:15 (for p.m. time) ; ;The optional second argument 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 MTHPRM,FORPRM SEGMENT CODE SALL ;FOR HELLO MACRO - SEE BELOW HELLO (TIME) FSRCH ;MUST FOLLOW HELLO MACRO TO AVOID OLD TIME JSYS ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4172]Is compatbility flagging on? $FCALL CFX ;[4172]Yes; display the compatibility message PUSH P,T2 ;[3206] Save ac's PUSH P,T3 ;[3206] PUSH P,T4 ;[3405] ;Process the first argument. Put it into TTIME. IF10,< ;TOPS10-only code MSTIME T1, ;Get time in millisecs from the monitor. > ;[3405] End IF10 IF20,< ;[3405] TOP20-only code GTAD% ;[3405] Get internal GMT HRLZ T1,T1 ;[3405] Put in left half LSH T1,-1 ;[3405] Divide by 2 MUL T1,[^D86400000] ;[3405] Compute ms since midnight in T1 > ;[3405] End IF20 IDIVI T1,^D60000 ;[2103]Total mins. in 1, leftover msecs. in 2. MOVEM T2,TEMP1 ;Save the leftover ms IDIVI T1,^D60 ;Hours in 1, minutes in 2. MOVEM T2,TEMP2 ;[3405] Save minutes ;[3405] For TOPS20, which is based on Greenwich Mean Time, determine and ;[3405] adjust for local time zone correction factor and adjust if necessary for ;[3405] Daylight Savings. ;The general algorithm is similar to that in SECNDS. If this must be ;changed, them SECNDS probably ought to be changed also. IF20,< ;[3405] TOPS20-only code SETO T2, ;[3405] -1 for current time SETZ T4, ;[3405] 0 for local time ODCNV% ;[3405] Return T4/flags+zone,,secs since 00:00 HLR T3,T4 ;[3405] Pick up left half HRROI T2,<^-<(IC%TMZ)>> ;[3405] Mask -1,,777700 to isolate zone TDZ T3,T2 ;[3405] Get zone bits (12-17) only TRNE T3,40 ;[3405] Time zone negative(-12 to +12)? TDO T3,T2 ;[3405] Yes, propogate its sign bit TXNE T4,IC%ADS ;[3405] Was Daylight Savings in effect? SUBI T3,1 ;[3405] Yes, subtract one hour SUB T1,T3 ;[3405] Adjust hours by time zone factor SKIPGE T1 ;[3405] Did hours go negative? ADDI T1,^D24 ;[3405] Yes, get it mod 24 hours > ;[3405] End IF20 MOVE T0,[POINT 7,TTIME] ;[3206] Build a BP for answer MOVEM T0,HLDBP ;Save it away JSP T3,SUB1 ;[3405] Go to subr. to set up hr.in T1 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. ;[3405] ; Return time in 1st argument LDB T0,[POINTR (0(L),ARGTYP)] ;[3206] Get type of 1st argument CAIE T0,TP%CHR ;[3206] Is it character? JRST NTCHR1 ;[3206] no ; Character argument. Use move string, so we don't have to ; worry about the length the user specified and how to pad with ; spaces. MOVEI T0,5 ;[3206] Length of 1 numeric word MOVE T1,[POINT 7,TTIME] ;[3206] Address of source (time to return) DMOVE T3,@0(L) ;[3206] Arg BP and length EXCH T3,T4 ;[3206] Exchange positions EXTEND T0,[MOVSLJ " "] ;[3206] Put the time in the argument JFCL ;[3206] NOP JRST NEXT1 ;[3206] NTCHR1: ; Numeric argument MOVE T0,TTIME ;[3206] Return time in MOVEM T0,@0(L) ;[3206] the first argument NEXT1: HLRZ T3,-1(L) ;[3206] Number of arguments CAIE T3,-2 ;[3206] Are there two? JRST EXTIME ;[3206] Exit from here ;[3405] ; Process 2nd argument to return seconds TIME02: MOVE T0,[POINT 7,TTIME] ;[3206] Build BP for second argument 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. LDB T0,[POINTR (1(L),ARGTYP)] ;[3206] Type of 2nd argument CAIE T0,TP%CHR ;[3206] Is it character? JRST NTCHR2 ;[3206] No ; 2nd argument is character. MOVEI T0,5 ;[3206] Length of source in characters MOVE T1,[POINT 7,TTIME] ;[3206] Make a BP for DMOVE T3,@1(L) ;[3206] 2nd arg's BP and length EXCH T3,T4 ;[3206] Exchange them EXTEND T0,[MOVSLJ " "] ;[3206] Put the time in the argument JFCL ;[3206] NOP JRST EXTIME ;[3206] Exit from here NTCHR2: ; 2nd argument is numeric. MOVE T0,TTIME ;[3206] Return the seconds as the 2nd arg MOVEM T0,@1(L) ;[3206] EXTIME: POP P,T4 ;[3405] POP P,T3 ;[3206] Restore ac's POP P,T2 ;[3206] POPJ P, ;[3206] 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. SEGMENT DATA TTIME: BLOCK 1 ;[3206] Temporary storage for Time TEMP1: BLOCK 1 ;[3206] TEMP2: BLOCK 1 ;[3206] HLDBP: BLOCK 1 ;Saved byte ptr 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;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 MTHPRM,FORPRM SEGMENT CODE HELLO (SLITE) ;ENTRY TO SLITE PROGRAM ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 SEGMENT DATA LITES: 0 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) DIGITAL EQUIPMENT CORPORATION 1972, 1987 ;ALL RIGHTS RESERVED. ;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 MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (SSWTCH) ;ENTRY TO SSWTCH PROGRAM ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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/PLB ;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 ; 2 input integer overflow ; 3 input floating overflow ; 4 floating overflow ; 5 floating divide check ; 6 floating underflow ; 7 input floating underflow ; 8 library routine error ; 9 output field width too small ; 21 FORLIB warnings ; 22 non-standard usage warnings ; ; If I is not specified, -1 is assumed ; ; SUBR = routine to call on the trap ; ; The effect is as if ; CALL SUBR (I, IPC, N2, ITYPE, UNFIXED, FIXED) ; 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 FOROTS call) ; N2 = 2nd error number (reserved for DEC) ; ITYPE = data type of value ; UNFIXED = value returned by the processor ; FIXED = value after fixup by MTHTRP ; If SUBR is not specified, no routine is called on the APR trap. SEARCH MTHPRM,FORPRM EXTERN MTHOP. EXTERN ABORT. ;[3322] SEGMENT CODE HELLO (ERRSET) ; ; [4172] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4172]Is any compatbility flagging on? $FCALL CFX ;[4172]Yes; display the compatibility message MOVEI T0,ML$APR ;T0:= function code XMOVEI T1,APRCT ;Read apr table addresses to here PUSHJ P,MTHOP. ;READ THEM MOVEM T0,ERRSZ ;SAVE SIZE OF TABLE XMOVEI T1,. ;[4012] GET LOCAL SECTION TLNE T1,-1 ;[4012] IS SECTION NUMBER ZERO? SKIPA T1,[B5] ;[4012] NO, USE "EFIW T2," MOVSI T1,(IFIW (T2)) ;[4012] ELSE, MAKE IFIW INDEXED BY T2 IORM T1,APRCT ;[4012] POINTING TO ERROR COUNT TABLE IORM T1,APRLM ;[4012] AND ERROR MESSAGE LIMIT TABLE IORM T1,APRSB ;[4012] AND SUBROUTINE ADDRESS TABLE HLLZ T4,-1(L) ;[4012] GET ARG COUNT SETO T2, ;DEFAULT IS ALL APR ERRORS SETZ T3, ;DEFAULT SUBROUTINE IS NONE MOVE T1,@(L) ;GET ERR MESSAGE LIMIT AOBJP T4,ERSET1 ;[4012] IF OUT OF ARGS, GO STORE THEM MOVE T2,@1(L) ;[4012] GET ERROR NUMBER AOBJP T4,ERSET1 ;[4012] IF OUT OF ARGS, GO STORE THEM XMOVEI T3,@2(L) ;[4012] GET ROUTINE TO CALL SKIPN (T3) ;[3322] VALID ROUTINE CALL? $FCALL MXD,ABORT. ;[3322] MISSING EXTERNAL DECLARATION. ABORT ERSET1: CAML T2,ERRSZ ;REASONABLE ERROR NUMBER? $FCALL NOR,EPOPJ ;NUMBER OUT OF RANGE MOVEI T0,1 ;[4012] DEFAULT IS DO JUST ONE ITEM JUMPGE T2,ERSETL ;IF INDIVIDUAL ERROR, GO SET IT MOVE T0,ERRSZ ;[4012] IF ALL ERRORS, LOOP MAXIMUM TIMES SETZ T2, ;[4012] STARTING AT ITEM ZERO 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 AOJ T2, ;[4012] BUMP INDEX AC SOJG T0,ERSETL ;[4012] SET ALL ERRORS IF THAT'S WHAT HE WANTS EPOPJ: POPJ P, ;DONE SEGMENT 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 ERRSZ: BLOCK 1 ;SIZE OF TABLES PRGEND TITLE MTHOP. SEARCH MTHPRM,FORPRM ENTRY MTHOP. EXTERN FOROP. MTHOP.== 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 MTHPRM,FORPRM FSRCH EXTERN FOROP. SEGMENT CODE HELLO (ERRSNS) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4172]Is compatbility flagging on? $FCALL CFX ;[4172]Yes; display the compatibility message 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 CAIGE T1,1 ;[5007]ANY ARGS? POPJ P, ;[5007]NOPE, JUST RETURN MOVE T2,ERRNUM ;[5007]ELSE,GET 1ST ERR NUMBER HLRZM T2,@0(L) ;[5007]STORE IN FIRST ARG CAIGE T1,2 ;[5007]IS THERE A SECOND ARG? POPJ P, ;[5007]NOPE, RETURN HRRZ T2,T2 ;Get RH only CAIN T2,-1 ;-1? SETO T2, ;Yes, make full word MOVEM T2,@1(L) ;Store 2nd ERR number CAIGE T1,4 ;[5007]IS THERE A FOURTH ARG? JRST ERRMSG ;[5007]NO, (SEE ABOUT THE 3RD) HRRZ T2,ERRNM3 ;[5007]GET THE STV HRRZM T2,@4(L) ;[5007]STORE THE FOURTH ARG ERRMSG: CAIGE T1,3 ;THIRD ARG (STRING) SPECIFIED? POPJ P, ;NO, DONE MOVE T1,ERRMSA ;GET MSG POINTER LDB T2,[POINTR (2(L),ARGTYP)] ;GET ARG TYPE CAIE T2,TP%CHR ;CHARACTER? JRST ERRNC ;NO DMOVE T2,@2(L) ;YES. GET PNTR/COUNT JRST ERRLP ;AND JOIN COMMON CODE ERRNC: XMOVEI T2,@2(L) ;GET STRING ADDRESS $BLDBP T2 ;BUILD A BYTE POINTER TO IT 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 SEGMENT DATA ERRNUM: BLOCK 1 ;ERR NUMBERS ERRMSA: BLOCK 1 ;ERR MSG ADDRESS ERRNM3: BLOCK 1 ;3RD ERROR NUMBER (STV) 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 MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (CLRDIV) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message SETO T1, ;Same as saying "UNIT=-1" JRST DIV01 ; (Should always return status 0) HELLO (DIVERT) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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. XMOVEI T0,DIVRT(T1) ;GET ADDR TO GO MOVE T1,@(L) ;GET UNIT NUMBER PJRST @T0 ;GO THERE ;Indexed by status value DIVRT: JRST DIVRET ;(0) OK, return $FCALL IDU,DIVRET ;(1) Illegal unit $FCALL UNO,DIVRET ;(2) Unit not open $FCALL NOF,DIVRET ;(3) Not open for FORMATTED IO $FCALL CWU,DIVRET ;(4) Can't write to unit DIVRET: POPJ P, ;DONE HELLO (CHKDIV) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (OVERFL) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4100]Is any compatbility flagging on? $FCALL CFX ;[4100]Yes; display the compatibility message 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 XMOVEI T1,. ;[4030] GET LOCAL SECTION TLNE T1,-1 ;[4030] IS SECTION NUMBER ZERO? SKIPA T1,[B5] ;[4030] NO, USE "EFIW T1," MOVSI T1,(IFIW (T1)) ;MAKE INDIRECT WORD INDEXED BY T1 IORM T1,APRCT ;[4030] POINTING TO COUNT TABLE MOVEI T1,8-1 ;[4030] MAKE TABLE SOJG COUNTR MOVEI T2,2 ;INIT ANSWER TO 2 (NO OVERFLOWS) OVLP: MOVE T3,@APRCT ;GET CURRENT COUNT CAMLE T3,OLDCT(T1) ;[2077][4007] GREATER THAN OLD COUNT? MOVEI T2,1 ;YES, SET ANSWER TO 1 (OVERFLOW OCCURRED) MOVEM T3,OLDCT(T1) ;[4030] STORE NEW COUNT SOJG T1,OVLP ;[4030] LOOK THROUGH WHOLE TABLE MOVEM T2,@0(L) ;STORE ANSWER FOR CALLER 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 SEGMENT 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 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) DIGITAL EQUIPMENT CORPORATION 1973, 1987 ;ALL RIGHTS RESERVED. SEARCH MTHPRM,FORPRM NOSYM ENTRY TRACE ;HELLO MACRO CAN NOT BE USED ;SIXBIT NAME DEFINED IN TRACE (FORERR) HELLO (TRACE) ; ; [4100] Check for compatibility flagging. ; SKIPE [FLGON.##] ;Is any compatbility flagging on ? $FCALL CFX ;Yes; display the compatibility message PJRST TRACE.## ;Call the correct (dotted) name 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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) DIGITAL EQUIPMENT CORPORATION 1974, 1987 ;ALL RIGHTS RESERVED. 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/DMN/CKS/AHM 21-Apr-83 SEARCH MTHPRM,FORPRM FSRCH SEGMENT DATA ;[3311] Put this in the lowseg because ;[3124] FDDT. is impure IF20,< DEFINE OUTSTR (X) < PUSH P,T1 ;[3124] Save T1 HRROI T1,X PSOUT% POP P,T1 ;[3124] Restore T1 > > 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 EXIT SEARCH MTHPRM,FORPRM ENTRY EXIT EXTERN EXIT. HELLO (EXIT) ; ; [4100] Check for compatibility flagging ; SKIPE [FLG77.##] ;Is ANSI compatbility flagging on ? $FCALL CFR ;Yes; display the compatibility message PJRST EXIT.## ;Call the correct (dotted) name PRGEND TITLE EXIT1 ;ENTRY POINT TO JUST CLOSE FILES ENTRY EXIT1 EXTERN EXIT1. EXIT1== PRGEND TITLE QUIETX SEARCH MTHPRM,FORPRM ;[3407] DOES A QUIET EXIT FROM FOROTS (NO CPU TIME MESSAGE, NO ERROR ;[3407] SUMMARIES, IF ANY) EXTERN FOROP. SEGMENT CODE HELLO (QUIETX) ;[4121] User callable subroutine MOVEI T0,FO$QIT ;QUIET EXIT FUNCTION PJRST FOROP. PRGEND TITLE PROSB. Substring bounds checking routine SUBTTL CHRIS SMITH/CKS 8-Jun-82 ;[3132] New ;Routine to perform substring bounds checking. ;The compiler transforms the substring reference ; ; VAR(LB:UB) ; ;into ; ; VAR(LB: PROSB.(VAR,LB-1,UB,ISN,'VAR') ) ; ;where PROSB. checks the validity of LB and UB, then returns UB. If the bounds ;are invalid, a warning message is typed. (LB-1 is used instead of LB because ;LB-1 is conveniently available in the compiler's internal representation of ;substrings.) ;The conditions for valid substring bounds are ; ; LB .LE. UB ; LB .GE. 1 ; UB .LE. LEN(VAR) ; ;If a bound is found to be out of range, a warning message is typed. No ;attempt at correction is made - the program will get the same results as if ;/DEBUG:BOUNDS were not specified, except for the message. SEARCH MTHPRM,FORPRM FSRCH ;[5015] SEGMENT CODE SALL ;Argument block offsets VAR==0 ;Variable we're taking substring of LB==1 ;Lower bound - 1 UB==2 ;Upper bound ISN==3 ;Statement number of substring reference VARNAME==4 ;Sixbit variable name for error message HELLO (PROSB.) PUSH P,T2 ;SAVE ACS PUSH P,T3 XMOVEI T1,@VAR(L) ;GET POINTER TO DESCRIPTOR MOVE T1,1(T1) ;GET CHARACTER VARIABLE LENGTH MOVE T2,@LB(L) ;GET LOWER BOUND - 1 MOVE T3,@UB(L) ;GET UPPER BOUND JUMPL T2,SERR ;CHECK LB .GE. 1 (LB-1 .GE. 0) CAML T2,T3 ;MUST HAVE LB .LE. UB (LB-1 .LT. UB) JRST SERR ;NO, ERROR CAMLE T3,T1 ;CHECK UB .LE. LENGTH JRST SERR ;NO, ERROR ;Return UB. RET: MOVE T0,@UB(L) ;RETURN UB FOR SUBSTRING CALCULATION POP P,T3 ;RESTORE ACS POP P,T2 POPJ P, ;RETURN ;Here on error, type message and return normally. SERR: PUSH P,T4 ;SAVE SOME MORE REGISTERS FOR ERR MESSAGE PUSH P,T5 MOVE T4,@ISN(L) ;GET ISN LDB T5,[POINTR (VARNAME(L),ARGTYP)];[5015] CAIN T5,TP%6BZ ;[5015]Is it SIXBITZ? JRST SERR6Z ;[5025]Yes, Pass pointer to sixbitz MOVE T5,@VARNAME(L) ;[5025]No, Pass sixbit word JRST SERR2 ;[5025]and skip over this stuff SERR6Z: MOVE T5,VARNAME(L) ;[5025]GET THE 18 BIT ADDRESS HLL T5,L ;[5025]ADD THE SECTION NUMBER SERR2: ADDI T2,1 ;CONVERT LB-1 TO LB $FCALL SSE ;"%Substring range error VAR(LB:UB) ; on line ISN at LABEL+OFFSET" POP P,T5 ;RESTORE REGISTERS POP P,T4 JRST RET ;GO RETURN UB PRGEND TITLE PA1050 SEARCH MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (PA1050) MOVEI T0,FO$PAT ;ALLOW AND GET PA1050 PJRST FOROP. PRGEND TITLE FFUNIT SEARCH MTHPRM,FORPRM EXTERN FOROP. SEGMENT CODE HELLO (FFUNIT) ; ; [4130] Check for compatibility flagging. ; SKIPE [FLGON.##] ;[4130]Is any compatbility flagging on? $FCALL CFX ;[4130]Yes; display the compatibility message MOVEI T0,FO$GFU ;GET # OF FIRST FREE UNIT PUSHJ P,FOROP. MOVEM T0,@(L) ;SAVE IN USER'S VARIABLE POPJ P, PRGEND ;[3142] End of the routine TITLE TOPMEM ALLOCATE MEMORY FROM TOP DOWN SUBTTL TGS 20-Oct-83 SEARCH MTHPRM,FORPRM ;[3362] EXTERN FOROP.,ABORT. ;[3362] SEGMENT CODE ;[3362] ;[3362] SET ENDP AND STARTP TO DESIRED PAGE NUMBER TO FORCE MEMORY ;[3362] ALLOCATION FROM THE TOP DOWN. NO PREALLOCATION FOR SORT'S PAGES ;[3362] IS DONE. ;[3362] USER CALL: ;[3362] CALL TOPMEM () HELLO (TOPMEM) ;[3362] MOVE T1,@0(L) ;[3362] GET PAGE NUMBER ARGUMENT CAIG T1,777 ;[3362] WITHIN RANGE? CAIG T1,0 ;[3362] 1-777? $FCALL IPN,ABORT. ;[3362] NO, DIE. MOVEI T0,FO$NOS ;[3362] FOROP FUNCTION TO SET ENDP/STARTP PUSHJ P,FOROP. ;[3362] DO IT. GOODBY ;[3362] RETURN PRGEND ;[3362] TITLE SRTINI ALLOCATE MEMORY TOPDOWN AND PREALLOCATE SORT SUBTTLE TGS 20-Oct-83 SEARCH MTHPRM,FORPRM ;[3362] EXTERN FOROP.,ABORT.,%PASRT ;[3362] SEGMENT CODE ;[3362] ;[3362] SET ENDP AND STARTP TO DESIRED PAGE NUMBER TO FORCE MEMORY ;[3362] ALLOCATION FROM THE TOP DOWN. ALSO PREALLOCATE PAGES FOR SORT. ;[3362] FOROP. CALL FO$SRT SETS A FLAG SO FORSRT WON'T ALSO TRY TO PREALLOCATE. ;[3362] CALLING THIS ROUTINE SHOULD BE UNNECESSARY ON EXTENDED MACHINES SINCE ;[3362] SORT WILL BE IN ITS OWN SECTION. ;[3362] USER CALL: ;[3362] CALL SRTINI () HELLO (SRTINI) ;[3362] MOVE T1,@0(L) ;[3362] GET PAGE NUMBER ARGUMENT CAIG T1,777 ;[3362] WITHIN RANGE? CAIG T1,0 ;[3362] 1-777? $FCALL IPN,ABORT. ;[3362] NO, DIE. MOVEI T0,FO$SRT ;[3362] FOROP. FUNCTION CODE TO SET ENDP/STARTP PUSHJ P,FOROP. ;[3362] AND PREALLOCATE SORT PAGES. SETOM %PASRT ;[3362] ASSUME SUCCESS. CAME T0,[-1] ;[3362] DID WE PREALLOCATE? POPJ P, ;[3362] YES, RETURN. SETZM %PASRT ;[3362] NO. CLEAR FLAG, $FCALL CPP ;[3362] WARN AND RETURN. POPJ P, ;[3362] RETURN PRGEND ;[3362] TITLE FORMSL - Fortran Library error message macros SUBTTL Jon Campbell/JLC 28-May-82 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1982, 1987 ;ALL RIGHTS RESERVED. ;++ ; FUNCTIONAL DESCRIPTION: ; ; Defines the text of error messages in the fortran library (FORLIB). ; Uses the Macro $FERR to generate error messages in propper format. ; ; Arguments to $FERR: ; $FERR( 1st - Warning/error character (? or %), ; 2nd - Unique three character pnuemonic for error ; message. A F.<3 character> symbol is created, ; 3rd - Error class number. (21 for Forlib error messages.) ; 4th - Unique error number for message. (Not currently used.) ; 5th - Message to appear ; ; For more information the error message macros see FORPRM & MTHPRM. ; ; CALLING SEQUENCE: ; ; Called from FORLIB code with a $FCALL macro (which generates): ; ; JRST F.nnn ;Where nnn is the 3 letter error code. ; ; For more information on the $FERR macro see FORPRM. ; ; INPUT PARAMETERS: ; ; None ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM, FORPRM SEGMENT CODE RADIX 10 SALL $FERR (%,CFF,33,322,$I Intrinsic routine $N invoked incompatibly,<[VAXIDX]>);[4100] IF20,< $FERR (%,CFR,33,323,$I FORTRAN-20 supplied routine $N invoked,<[ANSIDX]>) $FERR (%,CFX,33,323,$I FORTRAN-20 supplied routine $N invoked,<[ANSIDX+VAXIDX]>) >;END IF20 IF10,< $FERR (%,CFR,33,323,$I FORTRAN-10 supplied routine $N invoked,<[ANSIDX]>) $FERR (%,CFX,33,323,$I FORTRAN-10 supplied routine $N invoked,<[ANSIDX+VAXIDX]>) >;END IF10 $FERR (%,CFO,33,326,$I Overlap of character assignments,<[VAXIDX]>) $FERR (?,IOE,98,0,$J) ;General-purpose I/O error $FERR (%,NOR,-1,0,ERRSET: error number out of range - ignored) ;[3205] 21,102 was VDM ;[3205] 21,103 was ICF $FERR (?,IDU,21,104,DIVERT: illegal to divert to unit $D,) $FERR (?,UNO,21,105,DIVERT: unit $D is not open,) $FERR (?,NOF,21,106,DIVERT: unit $D is not open for FORMATTED I/O,) $FERR (?,CWU,21,107,DIVERT: Can't write to unit $D,) $FERR (?,CLE,21,108,) $FERR (?,ICE,21,109,) $FERR (?,NCS,21,110,No character stack allocated - compiler error) ;[4101] 21,111 was NCA $FERR (?,AQS,21,112,) ;[3205] $FERR (%,SSE,23,113,,) $FERR (%,SRE,23,114,,) $FERR (?,TMA,21,115,) ;[3205] $FERR (?,CGP,21,116,) ;[3205] $FERR (?,MXD,-1,0,);[3322] $FERR (%,WNA,21,0,) ;[4207] $FERR (%,NFL,21,0,) ;[4207] IF10,< $FERR (?,CRP,21,117,) > ; End of IF10 IF20,< $FERR (?,NSS,21,118,) ;[3205] $FERR (?,CFS,21,119,) ;[3205] $FERR (?,CGS,21,120,) ;[3205] > ; End of IF20 $FERR (%,CPP,21,121,) ;[3362] $FERR (?,IPN,21,122,Illegal page number $O,) ;[3362] $FERR (?,SNH,-1,0,) ;[3205] IF20,< ;[3205] $FERR (?,IJE,-1,0,) ;[3205] $FERR (%,DMA,21,126,<$N: Must give lower and upper bounds to dump in non-zero section>) ;[4110] > ; End of IF20 ;[3205] $FERR (?,CCS,21,123,) ;[4101] $FERR (?,ECS,21,124,) ;[4101] $FERR (?,ALZ,21,125,<$N: Argument less than or equal to zero>) ;[4101] PRGEND TITLE IIABS -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIABS EXTERN IABS. IIABS= PRGEND TITLE JIABS -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIABS EXTERN IABS. JIABS= PRGEND TITLE IINT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IINT EXTERN INT. IINT= PRGEND TITLE JINT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JINT EXTERN INT. JINT= PRGEND TITLE IIDINT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIDINT EXTERN IDINT. IIDINT= PRGEND TITLE JIDINT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIDINT EXTERN IDINT. JIDINT= PRGEND TITLE ININT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY ININT EXTERN NINT. ININT= PRGEND TITLE JNINT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JNINT EXTERN NINT. JNINT= PRGEND TITLE IIDNNT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIDNNT EXTERN IDNIN. IIDNNT= PRGEND TITLE JIDNNT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIDNNT EXTERN IDNIN. JIDNNT= PRGEND TITLE FLOATI -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY FLOATI EXTERN FLOAT. FLOATI= PRGEND TITLE FLOATJ -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY FLOATJ EXTERN FLOAT. FLOATJ= PRGEND TITLE IIFIX -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIFIX EXTERN IFIX. IIFIX= PRGEND TITLE JIFIX -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIFIX EXTERN IFIX. JIFIX= PRGEND TITLE DFLOTI -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY DFLOTI EXTERN DFLOT. DFLOTI= PRGEND TITLE DFLOTJ -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY DFLOTJ EXTERN DFLOT. DFLOTJ= PRGEND TITLE IMAX0 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IMAX0 EXTERN MAX0. IMAX0= PRGEND TITLE JMAX0 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JMAX0 EXTERN MAX0. JMAX0= PRGEND TITLE IMAX1 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IMAX1 EXTERN MAX1. IMAX1= PRGEND TITLE JMAX1 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JMAX1 EXTERN MAX1. JMAX1= PRGEND TITLE AIMAX0 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY AIMAX0 EXTERN AMAX0. AIMAX0= PRGEND TITLE AJMAX0 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY AJMAX0 EXTERN AMAX0. AJMAX0= PRGEND TITLE IMIN0 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IMIN0 EXTERN MIN0. IMIN0= PRGEND TITLE JMIN0 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JMIN0 EXTERN MIN0. JMIN0= PRGEND TITLE IMIN1 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IMIN1 EXTERN MIN1. IMIN1= PRGEND TITLE JMIN1 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JMIN1 EXTERN MIN1. JMIN1= PRGEND TITLE AIMIN0 -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY AIMIN0 EXTERN AMIN0. AIMIN0= PRGEND TITLE AJMIN0 -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY AJMIN0 EXTERN AMIN0. AJMIN0= PRGEND TITLE IIDIM -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIDIM EXTERN IDIM. IIDIM= PRGEND TITLE JIDIM -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIDIM EXTERN IDIM. JIDIM= PRGEND TITLE IMOD -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IMOD EXTERN MOD. IMOD= PRGEND TITLE JMOD -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JMOD EXTERN MOD. JMOD= PRGEND TITLE IISIGN -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IISIGN EXTERN ISIGN. IISIGN= PRGEND TITLE JISIGN -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JISIGN EXTERN ISIGN. JISIGN= PRGEND TITLE BITEST -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY BITEST EXTERN BTEST. BITEST= PRGEND TITLE BJTEST -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY BJTEST EXTERN BTEST. BJTEST= PRGEND TITLE IIAND -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIAND EXTERN IAND. IIAND= PRGEND TITLE JIAND -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIAND EXTERN IAND. JIAND= PRGEND TITLE IIBCLR -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIBCLR EXTERN IBCLR. IIBCLR= PRGEND TITLE JIBCLR -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIBCLR EXTERN IBCLR. JIBCLR= PRGEND TITLE IIBITS -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIBITS EXTERN IBITS. IIBITS= PRGEND TITLE JIBITS -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIBITS EXTERN IBITS. JIBITS= PRGEND TITLE IIBSET -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIBSET EXTERN IBSET. IIBSET= PRGEND TITLE JIBSET -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIBSET EXTERN IBSET. JIBSET= PRGEND TITLE IIEOR -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIEOR EXTERN IEOR. IIEOR= PRGEND TITLE JIEOR -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIEOR EXTERN IEOR. JIEOR= PRGEND TITLE IIOR -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IIOR EXTERN IOR. IIOR= PRGEND TITLE JIOR -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JIOR EXTERN IOR. JIOR= PRGEND TITLE IISHFT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY IISHFT EXTERN ISHFT. IISHFT= PRGEND TITLE JISHFT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JISHFT EXTERN ISHFT. JISHFT= PRGEND TITLE INOT -- VAX FORTRAN INTEGER*2 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*2 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY INOT EXTERN NOT. INOT= PRGEND TITLE JNOT -- VAX FORTRAN INTEGER*4 FUNCTION NAME SUBTTL R. Meyers/RVM 12-Sep-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4162. ; ; Provide the VAX-11 FORTRAN INTEGER*4 function name as a synonym of ; the FORTRAN-10/20 INTEGER function. ; ;- SEARCH MTHPRM NOSYM ENTRY JNOT EXTERN NOT. JNOT= PRGEND TITLE BTEST -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY BTEST EXTERN BTEST. BTEST= PRGEND TITLE IAND -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IAND EXTERN IAND. IAND= PRGEND TITLE IBCLR -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IBCLR EXTERN IBCLR. IBCLR= PRGEND TITLE IBITS -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IBITS EXTERN IBITS. IBITS= PRGEND TITLE IBSET -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IBSET EXTERN IBSET. IBSET= PRGEND TITLE IEOR -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IEOR EXTERN IEOR. IEOR= PRGEND TITLE IOR -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY IOR EXTERN IOR. IOR= PRGEND TITLE ISHFT -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY ISHFT EXTERN ISHFT. ISHFT= PRGEND TITLE ISHFTC -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY ISHFTC EXTERN ISHFC. ISHFTC= PRGEND TITLE NOT -- Undotted Function name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit function. ; ;- SEARCH MTHPRM NOSYM ENTRY NOT EXTERN NOT. NOT= PRGEND TITLE MVBITS -- Undotted Subroutine name SUBTTL R. Meyers/RVM 2-Nov-84 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;+ ; Created in edit 4163. ; ; Provide the undottend name of the bit subroutine. ; ;- SEARCH MTHPRM NOSYM ENTRY MVBITS EXTERN MVBIT. MVBITS= PRGEND TITLE BTEST. - Test a Bit for Being On SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This function is a logical function. The ith bit of argument ; 'n' is tested. If it is 1, the value of this function is ; .TRUE.; if it is 0, the value of the function is .FALSE. ; ; CALLING SEQUENCE: ; ; FLAG = BTEST(N, I) ; ; INPUT PARAMETERS: ; ; N An INTEGER containing the bit to be tested. ; I An INTEGER that is the bit position of the bit to be ; tested (0 is the rightmost bit). ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; .TRUE. If the bit tested was one. ; .FALSE. If the bit tested was zero. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (BTEST.) ;Entry to BTEST function MOVE T1,@1(L) ;Get second argument MOVEI T0,1 ;Get a one LSH T0,(T1) ;Make up mask TDNN T0,@0(L) ;Is the bit turned on? TDZA T0,T0 ;No--return .FALSE. SETO T0, ;Yes--return .TRUE. POPJ P, ;Return PRGEND TITLE IAND. - Bitwise AND SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function performs the bitwise AND of its two ; INTEGER arguments. ; ; CALLING SEQUENCE: ; ; IANS = IAND(M, N) ; ; INPUT PARAMETERS: ; ; M An INTEGER to be AND'ed ; N An INTEGER to be AND'ed ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; The bitwise and of the two arguments as an INTEGER. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (IAND.) ;Entry to IAND function MOVE T0,@0(L) ;Get first argument AND T0,@1(L) ;AND with second argument POPJ P, ;Return PRGEND TITLE IBCLR. - Clear a bit SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function returns a copy of argument N with the ; ith bit set to zero. ; ; CALLING SEQUENCE: ; ; IANS = IBCLR(N, I) ; ; INPUT PARAMETERS: ; ; N An INTEGER containing the bit to be cleared. ; I An INTEGER that is the bit position of the bit to be ; cleared (0 is the rightmost bit). ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; A copy of argument N with bit I set to zero. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (IBCLR.) ;Entry to IBCLR function MOVE T1,@1(L) ;Get second argument MOVEI T0,1 ;Get a one LSH T0,(T1) ;Make up mask ANDCA T0,@0(L) ;Get first argument with bit turned off POPJ P, ;Return PRGEND TITLE IBITS. - Extract a bit field SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function extracts a subfield of 'LEN' bits from ; 'M' starting with bit position 'I' and extending left for ; 'LEN'. The result field is right justified and the remaining ; bits are set to zero. The value of I must be greater than or ; equal to zero, and less than 35. The value of I+LEN must be ; less than or equal to 36. ; ; CALLING SEQUENCE: ; ; IANS = IBITS(M, I, LEN) ; ; INPUT PARAMETERS: ; ; M An INTEGER, the source of the bitfield. ; I An INTEGER, the starting position of the bitfield (the ; leftmost bit). ; LEN An INTEGER, the length of the bitfield. ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; The bitfield, right justified, as an INTEGER. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (IBITS.) ;Entry to IBITS function MOVE T0,@1(L) ;Get argument 2 (The start of bit field) DPB T0,[POINT 6,PTR,5] ;Store in pointer MOVE T0,@2(L) ;Get argument 3 (The size of the bit field) DPB T0,[POINT 6,PTR,11] ;Store in pointer LDB T0,PTR ;Get bit field POPJ P, ;Return LIT SEGMENT DATA PTR: POINT .-.,@0(L),.-. ;Pointer to first argument PRGEND TITLE IBSET. - Set a bit SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function returns a copy of its first argument ; with a bit to one. ; ; CALLING SEQUENCE: ; ; IANS = IBSET(N, I) ; ; INPUT PARAMETERS: ; ; N An INTEGER containing the source bitstring. ; I An INTEGER that is the bit position of the bit to be ; set (0 is the rightmost bit). ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; A copy of the first argument with the I'th bit set to one. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (IBSET.) ;Entry to IBSET function MOVE T1,@1(L) ;Get second argument MOVEI T0,1 ;Get a one LSH T0,(T1) ;Make up mask IOR T0,@0(L) ;Get first argument with specified bit on POPJ P, ;Return PRGEND TITLE IEOR. - Bitwise Exclusive OR SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function performs the bitwise exclusive OR of its ; two INTEGER arguments. ; ; CALLING SEQUENCE: ; ; IANS = IEOR(M, N) ; ; INPUT PARAMETERS: ; ; M An INTEGER to be exclusive OR'ed ; N An INTEGER to be exclusive OR'ed ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; The bitwise exclusive OR of the two arguments as an INTEGER. ; ; SIDE EFFECTS: ; ; None ; ;-- SEARCH MTHPRM,FORPRM FSRCH SEGMENT CODE HELLO (IEOR.) ;Entry to IEOR function MOVE T0,@0(L) ;Get first argument XOR T0,@1(L) ;Exclusive OR with second argument POPJ P, ;Return PRGEND TITLE IOR. - Bitwise Inclusive OR SUBTTL Randall Meyers/RVM 3-Oct-83 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1987 ;ALL RIGHTS RESERVED. ;++ [4074] Create this routine ; FUNCTIONAL DESCRIPTION: ; ; This INTEGER function performs the bitwise inclusive OR of its ; two INTEGER arguments. ; ; CALLING SEQUENCE: ; ; IANS = IOR(M, N) ; ; INPUT PARAMETERS: ; ; M An INTEGER to be inclusive OR'ed ; N An INTEGER to be inclusive OR'ed ; ; IMPLICIT INPUTS: ; ; None ; ; OUTPUT PARAMETERS: ; ; None ; ; IMPLICIT OUTPUTS: ; ; None ; ; FUNCTION VALUE: ; ; The bitwise inclusive OR of the two arguments as an INTEGER. ; ; SIDE E