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

⟦17bcdceba⟧ COMAL_SAVE

    Length: 5310 (0x14be)
    Types: COMAL_SAVE

Derivation

└─⟦d85593a46⟧ Bits:30000470 DOMUS disk image - User files
    └─ ⟦505121d1e⟧ »/BRL1« 
        └─⟦this⟧

UPAS Segment

SAVE filename: "BRL1"

 0010 DIM Q$ ( 3 )
 0020 PRINT "<27>AF"
 0030 PRINT "<27><12>"
 0040 DELAY = 1
 0050 PRINT
 0060 PRINT "      BEDSTE RETTE LINIE"
 0070 INPUT "ANTAL MAALEPUNKTER =" , N
 0080 DIM KO ( 2 , N )
 0090 LET SUMX = 0
 0100 LET SUMY = 0
 0110 LET SUMXY = 0
 0120 LET SUMX2 = 0
 0130 FOR I = 1 TO N STEP 1
 0140   PRINT "TALSAET NR " ; I ;
 0150   INPUT "    X=" , KO ( 1 , I ) , "    Y=" , KO ( 2 , I )
 0160 NEXT 
 0170 EXEC RETTE
 0180 FOR I = 1 TO N STEP 1
 0190   LET SUMX = SUMX + KO ( 1 , I )
 0200   LET SUMY = SUMY + KO ( 2 , I )
 0210   LET SUMXY = SUMXY + KO ( 1 , I ) * KO ( 2 , I )
 0220   LET SUMX2 = SUMX2 + KO ( 1 , I ) ^ 2
 0230 NEXT 
 0240 LET EX = SUMX / N
 0250 LET EY = SUMY / N
 0260 LET EXY = SUMXY / N
 0270 LET EX2 = SUMX2 / N
 0280 LET VARX = EX2 - EX ^ 2
 0290 IF VARX = 0 THEN
 0300   LET P = ( KO ( 2 , N ) - KO ( 2 , 1 ) ) / ( KO ( 1 , 1 ) - KO ( 1 , N ) )
 0310   LET Q = KO ( 2 , 1 ) - P * KO ( 1 , 1 )
 0320 ELSE 
 0330   LET P = ( EXY - EX * EY ) / VARX
 0340   LET Q = ( EX2 * EY - EX * EXY ) / VARX
 0350 ENDIF 
 0360 PRINT "HAELDNINGSKOEFFICIENT= " ; P
 0370 PRINT "SKAERING MED Y-AKSEN= " ; Q
 0380 DELAY = 5
 0390 EXEC KOVALG
 0400 EXEC GRAF
 0410 EXEC CHOICE
 0420 PROC KOVALG
 0430   PRINT "<27><12>"
 0440   DELAY = 1
 0450   INPUT "HOEJKANT SKRIV 0,VANDRET SKRIV 1" , J
 0460   LET XOMS = 25 ; YOMS = 25
 0470   LET XMAX = 395 + J * 217 ; YMAX = 608 - J * 188
 0480   PRINT "ANF0R BEGYNDELSESPUNKTETS PLACERING PAA PAPI-"
 0490   PRINT "RET MAALT I CM VANDRET OG CM LODRET FRA NEDERSTE VENSTRE"
 0500   PRINT "HJ0ERNE."
 0510   INPUT "CM VANDRET " , XO , "     CM LODRET " , YO
 0520   INPUT "1 CM PAA X-AKSEN SKAL SVARE TIL" , X1
 0530   INPUT "1 CM PAA Y-AKSEN SKAL SVARE TIL" , Y1
 0540 ENDPROC
 0550 PROC GRAF
 0560   PRINT "<27><12>"
 0570   DELAY = 1
 0580   LET X0 = XOMS * XO ; Y0 = YOMS * YO
 0590   CALL "GRAPH" , X0 , 0
 0600   CALL "OUTVECT" , X0 , YMAX
 0610   CALL "OUTVECT" , X0 - 4 * ( X0 >= 4 ) , YMAX - 4
 0620   CALL "OUTVECT" , X0 + 4 , YMAX - 4
 0630   CALL "OUTVECT" , X0 , YMAX
 0640   CALL "GRAPH" , 0 , Y0
 0650   CALL "OUTVECT" , XMAX , Y0
 0660   CALL "OUTVECT" , XMAX - 4 , Y0 + 4
 0670   CALL "OUTVECT" , XMAX - 4 , Y0 - 4 * ( Y0 >= 4 )
 0680   CALL "OUTVECT" , XMAX , Y0
 0690   FOR I = 1 TO 23 - 7 * J
 0700     CALL "GRAPH" , X0 - 2 * ( X0 >= 2 ) , I * YOMS
 0710     CALL "OUTVECT" , X0 + 2 , I * YOMS
 0720   NEXT 
 0730   FOR I = 1 TO 15 + 8 * J
 0740     CALL "GRAPH" , I * XOMS , Y0 - 2 * ( Y0 > 2 )
 0750     CALL "OUTVECT" , I * XOMS , Y0 + 2
 0760   NEXT 
 0770   FOR I = 1 TO N
 0780     LET X = X0 + XOMS * KO ( 1 , I ) / X1
 0790     LET Y = Y0 + YOMS * KO ( 2 , I ) / Y1
 0800     IF ( X < 2 ) + ( X > 1021 ) + ( Y < 2 ) + ( Y > YMAX - 2 ) THEN GOTO 0850
 0810     CALL "GRAPH" , X - 2 , Y + 2
 0820     CALL "OUTVECT" , X + 2 , Y - 2
 0830     CALL "GRAPH" , X - 2 , Y - 2
 0840     CALL "OUTVECT" , X + 2 , Y + 2
 0850   NEXT 
 0860   ON ERR THEN LET XNEDRE = 0
 0870   LET XNEDRE = X0 + ( - Y0 * Y1 / YOMS - Q ) * XOMS / P / X1
 0880   ON ERR THEN LET X0VRE = XMAX
 0890   LET X0VRE = X0 + ( ( YMAX - Y0 ) * Y1 / YOMS - Q ) * XOMS / X1 / P
 0900   LET YVENSTRE = Y0 + ( - X0 * X1 * P / XOMS + Q ) * YOMS / Y1
 0910   LET YH0JRE = Y0 + ( ( XMAX - X0 ) * X1 * P / XOMS + Q ) * YOMS / Y1
 0920   LET XSTART = XNEDRE * ( XNEDRE >= 0 ) * ( P >= 0 ) + X0VRE * ( X0VRE >= 0 ) * ( P < 0 )
 0930   LET YSTART = YVENSTRE * ( XSTART = 0 ) + YMAX * ( XSTART <> 0 ) * ( P < 0 )
 0940   LET XSLUT = ( X0VRE * ( X0VRE <= XMAX ) + XMAX * ( X0VRE > XMAX ) ) * ( P >= 0 ) + ( XNEDRE * ( XNEDRE <= XMAX ) + XMAX * ( XNEDRE > XMAX ) ) * ( P < 0 )
 0950   LET YSLUT = YH0JRE * ( XSLUT = XMAX ) + YMAX * ( XSLUT <> XMAX ) * ( P > 0 )
 0960   CALL "GRAPH" , XSTART , YSTART
 0970   CALL "OUTVECT" , XSLUT , YSLUT
 0980   CALL "GRAPH" , 0 , 765
 0990   CALL "ALPHA"
 1000 ENDPROC
 1010 PROC GRAFH
 1020   PRINT "<27><12>"
 1030   DELAY = 1
 1040   LET X0 = YO * XOMS ; Y0 = 783 - XO * YOMS
 1050   CALL "GRAPH" , X0 , 779
 1060   CALL "OUTVECT" , X0 , 779 - YMAX
 1070   CALL "OUTVECT" , X0 - 4 * ( X0 >= 4 ) , 783 - YMAX
 1080   CALL "OUTVECT" , X0 + 4 , 783 - YMAX
 1090   CALL "OUTVECT" , X0 , 779 - YMAX
 1100   CALL "GRAPH" , 0 , Y0
 1110   CALL "OUTVECT" , XMAX , Y0
 1120   CALL "OUTVECT" , XMAX - 4 , Y0 + 4 * ( Y0 <= 775 )
 1130   CALL "OUTVECT" , XMAX - 4 , Y0 - 4
 1140   CALL "OUTVECT" , XMAX , Y0
 1150   FOR I = 1 TO 16
 1160     CALL "GRAPH" , X0 - 2 * ( X0 >= 2 ) , 783 - I * YOMS
 1170     CALL "OUTVECT" , X0 + 2 , 783 - I * YOMS
 1180   NEXT 
 1190   FOR I = 1 TO 23
 1200     CALL "GRAPH" , I * XOMS , Y0 - 2
 1210     CALL "OUTVECT" , I * XOMS , Y0 + 2 * ( Y0 <= 775 )
 1220   NEXT 
 1230   FOR I = 1 TO N
 1240     LET X = X0 + XOMS * KO ( 2 , I ) / Y1
 1250     LET Y = Y0 - YOMS * KO ( 1 , I ) / X1
 1260     IF ( X < 2 ) + ( X > 1021 ) + ( Y > 777 ) + ( Y < 777 - YMAX ) THEN GOTO 1310
 1270     CALL "GRAPH" , X - 2 , Y + 2
 1280     CALL "OUTVECT" , X + 2 , Y - 2
 1290     CALL "OUTVECT" , X - 2 , Y - 2
 1300     CALL "OUTVECT" , X + 2 , Y + 2
 1310   NEXT 
 1320   LET XSTARTH = YSTART * XOMS / 25 ; YSTARTH = 783 - XSTART * YOMS / 25
 1330   LET XSLUTH = YSLUT * XOMS / 25 ; YSLUTH = 783 - XSLUT * YOMS / 25
 1340   IF YSTARTH > 779 THEN
 1350     LET YSTARTH = 779
 1360     LET XSTARTH = ( YSTART + 100 * P * X1 / Y1 / YOMS ) * XOMS / 25
 1370   ENDIF 
 1380   IF YSLUTH > 779 THEN
 1390     LET YSLUTH = 779
 1400     LET XSLUTH = ( YSLUT + 100 * P * X1 / Y1 / YOMS ) * XOMS / 25
 1410   ENDIF 
 1420   CALL "GRAPH" , XSTARTH , YSTARTH
 1430   CALL "OUTVECT" , XSLUTH , YSLUTH
 1440   CALL "GRAPH" , 0 , 765
 1450   CALL "ALPHA"
 1460 ENDPROC
 1470 PROC RETTE
 1480   PRINT "HVIS ET TAELSAET SKAL RETTES, INDTAST DETS NR. ELLERS INDTAST 0"
 1490   INPUT I
 1500   IF I = 0 THEN GOTO 1590
 1510   ON ERR THEN EXEC OUTERR
 1520   PRINT "TAELSAET NR " , I ;
 1530   INPUT "    X=" , KO ( 1 , I ) , "    Y=" , KO ( 2 , I )
 1540   GOTO 1480
 1550   PROC OUTERR
 1560     PRINT
 1570     PRINT "FORKERT NUMMERANGIVELSE!"
 1580   ENDPROC
 1590 ENDPROC
 1600 PROC CHOICE
 1610   DIM Q$ ( 1 )
 1620   PRINT "HVIS DENNE GRAF 0NSKES TEGNET, INDTAST T"
 1630   PRINT "HVIS DER 0NSKES NYT KOORDINATSYSTEM, INDTAST K"
 1640   PRINT "PROGRAMMET AFBRYDES VED AT INDTASTE S"
 1650   INPUT Q$
 1660   IF ( Q$ <> "T" ) * ( Q$ <> "K" ) * ( Q$ <> "S" ) THEN GOTO 1650
 1670   IF Q$ = "T" THEN
 1680     LET XOMS = 41.8 ; YOMS = 43.5
 1690     LET XMAX = 1023 ; YMAX = 730
 1700     PRINT "<27>AE"
 1710     IF J THEN
 1720       EXEC GRAF
 1730     ELSE 
 1740       EXEC GRAFH
 1750     ENDIF 
 1760     PRINT "<27>AF"
 1770     PRINT "HVIS GRAFEN 0NSKES TEGNET IGEN, INDTAST T"
 1780   ENDIF 
 1790   IF Q$ = "K" THEN
 1800     EXEC KOVALG
 1810     EXEC GRAF
 1820     PRINT "HVIS DENNE GRAF 0NSKES TEGNET, INDTAST T"
 1830   ENDIF 
 1840   IF Q$ <> "S" THEN GOTO 1630
 1850 ENDPROC

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 = 0x0001
      stack[0] = 0x00c9
      stack[1] = 0x06f7
      stack[2] = 0x0000
      stack[3] = 0x0000
      stack[4] = 0x0000
      stack[5] = 0x0000
      stack[6] = 0x0000
    FOR-NEXT stack pointer = 0x0000
      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 = 5.14756e-85   (0x00000001)
      Var# = 0x0000
      Loop Top = 0x0001
      To Val = 3.3735e-80   (0x00010000)
      Step Val = 0   (0x00000000)
      Var# = 0x0087
      Loop Top = 0x0097
      To Val = 2   (0x41200000)
      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 0x0005 0x00 N
    0x82 0x0007 0x01 KO
    0x83 0x0016 0x00 SUMX
    0x84 0x0018 0x00 SUMY
    0x85 0x001a 0x00 SUMXY
    0x86 0x001c 0x00 SUMX2
    0x87 0x001e 0x00 I
    0x88 0xffff 0x00 EX
    0x89 0xffff 0x00 EY
    0x8a 0xffff 0x00 EXY
    0x8b 0xffff 0x00 EX2
    0x8c 0xffff 0x00 VARX
    0x8d 0xffff 0x00 P
    0x8e 0xffff 0x00 Q
    0x8f 0xffff 0x00 LIST10
    0x90 0xffff 0x00 LISTT
    0x91 0xffff 0x00 LIIST
    0x92 0xffff 0x00 LIST50
    0x93 0xffff 0x00 VANDRET
    0x94 0xffff 0x00 XO
    0x95 0xffff 0x00 YO
    0x96 0xffff 0x00 X1
    0x97 0xffff 0x00 Y1
    0x98 0xffff 0x00 XO0
    0x99 0xffff 0x00 X0
    0x9a 0xffff 0x00 Y0
    0x9b 0xffff 0x00 I1
    0x9c 0xffff 0x00 I2
    0x9d 0xffff 0x00 I3
    0x9e 0xffff 0x00 I4
    0x9f 0xffff 0x00 CM
    0xa0 0xffff 0x00 LIST450
    0xa1 0xffff 0x00 X
    0xa2 0xffff 0x00 XNED
    0xa3 0xffff 0x00 XOP
    0xa4 0xffff 0x00 LISTLIST
    0xa5 0xffff 0x00 Y
    0xa6 0xffff 0x00 XNEDRE
    0xa7 0xffff 0x00 X0VRE
    0xa8 0xffff 0x00 YNEDRE
    0xa9 0xffff 0x00 Y0VRE
    0xaa 0xffff 0x00 LIST300
    0xab 0xffff 0x00 ST
    0xac 0xffff 0x00 LIST200
    0xad 0xffff 0x00 J
    0xae 0xffff 0x00 XOMS
    0xaf 0xffff 0x00 YOMS
    0xb0 0xffff 0x00 LIST400
    0xb1 0xffff 0x00 XMAX
    0xb2 0xffff 0x00 YMAX
    0xb3 0xffff 0x00 X0MS
    0xb4 0xffff 0x00 LLIST
    0xb5 0xffff 0x00 LIST305
    0xb6 0xffff 0x00 YVENSTRE
    0xb7 0xffff 0x00 YH0JRE
    0xb8 0xffff 0x00 XSTART
    0xb9 0xffff 0x00 O
    0xba 0xffff 0x00 XSLUT
    0xbb 0xffff 0x00 YSTART
    0xbc 0xffff 0x00 LISLIST
    0xbd 0xffff 0x00 YSLUT
    0xbe 0xffff 0x00 NUL
    0xbf 0xffff 0x00 YSTOP
    0xc0 0xffff 0x00 PRNT
    0xc1 0xffff 0x00 KOVALG
    0xc2 0xffff 0x00 LINIE
    0xc3 0xffff 0x00 GRAF
    0xc4 0xffff 0x02 G$
    0xc5 0xffff 0x02 K$
    0xc6 0xffff 0x00 RUNRUN
    0xc7 0xffff 0x00 UN
    0xc8 0xffff 0x00 LIST1000
    0xc9 0xffff 0x00 RTUN
    0xca 0x0000 0x02 Q$
    0xcb 0xffff 0x00 TALSAET
    0xcc 0xffff 0x00 Z
    0xcd 0xffff 0x00 RETTE
    0xce 0xffff 0x00 GRAF1
    0xcf 0xffff 0x00 GRAFH
    0xd0 0xffff 0x00 GRAFH0J
    0xd1 0xffff 0x00 XSLUTH
    0xd2 0xffff 0x00 YSLUTH
    0xd3 0xffff 0x00 XSTARTH
    0xd4 0xffff 0x00 YSTARTH
    0xd5 0xffff 0x00 LIAT
    0xd6 0xffff 0x00 YALUTH
    0xd7 0xffff 0x00 LIST1600
    0xd8 0xffff 0x00 CHOICE
    0xd9 0xffff 0x00 WHWN
    0xda 0xffff 0x00 OUTERR

Wrapper

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