1 REM Ins{nd av Kristoffer Eriksson <5357>    1987-04-03 19.50.44 (KERMIT)
10 ! save AVCROSS,  1987-04-01 22.10
20 ! +---------------------------------------------------+
30 ! ! AVCROSS Ver 1.2 - Korsreferensprogram till AVASS  !
40 ! ! F|r ABC800-serien (dvs DBASIC-II)                 !
50 ! ! Startas av AVASS med CHAIN.                       !
60 ! ! Av Kristoffer Eriksson "SKE" ABC <5357>, 1984-1987!
70 ! ! F}r fritt kopieras f|r icke-kommersiella syften   !
80 ! +---------------------------------------------------+
90 ! OBS: Skrivarutskriften {r inst{lld f|r EPSON med smal stil. [ndra om du
100 ! inte har en EPSON-kompatibel skrivare, eller inte vill ha smal stil.
110 ! 
120 ! 
130 ! Ver-/-Datum----/-Sign-/-Kommentar-----
140 ! 1.0 / 84-11-02 / SKE  /
150 ! 1.2 / 87-03-28 / SKE  / Moderniserat, snabbare sortering, AVASS 5.1
160 ! 
170 ! 
180 INTEGER : EXTEND : ! NO RESUME
190 ; CHR$(12) "Korsreferenstabulering Ver 1.2 f|r AVASS ver 5.1" : ; 
200 ! 
210 DIM Dig$=16,Diglen$=34,Prfil$=16,S$=5,X$=5
220 Dig$="0123456789ABCDEF" : Diglen$="  008@6;48474736363635353535353524"
230 Basa=10 ! Talsystem f|r adresser
240 Prfil$="PR:VSA56"
250 DIM Prinit$=20 : Prinit$=CHR$(15) ! Kod f|r smal stil p} skrivare
260 DIM Prvmrg$=20 : Prvmarg$=SPACE$(10) ! Inleder varje rad
270 Prmaxk=11 ! Max kolumner a' 10 tecken p} skrivare, 11 f|r 132-teckens rader
280 ! 
290 Maxr=(SYS(4)-1500)/5
300 DIM Ref$=Maxr*5 ! H{r l{ses referensfilen in.
310 POKE VAROOT(Ref$)+4,Maxr*5,SWAP%(Maxr*5) ! S{tt l{ngd till max
320 ! 
330 ! 
340 ! --- \ppna adressfil --------------
350 ON ERROR GOTO 430 : OPEN "AVCROSS.TMP" AS FILE 2
360 GET #2 P$ COUNT 2
370 Basa=CVT$%(P$)
380 GET #2 F$ COUNT 16
390 IF F$=SPACE$(16) THEN F$="ABC-PROM/RAM"
400 ON ERROR GOTO 
410 ! 
420 WHILE 0
430   IF ERRCODE<>21 THEN ; "Felkod" ERRCODE "p} AVCROSS.TMP" : STOP 
440   ; "Kan inte hitta AVCROSS.TMP som skapas n{r man beg{r korsreferens i AVASS."
450   END 
460 WEND 
470 ! 
480 ! --- St{ll fr}gor -----------------
490 Basa=FNFr}gabas("Talsystem f|r adresser",Basa)
500 Jr=FNJnv{lj("Ska JR tas med","J")=1
510 Jrt=0
520 IF Jr Jrt=FNJnv{lj("Ska JR skrivas ut i en s{rskild tabell","J")=1 AND 1
530 Pr=FNJnv{lj("Utskrift p} skrivare","N")
540 IF Pr=1 THEN Fpr=1 : OPEN Prfil$ AS FILE Fpr : ; #Fpr Prinit$ : Maxk=Prmaxk
550 IF Pr=2 THEN Fpr=0 : Maxk=7
560 ! 
570 ! --- Bearbetningsloop -------------
580 Flgavbryt=0
590 Start=-1
600 Eof=0
610 POSIT #2,68
620 WHILE NOT Eof AND Flgavbryt<>-1
630   ; : ; "L{ser in ";
640   IF Start THEN ; "adress-filen..." ELSE ; "en omg}ng adresser till..."
650   Z=FNL{sin
660   ; "Sorterar" Ant "adresser..."
670   Z=FNQsort(1,Pos-5)
680   ; "     "
690   IF Start THEN Z=FNWr("Korsreferens f|r disassemblering av "+F$,1)
700   Z=FNSkrivlista
710   Start=0
720 WEND 
730 IF Flgavbryt=0 THEN ; "Klart."
740 CLOSE 
750 END 
760 ! 
770 ! 
780 ! --- L{s in adresser --------------
790 ! Adresserna lagras i Ref$ p} ett s{tt som till}ter sortering
800 ! med vanlig str{ngj{mf|relse. I filen inneh}ller varje post
810 ! Typ, Tilladress, Fr}nadress
820 ! F|r sorteringens skull {ndras det till: Tilladress, Fr}nadress, Typ
830 DEF FNL{sin
840   GET #2 S$ COUNT 5
850   Ant=0
860   Pos=1
870   WHILE ASCII(S$)<>115 AND Ant<Maxr
880     IF ASCII(S$)=101 IF NOT Jr THEN 920
890     MID$(Ref$,Pos,5)=MID$(S$,3,1)+MID$(S$,2,1)+RIGHT$(S$,5)+MID$(S$,4,1)+LEFT$(S$,1)
900     Ant=Ant+1 : Pos=Pos+5
910     IF (Ant AND 31)=0 THEN ; Ant CHR$(13);
920     GET #2 S$ COUNT 5
930   WEND 
940   Eof=ASCII(S$)=115
950   IF NOT Eof THEN ; "Fler {n" Maxr "adresser. Tar hand om resten senare..."
960   IF Eof THEN CLOSE 2
970   RETURN 0
980 FNEND 
990 ! 
1000 ! --- Skriv ut listor --------------
1010 DEF FNSkrivlista LOCAL F|rra,K,Tbl
1020   ; "Mellanslag = Paus, --> Stegning, PF1 = Stopp, N = N{sta lista (JR)."
1030   F|rra=-1 : K=0
1040   Flgavbryt=0
1050   Tbl=0 : WHILE Tbl<=Jrt AND Flgavbryt<>-1
1060     Z=FNWr("",1)
1070     ; CHR$(138); ! ULN
1080     Z=FNWr("Till  Typ Fr}n",0)
1090     ; CHR$(139,13); ! NULN
1100     Flgavbryt=0
1110     FOR I=1 TO Pos-5 STEP 5
1120       S$=MID$(Ref$,I,5)
1130       IF RIGHT$(S$,5)<>"e" THEN IF Tbl THEN 1240 ELSE 1160
1140       IF Jrt<>Tbl THEN 1240
1150       ! 
1160       Adr=SWAP%(CVT$%(LEFT$(S$,2)))
1170       IF Adr<>F|rra THEN Z=FNWr("",1)+FNWr(FNNumber$(Adr,Basa,2,-1)+"  ",0) : F|rra=Adr : K=1 : GOTO 1210
1180       IF K<Maxk THEN K=K+1 : Z=FNWr(", ",0) : GOTO 1210
1190       Z=FNWr(",",1)+FNWr("       ",0) : K=1
1200       ! 
1210       Z=FNWr(MID$("??JRJPCALDRDWR",INSTR(1,"ejclrw",RIGHT$(S$,5))*2+1,2)+" ",0)
1220       Z=FNWr(FNNumber$(SWAP%(CVT$%(MID$(S$,3,2))),Basa,2,-1),0)
1230       IF FNPaus THEN I=Pos
1240     NEXT I 
1250     IF Flgavbryt THEN Z=FNWr("",1)+FNWr("-Avbrutet-",0)
1260     Z=FNWr("",1)
1270   Tbl=Tbl+1 : WEND 
1280   ! 
1290   RETURN Flgavbryt=-1
1300 FNEND 
1310 ! 
1320 ! 
1330 ! --- Sortering -------------------
1340 DEF FNQsort(L,R) LOCAL I,J
1350   IF R-L<45 THEN RETURN FNIsort(L,R)
1360   ; L/5 CHR$(13);
1370   I=L : J=R
1380   X$=MID$(Ref$,(L/10+R/10)*5+1,5)
1390   WHILE I<=J
1400     WHILE MID$(Ref$,I,5)<X$ : I=I+5 : WEND 
1410     WHILE X$<MID$(Ref$,J,5) : J=J-5 : WEND 
1420     IF I<=J THEN S$=MID$(Ref$,I,5) : MID$(Ref$,I,5)=MID$(Ref$,J,5) : MID$(Ref$,J,5)=S$ : I=I+5 : J=J-5
1430   WEND 
1440   IF L<J THEN Z=FNQsort(L,J)
1450   IF I<R THEN Z=FNQsort(I,R)
1460   RETURN 0
1470 FNEND 
1480 ! 
1490 DEF FNIsort(L,R) LOCAL I,J
1500   I=L : WHILE I<R : I=I+5
1510     S$=MID$(Ref$,I,5)
1520     J=I-5 : WHILE J>=L
1530     IF S$<MID$(Ref$,J,5) THEN MID$(Ref$,J+5,5)=MID$(Ref$,J,5) : J=J-5 : WEND 
1540     MID$(Ref$,J+5,5)=S$
1550   WEND 
1560   RETURN 0
1570 FNEND 
1580 ! 
1590 ! --- Andra funktioner ------------
1600 DEF FNFr}gabas(Fr}ga$,Default) LOCAL Bas,I$=10
1610   ON ERROR GOTO 1610
1620   ; Fr}ga$ SPACE$(40-LEN(Fr}ga$)) "(2-16,RET=" NUM$(Default) ")  ";
1630   INPUT I$;
1640   ON ERROR GOTO 1690
1650   IF LEN(I$) THEN Bas=VAL(I$) : ; ELSE Bas=Default : ; NUM$(Bas)
1660   IF Bas<2 OR Bas>16 THEN ; "Bara mellan 2 och 16." CHR$(7) : GOTO 1620
1670   RETURN Bas
1680   ! 
1690   Bas=INSTR(1,"BbQqKkDdHh",I$)
1700   IF Bas=0 OR LEN(I$)>1 THEN ; " Va?" CHR$(7) : GOTO 1610
1710   Bas=VAL(MID$(" 2 8 81016",(Bas+1) AND 254,2))
1720   ; "=" NUM$(Bas)
1730   RETURN Bas
1740 FNEND 
1750 ! 
1760 DEF FNJnkoll(T$,Deflt$) LOCAL S,S$=1
1770   IF T$="" OR ASCII(T$)=13 THEN S$=Deflt$ ELSE S$=LEFT$(T$,1)
1780   S=INSTR(2," JjNn",S$)/2
1790   IF S=1 THEN ; "Ja" ELSE IF S=2 THEN ; "Nej" ELSE ; CHR$(7);
1800   RETURN S
1810 FNEND 
1820 ! 
1830 DEF FNJnv{lj(Fr}ga$,Deflt$) LOCAL N,I$=1
1840   ; Fr}ga$; : IF LEN(Fr}ga$)<40 THEN ; SPACE$(40-LEN(Fr}ga$));
1850   ; "(J/N/RET=" Deflt$ ")    ? ";
1860   WHILE 1
1870     GET I$
1880     N=FNJnkoll(I$,Deflt$) : IF N>0 THEN RETURN N
1890   WEND 
1900 FNEND 
1910 ! 
1920 ! G|r heltal positivt ---
1930 DEF FNUs.(A)
1940   IF A>=0 THEN RETURN A ELSE RETURN 65536.+A
1950 FNEND 
1960 ! 
1970 ! Utskrift ---
1980 DEF FNWr(S$,Crf)
1990   ; S$; : IF Crf THEN ; 
2000   IF Fpr=0 THEN RETURN 0
2010   IF Radstart THEN ; #Fpr Prvmarg$; : Radstart=0
2020   ; #Fpr S$;
2030   IF Crf THEN ; #Fpr : Radstart=-1
2040   RETURN 0
2050 FNEND 
2060 ! 
2070 ! Talomvandling ---
2080 DEF FNNumber$(N,Radix,Bytes,Fixd) LOCAL Res$=16,L,N2
2090   L=ASCII(RIGHT$(Diglen$,Radix+Radix+Bytes))-48
2100   ON Radix GOTO 2150,2150,2150,2150,2150,2150,2150,2130,2150,2110,2150,2150,2150,2150,2150,2120
2110   IF Fixd THEN Res$=NUM$(FNUs.(N)) : RETURN SPACE$(L-LEN(Res$))+Res$ ELSE RETURN NUM$(FNUs.(N))
2120   Res$=HEX$(N) : RETURN STRING$(L-LEN(Res$),48)+Res$
2130   Res$=OCT$(N) : RETURN STRING$(L-LEN(Res$),48)+Res$
2140   ! 
2150   IF N<0 THEN Z.=65536.+N : Res$=MID$(Dig$,Z.-FIX(Z./Radix)*Radix+1.,1) : N2=FIX(Z./Radix) ELSE N2=N
2160   WHILE N2
2170     Res$=MID$(Dig$,MOD(N2,Radix)+1,1)+Res$
2180     N2=N2/Radix
2190   WEND 
2200   RETURN STRING$(L-LEN(Res$),48)+Res$
2210 FNEND 
2220 ! 
2230 DEF FNPaus LOCAL I$=1
2240   WHILE SYS(5) OR Flgstega
2250     GET I$
2260     WHILE ASCII(I$)=32
2270       WHILE NOT Flgstega
2280         ; " -Pause- "; : GET I$
2290         ; STRING$(9,8) SPACE$(9) STRING$(9,8);
2300       IF 0 WEND 
2310       Flgstega=0
2320     IF 0 WEND 
2330     IF ASCII(I$)=9 THEN Flgstega=-1
2340     IF ASCII(I$)=192 THEN Flgavbryt=-1
2350     IF (ASCII(I$) AND 223)=78 THEN Flgavbryt=2
2360   IF SYS(5) WEND 
2370   RETURN Flgavbryt
2380 FNEND