|
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: 4192 (0x1060)
Types: TextFile
Notes: BASIC::K244CL-0, K244CL-0
Names: »K244CL-0«
└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79
└─⟦this⟧
«ff» 0001 PROC DATALÆS 0002 RESTORE 0003 FOR S=1 TO 12 0004 READ T$(S) 0005 NEXT S 0006 DATA " ZOC"," LRS"," SCP","BNBZDNDZ"," ",",SKP",",SZC",",SNC",",SZR",",SNR",",SNR",",SEZ",",SBN" 0007 ENDPROC 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) 0011 DIM T$(12,8) 0020 INPUT "STARTSIDE ",STSIDE,"<10><13> SLUTSIDE ",SLSIDE 0025 EXEC OPENFILE 0027 DEF FNB(A)=48+B MOD 10^A DIV 10^(A-1) 0029 EXEC DATALÆS 0030 FOR XX=STSIDE TO SLSIDE 0040 FOR X=XX*256 TO XX*256+63 0050 FOR Y=0 TO 3 0060 LET ADR=X+Y*64; JUMP=0; FLAG=0 0070 CALL "GMEM",ADR,B 0080 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) 0090 IF JUMP THEN READ FILE(0,POS(Y+1))PIL(Y+1),PIL$(Y+1) 0100 REM Hvis foregående instruktion=EXECute fra PSEDOfil then 0110 IF CA(Y+1)=1 THEN 0120 FOR S=1 TO 20 0130 IF ENTRY(S)>B THEN LET INDEX=S; S=20 0140 NEXT S 0150 FOR S=INDEX*14-13 TO INDEX*14 0160 READ FILE(0,S)R,R$ 0170 IF B=R THEN LET FLAG=1; S=INDEX*14 0180 NEXT S 0190 IF FLAG=1 THEN LET UD$=R$; JUMP=1 0200 IF FLAG=0 THEN LET JUMP=1; UD$=CHR(FNB(5)),CHR(FNB(4)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1)) 0210 ENDIF CARRY=1 0215 IF B<=311 THEN LET JUMP=1; UD$="00",CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1)) 0220 IF JUMP THEN GOTO 1000 0230 REM PSEDO SØG 0240 FOR S=1 TO 20 0250 IF PSEDO(S)>B THEN LET INDEX=2; S=20 0260 NEXT S 0270 FOR S=INDEX*20-20 TO INDEX*20 0280 READ FILE(1,S)R,R$ 0290 IF R=B THEN LET JUMP=1; S=INDEX*20 0300 NEXT S 0310 IF JUMP=1 THEN LET UD$=R$; CA(Y+1)=(B=3232) 0320 REM JMPS160=TITALKODEN FOR JSR @ +160 0330 ON JUMP THEN GOTO 1000 0340 REM "Almen oversættelse" 0350 LET B1=B DIV 256; B2=B MOD 256; JUMP=1-(B1<128); HOP=0 0360 READ FILE(3,B1+1)INST$ 0370 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)) 0390 LET UD$=INST$," " 0395 ON HOP THEN GOTO 1000 0400 IF B1>127 THEN 0410 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) 0420 LET UD$(6)=CHR(32+B MOD 18 DIV 8*5) 0430 ELSE 0440 IF B>96 THEN 0450 IF UD$(1)<>"S" AND UD$(1)<>"F" THEN LET OUT$(4)=T$(3,B2 DIV 64+1) 0460 IF UD$(1)="S" THEN LET UD$(4,5)=T$(4,B2 DIV 64+1,B2 DIV 64+2)," " 0470 IF UD$(1)<>"F" THEN LET BB=B MOD 64 0480 ELSE 0490 LET BB=B2-(B MOD 1024 DIV 256<>0)*(B2>127)*256 0500 ENDIF 0510 ENDIF 1000 REM UDSKRIFT UD$ 1010 EXEC UDSKRIFT 1020 NEXT Y 1025 PRINT 1030 NEXT X 1040 NEXT XX 2000 PROC RAD 2010 LET R16$="0000"; ADR0=B 2020 FOR II=1 TO 4 2030 LET ADR1=ADR0 DIV 16; CUD=ADR0 MOD 16; ADR0=ADR1; CUD=CUD+48; CUD=CUD+(CUD>57)*7; R16$(5-II)=CHR(CUD) 2040 NEXT II 2050 ENDPROC 4000 PROC UDSKRIFT 4010 LET UDSK$=CHR(48+ADR MOD 10)," ##### #### ################ ##"; B0=B DIV 256; B1=B MOD 256 4020 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)) 4030 PRINT USING UDSK$,B,R16$,UD$,P$; 4040 ENDPROC UDSKRIFT 9000 PROC OPENFILE 9010 OPEN FILE(0,4)"+ENTRIES" 9020 OPEN FILE(1,4)"+PSEDO" 9040 OPEN FILE(3,4)"+STANDARD SYMBOLER" 9050 FOR S=1 TO 20 9060 READ FILE(0,S*14)ENTRY(S),R$ 9070 READ FILE(1,S*20)PSEDO(S),R$ 9080 NEXT S 9090 FOR S=1 TO 4 9095 LET JUMP=0 9100 REPEAT 9101 FOR XX=1 TO 20 9102 IF ENTRY(XX)>STSIDE*256-64+64*S THEN LET JUMP=14*XX-14 9103 NEXT XX 9110 LET JUMP=JUMP+1 9120 READ FILE(0,JUMP)PIL(S),PIL$(S) 9230 UNTIL PIL(S)>STSIDE*256-64+S*64 9240 READ FILE(0,JUMP-1)PIL(S),PIL$(S) 9250 NEXT S 9260 ENDPROC