1 REM Ins{nd av Johan Olofsson <5809>    1987-08-01 15.16.41 (DUMP)
10 ! -------------------------------------------------- 
20 ! CROSSREF Ver 2.00 - L{ser en BAS-fil 
30 ! F|r ABC800-BASIC, med diskett-station 
40 ! F}r kopieras fritt endast i icke-komersiella syften. 
70 ! -------------------------------------------------- 
99 ! 
100 INTEGER : EXTEND 
101 ! 
102 COMMON Sep$=18,E$=160,G$=30,Text$(0:6)=20,L$=1,W$=1,R$=1 
103 COMMON Rub$=80,Fil$=16,Tmpfil$=16,Pr$=16,Order$=7 
104 COMMON Typstring,Typvar,Typlocal,Typfn,Typbas,Typtal,Typrad 
106 COMMON Infil,Tmp,Utfil,Bas,Order,Flaglist,Flagkill,K9,T0,Utfilpos. 
112 ! 
180 OPEN Fil$ AS FILE Infil 
200 PREPARE Tmpfil$ AS FILE Tmp 
215 WHILE Flaglist 
220   PREPARE Pr$ AS FILE Utfil 
221   IF INSTR(1,Pr$,'PR:')<>1 THEN WIDTH #Utfil,78 
225 IF 0 WEND 
230 T=SYS(4)-3000 : DIM T$=T : POKE VAROOT(T$)+4,2,0 : T0=1 
235 MID$(T$,T0,2)=W$+' ' 
340 ! 
350 Z=FNL{s 
351 K9=POSIT(Tmp)/4 ! antalet poster i #Tmp 
352 PUT #Tmp,CHR$(0,0,0,0) 
353 PUT #Tmp,CVT%$(LEN(T$)) 
354 PUT #Tmp,T$ 
360 ! 
365 IF Flaglist THEN Utfilpos.=POSIT(Utfil) 
370 CHAIN 'cref3' 
400 ! 
410 ! ------------------------------------------------------------------------ 
420 ! 
1000 DEF FNL{s LOCAL Ord$=160,A$=200,Aa$=80,P$=1,R,S,Typ 
1005   ON ERROR GOTO 1485 
1010   IF Flaglist ; #Utfil 'Listning av programmet "'+Fil$+'"' : ; #Utfil 
1015   WHILE -1 
1020     INPUT LINE #Infil,A$ 
1025     IF Flaglist ; #Utfil,LEFT$(A$,LEN(A$)-2) 
1030     ! 
1035     R=VAL(LEFT$(A$,INSTR(1,A$,' '))) 
1040     ! R = radnummer 
1045     A$=RIGHT$(A$,INSTR(1,A$,' ')) 
1050     A$=LEFT$(A$,LEN(A$)-2)+' ' 
1055     ! A$ {r nu rensad fr}n radnummer och CRLF 
1060     ! 
1065     Flagdef=(1=INSTR(1,A$,' DEF FN')) 
1070     WHILE Flagdef 
1075       P$=L$ 
1080       Flagfn=-1 
1085       Posfn=T0 
1090       ! Flagdef {r satt f|r pgm-raden med ' DEF FN' 
1095       ! Flagfn  {r satt till pgm-raden med ' FNEND' 
1100       ! Posfn   anv{nds f|r att kolla om variabler {r lokala 
1105     IF 0 WEND 
1110     IF 2=INSTR(1,A$,'FNEND') THEN Flagfn=0 : Posfn=1 
1115     ! 
1120     S=0 
1125     Flaggo=0 : Flagif=0 : Flagon=0 
1130     FOR P=1 TO LEN(A$) 
1135       IF NOT Flagdef THEN P$='' 
1140       IF MID$(A$,P,1)=':' THEN Flaggo=0 : Flagif=0 : Flagon=0 
1145       IF MID$(A$,P,1)='"' THEN P=INSTR(P+1,A$,'"') : P$='"' 
1150       IF MID$(A$,P,1)="'" THEN P=INSTR(P+1,A$,"'") : P$="'" 
1155       IF MID$(A$,P,1)='!' THEN GOTO 1475 ! skippa kommentar ! 
1160       IF INSTR(P,A$,'REM')=P THEN GOTO 1475 
1165       WHILE INSTR(1,Sep$,MID$(A$,P,1)) 
1170         WHILE S>0 AND P>S 
1175           ! Det finns n}got mellan S och P 
1180           Ord$=MID$(A$,S,P-S) 
1185           Typ=FNTyp(Ord$) 
1190           IF Typ=Typvar IF MID$(A$,P,1)='(' THEN Ord$=Ord$+'()' 
1195           ! f|r indexerade variabler 
1200           IF Order<Typstring IF Typ=Typstring THEN Ord$='' 
1205           ! Fyll inte T$ med str{ngar i on|dan !!! 
1210           WHILE Typ=Typbas 
1215             IF INSTR(1,'IF THEN ELSE',Ord$) THEN Flagif=-1 
1220             IF INSTR(1,'GOTO GOSUB',Ord$) THEN Flaggo=-1 
1225             IF Ord$='ON' THEN Flagon=-1 
1230             Lastbas$=Ord$ 
1235             IF INSTR(1,E$,W$+Ord$+W$) THEN Ord$='' 
1240             ! Vanliga BASIC-ord struntar vi i !!! 
1245           IF 0 WEND 
1250           WHILE LEN(Ord$) 
1251             ! 
1252             ! Det {r n}got som ska vara i Crossref-tabellen T$ 
1253             ! 
1255             WHILE Typ=Typtal ! Ett radnummer ??? 
1260               WHILE INSTR(1,Sep$,MID$(A$,S-1,1))>13+Flagon 
1265                 WHILE INSTR(1,Sep$,MID$(A$+' ',P,1))>13+Flagon 
1270                   WHILE Flaggo OR Flagif 
1275                     WHILE INSTR(1,G$,' '+Lastbas$+' ') 
1280                       WHILE Lastbas$<>'IF' OR Lasttyp<>Typbas 
1285                         Ord$=Ord$+R$ ! En Rad-nummer-referens! 
1290                       IF 0 WEND 
1295                     IF 0 WEND 
1300                   IF 0 WEND 
1305                 IF 0 WEND 
1310               IF 0 WEND ! ( Med till visshet gr{nsande sannolikhet ! ) 
1315             IF 0 WEND 
1320             ! 
1330             IF Flagdef IF Typ=Typfn THEN Z=FNInsert(Ord$+P$) 
1335             ! S} att funktionsnamnet listas omedelbart f|re lokala var. 
1340             IF Flagdef IF Typ=Typvar THEN Z=FNInsert(Ord$+P$) 
1345             ! S{tt in lokala variabeln i T$ 
1350             IF Typ=Typstring THEN K=INSTR(1,T$,W$+Ord$+P$+W$) 
1355             ! Str{ngar lagras med avslutande citationstecken 
1360             IF Typ<>Typstring THEN K=INSTR(1,T$,W$+Ord$+W$) 
1365             ! K pekar nu p} f|rekomst i T$ 
1370             WHILE Flagfn AND (Typ=Typvar OR Typ=Typfn) 
1375               K=INSTR(Posfn,T$,W$+Ord$+L$+W$) 
1380               ! var det en lokal variabel? 
1385               IF K=0 THEN K=INSTR(1,T$,W$+Ord$+W$) ! GLOBAL ! 
1390             IF 0 WEND 
1395             WHILE (K=0) OR (K>T0) 
1400               ! S{tt in i T$ 
1405               IF P$=L$ IF Typ=Typvar THEN Z=FNInsert(Ord$+P$) 
1410               IF P$=L$ IF Typ<>Typvar THEN Z=FNInsert(Ord$) 
1415               IF P$<>L$ THEN Z=FNInsert(Ord$+P$) 
1420             IF 0 WEND 
1425             ; POSIT(Tmp)/4,K; : IF T0=K+1+LEN(Ord$)+LEN(P$) THEN ; '*'; 
1430             ; ,Ord$+P$ 
1435             PUT #Tmp,CVT%$(K)+CVT%$(R) 
1440           IF 0 WEND 
1445           IF Ord$='DATA' THEN Flagskip=-1 
1450           Lasttyp=Typ 
1455         IF 0 WEND 
1460         S=P+1 
1465       IF 0 WEND 
1470     IF NOT Flagskip THEN NEXT P ELSE Flagskip=0 
1475   WEND 
1480   ! 
1485   WHILE ERRCODE=20 
1490     Aa$='' 
1495     FOR X=1 TO 80 
1500       GET #Infil,Z$ 
1505     IF Z$>=' ' THEN Aa$=Aa$+Z$ : NEXT X ELSE POSIT #Infil,POSIT(Infil)-1 
1510     INPUT LINE #Infil,A$ : A$=Aa$+A$ 
1515     ON ERROR GOTO 1485 
1520     GOTO 1035 
1525   IF 0 WEND 
1528   ! 
1529   ON ERROR GOTO 
1800   RETURN 0 
1810 FNEND 
1820 ! 
3000 DEF FNTyp(Ord$) 
3005   IF LEN(Ord$)=0 THEN RETURN -1 
3006   WHILE ASCII(Ord$)<=ASCII('9') 
3007     WHILE ASCII(Ord$)>=ASCII('1') 
3008       IF RIGHT$(Ord$,LEN(Ord$))=R$ RETURN Typrad 
3009     IF 0 WEND 
3010     IF ASCII(Ord$)>=ASCII('0') RETURN Typtal 
3012   IF 0 WEND 
3020   IF ASCII(Ord$)=ASCII('"') THEN RETURN Typstring 
3030   IF ASCII(Ord$)=ASCII("'") THEN RETURN Typstring 
3040   IF LEN(Ord$)=1 THEN RETURN Typvar 
3047   IF RIGHT$(Ord$,LEN(Ord$))=L$ THEN RETURN Typlocal 
3050   IF MID$(Ord$,2,1)>='a' THEN RETURN Typvar 
3060   IF MID$(Ord$,2,1)<='9' THEN RETURN Typvar 
3080   IF LEN(Ord$)>4 IF LEFT$(Ord$,5)='FNEND' THEN RETURN Typbas 
3090   IF LEN(Ord$)>2 IF LEFT$(Ord$,2)='FN' THEN RETURN Typfn 
3100   RETURN Typbas 
3110 FNEND 
3120 ! 
3130 DEF FNInsert(Ord$) 
3140   K=T0 : T0=T0+LEN(Ord$)+1 
3150   WHILE T0<T 
3160     POKE VAROOT(T$)+4,T0+2,SWAP%(T0+2) 
3170     MID$(T$,K+1,LEN(Ord$))=Ord$ 
3180     MID$(T$,T0,2)=W$+' ' 
3190     RETURN 0 
3200     ! Ut-variabler: K, T0 och T$ 
3210   IF 0 WEND 
3220   OUT 34,7 : ; : ; 'Minnet r{cker inte till !!!' : ; 
3230   ; #Utfil CHR$(10,13,10)+'F|r litet minne !'; 
3240   ; #Utfil CHR$(10,13),'F|rs|k utan listning av str{ngvariabler.' 
3250   END 
3260   ! 
3270 FNEND