.TITLE $POL $VERSN 11 ;LAST EDIT: 10-APR-73 RFB ; ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORPORATION MAYNARD, MASS ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. .GLOBL $POLSH ; ; $POLSH - IS CALLED WHENEVER IT IS DESIRED TO ENTER POLISH ; MODE FROM IN-LINE CODE. ; IT MUST BE CALLED VIA A JSR R4,$POLSH ; R4=%4 SP=%6 .CSECT ; ; THE FOLLOWING ENTRY POINT IS A DIRTY TRICK TO DEFINE ; THE OTS VERSION N .NLIST ; ; COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; .TITLE EAE ; ; ASSEMBLE WITH ; ; $SBS ; $SBX ; $MLI ; $MLR ; $MLD ; $IR ; $DVR ; $DVI ; AINT ; $ADD ; $ADR ; $RI ; $DINT ; $POLSH ; ; TO CREATE THE EAE LIBRARY ; ; EAE=1 ; ; .LIST  .NLIST ; .TITLE EIS ; MULDIV=1 EIS=1; "MULDIV" AND "EIS" ARE SYNONYMOUS ; ; EIS V001A ; COPYRIGHT 1972, DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ASSEMBLE WITH ; ; $SBS ; $SBX ; $PII ; $MLI ; $MLR ; $MLD ; $DVR ; $DVI ; AINT ; $ADD ; $ADR ; $RI ; $DINT ; $POLSH ; ; TO CREATE THE EIS LIBRARY. ; ; IF THE FPU SWITCH IS SET THE EIS SWITCH SHOULD ON .NLIST ; .TITLE FIS FIS = 1 ; ; FIS V001A ; ; COPYRIGHT 1972 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ;ASSEMBLE WITH ; ; $ADR $MLR $DVR $POLSH ; $OTI $FPR ; ; NOTE THAT FISLIB IS BUILD BY REPLACING MODULES IN ; THE EIS LIB AFTER IT IS BUILT. ; .LIST UMBER IN THE OTS LINK MAP TO ALLOW ; THE MAINTAINER TO TELL WHAT VERSION IS BEING USED FOR ; A PARTICULAR LINK. ; ; THUS WHEN A USER FORGETS TO TELL US WHAT VERSION HE ; IS USING, ALL IS NOT LOST! ; .GLOBL $V22 ;THIS IS VERSION 22 $V22: ; $POLSH: TST (SP)+ ;DELETE JUNK FROM STACK JMP @(R4)+ ;WE'RE NOW IN POLISH MODE ; ; THE FOLLOWING CONDITIONALIZED ENTRY POINTS IDENTIFY THE ASSEMBLY ; OPTIONS USED IN THIS VERSION OF THE OTS. .IFDF EAE .GLOBL $EAE $EAE: .ENDC .IFDF EIS!MULDIV LY BE USED ; WITH ; ; $SBS ; $SBX ; $PII ; $MLI ; $DVI ; .LIST .GLOBL $EIS $EIS: .ENDC .IFDF FPU .GLOBL $FPU $FPU: .ENDC .IFDF FIS .GLOBL $FIS $FIS: .ENDC .IFDF RSX .GLOBL $RSX $RSXBC: .ENDC .IFEQ .F4SEQ .GLOBL $JSRR5 $JSRR5: .ENDC .IFNE .F4SEQ .GLOBL $JSRPC $JSRPC: .ENDC .IFDF RSX11D .GLOBL $RSXD $RSXD: .ENDC .END  .NLIST ; .TITLE FPU ; FPU=1 ; ; FPU V001A ; COPYRIGHT 1971,1972 DIGITAL EQUIPMENT CORPORATION, MAYNARD,MASS ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ASSEMBLE WITH ; ; $OTI $PRI $PDI ; SIN DSIN SQRT ; DSQRT ATAN DATAN ; EXP DEXP ALOG DLOG ; $RD ; $TSI ; $MLC ; $MLR ; $MLD ; $IR ; $DR ; $DVC ; $DVR ; $DVD ; $CMR ; $CMD ; AINT ; $ADC ; $ADD ; $ADR ; $RI ; $DINT ; SETERR $FPR $POLSH ; ; .NLIST ; ; COMMON ASSEMBLY PARAMETERS FOR DOS FORTRAN OTS ; ; ; COPYRIGHT 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ;REGISTER DEFINITIONS R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; .MACRO .F4RTN .GLOBL $RETA JMP $RETA .ENDM ; .MACRO $VERSN A .IDENT /A/ .ENDM ; .LIST  TO CREATE THE FPU LIBRARY. ; ; ALSO INCLUDE ; ; $SBS ; $SBX ; $PII ; $MLI ; $DVI ; ; ASSEMBLED WITH THE MULDIV SWITCH IF MULTIPLY/DIVIDE IS PRESENT. ; .LIST  .NLIST ;; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; MACRO DEFINITIONS FOR OPTIMIZED POLISH ; .MACRO NXT JMP @(R4)+ .ENDM ; ; MACROS FOR OPFPU ; ; GENERATE ALL CASES FOR REAL AND DOUBLE OPS ; ; .IF DF FPU .MACRO A B,C ADDF B,C .ENDM .MACRO S B,C SUBF B,C .ENDM  .NLIST ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; PARAMETERS FOR OLD FORTRAN CALLING SEQUENCE ; .F4SEQ =0 ; .LIST  .MACRO M B,C MULF B,C .ENDM .MACRO D B,C DIVF B,C .ENDM ; .MACRO PREF U,OP .GLOBL $'U'OP'R,$'U'OP'D $'U'OP'D: SETD BR .+4 $'U'OP'R: SETF ; .ENDM ; DEFINE THE FLOATING REGISTER F0 =%0 F1 =%1 ; .MACRO GENRD F .IRP X, PREF F,X FORM X .ENDM .ENDM ; .ENDC ; ; MACROS FOR OPMOV ; ; POLISH SUPPORT FOR OPT .NLIST ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC ; ; PARAMETERS FOR NEW FORTRAN CALLING SEQUENCE ; .F4SEQ =1 ; .LIST  .NLIST ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; I/O PROCESSOR GENERAL STACK TABLE (ADDRESSED BY R4) ; SAVER5 = 0. ;SAVE AREA FOR REGISTERS 0-5 SAVER4 = SAVER5+2. SAVER3 = SAVER4+2. SAVER2 = SAVER3+2. SAVER1 = SAVER2+2. SAVER0 = SAVER1+2. ERRFLG = SAVER0+2 ;=0 IF NO ERRORS ;=1 IF FLUSHING I/O LIST ENDERR = ERRFLG+2. ;PTR TO END AND ERRIMIZED MOVE OPERATORS ; ; FORM OF ENTRY POINT NAMES IS: $ABVM ; WHERE A IS LOCATION OF SOURCE, B IS LOCATION ; OF DESTINATION, V IS MOVE CODE, ; M IS DATA MODE. ; ; A & B CAN BE ANY OF: ; C - ITEM IN CORE, ADDRESS FOLLOWS ; R - ADDRESS IN R0 ; S - ITEM IN STACK ; K - (INTEGER MODE) ITEM IS CONSTANT, VALUE FOLLOWS ; 1 - (INTEGER MODE) ITEM IS CONSTANT 1 ; G - ITEM IN R0-R3 FROM FUNCTION CALL. ; ; M CAN BE ; B - BYTE ; L - LOGICAL ; I - IN .NLIST ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; THIS IS THE MAP ONTO THE I/O BUFF ($IOBUF) ; BFLP=0. ;LINK PTR BFLKER=BFLP-2. ;LINK BLOCK ERR RTN ADDR BFLDSN=BFLP+2. ;LOG DATASET NAME BFUNUM=BFLP+5. ;UNIT NUM BFPDVN=BFLP+6. ;PHYSICAL DEVICE NAME BFFLER=BFLP+8. ;FILE BLOCK ERR RTN ADDR BFHOPN=BFFLER+2. ;HOW OPEN BFERCD=BFFLER+3.  ADDRS ARGLEN = ENDERR+2. ;LENGTH OF CURRENT I/O ITEM 0,1,2,4,8 ARGTYP = ARGLEN+2. ;TYPE ITEM 1=B,2=I2,4=I4,5=R,6=C,8=D ARGPTR = ARGTYP+2. ;ADDRESS OF CURRENT I/O ITEM RECEND = ARGPTR+2. ;ADDRESS OF END LOC+1 IN CURRENT I/O BUFF RECPTR = RECEND+2. ;ADDRESS OF CURRENT POSITION IN I/O BUFF RECADR = RECPTR+2. ;ADDRESS OF START LOC OF CURRENT I/O BUFF IOTADR = RECADR+2. ;$INFR,$OUTFW,$INR,$OUTW,$INRR,$OUTR IOTSW = IOTADR+2. ;TYPE OF I/O-0=FMTD,1=UNFMTD,-1=RANDOM IOADDR = IOTSW+2. ;$FIO,$UIO,$RIO IOSTEGER ; R - REAL ; D - REAL *8 ; C - COMPLEX ; ; .MACRO MOV2 A,B .REPT 2 MOV A,B .ENDM .ENDM ; .MACRO MOV4 A,B .REPT 4 MOV A,B .ENDM .ENDM ; .MACRO NXTB JMP @(R4)+ .ENDM ; ; MACROS FOR OPARY ; ; THE SUBSCRIPTING GROUP - GROUP 0 ; ; LANGUAGE FORM: ; ...A(I)... ; ; CALLING FORM: ; ; ; ; $IJXN,SUBSC,BASE ; WHERE: ; I IS SUBSCRIPT CODE: ; ; C FOR CORE ADDRESS ; K FOR CONSTANT ; S FO .TITLE $TRACE PACKAGE - INTERIM .SBTTL PARAMETERS, ASSEMBLY OPTIONS, ETC. .IDENT /02.06/ ;RFB 19-APR-73 ; ;COPYRIGHT 1972, 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; MODIFIED BY R. BRENDER FOR RSX11D ; ; .CSECT ; ;THIS PACKAGE IS AN INTERIM TRACE PACKAGE FOR PDP-11 FORTRAN. ; ; IT DEPENDS ON THE USER WRITING A FORTRAN CODED SUBR! ;ERROR CODE BFFLNM=BFFLER+4. ;FILE NAME AND EXTENSION BFUIC=BFFLER+10. ;UIC BFPC=BFFLER+12. ;PROTECT CODE BFMCNT=BFFLER+14. ;BUFF HEADER MAX BYTE COUNT BFMODE=BFMCNT+2. ;MODE BFSTAT=BFMCNT+3. ;STATUS BFACNT=BFMCNT+4. ;ACTUAL BYTE COUNT BFPTR=BFMCNT+6. ;BUFFER START ; ; BFLEN=136. ;LENGTH OF BUFFER ; ; ; THIS IS THE MAP ONTO A DEVICE TABLE ENTRY ; DVLP=0. ;LINK PTR DVPDVN=DVLP+2. ;PHYSICAL DEVICE NAME DVHOPN=DVLP+4. ;HOW OPEN DVUNUM=DVLP+5. ;UNIT NUM DVFLNM=DVLP+"W = IOADDR+2. ;INPUT/OUTPUT SWITCH - 0=OUTPUT,1=INPUT FMTADR = IOSW+2. ;ADDRESS OF START OF FORMAT STMT RNUMAD = FMTADR ;ADDRESS OF RECORD NUMBER (IF RANDOM IO) UFNULL = FMTADR ;0 (IF UNFORMATTED IO) UNITAD = FMTADR+2. ;ADDRESS OF IO UNIT NUMBER ; ; IOPSTK = UNITAD+2. ;LENGTH OF GENERAL STACK TABLE ; ; ; ; I/O PROCESSOR FORMATTED I/O STACK TABLE (ADDRESSED BY R5) ; TSPECO = 0. ;RECORD MAX POSITN PTR(OUTPUT) PSCALE = TSPECO+2. ;CURRENT P SCALING FACTOR DSCALE = PSCALE+2. ;CURRENT DECIMAL#R ON STACK ; P FOR PARAMETER ; R FOR R0 POINTER ; G FOR R0 CONTENTS ; J IS ARRAY CODE: ; C FOR CORE ADDRESS ; A FOR PARAMETER (VIA ADB REFRENCE) ; N IS SUBSCRIPT SCALING CODE ; 1,2,4,8 FOR NON-CONSTANT SUBSCRIPT-ELEMENT ; SIZE IN BYTES ; 0 FOR CONSTANT SUBSCRIPT-SCALING DONE BY COMPILER ; ; SUBSC = ADDRESS OF VARIABLE IF I=C, ; ARG LIST OFFSET IF I=P, ; CONSTANT IF I=K, ; (NOT PRESENT IF I=S,R$OUTINE ; TO ACCOMPLISH WHATEVER TRACING HE NEEDS. THIS ROUTINE ; ACCOMPLISHES THE INTERFACE BETWEEN THE FORTRAN SYSTEM ; AND THE SUBROUTINE HE WRITES. ; ;ASSEMBLY OPTIONS - THE FOLLOWING OPTIONS ARE TURNED OFF IF SET ; TO ZERO AND TURNED ON IF SET TO ONE. ; ; ENABLE PROGRAM AND SEQUENCE TRACE - THIS CAUSES ALL ; SUBROUTINE ENTRIES AND EXITS AS WELL AS ALL SEQUENCE ; NUMBERS TO BE TRACED. ; PRGTRC = 1 ; ;ENABLE GOTO TRACE - THIS CAUSES ALL GOTOS, ASSIGNED GOTOS, ; COMPUTED GOTOS, ETC. TO BE%6. ;FILE NAME AND EXTENSION DVPC=DVLP+12. ;PROTECT CODE DVSW=DVLP+13. ;DEVICE STATUS SWITCHES DVMODE=DVLP+14. ;MODE DVSTAT=DVLP+15. ;STATUS DVRCNT=DVLP+16. ;RECORD COUNT DVUIC=DVLP+28. ;UIC DVARAD=DVLP+30. ;ERROR VAR ADDR (FROM SETFIL) ; DVFWRD=DVMODE ;RANDOM FUNC WORD DVBLKN=DVFWRD+2. ;RANDOM BLOCK NUM DVBLKA=DVFWRD+4. ;RANDOM BLOCK ADDR DVBLKL=DVFWRD+6. ;RANDOM BLOCK LEN DVAVAD=DVFWRD+8. ;RANDOM ASSOC VAR ADDR DVRMAX=DVFWRD+10. ;MAX RECS IN FILE DVRLEN=DVFWRD+12. ;& WIDTH FWIDTH = DSCALE+2. ;CURRENT FIELD WIDTH REPCNT = FWIDTH+2. ;CURRENT SPEC REPITITION COUNT SCNKAR = REPCNT+2. ;CURRENT CHAR PTD TO BY FMTPTR CVTRTN = SCNKAR+2. ;CURRENT SPEC'S CONVERT ROUTINE ADDR CVTSW = CVTRTN+2. ;CURRENT SPEC D=0,EFG=-1,IO=1,A=2,L=3 INT = CVTSW+2. ;NUMERIC ACCUMULATOR FOR WIDTHS ETC. INTSW = INT+2. ;STATE OF ACCUM - 0=EMPTY,1=POS NUM,-1=NEG EXITSW = INTSW+2. ;1 IF ITEMS NOT CVTD,0 IF ITEMS CVTD GRPCTS = EXITSW+2. ;SAVED UNEXHAUSTED HIGHEST NEST GROUP REP GRPCTI = GRPCT',OR G) ; ; BASE = ARRAY BASE MINUS ELEMENT SIZE IF J=C, ; ADDRESS OF ADB IF J=A ; (NOT PRESENT IF J=C AND I=K ; ; NOTE: WHEN THE SUBSCRIPT IS A CONSTANT ; THEN ALL SCALEING AND ADJUSTMENT FOR ; FIRST ELEMENT IS DONE AT COMPILE TIME. ; IF THE ARRAY IS LOCAL THEN IT IS ALSO ; ADDED INTO THE CONSTANT AT COMPILE TIME ; AND A SEPARATE BASE PARAMETER IS NOT ; USED. .MACRO LSHFT N .IF DF EIS .IF EQ N'.-2 ASL R0 .ENDC .IF EQ N'.-4 ASH #2,R0 .ENDC .IF EQ N'.-8. AS( TRACED. ; GTOTRC = 1 ; ; ENABLE STORE TRACE - POPS TO VARIABLES AND ARRAY ELEMENTS ; ARE TRACED HERE. ; STOTRC = 1 ; .SBTTL MACROS AND USEFUL THINGS .MACRO CALL ADDR JSR PC,ADDR .ENDM .MACRO RETURN RTS PC .ENDM .MACRO POLCAL SUB .GLOBL $CALL,$POLSH,SUB JSR R4,$POLSH +$CALL,SUB .ENDM .MACRO POLCA0 .GLOBL $RPOL0 JSR R4,$RPOL0 .+2 .ENDM .SBTTL INSTRUCTIONS FOR USE ; ; THIS )RECORD LENGTH ; .LIST *S+2. ;INITIAL HIGHEST LEVEL NEST GROUP REP CNT GRPCT = GRPCTI+2. ;CURRENTLY ACTIVE GROUP REPETITION COUNT NPRN2 = GRPCT+2. ;PTR TO LOWEST NESTING (IN FMT STMT) NPRN1 = NPRN2+2. ;PTR TO HIGHEST NESTING (IN FMT STMT) NEST = NPRN1+2. ;NESTING LEVEL FMTPTR = NEST+2. ;ADDRESS OF CURRENT POS IN FORMAT STMT ; ; IOFSTK = FMTPTR+2. ;LENGTH OF FORMATTED I/O STACK TABLE ; ; ; I/O PROCESSOR UNFORMATTED I/O STACK TABLE (ADDRESSED BY R5) ; IOSTAT=0. ;3=ONLY SEG,1=FIRST SEG,2=LAST SEG ;0=NEITHER FIR+H #3,R0 .ENDC .IFF .IF GE N'.-2 ASL R0 .ENDC .IF GE N'.-4 ASL R0 .ENDC .IF GE N'.-8. ASL R0 .ENDC .ENDC .ENDM ; .MACRO GENX J,N .GLOBL $P'J'X'N,$S'J'X'N,$C'J'X'N,$R'J'X'N,$G'J'X'N $P'J'X'N: MOV (R4)+,R1 ADD R5,R1 MOV @(R1)+,R0 BR $G'J'X'N $R'J'X'N: MOV @R0,R0 BR $G'J'X'N $S'J'X'N: MOV (SP)+,R0 BR $G'J'X'N $C'J'X'N: MOV @(R4)+,R0 $G'J'X'N: .IF IDN A,J DEC R0 .ENDC ,ROUTINE IS AN INTERFACE ROUTINE WHICH ALLOWS A USER TO ; WRITE A SUBROUTINE IN FORTRAN WHICH WILL TRACE ; VARIOUS GOOD AND WONDERFUL THINGS WHICH MAY BE OF ; INTEREST. IT IS DONE THIS WAY SO THAT THE USER CAN ; TAILOR THE TYPE OF TRACE HE NEEDS. FOR INSTANCE, HE ; CAN TYPE OUT THE VALUE OF VARIABLES WHICH ARE ; STORED INTO, ALONG WITH THE LINE NUMBER WHERE ; THE STORE OCCURRED. ; ; THIS ROUTINE CALLS A SUBROUTINE NAMED "TRACE" WITH A CALL ; SIMILAR TO "CALL TRACE(ICNT,ITYPE,IPAR,INAM)". ; ; .ST NOR LAST SEG ; ; IOUSTK=IOSTAT+2. ;LEN OF UNFMTD STACK TABLE ; ; ; ; I/O PROCESSOR RANDOM I/O STACK TABLE(ADDR BY R5) ; RECMAX=0. ;TOTAL NUM OF FIXED LEN RECORDS LENMAX=RECMAX+2. ;REMAINING NUM BYTES TO USE(THIS SEG) AVADDR=LENMAX+2. ;ADDR OF ASSOCIATED VAR ; IORSTK=AVADDR+2. ;LEN OF RANDOM I/O STACK TABLE ; .LIST /LSHFT N .IF IDN A,J ADD @(R4)+,R0 .IFF ADD (R4)+,R0 .ENDC NXT .ENDM ; ; MACROS FOR OPMDI ; ; POLISH SUPPORT FOR OPTIMIZED INTEGER MULTIPLY ; AND DIVIDE ; .IF DF EIS!EAE .IF DF EAE ; MQ=177304 MUL=177306 DIV=177300 ; .ENDC ;DF EAE ; .MACRO GENMDI A,B,C .GLOBL $'A'B'C'MI $'A'B'C'MI: GTMDI A,M DOMDI M,B ST M,C NXT .GLOBL $'A'B'C'DI $'A'B'C'DI: .IF IDN A,S .IF IDN B,S MOV (SP)+,R1 GTMDI A,D D0ICNT IS A VARIABLE WHICH CONTAINS WHAT KIND OF TRACE ; IS OCCURRING. ; ITYPE IS A VARIABLE WHICH TELLS THE VARIABLE TYPE ; IN CASE OF A STORE TRACE. ; IPAR IS A VARIABLE CONTAINING SUPPLEMENTAL ADDRESS ; INFORMATION. ; INAM IS AN ARRAY POINTER TO THE ASCII PROGRAM NAME. ; ; ICNT MAY HAVE THE FOLLOWING VALUES: ; ; 1 - SUBROUTINE ENTRY, INAM POINTS TO A 6 CHARACTER ; ASCII SUBROUTINE NAME. ; ; 2 - SUBROUTINE RETURN, INAM POINTS TO A 6 CHARACTER ; ASCII SUBROUTINE NAME BEING RETURNED TO. 1C C TITLE: TRACEF C VERSION: 04 C LAST EDIT: 20-APR-73 RFB C C COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., C MAYNARD, MASS. 01754 C SUBROUTINE TRACEF(ICNT,ITYPE,JPAR,INAM) C THIS ROUTINE IS A FORTRAN TRACE ROUTINE. C IT CAN BE MODIFIED, BY THE USER, TO C TAILOR THE TYPE OF TRACE, HE NEEDS. C FOR INSTANCE, HE CAN TYPE OUT THE C VALUE OF VARIABLES WHICH ARE STORED C INTO, ALONG WITH THE LINE NUMBER WHERE C THE STORE OCCURRED. C THE CALL IS SIMILAR TO: C "CALL TRACEF (ICNT,ITYP3OMDI D,R1 ST D,C NXT .MEXIT .ENDC .ENDC GTMDI A,D DOMDI D,B ST D,C NXT .ENDM .MACRO MM J,K .IF DF EAE MOV J,K .IFF MUL J,K .ENDC .ENDM .MACRO DD J,K .IF DF EAE MOV J,K .IFF DIV J,K .ENDC .ENDM .MACRO GTMDI X,OP .IF DF EAE R=MQ .IFF R=R3 .ENDC .IF IDN X,C MOV @(R4)+,R .ENDC .IF IDN X,R MOV @R0,R .ENDC .IF IDN X,S MOV (SP)+,R .ENDC .IF IDN X,G MOV R0,R .ENDC .IF NDF EAE .IF IDN OP,D SXT R2 .ENDC .ENDC .E4; ; 3 - STATEMENT TRACE, IPAR CONTAINS THE SEQUENCE NUMBER OF ; THE STATEMENT ABOUT TO BE EXECUTED. ; ; 4 - GOTO REFERENCE - IPAR CONTAINS THE SEQUENCE NUMBER ; OF THE STATEMENT WHERE THE TRANSFER WILL ; OCCUR. ; ; 5 - STORE REFERENCE - ITYPE HAS THE VARIABLE TYPE, ; IPAR POINTS TO THE VARIABLE, WHERE ; ITYPE= 0 BYTE ; 1 LOGICAL ; 2 INTEGER ; 3 REAL ; 4 DOUBLE ; 5 COMPLEX ; ; 6 - SELECTED STORE REFERENCE (AS IN 5) ; ; ; 7 - ASSIGN STATEMENT - IPAR CONTAINS SEQUENCE NUMBE5E,IPAR,INAM)". C C ICNT IS A VARIABLE WHICH CONTAINS WHAT C KIND OF TRACE IS OCCURRING C C ITYPE IS A VARIABLE WHICH TELLS THE C VARIABLE TYPE IN CASE OF A STORE TRACE. C C IPAR IS A VARIABLE CONTAINING SUPPLEMENTAL C ADDRESS INFORMATION C C INAM IS AN ARRAY POINTER TO THE ASCII C PROGRAM NAME. C C ICNT MAY HAVE THE FOLLOWING VALUES: C C 1 - SUBROUTINE ENTRY, INAM POINTS TO A 6 C CHARACTER ASCII SUBROUTINE NAME. C C 2 - SUBROUTINE RETURN, INAM POINTS TO A 6 C CHARACTER ASCII SUBR6116FORRUN.DGN 000 FORT000000 INVALID CALL TO ERROR 001 FORT000001 NO SPACE TO DO I/O 002 FORT000002 SUBROUTINE DIRECTLY(INDIRECTLY) REFERENCES ITSELF 003 FORT000003 ILLEGAL FLOATING POINT INSTRUCTION 004 FORT000004 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 005 FORT000005 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 006 FORT001000 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 007 FORT001001 DEVICE PARITY ERROR 008 FORT001002 CHECKSUM/PARITY ERROR-END OF DATA ERROR (RANDOM) 009 FORT0010037NDM .MACRO DOMDI OP,RT .IF DF EAE .IF IDN OP,M R=MUL .IFF R=DIV .ENDC .IFF .IF IDN OP,M R=%3 .IFF R=%2 .ENDC .ENDC .IF IDN RT,C OP'OP @(R4)+,R .ENDC .IF IDN RT,K OP'OP (R4)+,R .ENDC .IF IDN RT,R OP'OP @R0,R .ENDC .IF IDN RT,S OP'OP (SP)+,R .ENDC .IF IDN RT,G OP'OP R0,R .ENDC .IF IDN R1,RT OP'OP R1,R .ENDC .ENDM .MACRO ST OP,DS .IF DF EAE R=MQ .IFF .IF IDN OP,M R=%3 .IFF R=%2 .ENDC .ENDC .IF IDN DS,C MOV R,@(R4)+FR, IF PRESENT, ; OF ASSIGNED LABEL ; ; ; THE SUBROUTINE TRACE MUST FOLLOW THE NORMAL RULES FOR A ; FORTRAN SUBROUTINE. IT SHOULD NEVER BE CALLED BY ANY ; OTHER USER ROUTINE, BUT MAY CALL OTHER ROUTINES ITSELF. ; ; BE WARNED THAT THE SUBROUTINE TRACE HAS ALL ERROR TRACEING ; TURNED OFF SO THAT ANY ERRORS OCCURRING WITHIN IT WILL ; SHOW THAT THE TRACEBACK NAME AND SEQUENCE NUMBER OF THE ; STATEMENT WHICH CAUSED THE TRACE ROUTINE TO BE ENTERED, ; NOT THEGOUTINE NAME BEING C RETURNED TO. C C 3 - STATEMENT TRACE, IPAR CONTAINS THE C SEQUENCE NUMBER OF THE STATEMENT ABOUT C TO BE EXECUTED. C C 4 - GOTO REFERENCE - IPAR CONTAINS THE SEQUENCE C NUMBER OF THE STATEMENT WHERE THE TRANSFER C WILL OCCUR. C C 5 - STORE REFERENCE - ITYPE HAS THE VARIABLE TYPE, C IPAR POINTS TO THE VARIABLE, WHERE C ITYPE= 0-BYTE C 1-LOGICAL C 2-INTEGER C 3-REAL C 4-DOUBLE C 5-COMPLEX C 6 - STORE REFERENCE OF SELECTED VARIABLES - ITYPE HAS THE C H UNDIAGNOSABLE I/O ERROR 010 FORT001004 END OF FILE OR END OF MEDIUM 011 FORT001005 UNABLE TO ALLOCATE CONTIGUOUS FILE 012 FORT001006 DEFINE FILE NOT DONE (RANDOM ACCESS) 013 FORT001007 DEFINE FILE DONE (NOT RANDOM ACCESS) 014 FORT001008 INVALID PROTECTION FOR FILE ACCESS 015 FORT001009 FILE DOES NOT EXIST / OR IS ALREADY OPEN 016 FORT001010 UNABLE TO OPEN FILE 017 FORT001011 WRONG MODE FOR FILE ACCESS 018 FORT001012 INVALID DEVICE NUMBER 019 FORT001013 INVALID RECORD NUMBER (RANDOM ACE .ENDC .IF IDN DS,R MOV R,@R0 .ENDC .IF IDN DS,S MOV R,-(SP) .ENDC .ENDM ; .ENDC ;DF EIS!EAE .LIST ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ""DD "@DDD""@DDDDDDDDDDDDDD "D"""ADDB CdfkQ  mkQ  kQ  &kQ (kQ  fkQ  P`rkQ  EfukQ fxdkQ zkQ .xQkQ )kQ F$( -Ws&y 2t'&( I] [_$DwUUUDDDDDDDD ww8a ͋,L  Bw(B ` % & ~&*C$$Βe E%>l  aʋaՀ$ & * P$ ΋Ί   ΋   d Ί  ( 1'u  Q$f $5@ U C΋ Cb M΋U@ U &  B" .&0 J STATEMENT IN ERROR!! ; ;NOTES: ; ; 1. IF THE GOTO TRACE IS USED, AND THE PROGRAM IS COMPILED ; WITH THE /SU SWITCH THEN SEQUENCE INFORMATION IS NOT ; AVAILABLE. A SEQUENCE NUMBER OF 0 WILL BE SUPPLIED ; AS A DEFAULT VALUE. .SBTTL USER ROUTINE INTERFACE ; ; INTERFACE TO THE USER TRACE ROUTINE ; TRACIT: MOV R0,-(SP) ;SAVE MOV R1,-(SP) ;THE MOV R2,-(SP) ;VARIOUS MOV R3,-(SP) ;REGISTERS MOV R4,-(SP) MOV R5,-(SP) INC TFLG ;DISABLE TRKVARIABLE TYPE, IPAR POINTS TO THE VARIABLE. C C 7 - ASSIGN STATEMENT - JPAR CONTAINS C THE SEQUENCE NUMBER BEING ASSIGNED C C C THE SUBROUTINE TRACEF MUST FOLLOW THE C NORMAL RULES FOR A FORTRAN SUBROUTINE C C WARNING: ANY ERRORS OCCURING C WITHIN THE SUBROUTINE TRACE, C WILL SHOW THAT THE TRACEBACK NAME C AND SEQUENCE NUMBER OF THE STATEMENT C WHICH CAUSED THE TRACE ROUTINE TO BE C ENTERED, NOT THE STATEMENT IN ERROR. C C C NOTE: IF THE GOTO TRACE IS USED, DO NOT C COMPILE THE PROLCESS) 020 FORT001014 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 021 FORT001015 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 022 FORT001016 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 023 FORT001017 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 024 FORT002000 CANNOT DO CONVERSION WITH FORMAT SPECIFIED 025 FORT002001 PARENTHESES NESTING TOO DEEP (>2) IN FORMAT 026 FORT002002 SYNTAX ERROR IN FORMAT 027 FORT002003 REFERENCE OUTSIDE OF RECORD BOUNDARIES 028 FORT002004 SYSTEM ERROR NO DIAGNOSTICMC FORTRAN SYSTEM DIAGNOSTIC MESSAGE FILE BUILDER C THIS PROGRAM CAN BE USED TO BUILD FILES FOR C EITHER DOS-11 OR RSX-11D AND IT CAN BE C RUN UNDER EITHER SYSTEM BY MAKING THE APPROPRIATE C CHOICE OF "ASSIGN" OR "SETFIL" BELOW C C CREATES AND THEN PRINTS A FILE OF MESSAGES C FOR ACCESS BY THE FORTRAN COMPILER OR OTS C INPUT: C FILE - AS SPECIFIED BY KEYBOARD TYPE-IN C LUN - 4 C 1ST RECORD-- I3,40A1 I3=#OF 64 CHARACTER MESSAGES C TO BE ALLOCATED. 40A1=FILE SPECIFICATION C OTHER RECONACEBACK STUFF CALL SETFLG MOV ICNT,R0 TSTB USRFLG(R0) BEQ XT1 POLCAL TRACEF ARGLST: BR XT +ICNT ;CLASS OF TRACE +ITYPE ;TYPE OF VARIABLE PARM: 0 ;SUPPLIMENTAL INFO +INAM ;ROUTINE NAME IN ASCII XT: POLCA0 XT1: CLR TFLG ;RE-ENABLE TRACEBACK MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 XXT: RETURN ; ; SETFLG ; ; IF USRFLG IS 0 THEN SWITCHES ARE IN CONTR0L ; SO READ THE SWITCHES AND DISTRIBUTE IN REST OF USRFLG ; ELSE RETURN OGRAM WITH THE /SU C SWITCH, SINCE THE GOTO TRACE USES C THE SEQUENCE INFORMATION. C C BYTE INAM,LPAR,LNAM DIMENSION INAM(6),LNAM(6) DOUBLE PRECISION JPAR,DPAR REAL RPAR COMPLEX CPAR EQUIVALENCE (IPAR,LPAR,RPAR,DPAR,CPAR) DPAR=JPAR GO TO (10,20,30,40,50,50,70),ICNT C C SUBROUTINE ENTRY 10 CONTINUE C WRITE(6,100)INAM 100 FORMAT(/' ENTER ',6A1) RETURN C C SUBROUTINE RETURN C 20 CONTINUE WRITE (6,101)INAM 101 FORMAT (' RETURN TO ',6A1/) RETURN C C SEQUENCE TRACE C 3P MESSAGE ASSIGNED 029 FORT002005 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 030 FORT003000 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 031 FORT003001 EXPONENT OVERFLOW IN DOUBLE PRECISION ADDITION 032 FORT003002 EXPONENT OVERFLOW IN REAL ADDITION 033 FORT003003 DOUBLE PRECISION DIVISION BY ZERO 034 FORT003004 EXPONENT OVERFLOW IN DOUBLE PRECISION DIVISION 035 FORT003005 INTEGER DIVISION BY ZERO 036 FORT003006 EXPONENT OVERFLOW IN REAL DIVISION 037 FORT003007 COMPLEX DIVISION BY ZERO 03QRDS- I3,64A1 I3=POSITION OF CURRENT C MESSAGE IN THIS FILE. 64A1=CURRENT MESSAGE C LAST RECORD-- I3,64A1 I3=NEGATIVE INTEGER. 64A1=IGNORED C OUTPUT: C FILE - FILE SPECIFICATION READ INTO FILSPC C LUN - 1 C 64 CHARACTER FIXED LENGTH RECORDS C C LUN - 5 (NORMALLY LP:) C PRINTED OUTPUT C INTEGER COUNT,INDEX BYTE TODAY(9),FILSPC(40),A(64),NULL(64) DATA NULL / 64 * 0 / COUNT=0 WRITE (6,1000) 1000 FORMAT('$SPECIFY INPUT FILE>') READ(6,10001) I0,FILSPC 10001 FORMAT(Q,4R ; SETFLG: TSTB USRFLG BNE 1$ POLCAL READSW BR 2$ ;ONE ARGUMENT +NAM3 ;A HANDY TEMPORARY 2$: POLCA0 MOV NAM3,R0 ;BITS FROM SWITCHES ASR R0 ;IGNORE BIT 0 MOV #1,R1 ;COUNT FROM 1 4$: CLRB USRFLG(R1) ;PRE-CLEAR ASR R0 ;RELEVANT BIT TO C-BIT BCC 3$ BISB #1,USRFLG(R1) ;SET USER BIT 3$: INC R1 ;NEXT POSITION CMP R1,#NTYPES ;DONE? BLE 4$ ;NOT YET 1$: RETURN ; ; COMMON WORK AREAS ; ; ICNT: .BLKW ;CLASS OF TRACE ITYPE: .BLKW ;S0 CONTINUE WRITE (6,102)IPAR 102 FORMAT(' SEQ. ',I4) RETURN C C GOTO TRACE C 40 WRITE (6,103)IPAR 103 FORMAT(' GOTO SEQ. ',I4) RETURN C C STORE TRACE C 50 ITYPE=ITYPE+1 GOTO (1000,1100,1200,1300,1400,1500),ITYPE C C BYTE C 1000 WRITE(6,1001) LPAR 1001 FORMAT(' BYTE = ',I4) RETURN C C LOGICAL C 1100 WRITE(6,1101) IPAR 1101 FORMAT(' LOGICAL = ',O6) RETURN C C INTEGER C 1200 WRITE(6,1201) IPAR 1201 FORMAT(' INTEGER = ',I6) RETURN C C REAL C 1300 WRITE(6,1301T8 FORT003008 REAL DIVISION BY ZERO 039 FORT003009 EXPONENT OVERFLOW IN COMPLEX MULTIPLICATION 040 FORT003010 EXPONENT OVERFLOW IN DOUBLE PRECISION MULT. 041 FORT003011 EXPONENT OVERFLOW DURING NEGATION 042 FORT003012 EXPONENT OVERFLOW IN REAL MULTIPLICATION 043 FORT003013 INTEGER OVERFLOW ON ADDITION 044 FORT003014 PRODUCT OUTSIDE OF RANGE ON INTEGER MULT. 045 FORT003015 INTEGER BASE = 0, INTEGER EXPONENT <= 0 046 FORT003016 DOUBLE BASE = 0, INTEGER EXPONENT <= 0 047 FORT003017 DOUBLE BU0A1) C C SET UP THE INPUT FILE NAME ASSIGNMENT C C CALL ASSIGN(4,FILSPC,I0) CALL SETFIL(4,FILSPC,IERR,'SY',0) C ENDFILE 6 C C READ FIRST RECORD AND ALLOCATE CONTIGUOUS FILE READ(4,1001) IBLOK,FILSPC 1001 FORMAT(I3,40A1) C C SET UP THE OUTPUT FILE NAME ASSIGNMENT C C CALL ASSIGN(1,FILSPC,40) CALL SETFIL(1,FILSPC,IERR,'SY',0) C DEFINE FILE 1(IBLOK, 32, U, INDEX) C C INITIALIZE ALL RECORDS OF OUTPUT FILE TO ZEROS DO 10 I=1,IBLOK 10 WRITE (1'I)NULL C C READ INPUT AND WRITE EACH RVTYPE OF VARIABLE IPAR: .BLKW ;SUPPLEMENTAL VARIABLE INAM: .BLKB 6 ;SAVE SPACE FOR PROGRAM NAME .ASCII / / ;MAKES INAM DOUBLE PRECISION TFLG: .WORD 0 ;INTERNAL TRACE CONTROL WORD ;INITIAL USER FLAGS - ALL TRACING ON NTYPES =7 USRFLG: .BYTE 0 ;TRACING INITIALLY UNDER SWITCH CONTROL .REPT NTYPES .BYTE 1 .ENDM .EVEN CON6: +6 ;CONSTANT 6 LST: .BLKW 20. LSTEND: .IFNE PRGTRC .SBTTL PROGRAM AND SEQUENCE TRACE .GLOBL $NAM,$RET,$ERRA,$OTI,$AOTS W) RPAR 1301 FORMAT(' REAL = ',G20.8) RETURN C C DOUBLE PRECISION C 1400 WRITE(6,1401) DPAR 1401 FORMAT(' DOUBLE = ',D25.10) RETURN C C COMPLEX C 1500 WRITE(6,1501) CPAR 1501 FORMAT(' COMPLEX = (',G12.5,',',G12.5,')') RETURN C C C ASSIGN STATEMENT TRACE C 70 WRITE(6,71) IPAR 71 FORMAT(' ASSIGN = ',I4) RETURN END XASE = 0, DOUBLE EXPONENT <= 0 048 FORT003018 DOUBLE BASE < 0, DOUBLE EXPONENT <= 0 049 FORT003019 REAL BASE = 0, REAL EXPONENT <= 0 050 FORT003020 REAL BASE < 0, REAL EXPONENT <= 0 051 FORT003021 REAL BASE = 0, INTEGER EXPONENT <= 0 052 FORT003022 REAL OUTSIDE RANGE ON REAL TO INTEGER CONVERSION 053 FORT003023 EXPONENT OVERFLOW ON DOUBLE TO REAL CONVERSION 054 FORT003024 FLOATING POINT EXPONENT OVERFLOW 055 FORT003025 FLOATING POINT DIVISION BY ZERO 056 FORT003026 INTEGER OVERFLOW ON DO-YECORD OF OUTPUT FILE 40 READ (4,1002,END=50)I0,I1,A 1002 FORMAT(Q,I3,64A1) IF (I1 .LT. 0) GO TO 50 COUNT=COUNT+1 C I0=I0-3 IF (I0 .LE. 0) GO TO 40 IF (I0 .LT. 64)A(I0+1)=0 C I1=I1+1 WRITE (1'I1)A GOTO 40 C C READ THE CONTIGUOUS FILE AND C PRINT A LISTING OF THE COMPLETED FILE 50 ENDFILE 4 CALL DATE(TODAY) WRITE (5,1003) FILSPC, TODAY 1003 FORMAT(1H1,28X,40A1/1H0,'MSG MESSAGE',17X,9A1/' NUM'/) C DO 51 I1=1,IBLOK READ(1'I1)A I2=I1-1 51 WRITE (5,1004) I2,A 1004 FORMAT(X,Z ; ; CHAIN SUBROUTINE NAMES TOGETHER AND SAVE ; END OF CHAIN PTR ; $NAM: TST TFLG ;ARE WE IN TRACE ROUTINE? BNE NAM2 ;YES DON'T TRACE IT CMP #055740,6(R4) ;MAIN PROGRAM? BNE NAM1 ;BR IF NOT MOV R4,-(SP) JSR PC,$OTI ;DO OTS INITIALIZATION MOV (SP)+,R4 NAM1: JSR PC,$AOTS ;ADDRESS OF OTS TABLES ADD #6,R0 ;ADDRESS OF $NAMC MOV @R0,R1 ;ADDRESS LAST ENTRY IN CHAIN MOV R4,(R0)+ ;NEW LAST ENTRY TST @R4 ;IS SUBROUTINE ATTEMPTING TO REF ITSELF? BNE NAMERR ;BRANCH IF SO MOV R1,(R4)+\LOOP VARIABLE 057 FORT003027 COMPLEX BASE = 0, INTEGER EXPONENT <= 0 058 FORT003028 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 059 FORT003029 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 060 FORT003030 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 061 FORT004000 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 062 FORT004001 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 063 FORT004002 DEXP CALLED WITH EXPONENT GREATER THAN 88. 064 FORT004003 DLOG ARGUMENT LESS THAN OR EQUAL TO ZERO 065 FORT004004]I3,X,64A1) WRITE (5,1005) IBLOK,COUNT 1005 FORMAT(/X,I3,' MESSAGES ALLOCATED.',I6,' MESSAGES INPUT.') ENDFILE 1 ENDFILE 5 END ^ ;CHAIN ENTRIES MOV @R0,(R4)+ ;SET SEQ NUM OF CALLING STMT CLR @R0 ;INIT SEQUENCE NUMBER THIS ROUTINE MOV R4,NAM3 ;ADR OF NAME IN RAD50 POLCAL R50ASC ;CONVERT TO ASCII BR NAM4 +CON6 ;SIX CHARS OUTPUT NAM3: +0 ;ADDRESS OF RAD50 +INAM ;ADDRESS OF ASCII NAM4: POLCA0 MOV NAM3,R4 ;RECOVER POLISH POINTER MOV #1,ICNT ;CLASS IS 1 CALL TRACIT ;CALL TRACE CMP (R4)+,(R4)+ ;STEP OVER ROUTINE NAME JMP @(R4)+ ;RETURN NAM2: ADD #8.,R4 ;IGNORE NAME JMP @(R4)+ ;ENTRY IN TRACE SUBROUT_DIRECTORY DT0: [ 1,1 ] 23-OCT-73 POL .MAC 4 27-SEP-73 <233> 027420 EAE .MAC 2 27-SEP-73 <233> 054266 EIS .MAC 3 27-SEP-73 <233> 100053 FIS .MAC 2 27-SEP-73 <233> 056721 FPU .MAC 3 27-SEP-73 <233> 111554 PRM .MAC 2 27-SEP-73 <233> 061501 OPPRM .MAC 12 23-OCT-73 <233> 026625 PRMR5 .MAC 2 27-SEP-73 <233> 041201 PRMPC .MAC 2 27-SEP-73 <233> 041077 SYMBOL.MAC 7 27-SEP-73 <233> 133257 M` DSQRT ARGUMENT LESS THAN ZERO 066 FORT004005 EXP CALLED WITH EXPONENT GREATER THAN 88. 067 FORT004006 ARGUMENTS OUT OF RANGE FOR "TIME" CONVERSION 068 FORT004007 IABS ABS(X) GREATER THAN 2**15 - 1 069 FORT004008 IDIM RESULT OUTSIDE OF RANGE -2**15-1 TO 2**15-1 070 FORT004009 ISIGN RESULT GREATER THAN 2**15 - 1 071 FORT004010 ALOG ARGUMENT LESS THAN OR EQUAL TO ZERO 072 FORT004011 SQRT ARGUMENT LESS THAN ZERO 073 FORT004012 SNGL EXPONENT OVERFLOW ON ROUND 074 FORT004013 RANDU/RAN WRONG NbINE ; ; UNDO SUBROUTINE CHAIN ; $RET: TST TFLG ;ARE WE IN TRACE ROUTINE BNE RET3 ;YES DON'T TRACE IT. MOV R0,-(SP) ;SAVE RETURN VALUE JSR PC,$AOTS ;ADR OTS TABLES ADD #6,R0 ;ADR $NAMC MOV @R0,R4 ;ADR OF LAST CHAIN MOV @R4,(R0)+ ;DELETE LAST ENTRY FROM CHAIN MOV @R4,RET1 ;SAVE FOR NAME CONVERSION ADD #4,RET1 CLR (R4)+ ;CLEAR IN ROUTINE MOV @R4,@R0 ;RECOVER SEQUENCE NUMBER CLR (R4)+ ;CLEAR IN ROUTINE MOV @R0,IPAR ;FOR USE BY TRAP .MAC 5 27-SEP-73 <233> 067233 TRACEX.MAC 36 27-SEP-73 <233> 000126 TRACEF.FTN 8 27-SEP-73 <233> 005333 RUNDGN.SRC 14 27-SEP-73 <233> 031646 FORDGN.FTN 6 27-SEP-73 <233> 166614 FREE BLKS: 454 FREE FILES: 41 dUMBER OF ARGUMENTS 075 FORT004014 PDUMP WRONG NUMBER OF ARGUMENTS 076 FORT004015 INVALID ARGUMENT TO "SETFIL" 077 FORT004016 FILE ALREADY OPEN ON UNIT - "SETFIL" IGNORED 078 FORT004017 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 079 FORT004018 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 080 FORT004019 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 081 FORT004020 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 082 FORT005000 CSQRT UNDERFLOW 083 FORT005001 EXPONENT UNDERFLOW ON DOUBLE PRECISION AfACIT POLCAL R50ASC ;CONVERT NAME TO ASCII BR RET2 +CON6 ;6 LETERS RET1: +0 ;ADR OF RAD50 +INAM ;ADR OF ASCII RET2: POLCA0 MOV #IPAR,PARM ; MOV #2,ICNT ;CLASS IS 2 CALL TRACIT MOV (SP)+,R0 RET3: .F4RTN ;RETURN ; ; NAMERR: MOV #512.,R0 ;CALL ERROR CLASS=0/NUM=2-NO RETURN JSR PC,$ERRA ; ; SAVE SEQUENCE NUM OF CURRENT FORTRAN STMT ; ; .GLOBL $SEQ $SEQ: TST TFLG ;ARE WE IN THE TRACE ROUTINE? BNE BSEQ ;YES, DON'T TRACE IT MhDDITION 084 FORT005002 EXPONENT UNDERFLOW ON REAL ADDITION 085 FORT005003 EXPONENT UNDERFLOW ON REAL DIVISION 086 FORT005004 DEXP CALLED WITH EXPONENT LESS THAN -89.4 087 FORT005005 EXP CALLED WITH EXPONENT LESS THAN -89.4 088 FORT005006 EXPONENT UNDERFLOW ON DOUBLE MULTIPLICATION 089 FORT005007 EXPONENT UNDERFLOW ON REAL MULTIPLICATION 090 FORT005008 EXPONENT UNDERFLOW ON DOUBLE PRECISION DIVISION 091 FORT005009 FLOATING POINT EXPONENT UNDERFLOW 092 FORT005010 SYSTEM ERROR NO DIAGNOSTICjOV (R4),IPAR ;GET SEQUENCE NUMBER MOV #3,ICNT ;SET SEQUENCE ENTRY MOV #IPAR,PARM CALL TRACIT JSR PC,$AOTS MOV (R4)+,8.(R0) ;SAVE NUMBER ; ; JMP @(R4)+ ;EXIT BSEQ: TST (R4)+ JMP @(R4)+ .ENDC ;IFNE PRGTRC .IFNE GTOTRC .SBTTL GOTO TRACE ; ; $TR (GOTO) COMMAND ; .GLOBL $TR ; $TR: MOV @R4,R4 ;PICK UP TRANSFER ADDR GOEX: TST TFLG ;ARE WE ALREADY TRACING? BNE 1$ ;YES MOV #IPAR,PARM CMP @R4,#$SEQ ;IS SEQUENCE NUMBER AVAILABLE? l MESSAGE ASSIGNED 093 FORT005011 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 094 FORT005012 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 095 FORT006000 CONVERSION ERROR 096 FORT006001 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 097 FORT006002 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 098 FORT006003 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 099 FORT007000 SUBSCRIPT LESS THAN OR EQUAL TO ZERO 100 FORT007001 SUBSCRIPT GREATER THAN DIMENSIONED 101 FORT007002 VALUE OUT OF BOUNDS (COMPUTED nBEQ 2$ ;YES CLR IPAR ;NO - SUBSTITUTE 0 BR 3$ 2$: MOV 2(R4),IPAR ;GET NEW SEQUENCE NUMBER 3$: MOV #4,ICNT ;SET CLASS TO GOTO CALL TRACIT ;DO THE TRACE 1$: JMP @(R4)+ ;AND TRANSFER ; .GLOBL $TRA,$AS ; ; ASSIGNED GOTO - RUN-TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRA ;ENTRY ADDRESS ; $TRA: MOV (SP)+,R4 ;MOVE VALUE TO R4 AND BR GOEX pOR ASSIGNED GO TO) 102 FORT007003 FLOATING POINT UNDEFINED VARIABLE 103 FORT007004 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 104 FORT007005 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 105 FORT007006 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 106 FORT007007 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 107 FORT007008 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 108 FORT007009 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 109 FORT007010 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 110 FORT008r .GLOBL $TRAL ; ; ASSIGNED GOTO WITH CHECK LIST - RUN TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRAL ;ENTRY ADDRESS ; .N1,.N2,.N3,0 ;LEGAL LABELS TERMINATED BY ZERO ; $TRAL: MOV (SP)+,R0 ;POTENTIAL DESTINATION $TRAL1: MOV (R4)+,R1 ;LOOK AT NEXT LABEL BEQ $TRAL9 ;JUMP IF NOT FOUND CMP R0,R1 BNE $TRAL1 ;GO LOOK FARTHER MOV R0,R4 ;NOW BR GOEX ; GO AWAY ; RUN-TIME DIAGNOSTIC $TRAL9: MOV #<2*256.>+7,R0 JSR PC,$t000 LINKAGE ERROR (MISSING FORMAT CONVERSION ROUTINE) 111 FORT008001 LINKAGE ERROR (UNFORMATTED I/O) 112 FORT008002 LINKAGE ERROR (DIRECT-ACCESS I/O) 113 FORT008003 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 114 FORT008004 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED 115 FORT008005 SYSTEM ERROR NO DIAGNOSTIC MESSAGE ASSIGNED -01 vERRA ;ERROR BR GOEX ;DEFAULT CONTINUE ; .GLOBL $TRX ; ; COMPUTED GOTO - RUN TIME ROUTINE ; INTEGER INDEX ON STACK ON ENTRY, DELETED ON EXIT ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH INDEX ON STACK ; $TRX ;ENTRY ADDRESS ; K ;NUMBER OF PARAMETERS ; .N1 ;WHERE N1 IS STATEMENT NUMBER ; .N2 ;ETC. ; ... ; .NK ; $TRX: MOV (SP)+,R0 ;CLEAR STACK AND SAVE I CMP R0,#1 ;CHECK LIMITS ON I BLO $TRX1 ;I LESS THAN ONE CMP R0,@R4 ;COMPARE TO MAXIMUMz BLOS $TRX2 ;JUMP IF OK ; ; ERROR - GIVE OTS ERROR AND THEN CONTINUE ; DEFAULT IS TO FALL THROUGH TO NEXT STATEMENT ; $TRX1: $TRX3: MOV (R4)+,R0 ASL R0 ADD R0,R4 BR GOEX ; ; NORMAL ACTION ; $TRX2: ASL R0 ADD R0,R4 MOV @R4,R4 BR GOEX ; .ENDC ;IFNE GTOTRC .IFNE STOTRC .SBTTL STORE TRACE, INCLUDING ASSIGN ; ; $POPP3 - POP A REAL PARAMETER ; .GLOBL $POPP3 $POPP3: MOV (R4)+,R3 ;GET DISPLACEMENT ADD R5,R3 ;ADD TO THE LIST ADDRES~S MOV @R3,R3 ;GET THE VARIABLE ADDRESS ST2: TST TFLG ;ALREADY TRACING? BNE ST3 ;YES MOV #3,ITYPE ;TYPE IS REAL MOV R3,PARM ;ADDRESS OF VARIABLE MOV (SP)+,(R3)+ MOV (SP)+,(R3)+ ST0: TST TFLG BNE RR MOV R4,-(SP) CALL SETFLG ;UPDATE USRFLG MOV (SP)+,R4 MOV #5,ICNT ;ASSUME IS ASSIGNMENT TRACE TSTB USRFLG+5 ;BUT ARE WE? BNE STT ;YES - GO DO IT TSTB USRFLG+6 ;MAY YET BE SELECTIVE TRACE BEQ RR ;BUT ISN'T ; ; LOOK FOR DESTINATION ADDRESS IN LIST ; MOV #LST,R2 ST00: CMP R2,#LSTEND BHIS RR ;NOT THERE SO QUIT CMP PARM,(R2)+ BNE ST00 MOV #6.,ICNT STT: CALL TRACIT RR: JMP @(R4)+ ; ST3: MOV (SP)+,(R3)+ MOV (SP)+,(R3)+ JMP @(R4)+ ; ; ; POLISH LIST CONTAINS ADDRESS OF DATA DESTINATION ; FOLLOWING THE POP CALL ; ; $POP1,$POP2 - POP AN INTEGER OR LOGICAL ITEM ; .GLOBL $POP1,$POP2 $POP2: TST TFLG ;ALREADY TRACING? BNE PPX1 ;YES MOV #2,ITYPE ;TYPE IS INTEGER PP1: MOV (R4),PARM PPX1: MOV (SP)+,@(R4)+ ;MOVE THE DATA BR ST0 $POP1: TST TFLG ;ALREADY TRACING? BNE PPX1 ;YES MOV #1,ITYPE ;TYPE IS LOGICAL BR PP1 ; ; ; $POPP4,$POPP5 - POP A 4 WORD (DOUBLE OR COMPLEX) PARAMETER ; .GLOBL $POPP4,$POPP5 $POPP5: TST TFLG ;ARE WE ALREADY TRACING? BNE PP4 ;YES, DON'T TRACE AGAIN MOV #5,ITYPE BR PP4 $POPP4: TST TFLG ;ALREADY TRACING? BNE PP4 ;YES MOV #4,ITYPE PP4: MOV (R4)+,R3 ;GET DISPLACEMENT ADD R5,R3 ;ADD IT TO LIST ADDRESS MOV @R3,R3 ;GET THE VARIABLE ADDRESS JMP PP4B ; ; ; POP ROUTINES - POLISH LIST CONTAINS ADDRESS OF DATA ; DESTINATION FOLLOWING THE POP CALL. ; ; $POP4,$POP5 - POP A 4 WORD (DOUBLE OR COMPLEX) ITEM ; .GLOBL $POP4,$POP5,$POP4A,$POP4B $POP5: TST TFLG ;ALREADY TRACING? BNE PP4X ;YES MOV #5,ITYPE BR PP4X $POP4: TST TFLG ;ALREADY TRACING BNE PP4X ;YES MOV #4,ITYPE PP4X: MOV (R4)+,R3 ;GET DESTINATION ADDRESS PP4B: TST TFLG ;ARE WE ALREADY TRACING? BNE $POP4B ;YES, DON'T TRACE IT AGAIN MOV R3,PARM MOV (SP)+,(R3)+ MOV (SP)+,(R3)+ MOV (SP)+,(R3)+ MOV (SP)+,(R3)+ BR ST0 $POP4B: MOV (SP)+,(R3)+ ;COPY MOV (SP)+,(R3)+ ;FIRST HALF OF ITEM $POP4A: MOV (SP)+,(R3)+ ;COPY SECOND HALF MOV (SP)+,(R3)+ ;OF ITEM JMP @(R4)+ ;DISPATCH TO NEXT ROUTINE IN LIST ; ; $POP3 - POP A REAL ITEM ; .GLOBL $POP3 $POP3: MOV (R4)+,R3 ;GET DATA DESTINATION BR ST2 ; ; ; PUT - ONE, TWO, OR FOUR WORDS ; .GLOBL $PUT5,$PUT4,$PUT3,$PUT2,$PUT1 $PUT3: TST TFLG BNE PT3 MOV #3,ITYPE MOV R0,PARM BR PT3 $PUT2: TST TFLG BNE PT1 MOV #2,ITYPE BR PTT1 $PUT1: TST TFLG BNE PT1 MOV #1,ITYPE PTT1: MOV R0,PARM BR PT1 $PUT5: TST TFLG BNE PT4X MOV #5,ITYPE BR PT4 $PUT4: TST TFLG BNE PT4X MOV #4,ITYPE PT4: MOV R0,PARM PT4X: MOV (SP)+,(R0)+ ;PUT FOUR WORDS MOV (SP)+,(R0)+ PT3: MOV (SP)+,(R0)+ ;PUT TWO WORDS PT1: MOV (SP)+,(R0)+ ;PUT ONE WORD BR ST1X ; ; NON-TRACEABLE POPS USED BY THE I/O LIST ; ITERATION HANDLING ; .GLOBL $POPI,$POPPI $POPI: MOV (SP)+,@(R4)+ ;JUST LIKE $POP2 JMP @(R4)+ $POPPI: MOV (R4)+,R0 ADD R5,R0 ;JUST LIKE $POPP2 MOV (SP)+,@0(R0) JMP @(R4)+ ; ; .GLOBL $ASP ; ; $ASP ; ; ASSIGN TO DUMMY PARAMETER TYPE VARIABLE ; CALLING SEQUENCE: ; ; $ASP ;SERVICE NAME ; .K ;LABEL ADDRESS ; OFFSET ;PARAMETER OFFSET IN CALL ; $ASP: MOV (R4)+,R3 ;LABEL TO STACK MOV (R4)+,R2 ADD R5,R2 MOV @R2,R2 MOV R3,@R2 BR $ASTRC .GLOBL $AS ; ; $AS ; ; ASSIGN TO VARIABLE ; CALLING SEQUENCE: ; ; $AS,LABEL,NAME ; $AS: MOV (R4)+,R3 MOV R3,@(R4)+ $ASTRC: TST TFLG BNE 3$ MOV #IPAR,PARM CMP @R3,#$SEQ BEQ 1$ CLR IPAR BR 2$ 1$: MOV 2(R3),IPAR 2$: MOV #7.,ICNT ;ASSIGN TRACE CALL TRACIT 3$: JMP @(R4)+ ; ; $POPP2,$POPP1 - POP AN INTEGER OR LOGICAL PARAMETER ; .GLOBL $POPP2,$POPP1 $POPP2: TST TFLG BNE PX1 MOV #2,ITYPE BR PX1 $POPP1: TST TFLG BNE PX1 MOV #1,ITYPE PX1: MOV (R4)+,R3 ;GET THE ADD R5,R3 ; VARIABLE ADDRESS MOV @R3,R3 MOV (SP)+,@R3 ;STORE THE VALUE TST TFLG BNE ST1X MOV R3,PARM ST1X: JMP ST0 ; ; $POPR2,$POPR1 - REMOVES ONE WORD FROM THE STACK ; AND PLACES IT IN REGISTER R0. IT ; IS USED IN EXTERNAL FUNCTIONS TO ; RETURN THE FUNCTION VALUE ; .GLOBL $POPR2,$POPR1 $POPR2: $POPR1: MOV (SP)+,R0 ;POP ONE WORD JMP @(R4)+ ;AND CONTINUE ; ; ; $BYTE - COMMON POLISH BYTE ROUTINES ; ; ; GETTING A BYTE FROM AN ADDRESS ; SPECIFIED IN R0 (THE STACK IS THE OTHER OPERAND). ; R0 PREVIOUSLY SET BY THE SUBSCRIPT ROUTINE ; ; .GLOBL $GET0 $GET0: MOVB @R0,-(SP) JMP @(R4)+ ; ; ; PUT A BYTE FROM THE STACK INTO ADDR SPECIFIED ; BY R0. R0 PREVIOUSLY SET BY THE SUBSCRIPT ROUTINE. ; .GLOBL $PUT0 $PUT0: TST TFLG ;ARE WE CURRENTLY TRACING? BNE 1$ ;YES, DON'T TRACE THIS CLR ITYPE MOV R0,PARM 1$: MOVB (SP)+,(R0)+ BR ST1X ; ; ; ; PLACES THE LOW ORDER BYTE FROM R0 ON THE STACK ; USED AFTER A FUNCTION CALL TO PLACE FUNCTION RESULTS ; ON THE STACK ; .GLOBL $PSHR0 $PSHR0: MOVB R0,-(SP) ;PUSH ONE BYTE JMP @(R4)+ ; ; ; ; $POP0 - POP A BYTE ITEM ; .GLOBL $POP0 $POP0: TST TFLG BNE 1$ CLR ITYPE MOV (R4),PARM 1$: MOVB (SP)+,@(R4)+ BR ST1X ; ; ; $POPP0 - POP A BYTE PARAMETER ; .GLOBL $POPP0 $POPP0: MOV (R4)+,R3 ADD R5,R3 MOV @R3,R3 TST TFLG BNE 1$ CLR ITYPE MOV R3,PARM 1$: MOVB (SP)+,@R3 BR ST1X ; ; $POPR0 - THIS ROUTINE REMOVES A BYTE ITEM FROM THE STACK ; AND PLACES IT IN REGISTER R0. IT IS USED IN EXTERNAL ; FUNCTIONS TO RETURN THE FUNCTION VALUE IN THE REGISTERS ; .GLOBL $POPR0 $POPR0: MOVB (SP)+,R0 ;POP ONE BYTE JMP @(R4)+ .SBTTL USER CALLABLE ENTRY POINTS ; ; TRCLST ; ; CALLED WITH A LIST OF VARIABLE ADDRESSES WHICH ; ARE SIMPLY SAVED IN AN INTERNAL TABLE ; TOO MANY ENTRIES MEAN EXTRAS ARE SIMPLY IGNORED ; ; .GLOBL TRCLST TRCLST: MOV #LST,R2 MOV R5,-(SP) MOVB @R5,R1 BEQ TRL3 TST (R5)+ TRL1: CMP R2,#LSTEND BHIS TRL3 TST (R2) BEQ TRL2 TST (R2)+ BR TRL1 TRL2: MOV (R5)+,(R2)+ DEC R1 BNE TRL1 TRL3: MOV (SP)+,R5 .F4RTN ; ; TRCDEL ; ; CALLED WITH A LIST OF VARIABLE ADDRESSES WHICH ARE TO ; BE DELETED FROM THE INTERNAL TABLE ; .GLOBL TRCDEL TRCDEL: MOVB @R5,R1 BEQ UNTRC4 MOV R5,-(SP) UNTRC1: TST (R5)+ MOV #LST,R2 UNTRC2: CMP R2,#LSTEND BHIS UNTRC3 CMP (R5),(R2)+ BNE UNTRC2 CLR -(R2) UNTRC3: DEC R1 BNE UNTRC1 MOV (SP)+,R5 UNTRC4: .F4RTN .SBTTL TRCTRL ENTRY ; ; TRCTRL ; ; PROGRAM CONTROL OF TRACE OPTIONS ; CALLED WITH TWO INTEGER ARGUMENTS ; .GLOBL TRCTRL TRCTRL: CMPB #2,@R5 ;NEED TWO ARGS BNE TRCBAD ;BAD CALL - IGNORE MOV @2(R5),R0 ;GET FIRST ARG VALUE CMP #NTYPES,R0 ;CHECK RANGE BLO TRCSPC ;EITHER ERROR OR RESET TO SWITCH MODE TST R0 ;ZERO SPECS ALL TRACE TYPES BEQ TRCALL ;YUP TSTB USRFLG ;ARE WE IN SWITCH MODE NOW? BNE 1$ ;NO CLR R2 ;PARAM TO SETUP CALL SETUP 1$: MOVB @4(R5),USRFLG(R0) ;DO USER REQUEST TRCBAD: .F4RTN ; TRCSPC: CMP #-1,R0 ;CHECK FOR RESET BNE TRCBAD ;NOP - IGNORE CLRB USRFLG ;THIS RESETS TO SWITCH MODE BR TRCBAD ;NOT BAD - JUST EXIT ; TRCALL: MOV @4(R5),R2 ;USER VALUE FOR ALL TRACE TYPES CALL SETUP ;STORE IT BR TRCBAD ;AND EXIT ; SETUP: MOV #NTYPES,R1 1$: MOVB R2,USRFLG(R1) DEC R1 BGT 1$ MOVB #1,USRFLG RETURN .ENDC ;IFNE STOTRC .END