.TITLE $DMD $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL DMOD,$DVD,$MLD,$SBD,$DINT,$POLSH,$POPR4 ; THE FORTRAN DMOD FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (2 ARGS) ; ; RETURNS ARG1-INTEGER(ARG1/ARG2)*ARG2 ; IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 DMOD: MOV 2(R5),R3 ;GET  .TITLE $DMN $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL DMIN1,DMAX1,$CMD,$POLSH ; THE FORTRAN DMIN1 AND DMAX1 FUNCTIONS ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (VARIABLE# ARGS) ; ; RETURNS THE MINIMAL (MAXIMAL) ARGUMENT IN ; R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 DMIN1: MO .TITLE $DNT $VERSN 02 ; ; ;COPYRIGHT 1971, 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. .CSECT .GLOBL $DINT ; OTS INTERNAL FUNCTION TO FIND THE INTEGER ; PART OF A DOUBLE PRECISION NUMBER. ; CALLED IN THE POLISH MODE. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 MQ=177304 ASH=177316 F0=%0 F1=%1 .IFDF FPU $DINT: .WORD 170011 ;;SETD .WORD 172426 ;; .TITLE $DR $VERSN 02 ; ; ;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. .CSECT .GLOBL $DR,$ERRA ; $DR THE DOUBLE PRECISION TO REAL CONVERTER ; ROUND THE TOP STACK ITEM TO REAL FORMAT. R4=%4 R5=%5 SP=%6 F0=%0 .IFDF FPU $DR: .WORD 170001 ;;SETF .WORD 177426 ;;LDCDF (SP)+,F0 ;CONVERT ARG .WORD 17000 FIRST ARG ADDRESS ADD #8.,R3 ;POINT TO LOW ORDER MOV 4(R5),R4 ;GET SECOND ARG ADDRESS ADD #8.,R4 MOV #2,R2 ;GET TWO COPIES OF EACH ARG STACK: MOV R3,R0 MOV R4,R1 MOV -(R0),-(SP) ;MOVE FIRST MOV -(R0),-(SP) MOV -(R0),-(SP) MOV -(R0),-(SP) MOV -(R1),-(SP) ;MOVE SECOND MOV -(R1),-(SP) MOV -(R1),-(SP) MOV -(R1),-(SP) DEC R2 BGT STACK ;GO FOR ANOTHER COPY JSR R4,$POLSH .WORD $DVD,$DINT,$MLD,$SBD ; ARG1-INTEGER(ARG1/ARG2)*ARG2 .WORD $POPR4,UNPOL ;PUT RESULT IN REGS UNPOL V @PC,-(SP) ;FLAG MIN BR MINMAX DMAX1: CLR -(SP) ;FLAG MAX MINMAX: MOV (R5)+,-(SP) ;GET NUMBER OF ITEMS TST -(SP) ;GET POINTER SPACE GET: MOV (R5)+,@SP ;ITEM ADDRESS TO POINTER ADD #8.,@SP ;POINT TO LOW ORDER DECB 2(SP) ;COUNT ITEMS BLE DONE ;JUMP IF DONE PULL: MOV @SP,R0 ;GET CURRENT ADDRESS PUSH: MOV -(R0),-(SP) ;PUSH CURRENT MOV -(R0),-(SP) MOV -(R0),-(SP) MOV -(R0),-(SP) MOV @R5,R0 ;GET NEXT ADDRESS ADD #8.,R0 ;POINT TO LOW ORDER MOV -(R0),-(SP) ;PUSH NEXT MOV -(R0),-(SP) LDD (SP)+,FO ;LOAD ARG .WORD 171467,4 ;;MODD ONE,F0 ;GET INTEGER PART .WORD 174146 ;;STD F1,-(SP) ;PUSH INTEGER JMP @(R4)+ ;RETURN TO CALLER .WORD 040200,0,0,0 ;FLOATING 1. .ENDC .IFNDF FPU $DINT: MOV (SP)+,R0 ;POP DOUBLE ARG MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV R4,-(SP) MOV R5,-(SP) MOV R0,R4 ;GET EXPONENT ROL R4 CLRB R4 SWAB R4 SUB #270,R4 ;CONVERT TO -SHIFT COUNT BGE DONE ;JUMP IF ARG MUST BE INTEGER ALREADY CMP #-70,R4 BLT SHIFT ;JUMP TO GET INTEGER PART 0 ;;CFCC ;GET CONDITION CODES BVS OVER1 ;JUMP IF OVERFLOW ON ROUND .WORD 174046 ;;STF F0,-(SP) JMP @(R4)+; !!! .ENDC .IFNDF FPU $DR: ROL 4(SP) ;ROUND LOW ORDER PART ADC 2(SP) ADC @SP BCS OVER ;JUMP IF OVERFLOW BVS OVER DR1: MOV (SP)+,2(SP) ;MOVE HIGHEST ORDER PART MOV (SP)+,2(SP) ;MOVE LOW ORDER REAL JMP @(R4)+ ;RETURN OVER: CMP (SP)+,(SP)+ ;FLUSH ARG CMP (SP)+,(SP)+ .ENDC OVER1: MOV #13403,R0 ;ERROR 3,23 JSR PC,$ERRA DR2: CLR -(SP) ;RETURN 0. CLR -(SP) JMP @(R4)+ . : .F4RTN ;RETURN TO USER ; .END  MOV -(R0),-(SP) MOV -(R0),-(SP) JSR R4,$POLSH .WORD $CMD,UNPOL ;GO COMPARE UNPOL: BLT LOW ;JUMP IF FIRST LOW TST 4(SP) BEQ NEXT ;JUMP IF DMAX1 BR GET ;DMIN1 LOW: TST 4(SP) BEQ GET ;JUMP IF DMAX1 NEXT: TST (R5)+ ;POINT TO NEXT ITEM DECB 2(SP) ;COUNT ITEMS BGT PULL DONE: MOV (SP)+,R0 ;DONE, GET RESULT ADDRESS MOV -(R0),R3 ;PUT RESULT IN REGS MOV -(R0),R2 MOV -(R0),R1 MOV -(R0),R0 CMP (SP)+,(SP)+ ;POP FLAG AND COUNT .F4RTN ;RETURN TO USER ; .END CLR R0 ;ANSWER IS 0 CLR R1 C23: CLR R2 CLR R3 BR DONE SHIFT: .IFNDF EAE&MULDIV MOV R4,R5 ;SAVE A COPY OF SHIFT COUNT CMP #-32.,R4 ;CHECK LOW OR HIGH TRUNCATION BLT ROR BEQ C23 ;GO CLEAR LOW ORDER HALF ADD #32.,R4 ;DO HIGH ORDER MOV R4,R5 ROR1: ROR R0 ;SHIFT OUT FRACTION BITS ROR R1 INC R4 BLT ROR1 ASL1: ASL R1 ;SHIFT IN 0'S ROL R0 INC R5 BLT ASL1 BR C23 ;GO CLEAR LOW ORDER ROR: ROR R2 ;MOVE OUT FRACTION BITS ROR R3 INC R4 ;COUNT LOOP BLT ROR ASL: ASL R3 ROL END R2 INC R5 ;COUNT LOOP BLT ASL .ENDC .IFDF EAE MOV #MQ,R5 ;POINT TO MQ .ENDC .IFDF MULDIV!EAE CMP #-32.,R4 ;CHECK FOR HIGH OR LOW ORDER TRUNCATION BLT R23 ;LOW BEQ C23 ;CLEAR LOW ORDER R01: ADD #32.,R4 ;HIGH ORDER PARTS .IFDF MULDIV .WORD 073004 ;;ASHC R4,R0 ;SHIFT OUT FRACTION NEG R4 ;SET TO SHIFT LEFT .WORD 073004 ;;ASHC R4,R0 ;BRING IN THE 0'S .ENDC .IFDF EAE MOV R1,@R5 ;HIGH ORDER TO AC,MQ MOV R0,-(R5) MOV R4,@#ASH ;SHIFT RIGHT NEG R4 MOV R4,@#ASH ;SHIFT LEFT  .TITLE $DSG $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL DSIGN ; THE FORTRAN DSIGN FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (2 ARGS) ; ; RETURNS SIGN ARG2 * ABS(ARG1) IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 DSIGN: MOV 2(R5),R3 ;GET FIRST ARG ADDRESS MOV @R3,R0 ;GET FIRST ARG IN  MOV (R5)+,R0 ;RESULT TO REGS MOV @R5,R1 .ENDC BR C23 ;GO CLEAR LOW ORDER .IFDF MULDIV R23: .WORD 073204 ;;ASHC R4,R2 NEG R4 .WORD 073204 ;;ASHC R4,R2 ;SHIFT IN 0'S .ENDC .IFDF EAE R23: MOV R3,@R5 ;LOW ORDER TO AC,MQ MOV R2,-(R5) MOV R4,@#ASH ;DUMP BITS NEG R4 MOV R4,@#ASH ;BRING IN 0'S MOV (R5)+,R2 ;RESULT TO REGS MOV @R5,R3 .ENDC .ENDC DONE: MOV (SP)+,R5 MOV (SP)+,R4 MOV R3,-(SP) ;PUSH RESULT MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) JMP @(R4)+ ;RETURN .END .TITLE $DSN $VERSN 04 ; ; ; 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. ; .CSECT .GLOBL DSIN,DCOS; .IFNDF FPU .GLOBL $ADD,$SBD,$MLD,$DVD,$DINT,$POLSH,$POPR4; .ENDC ; DSIN DCOS THE DOUBLE PRECISION SIN AND COS ; FUNCTIONS. ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS SIN OR COS OF ARG IN R0 - R3. R0=%0 R1=%1 R2=%2 R0-R3 MOV 2(R3),R1 MOV 4(R3),R2 MOV 6(R3),R3 MOV @4(R5),R4 ;GET HIGH ORDER SECOND ARG ROL R0 ;DUMP FIRST ARG SIGN ROL R4 ;GET SECOND ARG SIGN ROR R0 ;INSERT IT IN FIRST .F4RTN ;RETURN TO CALLER .END  .TITLE $DSQ $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL DSQRT,$ERRA; .IFNDF FPU .GLOBL $ADD,$DVD,$POLSH; .ENDC ; $DSQRT THE DOUBLE PRECISION SQUARE ROOT FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS DSQRT IN R0 - R3. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 F0=%0 F1=%1 C .END  R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 F0=%0 F1=%1 F2=%2 F3=%3 .IFNDF FPU DCOS: MOV R5,-(SP) ;SAVE RETURN POINTER MOV 2(R5),R4 ;GET ARGUMENT ADDRESS CLR -(SP) ;MAKE ROOM FOR QUADRANT FLAG MOV 6(R4),-(SP) MOV 4(R4),-(SP) MOV 2(R4),-(SP) ;PUSH ARGUMENT MOV @R4,-(SP) MOV #064302,-(SP) MOV #121041,-(SP) MOV #007732,-(SP) ;PUSH PI/2 MOV #040311,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD $ADD,SINCOS ;COS(X)=SIN(X+PI/2) DSIN: MOV R5,-(SP) ;SAVE RETURN MOV 2(R5),R4 ;GET ARG F2=%2 SP=%6 .IFNDF FPU DSQRT: MOV R5,-(SP) MOV 2(R5),R5 ;GET ARGUMENT ADDRESS MOV @R5,R1 ;GET HIGH ORDER ARGUMENT BMI ERROR ;ERROR IF ARGUMENT NEGATIVE BEQ ZERO ;FAST EXIT IF ZERO MOV 2(R5),R2 MOV #4,-(SP) ;PUSH ITERATION COUNT ASR R1 ;FORM INITIAL ESTIMATE ROR R2 ADD #20100,R1 CLR -(SP) CLR -(SP) ;USE ONLY HIGH ORDER PARTS FIRST MOV R2,-(SP) MOV R1,-(SP) ;'CAUSE ADD AND DIVIDE ARE CLR -(SP) ;FASTER THAT WAY CLR -(SP) MOV 2(R5),-(SP) MOV @R5,-(SP) CLR -(SP) CLR .TITLE $DTN $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL DATAN,DATAN2; .IFNDF FPU .GLOBL $ADD,$SBD,$MLD,$DVD,$POLSH,$POPR4; .ENDC ; THE FORTRAN DATAN AND DATAN2 FUNCTIONS ; CALLING SEQUENCE FOR DATAN: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS ARCTAN(ARG) IN R0 AND R1. ; ; CALLING SEQUENCE FOR DATAN2: ; ; F UMENT ADDRESS CLR -(SP) ;MAKE ROOM FOR QUADRANT FLAG MOV 6(R4),-(SP) MOV 4(R4),-(SP) MOV 2(R4),-(SP) MOV @R4,-(SP) ;PUSH ARGUMENT SINCOS: ASL @SP ;CLEAR SIGN AND SAVE IT ROR 8.(SP) ;IN QUADRANT FLAG ROR @SP MOV #064302,-(SP) MOV #121041,-(SP) MOV #007732,-(SP) ;PUSH 2*PI MOV #040711,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD $DVD ;X/2PI .WORD DUP ;2 COPIES .WORD $DINT ;INT(X/2PI) .WORD $SBD ;FRACT(X/2PI) .WORD X4 ;4*FRACT(X/2PI) .WORD DUP ;2 COPIES .WORD $DINT ;INT! .TITLE $DVB $VERSN 09 ; ; ;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. ; .GLOBL $DEVTB .CSECT ; ;THESE ARE THE FORTRAN DEVICE TABLE ENTRIES ;WITH THE DEVICE TABLE HEADER AND ENTRY VECTOR ; .IFNDF RSX .WORD DEVM3 ;ADDR OF ENTRY FOR ERR LOG DEVICE ;ERROR LOG DEVICE IS -3(DEVM3) .WORD DEVERR ;ADDR OF ENTRY FOR ERR MSG FILE .ENDC $DEVTB: ." -(SP) MOV R2,-(SP) MOV R1,-(SP) LOOP: JSR R4,$POLSH ;ENTER POLISH MODE .WORD $DVD,$ADD,UNPOL ;(X/E+E) UNPOL: SUB #200,@SP ;(X/E+E)/2 DEC 8.(SP) ;COUNT LOOP BEQ OUT MOV 6(R5),-(SP) MOV 4(R5),-(SP) MOV 2(R5),-(SP) ;USE LOW ORDER PARTS MOV @R5,-(SP) ;TOO FROM NOW ON MOV 14.(SP),-(SP) MOV 14.(SP),-(SP) MOV 14.(SP),-(SP) MOV 14.(SP),-(SP) BR LOOP ;GO FOR ANOTHER ITERATION OUT: MOV (SP)+,R0 ;GET RESULT INTO R0-R3 MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 TST (SP)+ ;POP ITERA#ORTRAN STANDARD (2 ARGS) ; ; RETURNS ACRTAN(ARG1/ARG2) IN R0 AND R1. ; IF ABS(ARG1/ARG2) > 2**24, THE RESULT IS ; SIGN(ARG1)*PI/2. ; IF ARG2 <0 THE RESULT IS ARCTAN(ARG1/ARG2) + ; SIGN(ARG1)*PI. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 F0=%0 F1=%1 F2=%2 F3=%3 F4=%4 F5=%5 .IFNDF FPU DATAN2: MOV R5,-(SP) CLR -(SP) ;CLEAR SIGN FLAG CLR -(SP) ;CLEAR DATAN2 BIAS CLR -(SP) CLR -(SP) CLR -(SP) CLR -(SP) ;CLEAR QUADRANT BIAS CLR -(SP) CLR -(SP) CLR -(SP) $(4*FRACT(X/2PI)) .WORD QUAD ;SAVE INT(......) .WORD $SBD ;Y=FRACT(4*FRACT(X/2PI)) .WORD QSET ;REDUCE Y TO (-1,1) QSETRE: .WORD DUP ;2 COPIES .WORD DUP ;3 COPIES .WORD $MLD ;Y*Y .WORD $POPR4 ;SAVE Y*Y .WORD POLY ;PUSH COEFFICIENTS XPAND: .WORD $MLD,$ADD,$MLD,$ADD,$MLD,$ADD,$MLD,$ADD .WORD $MLD,$ADD,$MLD,$ADD,$MLD,$ADD,$MLD,$ADD .WORD $MLD ;Y*P(Y*Y) PR4: .WORD $POPR4 ;POP HIGH ORDER RESULT .WORD RTN RTN: TST (SP)+ ;POP QUADRANT FLAG BGE RTN1 ;JUMP IF ARGUMENT WAS + ADD #100000,R0%WORD 8. ;NUMBER OF ENTRIES IN ENTRY VECTOR .IFNDF RSX .WORD -3 ;DEVICE NUM OF ERROR LOGGING DEVICE .ENDC .IFDF RSX .WORD 6. ;DEVICE NUM OF ERROR LOGGING DEVICE .ENDC ; ;THE DEVICE TABLE ENTRY VECTOR ; .WORD DEV1 ;ADDR OF DEVICE 1 ENTRY .WORD DEV2 ;ADDR OF DEVICE 2 ENTRY .WORD DEV3 ;ADDR OF DEVICE 3 ENTRY .WORD DEV4 ;ADDR OF DEVICE 4 ENTRY .WORD DEV5 ;ADDR OF DEVICE 5 ENTRY .WORD DEV6 ;ADDR OF DEVICE 6 ENTRY .WORD DEV7 ;ADDR OF DEVICE 7 ENTRY .WORD DEV8 ;ADDR OF DE&TION COUNTER RTN: MOV (SP)+,R5 .F4RTN ERROR: MOV #2004,R0 ;ERROR4,4 JSR PC,$ERRA BR RTN ZERO: CLR R0 CLR R1 CLR R2 CLR R3 BR RTN ; .ENDC ; .IFDF FPU DSQRT: MOV 2(R5),R4; GET ARGUMENT ADDRESS MOV @R4,R1; GET HIGH ORDER ARGUMENT BMI ERROR ;ERROR IF ARGUMENT NEGATIVE BEQ ZERO ;FAST EXIT IF ZERO MOV 2(R4),R2; ASR R1 ;FORM INITIAL ESTIMATE ROR R2 ADD #20100,R1 CLR -(SP) CLR -(SP) ;USE ONLY HIGH ORDER PARTS FIRST MOV R2,-(SP) MOV R1,-(SP) ;'CAUSE ADD AND DIVIDE ARE' MOV 2(R5),R4 ;GET FIRST ARG ADDRESS MOV 6(R4),-(SP) MOV 4(R4),-(SP) MOV 2(R4),-(SP) ;GET FIRST ARG MOV @R4,-(SP) MOV @SP,R0 ;ARG1 TO R0 MOV 4(R5),R4 ;GET SECOND ARG ADDRESS MOV 6(R4),-(SP) MOV 4(R4),-(SP) MOV 2(R4),-(SP) ;GET SECOND ARG MOV @R4,-(SP) MOV @SP,R1 ;ARG2 TO R1 BEQ INF ;JUMP IF DENOMINATOR IS 0 ASL R0 ;GET ABS VAL ARG1 CLRB R0 ;GET EXPONENT SWAB R0 ASL R1 CLRB R1 ;GET EXPONENT ARG2 SWAB R1 SUB R1,R0 ;GET EXPONENT DIFFERENCE CMP #58.,R0 ;CHECK MAGNITUDE ( ;SIN(-X)=-SIN(X) RTN1: MOV (SP)+,R5 .F4RTN ;BACK TO CALLER ; DUP: MOV 6(SP),-(SP) ;DUPLICATE STACK ITEM MOV 6(SP),-(SP) MOV 6(SP),-(SP) MOV 6(SP),-(SP) JMP @(R4)+ ; X4: TST @SP ;CHECK FOR 0 FRACTION BEQ ZERO; QUIT NOW INCB 1(SP) ;QUADRUPLE STACK ITEM JMP @(R4)+ ZERO: MOV #PR4,R4; RETURN ZERO RESULT JMP @(R4)+; USE POLISH ; QUAD: BIS @SP,16.(SP) ;SAVE QUADRANT NUMBER JMP @(R4)+ ; QSET: TSTB 8.(SP) ;TEST QUADRANT BEQ Q13 ;JUMP IF FIRST OR THIRD QUAD ADD #100000,@SP ;NEGAT)VICE 8 ENTRY ; ; ; ;ENTRY 1 OF DEVICE TABLE ; DEV1: .WORD 0 ;LINK BLOCK PTR .IFNDF RSX .RAD50 /SY / ;PHYSICAL DEVICE NAME DEFAULT .ENDC .IFDF RSX .RAD50 /KB/ .ENDC .BYTE 0 ;HOW OPEN SWITCH .BYTE 0 ;UNIT NUM DEFAULT .RAD50 /FOR/ ;DEFAULT FILE NAME .RAD50 /001/ .RAD50 /DAT/ ;DEFAULT EXTENSION .BYTE 233 ;NO AUTO DEL, GROUP & OTHERS READ/RUN ONLY .BYTE 0 ;DEVICE STATUS SWITCH .BYTE 0 ;MODE OF I/O - FUNCN WORD (RANDOM) .BYTE 0 ;STATUS OF I/O .WORD 0 ;RECORD COUN* MOV #4,R0; ITERATION COUNT SETD ; DOUBLE PRECISION FP LDD (SP)+,F0; GET INITIAL ESTIMATE LDD @R4,F2; GET X ; LOOP: LDD F0,F1; E=E' LDD F2,F0; X DIVD F1,F0; X/E ADDD F1,F0; X/E+E DEC R0; COUNT DIVD #2.0,F0; E'=(X/E+E)/2 BGT LOOP; LOOP ; STD F0,-(SP); MOVE RESULT TO STACK MOV (SP)+,R0; MOV (SP)+,R1; MOV (SP)+,R2; AND THENCE TO R0...R3 MOV (SP)+,R3; BR RTN ; ERROR: MOV #2004,R0 ;ERROR4,4 JSR PC,$ERRA ZERO: CLR R0; CLR R1; CLR R2; CLR R3; RTN: .F4RTN + BLT INF ;TREAT AS INFINITY DIV: JSR R4,$POLSH .WORD $DVD,UNPOL ;GET ARG1/ARG2 UNPOL: TST @4(R5) ;IF ARG2 >0, BIAS =0 BGE ATANE ;IF ARG2<0, BIAS=SIGN(ARG1)*PI MOV #040511,16.(SP) ;PI MOV #007732,18.(SP) MOV #121041,20.(SP) MOV #064301,22.(SP) TST @2(R5) ;TEST ARG1 BGE ATANE ADD #100000,16.(SP) ;-PI ATANE: TST @SP ;SET CODES BR ATAN1 ;JOIN MAIN ROUTINE INF: ADD #36.,SP ;FLUSH STACK MOV #040311,R0 ;ANS = SIGN(ARG1)*PI/2 MOV #007732,R1 MOV #121041,R2 MOV #064301,R3 TST @2(R,E STACK ITEM CLR -(SP) CLR -(SP) CLR -(SP) ;PUSH A FLOATING 1. MOV #40200,-(SP) JSR R4,$POLSH ;ENTER POLISH .WORD $ADD,QSETR ;X=1.-X QSETR: MOV #QSETRE,R4 ;POINT BACK INTO LIST Q13: ASRB 9.(SP) ;TEST QUADRANT ; BCC QOUT ;JUMP IF FIRST OR SECOND ADD #100000,@SP ;NEGATE STACK ITEM QOUT: JMP @(R4)+ ; POLY: MOV #CONSTS+8.,R4 ;POINT TO LIST OF COEFFICIENTS MOV #9.,R5 ;NINE CONSTANTS BR POLY1 POLY2: MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) ;PUSH Y*Y MOV R0,-(SP) POLY1: MOV -(R4),-T - BLOCK NUM (RANDOM) .WORD 0 ;BUFF ADDR (RANDOM) .WORD 0 ;BUF LEN (RANDOM) .WORD 0 ;ASSOCIATED VAR ADDR (FROM DEFINE FILE) .WORD 0 ;NUM RECORDS IN FILE (FROM DEFINE FILE) .WORD 0 ;RECORD LENGTH (FROM DEFINE FILE) .WORD 0 ;USER ID CODE .WORD 0 ;ERROR VAR ADDR (FROM SETFIL) ; ; ; ;ENTRY 2 OF DEVICE TABLE ; DEV2: .WORD 0 .IFNDF RSX .RAD50 /SY / .ENDC .IFDF RSX .RAD50 /TT/ .ENDC .BYTE 0,0 .RAD50 /FOR/ .RAD50 /002/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,. .ENDC .END /5) ;TEST ARG1 BGE INFR ;JUMP IF +PI/2 ADD #100000,R0 ;-PI/2 INFR: .F4RTN ;RETURN TO USER ; DATAN: MOV R5,-(SP) CLR -(SP) ;CLEAR SIGN FLAG CLR -(SP) ;CLEAR ATAN2 BIAS CLR -(SP) CLR -(SP) CLR -(SP) CLR -(SP) ;CLEAR QUADRANT BIAS CLR -(SP) CLR -(SP) CLR -(SP) MOV 2(R5),R4 ;GET ARG ADDRESS MOV 6(R4),-(SP) MOV 4(R4),-(SP) MOV 2(R4),-(SP) ;GET LOW ORDER ARG MOV @R4,-(SP) ;GET HIGH ORDER ATAN1: BGE PLUS ;JUMP IF QUADRANT 1 OR 3 ADD #100000,@SP ;GET ABS VALUE INC 24.(SP) 0-(SP) ;PUSH CONSTANT MOV -(R4),-(SP) MOV -(R4),-(SP) MOV -(R4),-(SP) DEC R5 ;COUNT COEFFICIENTS BGT POLY2 MOV #XPAND,R4 JMP @(R4)+ .ENDC ; .IFDF FPU DCOS: SETD ; DOUBLE PRECISION FP LDD @2(R5),F0; GET ARGUMENT ADDD PIOV2,F0; COS(X)=SIN(X+PI/2) BR SINCOS; DSIN: SETD ; DOUBLE PRECISION FP LDD @2(R5),F0; GET ARGUMENT SINCOS: SETI ; SHORT INTEGERS MOV #FCONST,R0; POINTER TO CONSTANTS CLR R4; SIGN FLAG: + ARG CFCC ; GET SIGN OF ARG BGE POS; INC R4; SIGN FLAG: - ARG10,0,0,0 ; ; ; ;ENTRY 3 OF DEVICE TABLE ; DEV3: .WORD 0 .IFNDF RSX .RAD50 /SY / .ENDC .IFDF RSX .RAD50 /PP/ .ENDC .BYTE 0,0 .RAD50 /FOR/ .RAD50 /003/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ; ;ENTRY 4 OF DEVICE TABLE ; DEV4: .WORD 0 .RAD50 /PR / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /004/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 5 OF DEVICE TABLE ; ; DEV5: .WORD 0 .RAD50 /LP / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /005/ .3;FLAG - PLUS: CMP @SP,#40200 ;CHECK IF <1. BLO LE1 ;JUMP IF <1. BGT GT1 ;>1. TST 2(SP) ;CHECK LOW ORDER BNE GT1 TST 4(SP) BNE GT1 TST 6(SP) BEQ LE1 ;=1. GT1: MOV #140311,8.(SP) ;-PI/2 MOV #007732,10.(SP) ;ATAN(X)=PI/2-ATAN(1/X) MOV #121041,12.(SP) MOV #064301,14.(SP) DEC 24.(SP) ;ADJUST SIGN MOV 6(SP),-(SP) ;MOVE ARG DOWN MOV 6(SP),-(SP) MOV 6(SP),-(SP) MOV 6(SP),-(SP) MOV #40200,8.(SP) ;INSERT 1. CLR 10.(SP) CLR 12.(SP) CLR 14.(SP) JSR R4,$POLSH ;COMPUTE 1./X 4 ABSD F0; REMOVE ARGUMENT SIGN POS: DIVD (R0)+,F0; X/2PI MODD #1.0,F0; F0= FRACT(X/2PI) CFCC BEQ RTN; EXIT ON 0 FRACTION MODD #4.0,F0; F0= FRACT(4*FRACT(X/2PI)) STCDI F1,R1; QUAD= INT(4*FRACT(X/2PI)) ROR R1; BCC Q13; JUMP IF FIRST OR THIR QUAD NEGD F0; ADDD #1.0,F0; Y=1.0-X Q13: ROR R1; BCC Q12; JUMP IF FIRST OR 2ND QUAD NEGD F0; Y = -Y ; Q12: LDD F0,F2; MULD F2,F2; Z=Y**2 MOV #8.,R1; COUNT OF CONSTANTS FOR POLYNOMIAL LDD (R0)+,F1; INITIALIZE ACCUMULATOR XPAND:5RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 6 OF DEVICE TABLE ; ; DEV6: .WORD 0 .RAD50 /KB / .BYTE 0,0 .RAD50 /FOR/ .RAD50 /006/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ;ENTRY 7 OF DEVICE TABLE ; ; DEV7: .WORD 0 .IFNDF RSX .RAD50 /SY / .ENDC .IFDF RSX .RAD50 /UD/ .ENDC .BYTE 0,0 .RAD50 /FOR/ .RAD50 /007/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 ; ; ; ;ENTRY 8 OF DEVICE TABLE ; ; DEV8: .WORD 0 .IFNDF RS6 .TITLE $DVC $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL $DVC,$ERRA; .IFNDF FPU .GLOBL $ADR,$SBR,$MLR,$DVR,$POLSH; .ENDC ; $DVC --- COMPLEX DIVISION. ; CALLED IN THE POLISH MODE. ; REPLACE THE TWO COMPLEX NUMBERS ON THE ; TOP OF THE STACK WITH THEIR QUOTIENT. ; ; WHEN CALLED THE STACK CONTAINS: ; BI ; A 7 .WORD $DVD,LE1 LE1: MOV 6(SP),-(SP) ;MOVE ARG DOWN MOV 6(SP),-(SP) MOV 6(SP),-(SP) MOV 6(SP),-(SP) CLR 8.(SP) ;INSERT A 0. CLR 10.(SP) CLR 12.(SP) CLR 14.(SP) CMP @SP,#037611 ;TAN(15) BLO LT15 ;JUMP IF LESS THAN TAN(15) BHI TRANS ;JUMP IF > CMP 2(SP),#030242 BHI TRANS BLO LT15 CMP 4(SP),#172366 BHI TRANS BLO LT15 CMP 6(SP),#065261 BLOS LT15 TRANS: MOV #040006,8.(SP) ;INSERT PI/6 MOV #005221,10.(SP) MOV #140553,12.(SP) MOV #115454,14.(SP) MOV @SP,R0 ;ARG TO REE MULD F2,F1; DEC R1; COUNT ADDD (R0)+,F1; F1:= Z:F1 + C(I) BGT XPAND; LOOP ; MULD F1,F0; F0:= Y*F1 TST R4; TEST SIGN FLAG BEQ RTN; NEGD F0; SIN(-X) = -SIN(X) RTN: STD F0,-(SP); MOVE RESULT TO STACK MOV (SP)+,R0; AND THENCE TO R0...R3 MOV (SP)+,R1; MOV (SP)+,R2; MOV (SP)+,R3; .F4RTN ;EXIT ; PIOV2: .WORD 040311,007732; PI/2 .WORD 121041,064302; ; ; ORDER-DEPENDENT CONSTANTS ; FCONST: .WORD 040711,007732; 2*PI .WORD 121041,064302; .ENDC .WORD 026716,106703 ;.5GX .RAD50 /BI / .ENDC .IFDF RSX .RAD50 /AD/ .ENDC .BYTE 0,0 .RAD50 /FOR/ .RAD50 /008/ .RAD50 /DAT/ .BYTE 233,0,0,0 .WORD 0,0,0,0,0,0,0,0 .IFNDF RSX ; ;ENTRY - 3 OF DEVICE TABLE(ERROR LOGGING DEVICE) ;SPECIAL ENTRY USED AS DOS-11 ERROR LOGGING DEVICE ;LOGICAL UNIT NUMBER = -3, LOGICAL DEVICE NAME = CMO ; DEVM3: .WORD 0 ;LINK BLOCK PTR .RAD50 /KB / ;DEFAULT PHYSICAL DEVICE NAME .BYTE 0,0 .RAD50 /FOR/ ;DEFAULT FILE NAME .RAD50 /CMO/ ;FORCMO.DAT .RAD50 /DAT/ .BYTH; DI ;@SP C ; RESULT IS : ; (AC+BD)/(CC+DD) + (BC-AD)/(CC+DD)I R0=%0 R1=%1 R2=%2 R4=%4 R5=%5 SP=%6 A=12. B=20. C=8. D=16. IM=24. RE=12. F0=%0 F1=%1 F2=%2 F3=%3 F4=%4 F5=%5 .IFNDF FPU $DVC: MOV @SP,R0 ;GET C ASL R0 ;GET EXPONENT CLRB R0 MOV 4(SP),R1 ;GET D ASL R1 ;GET EXPONENT CLRB R1 CMP R0,R1 ;GET MAX. EXPONENT BHIS R0HI MOV R1,R0 R0HI: TST R0 BEQ DCHK ;JUMP IF DENOMINATOR 0 BR DIV ;TO AVOID BUG IN SCALE SUB #100000,R0 ;DROP EXCESS 128 ASFGS MOV 2(SP),R1 MOV 4(SP),R2 MOV 6(SP),R3 MOV #062524,-(SP) MOV #041302,-(SP) MOV #131727,-(SP) ;PUSH -ROOT 3 MOV #140335,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) ;PUSH ARG CLR -(SP) CLR -(SP) CLR -(SP) ;PUSH 1. MOV #40200,-(SP) MOV #062524,-(SP) MOV #041302,-(SP) MOV #131727,-(SP) ;PUSH ROOT3 MOV #040335,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) ;PUSH ARG MOV R0,-(SP) JSR R4,$POLSH ;TRANSFORM ARG ; (ROOT3*X-1)/(ROOT3 +X) .WORD $MLD,$""DD" "@DDD@DDDD """D"""""@D"@D ""@DDDDDDD" """"""""""""""""""@DD@DD@DDDDD@DD "D @DDADDB C kQ  kQ DkQ kQ kQ kQ  M kQ ..kQ "jrkQ  OskQ 2\tkQ Q uykQ SgkQ ` kQ k kQ nzkQ ykQ ~"kQ ""kQ #kQ  #kQ 6&kQ &kQ J&9'kQ d'kQ t'kQ 'kQ (kQ ,kQ -kQ j8kQ 8kQ 8kQ 8kQ 8kQ  9kQ 99kQ :kQ :kQ :kQ  :kQ  4;kQ *;kQ '?;kQ +3L;kQ .>;kQ 7CKkQ 8DKkQ =IQkQ BJRkQ GORkQ HX"SkQ MQ#SkQ N^8}@z Sc$D ҷ8a ͋,L  Bw(B ` % & ~&*C$$Βe E%>l  aʋaՀ$ & * P$ ΋Ί   ΋   d Ί  ( 1'u  Q$f $5@ U C΋ Cb M΋U@ U &  B" .&0 I87061098171E-11 .WORD 045277,146362 ; .WORD 130467,136273 ;-.66843217206396E-9 .WORD 103054,123153 ; .WORD 032164,074657 ;.5692134872719023E-7 .WORD 047254,154742 ; .WORD 133561,101646 ;-.3598843007208693E-5 .WORD 167216,134016 ; .WORD 035050,036032 ;.1604411847068221E-3 .WORD 041214,103131 ; .WORD 136231,064546 ;-.4681754135302643E-2 .WORD 071423,125024 ; .WORD 037243,032743 ;.7969262624616544E-1 .WORD 035655,051557 ; .WORD 140045,056747 ;-.6459640975062462 .WORD 0304JSBD,UP,$SBD,$DVD,LT15 LT15: MOV @SP,R0 ;GET ARG MOV 2(SP),R1 MOV 4(SP),R2 MOV 6(SP),R3 MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) ;GET THREE COPIES MOV R0,-(SP) MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) JSR R4,$POLSH .WORD $MLD ;GET ARG**2 .WORD $POPR4,POLY ;SET UP COEFFICIENTS XPAND: .WORD $MLD,$ADD,$MLD,$ADD,$MLD,$ADD .WORD $MLD,$ADD,$MLD,$ADD,$MLD,$ADD .WORD $MLD,$ADD,$MLD,$ADD,$MLD,$ADD .WORD $ADD ;P(X)+0 IF X<=1, P(X)-PI/2 IF X>1 .WORD SIGN ;ADJUST SIGN KE 233,0,0,0 ; .WORD 0,0,0,0,0,0,0,0 ; ; ; ; ;SPECIAL ENTRY FOR ERROR PROCESSORS MSG FILE ; .WORD 0 ;LINK BLOCK ERR RTN ADDR DEVERR: .WORD 0 ;LINK PTR .RAD50 /ERR/ ;LOG DATA SET NAME .BYTE 1 ;PHYSICAL DS NAME FOLLOWS .BYTE 0 ;UNIT NUM .RAD50 /SY / ;PHYSICAL DEVICE NAME ;DEFAULT TO SYSTEM DEVICE .WORD 0 ;FILE BLOCK ERROR RETURN ADDR .BYTE 4 ;HOW TO OPEN (OPENI) .BYTE 0 ;ERROR RTN CODE .RAD50 /FOR/ ;FILE NAME .RAD50 /RUN/ .RAD50 /DGN/ .BYTE 1 ;USER ID CODE .BLR R0 ;ALIGN MOV #4,R1 ;COUNT ITEMS MOV SP,R2 ;POINT TO C SCALE: SUB R0,(R2)+ ;SCALE ALL EXPONENTS BCS UNDER ;JUMP IF UNDERFLOW BVS UNDER TST (R2)+ ;SKIP LOW ORDER DEC: DEC R1 ;COUNT LOOP BGT SCALE BR DIV UNDER: CLR -2(R2) ;SET UNDERFLOW TO 0 CLR (R2)+ BR DEC DCHK: MOV #3403,R0 ;ERROR 3,7 JSR PC,$ERRA BR OUT; DIV: MOV R4,-(SP) ;SAVE RETURN POINTER MOV A(SP),-(SP) ;GET A MOV A(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR R4,$POLSH .WORD $MLR ;GET A*C .WORD MRM55,171222 ; CONSTS: .WORD 040311,007732 ;1.570796326794897 .WORD 121041,064302 ; .END N.WORD $ADD ;ADD ATAN2 BIAS .WORD $POPR4 ;POP RESULT TO REGS .WORD EXIT EXIT: TST (SP)+ ;POP SIGN FLAG MOV (SP)+,R5 .F4RTN ;RETURN TO USER ; UP: MOV (SP)+,22.(SP) ;MOVE STACK ITEM UP MOV (SP)+,22.(SP) MOV (SP)+,22.(SP) MOV (SP)+,22.(SP) JMP @(R4)+ ; POLY: MOV #CONSTS+8.,R4 ;POINT TO COEFFICIENT TABLE MOV #9.,R5 ;GET # OF CONSTANTS BR POLY1 POLY2: MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) ;PUSH ARG MOV R0,-(SP) POLY1: MOV -(R4),-(SP) ;PUSH CONSTANT MOV -(R4),-(SP) MOV -(ROYTE 1 .BYTE 322,0 ;ALLOW ONLY INPUT ACCESS .WORD 4 ;FUNCTION WORD (READ) .WORD 0 ;BLOCK NUM .WORD 0 ;BLOCK ADDR .WORD 0 ;BLOCK LENGTH ; ; .ENDC .END P1,$MLR,$ADR ;GET A*C+B*D .WORD MR2,$MLR ;GET B*C .WORD MR3,$MLR,$SBR ;GET B*C-A*D .WORD MR4,$MLR ;GET C*C .WORD MR5,$MLR,$ADR ;GET C*C+D*D .WORD MR6,$DVR ;GET IM(RESULT) .WORD IMAG ;STORE IT .WORD $DVR ;GET RE(RESULT) .WORD REAL ;STORE IT AND EXIT ; MR1: MOV B(SP),-(SP) ;GET B MOV B(SP),-(SP) MOV D(SP),-(SP) ;GET D MOV D(SP),-(SP) JMP @(R4)+ ; MR2: CMP -(SP),-(SP) ;MAKE ROOM FOR REAL PART MOV B+4(SP),-(SP) ;GET B MOV B+4(SP),-(SP) MOV C+8.(SP),-(SP) ;GET C MOV C+8.(SP)R4),-(SP) MOV -(R4),-(SP) DEC R5 ;COUNT BGT POLY2 MOV #XPAND,R4 JMP @(R4)+ ; SIGN: TST 16.(SP) ;CHECK SIGN FLAG BEQ SIGN1 ADD #100000,@SP ;NEGATE RESULT FOR (-1,0) & (1,INF) SIGN1: JMP @(R4)+ .ENDC ; .IFDF FPU DATAN2: SETD ; SET DP MODE FOR FPU MOV 2(R5),R3; ADDRESS OF ARG1 MOV 4(R5),R4; ADDRESS OF ARG2 MOV @R3,R0; HIGH ORDER ARG1 MOV @R4,R1; HIGH ORDER ARG2 BEQ INF; JUMP IF DENOMINATOR 0 ASL R0; CLRB R0; SWAB R0; EXPONENT OF ARG1 ASL R1; CLRB R1; SWAB R1; T,-(SP) JMP @(R4)+ ; MR3: MOV A+12.(SP),-(SP) ;GET A MOV A+12.(SP),-(SP) MOV D+8.(SP),-(SP) ;GET D MOV D+8.(SP),-(SP) JMP @(R4)+ ; MR4: MOV C+8.(SP),-(SP) ;GET C MOV C+8.(SP),-(SP) MOV C+12.(SP),-(SP) ;GET C MOV C+12.(SP),-(SP) JMP @(R4)+ ; MR5: MOV D+8.(SP),-(SP) ;GET D MOV D+8.(SP),-(SP) MOV D+12.(SP),-(SP) ;GET D MOV D+12.(SP),-(SP) JMP @(R4)+ ; MR6: MOV @SP,8.(SP) ;SAVE A COPY OF DENOM. MOV 2(SP),10.(SP) JMP @(R4)+ ; IMAG: MOV (SP)+,IM(SP) ;STORE IMAGINARY PART U .TITLE $DVD $VERSN 05 ; ; ;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. .CSECT .GLOBL $DVD,$ERRA ; $DVD --- THE DOUBLE DIVIDE ROUTINE ; CALLED IN THE POLISH MODE ; THE NUMERATOR IS THE SECOND ITEM ON THE STACK ; AND THE DENOMINATOR IS ON TOP. ; TAKES THE QUOTIENT AND PUTS IT ON TOP ; OF THE STACK IN THEIR PLACE R0=%0 R1=%1 R2=%2 R3=%3 RV EXPONENT OF ARG2 SUB R1,R0; GET EXPONENT DIFFERENCE CMP #58.,R0; CHECK MAGNITUDE BLT INF; TREAT AS INFINITE LDD PI,F3; INITIALIZE BIAS=PI LDD @R3,F0; GET ARG1 CFCC BGE A1PLUS; JUMP IF ARG1>0 NEGD F3; BIAS=SIGN(ARG1)*PI A1PLUS: LDD @R4,F1; GET ARG2 CFCC BLT A2NEG; CLRD F3; IF ARG2>0, BIAS=0 A2NEG: DIVD F1,F0; ARG1/ARG2, SET FLOAT CC BR ATAN1; JOIN MAIN ROUTINE ; INF: LDD PI2,F1; RESULT=SIGN(ARG1)*PI/2 TST @R3; TEST ARG1 BGE EXIT; +PI/2 NEGD F1; -PI/2 BR EW .TITLE $DVI $VERSN 04 ; ; ;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. .CSECT .GLOBL $DVI,$ERRA ; $DVI ------THE INTEGER DIVIDE ROUTINE ; CALLED IN THE POLISH MODE WITH THE NUMERATOR AT 2(SP) ; AND THE DENOMINATOR @SP. ; RETURNS THE INTEGER QUOTIENT @SP. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 MQ=177304 .IFNDF EAE&MULDIV $DVI:X MOV (SP)+,IM(SP) JMP @(R4)+ ; REAL: MOV (SP)+,RE(SP) ;STORE REAL PART MOV (SP)+,RE(SP) MOV (SP)+,R4 ;RESTORE RETURN OUT: ADD #8.,SP ;FLUSH JUNK JMP @(R4)+ ;RETURN TO USER .ENDC ; .IFDF FPU $DVC: SETF ; SINGLE PRECISION FP LDF (SP)+,F0; C LDF (SP)+,F1; D LDF (SP)+,F2; A LDF (SP)+,F3; B STF F0,F4; C STF F1,F5; D ; MULF F2,F0; AC MULF F3,F1; BD ADDF F1,F0; AC+BD MULF F4,F3; BC MULF F5,F2; AD SUBF F2,F3; BC-AD ; LDF F4,F1; MULF F1,F1; CC LDF F5,F2; Y4=%4 R5=%5 SP=%6 PC=%7 F0=%0 F1=%1 D=8. N=16. Q=16. .IFDF FPU $DVD: .WORD 170011 ;;SETD .WORD 172526 ;;LDD (SP)+,F1 ;GET DIVISOR .WORD 172426 ;;LDD (SP)+,F0 ;GET DIVIDEND .WORD 174401 ;;DIVD F1,F0 ;GET QUOTIENT .WORD 174046 ;;STD F0,-(SP) ;TO STACK JMP @(R4)+ .ENDC .IFNDF FPU $DVD: MOV R4,-(SP) MOV R5,-(SP) CLR R0 CLR R1 CLR R2 CLR R3 CLR -(SP) ASL N+0-2(SP) ;SHIFT NUMERATOR ROL @SP ;GET NUMERATOR SIGN CLR -(SP) TST D(SP); CHECK FOR 0.0 DENOMINATOR ZXIT; ; DATAN: SETD ; SET DP MODE FOR FPU CLRD F3; CLEAR ATAN2 BIAS LDD @2(R5),F0; GET ARGUMENT ATAN1: CLR R4; CLEAR SIGN FLAG CFCC ; GET SIGN OF ARGUMENT STD F3,F5; F5=ATAN2 BIAS CLRD F3; CLEAR QUADRANT BIAS BGE PLUS; JUMP IF QUADRANT 1 OR 3 ABSD F0; ABS(X) INC R4; FLAG - PLUS: LDD #1.0,F1; 1.0 CMPD F0,F1; CHECK IF X<=1.0 CFCC BLE LE1; GT1: DEC R4; X>1.0, ADJUST SIGN FLAG DIVD F0,F1; 1.0/X LDD F1,F0; ATAN(X)=PI/2-ATAN(1/X) LDD PI2,F3; QUADRANT BIAS=PI/2 ; [ CLR R0 ;CLEAR RESULT SIGN MOV (SP)+,R1 ;GET DENOMINATOR BGT P1 ;JUMP IF DENOMINATOR PLUS BEQ CHECK ;CAN'T DIVIDE BY ZERO INC R0 ;NOTE - NEG R1 P1: MOV @SP,R3 ;GET NUMERATOR BGT P2 ;JMP IF NUMERATOR PLUS BEQ ZERO ;JUMP IF IT IS ZERO INC R0 ;SET RESULT SIGN NEG R3 P2: MOV R4,-(SP) MOV #8.,R4 ;SET FOR 8 ITERATIONS CLR R2 ;CLEAR HIGH ORDER DIVIDEND SWAB R3 ;TEST HIGH ORDER NUMERATOR BEQ DIV ;JUMP IF HIGH ORDER QUOTIENT IS 0 ASL R4 ;WE NEED ALL 16 ITERATIONS SWAB R3 ;UNDO THE A\ MULF F2,F2; DD ADDF F2,F1; CC+DD CFCC BEQ DCHK; TEST FOR 0 DENOMINATOR DIVF F1,F0; (AC+BD)/(CC+DD) DIVF F1,F3; (BC-AD)/(CC+DD) OUT: STF F3,-(SP); STORE IM(RESULT) STF F0,-(SP); STORE RE(RESULT) JMP @(R4)+; RETURN ; DCHK: MOV #3403,R0 ;ERROR DENOMINATOR=0 JSR PC,$ERRA BR OUT; .ENDC .END ]BEQ DCHK; JUMP TO ERROR EXIT BISB N+1(SP),@SP ;GET NUMERATOR EXPONENT BEQ ZERO ;JUMP IF NUMERATOR IS ZERO BISB N(SP),R0 SWAB R0 ;LEFT JUSTIFY NUMERATOR FRACTION SEC ;INSERT NORMAL BIT ROR R0 BISB N+3(SP),R0 BISB N+2(SP),R1 SWAB R1 BISB N+5(SP),R1 BISB N+4(SP),R2 SWAB R2 BISB N+7(SP),R2 BISB N+6(SP),R3 SWAB R3 ASL D(SP) ;SHIFT DENOMINATOR ADC 2(SP) ;GET RESULT SIGN CLR R4 BISB D+1(SP),R4 ;GET DIVISOR EXPONENT SUB R4,@SP ;SUBTRACT EXPONENTS SWAB D(SP) ;LEFT JUSTIF^LE1: STD F3,F4; F4=QUADRANT BIAS CLRD F3; F3=0.0 CMPD TAN15,F0; COMPARE TAN(15) : X CFCC BGE LT15; X<= TAN(15) LDD PI6,F3; F3=PI/6 LDD F0,F1; MULD ROOT3,F0; SUBD #1.0,F0; X*ROOT3-1.0 ADDD ROOT3,F1; X+ROOT3 DIVD F1,F0; (X*ROOT3-1.0)/(X+ROOT3) ; LT15: LDD F0,F2; X MULD F0,F0; X**2 MOV #FCONST,R0; POINTER TO POLYNOMIAL CONSTANTS MOV #8.,R1; COUNT OF COEFFICIENTS LDD (R0)+,F1; INITIALIZE ACCUMULATOR XPAND: MULD F0,F1; DEC R1; COUNT ADDD (R0)+,F1; F1:= F1* X**2 + C(I_BOVE SWAB DIV: ASL R3 ;DOUBLE DIVIDEND ROL R2 BEQ LOOP ;JUMP IF NO CHANCE THIS TIME INC R3 ;ASSUME IT WILL GO. INSERT QUOTIENT BIT SUB R1,R2 ;TRIAL STEP BHIS LOOP ;OK ADD R1,R2 ;DIVIDEND NOT BIG ENOUGH YET DEC R3 ;TAKE OUT QUOTIENT BIT LOOP: DEC R4 BGT DIV ;GO AGAIN MOV (SP)+,R4 NEG R3 ;TEST FOR NEGMAX ASR R0 ;GET RESULT SIGN BCS P3 ;JUMP IF - NEG R3 ;ANSWER IS POSITIVE BVS CHECK ;JUMP IF ANSWER IS -NEGMAX P3: MOV R3,@SP ;OUTPUT RESULT JMP @(R4)+ ;RETURN ZERO: CLR @SP ;REaY DENOMINATOR SEC ;INSERT NORMAL BIT ROR D(SP) MOVB D+3(SP),D(SP) MOVB D+2(SP),D+3(SP) MOVB D+5(SP),D+2(SP) MOVB D+4(SP),D+5(SP) MOVB D+7(SP),D+4(SP) MOVB D+6(SP),D+7(SP) CLRB D+6(SP) CLR Q(SP) ;CLEAR QUOTIENT CLR Q+2(SP) CLR Q+4(SP) CMP R0,D(SP) ;COMPARE HIGH NUM. AND DEN. BHI DLOW ;JUMP IF DENOMINATOR LOW BLO DHI ;JUMP IF DENOMINATOR HIGH CMP R1,D+2(SP) ;COMPARE LOW ORDER PARTS BHI DLOW BLO DHI CMP R2,D+4(SP) BHI DLOW BLO DHI CMP R3,D+6(SP) BHI DLOW BNE Db) BGT XPAND; LOOP MULD F2,F1; F1:= F1*X ADDD F3,F1; PI/6 OR 0.0 SUBD F4,F1; P(X)-QUAD BIAS TST R4; TEST SIGN FLAG BEQ SIGN1; NO ADJUSTMENT NEGD F1; NEGATE RESULT FOR (-1,0)&(1,INF) SIGN1: ADDD F5,F1; ATAN2 BIAS ; EXIT: STD F1,-(SP); MOVE RESULT TO STACK MOV (SP)+,R0; AND THEN TO REGISTERS MOV (SP)+,R1; MOV (SP)+,R2; MOV (SP)+,R3; .F4RTN ;EXIT ; ; PI: .WORD 040511,007732; PI .WORD 121041,064301; ; PI2: .WORD 040311,007732; PI/2 .WORD 121041,064301; ; TAN15: .cSULT IS 0 JMP @(R4)+ .ENDC ; $DVI FOR THE EAE .IFDF EAE $DVI: MOV #MQ,R0 ;POINT TO MQ MOV (SP)+,R1 ;GET DIVISOR BEQ CHECK ;JUMP IF DIVISION BY 0 MOV (SP)+,@R0 ;DIVIDEND TO MQ TST -(R0) ;SKIP AC MOV R1,-(R0) ;DIVISOR TO DIV CMP (R0)+,(R0)+ ;POINT TO MQ MOV @R0,-(SP) ;GET QUOTIENT JMP @(R4)+ ;RETURN TO USER .ENDC ; $DVI FOR MUL/DIV .IFDF MULDIV $DVI: MOV 2(SP),R1 ;GET LOW ORDER DIVIDEND .WORD 006700 ;;SEX R0 ;EXTEND SIGN .WORD 071026 ;;DIV (SP)+,R0 ;DIVIDE MOV R0,@SP ;PUSd .TITLE $DVR $VERSN 10 ; ; ;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. .CSECT .GLOBL $DVR,$ERRA ; $DVR --- THE REAL DIVIDE ROUTINE ; ; ; CALLED IN THE POLISH MODE ; THE NUMERATOR IS THE SECOND ITEM ON THE STACK ; AND THE DENOMINATOR IS ON TOP. ; TAKES THE QUOTIENT AND PUTS IT ON TOP ; OF THE STACK IN THEIR PLACE R0=%0 R1=%1 R2=%2 R3=%3eHI INC @SP ;BUMP EXPONENT CLR R4 BR FLOAT DCHK: MOV #1403,R0 ;ERROR 3,3 BR ECALL1 UNDER: MOV #4005,R0 ;ERROR 5,8 ECALL: TST -(SP) ;FAKE SIGN ECALL1: JSR PC,$ERRA ZERO: CMP (SP)+,(SP)+ ;FLUSH EXP AND SIGN CLR Q+0-4(SP) CLR Q+2-4(SP) CLR Q+4-4(SP) CLR Q+6-4(SP) BR RTN DLOW: ROR R0 ;HALVE DENOMINATOR (C=0) ROR R1 ;TO ENSURE THAT N87 SMTST: ASL R0 ;DUMP SIGN CMP R0,#43000 BLO ONE ;JUMP IF ARG MAGNITUDE <2**-60 .IFNDF FPU SUB #20.,SP ;GET WORK SPACE ADD #8.t BR FLOAT .ENDC .IFDF EAE!MULDIV BHIS DLOW ;JUMP IF DENOMINATOR LOW OR SAME .ENDC ZERO: CMP (SP)+,(SP)+ ;FLUSH EXP AND SIGN BR ECALL1 DCHK: TST (SP)+ ;FLUSH EXP MOV #4003,R0 ;ERROR 3,8 BR ECALL OVER1: TST -(SP) ;FAKE SIGN OVER: MOV #3003,R0 ;ERROR 3,6 BR ECALL UNDER: MOV #1405,R0 ;ERROR 5,3 ECALL: TST (SP)+ ;FLUSH SIGN JSR PC,$ERRA ECALL1: CLR Q+0-4(SP) ;RETURN 0 CLR Q+2-4(SP) BR RTN DLOW: ROR R0 ;HALVE NUMERATOR (C=0) ROR R1 ;TO ENSURE THAT N=0; Z=Z-1,Y<0 .WORD $SBD .WORD M16 ;D=16*(X*LOG2(E)-FLOAT(Z)) .WORD DUP ;2 COPIES .WORD $DI .WORD DSAVE ;SAVE INTEGER PART OF 2**Y .WORD $ID ;E=D-INxENT .IFNDF EAE&MULDIV DHI: MOV #9.,R4 ;GO DO FIRST 9 QUOTIENT BITS JSR PC,DIV1 MOVB R5,Q(SP) ;SAVE ALL HIGH ORDER Q FRACTION ;EXCEPT NORMAL BIT TST R4 ;SEE IF DONE BEQ NOT0 ;N0, NUMERATOR NOT 0 CLR R5 ;ALL THE REST OF THE QUOTIENT IS ZERO BR FLOAT NOT0: MOV #16.,R4 ;GO DO 16 MORE BITS JSR PC,DIV1 .ENDC .IFDF EAE!MULDIV DHI: CLC ROR R3 ;ENSURE LOW HALF DENOM. + ROR R0 ;SCALE NUMERATOR FOR FIXED PT. DIVIDE ROR R1 .ENDC .IFDF EAE MOV #MQ,R5 ;POINT TO MQ MOV R1,@R5 ;NzOUT BUFFER CMP R0,RECADR(R4) BHI INEBB INECL: CLR INERSZ(R4) ;MARK FOR SUBSEQUENT ENTRY INERET: RTS PC ;RETURN TO INIT CALLER ; INEREJ: MOV #INEERR,R0 ;SET UP FOR INTERMEDIATE ENTRY ERROR JSR PC,$ERRA INC ERRFLG(R4) ;FLAG TO FLUSH I/O LIST RTS PC ; ;ASSEMBLE WITH IOPSTK.PAL FOR I/O TABLE REFERENCES ; .END {T(D) .WORD $SBD,D16 ;E/16 .WORD DUP,DUP ;GET 3 COPIES .WORD $MLD ;E*E .WORD $POPR4 ;POP E*E TO REGS .WORD UNPOL ONE: MOV #40200,R0 ;RESULT IS 1. BR Z1 OVER: MOV #1004,R0 ;ERROR 4,2 BR ECALL ZERO: MOV #2005,R0 ;ERROR 5,4 ECALL: JSR PC,$ERRA CLR R0 ;RESULT IS 0 Z1: CLR R1 CLR R2 CLR R3 BR OUT UNPOL: MOV #033343,-(SP) ;PUSH P0=7.213503410844819083 MOV #015345,-(SP) MOV #152405,-(SP) MOV #040746,-(SP) ; MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) ; MOV #1|UMERATOR TO AC,MQ MOV R0,-(R5) MOV R2,-(R5) ;(A+S*B)/C TST (R5)+ ;POINT TO AC MOV (R5)+,R1 ;KEEP REMAINDER MOV (R5)+,R4 ;KEEP QUOTIENT MOV R3,@R5 ;GET Q*D TST -(R5) ;POINT TO MQ ASR R1 ;SCALE R SUB R1,-(R5) ;Q*D-R DEC @#ASH MOV R2,-(R5) ;(Q*D-R)/C CMP (R5)+,(R5)+ ;MQ NEG @R5 MOV #2,@#ASH ;MULT BY 4 ADD R4,-(R5) ;Q+(Q*D-R)*S/C CLR @#NOR ;NORMALIZE SUB @#NOR,@SP ;APPLY TO EXPONENT MOV #-6,@#LSH ;POSITION NORMAL BIT MOV (R5)+,Q(SP) ;STORE QUOTIENT MOV @R5,R5 .ENDC } .TITLE $EDO $VERSN 05 ; ; ;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. .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $ENDDO - DO STATEMENT END PROCESSING, REQUIRES FOUR PARAMETERS. ; 1 - STEP VALUE ADDRESS ; 2 - CONTROL VARIABLE ADDRESS ; 3 - END VALUE ADDRESS ; 4 - ADDRESS OF LOOP BEGINNING ; ; .GLOBL $END53703,-(SP) ;PUSH P1=.057761135831801928 MOV #153011,-(SP) MOV #113360,-(SP) MOV #037154,-(SP) ; MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) ; MOV #171042,-(SP) ;PUSH Q0=20.8137711965230362973 MOV #074433,-(SP) MOV #101232,-(SP) MOV #041246,-(SP) ; JSR R4,$POLSH .WORD $ADD,AUP ;A=E*E+Q0 TO WORK SPACE .WORD $MLD,$ADD,$MLD ;B=E*(E*E*P1+P0) .WORD TWICE ;DUPLICATE A AND B .WORD $ADD,ABUP ;A+B TO WORD SPACE .WORD $SBD,$DVD ;(A+B)/(A-B) .WORD SCALE ;APPLY SCALE FAC.IFDF MULDIV MOV R0,R4 ;NUMERATOR TO DIVIDEND MOV R1,R5 .WORD 071402 ;; DIV R2,R4 ;(A+S*B)/C MOV R5,R1 ;SAVE REMAINDER MOV R4,R0 ;SAVE QUOTIENT .WORD 070403 ;; MUL R3,R4 ;GET Q*D ASR R1 ;SCALE R SUB R1,R4 ;Q*D-R .WORD 073427,-1 ;; ASHC #-1,R4 ;SCALE .WORD 071402 ;; DIV R2,R4 ;GET (Q*D-R)/C NEG R4 ;(R-Q*D)/C .WORD 073427,-14. ;; ASHC #14.,R4 ;UNSCALE ADD R0,R4 ;Q+(R-Q*D)*S/C NBTST: .WORD 073427,1 ;; ASHC #1,R4 ;SHIFT BMI NBIT ;CHECK FOR NORMAL BIT DEC @SP ;COMPENSATE EXPONENTDO,$ERRA $ENDDO: ADD @(R4)+,@(R4) ;INCREMENT CONTROL VARIABLE BVS ERR; TEST FOR INTEGER OVERFLOW CMP @(R4)+,@(R4)+ ;COMPARE TO LIMIT BGT ENDDO ;TEST FOR COMPLETION MOV @R4,R4 ;TRANSFER TO START OF LOOP JMP @(R4)+ ENDDO: TST (R4)+ ;DISCARD TRANSFER ADDRESS JMP @(R4)+ ;AND CONTINUE ; ERR: CMP (R4)+,(R4)+; SKIP OVER CONTROL&LIMIT MOV #15003,R0 ;ERROR 3,26 JSR PC,$ERRA BR ENDDO; OUT .END .TITLE $EDP $VERSN 05 ; ; ;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. .GLOBL $ENDDP,$ERRA .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; ; $ENDDP - DO STATEMENT END PROCESSING, DO PARAMETERS ; PASSED TO SUBPROGRAMS. ; $ENDDP: JSR PC,GT ;GET ADDR OF STEP VALUE MOV R0,R1 ;AND STORE IN R1 JSR PC,GT ;GETORS SCALE: MOV #ROOTS2+8.,R5 ;POINT TO POWERS OF 2 ASR: ASR 8.(SP) ;SHIFT D BCC NOMULT ;JUMP IF BIT IS OFF MOV -(R5),-(SP) ;PUSH 2**((2**N)*D/16) MOV -(R5),-(SP) MOV -(R5),-(SP) MOV -(R5),-(SP) JSR R4,$POLSH .WORD $MLD,ASR ;MULTIPLY BY ABOVE FACTOR AND TEST NOMULT: BEQ SCALE1 SUB #8.,R5 ;POINT TO NEXT POWER OF 2 BR ASR SCALE1: MOV (SP)+,R0 ;POP RESULT MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 TST (SP)+ ;FLUSH D MOV (SP)+,R4 ;GET Z SWAB R4 CLRB R4 ;MAKE INTO EXPONENT MODIF BR NBTST ;GO AGAIN NBIT: .WORD 073427,-7 ;;ASHC #-8,R4 ;ALIGN FRACTION MOV R4,Q(SP) ;STORE HIGH ORDER .ENDC FLOAT: MOV (SP)+,R4 ;PUSH UP EXPONENT ADD #200,R4 ;ADD IN EXCESS 200 BLE UNDER ;UNDERFLOW CMP #377,R4 BLT OVER ;OVERFLOW MOVB R4,Q+1-2(SP) ;INSERT EXPONENT IN RESULT SIGN: ROR (SP)+ ;INSERT QUOTIENT SIGN ROR Q+0-4(SP) ROR R5 ADC R5 ;ROUND ADC Q+0-4(SP) MOV R5,Q+2-4(SP) ;INSERT LOW ORDER FRACTION BCS OVER1 BVS OVER1 RTN: MOV (SP)+,R5 MOV (SP)+,R4 CMP (SP)+,(SP)+T CONTROL VARIABLE ADDR MOV R0,R2 ;AND STORE IN R2 JSR PC,GT ;GET END VALUE ADDR ADD @R1,@R2 ;INCREMENT CONTROL VARIABLE BVS ERR; TEST FOR INTEGER OVERFLOW CMP @R2,@R0 ;COMPARE TO LIMIT BLE TR ;TEST FOR COMPLETION ENDDP: TST (R4)+ ;DISCARD TRANSFER ADDRESS JMP @(R4)+ ;AND CONTINUE TR: MOV @R4,R4 ;TRANSFER TO START OF LOOP HERE JMP @(R4)+ GT: MOV (R4)+,R0 ;GET PARAMETER CMP R0,#400 ;DETERMINE IF ADDR OR INDEX BHI GTX ;EXIT IF ADDR ADD R5,R0 ;OTHERWISE INDEX OFF R5 TO IER ASR R4 ADD R4,R0 ;APPLY TO RESULT BMI OVER ;JUMP IF OVERFLOW OUT: MOV (SP)+,R5 ;POP RETURN .F4RTN ;RETURN TO USER ; ADJST: TST @2(R5) ;TEST X BGE ARTN ;JUMP IF + DEC @SP ;Z=Z-1 ARTN: MOV @SP,28.(SP) ;SAVE Z AS AN INTEGER JMP @(R4)+ ; M16: ADD #1000,@SP ;16* STACK ITEM JMP @(R4)+ ; D16: SUB #1000,@SP ;1/16*STACK ITEM BPL D16R ;JUMP IF NO UNDERFLOW CLR @SP ;UNDERFLOW=0 D16R: JMP @(R4)+ ; DSAVE: MOV @SP,26.(SP) ;SAVE D AS AN INTEGER JMP @(R4)+ ; AUP: MOV (SP)+,38.(SP) ;FLUSH FIRST ARGUMENT JMP @(R4)+ .IFNDF EAE&MULDIV DIV1: ASL R5 ;SHIFT QUOTIENT ASL R1 ;SHIFT NUMERATOR ROL R0 BCS GO ;GUARANTEED TO GO CMP R2,R0 ;COMPARE HIGH DIVISOR AND DIVIDEND BHI NOGO ;JUMP IF DIVISOR BIGGER BLO GO ;JUMP IF DIVISOR SMALLER CMP R3,R1 ;CHECK THE LOW ORDERS BHI NOGO BEQ NEQD ;JUMP IF NUMERATOR =DENOMINATOR GO: SUB R3,R1 ;N=N-D SBC R0 SUB R2,R0 INC R5 ;INSERT QUOTIENT BIT NOGO: DEC R4 ;COUNT LOOP BGT DIV1 RTS PC NEQD: INC R5 ;INSERT LAST 1 BIT IN QUO .TITLE $ERC $VERSN 08 ; ; ;COPYRIGHT 1971, 9172 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 $ERRC,$ERRF,$RTS,$EXIT .CSECT ; THIS IS THE FORTRN ERROR CLASS TABLE ; ; $ERRC IS NOT USED BY RSX ; .IFDF RSX $ERRC: .ENDC .IFNDF RSX .WORD 8. ;NUMBER OF LAST CLASS IN TABLE ; ; CLASS 0 ENTRY ; $ERRC: .BYTE 5. ;NUM MSGS IN THIS CLASS .BYTE 0 ;REC NUGET ADDR MOV @R0,R0 GTX: RTS PC ; ERR: MOV #15003,R0 ;ERROR 3,26. JSR PC,$ERRA BR ENDDP; .END ;A TO WORK SPACE MOV (SP)+,38.(SP) MOV (SP)+,38.(SP) MOV (SP)+,38.(SP) JMP @(R4)+ ; ABUP: MOV (SP)+,22.(SP) ;MOVE A+B TO WORD SPACE MOV (SP)+,22.(SP) MOV (SP)+,22.(SP) MOV (SP)+,22.(SP) JMP @(R4)+ ; DUP: MOV 6(SP),-(SP) ;DUPLICATE STACK ITEM MOV 6(SP),-(SP) MOV 6(SP),-(SP) MOV 6(SP),-(SP) JMP @(R4)+ ; TWICE: MOV #8.,R0 ;EIGHT ITEMS TW1: MOV 14.(SP),-(SP) ;DUPLICATE 2 DOUBLES DEC R0 BGT TW1 JMP @(R4)+ ; ; .WORD 040265,002363,031771,157145 ;2**1/2 .WORD 040230,0337TIENT BR EQ1 EQ2: ASL R5 ;FINISH OUT QUOTIENT WITH 0'S EQ1: DEC R4 BGT EQ2 INC R4 ;FLAG NO MORE NUMERATOR RTS: RTS PC ;RETURN TO CALLER .ENDC ;DF EAE!MULDIV .ENDC ;NDF FIS .ENDC ;NDF FPU .END M OF 1ST MSG OF CLASS ;IN MSG FILE .WORD $RTS ;TRANSFER ADDRESS .WORD -3 ;MAX ALLOWED OCCURANCE COUNT ;POS=LOG, INC COUNT CALL EXIT ;IF MATCH ;0=LOG AND IGNORE ;-1=IGNORE ERROR (NO LOG) ;-2=EXIT WITHOUT LOGGING ;-3=IMMEDIATE RUN ABORT .WORD 0 ;ACTUAL COUNT ; ; CLASS 1 ENTRY ; .BYTE 17. .BYTE 6 .WORD $RTS .WORD 0 ; LOG AND IGNORE .WORD 0 ; ; CLASS 2 ENTRY ; .BYTE 5. .BYTE 24. .WORD $RTS .WORD 1 ;LOG, INC COUNT CALL EXIT .WORD 0 ;IF M60,050615,134251 ;2**1/4 .WORD 040213,112701,161752,105727 ;2**1/8 ROOTS2: .WORD 040205,125303,063714,044173 ;2**1/16 .ENDC ; .IFDF FPU SETD ; DOUBLE PRECISION FP SETI ; SHORT INTEGERS MOV #FCONST,R0; POINTER TO CONSTANTS LDD @2(R5),F2; GET ARGUMENT MODD (R0)+,F2; F2=FRACT(X*LOG2(E)) STCDI F3,R4; Z=INT(X*LOG2(E)) TSTD F2; CFCC ; BGE M16; TEST F2 ADDD #1.0,F2; MAKE F2 POSITIVE DEC R4; AND ADJUST Z=Z-1 ; M16: MODD #16.0,F2; F2=FRACT(16*(X*LOG2(E)-FLOAT(Z))) STCDI F3,R3ATCH ; ; ; CLASS 3 ENTRY ; .BYTE 30. .BYTE 30. .WORD $RTS .WORD 3 ;LOG, INC COUNT CALL EXIT .WORD 0 ;IF MATCH ; ; CLASS 4 ENTRY ; .BYTE 20. .BYTE 61. .WORD $RTS .WORD 4 ;LOG, INC COUNT CALL EXIT .WORD 0 ;IF MATCH ; ; CLASS 5 ENTRY ; .BYTE 12. .BYTE 82. .WORD $RTS .WORD -1 ;IGNORE ERROR (NO LOG) .WORD 0 ; ; CLASS 6 ENTRY ; .BYTE 3. .BYTE 95. .WORD $RTS .WORD 0 ;LOG AND IGNORE .WORD 0 ; ; CLASS 7 ENTRY ; .BYTE 10. .BYTE 99. .WORD $RTS .WO .TITLE $ERR $VERSN 16 ; ; ;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 $ERRA,$EXIT,$RTS,$IOSET,$TRCBK .IFNDF RSX .GLOBL $AOTS,$AERF .GLOBL $RANDM .ENDC .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS IS THE OBJECT TIME FORTRAN ERROR HANDLER ; ; CALLING SEQUENCE- ; ; MOV #ERRNUM*256.+ERRCLASS,R0 ; ; D=INT (16*(... DIVD #16.0,F2; E=F2/16 LDD F2,F3; MULD F3,F3; E*E ; LDD F3,F1; ADDD (R0)+,F1; A=E*E+Q0 MULD (R0)+,F3; ADDD (R0)+,F3; MULD F2,F3; B=(E*E*P1 + P0)*E LDD F1,F0; ADDD F3,F0; A+B SUBD F3,F1; A-B DIVD F1,F0; (A+B)/(A-B) ; SCALE: ASR R3; SHIFT D BCC NOMULT; MULD (R0)+,F0; MULTIPLY BY ROOT OF 2 BR SCALE; NOMULT: BEQ SCALE1; ADD #8.,R0; POINT TO NEXT ROOT OF 2 BR SCALE; ; SCALE1: STD F0,-(SP); MOVE RESULT TO STACK MOV (SP)+,R0; AND THENCE TO R0.. .TITLE $EXP $VERSN 04 ; ; ; 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. ; .CSECT .GLOBL EXP,$ERRA; .IFNDF FPU .GLOBL $ADR,$SBR,$MLR,$DVR,$IR,$RI,$POLSH; .ENDC ; EXP THE REAL EXPONENTIATION ROUTINE ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS EXPONENTIAL IN R0 AND R1. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6RD 7; LOG, INC COUNT CALL EXIT .WORD 0; IF MATCH ; ; CLASS 8 ENTRY ; .BYTE 5. .BYTE 110. .WORD $RTS .WORD 1; LOG, INC COUNT CALL EXIT .WORD 0; IF MATCH ; ; ERROR FLAG VECTOR ; $ERRF(I) IS SET TO 1 ON AN ERROR OF CLASS I ; THE VECTOR MAY BE TESTED BY THE ROUTINE ; CALL TSTERR(ICLASS,J) ; $ERRF: .BYTE 0,0,0,0; .BYTE 0,0,0,0,0; .EVEN ; .ENDC .END JSR PC,$ERRA ; ; $ERR AND $ERRB PERMIT ACCESS TO THIS ROUTINE THROUGH ; THE (OUTDATED) R5 CALLING SEQUENCE. ; JSR R5,$ERR ; BR NEXT ; .BYTE ERRCLASS ; .BYTE ERRNUM ; NEXT: ; OR ; MOV #ERRNUM*256.+ERRCLASS,R0 ; JSR R5,$ERRB ; CAUTION: ALL CALLS THROUGH R5, PREVIOUSLY MADE TO ; $ERRA SHOULD NOW BE MADE TO $ERRB. ; $ERR: MOV R0,-(SP) ;SAVE R0 MOV 2(R5),R0 ERRR: JSR PC,$ERRA MOV (SP)+,R0 ;RESTORE R0 RTS R5 $ERRB: MOV R0,-(SP) ;SAVE R0 BR ERRR $ERRA: MOV R0,-(SP) ;SA.R3 MOV (SP)+,R1; MOV (SP)+,R2; MOV (SP)+,R3; SWAB R4; CONVERT Z TO EXPONENT MODIFIER CLRB R4; ASR R4; ADD R4,R0; APPLY TO RESULT BMI OVER; JUMP IF OVERFLOW BR OUT; EXIT ; ONE: MOV #40200,R0 ;RESULT IS 1. BR Z1 OVER: MOV #1004,R0 ;ERROR 4,2 BR ECALL ZERO: MOV #2005,R0 ;ERROR 5,4 ECALL: JSR PC,$ERRA CLR R0 ;RESULT IS 0 Z1: CLR R1 CLR R2 CLR R3 OUT: .F4RTN; EXIT ; ; ORDER-DEPENDENT CONSTANTS ; R0 POINTS AT NEXT CONSTANT IN FPU VERSION ; FCONST: .WORD 40270,12507 PC=%7 F0=%0 F1=%1 F2=%2 F3=%3 EXP: MOV 2(R5),R4 ;GET ARGUMENT POINTER MOV @R4,R0 ;GET HIGH ORDER ARG BGT POS ;JUMP IF ARG + CMP R0,#141662 BHI ZERO ;JUMP IF EXPONENT < -88.7 BR SMTST POS: CMP R0,#41660 BHI OVER ;JUMP IF EXPONENT > 87 SMTST: ASL R0 ;DUMP SIGN CMP R0,#63000 BLO ONE ;JUMP IF EXPONENT MAGNITUDE < 2**-28 .IFNDF FPU TST -(SP) ;SAVE SPACE FOR SCALE CLR -(SP) ;PUSH A 1. MOV #40200,-(SP) MOV 2(R4),-(SP) ;GET LOW ORDER ARGUMENT MOV @R4,-(SP) ;HIGH ORDER MVE R0 (CONTAINS ERR CLASS/NUM) MOV R1,-(SP) ;SAVE R1-R5 MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) ; .IFNDF RSX ; ; GET ERROR CLASS TABLE ENTRY INTO R4 ; PUT ERROR CLASS IN R3 ; ERRC: MOVB R0,R3 BLT BADERR ;BRANCH IS CLASS<0 MOV R0,R2 JSR PC,$AOTS MOV R0,R5 MOV 4(R5),R4 CMP R3,-2(R4) BLOS GETENT ;BRANCH IF VALID CLASS BADERR: CLR R0 ;ELSE SET CLASS/NUM =0 BR ERRC GETENT: JSR PC,$AERF ADD R3,R0 MOVB #1,(R0) MOV R2,R0 ASL R3 ASL R3 ASL R3 ADD R3,024534,013761; LOG2(E) ; .WORD 041246,101232,074433,171042; Q0 .WORD 037154,113360,153011,153703; P1 .WORD 040746,152405,015345,033343; P0 .WORD 040205,125303,063714,044173; 2**1/16 .WORD 040213,112701,161752,105727; 2**1/8 .WORD 040230,033760,050615,134251; 2**1/4 .WORD 040265,002363,031771,157145; 2**1/2 .ENDC .END OV 2(R4),-(SP) ;NEED TWO COPIES OF IT MOV @R4,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD PL2E ;PUSH LOG2(E) .WORD $MLR .WORD $RI ;FIX LOG2(E)*X .WORD ESAVE ;SAVE EXPONENT SCALE .WORD $IR ;FLOAT IT .WORD PL2E ;PUSH LOG2(E) .WORD $DVR .WORD $SBR .WORD CFRACT ;PUSH CONTINUED FRACTION CONSTANTS .WORD $MLR ;Y*Y .WORD $ADR ;B1+Y*Y .WORD $DVR ;A1/(B1+Y*Y) .WORD $ADR ;Y+A1/(B1+Y*Y) .WORD $ADR ;A0+Y+A1/(B1+Y*Y) .WORD $DVR ;Y/(A0+Y+A1/(B1+Y*Y)) .WORD INC ;-2*Y/(A0+Y+A1/(B1+Y*Y) .TITLE $EXT $VERSN 05 ; ; ;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 EXIT,$EXIT .IFNDF RSX .GLOBL $CLSUP,$AOTS .ENDC .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS IS THE OBJECT TIME EXIT ROUTINE ; ; .IFNDF RSX $EXIT: EXIT: JSR PC,$CLSUP; CLOSE ALL OF FORTRAN'S OPEN FILES EXIT01: JSR PC,$AOTS 3,R4 ;ADDR OF CLASS ENTRY IN R4 SWAB R0 MOVB R0,R3 ;ERR NUM IN R3 BLT BADERR ;BRANCH IF NUM<0 CMPB R3,(R4) BGT BADERR ;BRANCH IF INVALID NUM ; ; PROCESS ERROR DEPENDING ON LOG LIMIT ; ; -3=ABORT RUN ; -2=CALL EXIT (NO LOG) ; -1=NO LOG AND IGNORE ; 0=LOG AND IGNORE ; >0=LOG, ING COUNT CALL EXIT IF MATCH ; ; CMP #-1,4(R4) BEQ ERRX ;BRANCH IF ERR TO BE IGNORED BLT LOG ;BRANCH IF MSG TO BE LOGGED CMP #-2,4(R4) BNE ABORT ;BRANCH TO IMMEDIATE ABORT MOV #3,12(R5) ;SET ERRO) .WORD $ADR ;1-2*Y/......... .WORD DUP ;DUPLICATE IT .WORD $MLR ;(1-2*Y/.....)**2 .WORD SCALE ;EXIT POLISH MODE AND SCALE RESULT INC: ADD #100200,@SP ;MULTIPLY BY -2.0 JMP @(R4)+ ;GO BACK TO LIST ; DUP: MOV 2(SP),-(SP) ;DUPLICATE STACK ITEM MOV 2(SP),-(SP) JMP @(R4)+ ; PL2E: MOV #125073,-(SP) ;PUSH LOG2(E) MOV #40270,-(SP) JMP @(R4)+ ; ESAVE: MOV @SP,10.(SP) ;SAVE EXPONENT SCALE JMP @(R4)+ ; CFRACT: ROL @SP ;SHIFT MODIFIED ARG ROL R0 ;SAVE SIGN SUB #400,@SP ;DIVIDE BY 2. MOV 10.(R0),R0 ;GET $EXSW VALUE INTO R0 BNE EXIT1 ;BRANCH IF WERE ERRORS END: EMT 60 ;EXIT TO MONITOR ; EXIT1: DEC R0 BEQ END ;IF MSGS LOGGED EXIT MOV R0,-(SP) ;NOTE ERROR MAX CNT REACHED OR MOV EXNOTE,-(SP) ;NOTE LOGGING ERROR CALLED EXIT IOT BR END ; EXNOTE: .BYTE 351 ;NUM OF DIAG .BYTE 0 ;INFORM OF ABNORMAL EXIT CONDITION .ENDC .IFDF RSX $EXIT: EXIT: EMT 60 .ENDC .END R INDICATOR FOR EXIT ERRXIT: MOV #$EXIT,2(R4) ;SET TRANS VEC TO CALL EXIT BR ERRX ;GO EXIT ABORT: SUB R3,R0 ASL R0 ADD R3,R0 ;ERR NUM FOR PRINT, FORCE TO LOOK LIKE MOV R0,-(SP) ;3 CHAR CLASS + 3 CHAR NUM MOV ABCD,-(SP) ;INDICATE FATAL FORTRAN ERROR IOT ;EXIT TO MONITOR ABCD: .BYTE 30 ;GET NUM FROM H. SHEPARDSON .BYTE 3 ;INDICATE FATAL ERROR ; ERRX: MOV R4,R0 ;ADDR ERR ENTRY IN R0 MOV (SP)+,R5 ;RESTORE R5-R1 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV 2(R0 .TITLE $FDV $VERSN 05 ; ; ; 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 $FNDEV .GLOBL $ADEV .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;; ; GET ADDR IN DEVICE TABLE OF DEVICE NUM IN R0 AND PUT ; IN R1 ; $FNDEV: MOV R0,R1 JSR PC,$ADEV ;ADDR $DEVTAB MOV R0,R3 ;SAVE IN R3 MOV R1,R0 ;RESTORE DEVICE NUM BLOS ZFRACT ;UNDERFLOW. MAKE ARG 0 ROR R0 ;GET SIGN BACK ROR @SP MOV @SP,R0 ;GET MODIFIED ARGUMENT MOV 2(SP),R1 ;IN REGISTERS MOV #036602,-(SP) ;PUSH -12.01501675 *********** MOV #141100,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV #071571,-(SP) ;PUSH 601.8042667 *************** MOV #042426,-(SP) MOV #056133,-(SP) ;PUSH 60.0901907 *********** MOV #041560,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV R1,-(SP) MOV R0,-(SP) JMP @(R4)+ .ENDC ; .IFDF FPU SETD ; DOUBLE PRECISION ARGUMEN),R0 ;PUT TRANS ADDR IN R0 RTS R0 ;RESTORE R0 AND JUMP TO TRANS ADDR ;AS IF USER CALLED DIRECTLY ; $RTS: RTS PC ;DEFAULT EXIT FROM TRANS VEC ; ;IS TO RETURN TO CALLER ; ; ; MESSAGE IS TO BE LOGGED, CHECK IF LOG FILE AVAILABLE ; .ENDC ; ; ; .IFDF RSX ;RSX CODE ERRC: MOVB R0,R3 BGE GETENT ;BRANCH IF CLASS >=0 BADERR: CLR R0 ;ELSE SET CLASS/NUM =0 BR ERRC GETENT: SWAB R0 MOVB R0,R3 ;ERR NUM IN R3 BLT BADERR ;BRANCH IF NUM<0 .ENDC LOG: MOV R0,-(SP) ;CHECK IF LO BLE NEGDEV ;BRANCH IF DEVICE NOT POSITIVE CMP R0,(R3) ;CHECK IF DEVICE NUM GT MAX BGT BADEV ;BRANCH IF SO FDV00: ASL R1 ADD R3,R1 MOV 2(R1),R1 ;SET ADDR OF DEVICE TABLE ENTRY BEQ BADEV ;BRANCH IF ENTRY DOES NOT EXIST RTS PC ;RETURN ; NEGDEV: .IFNDF RSX CMP R0,#-3; PERMIT LOGICAL DEVICE -3 BEQ FDV00; FOR USE AS ERROR-LOGGING DEVICE .ENDC BADEV: CLR R1 ;SET BAD DEVICE CODE RTS PC ; ; .END T REDUCTION SETI ; SHORT INTEGERS MOV #FCONST,R0; POINTER TO CONSTANTS LDCFD @R4,F2; GET ARGUMENT MODD (R0)+,F2; F2=FRACT(X*LOG2(E)) STCDI F3,R4; R4=INT (X*LOG2(E)) LDD #1.0,F0; F0=1.0 DIVD (R0)+,F2; Y=F2/(2*LOG2(E)) SETF ; LDCDF F2,F2; REST IN SINGLE PRECISION CFCC ; TEST FOR UNDERFLOW BEQ SCALE1; APPROXIMATION RESULT IS 1.0 LDF F2,F3; MULF F3,F3; Y*Y ADDF (R0)+,F3; B1+Y*Y LDF (R0)+,F1; DIVF F3,F1; A1/(B1+Y*Y) ADDF F2,F1; ADDF (R0)+,F1; A0+Y+A1/(B1+Y*Y) DI .TITLE $FIO $VERSN 08 ; ; ;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. .CSECT .GLOBL $FIO,$ERRA ; ; THIS ROUTINE DOES FORMAT SCANNING AND I/O ITEM CONVERSION ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 .GLOBL $DCI,$DCO,$RCI,$ECO,$FCO .GLOBL $GCO,$ICI,$ICO,$LCI,$LCO,$OCI,$OCO ; ; ; ; ; ; $FIO: TST FMTPTR(R5) G DEVICE AVAILABLE JSR PC,$AOTS MOV (R0)+,R5 ;ADDR $DEVTB MOV (R0),R2 ;ADDR $IOBUF MOV (SP)+,R0 ; ; ; ; MOV 2(R5),R1 ;RUN ASCII OUTPUT BEQ NOLOG ;BRANCH IF NO DEVICE NUM ASL R1 ADD R5,R1 MOV 2(R1),R1 BEQ NOLOG ;BRANCH IF NO DEVTB ENTRY BITB DVSW(R1),#6 BNE NOLOG ;BRANCH IF RANDOM OR UNFMT FILE TSTB DVHOPN(R1) BEQ OPNLOG ;GO OPEN IF CLOSED CMPB DVHOPN(R1),#2 ;IF OPEN CHECK IF OPENO BNE NOLOG ;BRANCH IF NOT BR LOGOPN ;GO SET UP TO LOG MSGS ; OPNLOG: MOV R0,-(SVF F1,F2; Y/(A0+Y+A1/(B1+Y*Y)) MULF #2.0,F2; SUBF F2,F0; 1-2*Y/. . . MULF F0,F0; (1-2*Y/. . . )**2 SCALE1: STF F0,-(SP); MOVE APPROXIMATION TO STACK .ENDC ; .IFNDF FPU ZFRACT: CMP (SP)+,(SP)+ ;FLUSH CFRACT ARG ; RESULT IS 1. .ENDC SCALE: MOV (SP)+,R0; GET APPROXIMATION RESULT MOV (SP)+,R1; .IFNDF FPU MOV (SP)+,R4; GET INT(X*LOG2(E)) .ENDC SWAB R4; MAKE INTO EXPONENT MODIFIER CLRB R4; ASR R4; ADD R4,R0; ADD IN EXPONENT MODIFIER BMI OVER; TEST OVERFLOW .F4RTN ; ;IS THIS INIT CALL BEQ FIO1 ;BRANCH IF IS JMP REENT ;ELSE RETURN TO PLACE OF EXIT ; FIO1: MOV FMTADR(R4),FMTPTR(R5) ;INITIALIZE SCAN OF FORMAT MOVB @FMTPTR(R5),SCNKAR(R5) ;GET FIRST CHAR OF FORMAT CMPB #'(,SCNKAR(R5) ;VALIDATE OPENING ( BNE FIO2 ;IF NO (IS SYNTAX ERROR JMP LPARN FIO2: JMP BADSYN ; ; ; ; ; SCAN FORMAT ACCUMULATING NUMBER IN INT SETTING INTSW, SCNKAR ; AND FMTPOS PROPERLY AND STOPPING SCAN AT NONBLANK NONNUMBER ; SCAN: CLR R0 CLR INT(R5) ;ZERO ACCUMULATOR AP) ;SAVE R0 MOV 2(R5),R0 ;MOVE DEVICE NUMBER TO R0 JSR PC,$IOSET ;COME HERE TO OPEN LOGGING DEVICE MOV (SP)+,R0 ;RESTORE R0 MOVB R0,R3 ;RESTORE R3 MOV #LOGRI,BFLKER(R2) ;SET LINK BLOCK ERR RET MOV #LOGRO,BFFLER(R2) ;SET FILE BLOCK ERR RET MOV R2,-(SP) EMT 6 ;INIT MOVB #2,BFHOPN(R2) ;SET TO OPENO MOV R2,-(SP) ADD #BFFLNM,(SP) MOV R2,-(SP) EMT 16 ;OPEN MOVB BFHOPN(R2),DVHOPN(R1) ;SET OPENO IN DEVICE ENTRY INCB DVSW(R1) ;SET FMTD I/O MOV BFLP(R2),DVLP(R1) ;SAVE LINK PTR B .TITLE $FIX $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL IFIX,$RI,$POLSH ; THE FORTRAN IFIX FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS THE TRUNCATED AND FIXED REAL ; ARGUMENT AS AN INTEGER IN R0. ; R0=%0 R4=%4 R5=%5 SP=%6 IFIX: MOV 2(R5),R4 ;GET ARG ADDRESS MOV 2(R4),-(SP) ;PU ONE: CLR R1 MOV #40200,R0 ;EXP(TINY) = 1. BR OUT OVER: MOV #2404,R0 ;ERROR 4,5 BR ECALL ZERO: MOV #2405,R0 ;ERROR 5,5 ECALL: JSR PC,$ERRA CLR R0 ;RETURN 0 CLR R1 OUT: .F4RTN ; .IFDF FPU ; ORDER-DEPENDENT CONSTANTS ; FCONST: .WORD 040270,125073; LOG2(E) DOUBLE PRECISION .WORD 024534,013761; ; .WORD 040470,125073; 2*LOG2(E) DOUBLE PRECISION .WORD 024534,013761; ; .WORD 041560,056133; B1=60.0901907 ; .WORD 042426,071571; A1=601.8042667 ; .WORD 141100,036602; A0=-12.015016ND STATUS CLR INTSW(R5) ; ; LOOK FOR FORMAT VARIABLECHAR, "<" ; JSR PC,NXNBCH ;NEXT NON-BLANK CMPB #'<,R1 BNE SCAN4 ;BR IF NOT THERE JSR PC,EXECUT ;EXECUTE FORMAT EXPRESSION TST R0 ;RETURN VALUE BGE SCAN5 ;IF NOT NEGATIVE DEC INTSW(R5) ;SET NEGATIVE SWITCH BR SCANX1 ;FINISH UP SCAN5: INC INTSW(R5) ;SET PRESENT AND PLUS OR 0 BR SCANX1 ;FINISH UP ; ; NORMAL INTEGER SCAN ; SCAN1: JSR PC,NXNBCH ;GET NEXT NON-BLANK SCAN4: TST INTSW(R5) ;IF THIS IS FIRST NON-BLANK BNE SR LOGOPN ; LOGRI: LOGRO: MOV R2,-(SP) ;ERRORS ON INIT OR OPEN - EMT 7 ;RLSE DATA SET ; ; NO LOGGING DEVICE ; NOLOG: SUB R3,R0 ;MODIFY ERROR CLASS AND NUM TO ASL R0 ;LOOK GOOD ON OUTPUT ADD R3,R0 MOV R0,-(SP) ;PUSH IT ON STACK MOV NLOGD,-(SP) ;SET INFORMATION NO LOG DEV 1 IOT ;MONITOR DIAGNOSTIC JMP LOGD ;GO END UP ERROR PROCESSING ; NLOGD: .BYTE 353 ;NUM OF DIAG .BYTE 0 ;INFORMATIONAL (NO LOG DEV) DIAGNOSTIC ; LOGOPN: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR IN BUFF CLR SH ARG MOV @R4,-(SP) RND: JSR R4,$POLSH ;ENTER POLISH MODE .WORD $RI,UNPOL ;TRUNCATE AND FIX UNPOL: MOV (SP)+,R0 ;POP INTEGER RESULT .F4RTN ;RETURN TO CALLER .END 75 .ENDC .END CAN2 ;CHECK IF IS -, ELSE BRANCH CMPB #'-,R1 BNE SCAN2 ;IF NOT -, BRANCH DEC INTSW(R5) ;ELSE SET STATUS = -1(NEG NUM) BR SCAN1 ;AND IGNORE - SCAN2: SUB #60,R1 ;CHECK IF CHAR IS A DIGIT (0-9) BMI SCANX ;IF NOT GO EXIT CMP #9.,R1 BLT SCANX TST INTSW(R5) ;IF IS AND IS FIRST NON-BLANK BNE SCAN3 ;CHAR SET STATUS = 1 (POS NUM) INC INTSW(R5) SCAN3: ASL R0 ;MULTIPLY PREVIOUS ACCUMULATION ADD R0,R1 ;BY 10 AND ADD IN NEW DIGIT ASL R0 ASL R0 ADD R1,R0 BR SCAN1 ;GO BFLKER(R2) ;USE NEXT 4 WORDS OF IOBUF AS LINE ;BUFF HDR SO THAT ACTUAL LINE BUFF ;HDR AND LINE BUFF ARE NOT DISTURBED ; .IFDF RSX ;RSX WILL NOT SUPPORT ;A MSG FILE JMP NOMSG1 .ENDC ; .IFNDF RSX ; ; NOW CHECK IF MSG FILE EXISTS ; MOV -(R5),R5 ;GET ADDR MSG FILE FROM DEVTB HDR BEQ NOMSG1 ;BRANCH IF NONE TST (R5) BNE MSGOPN ;BRANCH IF ALREADY OPEN MOV R5,-(SP) EMT 6 ;INIT MOV #NOMSG,10(R5) MOV R5,-(SP) ADD #14,(SP) MOV R5,-(SP) EMT 16 ;OPEN MSGOPN:GET NEXT CHAR ; SCANX: MOVB @FMTPTR(R5),SCNKAR(R5) ;RE-SET CURRENT CHAR TST INTSW(R5) ;TEST IF NEG NUM BGE SCANX1 NEG R0 ;IF IS - NEGATE NUMBER SCANX1: MOV R0,INT(R5) ;SAVE NUMBER RTS PC ;RETURN TO CALLER ; ; EXECUTE FORMAT EXPRESSION ; EXECUT: MOV R4,-(SP) ;SAVE I/O CONTEXT MOV R5,-(SP) MOV FMTPTR(R5),R3 ;GET BEGINNING OF POLISH INC R3 ;SKIP "<" INC R3 ;ROUND UP TO EVEN BYTE BIC #1,R3 MOV SAVER5(R4),R5 ;USERS R5 CONTEXT MOV MOV #64.,-(SP) ;SET RECORD LENGTH CLR -(SP) MOVB 1(R4),(SP) ;RECORD NUM-1 ADD R3,(SP) MOV R5,-(SP) ;AND BLK SIZE IN BYTES EMT 13 CMP (SP)+,(SP)+ ASL (SP) JSR PC,$RANDM ;GET BLOCK NUM & DISP TST (SP)+ MOV (SP)+,R0 ;SAVE DISPLACEMENT MOV (SP)+,30(R5) ;SET BLK IN BLOCK BLOCK MOV R5,-(SP) ;ADDR BLOCK BLOCK ADD #26,(SP) MOV R5,-(SP) ;ADDR OF LINK BLOCK EMT 11 ;READ BLOCK MOV R5,-(SP) EMT 1 ;WAIT MOV 32(R5),R5 ;GET ADDR OF MSG ADD R0,R5 MOV R5,R0 ;SEARCH FOR WORD OF BL .TITLE $FLD $VERSN 02 ; ; ;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 $FLDEV ; $FLDEV - THIS MODULE CONTAINS A ; LIST OF THE DEVICES WHICH FOR ; PURPOSES OF FORMATTED I/O ; ARE TO BE CONSIDERED LISTING ; DEVICES .CSECT $FLDEV: .RAD50 /LP / .RAD50 /KB / .RAD50 /TT / .RAD50 /LP0/ .RAD50 /LP1/ .RAD50 /LPA/ .TITLE $FLT $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL FLOAT,$IR,$POLSH,$POPR3 ; FLOAT THE FORTRAN FLOAT FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS REAL EQUIVALENT IN R0 AND R1. ; USES $IR. ; R0=%0 R1=%1 R4=%4 R5=%5 SP=%6 FLOAT: MOV @2(R5),-(SP) ;GET ARGUMENT ON STACK J R3,R4 ;POLISH POINTER JMP @(R4)+ ;GO DO POLISH ; ; FORMAT EXPRESSION WILL RETURN HERE ; .GLOBL $FMTRT $FMTRT: MOV (SP)+,R0 ;EXPRESSION VALUE MOV (SP)+,R5 ;I/O CONTEXT MOV R4,FMTPTR(R5) ;UPDATE FORMAT POINTER JSR PC,NBCH ;SKIP BLANKS MOV (SP)+,R4 ;REST OF I/O CONTEXT RTS PC ; ; SOME SERVICE ROUTINES ; ; GET NEXT FORMAT CHAR NXFMCH: INC FMTPTR(R5) MOVB @FMTPTR(R5),R1 MOVB R1,SCNKAR(R5) RTS PC ; ; GET NON-BLANK FORMAT CHAR ; NBCH: DEC FMTPTR(R5) ; ; GET NEXT NON-BLAANKS TST (R0)+ ;IGNORE FIRST WORD MOV #31.,R3 ;CONSIDER 31 WORDS MSG3: DEC R3 BLT MSG4 CMP #" ,(R0)+ ;BRANCH IF NON BLANK BNE MSG3 MSG4: MOV #5015,-(R0) ;SET CRLF AT END ; .ENDC ; MSG2: MOV #5015,(R5) ;SET CRLF AT START MOV #64.,2(R2) ;SET BUFFER LEN = ASL R3 SUB R3,2(R2) ;TO 64. - NON BLANK ;BYTES MOV 2(R2),6(R2) ;SET BYTE COUNT MOV R5,8.(R2) ;SET RECORD ADDR (DUMP MODE) MOVB #4,4(R2) ;SET FMTD ASCII DUMP WRITE MOV R2,-(SP) ;ADDR BUF HDR ADD #2,(SP) MOV R2,-(SP) .RAD50 /LPB/ .WORD 0 .END SR R4,$POLSH ;ENTER POLISH MODE .WORD $IR ;CALL $IR TO CONVERT TO REAL .WORD $POPR3 ;POP RESULT TO REGS .WORD UNPOL UNPOL: .F4RTN ;RETURN TO CALLER .END NK ; NXNBCH: JSR PC,NXFMCH CMPB #' ,R1 BEQ NXNBCH RTS PC ; ; COME HERE TO DETERMINE WHERE TO GO ON BASIS OF NEXT CHAR IN ; FORMAT STMT ; ; ; VALID CHARS AR T / , ) ' ELSE SYNTAX ERR ; FCONT: MOV #FCLGT,R0 ;LIMIT SEARCH TO ;FIRST FIVE CHAR'S BR FCONT3 ; ; VALID CHARS ARE , ) ( / ' ADEFGHILOPTXQ = ALL SPEC ; FCONT1: MOV #F.CLGT,R0 ;ALLOW ALL CHAR'S ; FCONT3: CLR R1 ;CLEAR INDEX ; FCNT1: CMPB SCNKAR(R5),F.LGCH(R1) ;IS THERE A MATCH? ;ADDR OF LINK BLOCK EMT 2 ;WRITE MOV R2,-(SP) EMT 1 ;WAIT BITB #100,5(R2) ;IF EOF ON LOG DEVICE ABORT RUN BEQ MSGD ; LOGBAD: MOV R1,-(SP) ;PUSH ADDR OF DEVTB ENTRY (LOG DEVICE) MOV LBD,-(SP) ;EOF LOG DEV ERROR IOT ;INFORM OF ERROR BR LOGD ;AND CONTINUE AT USER OPTION LBD: .BYTE 352 ;NUM OF DIAG .BYTE 0 ;INFORMATIONAL - EOF LOG DEV NOMSG: MOV R5,-(SP) EMT 7 ;RELEASE NOMSG1: CLRB R0 SWAB R0 MOV R0,-(SP) ;PUSH CLASS NUMBER MOV R3,-(SP) ;PUSH ERROR NUMBER JSR PC,$AOT BEQ FCNT2 ;JUMP IF YES INC R1 ;SET INDEX FOR NEXT SEARCH CMP R1,R0 ;IS SEARCH COMPLETE? BLT FCNT1 ;BRANCH IF NOT FCONTX: JMP BADSYN ;ELSE SYNTAX ERROR FCNT2: ASL R1 ;MULTPLY BY TWO JMP @FCNT(R1) ;GO TO PROPER ROUTINE ; ; VALID CHARS ARE ( / ' ADEFGHILOPTX ; FCONT2: MOV #2,R1; SET TO ALLOW ALMOST ALL CHARS FCONT4: MOV #F.CLGT,R0; BUT DISALLOW , ) BR FCNT1 ; FCONT5: MOV #1,R1; SET TO ALLOW ALMOST ALL CHARS BR FCONT4; BUT DISALLOW , ; FCNT: COMMA RPARN SLASH TSPEC QUOS ;ADDR $OTSV MOV R0,R5 ADD #14,R5 ;ADDR LINE BUFFER AREA $ERRWK ; ;LINE = CRLFFORT000000CRLF MOV R5,-(SP) CMP (R5)+,(R5)+ ADD #7,(SP) MOV #3,-(SP) EMT 42 ;CVT ERR NUM TO DECIMAL CHARS MOV R5,-(SP) MOV #3,-(SP) EMT 42 ;CVT ERR CLASS TO DECI CHARS MOV #5015,8.(R5) ;PUT IN CR LF MOV #"RT,(R5) MOV #"FO,-(R5) TST -(R5) MOV #25.,R3 ;SET BUF LGN BR MSG2 ;GO WRITE ; MSGD: JSR PC,$TRCBK ;GO GEN TRACE BACK TST R3 ;ABORT IF EOF ON LOG DEV BNE LOGBAD .IFNDF RS .TITLE $FND $VERSN 03 ; ; ; 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. ; .GLOBL $FIND,$FNDEV,$ERRA .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS IS THE OBJECT TIME FIND ROUTINE FOR RANDOM I/O ; IT JUST UPDATES THE ASSOCIATED VARIABLE BUT ; IT DOES NOT PHYSICALLY 'FIND' THE RECORD. ; ; SP+2: ADDRESS OF LOGICAL UNIT NU .TITLE $FPR $VERSN 03 ; ; ; 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. ; ; .CSECT R0=%0 R1=%1 R5=%5 SP=%6 PC=%7 F0=%0 F1=%1 F2=%2 F3=%3 ; ; THIS IS THE OBJECT TIME FORTRAN INTERRUPT HANDLER ; FOR INTERRUPTS FROM THE 11/45 FPU ; ; FPU INTERRUPTS TRAP THROUGH LOCATION 244 TO $FPERR ; ; .IFDF FPU .GLOBL $FPERR,$ERRA .IFDF RSX11TE LPARN ASPEC DSPEC ESPEC FSPEC GSPEC ISPEC LSPEC OSPEC HSPEC PFACT XSPEC QSPEC ; ; F.LGCH: .BYTE ', .BYTE ') .BYTE '/ .BYTE 'T .BYTE '' FCLGT=.-F.LGCH .BYTE '( .BYTE 'A .BYTE 'D .BYTE 'E .BYTE 'F .BYTE 'G .BYTE 'I .BYTE 'L .BYTE 'O .BYTE 'H .BYTE 'P .BYTE 'X .BYTE 'Q F.CLGT=.-F.LGCH .EVEN ; ; Q SPEC COMES HERE ; QSPEC: TST IOSW(R4) ;IGNORE ON OUTPUT BNE 4$ JSR PC,NXFMCH ;ADVANCE TO NEXT FORMAT CHAR BR FCONT 4$: TSTX LOGD: TST 4(R4) ;IF IGNORE TYPE ERROR BNE LOGD1 LOGD2: JMP ERRX ;RETURN THRU TRANS VEC LOGD1: INC 6(R4) ;ELSE INC ERR CNT FOR CLASS CMP 6(R4),4(R4) ;CHECK IF MAX REACHED BLT LOGD2 MOV #2,12(R0) ;IFSO SET $EXSW AND CALL EXIT JMP ERRXIT .ENDC .IFDF RSX ;RSX CODE LOGD: ERRX: MOV (SP)+,R5 ;RESTORE R5-R0 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 $RTS: RTS PC ;RETURN TO CALLER .ENDC ; .END MBER ; SP : ADDRESS OF RECORD NUMBER ; $FIND,ADDR OF END RETURN, ADDR OF ERR RETURN ; $FIND: MOV @2(SP),R0; GET UNIT NUMBER FROM STACK JSR PC,$FNDEV; GET ADDRESS OF DEVTB ENTRY TST R1; BEQ BADEV; BRANCH IF BAD DEVICE NUMBER BITB #4,DVSW(R1); CHECK IF DEFINE FILE DONE BEQ NODEF; DEFINE FILE NOT DONE - ERROR MOV @0(SP),R0; GET THE RECORD NUMBER BLE BADREC; BRANCH IF < 1 CMP R0,DVRMAX(R1); BGT BADREC; BRANCH IF > MAX MOV R0,@DVAVAD(R1); MOVE REC NUM TO ASSOC. VAR. OUT: CMP (SP)D $FPERR: MOV 2(SP),-(SP) MOV R0,4(SP) .ENDC .IFNDF RSX11D $FPERR: MOV R0,-(SP); SAVE A REGISTER STST -(SP); FLT EXCEPTION CODE AND ADDRESS .ENDC STFPS R0; GET FPU INTERRUPT WORD BIC #100000,R0; CLEAR ERROR FLAG LDFPS R0; RESTORE INTERRUPT WORD MOV (SP),R0; FLT EXCEPTION CODE MOV ERRMSG(R0),R0; GET ERROR CODE WORD JSR PC,$ERRA; LOG ERROR ; MOV (SP)+,R0; FLT EXCEPTION CODE CMP R0,#10.; TEST IF FLT UNDERFLOW BNE OUT; NOT UNDERFLOW-EXIT MOV @(SP)+,R0; GET THE UNDERFLOWING INTSW(R5) ;NO REPEAT ALLOWWED BEQ 1$ JMP BADSYN 1$: TST ARGPTR(R4) ;I/O LIST ITEM PRESENT? BNE 3$ JMP ENDUPX ;IF NOT THEN END FORMAT SCAN 3$: CMP #2,ARGTYP(R4) ;MUST BE INTEGER LIST ITEM BEQ 2$ MOV #6,R0 JSR PC,$ERRA 2$: MOV RECEND(R4),R0 SUB RECADR(R4),R0 MOV R0,@ARGPTR(R4) JSR PC,NXFMCH ;ADVANCE FORMAT POINTER MOV #1,REPCNT(R5) ;FOR GOOD REENTRY RTS PC ; ; COMMA COMES HERE ; COMMA: TST INTSW(R5) ;NO PRECEEDING NUM ALLOWED BEQ C+,(SP)+; CLEAN UP STACK CMP (R4)+,(R4)+; SKIP OVER END=, ERR= JMP @(R4)+ ;RETURN ; BADEV: MOV #6001,R0 ;ERROR 1,12 JSR PC,$ERRA BR OUT; NODEF: MOV #3001,R0 ;ERROR 1,6 JSR PC,$ERRA BR OUT; BADREC: MOV #6403,R0 ;ERROR 1,13 JSR PC,$ERRA BR OUT; .END INSTRUCTION ROR R0; SHIFT RIGHT 4 ROR R0; ROR R0; ROR R0; BIC #177763,R0; R0=AC*4 JMP CLRF0(R0); CLEAR APPROPRIATE FLT AC ; CLRF0: CLRF F0; F0=0 BR OUT1; CLRF F1; F1=0 BR OUT1; CLRF F2; F2=0 BR OUT1; CLRF F3; F3=0 BR OUT1; ; OUT: TST (SP)+; POP FLT EXCEPTION ADDRESS OUT1: MOV (SP)+,R0; RESTORE R0 .IFNDF RSX11D RTI ; RETURN TO USER PROGRAM .ENDC .IFDF RSX11D .GLOBL $ASTX JMP $ASTX .ENDC ; ERRMSG: .BYTE 0,3; 0 ILLEGAL INSTR 11/20 .BYTE 0,3; 2 FLOATIOMMA1 JMP BADSYN COMMA1: JSR PC,SCAN ;GO GET NEXT NUMAND SPEC JMP FCONT2 ;ALLOW ALL SPECS BUT ) AND , ; ; P COMES HERE ; PFACT: TST INTSW(R5) ;PRECEEDING NUM REQUIRED BNE PFACT1 JMP BADSYN PFACT1: MOV INT(R5),PSCALE(R5) ;SAVE SCALING JSR PC,SCAN ;GET NEXT NUM AND SPEC JMP FCONT1 ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; ; T SPEC COMES HERE ; TSPEC: TST INTSW(R5) ;NO PRECEEDING NUM ALLOWED BEQ TSPEC1 TSPECX: JMP BADSYN TSPEC1: JSR PC,SCAN ;GET TAB POSITION AND NEXT SPEC T .TITLE $GET $VERSN 03 ; ; ;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. ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; GETTING AN ITEM FROM AN ADDRESS ; SPECIFIED IN R0 (THE STACK IS THE OTHER OPERAND). ; ; GET - ONE, TWO, OR FOUR WORDS ; .GLOBL $GET5,$GET4,$GET3,$GET2,$GET1 $GET5: $GET4: MOV 6(R0),-(SP) ;FNG OP CODE ERROR .BYTE 3,25.; 4 FLOATING DIVIDE BY 0 .BYTE 3,22.; 6 FLT/INT CONVERSION ERROR .BYTE 3,24.; 8 FLOATING OVERFLOW .BYTE 5,9.; 10 FLOATING UNDERFLOW .BYTE 7,3; 12 FLOATING UDEFINED VARIABLE .BYTE 0,3; 14 MAINTENANCE TRAP .ENDC ; ; FLOATING POINT INTERRUPT HANDLER FOR 11/40 FIS ; .IFDF FIS .GLOBL $FPERR,$ERRA .IFDF RSX11D STATUS=2 .ENDC .IFNDF RSX11D STATUS=4 .ENDC $FPERR: MOV R0,-(SP) ;SAVE R0 MOV #3+<25.*256.>,R0 ;MESSAGE 3.25. BIT #1,STATUS(SP) ;DIVIST INT(R5) ;MUST BE NON-ZERO POSITIVE TAB BLE TSPECZ ;ELSE-ERROR DEC INT(R5) ADD RECADR(R4),INT(R5) CMP RECPTR(R4),TSPECO(R5) ;SET PTR TO HIGHEST POS REF BLOS TSPEC3 MOV RECPTR(R4),TSPECO(R5) TSPEC3: MOV INT(R5),RECPTR(R4) ;READJUST RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK IF IN BOUNDS OF BUFFER BLO TSPEC2 ;BRANCH IF IN BOUNDS TSPECZ: JMP BADTAB ;ERROR - SPEC OUTSIDE RECORD TSPEC2: CLR INT(R5) ;RESET ACCUMULATOR AND STATUS CLR INTSW(R5) JMP FCONT ;ALLOW T / , ) ' SPECOUR WORD CASE MOV 4(R0),-(SP) ; $GET3: MOV 2(R0),-(SP) ;TWO WORD CASE $GET2: $GET1: MOV @R0,-(SP) ;SINGLE WORD CASE JMP @(R4)+ ; .END .TITLE $GLE $VERSN 02 ; ; ;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. .GLOBL $LE,$LT,$EQ,$GT,$GE,$NE .CSECT ; ; PERFORMS TESTS FOR LOGICAL OPERATORS - .LE., .LT., .EQ., ; .GT., .GE., .NE. AND RETURNS A VALUE OF .TRUE. OR ; .FALSE. ON THE STACK. ; ; ASSUMES CONDITION CODES 'N' & 'Z' PROPERLY SET BY $CMI, ; $CMR, $CMD ETC. ; R4=%4 SP=%6 ; DE BY ZERO? BNE OUT ;YES MOV #5.+<9.*256.>,R0 ;MESSAGE 5,9. BIT #10,STATUS(SP) ;UNDERFLOW? BNE OUT ;YES MOV #3+<24.*256.>,R0 ;ELSE OVERFLOW OUT: JSR PC,$ERRA MOV (SP)+,R0 ;RESTORE R0 .IFDF RSX11D TST (SP)+ ;REMOVE STATUS .ENDC MOV @SP,4(SP) ;MOV PC,PS UP MOV 2(SP),6(SP) ;OVERWRITING B ARG CLR 8.(SP) ;DEFUALT VALUE 0.0 CLR 10.(SP) CMP (SP)+,(SP)+ ;POSITION SP FOR RTI ;EXIT .ENDC ;DF FIS .END S TO FOLLOW ; ; ; ; ; X SPEC COMES HERE ; XSPEC: TST INTSW(R5) ;EITHER THERE MUST BE NO PRECEED BEQ XSPEC1 ;ING NUM OR IT MUST BE POSITIVE BGT XSPEC2 ;NONZERO XSPECX: JMP BADSYN ;ELSE-ERROR XSPEC1: INC INT(R5) ;IF ABSENT SET TO 1 XSPEC2: TST INT(R5) BEQ XSPECX ;IF ZERO - ERROR ADD INT(R5),RECPTR(R4) ;SET NEW RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK IF IN BOUNDS OF BUFFER BLOS XSPEC3 JMP BADTAB ;ELSE ERROR XSPEC3: JSR PC,SCAN ;GET NEXT NUM AND SPEC JMP FCONT1 ; $LE - TRUE IF Z=1 OR N=1 ; $LE: BEQ TRUE ;SET TRUE IF = OR ; ; $TRUE - TRUE IF N=1 ; $LT: BLT TRUE ;SET TRUE IF <, ELSE ; FALSE: CLR -(SP) ;SET STACK TO FALSE JMP @(R4)+ ;AND RETURN ; ; $EQ - TRUE IF Z=1 ; $EQ: BNE FALSE ;SET FALSE IF <>, ELSE ; TRUE: MOV #-1,-(SP) ;SET STACK TO TRUE JMP @(R4)+ ;AND RETURN ; ; $GT - TRUE IF Z=0 AND N=0 ; $GT: BGT TRUE ;SET FALSE IF = OR BR FALSE ; ; $GE - TRUE IF Z=1 OR N=0 ; $GE: BGE TRUE ;SET FALSE IF < BR FALSE ;ELSE SET TRUE ; ; $NE ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; H SPEC COMES HERE ; HSPEC: TST INT(R5) ;COUNT MUST BE PRESENT AND BGT HSPEC1 ;GREATER THAN 0 JMP BADSYN ;ELSE - ERROR ; HSPEC1: MOV RECPTR(R4),R0 ;SET UP TO DO MOVE MOV FMTPTR(R5),R1 MOV INT(R5),R2 ADD R2,RECPTR(R4) ;RESET RECORD PTR CMP RECPTR(R4),RECEND(R4) ;CHECK IF RECORD OVERFLOW BLOS HSPEC2 JMP BADTAB HSPEC2: INC R1 ;GET NEXT FMT POSITN TST IOSW(R4) ;MOVE TO OR FROM RECORD DEPEND- BEQ HSPEC3 ;ING ON IOSW MOVB (R0)+,(R1) .TITLE $IAB $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL IABS,$ERRA ; THE FORTRAN IABS FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS THE ABSOLUTE VALUE OF THE ; ARGUMENT IN R0. ; R0=%0 R5=%5 IABS: MOV @2(R5),R0 ;GET ARG BGE RTN ;JUMP IF + NEG R0 ;MAKE IT + BVS ERROR ;JUMP IF NE - TRUE IF Z=0 ; $NE: BNE TRUE ;SET TRUE IF <> BR FALSE ;ELSE SET FALSE ; .END .TITLE $IBF $VERSN 02 ; ; ; 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. ; .GLOBL $IOBUF .CSECT ; ;THIS IS THE FORTRAN I/O BUFFER WITH ASSOCIATED LINK BLOCK, ;FILE BLOCK AND BUFFER HEADER WHICH IS USED FOR ALL FORTRAN I/O. ; BFLKER: .WORD 0 ;ERROR RETURN ADDR - LINK BLOCK $IOBUF: .WORD 0 ;LINK PTR BFLP=$IOBUF BFLDSN: .WORD 0 ;LOG DATASET NAM;MOVE FROM RECORD BR HSPEC4 HSPEC3: MOVB (R1),(R0)+ ;MOVE TO RECORD HSPEC4: DEC R2 ;CHECK IF DONE BNE HSPEC2 ;IF NOT GO GET NEXT CHAR MOV R1,FMTPTR(R5) ;ELSE - SAVE NEW FMT PTR JSR PC,SCAN ;GET NEXT NUM AND SPEC JMP FCONT1 ;ALLOW ALL SPECS TO FOLLOW ; ; ; /COMES HERE ; SLASH: TST INTSW(R5) ;NO PRECEEDING NUM ALLOWED BEQ SLASH1 JMP BADSYN SLASH1: CMP RECPTR(R4),TSPECO(R5) ;SET HIGHEST POS REF IN REC BHIS SLASH3 MOV TSPECO(R5),RECPTR(R4) CLR TSPECO(R5) SLASH3: JSR PC,GMAX RTN: .F4RTN ERROR: MOV #3404,R0 ;ERROR 4,7 JSR PC,$ERRA BR RTN .END E .BYTE 1 ;DEV NAME PRESENT VALUE BFUNUM: .BYTE 0 ;UNIT NUM BFPDVN: .WORD 0 ;PHYSICAL DEVICE NAME BFFLER: .WORD 0 ;ERROR RETURN ADDR - FILE BLOCK BFHOPN: .BYTE 0 ;HOW OPEN FLAG BFERCD: .BYTE 0 ;ERROR RETURN CODE BFFLNM: .WORD 0 ;FILE NAME .WORD 0 .WORD 0 ;EXTENSION NAME BFUIC: .WORD 0 ;UIC BFPC: .BYTE 0 ;PROTECT CODE .BYTE 0 ;SPARE BFMCNT: .WORD 136. ;MAXIMUM BYTE COUNT - BUFF HEADER BFMODE: .BYTE 0 ;I/O MODE BFSTAT: .BYTE 0 ;I/O STATUS BFACNT: .WORD 0 ;ACTUAL BYTE COUNT@IOTADR(R4) ;GO TO $INFR OR $OUTFW TO RD/WT ; SLASH2: JSR PC,SCAN ;GET NUM AND NEXT SPEC JMP FCONT1 ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; ; ' COMES HERE ; QUOTE: TST INTSW(R5) ;NO PRECEEDING NUM ALLOWED BEQ QUOTE1 JMP BADSYN QUOTE1: MOV RECPTR(R4),R0 ;SET UP TO DO MOVE MOV FMTPTR(R5),R1 ; QUOTE2: INC R1 ;STEP TO NEXT FORMAT POSITION CMPB #'',(R1) ;CHECK IF ' BEQ QUOTE6 ;IF SO GO CHECK IF PAIRED OR END QUOTE3: CMP R0,RECEND(R4) ;CHECK IF RECORD BUFF OVERFLOW BLO QUOTE4 .TITLE $ICI $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL $ICI,$OCI ; $OCI ASCII TO OCTAL CONVERSION ; $ICI ASCII TO INTEGER CONVERSION ; CALLING SEQUENCE: ; PUSH CHARACTER FIELD START ; PUSH CHARACTER FIELD LENGTH ; JSR PC,$ICI OR $OCI ; RETURNS WITH INTEGER RESULT ON TOP OF STACK. R0=%0 R1=%1 R2=%2 SP=%6 BFPTR=. ;BUFFER .=.+136. ; ; ; .END ;BRANCH IF NOT JMP BADTAB QUOTE4: TST IOSW(R4) ;MOVE TO OR FROM RECORD BUFFER BEQ QUOTE5 ;DEPENDING ON IOSW MOVB (R0)+,(R1) ;MOVE FROM RECORD BUFFER (INPUT) BR QUOTE2 ;GO GET NEXT FMT CHAR QUOTE5: MOVB (R1),(R0)+ ;MOVE TO RECORD BUFFER (OUTPUT) BR QUOTE2 ;GO GET NEXT FMT CHAR QUOTE6: CMPB #'',1(R1) BNE QUOTEX ;BRANCH IF END QUOTE TST IOSW(R4) ;ELSE - CHECK IF INPUT OR OUTPUT BNE QUOTE7 INC R1 ;IF OUTPUT, PUT OUT ONLY 1 QUOTE BR QUOTE3 QUOTE7: CLRB 1(R1) ;IF INPUT, R .TITLE $ICO $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL $ICO,$OCO ; $OCO OCTAL TO ASCII CONVERSION ; $ICO INTEGER TO ASCII CONVERSION ; CALLING SEQUENCE: ; PUSH FIELD START LOCATION ; PUSH FIELD LENGTH ; PUSH VALUE ; JSR PC,$ICO (OR $OCO) ; ERROR WILL RETURN WITH C BIT SET ON ; R0, R1, R2, R3 ARE DESTROYED R0 PC=%7 $OCI: MOV #67,-(SP) ;SET OCTAL FLAGS BR GO $ICI: MOV #471,-(SP) ;SET DECIMAL FLAGS GO: MOV R1,-(SP) ;SAVE R1 MOV 8.(SP),R1 ;GET STRING START ADD 6(SP),8.(SP) ;GET END+1 MOV 4(SP),6(SP) ;FIDDLE RETURN POINTER MOV R0,4(SP) ;SAVE R0 MOV R2,-(SP) ;SAVE R2 CLR -(SP) ;CLEAR SIGN CLR R0 ;CLEAR WORK SPACE START: MOVB (R1)+,R2 ;GET NEXT CHAR. BIC #177600,R2 CMPB R2,#' BNE SIGNS ;JUMP IF NOT BLANK CMP R1,12.(SP) BLT START ;JUMP IF MORE TO SCAN BR SIGN ;DONE SIGNS: TSTB 7(SEAD INTO BOTH QUOTES BR QUOTE3 ; QUOTEX: MOV R1,FMTPTR(R5) ;SET NEW FMT AND RECORD PTRS MOV R0,RECPTR(R4) JSR PC,SCAN ;GET NEXT NUM AND SPEC JMP FCONT1 ;ALLOW ANY SPEC TO FOLLOW ; ; ; ; ; ( COMES HERE ; LPARN: TST INTSW(R5) ;IF PRECEEDING NUM IS PRESENT BEQ LPARN1 ;IT MUST BE POSITIVE NON-ZERO BGT LPARN2 LPARNX: JMP BADSYN LPARN1: INC INT(R5) ;IF ABSENT SET TO 1 LPARN2: TST INT(R5) BEQ LPARNX ; TST NEST(R5) ;CHECK IF THIS FIRST CALL BEQ LPARNS ;BRANCH IF SO CM=%0 R1=%1 R2=%2 R3=%3 R4=%4 SP=%6 PC=%7 $OCO: MOV #OCT-REL,R0 ;POINT TO OCTAL TABLE BR GO $ICO: MOV #DEC-REL,R0 ;POINT TO DECIMAL TABLE GO: MOV R4,-(SP) MOV 8.(SP),R3 ;GET FIELD START MOV 6.(SP),R2 ;GET FIELD LENGTH BGE LPOS ;JUMP IF LENGTH NOT NEG CLR R2 CLR 6(SP) LPOS: MOV 4.(SP),R4 ;GET VALUE TO BE CONVERTED MOV #' ,-(SP) ;CLEAR SIGN CMP R0,#OCT-REL ;CHECK IF DOING OCTAL BEQ POS ;YES, GIVE MAGNITUDE RESULT TST R4 BGE POS ;JUMP IF + NEG R4 ;GET ABSOLUTE VALUE MOP); IF OCTAL CONVERSION BNE SIGNS1; DO NOT PERMIT SIGNS INC @SP; OCTAL - FAKE THE SIGN BIT BR NUMCK; GO PROCESS THE DIGIT SIGNS1: CMPB R2,#'+; BEQ FIELD ;JUMP IF + CMPB R2,#'- BNE NUMCK ;JUMP IF NOT - INC @SP ;SET SIGN - BR FIELD NEXT: MOVB (R1)+,R2 ;GET NEXT CHAR. BIC #177600,R2 CMPB R2,#' BNE NUMCK ;JUMP IF NOT BLANK MOVB #60,R2 ;BLANK =ZERO NUMCK: CMPB R2,#'0 BLT ERROR ;JUMP IF TOO SMALL CMPB R2,6(SP) BGT ERROR ;JUMP IF TOO BIG SUB #60,R2 ;MAKE NUMERIC TSTB 7(S .TITLE $IDM $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL IDIM,$ERRA ; THE FORTRAN IDIM FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (2 ARGS) ; ; RETURNS ARG1-ARG2 IN R0 IF ARG1>ARG2 ; RETURNS 0 OTHERWISE. ; R0=%0 R5=%5 IDIM: MOV @2(R5),R0 ;GET ARG1 SUB @4(R5),R0 ;GET ARG1-ARG2 BVS OVER ;JUMP IF OVERP #2,NEST(R5) ;CHECK WHICH IS CURRENT LEVEL BHI LPARNH ;HIGHEST LEVEL - BRANCH BEQ LPARNL ;LOWEST LEVEL - BRANCH MOV #258.,R0 ;ERROR - NESTING TOO DEEP JMP FIOERR ;CLASS=2/NUM=1 ; LPARNH: MOV FMTPTR(R5),NPRN1(R5) ;SAVE FMT LOCN WHERE NEST STARTS MOV INT(R5),GRPCTI(R5) ;SAVE HIGHEST LEVEL GROUP REP LPARNS: INC EXITSW(R5) ;SET NO CONVERTS DONE SWITCH LPARN3: MOV INT(R5),GRPCT(R5) ;SET CURRENT GROUP REP COUNT INC NEST(R5) ;SET NEW NESTING LEVEL JSR PC,SCAN ;GET NEXT NUM AND SPEC V #'-,@SP ;SAVE - POS: CLR -(SP) ;SET FENCE ADD PC,R0 REL=. TST: TST @R0 BEQ MOV ;JUMP IF ALL POWERS DONE CLR R1 SUB: SUB @R0,R4 ;SEE IF CURRENT POWER WILL GO AGAIN BLO BACK INC R1 ;BUMP DIGIT BR SUB BACK: ADD (R0)+,R4 ;TOO MUCH, BACK UP TST R1 BNE NZERO ;JUMP IF DIGIT NOT 0 TST @SP BEQ TST ;JUMP IF NO NON-ZERO DIGITS YET NZERO: ADD #60,R1 ;CONVERT TO ASCII MOV R1,-(SP) BR TST MOV: ADD R2,R3 ;POINT TO FIELD END ADD #60,R4 ;CONVERT LEAST SIGNIFICANT DIGIT MOVB R4,-(R3) DP) ;OCTAL OR BINARY BEQ OCTAL ASL R0 ;R0=BASE*R0+R2 BVS ERROR SUB R0,R2 ASL R0 BVS ERROR ASL R0 BVS ERROR SUB R2,R0 BVS ERROR FIELD: CMP R1,12.(SP) BLT NEXT ;JUMP IF MORE FIELD TO SCAN SIGN: ROR (SP)+ ;TEST SIGN BCS DONE ;JUMP IF - NEG R0 ;MAKE + BVS NEGM ;JUMP IF -NEGMAX CLC ;SET SUCCESS FLAG DONE: MOV (SP)+,R2 ;RESTORE R2 MOV (SP)+,R1 ;RESTORE R1 ROL (SP)+ ;FLUSH FLAG AND SET C BIT IF ERROR MOV R0,4(SP) ;RETURN RESULT MOV (SP)+,R0 RTS PC ERROR: TST (SP)+ ;FLUSFLOW BGE RTN ;JUMP IF DONE CLR R0 ;RETURN 0 RTN: .F4RTN OVER: MOV #4004,R0 ;ERROR 4,8. JSR PC,$ERRA BR RTN .END JMP FCONT5 ;ALLOW ANY SPECS BUT , ; LPARNL: MOV FMTPTR(R5),NPRN2(R5) ;SAVE FMT LOCN WHERE NEST STARTS MOV GRPCT(R5),GRPCTS(R5) ;SAVE UNEXHAUSTED HIGHER REP CNT BR LPARN3 ;GO SET NEST AND CURRENT REP CNT ; ; ; ; ; ) COMES HERE ; RPARN: TST INTSW(R5) ;NO NUMBER MAY PRECEED BEQ RPARN1 JMP BADSYN RPARN1: CMP #2,NEST(R5) ;BRANCH ON NESTING LEVEL BHI RPARNI ;NO NESTING - BRANCH BEQ RPARNH ;HIGH NESTING ONLY DEC GRPCT(R5) ;CHECK IF GROUP REP EXHAUSTED BEQ RPARNL ;BRANCH IF ECR: DEC R2 BLE FULL ;JUMP IF COUNT EXHAUSTED MOVB (SP)+,-(R3) ;MOVE DIGIT BNE DECR ;JUMP IF NOT THE FENCE MOVB (SP)+,@R3 ;MOVE OUT THE SIGN FILL: DEC R2 BEQ DONE ;JUMP IF FIELD FILLED MOVB #' ,-(R3) ;MOVE IN LEADING BLANKS BR FILL FULL: TST (SP)+ BNE ERROR ;NUMBER TOO BIG FOR FIELD CMP #' ,(SP)+ BNE STARS-4. ;JUMP IF NO ROOM FOR - DONE: MOV (SP)+,R4 MOV (SP)+,4(SP) ;MOVE RETURN UP TST (SP)+ ;FLUSH VALUE ROL (SP)+ ;FLUSH FLAG AND SET C BIT ON IF ERROR RTS PC ERROR: TST (SP)H SIGN NEGM: CLR R0 COM 4(SP) ;SET ERROR FLAG BR DONE ; OCTAL: ROL R0; SHIFT 3 BITS LEFT, BCS ERROR; CHECKING AS YOU GO ROL R0; BCS ERROR; ROL R0; BCS ERROR; ADD R2,R0; ADD IN THE DIGIT BR FIELD; DO NEXT .END SO TO POP A LEVEL MOV NPRN2(R5),FMTPTR(R5) ;ELSE - REPEAT GROUP RPARN2: JSR PC,SCAN ;GET NEXT NUM AND SPEC JMP FCONT1 ;ALLOW ANY TO FOLLOW RPARNL: MOV GRPCTS(R5),GRPCT(R5) ;RESET PREVIOUS REP REMAINING RPARN3: DEC NEST(R5) ;POP A LEVEL BR RPARN2 ;GO CONTINUE SCAN RPARNH: DEC GRPCT(R5) ;CHECK IF GROUP REP EXHAUSTED BEQ RPARN3 ;BRANCH IF SO TO POP A LEVEL MOV NPRN1(R5),FMTPTR(R5) ;ELSE - REPEAT GROUP BR RPARN2 ; RPARNI: TST ARGPTR(R4) ;OUTERMOST , COMES HERE BNE RPARN5 ;BRAN+ BNE ERROR TST (SP)+ ;FLUSH SIGN MOV 8.(SP),R3 STARS: MOVB #'*,(R3)+ ;FILL FIELD WITH * DEC 6(SP) BGT STARS ;JUMP IF MORE TO DO COM 6(SP) ;FLAG ERROR BR DONE DEC: .WORD 10000.,1000.,100.,10.,0 OCT: .WORD 100000,10000,1000,100,10,0 .END .TITLE $IED $VERSN 02 ; ; ;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. ; 1972, USED BY PERMISSION OF ; DEPARTMENT OF OCEANOGRAPHY ; UNIVERSITY OF WASHINGTON, SEATTLE, WASHINGTON ; .GLOBL $DECD,$ENCD .GLOBL $FIO,$INDE,$OUTEN .CSECT ; ; THIS ROUTINE IS CALLED TO INITIALIZE ENCODE/DECODE ; ; CALLED IN POLISH MODE ; CALLING SEQUENCE ; ; PUSH ADDCH IF MORE IO LIST ITEMS ENDUPX: TST IOSW(R4) ;WRITE OUT LAST RECORD IF OUTPUT BNE RPARN4 CMP RECPTR(R4),TSPECO(R5) BHIS ENDUPY MOV TSPECO(R5),RECPTR(R4) CLR TSPECO(R5) ENDUPY: JSR PC,@IOTADR(R4) ;GO TO $OUTFW RPARN4: JMP ENDUP ;GO TO EXIT RPARN5: TST EXITSW(R5) ;CHECK IF FMT WILL CVT REMAINING BEQ RPARN6 ;IO LIST ITEMS - BRANCH IF SO MOV #2,R0 ;ELSE - FORMAT ERROR JMP FIOERR ;CLASS=2/NUM=0 RPARN6: CMP RECPTR(R4),TSPECO(R5) BHIS RPARNX MOV TSPECO(R5),RECPTR(R4) CLR TS .TITLE $IFI $VERSN 02 ; ; ; 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. ; .GLOBL $INFI,$OUTFI .GLOBL $FIO,$INFR,$OUTFW .CSECT ; ; THIS ROUTINE IS CALLED TO INITIALIZE FORMATTED I/O ; ; CALLING SEQUENCE ; ; PUSH ADDR OF UNIT NUM ; PUSH ADDR OF FORMAT STMT ; JMP ($INFI,$OUTFI) ; ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SPR OF BFFR SIZ ; PUSH ADDR OF FORMAT STMT ; PUSH ADDR OF BUFFER ; JMP ($ENCD,$DECD) ; .WORD END= ADDRESS ; .WORD ERR= ADDRESS ; ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; ; ; ; ; $DECD: MOV #1.,-(SP) ;SET IOSW FOR INPUT BR IOFI $ENCD: CLR -(SP) ;SET IOSW FOR OUTPUT IOFI: CLR -(SP) MOV #$INDE,-(SP) ;SET IOTADR TST IOSW-IOTADR-2(SP) BNE IOFI1 MOV #$OUTEN,(SP) .GLOBL $IOFI1 IOFI1: JSR PC,$IOFI1 ;ALLOCATE IOPSTK MOV IOSW(R4),RECADR(R4)PECO(R5) RPARNX: JSR PC,@IOTADR(R4) ;GO TO READ NEXT OR WRITE LAST RPARN7: TST NPRN1(R5) ;CHECK IF WAS EVER NESTED BNE RPARN8 ;BRANCH IF WAS MOV FMTADR(R4),FMTPTR(R5) ;REPEAT ENTIRE FMT RPARN9: INC EXITSW(R5) ;RESET NON-CONVERT SWITCH BR RPARN2 ;GO CONTINUE SCAN RPARN8: MOV GRPCTI(R5),GRPCT(R5) ;RESET NEXTING ORIGINAL GROUP CT MOV NPRN1(R5),FMTPTR(R5) ;SET UP STARTING LOCN INC NEST(R5) ;NEST A LEVEL BR RPARN9 ;GO SCAN ; ; COME HERE TO EXIT AT NORMAL END OF FMT SCAN ; ENDUP: R .TITLE $INR $VERSN 03 ; ; ; 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 $INR, $OUTW, $OPEN, $CLOSE, $READ, $WRITE .GLOBL $FNDEV,$IOSET,$IOERR .GLOBL $AIOB .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE CONTROLS UNFORMATTED I/O ; $INR: $OUTW: MOV @UNITAD(R4),R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET  = %6 PC = %7 ; ; ; ; ; ; $INFI: MOV #1.,-(SP) ;SET IOSW FOR INPUT BR IOFI $OUTFI: CLR -(SP) ;SET IOSW FOR OUTPUT IOFI: MOV #$FIO,-(SP) ;SET IOADDR=$FIO CLR -(SP) ;SET IOTSW=0=FMTD I/O MOV #$INFR,-(SP) ;SET IOTADR=$INFR=INPUT TST IOSW-IOTADR(SP) ;CHECK IF INPUT BNE IOFI1 ;BRANCH IF INPUT MOV #$OUTFW,(SP) ;ELSE SET IOADR=$OUTFR=OUTPUT .GLOBL $IOFI1 IOFI1: JSR PC,$IOFI1 ;ALLOCATE IOPSTK ; MOV #IOFSTK,R5 ;NOW ALLOCATE I/O SPECIFIC STACK ASR R5 ;IOFSTK IOFI2: CLR -(SP)  ;MOV ADDR OF BFFR TO RECADDR MOV IOADDR(R4),IOSW(R4) ;SET IOSW MOV #$FIO,IOADDR(R4) ;IOFSTK IS NOW PROPERLY SET ; MOV #IOFSTK,R5 ;NOW ALLOCATE I/O SPECIFIC STACK ASR R5 ;IOFSTK IOFI2: CLR -(SP) ;CLEAR IOFSTK DEC R5 BNE IOFI2 MOV SP,R5 ;SET R5 TO POINT TO IOFSTK ; MOV #IOFSTK+2.,-(SP) ;PUSH SIZE OF IOFSTK+2 ONTO STK ; .GLOBL $IOFI3 JMP $IOFI3 ;GO INITIALIZE I/O ;AND RETURN TO MAIN IN ;EXPECTATION OF ARG AND ;END CALLS ; .END TS PC ;EXIT TO CALLING ROUTINE ; ; COME HERE TO CALL ERROR AND SET FLAG TO ; FLUSH I/O LIST IF ERROR RETURNS ; FIOERR: JSR PC,$ERRA ;CALL ERROR INC ERRFLG(R4) ;IF ERR RET'S SET FLAG RTS PC ;AND GO FLUSH I/O LIST BADTAB: MOV #770.,R0 ;REF OUTSIDE RECORD BOUNDARIES BR FIOERR ;CLASS=2/NUM=3 BADSYN: MOV #514.,R0 ;SYNTAX ERROR BR FIOERR ;CLASS=2/NUM=2 ; ; D SPEC COMES HERE ; DSPEC: MOV #25.,-(SP) ;DEFAULT WIDTH MOV #16.,-(SP) ;DEFAULT DECIMALSCALE CLR -(SP) ;CONVERSION TYPETABLE ENTRY INTO R1 TST R1 BEQ BADEV ;BRANCH IF BAD DEVICE NUM ; JSR PC,$AIOB ;GET ADDR IOBUF IN R2 ; ; CHECK IF FIRST CALL ; TST RECADR(R4) BNE INRS ;BRANCH IF NOT INIT CALL ; BITB #3,DVSW(R1) ;CHECK IF DEVICE OPEN BNE INR2 ;BRANCH IF SO ; INR1: JSR PC,$IOSET ;SET UP TO OPEN ; JSR PC,$OPEN ;OPEN TST R3 BNE BADOPN ;BRANCH IF ERRORS ; ; CHECK COMPATABLE DEVICE STATUS ; INR2: BITB #1,DVSW(R1) ;CHECK IF COMPATABLE FILE BNE COMPER ;ERROR IF NOT ; CMPB #4,DVHOPN(R1) ;C ;CLEAR IOFSTK DEC R5 BNE IOFI2 MOV SP,R5 ;SET R5 TO POINT TO IOFSTK ; MOV #IOFSTK+2.,-(SP) ;PUSH SIZE OF IOFSTK+2 ONTO STK ; .GLOBL $IOFI3 JMP $IOFI3 ;GO INITIALIZE I/O ;AND RETURN TO MAIN IN ;EXPECTATION OF ARG AND ;END CALLS ; .END  EFGSP: MOV #1,R2 ;PROCESSING FLAG BR COMCON ; ; E, F, G SPEC S COME HERE ; ESPEC: FSPEC: GSPEC: MOV #15.,-(SP) MOV #7.,-(SP) MOV #-1,-(SP) BR EFGSP ; ; I, O SPECS COME HERE ; ISPEC: OSPEC: MOV #7.,-(SP) CLR -(SP) ;IGNORE DECIMAL FIELD PART MOV #1,-(SP) AILOSP: CLR R2 BR COMCON ; ; A SPEC COMES HERE ; ASPEC: MOV #8.,-(SP) CLR -(SP) MOV #2,-(SP) BR AILOSP ; ; L SPEC COMES HERE ; LSPEC: MOV #2.,-(SP) CLR -(SP) MOV #3,-(SP) BR AILOSP ; ; ; ALL OF HECK IF OPENED FOR INPUT BNE INR4 ;BRANCH IF NOT TST IOSW(R4) ;CHECK IF WRITE STMT BNE INR5 ;BRANCH IF NOT ; ; INR3: MOV DVLP(R1),BFLP(R2) ;CLOSE FILE JSR PC,$CLOSE TST R3 BNE INRERR ;CHECK ERRORS BR INR1 ;GO REOPEN ; INR4: TST IOSW(R4) ;CHECK IF WRITE STMT BNE INR3 ;BRANCH IF NOT ; INR7: MOV #124.,R0 ;LENGTH OF DATA AREA MOV R2,R3 ADD #BFPTR,R3 ;ADDR OF BUFFER MOV IOSTAT(R5),(R3)+;SET CONTROL WORD INR6: MOV R3,RECADR(R4) ;SET BUFF PTR MOV R3,RECPTR(R4) ;SET BUFF END+1  .TITLE $INT $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL INT,IDINT,$RI,$POLSH ; THE FORTRAN INT AND IDINT FUNCTIONS. ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS INTEGER EQUIVALENT IN R0. ; USES $RI. ; R0=%0 R4=%4 R5=%5 SP=%6 INT: IDINT: MOV 2(R5),R4 ;GET ARGUMENT ADDRESS MOV 2(R4),-(S A D E F G I L O CONVERGE HERE ; COMCON: MOV (SP)+,CVTSW(R5) ;CONVERSION SWITCH MOV (SP)+,DSCALE(R5) ;DECIMAL SCALE MOV (SP)+,FWIDTH(R5) ;FIELD WIDTH TST IOSW(R4) BEQ COM1 ADD #20,R1 COM1: SUB #14,R1 MOV CONTAB(R1),CVTRTN(R5) ; TST INTSW(R5) ;IF NUM PRECEEDS IT MUST BE BEQ CONV1 ;GREATER THAN ZERO BGT CONV2 ;ELSE IS ERROR CONVX: JMP BADSYN CONV1: INC INT(R5) CONV2: MOV INT(R5),REPCNT(R5) ;SAVE REP COUNT BEQ CONVX ; JSR PC,SCAN ;GET FIELD WIDTH TST INTSW(R5) ;IS FIELD  ADD R0,R3 MOV R3,RECEND(R4) ;SET BUFF END+1 RTS PC ;RETURN ; ; INR5: MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET BUFF LEN ; JSR PC,$READ ;READ TST R3 ;CHECK IF ERRORS BNE INRERR ADD #BFACNT,R2 ;ADBR BYTE COUNT MOV (R2)+,R0 ;PUT COUNT IN R0, ADDR CONTROL WORD BIT #2,(R2) BEQ INR5A INC DVRCNT(R1) ;INC RECORD COUNT IF LAST SEG INR5A: MOV (R2)+,IOSTAT(R5);SET CONTROL WORD, ADD N DATA DEC R0 ;ADJUST COUNT BY LEN CNTRL WRD DEC R0 MOV R2,R3 BR INR6 ;GO .TITLE $IOC $VERSN 01 ; ; ; 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. ; ; $IOC - MISCELLANEOUS COMMON SUBROUTINES USED BY I/O ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL $IOFI1,$IOFI3 .CSECT ; ALLOCATE I/O PROCESSOR GERERAL STACK TABLE (IOPSTK) $IOFI1: CLR -(SP) ;CLEAR RECPTR,RECEND, CLR -(SP) ;ARGPTR,ARGTYP,P) ;PUSH LOW ORDER REAL PART MOV @R4,-(SP) ;HIGH ORDER JSR R4,$POLSH ;CALL $RI TO CONVERT TO .WORD $RI,UNPOL ;INTEGER UNPOL: MOV (SP)+,R0 ;POP INTEGER RESULT .F4RTN .END VALUE PRESENT? BLT CONVX ;NEGATIVE IS N.G. BEQ AILO ;NOT PRESENT MEANS DEFAULTS APPLY MOV INT(R5),FWIDTH(R5) ;SAVE FIELD WIDTH BEQ CONVX ; TST R2 ;IF A,I,L,O, SPEC DO NOT GET BEQ AILO ;DECIMAL FIELD CMP #'.,SCNKAR(R5) ;IF NOT . - SYNTAX ERROR BNE CONVX JSR PC,SCAN ;GET DECIMAL SPEC TST INTSW(R5) ;IT MUST BE PRESENT AND NOT BLE CONVX ;NEGATIVE MOV INT(R5),DSCALE(R5) ;SAVE DECIMAL SPEC ; AILO: JMP FMT ;GO DO I/O FOR SPEC AND CONTINUE ; ; ADDRESS TABLE OF CONVERSIO CLEANUP AND RETURN ; ; INRS: TST IOSW(R4) ;NON-FIRST CALL COMES HERE BNE INR5 ;BRANCH IF READ ; MOV DVLP(R1),BFLP(R2) ;SET LINK PTR MOV #BFLEN,BFMCNT(R2) ;SET BUFF LEN MOV IOSTAT(R5),BFPTR(R2) ;PUT IN CONTROL WORD SUB RECADR(R4),RECPTR(R4) MOV RECPTR(R4),BFACNT(R2) ;SET DATA LENGTH INC BFACNT(R2) ;PLUS CNTRL WD LEN INC BFACNT(R2) JSR PC,$WRITE ;WRITE RECORD TST R3 BNE INRERR ;BRANCH IF ERRORS ; BIT #2,IOSTAT(R5) ;INC RECORD COUNT IF LAST SEGMENT BEQ INR7 INC DVRCNT(R1) ARGLGN CLR -(SP) CLR -(SP) CLR -(SP) MOV R4,-(SP) ;SAVE PTR TO END=ERR= ADDRS CLR -(SP) ;CLEAR ERRFLG MOV R0,-(SP) ;SAVE REGISTERS 0-5 MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) MOV SP,R4 ;SET R4 TO POINT OF IOPSTK MOV 32(SP),-(SP) ;GET THE RETURN ADDR CLR 34(SP) ;CLEAR RECADR RTS PC ; INITIALIZE I/O AND RETURN TO MAIN $IOFI3: JSR PC,@IOTADR(R4) ;INITIALIZE I/O MOV R4,R0 MOV (R0)+,R5 ;RESTORE REGISTERS 0-5 MOV (R0)+,R4 MOV (R0)+,R3 MOVN ROUTINES ; CONTAB: .WORD $ACO,$DCO,$ECO,$FCO,$GCO .WORD $ICO,$LCO,$OCO .WORD $ACI,$DCI,$RCI,$RCI,$RCI .WORD $ICI,$LCI,$OCI ; ; ;; ; ; COME HERE TO SET UP AND CALL ROUTINES WHICH DO ACTUAL I/O CVTS ; FMT: TST ARGPTR(R4) ;IF ITEM LIST NOT EXHAUSTED BNE FMT1 ;GO PROCESS NEXT ITEM JMP ENDUPX ;ELSE - GO END LAST REC AND EXIT FMT1: MOV RECPTR(R4),-(SP) ;PUSH RECORD LOC ; ; SHORT FIELD TERMINATION IS HANDLED HERE ; TST IOSW(R4) ;APPLIES ONLY TO INPUT BEQ FMT1X ;IS OUTPUT BR INR7 ;GO CLEAN UPAND RETURN ; ; BADEV: MOV #14,R3 ;SET R3 TO BAD DEVICE INRERR: JMP $IOERR ;GO PROCESS THE ERROR BADOPN: TST R3 ;CHK FOR NO SPACE ERR BLT INRERR ;BR IF PRESENT ADD #3,R3 ;OTHERWISE SET R3 TO PROPER NUM BR INRERR COMPER: MOV #13,R3 ;SET R3 TO COMPATABILITY ERR BR INRERR ; ; .END  (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 CMP (R4)+,(R4)+ ;SPACE OVER END=ERR= ADDRS JMP @(R4)+ .END  .TITLE $IOF $VERSN 06 ; ; ; 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 $IOF,$IOFX,$IOERR .GLOBL $ERRA,$EXIT,$SERR .CSECT ; ; THIS ROUTINE IS CALLED AT THE END OF I/O LIST PROCESSING FOR ; FORMATTED,UNFORMATTED AND RANDOM I/O ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; $IOF: ;REFERENCE LABEL  MOV @SP,R0 ;RECPTR CLR R1 ;# VALID CHARS CMP #2,CVTSW(R5) ;A FORMAT IS SPECIAL BEQ FMT1A ; ; LOOK FOR COMMA OR END OF RECORD TO TERMINATE FIELD ; FMT1L: CMP FWIDTH(R5),R1 ;SCANNED ENTIRE FIELD? BEQ FMT1X ;YES - USE AS SPECIFIED CMP RECEND(R4),R0 ;AT END OF RECORD? BLOS FMT1EN CMPB #',,@R0 ;COMMA? BEQ FMT1CM INC R1 INC R0 BR FMT1L ;LOOK SOME MORE ; ; HAVE A SHORT FIELD - USE IT ; FMT1EN: FMT1CM: TST R1 ;ZERO WIDTH IS SPECIAL BEQ FMT1XS MOV R1,-(SP) ;FIELD WID MOV SP,R5 ;SET R5 TO POINT TO IOPSTK ADD (R5),R5 ADD #SAVER4+2.,R5 ;SAVE R4 MOV R4,-(R5) TST -(R5) MOV R5,R4 ;SET R4 TO POINT TO IOPSTK MOV SP,R5 ;SET R5 TO POINT TO I/O SPECIFIC TST (R5)+ ;STACK CLR ARGPTR(R4) ;CLEAR OUT ARG ADDR, LEN AND TYPE CLR ARGLEN(R4) CLR ARGTYP(R4) TST IOTSW(R4) ;DETERMINE TYPE OF I/O ;AND GO PROCESS BEQ IOFD BLT IORD JMP $IOUD ;PROCESS UNFORMATTED IORD: JMP $IORD ;PROCESS RANDOM .GLOBL $IOUD,$IOFX ; ; THIS ROUTINE IS CALLED AT THE ENDTH TO USE INC R1 ;ADJUST FOR COMMA ADD R1,RECPTR(R4) ;NEXT FIELD BEGINNING FMT1EM: CMP RECEND(R4),RECPTR(R4) BHI 1$ ;KEEP RECPTR < OR = RECEND MOV RECEND(R4),RECPTR(R4) 1$: BR FMT2 ;GO MAKE CALL TO CONVERSION ; ; HANDLE ZERO LENGTH FIELDS ; CAUSED EITHER BY ADJACENT COMMAS OR REQUEST BEYOND END OF RECORD ; TREATED AS A SINGLE BLANK ; FMT1XS: MOV #BLANK1,@SP ;REPLACE RECORD POINTER MOV #1,-(SP) ;FIELD WIDTH INC RECPTR(R4) ;TO SKIP POSSIBLE COMMA BR FMT1EM ;KEEP IT CLEAN BLA .TITLE $IR $VERSN 04 ; ; ;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. .CSECT .GLOBL $IR,$ID,$IC ; INTEGER TO REAL CONVERSION. ; ARGUMENT IS A FULL WORD ON THE TOP OF THE STACK ; CONVERT IT TO REAL FORMAT AND RETURN IT AS THE TOP ; TWO WORDS ON THE STACK. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 SP=%6 MQ=177304 NOR=177312 F0=%0 .IFDF FPU  .TITLE $IRI $VERSN 03 ; ; ; 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. ; .GLOBL $INRI,$OUTRI .GLOBL $RIO,$INRR,$OUTRW .GLOBL $IORD .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO INITIALIZE RANDOM I/O ; ; CALLING SEQUENCE ; ; PUSH ADDR OF UNIT NUM ; PUSH ADR OF RECORD NUMBER ; JMP ($INRI,  OF I/O PROCESSING FOR ; UNFORMATTED I/O ; ; $IOUD: TST IOSW(R4) ;BRANCH IF OUTPUT BEQ IOD1 IOD: BIT IOSTAT(R5),#2 ;IF INPUT FLUSH REST OF REC BNE IODX ;BRANCH IF DONE JSR PC,@IOTADR(R4) ;GET NEXT SEGMENT BR IOD ;GO CHECK IF DONE ; IOD1: BIS #2,IOSTAT(R5) ;SET FIRST AND LAST OR JUST LAST IOD2: JSR PC,@IOTADR(R4) ;GO WRITE LAST SEGMENT ; ; IODX: JMP $IOFX ;GO FINISH UP & RETURN TO CALLER ; ; .GLOBL $IORD,$IOFX ; ; THIS ROUTINE IS CALLED AT THE END OF I/O LIST PROCESSING FOR ; R!NK1: .ASCII / / ; ; A FORMAT WILL NOT STOP ON COMMA ; ONLY ON END OF RECORD ; FMT1A: CMP FWIDTH(R5),R1 ;SCANNED ENTIRE FIELD? BEQ FMT1X ;YES - USE IT CMP RECEND(R4),R0 ;END OF RECORD? BLOS FMT1EN ;USE IT INC R0 INC R1 BR FMT1A ;LOOK FARTHER ; ; NORMAL PROCESSING COMES HERE ; FMT1X: MOV FWIDTH(R5),-(SP) ;PUSH WIDTH OF FIELD ADD (SP),RECPTR(R4) ;SET NEW RECORD LOCN CMP RECPTR(R4),RECEND(R4) ;CHECK FOR RECORD OVERFLOW BLOS FMT2 ;BRANCH IF NOT JMP BADTAB ;ELSE - E"$IC: $ID: SETD; BR IDIR $IR: SETF ; IDIR: SETI ; SHORT INTEGERS LDCIF (SP)+,F0; CONVERT STF F0,-(SP); RESULT TO STACK JMP @(R4)+ .ENDC .IFNDF FPU $IC: $ID: MOV @SP,-(SP) ;PUSH ARGUMENT DOWN MOV @SP,-(SP) CLR 2(SP) ;CLEAR LOWEST ORDER DOUBLE CLR 4(SP) $IR: CLR -(SP) ;MAKE ROOM FOR RESULT MOV 2(SP),R1 ;GET INTEGER ARGUMENT BGT POS BEQ ZERO NEG R1 ;GET ABSOLUTE VALUE POS: ROL -(SP) ;SAVE SIGN .IFNDF EAE MOV #220,R2 ;GET MAX. POSSIBLE EXPONENT +1 .ENDC ; EAE CODE .IF#$OUTRI) ; ; ; $INRI: MOV #1,-(SP) ;SET IOSW = 1 = INPUT BR IORI $OUTRI: CLR -(SP) ;SET IOSW = 0 = OUTPUT IORI: MOV #$RIO,-(SP) ;SET IOADR = $RIO MOV #-1,-(SP) ;SET IOTSW = -1 = RANDOM MOV #$INRR,-(SP) ;SET IOTADR = $INRR = INPUT TST IOSW-IOTADR(SP) BNE IORI1 MOV #$OUTRW,(SP) ;IF OUTPUT RESET IOTADR = $OUTRW .GLOBL $IOFI1 IORI1: JSR PC,$IOFI1 ;ALLOCATE IOPSTK ; MOV #IORSTK,R5 ;ALLOCATE I/O SPECIFIC STACK ASR R5 IORI2: CLR -(SP) DEC R5 BNE IORI2 MOV SP,R5 ;IORSTK IS AD$ANDOM I/O ; $IORD: TST IOSW(R4) ;INPUT OR OUTPUT?? BNE IORD2 ;BRANCH IF INPUT IORD3: MOV RECPTR(R4),R0 ;GET BUFF PTR MOV RECEND(R4),R1 ;GET END OF BUFF IORD4: CMP R0,R1 ;CHECK IF BUFF FULL BEQ IORD1 ;BRANCH IF FULL DEC LENMAX(R5) ;DECREMENT REMAINING REC CHARS CLRB (R0)+ BR IORD4 IORD1: JSR PC,@IOTADR(R4) ;PUT/GET RECORD BUFFER TST LENMAX(R5) ;CHECK IF NO MORE CHARS IN REC BNE IORD3 ;GO CHECK IF MORE ; IORD2: MOV @RNUMAD(R4),R0 ;SET ASSOCIATED VAR TO CURRENT B INC R0 MOV R0,%RROR FMT2: TST CVTSW(R5) ;IF NOT D, E, F, OR G SPEC BGT FMTC ;BRANCH MOV DSCALE(R5),-(SP) ;PUSH DECIMAL SCALE MOV PSCALE(R5),-(SP) ;PUSH P SCALE FMTC: TST IOSW(R4) ;IF INPUT DO NOT SEND VALUES BNE FMTGO MOV #2,R0 TST CVTSW(R5) BEQ FMT3 ;IF D SPEC SEND 4 WORDS BLT FMT4 ;IF E, F, OR G SPEC SEND 2 WORDS CMP R0,CVTSW(R5) BHI FMT5 ;IF I OR O SPEC SEND 1 WORD BEQ $ACO ;IF A SPEC GO DO CONVERT NOW MOVB @ARGPTR(R4),R0 ;IF L SPEC SEND 1 BYTE TWICE MOV R0,-(SP) BR FMTGO F&DF EAE MOV #217,R2 ;GET MAX. POSSIBLE EXPONENT .ENDC CLRB 4(SP) ;CLEAR LOWEST ORDER FRACTION NORM: .IFNDF EAE ROL R1 ;LOOK FOR NORMAL BIT BCS NORMD ;JUMP IF FOUND DEC R2 ;DECREASE EXPONENT BR NORM ;TRY AGAIN .ENDC ; EAE CODE .IFDF EAE MOV #MQ,R3 ;POINT TO MQ CLR @R3 MOV R1,-(R3) ;MOVE ARG MOV #NOR,R0 ;POINT TO NOR IN EAE CLR @R0 ;NORMALIZE FRACTION SUB (R0)+,R2 ;TELL EXPONENT MOV #2,@R0 ;SHIFT OUT NORMAL BIT BY LSH MOV @R3,R1 ;RESULT TO R1 .ENDC NORMD: MOVB R1,5(SP'DRESSED BY R5 MOV #IORSTK+2.,-(SP);PUSH SIZE OF IORSTK+2 ONTO STACK ; .GLOBL $IOFI3 JMP $IOFI3 ;GO INITIALIZE I/O ;AND RETOUR TO MAIN IN ;EXPECTATION OF ARG AND ;END CALLS ; ; .END (@AVADDR(R5) JMP $IOFX ;GO FUNISH UP & RETURN TO CALLER ; ; COME HERE TO PROCESS FORMATTED I/O ; IOFD: TST ERRFLG(R4) ;CHECK IF ERROR CONDITIONS EXIST BNE IOFD1 ;IF NE YES JSR PC,@IOADDR(R4) ;CALL SPECIFIC I/O ROUTINE IOFD1: ;REFERENCE LABEL .IFDF RSX .GLOBL $AIOB TST IOSW(R4) ;IN OR OUT? BNE $IOFX ;IF NE IN JSR PC,$AIOB ;GET ADDR $IOBUF IN R2 MOV R2,-(SP) ;CALCULATE ADDRESS OF ADD #BFMCNT,(SP) ;BUFFER HEADER MOVB #40,BFMODE(R2) ;SET TO FREE DEVICE & ASCII MODE CLR BFACN)MT3: ASL R0 FMT4: ASL R0 FMT5: MOV ARGPTR(R4),R1 ;PUSH REQUIRED NUM WORDS 1 BYTE ADD R0,R1 ASR R0 ;AT A TIME ONTO THE STACK FMT6: TST -(SP) MOVB -(R1),1(SP) MOVB -(R1),(SP) DEC R0 BNE FMT6 CMP ARGLEN(R4),#1; TEST IF A BYTE OPERAND BNE FMTGO; NO CLRB 1(SP); CLEAR HIGH ORDER HALF WORD FMTGO: JSR PC,@CVTRTN(R5) ;GO DO CONVERT ROR R3 ;SAVE ERROR STATUS FMT7: TST IOSW(R4) ;IF OUTPUT DO NOT RETRIEVE VALUE BEQ FMTX ;BRANCH IF OUTPUT MOV #2,R0 TST CVTSW(R5) BEQ FMT8 *) ;SAVE LOW ORDER FRACTION CLRB R1 BISB R2,R1 ;COMBINE EXPONENT AND HIGH ORDER FRACTION SWAB R1 ROR (SP)+ ;GET SIGN ROR R1 ;INSERT SIGN IN RESULT RORB 3(SP) MOV R1,@SP ;OUTPUT RESULT ZERO: JMP @(R4)+ .ENDC .END ,T(R2) ;CLEAR ACTUAL BYTE COUNT MOV R2,-(SP) ;EXECUTE A DUMMY WRITE EMT 2 ;TO FREE THE DEVICE MOV R2,-(SP) ;MAKE SURE OF COMPLETION EMT 1 ; .ENDC ; ; COME HERE TO FLUSH I/O LIST IF ANY ; AND RETURN TO CALLER ; $IOFX: ;REFERENCE LABEL .IFDF RSX .GLOBL $FNDEV MOV @UNITAD(R4),R0 ;GET DEVICE NUMBER JSR PC,$AIOB ;GET ADDR $IOBUF MOV BFLP(R2),DVLP(R1);SAVE LINK BLOCK POINTER .ENDC MOV R4,R0 ; MOV R4,SP ;FREE SPECIFIC I/O STACK MOV (R0)+,R5 ;RESTORE CALLERS R0- ;IF DSPEC GET 4 WORDS BLT FMT9 ;IF E, F, OR G SPEC GET 2 WORDS CMP R0,ARGLEN(R4) ;IF L,O,I SPEC MOVE 1 BYTE OR 1 WORD BLOS FMTA ;DEPENDING ON STORAGE WIDTH OF MOVB (SP)+,@ARGPTR(R4) ;ARG BR FMTX ; FMT8: ASL R0 FMT9: ASL R0 FMTA: MOV ARGPTR(R4),R1 ;POP REQUIRED NUM WORDS 1 BYTE MOV SP,R2 ;AT A TIME FROM THE STACK FMTB: MOVB (R2)+,(R1)+ DEC R0 BNE FMTB MOV R2,SP FMTX: ROL R3 ;BRANCH IF CVT ERR OFF BCC FMTRET MOV #6.,R0 ;ELSE - CVT ERR JSR PC,$ERRA ;CALL ERROR / .TITLE $ISG $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL ISIGN,$ERRA ; THE FORTRAN ISIGN FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (2 ARGS) ; ; RETURNS SIGN ARG2 * ABS(ARG1) IN R0. ; R0=%0 R5=%5 ISIGN: MOV @2(R5),R0 ;GET FIRST ARG IN R0 BLE ISN ;GET -ABSOLUTE VALUE NEG R0 ISN: TST @4(R5) ;TEST SI0-R5 MOV (R0)+,R4 ;NOTE R5 IS AS BEFORE INIT CALL MOV (R0)+,R3 MOV (R0)+,R2 MOV (R0)+,R1 MOV (R0)+,R0 ADD #IOPSTK,SP ;FREE IOPSTK JMP @(R4)+ ;RETURN TO CALLER ; ; ; I/O ROUTINES COME HERE TO PROCESS ERRORS ; ; $IOERR: TST R3 ;NO SPACE TO DO I/O? BGE IOERR0 ;BRANCH IF SOME OTHER ERROR MOV #256.,R0 ;CALL ERR CLASS=0/NUM=1 JSR PC,$ERRA BR IOERR4 IOERR0: MOV ENDERR(R4),R0 ;GET POINTER TO END=ERR= CMP #4,R3 ;EOF/EOM? BNE IOERR3 ;BRANCH IF OTHER TST (R0) ;IS END= SPEC1;CLASS=6/NUM=0 ;IF ERROR RETURNS CONTINUE FMTRET: RTS PC ;RETURN TO GET NEXT ARG OR END REENT: DEC REPCNT(R5) ;REENTER HERE BEQ 1$ JMP FMT ;IF MORE REPCNT FO CVT 1$: CLR EXITSW(R5) ;ELSE - SET CVT DONE SWITCH CLR INTSW(R5) ;RESET ACCUMULATOR AND STATUS CLR INT(R5) JMP FCONT ;ALLOW T/),'SPECS ONLY ; ; ; COME HERE TO DO OUTPUT A CONVERSION ; $ACO: MOV ARGPTR(R4),R1 ;GET PTR TO FIRST CHAR OF ITEM MOV (SP)+,R2 ;GET FIELD WIDTH MOV (SP)+,R0 ;GET PTR TO FIRST CHAR OF REC M2 .TITLE $IST $VERSN 05 ; ; ;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 $IOSET .GLOBL $AOTS .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 R50CMO=12327; RAD50 /CMO/ ; ; THIS ROUTINE SETS UP I/O BUFFER FOR OPENS ; ; R0=DEVICE NUM. R1=DEVTAB ENTRY, R2=BUFFER ADDR ; $IOSET: CLR BFLP(R2) ;CLEAR LINK PTR MOV DV3GN OF SECOND ARG BLT RTN ;DONE IF - NEG R0 ;MAKE R0 + BVS ERROR ;JUMP IF NEGMAX RTN: .F4RTN ERROR: MOV #4404,R0 ;ERROR 4,9. JSR PC,$ERRA BR RTN .END 4IFIED? BEQ IOERRX ;GO PROCESS ERROR IF NOT IOERR1: JSR PC,$SERR ;STORE (R3) IN ERROR VARIABLE IOERR2: MOV @R0,2(R4) ;SET SAVED R4= END/ERR ADDR BR $IOFX ;GO CLEAN UP STACK & RETURN IOERR3: TST (R0)+; POINT TO ERR= PARAMETER TST (R0); BRANCH IF ERR= SPECIFIED BNE IOERR1 IOERRX: SWAB R3 ;OTHERWISE PROCESS ERROR INC R3 MOV R3,R0 JSR PC,$ERRA ;CALL ERR CLASS=1/NUM=(R3) IOERR4: JSR PC,$EXIT ;IF ERROR RETURNS CALL EXIT .END 5OV ARGLEN(R4),R3 ;GET ITEM WIDTH CMP R3,R2 ;BRANCH IF FIELD WIDTH WIDER THAN ITEM TO BHIS OCA1 ;MOVE INIT SEG OF ITEM ;ELSE LEAVE LEADING BLANKS AND MOVE ITEM WIDTH CHARS ADD R2,R0 SUB R3,R0 MOV R3,R2 OCA1: MOVB (R1)+,(R0)+ ;MOVE CHARS FROM ITEM TO REC DEC R2 BNE OCA1 CLR R3 ;SET CVT ERR OFF JMP FMTX ;GO BACK TO CALLER ; ; COME HERE TO DO INPUT A CONVERSION ; $ACI: TST (SP)+ ;REMOVE RETURN FROM STACK MOV (SP)+,R2 MOV (SP)+,R1 ;GET PTR TO FIRST CHAR MOV ARGPTR(R4)6PDVN(R1),BFPDVN(R2) ;SET PHYS DEV NAME MOVB DVUNUM(R1),BFUNUM(R2) ;SET UNIT NUM CLR BFHOPN(R2) ;CLEAR HOW OPEN/ERR CODE MOV DVFLNM(R1),BFFLNM(R2) ;SET FILE NAME AND EXT MOV DVFLNM+2.(R1),BFFLNM+2(R2) MOV DVFLNM+4.(R1),BFFLNM+4(R2) MOV DVUIC(R1),BFUIC(R2) ;SET UIC MOVB DVPC(R1),BFPC(R2) ;SET PROTECT CODE ; MOV R0,-(SP) JSR PC,$AOTS ;GET ADDR $OTSV MOV R0,R3 MOV (SP)+,R0 ADD #14,R3 ;GET ADDR $ERRWK .IFNDF RSX CMP R0,#-3; TEST FOR LOGICAL UNIT = -3 BEQ IOSET3; FORTRAN ERRO9,R0 ;GET PTR TO FIRST CHAR OF ITEM MOV ARGLEN(R4),R3 ;GET ITEM WIDTH CMP R3,R2 ;IF FIELD WIDTH = ARG LEN BEQ OCA1 ;GO MOVE FIELD WIDTH CHARS BHI ICA2 ADD R2,R1 SUB R3,R1 MOV R3,R2 BR OCA1 ICA2: ADD R3,R0 SUB R2,R3 ICA3: MOVB #' ,-(R0) DEC R3 BNE ICA3 SUB R2,R0 BR OCA1 .END ; ; :R LOGGING DEVICE .ENDC MOV R0,-(SP);CONVERT DEVICE NUM TO ASCII STRING MOV R3,-(SP) MOV #3,-(SP) EMT 42 ;DO BIN2D ; TST (R3)+ ;CONVERT ASCII STRING ;TO RAD50 IOSET1: CMPB #'0,(R3) BNE IOSET2 INC R3 MOVB #' ,2(R3) BR IOSET1 IOSET2: MOV R3,-(SP) CLR -(SP) EMT 42 ;DO RADPK ; MOV (SP)+,BFLDSN(R2) ;SET LOG DATASET NAME TST (SP)+ RTS PC ; .IFNDF RSX ;THIS CODE PERMITS LOGICAL UNIT NUM -3 ;THE LOGICAL NAME CMO IS SUBSTITUTED IN THE LINK BLOCK ; IOSET3: MOV #R5; .TITLE $IUI $VERSN 03 ; ; ; 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. ; .GLOBL $INI,$OUTI,$UIO,$INR,$OUTW .GLOBL $IOUD .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO INITIALIZE UNFORMATTED I/O ; ; CALLING SEQUENCE ; ; PUSH ADDR OF UNIT NUM ; JMP ($INI,$OUTI) ; $INI: CLR -(SP) ;CLEAR UFNULL < .TITLE $LCI $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL $LCI ; $LCI ASCII TO LOGICAL CONVERSION ; CALLING SEQUENCE: ; PUSH FIELD START ; PUSH FIELD WIDTH ; JSR PC,$LCI ; RETURNS WITH LOGICAL RESULT ON TOP OF STACK. ; R0 ... R3 ARE DESTROYED R0=%0 R1=%1 R2=%2 R3=%3 SP=%6 PC=%7 $LCI: MOV 2(SP),R0>0CMO,BFLDSN(R2); MOVE RAD50 /CMO/ RTS PC .ENDC ; .END ? MOV #1,-(SP) ;SET IOSW TO INPUT BR IOUI $OUTI: CLR -(SP) ;CLEAR UFNULL CLR -(SP) ;SET IOSW TO OUTPUT ; IOUI: MOV #$UIO,-(SP) ;SET IOADDR = $UIO MOV #1,-(SP) ;SET IOTSW = 1 = UNFORMATTED MOV #$INR,-(SP) ;SET IOTADR = $INR = INPUT TST IOSW-IOTADR(SP) BNE IOUI1 MOV #$OUTW,(SP) ;IF OUTPUT, RESET IOTADR = $OUTW .GLOBL $IOFI1 IOUI1: JSR PC,$IOFI1 ;ALLOCATE IOPSTK ; MOV #IOUSTK,R5 ;ALLOCATE I/O SPECIFIC STACK ASR R5 IOUI2: CLR -(SP) DEC R5 BNE IOUI2 MOV SP,R5 ;IOUSTK IS A@ ;GET WIDTH BGE WOK ;ASSURE NON-NEG CLR R0 WOK: MOV 4(SP),R1 ;GET FIELD START ADD R1,R0 ;GET END +1 MOV (SP)+,@SP ;MOVE RETURN UP CLR -(SP) ;CLEAR ERROR FLAG CLR 4(SP) ;CLEAR RESULT = FALSE AGAIN: MOVB (R1)+,R3 BICB #200,R3 CMPB R3,#'T ;CHECK FOR TRUE BEQ TRUE CMPB R3,#'F ;CHECK FOR FALSE BEQ DONE CMPB R3,#' ;CHECK BLANK BNE ERROR ;JUMP IF NOT T, F, OR BLANK CMP R1,R0 ;CHECK FIELD LIMIT BLT AGAIN ;JUMP IF MORE BR DONE ;BLANK FIELD TREATED AS FALSE ERROR: COM @SP ;SET ERA .TITLE $LCO $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL $LCO ; $LCO LOGICAL TO ASCII CONVERSION ; CALLING SEQUENCE: ; PUSH FIELD START ADDRESS ; PUSH FIELD LENGTH ; PUSH LOGICAL VALUE ; JSR PC,$LCO ; R0 ... R3 ARE DESTROYED R0=%0 R1=%1 R2=%2 SP=%6 PC=%7 $LCO: MOV 4(SP),R0 ;GET FIELD WIDTH BGE WOK ;ASSCDDRESSED BY R5 MOV #IOUSTK+2,-(SP) ;PUSH SIZE OF IOFSTK+2 ONTO STACK INC IOSTAT(R5) ;FOR OUTPUT INIT AS FIRST SEG ; .GLOBL $IOFI3 JMP $IOFI3 ;GO INITALIZE I/O ;AND RETURN TO MAIN IN ;EXPECTATION OF ARG AND ;END CALLS ; ; .END DROR RETURN DONE: ROL (SP)+ ;FLUSH FLAG AND SET C BIT RTS PC ;RETURN CONTROL TRUE: COM 4(SP) ;SET RETURN TRUE BR DONE .END EURE NON-NEG CLR R0 WOK: MOV 6(SP),R1 ;GET FIELD START ADDRESS ADD R1,R0 ;GET POINTER TO END+1 MOV (SP)+,4(SP) ;MOVE RETURN UP MOV (SP)+,R2 ;GET VALUE TO BE CONVERTED CLR @SP ;CLEAR ERROR FLAG TST R2 ;TEST LOGICAL VALUE BEQ FALSE COM R2 BEQ TRUE COM @SP ;FLAG ARGUMENT NOT 0 OR -1 MOVB #'*,-(R0) ;MOVE OUT * BR FIELD FALSE: MOVB #'F,-(R0) ;OUTPUT FALSE BR FIELD TRUE: MOVB #'T,-(R0) ;OUTPUT TRUE FIELD: CMP R0,R1 ;CHECK FIELD END BLOS DONE ;FIELD IS FULL MOVB #' ,-(R0) ;INSERF .TITLE $MAX $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL MAX0 ; THE FORTRAN MAX0 FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (VARIABLE # ARGS) ; ; RETURNS THE MAXIMAL ARGUMENT IN R0. ; R0=%0 R4=%4 R5=%5 MAX0: MOV (R5)+,R4 ;GET NUMBER OF ARGS MAX: MOV @(R5)+,R0 ;GET TRIAL MAX BR LOOP ;GO TEST COUNT IT LEADING BLANKS BR FIELD DONE: ROL (SP)+ ;FLUSH FLAG AND SET C BIT RTS PC .END z JCOMP: CMP @0(R5),R0 ;COMPARE NEXT WITH MAX SO FAR BGT MAX ;IT IS BIGGER SO SAVE IT TST (R5)+ ;IT LOOSES SO FLUSH IT LOOP: DECB R4 ;CHECK COUNT BGT COMP ;JUMP IF MORE TO COMPARE .F4RTN .END K .TITLE $MIN $VERSN 03 ; ; ; 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. ; .CSECT .GLOBL MIN0 ; THE FORTRAN MIN0 FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (VARIABLE # ARGS) ; ; RETURNS THE MINIMAL ARGUMENT IN R0. ; R0=%0 R4=%4 R5=%5 MIN0: MOV (R5)+,R4 ;GET NUMBER OF ARGS MIN: MOV @(R5)+,R0 ;GET TRIAL MAX BR LOOP ;GO TEST COUNT L .TITLE $MIX $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL AMAX1,MAX1,AMIN1,MIN1,$CMR,$RI .GLOBL $POLSH ; THE FORTRAN AMAX1,MAX1,AMIN1,MIN1 FUNCTIONS ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (VARIABLE # ARGS) ; ; AMAX1 (AMIN1) RETURNS THE LARGEST (SMALLEST) ; REAL ARGUMENT IN R0, R1. ; MAX1 (MIN1) RETURNS THE INTOCOMP: CMP @0(R5),R0 ;COMPARE NEXT WITH SMALLEST SO FAR BLT MIN ;IT IS SMALLER SO SAVE IT TST (R5)+ ;IT LOOSES SO FLUSH IT LOOP: DECB R4 ;CHECK COUNT BGT COMP ;JUMP IF MORE TO COMPARE .F4RTN .END PEGER EQUIVALENT OF ; THE RESULT OF AMAX1 (AMIN1) IN R0. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 AMIN1: MOV @PC,-(SP) ;SET MIN FLAG BR MINMAX ; MIN1: MOV @PC,-(SP) ;SET MIN FLAG BR MIN1A ; MAX1: CLR -(SP) ;SET MAX FLAG MIN1A: MOV (R5)+,-(SP) ;GET NUMBER OF ARGS CLRB 1(SP) BR MMD ; AMAX1: CLR -(SP) ;FLAG MAX MINMAX: MOV (R5)+,-(SP) ;GET NUMBER OF ARGS MMD: TST -(SP) ;GET POINTER SPACE MMA: MOV (R5)+,@SP ;GET ITEM ADDRESS DECB 2(SP) ;COUNT ITEMS BLE MME ;JUMQ .TITLE $MLB $VERSN 01 ; ; ; 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. ; .CSECT .GLOBL $MLB,$MLI; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; $MLB: MOVB (SP)+,R0; EXTEND SIGN MOVB (SP)+,R1; MOV R1,-(SP); MOV R0,-(SP); JMP $MLI; AND MULTIPLY AS INTEGER .END R .TITLE $MLC $VERSN 02 ; ; ; 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. ; .CSECT .GLOBL $MLC; .IFNDF FPU .GLOBL $ADR,$MLR,$SBR,$POLSH; .ENDC ; COMPLEX MULTIPLICATION. CALLED IN THE POLISH MODE. ; COMPUTES (A+BI)*(C+DI)=(AC-BD)+(AD+BC)I. ; THE STACK CONTAINS: ; D ; C ; B ;@SP A R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%TP IF DONE MMC: MOV @SP,R0 ;GET ITEM ADDRESS MOV 2(R0),-(SP) ;MOVE ITEM MOV @R0,-(SP) MOV @R5,R0 ;GET SECOND ITEM MOV 2(R0),-(SP) MOV @R0,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD $CMR,UNPOL ;GO COMPARE ITEMS UNPOL: BLT LOW ;JUMP IF FIRST IS LOW TST 4(SP) ;CHECK FLAG BEQ MMF ;JUMP IF MAX BR MMA LOW: TST 4(SP) BEQ MMA ;JUMP IF MAX MMF: TST (R5)+ ;POINT TO NEXT ITEM DECB 2(SP) ;COUNT ITEMS BGT MMC MME: MOV (SP)+,R1 ;GET RESULT ADDRESS TST (SP)+ ;POP COUNT AND TEST FIX FLAGV7 A=4 B=12. C=20. D=20. F0=%0 F1=%1 F2=%2 F3=%3 F4=%4 F5=%5 .IFNDF FPU $MLC: MOV R4,-(SP) ;SAVE RETURN POINTER MOV A(SP),-(SP) ;GET A MOV A(SP),-(SP) MOV D(SP),-(SP) ;GET D MOV D(SP),-(SP) JSR R4,$POLSH .WORD $MLR,MLC1 ;GET A*D MLC1: MOV B(SP),-(SP) ;GET B MOV B(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR R4,$POLSH .WORD $MLR,$ADR,MLC2 ;GET AD+BC MLC2: MOV A+0+4(SP),-(SP) ;GET A MOV A+0+4(SP),-(SP) MOV C(SP),-(SP) ;GET C MOV C(SP),-(SP) JSR RWDIRECTORY DT1: [ 1,1 ] 27-SEP-73 DMD .MAC 4 27-SEP-73 <233> 164741 DMN .MAC 5 27-SEP-73 <233> 050475 DNT .MAC 6 27-SEP-73 <233> 024674 DR .MAC 4 27-SEP-73 <233> 155430 DSG .MAC 3 27-SEP-73 <233> 121726 DSN .MAC 12 27-SEP-73 <233> 056171 DSQ .MAC 7 27-SEP-73 <233> 025632 DTN .MAC 18 27-SEP-73 <233> 162163 DVB .MAC 10 27-SEP-73 <233> 102554 DVC .MAC 8 27-SEP-73 <233> 144161 DX BEQ FIX ;JUMP IF MAX1 OR MIN1 MOV @R1,R0 ;RETURN RESULT TO USER MOV 2(R1),R1 TST (SP)+ ;POP MAX/MIN FLAG BR RTN ; FIX: MOV 2(R1),-(SP) ;MOVE RESULT TO STACK MOV @R1,-(SP) JSR R4,$POLSH .WORD $RI,UNPOL1 ;GO CONVERT REAL TO INTEGER UNPOL1: MOV (SP)+,R0 ;POP RESULT TO R0 TST (SP)+ ;POP MAX/MIN FLAG RTN: .F4RTN .END Z4,$POLSH .WORD $MLR,MLC3 ;GET A*C MLC3: MOV B+0+4(SP),-(SP) ;GET B MOV B+0+4(SP),-(SP) MOV D+0+8.(SP),-(SP) ;GET D MOV D+0+8.(SP),-(SP) JSR R4,$POLSH .WORD $MLR,$SBR,MLC4 ;GET AC-BD MLC4: MOV SP,R0 ;POINT TO RE(RESULT) ADD #18.,R0 MOV (SP)+,(R0)+ ;MOVE RESULT TO RIGHT PLACE MOV (SP)+,(R0)+ MOV (SP)+,(R0)+ MOV (SP)+,(R0)+ MOV (SP)+,R4 ;GET RETURN POINTER ADD #8.,SP ;FLUSH JUNK JMP @(R4)+ ;RETURN TO USER .ENDC ; .IFDF FPU $MLC: SETF ; SINGLE PRECISION FP LDF (SP)+,F2; [VD .MAC 10 27-SEP-73 <233> 123172 DVI .MAC 6 27-SEP-73 <233> 165576 DVR .MAC 12 27-SEP-73 <233> 112621 DXP .MAC 13 27-SEP-73 <233> 162034 ECD .MAC 4 27-SEP-73 <233> 037463 EDO .MAC 3 27-SEP-73 <233> 150414 EDP .MAC 4 27-SEP-73 <233> 175776 ERC .MAC 5 27-SEP-73 <233> 113660 ERR .MAC 16 27-SEP-73 <233> 100655 EXP .MAC 10 27-SEP-73 <233> 066372 EXT .MAC 3 27-SEP-73 <233> 147777 FDV ^A LDF (SP)+,F3; B LDF (SP)+,F0; C LDF (SP)+,F1; D STF F0,F4; C STF F1,F5; D ; MULF F2,F0; A*C MULF F3,F1; B*D SUBF F1,F0; A*C - B*D MULF F5,F2; A*D MULF F4,F3; B*C ADDF F3,F2; A*D + B*C STF F2,-(SP); STORE IM(RESULT) STF F0,-(SP); STORE RE(RESULT) JMP @(R4)+; EXIT .ENDC .END _ .MAC 3 27-SEP-73 <233> 150326 FIO .MAC 38 27-SEP-73 <233> 057776 FIX .MAC 3 27-SEP-73 <233> 117376 FLD .MAC 3 27-SEP-73 <233> 074234 FLT .MAC 3 27-SEP-73 <233> 115762 FND .MAC 4 27-SEP-73 <233> 022571 FPR .MAC 6 27-SEP-73 <233> 020736 GET .MAC 3 27-SEP-73 <233> 107566 GLE .MAC 4 27-SEP-73 <233> 172541 IAB .MAC 3 27-SEP-73 <233> 103264 IBF .MAC 4 27-SEP-73 <233> 172715 ICI .MAcC 6 27-SEP-73 <233> 174743 ICO .MAC 6 27-SEP-73 <233> 001327 IDM .MAC 3 27-SEP-73 <233> 110307 IED .MAC 4 27-SEP-73 <233> 047546 IFI .MAC 4 27-SEP-73 <233> 017160 INR .MAC 7 27-SEP-73 <233> 105271 INT .MAC 3 27-SEP-73 <233> 120223 IOC .MAC 4 27-SEP-73 <233> 174044 IOF .MAC 9 27-SEP-73 <233> 107304 IR .MAC 5 27-SEP-73 <233> 106022 IRI .MAC 4 27-SEP-73 <233> 011534 ISG .MAC 3 27-SEP-73 <233> 114574 IST .MAC 5 27-SEP-73 <233> 061006 IUI .MAC 4 27-SEP-73 <233> 017627 LCI .MAC 4 27-SEP-73 <233> 002411 LCO .MAC 4 27-SEP-73 <233> 175664 MAX .MAC 3 27-SEP-73 <233> 122403 MIN .MAC 3 27-SEP-73 <233> 123331 MIX .MAC 5 27-SEP-73 <233> 123653 MLB .MAC 2 27-SEP-73 <233> 057745 MLC .MAC 5 27-SEP-73 <233> 100420 FREE BLKS: 232 FREE FILES: 3