|
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: 5485 (0x156d)
Types: TextFile
Notes: .231CL-1, ASS::.231CL-1
Names: ».231CL-1«
└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79
└─⟦this⟧ »ASS::.231CL-1«
«ff»
0003 CLOSE
0005 PAGE=132
0008 REM CENTRAL LAGER UDSKRIFTPROGRAM MED SØGNING EFTER ENTRIES M.M. «so»244 «si»
0010 DIM CA(4),UDSK$(32),UD$(20),R16$(4),PIL(4),PIL$(4,8),P$(8),POS(4),ENTRY(20),PSEDO(20),R$(20)
0020 DIM T$(12,8),UDSKRIFT$(128),INST$(20),UD(4)
0035 LET PSEKON=6.45
0040 EXEC OPENFIL1
0045 INPUT "STARTSIDE : ",STSIDE,"<10><13> SLUTSIDE : ",SLSIDE
0046 STOP
0047 EXEC OPENFILE
0050 DEF FNB(A)=48+B MOD 10^A DIV 10^(A-1)
0060 EXEC DATALÆS
0065 FOR XX=STSIDE TO SLSIDE STEP .5
0070 PRINT "<12>(";XX;")";TAB(120);"(";XX;")<13>";
0072 LET X=XX*256
0074 EXEC HEADLINE
0080 FOR X=XX*256 TO XX*256+63
0085 IF X=XX*256+32 THEN EXEC HEADLINE
0090 LET UDSKRIFT$=""
0100 FOR Y=0 TO 3
0110 LET ADR=X+Y*64; JUMP=0; FLAG=0
0120 CALL "GMEM",ADR,B
0122 LET B1=B DIV 256; B2=B MOD 256; INDEX=20
0125 EXEC RAD
0130 IF B=PIL(Y+1) THEN LET JUMP=1; UD$=PIL$(Y+1); POS(Y+1)=POS(Y+1)+1; CA(Y+1)=(B=3232)
0140 IF JUMP THEN READ FILE(0,POS(Y+1))PIL(Y+1),PIL$(Y+1)
0150 REM Hvis foregående instruktion=EXECute fra PSEDOfil then
0160 IF CA(Y+1)=1 THEN
0170 FOR S=1 TO 20
0180 IF ENTRY(S)>B THEN LET INDEX=S; S=20
0190 NEXT S
0200 FOR S=INDEX*14-13 TO INDEX*14
0210 READ FILE(0,S-(S=280))R,R$
0220 IF B=R THEN LET FLAG=1; S=INDEX*14
0230 NEXT S
0235 LET CA(Y+1)=0
0240 IF FLAG=1 THEN LET UD$=R$; JUMP=1
0250 IF FLAG=0 THEN LET JUMP=1; UD$=CHR(FNB(5)),CHR(FNB(4)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1))
0260 ENDIF CARRY=1
0270 IF B<255 OR ADR<311 THEN LET UD$="##### "; JUMP=2; BB=B
0280 IF JUMP THEN GOTO 0580
0290 REM PSEDO SØG
0300 FOR S=1 TO 20
0310 IF PSEDO(S)>B THEN LET INDEX=S; S=20
0320 NEXT S
0330 FOR S=INT(INDEX*PSEKON-PSEKON+1) TO INT(PSEKON*INDEX)
0340 READ FILE(1,S)R,R$
0350 IF R=B THEN LET JUMP=1; S=INDEX*20
0360 NEXT S
0370 IF JUMP=1 THEN LET UD$=R$; CA(Y+1)=(B=3232)
0390 ON JUMP THEN GOTO 0580, 0580
0400 REM "Almen oversættelse"
0410 LET B1=B DIV 256; B2=B MOD 256; JUMP=1-(B1<128); HOP=0
0420 READ FILE(3,B1+1)INST$
0430 IF INST$="FEJL" THEN LET HOP=1; JUMP=1; INST$=CHR(FNB(5)),CHR(FNB(4)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1))
0440 LET UD$=INST$," "
0450 ON HOP THEN GOTO 0580
0460 IF B1>127 THEN
0470 LET UD$(4)=T$(1,B MOD 64 DIV 16+1); UD$(4+(UD$<>" "))=T$(2,B2 DIV 64+1); UD$(13,16)=T$(B MOD 8+5)
0480 LET UD$(6)=CHR(32+B MOD 18 DIV 8*5)
0490 ELSE
0500 IF B1>96 THEN
0510 IF UD$(1)<>"S" AND UD$(1)<>"F" THEN LET UD$(4)=T$(3,B2 DIV 64+1)
0520 IF UD$(1)="S" THEN LET UD$(4,5)=T$(4,(B2 DIV 64)*2+1,(B2 DIV 64)*2+2)," "
0530 IF UD$(1)<>"F" THEN LET BB=B MOD 64
0540 ELSE
0550 LET BB=B2-(B MOD 1024 DIV 256<>0)*(B2>127)*256
0560 ENDIF
0570 ENDIF
0580 REM UDSKRIFT UD$
0590 EXEC UDSKRIFT
0600 NEXT Y
0610 PRINT USING UDSKRIFT$,UD(1),UD(2),UD(3),UD(4)
0615 IF X=12551 THEN STOP
0620 NEXT X
0630 NEXT XX
0635 GOTO 0045
0640 PROC RAD
0645 LET ADR0=B
0650 LET R16$="0000"
0660 FOR II=1 TO 4
0670 LET ADR1=ADR0 DIV 16; CUD=ADR0 MOD 16; ADR0=ADR1; CUD=CUD+48; CUD=CUD+(CUD>57)*7; R16$(5-II)=CHR(CUD)
0680 NEXT II
0690 ENDPROC
0700 PROC UDSKRIFT
0710 LET UDSK$=CHR(48+ADR MOD 10)," ",CHR(FNB(5)),CHR(FNB(4)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1))
0720 LET UDSK$=UDSK$," ",R16$," ",UD$," "; P$=" !"
0730 IF B1>64 AND B1<96 THEN LET P$(1)=CHR(B1)
0731 IF B1>64 AND B1<96 THEN IF B2>47 AND B2<96 THEN LET P$(2)=CHR(B2)
0735 IF JUMP=1 THEN LET UD(Y+1)=ADR MOD 10; UDSK$(1)="#"
0740 IF JUMP=1 THEN GOTO 0820
0750 LET UD(Y+1)=BB
0820 LET UDSK$=UDSK$," "; UDSK$(30,31)=P$; UDSKRIFT$=UDSKRIFT$,UDSK$
0830 ENDPROC UDSKRIFT
0840 PROC OPENFIL1
0850 OPEN FILE(0,4)"CO10.ENT"
0860 OPEN FILE(1,4)"CO...PSE"
0870 OPEN FILE(3,4)"CO...STA"
0880 FOR S=1 TO 20
0890 READ FILE(0,S*14-(S=20))ENTRY(S),R$
0900 READ FILE(1,INT(S*PSEKON))PSEDO(S),R$
0910 NEXT S
0915 ENDPROC OPENFIL1
0917 PROC OPENFILE
0920 FOR S=1 TO 4
0930 LET JUMP=0
0940 REPEAT
0950 FOR XX=1 TO 20
0960 IF ENTRY(XX)>STSIDE*256-64+64*S THEN LET JUMP=14*XX-14
0970 NEXT XX
0980 LET JUMP=JUMP+1
0990 READ FILE(0,JUMP)PIL(S),PIL$(S)
1000 UNTIL PIL(S)>STSIDE*256-64+S*64
1010 READ FILE(0,JUMP-1)PIL(S),PIL$(S)
1020 NEXT S
1030 ENDPROC
1040 PROC DATALÆS
1050 RESTORE
1060 FOR S=1 TO 12
1070 READ T$(S)
1080 NEXT S
1090 DATA " ZOC"," LRS"," SCP","BNBZDNDZ"," ",",SKP",",SZC",",SNC",",SZR",",SNR",",SNR",",SEZ",",SBN"
1100 ENDPROC
1200 PROC HEADLINE
1205 LET UDSKRIFT$=""
1210 FOR Y=0 TO 3
1220 LET ADR0=X+64*Y; UD(Y+1)=ADR0
1230 GOSUB 0650
1240 LET UDSKRIFT$=UDSKRIFT$," ##### ",R16$," "
1250 NEXT Y
1260 PRINT
1270 PRINT USING UDSKRIFT$,UD(1),UD(2),UD(3),UD(4)
1280 PRINT
1290 ENDPROC