Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50404/infsta.bas
There are 2 other files named infsta.bas in the archive. Click here to see a list.
00010 REM INFSTA SAPSFORD/NADDOR 75
00011 I$="BAS:INFSAR.BAS"
00012 S$="22-FEB-76"
00014 PRINT S$" VERSION"
00016 PRINT
00100 Q0=0
00105 Q1=1
00110 Q2=2
00115 RANDOMIZE
00120 A9=64
00125 DIM V$(64)
00130 DIM S$(10)
00133 DIM L(19)
00135 DIM Z$(2),C(9,6),T(9),F(10),S(72),U$(9)
00200 DEF FNR(X,Y)=X+INT(RND*(Y-X+1))
00210 DEF FNS(X)=INT(10*X+0.1)-9*INT(X)
00300 ' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
00305 J$="STOSTABRIDESCLETRAADDCANCHADISFINLOCRANREPLINFILUPDTOTINS"
00400 F$="NAMDATSSNNUMTOTTEX"
00405 A$="AEIOUY"
00410 O7$="0000000000"
00415 D$="123456789"
00420 D1$="99312931303130313130313031"
00423 P$=" ## 'CC ##.# 'E"
00425 FOR I=15 TO 127
00430 O6$=O6$+CHR$(I)
00435 NEXT I
00440 O5$=CHR$(1)+CHR$(2)
00450 MAT READ L
00455 DATA 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
00960 T2=2
00965 T1=-T2
00970 GOTO 1000
00980 PRINT"NO FILE SYSTEM - START OR BRING"
00990 PRINT"BAD COMMAND"
01000 PRINT
01010 PRINT INT(TIM-T1+0.5)"/"INT(TIM+T2+0.5);
01020 T1=TIM
01040 MAT INPUT S$
01050 PRINT
01060 L=INSTR(Q1,J$,LEFT$(S$(1),3))
01070 IF L=Q0 THEN 990
01110 L=Q1+(L-Q1)/3
01130 IF C9<>0 THEN 1170
01140 IF L>3 THEN 980
01170 ON INT((L+4)/5) GOTO 1180,1190,1200,1210
01180 ON L GOTO 99999,4000,1303,6000,6000
01190 ON L-5 GOTO 1306,1307,1308,1309,1310
01200 ON L-10 GOTO 1311,1312,10000,1314,1315
01210 ON L-15 GOTO 3000,1317,1318,1319
01303 GOTO 1350
01306 GOTO 1350
01307 GOTO 1350
01308 GOTO 1350
01309 GOTO 1350
01310 GOTO 1350
01311 GOTO 1350
01312 GOTO 1350
01313 GOTO 1350
01314 GOTO 1350
01315 GOTO 1350
01317 GOTO 1350
01318 GOTO 1350
01319 GOTO 1350
01350 CHAIN I$
03000 IF INSTR(1,S$(1),"/R")<>0 THEN 3110
03010 PRINT "FIELD TYPE LENGTH TITLE"
03030 FOR I=1 TO C9
03040 K=C(I,4)
03050 ON C(I,3) GOTO 3080,3080,3080,3060,3060,3080
03060 K=K-INT(10*(K-INT(K))+0.5)
03080 PRINT USING P$,I,MID$(F$,C(I,3)*3-2,3),K,U$(I)
03090 NEXT I
03100 PRINT
03110 PRINT LOF(:2);" RECORDS IN ";Z9$+".STO"
03120 GOTO 1000
04000 F(3)=NUM 'START 4000
04002 Z$=S$(2)
04005 IF F(3)=2 THEN 4030
04010 IF LEFT$(S$(3),4)<>"DATA" THEN 4050
04020 GOSUB 41020
04030 GOSUB 41020
04035 IF F(5)=0 THEN 5000
04040 PRINT"FIELD SPECIFICATION ERROR"
04045 GOTO 1000
04050 T$=S$(3)
04052 GOSUB 81000
04054 IF F(5)=-1 THEN 990
04056 S$(0)=S$(4)
04060 PRINT"FIELD,TYPE,LENGTH,TITLE"
04070 C9=F(5)
04080 FOR I=1 TO C9
04090 PRINT I;" ";
04092 IF S$(0)="-1" THEN 4100
04095 IF F(3)=4 THEN 4105
04100 INPUT S$(I),C(I,4),U$(I)
04102 GOTO 4110
04105 INPUT S$(I),C(I,4),C(I,5),C(I,6),U$(I)
04110 GOSUB 45000
04115 IF F(5)=0 THEN 4140
04120 PRINT"SPECIFICATION ERROR"
04130 I=I-1
04140 NEXT I
04999 IF S$(0)="-1" THEN 1000
05000 I=INSTR(Z$,".")
05002 IF I=0 THEN 5040
05004 PRINT".EXT NOT NEEDED"
05006 Z$=LEFT$(Z$,I-1)
05040 Z9$=Z$
05070 GOSUB 43000
05090 FILE :1,Z$+".ANC$132", :2,Z$+".STO$"+STR$(G9)
05100 WRITE :1, F$+A$+D$+O7$+O5$+D1$, O6$
05110 S(0)=5*C9
05120 FOR I=1 TO C9
05122 K=5*I
05124 S(K-4)=C(I,1)+15
05126 S(K-3)=C(I,2)+15
05128 S(K-2)=C(I,3)+15
05130 S(K-1)=INT(10*C(I,4)+15.5)
05133 IF I<>1 THEN 5137
05135 S(K)=16
05136 GOTO 5140
05137 S(K)=S(K-5)+INT(C(I-1,4)+1.95)
05138 IF C(I-1,3)<>5 THEN 5140
05139 S(K)=S(K)+1 'FUDGE FOR " "+TOTAL
05140 NEXT I
05145 CHANGE S TO C$
05152 FOR I=1 TO 19
05154 S(I)=L(I)+15
05156 NEXT I
05158 S(0)=19
05160 CHANGE S TO L$
05162 WRITE :1, C$, U0$, L$
05164 GOSUB 44000
05166 PRINT
05170 PRINT Z9$+" READY"
05210 IF F(3)<4 THEN 1000
05300 FILE #5,S$(0)
05310 K9=0
05320 IF END#5 THEN 5340
05330 IF K9<A9 THEN 5400
05340 GOSUB 51000
05360 GOSUB 52000
05370 IF END#5 THEN 1000
05380 GOTO 5310
05400 K9=K9+1
05410 READ #5,S$
05420 V$=""
05430 FOR I=1 TO C9
05440 S$(I)=MID$(S$,C(I,5),C(I,6))
05450 ON C(I,3) GOTO 5500,5600,5600,5600,5600,5700
05500 GOSUB 29070
05510 GOSUB 29000
05520 GOTO 5700
05600 GOSUB 26500
05620 IF F(4)=1 THEN 1000
05630 IF C(I,3)<>5 THEN 5700
05640 S$(I)=CHR$(15)+S$(I)
05700 V$=V$+S$(I)
05710 NEXT I
05720 V$(K9)=V$+CHR$(1)
05730 GOTO 5320
06000 IF NUM<>2 THEN 6020
06010 IF S$(2)="-1" THEN 6050
06020 PRINT"VERIFY ";MID$("DESCLE",L*3-11,3);
06030 INPUT T$
06040 IF LEFT$(T$,1)<>"Y" THEN 1000
06050 ON L-3 GOTO 6060,6080
06060 SCRATCH :1
06070 C9=0
06080 SCRATCH :2
06090 PRINT MID$("DESTROYEDCLEARED ",(L-L(4))*9+1,9)
06100 GOTO 1000
10000 ' RANDOM RECORD GENERATOR
10010 ' F(3)=1 FOR DETAILS,=2 FOR COUNT ONLY
10020 F(10)=0
10022 T$=S$(2)+S$(3)
10024 GOSUB 81000
10026 IF F(5)=-1 THEN 990
10030 F(3)=VAL(S$(2))
10040 K9=VAL(S$(3))
10050 IF K9<1 THEN 1000
10055 IF F(3)=4 THEN 16000
10060 GOTO 1313
16000 'RANDOM FOR SPECIAL START FILES
16002 FILE #5,S$(4)
16005 SCRATCH #5
16010 FOR L1=1 TO K9
16015 K=0
16020 FOR I=1 TO C9
16030 ON C(I,3) GOTO 16100,16200,16300,16400,16400,16100
16100 FOR J=1 TO C(I,4)
16110 K=K+1
16120 S(K)=FNR(65,90)
16130 NEXT J
16140 GOTO 16500
16200 S(K+1)=FNR(48,57)
16210 S(K+2)=FNR(48,57)
16220 S(K+3)=FNR(48,49)
16230 S(K+4)=FNR(97-S(K+3),57-7*(S(K+3)-48))
16240 S(K+5)=FNR(48,50)
16250 S(K+6)=FNR(49-SGN(S(K+5)-48),57)
16260 K=K+6
16270 GOTO 16500
16300 FOR J=1 TO 9
16310 K=K+1
16320 S(K)=FNR(48,57)
16330 NEXT J
16340 GOTO 16500
16400 FOR J=1 TO FNS(C(I,4))
16410 K=K+1
16420 S(K)=FNR(48,57)
16430 NEXT J
16500 NEXT I
16510 S(0)=K
16520 CHANGE S TO S$
16521 PRINT #5,STR$(10000+L1*10)" "S$
16522 IF F(3)=5 THEN 16540
16524 PRINT S$
16526 GOTO 16550
16540 PRINT L1;
16550 NEXT L1
16555 PRINT
16560 PRINT S$(4)" READY"
16999 GOTO 1000
26500 'REVISED NUMERIC TO STRING CONVERTER
26510 IF INT(C(I,4))/2=INT(INT(C(I,4))/2) THEN 26540
26520 T$="0"+S$(I)
26530 GOTO 27020
26540 T$=S$(I)
27020 S$(I)=""
27030 F(4)=0
27040 IF INSTR(1,"0"+D$,LEFT$(T$,1))=0 THEN 27060
27050 IF INSTR(1,"0"+D$,MID$(T$,2,1))<>0 THEN 28000
27060 PRINT"ILLEGAL NUMBER IN FIELD #";I
27070 F(4)=1
27080 GOTO 28060
28000 I2=VAL(LEFT$(T$,2))+15
28010 IF I2<32 THEN 28030
28020 I2=I2+1
28030 S$(I)=S$(I)+CHR$(I2)
28040 T$=MID$(T$,3)
28050 IF LEN(T$)>0 THEN 27040
28060 RETURN
29000 ' CORRECT NAME LENGTHS
29010 K=LEN(S$(I))
29020 IF K>=C(I,2) THEN 29070
29030 FOR I1=K+1 TO C(I,2)
29040 S$(I)=S$(I)+CHR$(1)
29050 NEXT I1
29060 GOTO 29150
29070 FOR J=K TO 3 STEP -1
29080 IF K=C(I,2) THEN 29150
29090 P=INSTR(Q1,A$,MID$(S$(I),J,1))
29100 IF P=0 THEN 29130
29110 S$(I)=LEFT$(S$(I),J-1)+MID$(S$(I),J+1)
29120 K=K-1
29130 NEXT J
29140 S$(I)=LEFT$(S$(I),C(I,2))
29150 RETURN
41000 ' THE CONVERSION ROUTINES FOR FILE SYSTEM START-UP.
41010 ' INDATA
41020 READ C9
41030 FOR I=1 TO C9
41035 IF F(3)=3 THEN 41044
41040 READ U$(I),S$(I),C(I,4)
41042 GOTO 41050
41044 READ U$(I),S$(I),C(I,4),C(I,5),C(I,6)
41050 GOSUB 45000
41060 IF F(5)=-1 THEN 41080
41070 NEXT I
41080 RETURN
43000 U0$="" 'CONVRT
43010 FOR I=1 TO C9
43070 ON C(I,3) GOTO 43160,43075,43075,43110,43110,43160
43075 C3=C(I,3)
43080 C(I,2)=C3+INT(C3/1.5)
43090 C(I,4)=C3*3+2
43100 GOTO 43170
43110 C4=C(I,4)
43120 C(I,4)=C4=C4+INT(10*(C4-INT(C4))+0.5)
43130 C(I,2)=INT((C4+1)/2)
43150 GOTO 43170
43160 C(I,2)=C(I,4)=INT(C(I,4))
43170 IF I>1 THEN 43200
43180 C(I,1)=1
43190 GOTO 43220
43200 C(I,1)=C(I-1,1)+C(I-1,2)
43220 U$=U$(I)
43225 U=LEN(U$)
43230 C=INT(C(I,4)+0.95)
43232 ON SGN(U-C)+2 GOTO 43240,43270,43264
43240 IF ABS(4.5-C(I,3))<1 THEN 43260
43250 U$(I)=U$+SPACE$(C-U)
43255 GOTO 43270
43260 U$(I)=SPACE$(C-U)+U$
43262 GOTO 43270
43264 U$(I)=LEFT$(U$,C)
43270 IF C(I,3)<>5 THEN 43274
43272 U0$=U0$+" "
43274 U0$=U0$+U$(I)+" "
43275 NEXT I
43280 G9=C(C9,1)+C(C9,2)
43999 RETURN
44000 ' CREATE PADDERS FOR FIND STRINGS: LOW-S1$ , HIGH-S2$
44010 FOR I=1 TO C9
44020 S1$=S2$=""
44030 ON C(I,3) GOTO 44120,44060,44090,44200,44200,44120
44060 S1$="00/00/00"
44070 S2$="99/12/31"
44080 GOTO 44500
44090 S1$="000-00-0000"
44100 S2$="999-99-9999"
44110 GOTO 44500
44120 FOR J=1 TO C(I,4)
44130 S(J)=1
44140 NEXT J
44150 S(0)=J
44160 CHANGE S TO S1$
44170 MAT S=(127)*S
44180 CHANGE S TO S2$
44190 GOTO 44500
44200 FOR J=1 TO INT(C(I,4))
44210 S(J)=48
44220 NEXT J
44230 S(0)=J
44240 CHANGE S TO S1$
44250 FOR J=1 TO S(0)
44260 S(J)=57
44270 NEXT J
44280 CHANGE S TO S2$
44290 K=INT(10*(C(I,4)-INT(C(I,4)))+0.5)
44300 IF K=0 THEN 44340
44310 K1=INT(C(I,4))-K
44320 S1$=LEFT$(S1$,K1)+"."+RIGHT$(S1$,K)
44330 S2$=LEFT$(S2$,K1)+"."+RIGHT$(S2$,K)
44340 GOTO 44500
44500 WRITE :1, S1$,S2$
44600 NEXT I
44999 RETURN
45000 'VERIFY FIELD SPECS
45010 F(5)=0
45020 C3=INSTR(1,F$,LEFT$(S$(I),3))
45030 IF INT((C3-1)/3)<>(C3-1)/3 THEN 45990
45040 C(I,3)=(C3+2)/3
45045 IF F(3)<>4 THEN 45999
45047 IF S$(0)="-1" THEN 45999
45050 C(I,6)=C(I,6)-C(I,5)+1
45060 ON C(I,3) GOTO 45100,45120,45140,45160,45160,45180
45100 IF C(I,6)<C(I,4) GOTO 45990
45110 GOTO 45999
45120 IF C(I,6)<>6 THEN 45990
45130 GOTO 45999
45140 IF C(I,6)<>9 THEN 45990
45150 GOTO 45999
45160 IF C(I,6)<>FNS(C(I,4)) THEN 45990
45170 GOTO 45999
45180 IF C(I,6)=C(I,4) THEN 45999
45990 F(5)=-1
45999 RETURN
51000 IF K9=0 THEN 51160 'SHELLSORT 51000
51010 H=40
51020 IF K9>=H THEN 51050
51030 H=INT(H/3)
51040 GOTO 51020
51050 H=INT(H/3)
51060 FOR J=H+1 TO K9
51070 I=J-H
51080 V$=V$(J)
51090 IF V$>=V$(I) THEN 51130
51100 V$(I+H)=V$(I)
51110 I=I-H
51120 IF I>0 THEN 51090
51130 V$(I+H)=V$
51140 NEXT J
51150 IF H<>1 THEN 51050
51160 PRINT
51170 PRINT"SORTED"
51180 RETURN
52000 ' MERGE V$( ) INTO STORAGE FILE ON CHANNEL N
52010 K2=LOF(:2)
52020 SET :2,K2+1
52030 FOR I=1 TO K9
52040 WRITE :2, V$(I)
52050 NEXT I
52060 IF K2=0 THEN 52260
52070 K3=K2+K9
52080 SET :2,K2
52090 READ :2,V$
52100 SET :2,K3
52110 K3=K3-1
52120 IF V$>V$(K9) THEN 52170
52130 WRITE :2,V$(K9)
52140 K9=K9-1
52150 IF K9>0 THEN 52100
52160 GOTO 52260
52170 WRITE :2,V$
52180 K2=K2-1
52190 IF K2>0 THEN 52080
52200 SET :2,K3
52210 WRITE :2,V$(K9)
52220 K9=K9-1
52230 IF K9=0 THEN 52260
52240 K3=K3-1
52250 GOTO 52200
52260 IF F(9)=1 THEN 52280
52270 PRINT"MERGED"
52280 RETURN
81000 'CODE TO VERIFY VAL(T$),F(5)=-1 FOR ERROR
81010 IF LEN(T$)=0 THEN 81090
81030 FOR V=1 TO LEN(T$)
81040 IF INSTR("0"+D$,MID$(T$,V,1))>0 THEN 81070
81060 GOTO 81090
81070 NEXT V
81075 F(5)=VAL(T$)
81080 GOTO 81100
81090 F(5)=-1
81100 RETURN
90000 DATA 7
90010 DATA "STUDENT",NAME,8
90020 DATA "INITIAL",TEXT,3
90030 DATA "BIRTHDAY",DATE,0
90040 DATA "SOC-SE-NUMB",SSN,0
90050 DATA "BILL TO DATE",TOTAL,4.2
90060 DATA "COURSE",NUMBER,2.3
90070 DATA "AVERAGE",TOTAL,2.1
99999 END
*U*: *