|
|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC3600/RC7000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC3600/RC7000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5632 (0x1600)
Types: COMAL_SAVE
Names: »POLYN«
└─⟦d85593a46⟧ Bits:30000470 DOMUS disk image - User files
└─⟦this⟧ »/POLYN«
SAVE filename: "POLYN" 0020 PRINT "------------------------------------------------------------" 0030 PRINT " BEREGNING AF ALLE KOMPLEKSE RØDDER I ET REELT POLYNOMIUM " 0040 PRINT "------------------------------------------------------------" 0050 PRINT " " 0060 PRINT " POLYNOMIET HAR FØLGENDE FORM :" 0070 PRINT " A(0)*X^N + A(1)*X^N-1 + .......A(N-1)*X + A(N) " 0080 PRINT "" 0090 DIM A ( 50 ) , Q ( 50 ) , W ( 50 ) , B ( 50 ) , C ( 50 ) , R ( 50 ) 0100 REPEAT 0110 INPUT " POLYNOMIETS GRAD ER : " , N 0120 PRINT "" 0130 PRINT " POLYNOMIETS KOEFFICIENTER A(0), A(1),... ER : " 0140 FOR K = 1 TO N + 1 0150 INPUT A ( K ) 0160 NEXT 0170 LET A0 = A ( 1 ) 0180 LET A ( 1 ) = 1 0190 FOR I = 2 TO N + 1 0200 LET A ( I ) = A ( I ) / A0 0210 NEXT 0220 IF A ( N + 1 ) <> 0 THEN GOTO 0260 0230 PRINT " NULSTED : 0" 0240 LET N = N - 1 0250 GOTO 0220 0260 IF N = 0 THEN GOTO 1440 0270 IF N <> 1 THEN GOTO 0300 0280 PRINT " NULSTED : " ; - A ( 2 ) 0290 GOTO 1440 0300 IF N = 2 THEN GOTO 1240 0310 IF INT ( N / 2 ) = N / 2 THEN GOTO 0750 0320 LET X1 = - 1 X2 = 2 0330 LET X = X1 0340 LET I = 0 Y = 0 0350 EXEC I800 0360 LET Y1 = Y 0370 IF Y1 = 0 THEN GOTO 0690 0380 LET X = X2 0390 LET I = 0 Y = 0 0400 EXEC I800 0410 LET Y2 = Y 0420 IF Y2 = 0 THEN GOTO 0690 0430 IF Y1 * Y2 <= 0 THEN GOTO 0470 0440 LET X1 = 2 * X1 0450 LET X2 = 2 * X2 0460 GOTO 0330 0470 LET X3 = ( X1 + X2 ) / 2 0480 LET X = X3 0490 LET I = 0 Y = 0 0500 EXEC I800 0510 LET Y3 = Y 0520 IF Y1 * Y3 > 0 THEN GOTO 0560 0530 LET X2 = X3 0540 IF ABS ( X1 - X2 ) < 1 / 10 ^ 9 THEN GOTO 0580 0550 GOTO 0470 0560 LET X1 = X3 0570 GOTO 0540 0580 LET X1 = ( X1 + X2 ) / 2 0590 LET X = X1 0600 LET I = 0 Y = 0 0610 EXEC I800 0620 LET Y1 = Y 0630 IF Y1 = 0 THEN GOTO 0690 0640 LET T = 0 Z = 0 0650 EXEC I900 0660 LET X1 = X1 - Y1 / Z 0670 LET X = X1 0680 EXEC I1000 0690 PRINT " NULSTED : " ; X 0700 FOR M = 1 TO N - 1 0710 LET A ( M + 1 ) = A ( M ) * X + A ( M + 1 ) 0720 NEXT 0730 LET N = N - 1 0740 IF N = 0 THEN GOTO 1440 0750 IF N = 2 THEN GOTO 1240 0760 LET P = 1 K = 1 C ( 1 ) = 1 B ( 1 ) = 1 0770 LET B ( 2 ) = A ( 2 ) - P 0780 LET B ( 3 ) = A ( 3 ) - P * B ( 2 ) - K 0790 LET C ( 2 ) = B ( 2 ) - P 0800 LET C ( 3 ) = B ( 3 ) - P * C ( 2 ) - K 0810 FOR J = 3 TO N 0820 LET B ( J + 1 ) = A ( J + 1 ) - P * B ( J ) - K * B ( J - 1 ) 0830 LET C ( J + 1 ) = B ( J + 1 ) - P * C ( J ) - K * C ( J - 1 ) 0840 NEXT 0850 LET DE = C ( N - 1 ) * C ( N - 1 ) - C ( N - 2 ) * ( C ( N ) - B ( N ) ) 0860 IF DE <> 0 THEN GOTO 0890 0870 LET P = 2 K = 2 C ( 1 ) = 1 B ( 1 ) = 1 0880 GOTO 0770 0890 LET DP = ( B ( N ) * C ( N - 1 ) - B ( N + 1 ) * C ( N - 2 ) ) / DE 0900 LET DK = ( C ( N - 1 ) * B ( N + 1 ) - B ( N ) * ( C ( N ) - B ( N ) ) ) / DE 0910 LET P = P + DP K = K + DK 0920 IF ABS ( DP ) > 1 / 10 ^ 8 THEN GOTO 0770 0930 IF ABS ( DK ) > 1 / 10 ^ 8 THEN GOTO 0770 0940 LET D = P - P / 4 - K 0950 LET [ = SQR ( ABS ( D ) ) 0960 LET X = [ 0970 EXEC I1000 0980 LET U2 = X 0990 LET X = - P / 2 1000 EXEC I1000 1010 LET U1 = X 1020 IF D >= 0 THEN GOTO 1060 1030 PRINT " NULSTED : " ; U1 ; "+I*" ; U2 1040 PRINT " NULSTED : " ; U1 ; "-I*" ; U2 1050 GOTO 1140 1060 LET X = - P / 2 + [ 1070 EXEC I1000 1080 LET U3 = X 1090 LET X = - P / 2 - [ 1100 EXEC I1000 1110 LET U4 = X 1120 PRINT " NULSTED : " ; U3 1130 PRINT " NULSTED : " ; U4 1140 LET N = N - 2 1150 IF N = 0 THEN GOTO 1440 1160 FOR O = 1 TO N 1170 LET A ( O + 1 ) = B ( O + 1 ) 1180 LET X = A ( O + 1 ) 1190 EXEC I1000 1200 LET A ( O + 1 ) = X 1210 NEXT 1220 IF N = 2 THEN GOTO 1240 1230 GOTO 0750 1240 LET P = A ( 2 ) 1250 LET K = A ( 3 ) 1260 GOTO 0940 1270 PROC I800 1280 LET Q ( 1 ) = A ( 1 ) 1290 FOR I = 1 TO N 1300 LET Q ( I + 1 ) = Q ( I ) * X + A ( I + 1 ) 1310 NEXT 1320 LET Y = Q ( N + 1 ) 1330 ENDPROC 800«nul» 1340 PROC I900 1350 FOR T = 0 TO N - 1 1360 LET R ( T + 1 ) = ( N - ( T + 1 ) ) * A ( T + 1 ) 1370 NEXT 1380 LET W ( 1 ) = R ( 1 ) 1390 FOR V = 1 TO N - 1 1400 LET W ( V + 1 ) = W ( V ) * X + R ( V + 1 ) 1410 NEXT 1420 LET Z = W ( N ) 1430 ENDPROC 900«nul» 1440 GOTO 1510 1450 PROC I1000 1460 LET X = X * 1e+06 1470 IF ( X - INT ( X ) ) < 0.5 THEN GOTO 1490 1480 LET X = X + 1 1490 LET X = INT ( X ) / 1e+06 1500 ENDPROC 1000«nul» 1510 DIM HL$ ( 2 ) 1520 INPUT "EN GANG TIL : " , HL$ 1530 UNTIL ORD ( HL$ ) <> 74
FNA definition = 0xffff
FNB definition = 0xffff
FNC definition = 0xffff
FND definition = 0xffff
FNE definition = 0xffff
FNF definition = 0xffff
FNG definition = 0xffff
FNH definition = 0xffff
FNI definition = 0xffff
FNJ definition = 0xffff
FNK definition = 0xffff
FNL definition = 0xffff
FNM definition = 0xffff
FNN definition = 0xffff
FNO definition = 0xffff
FNP definition = 0xffff
FNQ definition = 0xffff
FNR definition = 0xffff
FNS definition = 0xffff
FNT definition = 0xffff
FNU definition = 0xffff
FNV definition = 0xffff
FNW definition = 0xffff
FNX definition = 0xffff
FNY definition = 0xffff
FNZ definition = 0xffff
FN[ definition = 0xffff
FN\ definition = 0xffff
FN] definition = 0xffff
GOSUB-RETURN stack pointer = 0x0000
stack[0] = 0x049d
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
FOR-NEXT stack pointer = 0x0000
Var# = 0x0113
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0089
Loop Top = 0x016d
To Val = 4 (0x41400000)
Step Val = 1 (0x41100000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
REPEAT-UNTIL stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
WHILE-ENDWHILE stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
IF-ELSE stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
Variables:
0x80 0xffff 0x00
0x81 0x0000 0x01 A
0x82 0x0099 0x01 Q
0x83 0x0132 0x01 W
0x84 0x01cb 0x01 B
0x85 0x0264 0x01 C
0x86 0x02fd 0x01 R
0x87 0x0396 0x00 N
0x88 0x0398 0x00 K
0x89 0x039c 0x00 I
0x8a 0x039a 0x00 A0
0x8b 0xffff 0x00 X1
0x8c 0xffff 0x00 X2
0x8d 0x03a4 0x00 X
0x8e 0xffff 0x00 Y
0x8f 0xffff 0x00 I800
0x90 0xffff 0x00 Y1
0x91 0xffff 0x00 Y2
0x92 0xffff 0x00 X3
0x93 0xffff 0x00 Y3
0x94 0xffff 0x00 T
0x95 0xffff 0x00 Z
0x96 0xffff 0x00 I900
0x97 0xffff 0x00 I1000
0x98 0xffff 0x00 M
0x99 0x039e 0x00 P
0x9a 0xffff 0x00 J
0x9b 0xffff 0x00 DE
0x9c 0xffff 0x00 DP
0x9d 0xffff 0x00 DK
0x9e 0x03a0 0x00 D
0x9f 0x03a2 0x00 [
0xa0 0x03a6 0x00 U2
0xa1 0x03a8 0x00 U1
0xa2 0xffff 0x00 GOTO1140
0xa3 0x03aa 0x00 U3
0xa4 0x03ac 0x00 U4
0xa5 0xffff 0x00 O
0xa6 0xffff 0x00 V
0xa7 0x03ae 0x02 HL$
0xa8 0xffff 0x00 GOTO1510
.magic = 0x4e32 .u_pas = 0x05e1 // Length of UPAS in words .u_das = 0x04e7 // Length of UDAS in words .u_dvs = 0x0135 // Start på savede variabel indhold (word adr) .u_nds = 0x05e1 // Address på næste prog.sætning (word adr) .u_cps = 0x05d9 // Address på curr prog.sætning (word adr) .u_tll = 0x0048 // Page størrelse .u_tts = 0x000e // TAP størrelse .u_ran = 0x0001 // Random tal .u_cdl = 0x0006 // Current DATA sætning ptr .u_cdb = 0x0000 // Current DATA byte ptr .u_esa = 0x0042 // ON ESE (word adr) .u_era = 0x0000 // ON ERR (word adr) .u_cas = 0xffff // CASE dybde .u_las = 0xffff // last (-1)