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 - metrics - download

⟦9b93432b8⟧ COMAL_SAVE

    Length: 4512 (0x11a0)
    Types: COMAL_SAVE
    Notes: BASIC::CLPRG, CLPRG   
    Names: »CLPRG«

Derivation

└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79
    └─⟦this⟧ »BASIC::CLPRG«

UPAS Segment

SAVE filename: "CLPRG"

 0010 REM  CB 12.11 - 15.11.79 «so»LAGERANALYSE M. PS  ... "CLPRG"«nul»
 0020 REM  K231SLUT«nul»
 0030 PROC RADIX
 0040   FOR II = 4 + ( RA = 10 ) TO 1 STEP - 1
 0050     LET RAD$ ( II ) = CHR ( RA0 MOD RA + ( RA0 MOD RA > 9 ) * 7 + 48 - 16 * ( SP = 1 ) * ( RA0 = 0 ) ) RA0 = RA0 DIV RA
 0060   NEXT 
 0070 ENDPROC
 0080 PROC FIND
 0090   LET MIN = 1 MAX = EA * ( \ = 1 ) + PA * ( \ = 2 ) MIDT = MAX * ( ] > ADR ( \ , 1 ) ) DIV ( 2 - ( ] >= ADR ( \ , MAX ) ) ) JUMP = 0
 0100   IF ] <= ADR ( \ , 1 ) OR ] >= ADR ( \ , MAX ) THEN GOTO 0140
 0110   WHILE ADR ( \ , MIDT ) >= ] OR ADR ( \ , MIDT + 1 ) < ] DO
 0120     LET W = ( ] > ADR ( \ , MIDT ) ) S = NOT W MIN = MIN * S + MIDT * W MAX = MAX * W + MIDT * S MIDT = ( MIN + MAX ) DIV 2
 0130   ENDWHILE
 0140   IF ADR ( \ , MIDT + 1 ) <> ] THEN GOTO 0170
 0150   READ FILE ( \ - 1 , MIDT + 1 ) S , UD$
 0160   LET JUMP = 1 UD$ = UD$ ( 1 , 5 + ( \ = 2 ) * ( LEN ( UD$ ) - 5 ) )
 0170 ENDPROC
 0180 PROC OVERSKRI
 0190   LET UDSKRIFT$ = "<13>" , CHR ( 10 + 2 * ( XX * 256 = X ) ) RA = 16 SP = 0
 0200   FOR Y = 0 TO 3
 0210     LET RA0 = X + 64 * Y UD ( Y + 1 ) = RA0 S = RA0 - 1 + ( RA0 = 0 )
 0220     IF X = XX * 256 THEN CALL "GMEM" , S , S
 0230     IF X = XX * 256 THEN LET CA ( Y + 1 ) = ( S = 3232 )
 0240     EXEC RADIX
 0250     LET UDSKRIFT$ = UDSKRIFT$ , "         ##### " , RAD$ ( 1 , 4 ) , "              " UDSKRIFT$ = UDSKRIFT$ ( 1 , 128 )
 0260   NEXT 
 0270   LET UDSKRIFT$ ( 64 , 63 + LEN ( DAT$ ) ) = DAT$
 0280   IF X = XX * 256 THEN LET UDSKRIFT$ ( 3 , 7 ) = "(###)" UDSKRIFT$ ( 124 , 128 ) = "(###)"
 0290   IF X = XX * 256 THEN PRINT UDSKRIFT$ , XX , UD ( 1 ) , UD ( 2 ) , UD ( 3 ) , UD ( 4 ) , XX
 0300   IF X = XX * 256 + 32 THEN PRINT UDSKRIFT$ , UD ( 1 ) , UD ( 2 ) , UD ( 3 ) , UD ( 4 )
 0310   PRINT
 0320 ENDPROC
 0330 REM  MAINPROC START  LAGERUD  // CB 12.11.79«nul»
 0340 CLOSE
 0350 PAGE = 0
 0360 DIM DAT$ ( 8 )
 0370 DIM UD$ ( 15 ) , UDSKRIFT$ ( 132 ) , UDSK$ ( 13 ) , P$ ( 3 ) , T$ ( 12 , 8 ) , HJ[LP$ ( 10 ) , RAD$ ( 5 )
 0380 DIM CA ( 4 ) , PIL ( 4 ) , PIL$ ( 4 , 5 ) , POS ( 4 ) , UD ( 4 ) , ADR ( 2 , 280 )
 0390 DEF FNB ( VAR98 ) = ABS ( S ) MOD 10 ^ [LVAR]  DIV 10 ^ ( [LVAR]  - 1 ) + 48 - 16 * ( ABS ( S ) DIV 10 ^ ( [LVAR]  - 1 ) = 0 ) * ( [LVAR]  <> 1 )
 0400 LET EA = 279 PA = 138 RAD$ = "     " UDSK$ = "                                 "
 0410 OPEN FILE ( 0 , 4 ) "CO10.ENT"
 0420 OPEN FILE ( 1 , 4 ) "CO...PSE"
 0430 OPEN FILE ( 3 , 4 ) "CO...STA"
 0440 OPEN FILE ( 4 , 4 ) "CO...USE"
 0450 FOR S = 1 TO EA
 0460   READ FILE ( 0 , S ) ADR ( 1 , S )
 0470   IF S <= PA THEN READ FILE ( 1 , S ) ADR ( 2 , S )
 0480   IF S <= 12 THEN READ T$ ( S )
 0490 NEXT 
 0500 DATA " ZOC" , " LRS" , " SCP" , "BNBZDNDZ" , "    " , ",SKP" , ",SZC" , ",SNC" , ",SZR" , ",SNR" , ",SEZ" , ",SBN"
 0510 INPUT "     DD/MM-ÅÅ<13>DATO " , DAT$
 0520 REM «nul»
 0530 INPUT "FRA SIDE : " , STS , "  TIL SIDE : " , SLS
 0540 LET POS ( 4 ) = 1
 0550 REM «ff»
«nul»
 0560 REM                                              «so»PAGE 2«nul»
 0570 FOR XX = STS TO SLS
 0580   FOR S = 1 TO 4
 0590     LET POS ( S ) = POS ( 4 ) - 1
 0600     REPEAT 
 0610       LET POS ( S ) = POS ( S ) + 1
 0620     UNTIL ADR ( 1 , POS ( S ) ) > XX * 256 + ( S - 1 ) * 64
 0630     READ FILE ( 0 , POS ( S ) ) PIL ( S ) , PIL$ ( S )
 0640   NEXT 
 0650   FOR X = XX * 256 TO XX * 256 + 63
 0660     IF X MOD 32 = 0 THEN EXEC OVERSKRI
 0670     LET UDSKRIFT$ = ""
 0680     FOR Y = 1 TO 4
 0690       LET ADRR = X + ( Y - 1 ) * 64 JUMP = 0 P$ = " ! "
 0700       CALL "GMEM" , ADRR , B
 0710       LET B1 = B DIV 256 B2 = B MOD 256 SP = 0 RA = 16 RA0 = B
 0720       EXEC RADIX
 0730       LET UDSK$ ( 10 , 13 ) = RAD$
 0740       IF ADRR <> PIL ( Y ) THEN
 0750         LET SP = 1 RA = 10 RA0 = B
 0760         EXEC RADIX
 0770         LET UDSK$ ( 1 , 8 ) = CHR ( ADRR MOD 100 DIV 10 + 48 ) , CHR ( ADRR MOD 10 + 48 ) , " " , RAD$
 0780       ENDIF 
 0790       WHILE ADRR = PIL ( Y ) DO
 0800         LET UDSK$ ( 1 , 5 ) = PIL$ ( Y ) UDSK$ ( 6 , 8 ) = "   " POS ( Y ) = POS ( Y ) + 1
 0810         READ FILE ( 0 , POS ( Y ) ) PIL ( Y ) , PIL$ ( Y )
 0820       ENDWHILE
 0830       IF CA ( Y ) THEN
 0840         LET \ = 1 ] = B
 0850         EXEC FIND
 0860       ENDIF 
 0870       IF NOT ( JUMP = 0 AND CA ( Y ) OR B < 256 OR ADRR < 311 ) THEN GOTO 0910
 0880       LET JUMP = 1 SP = ( B < 256 OR ADRR < 311 ) RA = 10 RA0 = B
 0890       EXEC RADIX
 0900       LET UD$ = RAD$
 0910       LET CA ( Y ) = ( B = 3232 ) \ = 2 ] = B
 0920       IF JUMP THEN GOTO 1140
 0930       EXEC FIND
 0940       IF JUMP THEN GOTO 1140
 0950       REM    ALMEN OVERSÆTTELSE«nul»
 0960       READ FILE ( 3 , B1 + 1 ) UD$
 0970       IF UD$ = "FEJL" THEN GOTO 0880
 0980       IF B1 > 127 THEN
 0990         LET UD$ ( 4 ) = T$ ( 1 , B MOD 64 DIV 16 + 1 ) UD$ ( 4 + ( UD$ ( 4 ) <> " " ) ) = T$ ( 2 , B2 DIV 64 + 1 )
 1000         LET UD$ ( 11 , 14 ) = T$ ( B MOD 8 + 5 ) UD$ ( 6 ) = CHR ( 32 + B MOD 16 DIV 8 * 3 )
 1010       ELSE 
 1020         IF B1 > 95 THEN
 1030           IF UD$ ( 1 ) <> "S" THEN LET S = B2 MOD 64 UD$ ( 4 ) = T$ ( 3 , B2 DIV 64 + 1 ) UD$ ( 10 , 11 ) = CHR ( FNB ( 2 ) ) , CHR ( FNB ( 1 ) )
 1040           IF UD$ ( 1 ) = "S" THEN LET S = B2 MOD 64 UD$ ( 4 , 5 ) = T$ ( 4 , ( B2 DIV 64 ) * 2 + 1 , ( B2 DIV 64 ) * 2 + 2 )
 1050           IF UD$ ( 1 ) = "S" OR UD$ ( 1 ) = "N" THEN LET UD$ ( 8 , 15 ) = CHR ( FNB ( 2 ) ) , CHR ( FNB ( 1 ) ) , "               "
 1060         ELSE 
 1070           LET S = B2 - ( B MOD 1024 DIV 256 <> 0 ) * ( B2 > 127 ) * 256 LS = 2 * ( B1 DIV 32 <> 0 )
 1080           LET UD$ ( 8 + LS , 11 + LS ) = CHR ( 43 + 2 * ( S < 0 ) ) , CHR ( FNB ( 3 ) ) , CHR ( FNB ( 2 ) ) , CHR ( FNB ( 1 ) )
 1090           IF B1 < 8 OR S < 11 OR S > 111 OR B MOD 1024 DIV 256 <> 3 OR ADRR < 4012 THEN GOTO 1120
 1100           READ FILE ( 4 , S ) HJ[LP$
 1110           LET UD$ ( 8 + LS , 15 ) = HJ[LP$ , "           "
 1120         ENDIF 
 1130       ENDIF 
 1140       IF B1 > 64 AND B1 < 95 THEN LET P$ ( 1 ) = CHR ( B1 )
 1150       IF B1 > 64 AND B1 < 95 AND B2 > 47 AND B2 < 95 THEN LET P$ ( 2 ) = CHR ( B2 )
 1160       LET UD$ = UD$ , "               " UDSKRIFT$ = UDSKRIFT$ , UDSK$ , " " , UD$ , " " , P$
 1170     NEXT 
 1180     PRINT UDSKRIFT$
 1190   NEXT 
 1200 NEXT 
 1210 GOTO 0530

UDAS Segment

    FNA definition = 0x0000
    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 = 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 = 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# = 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 0x0000 0x00 
    0x81 0xffff 0x00 OVERSKRI
    0x82 0xffff 0x02 UDSKRIFT$
    0x83 0xffff 0x00 XX
    0x84 0xffff 0x00 X
    0x85 0xffff 0x00 RA
    0x86 0xffff 0x00 SP
    0x87 0xffff 0x00 Y
    0x88 0xffff 0x00 RA0
    0x89 0xffff 0x00 UD
    0x8a 0xffff 0x00 S
    0x8b 0xffff 0x00 CA
    0x8c 0xffff 0x00 RADIX
    0x8d 0xffff 0x02 RAD$
    0x8e 0xffff 0x02 DAT$
    0x8f 0xffff 0x00 II
    0x90 0xffff 0x00 FIND
    0x91 0xffff 0x00 MIN
    0x92 0xffff 0x00 MAX
    0x93 0xffff 0x00 EA
    0x94 0xffff 0x00 \
    0x95 0xffff 0x00 PA
    0x96 0xffff 0x00 MIDT
    0x97 0xffff 0x00 ]
    0x98 0xffff 0x00 ADR
    0x99 0xffff 0x00 JUMP
    0x9a 0xffff 0x00 W
    0x9b 0xffff 0x02 UD$
    0x9c 0xffff 0x02 UDSK$
    0x9d 0xffff 0x02 P$
    0x9e 0xffff 0x02 T$
    0x9f 0xffff 0x02 HJ[LP$
    0xa0 0xffff 0x00 PIL
    0xa1 0xffff 0x02 PIL$
    0xa2 0xffff 0x00 POS
    0xa3 0xffff 0x00 STS
    0xa4 0xffff 0x00 SLS
    0xa5 0xffff 0x00 ADRR
    0xa6 0xffff 0x00 B
    0xa7 0xffff 0x00 B1
    0xa8 0xffff 0x00 B2
    0xa9 0xffff 0x00 LS
    0xaa 0xffff 0x00 LOOJUP

Wrapper

.magic = 0x5356
.u_pas = 0x0782  // Length of UPAS in words
.u_das = 0x013f  // Length of UDAS in words
.u_dvs = 0x013f  // Start på savede variabel indhold (word adr)
.u_nds = 0x0000  // 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 = 0x0000  // Random tal
.u_cdl = 0x0042  // Current DATA sætning ptr
.u_cdb = 0x0000  // Current DATA byte ptr
.u_esa = 0xffff  // ON ESE (word adr)
.u_era = 0xffff  // ON ERR (word adr)
.u_cas = 0x0000  // CASE dybde
.u_las = 0xffff  // last (-1)