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

⟦cad88a8df⟧ COMAL_SAVE

    Length: 5480 (0x1568)
    Types: COMAL_SAVE
    Names: »EDIT  «

Derivation

└─⟦3d9d2c4f1⟧ Bits:30001780 SG0000 Floppy
    └─⟦this⟧

UPAS Segment

SAVE filename: "EDIT"

 0020 PROC LAV1310
 0040   REPEAT 
 0060     CALL "FINDTEGN" , LS$ , TEXT$ , NF , FUNR
 0080     IF FUNR <> - 1 THEN
 0100       LET FUNR = FUNR + 1
 0120       IF FUNR < LEN ( TEXT$ ) THEN LET TEXT2$ = TEXT$ ( FUNR , LEN ( TEXT$ ) )
 0140       IF FUNR >= LEN ( TEXT$ ) THEN LET TEXT2$ = ""
 0160       IF FUNR > 2 THEN LET TEXT$ = TEXT$ ( 1 , FUNR - 2 ) , S1310$ , TEXT2$ NF = FUNR
 0170       IF FUNR <= 2 THEN LET TEXT$ = S1310$ , TEXT2$ NF = FUNR
 0180     ENDIF 
 0200   UNTIL FUNR = - 1
 0220 ENDPROC
 0240 PROC I
 0260   LET LS$ = "_" NF = 0
 0280   EXEC LAV1310
 0300   LET LTEXT = LEN ( TEXT$ ) SIDE2$ = SIDE$ ( CP , SIDEL )
 0320   IF CP = 1 THEN LET SIDE$ = ""
 0340   LET SIDE$ = SIDE$ ( 1 , CP ) , TEXT$ , SIDE2$ CP = LEN ( SIDE$ ) - LEN ( SIDE2$ )
 0360 ENDPROC
 0380 PROC S
 0400   LET NF = CP TESTT = 0
 0420   IF TEXT$ = "_" THEN LET TEXT$ = S1310$
 0440   CALL "FINDTEGN" , TEXT$ ( 1 ) , SIDE$ , NF , FUNR
 0460   IF FUNR <> - 1 THEN
 0480     IF SIDE$ ( FUNR , FUNR + LEN ( TEXT$ ) - 1 ) = TEXT$ THEN
 0500       LET CP = FUNR TESTT = 1
 0520     ENDIF 
 0540   ENDIF 
 0560   IF NOT TESTT THEN LET NF = FUNR + 1
 0580   IF NOT TESTT AND FUNR <> - 1 THEN GOTO 0440
 0600 ENDPROC
 0620 PROC LINIERS
 0640   LET S\G = CP
 0660   FOR T[LLE = 1 TO TAL
 0680     CALL "FINDTEGN" , S1310$ , SIDE$ , S\G , S\G
 0700     IF S\G = - 1 THEN LET S\G = LEN ( SIDE$ ) T[LLE = TAL
 0720   NEXT 
 0740 ENDPROC
 0760 INPUT "SIDELÆNGDE " , SIDEL
 0780 PAGE = 0
 0800 DIM SIDE$ ( SIDEL ) , SIDE2$ ( SIDEL ) , INSTR$ ( 512 ) , S1310$ ( 2 ) , TEXT$ ( 512 ) , TEXT2$ ( 512 ) , TYPE$ ( 2 ) , TYPEGEM$ ( 10 , 2 ) , OIFILE$ ( 2 , 5 ) , LS$ ( 1 ) , TALGEM ( 10 )
 0820 DIM TEXT3$ ( 512 )
 0840 LET TEST = 0 CP = 1 NUMMER = 0 S1310$ = "<10><13>"
 0860 PRINT "<12>EDITOR v. STK<10><13>"
 0880 PRINT "<6>be<30><6>`d<30>CP=" ; CP ;
 0900 INPUT " FUNKTION >> " , INSTR$
 0920 LET ANTALI = 0
 0940 LET INDEX = 1 TYPE$ = "" TEXT$ = "" TEXT2$ = "" TEXT3$ = "" TAL = 0 SINDEX = 1 NUMMER = ( NUMMER + 1 ) * ( NUMMER < 11 ) + ( NUMMER >= 11 ) ANTALI = ANTALI + 1
 0960 WHILE INSTR$ ( INDEX ) >= "0" AND INSTR$ ( INDEX ) <= "9" OR INSTR$ ( INDEX ) = "-" DO
 0980   LET SINDEX = SINDEX + ( INSTR$ ( INDEX ) = "-" ) INDEX = INDEX + 1
 1000 ENDWHILE
 1020 FOR I = SINDEX TO INDEX - 1
 1040   LET TAL = TAL * 10 + ( ORD ( INSTR$ ( I ) ) - 48 )
 1060 NEXT 
 1080 IF SINDEX > INDEX OR INDEX > LEN ( INSTR$ ) THEN GOTO 0880
 1100 IF SINDEX - 1 THEN IF INSTR$ ( SINDEX - 1 ) = "-" THEN LET TAL = - TAL
 1120 IF INDEX - 1 THEN LET INSTR$ = INSTR$ ( INDEX , LEN ( INSTR$ ) )
 1140 IF INSTR$ ( 1 ) = "G" OR INSTR$ ( 1 , 2 ) = "PW" THEN LET TYPE$ = INSTR$ ( 1 , 2 )
 1160 IF TYPE$ = "" THEN LET TYPE$ = INSTR$ ( 1 )
 1180 PRINT "<6>" ; CHR ( 96 + 3 * NUMMER ) ; "A" ; TYPE$ ; "  _         "
 1200 IF TYPE$ = "C" THEN
 1220   FOR I = 2 TO LEN ( INSTR$ )
 1240     IF INSTR$ ( I ) = "`" THEN LET TEXT$ = INSTR$ ( 2 , I - 1 ) INDEX = I + 1
 1260   NEXT 
 1280   IF INDEX <= I THEN LET TEXT2$ = INSTR$ ( INDEX , LEN ( INSTR$ ) )
 1300 ELSE 
 1320   IF LEN ( INSTR$ ) - 1 THEN IF TYPE$ <> "GC" THEN LET TEXT$ = INSTR$ ( 2 + ( ( TYPE$ = "GK" ) + ( TYPE$ = "GI" ) + ( TYPE$ = "GR" ) + ( TYPE$ = "GW" ) ) , LEN ( INSTR$ ) )
 1340 ENDIF 
 1360 IF TYPE$ = "T" OR TYPE$ = "J" OR TYPE$ = "L" OR TYPE$ = "K" THEN IF ANTALI < 2 THEN LET INSTR$ = INSTR$ , " "
 1380 LET TYPEGEM$ ( ANTALI ) = TYPE$ TALGEM ( ANTALI ) = TAL
 1400 IF LEN ( INSTR$ ) = 1 THEN IF ANTALI = 1 THEN GOTO 1460
 1420 IF LEN ( INSTR$ ) > 1 THEN LET INSTR$ = INSTR$ ( 2 , LEN ( INSTR$ ) )
 1440 IF TYPE$ = "T" OR TYPE$ = "J" OR TYPE$ = "L" OR TYPE$ = "J" THEN IF LEN ( INSTR$ ) > 1 THEN GOTO 0940
 1460 FOR ANTALINS = 1 TO ANTALI
 1480   PRINT "<6>aH<30><6>aI<30>"
 1500   LET TYPE$ = TYPEGEM$ ( ANTALINS ) TAL = TALGEM ( ANTALINS )
 1520   LET NF = CP TESTT = 0
 1540   LET PER = 0
 1560   CASE TYPE$ OF
 1580     PRINT "<6>æKSystemet includerer ikke faciliteten " ; TYPE$
 1600   WHEN "H"
 1620     ON ERR THEN GOTO 1660
 1640     LET OLE = KNUD
 1660     ON ERR THEN PRINT SYS ( 7 ) ; " ** ÅBNE FILER"
 1680     IF SYS ( 7 ) <> 17 THEN GOTO 1720
 1700     END «nul»
 1720   WHEN "S"
 1740     EXEC S
 1760   WHEN ":"
 1780     LET NF = 0 S\G = 0
 1800     REPEAT 
 1820       CALL "FINDTEGN" , S1310$ , SIDE$ , S\G + 1 , S\G
 1840       LET NF = NF + 1
 1860     UNTIL S\G = - 1
 1880     PRINT NF - 1
 1900   WHEN "I"
 1920     EXEC I
 1940   WHEN "B" , "Z"
 1960     LET CP = 1 + ( TYPE$ = "Z" ) * ( LEN ( SIDE$ ) - 1 )
 1980   WHEN "M"
 2000     LET CP = CP + TAL
 2020     IF CP > LEN ( SIDE$ ) THEN LET CP = LEN ( SIDE$ )
 2040     IF CP < 1 THEN LET CP = 1
 2060   WHEN "C"
 2080     EXEC LAV1310
 2100     LET TEXT3$ = TEXT$ TEXT$ = TEXT2$
 2120     EXEC LAV1310
 2140     LET TEXT2$ = TEXT$ TEXT$ = TEXT3$
 2160     EXEC S
 2180     LET SIDE2$ = SIDE$ ( 1 , CP - 1 ) , TEXT2$ , SIDE$ ( CP + LEN ( TEXT$ ) , SIDEL ) SIDE$ = SIDE2$ CP = CP + LEN ( TEXT2$ ) - 1
 2200     EXEC LAV1310
 2220   WHEN "E" , "PW" , "P"
 2240     IF TYPE$ = "P" THEN LET SIDE$ = SIDE$ , "<12>"
 2260     IF NOT TAL THEN
 2280       WRITE FILE ( 2 ) SIDE$
 2300     ELSE 
 2320       EXEC LINIERS
 2340       WRITE FILE ( 2 ) SIDE$ ( CP , S\G )
 2360     ENDIF 
 2380   WHEN "R"
 2400     FOR T[LLE = 1 TO TAL + ( TAL = 0 )
 2420       WRITE FILE ( 2 ) SIDE$
 2440       IF EOF ( 1 ) THEN LET T[LLE = 1e+06
 2460       IF T[LLE > TAL THEN GOTO 2500
 2480       READ FILE ( 1 ) SIDE$
 2500     NEXT 
 2520   WHEN "GK"
 2540     ON ERR THEN LET PER = 1
 2560     DELETE TEXT$
 2580     IF PER THEN PRINT " Ulovlig koma<7>ndo"
 2600   WHEN "GC"
 2620     CLOSE
 2640     LET OIFILE$ ( 1 ) = "" OIFILE$ ( 2 ) = ""
 2660   WHEN "GR"
 2680     ON ERR THEN CLOSE FILE ( 1 )
 2700     OPEN FILE ( 1 , 1 ) TEXT$
 2720     LET OIFILE$ ( 1 ) = TEXT$
 2740   WHEN "GW"
 2760     ON ERR THEN LET PER = 1
 2780     CREATE TEXT$ , 0
 2800     RESET ERR
 2820     IF NOT PER THEN OPEN FILE ( 2 , 3 ) TEXT$
 2840     IF NOT PER THEN LET OIFILE$ ( 2 ) = TEXT$
 2860   WHEN "T"
 2880     PRINT "<31>" ;
 2900     IF NOT TAL THEN
 2920       PRINT SIDE$
 2940     ELSE 
 2960       EXEC LINIERS
 2980       IF S\G < CP THEN LET S\G = LEN ( SIDE$ )
 3000       PRINT SIDE$ ( CP , S\G )
 3020     ENDIF 
 3040   WHEN "Y"
 3060     ON ERR THEN PRINT "FEJL " ; SYS ( 7 )
 3080     READ FILE ( 1 ) SIDE$
 3100     REM  «nul»
 3120   WHEN "GI"
 3140     LET PER = 0
 3160     ON ERR THEN LET PER = 1
 3180     CONNECT TEXT$ , TAL
 3200     IF PER THEN PRINT "Subcatalog ukendt " ; TEXT$
 3220   WHEN "="
 3221     EXEC LIGMED
 3240     PRINT "<31>"
 3260     PRINT " Længde på siden   " ; LEN ( SIDE$ ) ; "<13><10> Output fil         " ; OIFILE$ ( 2 ) ; "<13><10> Input fil          " ; OIFILE$ ( 1 ) ; "<13><10> Løbende subkatalog " ;
 3280     CALL "GMEM" , 15 , A
 3300     REPEAT 
 3320       CALL "GMEM" , A + 27 , B
 3340       LET A = A + 1 K = B DIV 256 B = B MOD 256
 3360       IF K THEN PRINT CHR ( K ) ;
 3380       IF B AND K THEN PRINT CHR ( B ) ;
 3400     UNTIL K = 0 OR B = 0
 3420     PRINT
 3440   WHEN "L" , "J"
 3460     IF TAL > 0 OR TYPE$ = "J" THEN
 3480       LET NF = - 1 START = CP * ( TYPE$ = "L" ) + ( TYPE$ = "J" )
 3500       LET FUNDET = 0 T[LL = 0
 3520       CALL "FINDTEGN" , S1310$ , SIDE$ , START , NF
 3540       IF NF = - 1 THEN STOP «nul» 
 3560       LET T[LL = T[LL + 1 START = NF
 3580       IF T[LL >= TAL THEN LET CP = NF + 1 FUNDET = 1
 3600       IF NOT FUNDET THEN GOTO 3520
 3620     ELSE 
 3640       LET FUNDET = 0 T[LL = 0
 3660       FOR I = CP TO 2 STEP - 1
 3680         IF SIDE$ ( I , I + 1 ) = S1310$ OR SIDE$ ( I , I + 1 ) = "<13><10>" THEN LET T[LL = T[LL + 1 FUNDET = 1
 3700         IF FUNDET THEN IF NOT TAL THEN LET CP = ( I + 2 ) * ( I > 2 ) + ( I < 3 ) I = 0
 3720         IF FUNDET THEN IF TAL <> 0 THEN IF T[LL >= ABS ( INT ( TAL ) ) THEN LET CP = I + 2 I = 1
 3740       NEXT 
 3760     ENDIF 
 3780   WHEN "K"
 3800     EXEC LINIERS
 3820     LET SIDE2$ = SIDE$
 3840     IF S\G < LEN ( SIDE$ ) THEN
 3860       IF CP > 1 THEN LET SIDE$ = SIDE2$ ( 1 , CP - 1 ) , SIDE2$ ( S\G + 1 , LEN ( SIDE2$ ) )
 3880       IF CP = 1 THEN LET SIDE$ = SIDE2$ ( S\G + 1 , LEN ( SIDE2$ ) )
 3900     ELSE 
 3920       IF CP > 1 THEN LET SIDE$ = SIDE$ ( 1 , CP - 1 ) CP = CP - 1
 3940       IF CP = 1 THEN LET SIDE$ = ""
 3960     ENDIF 
 3980   ENDCASE «nul» 
 4000 NEXT 
 4020 GOTO 0880
 4040 REM  19.11.81 * EDITOR RETTET V. HT,RJ,PL,MM Crosholm mf«nul»«nul»
 4060 REM  PL STKR EDITOR STATUS PR 5.11.81 KL 1840 / LIGGER PÅ BUF OG BUF1«nul»
 4080 REM  PL STKR. «so»TEXT EDITOR«nul»P
 4100 REM  05.11.81. 273 SM ** PL-stud. ** Start til editor ** @EDIT *^^«nul»F
 4120 REM  VISSE ÆNDRINGER OG TILFØJELSER FORETAGET 6.11.81 KL 11.11.11 ** TT/HT/RJ«nul»
 4140 REM  FORTSAT Z/=/: ER LAVET«nul»
 4160 REM  PR 12.11.81 ER DER ÆNDRET VEDR C OL. , LK HAR UDVIDET = EFTER DIREKTIV = LAVER NU EN DECIDERET STATUS«nul»b
 4180 REM  REV. 26.11.81 v. MM & PL«nul»
 9200 PROC LIGMED
 9201   CALL "GMEM" , 15 , A
 9202   CALL "GMEM" , 26 + A , T
 9203   PRINT "<9><9><9>Subcatalog <34>" ;
 9204   EXEC NAME
 9205   FOR I = 1 TO 8
 9206     CALL "GMEM" , A + I + 39 , T
 9207     IF T THEN
 9208       CALL "GMEM" , T + 4 , W
 9209       PRINT "<9><9><9>FILE(#'#)<34>" , I - 1 , CHR ( 49 * ( W = 5 ) + 51 * ( W = 7 ) ) ;
 9210       EXEC NAME
 9211       PROC NAME
 9212         FOR Q = T TO T + 2
 9213           CALL "GMEM" , Q , X
 9214           LET B = X DIV 256 C = X MOD 256
 9215           PRINT CHR ( B ) ;
 9216           IF B THEN PRINT CHR ( C ) ;
 9217         NEXT 
 9218         PRINT
 9219       ENDPROC
 9220     ENDIF 
 9221   NEXT 
 9222 ENDPROC   LIGMED«nul»

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] = 0x05f6
      stack[1] = 0x08bb
      stack[2] = 0x0000
      stack[3] = 0x0000
      stack[4] = 0x0000
      stack[5] = 0x0000
      stack[6] = 0x0000
    FOR-NEXT stack pointer = 0x0000
      Var# = 0x03fd
      Loop Top = 0x0000
      To Val = 0   (0x00000000)
      Step Val = 0   (0x00000000)
      Var# = 0x0000
      Loop Top = 0x0000
      To Val = 2.15904e-76   (0x02190000)
      Step Val = 0   (0x00000000)
      Var# = 0x0000
      Loop Top = 0x0000
      To Val = 0   (0x00000000)
      Step Val = 0   (0x00000000)
      Var# = 0x0001
      Loop Top = 0x0000
      To Val = 0   (0x00000000)
      Step Val = 0   (0x00000000)
      Var# = 0x009f
      Loop Top = 0x037c
      To Val = 1   (0x41100000)
      Step Val = 1   (0x41100000)
      Var# = 0x0088
      Loop Top = 0x08bb
      To Val = 0   (0x00000000)
      Step Val = 1   (0x41100000)
      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 0xffff 0x00 LAV1310
    0x82 0xffff 0x02 LS$
    0x83 0xffff 0x02 TEXT$
    0x84 0xffff 0x00 NF
    0x85 0xffff 0x00 FUNR
    0x86 0xffff 0x02 TEXT2$
    0x87 0xffff 0x02 S1310$
    0x88 0xffff 0x00 I
    0x89 0xffff 0x00 LTEXT
    0x8a 0xffff 0x02 SIDE2$
    0x8b 0xffff 0x02 SIDE$
    0x8c 0xffff 0x00 CP
    0x8d 0xffff 0x00 SIDEL
    0x8e 0xffff 0x00 S
    0x8f 0xffff 0x00 TESTT
    0x90 0xffff 0x00 LINIERS
    0x91 0xffff 0x00 S\G
    0x92 0xffff 0x00 T[LLE
    0x93 0xffff 0x00 TAL
    0x94 0xffff 0x02 INSTR$
    0x95 0xffff 0x02 TYPE$
    0x96 0xffff 0x02 TYPEGEM$
    0x97 0xffff 0x02 OIFILE$
    0x98 0xffff 0x00 TALGEM
    0x99 0xffff 0x02 TEXT3$
    0x9a 0xffff 0x00 TEST
    0x9b 0xffff 0x00 NUMMER
    0x9c 0xffff 0x00 ANTALI
    0x9d 0xffff 0x00 INDEX
    0x9e 0xffff 0x00 SINDEX
    0x9f 0xffff 0x00 ANTALINS
    0xa0 0xffff 0x00 PER
    0xa1 0xffff 0x00 OLE
    0xa2 0xffff 0x00 KNUD
    0xa3 0xffff 0x00 A
    0xa4 0xffff 0x00 B
    0xa5 0xffff 0x00 K
    0xa6 0xffff 0x00 START
    0xa7 0xffff 0x00 FUNDET
    0xa8 0xffff 0x00 T[LL
    0xa9 0xffff 0x00 T
    0xaa 0xffff 0x00 NAME
    0xab 0xffff 0x00 W
    0xac 0xffff 0x00 Q
    0xad 0xffff 0x00 X
    0xae 0xffff 0x00 C
    0xaf 0xffff 0x00 LIGMED

Wrapper

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