DataMuseum.dk

Presents historical artifacts from the history of:

RegneCentralen RC3600/RC7000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RegneCentralen RC3600/RC7000

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦505c8c50c⟧ COMAL_SAVE

    Length: 5598 (0x15de)
    Types: COMAL_SAVE

Derivation

└─⟦d85593a46⟧ Bits:30000470 DOMUS disk image - User files
    └─ ⟦23c8ed297⟧ »/SPACE.POLYN« 
        └─⟦this⟧

UPAS Segment

SAVE filename: "POLYN"

 0005 REM       «bel»«bel»«bel»GEMENE TYVEKNÆGT !!«bel»«bel»«bel»«bel»«nul»
 0010 REM  ****HENRIK LUND :DATO/1-2-82:****«nul»D
 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

UDAS Segment

    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] = 0x0000
      stack[1] = 0x0000
      stack[2] = 0x0000
      stack[3] = 0x0000
      stack[4] = 0x0000
      stack[5] = 0x0000
      stack[6] = 0x0000
    FOR-NEXT stack pointer = 0x0001
      Var# = 0x0126
      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 0xffff 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 0xffff 0x00 P
    0x9a 0xffff 0x00 J
    0x9b 0xffff 0x00 DE
    0x9c 0xffff 0x00 DP
    0x9d 0xffff 0x00 DK
    0x9e 0xffff 0x00 D
    0x9f 0xffff 0x00 [
    0xa0 0xffff 0x00 U2
    0xa1 0xffff 0x00 U1
    0xa2 0xffff 0x00 GOTO1140
    0xa3 0xffff 0x00 U3
    0xa4 0xffff 0x00 U4
    0xa5 0xffff 0x00 O
    0xa6 0xffff 0x00 V
    0xa7 0xffff 0x02 HL$
    0xa8 0xffff 0x00 GOTO1510
    0xa9 0xffff 0x00 LOOKU

Wrapper

.magic = 0x4e32
.u_pas = 0x0608  // Length of UPAS in words
.u_das = 0x04d8  // Length of UDAS in words
.u_dvs = 0x013a  // Start på savede variabel indhold (word adr)
.u_nds = 0x0196  // Address på næste prog.sætning (word adr)
.u_cps = 0x0000  // 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)