PDP-10 Archive: decus/20-0134/xreseq.fcl from decus_20tap4

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0134/xreseq.fcl
There is 1 other file named xreseq.fcl in the archive. Click here to see a list.
ERASE ALL,
C-FOCAL	v5D(315)-1	2019	18-Sep-75

01.01	C PROGRAM TO RE-SEQUENCE A FOCAL PROGRAM.
01.02	10.01
01.03	11.01
01.04	12.01
01.05	13.01
01.06	14.01
01.07	15.01
01.08	16.01
01.09	17.01
01.10	X FOCAL(1,1),FOCAL(2,2)
01.20	A!"NAME OF FOCAL PROGRAM TO RESEQUENCE:"I$
01.25	O O RS.TMP;T I$;O O TTY:;O I RS.TMP
01.30	S I$="",CNT=6,FLAG=0
01.40	S C=FCHR(-1);I(C-46)1.7,1.6;I(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(122-C)1.2
01.50	I CNT 1.4;S CNT=CNT-1,I$=I$+FCHR$(C);G 1.4
01.60	I FLAG 1.2;S CNT=4,FLAG=-1;G 1.5;C HERE IF EXTENSION SPECIFIED
01.70	I FLAG 1.8;S I$=I$+".FCL";C HERE IF NO EXTENSION SPECIFIED
01.80	O I TTY:
01.90	COLLECT ALL OLD LINE NUMBERS IN ARRAY A(N), N=1,FLN
01.95	O O RS.TMP;T"L S RS.TMP;E,A;L C "I$";E;S X=(2^36+FOCAL(97))/2^18,X=(X-FITR(X))*2^18,FLN=0"!"99.98	S X=X+1;I FOCAL(X)99.99,99.98;S FLN=FLN+1,T=FITR(FOCAL(X)/2^18)/2^7,A(FLN)=100*FITR(T)+128*(T-FITR(T));G 99.98"!"99.99	R"!"D 99.98;E A;L S RS1.TMP;L C RS.TMP;L C RS1.TMP;L D RS1.TMP"!;O O TTY:
01.99	L C RS.TMP

02.10	A"SELECT THE PORTION TO BE RE-SEQUENCED:"!"1.  THE WHOLE PROGRAM."!"2.  ONE GROUP."!"3.  A RANGE OF LINES."!":"J
02.11	I J-1 2.1,2.12;I J-2 2.1,2.5;I J-3 2.1,2.6,2.1
02.12	S L=A(1)/100,LO=1.01,U=A(FLN)/100;T!"THERE ARE"%4,FLN-2" LINES IN THE PROGRAM"!
02.20	A"DO YOU WANT TO PRESERVE THE PROGRAM IN A GROUP STRUCTURE? (YES OR NO)"J;I J-0NO 2.2,2.3;I J-0YES 2.2,2.4,2.2
02.30	T"WARNING: REFERENCES TO GROUPS WILL NOT BE CHANGED."!
02.31	A"WHAT STEP INTERVAL BETWEEN LINE NUMBERS? "S
02.32	S S=FITR(S*100+.5)/100;I S-.01 4.21;I 99*.99-FLN*S 4.21,4.21
02.33	G 2.8
02.40	D 2.31;S S=FITR(S*100+.5)/100,X=101;I S-.01 4.21;F J=1,FLN;D 2.45
02.41	I S,4.21,4.4
02.45	I FITR(A(J)/100)-FITR(X/100),2.46;S X=FITR(A(J)/100)*100+1;G 2.45
02.46	S B(A(J))=X/100,X=X+100*S;I FITR(A(J)/100)-FITR(X/100)2.47
02.47	S X=X-100*S+.01;I FITR(A(J)/100)-FITR(X/100+.5)2.48
02.48	S S=0,J=FLN+1;CAUSE PREMATURE EXIT AND ERROR MESSAGE.
02.50	T"WHAT GROUP NUMBER? :";A L;S U=FITR(L+.5)+.99
02.51	A"ENTER NEW GROUP NUMBER AND STEP SIZE: "LO,S
02.52	I-(LO-FITR(LO))^2 2.51;I LO-1 2.51;I 99-LO 2.51;I S-.01 2.51;I .98-S 2.51;I(L-LO)^2,2.53;S B(L*100)=LO;F J=1,FLN;I(A(J)-LO*100)^2 ,2.59
02.53	I LO 2.1;S LO=LO+.01
02.54	F J=1,FLN;I(FITR(A(J)/100)-L)^2,2.58
02.55	I S,4.21,4.4
02.57	S J=FLN,S=0
02.58	S B(A(J))=LO,LO=LO+S;I FITR(LO-S)-FITR(LO)2.57
02.59	S J=FLN,LO=-1;T!"THERE ARE ALREADY LINES IN THAT GROUP.  SUGGEST OPTION 3."!
02.60	A"ENTER THE NUMBERS OF THE FIRST AND LAST LINES OF THE RANGE: ",L,U;G 2.7
02.70	A"RANGE THESE ARE TO BECOME"!"[LOWEST,INTERVAL]"!LO,S
02.80	I 100-LO 2.7;I S-.01 2.7;I 1-LO 2.9;S LO=1.01
02.90	C

04.01	CHECK THAT RESEQUENCING IS POSSIBLE; MAKE RESEQUENCING MATRIX.
04.10	S K=0;F J=1,FLN;I(A(J)-L*100)*(U*100-A(J))4.3;S B(A(J))=LO+S*K,K=K+1;I FITR(B(A(J)))-B(A(J))4.3;S B(A(J))=B(A(J))+.01;I .015-S 4.3;S K=K+1
04.11	S E$=""
04.13	F J=1,FLN;I(A(J)-L*100)*(A(J)-U*100)4.3,4.3;I(A(J)-LO*100)*(LO*100+(K-1)*100*S-A(J))4.3;S E$=FCHR$(13)+FCHR$(10)+"%OVERLAP WILL OCCUR";I FITR((A(J)-LO*100)/S)-(A(J)-LO*100)/S 4.3;S E$="";T!"%OVERWRITING WILL OCCUR AT LINE"%4.02,A(J)/100" ..."!;S J=FLN
04.14	T E$!
04.20	I LO+K*S-100 4.4
04.21	T!"RE-SEQUENCING IS NOT POSSIBLE WITH THAT INCREMENT"!;G 2.1
04.30	R
04.40	C

05.01	C DO THE RESEQUENCING
05.02	O O RS.TMP;T"O I "I$"/4;O O RS.TMP/5";O O TTY:;L C RS.TMP;L D RS.TMP
05.10	S C0=0,C=0;D 10;C IS THE CURRENT CHARACTER JUST READ FROM THE INPUT FILE; C0 HAS BEEN PROCESSED BUT NOT YET WRITTEN TO THE OUTPUT FILE.
05.90	O I TTY:/4;O O TTY:/5;CLOSE OUTPUT FILE.
05.92	O O RS1.TMP;T"E,A;L C RS.TMP;L D RS1.TMP;L D RS.TMP;T!";X FCHR(34);T"THE RESEQUENCED FILE IS NOW IN CORE.	PLEASE SAVE IT.";X FCHR(34);T"!;Q"!;O O TTY:
05.94	L C RS1.TMP

10.01	C PROGRAM TRANSLATOR
10.02	COME HERE WITH CHARACTER IN C READY TO PROCESS
10.03	CHARACTER IN C0 READY TO WRITE TO THE OUTPUT FILE.
10.04	C - THIS ROUTINE PROCESSES A LINE AT A TIME TILL EOF THEN EXITS.
10.10	I C 10.9;D 11
10.15	C - WE OUGHT TO EXIT GROUP 11 WITH C CONTAINING A LINE FEED.   BEST CHECK THIS HOWEVER...
10.20	D 15;I(C0-10)^2,10.1;I-C0 10.2,10.2
10.90	R

11.01	C LINE TRANSLATOR
11.10	S Z=0,CH(-1)=C0,CH(0)=C
11.20	D 12;I C 11.9;I-(C-10)^2 11.2
11.90	R

12.01	C COMMAND TRANSLATOR
12.02	I(C-48)*(57-C)12.03;D 14;R
12.03	I-C 12.04,12.04;R
12.04	I-((C-10)*(C-13)*(C-59))^2 12.05;D 15;R
12.05	I 32-C 12.06;D 15;G 12.02
12.06	S X=C
12.07	D 15;I(C-47)*(C-58)*(C-64)*(C-91)*(C-96)*(C-123)12.07
12.08	I 32-C 12.09;D 15;I-C 12.08,12.08;R
12.09	I(X-96)*(123-X)12.1;S X=X-32
12.10	I (X-65)*(X-70)*(X-79)*(X-81)*(X-82)*(X-83)*(X-84)*(X-88) 12.11,12.40,12.11	;ASK FOR OPERATE QUIT RETURN SET TYPE XECUTE
12.11	I X-67 12.12,12.55,12.12	;COMMENT
12.12	I (X-68)*(X-69)*(X-77)*(X-87) 12.13,12.46,12.13	;DO;ERASE;MODIFY;WRITE
12.13	I X-71 12.16,12.75,12.16	;GO
12.16	I X-73 12.17,12.45,12.17	;IF
12.17	I X-76 12.18,12.50,12.18	;LIBRA
12.18	T/0!"%ILLEGAL COMMAND IN LINE BEGINNING..."!
12.19	F J=0,Z;X FCHR(CH(J))
12.20	T!/5;G 12.55
12.40	D 13;I C 12.9;I ((C-59)*(C-13)*(C-10))^2,12.9;I ((C-34)*(C-40))^2*(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(C-122)12.42,12.42;D 15;G 12.4
12.42	D 13;G 12.4
12.45	D 13
12.46	D 14;I-(C-44)^2 12.4;D 15;G 12.46
12.50	I(C-83)*(C-115)12.4,12.51,12.4;C - CONVERT ONLY LIBRA SAVE.
12.51	D 15;I(C-47)*(C-58)*(C-64)*(C-91)*(C-96)*(C-123)12.51
12.52	D 13;I-(C-58)^2 12.46;D 15;G 12.52
12.55	I C 12.99;I(C-10)^2,12.99;D 15;G 12.55
12.75	I FABS((C-84)*(C-116)),12.76;D 14;G 12.55
12.76	D 13,14;G 12.55
12.80	D 15;G 12.02
12.90	I-(C-59)^2 12.99;D 15
12.99	R

13.01	C EXPRESSION SKIPPER
13.02	I C-34 13.1,13.03,13.1
13.03	D 18;G 13.02
13.10	I C-40 13.2,13.11,13.2
13.11	D 17;G 13.5
13.20	I((C-46)*(C-36))^2*(C-48)*(C-57)*(C-65)*(C-90)*(C-97)*(C-122)13.21,13.21,13.4
13.21	D 15;G 13.2;COME TO THIS LINE TO FIND THE END OF ALPHANUMERIC/ALPHANUM$.
13.40	I C-40 13.5,13.11,13.5
13.50	I (C-45)*(C-43)*(C-42)*(C-47)13.9,13.51,13.9
13.51	D 15;G 13.02
13.90	R

14.01	C NUMBER TRANSLATOR
14.10	I C-58 14.2;D 13;R
14.20	I (C-59)*(C-10)*(C-13) 14.3,14.9
14.30	I 32-C 14.4;D 15;G 14.1
14.40	I 47-C 14.5;D 13;R
14.50	S J=0,NP=10,NPI=1,ZZ=Z-1
14.60	S NPI=NPI*10/NP,J=J*NP+(C-48)/NPI;D 16;I(C-46)^2,14.7;I(C-47)*(58-C)14.8,14.8,14.6
14.70	I NP-5 14.8;S NP=1,NPI=.1,C=48;G 14.6
14.80	S J=FITR(J*100+.5);I B(J),14.89;I((CH(ZZ)-32)*(CH(ZZ)-9))^2,14.81;X FCHR(CH(ZZ))
14.81	S C0=0;T%4.02,B(J);R
14.89	S C0=0;F J=ZZ,Z-1;X FCHR(CH(J))
14.90	R

15.01	CHARACTER PUTTER AND GETTER
15.10	X FCHR(C0);S C0=C,C=FCHR(-1),Z=Z+1,CH(Z)=C

16.01	CHARACTER GETTER WITH NO PUTTER.
16.20	S C0=C,C=FCHR(-1),Z=Z+1,CH(Z)=C

17.01	C - IF YOUR CURRENT CHARACTER IS LEFT PARENS (40), DO 17.
17.02	C - THIS GROUP WILL SKIP ALL THE CONTENTS INCLUDING THE ).
17.03	C - ON EXIT, C WILL CONTAIN THE CHARACTER TO RIGHT OF THE ).
17.10	S NP=0
17.20	D 15
17.25	I C 17.99;I C-13 17.2,17.99;I C-34 17.2,17.4;I C-40 17.2,17.5;I 41-C 17.2;S NP=NP-1;I-NP 17.2;D 15;G 17.99
17.40	D 18;G 17.25;COME TO THIS LINE IF " ENCOUNTERED.
17.50	S NP=NP+1;G 17.2;COME TO THIS LINE IF NESTED ().
17.99	R

18.01	C - IF YOUR CURRENT CHARACTER IS DOUBLE QUOTE (34), DO 18.
18.02	C - THIS GROUP WILL SKIP ALL THE CONTENTS INCL THE CLOSING ".
18.03	C - ON EXIT, C WILL CONTAIN THE CHAR TO RIGHT OF CLOSING ".
18.04	D 15;I 34-C 18.04,18.05;I 10-C 18.04,18.9,18.04
18.05	D 15
18.90	R
TYPE!!"BEWARE!	THIS PROGRAM IS PRETTY SLOW."!"IT RESEQUENCES ABOUT 50 LINES PER MINUTE OF CPU TIME."!