DataMuseum.dk

top - download

    Length: 5990 (0x1766)
    Types: TextFile
    Notes: CLPRG000
    Names: »CLPRG000«

└─⟦714f3848e⟧ Bits:30006597 ALM Copy 24.9.79
    └─ ⟦this⟧ »ASS::CLPRG000« 

TextFile

«ff»
  0010 REM CB 12.11 - 15.11.79 «so»LAGERANALYSE M. PS  ... "CLPRG"
  0015 REM K231SLUT >> CLPRG000
  0020 REM BRUGT 16-18/11 RETTET 19/11 79 
  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 II
  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 Y
  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 USING UDSKRIFT$,XX,UD(1),UD(2),UD(3),UD(4),XX
  0300   IF X=XX*256+32 THEN PRINT USING UDSKRIFT$,UD(1),UD(2),UD(3),UD(4)
  0310   PRINT 
  0320 ENDPROC
  0330 REM MAINPROC START  LAGERUD  // CB 12.11.79
  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(X)=ABS(S) MOD 10^X DIV 10^(X-1)+48-16*(ABS(S) DIV 10^(X-1)=0)*(X<>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+1
  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 S
  0500 DATA " ZOC"," LRS"," SCP","BNBZDNDZ","    ",",SKP",",SZC",",SNC",",SZR",",SNR",",SEZ",",SBN"
  0510 INPUT "     DD/MM-ÅÅ<13>DATO ",DAT$
  0520 REM
  0530 INPUT "FRA SIDE : ",STS,"  TIL SIDE : ",SLS
  0540 INPUT "ANTAL BØGER : ",AB
  0550 LET POS(4)=1
  0580 FOR UUU=1 TO AB
  0590   FOR XX=STS TO SLS
  0600     FOR S=1 TO 4
  0610       LET POS(S)=POS(4)-1
  0620       REPEAT
  0630         LET POS(S)=POS(S)+1
  0640       UNTIL ADR(1,POS(S))>=XX*256+(S-1)*64
  0650       IF POS(S)<280 THEN READ FILE(0,POS(S))PIL(S),PIL$(S)
  0660     NEXT S
  0665     REM«ff»
«so»                      ... "CLPRG"  SIDE 2
  0670     FOR X=XX*256 TO XX*256+63
  0680       IF X MOD 32=0 THEN EXEC OVERSKRI
  0690       LET UDSKRIFT$=""
  0700       FOR Y=1 TO 4
  0710         LET ADRR=X+(Y-1)*64; JUMP=0; P$=" ! "
  0720         CALL "GMEM",ADRR,B
  0730         LET B1=B DIV 256; B2=B MOD 256; SP=0; RA=16; RA0=B
  0740         EXEC RADIX
  0750         LET UDSK$(10,13)=RAD$
  0760         IF ADRR<>PIL(Y) THEN 
  0770           LET SP=1; RA=10; RA0=B
  0780           EXEC RADIX
  0790           LET UDSK$(1,8)=CHR(ADRR MOD 100 DIV 10+48),CHR(ADRR MOD 10+48)," ",RAD$
  0800         ENDIF
  0810         IF ADRR<22169 THEN GOTO 0840
  0812         LET UD$="               "
  0813         IF ADRR>23172 AND ADRR<23259 THEN GOTO 0840
  0815         IF ADRR>22168 AND ADRR<23173 THEN GOTO 0830
  0820         LET S=B1; UD$=".",CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1)),"."; S=B2; UD$=UD$,CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1)),"."
  0830         GOTO 1190
  0840         WHILE ADRR=PIL(Y) DO 
  0850           LET UDSK$(1,5)=PIL$(Y),"   "; UDSK$(6,8)="   "; POS(Y)=POS(Y)+1
  0860           READ FILE(0,POS(Y))PIL(Y),PIL$(Y)
  0870         ENDWHILE
  0880         IF CA(Y) THEN 
  0890           LET Ø=1; Å=B
  0900           EXEC FIND
  0910         ENDIF
  0920         IF NOT (JUMP=0 AND CA(Y) OR B<256 OR ADRR<311) THEN GOTO 0960
  0930         LET JUMP=1; SP=(B<256 OR ADRR<311); RA=10; RA0=B
  0940         EXEC RADIX
  0950         LET UD$=RAD$
  0960         LET CA(Y)=(B=3232); Ø=2; Å=B
  0970         IF JUMP THEN GOTO 1190
  0980         EXEC FIND
  0990         IF JUMP THEN GOTO 1190
  1000         REM   ALMEN OVERSÆTTELSE
  1010         READ FILE(3,B1+1)UD$
  1020         IF UD$="FEJL" THEN GOTO 0930
  1030         IF B1>127 THEN 
  1040           LET UD$(4)=T$(1,B MOD 64 DIV 16+1); UD$(4+(UD$(4)<>" "))=T$(2,B2 DIV 64+1)
  1050           LET UD$(11,14)=T$(B MOD 8+5); UD$(6)=CHR(32+B MOD 16 DIV 8*3)
  1060         ELSE
  1070           IF B1>95 THEN 
  1080             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))
  1090             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)
  1100             IF UD$(1)="S" OR UD$(1)="N" THEN LET UD$(8,15)=CHR(FNB(2)),CHR(FNB(1)),"               "
  1110           ELSE
  1120             LET S=B2-(B MOD 1024 DIV 256<>0)*(B2>127)*256; LS=2*(B1 DIV 32<>0)
  1130             LET UD$(8+LS,11+LS)=CHR(43+2*(S<0)),CHR(FNB(3)),CHR(FNB(2)),CHR(FNB(1))
  1140             IF B1<8 OR S<11 OR S>111 OR B MOD 1024 DIV 256<>3 OR ADRR<4012 THEN GOTO 1170
  1150             READ FILE(4,S)HJÆLP$
  1160             LET UD$(8+LS,15)=HJÆLP$,"           "
  1170           ENDIF
  1180         ENDIF
  1190         IF B1>47 AND B1<94 THEN LET P$(1)=CHR(B1)
  1200         IF B2>47 AND B2<94 THEN LET P$(2)=CHR(B2)
  1210         LET UD$=UD$,"               "; UDSKRIFT$=UDSKRIFT$,UDSK$," ",UD$," ",P$
  1220       NEXT Y
  1230       PRINT UDSKRIFT$
  1240     NEXT X
  1250   NEXT XX
  1255   LET POS(4)=1
  1260 NEXT UUU
  1270 GOTO 0530