IDENT CPU.ZFN ZFN 2 B1=1 ZFN 3 ENTRY ZFN= ZFN 4 CPU.ZFN SPACE 4,10 V41AC07 5 TITLE CPU.ZFN - ZERO FILL NAME. V41AC07 6 COMMENT CPU.ZFN - ZERO FILL NAME. V41AC07 7 COMMENT COPYRIGHT 1973, UNIVERSITY OF MINNESOTA. V41AC07 8 CPU.ZFN SPACE 4,10 V41AC07 9 * CTEXT COMCZFN - ZERO FILL NAME. ZFN 8 IF -DEF,QUAL$,1 ZFN 9 QUAL COMCZFN ZFN 10 BASE D ZFN 11 * COMMENT COPYRIGHT 1973, UNIVERSITY OF MINNESOTA. V41AC07 10 CPU.ZFN SPACE 4,10 V41AC07 11 *** ZFN - ZERO FILL NAME. V41AC07 12 * D. W. MEARS. 1973-30-01. V41AC07 13 HISTORY SPACE 4,10 HZFN 1 ** PASCAL-6000 MODIFICATION HISTORY. HZFN 2 * HZFN 3 * CLEAN UP COMPASS DOCUMENTATION. V41AC07 14 * HZFN 4 ZFN SPACE 4,10 ZFN 16 *** ZFN - ZERO FILL NAME. V41AC07 15 * V41AC07 16 * ZFN REPLACES 55 CODES WITH 00 CODES IN A WORD V41AC07 17 * (THE OPPOSITE OF SFN). ZFN 18 * ZFN 19 * ENTRY (X1) = WORD TO BE ZERO FILLED. ZFN 20 * (B1) = 1. ZFN 21 * ZFN 22 * EXIT (X6) = ZERO FILLED WORD. ZFN 23 * ZFN 24 * USES X - 1, 2, 3, 4, 6, 7. V41AC07 18 * A - 2. V41AC07 19 ZFN 32 ZFN 33 ZFN ROUTINE ZFN= ENTRY/EXIT V41AC07 20 SA2 ZFNA =10HAAAAAAAAAA V41AC07 21 BX3 X1 ZFN 36 AX1 3 ZFN 37 BX4 X1*X3 ZFN 38 BX1 X1+X3 ZFN 39 AX6 X1,B1 ZFN 40 BX7 -X6*X4 ZFN 41 AX4 2 ZFN 42 BX7 X7*X4 ZFN 43 BX6 X7*X2 ZFN 44 BX1 X7*X2 ZFN 45 LX6 2 ZFN 46 BX1 X6+X1 ZFN 47 BX3 X3-X1 ZFN 48 LX1 3 ZFN 49 BX6 X3-X1 ZFN 50 EQ ZFNX RETURN V41AC07 22 ZFN 52 ZFNA DATA 10HAAAAAAAAAA ZFN 53 ZFN SPACE 4 ZFN 54 IF -DEF,QUAL$,2 ZFN 55 QUAL * ZFN 56 ZFN= EQU /COMCZFN/ZFN= ZFN 57 BASE * ZFN 58 * ENDX ZFN 59 CPU.ZFN SPACE 4 V41AC07 23 END ZFN 61 IDENT P.AHM AHM 2 SST AHM 3 SYSCOM B1 AHM 4 LIST F AHM 5 ENTRY PASAHM V41DC01 23 ENTRY P.MND AHM 6 ENTRY P.MNW AHM 7 ENTRY P.MRK AHM 8 ENTRY P.RLS AHM 9 TITLE PASCAL-6000 ALTERNATIVE HEAP MANAGEMENT ROUTINES. AHM 10 COMMENT PASCAL-6000 ALTERNATIVE HEAP MANAGEMENT ROUTINES. AHM 11 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1983. AHM 12 AHM SPACE 4,10 AHM 13 *** PASCAL-6000 ALTERNATIVE HEAP MANAGEMENT ROUTINES. AHM 14 * J. F. MINER. 82/07/23. 83/05/12. AHM 15 * D. E. GERMANN. 82/10/15. 83/05/14. AHM 16 HISTORY SPACE 4,10 HAHM 1 ** PASCAL-6000 MODIFICATION HISTORY. HAHM 2 * HAHM 3 * INSTALL ENTRY POINT PASAHM. V41DC01 24 * ELIMINATE SUBROUTINE "SML". V41CC19 5 * HAHM 4 AHM TITLE DATA, CONSTANTS. AHM 17 ** PROGRAM VARIABLES. AHM 18 AHM 19 AHM 20 ML DATA 0 CURRENT MARK LEVEL AHM 21 AHM TITLE ALTERNATIVE HEAP MANAGEMENT ROUTINES. AHM 22 P.MND SPACE 4,15 AHM 23 ** P.MND - ALLOCATE CHECKED MARKED HEAP STORAGE. AHM 24 * AHM 25 * ENTRY (X1) = SIZE OF CHUNK TO ALLOCATE. AHM 26 * (INCLUDES SPACE FOR POINTER KEY WORD.) AHM 27 * (B1) = 1. AHM 28 * AHM 29 * EXIT (X6) = KEY AND POINTER (SEE P.SPK). AHM 30 * AHM 31 * USES X - 1, 2, 7. V41CC19 6 * A - 1, 2, 7. V41CC19 7 * AHM 35 * CALLS P.ALM, P.SPK. V41CC19 8 AHM 37 AHM 38 MND ROUTINE P.MND ENTRY/EXIT AHM 39 RJ =XP.ALM ALLOCATE NODE AHM 40 SA1 ML CURRENT MARK LEVEL V41CC19 9 SA2 X6-1 HEADER WORD OF NODE V41CC19 10 LX1 54 V41CC19 11 BX7 X2+X1 V41CC19 12 SA7 A2+ SET MARK LEVEL IN HEADER WORD OF NODE V41CC19 13 RJ =XP.SPK SET POINTER KEY AHM 42 EQ MNDX RETURN AHM 43 P.MNW SPACE 4,15 AHM 44 ** P.MNW - ALLOCATE MARKED HEAP STORAGE. AHM 45 * AHM 46 * ENTRY (X1) = SIZE OF CHUNK TO ALLOCATE. AHM 47 * (B1) = 1. AHM 48 * AHM 49 * EXIT (X6) = ADDRESS OF ALLOCATED CHUNK. AHM 50 * AHM 51 * USES X - 1, 2, 7. V41CC19 14 * A - 1, 2, 7. V41CC19 15 * AHM 55 * CALLS P.ALM. V41CC19 16 AHM 57 AHM 58 MNW ROUTINE P.MNW ENTRY/EXIT AHM 59 RJ =XP.ALM ALLOCATE NODE AHM 60 SA1 ML CURRENT MARK LEVEL V41CC19 17 SA2 X6-1 HEADER WORD OF NODE V41CC19 18 LX1 54 V41CC19 19 BX7 X2+X1 V41CC19 20 SA7 A2+ SET MARK LEVEL IN HEADER WORD OF NODE V41CC19 21 EQ MNWX RETURN AHM 62 P.MRK SPACE 4,15 AHM 63 ** P.MRK - START NEW MARK LEVEL. AHM 64 * AHM 65 * ENTRY (X1) = ADDRESS OF MARKER VARIABLE. AHM 66 * (B1) = 1. AHM 67 * (ML) = CURRENT MARK LEVEL. AHM 68 * AHM 69 * EXIT OLD MARK LEVEL STORED INTO MARKER VARIABLE. AHM 70 * (ML) INCREASED BY ONE TO NEW MARK LEVEL. AHM 71 * AHM 72 * USES X - 2, 3, 6, 7. AHM 73 * A - 2, 6, 7. AHM 74 * AHM 75 * CALLS P.SABRT. AHM 76 AHM 77 AHM 78 MRK ROUTINE P.MRK ENTRY/EXIT AHM 79 SA2 ML CURRENT MARK LEVEL AHM 80 BX6 X2 AHM 81 SX7 X2+B1 ML := ML + 1 AHM 82 SX3 X2-MARKLIM AHM 83 ZR X3,MRK1 IF ALREADY AT MAXIMUM MARK LEVEL AHM 84 SA6 X1 STORE MARK LEVEL INTO MARKER VARIABLE AHM 85 SA7 A2 UPDATE MARK LEVEL TO NEW VALUE AHM 86 EQ MRKX RETURN AHM 87 AHM 88 MRK1 SX0 MRKA MAXIMUM MARK LEVEL EXCEEDED AHM 89 EQ =XP.SABRT ABORT AHM 90 AHM 91 MRKA DATA C* MAXIMUM MARK LEVEL EXCEEDED. * AHM 92 P.RLS SPACE 4,15 AHM 93 ** P.RLS - RELEASE MARKED NODES AND RESET MARK LEVEL. AHM 94 * AHM 95 * ENTRY (X1) = DML (DESTINATION MARK LEVEL). AHM 96 * (B1) = 1. AHM 97 * AHM 98 * EXIT ALL NODES WITH MARK LEVEL GREATER THAN DML RELEASED. AHM 99 * MARK LEVEL SET TO DML. AHM 100 * FL REDUCED IF APPROPRIATE. AHM 101 * *P.TMEM* UPDATED. AHM 102 * AHM 103 * USES X - ALL. AHM 104 * A - 1, 2, 3, 4, 5, 6, 7. AHM 105 * B - 2, 3, 7. AHM 106 * AHM 107 * CALLS P.CMR, P.SABRT. AHM 108 AHM 109 AHM 110 * SCAN FOR NEXT NODE THAT IS FREE OR RELEASEABLE. AHM 111 AHM 112 RLS4 SA2 X2+B7 M[NEXT(P2)] AHM 113 SB7 A2 P2 := NEXT(P2) AHM 114 NG X2,RLS5 IF P2 IS A FREE NODE AHM 115 IX4 X5-X2 AHM 116 PL X4,RLS4 IF M[P2].MARK <= ML AHM 117 MX7 1 AHM 118 BX7 X7+X2 AHM 119 SA7 A2 M[P2].FREE := TRUE AHM 120 RLS5 SA1 B2+B1 M[P1+1] AHM 121 SX4 B7 AHM 122 BX1 X0*X1 AHM 123 BX6 X1+X4 AHM 124 SA6 A1+ M[P1+1].NEXTFREE := P2 AHM 125 SX7 B2 AHM 126 SA3 B7+B1 M[P2+1] AHM 127 LX7 18 AHM 128 BX3 -X0*X3 AHM 129 BX7 X7+X3 AHM 130 SA7 A3 M[P2+1].PREVFREE := P1 AHM 131 SB2 B7 P1 := P2 AHM 132 BX7 X7-X7 AHM 133 NE B2,B3,RLS1 IF P1 <> LF AHM 134 AHM 135 RLS ROUTINE P.RLS ENTRY/EXIT AHM 136 AHM 137 * CHECK DESTINATION MARK LEVEL FOR VALIDITY. AHM 138 AHM 139 SA4 ML CURRENT MARK LEVEL AHM 140 BX6 X1 DESTINATION MARK LEVEL (DML) AHM 141 IX4 X1-X4 AHM 142 SA2 =XP.TMEM+MEMFF ADDRESS OF FIRST FREE NODE AHM 143 SA3 A2+B1 ADDRESS OF LAST FREE NODE AHM 144 ERRNZ MEMLF-MEMFF-1 FIX PREVIOUS LINE AHM 145 BX4 -X4+X1 AHM 146 SX5 X1+1 DML+1 AHM 147 SX0 RLSA INCORRECT VALUE PASSED TO RELEASE AHM 148 NG X4,=XP.SABRT IF DML NOT IN [0..ML-1] AHM 149 SA6 A4+ ML := DML AHM 150 SB2 X2 P1 := FF AHM 151 SB3 X3 LF AHM 152 MX0 -18 AHM 153 SA2 B2 M[FF] AHM 154 SB7 B2+ P2 := FF AHM 155 LX5 54 1/0,5/ML+1,54/0 AHM 156 BX7 X7-X7 AHM 157 AHM 158 * LOOP TO RELEASE ALL DESIRED NODES. AHM 159 AHM 160 RLS1 SA2 B7+X2 M[NEXT(P2)] AHM 161 SB7 A2 P2 := NEXT(P2) AHM 162 NG X2,RLS1 IF NODE P2 IS FREE AHM 163 IX4 X5-X2 AHM 164 PL X4,RLS2 IF M[P2].MARK <= ML AHM 165 SA7 B7+B1 ZERO OUT POINTER TEST WORD AHM 166 EQ RLS1 AHM 167 RLS2 SA1 B2 M[P1] AHM 168 SX4 B7-B2 P2-P1 AHM 169 BX3 -X0*X1 M[P1].SIZE AHM 170 IX3 X4-X3 P2 - NEXT(P1) AHM 171 BX1 X0*X1 AHM 172 ZR X3,RLS3 IF P2 = NEXT(P1) AHM 173 BX6 X1+X4 AHM 174 SA6 A1 M[P1].SIZE := P2 - P1 AHM 175 BX4 X2 M[P2] AHM 176 LX4 -18 AHM 177 SX1 B2 AHM 178 BX4 X0*X4 AHM 179 BX7 X4+X1 AHM 180 LX7 18 AHM 181 SA7 A2 M[P2].PREV := P1 AHM 182 RLS3 LE B7,B3,RLS4 IF P2 <= LF AHM 183 AHM 184 * LAST FREE NODE WAS ENLARGED. AHM 185 AHM 186 SA1 =XP.TMEM+MEMFF AHM 187 SX7 B2 AHM 188 SB3 X1 REGISTER LF := FF (* SO LOOP WILL EXIT *) AHM 189 SA7 A1+B1 LF := P1 AHM 190 ERRNZ MEMFF+1-MEMLF FIX PREVIOUS LINE AHM 191 SB7 X1 P2 := FF AHM 192 RJ =XP.CMR CHECK FOR MEMORY REDUCTION AHM 193 EQ RLS5 FIX UP FREELIST AND RETURN AHM 194 AHM 195 RLSA DATA C* INCORRECT VALUE PASSED TO RELEASE. * AHM 196 PASAHM SPACE 4,10 V41DC01 25 ** PASAHM - DUMMY ENTRY POINT. V41DC01 26 V41DC01 27 V41DC01 28 PASAHM SUBR ENTRY/EXIT V41DC01 29 EQ PASAHMX RETURN V41DC01 30 AHM SPACE 4,10 AHM 217 END AHM 218 IDENT P.ATAN ATAN 2 B1=1 ATAN 3 ENTRY P.ATAN ATAN 4 ATAN SPACE 4,10 ATAN 5 ATAN TITLE ATAN - INVERSE TANGENT OF ARGUMENT. ATAN 6 COMMENT PASCAL-6000 INVERSE TANGENT ROUTINE. ATAN 7 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. ATAN 8 ATAN SPACE 4,10 ATAN 9 *** ATAN - INVERSE TANGENT OF ARGUMENT. ATAN 10 * L. A. LIDDIARD. CIRCA 1970. ATAN 11 * D. M. LALIBERTE. 76/08/25. ATAN 12 HISTORY SPACE 4,10 HATAN 1 ** PASCAL-6000 MODIFICATION HISTORY. HATAN 2 * HATAN 3 * HATAN 4 ATAN SPACE 4,22 ATAN 13 *** ATAN - INVERSE TANGENT OF ARGUMENT. ATAN 14 * ATAN 15 * ENTRY (B1) = 1. ATAN 16 * (X1) = ARGUMENT. ATAN 17 * ATAN 18 * EXIT (X6) = INVERSE TANGENT OF ARGUMENT. ATAN 19 * EXITS TO P.SABRT IF INDEFINITE ARGUMENT. ATAN 20 * ATAN 21 * USES A - 1, 2, 3, 4, 5. ATAN 22 * B - 2, 3, 7. ATAN 23 * X - ALL. ATAN 24 * ATAN 25 * CALLS P.SABRT. ATAN 26 * ATAN 27 * MACROS NONE. ATAN 28 * ATAN 29 * ALGORTHM AND CONSTANTS ARE COPYRIGHT (C) 1970 BY PROFESSOR ATAN 30 * KRZYSZTOF FRANKOWSKI, UNIVERSITY OF MINNESOTA. ATAN 31 * ATAN 32 * RELATIVE ACCURACY (I.E. ERROR/RESULT) ATAN 33 * AVERAGE = 2.5E-15 IN THE RANGE -2.0 BY .0004 TO +2.0 ATAN 34 * WORST = 8E-15 IN THE RANGE -2.0 BY .0004 TO +2.0 ATAN 35 * ATAN 36 * OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS. ATAN 37 ATAN 38 ATAN 39 ATN2 SA3 ATND PI/4 ATAN 40 SX0 ATNA ATAN 41 FX5 X3+X3 PI/2 ATAN 42 ID X1,=XP.SABRT IF INDEFINITE ARGUMENT ATAN 43 BX6 X7-X5 CORRECT SIGN ATAN 44 ATAN 45 P.ATAN PS ENTRY/EXIT ATAN 46 SA2 ATNB LOAD 1.0 ATAN 47 UX7,B7 X1 B7 = ARGUMENT EXPONENT ATAN 48 SB3 -B1 SET BUMPING REGISTER ATAN 49 SB2 B1 SET J = 1 ATAN 50 AX7 59 SIGN EXTENSION OF ARGUMENT ATAN 51 BX3 X7-X1 Z = ABS(ARG) ATAN 52 SA5 A2+B1 LOAD *16 INTEGERIZER ATAN 53 IX4 X2-X3 COMPARE ARGUMENT WITH 1.0 ATAN 54 PX6 X3 ATAN 55 PL X4,ATN1 IF Z < 1.0 ATAN 56 RX6 X2/X6 OBTAIN INVERSE ATAN 57 SX4 B7 ATAN 58 LX4 48 ATAN 59 SB2 B0 SET J = 0 ATAN 60 IX3 X6-X4 CORRECT EXPONENT OF INVERSE ATAN 61 LT B3,B7,ATN2 ANALYZE LARGE EXPONENT ATAN 62 ATAN 63 ATN1 FX5 X3+X5 OBTAIN INDEX I(I = 0 THROUGH 16) ATAN 64 SB3 X5 ATAN 65 NX0 X5 X0 = I/16 ATAN 66 FX1 X0*X3 X0*Z ATAN 67 FX3 X3-X0 Z-X0 ATAN 68 NX5 X3 ATAN 69 FX0 X2+X1 1.+X0*Z ATAN 70 SA2 B2+ATND LOAD P(J) = 0 OR PI/4 ATAN 71 SA1 B3+ATNC LOAD ARCTAN(X0) ATAN 72 FX3 X5/X0 X = (Z-X0)/(1.+X0*Z) ATAN 73 SX6 B2-B1 -1 IF J = 0 0 IF J = 1 ATAN 74 RX0 X2-X1 P(J)-ARCTAN(X0) ATAN 75 AX6 77B SIGN BITS OF (J-1) ATAN 76 BX7 X6-X7 SIGN(ARG) XOR SIGN(J-1) ATAN 77 SA1 A5+B1 LOAD A3 ATAN 78 FX0 X2+X0 P(J)+(P(J)-ARCTAN(X0)) ATAN 79 SA2 A1+B1 LOAD A2 ATAN 80 FX6 X3*X3 X**2 ATAN 81 FX4 X1*X6 A3*X**2 ATAN 82 SA5 A2+B1 LOAD A4 ATAN 83 RX1 X4+X2 A3*X**2+A2 ATAN 84 FX2 X6*X6 X**4 ATAN 85 FX5 X5*X2 A4*X**4 ATAN 86 SA4 A5+B1 LOAD A1 ATAN 87 RX1 X5+X1 A4*X**4+(A3*X**2+A2) = R ATAN 88 FX6 X4*X6 A1*X**2 ATAN 89 FX2 X1*X2 R*X**4 ATAN 90 RX1 X2+X6 R*X**4+A1*X**2 ATAN 91 FX6 X1*X3 (R*X**4+A1*X**2)*X ATAN 92 RX3 X3+X6 ATAN 93 RX2 X0-X3 2*P(J)-ARCTAN(X0)-POLY ATAN 94 BX5 -X7-X2 GET CORRECT SIGN ATAN 95 NX6,B3 X5 GET NORMALIZED ANSWER ATAN 96 EQ P.ATAN RETURN ATAN 97 ATAN 98 ATNA DATA C* INDEFINITE ARGUMENT OF ARCTAN. * ATAN 99 ATAN 100 ATNB DATA 1.0 ATAN 101 DATA 17730000000000000000B INTEGERIZER ATAN 102 DATA -0.1428541305087450 A3 ATAN 103 DATA 0.1999999958014464 A2 ATAN 104 DATA 0.1102281616126149 A4 ATAN 105 DATA -0.3333333333312845 A1 ATAN 106 ATAN 107 ATNC DATA 0.0 ARCTAN(0/16) ATAN 108 DATA 17137772533556263757B ARCTAN(1/16) ATAN 109 DATA 17147752672465260574B ARCTAN(2/16) ATAN 110 DATA 17155734573227471330B ARCTAN(3/16) ATAN 111 DATA 17157655565762262007B ARCTAN(4/16) ATAN 112 DATA 17164661167156037536B ARCTAN(5/16) ATAN 113 DATA 17165573031203623367B ARCTAN(6/16) ATAN 114 DATA 17166462356607460440B ARCTAN(7/16) ATAN 115 DATA 17167326147012606733B ARCTAN(8/16) ATAN 116 DATA 17174062576451554606B ARCTAN(9/16) ATAN 117 DATA 17174360013527573766B ARCTAN(10/16) ATAN 118 DATA 17174642760071470676B ARCTAN(11/16) ATAN 119 DATA 17175113617506232367B ARCTAN(12/16) ATAN 120 DATA 17175352611416132331B ARCTAN(13/16) ATAN 121 DATA 17175600247612741062B ARCTAN(14/16) ATAN 122 DATA 17176014720556126122B ARCTAN(15/16) ATAN 123 ATND DATA 17176220773250420551B ARCTAN(16/16) = PI/4 ATAN 124 DATA 0.0 ATAN 125 ATAN SPACE 4 ATAN 126 END ATAN 127 IDENT P.BPV BPV 2 SST BPV 3 B1=1 BPV 4 ENTRY P.BPV BPV 5 P.BPV SPACE 4,10 V41AC07 24 P.BPV TITLE P.BPV - POINTER TEST ROUTINE. V41AC07 25 COMMENT PASCAL-6000 POINTER TEST ROUTINE. BPV 8 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. BPV 9 P.BPV SPACE 4,10 V41AC07 26 *** P.BPV - POINTER TEST ROUTINE. V41AC07 27 * J. P. STRAIT. 1977-09-09. V41AC07 28 HISTORY SPACE 4,10 HBPV 1 ** PASCAL-6000 MODIFICATION HISTORY. HBPV 2 * HBPV 3 * CLEAN UP COMPASS DOCUMENTATION. V41AC07 29 * HBPV 4 P.BPV SPACE 4,15 V41AC07 30 *** P.BPV - POINTER TEST ROUTINE. BPV 14 * BPV 15 * FUNCTION (*$E'P.BPV'*) BPV(P : POINTER) : BOOLEAN; BPV 16 * BPV 17 * V41AC07 31 * ENTRY (X0) = POINTER VALUE. V41AC07 32 * (B1) = 1. V41AC07 33 * BPV 20 * EXIT (X6) = 1 (TRUE) IF BAD POINTER, ELSE 0 (FALSE). BPV 21 * BPV 22 * USES X - 1, 2, 6. V41AC07 34 * A - 1. V41AC07 35 BPV 30 BPV 31 BPV ROUTINE P.BPV ENTRY/EXIT V41AC07 36 SA1 =XP.TMEM+MEMFL CURRENT FIELD LENGTH BPV 33 SX6 B1 ASSUME BAD POINTER BPV 34 SX2 X0-1 FWA NODE BPV 35 IX1 X2-X1 BPV 36 BX1 -X1+X2 BPV 37 NG X1,BPVX IF POINTER NOT IN FIELD LENGTH V41AC07 37 SA1 X2 KEY FROM NODE BPV 39 IX1 X0-X1 BPV 40 NZ X1,BPVX IF KEYS DO NOT MATCH V41AC07 38 SX6 B0+ SET GOOD POINTER BPV 42 EQ BPVX RETURN V41AC07 39 P.BPV SPACE 4 V41AC07 40 END BPV 45 IDENT CLOSE CLOSE 2 SST CLOSE 3 B1=1 CLOSE 4 ENTRY CLOSE CLOSE 5 LIST F CLOSE 6 CLOSE SPACE 4,10 CLOSE 7 TITLE CLOSE - CLOSE FILE VARIABLE. CLOSE 8 COMMENT PASCAL-6000 CLOSE FILE VARIABLE. CLOSE 9 COMMENT COPYRIGHT 1978, 1984, UNIVERSITY OF MINNESOTA. CLOSE 10 CLOSE SPACE 4,10 CLOSE 11 *** CLOSE - CLOSE FILE VARIABLE. CLOSE 12 * J. P. STRAIT. 1977-12-08. CLOSE 13 * D. J. BIANCHI. 1984-10-18. CLOSE 14 HISTORY SPACE 4,10 HCLOSE 1 ** PASCAL-6000 MODIFICATION HISTORY. HCLOSE 2 * HCLOSE 3 * HCLOSE 4 CLOSE SPACE 4,20 CLOSE 15 *** CLOSE - CLOSE A PASCAL-6000 FILE VARIABLE. CLOSE 16 * CLOSE 17 * IF THE FILE IS NON-PERSISTENT, IT WILL BE RETURNED. CLOSE 18 * ATTEMPTS TO WRITE OR READ A FILE WHICH HAS BEEN CLOSED, CLOSE 19 * BUT NOT RE-OPENED WILL YIELD UNPREDICTABLE RESULTS. CLOSE 20 * CLOSE 21 * PROCEDURE CLOSE(VAR F : SOMEFILETYPE); CLOSE 22 * CLOSE 23 * CLOSE 24 * ENTRY (B1) = 1. CLOSE 25 * (X0) = ADDRESS OF FILE VARIABLE. CLOSE 26 * CLOSE 27 * EXIT (X2) = FET ADDRESS. CLOSE 28 * CLOSE 29 * USES X - 1. CLOSE 30 * A - 1. CLOSE 31 * B - 3. CLOSE 32 * CLOSE 33 * CALLS P.CLO. CLOSE 34 CLOSE 35 CLOSE 36 CLO ROUTINE CLOSE ENTRY/EXIT CLOSE 37 CLOSE 38 * DETERMINE IF FILE IS TEXT OR BINARY; LOCATE EFET. CLOSE 39 CLOSE 40 SCOPE2 IFNE SCOPE2,1 CLOSE 41 SA1 X0+BINEFET+EFETIN FET+IN OR CHAR BUFFER ELEMENT CLOSE 42 SCOPE2 ELSE CLOSE 43 SA1 X0+BINEFET+EFITIN IN/OUT OR CHAR BUFFER ELEMENT CLOSE 44 SCOPE2 ENDIF CLOSE 45 CLOSE 46 SB3 X0+TXTEFET EFET FOR TEXT FILE CLOSE 47 SX1 X1-MAXORDCH-1 CLOSE 48 NG X1,CLO1 IF TEXT FILE CLOSE 49 SB3 X0+BINEFET EFET FOR BINARY FILE CLOSE 50 CLOSE 51 CLO1 SA1 B3 EFET ADDRESS CLOSE 52 RJ =XP.CLO CLOSE EFET CLOSE 53 CLOSE 54 SCOPE2 IFNE SCOPE2,1 CLOSE 55 RECALL X2 WAIT IF BUSY CLOSE 56 SCOPE2 ENDIF CLOSE 57 CLOSE 58 EQ CLOX RETURN CLOSE 59 CLOSE SPACE 4 CLOSE 60 END CLOSE 61 IDENT P.DBL DBL 2 B1=1 DBL 3 ENTRY P.DADD DBL 4 ENTRY P.DDIV DBL 5 ENTRY P.DMUL DBL 6 ENTRY P.DSUB DBL 7 P.DBL SPACE 4,10 V41AC07 41 P.DBL TITLE P.DBL - DOUBLE PRECISION ROUTINES. V41AC07 42 COMMENT PASCAL-6000 DOUBLE PRECISION ROUTINES. DBL 10 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. DBL 11 P.DBL SPACE 4,10 V41AC07 43 *** P.DBL - DOUBLE PRECISION ROUTINES. V41AC07 44 * J. P. STRAIT. 1978-10-08. V41AC07 45 HISTORY SPACE 4,10 HDBL 1 ** PASCAL-6000 MODIFICATION HISTORY. HDBL 2 * HDBL 3 * CLEAN UP COMPASS DOCUMENTATION. V41AC07 46 * HDBL 4 P.DADD SPACE 4,15 V41AC07 47 *** P.DADD - DOUBLE PRECISION ADD. DBL 16 * DBL 17 * TYPE DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; V41AC07 48 * PROCEDURE (*$E'P.DADD'*) DADD(VAR R: DOUBLE; A,B: DOUBLE); V41AC07 49 * DBL 20 * ENTRY (X0) = ADDRESS OF R. V41AC07 50 * (X1) = ADDRESS OF A. DBL 23 * (X2) = ADDRESS OF B. DBL 24 * (B1) = 1. V41AC07 51 * DBL 25 * EXIT R := A + B IN DOUBLE PRECISION. DBL 26 * DBL 27 * USES X - 1, 2, 3, 4, 5, 6, 7. V41AC07 52 * A - 2, 3, 4, 5, 6, 7. V41AC07 53 DBL 35 DBL 36 ADD ROUTINE P.DADD ENTRY/EXIT V41AC07 54 SA4 X2 B.UPPER DBL 38 SA2 X1 A.UPPER DBL 39 SA5 A4+B1 B.LOWER DBL 40 SA3 A2+B1 A.LOWER DBL 41 FX1 X2+X4 DBL 42 FX7 X3+X5 DBL 43 DX6 X2+X4 DBL 44 FX7 X6+X7 DBL 45 FX6 X1+X7 DBL 46 NX2 X6 DBL 47 DX7 X1+X7 DBL 48 NX1 X7 DBL 49 FX6 X2+X1 DBL 50 DX7 X2+X1 DBL 51 SA6 X0 SET R.UPPER DBL 52 SA7 X0+B1 SET R.LOWER DBL 53 EQ ADDX RETURN V41AC07 55 P.DDIV SPACE 4,15 V41AC07 56 *** P.DDIV - DOUBLE PRECISION DIVIDE. DBL 56 * DBL 57 * TYPE DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; V41AC07 57 * PROCEDURE (*$E'P.DDIV'*) DDIV(VAR R: DOUBLE; A,B: DOUBLE); V41AC07 58 * DBL 60 * ENTRY (X0) = ADDRESS OF R. V41AC07 59 * (X1) = ADDRESS OF A. DBL 63 * (X2) = ADDRESS OF B. DBL 64 * (B1) = 1. V41AC07 60 * DBL 65 * EXIT R := A / B IN DOUBLE PRECISION. DBL 66 * DBL 67 * USES X - 1, 2, 3, 4, 5, 6, 7. V41AC07 61 * A - 2, 3, 4, 5, 6, 7. V41AC07 62 DBL 75 DBL 76 DIV ROUTINE P.DDIV ENTRY/EXIT V41AC07 63 SA4 X2 B.UPPER DBL 78 SA2 X1 A.UPPER DBL 79 SA5 A4+B1 B.LOWER DBL 80 SA3 A2+B1 A.LOWER DBL 81 FX1 X2/X4 DBL 82 FX6 X1*X4 DBL 83 FX7 X2-X6 DBL 84 DX6 X2-X6 DBL 85 NX7 X7 DBL 86 FX6 X7+X6 DBL 87 DX7 X1*X4 DBL 88 FX2 X1*X5 DBL 89 FX6 X6+X3 DBL 90 FX6 X6-X7 DBL 91 FX6 X6-X2 DBL 92 FX2 X6/X4 DBL 93 FX6 X1+X2 DBL 94 DX7 X1+X2 DBL 95 NX1 X6 DBL 96 FX6 X1+X7 DBL 97 DX7 X1+X7 DBL 98 SA6 X0 SET R.UPPER DBL 99 SA7 X0+1 SET R.LOWER DBL 100 EQ DIVX RETURN V41AC07 64 P.DMUL SPACE 4,15 V41AC07 65 *** P.DMUL - DOUBLE PRECISION MULTIPLY. DBL 103 * DBL 104 * TYPE DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; V41AC07 66 * PROCEDURE (*$E'P.DMUL'*) DMUL(VAR R: DOUBLE; A,B: DOUBLE); V41AC07 67 * DBL 107 * ENTRY (X0) = ADDRESS OF R. V41AC07 68 * (X1) = ADDRESS OF A. DBL 110 * (X2) = ADDRESS OF B. DBL 111 * (B1) = 1. V41AC07 69 * DBL 112 * EXIT R := A * B IN DOUBLE PRECISION. DBL 113 * DBL 114 * USES X - 1, 2, 3, 4, 5, 6, 7. V41AC07 70 * A - 2, 3, 4, 5, 6, 7. V41AC07 71 DBL 122 DBL 123 MUL ROUTINE P.DMUL ENTRY/EXIT V41AC07 72 SA4 X2 B.UPPER DBL 125 SA2 X1 A.UPPER DBL 126 SA5 A4+B1 B.LOWER DBL 127 SA3 A2+B1 A.LOWER DBL 128 FX1 X2*X5 DBL 129 FX7 X3*X4 DBL 130 FX1 X1+X7 DBL 131 DX7 X2*X4 DBL 132 FX6 X2*X4 DBL 133 FX1 X1+X7 DBL 134 DX7 X1+X6 DBL 135 FX6 X1+X6 DBL 136 SA6 X0 SET R.UPPER DBL 137 SA7 X0+B1 SET R.LOWER DBL 138 EQ MULX RETURN V41AC07 73 P.DSUB SPACE 4,15 V41AC07 74 *** P.DSUB - DOUBLE PRECISION SUBTRACT. DBL 141 * DBL 142 * TYPE DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; V41AC07 75 * PROCEDURE (*$E'P.DSUB'*) DSUB(VAR R: DOUBLE; A,B: DOUBLE); V41AC07 76 * DBL 145 * ENTRY (X0) = ADDRESS OF R. V41AC07 77 * (X1) = ADDRESS OF A. DBL 148 * (X2) = ADDRESS OF B. DBL 149 * (B1) = 1. V41AC07 78 * DBL 150 * EXIT R := A - B IN DOUBLE PRECISION. DBL 151 * DBL 152 * USES X - 1, 2, 3, 4, 5, 6, 7. V41AC07 79 * A - 2, 3, 4, 5, 6, 7. V41AC07 80 DBL 160 DBL 161 SUB ROUTINE P.DSUB ENTRY/EXIT V41AC07 81 SA4 X2 B.UPPER DBL 163 SA2 X1 A.UPPER DBL 164 SA5 A4+B1 B.LOWER DBL 165 SA3 A2+B1 A.LOWER DBL 166 FX1 X2-X4 DBL 167 FX7 X3-X5 DBL 168 DX6 X2-X4 DBL 169 FX7 X6+X7 DBL 170 FX6 X1+X7 DBL 171 NX2 X6 DBL 172 DX7 X1+X7 DBL 173 NX1 X7 DBL 174 FX6 X2+X1 DBL 175 DX7 X2+X1 DBL 176 SA6 X0 SET R.UPPER DBL 177 SA7 X0+B1 SET R.LOWER DBL 178 EQ SUBX RETURN V41AC07 82 P.DBL SPACE 4 V41AC07 83 END DBL 181 IDENT P.EOI EOI 2 SST EOI 3 B1=1 EOI 4 ENTRY P.EOI EOI 5 LIST F EOI 6 P.EOI SPACE 4,10 EOI 7 TITLE P.EOI - TEST EOI OF FILE VARIABLE. EOI 8 COMMENT PASCAL-6000 TEST EOI OF FILE VARIABLE. EOI 9 COMMENT COPYRIGHT 1984, UNIVERSITY OF MINNESOTA. EOI 10 P.EOI SPACE 4,10 EOI 11 *** P.EOI - TEST EOI OF FILE VARIABLE. EOI 12 * L. H. DAASCH. 1984-04-27. EOI 13 * D. J. BIANCHI. 1984-10-18. EOI 14 HISTORY SPACE 4,10 HEOI 1 ** PASCAL-6000 MODIFICATION HISTORY. HEOI 2 * HEOI 3 * HAVE EOI RETURN TRUE WHEN FILE IS IN GENERATION MODE. V41FC08 7 * HAVE SCOPE2 VERSION OF EOI CHECK EOFS BIT FIRST. V41FC08 8 * USE SYMBOLIC BIT POSITION. V41FC08 9 * HEOI 4 P.EOI SPACE 4,15 EOI 15 *** P.EOI - TEST EOI OF FILE VARIABLE. EOI 16 * EOI 17 * THIS ROUTINE TESTS IF A PASCAL FILE IS POSITIONED EOI 18 * AT END OF INFORMATION. EOI 19 * EOI 20 * ENTRY (A1) = EFET ADDRESS. EOI 21 * (X1) = ((A1)). EOI 22 * EOI 23 * EXIT (X6) = 1 IF EOI, 0 OTHERWISE. EOI 24 * EOI 25 * USES X - 1, 2, 3, 4, 6. EOI 26 * A - 1, 3. EOI 27 * EOI 28 * MACROS FETCH, RECALL. EOI 29 EOI 30 EOI 31 EOI ROUTINE P.EOI ENTRY/EXIT EOI 32 BX6 X6-X6 ASSUME FALSE EOI 33 ERRNZ EEOSF-59 SHIFT X1 V41FC08 10 PL X1,EOIX RETURN FALSE IF NOT (EOS OR EOF) V41FC08 11 SX6 B1 V41FC08 12 LX1 EEOSF-59+59-EREWRITE V41FC08 13 NG X1,EOIX RETURN TRUE IF REWRITE BIT SET V41FC08 14 EOI 34 SCOPE2 IFNE SCOPE2,1 EOI 35 ERRNZ EFETFET-1 FIX NEXT LINE EOI 36 SX2 A1+B1 FET EOI 37 RECALL X2 IN CASE FET BUSY EOI 39 SA3 X2 FET EOI 40 LX3 0-9 POSITION EOI BIT EOI 41 SCOPE2 ELSE EOI 42 SX2 A1+EFITFIT FIT EOI 43 FETCH X2,FP,X3 IF EOI THEN X3 = 100B EOI 44 LX3 0-6 POSITION EOI BIT EOI 45 SCOPE2 ENDIF EOI 46 EOI 47 SX4 B1 EOI 48 BX6 X3*X4 EXTRACT EOI BIT EOI 49 EQ EOIX RETURN EOI 50 P.EOI SPACE 4 EOI 51 END EOI 52 IDENT P.EXP EXP 2 B1=1 EXP 3 ENTRY P.EXP EXP 4 EXP SPACE 4,10 EXP 5 EXP TITLE EXP - EXPONENTIAL FUNCTION OF ARGUMENT. EXP 6 COMMENT PASCAL-6000 EXPONENTIAL FUNCTION ROUTINE. EXP 7 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. EXP 8 EXP SPACE 4,10 EXP 9 *** EXP - EXPONENTIAL FUNCTION OF ARGUMENT. EXP 10 * L. A. LIDDIARD. CIRCA 1970. EXP 11 * D. M. LALIBERTE. 76/08/25. EXP 12 HISTORY SPACE 4,10 HEXP 1 ** PASCAL-6000 MODIFICATION HISTORY. HEXP 2 * HEXP 3 * HEXP 4 EXP SPACE 4,10 EXP 13 *** EXP - EXPONENTIAL FUNCTION OF ARGUMENT. EXP 14 * EXP 15 * ENTRY (B1) = 1. EXP 16 * (X1) = ARGUMENT. EXP 17 * EXP 18 * EXIT (X6) = EXPONENTIAL FUNCTION OF ARGUMENT (E**X). EXP 19 * EXITS TO P.SABRT IF ARGUMENT OUT OF RANGE. EXP 20 * EXP 21 * USES A - 2, 3, 4, 5. EXP 22 * B - 3. EXP 23 * X - ALL. EXP 24 * EXP 25 * CALLS P.SABRT. EXP 26 * EXP 27 * MACROS NONE. EXP 28 * EXP 29 * ALGORITHM AND CONSTANTS COPYRIGHT (C) 1970 BY PROFESSOR EXP 30 * KRZYSZTOF FRANKOWSKI, UNIVERSITY OF MINNESOTA. EXP 31 * EXP 32 * RELATIVE ACCURACY (I.E. ERROR/RESULT) EXP 33 * AVERAGE = 2.2E-15 IN THE RANGE -1.0 BY 00038 TO 2.8 EXP 34 * WORST = 8E-15 IN THE RANGE -1.0 BY 00038 TO 2.8 EXP 35 * EXP 36 * OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS. EXP 37 EXP 38 EXP 39 EXP0 SX6 B0 RETURN ZERO EXP 40 EXP 41 P.EXP PS ENTRY/EXIT EXP 42 SA2 EXPC LOAD LOG2(E) UPPER EXP 43 UX7,B3 X1 GET ARGUMENT EXPONENT EXP 44 FX6 X1*X2 (ARG*LOG2(E)U)UPPER=Z UPPER + N EXP 45 SB3 B3+37 SET TO CHECK TOO LARGE,INF,IND EXP 46 NG B3,EXP1 IF GOOD EXPONENT EXP 47 EQ EXP3 IF BAD EXPONENT EXP 48 EXP 49 EXP1 AX7 77B GET SIGN EXTENSION OF ARGUMENT EXP 50 SA3 A2+B1 LOAD LOG2(E) LOWER EXP 51 PX5 X7 INTEGERIZER HAS CORRECT SIGN EXP 52 RX7 X5+X6 ENTIER(ARG*LOG2(E)+SIGN(.5,ARG)) EXP 53 DX4 X1*X2 (ARG*LOG2(E)UPPER)LOWER EXP 54 FX3 X1*X3 (ARG*LOG2(E)LOWER)UPPER EXP 55 DX2 X6-X7 Z UPPER+N-N=Z UPPER EXP 56 NX6 X2 EXP 57 FX2 X4+X3 (ARG*LOGU)L+(ARG*LOGL)U=Z LOWER EXP 58 SB3 X7-2055B SET EXPONENT OVERFLOW CHECK EXP 59 FX1 X6+X2 Z=Z UPPER + Z LOWER EXP 60 SA4 A3+B1 LOAD C3 EXP 61 FX2 X1*X1 Z**2 EXP 62 FX6 X2*X2 Z**4 EXP 63 SA3 A4+B1 LOAD C4 EXP 64 NG B3,EXP2 IF NO EXPONENT OVERFLOW EXP 65 EQ EXP3 IF EXPONENT OVERFLOW EXP 66 EXP 67 EXP2 FX4 X4*X2 C3*Z**2 EXP 68 SA5 A3+B1 LOAD C2 EXP 69 FX0 X4+X5 C3*Z**2+C2 EXP 70 FX3 X3*X6 C4*Z**4 EXP 71 SB3 X7+1717B SET EXPONENT UNDERFLOW CHECK EXP 72 SA5 A5+B1 LOAD C1 EXP 73 FX0 X3+X0 C4*Z**4+C3*Z**2+C2=PU EXP 74 SA4 A5+B1 LOAD C0 EXP 75 FX2 X5*X2 C1*Z**2 EXP 76 FX6 X0*X6 PU*Z**4 (ZERO IF EXPONENT UNDERFLOW) EXP 77 FX0 X6+X2 PU*Z**4+C1*Z**2 EXP 78 GE B0,B3,EXP0 IF SMALL EXPONENT EXP 79 FX3 X0+X4 PU*Z**J+C1*Z**2+C0=POLY EXP 80 RX4 X3+X1 POLY+Z EXP 81 UX2,B3 X4 EXP 82 SB3 X7+B3 ADD N TO EXPONENT EXP 83 FX5 X3-X1 POLY - Z EXP 84 PX3 X2,B3 EXP 85 FX6 X3/X5 EXP(ARG)=(POLY+Z)/(POLY-Z) EXP 86 EQ P.EXP RETURN EXP 87 EXP 88 EXP3 SX0 EXPA EXP 89 ID X1,EXP4 IF INDEFINITE ARGUMENT EXP 90 OR X1,EXP4 IF INFINITE ARGUMENT EXP 91 SX0 EXPB IF ARGUMENT TOO LARGE EXP 92 EXP4 EQ =XP.SABRT ABORT EXP 93 EXP 94 EXPA DATA C* INFINITE OR INDEF ARGUMENT OF EXP. * EXP 95 EXP 96 EXPB DATA C* ABS(ARG) GREATER THAN 740.3 IN EXP.* EXP 97 EXP 98 EXPC DATA 17205612507312256027B LOG2(E) UPPER EXP 99 DATA 16407413567641777322B LOG2(E) LOWER EXP 100 DATA 1.05819256182728E-5 EXP 101 DATA -1.26051181801546E-7 EXP 102 DATA -9.25068448947120E-4 EXP 103 DATA 17147311403775206256B EXP 104 DATA 2.8853900817779429E0 EXP 105 EXP SPACE 4 EXP 106 END EXP 107 IDENT FILENAM FILENAM 2 SST FILENAM 3 B1=1 FILENAM 4 ENTRY FILENAM FILENAM 5 LIST F FILENAM 6 FILENAM SPACE 4,10 FILENAM 7 TITLE FILENAM - RETURN ACTUAL NAME OF FILE VARIABLE. FILENAM 8 COMMENT PASCAL-6000 RETURN ACTUAL NAME OF FILE VARIABLE. FILENAM 9 COMMENT COPYRIGHT 1978, 1984, UNIVERSITY OF MINNESOTA. FILENAM 10 FILENAM SPACE 4,10 FILENAM 11 *** FILENAM - RETURN ACTUAL NAME OF FILE VARIABLE. FILENAM 12 * J. P. STRAIT. 1977-12-08. FILENAM 13 * D. J. BIANCHI. 1984-10-18. FILENAM 14 HISTORY SPACE 4,10 HFILENA 1 ** PASCAL-6000 MODIFICATION HISTORY. HFILENA 2 * HFILENA 3 * ADD ASCII CONDITIONAL ASSEMBLY. V41CC10 568 * HFILENA 4 FILENAM SPACE 4,20 FILENAM 15 *** FILENAM - RETURN THE ACTUAL NAME OF A PASCAL FILE VARIABLE. FILENAM 16 * FILENAM 17 * PROCEDURE FILENAME(VAR F : SOMEFILETYPE; VAR N : ALFA); FILENAM 18 * FILENAM 19 * FILENAM 20 * ENTRY (B1) = 1. FILENAM 21 * (X0) = ADDRESS OF FILE VARIABLE. FILENAM 22 * (X1) = ADDRESS TO RECEIVE FILE NAME. FILENAM 23 * FILENAM 24 * EXIT ((X1)) = FILE NAME SPACE FILLED. FILENAM 25 * (X6) = FILE NAME SPACE FILLED. FILENAM 26 * FILENAM 27 * USES X - 1, 2, 6. V41CC10 569 * A - 1, 6. FILENAM 29 * B - 3, 7. FILENAM 30 * FILENAM 31 * CALLS P.DWA, SFN=. V41CC10 570 FILENAM 33 FILENAM 34 FNM ROUTINE FILENAM ENTRY/EXIT FILENAM 35 SB3 X1 V41CC10 571 FILENAM 37 * DETERMINE IF FILE IS TEXT OR BINARY; LOCATE EFET. FILENAM 38 FILENAM 39 SCOPE2 IFNE SCOPE2,1 FILENAM 40 SA1 X0+BINEFET+EFETIN FET+IN OR CHAR BUFFER ELEMENT FILENAM 41 SCOPE2 ELSE FILENAM 42 SA1 X0+BINEFET+EFITIN IN/OUT OR CHAR BUFFER ELEMENT FILENAM 43 SCOPE2 ENDIF FILENAM 44 FILENAM 45 SB7 X0+TXTEFET EFET OF TEXT FILE V41CC10 572 SX1 X1-MAXORDCH-1 FILENAM 47 NG X1,FNM1 IF TEXT FILE FILENAM 48 SB7 X0+BINEFET EFET OF BINARY FILE V41CC10 573 FILENAM 50 FNM1 BSS 0 FILENAM 51 FILENAM 52 SCOPE2 IFNE SCOPE2,1 FILENAM 53 SA1 B7+EFETFET FET ADDRESS V41CC10 574 SCOPE2 ELSE FILENAM 55 SA1 B7+EFITFIT FIT ADDRESS V41CC10 575 SCOPE2 ENDIF FILENAM 57 FILENAM 58 MX6 DCCHARSZ*7 MASK SEVEN DISPLAY CODE CHARS V41CC10 576 BX1 X6*X1 FILENAM 60 RJ =XSFN= SPACE FILL NAME FILENAM 61 V41CC10 577 ASCII IFEQ ASCFLAG,1 V41CC10 578 BX1 X6 V41CC10 579 SX2 ASALFALN V41CC10 580 RJ =XP.DWA CONVERT DISPLAY CODE WORD TO ASCII V41CC10 581 ASCII ENDIF V41CC10 582 V41CC10 583 SA6 B3 STORE FILE NAME V41CC10 584 EQ FNMX RETURN FILENAM 63 FILENAM SPACE 4 FILENAM 64 END FILENAM 65 IDENT P.GETF GETF 2 SST GETF 3 B1=1 GETF 4 ENTRY P.GETF GETF 5 LIST F GETF 6 P.GETF SPACE 4,10 GETF 7 TITLE P.GETF - GET FILE ROUTINE. GETF 8 COMMENT PASCAL-6000 GET FILE ROUTINE. GETF 9 COMMENT COPYRIGHT 1984, UNIVERSITY OF MINNESOTA. GETF 10 P.GETF SPACE 4,10 GETF 11 *** P.GETF - GET FILE ROUTINE. GETF 12 * L. H. DAASCH. 1984-04-27. GETF 13 * D. J. BIANCHI. 1984-10-18. GETF 14 HISTORY SPACE 4,10 HGETF 1 ** PASCAL-6000 MODIFICATION HISTORY. HGETF 2 * HGETF 3 * CORRECT CODE TO USE NEW VALUE OF *ERT* AND TO USE *ERTW*. V41DC09 14 * HGETF 4 P.GETF SPACE 4,25 GETF 15 *** P.GETF - GET FILE ROUTINE. GETF 16 * GETF 17 * THIS ROUTINE SKIPS FORWARD OR BACK OVER FILES IN A GETF 18 * PASCAL MULTI-FILE FILE. ON SCOPE2 SYSTEMS THIS GETF 19 * ROUTINE SKIPS FORWARD AND BACK OVER PARTITIONS IN GETF 20 * A MULTI-PARTITION FILE. GETF 21 * GETF 22 * ENTRY (A1) = EFET ADDRESS. GETF 23 * (X1) = ((A1)). GETF 24 * (X2) = SKIP COUNT. GETF 25 * GETF 26 * EXIT (X2) = FET. GETF 27 * GETF 28 * USES X - ALL. GETF 29 * A - 1, 3, 4, 6. GETF 30 * B - 2, 3. GETF 31 * GETF 32 * CALLS P.FOB, P.IOE, P.SRS. GETF 33 * GETF 34 * MACROS FETCH, GETPOS, POSITION, RECALL, SKIPBP, SKIPFB, GETF 35 * SKIPFF, SKIPFL, SKIPFP, STORE. GETF 36 GETF 37 GETF 38 SCOPE2 IFNE SCOPE2,1 GETF 39 GTF1 PL X7,GTF2 IF ABS(SKIP COUNT) > 777776B GETF 40 LX6 1 GETF 41 IX1 X5+X6 ADD ONE TO COUNT GETF 42 GTF2 SKIPFB X2,X1,R SKIP BACKWARDS GETF 43 RJ =XP.SRS SET READ STATUS GETF 44 GETF 45 GTF ROUTINE P.GETF ENTRY/EXIT GETF 46 BX6 X2 GETF 47 SA6 GTFA SAVE SKIP COUNT GETF 48 ERRNZ EFETFET-1 FIX NEXT LINE GETF 49 SX2 A1+B1 FET GETF 50 RJ =XP.FOB FLUSH OUTPUT BUFFER GETF 51 RECALL X2 WAIT I/O COMPLETE GETF 52 MX6 1 GETF 53 MX1 18 GETF 54 LX1 18 GETF 55 SA3 GTFA GET SKIP COUNT GETF 56 BX0 X3 GETF 57 AX0 59 GETF 58 BX5 X0-X3 ABS(SKIP COUNT) GETF 59 IX7 X5-X1 ABS(SKIP COUNT) - 777777B GETF 60 NG X3,GTF1 IF NEGATIVE SKIP COUNT GETF 61 ZR X3,GTF1 IF ZERO SKIP COUNT GETF 62 PL X7,GTF3 IF ABS(SKIP COUNT) > 777776B GETF 63 SA4 X2-EFETFET EFET GETF 64 LX0 X4,B1 GETF 65 BX7 X0*X6 GETF 66 LX7 1 GETF 67 IX1 X5-X7 SUBTRACT ONE IF EOF GETF 68 ZR X1,GTF3 IF FINAL COUNT ZERO GETF 69 SKIPFF X2,X1,R SKIP FORWARD GETF 70 GETF 71 GTF3 RJ =XP.SRS SET READ STATUS GETF 72 EQ GTFX RETURN GETF 73 GETF 74 GTFA BSS 1 SKIP COUNT GETF 75 GETF 76 SCOPE2 ELSE GETF 77 GETF 78 GTF.END MX6 2 GETF 79 SA1 A1 REFRESH X1 GETF 80 BX6 X6+X1 GETF 81 SA6 A1 GETF 82 GTF.RET STORE X2,DX=0 GETF 83 ZR X0,GTFX GETF 84 STORE X2,RT=Z RESTORE RT=Z GETF 85 GETF 86 GTF ROUTINE P.GETF ENTRY/EXIT GETF 87 SB2 X2 GETF 88 SX2 A1+EFITFIT FIT GETF 89 RJ =XP.FOB FLUSH OUTPUT BUFFER GETF 90 SA1 X2-EFITFIT REFRESH X1 GETF 91 SX3 B2 SET COUNT GETF 92 FETCH X2,FP,X5 GETF 93 NG X3,GTF1 GETF 94 SX6 X5-FPEOI GETF 95 ZR X6,GTF.END IF AT EOI GETF 96 GTF1 LX1 -ERT-ERTW V41DC09 15 AX1 -ERTW X1 = RT V41DC09 16 ZR X1,GTF3 IF RT = W GETF 99 SX0 X1-RTS GETF 100 ZR X1,GTF3 IF RT = S GETF 101 SX0 X1-RTZ GETF 102 ZR X1,GTF2 IF RT = Z GETF 103 EQ GTF.ERR IF UNSUPPORTED RECORD-TYPE GETF 104 GETF 105 GTF2 STORE X2,RT=S SKIP MACROS DO NOT ALLOW RT = Z GETF 106 SX0 1 SET FLAG FOR RT = Z GETF 107 GTF3 SB3 X3 B3 = SIGN(X3) IN EFFECT GETF 108 PL X3,GTF4 GETF 109 IX3 X3-1 ADD ONE TO ABS(COUNT) IF COUNT <= ZERO GETF 110 BX3 -X3 GETF 111 GTF4 STORE X2,DX=GTF.CHK GETF 112 NG B3,GTF.B GETF 113 GTF.F SKIPFP X2,377777B GETF 114 EQ GTF.F GETF 115 GTF.B SKIPBP X2,377777B GETF 116 EQ GTF.B GETF 117 GETF 118 GTF.CHK PS GETF 119 FETCH X2,FP,X5 GETF 120 SX4 X5-FPBOI GETF 121 ZR X4,GTF.RET IF AT BOI GETF 122 SX4 X5-FPEOI GETF 123 ZR X4,GTF.END IF AT EOI GETF 124 SX3 X3-1 GETF 125 PL X3,GTF.CHK IF NOT COUNTED OUT, CONTINUE GETF 126 PL B3,GTF.RET IF FORWARD SKIP GETF 127 GETPOS X2,X5 GETF 128 POSITION X2,X5 GETF 129 STORE X2,DX=0 GETF 130 SKIPFL X2,1 SET AT FIRST DATA RECORD GETF 131 EQ GTFX RETURN GETF 132 GETF 133 GTF.ERR SX1 RMIOEE GETF 134 SX0 X2-EFETFET-TXTEFET ADDRESS OF FILE VARIABLE GETF 135 RJ =XP.IOE ISSUE INPUT/OUTPUT ERROR GETF 136 SCOPE2 ENDIF GETF 137 P.GETF SPACE 4 GETF 138 END GETF 139 IDENT GETPAGE GETPAGE 2 SST GETPAGE 3 SYSCOM B1 GETPAGE 4 IPARAMS GETPAGE 5 LIST F GETPAGE 6 ENTRY GETPAGE GETPAGE 7 ENTRY SETPAGE GETPAGE 8 GETPAGE SPACE 4,10 GETPAGE 9 GETPAGE TITLE GETPAGE - GET/SET PAGE SIZE PARAMETERS. GETPAGE 10 COMMENT PASCAL-6000 GET/SET PAGE SIZE PARAMETERS. GETPAGE 11 COMMENT COPYRIGHT 1985, UNIVERSITY OF MINNESOTA. GETPAGE 12 GETPAGE SPACE 4,10 GETPAGE 13 *** GETPAGE - GET/SET PAGE SIZE PARAMETERS. GETPAGE 14 HISTORY SPACE 4,10 HGETPAG 1 ** PASCAL-6000 MODIFICATION HISTORY. HGETPAG 2 * HGETPAG 3 * HGETPAG 4 * D. J. BIANCHI. 1985-04-23. GETPAGE 15 GETPAGE SPACE 4,20 GETPAGE 16 *** GETPAGE - GET PAGE SIZE PARAMETERS. GETPAGE 17 * GETPAGE 18 * TYPE PAGESIZEREC = RECORD PD, PS, PW : INTEGER END; GETPAGE 19 * PROCEDURE GETPAGE(VAR P : PAGESIZEREC); GETPAGE 20 * GETPAGE 21 * GETPAGE 22 * ENTRY (X0) = ADDRESS OF PAGESIZEREC VARIABLE. GETPAGE 23 * (B1) = 1. GETPAGE 24 * GETPAGE 25 * EXIT ((X0)) = DEFAULT PAGE DENSITY. GETPAGE 26 * ((X0)+1) = DEFAULT PAGE LENGTH. GETPAGE 27 * ((X0)+2) = DEFAULT PAGE WIDTH. GETPAGE 28 * GETPAGE 29 * USES X - 3, 4, 6, 7. GETPAGE 30 * A - 3, 6, 7. GETPAGE 31 * B - 2. GETPAGE 32 * GETPAGE 33 * MACROS GETPAGE. GETPAGE 34 GETPAGE 35 GETPAGE 36 GTP ROUTINE GETPAGE ENTRY/EXIT GETPAGE 37 SB2 X0 GETPAGE 38 GETPAGE 39 GETPAGE IF MAC,GETPAGE GETPAGE 40 GETPAGE GTPA GET PAGE SIZE PARAMETERS GETPAGE 41 GETPAGE ENDIF GETPAGE 42 GETPAGE 43 SA3 GTPA GETPAGE 44 MX4 -4 GETPAGE 45 LX3 -28 GETPAGE 46 BX6 -X4*X3 PAGE DENSITY GETPAGE 47 LX3 8 GETPAGE 48 MX4 -8 GETPAGE 49 SA6 B2 STORE PAGE DENSITY GETPAGE 50 BX7 -X4*X3 PAGE LENGTH GETPAGE 51 LX3 8 GETPAGE 52 BX6 -X4*X3 PAGE WIDTH GETPAGE 53 SA7 A6+B1 STORE PAGE LENGTH GETPAGE 54 SA6 A7+B1 STORE PAGE WIDTH GETPAGE 55 EQ GTPX RETURN GETPAGE 56 GETPAGE 57 GTPA VFD 28/0,4/IP.PD,8/IP.PS,8/136,12/0 GETPAGE 58 DATA 0 GETPAGE 59 SETPAGE SPACE 4,20 GETPAGE 60 *** SETPAGE - SET PAGE SIZE PARAMETERS. GETPAGE 61 * GETPAGE 62 * TYPE PAGESIZEREC = RECORD PD, PS, PW : INTEGER END; GETPAGE 63 * PROCEDURE SETPAGE(P : PAGESIZEREC); GETPAGE 64 * GETPAGE 65 * GETPAGE 66 * ENTRY (X0) = ADDRESS OF PAGESIZEREC VARIABLE. GETPAGE 67 * (B1) = 1. GETPAGE 68 * GETPAGE 69 * EXIT PAGE SIZE PARAMETERS SET IF SETPAGE DEFINED. GETPAGE 70 * (GTPA) = PAGE SIZE PARAMETERS, OTHERWISE. GETPAGE 71 * GETPAGE 72 * USES X - 1, 2, 3, 4, 5, 6. GETPAGE 73 * A - 1, 2, 3, 6. GETPAGE 74 * GETPAGE 75 * MACROS SETPAGE. GETPAGE 76 GETPAGE 77 GETPAGE 78 STP ROUTINE SETPAGE ENTRY/EXIT GETPAGE 79 SA1 X0 GETPAGE 80 MX4 -4 GETPAGE 81 SA2 A1+B1 GETPAGE 82 MX5 -8 GETPAGE 83 SA3 A2+B1 GETPAGE 84 BX1 -X4*X1 GETPAGE 85 BX2 -X5*X2 GETPAGE 86 LX1 28 GETPAGE 87 BX3 -X5*X3 GETPAGE 88 LX2 20 GETPAGE 89 BX6 X1+X2 GETPAGE 90 LX3 12 GETPAGE 91 BX6 X6+X3 GETPAGE 92 SA6 GTPA STORE PAGE SIZE PARAMETERS GETPAGE 93 GETPAGE 94 SETPAGE IF MAC,SETPAGE GETPAGE 95 SETPAGE GTPA SET PAGE SIZE PARAMETERS GETPAGE 96 SETPAGE ENDIF GETPAGE 97 GETPAGE 98 EQ STPX RETURN GETPAGE 99 GETPAGE SPACE 4 GETPAGE 100 END GETPAGE 101 IDENT P.LN LN 2 B1=1 LN 3 ENTRY P.LN LN 4 LN SPACE 4,10 LN 5 LN TITLE LN - NATURAL LOGARITHM OF ARGUMENT. LN 6 COMMENT PASCAL-6000 NATURAL LOGARITHM ROUTINE. LN 7 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. LN 8 LN SPACE 4,10 LN 9 *** LN - NATURAL LOGARITHM OF ARGUMENT. LN 10 * L. A. LIDDIARD. CIRCA 1970. LN 11 * D. M. LALIBERTE. 76/08/25. LN 12 HISTORY SPACE 4,10 HLN 1 ** PASCAL-6000 MODIFICATION HISTORY. HLN 2 * HLN 3 * HLN 4 LN SPACE 4,10 LN 13 *** LN - NATURAL LOGARITHM OF ARGUMENT. LN 14 * LN 15 * ENTRY (B1) = 1. LN 16 * (X1) = ARGUMENT. LN 17 * LN 18 * EXIT (X6) = NATURAL LOGARITHM OF ARGUMENT. LN 19 * EXITS TO P.SABRT IF ARGUMENT OUT OF RANGE. LN 20 * LN 21 * USES A - 2, 3, 5. LN 22 * B - 2, 3, 7. LN 23 * X - ALL. LN 24 * LN 25 * CALLS P.SABRT. LN 26 * LN 27 * MACROS NONE. LN 28 * LN 29 * ALGORITHM AND CONSTANTS COPYRIGHT (C) 1970 BY PROFESSOR LN 30 * KRZYSZTOF FRANKOWSKI, UNIVERSITY OF MINNESOTA. LN 31 * LN 32 * RELATIVE ACCURACY (I.E. ERROR/RESULT) LN 33 * AVERAGE = 1.8E-15 IN THE RANGE .135 BY .00072 TO 7.38 LN 34 * WORST = 8E-15 IN THE RANGE .135 BY .00072 TO 7.38 LN 35 * LN 36 * OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS. LN 37 LN 38 LN 39 P.LN PS ENTRY/EXIT LN 40 MX4 16 MASK FOR Z0 IF ARGUMENT >= 1.0 LN 41 SB3 -47 B3=EXPONENT OF 1.0 LN 42 UX7,B7 X1 B2=ARGUMENT EXPONENT LN 43 BX2 X7 SAVE MANTISSA LN 44 AX7 44 I+8 LN 45 GE B7,B3,LOG1 IF ARGUMENT >= 1.0 LN 46 SX6 X7+B1 FORM Z0 .5625(.0625)1.0 LN 47 LX6 44 LN 48 SB2 X7+LOGD-15 LOAD CONM(I) (IE LOGE(Z0) LN 49 IX5 X2+X6 FORM Z+Z0 LN 50 AX5 1 LN 51 IX2 X2-X6 FORM Z-Z0 LN 52 PX0 X5,B3 PACK EXPONENT 1.0 LN 53 SB3 B3-B1 LN 54 PX2 X2,B3 PACK EXPONENT 0.5 LN 55 SA5 LOGC LOAD LOGE(2.0) LOWER LN 56 NX2 X2 LN 57 RX0 X2/X0 T=(Z-Z0)/(Z+Z0) LN 58 AX1 48 LN 59 SX7 B7-B3 FORM N LN 60 SB3 X1+ LN 61 LT B0,B3,LOG2 IF ARGUMENT > 0.0 LN 62 EQ LOG4 LN 63 LN 64 LOG1 PX5 X1,B3 FORM 2Z LN 65 BX6 X4*X5 FORM Z0 1.(.125)1.875 LN 66 FX0 X5+X6 2Z+Z0 LN 67 BX3 X1 SAVE ARGUMENT LN 68 AX1 48 LN 69 BX5 -X4*X5 FORM 2Z-Z0 LN 70 SB2 X7+LOGD-8 LOAD LOGD(I) (IE LOGE(Z0)) LN 71 PX6 X5,B3 PACK EXPONENT OF 1.0 LN 72 SA5 LOGC LOAD LOGE(2.0) LOWER LN 73 NX2 X6 LN 74 RX0 X2/X0 T=(2Z-Z0)/(2Z+Z0) LN 75 LX3 2 SEE IF INFINITE OR INDEFINITE ARGUMENT LN 76 SX7 B7-B3 FORM N-1 LN 77 AX3 50 LN 78 NZ X3,LOG2 LN 79 NZ B7,LOG3 IF INFINITE OR INDEFINITE ARGUMENT LN 80 LN 81 LOG2 PX7 X7 FLOAT N OR N-1 CALL IT M LN 82 SA2 A5+B1 LOAD C3 LN 83 SB3 X1 B3 > 0 IF NOT 0 OR NEG ARGUMENT LN 84 NX7 X7 LN 85 FX4 X7*X5 M*LOGE(2.) LOWER LN 86 FX6 X0*X0 T**2 LN 87 SA5 A2+B1 LOAD C4 LN 88 FX1 X0+X0 2*T LN 89 FX1 X4+X1 M*LOGE(2)+2*T LN 90 SA3 A5+B1 LOAD C2 LN 91 FX2 X2*X6 C3*T**2 LN 92 FX4 X6*X6 T**4 LN 93 RX3 X2+X3 C3*T**2+C2 LN 94 FX5 X5*X4 C4*T**4 LN 95 SA2 A3+B1 LOAD C1 LN 96 FX0 X0*X6 T**3 LN 97 RX3 X5+X3 C4*T**4+C3*T**2+C2=R LN 98 FX6 X2*X6 C1*T**2 LN 99 SA2 A2+B1 LOAD C0 LN 100 FX4 X3*X4 R*T**4 LN 101 SA5 A2+B1 LOAD LOGE(2) UPPER LN 102 RX3 X6+X2 C1*T**2+C0 LN 103 RX6 X4+X3 R*T**4+C1*T**2+C0=POLY LN 104 RX3 X6*X6 POLY**2 LN 105 SA4 B2 LOAD LOGE(Z0) LN 106 RX0 X0*X3 T**3*POLY**2 LN 107 GE B0,B3,LOG4 IF BAD ARGUMENT LN 108 FX7 X7*X5 M*LOGE(2)UPPER LN 109 RX2 X1+X0 2*T+T**3*POLY**2 LN 110 RX1 X4+X2 LOG(Z0)+2*T+T**3*POLY**2 LN 111 RX6 X7+X1 M*LOG(2)+LOG(Z0)+2*T+T**3*PLY**2 LN 112 EQ P.LN RETURN LN 113 LN 114 LOG3 SX0 LOGA INFINITE OR INDEFINITE ARGUMENT LN 115 EQ =XP.SABRT ABORT LN 116 LN 117 LOG4 SX0 LOGB NEGATIVE OR ZERO ARGUMENT LN 118 EQ =XP.SABRT ABORT LN 119 LN 120 LOGA DATA C* INFINITE OR INDEF ARGUMENT OF LN.* LN 121 LN 122 LOGB DATA C* ZERO OR NEGATIVE ARGUMENT OF LN. * LN 123 LN 124 LOGC DATA 16530717363257120000B LOG2 LOWER LN 125 DATA 9.458758712636952E-2 C3 LN 126 DATA 7.336694749002597E-2 C4 LN 127 DATA 1.382213850374260E-1 C2 LN 128 DATA 2.449489737976310E-1 C1 LN 129 DATA 8.164965809281486E-1 C0 LN 130 DATA 17175427102775750000B LOG2 UPPER LN 131 LN 132 DATA 60603313235735454443B LOGE(0.5625) LN 133 DATA 60610365565713543310B LOGE(0.6250) LN 134 DATA 60612002405610237526B LOGE(0.6875) LN 135 DATA 60613313235735454442B LOGE(0.7500) LN 136 DATA 60621266022606724460B LOGE(0.8125) LN 137 DATA 60623564161373540333B LOGE(0.8750) LN 138 DATA 60633675147224607057B LOGE(0.9375) LN 139 LOGD DATA 00000000000000000000B LOGE(1.0000) LN 140 DATA 17147423407334253627B LOGE(1.1250) LN 141 DATA 17157107767617152322B LOGE(1.2500) LN 142 DATA 17165060613604161366B LOGE(1.3750) LN 143 DATA 17166371443731376303B LOGE(1.5000) LN 144 DATA 17167611217277274067B LOGE(1.6250) LN 145 DATA 17174364137274701006B LOGE(1.7500) LN 146 DATA 17175016617720431625B LOGE(1.8750) LN 147 LN SPACE 4 LN 148 END LN 149 IDENT P.MVE MVE 2 SST MVE 3 SYSCOM B1 MVE 4 LIST F MVE 5 ENTRY P.MVE MVE 6 P.MVE SPACE 4,10 V41AC07 84 P.MVE TITLE P.MVE - MOVE BLOCK OF DATA. V41AC07 85 COMMENT PASCAL-6000 MOVE DATA ROUTINE. MVE 9 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. MVE 10 P.MVE SPACE 4,10 V41AC07 86 *** MVE - MOVE BLOCK OF DATA. V41AC07 87 * J. J. DRUMMOND. 1978-10-01. V41AC07 88 HISTORY SPACE 4,10 HMVE 1 ** PASCAL-6000 MODIFICATION HISTORY. HMVE 2 * HMVE 3 * CLEAN UP COMPASS DOCUMENTATION. V41AC07 89 * CHANGE SYMBOL *NOS* TO *NOS1+NOS2*. V41AC01 63 * HMVE 4 P.MVE SPACE 4,20 V41AC07 90 *** P.MVE - MOVE BLOCK OF DATA. V41AC07 91 * V41AC07 92 * P.MVE MOVES A BLOCK OF DATA FROM ONE LOCATION TO ANOTHER. V41AC07 93 * IF THE CMU IS AVAILABLE, IT IS USED OTHERWISE AN IN-STACK V41AC07 94 * REGISTER MOVE LOOP IS EMPLOYED. MVE ASSUMES THERE ARE AT V41AC07 95 * LEAST 8 WORDS TO BE MOVED. V41AC07 96 * MVE 19 * ENTRY (A1) = ADDRESS OF FIRST WORD TO BE MOVED. MVE 20 * (X1) = ((A1)). V41AC07 97 * (B1) = 1. MVE 21 * (B2) = ADDRESS OF FIRST WORD TO RECEIVE DATA. MVE 22 * (B7) = NUMBER OF WORDS TO BE MOVED (>7). MVE 23 * MVE 25 * EXIT DATA BLOCK MOVED. MVE 26 * MVE 27 * USES X - ALL. V41AC07 98 * A - 1, 2, 3, 4, 5, 6, 7. V41AC07 99 * B - 2, 3, 7. V41AC07 100 MVE 35 MVE 36 SCOPE2 IFNE SCOPE2,1 V41AC01 64 MVE4 LX1 30 MVE 38 SX6 819 MAXIMUM WORD TRANSFER SIZE MVE 39 BX5 X1+X2 ADDRESSES MVE 40 SB3 X6 MVE 41 SX4 17B 4 BIT MASK MVE 42 LX6 30 MVE 43 SX7 B3 MVE 44 SB2 MVEB ADDRESS OF DESCRIPTOR WORD MVE 45 BX7 X6+X7 ADDER MVE 46 MVE 47 * MOVE NEXT BLOCK OF DATA (CMU). MVE 48 MVE 49 MVE5 SX3 B7 NUMBER OF WORDS TO TRANSFER MVE 50 LE B7,B3,MVE6 IF LESS THAN 819 WORDS TO MOVE MVE 51 SX3 B3 SET LENGTH OF TRANSFER MVE 52 MVE6 IX6 X3+X3 TIMES 2 MVE 53 LX3 3 TIMES 8 MVE 54 IX0 X6+X3 CC := NUMBER OF WORDS * 10 (CHAR COUNT) MVE 55 BX1 X4*X0 CC (LOWER) MVE 56 BX0 -X4*X0 CC (UPPER) MVE 57 LX1 26 POSITION CC (LOWER) MVE 58 LX0 48-4 POSITION CC (UPPER) MVE 59 BX3 X1+X0 MVE 60 IX6 X3+X5 DESCRIPTOR WORD MVE 61 SB7 B7-B3 DECREMENT WORD COUNT MVE 62 IX5 X5+X7 ADVANCE ADDRESSES MVE 63 SA6 B2 STORE DESCRIPTOR WORD MVE 64 IM B2 MOVE WORDS MVE 65 GT B7,B0,MVE5 IF NOT DONE V41AC07 101 SCOPE2 ENDIF V41AC01 65 MVE 69 MVE ROUTINE P.MVE ENTRY/EXIT V41AC07 102 SB3 A1+ MVE 71 EQ B2,B3,MVEX RETURN IF ADDRESSES EQUAL V41AC07 103 MVE 73 SCOPE2 IFNE SCOPE2,1 V41AC01 66 MVEA SA5 CMUR CHECK IF CMU AVAILABLE MVE 75 RJ MVEB VOID STACK MVE 76 MVE 77 *MVEA SA3 B2-B1 PREAMBLE CODE (NO CMU) MVE 78 * SA2 A1+B1 PRE-LOAD MVE 79 * BX7 X3 MVE 80 * SA7 A3 INITIALIZE A7 MVE 81 MVE 82 *MVEA SX2 B2 PREAMBLE CODE (CMU) MVE 83 * SX1 A1 MVE 84 * EQ MVE4 CONTINUE MVE 85 SCOPE2 ENDIF V41AC01 67 MVE 87 * MOVE DATA WITH REGISTERS. MVE 88 MVE 89 SB3 8 NUMBER OF WORDS MOVED IN LOOP MVE 90 MVE1 BX6 X1 MVE 91 LX7 X2 MVE 92 SA6 A7+B1 MVE 93 SA7 A6+B1 MVE 94 SA1 A2+B1 MVE 95 SA2 A1+B1 MVE 96 BX6 X1 MVE 97 LX7 X2 MVE 98 SA6 A7+B1 MVE 99 SA7 A6+B1 MVE 100 SB7 B7-B3 DECREMENT WORD COUNT MVE 101 SA1 A2+B1 MVE 102 SA2 A1+B1 MVE 103 BX6 X1 MVE 104 LX7 X2 MVE 105 SA6 A7+B1 MVE 106 SA7 A6+B1 MVE 107 SA1 A2+B1 MVE 108 SA2 A1+B1 MVE 109 BX6 X1 MVE 110 LX7 X2 MVE 111 SA6 A7+B1 MVE 112 SA7 A6+B1 MVE 113 SA1 A2+B1 MVE 114 SA2 A1+B1 MVE 115 GE B7,B3,MVE1 IF AT LEAST 8 MORE WORDS TO MOVE MVE 116 MVE 117 * MOVE REMAINING WORDS (IF ANY). MVE 118 MVE 119 MVE2 ZR B7,MVEX IF ALL DONE V41AC07 104 BX7 X1 MVE 121 SA7 A7+B1 STORE WORD MVE 122 SA1 A1+B1 NEXT WORD MVE 123 SB7 B7-B1 DECREMENT COUNTER MVE 124 EQ MVE2 CONTINUE MVE 125 MVE 126 SCOPE2 IFNE SCOPE2,1 V41AC01 68 MVEB BSS 1 CMU DESCRIPTOR WORD (AND TEMPORARY) MVE 128 MVE 129 MVE3 SX6 B1+ MVE 130 LX5 1 MVE 131 BX0 X6*X5 (0 IF NO CMU, 1 IF CMU) MVE 132 SA4 MVEC+X0 LOAD CORRECT PREAMBLE CODE MVE 133 BX6 X4 MVE 134 SA6 MVEA MVE 135 EQ MVEA MVE 136 MVE 137 MVEC BSS 0 MVE 138 MVE 139 LOC MVEA MVE 140 MVE 141 MVEA SA3 B2-B1 MVE 142 SA2 A1+B1 PRE-LOAD MVE 143 BX7 X3 MVE 144 SA7 A3 INITIALIZE A7 MVE 145 MVE 146 LOC *O MVE 147 MVE 148 LOC MVEA MVE 149 MVE 150 MVEA SX2 B2 SET ADDRESSES MVE 151 SX1 A1 MVE 152 EQ MVE4 CONTINUE MVE 153 MVE 154 LOC *O MVE 155 SCOPE2 ENDIF V41AC01 69 P.MVE SPACE 4 V41AC07 105 END MVE 158 IDENT OPEN OPEN 2 SST OPEN 3 B1=1 OPEN 4 ENTRY OPEN OPEN 5 LIST F OPEN 6 OPEN SPACE 4,10 OPEN 7 TITLE OPEN - OPEN FILE VARIABLE. OPEN 8 COMMENT PASCAL-6000 OPEN FILE VARIABLE. OPEN 9 COMMENT COPYRIGHT 1978, 1984, UNIVERSITY OF MINNESOTA. OPEN 10 OPEN SPACE 4,10 OPEN 11 *** OPEN - OPEN FILE VARIABLE. OPEN 12 * J. P. STRAIT. 1977-12-08. OPEN 13 * D. J. BIANCHI. 1984-10-18. OPEN 14 HISTORY SPACE 4,10 HOPEN 1 ** PASCAL-6000 MODIFICATION HISTORY. HOPEN 2 * HOPEN 3 * ADD ASCII CONDITIONAL ASSEMBLY. V41CC10 585 * HOPEN 4 OPEN SPACE 4,30 OPEN 15 *** OPEN - OPEN A PASCAL-6000 FILE VARIABLE. OPEN 16 * OPEN 17 * THE FILE VARIABLE IS OPENED AND A NEW FILE NAME IS ASSIGNED OPEN 18 * TO THE FILE VARIABLE. THE FILE MAY BE MADE NON-PERSISTENT OPEN 19 * BY USING A BLANK FILE NAME. A NEW SCRATCH FILE NAME IS OPEN 20 * GENERATED FOR A NON-PERSISTENT FILE VARIABLE. OPEN WILL OPEN 21 * AUTOMATICALLY CLOSE THE FILE BEFORE RE-OPENING IT. OPEN 22 * IF OPENWRITE IS TRUE, THE FILE IS OPENED FOR WRITING, OPEN 23 * OTHERWISE IT IS OPENED FOR READING. THE FILE IS NOT OPEN 24 * REPOSITIONED BY OPEN, AND SO IT MAY BE READ OR WRITTEN OPEN 25 * FROM ITS CURRENT POSITION. OPEN 26 * OPEN 27 * PROCEDURE OPEN(VAR F : SOMEFILETYPE; FN : ALFA; OPEN 28 * OPENWRITE : BOOLEAN); OPEN 29 * OPEN 30 * OPEN 31 * ENTRY (X0) = ADDRESS OF FILE VARIABLE. V41CC10 586 * (X1) = NEW FILE NAME. OPEN 34 * (X2) = OPEN MODE FLAG (0=READ,1=WRITE). OPEN 35 * (B1) = 1. V41CC10 587 * OPEN 36 * EXIT (X2) = FET ADDRESS. OPEN 37 * OPEN 38 * USES X - 0, 1, 2, 3, 5, 6, 7. V41CC10 588 * A - 1, 2, 6, 7. OPEN 40 * B - 3. OPEN 41 * OPEN 42 * CALLS CLOSE, P.AFD, P.OPE, P.SRS, P.SWS, ZFN=. V41CC10 589 OPEN 44 OPEN 45 OPE2 RJ =XP.SWS SET WRITE STATUS OPEN 46 OPEN 47 OPE ROUTINE OPEN ENTRY/EXIT OPEN 48 BX7 X2 OPEN 49 SA7 OPEB SAVE OPENWRITE FLAG OPEN 50 V41CC10 590 ASCII IFNE ASCFLAG,1 V41CC10 591 MX6 DCCHARSZ*7 MASK SEVEN DISPLAY CODE CHARS V41CC10 592 BX1 X6*X1 V41CC10 593 RJ =XZFN= ZERO FILL NAME V41CC10 594 ASCII ELSE V41CC10 595 BX5 X0 SAVE FILE VARIABLE ADDRESS V41CC10 596 RJ =XP.AFD CONVERT ASCII FILE NAME TO DISPLAY CODE V41CC10 597 BX0 X5 RESTORE FILE VARIABLE ADDRESS V41CC10 598 ASCII ENDIF V41CC10 599 V41CC10 600 SA6 OPEA SAVE FILE NAME OPEN 54 RJ =XCLOSE CLOSE FILE VARIABLE OPEN 55 OPEN 56 SCOPE2 IFNE SCOPE2,1 OPEN 57 SA1 X2-EFETFET EFET ADDRESS OPEN 58 SCOPE2 ELSE OPEN 59 SA1 X2-EFITFIT EFET ADDRESS OPEN 60 SCOPE2 ENDIF OPEN 61 OPEN 62 SA2 OPEA FILE NAME OPEN 63 MX3 1 OPEN 64 SB3 A1 EFET OPEN 65 LX3 EPERSIST-59 OPEN 66 BX7 X1+X3 SET PERSISTENT-FILE BIT OPEN 67 NZ X2,OPE1 IF NON-BLANK FILE NAME OPEN 68 BX7 -X3*X7 CLEAR PERSISTENT-FILE BIT OPEN 69 OPE1 SA7 A1 UPDATE EFET+0 OPEN 70 RJ =XP.OPE OPEN EFET OPEN 71 SA1 OPEB OPEN 72 NZ X1,OPE2 IF OPENWRITE OPEN 73 RJ =XP.SRS SET READ STATUS OPEN 74 EQ OPEX RETURN OPEN 75 OPEN 76 OPEA BSS 1 FILE NAME OPEN 77 OPEB BSS 1 OPENWRITE FLAG OPEN 78 OPEN SPACE 4 OPEN 79 END OPEN 80 IDENT P.PUTF PUTF 2 SST PUTF 3 B1=1 PUTF 4 ENTRY P.PUTF PUTF 5 LIST F PUTF 6 P.PUTF SPACE 4,10 PUTF 7 TITLE P.PUTF - WRITE EOF ON PASCAL FILE. PUTF 8 COMMENT PASCAL-6000 PUT FILE ROUTINE. PUTF 9 COMMENT COPYRIGHT 1984, UNIVERSITY OF MINNESOTA. PUTF 10 P.PUTF SPACE 4,10 PUTF 11 *** PUTF - WRITE EOF ON PASCAL FILE. PUTF 12 * L. H. DAASCH. 1984-04-27. PUTF 13 * D. J. BIANCHI. 1984-10-18. PUTF 14 HISTORY SPACE 4,10 HPUTF 1 ** PASCAL-6000 MODIFICATION HISTORY. HPUTF 2 * HPUTF 3 * CHANGE "RJ =XP.WWR" TO "EQ =XP.WWR". V41CC13 19 * HPUTF 4 P.PUTF SPACE 4,20 PUTF 15 *** PUTF - WRITE EOF ON PASCAL FILE. PUTF 16 * PUTF 17 * THIS ROUTINE WRITES AN END-OF-FILE ON A PASCAL FILE. PUTF 18 * FOR SCOPE2 SYSTEMS AN END-OF-PARTITION IS WRITTEN ON PUTF 19 * FILES WITH RECORD TYPES S, W, AND Z. PUTF 20 * PUTF 21 * ENTRY (A1) = EFET ADDRESS. PUTF 22 * (X1) = ((A1)). PUTF 23 * PUTF 24 * EXIT BUFFER FLUSHED AND EOF WRITTEN. PUTF 25 * PUTF 26 * USES X - 1, 2. PUTF 27 * A - 1. PUTF 28 * PUTF 29 * CALLS P.FOB, P.SWS, P.WWR. PUTF 30 * PUTF 31 * MACROS ENDFILE, WRITEF. PUTF 32 PUTF 33 PUTF 34 PTF ROUTINE P.PUTF ENTRY/EXIT PUTF 35 LX1 59-EREWRITE PUTF 36 PUTF 37 SCOPE2 IFNE SCOPE2,1 PUTF 38 ERRNZ EFETFET-1 FIX NEXT LINE PUTF 39 SX2 A1+B1 FET PUTF 40 SCOPE2 ELSE PUTF 41 SX2 A1+EFITFIT FIT PUTF 42 SCOPE2 ENDIF PUTF 43 PUTF 44 PL X1,=XP.WWR IF WRITE WITHOUT REWRITE V41CC13 20 RJ =XP.FOB FLUSH OUTPUT BUFFER PUTF 46 PUTF 47 SCOPE2 IFNE SCOPE2,1 PUTF 48 WRITEF X2 PUTF 49 SCOPE2 ELSE PUTF 50 ENDFILE X2 PUTF 51 SCOPE2 ENDIF PUTF 52 PUTF 53 RJ =XP.SWS SET WRITE STATUS PUTF 54 EQ PTFX RETURN PUTF 55 P.PUTF SPACE 4 PUTF 58 END PUTF 59 IDENT P.SINCO SINCO 2 B1=1 SINCO 3 ENTRY P.SINCO SINCO 4 SINCO SPACE 4,10 SINCO 5 SINCO TITLE P.SINCO - SINE OR COSINE OF ARGUMENT. SINCO 6 COMMENT PASCAL-6000 SINE OR COSINE ROUTINE. SINCO 7 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. SINCO 8 SINCO SPACE 4,10 SINCO 9 *** P.SINCO - SINE OR COSINE OF ARGUMENT. SINCO 10 * L. A. LIDDIARD. CIRCA 1970. SINCO 11 * D. M. LALIBERTE. 76/08/25. SINCO 12 HISTORY SPACE 4,10 HSINCO 1 ** PASCAL-6000 MODIFICATION HISTORY. HSINCO 2 * HSINCO 3 * HSINCO 4 SINCO SPACE 4,25 SINCO 13 *** P.SINCO - SINE OR COSINE OF ARGUMENT. SINCO 14 * SINCO 15 * ENTRY (B1) = 1. SINCO 16 * (B3) = 0 FOR SINE, 1 FOR COSINE. SINCO 17 * (X1) = ARGUMENT. SINCO 18 * SINCO 19 * EXIT (X6) = SINE OR COSINE OF ARGUMENT. SINCO 20 * EXITS TO P.SABRT IF ARGUMENT OUT OF RANGE. SINCO 21 * SINCO 22 * USES A - 2, 3, 4, 5. SINCO 23 * B - 3, 7. SINCO 24 * X - ALL. SINCO 25 * SINCO 26 * CALLS P.SABRT. SINCO 27 * SINCO 28 * MACROS NONE. SINCO 29 * SINCO 30 * ALGORITHM AND CONSTANTS COPYRIGHT (C) 1970 BY PROFESSOR SINCO 31 * KRZYSZTOF FRANKOWSKI, UNIVERSITY OF MINNESOTA. SINCO 32 * SINCO 33 * RELATIVE ACCURACY (I.E. ERROR/RESULT) SINCO 34 * SINE AVERAGE = 1.8E-15 IN THE RANGE -PI/2 BY PI/10000 TO +PI/2 SINCO 35 * WORST = 8E-15 IN THE RANGE -PI/2 BY PI/10000 TO +PI/2 SINCO 36 * COSINE AVERAGE = 2.2E-15 IN THE RANGE -PI/2 BY PI/10000 TO +PI/2 SINCO 37 * WORST = 8E-15 IN THE RANGE -PI/2 BY PI/10000 TO +PI/2 SINCO 38 * SINCO 39 * OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS. SINCO 40 SINCO 41 SINCO 42 P.SINCO PS ENTRY SINCO 43 SX0 -B3 SINE/COSINE FLAG SINCO 44 SB3 -B1 SET BUMPING REGISTER SINCO 45 SA2 SNCC LOAD2/PI UPPER SINCO 46 UX7,B7 X1 GET ARGUMENT EXPONENT SINCO 47 SA5 A2-B3 LOAD INTEGERIZER SINCO 48 AX7 77B SIGN BITS OF ARGUMENT SINCO 49 IX3 X5-X0 INTEGERIZER + 0 IF SINE, 1 IF COSINE SINCO 50 GE B3,B7,SNC1 IF GOOD EXPONENT SINCO 51 EQ SNC3 ANALYZE BAD EXPONENT SINCO 52 SINCO 53 SNC1 FX6 X2*X1 (2/PIU*ARG)U SINCO 54 BX4 X5-X7 INTEGERIZER HAS SAME SIGN AS ARGUMENT SINCO 55 RX7 X6+X4 FIND N MULTIPLES OF PI/2 SINCO 56 DX4 X2*X1 (2/PIU*ARG)L SINCO 57 BX2 X5-X7 GET N SINCO 58 NX5 X7 FLOAT N SINCO 59 IX7 X3+X2 INTEGERIZER+1 OR 0+N GIVES QUADRANT SINCO 60 SA2 A5-B3 LOAD 2/PI LOWER SINCO 61 FX3 X6-X5 (2/PIU*ARG)U-N SINCO 62 DX6 X6-X5 GET ANY BIT SHIFTED DOWN SINCO 63 FX1 X2*X1 (2/PIL*ARG)U SINCO 64 NX5 X3 SINCO 65 FX6 X6+X4 ADD (2/PIU*ARG)L SINCO 66 FX6 X6+X1 ADD (2/PIL*ARG)U SINCO 67 MX2 59 SINCO 68 RX1 X6+X5 FORM Z (REDUCED ARGUMENT) SINCO 69 RX6 X1*X1 Z**2 SINCO 70 BX2 -X2*X7 GET 1 IF COSINE, 0 IF SINE TO COMPUTE SINCO 71 SA3 X2+SNCD LOAD CORRECT CONSTANT GROUP SINCO 72 SB3 B3+B3 SET BUMPING REGISTER TO -2 SINCO 73 RX0 X6*X6 Z**4 SINCO 74 SA5 A3-B3 LOAD N4 SINCO 75 RX4 X3*X6 N3*Z**2 SINCO 76 SA3 A5-B3 LOAD N2 SINCO 77 SB7 X2 SAVE WHETHER IN SINE OR COSINE SINCO 78 LX7 58 POSITION AT SIGN OF QUADRANT SINCO 79 RX5 X5*X0 N4*Z**4 SINCO 80 RX2 X4+X3 N3*Z**2+N2 SINCO 81 SA3 A3-B3 LOAD N1 SINCO 82 SA4 A3-B3 LOAD N0 SINCO 83 RX2 X5+X2 N4*Z**4+N3*Z**2+N2=R SINCO 84 RX0 X2*X0 R*Z**4 SINCO 85 RX3 X3*X6 N1*Z**2 SINCO 86 SA5 A4-B3 LOAD 1.0 OR PI/2 SINCO 87 RX2 X0+X3 R*Z**4+N1*Z**2 SINCO 88 RX2 X2+X4 R*Z**4+N1*Z**2+N0=POLY SINCO 89 NO SINCO 90 RX0 X2*X2 POLY**2 SINCO 91 RX6 X0*X6 Z**2*POLY**2 SINCO 92 NZ B7,SNC2 IF COSINE COMPUTATION SINCO 93 RX5 X1*X5 Z*PI/2 SINCO 94 RX6 X6*X1 Z**2*POLY**2*Z SINCO 95 SNC2 FX3 X5-X6 SINCO 96 AX7 77B GET SIGN BITS OF QUADRANT SINCO 97 DX0 X5-X6 SINCO 98 NX4 X3 SINCO 99 RX5 X4+X0 SINCO 100 BX6 X7-X5 GET PROPER SIGN SINCO 101 EQ P.SINCO RETURN SINCO 102 SINCO 103 SNC3 SX0 SNCA SINCO 104 ID X1,SNC4 IF INDEFINITE ARGUMENT SINCO 105 OR X1,SNC4 IF INFINITE ARGUMENT SINCO 106 SX0 SNCB SINCO 107 SNC4 EQ =XP.SABRT ABORT SINCO 108 SINCO 109 SNCA DATA C* INFINITE OR INDEF ARGUMENT OF SIN/COS. * SINCO 110 SINCO 111 SNCB DATA C' ABS(ARG) 2**47 OR MORE IN SIN/COS. ' SINCO 112 SINCO 113 SNCC DATA 17175057460333447104B TWO PI SINCO 114 DATA 20000000000000000000B INTEGERIZER SINCO 115 SINCO 116 DATA 16370522477411653721B SINCO 117 SNCD DATA -1.44725130681196E-5 S3 SINCO 118 DATA 5.172606069276518E-5 C3 SINCO 119 DATA 1.54733311005155E-7 S4 SINCO 120 DATA -4.413282528387191E-7 C4 SINCO 121 DATA 1.38346449783347E-3 S2 SINCO 122 DATA -3.521949713998275E-3 C2 SINCO 123 DATA -4.95774235001375E-2 S1 SINCO 124 DATA 1.14191398434002E-1 C1 SINCO 125 DATA 8.03718916976708E-1 S0 SINCO 126 DATA -1.110720734539535 C0 SINCO 127 DATA 1.5707963267949 PI/2 SINCO 128 DATA 1.0 SINCO 129 SINCO SPACE 4 SINCO 130 END SINCO 131 IDENT P.SQRT SQRT 2 B1=1 SQRT 3 ENTRY P.SQRT SQRT 4 SQRT SPACE 4,10 SQRT 5 SQRT TITLE SQRT - SQUARE ROOT OF ARGUMENT. SQRT 6 COMMENT PASCAL-6000 SQUARE ROOT ROUTINE. SQRT 7 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. SQRT 8 SQRT SPACE 4,10 SQRT 9 *** SQRT - SQUARE ROOT OF ARGUMENT. SQRT 10 * L. A. LIDDIARD. CIRCA 1970. SQRT 11 * D. M. LALIBERTE. 76/08/25. SQRT 12 HISTORY SPACE 4,10 HSQRT 1 ** PASCAL-6000 MODIFICATION HISTORY. HSQRT 2 * HSQRT 3 * HSQRT 4 SQRT SPACE 4,20 SQRT 13 *** SQRT - SQUARE ROOT OF ARGUMENT. SQRT 14 * SQRT 15 * ENTRY (B1) = 1. SQRT 16 * (X1) = ARGUMENT. SQRT 17 * SQRT 18 * EXIT (X6) = SQUARE ROOT OF ARGUMENT. SQRT 19 * SQRT 20 * USES A - 4, 5. SQRT 21 * B - 3, 7. SQRT 22 * X - ALL. SQRT 23 * SQRT 24 * CALLS P.SABRT. SQRT 25 * SQRT 26 * MACROS NONE. SQRT 27 * SQRT 28 * ALGORITHM AND CONSTANTS COPYRIGHT CONTROL DATA CORPORATION. SQRT 29 * SQRT 30 * RELATIVE ACCURACY (I.E. ERROR/RESULT) SQRT 31 * AVERAGE = 1.6E-15 IN THE RANGE 0 BY .01 TO 100.0 SQRT 32 * WORST = 4E-15 IN THE RANGE 0 BY .01 TO 100.0 SQRT 33 * SQRT 34 * OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS. SQRT 35 SQRT 36 SQRT 37 P.SQRT PS ENTRY/EXIT SQRT 38 UX6,B3 X1 B3 = N-48 SQRT 39 SB7 -48 SQRT 40 PX7 X1,B7 W*2(-48) SQRT 41 SA5 SRTC LOAD CA SQRT 42 FX0 X5*X7 CA*W SQRT 43 SX3 B3-B7 N-48-(-48) = N = 2*K+R SQRT 44 SA4 SRTD LOAD CB SQRT 45 BX6 X3 SQRT 46 FX2 X4+X0 CA*W+CB = INITIAL GUESS = B SQRT 47 AX6 1 K = N/2 SQRT 48 IX3 X3-X6 N-K SQRT 49 FX4 X2*X2 B*B SQRT 50 IX3 X3-X6 N-K-K = R SQRT 51 FX0 X4+X7 B*B+W SQRT 52 SB7 X6 B7 = K SQRT 53 SA5 X3+SRTF LOAD 2.0**(R/2)*2(-1) SQRT 54 FX3 X2*X0 B*(B*B+W) = DENOM SQRT 55 UX2,B3 X5 SQRT 56 SB7 B7+B3 INCORPORATE K INTO EXPONENT OF SQRT 57 PX2 X2,B7 2(K)*2(R/2)*2(-1) SQRT 58 FX7 X7+X7 2*W SQRT 59 NX6 X3 NORMALIZE DENOM SQRT 60 FX2 X2/X6 (2(K)*2(R/2)*2(-1))/DENOM = TERM1 SQRT 61 BX3 X1 SQRT 62 FX5 X0*X0 (B*B+W)**2 SQRT 63 FX7 X7+X7 4*W SQRT 64 LX3 2 MOVE TO 1ST BIT OF EXP COEFFICENT SQRT 65 FX4 X7*X4 4*W*B*B SQRT 66 FX7 X5+X4 NUM = (B*B+W)**2+4*W*B*B SQRT 67 AX3 50 X3 = COEFFICIENT BITS OF EXPONENT SQRT 68 FX2 X7*X2 NUM*TERM1 = 2*U SQRT 69 BX6 X6-X6 POSITIVE ZERO RESULT SQRT 70 SA5 SRTE LOAD .25 SQRT 71 ZR X3,SRT3 IF BITS OF EXPONENT IDENTICAL SQRT 72 SRT1 NX0 X2 SQRT 73 FX3 X1/X0 ARG/(2*U) SQRT 74 FX4 X5*X0 25*(2*U) SQRT 75 FX6 X3+X4 SUM = SQRT(ARG) SQRT 76 PL X1,P.SQRT IF POSITIVE ARGUMENT, RETURN SQRT 77 SX0 SRTB SQRT 78 EQ SRT4 ABORT SQRT 79 SQRT 80 SRT3 ZR X1,P.SQRT RETURN IF ZERO ARGUMENT SQRT 81 SX0 SRTA SQRT 82 ID X1,SRT4 IF INDEFINITE ARGUMENT SQRT 83 IR X1,SRT1 IF IN RANGE AFTER ALL SQRT 84 SRT4 EQ =XP.SABRT ABORT SQRT 85 SQRT 86 SRTA DATA C* INFINITE OR INDEF ARGUMENT OF SQRT.* SQRT 87 SQRT 88 SRTB DATA C* NEGATIVE ARGUMENT OF SQRT.* SQRT 89 SQRT 90 SRTC DATA 0.585786437 CA SQRT 91 SQRT 92 SRTD DATA 0.4204951288 CB SQRT 93 SQRT 94 SRTE DATA 17164000000000000001B SQRT 95 SQRT 96 DATA 0.353553390593 SQRT 97 SRTF DATA 0.5 SQRT 98 DATA 0.707106781186 SQRT 99 SQRT SPACE 4 SQRT 100 END SQRT 101 IDENT P.WRS WRS 2 SST WRS 3 B1=1 WRS 4 LIST F WRS 5 ENTRY P.WRS WRS 6 P.WRS SPACE 4,10 V41AC07 106 TITLE P.WRS - WRITE STRING ROUTINE. V41AC07 107 COMMENT PASCAL-6000 WRITE STRING ROUTINE. V41AC07 108 COMMENT COPYRIGHT 1978, UNIVERSITY OF MINNESOTA. V41AC07 109 P.WRS SPACE 4,10 V41AC07 110 *** P.WRS - WRITE STRING ROUTINE. WRS 12 * J. P. STRAIT. 1977-04-30. V41AC07 111 HISTORY SPACE 4,10 HWRS 1 ** PASCAL-6000 MODIFICATION HISTORY. HWRS 2 * HWRS 3 * ADD ASCII CONDITIONAL ASSEMBLY. V41CC10 601 * USE SYMBOLIC EFET CONSTANTS. V41CC06 5 * CLEAN UP COMPASS DOCUMENTATION. V41AC07 112 * HWRS 4 P.WRS SPACE 4,20 V41AC07 113 *** P.WRS - WRITE STRING ROUTINE. WRS 15 * WRS 16 * ENTRY (B1) = 1. WRS 17 * (B6) = TOP OF STACK (TOS). WRS 18 * (TOS+PFLC) = FILE VARIABLE ADDRESS. V41AC07 114 * (TOS+PFLC+1) = THE STRING ITSELF IF (TOS+PFLC+2) < 0, V41AC07 115 * OTHERWISE THE FWA OF THE STRING. V41AC07 116 * (TOS+PFLC+2) = FIELD WIDTH. V41AC07 117 * (TOS+PFLC+3) = ABSOLUTE VALUE OF LENGTH OF STRING V41AC07 118 * IN CHARACTERS. V41AC07 119 * WRS 27 * EXIT STRING WRITTEN TO FILE BUFFER. WRS 28 * WRS 29 * USES X - ALL. V41AC07 120 * A - 1, 2, 3, 4, 5, 6, 7. V41AC07 121 * B - 2, 3, 7. V41AC07 122 * WRS 33 * CALLS P.PUTC. WRS 34 WRS 37 WRS 38 WRS ROUTINE P.WRS ENTRY/EXIT V41AC07 123 SA1 B6+ARPS+PFLC+2 FIELD WIDTH WRS 40 SA2 A1+B1 STRING LENGTH WRS 41 SB3 X1 WRS 42 BX6 -X2 WRS 43 LE B3,B0,WRSX IF FIELD WIDTH <= 0 V41AC07 124 SA5 A1-B1 STRING OR ITS ADDRESS WRS 45 SA4 A5-B1 FILE FWA WRS 46 SA1 X4+TXTEFET+EFETPTR EFETPTR V41CC06 6 PL X6,WRS1 IF VALUE WAS PASSED WRS 48 BX6 X2 LENGTH OF STRING WRS 49 SA5 X5 GET FIRST WORD OF STRING WRS 50 WRS1 SB2 X6 WRS 51 SA6 A2 SET ABSOLUTE VALUE OF LENGTH WRS 52 SB2 B3-B2 NUMBER OF LEADING BLANKS WRS 53 SCOPE2 IFNE SCOPE2,1 WRS 60 SA1 X2-EFETFET+EFETPTR WRS 61 SCOPE2 ELSE WRS 62 SA1 X2-EFITFIT+EFETPTR WRS 63 SCOPE2 ENDIF WRS 64 WRS 65 GT B2,B0,WRS2 IF MORE BLANKS ARE LEFT WRS 66 WRS3 SA2 B6+ARPS+PFLC+3 STRING LENGTH WRS 67 SB3 X2+B2 NUMBER OF CHARACTERS TO WRITE WRS 68 SX6 -B3 WRS 69 WRS4 SA6 A2 REMEMBER NEGATIVE CHARACTER COUNT WRS 70 SX3 X6+ALFALENG V41CC10 603 SB2 X6 ASSUME THIS IS THE LAST WORD WRS 72 PL X3,WRS5 IF THIS IS THE LAST WORD WRS 73 SB2 -ALFALENG ALFALENG CHARACTERS IN THIS WORD V41CC10 604 WRS5 MX4 -CHARSIZE V41CC10 605 LX5 CHARSIZE V41CC10 606 BX6 -X4*X5 EXTRACT NEXT CHARACTER WRS 77 SB2 B2+B1 COUNT THIS CHARACTER WRS 78 SA6 X1 STORE THIS CHARACTER WRS 79 RJ =XP.PUTC ADVANCE FILE POINTER WRS 80 WRS 81 SCOPE2 IFNE SCOPE2,1 WRS 82 SA1 X2-EFETFET+EFETPTR WRS 83 SCOPE2 ELSE WRS 84 SA1 X2-EFITFIT+EFETPTR WRS 85 SCOPE2 ENDIF WRS 86 WRS 87 LT B2,B0,WRS5 IF MORE CHARS ARE LEFT IN THIS WORD WRS 88 SA2 B6+ARPS+PFLC+3 NEGATIVE CHARACTER COUNT WRS 89 SX6 X2+ALFALENG COUNT ALFALENG CHARACTERS V41CC10 607 PL X6,WRSX IF NO MORE WORDS LEFT V41AC07 125 SA5 A5+1 NEXT WORD WRS 92 EQ WRS4 WRS 93 P.WRS SPACE 4 V41AC07 126 END