10  COM V0,V1,V2,V3,V4,V5,V6,V7
20  COM H$[62],H[62],S$[70],T$[70],V$[70]
21  COM S[240,4]
25  COM F$[6],V9
30  COM C[200],C0,P0,P9
40  DIM P[40,3],Q[20,3]
100  REM - SNOBOL COMPILER FOR THE HP2000 T/S SYSTEM
110  REM - WES FASNACHT   12/5/72
120  REM - FOR DR. LEATHRUM  CSC 6505  UNIV OF DELAWARE
130  REM
140  REM - ADAPTED FROM THE DESCRIPTION OF THE SNOBOL-3 SYSTEM IN 
150  REM - ROSEN'S "PROGRAMMING SYSTEMS AND LANGUAGES"
160  REM HP CONTRIBUTED LIBRARY 2/75, 4 PROGRAMS: SNOBOL,SNOBEX,
170  REM SNOBLD, SNOBER.
200  REM-INITIALIZATION PHASE
210  V0=0
215  P7=0
220  V1=70
230  V2=7
240  V3=10
250  V4=1
260  V5=2
270  V6=3
280  V7=1
285  V9=4
290  H$=" !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ["'92"]^"
300  MAT H=ZER
305  MAT S=ZER
310  FILES STRING,STRING,STRING
311  FILES *
312  PRINT "INPUT FILE-NAME";
313  INPUT F$
314  ASSIGN F$,V9,N
315  IF N <= 2 THEN 318
316  PRINT "FILE NOT AVAILABLE"
317  GOTO 312
318  U9=0
319  PRINT "WANT A PROGRAM LISTING";
320  INPUT V$
321  IF V$="YES" THEN 325
322  U9=1
325  S$[1,V1]=" "
327  PRINT LIN(2)
330  FOR I=1 TO V3
340  FOR J=1 TO V2
350  PRINT #1;S$
360  NEXT J
370  NEXT I
380  REM-STORE SYSTEM VARIABLES
390  R1=1
400  FOR I1=1 TO 30
410  READ T$
420  R2=LEN(T$)
430  GOSUB 5000
440  NEXT I1
450  DATA "SYSPIT","SYSPOT","ANCHOR","UNANCHOR","INTEGER","TRUNCATION"
460  DATA "MODE","DATE","EQUALS","PRINT","READ","REWIND","SIZE","TIME"
470  DATA "TRIM","UNANCH","UNEQL",".EQ",".GE",".GT",".LE",".LT",".NE"
480  DATA ".NUM",".REMDR","DEFINE","RETURN","FRETURN","QUOTE","'"
500  S[29,4]=30
510  C0=1
520  C2=0
525  P8=0
530  REM-SETTING OPERATOR PRECEDENCE VALUES
535  FOR I=1 TO 20
540  READ Q[I,3]
545  DATA 80,80,80,80,80,80,80,105,0,110,0,0,0,90,100,100,100,100,100,100
550  NEXT I
600  REM-PARSER
605  P6=0
610  E1=0
615  GOSUB 3000
620  IF E1 THEN 9500
625  IF T$[1,1]=" " THEN 735
630  REM-LABEL ROUTINE
635  IF P9=1 THEN 650
640  E0=305
645  GOTO 9500
650  GOSUB 8050
655  S[S6,4]=-(C0-1)
660  GOSUB 7850
665  IF T$[1,4]#"END " THEN 735
670  C1=20099
675  GOSUB 7800
680  IF P9#10 THEN 695
685  P0=1
690  GOTO 725
695  IF P9=1 THEN 710
700  E0=3
705  GOTO 9000
710  GOSUB 8050
715  P0=-S[S6,4]
720  IF P0 <= 0 THEN 700
725  REM-EXEC
727  IF P8=0 THEN 730
728  PRINT "COMPILATION ERRORS - EXECUTION BYPASSED"
729  STOP 
730  PRINT LIN(2)"SUCCESSFUL COMPILATION"
731  PRINT LIN(2)
733  C0=C0-1
734  CHAIN "SNOBEX"
735  REM-E
740  P2=P3=P5=0
745  GOTO 770
750  REM-B
760  REM-C
765  GOSUB 7850
770  REM-A
772  IF P4=1 AND P3=1 AND P6<1 THEN 785
773  IF P5#1 THEN 780
774  IF P4=2 AND P6=0 THEN 779
775  IF P9=1 OR P9=2 OR P9=4 OR P9=12 THEN 777
776  GOTO 779
777  P1=20014
778  GOSUB 7900
779  P5=0
780  GOTO P9 OF 810,810,905,975,995,1005,1160,1205,1275,1395,1440,1440
781  GOTO P9-12 OF 1460,1457,1520,1520,1520,1520,1520
782  E0=2
784  GOTO 9000
785  GOSUB 8000
787  IF P9=3 THEN 905
790  C1=20050
795  GOSUB 7800
800  P4=2
805  GOTO 735
810  REM-1 OR 2
835  GOSUB 8050
840  GOSUB 7850
845  P3=P5=1
850  IF P9#11 THEN 890
855  P1=20000
860  GOSUB 7900
865  P1=20020
870  GOSUB 7900
875  P1=S6
880  GOSUB 7900
885  GOTO 750
890  C1=S6
895  GOSUB 7800
900  GOTO 770
905  REM-3
910  IF P4=1 THEN 930
915  IF P4#2 THEN 935
920  GOSUB 8000
925  GOTO 950
930  IF P3=1 THEN 945
935  E0=306
940  GOTO 9500
945  IF P2#0 THEN 935
950  C1=20051
955  GOSUB 7800
960  GOSUB 7850
965  P4=3
970  GOTO 735
975  REM-4
980  P1=20010
985  GOSUB 7900
990  GOTO 760
995  REM-5
1000  GOTO 750
1005  REM-6
1010  IF P4=2 THEN 1025
1015  E0=307
1020  GOTO 9500
1025  P5=0
1030  GOSUB 7850
1035  IF P9#7 THEN 1055
1040  C1=20005
1045  GOSUB 7800
1050  GOTO 760
1055  IF P9#8 THEN 1075
1060  P1=20006
1065  GOSUB 7900
1070  GOTO 750
1075  IF P9=11 THEN 1095
1080  P1=20001
1085  GOSUB 7900
1090  GOTO 770
1095  GOSUB 7850
1100  IF P9=13 THEN 1135
1105  P1=20003
1110  GOSUB 7900
1115  P1=20000
1120  GOSUB 7900
1125  P7=1
1130  GOTO 770
1135  GOSUB 7850
1140  IF P9#7 THEN 1015
1145  C1=20007
1150  GOSUB 7800
1155  GOTO 760
1160  REM-7
1165  GOSUB 7950
1170  IF P1=20000 THEN 1015
1175  C1=P1
1180  GOSUB 7800
1185  IF P1 >= 20001 AND P1 <= 20007 THEN 1195
1190  GOTO 1160
1195  P7=0
1200  GOTO 760
1205  REM-8
1210  GOSUB 7950
1215  IF P1=20000 THEN 1015
1220  IF P1 >= 20001 AND P1 <= 20007 THEN 1240
1225  C1=P1
1230  GOSUB 7800
1235  GOTO 1205
1240  IF P7=1 THEN 1260
1245  P1=20002
1250  GOSUB 7900
1255  GOTO 750
1260  P1=20004
1265  GOSUB 7900
1270  GOTO 750
1275  REM-9
1280  GOSUB 8000
1285  IF P3#0 THEN 1300
1290  C1=0
1295  GOSUB 7800
1300  GOSUB 7850
1305  P4=4
1310  IF P9#11 THEN 1340
1315  C1=20052
1320  GOSUB 7800
1325  P1=20000
1330  GOSUB 7900
1335  GOTO 750
1340  REM-D
1343  P5=P[P0,2]
1345  IF T$[P5,P5]#"S" THEN 1365
1350  C1=20054
1355  GOSUB 7800
1360  GOTO 750
1365  IF T$[P5,P5]="F" THEN 1380
1370  E0=308
1375  GOTO 9500
1380  C1=20053
1385  GOSUB 7800
1390  GOTO 750
1395  REM-10
1400  GOSUB 8000
1405  IF P3#0 THEN 1420
1410  C1=0
1415  GOSUB 7800
1420  REM-EOS
1425  C1=20055
1430  GOSUB 7800
1435  GOTO 600
1440  REM-11 & 12
1445  P1=20000
1450  GOSUB 7900
1455  GOTO 750
1457  REM-14
1458  P5=1
1460  REM-13
1465  GOSUB 7950
1470  IF P1=20000 THEN 1490
1475  C1=P1
1480  GOSUB 7800
1485  GOTO 1460
1490  P6=P6-1
1495  IF P4#4 THEN 750
1500  IF P2#0 THEN 750
1505  GOSUB 7850
1510  IF P9=10 THEN 1420
1515  GOTO 1340
1520  REM-15 THRU 19
1525  P1=P9+20000
1530  GOSUB 7900
1535  GOTO 750
3000  REM-NEXTSTMT ROUTINE
3010  READ #V9;T$
3020  IF LEN(T$) <= 68 THEN 3050
3030  E0=304
3040  GOTO 9500
3050  IF T$[1,1]#"*" THEN 3080
3055  IF U9 THEN 3010
3060  PRINT "    ";T$
3070  GOTO 3010
3080  C2=C2+1
3085  C1=C2
3090  GOSUB 7800
3100  IF U9 THEN 3120
3110  PRINT  USING "#,3D";C2
3115  PRINT " ";T$
3120  T$[LEN(T$)+1]=" "
3130  Q1=1
3140  P0=0
3150  GOTO 3210
3160  REM-CA
3170  Q1=Q2+2
3180  GOTO 3210
3190  REM-CB
3200  Q1=Q2+1
3210  P0=P0+1
3220  REM-CC
3230  IF Q1 <= LEN(T$) THEN 3300
3240  REM-CD
3250  P[P0,1]=10
3260  P0=1
3270  P9=P[P0,1]
3280  P4=1
3290  RETURN 
3300  REM-CONV
3310  FOR Q1=Q1 TO LEN(T$)
3320  IF T$[Q1,Q1]#" " THEN 3350
3330  NEXT Q1
3340  GOTO 3240
3350  FOR Q2=Q1 TO LEN(T$)
3360  IF T$[Q2,Q2]="." THEN 3410
3370  IF T$[Q2,Q2]<"0" THEN 3440
3380  IF T$[Q2,Q2] <= "9" THEN 3410
3390  IF T$[Q2,Q2]<"A" THEN 3440
3400  IF T$[Q2,Q2]>"Z" THEN 3440
3410  NEXT Q2
3420  PRINT "SYSTEM ERROR"
3430  STOP 
3440  IF Q2 <= Q1 THEN 3490
3450  P[P0,1]=1
3460  P[P0,2]=Q1
3470  P[P0,3]=Q2-1
3480  P0=P0+1
3490  IF T$[Q2,Q2]#" " THEN 3520
3500  Q1=Q2+1
3510  GOTO 3220
3520  IF T$[Q2-1,Q2+1]#" = " THEN 3550
3530  P[P0,1]=3
3540  GOTO 3160
3550  IF T$[Q2,Q2]#"$" THEN 3580
3560  P[P0,1]=4
3570  GOTO 3190
3580  IF T$[Q2,Q2]#"*" THEN 3700
3590  IF T$[Q2-1,Q2+1]#" * " THEN 3620
3600  P[P0,1]=17
3610  GOTO 3160
3620  IF T$[Q2,Q2+1]#"* " THEN 3650
3630  P[P0,1]=7
3640  GOTO 3160
3650  IF T$[Q2-1,Q2]=" *" THEN 3680
3660  E0=301
3670  E1=1
3675  RETURN 
3680  P[P0,1]=6
3690  GOTO 3190
3700  IF T$[Q2,Q2]#"'" THEN 3810
3710  Q1=Q2+1
3720  FOR Q2=Q1 TO LEN(T$)
3730  IF T$[Q2,Q2]="'" THEN 3770
3740  NEXT Q2
3750  E0=302
3760  GOTO 9500
3770  P[P0,1]=2
3780  P[P0,2]=Q1
3790  P[P0,3]=Q2-1
3800  GOTO 3190
3810  IF T$[Q2,Q2]#"/" THEN 3900
3820  IF T$[Q2-1,Q2+1]#" / " THEN 3850
3830  P[P0,1]=18
3840  GOTO 3160
3850  IF T$[Q2-1,Q2]=" /" THEN 3880
3860  P[P0,1]=8
3870  GOTO 3190
3880  P[P0,1]=9
3890  GOTO 3190
3900  IF T$[Q2,Q2]#"(" THEN 3960
3910  IF T$[Q2-1,Q2]=" (" THEN 3940
3920  P[P0,1]=11
3930  GOTO 3190
3940  P[P0,1]=12
3950  GOTO 3190
3960  IF T$[Q2,Q2]#")" THEN 4020
3970  IF T$[Q2,Q2+1]=") " THEN 4000
3980  P[P0,1]=13
3990  GOTO 3190
4000  P[P0,1]=14
4010  GOTO 3160
4020  IF T$[Q2,Q2]#"," THEN 4050
4030  P[P0,1]=5
4040  GOTO 3190
4050  IF T$[Q2-1,Q2+1]#" + " THEN 4080
4060  P[P0,1]=15
4070  GOTO 3160
4080  IF T$[Q2-1,Q2+1]#" - " THEN 4110
4090  P[P0,1]=16
4100  GOTO 3160
4110  IF T$[Q2-1,Q2+1]=" ^ " THEN 4140
4120  E0=303
4130  GOTO 3670
4140  P[P0,1]=19
4250  GOTO 3160
5000  REM-STORE ROUTINE
5010  IF R2#0 THEN 5040
5020  S6=0
5030  RETURN 
5040  V$=T$[R1,R1]
5050  T0=1
5060  REM-S/C/R-A
5065  R0=0
5070  R7=R2
5080  GOTO 5430
5100  REM-CONCAT ROUTINE
5110  REM-S/C/R-B
5115  R0=1
5120  S0=T0=0
5130  R7=R2+R4
5140  IF R2=0 THEN 5180
5150  F6=R1
5160  GOSUB 7700
5170  GOTO 5430
5180  IF R4=0 THEN 5240
5190  F6=R3
5200  GOSUB 7700
5210  R1=R3
5220  R2=R4
5230  GOTO 5060
5240  S6=0
5250  RETURN 
5300  REM-REPLACE ROUTINE
5310  R0=2
5320  S0=T0=0
5330  R7=R2+R4+R6
5340  IF R2=0 THEN 5380
5350  F6=R1
5360  GOSUB 7700
5370  GOTO 5430
5380  R1=R3
5390  R2=R4
5400  R3=R5
5410  R4=R6
5420  GOTO 5110
5430  REM-S/C/R-1
5440  I=1
5450  J=62
5460  S0=0
5470  S5=INT((I+J)/2)
5480  IF V$=H$[S5,S5] THEN 5560
5490  IF V$<H$[S5,S5] THEN 5520
5500  I=S5+1
5510  GOTO 5530
5520  J=S5-1
5530  IF J >= I THEN 5470
5540  PRINT "INVALID CHARACTER"
5550  STOP 
5560  S6=H[S5]
5570  IF S6#0 THEN 5610
5580  V0=V0+1
5590  H[S5]=V0
5600  GOTO 5920
5610  REM-S/C/R-2
5620  IF S[S6,2]=R7 THEN 5690
5630  S5=S6
5640  S6=S[S5,3]
5650  IF S6#0 THEN 5620
5660  V0=V0+1
5670  S[S5,3]=V0
5680  GOTO 5920
5690  R8=R1
5700  R9=S[S6,1]
5710  T=R2
5720  GOSUB 6300
5730  IF U0#0 THEN 5630
5740  IF R0#0 THEN 5760
5750  RETURN 
5760  R9=R9+R2
5765  IF R4=0 THEN 5820
5770  R8=R3
5790  T=R4
5800  GOSUB 6300
5810  IF U0#0 THEN 5630
5820  IF R0#1 THEN 5840
5830  RETURN 
5840  IF R6=0 THEN 5830
5860  R8=R5
5870  R9=R9+R4
5880  T=R6
5890  GOSUB 6300
5900  IF U0#0 THEN 5630
5910  RETURN 
5920  REM-S/C/R-3
5930  S6=V0
5940  R9=V7
5950  S[V0,1]=V7
5960  S[V0,2]=R7
5970  S[V0,3]=S[V0,4]=0
5980  R8=R1
5990  T=R2
6000  GOSUB 6200
6010  IF R0#0 THEN 6030
6020  RETURN 
6030  IF R4=0 THEN 6080
6040  R9=V7
6050  R8=R3
6060  T=R4
6070  GOSUB 6200
6080  IF R0#1 THEN 6100
6090  RETURN 
6100  IF R6=0 THEN 6090
6120  R9=V7
6130  R8=R5
6140  T=R6
6150  GOSUB 6200
6160  RETURN 
6200  REM-MOVE ROUTINE
6210  U1=0
6220  GOTO 6330
6300  REM-MATCH ROUTINE
6310  U1=1
6320  S0=0
6330  IF S0#0 THEN 6400
6340  F6=R9
6350  GOSUB 7500
6360  S1=F1
6370  S2=F2
6380  S3=F3
6390  GOTO 6410
6400  S3=R9
6410  IF T0#0 THEN 6480
6420  F6=R8
6430  GOSUB 7500
6440  T1=F1
6450  T2=F2
6460  T3=F3
6470  GOTO 6490
6480  T3=R8
6490  REM-M/M-1
6500  IF S0=1 THEN 6660
6510  READ #V4,S1
6520  IF U1=1 THEN 6540
6530  READ #V6,S1
6540  S5=0
6550  S8=S1
6560  FOR I=1 TO S2
6570  IF U1=1 THEN 6620
6580  IF S5=0 THEN 6610
6590  PRINT #V6;S$
6600  GOTO 6620
6610  S5=1
6620  READ #V4;S$
6630  NEXT I
6640  S9=S2
6650  GOTO 6690
6660  IF S3+T-1 <= V1 THEN 6690
6670  E0=1
6680  GOTO 9000
6690  IF T0=1 THEN 6770
6700  READ #V5,T1
6710  T8=T1
6720  T9=T2
6730  FOR I=1 TO T2
6740  READ #V5;T$
6750  NEXT I
6760  GOTO 6780
6770  IF T3+T-1>V1 THEN 6670
6780  REM-M/M-2
6790  U0=0
6800  T4=T
6810  S7=S3
6820  T7=T3
6830  REM-M/M-4
6840  S4=(V1-S7+1) MIN (V1-T7+1)
6850  IF T4 <= S4 THEN 7220
6860  REM-M/M-3
6870  S5=S7+S4-1
6880  T5=T7+S4-1
6890  IF U1=1 THEN 6920
6900  S$[S7,S5]=T$[T7,T5]
6910  GOTO 6980
6920  IF S$[S7,S5]=T$[T7,T5] THEN 6980
6930  IF S$[S7,S5]<T$[T7,T5] THEN 6960
6940  U0=-1
6950  RETURN 
6960  U0=1
6970  RETURN 
6980  S7=S5+1
6990  T7=T5+1
7000  T4=T4-S4
7010  IF S0=1 THEN 7130
7020  IF S7 <= V1 THEN 7130
7030  S7=1
7040  S9=S9+1
7050  IF U1=1 THEN 7120
7080  IF S9 <= V2 THEN 7110
7090  S9=1
7100  S8=S8+1
7110  PRINT #V6;S$
7120  READ #V4;S$
7130  IF T0=1 THEN 6830
7140  IF T7 <= V1 THEN 6830
7150  T7=1
7160  T9=T9+1
7170  READ #V5;T$
7180  IF T9 <= V2 THEN 6830
7190  T9=1
7200  T8=T8+1
7210  GOTO 6830
7220  S5=S7+T4-1
7230  T5=T7+T4-1
7240  IF U1=1 THEN 7390
7250  S$[S7,S5]=T$[T7,T5]
7260  IF S0#1 THEN 7280
7270  RETURN 
7280  FOR I=S9 TO V2+1
7290  PRINT #V6;S$
7300  READ #V4;S$
7310  NEXT I
7320  READ #V6,S8
7330  F1=S8
7340  F2=S9
7350  F3=S5+1
7360  GOSUB 7600
7370  V7=F6
7380  RETURN 
7390  IF S$[S7,S5]=T$[T7,T5] THEN 7440
7400  IF S$[S7,S5]<T$[T7,T5] THEN 7430
7410  U0=-1
7420  RETURN 
7430  U0=1
7440  RETURN 
7500  REM-GETPTRS
7510  F1=F6-1
7520  F2=INT(F1/V1)
7530  F3=F1-V1*F2+1
7540  F1=INT(F2/V2)
7550  F2=F2-V2*F1+1
7560  F1=F1+1
7570  RETURN 
7600  REM-PUTPTRS
7610  F6=V1*V2*(F1-1)+V1*(F2-1)+F3
7620  RETURN 
7700  REM-FINDFIRSTCHAR
7710  GOSUB 7500
7720  READ #V6,F1
7730  FOR I=1 TO F2
7740  READ #V6;V$
7750  NEXT I
7760  V$=V$[F3,F3]
7770  RETURN 
7800  REM-ENCODE
7810  C[C0]=C1
7820  C0=C0+1
7830  RETURN 
7850  REM-INCPTR
7860  P0=P0+1
7870  P9=P[P0,1]
7880  RETURN 
7900  REM-STACKOP
7903  IF P1=20000 THEN 7936
7906  IF P1<20000 THEN 7915
7909  Q3=P1-20000
7912  GOTO 7918
7915  Q3=8
7918  IF P2=0 THEN 7942
7921  IF Q[Q3,3]>Q[P2,2] THEN 7942
7924  C1=Q[P2,1]
7927  GOSUB 7800
7930  P2=P2-1
7933  GOTO 7918
7936  P6=P6+1
7939  Q3=1
7942  P2=P2+1
7945  Q[P2,1]=P1
7946  Q[P2,2]=Q[Q3,3]
7947  RETURN 
7950  REM-POPUP
7960  IF P2>0 THEN 7985
7970  E0=2
7980  GOTO 9000
7985  P1=Q[P2,1]
7990  P2=P2-1
7995  RETURN 
8000  REM-CLEARSTACK
8005  IF P2#0 THEN 8015
8010  RETURN 
8015  GOSUB 7950
8020  IF P1=20000 THEN 7970
8023  C1=P1
8025  GOSUB 7800
8030  GOTO 8000
8050  REM-PUTSTRING
8055  IF P[P0,2] <= P[P0,3] THEN 8070
8060  S6=0
8065  RETURN 
8070  R1=P[P0,2]
8075  R2=P[P0,3]-R1+1
8080  GOSUB 5000
8085  IF P9#2 THEN 8095
8090  S6=-S6
8095  RETURN 
9000  REM-ERROR ROUTINE
9010  PRINT "****ERROR -";E0
9020  CHAIN "$SNOBER"
9500  REM-PARSER ERRORS
9510  PRINT "****ERROR -";E0
9517  CHAIN "$SNOBER"
9999  END 
