.TITLE $POI $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 R0=%0 R4=%4 SP=%6 ; POLISH LIST CONTAINS ADDRESS OF DATA DESTINATION ; FOLLOWING THE POP CALL ; ; $POP1,$POP2 - POP AN INTEGER OR LOGICAL ITEM ; .GLOBL $POP1,$POP2,$POPI $POPI: $POP2: $POP1: MOV (SP)+,@(R4)+ ;MOVE THE DATA TO THE DESTINATION JMP @(R4)+ .TITLE $PPR $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 ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE REMOVES TWO OR FOUR ITEMS FROM THE STACK ; AND PLACES THEM IN REGISTERS R0-R3. IT IS USED IN EXTERNAL ; FUNCTIONS TO RETURN THE FUNCTION VALUE IN THE REGISTERS ; .GLOBL $POPR5,$POPR4,$POPR3  .TITLE $PRI $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 $PWRI,$ERRA; .IFNDF FPU .GLOBL $MLR,$DVR,$POLSH; .ENDC ; REAL BASE TO INTEGER EXPONENT PROCESSING ; CALLED IN THE POLISH MODE. ; THE INTEGER EXPONENT IS @SP ; THE REAL BASE IS AT 2(SP) AND 4(SP). ; THIS ROUTINE REPLACES THEM WITH R**I. R0=%0 R1=%1  .TITLE $PRP $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. R3=%3 R4=%4 R5=%5 .CSECT ; ; $POPP3 - POP A REAL PARAMETER ; .GLOBL $POPP3,$POP4A $POPP3: MOV (R4)+,R3 ;GET DISPLACEMENT ADD R5,R3 ;ADD TO THE LIST ADDRESS MOV @R3,R3 ;GET THE VARIABLE ADDRESS JMP $POP4A ; .END ;THEN CONTINUE ; .END ; $POPR5: $POPR4: MOV (SP)+,R0 ;POP FOUR WORDS MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 JMP @(R4)+ $POPR3: MOV (SP)+,R0 ;POP TWO WORDS MOV (SP)+,R1 JMP @(R4)+ ; .END R4=%4 R5=%5 SP=%6 F0=%0 F1=%1 .IFNDF FPU $PWRI: MOV @SP,-(SP) ;DUPLICATE EXPONENT BGE EPOS ;JUMP IF + NEG @SP ;GET ABS VALUE OF EXPONENT EPOS: MOV R4,-(SP) ;SAVE R4 ASR 2(SP) ;TEST EXPONENT BCC EVEN ;JUMP IF EVEN MOV 8.(SP),-(SP) ;R TO WORK SPACE MOV 8.(SP),-(SP) TST 6(SP) ;TEST REST OF EXPONENT BEQ DONE1 ;JUMP IF EXP WAS 1 BR EVODD EVEN: CLR -(SP) ;PUT 1. IN WORK SPACE MOV #40200,-(SP) TST 6(SP) ;TEST REST OF EXPONENT BNE EVODD ;JUMP IF EXPONENT NOT 0 TST 10.(SP) ;TEST R BNE DONE1 ;JUMP IF BASE NOT 0 BR ERROR1 ;0**0 NOT DEFINED EVODD: MOV 12.(SP),-(SP) ;GET R MOV 12.(SP),-(SP) SQUAR: MOV 2(SP),-(SP) ;DUPLICALTE CURRENT POWER OF R MOV 2(SP),-(SP) JSR R4,$POLSH ;SQUARE CURRENT POWER OF R .WORD $MLR,ASR ASR: ASR 10.(SP) ;TEST EXPONENT BIT BCC SQUAR ;JUMP IF 0 MOV 6(SP),-(SP) ;GET PARTIAL RESULT MOV 6(SP),-(SP) MOV 6(SP),-(SP) ;GET R**2**N MOV 6(SP),-(SP) JSR R4,$POLSH ;FORM NEW PARTIAL RESULT .WORD $MLR,UNPOL UNPOL: MOV (SP)+,6(SP) ;STORE  .TITLE $PRR $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 $PWRR,ALOG,EXP,$MLR,$FCALL,$ERRA .GLOBL $POLSH ; REAL BASE TO REAL EXPONENT PROCESSING ; CALLED IN THE POLISH MODE. ; THE BASE (B) IS AT 4(SP) AND 6(SP), AND ; THE EXPONENT (E) IS AT @SP AND 2(SP). ; THIS ROUTINE REPLACES THEM WITH B**E. R0=%0 R1=%1 R2 .TITLE $PSH $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. .GLOBL $PSH ; ; $PSH - PUSH AN ADDRESS OR VALUE ON THE STACK ; R4=%4 SP=%6 ; .CSECT ; $PSH: MOV (R4)+,-(SP) ;ADDRESS TO THE STACK JMP @(R4)+ ;AND NOW RETURN ; .END  .TITLE $PUT $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 ; ; PUT - ONE, TWO, OR FOUR WORDS ; .GLOBL $PUT5,$PUT4,$PUT3,$PUT2,$PUT1 $PUT5: $PUT4: MOV (SP)+,(R0)+ ;PUT FOUR WORDS MOV (SP)+,(R0)+ $PUT3: MOV (SP)+,(R0)+ ;PUT TWO WORDS $PUT2: $PUT1: MOV IN WORK SPACE MOV (SP)+,6(SP) TST 10.(SP) ;TEST REMAINDER OF EXPONENT BNE SQUAR ;JUMP IF MORE TO DO DONE: CMP (SP)+,(SP)+ ;FLUSH R**2**N DONE1: TST 8.(SP) ;TEST EXPONENT SIGN BGE EPLUS ;JUMP IF + MOV 2(SP),-(SP) ;MOVE R**+I DOWN MOV 2(SP),-(SP) BEQ ERROR ;JUMP IF R=0 CLR 6(SP) ;INSERT A 1. MOV #40200,4(SP) JSR R4,$POLSH ;GET 1/R**+I .WORD $DVR,EPLUS EPLUS: MOV (SP)+,8.(SP) ;MOVE RESULT UP MOV (SP)+,8.(SP) MOV (SP)+,R4 ;RESTORE R4 CMP (SP)+,(SP)+ ;FLUSH EXPONENTS JMP @(R4)+=%2 R4=%4 R5=%5 SP=%6 PC=%7 $PWRR: MOV (SP)+,R0 ;GET EXPONENT MOV (SP)+,R1 MOV SP,R2 ;KEEP POINTER TO B MOV R4,-(SP) ;SAVE REGISTERS MOV R5,-(SP) MOV R1,-(SP) ;PUSH EXPONENT MOV R0,-(SP) BGE EPZ ;JUMP IF E >=0 TST @R2 ;CHECK B BLT ERROR ;JUMP IF E <0 AND B <0 BEQ ERROR1 ;JUMP IF E <0 AND B =0 BR BPOS ;JUMP IF E <0 AND B >0 EPZ: BGT EPOS; JUMP IF E>0 TST @R2; E=0, CHECK B BEQ ERROR1; JUMP IF E=0 AND B=0 BR ONE; JUMP IF E=0 AND B<>0 EPOS: TST @R2; E>0, CHECK B BEQ ZE(SP)+,(R0)+ ;PUT ONE WORD JMP @(R4)+ ; .END  ;RETURN TO CALLER ERROR: CMP (SP)+,(SP)+ ;FLUSH STACK ERROR1: MOV #12403,R0 ;ERROR 3,21. JSR PC,$ERRA BR EPLUS .ENDC .IFDF FPU $PWRI: SETF ; SET FP MODE FOR FPU LDF #1.0,F0; INITIALIZE RESULT TO 1.0 MOV (SP)+,R0; GET EXPONENT MOV R0,R1; SAVE SIGN IN R1 BGE EPOS; JUMP IF + NEG R0; GET ABS VALUE OF EXPONENT EPOS: LDF (SP)+,F1; GET R ASR R0; TEST EXPONENT BCC EVEN; JUMP IF EVEN ODD: LDF F1,F0; BEQ DONE; JUMP IF EXP WAS 1 BR SQUAR; GO TO COMPUTE POWER EVEN: BNE SQUAR; RO; JUMP IF E>0 AND B=0 BLT ERROR; JUMP IF E>0 AND B<0 BPOS: MOV #ALOG,R4 ;POINT TO ALOG MOV R2,R5 ;POINT TO B JSR PC,$FCALL ;GO GET LOG(B) MOV R1,-(SP) ;PUSH ALOG(B) MOV R0,-(SP) JSR R4,$POLSH ;GET E*ALOG(B) .WORD $MLR,UNPOL UNPOL: MOV SP,R5 ;POINT TO E*LN(B) MOV #EXP,R4 ;POINT TO EXP JSR PC,$FCALL OUT: CMP (SP)+,(SP)+ ;FLUSH E*LN(B) MOV (SP)+,R5 MOV (SP)+,R4 MOV R0,@SP ;PUT RESULT ON STACK MOV R1,2(SP) JMP @(R4)+ ;RETURN TO CALLER ONE: MOV #40200,R0 ;RETURN 1. BR ZERO1  .TITLE $RAD $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. ; .GLOBL $READ,$WRITE,$GET .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; READ OR WRITE A RECORD-R1=DEVTAB ENTRY, R2=BUFF ADDR, ; R0=DEV NUM, R3=ERROR RETURNS $GET: MOV #1,-(SP); SET 'GET' MODE (RANDOM) BR $READ1; $WRITE: CLR -(SP) ;SET WRITE MOD EXPONENT .NE. 0 CFCC ; GET SIGN OF R BNE OUT; JUMP IF BASE NOT 0 BR ERROR; 0**0 NOT DEFINED ; SQUAR: MULF F1,F1; SQUARE CURRENT POWER OF R ASR R0; TEST EXPONENT BIT BCC SQUAR; JUMP IF 0 MULF F1,F0; RESULT=RESULT*R**2**N BNE SQUAR; MORE EXPONENT TO DO ; DONE: TST R1; TEST EXPONENT SIGN BGE OUT; CFCC ; CHECK 0 RESULT BEQ ERROR; 0.0**(-N) LDF #1.0,F1; DIVF F0,F1; GET 1/R**I LDF F1,F0; OUT: STF F0,-(SP); RESULT TO STACK JMP @(R4)+; EXIT ERROR: MOV #12403,R0 ;ERR ERROR: MOV #12003,R0 ;ERROR 3,20 BR ECALL ERROR1: MOV #11403,R0 ;ERROR 3,19 ECALL: JSR PC,$ERRA ZERO: CLR R0 ;RETURN 0 ZERO1: CLR R1 BR OUT .END E BR $READ1 $READ: MOV #-1,-(SP) ;SET READ MODE $READ1: MOV #READER,BFLKER(R2) ;SET LNK BLK ERR RTN TST IOTSW(R4) ;CHECK WHICH TYPE INPUT BLT READR ;BRANCH IF RANDOM BNE READU ;BRANCH IF UNFMTD CLRB BFMODE(R2) ;SET ASCII FMTD, NODUMP, NO PARITY, BR READF ;NORMAL MODE READU: MOVB #1,BFMODE(R2) ;SET BINARY, FMTD, NODUMP, ; PARITY, NORMAL MODE ; DO FMTD/UNFMTD READ READF: MOV R2,-(SP) ;PUSH ADDR BUFF HEADER ADD #BFMCNT,(SP) MOV R2,-(SP) ;PUSH ADDR LINK BLOCK TST 4(SP) BEQ .TITLE $RAD50 $VERSN 00 ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; A FAST IMPLEMENTATION FROM ; AVAILABLE PIECES - TO BE REWRITTEN ; .CSECT .GLOBL $DVI,IRAD50,RAD50,$POLSH ; RAD50: MOV R5,-(SP) CMP -(SP),-(SP) ;ROOM FOR RESULT MOV 2(R5),R1 ;TEXT POINTER MOV SP,R0 ;OUTPUT POINTER MOV #-2,R5 ;OUTPUT WORD COUNT MOV #6,R2 ;INPUT COR 3,21. JSR PC,$ERRA BR OUT; .ENDC .END ! RDX1 ;BRANCH IF WRITE MODE EMT 4 ;OTHERWISE READ BR RDX2 RDX1: EMT 2 ;WRITE RDX2: MOV R2,-(SP) EMT 1 ;WAIT ; ; CHECK ERRORS ; CLR R3 ;CLEAR ERROR FLAG TSTB BFSTAT(R2) ;BRANCH IF NO ERRORS BEQ READX INC R3 BITB #40,BFSTAT(R2) ;BRANCH IF DEVICE PARITY BNE READX INC R3 BITB #6,BFSTAT(R2) ;BRANCH IF CHECKSUM/PARITY BNE READX INC R3 BITB #100,BFSTAT(R2) ;BRANCH IF UNDIAGNOSABLE BEQ READX INC R3 ;SET EOF/EOM ; READX: TST (SP)+ ;CLEAR READ/WRITE FLAG RTS PC ;RE"HAR COUNT JSR PC,PACK00 MOV (SP)+,R0 ;FUNCTION RESULT MOV (SP)+,R1 MOV (SP)+,R5 .F4RTN ; ; IRAD50: MOV R5,-(SP) MOV @2(R5),-(SP) ;COUNT VALUE BLE RET0 ADD #2,@SP MOV #3,-(SP) JSR R4,$POLSH $DVI .+2 MOV (SP)+,R5 ;WORDS TO MODIFY NEG R5 MOV @SP,R4 MOV @2(R4),R2 ;MAX CHAR COUNT MOV 4(R4),R1 ;TEXT POINTER MOV 6(R4),R0 ;DESTINATION JSR PC,PACK00 MOV R1,R0 ;FIRST CHAR NOT USED MOV (SP)+,R5 SUB 4(R5),R0 ;GIVES COUNT USED .F4RTN ; RET0: CLR R0 TST (SP)+ MOV $ .TITLE $RAN $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 RAN .GLOBL $ERRA ; RANDOM NUMBER GENERATOR ; CALLING SEQUENCE: ; RAN(I1,I2) ; WHERE ; I1,I2 IS THE GENERATOR BASE FOR THIS CALL ; AND SHOULD BE 0,0 FOR THE FIRST CALL ONLY. ; RETURNS IN R0, R1 A RANDOM NUMBER UNIFORMALY ; DISTRIBUTED BETWEEN 0. AND 1. %TURN ; ; ERROR RETURN VALUES ; 1=DEVICE PARITY ; 2=CHECKSUM/PARITY ERR OR END OF DATA ERROR?(RANDOM) ; 3=UNDIAGNOSABLE ERROR ; 4=EOF/EOM ; ; -1=OUT OF SPACE ; READER: MOV #-1,R3 ;SET OUT OF SPACE ERROR RTS PC ; ; ; RANDOM READ COMES HERE ; READR: MOV #4,BFMCNT(R2) ;SET FUNCN WRD TO READ TST (SP); TEST OPERATION BLT RDX4; -1 => READ (FUNCT=4) BEQ RDX3; 0 => WRITE(FUNCT=2) ASR BFMCNT(R2); 1 => GET (FUNCT=1) RDX3: ASR BFMCNT(R2) ;OTHERWISE SET FUNCN WRD ;TO WRITE RDX4&(SP)+,R5 .F4RTN ; ; MOD40 PACK - ENTERED WITH JSR PC, PACK00 ; ; INPUT: R0=ADR OF MOD40 WORDS (2 WORDS) ; R1=ADR OF ASCII CHARACTERS (6 CHARS) ; ; OUTPUT: R1 POINTS ONE PAST END OF ASCII STRINT ; THE MOD40 WORD IS FORMED AS ; N=C1*40^2+C2*40+C3 ; ; R2,R3,R4,R5 ARE CLOBBERED PACK00: MOV R2,-(SP) ;SAVE CHAR COUNT CLR -(SP) ;CLEAR TERMINATOR SWITCH PACK01: MOV #-3,R4 ;MINOR LOOP CT. CLR R2 ;0 SUM PACK05: TST @SP ;TEST TERMINATED SWITCH BNE PACK10 TST 2(SP) ;CHARS EXAUSTED? ' .TITLE $RD $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 $RD,$RC ; $RD THE REAL TO DOUBLE PRECISION CONVERTER ; APPEND ZEROS TO THE TOP STACK ITEM TO ; MAKE IT DOUBLE PRECISION FORMAT ; $RC --- REAL TO COMPLEX CONVERSION ; REPLACES THE REAL ON TOP OF THE STACK WITH ; A COMPLEX NUMBER WHOSE REAL PART IS THE STACK ; ITEM AND(R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 RAN: CMPB (R5),#2 ;SHOULD BE 2 ARGS BNE ERROR ;JUMP IF NOT 2 TST (R5)+ MOV (R5)+,R2 ;ADDRESS OF I1 MOV (R5)+,R3 ;ADDRESS OF I2 MOV @R2,R0 ;GET I1 MOV @R3,R1 ;GET I2 BEQ INIT ;JUMP IF INITIAL CALL ASL R1 ;MULT BY 2 ROL R0 ADD @R2,R0 ;NOW BY 3 ADD @R3,R1 ADC R0 ADD @R3,R0 ;NOW BY 2**16 +3 BPL PLUS ;JUMP IF + ADD #100000,R0 ;GET 2**32 +G PLUS: MOV R0,@R2 ;STORE NEXT GENERATOR MOV R1,@R3 MOV #201,R2 ;GET INITIAL EXPONENT NORM:): MOV R2,-(SP) ;PUSH BLOCK BLOCK ADDR ADD #BFMCNT,(SP) MOV R2,-(SP) ;PUSH LINK BLOCK ADDR EMT 11 ;READ MOV R2,-(SP) EMT 1 ;WAIT ; CLR R3 TSTB BFMCNT+1(R2) ;TEST FOR ERROR5 BEQ READX ;BRANCH IF NONE INC R3 BITB #200,BFMCNT+1(R2) ;BRANCH IF DEVICE PARITY BNE READX INC R3 BITB #100,BFMCNT+1(R2) ;BRANCH IF END OF DATA ERROR BNE READX INC R3 BITB #10,BFMCNT+1(R2) ;BRANCH IF UNDIAGNOSABLE BEQ READX INC R3 ;SET EOF ERROR BR READX ; ; .END *BEQ PACK10 DEC 2(SP) ;USE ONE MORE IF POSSIBLE MOVB (R1)+,R3 ;GET NEXT ASCII CHAR. PACK06: CMPB #' ,R3 BEQ PACK02 ;"BLANK" CMPB #'$,R3 BEQ PACK04 ;"$" CMPB R3,#'A BLO PACK09 ;"." OR "0-9" SUB #40,R3 ;"A"-"Z" BEQ PACK08 CMP R3,#'Z-'A+41 BGT PACK08 ;NON-RAD50 CHAR PACK02:SUB #16,R3 PACK03:SUB #11,R3 PACK04:SUB #11,R3 ; MULT R2 BY 40. PACK07: ASL R2 ;2*R2 ASL R2 ;4*R2 ASL R2 ;8*R2 MOV R2,-(SP) ;STACK 8*R2 ASL R2 ;16.*R2 ASL R2 ;32.*R2 ADD (SP)+,R2 ;40.*R2 + WHOSE IMAGINARY PART IS 0. R4=%4 SP=%6 F0=%0 F1=%1 $RC: .IFDF FPU $RD: .WORD 170011 ;;SETD .WORD 177426 ;;LDCFD (SP)+,F0 ;CONVERT ARG .WORD 174046 ;;STD F0,-(SP) JMP @(R4)+ .ENDC .IFNDF FPU $RD: MOV 2(SP),-(SP) ;MOVE LOW ORDER PART MOV 2(SP),-(SP) ;MOVE HIGH ORDER PART CLR 4(SP) ;INSERT TRAILING ZEROS CLR 6(SP) JMP @(R4)+ .ENDC .END , ASL R1 ;FLOAT RESULT ROL R0 BCS EXP ;JUMP IF LEADING BIT FOUND DEC R2 ;COMPENSATE EXPONENT BR NORM EXP: CLRB R1 BISB R0,R1 SWAB R1 CLRB R0 BISB R2,R0 ;INSERT EXPONENT IN RESULT SWAB R0 ROR R0 ROR R1 ;INSERT + SIGN BR RTN ;RETURN TO CALLER ; INIT: MOV #3,R1 INC R0 ;SET UP 2**16 +3 BR PLUS ; ERROR: MOV #6404,R0 ;ERROR 4,13. JSR PC,$ERRA RTN: .F4RTN .END -.; INCLUDE CURRENT CHARACTER ADD R3,R2 INC R4 ;DONE 3 CHARS? BLT PACK05 ;NO MOV R2,(R0)+ ;YES-STORE MOD40 WORD INC R5 ;DONE ALL WORDS? BLT PACK01 ;NO CMP (SP)+,(SP)+ ;DISCARD TEMPS RTS PC ;EXIT ; PACK08: DEC R1 ;DON'T USE THIS CHAR PACK10: INC @SP ;SET TERMINATION FLAG CLR R3 ;USE ZERO FILL FOR REST BR PACK07 ; PACK09: CMPB #'.,R3 ;"." BEQ PACK03 CMPB R3,#'0 BLT PACK08 CMPB R3,#'9 BLE PACK03 ;"0" - "9" BR PACK08 ;NON-RAD50 ; ; R50ASC ; ; FORTRAN SUBPROGRAM - C2ALLING FORM: ; ; CALL R50ASC(ICNT,IN,OUT) ; ; WHERE ; ICNT - NUMBER OF OUTPUT CHARS TO PRODUCE ; IN - INPUT VARIABLE OR ARRAY ; OUT - OUTPUT VARIABLE OR ARRAY ; .IF NDF EIS .MACRO DIV A,B,?DIV0,?DIV1 DIV0: CMP #50,R1 BHI DIV1 SUB #50,R1 INC R0 BR DIV0 DIV1: .ENDM .ENDC ; ; .GLOBL R50ASC R50ASC: MOV @2(R5),R0 ;CHAR COUNT BLE EXIT ;NO GOOD UNLESS POSITIVE CMP -(SP),-(SP) ;WORK AREA MOV SP,R2 ;TO USE WORK AREA MOV R0,-(SP) ;COUNT MOV 4(R5),R3 ;INPUT POINTER MOV 3 .TITLE $RDM $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 $RANDM .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; DO BLOCK/DISP CALC FOR RANDOM I/O ; A3=12. A1=16. A2=14. $RANDM: MOV R0,-(SP) ;SAVE REGS MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV A1(SP),R3 ;GET ARGS TO MULTIPLY 4 .TITLE $RDSW .IDENT /01/ ; ; COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; FORTRAN SUBPROGRAM TO READ THE PDP-11 ; SWITCHES. ; ; CALLED WITH ONE PARAMETER INTO WHICH THE ; SWITCH CONTENTS ARE STORED AS A 16 BIT MASK. ; .MCALL .PARAM .PARAM .GLOBL READSW READSW: MOV SWR,@2(R5) .F4RTN .END 5 .TITLE $RDU $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 RANDU .GLOBL $ERRA ; RANDOM NUMBER GENERATOR ; CALLING SEQUENCE: ; CALL RANDU(I1,I2,R) ; WHERE ; I1,I2 IS THE GENERATOR BASE FOR THIS CALL ; AND SHOULD BE 0,0 FOR THE FIRST CALL ONLY. ; R IS A RANDOM REAL NUMBER UNIFORMALY ; DISTRIBUTED BETWEEN 0. AND 1.66(R5),R4 ;OUTPUT POINTER ; ; MAJOR LOOP TO UNPACK ONE WORD ; 3$: MOV (R3)+,R0 ;GET WORD CMP #174777,R0 ;TOO BIG? BHIS 4$ ;BR IF OKAY MOVB #'?,R1 ;USE "???" IF TOO BIG MOVB R1,(R2)+ MOVB R1,(R2)+ MOVB R1,(R2)+ BR 5$ ;GO DO OUTPUT COPY ; 4$: MOV #3,-(SP) ;MINOR LOOP COUNTER 1$: MOV R0,R1 CLR R0 DIV #50,R0 JSR PC,CVT ;RAD50 TO ASCII MOVB R1,(R2)+ DEC @SP ;3 CHARS? BNE 1$ ;BR IF NOT TST (SP)+ ;DISCARD MINOR LOOP COUNT ; ; COPY CHARS TO USER OUTPUT ; 5$: MOV #3,7 MOV A2(SP),R4 ;R4*(R2,R3)=(R0,R1) CLR R0 CLR R2 CLR R1 RANDM1: CLC ;MULTIPLY AND LEAVE DP RESULT ROR R4 ;IN R0 AND R1 BCC RANDM2 ADD R3,R1 ADC R0 ADD R2,R0 RANDM2: ASL R3 ROL R2 TST R4 BNE RANDM1 CLR R4 ;NOW DIVIDE BY 3RD ARG CLR R2 ;LEAVE QUOTIENT IN R1, REMAINDER MOV A3(SP),R3 ;IN R0 RANDM3: ASR R3 BEQ RANDM5 ASR R0 ROR R1 ROR R2 INC R4 BR RANDM3 ; RANDM5: CLR R0 RANDM4: ASL R2 ;MOVE REMAINDER FROM HIGH END OF ROL R0 ;R2 TO LOW END R0 DEC R4 BNG ; EXAMPLE: ; . ; . ; CALL RANDU (0,0,R) ; . ; . ; MAKE SOME USE OF R ; . ;1 CALL RANDU (I1,I2,R) ; . ; USE R ; . ; GO TO 1 ; . R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 RANDU: CMPB (R5),#3 ;SHOULD BE 3 ARGS BNE ERROR ;JUMP IF NOT 3 TST (R5)+ MOV (R5)+,R2 ;ADDRESS OF I1 MOV (R5)+,R3 ;ADDRESS OF I2 MOV @R2,R0 ;GET I1 MOV @R3,R1 ;GET I2 BEQ INIT ;JUMP IF INITIAL CALL ASL R1 ;MULT BY 2 ROL R0 ADD @R2,R0 ;NOW BY 3 ADD @R3,R1 ADC R0 ADD @R3,R0 ;NOW BY 2**16 +3 ER1 ;COUNTER 2$: MOVB -(R2),(R4)+ DEC @SP ;EXHAUSED USER COUNT? BEQ DONE ;BRANCH IF YES DEC R1 ;DONE 3 CHARS BNE 2$ ;LOOP IF NOT BR 3$ ;DO ANOTHER WORD ; DONE: ADD #6,SP ;DELETE WORK AREA AND COUNT EXIT: .F4RTN ; ; CVT - CONVERT RADIX-50 CODE IN R1 TO ASCII CODE IN R1 ; CVT: TST R1 BEQ $SP ;SPACE CMP R1,#32 BLOS $LET ;BR IF LETTER CMP R1,#36 BHIS $DIG ;BR IF DIGIT MOVB T-33(R1),R1 ;THE OTHERS RTS PC ; CASES $SP: MOV #' ,R1 RTS PC $LET: ADD #'A-1,R1 RTS PC FE RANDM4 MOV R1,A1(SP) ;RETURN QUOTIENT MOV R0,A2(SP) ;RETURN REMAINDER MOV (SP)+,R4 ;RESTORE REGS MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ;EXIT ; ; .END "D @D """DDDD @"DD " """@D@DDDD """"D@D "DD""""DD@DD"""DADDB CafkQ  fkQ  fkQ fkQ fkQ  gkQ  \gkQ pkQ -ppkQ  IpkQ  , qkQ #+-qkQ /F3qkQ 045qkQ 1OTqkQ HPqkQ JZqkQ MYtkQ S[wkQ TX#wkQ \x(wkQ ]yw XkQ ^jwkQ _gwkQ kwwkQ n wkQ {wkQ |6xkQ } |ykQ ykQ ykQ ykQ ykQ 1zkQ 5zkQ @zkQ }kQ u~kQ 8kQ kQ kQ kQ kQ kQ kQ kQ kQ kQ ZkQ PkQ kQ &kQ ;MkQ hfkQ 8}@z $D M  8; ҷ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 I$DIG: ADD #'0-36,R1 RTS PC T: .BYTE '$,'.,'? .EVEN .END KBPL PLUS ;JUMP IF + ADD #100000,R0 ;GET 2**32 +G PLUS: MOV R0,@R2 ;STORE NEXT GENERATOR MOV R1,@R3 MOV #201,R2 ;GET INITIAL EXPONENT NORM: ASL R1 ;FLOAT RESULT ROL R0 BCS EXP ;JUMP IF LEADING BIT FOUND DEC R2 ;COMPENSATE EXPONENT BR NORM EXP: CLRB R1 BISB R0,R1 SWAB R1 CLRB R0 BISB R2,R0 ;INSERT EXPONENT IN RESULT SWAB R0 ROR R0 ROR R1 ;INSERT + SIGN MOV (R5)+,R3 ;ADDRESS OF R MOV R0,(R3)+ ;STORE RESULT FOR USER MOV R1,@R3 BR RTN ; INIT: MOV #3,R1 INC R0 ;SET UP L .TITLE $REL $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 REAL ; THE FORTRAN REAL FUNCTION. ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 COMPLEX ARG) ; ; RETURNS THE REAL PART OF ARG IN RO,R1. R0=%0 R1=%1 R5=%5 REAL: MOV 2(R5),R1 ;GET ARG ADDRESS MOV (R1)+,R0 ;GET HIGH ORDER REAL MOV @R1,R1 ;GET LOW ORDER N .TITLE $RI $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 $RI,$DI,$ERRA ; REAL TO INTEGER CONVERSION. ; ARGUMENT IS A DOUBLE WORD REAL NUMBER ON THE TOP ; OF THE STACK. ; TRUNCATE IT AND CONVERT IT TO AN INTEGER ON THE ; TOP OF THE STACK. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 MQ=177304 LSH=177314 O2**16 +3 BR PLUS ; ERROR: MOV #6404,R0 ;ERROR 4,13. JSR PC,$ERRA RTN: .F4RTN .END P .F4RTN ;RETURN TO USER .END Q .TITLE $RIO $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 $RIO,$ERRA .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; THIS ROUTINE DOES TRANSFERS TO OR FROM RANDOM I/O RECORD ; $RIO: MOV ARGLEN(R4),R0 ;GET NUM BYTES TO TRANSFER MOV ARGPTR(R4),R1 ;GET ITEM LOC MOV RECPTR(R4),R2 ;GET RECORD BUFFER LOC RF0=%0 .IFDF FPU $DI: SETD ; DOUBLE PRECISION BR RIDI; $RI: SETF ; SINGLE PRECISION RIDI: SETI ; SHORT INTEGERS LDD (SP)+,F0; GET ARGUMENT STCDI F0,-(SP); CONVERT TO STACK JMP @(R4)+; RETURN .ENDC .IFNDF FPU $DI: MOV (SP)+,2(SP); TRUNCATE TO REAL FORMAT MOV (SP)+,2(SP); $RI: CLR R2 ;CLEAR WORK SPACE INC R2 ;SET UP NORMAL BIT MOV (SP)+,R1 ;GET REAL ARGUMENT ROL @SP ;GET SIGN ROL R1 ;AND ROL -(SP) ;SAVE IT MOVB R1,R3 ;GET HIGH ORDER FRACTION CLRB R1 SWAB R1 ;GET EXPONU MOV R2,R3 ;SET RECORD BUFFER LOC IN R3 TST IOSW(R4) ;IF OUTPUT REVERSE R1 AND R2 BNE RIO1 MOV R1,R2 MOV R3,R1 ; ; ; RIO1: CMP R3,RECEND(R4) ;CHECK IF BUFFER EMPTY BLO RIO3 ;BRANCH IF NOT TST LENMAX(R5) ;CHECK IF ANY MORE CHARS IN REC BEQ SHORT ;BRANCH IF NOT - ERROR SHORT RECORD ; MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) JSR PC,@IOTADR(R4) ;ELSE GET NEXT BUFFER OF REC MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 ; MOV RECPTR(R4),R3 ;RESET RECPTR IN PROPER REGS TST IOSW(RVENT SUB #201,R1 BLT ZERO ;JUMP IF IT IS TOO SMALL BEQ DONE CMP #15.,R1 BLT OVER ;JUMP IF IT IS TOO BIG SWAB R3 ;FORM 16 BITS OF HIGH ORDER FRACTION CLRB R3 BISB 3(SP),R3 SHFT: .IFNDF EAE&MULDIV ROL R3 ;GET NEXT BIT ROL R2 DEC: DEC R1 ;DECREASE EXPONENT BGT SHFT ;GO AGAIN IF NOT DONE .ENDC ; ; EAE CODE .IFDF EAE MOV #MQ,R0 ;POINT TO MQ MOV R3,@R0 ;INSERT FRACTION MOV R2,-(R0) MOV R1,@#LSH ;SHIFT LEFT MOV @R0,R2 ;RESULT TO REG .ENDC ; MULDIV CODE .IFDF MULDIV W .TITLE $RWD $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 $RWIND,$ENDFL,$CLOSE,$FNDEV .GLOBL $ERRA,$EXIT .GLOBL $AIOB .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ;THIS ROUTINE IS END FILE AND REWIND ; $RWIND: $ENDFL: MOV (SP)+,R0 ;GET DEVICE NUM JSR PC,$FNDEV ;GET DEVICE TABLE ENTRY TST X .TITLE $SBI $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 R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .GLOBL $SBI ; ; $SBI - SUBTRACT INTEGER ; $SBI: SUB (SP)+,@SP BVC SBI1 MOV #6403,R0 JSR PC,$ERRA SBI1: JMP @(R4)+ .GLOBL $ERRA ; .END Y4) BEQ RIO2 MOV R3,R2 BR RIO1 RIO2: MOV R3,R1 BR RIO1 ; RIO3: MOVB (R2)+,(R1)+ ;MOVE CHARS TO/FROM REC INC R3 ;INC BUFFER PTR DEC LENMAX(R5) ;DEC NUM CHARS IN REC REMAINING DEC R0 ;CHECK IF ITEM TRANSFER DONE BNE RIO1 ;BRANCH IF NOT ; MOV R3,RECPTR(R4) ;RESTORE RECORD BUFFER PTR RTS PC ;RETURN TO CALLER ; ; SHORT: MOV #770.,R0 ;ERROR - SHORT REC (MORE ITEMS THAN REC) JSR PC,$ERRA ;CALL ERROR CLASS=2/NUM=3 INC ERRFLG(R4) ;IF ERROR RETNS SET FLG RTS PC ; ; .END Z .WORD 073201 ;;ASHC R1,R2 .ENDC DONE: NEG R2 ;MAKE - BVS NEGM ;JUMP IF POSSIBLE NEGMAX BGT OVER ;JUMP IF MORE THAN 15 BITS SIGN: ROR (SP)+ ;GET SIGN BCS OUT ;JUMP IF - NEG R2 ;- RESULT OUT: MOV R2,@SP ;STORE INTEGER RESULT JMP @(R4)+ ;RETURN TO CALLER NEGM: ROR (SP)+ BCS OUT ;OK IF RESULT TO BE - OVER: TST -(SP) ;FAKE SIGN MOV #13003,R0 ;ERROR 3,22. JSR PC,$ERRA ZERO: CLR R2 ;ANSWER IS 0 BR SIGN .ENDC .END [R1 ;BRANCH IF ERROR BEQ BADEV ; BITB DVSW(R1),#3 ;IF FILE CLOSED, EXIT BEQ RDEFX JSR PC,$AIOB ;GET ADDR $IOBUF IN R2 ; MOV DVLP(R1),BFLP(R2) ;SET LINK PTR JSR PC,$CLOSE ;CLOSE FILE MOV BFLP(R2),DVLP(R1) ;RESTORE LINK POINTER TST R3 BNE CLOSER ;BRANCH IF ERROR ; RDEFX: JMP @(R4)+ ;GO TO NEXT STMT ; BADEV: MOV #12.,R3 MOV #1,R0 RWEFER: SWAB R3 BIS R3,R0 JSR PC,$ERRA JSR PC,$EXIT CLOSER: MOV #1,R3 CLR R0 BR RWEFER ; .END ` .TITLE $SBS $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 $SBS1,$SBS2,$SBS3,$ERRA ; $SBS1,$SBS2,$SBS3 GENERAL ARRAY SUBSCRIPTING ; CALLED IN THE POLISH MODE ; WITH R4 POINTING TO THE ADDRESS OF THE ADB. ; THE ADB CONTAINS THE FOLLOWING INFORMATION: ; WORD1 ADDRESS OF FIRST ARRAY ELEMENT (ADDR) ; WORD2 ELEMENT SIZE Ia .TITLE $SBX $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 $SBX1,$SBX2,$SBX3,$ERRA ; $SBX1,$SBX2,$SBX3 ARRAY SUBSCRIPTING WITH BOUNDS CHECKS ; CALLED IN THE POLISH MODE ; WITH R4 POINTING TO THE ADDRESS OF THE ADB. ; THE ADB CONTAINS THE FOLLOWING INFORMATION: ; WORD1 ADDRESS OF FIRST ARRAY ELEMENT (ADDR) ; WORD2 ELb .TITLE $SECND $VERSN 04 ; ; COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .CSECT .GLOBL $POLSH,$IR,$MLR .GLOBL $ADR,$DVR,$SBR,SECNDS SECNDS: MOV #104,-(SP) ;TIME REQUEST EMT 41 JSR R4,$POLSH ;WITH TWO INTEGERS ON STACK $IR ;FLOAT LOW ORDER PART SUFFLE ;EXCHANGE HIGH AND FLOATc .TITLE $SEQ $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 $SEQ .GLOBL $AOTS .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; SAVE SEQUENCE NUM OF CURRENT FORTRAN STMT ; ; $SEQ: JSR PC,$AOTS MOV (R4)+,10(R0) ;PUT NUM IN $SEQC ; JMP @(R4)+ ;EXIT ; ; .END dN BYTES (SIZE) CONTAINED IN ; THE LOW ORDER BYTE. ; WORD3 FIRST DIMENSION (A) ; WORD4 SECOND DIMENSION (B) ; WORD5 THIRD DIMENSION (C) ; INDICES ARE PUSHED ON THE STACK IN THE ORDER ; IN WHICH THEY ARE ENCOUNTERED. THUS FOR SBS1 THE FIRST ; INDEX I IS @SP. FOR SBS2 THE SECOND INDEX J IS @SP. ; FOR SBS3 THE THIRD INDEX K IS @SP. ; RETURNS THE POINTER TO THE ARRAY ELEMENT IN R0. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 MQ=177304 .IFNDF MULDIV $SBS1: MOV (R4)+,R3 ;GET AeEMENT SIZE IN BYTES (SIZE) CONTAINED IN ; THE LOW ORDER BYTE. ; WORD3 FIRST DIMENSION (A) ; WORD4 SECOND DIMENSION (B) ; WORD5 THIRD DIMENSION (C) ; INDICES ARE PUSHED ON THE STACK IN THE ORDER ; IN WHICH THEY ARE ENCOUNTERED. THUS FOR SBS1 THE FIRST ; INDEX I IS @SP. FOR SBS2 THE SECOND INDEX J IS @SP. ; FOR SBS3 THE THIRD INDEX K IS @SP. ; RETURNS THE POINTER TO THE ARRAY ELEMENT IN R0. R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 MQ=177304 .IFNDF MULDIV $SBX1: MOV (R4fED LOW $IR ;FLOAT HIGH ORDER PART $P0013 $MLR $ADR $P0014 $DVR $P0015 $SBR .+2 MOV (SP)+,R0 MOV (SP)+,R1 .F4RTN $P0013: MOV #ICON+4,R0 F001: MOV -(R0),-(SP) MOV -(R0),-(SP) JMP @(R4)+ $P0014: MOV #I60+4,R0 MOV #113,-(SP) EMT 41 ASR (SP)+ BCC F001 MOV #I50+4,R0 BR F001 $P0015: MOV 2(R5),R0 MOV 2(R0),-(SP) MOV @R0,-(SP) JMP @(R4)+ SUFFLE: MOV 4(SP),R0 MOV 2(SP),4(SP) MOV @SP,2(SP) MOV R0,@SP JMP @(R4)+ ICON: .FLT2 32768. I60: .FLT2 60. I50: .FLT2ghDB POINTER CLR R0 BR SBS1A $SBS2: MOV (R4)+,R3 ;GET ADB POINTER CLR R0 BR SBS2A $SBS3: MOV (R4)+,R3 ;GET ADB POINTER MOV (SP)+,R2 ;GET K DEC R2 BLT ERROR2 ;JUMP IF K < 1 ; CMP R2,8.(R3) ; BGE ERROR2 ;JUMP IF K > C MOV 6(R3),R1 ;GET B JSR PC,MULT ;R0=B*(K-1) SBS2A: MOV (SP)+,R2 ;GET J DEC R2 BLT ERROR1 ;JUMP IF J < 1 ; CMP R2,6(R3) ; BGE ERROR1 ;JUMP IF J > B ADD R0,R2 ;J-1+B*(K-1) MOV 4(R3),R1 ;GET A JSR PC,MULT ;A*(J-1+B*(K-1)) SBS1A: MOV (SP)+,R2 ;GET I DEC R2 BLTi)+,R3 ;GET ADB POINTER CLR R0 BR SBS1A $SBX2: MOV (R4)+,R3 ;GET ADB POINTER CLR R0 BR SBS2A $SBX3: MOV (R4)+,R3 ;GET ADB POINTER MOV (SP)+,R2 ;GET K DEC R2 BLT ERROR2 ;JUMP IF K < 1 CMP R2,8.(R3) BGE ERR2G ;JUMP IF K > C MOV 6(R3),R1 ;GET B JSR PC,MULT ;R0=B*(K-1) SBS2A: MOV (SP)+,R2 ;GET J DEC R2 BLT ERROR1 ;JUMP IF J < 1 CMP R2,6(R3) BGE ERR1G ;JUMP IF J > B ADD R0,R2 ;J-1+B*(K-1) MOV 4(R3),R1 ;GET A JSR PC,MULT ;A*(J-1+B*(K-1)) SBS1A: MOV (SP)+,R2 ;GET I DEC R2j 50. .END l ERROR ; CMP R2,4(R3) ; BGE ERROR ;JUMP IF I > A ADD R2,R0 ;I-1+A*(J-1+B*(K-1)) MOVB 2(R3),R2 ;GET ELEMENT SIZE SHFT: ASR R2 ;EXAMINE NEXT SIZE BIT BEQ DONE ASL R0 ;DOUBLE LINEAR INDEX BR SHFT DONE: ADD @R3,R0 ;ADD ON ARRAY BASE JMP @(R4)+ ;RETURN TO CALLER ERROR2: TST (SP)+ ERROR1: TST (SP)+ ERROR: MOV #7,R0 ;ERROR 7,0 JSR PC,$ERRA MOV @R3,R0; ERROR - RETURN FIRST ELEMENT JMP @(R4)+ ; .IFNDF EAE MULT: CLR R0 ;CLEAR ACCUMULATOR MULT1: ASR R2 ;SHIFT MULTIPLIER BCC X0 ;JUMP Im BLT ERROR CMP R2,4(R3) BGE ERRG ;JUMP IF I > A ADD R2,R0 ;I-1+A*(J-1+B*(K-1)) MOVB 2(R3),R2 ;GET ELEMENT SIZE SHFT: ASR R2 ;EXAMINE NEXT SIZE BIT BEQ DONE ASL R0 ;DOUBLE LINEAR INDEX BR SHFT DONE: ADD @R3,R0 ;ADD ON ARRAY BASE JMP @(R4)+ ;RETURN TO CALLER ; .IFNDF EAE MULT: CLR R0 ;CLEAR ACCUMULATOR MULT1: ASR R2 ;SHIFT MULTIPLIER BCC X0 ;JUMP IF LOW ORDER BIT IS 0 ADD R1,R0 ;ADD IN MULTIPLICAND X0: BEQ RTN ;JUMP IF DONE ASL R1 ;SHIFT MULTIPLICAND BR MULT1 ;LOOP AGAIN Ro .TITLE $SER $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 SETERR,$AOTS .GLOBL .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; CALL SETERR (ERR CLASS, LOG LIMIT VALUE) ; SETERR: MOV R5,-(SP) CMPB #2,(R5) BNE EREX ;IF NOT 2 ARGS EXIT TST (R5)+ MOV @(R5)+,R4 ;GET CLASS NUM BLE EREX MOVpF LOW ORDER BIT IS 0 ADD R1,R0 ;ADD IN MULTIPLICAND X0: BEQ RTN ;JUMP IF DONE ASL R1 ;SHIFT MULTIPLICAND BR MULT1 ;LOOP AGAIN RTN: RTS PC .ENDC ; EAE CODE .IFDF EAE MULT: MOV #MQ,R0 ;POINT TO MQ MOV R1,(R0)+ ;MULTIPLIER TO MQ MOV R2,@R0 ;MULTIPLY MOV -(R0),R0 ;PRODUCT TO R0 RTS PC .ENDC .ENDC .IFDF MULDIV $SBS1: MOV (R4)+,R3 ;GET ADB POINTER CLR R1 BR SBS1A $SBS2: MOV (R4)+,R3 ;GET ADB POINTER CLR R1 BR SBS2A $SBS3: MOV (R4)+,R3 ;GET ADB POINTER MOV (SP)+,R1 ;GET KqTN: RTS PC .ENDC ; EAE CODE .IFDF EAE MULT: MOV #MQ,R0 ;POINT TO MQ MOV R1,(R0)+ ;MULTIPLIER TO MQ MOV R2,@R0 ;MULTIPLY MOV -(R0),R0 ;PRODUCT TO R0 RTS PC .ENDC .ENDC .IFDF MULDIV $SBX1: MOV (R4)+,R3 ;GET ADB POINTER CLR R1 BR SBS1A $SBX2: MOV (R4)+,R3 ;GET ADB POINTER CLR R1 BR SBS2A $SBX3: MOV (R4)+,R3 ;GET ADB POINTER MOV (SP)+,R1 ;GET K DEC R1 BLT ERROR2 ;JUMP IF K < 1 CMP R1,8.(R3) BGE ERR2G ;JUMP IF K > C MUL 6(R3),R1; R1=B*(K-1) SBS2A: MOV (SP)+,R2 ;GET Jr .TITLE $SFL $VERSN 07 ; ; ;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 SETFIL,$ERRA,$ADEV .GLOBL $AOTS .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE PROVIDES A MEANS BY WHICH THE USER MAY ; OVERRIDE THE DEVICE TABLE DEFAULTS FOR A FORTRAN DEVICE ; ; CALLING SEQUENCE ; ; FORTRAN STANDARD (FOLLOWIs @(R5),R3 ;GET MAX LOG VALUE JSR PC,$AOTS ;GET ADDR OF OTS TABLES MOV 4(R0),R5 ;GET ADDR OF $ERRC .IFDF FPU CMP R4,#5; TEST IF ERROR CLASS 5 BNE CHK; NO STFPS -(SP); GET FPU STATUS WORD BIS #2000,@SP; ENABLE UNDERFLOW INTERRUPTS CMP R3,#-1; TEST FOR NO-LOG-IGNORE BNE LOAD; NOT-INTERRUPTS REQUIRED BIC #2000,@SP; DISABLE INTERRUPT LOAD: LDFPS (SP)+; RELOAD FPU STATUS .ENDC CHK: CMP R4,-2(R5) ;CHECK IF VALID CLASS BHI EREX ;EXIT IF NOT ASL R4 ASL R4 ASL R4 ADD R4,R5 t DEC R1 BLT ERROR2 ;JUMP IF K < 1 ; CMP R1,8.(R3) ; BGE ERROR2 ;JUMP IF K > C MUL 6(R3),R1; R1=B*(K-1) SBS2A: MOV (SP)+,R2 ;GET J DEC R2 BLT ERROR1 ;JUMP IF J < 1 ; CMP R2,6(R3) ; BGE ERROR1 ;JUMP IF J > B ADD R2,R1; J-1+B*(K-1) MUL 4(R3),R1; R1=A*(J-1+B*(K-1)) SBS1A: MOV (SP)+,R2 ;GET I DEC R2 BLT ERROR ; CMP R2,4(R3) ; BGE ERROR ;JUMP IF I > A ADD R2,R1 ;I-1+A*(J-1+B*(K-1)) MOVB 2(R3),R2 ;GET ELEMENT SIZE MUL R2,R1; INDEX*ELEMENT SIZE MOV R1,R0; SET UP RESULT DONE: u DEC R2 BLT ERROR1 ;JUMP IF J < 1 CMP R2,6(R3) BGE ERR1G ;JUMP IF J > B ADD R2,R1; J-1+B*(K-1) MUL 4(R3),R1; R1=A*(J-1+B*(K-1)) SBS1A: MOV (SP)+,R2 ;GET I DEC R2 BLT ERROR CMP R2,4(R3) BGE ERRG ;JUMP IF I > A ADD R2,R1 ;I-1+A*(J-1+B*(K-1)) MOVB 2(R3),R2 ;GET ELEMENT SIZE MUL R2,R1; INDEX*ELEMENT SIZE MOV R1,R0; SET UP RESULT DONE: ADD @R3,R0 ;ADD ON ARRAY BASE JMP @(R4)+ ;RETURN TO CALLER .ENDC ERROR2: TST (SP)+ ERROR1: TST (SP)+ ERROR: MOV #7,R0 ;ERROR 7,0 JSR PCvNG ARGS ALLOWED) ; ; ADDR OF LOG DEVICE NUM(INTEGER) ; ADDR OF FILE NAME(ASCII STRING) ; ADDR OF ERROR VALUE VAR(INTEGER) ; ADDR OF PHYSICAL DEVICE NAME(3 CHAR ASCII) ; ADDR OF UNIT NUM(INTEGER) ; ADDR OF UIC (INTEGER) ; ADDR OF PROTECT CODE(INTEGER) ; ADDR OF ALLOCATE FILE VALUE(INTEGER) ; ADDR OF RECORD LEN TO ALLOC(INTEGER) ; ADDR OF NUM RECS TO ALLOC(INTEGER) ; SETFIL: MOV R5,-(SP) ;SAVE REG JSR PC,$ADEV ;GET ADDR OF DEVTAB MOV R0,R4 ;PUT IN R4 MOVB (R5),R3 ;GET NUM ARGS IN CALL w MOV R3,4(R5) ;SET NEW VALUE EREX: MOV (SP)+,R5 .F4RTN ;EXIT ; ; .END xADD @R3,R0 ;ADD ON ARRAY BASE JMP @(R4)+ ;RETURN TO CALLER ERROR2: TST (SP)+ ERROR1: TST (SP)+ ERROR: MOV #7,R0 ;ERROR 7,0 JSR PC,$ERRA MOV @R3,R0; ERROR - RETURN FIRST ELEMENT JMP @(R4)+ .ENDC .END y,$ERRA MOV @R3,R0; ERROR - RETURN FIRST ELEMENT JMP @(R4)+ ERR2G: TST (SP)+; ERR1G: TST (SP)+; ERRG: MOV #407,R0 ;ERROR 7,1 JSR PC,$ERRA MOV @R3,R0; ERROR - RETURN FIRST ELEMENT JMP @(R4)+; .END z BEQ EXFIL ;EXIT IF NO ARGS TST (R5)+ MOV @(R5)+,R1 ;BRANCH IF DEVICE<=0 BLE ERR1 CMP R1,(R4) ;OR GREATER THAN MAX BGT ERR1 ASL R1 ADD R1,R4 MOV 2(R4),R4 ;ADDR OF DEVTB ENTRY FOR DEVICE DEC R3 BEQ EXFIL ;EXIT IF NO MORE ARGS BITB #3,DVSW(R4) ;CHECK IF FILE OPEN BNE ERR2 ;EXIT IF OPEN MOV (R5)+,R1 ;GET ADDR OF FILE NAME AND EXT ; ; CONVERT FILE NAME AND EXTENSION ; ; FILE NAME IS ONE TO SIX ALPHANUMERIC CHARACTERS ; THE FIRST CHARACTER IS REQUIRED TO BE AN ALPHA. ; ; ~THE CHARACTER DOT(.) MUST PRECEDE ANY ; EXTENSION WHICH MAY BE FROM ONE TO THREE CHARACTERS. ; ; ANY OTHER CHARACTERS WILL TERMINATE THE ; SCAN ; MOV #5,R0 ;BLANK THE TEMP BUFFER FNAME1: MOV #" ,-(SP) DEC R0 BNE FNAME1 MOV SP,R2 ;POINT AT BUFFER MOV #6,R0 ;SET FILE NAME COUNT MOV R0,-(SP) ;AND FLAG BR FNAME8 ;REQUIRE FIRST CHAR ;TO BE ALPHA FNAME2: CMPB (R1),#'0 ;BRANCH IF CHAR NON NUMERIC BLT FNAME4 CMPB (R1),#'9 BLE FNAME3 ;BR IF NUMERIC FNAME8: CMPB (R1),#'A ;CHEC .TITLE $SGL $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 SNGL,$ERRA ; THE FORTRAN SNGL FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS THE ARGUMENT ROUNDED TO SINGLE ; PRECISON REAL FORMAT IN R0, R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SNGL: MOV 2(R5),R4 ;GET ADDRESS MOV (R4)+,R0 ;GET HIGH .TITLE $SGN $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 SIGN ; THE FORTRAN SIGN FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (2 ARGS) ; ; RETURNS SIGN (ARG2) * ABS(ARG1) IN R0, R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SIGN: MOV 2(R5),R1 ;GET FIRST ARG ADDRESS MOV @R1,R0 ;GET FIRST ARG IN R0,R1 MOV 2(R1),R1 .TITLE $SIN $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 SIN,COS; .IFNDF FPU .GLOBL $ADR,$MLR,$SBR,$DVR,$INTR,$POLSH .ENDC ; SIN COS THE REAL SIN AND COSINE FUNCTIONS ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS SIN OR COS OF ARG IN R0 AND R1 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SPK FOR ALPHA BLT FNAME4 ;BRANCH IF NON ALPHA CMPB (R1),#'Z BGT FNAME4 FNAME3: MOVB (R1)+,(R2)+ ;STORE AN ALPHANUMERIC DEC R0 BNE FNAME2 ;CONTINUE SCAN FNAME4: TST (SP) ;BRANCH IF EXT FLG SET BEQ FNAME5 CMP R0,(SP) ;OR IF FIRST CHAR ;IS NON ALPHA BEQ FNAME7 CMPB #'.,(R1)+ ;BR IF INVALID CHAR BNE FNAME5 CLR (SP) ;SET EXT FLAG MOV SP,R2 ;AND POINTERS ADD #10,R2 MOV #3,R0 BR FNAME2 ;SCAN EXTENSION FNAME5: MOV R4,R1 ;POINT TO FILE NAME ADD #DVFLNM,R1 ;IN $DEVTB EN ORDER MOV (R4)+,R1 ;GET LOW ORDER MOV @R4,R4 ;GET NEXT WORD ROL R4 ;GET ROUND BIT ADC R1 ;ROUND REAL ADC R0 BCS OVER ;JUMP IF OVERFLOW ON ROUND BVS OVER BR RTN OVER: MOV #6004,R0 ;ERROR 4,12. JSR PC,$ERRA RTN: .F4RTN .END MOV @4(R5),R4 ;GET HIGH ORDER SECOND ARG ROL R0 ;DUMP FIRST ARG SIGN ROL R4 ;GET SECOND ARG SIGN ROR R0 ;INSERT IN FIRST ARG .F4RTN .END =%6 PC=%7 F0=%0 F1=%1 F2=%2 F3=%3 .IFNDF FPU COS: MOV 2(R5),R4 ;GET ARGUMENT ADDRESS CLR -(SP) ;MAKE ROOM FOR QUADRANT FLAG MOV 2(R4),-(SP) ;PUSH ARGUMENT MOV @R4,-(SP) MOV #007733,-(SP) ;PUSH PI/2 MOV #040311,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD $ADR,SINCOS ;COS(X)=SIN(X+PI/2) SIN: MOV 2(R5),R4 ;GET ARGUMENT ADDRESS CLR -(SP) ;MAKE ROOM FOR QUADRANT FLAG MOV 2(R4),-(SP) MOV @R4,-(SP) ;PUSH ARGUMENT SINCOS: ASL @SP ;REMOVE AND SAVE SIGN ROR 4(SP) ;IN QUADRANT FTRY MOV #2,R0 MOV SP,(SP) ;POINT AT FILE NAM & EXT ADD R0,(SP) FNAME6: CLR -(SP) EMT 42 ;CVT TO RAD50 MOV (SP)+,(R1)+ ;AND STORE FILE NAM & EXT DEC R0 BGE FNAME6 FNAME7: ADD #14,SP ;REMOVE TEMP BUFFER DEC R3 BEQ EXFIL MOV (R5),DVARAD(R4) ;SET ADDR OF ERROR VAR CLR @(R5)+ ;CLEAR ERROR VARIABLE TO 0 DEC R3 BEQ EXFIL MOV (R5)+,-(SP) ;PACK PHYS DEV NAM CLR -(SP) EMT 42 MOV (SP)+,DVPDVN(R4) TST (SP)+ DEC R3 BEQ EXFIL MOVB @(R5),DVUNUM(R4) ;GET UNIT NUM TST (R5)LAG ROR @SP MOV #007733,-(SP) ;PUSH 2*PI MOV #040711,-(SP) JSR R4,$POLSH ;ENTER POLISH MODE .WORD $DVR ;X/2PI .WORD DUP ;2 COPIES .WORD $INTR ;INT(X/2PI) .WORD $SBR ;FRACT(X/2PI) .WORD X4 ;4*FRACT(X/2PI) .WORD DUP ;2 COPIES .WORD $INTR ;INT(4*FRACT(X/2PI)) .WORD QUAD ;SAVE INT(......) .WORD $SBR ;Y=FRACT(4*FRACT(X/2PI)) .WORD QSET ;REDUCE Y TO (-1,1) QSETRE: .WORD DUP ;2 COPIES .WORD DUP ;3 COPIES .WORD $MLR ;Y*Y .WORD POLY ;PUSH COEFFICIENTS .WORD $MLR ;A4*Y**2 .WOR+ DEC R3 BEQ EXFIL MOV @(R5)+,DVUIC(R4) ;GET UIC DEC R3 BEQ EXFIL MOVB @(R5),DVPC(R4) ;GET PROTECT CODE TST (R5)+ DEC R3 BEQ EXFIL CMP @(R5),#2 ;CHECK IF RANDOM ALLOCATE BEQ RANAL ;BRANCH IF RANDOM (DEFN FILE SETS) CMP @(R5)+,#1 ;CHECK IF NON-RANDOM ALLOCATE BNE SFERR ;ERROR IF NOT CMP R3,#3 ;MUST BE 2 MORE ARGS BNE SFERR ;ERROR IF NOT MOV @(R5)+,R0; SET RECLEN ASL R0; CONVERT TO BYTE COUNT MOV R0,DVRLEN(R4); MOV @(R5)+,DVRMAX(R4) ;SENUM RECS TO ALLOC RANAL: .TITLE $SQT $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 SQRT,$ERRA; .IFNDF FPU .GLOBL $ADR,$DVR,$POLSH; .ENDC ; SQRT THE REAL SQUARE ROOT FUNCTION ; CALLING SEQUENCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS THE SQUARE ROOT IN R0 AND R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SP=%6 F0=%0 F1=%1 F2=%2 .I .TITLE $SRV $VERSN 01 ; ;COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD,MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; .GLOBL $APDU,$ADEV,$AOTS,$AIOB,$SERR .GLOBL $OTSV,$ERRF,$AERF ; ; GENERAL SERVICE ROUTINES FOR DOS/RSX11B-C ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; RETURN ADDR OF OTS TABLES IN R0 ; $AOTS: .IFDF RSX MOV #107,-(SP) EMT 41 MOV (SP)+,R0 ;ADDR OFD $ADR ;A4*Y**2+A3 .WORD $MLR .WORD $ADR .WORD $MLR .WORD $ADR .WORD $MLR .WORD $ADR .WORD $MLR ;((((A4*Z+A3)*Z+A3)*Z+A2)*Z ;+A1)*Z+A0)*Z Z=Y*Y .WORD RTN RTN: MOV (SP)+,R0 ;POP HIGH ORDER RESULT MOV (SP)+,R1 TST (SP)+ ;POP QUADRANT FLAG BGE RTN1 ;JUMP IF ARGUMENT WAS + ADD #100000,R0 ;SIN(-X)=-SIN(X) RTN1: .F4RTN ;BACK TO CALLER ; DUP: MOV 2(SP),-(SP) ;DUPLICATE STACK ITEM MOV 2(SP),-(SP) JMP @(R4)+ ; X4: TST @SP ;CHECK FOR 0 FRACTION BEQ RTN ;QUIT NOW INCB 1 MOVB #127.,DVHOPN(R4) ;SET FLAG TO INDICATE ALLOC REQD EXFIL: MOV (SP)+,R5 ;RESTORE REG .F4RTN ;EXIT ; SFERR: MOV #-1,@DVARAD(R4) ;SET INVALID ARGS ERROR ERR1: MOV #7404,R0 ;ERROR 4,15. ERR: JSR PC,$ERRA BR EXFIL ;EXIT ; ERR2: MOV #10004,R0 ;ERROR 4,16. BR ERR ; ; ; .END FDF FPU SQRT: MOV @2(R5),R1; GET HIGH ORDER ARGUMENT .ENDC .IFNDF FPU SQRT: MOV R5,-(SP) MOV 2(R5),R5 ;GET ARGUMENT ADDRESS MOV @R5,R1 ;GET HIGH ORDER ARGUMENT .ENDC BMI ERROR ;ERROR IF ARGUMENT NEGATIVE BEQ ZERO ;FAST EXIT IF ZERO .IFNDF FPU MOV #3,-(SP) ;PUSH ITERATION COUNT .ENDC ASR R1 ;FORM INITIAL ESTIMATE ADD #20100,R1 CLR -(SP) ;USE ONLY HIGH ORDER PARTS FIRST MOV R1,-(SP) ;'CAUSE ADD AND DIVIDE ARE .IFNDF FPU CLR -(SP) ;FASTER THAT WAY MOV @R5,-(SP) CLR -(SP) OTS TABLES .ENDC .IFNDF RSX MOV #$OTSV,R0 ;ADDR OF OTS TABLES .ENDC RTS PC ; ; RETURN ADDR OF DEVICE TABLE IN R0 ; $ADEV: JSR PC,$AOTS ;GET OTS TABLES ADDR MOV (R0),R0 ;ADDR OF DEVICE TABLE RTS PC ; ; RETURN ADDR OF PDUMP UNIT NUM IN R0 ; $APDU: JSR PC,$ADEV ;GET DEVICE TABLE ADDR TST (R0)+ ;ADDR OF PDUMP UNIT NUM RTS PC ; ; RETURN ADDR OF I/O BUFFER IN R2 ; $AIOB: MOV R0,-(SP) ;SAVE R0 JSR PC,$AOTS ;GET ADDR OTS TABLES MOV 2(R0),R2 ;ADDR I/O BUFFER MOV (SP)+,R0 ;RES(SP) ;QUADRUPLE STACK ITEM JMP @(R4)+ ; QUAD: BIS @SP,8.(SP) ;SAVE QUADRANT NUMBER JMP @(R4)+ ; QSET: TSTB 4(SP) ;TEST QUADRANT BEQ Q13 ;JUMP IF FIRST OR THIRD QUAD ADD #100000,@SP ;NEGATE STACK ITEM CLR -(SP) ;PUSH A FLOATING 1. MOV #40200,-(SP) JSR R4,$POLSH ;ENTER POLISH .WORD $ADR,QSETR ;X=1.-X QSETR: MOV #QSETRE,R4 ;POINT BACK INTO LIST Q13: ASRB 5(SP) ;TEST QUADRANT ; BCC QOUT ;JUMP IF FIRST OR SECOND ADD #100000,@SP ;NEGATE STACK ITEM QOUT: JMP @(R4)+ ; POLY: MOV (SP)+ MOV R1,-(SP) LOOP: JSR R4,$POLSH ;ENTER POLISH MODE .WORD $DVR,$ADR,UNPOL ;(X/E+E) UNPOL: SUB #200,@SP ;(X/E+E)/2 DEC 4(SP) ;COUNT LOOP BEQ OUT MOV 2(R5),-(SP) ;USE LOW ORDER PARTS MOV @R5,-(SP) ;TOO FROM NOW ON MOV 6(SP),-(SP) MOV 6(SP),-(SP) BR LOOP ;GO FOR ANOTHER ITERATION OUT: MOV (SP)+,R0 ;GET RESULT INTO R0,R1 MOV (SP)+,R1 TST (SP)+ ;POP ITERATION COUNTER RTN: MOV (SP)+,R5 .F4RTN ;RETURN TO CALLER ERROR: MOV #5404,R0 ;ERROR 4,11. JSR PC,$ERRA BR RTN ZERO: CLR R0 TORE R0 RTS PC ; ; STORE (R3) IN ERROR VARIALBE FOR $IOF($IOERR) ; $SERR: TST DVARAD(R1) ;EXIT IF ERR VAR NOT SPECD BEQ SERX MOV R3,@DVARAD(R1) ;STORE ERROR VALUE SERX: RTS PC .IFNDF RSX ; ; RETURN ADDR OF $ERRF (ERROR FLAG VECTOR) IN R0 ; $AERF: MOV #$ERRF,R0 RTS PC .ENDC ; ; .END ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ,R0 ;SAVE Y*Y MOV (SP)+,R1 MOV #CONSTS+4,R2 ;POINT TO LIST OF COEFFICIENTS MOV #5,R3 BR POLY1 POLY2: MOV R1,-(SP) ;PUSH Y*Y MOV R0,-(SP) POLY1: MOV -(R2),-(SP) MOV -(R2),-(SP) DEC R3 ;COUNT COEFFICIENTS BGT POLY2 JMP @(R4)+ .ENDC ; .IFDF FPU COS: SETD ; DOUBLE PRECISION FP LDCFD @2(R5),F0; GET ARGUMENT ADDD PIOV2,F0; COS(X)= SIN(X+PI/2) BR SINCOS; SIN: SETD ; DOUBLE PRECISON FP LDCFD @2(R5),F0; GET ARGUMENT SINCOS: SETI ; SHORT INTEGERS MOV #FCONST,R0; POINTER TO .TITLE $SSP $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 ; ; THE FOLLOWING ROUTINE SAVES STACK ADDRESSES AT ADDRESS ; SPECIFIED FOLLOWING THE CALL. THIS ROUTINE IS USED ; FOR ADDRESS SUBSTITUTION IN SUBROUTINE CALLS. ; .GLOBL $SVSP $SVSP: MOV SP,@(R4 CLR R1 BR RTN .ENDC .IFDF FPU MOV #3,R0; ITERATION COUNT SETF ; SINGLE PRECISION FP LDF (SP)+,F0; GET INITIAL ESTIMATE LDF @2(R5),F2; GET X ; LOOP: LDF F0,F1; E=E' LDF F2,F0; X DIVF F1,F0; X/E ADDF F1,F0; X/E+E DEC R0; COUNT DIVF #2.0,F0; E'=(X/E+E)/2 BGT LOOP; ; STF F0,-(SP); RESULT TO STACK MOV (SP)+,R0; AND THENCE TO R0,R1 MOV (SP)+,R1; RTN: .F4RTN ; ERROR: MOV #5404,R0 ;ERROR 4,11. JSR PC,$ERRA BR RTN ZERO: CLR R0; CLR R1; BR RTN .ENDC .END CONSTANTS CLR R4; SIGN FLAG: + ARG CFCC ; GET SIGN OF ARGUMENT BGE POS; INC R4; SIGN FLAG: - ARG ABSD F0; REMOVE ARGUMENT SIGN POS: DIVD (R0)+,F0; X/(PI/2) MODD #0.25,F0; F0=FRACT(X/2PI) SETF ; SINGLE PRECISION FP LDCDF F0,F0; CONVERT ARGUMENT CFCC ; BEQ RTN; CHECK FOR 0 FRACTION MODF #4.0,F0; F0=FRACT(4*FRACT(X/2PI)) STCFI F1,R1; QUAD=INT(4*FRACT(X/2PI)) ROR R1; BCC Q13; JUMP IF FIRST OR THIRD QUAD NEGF F0; ADDF #1.0,F0; Y=1.0-X Q13: ROR R1; BCC Q12; JUMP )+ ;SAVE SP AT SPECIFIED ADDRESS JMP @(R4)+ ;THEN CONTINUE ; .END .TITLE $SSW $VERSN 01 ; ; ;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 .GLOBL SSWTCH ; ; ; THE FORTRAN OTS SENSE SWITCH ROUTINE ; CALL SSWTCH(I,J) ; TEST THE I'TH BIT (0<=I<=15) OF CONSOLE SWITCH REGISTER ; AND RETURNS ; J=1 IF BIT(I) =1 (UP) ; J=2 IF BIT(I) =0 (DOWN) ; R0=%0 R1=%1 R2=%2 R5=%5 SSWREG=177570 ; SSWTCH: MOV #1,R2; INIIF FIRST OR SECOND QUAD NEGF F0; Y= -Y ; Q12: LDF F0,F2; MULF F2,F2; Z=Y**2 MOV #4,R1; COUNT OF CONSTANTS FOR POLY LDF (R0)+,F1; INITIALIZE ACCUMULATOR XPAND: MULF F2,F1; DEC R1; COUN ADDF (R0)+,F1; F1:= Z*F1 + C(I) BGT XPAND; LOOP MULF F1,F0; F0:= Y*F1 TST R4; TEST SIGN FLAG BEQ RTN; NEGF F0; SIN(-X) = -SIN(X) RTN: STF F0,-(SP); MOVE RESULT TO STACK MOV (SP)+,R0; AND THENCE TO R0,R1 MOV (SP)+,R1; .F4RTN ;EXIT ; FCONST: PIOV2: .WORD 040311,007732; PI/2 (DOUBLE TIALIZE VALUE TO BE RETURNED MOV R2,R1; AND BIT POSITION TO BE TESTED MOV @2(R5),R0; GET ARGUMENT I CMP R0,#15.; BHI RET; IF OUT OF RANGE, EXIT CLC ; CLEAR C BIT BEFORE SHIFT SHIFT: DEC R0; BLT TEST; SHIFTED ENOUGH? ROL R1; SHIFT TEST BIT BR SHIFT; TEST: BIT R1,@#SSWREG; TEST I'TH BIT BNE OUT; BIT(I)=1, RETURN J=1 INC R2; BIT(I)=0, RETURN J=2 OUT: MOV R2,@4(R5); SET J RET: .F4RTN .END PRECISION) .WORD 121041,064302; ; ; ORDER-DEPENDENT CONSTANTS ; .ENDC ; .WORD 035036,153672; .00015148419 ; .WORD 136231,023143; -.00467376557 ; .WORD 037243,032130; .0796896793 ; .WORD 140045,056741; -.645963711 ; CONSTS: .WORD 040311,007733; 1.570796318 .END .TITLE $STO $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 $STOP,$EXIT .CSECT ; R4=%4 R5=%5 SP=%6 ; ; THIS IS THE OBJECT TIME STOP ROUTINE ; IT WILL CAUSE A MONITOR DIAG PRINT(INFORMATIONAL) ; WITH NUM INDICATED ; $STOP: MOV R4,-(SP) ;PUSH ADDR OF STOP NUM MOV #4,-(SP) ;PUSH .O2BIN CONVT CODE EMT 42 ;DO CONVERSION .TITLE $SVA $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. ; ; GET AN ARRAY ADDRESS FROM THE ADB ; .GLOBL $SVA ; R4=%4 SP=%6 ; $SVA: MOV @(R4)+,@(R4)+ JMP @(R4)+ ; .END ; MOV DIAG,-(SP) ;PUSH DIAG TYPE IOT ;DO DIAGNOSE ; JSR PC,$EXIT ;EXIT TO MONITOR ; ; DIAG: .BYTE 350 ;NUM OF DIAG .BYTE 0 ;INDICATE INFORMATIONAL MSG ; .END .TITLE $SVE $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. ; ; SAVE ADDRESS OF SINGLE ARRAY ELEMENT ; .CSECT R0 = %0 R4 = %4 ; .GLOBL $SVE $SVE: MOV R0,@(R4)+ ;STORE THE ADDRESS JMP @(R4)+ ;AND RETURN ; .END .TITLE $SVP $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. ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; GET ADDRESS OF PARAMETER AND STORE IT IN PARAMETER LIST ; .GLOBL $SVP $SVP: MOV (R4)+,R0 ;GET PARAMETER POSITION ADD R5,R0 ;GET ADDRESS OF PARAMETER ADDRESS MOV @R0,@(R4)+ ;PUT THE ADDRES .TITLE $TER $VERSN 01 ; ; ;COPYRIGHT 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 TSTERR,$AOTS,$AERF; ; ; THE FORTRAN OTS TSTERR ROUTINE ; CALL TSTERR(I,J) ; RETURNS ; J=1 IF AN ERROR OF CLASS I HAS OCCURRED ; J=2 IF NO ERROR OF CLASS I HAS OCCURRED ; THE ERROR FLAG BYTE $ERRF(I) IS CLEARED. ; R0=%0 R1=%1 R5=%5 ; TSTERR: MOV @2(R5),RS AWAY JMP @(R4)+ ;AND RETURN ; .END .TITLE $TIM $VERSN 01 ; ; ;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 .GLOBL DATE,TIME,$ERRA; ; ; ; THE FORTRAN OTS DATE AND TIME CONVERSION ROUTINES ; CALL DATE(A) RETURNS 9 ASCII BYTE DATE IN A ; CALL TIME(A) RETURNS 8 ASCII BYTE TIME IN A ; CALL TIME(I1,I2) RETURNS CURRENT TIME IN TICKS IN I1,I2 ; HIGH ORDER 152; GET THE ERROR CLASS I JSR PC,$AOTS MOV 4(R0),R0 ;ADDR $ERRC CMP R2,-(R0); TEST IF A LEGAL CLASS BHI EXIT; NO - EXIT MOV #1,R1; INITIALIZE RETURN VALUE JSR PC,$AERF ;ADDR $ERRF ADD R2,R0 TSTB (R0); TEST ERROR FLAG FOR CLASS I BNE ONE; J=1, $ERRF(I) WAS SET INC R1; J=2, $ERRF(I) WAS CLEAR ONE: MOV R1,@4(R5); RETURN RESULT CLRB (R0); CLEAR ERROR FLAG FOR CLASS I EXIT: .F4RTN ;RETURN .END .TITLE $TNH $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 TANH,EXP,$ADR,$SBR,$MLR,$DVR,$FCALL .GLOBL $POLSH,$PSHR3 ; THE FORTRAN TANH FUNCTION ; CALLING SEQUNCE: ; ; FORTRAN STANDARD (1 ARG) ; ; RETURNS (EXP(2*ARG) -1)/(EXP(2*ARG)+1) IN R0,R1. ; R0=%0 R1=%1 R4=%4 R5=%5 SP=%6 PC=%7 TANH: MOV R5,-(SP) ;SAVE RET BITS IN I1, LOW IN I2 ; CALL TIME(A,I1,I2)CONVERTS TIME IN TICK IN I1,I2 ; TO AN ASCII STRING IN A ; R0=%0 R1=%1 R5=%5 SP=%6 ; DATE: CLR R0; SET CONVERSION CODE FOR TODAY'S DATE BR CNVRT; RETURN CURRENT DATE IN ASCII ; TIME: MOVB @R5,R0; GET NUMBER ARGS FROM CALL CMP R0,#2; BEQ TICKS; RETURN TIME IN TICKS TO CALLER BLT CNVRT; RETURN CURRENT TIME IN ASCII MOV @6(R5),-(SP); LOW ORDER TIME MOV @4(R5),-(SP); HIGH ORDER TIME CNVRT: MOV 2(R5),-(SP); ADDRESS OF BUFFER FOURN POINTER MOV 2(R5),R5 ;GET ARG ADDRESS MOV @R5,R0 ;GET HIGH ORDER ARG BEQ ZERO ;JUMP IF ARG=0 ASL R0 CLRB R0 SWAB R0 ;GET EXPONENT CMP R0,#205 BLT STEST ;JUMP IF ABS(ARG) <16. MOV #40200,R0 ;ANSWER IS 1.*SIGN(ARG) CLR R1 TST @R5 ;TEST ARG SIGN BGE OUT ADD #100000,R0 ;MAKE -1. BR OUT STEST: CMP R0,#177 BGT TAN ;JUMP IF >1/2 CMP R0,#164 BGE SMALL ;USE CONTINUED FRACTION FOR THIS RANGE MOV 2(R5),R1 MOV @R5,R0 ;IF ABS(X)<2**-12, LET TANH=X BR OUT TAN: MOV 2(R5),-(S .TITLE $TR $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. ; ; $TR (GOTO) COMMAND ; .GLOBL $TR ; R4=%4 ; $TR: MOV @R4,R4 ;PICK UP TRANSFER ADDR JMP @(R4)+ ;AND TRANSFER ; .END R ASCII MOV R0,-(SP); CONVERSION CODE EMT 66; CONVERT DATE/TIME BVS ERROR; TEST FOR TIME CONVERSION ERROR BR RTN ;OK- RETURN ; ERROR: MOV #3004,R0 ;ERROR 4,6 JSR PC,$ERRA BR RTN TICKS: MOV #104,-(SP); GET CURRENT TIME IN TICKS EMT 41; MOV (SP)+,@4(R5); LOW ORDER 15 BITS MOV (SP)+,@2(R5); HIGH ORDER 15 BITS RTN: .F4RTN .END .TITLE $TRA $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 $TRA,$AS .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; ASSIGNED GOTO - RUN-TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRA ;ENTRY ADDRESS ; $TRA: MOV (SP)+,R4 ;MOVE P) ;PUSH 2*ARG ON STACK MOV @R5,-(SP) ADD #200,@SP ;DOUBLE ARG MOV SP,R5 ;SET UP CALL TO EXP. ARG POINTER MOV #EXP,R4 ;POINT TO EXP JSR PC,$FCALL MOV R1,-(SP) ;PUSH E**2ARG MOV R0,-(SP) CLR -(SP) ;PUSH 1. MOV #40200,-(SP) MOV R1,-(SP) ;PUSH E**2ARG MOV R0,-(SP) CLR -(SP) MOV #40200,-(SP) ;PUSH 1. JSR R4,$POLSH ;GET (E**2X -1)/(E**2X +1) .WORD $SBR,UP,$ADR,$DVR,UNPOL UNPOL: MOV (SP)+,R0 ;POP RESULT MOV (SP)+,R1 OUT: MOV (SP)+,R5 ;RESTORE RETURN .F4RTN ;RETURN TO USER SVALUE TO R4 AND JMP @(R4)+ ;DISPATCH ; ; $AS ; ; ASSIGN LABEL TO VARIABLE ; CALLING SEQUENCE: ; ; $AS ;SERVICE NAME ; .K ;LABEL ADDRESS ; NAME ;NAME OF VARIABLE ; $AS: MOV (R4)+,@(R4)+ ;STORE THE LABEL JMP @(R4)+ ; .END MALL: MOV 2(R5),R1 ;GET ARG MOV @R5,R0 JSR R4,$POLSH .WORD $PSHR3,$PSHR3,$PSHR3,$MLR,XSQ ;GET X AND X*X ON STACK XSQ: MOV 2(SP),-(SP) ;GET X SQUARE MOV 2(SP),-(SP) JSR R4,$POLSH .WORD P35,$ADR,ONE ;SET UP NUMERATOR .WORD $PSHR3,P45,$PSHR3,$DVR,$ADR,$ADR,$DVR ;GET QUOTIENT .WORD $SBR,$MLR,UNPOL ; THE ABOVE COMPUTES X(1-((Y+35...)/(Y+45...+105../Y))) ; WHERE Y=X*X ONE: MOV 4(SP),R0 ;GET XSQUARE AGAIN MOV 6(SP),R1 CLR 6(SP) ;INSERT A 1. MOV #40200,4(SP) JMP @(R4)+ P45: MOV #13623 .TITLE $TRC $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 $TRCBK .GLOBL $AOTS .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE IS CALLED TO GENERATE SUBROUTINE TRACEBACK ; R0 = SAVED ; R1 = SAVED ; R2 = ADDR OF DDB PTR FOLLOWED BY 4 WD LINE BUF HDR ; R3 = SET TO 1 IF EOF ON DEVICE, ELS .TITLE $TRCXX $VERSN 01 ; ; COPYRIGHT 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE ; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT ; WHICH IS NOT SUPPLIED BY DEC. ; ; FORTRAN CALLABLE DUMMY ENTRY POINTS ; THAT CORRESPOND TO ENTRIES IN THE TRACE ; PACKAGE LIBRARY. ; .GLOBL TRCTRL,TRCLST,TRCDEL TRCTRL: TRCLST: TRCDEL: .F4RTN .END 7,-(SP) ;PUSH 45.1842 MOV #41464,-(SP) P105: MOV #165707,-(SP) ;PUSH 105.4605 MOV #41722,-(SP) JMP @(R4)+ P35: MOV #116457,-(SP) ;PUSH 35.1535 MOV #41414,-(SP) JMP @(R4)+ ZERO: CLR R0 CLR R1 BR OUT ; UP: MOV (SP)+,10.(SP) ;MOVE STACK ITEM UP MOV (SP)+,10.(SP) JMP @(R4)+ ; .END E CLEARED ; R4 = SAVED ; R5 = ADDR OF AREA TO AVILD REC ; JSR PC,$TRCBK ; ; $TRCBK: MOV R0,-(SP) MOV R1,-(SP) MOV R4,-(SP) ; ; DO NAME/SEQ TRACE IF AVAILABLE JSR PC,$AOTS MOV R0,R3 ;SAVE ADDR OF $OTSV TST 6(R3) ;IF NO NAME CHAIN BEQ ENDTRC ;TO CALLER MOV R5,R1 MOV #14.,R0 TBK: MOVB #' ,(R1)+ ;CLEAR BUFF DEC R0 BNE TBK MOV #5015,(R1) ;PUT IN CR,LF MOVB #11,6(R5) ;PUT IN TITLE MOV #"NA,(R5) MOV #"ME,2(R5) MOVB #'S,7(R5) MOV #"EQ,8.(R5) MOV #16.,R0 ;SET REC .TITLE $TRL $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 $TRAL,$ERRA .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ; $TRAL ; ; ASSIGNED GOTO WITH CHECK LIST - RUN TIME SUPPORT ; INTEGER VALUE ON STACK UPON ENTRY ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH VALUE ON STACK ; $TRAL ;ENTRY ADDRE LEN JSR PC,WRIT ;WRITE TITLE LINE ; ; MOV 6(R3),R4 ;$NAMC VALUE MOV 10(R3),R1 ;$SEQC VALUE TBK1: MOV R1,-(SP) ;PUSH SEQ NUM MOV R5,-(SP) ;REC LOC WHERE TO GO ADD #7,(SP) MOV #3,-(SP) EMT 42 ;CVT TO DECIMAL CHARS ; MOV 6(R4),-(SP) ;PUSH 2ND WRD NAME MOV 4(R4),-(SP) ;PUSH 1ST WRD NAME MOV R5,-(SP) ;PUSH ADDR IN REC 1ST 3 CHARS MOV #1,-(SP) EMT 42 ;RADUP MOV R5,-(SP) ;PUSH ADDR IN REC 2ND 3 CHARS ADD #3,(SP) MOV #1,-(SP) EMT 42 ;RADUP ; JSR PC,WRIT ;WRITE LINE .TITLE $TRT $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. ; ;$TRTST OTS ROUTINE FOR SERVICING LOGICAL IF STATEMENTS. ; ;$TRTST, ;THE TOP OF THE STACK IS TESTED (AND POPPED). IF ITS VALUE ;IS .FALSE. (=0), CONTROL GOES TO IN POLISH MODE. ;OTHERWISE, CONTROL GOES TO THE WORD FOLLOWING THE PARAMETER ;IN POLISH MODE. SS ; .N1,.N2,.N3,0 ;LEGAL LABELS TERMINATED BY ZERO ; $TRAL: MOV (SP)+,R0 ;POTENTIAL DESTINATION $TRAL1: MOV (R4)+,R1 ;LOOK AT NEXT LABEL BEQ $TRAL9 ;JUMP IF NOT FOUND CMP R0,R1 BNE $TRAL1 ;GO LOOK FARTHER MOV R0,R4 ;NOW JMP @(R4)+ ; GO AWAY ; RUN-TIME DIAGNOSTIC $TRAL9: MOV #<2*256.>+7,R0 ;ERROR CLASS 7, NO. 2 JSR PC,$ERRA ;REPORT ERROR JMP @(R4)+; DEFAULT CONTINUE ; .END .TITLE $TRX $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 $TRX .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; COMPUTED GOTO - RUN TIME ROUTINE ; INTEGER INDEX ON STACK ON ENTRY, DELETED ON EXIT ; ; CALLING SEQUENCE: ; ; $PUSH(I) ;PUSH INDEX ON STACK ; $TRX ;ENTRY ADDRESS ; K ;NUMBER OF PARA MOV 2(R4),R1 ;GET NEXT SEQ NUM MOV (R4),R4 ;GET NEXT NAME BNE TBK1 JMP ENDTRC ;IF NONE RETURN ; ; WRIT: MOV R0,2(R2) ;SET LENGTH MOV R0,6(R2) MOV R5,8.(R2) ;SET BUFF ADDR MOV #4,4(R2) ;SET FMTD ASCII DUMP MOV R2,-(SP) ;WRITE ADD #2,(SP) MOV R2,-(SP) EMT 2 MOV R2,-(SP) EMT 1 ;WAIT BITB #100,5(R2) ;CHECK FOR EOF BNE EOFW ;REPORT TO CALLER IF SO RTS PC ;CONTINUE IF NOT EOFW: CLR R3 INC R3 ;SET ERROR CONDITION TST (SP)+ ;REMOVE OLD PC BR EOFX ENDTRC: CLR R3 EO; ; .GLOBL $TRTST R4=%4 SP=%6 ; $TRTST: TST (SP)+ ;LOOK AT VALUE AND POP IT BEQ $TRST1 ;BR IF FALSE TST (R4)+ ;SKIP OVER PARAMETER JMP @(R4)+ ;AND FALL THROUGH $TRST1: MOV (R4),R4 ;TRANSFER CONTROL TO JMP @(R4)+ .END ; METERS ; .N1 ;WHERE N1 IS STATEMENT NUMBER ; .N2 ;ETC. ; ... ; .NK ; $TRX: MOV (SP)+,R0 ;CLEAR STACK AND SAVE I CMP R0,#1 ;CHECK LIMITS ON I BLO $TRX1 ;I LESS THAN ONE CMP R0,@R4 ;COMPARE TO MAXIMUM BLOS $TRX2 ;JUMP IF OK ; ; ERROR - GIVE OTS ERROR AND THEN CONTINUE ; DEFAULT IS TO FALL THROUGH TO NEXT STATEMENT ; $TRX1: ;DEFAULT ACTION IS FALL THROUGH $TRX3: MOV (R4)+,R0 ASL R0 ADD R0,R4 JMP @(R4)+ ; ; NORMAL ACTION ; $TRX2: ASL R0 ADD R0,R4 MOV @R4,R4 JMP @(R4FX: MOV (SP)+,R4 ;RESTORE REGS MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ;RETURN ; .END .TITLE $TSI $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 $TSI,$TSR,$TSD,$TSB ; $TSI,$TSR,$TSD LOGICAL TEST ROUTINES ; CALLED IN THE POLISH MODE ; TESTS THE ITEM ON THE TOP OF THE STACK ; AND RETURNS CONTROL TO THE POINT WHOSE ADDRESS ; IS POINTED TO BY R4 IF <0, BY R4+2 IF =0, AND ; R4+4 IF >0. R4=%4 SP=%6 .IF)+ ; .END .TITLE $UIO $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. .GLOBL $UIO,$ERRA .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; THIS ROUTINE DOES ITEM TRANSFERS TO OR FROM INFORMATTED I/O ; RECORD ; $UIO: MOV RECPTR(R4),R2 ;GET RECORD LOC MOV ARGLEN(R4),R0 MOV ARGPTR(R4),R1 TST IOSW(R4) BEQ UIO1 ;BRANCH IF DF FPU $TSD: .WORD 170011 ;;SETD BR TSRD $TSR: .WORD 170001 ;;SETD TSRD: .WORD 170526 ;;TSTF (SP)+ ;TEST .WORD 170000 ;;CFCC BEQ ZERO BLT NEG BR POS .ENDC ; $TSB: NEGB (SP)+ ;TEST BYTE ITEM BR BGT; $TSI: NEG (SP)+ ;TEST INTEGER ITEM .IFNDF FPU BR BGT $TSD: MOV (SP)+,2(SP) ;DOUBLE PRECISION ENTRY TST (SP)+ ;POP THE STACK OF USELESS INFO. $TSR: MOV (SP)+,(SP) ;REAL ENTRY MOVE HIGH ORDER UP NEG (SP)+ ;DO THE TEST BVS ZERO ;REAL -0 = 0 .ENDC BGT: BGT NEG ;JUMP IF ARG < 0 B .TITLE $V22 ; V020A ; 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. ; IDENTIFIES THIS VERSION OF THE LIBRARY. SHOULD BE UPDATED ; WITH EACH VERSION. ; .END OUTPUTTING ITEMS ; UIO2: CMP R2,RECEND(R4) ;IF INPUT, CHECK IF SEGMENT DONE BLO UIO4 ;BRANCH IF NOT BIT IOSTAT(R5),#2 ;CHECK IF LAST SEGMENT BNE SHORT ;ERROR IF SO (SHORT RECORD) ; MOV R1,-(SP) MOV R0,-(SP) JSR PC,@IOTADR(R4) ;IF NOT LAST, GET NEXT SEGMENT MOV (SP)+,R0 MOV (SP)+,R1 MOV RECPTR(R4),R2 ; UIO4: MOVB (R2)+,(R1)+ ;MOVE BYTES FROM REC TO ITEM DEC R0 BNE UIO2 UIO5: MOV R2,RECPTR(R4) ;RESET RECORD PTR RTS PC ;RETURN TO CALLER ; ; SHORT: MOV #770.,R0 ;SHORT RECOREQ ZERO POS: TST (R4)+ ;ARGUMENT IS POSITIVE, USE THIRD RETURN ZERO: TST (R4)+ ;ARGUMENT IS ZERO, USE SECOND RETURN NEG: MOV (R4),R4 ;GET THE RETURN ADDRESS POINTER JMP @(R4)+ ;EXIT .END .TITLE $XB $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 $CB,$RB,$DB; .GLOBL $RI,$POLSH; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; $CB: $DB: MOV (SP)+,2(SP); MOV (SP)+,2(SP); TRUNCATE TO REAL FORMAT ; $RB: MOV @SP,-(SP); MAKE A HOLE IN STACK MOV 4(SP),2(SP); MOV R4,4(SP); SAVE R4 JSR R4,$POLSH; $RID ERR (MORE ITEMS THAN REC) JSR PC,$ERRA ;CALL ERROR CLASS=2/NUM=3 INC ERRFLG(R4) ;IF ERR RETNS SET FLAG RTS PC ; ; UIO1: CMP RECEND(R4),R2 ;IF OUTPUT, CHECK IF ITEM WILL OVERFLOW BHI UIO3 ;BRANCH IF NOT ; MOV R2,RECPTR(R4) MOV R0,-(SP) MOV R1,-(SP) JSR PC,@IOTADR(R4) ;WRITE THIS SEGMENT CLR IOSTAT(R5) ;SET TO NEITHER FIRST NOR LAST REC MOV (SP)+,R1 MOV (SP)+,R0 MOV RECPTR(R4),R2 ;RESET REC PTR UIO3: MOVB (R1)+,(R2)+ ;MOVE BYTES TO REC FROM ITEM DEC R0 BNE UIO1 BR UIO5 ,.+2; CONVERT IT CLRB 1(SP); CONVERT INT TO BYTE MOV 2(SP),R4; RESTORE R4 MOV (SP)+,@SP; MOVE RESULT UP JMP @(R4)+; .END .TITLE $CALLS $VERSN 02 ; ; 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. ; ; POLISH SUPPORT FOR NEW FORM OF CALLS IN PDP-11 FORTRAN ; COMPILER. .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; .GLOBL $CALL,$CALLP,$RETA,$RPOL0,$RPOLN,$PA .GLOBL $SVPA ; $CALL,SUB -CALL A SUBROUTINE ; $CALL: MOV R5,-(SP) ;SAVE OLD R5 MOV R4,R5 ;NEW R5 A ;GO TO EXIT ; ; ; .END .TITLE $FCL $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 $FCALL ; $FCALL --- ROUTINE FOR CALLING SINGLE ARG FORTRAN ; FUNCTIONS FROM WITHIN OTHER FORTRAN FUNCTIONS. ; CALLING SEQUENCE: ; MOV ARG POINTER,R5 ; MOV #FUNCTION NAME,R4 ; JSR PC,$FCALL ; FLUSH ARGUMENT R0=%0 R4=%4 R5=%5 SP=%6 .IFEQ .F4SEQ $FCALMOST POINTS AT ARGS .IFEQ .F4SEQ JMP @(R5)+ ;GOTO SUB AND MAKE R5 OKAY .ENDC .IFNE .F4SEQ TST (R5)+ ;MAKE R5 OKAY MOV R5,-(SP) ;SAVE IT TOO - THE RETURN ADDRESS JMP @(R4)+ ;GOTO SUB .ENDC ; ; $CALLP,OFFSET -CALL A SUBROUTINE WHICH IS AN ARGUMENT ; $CALLP: MOV R5,-(SP) ;SAVE R5 MOV R5,R0 ;COMPUTE SUB ADDRESS HERE MOV R4,R5 ;FOR ARG LIST POINTER .IFEQ .F4SEQ ADD (R5)+,R0 ;ADR IN R0 AND R5 OKAY .ENDC .IFNE .F4SEQ TST (R5)+ ;R5 OKAY MOV R5,-(SP) ADD (R4)+,R0 ;ADR ILL: MOV #RET,-(SP) ;PUSH $FCALL RETURN MOV #137,-(SP) ;JMP @PC MOV R5,-(SP) ;.WORD ARG MOV #401,-(SP) ;BR .+4 MOV SP,R5 ;JSR R5,FUNCT JSR R0,@R4 RET: ADD #8.,SP ;FLUSH CALL JMP @(SP)+ ;RETURN TO USER WITH ARG ON STACK ; AND FUNCT(ARG) IN REGS. .ENDC .IFNE .F4SEQ $FCALL: MOV R5,-(SP) ;ARGUMENT ADDRESS MOV #401,-(SP) ;ONE ARGUMENT MOV SP,R5 ;POINT R5 AT ARG LIST JSR PC,@R4 ADD #4,SP RTS PC .ENDC ; ; $FCAL2 - ROUTINE FOR CALLING DOUBLE ARG FORTRAN ; FUNCTION REENTRANTLY .TITLE $LNK $VERSN 04 ; ; ;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. ; ;THIS ROUTINE IS NOT REENTRANT!!! ; ; ;CALLING SEQUENCES: ; ; ; IN FORTRAN: ; ;FOR LINK: ; ; CALL LINK('DEV:FILNAM.EXT[UIC]') ; ;FOR RUN: ; ; CALL RUN('DEV:FILNAM.EXT[UIC]') ; ;NOTE: ARGUMENTS ARE ENCLOSED IN ; QUOTATION MARKS, AND THE ; ARGUMENT IS THE OVERLAY LOAD MODUN R0 .ENDC JMP @(R0)+ ;GOTO SUBROUTINE ; ; $RETA -RETURN FROM ASF ; $RETA: .IFEQ .F4SEQ RTS R5 .ENDC .IFNE .F4SEQ RTS PC .ENDC ; ; $RPOL0 -RETURN TO POLISH WITH NO STACK ADJUST ; $RPOL0: TST (SP)+ ;DISCARD FROM JSR R4,$RPOL0 .IFNE .F4SEQ MOV (SP)+,R5 ;RESTORE CALLERS R5 .ENDC JMP @(R4)+ ;CONTINUE IN POLISH MODE ; ; $RPOLN,VALUE -RETURN TO POLISH WITH STACK ADJUST ; $RPOLN: TST (SP)+ ;DISCARD FROM JSR R4,$RPOLN .IFNE .F4SEQ MOV (SP)+,R5 ;RESTORE CALLERS R5 .E .TITLE $POP $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 ; ; POP ROUTINES - POLISH LIST CONTAINS ADDRESS OF DATA ; DESTINATION FOLLOWING THE POP CALL. ; ; $POP4,$POP5 - POP A 4 WORD (DOUBLE OR COMPLEX) ITEM ; .GLOBL $POP4,$POP5,$POP4A,$POP4B $POP5: ; CALLING SEQUENCE: ; MOV ARG2 ADR,-(SP) ; MOV ARG1 ADR,-(SP) ; MOV SUBR ADR,R4 ; JSR PC,$FCAL2 .GLOBL $FCAL2 .IFEQ .F4SEQ $FCAL2: MOV #RET2,-(SP) MOV #137,-(SP) MOV 6(SP),-(SP) MOV 10.(SP),-(SP) MOV #402,-(SP) MOV SP,R5 JSR R0,@R4 RET2: ADD #10.,SP RTS PC .ENDC .IFNE .F4SEQ $FCAL2: MOV 2(SP),-(SP) MOV 6(SP),-(SP) MOV #402,-(SP) MOV SP,R5 JSR PC,@R4 ADD #6,SP RTS PC .ENDC .END LE ; FILE SPECIFICATION. ; ; THE CALLING SEQUENCE FOR RUN IS THE SAME AS FOR LINK ; RUN CLOSES ALL FILES OPENED BY FORTRAN ; AND LOADS AND RUNS THE REQUESTED PROGRAM ; ;FOR RETURN: ; ; CALL RETURN ; ; ;IN ASSEMBLY LANGUAGE: ; ;FOR LINK: ; ; JSR %5,LINK ; BR .+000004 ;RETURN ADDRESS ; +$I0000 ;POINTER TO ARGUMENT ; . ; . ; . ;$I0000:... ;ARGUMENT ; ... ; ... ;000 ;TERMINATING NULL ; . ;IF ARGUMENT IS ODD, BYTE ; . ;IF ARGUMENT IS EVEN, WORD ; . ; ;FOR RETURN: ; ; NDC ADD (R4)+,SP ;ADJUST STACK TO DELETE ARG TEMPS JMP @(R4)+ ;CONTINUE IN POLISH ; ; $PA,OFFSET -ADDRESS OF PARAMETER TO R0 ; $PA: MOV (R4)+,R0 ;OFFSET ADD R5,R0 ;+ADDRESS OF ARG LIST MOV @R0,R0 ;GIVES ADDRESS OF ADDRESS THENCE JMP @(R4)+ ;TO R0 AND CONTINUE ; ; $SVPA,OFFSET,ADDRES ; ; COPY PARAMETER ADRESS TO PARAMETER LIST ; $SVPA: MOV (R4)+,R2 ADD R5,R2 MOV @R2,@(R4)+ JMP @(R4)+ ; .END $POP4: MOV (R4)+,R3 ;GET DESTINATION ADDRESS $POP4B: MOV (SP)+,(R3)+ ;COPY MOV (SP)+,(R3)+ ;FIRST HALF OF ITEM $POP4A: MOV (SP)+,(R3)+ ;COPY SECOND HALF MOV (SP)+,(R3)+ ;OF ITEM JMP @(R4)+ ;DISPATCH TO NEXT ROUTINE IN LIST ; ; $POP3 - POP A REAL ITEM ; .GLOBL $POP3 $POP3: MOV (R4)+,R3 ;GET DATA DESTINATION BR $POP4A ;GO MOVE THE DATA ; .END JSR %5,RETURN ; BR .+000002 ; . ; . ; . ; ; ;IN ASSEMBLY LANGUAGE PROGRAMS. BOTH SYMBOLS ;LINK & RETURN HAVE TO BE DECLARED AS ;GLOBALS I.E.: .GLOBL LINK,RETURN ; ; .GLOBL LINK,RETURN,RUN ;ENTRY POINTS .GLOBL $OTSV,$NAMC,$CLSUP ;EXTERNAL GLOBALS INIT=6 GET=65 GUT=41 CSI1=56 CSI2=57 R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 LNKACT=2 ;OVL-RETURN,UNCOND STACK MOVE RUNACT=40003 ;RUN-NO RET,UNCOND STACK MOVE ; ; PROGRAM RUN ENTRY ; RUN: MOV #RUNACT,RUNDIRECTORY DT0: [ 1,1 ] 01-OCT-73 POI .MAC 3 27-SEP-73 <233> 076426 PPR .MAC 3 27-SEP-73 <233> 117125 PRI .MAC 8 27-SEP-73 <233> 133305 PRP .MAC 2 27-SEP-73 <233> 064530 PRR .MAC 5 27-SEP-73 <233> 073462 PSH .MAC 2 27-SEP-73 <233> 056516 PUT .MAC 3 27-SEP-73 <233> 074771 RAD .MAC 7 27-SEP-73 <233> 030716 RAD50 .MAC 10 27-SEP-73 <233> 073303 RAN .MAC 4 27-SEP-73 <233> 033541 RBLK ;GET RUN ACTION WORD ; CLOSE ALL FILES OPENED FOR FORTRAN ; JSR PC,$CLSUP ; OBTAIN THE STACK BASE FROM THE SYSTEM ; VECTOR TABLE TO CLEAR THE STACK ; CLR -(SP) ;ARGUMENT MOV #4,-(SP) ;REQUEST CODE EMT GUT ;EMT CALL MOV (SP)+,SP ;CLEAR STACK BR COMMON ; ; OVERLAY ENTRY ; LINK: MOV #LNKACT,RUNBLK ;SET LINK ACTION WORD COMMON: MOV R0,-(SP) ;SAVE REGISTERS ON STACK. MOV R1,-(SP) ; ;COPY FORTRAN ARGUMENT STRING TO INTERNAL ;BUFFER. TERMINATE STRING WITH A "LINE FEED". ;CC 3 27-SEP-73 <233> 117342 SVA .MAC 2 27-SEP-73 <233> 047563 SVE .MAC 2 27-SEP-73 <233> 054525 SVP .MAC 3 27-SEP-73 <233> 075641 TER .MAC 3 27-SEP-73 <233> 153200 TIM .MAC 4 27-SEP-73 <233> 035307 TNH .MAC 6 27-SEP-73 <233> 177052 TR .MAC 2 27-SEP-73 <233> 050665 TRA .MAC 3 27-SEP-73 <233> 123061 TRC .MAC 6 27-SEP-73 <233> 144633 TRCXX .MAC 2 27-SEP-73 <233> 060554 TRL .MAC D .MAC 3 27-SEP-73 <233> 144572 RDM .MAC 4 27-SEP-73 <233> 001474 RDSW .MAC 2 27-SEP-73 <233> 066736 RDU .MAC 5 27-SEP-73 <233> 057557 REL .MAC 3 27-SEP-73 <233> 076656 RI .MAC 5 27-SEP-73 <233> 133357 RIO .MAC 4 27-SEP-73 <233> 054362 RWD .MAC 3 27-SEP-73 <233> 154536 SBI .MAC 2 27-SEP-73 <233> 060730 SBS .MAC 8 27-SEP-73 <233> 151432 SBX .MAC 8 27-SEP-73 <233> 150635 SECNDALL CSI TO CHECK SYNTAX & SET UP LINK & FILE ;BLOCKS MOV #BUFFBE,R0 ;R0 PTS TO INTERNAL BUFFER MOV 2(R5),R1 ;R1 PTS TO BEG OF STRING LOOP: CMP R0,#BUFFBE+32 ;IS BYTE COUNT>32? BHIS BCERR ;YES- MOVB (R1)+,(R0)+ BNE LOOP ;NULL TERMINATES STRING. MOVB #12,-(R0) ;TERMINATE STRING WITH LF. MOV (SP)+,R1 ;RESTORE REGISTERS FROM STACK MOV (SP)+,R0 MOV #CMDBUF,-(SP) ;CALL CSI1 CHECK FOR EMT CSI1 ;SYNTAX TST (SP)+ ;SYNTAX ERROR? BNE CSI1ER ;YES- NCSI1E: MOV #BLOCK,-(SP) ;NO- CALL CSI 3 27-SEP-73 <233> 146731 TRT .MAC 3 27-SEP-73 <233> 131726 TRX .MAC 4 27-SEP-73 <233> 162661 TSI .MAC 4 27-SEP-73 <233> 013263 UIO .MAC 5 27-SEP-73 <233> 060516 VER .MAC 2 27-SEP-73 <233> 046205 XB .MAC 3 27-SEP-73 <233> 106533 CAL .MAC 5 27-SEP-73 <233> 131172 FCL .MAC 4 27-SEP-73 <233> 037170 LNK .MAC 14 27-SEP-73 <233> 127027 FREE BLKS: 333 FREE FILES: 3 .MAC 4 27-SEP-73 <233> 152716 SEQ .MAC 3 27-SEP-73 <233> 064357 SER .MAC 4 27-SEP-73 <233> 171521 SFL .MAC 9 27-SEP-73 <233> 056736 SGL .MAC 3 27-SEP-73 <233> 125752 SGN .MAC 3 27-SEP-73 <233> 113171 SIN .MAC 10 27-SEP-73 <233> 133516 SQT .MAC 6 27-SEP-73 <233> 137752 SRV .MAC 4 27-SEP-73 <233> 043614 SSP .MAC 3 27-SEP-73 <233> 102647 SSW .MAC 3 27-SEP-73 <233> 152127 STO .MA2,SET UP EMT CSI2 ;LINK & FILE BLOCKS. BIT #2,(SP) ;TOO MANY SWITCHES? BNE CSI2ER ;YES- ERROR BIT #1,(SP)+ ;NO-ANY MORE SPECIFICATIONS? BEQ CSI2ER ;YES- ERROR ; CMP #RUNACT,RUNBLK; CHECK FOR CALL RUN OR LINK BEQ GETOVL; RUN - SKIP REGISTER SAVES ; ; DETERMINE IF CALL LINK ISSUED FROM ; WITHIN RESIDENT SECTION OR FROM AN OVERLAY ; ;IS RETURN ADDR WITHIN RESIDENT? .IFEQ .F4SEQ CMP LIMIT,R5 .ENDC .IFNE .F4SEQ CMP LIMIT,@SP .ENDC BHI NOSAVE; NO - DON'T SAVE REGISTERS ;C 3 27-SEP-73 <233> 117342 SVA .MAC 2 27-SEP-73 <233> 047563 SVE .MAC 2 27-SEP-73 <233> 054525 SVP .MAC 3 27-SEP-73 <233> 075641 TER .MAC 3 27-SEP-73 <233> 153200 TIM .MAC 4 27-SEP-73 <233> 035307 TNH .MAC 6 27-SEP-73 <233> 177052 TR .MAC 2 27-SEP-73 <233> 050665 TRA .MAC 3 27-SEP-73 <233> 123061 TRC .MAC 6 27-SEP-73 <233> 144633 TRCXX .MAC 2 27-SEP-73 <233> 060554 TRL .MAC ; SAVE RETURN ADDRESS AND THE REGISTERS IF THE SUBROUTINE ; CALL FOR LINK WAS ISSUED FROM THE RESIDENT SECTION ; MOV $NAMC,SAVENM ;SAVE SUBROUTINE TRACEBACK CHAIN MOV R0,SAVER0 ;SAVE REGISTERS MOV #SAVER5+2,R0 MOV R5,-(R0) MOV R4,-(R0) MOV R3,-(R0) MOV R2,-(R0) MOV R1,-(R0) MOV -(R0),R0 ;FIX UP R0 BR GETOVL ;GO LOAD THE OVERLAY ; NOSAVE: .IFEQ .F4SEQ ; ;DELETE OLD R5 VALUE FOR CALL LINK ;ISSUED FROM AN OVERLAY ; TST (SP)+ .ENDC .IFNE .F4SEQ ; ;FOR NEW CALL SEQUENCE 3 27-SEP-73 <233> 146731 TRT .MAC 3 27-SEP-73 <233> 131726 TRX .MAC 4 27-SEP-73 <233> 162661 TSI .MAC 4 27-SEP-73 <233> 013263 UIO .MAC 5 27-SEP-73 <233> 060516 VER .MAC 2 27-SEP-73 <233> 046205 XB .MAC 3 27-SEP-73 <233> 106533 CAL .MAC 5 27-SEP-73 <233> 131172 FCL .MAC 4 27-SEP-73 <233> 037170 LNK .MAC 14 27-SEP-73 <233> 127027 POP .MAC 3 01-OCT-73 <233> 141646 FREE BLKS: 33 CONVENTION BOTH ;OLD R5 AND PC VALUES GET SCRATCHED ; CMP (SP)+,(SP)+ .ENDC ; PREPARE GET EMT CALLING SEQUENCE ; ;MONITOR REQUEST "GET" EMT BRINGS THE OVERLAY INTO CORE ; GETOVL: CLR $NAMC; RESET SUBROUTINE TRACEBACK CHAIN MOV #RUNBLK,-(SP) ;ISSUE GET EMT ;TO BRING OVERLAY ;FILE INTO CORE EMT GET ; ;GET EMT POST PROCESSING ; MOV (SP),TRA ; SAVE TRANSFER ADDR. DEC (SP)+ ;WAS TRANSFER ADDR SPECIFIED? BEQ TRAERR ;NO - CMP (SP)+,(SP)+ ;YES - JMP @TRA ;GO TO SPECIFIED0 FREE FILES: 2  TRANSFER ADDR. ; ;RETURN TO RESIDENT AREA AFTER ISSUING A ;"CALL RETURN" FROM THE NONRESIDENT SECTION ; RETURN: ;RETURN TO RESIDENT AREA .IFEQ .F4SEQ TST (SP)+ ;DELETE R5 FROM JSR R5,RETURN .ENDC .IFNE .F4SEQ CMP (SP)+,(SP)+ ;DELETE R5,PC FROM ;MOV R5,-(SP) & JSR PC,RETURN .ENDC MOV SAVENM,$NAMC; RESTORE TRACEBACK CHAIN MOV #SAVER0,R5 MOV (R5)+,R0 MOV (R5)+,R1 MOV (R5)+,R2 MOV (R5)+,R3 MOV (R5)+,R4 MOV (R5),R5 .F4RTN ; ;ERROR PROCESSING ; BCERR: ;BYTE COUNT ERROR-F275 .IFNE .F4SEQ ;RETURN ADDRESS UNDER NEATH SAVED R0,R1 CMP (SP)+,(SP)+ .ENDC CSI1ER: ;CSI1 ERROR-F275 CSI2ER: ;CSI2 ERROR-F275 .IFEQ .F4SEQ MOV R5,-(SP) ;RETURN ADDRESS AS INFO .ENDC .IFNE .F4SEQ ; RETURN ADDRESS ALREADY ON STACK FOR INFO .ENDC MOV #1675,-(SP) ;ERROR NUMBER F275 IOT TRAERR: .IFEQ .F4SEQ MOV R5,-(SP) ;RETURN ADDRESS AS INFO .ENDC .IFNE .F4SEQ ; RETURN ADDRESS ALREADY ON STACK FOR INFO .ENDC MOV #1676,-(SP) ;ERROR NUMBER F276 IOT ; ; DATA AREA ; ; ;A 3 WORD BUFFER, ;USED WHEN CALLING CSI2. ; BLOCK: .WORD CMDBUF ;POINTER TO CMDBUF .WORD LNKBLK ;POINTER TO LINK BLOCK .WORD FILBLK ;POINTER TO FILE BLOCK ; ;COMMAND BUFFER, ;WORK AREA FOR CSI USE. ;7 WORDS LONG. ; ;CAUTION:COMMAND BUFFER CAN'T BE SEPARATED FROM LINE BUFFER! ;; CMDBUF: 2 ;WORK AREA FOR CSI. ; ;FOR A SHORT WHILE ;THE FOLLOWING WORD ;OVERLAYS THE 2ND WORD ;OF THE CSI WORK AREA ; TRA: 0 ;SAVE TRANSFER ADDRESS .=.+10. ; ; LINE BUFFER HEADER CONTENT IS NOT USED BY CSI ; OVERLAY IT BY DATA WORDS ; LIMIT: .LIMIT ;PROGRAM LOW & HIGH LIMIT SAVENM: 0 ;SAVE TRACEBACK CHAIN ; ;LINE BUFFER ; BUFFBE: .=.+32 ; ;LINK BLOCK ; 0 ;ERROR RETURN ADDRESS LNKBLK: 0 ;LINK POINTER .RAD50 /OVR/ ;LOGICAL NAME OF DATASET 1 ;UNIT #,# OF WORDS TO FOLLOW. .RAD50 /SY/ ;PHYSICAL DEVICE NAME ; ;FILE BLOCK ; 0 ;ERROR RETURN ADDRESS 0 ;ERROR CODE, HOW OPEN FILBLK: 0 ;FILE NAME 0 ;FILE NAME 0 ;EXTENSION 0 ;USER ID CODE 0 ;PROTECT CODE ; ; RUN BLOCK USED BY GET EMT ; RUNBLK: +LNKACT ; ACTION WORD +FILBLK ;ADDRESS OF FILE BLOCK +LNKBLK ;ADDRESS OF LINK BLOCK ; ; SAVE AREA FOR CONTENTS OF REGISTERS 0 THROUGH 5 ; SAVER0: 0 SAVER1: 0 SAVER2: 0 SAVER3: 0 SAVER4: 0 SAVER5: 0 ; .END LINK