100 REM ************************************************
110 REM **** CROSS.BAS          28-FEB-78/27-FEB-81 ****
120 REM **** N A BOURGEOIS      SANDIA LABORATORIES ****
130 REM ************************************************
140 REM **** CROSS REFERENCE PROGRAM FOR BASIC TEXT ****
150 REM **** CLINT PURDUE   KEN NOWOTNY   20-JAN-75 ****
160 REM ************************************************
170 REM **** INITIALIZATION ****
180 REM ************************
190 PRINT CLK$,'CROSS:  81B27C'
200 DIM S1%(857%),S2%(2200%,1%),S4%(500%,1%)
210 S3%=1%
220 S5%=0%
230 DIM D1$(1%)
240 D1$(0%)="'"
250 D1$(1%)='"'
260 DIM D$(112%)
270 I8%=112%
280 FOR I%=0% TO I8%
290 READ D$(I%)
300 NEXT I%
310 P$=CHR$(12%)
320 T$='   CROSS REFERENCE   '&DAT$&'   '&CLK$
330 REM **************************
340 REM **** KEYBOARD ENTRIES ****
350 REM **************************
360 PRINT 'ENTER THE INPUT FILE NAME',
370 LINPUT A$
380 IF POS(A$,':',1%)=0% THEN A$='SY:'&A$
390 IF POS(A$,'.',1%)=0% THEN A$=A$&'.BAS'
400 PRINT 'NAME THE OUTPUT DEVICE',
410 LINPUT F$
420 IF F$='' THEN F$='LP:'
430 IF POS(F$,':',1%)=0% THEN 400
440 I%=POS(A$,':',1%)
450 J%=POS(A$,".",1%)
460 Z$=SEG$(A$,I%+1%,J%-1%)
470 F$=F$&Z$&'.CRF'
480 I%=POS(A$,':',1%)
490 Z$=SEG$(A$,I%+1%,255%)
500 T$=Z$&T$
510 REM ************************
520 REM **** OPEN THE FILES ****
530 REM ************************
540 OPEN A$ FOR INPUT AS FILE #1 DOUBLE BUF
550 OPEN F$ FOR OUTPUT AS FILE #2 DOUBLE BUF
560 IF SEG$(F$,1%,3%)='TT:' THEN PRINT #2
570 PRINT #2,T$
580 PRINT #2
590 REM ********************************
600 REM **** START OF MAIN SEQUENCE ****
610 REM ********************************
620 IF END #1 THEN 2000 \ REM		**** PRINT THE VARIABLES USAGE TABLE
630 LINPUT #1,B$
640 PRINT #2,B$
650 I1%=1%
660 GOSUB 2590 \ REM			**** OBTAIN THE LINE NUMBER
670 I9%=I2%
680 REM *********************************
690 REM **** IGNORE 'REM' STATEMENTS ****
700 REM *********************************
710 IF SEG$(B$,I1%,I1%+2%)='REM' THEN 620 \ REM **** GET ANOTHER LINE
720 REM ****************************************
730 REM **** FIND AND REMOVE QUOTED STRINGS ****
740 REM ****************************************
750 FOR I%=0% TO 1%
760 I1%=POS(B$,D1$(I%),1%)
770 IF I1%=0% THEN 890
780 I4%=POS(B$,D1$(I%),I1%+1%)
790 IF I4%=0% THEN 890
800 I3%=POS(B$,D1$(1%-I%),1%)
810 IF I3%>I1% THEN 860
820 I5%=POS(B$,D1$(1%-I%),I3%+1%)
830 IF I5%=0% THEN 860
840 I1%=I3%
850 I4%=I5%
860 I4%=I4%+1%
870 GOSUB 2910 \ REM			**** REMOVE QUOTED STRING
880 GO TO 760
890 NEXT I%
900 REM ****************************************
910 REM **** TRUNCATE '   \ REM' STATEMENTS ****
920 REM ****************************************
930 I1%=POS(B$,'\ REM',1%)
940 IF I1%=0% THEN 990
950 B$=SEG$(B$,1%,I1%-1%)
960 REM ***********************************
970 REM **** FIND AND REMOVE KEY WORDS ****
980 REM ***********************************
990 FOR I%=0% TO I8%
1000 I1%=POS(B$,D$(I%),1%)
1010 IF I1%=0% THEN 1230
1020 I4%=I1%+LEN(D$(I%))
1030 GOSUB 2910 \ REM			**** REMOVE KEY WORD
1040 IF I%>2% THEN 1000
1050 GOSUB 2590 \ REM			**** OBTAIN THE LINE NUMBER
1060 IF I%=2% THEN I9%=-I9% \ REM	**** KEY WORD 'GOSUB'
1070 FOR J%=0% TO S5%
1080 IF S4%(J%,0%)<>I2% THEN 1150
1090 K%=S4%(J%,1%)
1100 IF S2%(K%,1%)=0% THEN 1130
1110 K%=S2%(K%,1%)
1120 GO TO 1100
1130 S2%(K%,1%)=S3%
1140 GO TO 1190
1150 NEXT J%
1160 S4%(S5%,0%)=I2%
1170 S4%(S5%,1%)=S3%
1180 S5%=S5%+1%
1190 S2%(S3%,0%)=I9%
1200 S3%=S3%+1%
1210 I9%=ABS(I9%)
1215 IF X%=1% THEN 1050
1220 GO TO 1000
1230 NEXT I%
1240 REM *******************************
1250 REM **** REPLACE 'AS' WITH '?' ****
1260 REM *******************************
1270 I1%=POS(B$,'AS',1%)
1280 IF I1%=0% THEN 1340
1290 B$=SEG$(B$,1%,I1%-1%)&'?'&SEG$(B$,I1%+2%,255%)
1300 GO TO 1270
1310 REM *******************************
1320 REM **** REPLACE 'IF' WITH '@' ****
1330 REM *******************************
1340 I1%=POS(B$,'IF',1%)
1350 IF I1%=0% THEN 1410
1360 B$=SEG$(B$,1%,I1%-1%)&'@'&SEG$(B$,I1%+2%,255%)
1370 GO TO 1340
1380 REM **************************************
1390 REM **** FIND AND SAVE VARIABLE NAMES ****
1400 REM **************************************
1410 I3%=0%
1420 I2%=LEN(B$)
1430 IF I2%=0% THEN 620 \ REM		**** GET ANOTHER LINE
1440 I1%=1%
1450 J5%=I3%
1460 J1%=0%
1470 J2%=0%
1480 J3%=0%
1490 I3%=ASC(SEG$(B$,1%,1%))
1500 GOSUB 2860 \ REM			**** REMOVE SINGLE CHARACTER
1510 IF I3%<65% THEN 1420 \ REM		**** 'A'
1520 IF I3%>90% THEN 1420 \ REM		**** 'Z'
1530 J1%=I3%
1540 IF I2%=1% THEN 1710
1550 I4%=ASC(SEG$(B$,1%,1%))
1560 IF I4%=36% THEN 1670 \ REM		**** '$'
1570 IF I4%=37% THEN 1690 \ REM		**** '%'
1580 IF I4%>57% THEN 1710 \ REM		**** '9'
1590 IF I4%<48% THEN 1710 \ REM		**** '0'
1600 J2%=I4%
1610 GOSUB 2860 \ REM			**** REMOVE SINGLE CHARACTER
1620 IF I2%=2% THEN 1710
1630 I4%=ASC(SEG$(B$,1%,1%))
1640 IF I4%<36% THEN 1710 \ REM		**** '$'
1650 IF I4%>37% THEN 1710 \ REM		**** '%'
1660 IF I4%=37% THEN 1690
1670 J3%=1%
1680 GO TO 1700
1690 J3%=2%
1700 GOSUB 2860 \ REM			**** REMOVE SINGLE CHARACTER
1710 IF LEN(B$)<1% THEN 1800
1720 IF J5%=64% THEN 1800 \ REM		**** '@' (IF )
1730 Z$=SEG$(B$,1%,1%)
1740 IF Z$='=' THEN 1790
1750 IF Z$<>'(' THEN 1800
1760 I4%=POS(B$,')',1%)
1770 IF I4%=0% THEN 1800
1780 IF SEG$(B$,I4%+1%,I4%+1%)<>'=' THEN 1800
1790 I9%=-I9% \ REM			**** VARIABLE PRECEEDED BY '='
1800 IF J2%=0% THEN J2%=47%
1810 J9%=J3%*286%+(J1%-65%)*11%+J2%-47%
1820 IF S1%(J9%)<>0% THEN 1880
1830 S1%(J9%)=S3%
1840 S2%(S3%,0%)=I9%
1850 I9%=ABS(I9%)
1860 S3%=S3%+1%
1870 GO TO 1420 \ REM			**** LOOK FOR ANOTHER VARIABLE
1880 I1%=S1%(J9%)
1890 IF S2%(I1%,1%)<>0% THEN 1920
1900 S2%(I1%,1%)=S3%
1910 GO TO 1840
1920 I1%=S2%(I1%,1%)
1930 GO TO 1890
1940 REM ******************************
1950 REM **** END OF MAIN SEQUENCE ****
1960 REM ******************************
1970 REM *****************************************
1980 REM **** PRINT THE VARIABLES USAGE TABLE ****
1990 REM *****************************************
2000 CLOSE #1
2010 PRINT #2,P$
2020 IF SEG$(F$,1%,3%)='TT:' THEN PRINT #2
2030 PRINT #2,T$
2040 PRINT #2
2050 PRINT #2,'VARIABLE   LINE(S) WHERE USED:';
2060 PRINT #2,' IF PRECEEDED BY -, VAR FOLLOWED BY ='
2070 PRINT #2
2080 FOR K%=0% TO 285%
2090 FOR K1%=0% TO 572% STEP 286%
2100 I%=K%+K1%
2110 IF S1%(I%)=0% THEN 2300
2120 V$=''
2130 J3%=I%
2140 J4%=INT(I%/286%)
2150 IF J4%=0% THEN 2220
2160 IF J4%=1% THEN 2200
2170 V$='%'
2180 J3%=I%-572%
2190 GO TO 2220
2200 V$='$'
2210 J3%=I%-286%
2220 I3%=INT(J3%/11%)
2230 I2%=J3%-I3%*11%
2240 IF I2%=0% THEN 2260
2250 V$=CHR$(I2%+47%)&V$
2260 V$=CHR$(I3%+65%)&V$
2270 I1%=S1%(I%)
2280 PRINT #2,V$;
2290 GOSUB 2720 \ REM			**** PRINT THE LINE NUMBERS USED
2300 NEXT K1%
2310 NEXT K%
2320 REM *****************************************
2330 REM **** PRINT THE CONTOL TRANSFER TABLE ****
2340 REM *****************************************
2350 K1%=1%
2360 S6%=S5%-1%
2370 PRINT #2,P$
2380 IF SEG$(F$,1%,3%)='TT:' THEN PRINT #2
2390 PRINT #2,T$
2400 PRINT #2
2410 PRINT #2,'CONTROL TRANSFER SECTION (GOSUB, GO TO & THEN):';
2420 PRINT #2,' GOSUB PRECEEDED BY -'
2430 PRINT #2
2440 K2%=32767%
2450 FOR K%=0% TO S6%
2460 IF S4%(K%,0%)<=K1% THEN 2500
2470 IF S4%(K%,0%)>K2% THEN 2500
2480 K2%=S4%(K%,0%)
2490 I1%=S4%(K%,1%)
2500 NEXT K%
2510 IF K2%=32767% THEN 3390 \ REM	**** CLOSEOUT ROUTINE
2520 K1%=K2%
2530 PRINT #2,K1%;
2540 GOSUB 2720 \ REM			**** PRINT THE LINE NUMBERS USED
2550 GO TO 2440
2560 REM *********************
2570 REM **** SUBROUTINES ****
2580 REM ************************************
2590 REM **** S/R OBTAIN THE LINE NUMBER ****
2600 REM ************************************
2610 I2%=0%
2615 X%=0%
2620 IF I1%>LEN(B$) THEN 2700
2630 I3%=ASC(SEG$(B$,I1%,I1%))
2635 IF I3%=44% THEN GOSUB 2880 \ X%=1% \ GO TO 2700
2640 IF I3%=32% THEN 2680 \ REM		**** 'SPACE'
2650 IF I3%<48% THEN 2700 \ REM		**** '0'
2660 IF I3%>57% THEN 2700 \ REM		**** '9'
2670 I2%=I2%*10%+I3%-48%
2680 GOSUB 2860 \ REM			**** REMOVE SINGLE CHARACTER
2690 GO TO 2620
2700 RETURN
2710 REM *****************************************
2720 REM **** S/R PRINT THE LINE NUMBERS USED ****
2730 REM *****************************************
2740 I2%=5%
2750 I2%=2%+I2%+LEN(STR$(S2%(I1%,0%)))
2760 IF I2%<60% THEN 2790
2770 PRINT #2
2780 GO TO 2740
2790 PRINT #2,TAB(10%);S2%(I1%,0%);
2800 I1%=S2%(I1%,1%)
2810 IF I1%<>0% THEN 2750
2820 PRINT #2
2830 PRINT #2
2840 RETURN
2850 REM *************************************
2860 REM **** S/R REMOVE SINGLE CHARACTER ****
2870 REM *************************************
2880 B$=SEG$(B$,1%,I1%-1%)&SEG$(B$,I1%+1%,255%)
2890 RETURN
2900 REM **********************************************
2910 REM **** S/R REMOVE KEY WORD OR QUOTED STRING ****
2920 REM **********************************************
2930 B$=SEG$(B$,1%,I1%-1%)&SEG$(B$,I4%,255%)
2940 RETURN
2950 REM *******************
2960 REM **** KEY WORDS ****
2970 REM ********************
2980 REM **** STATEMENTS ****
2990 REM ********************
3000 DATA 'GO TO','THEN','GOSUB'
3010 DATA 'AS FILE','CALL','CHAIN','CLOSE #','CLOSE','COMMON'
3020 DATA 'DATA','DEF','DIM #','DIM','DOUBLE BUF','FILESIZE'
3030 DATA 'FOR INPUT','FOR OUTPUT','FOR','IF END #','END',LINPUT #'
3040 DATA 'LINPUT','INPUT #','INPUT','KILL','LET','LINE'
3050 DATA 'MODE','NAME','NEXT','ON','OPEN','OVERLAY'
3060 DATA 'PRINT #','PRINT','RANDOMIZE','READ','RECORDSIZE','REM'
3070 DATA 'RESET #','RESET','RESTORE #','RESTORE','RETURN','STEP'
3080 DATA 'STOP','TO','USING'
3090 REM ******************************
3100 REM **** ARITHMETIC FUNCTIONS ****
3110 REM ******************************
3120 DATA 'ABS','ATN','COS','EXP','INT','LOG10'
3130 DATA 'LOG','PI','RND','SGN','SIN','SQR'
3140 DATA 'TAB'
3150 REM **************************
3160 REM **** STRING FUNCTIONS ****
3170 REM **************************
3180 DATA 'ASC','BIN','CHR$','CLK$','DAT$','LEN'
3190 DATA 'OCT','POS','SEG$','STR$','TRM$','VAL'
3200 REM ********************************
3210 REM **** USER DEFINED FUNCTIONS ****
3220 REM ********************************
3230 DATA 'FNA','FNB','FNC','FND','FNE','FNF'
3240 DATA 'FNG','FNH','FNI','FNJ','FNK','FNL'
3250 DATA 'FNM','FNN','FNO','FNP','FNQ','FNR'
3260 DATA 'FNS','FNT','FNU','FNV','FNW','FNX'
3270 DATA 'FNY','FNZ'
3280 REM *********************************
3290 REM **** RT-11 UTILITY FUNCTIONS ****
3300 REM *********************************
3310 DATA 'ABORT','RCTRLC','CTRLC'
3320 DATA 'RCTRLO','SYS','TTYSET'
3330 REM ***************************
3340 REM **** DATBAS CALL NAMES ****
3350 REM ***************************
3360 DATA 'GETB','GET','IDEN','NULL'
3370 DATA 'PUTB','PUT','SBIT','TBIT'
3380 REM **************************
3390 REM **** CLOSEOUT ROUTINE ****
3400 REM **************************
3410 PRINT #2,P$
3420 CLOSE #2
3430 PRINT CLK$,'CROSS:  END'
3440 END