|
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 - download
Length: 4735 (0x127f) Types: TextFile Notes: BASIC::K244CL-1, K244CL-1 Names: »K244CL-1«
└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79 └─⟦this⟧
«ff» 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) 0030 INPUT "STARTSIDE ",STSIDE,"<10><13> SLUTSIDE ",SLSIDE 0040 EXEC OPENFILE 0050 DEF FNB(A)=48+B MOD 10^A DIV 10^(A-1) 0060 EXEC DATALÆS 0070 FOR XX=STSIDE TO SLSIDE 0080 FOR X=XX*256 TO XX*256+63 0090 LET UDSKRIFT$="" 0100 FOR Y=0 TO 3 0110 LET ADR=X+Y*64; JUMP=0; FLAG=0 0120 CALL "GMEM",ADR,B 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)R,R$ 0220 IF B=R THEN LET FLAG=1; S=INDEX*14 0230 NEXT S 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<=311 THEN LET JUMP=1; UD$="00",CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1)) 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=2; S=20 0320 NEXT S 0330 FOR S=INDEX*20-20 TO INDEX*20 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) 0380 REM JMPS160=TITALKODEN FOR JSR @ +160 0390 ON JUMP THEN GOTO 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 B>96 THEN 0510 IF UD$(1)<>"S" AND UD$(1)<>"F" THEN LET OUT$(4)=T$(3,B2 DIV 64+1) 0520 IF UD$(1)="S" THEN LET UD$(4,5)=T$(4,B2 DIV 64+1,B2 DIV 64+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 UDSKRIFT$ 0620 NEXT X 0630 NEXT XX 0640 PROC RAD 0650 LET R16$="0000"; ADR0=B 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$; B0=B1; B1=B2 0730 LET P$=CHR(32+(B0>64 AND B0<96)*(B0-32)),CHR(42+(B0>64 AND B0<64)*(B1-42)*(B1>64 AND B1<96)) 0740 IF JUMP=1 THEN GOTO 0820 0750 FOR S=14 TO 20 0760 IF UDSK$(S)="#" THEN LET INS=S; S=20; HOP=2; B=BB 0770 NEXT S 0780 IF HOP<>2 THEN GOTO 0820 0790 FOR S=INS TO INS+INT(LOG(BB)/LOG(10)) 0800 LET UDSK$(S)=CHR(FNB(INS+INT(LOG(BB)/LOG(10))-S)) 0810 NEXT S 0820 LET UDSK$(19,20)=P$; UDSKRIFT$=UDSKRIFT$,UDSK$ 0830 ENDPROC UDSKRIFT 0840 PROC OPENFILE 0850 OPEN FILE(0,4)"C010.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)ENTRY(S),R$ 0900 READ FILE(1,S*20)PSEDO(S),R$ 0910 NEXT S 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 DPROC 1090 DATA " ZOC"," LRS"," SCP","BNBZDNDZ"," ",",SKP",",SZC",",SNC",",SZR",",SNR",",SNR",",SEZ",",SBN" 1100 E