DataMuseum.dk

top - download

    Length: 5740 (0x166c)
    Types: TextFile
    Notes: .231CL-2
    Names: ».231CL-2«

└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79
    └─ ⟦this⟧ »ASS::.231CL-2« 

TextFile

«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),ADR(2,280),R$(20)
  0020 DIM T$(12,8),UDSKRIFT$(128),INST$(20),UD(4),LBL$(5)
  0035 LET PSEKON=6.45
  0040 EXEC OPENFIL1
  0045 INPUT "STARTSIDE :  ",STSIDE,"<10><13> SLUTSIDE  :  ",SLSIDE
  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
  0072   LET X=XX*256
  0074   EXEC HEADLINE
  0080   FOR X=XX*256 TO XX*256+63
  0083     IF X=XX*256+32 THEN PRINT 
  0085     IF X=XX*256+32 THEN EXEC HEADLINE
  0090     LET UDSKRIFT$=""
  0100     FOR Y=0 TO 3
  0110       LET ADRR=X+Y*64; JUMP=0
  0120       CALL "GMEM",ADRR,B
  0122       LET B1=B DIV 256; B2=B MOD 256; LBL$=CHR(FNB(5)),CHR(FNB(4)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1))
  0125       EXEC RAD
  0130       WHILE ADRR=PIL(Y+1) DO 
  0131         LET LBL$=PIL$(Y+1); POS(Y+1)=POS(Y+1)+1; CA(Y+1)=(B=3232)
  0132         READ FILE(0,POS(Y+1))PIL(Y+1),PIL$(Y+1)
  0134       ENDWHILE
  0150       REM Hvis foregående instruktion=EXECute  fra PSEDOfil then
  0160       IF CA(Y+1)=1 THEN 
  0170         LET Ø=1; Å=B
  0180         EXEC FIND
  0250         IF NOT FUNDET 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 ADRR<311 THEN LET UD$="#####                           "; JUMP=2; BB=B
  0280       IF JUMP THEN GOTO 0580
  0290       REM PSEDO SØG
  0300       LET Ø=2; Å=B
  0310       EXEC FIND
  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$(4)<>" "))=T$(2,B2 DIV 64+1); UD$(11,14)=T$(B MOD 8+5)
  0480         LET UD$(6)=CHR(32+B MOD 16 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(ADRR MOD 10+48)," ",LBL$
  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)=ADRR 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 279
  0890     READ FILE(0,S)ADR(1,S)
  0900     IF S<130 THEN READ FILE(1,S)ADR(2,S)
  0910   NEXT S
  0915 ENDPROC OPENFIL1
  0917 PROC OPENFILE
  0920   FOR S=1 TO 4
  0930     LET JUMP=0; POS(S)=0
  0975     REPEAT
  0980       LET POS(S)=POS(S)+1
  1000     UNTIL ADR(1,POS(S))>=STSIDE*256-64+S*64
  1010     READ FILE(0,POS(S))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
  1255   IF X=XX*256 THEN PRINT "<12>";
  1260   IF X=XX*256 THEN LET UDSKRIFT$(1,5)="(###)"; UDSKRIFT$(124,128)="(###)"
  1270   IF X=XX*256 THEN PRINT USING UDSKRIFT$,XX,UD(1),UD(2),UD(3),UD(4),XX
  1275   IF X=XX*256+32 THEN PRINT USING UDSKRIFT$,UD(1),UD(2),UD(3),UD(4)
  1280   PRINT 
  1290 ENDPROC
  1500 PROC FIND
  1505   LET AREC=138*(Ø=2)+279*(Ø=1)
  1510   LET MIN=1; MAX=AREC; MIDT=(AREC*(Å>ADR(Ø,1))-(Å>=ADR(Ø,MAX))) DIV (2-(Å>=ADR(Ø,MAX))); FUNDET=0
  1520   IF Å<=ADR(Ø,1) OR Å>=ADR(Ø,MAX) THEN GOTO 1610
  1530   WHILE ADR(Ø,MIDT)>=Å OR ADR(Ø,MIDT+1)<Å DO 
  1540     IF Å>ADR(Ø,MIDT) THEN 
  1550       LET MIN=MIDT
  1560     ELSE
  1570       LET MAX=MIDT
  1580     ENDIF
  1590     LET MIDT=(MIN+MAX) DIV 2
  1600   ENDWHILE
  1605   LET CA(Y+1)=(B=3232)
  1610   IF ADR(Ø,MIDT+1)<>Å THEN GOTO 1640
  1620   READ FILE(Ø-1,MIDT+1)A,UD$
  1630   LET JUMP=1; FUNDET=1; UD$=UD$(1,5+(Ø=2)*(LEN(UD$)-5)); CA(Y+1)=(B=3232)
  1640 ENDPROC
  READ FILE(Ø-1,MIDT
  1640 ENDPROC
GOTO 1640
  1620   READ FILE(Ø-1,MIDT+1)A,UD$
  1630   LET JUMP=1; FUNDET=1; UD$=UD$(1,5