C ALGORITHM 607, COLLECTED ALGORITHMS FROM ACM. C ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.9, NO. 4, C DEC., 1983, P. 427-440. THIS ACM-CALGO ALGORITHM 607 CONTAINS 18 LOGICAL FILES. THESE 18 LOGICAL FILES ARE CONTAINED IN ONE PHYSICAL FILE CONSISTING OF RECORDS OF 80 8-BIT ASCII CHARACTERS, GROUPED INTO BLOCKS OF 36 RECORDS (2880 CHARACTERS). EACH LOGICAL FILE AFTER THE FIRST BEGINS WITH A RECORD CONSISTING OF THE STRING "=TES FILE=N" WHERE THE QUOTATION MARKS ARE NOT PART OF THE RECORD, AND N IS A DECIMAL NUMBER FROM 2 TO 18 INCLUSIVE. BY RECOGNIZING THIS RECORD, YOUR TEXT EDITOR, OR A TRIVIAL PROGRAM (NOT PROVIDED HERE) SHOULD BE ABLE TO EXTRACT THE DESIRED LOGICAL FILE FROM THE PHYSICAL FILE. IN ADDTION, A TAPE CONTAINING THE TES, IN THE FORMAT ACCEPTED AND PRODUCED BY THE TES, IS DISTRIBUTED WITH ALGORITHM 607. THIS TAPE HAS PHYSICAL BLOCK SIZES OF 180, 3600,...,3600 8-BIT CHARACTERS. THE RECORDING FORMAT OF THIS TAPE IS DESCRIBED MORE FULLY IN CHAPTER 2 OF THE DOCUMENT PROVIDED HERE AS LOGICAL FILE 18 OF THE ALGORITHM DESCRIPTION. BOTH TAPES (AS DISTRIBUTED) ARE UNLABELLED AND ARE RECORDED AT 1600 BPI. THE FILES CONTAIN: 1: THIS DESCRIPTION, PREPARED 830826. 2: IBM SYSTEM/370 VERSION OF TES 3: CDC 6600/7600 VERSION OF TES 4: UNIVAC 1100 VERSION OF TES 5: DEC VAX USING VMS VERSION OF TES 6: HELP FILE FOR DEC VAX USING VMS VERSION 7: DEC VAX USING UNIX VERSION OF TES, FORTRAN SUBPROGRAMS 8: DEC VAX USING UNIX VERSION OF TES, C PROGRAMS 9: DEC PDP10 USING TOPS 10 OR TOPS 20, FORTRAN SUBPROGRAMS 10: DEC PDP10 USING TOPS 10 OR TOPS 20, MACRO 10 SUBPROGRAMS 11: DEC PDP11 USING RSX11M/V1 VERSION OF TES, FORTRAN SUBPROGRAMS 12: DEC PDP11 USING RSX11M/V1 VERSION OF TES, MACRO11 SUBPROGRAMS 13: DEC PDP11 USING RSX11M/V1 TASK BUILD AND OVERLAY INSTRUCTIONS 14: DATA GENERAL MV/8000 VERSION OF TES 15: SPERRY UNIVAC V70 VERSION OF TES. 16: TEXT EXCHANGE SYSTEM USER'S GUIDE 17: TEXT EXCHANGE SYSTEM DESCRIPTION OF SYSTEM DEPENDENT VARIANTS 18: TEXT EXCHANGE SYSTEM PROGRAM DESCRIPTIONS THE LAST THREE OF THE ABOVE ARE PRINT FILES WITH FORTRAN STANDARD VERTICAL SPACING IN COLUMN 1. A PERIOD IS PRINTED IN COLUMN 2 ON TWO LINES NEAR THE TOP AND BOTTOM OF EACH PAGE. IF YOU PRINT AT 6 LINES PER INCH ON PAPER THAT IS 11 INCHES LONG, AND CUT THROUGH THESE PERIODS AND 8.5 INCHES TO THE RIGHT, THE PAGES WILL BE 8.5 X 11 INCHES AND THE TEXT WILL HAVE ADEQUATE MARGINS. IF YOU HAVE ANY PROBLEMS CALL VAN SNYDER AT 213/354-6271 OR DICK HANSON AT 505/844-1715. THE DEC PDP11 AND SPERRY UNIVAC V70 VERSIONS OF TES ARE NOT OF THE SAME QUALITY AS THE OTHER VERSIONS; THE AUTHORS NO LONGER HAVE ACCESS TO THESE MACHINES. USE THEM AT YOUR OWN RISK. THEY MAY REQUIRE SOME WORK TO BE USABLE. ANY VERSION OF THE TES FOR MACHINES NOT ON THE ABOVE LIST CAN BE SENT TO SNYDER. CALL SNYDER AT THE ABOVE NUMBER FOR MORE DETAILS. THE SPERRY UNIVAC V70 VORTEX OPERATING SYSTEM EXPECTS ASCII CHARACTERS TO HAVE THE HIGH-ORDER BIT SET. THE HIGH-ORDER BIT IS NOT SET IN FILE 15. AFTER UNBLOCKING FILE 15 WITH IOUTIL, RUN THE FOLLOWING PROGRAM ON THE OUTPUT TEXT: /JOB,HIGHBIT /MEM,6 /FORT,M,L,B C READ AN ASCII TAPE AND INSERT THE HIGH ORDER BIT IN C EVERY BYTE. DISCARD COMPLETELY BLANK RECORDS WHEN C WRITING THE OUTPUT TAPE. C ONE CARD IS READ USING FORMAT (2I5) TO DEFINE THE C INPUT AND OUTPUT TAPE UNIT NUMBERS. INTEGER BLANKS,BUF(40),INTAPE,OUTAPE,SIGNS DATA BLANKS /2H /, SIGNS /Z8080/ C READ (2,10) INTAPE,OUTAPE 10 FORMAT (2I5) 20 READ (INTAPE,30,END=50) BUF 30 FORMAT (40A2) J=0 DO 40 I = 1, 40 BUF(I)=BUF(I).OR.SIGNS 40 IF (BUF(I).NE.BLANKS) J=1 IF (J.NE.0) WRITE (OUTAPE,30) BUF GO TO 20 50 END FILE OUTAPE STOP END /EXEC 30 31 /FINI =TES FILE=2 C IBM 360/370 MAIN PROGRAM FOR TEXT EXCHANGE PROGRAMS. C C THE FOLLOWING STATEMENT ALLOCATES SPACE FOR TAPE INPUT. C INTEGER IBLOCK(1800) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE C NWCBI=45 READER=5 PRINTR=6 CALL EXCH (IBLOCK) STOP END BLOCK DATA C C BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/ DATA INTEXT /0/, INALT /0/ C DATA CHAR1L /1H1/ C A U T H DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1) /65,85,84,72/ C C O M M DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2) /67,79,77,77/ C C O P Y DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3) /67,79,80,89/ C D A T A DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4) /68,65,84,65/ C D A T E DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5) /68,65,84,69/ C G R O U DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6) /71,82,79,85/ C I N D E DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7) /73,78,68,69/ C I N P U DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8) /73,78,80,85/ C N A M E DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9) /78,65,77,69/ C I N T A DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/ C K E Y W DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/ C L I M I DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/ C M A C H DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/ C O P T I DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/ C O R I G DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/ C O U T A DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/ C O U T P DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/ C P R E D DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/ C P R I N DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/ C Q U I T DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/ C R E A D DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/ C R E F E DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/ C R E M O DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/ C R E W I DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/ C S I T E DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/ C S K I P DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/ C T E X T DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/ C T I T L DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/ C U P D A DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/ C W O R K DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/ C C O N T DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/ C I D E N DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/ C I N C L DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/ C S I G N DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/ C M A R G DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/ DATA IDSTEP /0/, IDTXTL /0/ DATA INDEX /0/ DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/ DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/ DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/ DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/ DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/ DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/ DATA INDEXS(25),INDEXS(26) /0,0 / DATA INTOPN /0/ DATA ITYPEI /0/ DATA LIMIT /0/ DATA MARGIN /180/ DATA NCCBI /180/ DATA NCCBO /180/ DATA NCHCMD /0/ DATA NCHMAX /180/ DATA NCOMDP /35/ DATA NCOMDT /35/ DATA NDATAO /3591/ DATA NERRCO /0/ DATA NERRG /0/ DATA NRWORK /0/ DATA OUTOPN /0/ DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/ DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/ DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/ DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/ DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/ DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/ DATA OPTVAL(25),OPTVAL(26) /0,0 / DATA PHASE /1/ C INDICATE THAT NO PREDICATES ARE DEFINED. DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/ DATA PRED(1,6),PRED(1,7),PRED(1,8) /0,0,0 / DATA SITE(1) /0/ DATA TITLE(1) /32/ C 32 = ASCII BLANK DATA TODAY (1) /0/ DATA TRANS /1/ C C TRANSLATION TABLE FROM ASCII TO HOLLERITH. USES ASCII GRAPHICS. C TRANSLATES CONTROL CHARACTERS (<32) TO '$'. C MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES. C DATA XLATE(1), XLATE(2), XLATE(3), XLATE(4) /1H$,1H$,1H$,1H$/ DATA XLATE(5), XLATE(6), XLATE(7), XLATE(8) /1H$,1H$,1H$,1H$/ DATA XLATE(9), XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/ DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/ DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/ DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/ DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/ DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/ DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/ DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/ DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/ DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H// DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/ DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/ DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/ DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/ DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/ DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/ DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/ DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/ DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/ DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/ DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/ DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/ DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/ DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/ DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/ DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/ DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/ DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/ DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/ DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/ END SUBROUTINE EXCH (IBLOCK) C C IBM 360/370 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM C INTEGER IBLOCK(1) C C ALLOCATE SPACE FOR TAPE OUTPUT C INTEGER OBLOCK(900) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C NWCBO=45 WORKF=8 MARGIN=72 CALL EXCHTR (IBLOCK,OBLOCK) RETURN END SUBROUTINE EXCHIM C C READ A COMMAND OR TEXT IMAGE FROM 1. ALTERNATE CORRECTION FILE, C 2. TEXT FILE, C 3. INPUT FILE, C 4. SYSTEM READER. C PUT THE HOLLERITH COMMAND IN HOLCMD, C PUT THE ASCII EQUIVALENT IN COMAND, C PUT THE NUMBER OF CHARACTERS IN NCHCMD. C IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1. C C THIS IS AN IBM 360/370 VERSION. IT READS 80 CHAR. IMAGES. C IT TRANSLATES IBM PRINTER GRAPHICS TO ASCII CODE. C C R. J. HANSON, SANDIA LABS., ALBUQUERQUE, NM., OCTOBER, 1979. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C TRANSLATE FROM IBM PRINTER GRAPHICS TO ASCII CODES. C USE IBM PRINTER GRAPHICS TO ASCII CODE TRANSFORMATION TABLE. C REF. IBM 360 ASSEMB. LANG. REFERENCE MANUAL, CODE CONVERSION TABLE C INTEGER PGASC(256),BLANK,CARD(45) C C FILL NONPRINTABLE CHARS. WITH THE ASCII CODE FOR DOLLAR SIGN C DATA PGASC /256*36/ C C BLANK . < ( DATA PGASC(065),PGASC(076),PGASC(077),PGASC(078)/32,46,60,40/ C + & $ * DATA PGASC(079),PGASC(081),PGASC(092),PGASC(093)/43,38,36,42/ C ) - / , DATA PGASC(094),PGASC(097),PGASC(098),PGASC(108)/41,45,47,44/ C % # @ ' DATA PGASC(109),PGASC(124),PGASC(125),PGASC(126)/37,35,64,39/ C = A B C DATA PGASC(127),PGASC(194),PGASC(195),PGASC(196)/61,65,66,67/ C D E F G DATA PGASC(197),PGASC(198),PGASC(199),PGASC(200)/68,69,70,71/ C H I J K DATA PGASC(201),PGASC(202),PGASC(210),PGASC(211)/72,73,74,75/ C L M N O DATA PGASC(212),PGASC(213),PGASC(214),PGASC(215)/76,77,78,79/ C P Q R S DATA PGASC(216),PGASC(217),PGASC(218),PGASC(227)/80,81,82,83/ C T U V W DATA PGASC(228),PGASC(229),PGASC(230),PGASC(231)/84,85,86,87/ C X Y Z 0 DATA PGASC(232),PGASC(233),PGASC(234),PGASC(241)/88,89,90,48/ C 1 2 3 4 DATA PGASC(242),PGASC(243),PGASC(244),PGASC(245)/49,50,51,52/ C 5 6 7 8 DATA PGASC(246),PGASC(247),PGASC(248),PGASC(249)/53,54,55,56/ C 9 DATA PGASC(250) /57/ C DATA BLANK /64/ C C DETERMINE WHICH FILE TO READ. IF (IABS(ACTION).EQ.1) GO TO 70 I=INALT IF (I.GT.0) GO TO 10 I=INTEXT IF (I.NE.0) GO TO 10 I=INFILE IF (I.EQ.0) I=READER 10 IF (ACTION.NE.2) GO TO 15 REWIND I GO TO 70 15 READ (I,20,END=80) (CARD(J),J=1,20) 20 FORMAT (20A4) C C RIGHT-ADJUST THE INPUT CHARACTERS. CALL EXCHUN(CARD,HOLCMD) C C SCAN THE CARD IMAGE FROM THE RIGHT. FIND LAST C NON-BLANK CHARACTER. DO 90 I=1,80 IF(HOLCMD(81-I).NE.BLANK) GO TO 100 90 CONTINUE NCHCMD=1 GO TO 40 100 NCHCMD=81-I 40 DO 60 I=1,NCHCMD COMAND(I)=PGASC(HOLCMD(I)+1) C CONVERT HOLCMD BACK TO HOLLERITH FOR 80A1 OUTPUT. 60 HOLCMD(I)=XLATE(COMAND(I)+1) 70 ACTION=0 RETURN 80 NCHCMD=-1 RETURN END SUBROUTINE EXCHPA(BUFIN,BUF9T) C CHARACTER PACKING ROUTINE FOR THE IBM 360, 370 SERIES MACHINES. C THE LOGICAL *1 DATA TYPE IS USED TO PACK THE CHARACTERS FROM C THE WORKING BUFFER BUFIN() TO BUF9T(). C WRITTEN BY R. J . HANSON, SANDIA LABS., NOVEMBER, 1979. LOGICAL *1 BUFIN(720),BUF9T(180) DO 10 I=1,180 10 BUF9T(I)=BUFIN(4*I) RETURN END SUBROUTINE EXCHRT (ISTAT,DBLOCK) C C IBM 360/370/3030. C C READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE. C INPUT: C ISTAT = 1 MEANS OPEN WITH NO REWIND. C ISTAT = 2 MEANS REWIND (CLOSE WITH REWIND). C ISTAT = 3 MEANS READ. C ISTAT = 4 MEANS CLOSE WITH NO REWIND. C C OUTPUT: C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR WAS DETECTED. C C DBLOCK IS THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). C INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C I=ISTAT ISTAT=0 GO TO (10,50,20,80), I C C OPEN WITH NO REWIND. THIS IS THE PLACE TO MODIFY THE DCB IF C YOUR JCL DOESN'T DO IT. C 10 CONTINUE GO TO 80 C C READ A BLOCK. ALLOW AN EOF IF WE ARE LOOKING FOR A LABEL. C 20 NCDBI=NERRCI+NDATAI+9 NWORDS=(NCDBI+3)/4 DO 30 I=1,2 READ (INTAPE,23,END=25,ERR=40) (DBLOCK(L),L=1,NWORDS) 23 FORMAT (10(255A4)) GO TO 80 25 IF (BLKSQI.NE.0) GO TO 40 30 CONTINUE 40 ISTAT=3 GO TO 80 C C REWIND C 50 REWIND INTAPE C 80 RETURN C END SUBROUTINE EXCHUN(BUF9T,BUFOUT) C CHARACTER UNPACKING ROUTINE FOR THE IBM 360, 370 SERIES MACHINES. C THE LOGICAL *1 DATA TYPE IS USED TO UNPACK THE CHARACTERS FROM C THE INPUT BLOCK BUF9T() TO THE OUTPUT BUFFER, BUFOUT(). C C WRITTEN BY R. J. HANSON, SANDIA LABS., NOVEMBER, 1979. LOGICAL *1 BUF9T(180),BUFOUT(720) LOGICAL *1 IZERO DATA IZERO/Z00/ DO 10 I=1,180 BUFOUT(4*I-3)=IZERO BUFOUT(4*I-2)=IZERO BUFOUT(4*I-1)=IZERO 10 BUFOUT(4*I)=BUF9T(I) RETURN END SUBROUTINE EXCHWT (ISTAT,DBLOCK) C C IBM 360/370/3030. C C WRITE A BLOCK ON THE EXCHANGE TAPE. C C INPUT: C ISTAT = 1 MEANS OPEN OUTPUT WITH NO REWIND C ISTAT = 2 MEANS WRITE C ISTAT = 3 MEANS WRITE END FILE AND CLOSE WITH NO REWIND. C C OUTPUT: C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ON C TAPE). INTEGER DBLOCK(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C I=ISTAT ISTAT=0 GO TO (10,20,40), I C C OPEN WITH NO REWIND. THIS IS THE PLACE TO MODIFY THE DCB IF C YOUR JCL DOESN'T DO IT. C 10 CONTINUE GO TO 50 C C WRITE A BLOCK. C 20 NWORDS=(NDATAO+NERRCO+9+3)/4 IF (BLKSQO.EQ.0) NWORDS=(CCDBO+3)/4 WRITE (OUTAPE,25) (DBLOCK(I),I=1,NWORDS) 25 FORMAT (10(255A4)) GO TO 50 C C WRITE END OF FILE MARK. C 40 END FILE OUTAPE C 50 RETURN C END SUBROUTINE EXCHAH (RECORD,NCHAR) C C CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO C HOLLERITH FORMAT. C THIS PROGRAM IS NOT MACHINE SENSITIVE. C C RECORD IS THE RECORD TO BE CONVERTED. THE HOLLERITH IS STORED C IN RECORD ALSO INTEGER RECORD(1) C C NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED C INTEGER XLATE(128) COMMON /EXCHXC/ XLATE C C DO 10 I=1,NCHAR J=RECORD(I) 10 RECORD(I)=XLATE(J+1) RETURN END SUBROUTINE EXCHFO (IOP) C C OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM. C IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS C OPEN FILE. IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3 C MEANS WORK FILE, = 4 MEANS INFILE. IOP = 4 IS USED ONLY BY THE C BOOTSTRAP PROGRAM. C INTEGER IOP C INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C RETURN C END SUBROUTINE EXCHOU (OUTPUT) C C NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM. C C OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN. C THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT. C C THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180), C THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179). IF OUTPUT(180) C IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE. IF OUTPUT(180) C IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW C IMAGE. C INTEGER OUTPUT(1) INTEGER WORK(180) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C C DECIDE WHETHER TO OPEN, CLOSE OR WRITE. C IF (IABS(ACTION).EQ.2) GO TO 50 C IABS(ACTION) = 2 MEANS START OR END OF PROGRAM. IF (ACTION) 40,10,50 C WRITE 10 DO 20 I=1,NCHOUT J=OUTPUT(I) 20 WORK(I)=XLATE(J+1) WRITE (OUFILE,30) (WORK(I),I=1,NCHOUT) 30 FORMAT (132A1) GO TO 50 C CLOSE 40 END FILE OUFILE C OPEN, RETURN 50 ACTION=0 RETURN END SUBROUTINE EXCHSL C C LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS. C C EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE C SEGMENT. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C RETURN END SUBROUTINE EXCHTR (IBLOCK,OBLOCK) C C TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER. C INTEGER IBLOCK(1), OBLOCK(1) C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4. C CALL EXCHFO (1) CALL EXCHFO (2) WORKF=-IABS(WORKF) C 10 IF (TRANS.LE.0) RETURN CALL EXCHSL C LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS. GO TO (11,12,13,14,15,16,17,18,19), TRANS C COMMAND PARSER 11 CALL EXCHC1 (IBLOCK,OBLOCK) GO TO 10 C IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE 12 CALL EXCHC2 GO TO 10 C OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE. 13 CALL EXCHC3 (IBLOCK,OBLOCK) GO TO 10 C COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE. 14 CALL EXCHC4 (IBLOCK) GO TO 10 C COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE. 15 CALL EXCHC5 (IBLOCK,OBLOCK) GO TO 10 C COPY TEXT FROM INTAPE TO OUTAPE 16 CALL EXCHC6 (IBLOCK,OBLOCK) GO TO 10 C TEXT COMMAND 17 CALL EXCHC7 (IBLOCK,OBLOCK) GO TO 10 C ERROR MESSAGES 18 CALL EXCHC8 GO TO 10 C QUIT 19 CALL EXCHC9 (IBLOCK,OBLOCK) GO TO 10 END SUBROUTINE EXCHGB (ISTAT,DBLOCK) C C READ A BLOCK FROM THE EXCHANGE TAPE. C IGNORE THE ERROR CONTROL SEGMENT. C CHECK THE BLOCK SEQUENCE NUMBER. C CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER, C OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C C C READ A BLOCK FROM INTAPE. C BLKSQI=BLKSQI+1 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 160 C C GET INFORMATION OUT OF THE BLOCK HEADER. C CCDBI=NERRCI CWDBI=NWCBI*(CCDBI/NCCBI)+1 CPCBI=MOD(CCDBI,NCCBI) CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) DO 110 JUMP=1,9 CCDBI=CCDBI+1 CPCBI=CPCBI+1 IF (CCDBI.GT.NCDBI) GO TO 130 IF (CPCBI.LE.NCCBI) GO TO 10 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 10 GO TO (20,30,40,50,60,70,80,90,100), JUMP 20 NEWBLK=256*CBLCKI(CPCBI) GO TO 110 30 NEWBLK=NEWBLK+CBLCKI(CPCBI) GO TO 110 40 LASTI=CBLCKI(CPCBI) GO TO 110 50 L1PRGI=256*CBLCKI(CPCBI) GO TO 110 60 L1PRGI=L1PRGI+CBLCKI(CPCBI) GO TO 110 70 N1RECI=256*CBLCKI(CPCBI) GO TO 110 80 N1RECI=N1RECI+CBLCKI(CPCBI) GO TO 110 90 L1RECI=256*CBLCKI(CPCBI) GO TO 110 100 L1RECI=L1RECI+CBLCKI(CPCBI) 110 CONTINUE C C CHECK THE BLOCK SEQUENCE NUMBER. C IF (BLKSQI.EQ.NEWBLK) GO TO 150 ISTAT=1 WRITE (PRINTR,120) NEWBLK,BLKSQI 120 FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I 15//) BLKSQI=NEWBLK GO TO 160 C C FORMAT ERROR C 130 ISTAT=2 GO TO 160 C C CHECK L1PRGI AND L1RECI. C 150 IF (L1PRGI.GT.NCDBI) GO TO 130 IF (L1RECI.GT.NCDBI) GO TO 130 ISTAT=0 160 RETURN C END SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD) C C GET A RECORD FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK). C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE C SPACE ALLOWED BY THE USER. (POSITION IS STILL OK). C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM C CONTROL RECORDS. NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS. C ISTAT=0 NCHACT=0 10 JUMP=1 GO TO 260 20 NG=CBLCKI(CPCBI) IF (NG.EQ.0) GO TO 90 IF (NG.NE.255) GO TO 30 C C END OF SHORT TAPE BLOCK. C CCDBI=NCDBI GO TO 10 C C UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO C THE USER RECORD AREA. C 30 ITYPEI=0 IF (MODEI.EQ.0) GO TO 40 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG 40 IG=0 50 JUMP=2 GO TO 260 60 NR=CBLCKI(CPCBI) IF (MODEI.EQ.0) GO TO 70 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR GO TO 160 70 IR=0 C PUT REMVI INTO THE USER RECORD NR TIMES. 80 IF (IR.GE.NR) GO TO 160 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI IR=IR+1 GO TO 80 C C THE NEXT RECORD IS A CONTROL RECORD. FIND OUT WHAT KIND. C 90 JUMP=3 GO TO 260 100 ITYPEI=CBLCKI(CPCBI) IF (ITYPEI.LT.65) GO TO 250 C 65 = ASCII A IF (ITYPEI.GT.90) GO TO 250 C 90 = ASCII Z I=ITYPEI-64 C A B C D E F G H I J K L M N O GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160 1,110,160,220,160,160,160,160,160,160,160,160), I C P Q R S T U V W X Y Z C C P - PROGRAM HEADER C C CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER 110 REMVI=32 C RESET THE REMOVED CHARACTER TO ASCII BLANK. JUMP=4 GO TO 260 120 L1PRGI=256*CBLCKI(CPCBI) JUMP=5 GO TO 260 130 L1PRGI=L1PRGI+CBLCKI(CPCBI) JUMP=6 GO TO 260 140 N1RECI=256*CBLCKI(CPCBI) JUMP=7 GO TO 260 150 N1RECI=N1RECI+CBLCKI(CPCBI) C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 160 JUMP=8 GO TO 260 170 NC=CBLCKI(CPCBI) IF (ITYPEI.NE.0) GO TO 180 IF (MODEI.EQ.0) GO TO 180 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC C COPY NC CHARACTERS TO THE USER RECORD AREA. 180 IC=0 JUMP=9 190 IF (IC.GE.NC) IF (ITYPEI) 240,210,240 GO TO 260 200 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI) IC=IC+1 GO TO 190 210 IG=IG+1 IF (IG-NG) 50,240,240 C C J - UPDATING AND END OF INPUT TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 220 JUMP=10 GO TO 260 230 RECORD(1)=CBLCKI(CPCBI) NCHACT=1 IF (ITYPEI.EQ.82) REMVI=RECORD(1) C 82 = ASCII R C C RETURN TO THE USER PROGRAM. C 240 IF (NCHACT.GT.NCHMAX) ISTAT=4 GO TO 290 C C CONTROL RECORD TYPE CANNOT BE DETERMINED. C 250 ISTAT=5 GO TO 290 C C GET A CHARACTER FROM CBLOCK. UNPACK A NEW BLOCK IF NECESSARY. C READ MORE TAPE IF NECESSARY. C 260 CPCBI=CPCBI+1 CCDBI=CCDBI+1 IF (CCDBI.LE.NCDBI) GO TO 270 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 290,260,290 270 IF (CPCBI.LE.NCCBI) GO TO 280 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 280 GO TO (20,60,100,120,130,140,150,170,200,230), JUMP 290 RETURN C END SUBROUTINE EXCHNP (ISTAT,DBLOCK) C C SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE C TAPE. C THIS MODULE IS MACHINE INSENSITIVE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) ISTAT=0 IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20 C C CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK. C 10 IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20 C 76 = ASCII L C C NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK. CCDBI=L1PRGI-1 I=NWCBI*(CCDBI/NCCBI)+1 IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI) CWDBI=I CPCBI=MOD(CCDBI,NCCBI) GO TO 40 C C NO MORE HEADERS IN THIS BLOCK. C 20 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 40,10,40 C C END OF FILE. C 30 ISTAT=7 C 40 RETURN C END SUBROUTINE EXCHPB (ISTAT,DBLOCK) C C WRITE A BLOCK ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK. INTEGER WORK(9) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C C PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK. C BLKSQO=BLKSQO+1 WORK(1)=BLKSQO/256 WORK(2)=MOD(BLKSQO,256) WORK(3)=LASTO WORK(4)=L1PRGO/256 WORK(5)=MOD(L1PRGO,256) WORK(6)=N1RECO/256 WORK(7)=MOD(N1RECO,256) WORK(8)=L1RECO/256 WORK(9)=MOD(L1RECO,256) C CPCBO=MOD(NERRCO,NCCBO) CWDBO=(NERRCO/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) C DO 10 I=1,9 CPCBO=CPCBO+1 IF (CPCBO.LE.NCCBO) GO TO 10 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) CWDBO=CWDBO+NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) CPCBO=1 10 CBLCKO(CPCBO)=WORK(I) CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) C C WRITE THE DATA BLOCK ON TAPE. C ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L). C IF (LASTO.NE.76) GO TO 20 ISTAT=3 CALL EXCHWT (ISTAT,DBLOCK) GO TO 30 C C COMPUTE POINTERS FOR NEXT BLOCK OUT. C 20 L1PRGO=0 LLPRGO=0 N1RECO=0 L1RECO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 C 30 RETURN C END SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD) C C WRITE A RECORD ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A C TEXT RECORD CONTAINS MORE THAN 254 GROUPS. C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER GC,RC(255),CC(255) C GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C ISTAT=0 INCHAR=0 C C DETERMINE THE RECORD TYPE. C IF (NCHOUT.NE.255) GO TO 10 ITYPEO=255 GO TO 70 10 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO IF (ITYPEO.NE.0) GO TO 30 C C DATA RECORD. C IF (MODEO.NE.0) GO TO 170 C COMPRESS THE RECORD. CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255) IF (GC.GE.255) GO TO 210 IG=0 C OUTPUT THE GROUP COUNT. CBLCKO(CPCBO)=GC JUMP=1 GO TO 230 20 IG=IG+1 IF (IG.GT.GC) GO TO 250 NC=CC(IG) INCHAR=INCHAR+RC(IG) C OUTPUT REMOVED CHARACTER COUNT. CBLCKO(CPCBO)=RC(IG) JUMP=2 GO TO 230 C C THE USER SAYS HE HAS A CONTROL RECORD TO WRITE. FIND OUT C WHAT KIND. C 30 IF (ITYPEO.LT.65) GO TO 220 C 65 = ASCII A IF (ITYPEO.GT.90) GO TO 220 C 90 = ASCII Z I=ITYPEO-64 C A B C D E F G H I J K L M N O P Q R S GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40, 140,40,40,40,40,40,40), I C T U V W X Y Z C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE TYPE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 40 IF (NCHOUT-255) 100,100,210 C C END OF FILE. C 50 IF (NERRCO+NDATAO+7-CCDBO) 70,80,80 C C P - PROGRAM HEADER. C 60 IF (NCHOUT.GT.255) GO TO 210 REMVO=32 C RESET REMOVED CHARACTER TO ASCII BLANK. IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80 IF (CCDBO.EQ.NERRCO+10) GO TO 80 C C END OF SHORT TAPE BLOCK. C 70 CBLCKO(CPCBO)=255 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250 C 69 = ASCII E C 80 = ASCII P L1RECO=CCDBO-NERRCO 80 IF (LLPRGO.EQ.0) GO TO 90 C LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK. CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) NC=MOD(LLPRGO+1,NCCBO) NW=((LLPRGO+1)/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) CBLCKO(NC+1)=CCDBO/256 IF (NC+1.LT.NCCBO) GO TO 85 CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) NW=NW+NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) NC=-1 85 CBLCKO(NC+2)=MOD(CCDBO,256) CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) CALL EXCHUN (DBLOCK(CWDBO),CBLCKO) C UPDATE TABLE OF CONTENTS POINTERS 90 LLPRGO=CCDBO IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO NLRECO=NLRECO+1 IF (N1RECO.EQ.0) N1RECO=NLRECO 100 CBLCKO(CPCBO)=0 JUMP=3 GO TO 230 110 CBLCKO(CPCBO)=ITYPEO JUMP=4 GO TO 230 120 IF (ITYPEO.NE.69) GO TO 130 C 69 = ASCII E LASTO=76 GO TO 70 130 IF (ITYPEO.NE.80) GO TO 170 C 80 = ASCII P CBLCKO(CPCBO)=0 JUMP=5 GO TO 230 140 CBLCKO(CPCBO)=0 JUMP=6 GO TO 230 150 CBLCKO(CPCBO)=NLRECO/256 JUMP=7 GO TO 230 160 CBLCKO(CPCBO)=MOD(NLRECO,256) JUMP=8 GO TO 230 C 170 NC=NCHOUT 180 CBLCKO(CPCBO)=NC IC=0 JUMP=9 C PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD. IF (ITYPEO.EQ.82) GO TO 190 IF (ITYPEO.EQ.74) GO TO 190 IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230 190 IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250 INCHAR=INCHAR+1 IC=IC+1 CBLCKO(CPCBO)=RECORD(INCHAR) GO TO 230 C C J - UPDATING AND END OF TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 200 NCHOUT=1 IF (ITYPEO.EQ.82) REMVO=RECORD(1) C 82 = ASCII R GO TO 100 C C RECORD TOO LONG. C 210 ISTAT=4 GO TO 250 C C UNKNOWN CONTROL RECORD TYPE. C 220 ISTAT=5 GO TO 250 C C INCREMENT THE OUTPUT BUFFER POINTERS. PACK A CHARACTER BLOCK C IF NECESSARY. WRITE A TAPE BLOCK IF NECESSARY. C 230 CPCBO=CPCBO+1 CCDBO=CCDBO+1 IF (CPCBO.LE.NCCBO) GO TO 240 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CWDBO=CWDBO+NWCBO CPCBO=1 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240 CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 250 240 GO TO (20,180,110,120,140,150,160,170,190), JUMP 250 RETURN C END SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL) C C SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE C DATA TO BE REMOVED. DIVIDE DATA INTO GROUPS CONSISTING OF C STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT C DATA. THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE C REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP C ARE RECORDED IN RC() AND SC() RESPECTIVELY. MAXSL IS THE C MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC(). C INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL C C RC AND SC MUST BE AT LEAST (IMGLEN-1)//3. C GC=1 SC(1)=0 RC(1)=0 MODE=-1 INPLEN=IABS(IMGLEN) C C IDENTIFY DATA GROUPS. C DO 110 I=1,INPLEN IF (MODE) 40,60,90 C C MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE. C 40 IF (INPIMG(I).EQ.REMOVE) GO TO 50 C SWITCH TO SIGNIFICANT DATA SCAN. MODE=1 SC(GC)=1 GO TO 110 C CONTINUE REMOVE SCAN 50 RC(GC)=RC(GC)+1 IF (RC(GC)-MAXSL) 110,95,110 C C MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY C ONE OCCURRENCE OF REMOVE. CHANGE TO REMOVE MODE IF ANOTHER REMOVE C OCCURS OR BACK TO DATA MODE IF NOT. C 60 IF (INPIMG(I).EQ.REMOVE) GO TO 80 C SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT. MODE=1 IF (SC(GC).GE.MAXSL-2) GO TO 70 SC(GC)=SC(GC)+2 GO TO 110 C FULL GROUP 70 GC=GC+1 RC(GC)=1 SC(GC)=1 GO TO 110 C SWITCH TO REMOVE MODE. 80 GC=GC+1 SC(GC)=0 RC(GC)=2 MODE=-1 GO TO 110 C C MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA. C 90 IF (INPIMG(I).EQ.REMOVE) GO TO 100 SC(GC)=SC(GC)+1 IF (SC(GC).NE.MAXSL) GO TO 110 C FULL GROUP MODE=-1 95 IF (I.GE.INPLEN) GO TO 120 GC=GC+1 RC(GC)=0 SC(GC)=0 GO TO 110 100 MODE=0 110 CONTINUE 120 RETURN C END SUBROUTINE EXCHTP (RECORD,LINEI) C C MATERIALIZE INCLUDES IF INALT IS NON-ZERO. C CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE C AND THE PRINTER IF LISTING IS REQUESTED. C LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C INTEGER RECORD(1),LINEI C C ***** LOCAL VARIABLES ************************************ C C COPY DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR C SKIPPING TEXT NOT TO BE INCLUDED. INTEGER COPY C DASH CONTAINS '-' IN HOLLERITH. INTEGER DASH C ENDMRK HOLDS THE END SENTINEL. INTEGER ENDMRK(40) C NCHEND IS THE NUMBER OF CHARACTERS IN ENDMRK. INTEGER NCHEND C NCHSAV SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD. INTEGER NCHSAV C NCHTAR IS THE NUMBER OF CHARACTERS IN TARGET. INTEGER NCHTAR C STAR CONTAINS '*' IN HOLLERITH. INTEGER STAR C TARGET IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY). INTEGER TARGET(40) C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL DATA *************************************** C DATA DASH /1H-/, STAR /1H*/ C C ***** PROCEDURES ***************************************** C LINEO=LINEO+1 IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190 RECORD(180)=LINEO RECORD(179)=LINEI COPY=-1 C COPY=-1 MEANS NOT COPYING INCLUDED TEXT. IF (ITYPEO.EQ.0) GO TO 110 C PROCESS INCLUDE RECORD. DO 10 I=1,NCHOUT 10 RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I) C INSERT '-I '. RECORD(1)=45 RECORD(2)=73 RECORD(3)=32 NCHOUT=NCHOUT+3 IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110 C STORE SEARCH TARGET NCHTAR=MIN0(NCHOUT,40) DO 20 I=1,NCHTAR 20 TARGET(I)=RECORD(I) C STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). NCHSAV=NCHCMD DO 30 I=1,NUMBER 30 OUTREC(I)=COMAND(I) COPY=0 C COPY=0 MEANS SKIPPING MODULE ON INALT FILE. INALT=IABS(INALT) NEOF=0 40 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 IF (NCHCMD.LT.2) GO TO 40 IF (COMAND(1).NE.45) GO TO 40 C 45 = ASCII - IF (COMAND(2).EQ.45) GO TO 130 IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40 C 73 = ASCII I, 105 = ASCII LOWER CASE I. C COMPARE IMAGE WITH SEARCH TARGET. IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60 DO 50 I=2,NCHTAR K=COMAND(I) IF (K.GT.96 .AND. K.LT.123) K=K-32 IF (TARGET(I).NE.K) GO TO 60 50 CONTINUE NEOF=3 C PREVENT SEARCH LOOP. COPY=1 C COPY=1 MEANS COPYING INCLUDED TEXT. 60 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C STORE END OF INCLUDE MODULE SIGNAL. NCHEND=MIN0(40,NCHCMD) DO 70 I=1,NCHEND 70 ENDMRK(I)=COMAND(I) IF (COPY.EQ.0) GO TO 80 CHAR1L=DASH NCHOUT=NCHTAR DO 75 I = 1,NCHOUT 75 COMAND(I)=TARGET(I) COMAND(180)=LINEO COMAND(179)=LINEI C GO PRINT TARGET. CALL EXCHTW (COMAND,-1) GO TO 120 C COPY OR SKIP UNTIL ENDMRK SEEN AGAIN. 80 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF. C TEST FOR ENDMRK DO 90 I=1,NCHEND IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100 90 CONTINUE IF (COPY) 140,40,140 C OUTPUT TEXT RECORD. 100 COMAND(180)=LINEO COMAND(179)=LINEI NCHOUT=NCHCMD CALL EXCHTW (COMAND,OPTI) GO TO 120 C OUTPUT TEXT RECORD. 110 CALL EXCHTW (RECORD,1) 120 IF (COPY) 190,190,80 C WE ONLY GET HERE WITH COPY .GE. 0. 130 NEOF=NEOF+1 ACTION=2 C ACTION = 2 MEANS REOPEN INALT. CALL EXCHIM IF (NEOF.LT.2) GO TO 40 140 INALT=-IABS(INALT) NCHCMD=1 IF (COPY.GT.0) GO TO 170 C PROCESS TARGET AS THOUGH IT WERE TEXT. NCHOUT=NCHTAR C SAVE TARGET FOR ERROR MESSAGE. DO 150 I=1,NCHTAR 150 COMAND(I)=TARGET(I) CALL EXCHTW (COMAND,1) CALL EXCHAH (TARGET,NCHTAR) WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR) 160 FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8 10A1)) NERRS=MAX0(NERRS,3) C C RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). C 170 NCHCMD=NCHSAV DO 180 I=1,NUMBER 180 COMAND(I)=OUTREC(I) C 190 CHAR1L=STAR RETURN C END SUBROUTINE EXCHTW (RECORD,OPTION) C C WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING C EXCHOU. WRITE RECORD ON THE PRINTER IF LISTING REQUESTED. C RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C IF OPTION = ZERO, WRITE TO FILE ONLY. C IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING. C IF OPTION .LT. ZERO, WRITE TO LISTING ONLY. C INTEGER RECORD(1),OPTION C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** PROCEDURES ***************************************** C LINEI=RECORD(179) IF (OPTION.LT.0) GO TO 130 C C INSERT IDENTIFICATION IF REQUESTED. C IF (IDCOL2.LT.IDCOL1) GO TO 120 IF (IDTXTL+IDSTEP.EQ.0) GO TO 120 IF (NCHOUT.GE.IDCOL2) GO TO 20 J=IDCOL2-1 C FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2 DO 10 I=NCHOUT,J 10 RECORD(I+1)=32 C 32 = ASCII BLANK. 20 NCHOUT=MAX0(NCHOUT,IDCOL2) N=-1 IF (LINEI.EQ.0) GO TO 40 IF (IDOPTN.NE.73) GO TO 40 C 73 = ASCII I. IDENTIFY ONLY FROM INTAPE. N=(LINEI-1)*IDSTEP+IDSTRT GO TO 70 40 IF (IDOPTN.NE.79) GO TO 50 C 79 = ASCII O. IDENTIFY ONLY TO OUTAPE. N=(LINEO-1)*IDSTEP+IDSTRT GO TO 70 50 IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70 C 67 = ASCII C, 70 = ASCII F. IDENTIFY EVERYTHING. N=IDCUR 70 IF (N.LT.0) GO TO 120 IF (IDTXTL.EQ.0) GO TO 100 J=MIN0(IDCOL2,IDTXTL+IDCOL1-1) K=1 DO 80 I=IDCOL1,J RECORD(I)=IDTEXT(K) 80 K=K+1 100 IF (IDSTEP.EQ.0) GO TO 120 IDCUR=IDCUR+IDSTEP K=IDCOL2 110 RECORD(K)=MOD(N,10)+48 N=N/10 K=K-1 IF (N.EQ.0) GO TO 120 IF (K.GE.IDCOL1) GO TO 110 C C OUTPUT RECORD. C 120 IF (OUFILE.NE.0) CALL EXCHOU (RECORD) IF (OPTION.EQ.0) GO TO 220 130 IF (OPTL.NE.0) GO TO 140 IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220 140 CALL EXCHAH (RECORD,NCHOUT) IF (OPTV+VERT.NE.0) GO TO 200 IF (PHASE.NE.8) GO TO 180 IF (LINEI.EQ.0) GO TO 160 WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 150 FORMAT (1X,2I5,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 160 WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 170 FORMAT (5H NEW,I6,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 180 WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 190 FORMAT (1X,I5,A1,3X,110A1/(6H CONT,4X,110A1)) GO TO 220 200 WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT) 210 FORMAT (132A1) 220 RETURN C END SUBROUTINE EXCHC1 (IBLOCK,OBLOCK) C C COMMAND DECODER AND FORMAT VERIFIER. SOME COMMANDS ARE ALSO C COMPLETELY PROCESSED HERE. C C IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS. C INTEGER IBLOCK(1),OBLOCK(1) C C C ***** LOCAL VARIABLES ************************************ C C ALLOW TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED. VALUES ARE C SUMS OF PERMITTED VALUES OF PHASE. C 1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING, C 8 = UPDATING. C ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A C PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR C MAY BE VOID (EQUAL SIGN IS LAST CHARACTER). C 32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT. INTEGER ALLOW(35) C BLANK A CONSTANT. 1H . INTEGER BLANK C DATE IS THE DATE FROM UPDA=, DATE=, ORIG=. INTEGER DATE(3) C DAYS TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS. INTEGER DAYS(12) C I IS USED FREELY AS AN INDEX. C J IS USED FREELY AS AN INDEX. C JUMP USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE. C K IS USED FREELY AS AN INDEX. C KDATE IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD). C KQUIT IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD). C KTEXT IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD). C N IS USED FREELY AS AN INDEX. C NCNREC IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS. C ND IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER. C NM IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER. C NY IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER. C TVAL A VECTOR OF VALUES FOR TRANS. INDEXED BY ICOMD. INTEGER TVAL(35) C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL EQUIVALENCE ********************************** C EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND) C C ***** DATA STATEMENTS ************************************ C DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/ DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/ DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/ DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/ DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/ DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/ DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/ DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/ DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/ DATA BLANK /1H / DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/ DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/ DATA DAYS(11),DAYS(12) /30,31/ DATA KDATE /5/ DATA KQUIT /20/ DATA KTEXT /27/ DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/ DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/ DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/ DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/ DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/ DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/ DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/ C C ***** PROCEDURES ***************************************** C C GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER. C ECHO IT IF THE E OPTION IS SET. DETERMINE WHETHER IT IS A CHANGE C TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND. C 10 NCNREC=0 20 ACTION=0 IF (NCHCMD.LT.0) GO TO 220 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (OPTE.EQ.0) GO TO 27 WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD) 23 FORMAT (1X,80A1) CHAR1L=0 27 NCHCMD=MIN0(NCHCMD,MARGIN) IF (PHASE.LT.4) SIGNAL=45 C 45 = ASCII - IF (COMAND(1).NE.45) GO TO 50 C 45 = ASCII -. REQUEST TO CHANGE CONTROL RECORD. IF (PHASE.LT.4) GO TO 40 WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD) 30 FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT 1OR UPDATE/1X,80A1) NERRG=MAX0(NERRG,2) GO TO 200 40 ICOMD=0 EQUAL=2 TRANS=3 GO TO 370 50 IF (COMAND(1).NE.42) GO TO 70 C 42 = ASCII *. COMMENT RECORD. JUST ECHO IT. NCHCMD=MAX0(NCHCMD,2) WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD) 60 FORMAT (A1,1H*,78A1/(1X,80A1)) GO TO 10 C C SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR C EQUAL SIGN ARE FOUND. LOOK UP THE WORD IN THE COMMAND NAME TABLE. C 70 EQUAL=0 DO 80 I=1,NCHCMD IF (COMAND(I).EQ.32) GO TO 80 C 32 = ASCII BLANK EQUAL=EQUAL+1 ICOMD=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32 C ABOVE STATEMENT CONVERTS TO UPPER CASE. COMAND(I)=32 COMAND(EQUAL)=ICOMD IF (EQUAL.GE.4) GO TO 90 IF (ICOMD.EQ.61) GO TO 90 C 61 = ASCII =. IF (ICOMD.EQ.44) GO TO 90 C 44 = ASCII ,. 80 CONTINUE IF (EQUAL.EQ.0) GO TO 185 90 DO 110 ICOMD=1,NCOMDT DO 100 K=1,EQUAL IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110 100 CONTINUE IF (EQUAL.EQ.4) GO TO 130 IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130 C 32 = ASCII BLANK. 110 CONTINUE C C UNRECOGNIZED COMMAND. C 120 ICOMD=0 C C LOOK FOR AN EQUAL SIGN. SET THE VARIABLE NAMED EQUAL TO ZERO IF C THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK C CHARACTER FOLLOWING THE EQUAL SIGN. C 130 MODIFY=0 140 DO 150 I=EQUAL,NCHCMD K=COMAND(I) IF (K.EQ.61) GO TO 160 C 61 = ASCII =. IF (MODIFY.NE.0) GO TO 150 C USE FIRST MODIFIER. IF (K.EQ.44) GO TO 160 C 44 = ASCII ,. 150 CONTINUE EQUAL=0 GO TO 170 160 I=I+1 EQUAL=I IF (I.GT.NCHCMD) GO TO 170 IF (COMAND(I).EQ.32) GO TO 160 C 32 = ASCII BLANK IF (K.NE.44) GO TO 170 C 44 = ASCII ,. MODIFY=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32 C CONVERT TO UPPER CASE. GO TO 140 170 IF (K.NE.61) EQUAL=0 C 61 = ASCII =. IF (ICOMD.EQ.0) GO TO 180 IF (ICOMD.GT.NCOMDP) GO TO 180 IF (EQUAL.GT.NCHCMD) GO TO 175 IF (EQUAL.NE.0) GO TO 230 IF (ALLOW(ICOMD)/64.NE.0) GO TO 230 175 IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690 C PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK. NCHCMD=NCHCMD+1 EQUAL=NCHCMD COMAND(NCHCMD)=32 C 32 = ASCII BLANK HOLCMD(NCHCMD)=BLANK GO TO 230 C C GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX. C 180 CALL EXCHCX (0) C IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND. IF (ICOMD.NE.0) GO TO 730 185 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1)) NERRG=MAX0(NERRG,5) 200 CHAR1L=0 NCNREC=NCNREC+1 IF (NCNREC.LE.20) GO TO 20 WRITE (PRINTR,210) 210 FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU 1MES TEXT COMMAND IS MISSING.) GO TO 270 C C END OF FILE - SIMULATE A QUIT COMMAND. C 220 ICOMD=KQUIT C C RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME. C 230 IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240 TRANS=TVAL(ICOMD) C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300 1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7 230,370,730,370), ICOMD C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 C 32 33 34 35 C C THE COMMAND IS NOT ALLOWED AT THIS TIME. C 240 WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE 1D./1X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 C DECIDE WHETHER TO SKIP TEXT 260 IF (ICOMD.NE.KTEXT) GO TO 10 IF (EQUAL.NE.0) GO TO 10 270 WRITE (PRINTR,280) 280 FORMAT (//15H0SKIPPING TEXT.) 290 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (NCHCMD.LT.2) GO TO 290 IF (COMAND(1).NE.SIGNAL) GO TO 290 IF (COMAND(2).EQ.SIGNAL) GO TO 10 IF (NCHCMD.LT.3) GO TO 290 IF (COMAND(2).NE.61) GO TO 290 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 290 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING. C DATE=YYMMDD C ORIGIN=YYMMDD SITE C UPDATE=YYMMDD SITE C IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE C THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED. C 300 IF (EQUAL+5.GT.NCHCMD) GO TO 700 I=EQUAL DO 310 J=1,3 DATE(J)=0 DO 310 K=1,2 N=COMAND(I)-48 IF (N.LT.0) GO TO 320 IF (N.GT.9) GO TO 320 DATE(J)=10*DATE(J)+N 310 I=I+1 IF (NM.EQ.0) GO TO 320 IF (NM.GT.12) GO TO 320 IF (ND.LE.0) GO TO 320 DAYS(2)=28 IF (MOD(NY,4).EQ.0) DAYS(2)=29 IF (NY.EQ.0) DAYS(2)=28 IF (ND.LE.DAYS(NM)) GO TO 440 320 IF (ICOMD.EQ.KDATE) GO TO 700 IF (TODAY(1).EQ.32) GO TO 700 I=MIN0(NCHCMD+6,180) NCHCMD=I J=I-6 IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1 C 32 = ASCII BLANK IF (J.LT.EQUAL) GO TO 700 330 COMAND(I)=COMAND(J) HOLCMD(I)=HOLCMD(J) J=J-1 I=I-1 IF (J.GE.EQUAL) GO TO 330 DO 340 I=1,6 COMAND(I+EQUAL-1)=TODAY(I) 340 HOLCMD(I+EQUAL-1)=TODAY(I) CALL EXCHAH (HOLCMD(EQUAL),6) WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD) 345 FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1)) NERRG=MAX0(NERRG,1) GO TO 440 C C REWIND INTAPE C 350 IF (INTAPE.EQ.0) GO TO 680 IF (INTOPN.NE.0) GO TO 360 I=1 C OPEN INTAPE IF NOT ALREADY OPEN. DO NOT CHECK EXCH LABEL. CALL EXCHRT (I,IBLOCK) C IGNORE STATUS 360 I=2 CALL EXCHRT (I,IBLOCK) INTOPN=0 GO TO 725 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH C BEGINS WITH A NUMBER FOLLOWED BY A BLANK. C C INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA C INTAPE = NUMBER SYSTEM DEPENDENT DATA C LIMIT = NUMBER C MARGIN = NUMBER C OUTAPE = NUMBER SYSTEM DEPENDENT DATA C OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA C PRINTER = NUMBER C READER = NUMBER C SKIP = NUMBER C TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL) C WORK = NUMBER C 370 NUMBER=0 IF (EQUAL.EQ.0) GO TO 440 DO 410 J=EQUAL,NCHCMD IF (COMAND(J).EQ.32) GO TO 420 C 32 = ASCII BLANK N=COMAND(J)-48 C 48 = ASCII ZERO IF (N.GE.0) GO TO 400 380 WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD) 390 FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS. NOT PROCESSED./ 11X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 GO TO 260 400 IF (N.GT.9) GO TO 380 410 NUMBER=10*NUMBER+N EQUAL=NCHCMD+1 GO TO 440 420 EQUAL=J 430 EQUAL=EQUAL+1 IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440 C 32 = ASCII BLANK C C PRELIMINARY FORMAT CHECKING IS COMPLETE C 440 J=ICOMD+1 C 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6 120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595), 2J C 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 C C DATE=YYMMDD C 450 DO 460 I=1,6 460 TODAY(I)=COMAND(EQUAL+I-1) GO TO 10 C C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA. C 470 I=INFILE J=1 GO TO 500 C C INCLUDE = NUMBER SYSTEM DEPENDENT DATA. C 480 I=INALT J=3 INALT=IABS(INALT) GO TO 500 C C TEXT C 490 I=INTEXT J=2 IF (EQUAL.EQ.0) GO TO 560 C C OPEN AN INPUT FILE. C 500 IF (NUMBER.EQ.0) GO TO 505 IF (NUMBER.EQ.OUFILE) GO TO 710 IF (NUMBER.EQ.OUTAPE) GO TO 710 505 IF (J.EQ.2) GO TO 510 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (I.NE.0) CALL EXCHIM 510 IF (J-2) 520,530,540 520 INFILE=NUMBER GO TO 550 530 INTEXT=NUMBER GO TO 550 540 INALT=NUMBER 550 IF (NUMBER.EQ.0) GO TO 560 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND CALL EXCHCX (J+1) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHIM ACTION=2 C ACTION = 2 MEANS REWIND IF (J.EQ.3) CALL EXCHIM INALT=-IABS(INALT) 560 ACTION=0 C ACTION = 0 MEANS READ TEXT GO TO 730 C C INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 570 IF (INTOPN.EQ.0) GO TO 580 C CLOSE THE INPUT TAPE, IGNORE STATUS. I=4 CALL EXCHRT (I,IBLOCK) INTOPN=0 580 INTAPE=NUMBER C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (INTAPE.NE.0) CALL EXCHCX (6) GO TO 725 C C LIMIT = NUMBER C 590 LIMIT=NUMBER GO TO 10 C C MARGIN = NUMBER C C MINIMUM MARGIN IS 60 595 MARGIN=MAX0(NUMBER,60) GO TO 10 C C OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 600 IF (OUTOPN.EQ.0) GO TO 610 C WRITE AND END-OF-FILE MARK ON OUTAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (I,OBLOCK,OBLOCK) C IGNORE STATUS OUTOPN=0 PHASE=1 610 OUTAPE=NUMBER OUTUPD=MODIFY C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (OUTAPE.NE.0) CALL EXCHCX (7) GO TO 730 C C OUTPUT = NUMBER SYSTEM DEPENDENT INFORMATION C 620 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) OUFILE=NUMBER IDCUR=IDSTRT IF (OUFILE.EQ.0) GO TO 730 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND. CALL EXCHCX (5) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHOU (OUTREC) GO TO 730 C C PRINTER = NUMBER. C 630 CALL EXCHFO (-2) PRINTR=NUMBER CALL EXCHFO (2) GO TO 10 C C READER = NUMBER. C 640 IF (INFILE.NE.0) GO TO 670 CALL EXCHFO (-1) READER=NUMBER CALL EXCHCX (1) CALL EXCHFO (1) GO TO 10 C C WORK = NUMBER C 650 IF (WORKF.GT.0) CALL EXCHFO (-3) WORKF=NUMBER C WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4. GO TO 10 C C UPDATE C C DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR C SIMPLY TO OUTPUT THE UPDATE COMMAND. 660 IF (PHASE.GE.4) TRANS=5 GO TO 730 C C ERROR MESSAGES. C 670 NUMBER=3 C MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE. GO TO 720 680 NUMBER=4 C MESSAGE 4 - INTAPE IS NOT DEFINED. GO TO 720 690 NUMBER=12 C MESSAGE 12 - NO PARAMETER STRING. GO TO 720 700 NUMBER=13 C MESSAGE 13 - IMPROPER DATE. GO TO 720 710 NUMBER=31 C MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT. C C RETURN TO ERROR MESSAGE SEGMENT. C 720 TRANS=8 GO TO 740 c c Indicate the WORK file is empty. c 725 if (nrwork.le.0 .or. workf.le.0) go to 730 REWIND WORKF NRWORK=0 C C IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP. C 730 IF (TRANS.EQ.1) GO TO 10 740 RETURN C END SUBROUTINE EXCHCX (REASON) C C PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER C PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT, C INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS. C PORTABLE VERSION. C INTEGER REASON C C REASON=0 FOR UNRECOGNIZED COMMAND. C REASON=1 BEFORE OPENING READER. C REASON=2 BEFORE OPENING INFILE. C REASON=3 BEFORE OPENING INTEXT. C REASON=4 BEFORE OPENING INALT. C REASON=5 BEFORE OPENING OUFILE. C REASON=6 BEFORE OPENING INTAPE. C REASON=7 BEFORE OPENING OUTAPE. C RETURN C END SUBROUTINE EXCHC2 C C PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KINDE /32/ DATA KOPTI /14/ DATA KSITE /25/ C C FIGURE OUT WHICH COMMAND GOT US HERE. C IF (ICOMD-KOPTI) 60,150,10 10 IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270 C C ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT C WHERE C1, C2, STEP AND START ARE INTEGERS. C STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP, C START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF C CHARACTERS OF TEXT IN IDTXTL. IF AN ERROR OCCURS, C STORE ZERO IN IDSTEP AND IDTXTL. C IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO. C C STORE THE MODIFIER IN IDOPTN. C IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE C PRODUCED ONLY FOR IMAGES FROM INTAPE. IF THE O MODIFIER C IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES C WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT. IF THE F C MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION C OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE C PRODUCED FOR ALL IMAGES OUTPUT. IF THE C MODIFIER IS SPECIFIED, C SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH C RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR C ALL IMAGES OUTPUT. IF NONE OF THE I, F, OR C MODIFIERS ARE C SPECIFIED, THE O MODIFIER IS ASSUMED. C C IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED. C IF IDTXTL = ZERO, TEXT IS NOT EMITTED. C IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE C EMITTED. C C CONVERT C1,C2,STEP,START C IDOPTN=MODIFY IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79 C 70 = ASCII F, 73 = ASCII I, 79 = ASCII O. DO 40 J=1,4 NUMBER=0 20 IF (EQUAL.GT.NCHCMD) GO TO 40 IF (COMAND(EQUAL).EQ.44) GO TO 30 C 44 = ASCII , I=COMAND(EQUAL)-48 IF (I.LT.0) GO TO 350 IF (I.GT.9) GO TO 350 NUMBER=10*NUMBER+I EQUAL=EQUAL+1 GO TO 20 30 EQUAL=EQUAL+1 40 IDNBRS(J)=NUMBER IDCUR=IDSTRT IDCOL1=MAX0(1,MIN0(IDCOL1,178)) IDCOL2=MIN0(IDCOL2,178) C C STORE TEXT. C IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0) IF (IDTXTL.EQ.0) GO TO 330 DO 50 J=1,IDTXTL IDTEXT(J)=COMAND(EQUAL) 50 EQUAL=EQUAL+1 GO TO 330 C C INDEX = PARAMETER STRING C 60 J=0 IF (COMAND(EQUAL).NE.45) GO TO 70 C 45 = ASCII - J=-1 EQUAL=EQUAL+1 70 N=0 DO 80 I=1,26 80 INDEXS(I)=0 90 IF (EQUAL.GT.NCHCMD) GO TO 130 I=COMAND(EQUAL)-64 IF (I.EQ.-32) GO TO 120 C 32 = ASCII BLANK. IF (I.GE.32) I=I-32 C CONVERT TO UPPER CASE. IF (I.LE.0) GO TO 100 IF (I.LE.26) GO TO 110 100 N=EQUAL GO TO 120 110 INDEXS(I)=1 120 EQUAL=EQUAL+1 GO TO 90 130 INDEX=0 DO 140 I=1,26 INDEXS(I)=IABS(INDEXS(I)+J) 140 INDEX=INDEX+INDEXS(I) IF (MODIFY.EQ.76) INDEX=-INDEX C 76 = ASCII L. IF (N) 340,330,340 C C OPTION = PARAMETER STRING C 150 IF (MODIFY.NE.0) GO TO 170 DO 160 I=1,26 160 OPTVAL(I)=0 170 IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330 I=1 IF (MODIFY.EQ.67) I=0 C 67 = ASCII C. N=0 DO 190 J=EQUAL,NCHCMD K=COMAND(J) IF (K.GE.96) K=K-32 C CONVERT TO UPPER CASE. IF (K.EQ.32) GO TO 190 C 32 = ASCII BLANK IF (K.LT.65) GO TO 180 IF (K.GT.90) GO TO 180 C PROCESS ALPHABETIC OPTIONS. OPTVAL(K-64)=I GO TO 190 180 N=J 190 CONTINUE IF (N) 330,330,340 C C PROCESS PRED = ID REC A/X MASK STRING C WHERE ID = PREDICATE IDENTIFIER (A-H), C REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE, C A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH C IN EXACT POSITION, C MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE C TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED. C STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF C CONTROL RECORDS. C C THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR C PREDICATE A, ETC. C C PRED(1,*)=LENGTH OF STRING + 3 C PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED. C PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND). C PRED(3,*)=RECORD TYPE. C PRED(4,*)=A/X C PRED(5,*)=MASK CHARACTER. C PRED(6..42,*)=STRING. C 200 IF (EQUAL.NE.0) GO TO 240 C LIST ALL ACTIVE PREDICATES. DO 230 I=1,8 IF (PRED(1,I).EQ.0) GO TO 230 J=PRED(1,I)+1 COMAND(1)=I+64 DO 210 K=2,J 210 COMAND(K)=PRED(K+1,I) CALL EXCHAH (COMAND,J) WRITE (PRINTR,220) (COMAND(K),K=1,J) 220 FORMAT (6H PRED=,42A1) 230 CONTINUE GO TO 330 C SAVE PREDICATE IF VALID. 240 IF (NCHCMD.LE.EQUAL+3) GO TO 370 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.GT.72) GO TO 360 C 72 = ASCII H NUMBER=J-64 PRED(1,NUMBER)=0 EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.GT.90) GO TO 360 C 90 = ASCII Z IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.EQ.82) GO TO 360 C 82 = ASCII R PRED(3,NUMBER)=J EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.NE.65.AND.J.NE.88) GO TO 360 C 65 = ASCII A, 88 = ASCII X PRED(4,NUMBER)=J EQUAL=EQUAL+1 PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40) I=4 DO 250 J=EQUAL,NCHCMD I=I+1 IF (I.GT.42) GO TO 330 K=COMAND(J) IF (K.GT.96) K=K-32 C CONVERT TO UPPER CASE. 250 PRED(I,NUMBER)=K GO TO 330 C C SITE = SITE NAME C 260 JUMP=1 GO TO 280 C C TITLE = OUTPUT TAPE TITLE C 270 JUMP=2 280 K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 320 I=1,40 IF (K.GT.NCHCMD) GO TO 290 J=COMAND(K) K=K+1 GO TO 300 290 J=32 C 32 = ASCII BLANK. 300 IF (JUMP.EQ.2) GO TO 310 SITE(I)=J GO TO 320 310 TITLE(I)=J 320 CONTINUE C C RETURN TO COMMAND DECODER. C 330 TRANS=1 GO TO 390 C C ERROR MESSAGES C 340 NUMBER=14 C MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED. EQUAL=N GO TO 380 350 IDSTEP=0 IDTXTL=0 360 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED. GO TO 380 370 NUMBER=30 C MESSAGE 30 - COMMAND IS INCOMPLETE. C 380 TRANS=8 C 390 RETURN C END SUBROUTINE EXCHC3 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE C COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES. C C OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE C NAME COMMAND. C C OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING C COPY, NAME OR UPDATE COMMANDS. C C ID IS USED TO CONSTRUCT THE OUTPUT LABEL. INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/ C A N G E DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/ DATA KNAME /9/ DATA KSKIP /26/ C C OPEN INTAPE IF NECESSARY C IF (INTOPN.NE.0) GO TO 70 IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300 IF (INTAPE.EQ.OUTAPE) GO TO 360 CALL EXCHRH (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 310 INTOPN=1 C COPY THE LABEL TO A SAVE AREA. DO 10 I=1,180 10 LABELI(I)=CBLCKI(I) CALL EXCHAH (CBLCKI(13),138) WRITE (PRINTR,20) 20 FORMAT (25H0INPUT LABEL INFORMATION.) WRITE (PRINTR,30) (CBLCKI(I),I=13,104) 30 FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/ 1 20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1) IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150) 40 FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1) WRITE (PRINTR,50) NDATAI 50 FORMAT (28H DATA CHARACTERS PER BLOCK =,I6) IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI 60 FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6) CHAR1L=0 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 290 70 IF (ICOMD.EQ.KSKIP) GO TO 270 C C OPEN OUTAPE IF NECESSARY C 80 IF (ICOMD.EQ.0) GO TO 90 IF (ICOMD.LT.KNAME) GO TO 100 90 IF (INTAPE*OUTAPE.EQ.0) GO TO 100 IF (OUTUPD.NE.85) GO TO 370 C 85 = ASCII U. 100 IF (OUTOPN.NE.0) GO TO 240 IF (OUTAPE.EQ.0) GO TO 240 C CONSTRUCT THE OUTPUT LABEL. IF (TODAY(1).EQ.0) GO TO 340 IF (INTOPN.EQ.0) GO TO 160 DO 110 I=1,180 110 CBLCKO(I)=LABELI(I) IF (TITLE(1).EQ.32) GO TO 130 C 32 = ASCII BLANK DO 120 I=1,40 120 CBLCKO(I+18)=TITLE(I) 130 IF (OUTUPD.NE.85) GO TO 220 C 85 = ASCII U. IF (SITE(1).EQ.0) GO TO 350 DO 140 I=1,6 140 CBLCKO(I+104)=TODAY(I) DO 150 I=1,40 150 CBLCKO(I+110)=SITE(I) GO TO 220 160 IF (TITLE(1).EQ.32) GO TO 330 C 32 = ASCII BLANK IF (SITE(1).EQ.0) GO TO 350 IF (INTAPE*OUTAPE.EQ.0) GO TO 170 IF (INTAPE.EQ.OUTAPE) GO TO 360 170 DO 180 I=1,8 180 CBLCKO(I)=ID(I) DO 190 I=1,40 CBLCKO(I+18)=TITLE(I) 190 CBLCKO(I+64)=SITE(I) DO 200 I=1,6 200 CBLCKO(I+58)=TODAY(I) DO 210 I=105,180 210 CBLCKO(I)=0 220 CALL EXCHWH (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 320 OUTOPN=1 CBLCKO(1)=CBLCKO(105) CALL EXCHAH (CBLCKO(13),138) WRITE (PRINTR,230) WRITE (PRINTR,30) (CBLCKO(I),I=13,104) 230 FORMAT (26H0OUTPUT LABEL INFORMATION.) IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150) WRITE (PRINTR,50) NDATAO IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO CHAR1L=0 240 IF (ICOMD-KNAME) 250,260,280 C C COPY C 250 TRANS=4 MODEI=1-MIN0(1,OUFILE+OPTL) IF (ICOMD.EQ.0) MODEI=0 GO TO 390 C C NAME C 260 TRANS=5 IF (NRWORK.EQ.0) PHASE=4 GO TO 390 C C SKIP C 270 TRANS=4 GO TO 390 C C UPDATE C 280 TRANS=5 MODEI=0 GO TO 390 C C ERROR MESSAGES C 290 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. EQUAL=ISTAT GO TO 380 300 NUMBER=4 C MESSAGE 4 - INTAPE NOT DEFINED. GO TO 380 310 NUMBER=5 C MESSAGE 5 - UNABLE TO OPEN INTAPE. EQUAL=ISTAT GO TO 380 320 NUMBER=6 C MESSAGE 6 - UNABLE TO OPEN OUTAPE. EQUAL=ISTAT GO TO 380 330 NUMBER=7 C MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE. GO TO 380 340 NUMBER=8 C MESSAGE 8 - DATE NOT SUPPLIED. GO TO 380 350 NUMBER=9 C MESSAGE 9 - SITE NOT SUPPLIED. GO TO 380 360 NUMBER=10 C MESSAGE 10 - INTAPE = OUTAPE. GO TO 380 370 NUMBER=11 C MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED. 380 TRANS=8 C C RETURN TO TRANSITION PROGRAM C 390 RETURN C END SUBROUTINE EXCHRH (ISTAT,DBLOCK) C C READ THE HEADER LABEL FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE C NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C OPEN THE INPUT TAPE. C ISTAT=1 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C READ A BLOCK. C NDATAI=171 NERRCI=0 BLKSQI=0 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C FIND OUT IF IT IS A PROPER LABEL. C CALL EXCHUN (DBLOCK,CBLCKI) DO 10 I=1,8 IF (CBLCKI(I).NE.ID(I)) GO TO 20 10 CONTINUE C C GET READY TO READ THE REST OF THE TAPE. C CCDBI=NCDBI NDATAI=256*CBLCKI(9)+CBLCKI(10) NERRCI=256*CBLCKI(11)+CBLCKI(12) LASTI=0 L1PRGI=0 ISTAT=0 GO TO 30 C C NOT A LABEL. C 20 ISTAT=6 C C CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK. 25 I=4 CALL EXCHRT (I,DBLOCK) C 30 RETURN C END SUBROUTINE EXCHWH (ISTAT,DBLOCK) C C WRITE A HEADER ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE C WRITTEN ARE NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C MAKE SURE IT IS A PROPER LABEL. C DO 10 I=1,8 IF (CBLCKO(I).NE.ID(I)) GO TO 30 10 CONTINUE C C OPEN THE OUTPUT TAPE. C ISTAT=1 CALL EXCHWT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 40 C C CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR C CONTROL CHARACTERS C CBLCKO(9)=NDATAO/256 CBLCKO(10)=MOD(NDATAO,256) CBLCKO(11)=NERRCO/256 CBLCKO(12)=MOD(NERRCO,256) C C INSERT TODAYS DATE C DO 20 I=1,6 20 CBLCKO(I+12)=TODAY(I) C C WRITE THE BLOCK ON TAPE. C BLKSQO=0 CALL EXCHPA (CBLCKO,DBLOCK) CCDBO=180 ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C GET READY TO WRITE THE REST OF THE FILE. C L1PRGO=0 LLPRGO=0 N1RECO=0 NLRECO=0 L1RECO=0 LASTO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 GO TO 40 C C NOT A PROPER LABEL. C 30 ISTAT=6 C 40 RETURN C END SUBROUTINE EXCHC4 (IBLOCK) INTEGER IBLOCK(1) C C PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM C COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KCOPY /3/ C C ARE WE STARTING OR CONTINUING? C C ICOMD.EQ.0 MEANS CHANGE A CONTROL RECORD C ICOMD.GT.0 MEANS SKIP OR COPY COMMAND BEGIN C ICOMD.EQ.-1 MEANS CONTINUE COPY = NUMBERS C ICOMD.EQ.-2 MEANS CONTINUE COPY = PREDICATE EXPRESSION NEWP=0 IF (ITYPEI.EQ.80) VERT=0 C 80 = ASCII P. WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO C IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON C THE WORK FILE. IF (ICOMD.EQ.0) GO TO 190 C ICOMD=0 MEANS CHANGING A CONTROL RECORD. IF (ICOMD+1) 290,170,10 10 IF (ICOMD.EQ.KCOPY) GO TO 30 C C SKIP COMMAND. C IF (INTOPN.LT.0) GO TO 430 if (modify.eq.70) number=number+n1reci-1 c 70 = ASCII F. IF (NUMBER+1-N1RECI) 540,430,20 20 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.EQ.69) GO TO 460 C 69 = ASCII E. IF (N1RECI-NUMBER) 20,20,430 C C COPY COMMAND FORMAT VERIFICATION. C 30 IF (COMAND(EQUAL).LT.48) GO TO 180 C 48 = ASCII ZERO IF (COMAND(EQUAL).GT.57) GO TO 180 C 57 = ASCII NINE C C COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS. C CONVERT THE NUMBERS AND STORE THEM IN COMAND. IF THE NUMBER C IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER. C ICOMD=-1 I=0 J=44 C 44 = ASCII COMMA 40 I=I+1 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 480 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=NUMBER 50 EQUAL=EQUAL+1 IF (EQUAL.GT.NCHCMD) GO TO 60 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 60 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=10*COMAND(I)+NUMBER GO TO 50 60 IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70 70 IF (J.EQ.45) COMAND(I)=-COMAND(I) C 45 = ASCII DASH IF (EQUAL.GT.NCHCMD) GO TO 90 J=COMAND(EQUAL) IF (J.EQ.32 .OR. J.EQ.46) GO TO 90 C 32 = ASCII BLANK, 46 = ASCII PERIOD. IF (J.NE.44.AND.J.NE.45) GO TO 480 C 44 = ASCII COMMA, 45 = ASCII DASH 80 EQUAL=EQUAL+1 IF (COMAND(EQUAL)-32) 40,80,40 C 32 = ASCII BLANK 90 NUMBER=I C FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE C POSITION IN COMAND CURRENTLY BEING EXAMINED. EQUAL=-1 100 EQUAL=EQUAL+1 IF (EQUAL.GE.NUMBER) GO TO 470 IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100 IF (EQUAL.EQ.0) GO TO 120 WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD) 110 FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H) 1NOT COPIED./(1X,80A1)) NERRG=MAX0(NERRG,5) 120 IF (COMAND(EQUAL+1).GT.0) GO TO 130 EQUAL=EQUAL-1 COMAND(EQUAL+1)=N1RECI 130 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. C C PROCESS COPY = LIST OF NUMBERS C 140 EQUAL=EQUAL+1 C GO COPY THE PROGRAM IF IT IS THE RIGHT ONE. 150 IF (INTOPN.LT.0) GO TO 430 IF (COMAND(EQUAL)-N1RECI) 170,420,160 C SKIP TO DESIRED PROGRAM 160 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI-69) 150,460,150 C 69 = ASCII E 170 IF (EQUAL.GE.NUMBER) GO TO 430 IF (COMAND(EQUAL+1).GE.0) GO TO 140 COMAND(EQUAL)=IABS(COMAND(EQUAL))+1 IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420 EQUAL=EQUAL+1 GO TO 170 C C COPY = SELECTION STRING OR CHANGE CONTROL RECORD. C 180 ICOMD=-2 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. NRWORK=-1 C C DETERMINE NEED TO OPEN WORK FILE. C 190 IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0) 1IF (ICOMD) 290,430,290 IF (WORKF.EQ.0) GO TO 500 I=IABS(WORKF) IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510 IF (WORKF.GT.0) GO TO 200 WORKF=I CALL EXCHFO (3) 200 IF (ICOMD.NE.0) GO TO 280 C C CHANGE CONTROL RECORD. C if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520 c 69 = ascii E, 73 = ascii I. if (nrwork.eq.0) go to 210 if (itypei.eq.80) go to 520 c 80 = ascii P 210 IF (NUMBER-NRWORK-1) 530,220,410 220 NCHACT=NCHCMD+1-EQUAL IF (NCHACT.GT.0) GO TO 230 NCHACT=1 INTREC(1)=32 C 32 = ASCII BLANK GO TO 425 230 DO 240 I=1,NCHACT 240 INTREC(I)=COMAND(EQUAL+I-1) GO TO 425 C C COPY = SELECTION EXPRESSION. C C SKIP TO NEXT PROGRAM. 250 IF (INTOPN.LT.0) GO TO 430 if (itypei.eq.69) go to 460 c 69 = ASCII E. do 260 i = 1, 8 260 pred(2,i)=0 if (itypei.ne.80) go to 265 c If the current record is a new program, don't skip it (we haven't c processed it yet). if (nrwork.gt.0 .and. workf.gt.0) rewind workf nrwork=min0(nrwork,0) newp=0 go to 320 265 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 nxnewp=0 270 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.NE.80) GO TO 310 C 80 = ASCII P NEWP=nxnewp c Set NEWP non-zero when all control records for a module have been c seen. GO TO 320 280 NRWORK=MAX0(NRWORK,0) 290 DO 300 I=1,8 300 PRED(2,I)=0 c NEWP is non-zero when all control records have been read. 310 if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1 C 69 = ASCII E, 73 = ASCII I. 320 nxnewp=1 if (icomd.eq.0) if (newp) 520,210,520 IF (LIMIT.EQ.0) GO TO 340 IF (N1RECI.LE.LIMIT) GO TO 340 WRITE (PRINTR,330) LIMIT 330 FORMAT (7H LIMIT=,I6,9H REACHED.) GO TO 430 340 IF (NEWP.EQ.0) GO TO 360 CALL EXCHLX C EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'. NUMBER=NCHCMD IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415 C 73 = ASCII I. IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425 C 80 = ASCII P. IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425 C 83 = ASCII S. IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415 C 88 = ASCII X. IF (COMAND(180)) 450,250,420 C CONTROL RECORD. EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE. 360 I=1 DO 400 NUMBER=1,8 IF (PRED(1,NUMBER).EQ.0) GO TO 400 IF (PRED(2,NUMBER).NE.0) GO TO 400 IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390 NM=PRED(1,NUMBER)-3 IF (.NOT.(NCHACT.GT.0)) GO TO 390 DO 385 L = 1, NCHACT DO 380 J = 1, NM C C DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND C IN PREDICATE. IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380 IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370 C C NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS. K=32 GO TO 375 C USE CHARACTER FROM CONTROL RECORD. 370 K=INTREC(J+L-1) C C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (K.GT.96 .AND. K.LT.123) K=K-32 C C TEST FOR A MATCH ON A SINGLE CHARACTER. C IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE C PATTERN. IF THE SEARCH MODE IS X, TERMINATE THE SEARCH. 375 IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390 380 CONTINUE C C FOUND A MATCH IN CONTROL RECORD AND PREDICATE. PRED(2,NUMBER)=1 GO TO 400 385 CONTINUE 390 I=0 400 CONTINUE IF (I.NE.0) newp=1 IF (NRWORK.LT.0) GO TO 270 C AT LEAST ONE FALSE PREDICATE. WRITE THE CONTROL RECORD ON WORKF. 410 WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT) NRWORK=NRWORK+1 GO TO 270 C C GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM. C 415 ICOMD=-3 C RETURN TO EXCHC1 AFTER COPYING MODULE. 420 TRANS=5 GO TO 570 C C RETURN TO THE COMMAND PROCESSOR. C 425 TRANS=1 C REMEMBER CONTROL RECORDS ON WORKF. GO TO 570 430 TRANS=1 IF (ICOMD+1) 560,570,570 C C ERROR MESSAGES. C 440 NUMBER=1 C MESSAGE 1 - I/O ERROR. EQUAL=ISTAT GO TO 550 450 NUMBER=-COMAND(180) C MESSAGES GENERATED BY EXCHLX GO TO 550 460 IF (INTOPN.LT.0) GO TO 430 INTOPN=-1 EQUAL=NUMBER NUMBER=15 C MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE. GO TO 550 470 NUMBER=16 C MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION. GO TO 550 480 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER GO TO 550 490 NUMBER=18 C MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER. GO TO 550 500 NUMBER=19 C MESSAGE 19 - WORK FILE NOT DEFINED. GO TO 550 510 NUMBER=20 C MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE. GO TO 550 520 EQUAL=NUMBER NUMBER=21 C MESSAGE 21 - CONTROL RECORD NOT PRESENT GO TO 550 530 NUMBER=22 C MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER. GO TO 550 540 NUMBER=29 C MESSAGE 29 - BACKWARD SKIP IGNORED. C C RETURN TO THE ERROR MESSAGE PROCESSOR. C 550 TRANS=8 IF (ICOMD.EQ.0) GO TO 570 C C DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF. C 560 IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) C C RETURN TO TRANSITION PROGRAM. C 570 RETURN C END SUBROUTINE EXCHLX C C EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND. C C THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE C STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM C COPY=LOGICAL EXPRESSION. THE LOGICAL EXPRESSION CONSISTS OF THE C EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY C OPERATORS + - * / AND PARENEHESES. THE PRIMARY SYMBOLS A-H ARE C LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE C STATEMENTS. THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE C NULL PREDICATE, WHICH IS ALWAYS FALSE. THE OPERATORS + - * / ARE C THE BINARY LOGICAL OPERATIONS OR, OR NOT, AND, AND NOT C RESPECTIVELY. THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE C PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL C PRIORITY. THE RELATIVE PRIORITY MAY BE CHANGED BY USING C PARENTHESES. C C WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY C FALSE. AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL C FALSE PREDICATES IS DETERMINED. ONCE TRUE, A PREDICATE REMAINS C TRUE. THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND C A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE. WHEN ALL ACTIVE C PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM C HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND C IS EVALUATED. IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED. C IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED. THIS PROCESS C CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM C NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED. C C THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE C TABLE BELOW. INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS C APPENDED TO THE END OF THE LOGICAL EXPRESSION. C C PREVIOUS I CURRENT TOKEN I C TOKEN I + - * / I PRIMARY I ( I ) I ELSE I C ----------I---------I---------I---------I---------I---------I C + - * / I ERROR I OK I OK I ERROR I ERROR I C PRIMARY I OK I ERROR I ERROR I OK I ERROR I C ( I ERROR I OK I OK I OK I ERROR I C ) I OK I ERROR I ERROR I OK I ERROR I C ----------I---------I---------I---------I---------I---------I C C CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING C A STACK AND THE PRECEDENCE TABLE BELOW. TOS MEANS TOP-OF-STACK, C HOI MEANS HEAD-OF-INPUT. THE STACK INITIALLY CONTAINS (. C C TOS HOI C TOKEN I INDEX I INDEX I C ---------I---------I---------I C + - I 2 I 1 I C * / I 4 I 3 I C PRIMARY I 6 I 5 I C ( I 0 I 7 I C ) I N/A I 0 I C ---------I---------I---------I C C WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS C PUSHED ONTO THE STACK. WHEN THE TOS INDEX IS GREATER THAN THE HOI C INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY C SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT C PLACED IN THE SUFFIX LIST. THEN THE RELATION OF THE TOS INDEX TO C THE HOI INDEX IS RE-EXAMINED. WHEN THE TOS INDEX IS EQUAL TO THE C HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED. C C ***** INTERNAL VARIABLES ********************************* C C CHTAB RECOGNIZED CHARACTERS. INTERNAL PROCESSES USE THE INDEX C INTO CHTAB. C COLTAB CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX. C HOI CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE. C INFIX IS THE CURRENT POSITION IN THE INFIX. C IPREV IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN. C ISTACK IS THE CURRENT STACK INDEX. C ISUFIX IS THE CURRENT SUFFIX INDEX. C SYNTAX CONTAINS THE SYNTAX RULES. C TOS CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE. C INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15) C C ***** COMMON VARIABLES *********************************** C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** DATA STATEMENTS ************************************ C C A B C D DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/ C E F G H DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/ C N + - * DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/ C / ( ) DATA CHTAB(13),CHTAB(14),CHTAB(15) /47,40,41 / C A B C D DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/ C E F G H DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/ C N + - * DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/ C / ( ) DATA COLTAB(13),COLTAB(14),COLTAB(15) /1,3,4 / C A B C D E DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/ C F G H N + DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/ C - * / ( ) DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/ C CURRENT TOKEN IS +-*/. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/ C CURRENT TOKEN IS PRIM. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/ C CURRENT TOKEN IS (. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/ C CURRENT TOKEN IS ). NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/ C A B C D E DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/ C F G H N + DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/ C - * / ( ) DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/ C C ***** PROCEDURES ***************************************** C C COMAND IS USED FOR INFIX, STACK AND SUFFIX. UPON COMPLETION, C COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE C OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE C EXPRESSION IS TRUE. C ISTACK=NCHCMD+2 COMAND(ISTACK)=14 ISUFIX=181 IPREV=3 COMAND(NCHCMD+1)=41 INFIX=EQUAL-1 C C GET A CHARACTER FROM INFIX. LOOK UP IN CHTAB. CHECK SYNTAX. C 10 IF (INFIX.GT.NCHCMD) GO TO 180 INFIX=INFIX+1 J=COMAND(INFIX) IF (J.EQ.32) GO TO 10 C 32 = ASCII BLANK - IGNORE IT. IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. DO 20 I=1,15 IF (CHTAB(I).EQ.J) GO TO 30 20 CONTINUE GO TO 230 30 J=COLTAB(I) IF (SYNTAX(IPREV,J)-1) 40,190,200 C C CONVERT INFIX TO SUFFIX C 40 IPREV=J 50 J=COMAND(ISTACK) IF (TOS(J)-HOI(I)) 60,70,80 C PUSH INFIX ONTO STACK 60 ISTACK=ISTACK+1 COMAND(ISTACK)=I GO TO 10 C DELETE TOP OF STACK 70 ISTACK=ISTACK-1 IF (ISTACK.GT.NCHCMD+1) GO TO 10 IF (INFIX-NCHCMD) 220,220,250 C IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX. C IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX. 80 IF (J-9) 90,100,130 C PRIMARY IS SYMBOL A-H 90 IF (PRED(1,J).EQ.0) GO TO 210 J=PRED(2,J) GO TO 110 C NULL PREDICATE 100 J=0 110 ISUFIX=ISUFIX-1 120 COMAND(ISUFIX)=J ISTACK=ISTACK-1 GO TO 50 C OPERATOR 130 J=J-9 ISUFIX=ISUFIX+1 GO TO (140,150,160,170), J C + - * / 140 J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1) GO TO 120 150 J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1) GO TO 120 160 J=COMAND(ISUFIX)*COMAND(ISUFIX-1) GO TO 120 170 J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1)) GO TO 120 C 180 COMAND(180)=-23 C MESSAGE 23 - TOO MANY ( GO TO 240 190 COMAND(180)=-24 C MESSAGE 24 - MISSING PRIMARY GO TO 240 200 COMAND(180)=-25 C MESSAGE 25 - MISSING OPERATOR GO TO 240 210 EQUAL=CHTAB(J) CALL EXCHAH (EQUAL,1) COMAND(180)=-26 C MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE. GO TO 250 220 COMAND(180)=-27 C MESSAGE 27 - TOO MANY ) GO TO 240 230 COMAND(180)=-28 C MESSAGE 28 - UNRECOGNIZED CHARACTER C 240 EQUAL=INFIX 250 RETURN C END SUBROUTINE EXCHC5 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE, C AND INDEX IF SELECTED. COPY RECORDS FROM WORKF FIRST, IF ANY. C CREATE CONTROL RECORDS DEMANDED BY COMMANDS. C C THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF C THE PARAMETER STRING. C C AUTHOR C COMMENT C CONTROL (ITYPEO SET FROM MODIFY) C DATA TYPE C GROUPS C INSERT C KEYWORDS C MACHINE C ORIGIN C REFERENCES C REMOVE (FIRST CHARACTER OF PARAMETER STRING ONLY) C SIGNAL (FIRST CHARACTER OF PARAMETER STRING ONLY) C UPDATE C C IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS C ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A C CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND. C C ***** LOCAL VARIABLES ************************************ C C BLANK CONTAINS A HOLLERITH BLANK. INTEGER BLANK C C1 IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING. INTEGER C1 C COL1 THE FIRST COLUMN OF TEXT OF A CONTROL RECORD. DERIVED FROM C EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE. INTEGER COL1 C I,J USED FREELY AS INDICES. INTEGER I,J C KCONT THE INDEX IN COMD OF THE CONTROL COMMAND. INTEGER KCONT C KNAME IS THE INDEX IN COMD OF THE NAME COMMAND. INTEGER KNAME C KTEXT THE INDEX IN COMD OF THE TEXT COMMAND. INTEGER KTEXT C KUPDA THE INDEX IN COMD OF THE UPDATE COMMAND. INTEGER KUPDA C LIST CONTAINS THE WORD LIST IN ASCII. USED FOR THE A OPTION. INTEGER LIST(4) C NM IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED. INTEGER NM C NOUT IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED. INTEGER NOUT C NY IS THE PROGRAM NUMBER. IT IS THE NUMBER FROM INTAPE IF C OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE. INTEGER NY C ONE CONTAINS A HOLLERITH 1. INTEGER ONE C REASON REASON FOR COPYING A CONTROL RECORD. 1 = COPY COMMAND C PENDING. 2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8. C 3 = COMMAND. INTEGER REASON C RI CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A C GIVEN RECORD TYPE. RI IS SUBSCRIPTED BY (ITYPEO-64). INTEGER RI(26) C RT IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT. INTEGER RT(34) C STAR CONTAINS A HOLLERITH STAR. INTEGER STAR C ZERO CONTAINS A HOLLERITH ZERO. INTEGER ZERO C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL VARIABLE DATA ******************************** C DATA BLANK /1H / C L I S T DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/ C DATA KCONT /31/ DATA KNAME /9/ DATA KTEXT /27/ DATA KUPDA/29/ DATA ONE /1H1/ C A B C D E F DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/ C G H I J K L DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/ C M N O P Q R DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/ C S T U V W X DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/ C Y Z DATA RI(25),RI(26) /31,31 / C A C D G DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/ C P K DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/ C M O DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/ C B R DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/ C S DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/ C J DATA RT(31),RT(32),RT(33),RT(34) /-1, 0, 0,74/ C DATA STAR /1H*/ DATA ZERO /1H0/ C C ***** PROCEDURES ***************************************** C REASON=1 NY=N1RECI IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1 C ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P. C IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT. IF (PHASE.EQ.4) NY=0 C NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER. (IT IS PRINTED C IN THE INDEX). IF (ICOMD.LE.0) GO TO 10 IF (PHASE.GE.4) GO TO 100 IF (ICOMD.EQ.KNAME) GO TO 10 IF (ICOMD.NE.KUPDA) GO TO 100 REASON=2 PHASE=8 10 IF (NRWORK.GT.0) REWIND WORKF NM=0 NOUT=0 20 NM=NM+1 IF (NM.LE.NRWORK) GO TO 60 30 IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230 C 69 = ASCII E, 73 = ASCII I. IF (NOUT.EQ.0) GO TO 40 IF (ITYPEI.EQ.80) GO TO 230 C 80 = ASCII P. IF (NCHACT.NE.1) GO TO 40 IF (INTREC(1).EQ.32) GO TO 220 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 40 ITYPEO=ITYPEI NCHOUT=NCHACT DO 50 J=1,NCHOUT 50 OUTREC(J+5)=INTREC(J) GO TO 70 60 READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT) IF (NCHOUT.NE.1) GO TO 70 IF (NM.EQ.1) GO TO 70 IF (OUTREC(6).EQ.32) GO TO 200 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 70 NOUT=NOUT+1 J=RI(ITYPEO-64) DO 80 I=1,4 80 OUTREC(I)=COMD(I,J) OUTREC(5)=61 C 61 = ASCII = COL1=5 IF (J.NE.KCONT) GO TO 130 COL1=7 C CONTROL,*=... MOVE UP TWO CHARACTERS AND INSERT ITYPEO. DO 90 I=1,NCHOUT 90 OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I) OUTREC(5)=44 C 44 = ASCII COMMA. OUTREC(6)=ITYPEO OUTREC(7)=61 C 61 = ASCII = GO TO 130 100 IF (ICOMD.EQ.KTEXT) GO TO 240 COL1=EQUAL-1 NCHOUT=NCHCMD-COL1 NRWORK=NRWORK+1 C NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD. ITYPEO=RT(ICOMD) IF (ITYPEO.GT.0) GO TO 110 C PROCESS CONTROL,TYPE=TEXT COMMAND. ITYPEO=MODIFY IF (RI(ITYPEO-64).NE.KCONT) GO TO 320 110 NOUT=NRWORK REASON=3 DO 120 I=1,NCHCMD 120 OUTREC(I)=COMAND(I) 130 IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1) C 74 = ASCII J. IF (ITYPEO.EQ.80) VERT=0 C 80 = ASCII P IF (ITYPEO.NE.68) GO TO 150 C 68 = ASCII D IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150 DO 140 J=1,4 I=OUTREC(J+COL1) IF (I.GT.96 .AND. I.LT.123) I=I-32 C CONVERT TO UPPER CASE. IF (I.NE.LIST(J)) GO TO 150 140 CONTINUE VERT=1 C GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE. 150 CALL EXCHCG (OUTREC(COL1+1)) IF (OUTOPN.EQ.0) GO TO 160 CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1)) IF (ISTAT.NE.0) GO TO 340 NY=NLRECO 160 NCHOUT=NCHOUT+COL1 C TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER. OUTREC(180)=-NOUT IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC) C PRINT THE INDEX IF SELECTED. IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 1190 IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190 C1=BLANK C DOUBLE SKIP FOR PROGRAM HEADER (P). IF (ITYPEO.EQ.80) C1=ZERO IF (OPTV+VERT.NE.0) GO TO 170 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170 IF (CHAR1L.NE.ONE) C1=ONE CHAR1L=ONE 170 CALL EXCHAH (OUTREC,NCHOUT) WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT) 180 FORMAT (A1,2I5,1H*,(3X,105A1)) 190 IF (REASON.EQ.3) GO TO 310 200 IF (NM-NRWORK) 20,210,220 210 REWIND WORKF NRWORK=0 GO TO 30 220 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT) 330,30,330 230 IF (REASON.EQ.2) GO TO 300 240 IF (OUFILE.EQ.0) GO TO 260 DO 250 I=1,4 250 OUTREC(I)=COMD(I,KTEXT) OUTREC(180)=0 NCHOUT=0 C TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED. CALL EXCHCG (OUTREC) NCHOUT=4 ACTION=2-OPTC-OPTC C ACTION = 2 MEANS START OF PROGRAM. CALL EXCHOU (OUTREC) 260 IF (OPTV+VERT.NE.0) GO TO 280 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280 IF (OUTOPN.NE.0) NY=NLRECO I=BLANK IF (CHAR1L.NE.ONE) I=ONE WRITE (PRINTR,270) I,NY 270 FORMAT (A1,I5,1H*,8X,4HTEXT/) 280 CHAR1L=STAR NRWORK=MIN0(NRWORK,0) IF (IDOPTN.NE.67) IDCUR=IDSTRT C 67 = ASCII C IF (ICOMD.EQ.KTEXT) GO TO 290 C C WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL C RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED. C TRANS=6 GO TO 370 C C WORKING ON A TEXT STATEMENT. C 290 TRANS=7 GO TO 370 C C WORKING ON AN UPDATE STATMENT. C 300 NRWORK=NOUT GO TO 100 C C WRITING A SINGLE CONTROL RECORD. C 310 TRANS=1 GO TO 370 C C ERROR MESSAGES. C 320 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER. GO TO 360 330 NUMBER=1 GO TO 350 340 NUMBER=2 350 EQUAL=ISTAT 360 TRANS=8 C C RETURN TO TRANSITION PROGRAM. C 370 RETURN C END SUBROUTINE EXCHCG (RECORD) C C USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL. C WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED. C THIS IS THE PORTABLE VERSION. IT DOES NOT DO ANYTHING. C INTEGER RECORD(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C RETURN END SUBROUTINE EXCHC6 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE. C INTEGER KNAME,ONE,SVHCMD(180) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KNAME /9/ DATA ONE /1H1/ C LINEO=0 NERRS=0 C SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT. DO 5 I = 1,NCHCMD 5 SVHCMD(I)=HOLCMD(I) IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165 C 73 = ASCII I. IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE C A VOID MODULE. IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.EQ.7) GO TO 220 IF (ISTAT) 250,160,250 10 MODEO=MODEI ITYPEO=0 NBC=OPTL+OUFILE IF (INDEX.GT.0) NBC=1 20 NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTOPN.EQ.0) GO TO 120 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 260 C C CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD C INSTEAD OF BYTE-BY-BYTE). WE CAN DO A BLOCK COPY IF C WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT C FILE AND NOT PRINTING THE INDEX. ALSO, THE INPUT AND C OUTPUT CHARACTER POSITIONS MUST BE THE SAME. IF THE C PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH C THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE C CURRENT POSITION IN THE BYTE BUFFER BE THE SAME. C WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE C LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T C KNOW THE LOCATION OF THE END-OF-FILE RECORD. C IF (NBC.NE.0) GO TO 120 IF (CPCBI+1.NE.CPCBO) GO TO 120 IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120 C WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF. IF (L1PRGI.EQ.0) GO TO 25 IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30 25 IF (CCDBI+1.NE.CCDBO) GO TO 120 IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120 C WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE). C FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO. 30 LI=L1PRGI+NERRCI-1 IF (L1PRGI.NE.0) GO TO 40 LI=NERRCI+NDATAI+9 IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1 40 IF (CPCBI.GE.NCCBI) GO TO 50 IF (CCDBI.GE.LI) GO TO 160 CPCBI=CPCBI+1 CBLCKO(CPCBO)=CBLCKI(CPCBI) CPCBO=CPCBO+1 CCDBI=CCDBI+1 CCDBO=CCDBO+1 GO TO 40 C PACK COPIED BYTES. 50 CALL EXCHPA (CBLCKO,OBLOCK(CWDBO)) CPCBO=1 CPCBI=0 CWDBO=CWDBO+NWCBO CWDBI=CWDBI+NWCBI C NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM 60 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=L1RECI CALL EXCHPB (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 260 70 IF (CCDBI.LT.LI) GO TO 80 IF (L1PRGI.NE.0) GO TO 100 CALL EXCHGB (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 250 GO TO 30 80 NW=NWCBI*((LI-CCDBI)/NCCBI) IF (NW.EQ.0) GO TO 100 DO 90 I=1,NW OBLOCK(CWDBO)=IBLOCK(CWDBI) CWDBO=CWDBO+1 90 CWDBI=CWDBI+1 100 CCDBO=CCDBO+LI-CCDBI CCDBI=LI IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60 CPCBI=MOD(LI,NCCBI) CPCBO=MOD(CCDBO-1,NCCBO)+1 CALL EXCHUN (IBLOCK(CWDBI),CBLCKI) IF (CPCBI.EQ.0) GO TO 160 DO 110 I=1,CPCBI 110 CBLCKO(I)=CBLCKI(I) GO TO 160 C C END OF BLOCK COPY CODE. C 120 CALL EXCHTP (INTREC,LINEO) 160 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 250 IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20 C 73 = ASCII I. 165 IF (OPTL.NE.0) GO TO 180 IF (INDEX.LE.0) GO TO 195 WRITE (PRINTR,170) LINEO 170 FORMAT (I9,14H IMAGES COPIED) GO TO 200 180 WRITE (PRINTR,190) 190 FORMAT (1H1) 195 CHAR1L=ONE 200 IF (OUFILE.EQ.0) GO TO 210 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 210 IF (ITYPEI.EQ.69) GO TO 220 C 69 = ASCII E C C RETURN TO THE COPY CONTROL SEGMENT. C DO 215 I=1,NCHCMD 215 HOLCMD(I)=SVHCMD(I) IF (ICOMD.EQ.-3) GO TO 240 C ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE. TRANS=4 IF (ICOMD.NE.KNAME) GO TO 280 C MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME' C COMMAND SUBMITTED. GO PROCESS 'NAME' COMMAND. TRANS=5 PHASE=4 GO TO 280 C C END OF FILE ON INPUT TAPE. C 220 IF (INTOPN.LT.0) GO TO 240 WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD) 230 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1)) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 240 TRANS=1 GO TO 280 C C ERROR MESSAGES. C 250 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. GO TO 270 260 NUMBER=2 C MESSAGE 2 - I/O ERROR WRITING OUTAPE. 270 TRANS=8 EQUAL=ISTAT C C RETURN TO THE TRANSITION PROGRAM. C 280 IF (NERRS.EQ.0) GO TO 300 WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD) 290 FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./ 1(1X,80A1)) NERRG=MAX0(NERRS,NERRG) 300 RETURN C END SUBROUTINE EXCHC7 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40) C C PROCESS THE TEXT COMMAND. C C MSG IS USED TO PRINT A MESSAGE. INTEGER MSG(6,2) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/ DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/ DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/ DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/ DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/ C LINEI=1 LINEO=0 NERRS=0 INEND=0 CHAR1L=STAR C C SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND C K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 20 I=1,40 IF (K.GT.NCHCMD) GO TO 10 J=COMAND(K) K=K+1 GO TO 20 10 J=32 C 32 = ASCII BLANK. 20 TXDISK(I)=J IF (INTOPN.LE.0) ITYPEI=0 C C MAIN PROCESSING LOOP C 60 EDIT=0 70 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 80 C NCHCMD.LT.0 MEANS END OF FILE. IF (NCHCMD.LT.2) GO TO 100 IF (COMAND(1).NE.SIGNAL) GO TO 100 IF (COMAND(2).EQ.SIGNAL) GO TO 80 IF (COMAND(2).EQ.73) GO TO 370 IF (COMAND(2).EQ.105) GO TO 370 C 73,105 = ASCII I - REQUEST TO INCLUDE TEXT. IF (NCHCMD.LT.3) GO TO 100 IF (COMAND(2).NE.61) GO TO 100 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 70 C END OF TEXT FILE. 80 IF (INTEXT.EQ.0) GO TO 90 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE CALL EXCHIM INTEXT=0 NCHCMD=0 90 NCHCMD=MIN0(NCHCMD,0) IF (PHASE.NE.8) GO TO 660 IF (INEND) 660,630,660 100 IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110 110 IF (EDIT.EQ.0) GO TO 450 C C PARTIAL LINE EDITOR. C INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED. C EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES C THE FIRST NON-BLANK CHARACTER AFTER N2. N1 AND N2 ARE COLUMN C LIMITS UNDER WHICH TO PERFORM THE EDITING. N1 AND ,N2 ARE C OPTIONAL. IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT C LIMIT. IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS C ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE. WHEN C STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING C PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT C LENGTHS OF STRING1 AND STRING2. THE THIRD DELIMITER IS C OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED C AFTER STRING2 IS INSERTED. C IF (INEND.NE.0) GO TO 240 C CONVERT COLUMN NUMBERS. NBR1=0 NBR2=0 I=0 120 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.EQ.44) GO TO 150 C 44 = ASCII COMMA IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR1=10*NBR1+J-48 GO TO 120 130 WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD) 140 FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/ 1(1X,80A1)) NERRS=2 GO TO 70 150 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR2=10*NBR2+J-48 GO TO 150 C SCAN FOR DELIMITER 160 IF (J.NE.32) GO TO 170 C 32 = ASCII BLANK I=I+1 J=COMAND(I) GO TO 160 170 D1=I NBR1=MIN0(NBR1,180) NBR2=MIN0(NBR2,180) IF (NBR1.EQ.0) NBR1=1 IF (NBR2.EQ.0) GO TO 180 IF (NBR2.LT.NBR1) GO TO 130 180 I=I+1 IF (I.GT.NCHCMD) GO TO 130 IF (COMAND(I).NE.J) GO TO 180 D2=I D3=0 190 I=I+1 IF (I.GT.NCHCMD) GO TO 200 IF (COMAND(I).NE.J) GO TO 190 D3=I C LOOK FOR SEARCH STRING (STRING1) 200 NUMBER=D2-D1-1 J=NBR1 IF (NUMBER.EQ.0) GO TO 260 NY=NBR2 IF (NY.EQ.0) NY=NCHACT 210 DO 220 I=1,NUMBER IF (I+J-1.GT.NY) GO TO 240 IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230 220 CONTINUE GO TO 260 230 J=J+1 GO TO 210 240 WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1)) NERRS=2 GO TO 70 C FOUND SEARCH STRING. REPLACE WITH UPDATE STRING. 260 CHAR1L=PLUS IF (D3.NE.0) GO TO 300 C NO THIRD DELIMITER. REPLACE REST OF REGION. NY=NBR2 IF (NY.EQ.0) NY=180 D2=D2+1 IF (D2.GT.NCHCMD) GO TO 280 DO 270 I=D2,NCHCMD INTREC(J)=COMAND(I) J=J+1 IF (J.GT.NY) GO TO 280 270 CONTINUE 280 IF (NBR2.NE.0) GO TO 290 NCHACT=J-1 GO TO 70 290 IF (J.GT.NBR2) GO TO 70 INTREC(J)=32 C 32 = ASCII BLANK J=J+1 GO TO 290 C WE HAVE A THIRD DELIMITER. REPLACE ONLY THE SEARCH STRING. C SHIFT THE REST OF THE REGION AS NECESSARY. 300 NUMBER=(D3-D2)-(D2-D1) IF (NUMBER) 310,350,330 C SHIFT LEFT 310 I=J+D2-D1-1 NY=MIN0(NBR2,NCHACT) IF (NY.EQ.0) NY=NCHACT 320 IF (I.GT.NY) GO TO 350 INTREC(I+NUMBER)=INTREC(I) C NOTE - NUMBER .LT. 0 HERE INTREC(I)=32 C 32 = ASCII BLANK I=I+1 GO TO 320 C RIGHT SHIFT 330 I=NBR2 IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180) NY=J+NUMBER 340 IF (I.LT.NY) GO TO 350 INTREC(I)=INTREC(I-NUMBER) I=I-1 GO TO 340 C NO SHIFT NEEDED. 350 IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180) IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2) NY=NBR2 IF (NY.EQ.0) NY=NCHACT C MOVE UPDATE STRING (STRING2). 360 D2=D2+1 IF (D2.GE.D3) GO TO 70 INTREC(J)=COMAND(D2) J=J+1 IF (J-NY) 360,360,70 C C REQUEST TO INCLUDE TEXT. -I IN COLUMNS 1 AND 2. C 370 IF (EDIT.EQ.0) GO TO 390 WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD) 380 FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X 1,80A1)) NERRS=2 GO TO 70 390 ITYPEO=73 C 73 = ASCII I IF (NCHCMD.GE.4) GO TO 410 WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD) 400 FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A 11)) NERRS=2 GO TO 70 410 DO 420 I=4,NCHCMD IF (COMAND(I).NE.32) GO TO 430 420 CONTINUE C CONVERT TO UPPER CASE. WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM 430 K=0 DO 440 J=I,NCHCMD IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32 K=K+1 440 COMAND(K)=COMAND(J) NCHCMD=K GO TO 460 C C TEXT RECORD. C 450 ITYPEO=0 460 NCHOUT=NCHCMD IF (OUTOPN.EQ.0) GO TO 470 MODEO=0 CALL EXCHPR (ISTAT,OBLOCK,COMAND) IF (ISTAT.NE.0) GO TO 770 470 CALL EXCHTP (COMAND,0) GO TO 70 C C APPARENT CHANGE CONTROL COMMAND C 480 IF (INEND.EQ.0) GO TO 510 490 WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD) 500 FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT 1 END./(1X,80A1)) NERRS=1 GO TO 70 510 NUMBER=1 NBR1=0 EDIT=0 I=1 520 I=I+1 IF (I.GT.NCHCMD) GO TO 600 J=COMAND(I) IF (J.EQ.32) GO TO 600 C 32 = ASCII BLANK IF (EDIT.NE.0) GO TO 530 C EDIT CONTROL MUST BE BLANK AFTER $. IF (J.EQ.44) GO TO 570 C 44 = ASCII COMMA IF (J.EQ.36) GO TO 560 C 36 = ASCII $ IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.LE.57) GO TO 550 C 57 = ASCII 9 530 WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD) 540 FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1) NERRS=2 GO TO 60 550 NBR1=10*NBR1+J-48 GO TO 520 560 IF (NBR1.EQ.0) GO TO 530 EDIT=1 NBR1=NBR1-1 GO TO 520 570 NUMBER=2 NBR2=0 580 I=I+1 IF (I.GT.NCHCMD) GO TO 590 J=COMAND(I) IF (J.EQ.32) GO TO 590 C 32 = ASCII BLANK IF (IABS(J-44).EQ.1) GO TO 590 C 43 = ASCII +, 45 = ASCII - IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.GT.57) GO TO 530 C 57 = ASCII 9 NBR2=10*NBR2+J-48 GO TO 580 590 IF (NBR2.LT.NBR1) GO TO 530 NBR1=NBR1-1 600 IF (NBR1.GE.LINEI-1) GO TO 620 WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD) 610 FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1) NERRS=2 GO TO 60 620 IF (NCHCMD.LE.0) GO TO 630 IF (LINEI.LE.NBR1) GO TO 630 IF (NUMBER.EQ.1) GO TO 70 C SKIP INTAPE UNTIL NBR2 IS SKIPPED. MODEI=1 IF (LINEI.GE.NBR2) MODEI=0 IF (LINEI-NBR2) 650,650,70 C COPY FROM INTAPE UNTIL NBR1 COPIED. 630 MODEO=MODEI NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTAPE.EQ.0) GO TO 640 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 770 640 CALL EXCHTP (INTREC,LINEI) MODEI=0 IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650 IF (LINEI.EQ.NBR1) GO TO 650 MODEI=1 650 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 760 LINEI=LINEI+1 IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620 C 73 = ASCII I INEND=1 IF (NCHCMD.LE.0) GO TO 660 I=NBR2 IF (NUMBER.EQ.1) I=NBR1 IF (LINEI-I) 490,490,70 660 IF (NERRS.EQ.0) GO TO 675 J=1 IF (PHASE.EQ.8) J=2 WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS 670 FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.) 675 NERRG=MAX0(NERRG,NERRS) IF (OPTL+OPTS.NE.0) GO TO 690 IF (OUTAPE+OUFILE.EQ.0) LINEO=0 IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO 680 FORMAT (I9,14H IMAGES COPIED) GO TO 710 690 WRITE (PRINTR,700) 700 FORMAT (1H1) CHAR1L=ONE 710 IF (OUFILE.EQ.0) GO TO 720 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 720 IF (ITYPEI.NE.69) GO TO 750 C 69 = ASCII E C C END OF FILE ON INPUT TAPE (UPDATE MODE). C IF (INTOPN.LT.0) GO TO 750 DO 730 I=1,40 730 HOLCMD(I+1)=TXDISK(I) HOLCMD(1)=32 IF (TXDISK(1).NE.32) HOLCMD(1)=61 C 32 = ASCII BLANK, 61 = ASCII = CALL EXCHAH (HOLCMD,41) WRITE (PRINTR,740) (HOLCMD(I),I=1,41) 740 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 750 TRANS=1 GO TO 790 C C ERROR MESSAGES. C 760 NUMBER=1 GO TO 780 770 NUMBER=2 780 EQUAL=ISTAT TRANS=8 C C RETURN TO THE TRANSITION PROGRAM. C 790 PHASE=2 IF (OUTOPN.EQ.0) PHASE=1 RETURN C END SUBROUTINE EXCHC8 C C PRINT ERROR MESSAGES. C C ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE INTEGER S(31) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/ DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/ DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/ DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/ DATA S(29),S(30),S(31) /4,5,5 / C C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4 160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751), 2NUMBER C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 10 WRITE (PRINTR,20) EQUAL 20 FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.) GO TO 50 30 WRITE (PRINTR,40) EQUAL 40 FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.) 50 GO TO (60,80,100,120,140,160), EQUAL 60 WRITE (PRINTR,70) 70 FORMAT (22H BLOCK SEQUENCE ERROR.) GO TO 180 80 WRITE (PRINTR,90) 90 FORMAT (20H BLOCK IS TOO SHORT.) GO TO 180 100 WRITE (PRINTR,110) 110 FORMAT (11H I/O ERROR.) GO TO 180 120 WRITE (PRINTR,130) 130 FORMAT (18H RECORD TOO LARGE.) GO TO 180 140 WRITE (PRINTR,150) 150 FORMAT (21H UNKNOWN RECORD TYPE.) GO TO 180 160 WRITE (PRINTR,170) 170 FORMAT (25H FIRST BLOCK NOT A LABEL.) GO TO 760 180 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1) INFILE=0 C C RETURN TO QUIT SEGMENT. C TRANS=9 GO TO 800 C 200 WRITE (PRINTR,210) 210 FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.) GO TO 760 220 WRITE (PRINTR,230) 230 FORMAT (//20H0INTAPE NOT DEFINED.) GO TO 760 240 WRITE (PRINTR,250) 250 FORMAT (//23H0UNABLE TO OPEN INTAPE.) GO TO 10 260 WRITE (PRINTR,270) 270 FORMAT (//23H0UNABLE TO OPEN OUTAPE.) GO TO 30 280 WRITE (PRINTR,290) 290 FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.) GO TO 760 300 WRITE (PRINTR,310) 310 FORMAT (//19H0DATE NOT SUPPLIED.) GO TO 760 320 WRITE (PRINTR,330) 330 FORMAT (//19H0SITE NOT SUPPLIED.) GO TO 760 340 WRITE (PRINTR,350) INTAPE 350 FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4) GO TO 760 360 WRITE (PRINTR,370) 370 FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.) GO TO 760 380 WRITE (PRINTR,390) 390 FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.) GO TO 760 400 WRITE (PRINTR,410) 410 FORMAT (//27H0COMMAND HAS IMPROPER DATE.) GO TO 760 420 WRITE (PRINTR,430) EQUAL 430 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.) GO TO 780 440 WRITE (PRINTR,450) 450 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.) IF (ICOMD) 780,560,780 460 WRITE (PRINTR,470) N1RECI 470 FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO 1N (,I5,2H).) GO TO 760 480 WRITE (PRINTR,490) EQUAL 490 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 500 WRITE (PRINTR,510) 510 FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.) GO TO 760 520 WRITE (PRINTR,530) 530 FORMAT (//23H0WORK FILE NOT DEFINED.) GO TO 760 540 WRITE (PRINTR,550) 550 FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.) GO TO 760 560 WRITE (PRINTR,570) EQUAL 570 FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.) GO TO 760 580 WRITE (PRINTR,590) 590 FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE 1R.) GO TO 760 600 WRITE (PRINTR,610) 610 FORMAT (//12H0TOO MANY (.) GO TO 760 620 WRITE (PRINTR,630) EQUAL 630 FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.) GO TO 760 640 WRITE (PRINTR,650) EQUAL 650 FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.) GO TO 760 660 WRITE (PRINTR,670) EQUAL 670 FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.) GO TO 760 680 WRITE (PRINTR,690) EQUAL 690 FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.) GO TO 760 700 WRITE (PRINTR,710) EQUAL 710 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 720 WRITE (PRINTR,730) N1RECI 730 FORMAT (//21H0INTAPE POSITIONED AT,I5,25H. BACKWARD SKIP IGNORED. 1) GO TO 780 740 WRITE (PRINTR,750) 750 FORMAT (//23H0COMMAND IS INCOMPLETE.) GO TO 760 751 WRITE (PRINTR,752) 752 FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA 1PE OR OUTPUT.) 760 WRITE (PRINTR,770) 770 FORMAT (23H COMMAND NOT PROCESSED.) 780 WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD) 790 FORMAT ((1X,80A1)) C C RETURN TO COMMAND PROCESSSOR. C CHAR1L=0 NERRS=MAX0(S(NUMBER),NERRS) NERRG=MAX0(NERRG,NERRS) TRANS=1 C C RETURN TO TRANSITION PROGRAM. C 800 RETURN C END SUBROUTINE EXCHC9 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO C ERRORS. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KQUIT /20/ C IF (INFILE.EQ.0) GO TO 10 IF (MODIFY.NE.82) GO TO 5 C 82 = ASCII R ACTION=2 C ACTION = 2 MEANS REWIND INFILE. CALL EXCHIM 5 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. CALL EXCHIM INFILE=0 NCHCMD=0 GO TO 50 10 IF (OPTC*OUFILE.EQ.0) GO TO 20 ACTION=0 NCHOUT=4 CALL EXCHOU (COMD(1,KQUIT)) 20 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) IF (OUTOPN.EQ.0) GO TO 30 C WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (ISTAT,OBLOCK,OUTREC) C CLOSE THE INPUT TAPE. 30 IF (INTOPN.EQ.0) GO TO 40 ISTAT=4 CALL EXCHRT (ISTAT,OBLOCK) C C RETURN TO MAIN PROGRAM. C 40 TRANS=0 IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG 45 FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.) GO TO 60 C C RETURN TO THE COMMAND DECODER. C 50 TRANS=1 60 RETURN C END =TES FILE=3 PROGRAM EXCHMN(INPUT=/180,OUTPUT=/180,TAPE5=INPUT,TAPE6=OUTPUT, 1 INTAPE,OUTAPE,TAPE7,TAPE10=/180,TAPE11=/180,TAPE12=/180, 2 TAPE13=/180,TAPE14=/180,TAPE15=/180) C C TAPES TAPE10,...,TAPE15 ARE AVAILABLE AS FILES THAT THE C USER MAY USE FOR DIRECTIVES AND SOURCE CARD FILES. C C INTAPE IS THE INPUT EXCHANGE TAPE. C TAPE7 IS USED AS A WORKING OR SCRATCH FILE. C OUTAPE IS THE OUTPUT EXCHANGE TAPE THAT WILL BE WRITTEN. C C TAPE EXCHANGE MAIN PROGRAM FOR CDC6000/7000 C C WRITTEN BY K. HASKELL, SANDIA LABS., ALBUQUERQUE, NM 87185. C REVISED JUN. 1, 1979. C REVISED NOV 27, 1979 BY W. V. SNYDER AT JPL, 91103. C REVISED FEB 22, 1980 BY W. V. SNYDER AT JPL, 91103. C REVISED DEC 15, 1980 BY R. J. HANSON AT SNLA, 87185. C INTEGER IBLOCK(960) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHXC/ XLATE PRINTR=6 READER=5 NWCBI=24 C CALL EXCH (IBLOCK) STOP C END BLOCK DATA C C BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/ DATA INTEXT /0/, INALT /0/ C DATA CHAR1L /1H1/ C A U T H DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1) /65,85,84,72/ C C O M M DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2) /67,79,77,77/ C C O P Y DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3) /67,79,80,89/ C D A T A DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4) /68,65,84,65/ C D A T E DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5) /68,65,84,69/ C G R O U DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6) /71,82,79,85/ C I N D E DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7) /73,78,68,69/ C I N P U DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8) /73,78,80,85/ C N A M E DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9) /78,65,77,69/ C I N T A DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/ C K E Y W DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/ C L I M I DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/ C M A C H DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/ C O P T I DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/ C O R I G DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/ C O U T A DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/ C O U T P DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/ C P R E D DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/ C P R I N DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/ C Q U I T DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/ C R E A D DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/ C R E F E DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/ C R E M O DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/ C R E W I DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/ C S I T E DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/ C S K I P DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/ C T E X T DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/ C T I T L DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/ C U P D A DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/ C W O R K DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/ C C O N T DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/ C I D E N DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/ C I N C L DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/ C S I G N DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/ C M A R G DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/ DATA IDSTEP /0/, IDTXTL /0/ DATA INDEX /0/ DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/ DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/ DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/ DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/ DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/ DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/ DATA INDEXS(25),INDEXS(26) /0,0 / DATA INTOPN /0/ DATA ITYPEI /0/ DATA LIMIT /0/ DATA MARGIN /180/ DATA NCCBI /180/ DATA NCCBO /180/ DATA NCHCMD /0/ DATA NCHMAX /180/ DATA NCOMDP /35/ DATA NCOMDT /35/ DATA NDATAO /3591/ DATA NERRCO /0/ DATA NERRG /0/ DATA NRWORK /0/ DATA OUTOPN /0/ DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/ DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/ DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/ DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/ DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/ DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/ DATA OPTVAL(25),OPTVAL(26) /0,0 / DATA PHASE /1/ C INDICATE THAT NO PREDICATES ARE DEFINED. DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/ DATA PRED(1,6),PRED(1,7),PRED(1,8) /0,0,0 / DATA SITE(1) /0/ DATA TITLE(1) /32/ C 32 = ASCII BLANK DATA TODAY (1) /0/ DATA TRANS /1/ C C TRANSLATION TABLE FROM ASCII TO HOLLERITH. USES ASCII GRAPHICS. C TRANSLATES CONTROL CHARACTERS (<32) TO '$'. C MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES. C DATA XLATE(1), XLATE(2), XLATE(3), XLATE(4) /1H$,1H$,1H$,1H$/ DATA XLATE(5), XLATE(6), XLATE(7), XLATE(8) /1H$,1H$,1H$,1H$/ DATA XLATE(9), XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/ DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/ DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/ DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/ DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/ DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/ DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/ DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/ DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/ DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H// DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/ DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/ DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/ DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/ DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/ DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/ DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/ DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/ DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/ DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/ DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/ DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/ DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/ DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/ DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/ DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/ DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/ DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/ DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/ DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/ END SUBROUTINE EXCH (IBLOCK) C C CDC 6600/7600 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM C INTEGER IBLOCK(1) C C WRITTEN BY K. HASKELL, SANDIA LABS., ALBUQUERQUE, NM 87185. C REVISED JUN. 1, 1979. C REVISED NOV 27, 1979 BY W. V. SNYDER AT JPL, 91103. C REVISED FEB 22, 1980 BY W. V. SNYDER AT JPL, 91103. C REVISED JAN. 21, 1981 BY R. J. HANSON AT SNLA 87185 C C ALLOCATE SPACE FOR TAPE OUTPUT C INTEGER OBLOCK(480) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) INTEGER DISASC(64) INTEGER CDCMDE COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE COMMON /DISASC/ DISASC COMMON /CDCMDE/ CDCMDE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C SET CDCMDE=1 TO NOTE THAT 6-BIT MODE FOR CDC USAGE IS NORMAL. C THE SUBROUTINE EXCHCX( ) FOR CDC NOW RECOGNIZES TWO NEW C COMMANDS, 12BIT AND 6BIT. 12BIT SETS CDCMDE=2, WHILE 6BIT C SETS CDCMDE=1. CDCMDE=1 C C DATE COMPUTATION USING THE SUBROUTINE DATE( ) PROVIDED BY THE C CDC FORTRAN LIBRARY. CALL DATE(IDAY) IZERO=AND(COMPL(MASK(54)),SHIFT(1H0,6)) DO 20 L=1,3 DO 10 J=1,3 IDAY=SHIFT(IDAY,6) IF(.NOT.(J.GT.1)) GO TO 10 TODAY(2*(L-1)+J-1)=AND(COMPL(MASK(54)),IDAY)-IZERO+48 10 CONTINUE 20 CONTINUE C START SANDIA NATL. LABS. 87185 SITE DEFINITION. C SITE(1)=83 C SITE(2)=78 C SITE(3)=76 C SITE(4)=65 C SITE(5)=32 C SITE(6)=56 C SITE(7)=55 C SITE(8)=49 C SITE(9)=56 C SITE(10)=53 C DO 40 I=11,40 C 40 SITE(I)=32 C C THE ABOVE SITE MESSAGE IS ONLY FOR SANDIA NATL. LABS., 87185. C IT SAYS.. SNLA 87185. C C PUT IN TWO CDC DEPENDENT COMMANDS, 6BIT AND 12BI(T). NCOMDT=NCOMDP+2 COMD(1,NCOMDP+1)=54 COMD(2,NCOMDP+1)=66 COMD(3,NCOMDP+1)=73 COMD(4,NCOMDP+1)=84 C COMD(1,NCOMDP+2)=49 COMD(2,NCOMDP+2)=50 COMD(3,NCOMDP+2)=66 COMD(4,NCOMDP+2)=73 NWCBO=24 WORKF=7 C C CONSTRUCT TRANSLATE TABLE FROM DISPLAY CODE TO ASCII. C USED IN EXCHIM. C DO 30 I = 32,95 30 DISASC(SHIFT(AND(MASK(6),XLATE(I+1)),6)+1)=I CALL EXCHTR (IBLOCK,OBLOCK) RETURN C END SUBROUTINE EXCHIM C C READ A COMMAND OR TEXT IMAGE FROM 1. ALTERNATE CORRECTION FILE, C 2. TEXT FILE, C 3. INPUT FILE, C 4. SYSTEM READER. C PUT THE HOLLERITH COMMAND IN HOLCMD, C PUT THE ASCII EQUIVALENT IN COMAND, C PUT THE NUMBER OF CHARACTERS IN NCHCMD. C IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1. C C THIS IS A CDC 6600-7600 VERSION. IT READS 180 CHARACTER IMAGES. C IT TRANSLATES CDC GRAPHIC TO ASCII CODE. C C R. J. HANSON, SANDIA LABS., ALBUQUERQUE, NM., DECEMBER, 1980. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER DISASC(64) INTEGER CDCMDE COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /DISASC/ DISASC COMMON /CDCMDE/ CDCMDE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C TRANSLATE FROM CDC GRAPHIC TO ASCII CODES. C USE CDC GRAPHIC TO ASCII CODE TRANSFORMATION TABLE. C REF. SCOPE 2.1 REFERENCE MANUAL, CODE CONVERSION TABLES. C INTEGER BLANK C DATA BLANK /45/ C C DETERMINE WHICH FILE TO READ. IF (ACTION.EQ.0) GO TO 10 IF (ACTION.NE.2) GO TO 250 10 I = INALT IF (I.GT.0) GO TO 20 I = INTEXT IF (I.NE.0) GO TO 20 I = INFILE IF (I.EQ.0) I = READER 20 IF (ACTION.NE.2) GO TO 30 REWIND I GO TO 250 30 READ (I,99999) (HOLCMD(J),J=1,180) IF (EOF(I).NE.0.) GO TO 260 99999 FORMAT (180R1) C C SCAN THE CARD IMAGE FROM THE RIGHT. FIND LAST C NON-BLANK CHARACTER. DO 40 I=1,180 IF (HOLCMD(181-I).NE.BLANK) GO TO 50 40 CONTINUE NCHCMD = 1 GO TO 60 50 NCHCMD = 181 - I 60 DO 70 I=1,NCHCMD COMAND(I) = DISASC(HOLCMD(I)+1) 70 CONTINUE IF (.NOT.(CDCMDE.EQ.2)) GO TO 230 C C THESE NEXT LINES CONVERT CERTAIN PAIRS OF 6 BIT CDC CODES C TO AN EQUIVALENT ASCII REPRESENTATION. ISHAVE = COMPL(MASK(54)) I = 1 IP = 0 80 IF (.NOT.(I.LT.NCHCMD)) GO TO 190 IP = IP + 1 NEXT = COMAND(I+1) C C TEST FOR A CIRCUMFLEX. IF (.NOT.(COMAND(I).EQ.94)) GO TO 120 C C TEST FOR THE NEXT CHAR. = LETTER OF ALPHABET. IF (.NOT.(65.LE.NEXT .AND. NEXT.LE.90)) GO TO 90 COMAND(IP) = NEXT + 32 HOLCMD(IP) = HOLCMD(I+1) I = I + 1 GO TO 180 C C TEST FOR FOUR SPECIAL CHARACTERS. 90 IF (.NOT.(48.LE.NEXT .AND. NEXT.LE.51)) GO TO 95 COMAND(IP) = NEXT + 75 HOLCMD(IP)=AND(ISHAVE,SHIFT(4H[\]^,6*(NEXT-47))) I = I + 1 GO TO 180 C C TEST FOR ASCII CHARACTERS 0-31 EQUIVALENT. 95 IF (.NOT.(32.LE.HOLCMD(I+1).AND.HOLCMD(I+1).LE.63)) GO TO 170 I = I + 1 COMAND(IP) = HOLCMD(I) - 32 HOLCMD(IP) = HOLCMD(I) GO TO 180 C C TEST FOR COMMERCIAL AT SIGN. 120 IF (.NOT.(COMAND(I).EQ.64)) GO TO 170 C C TEST FOR AT SIGN EQUIVALENT. IF (.NOT.(NEXT.EQ.65)) GO TO 130 COMAND(IP) = 64 HOLCMD(IP)=AND(ISHAVE,SHIFT(1H@,6)) I = I + 1 GO TO 180 C C TEST FOR CIRCUMFLEX EQUIVALENT. 130 IF (.NOT.(NEXT.EQ.66)) GO TO 140 COMAND(IP) = 94 HOLCMD(IP)=AND(ISHAVE,SHIFT(1H^,6)) I = I + 1 GO TO 180 C C TEST FOR ACCENT GRAVE EQUIVALENT. 140 IF (.NOT.(NEXT.EQ.71)) GO TO 150 COMAND(IP) = 96 HOLCMD(IP)=AND(ISHAVE,SHIFT(1H\,6)) I = I + 1 GO TO 180 C C TEST FOR COLON EQUIVALENT. 150 IF(.NOT.(NEXT.EQ.68)) GO TO 170 COMAND(IP)=58 HOLCMD(IP)=AND(ISHAVE,SHIFT(1H:,6)) I = I + 1 GO TO 180 170 COMAND(IP) = COMAND(I) HOLCMD(IP) = HOLCMD(I) 180 I = I + 1 GO TO 80 190 IF (.NOT.(I.EQ.NCHCMD)) GO TO 200 IP = IP + 1 COMAND(IP) = COMAND(I) HOLCMD(IP) = HOLCMD(I) 200 NCHCMD = IP C C END OF CDC 12 BIT TO ASCII CONVERSION. 230 DO 240 I=1,NCHCMD HOLCMD(I) = SHIFT(HOLCMD(I),54) 240 CONTINUE 250 ACTION = 0 RETURN 260 NCHCMD = -1 RETURN END SUBROUTINE EXCHOU (OUTPUT) C C NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM. C C OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN. C THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT. C C THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180), C THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179). IF OUTPUT(180) C IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE. IF OUTPUT(180) C IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW C IMAGE. CDC6600/7600 VERSION. C INTEGER OUTPUT(1) INTEGER WORK(180) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) INTEGER CDCMDE COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /CDCMDE/ CDCMDE COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C C DECIDE WHETHER TO OPEN, CLOSE OR WRITE. C IF (IABS(ACTION).EQ.2) GO TO 50 C IABS(ACTION) = 2 MEANS START OR END OF PROGRAM. IF (ACTION) 40,10,50 C WRITE 10 IF(.NOT.(CDCMDE.EQ.1)) GO TO 60 DO 20 I=1,NCHOUT J=OUTPUT(I) 20 WORK(I)=XLATE(J+1) NOUT=NCHOUT GO TO 70 60 N=0 DO 80 I=1,NCHOUT N=MIN0(N,178) J=OUTPUT(I) IF(.NOT.(97.LE.J .AND. J.LE.122)) GO TO 100 C C 12 BIT CODE FOR LOWER CASE LETTERS OF THE ALPHABET. WORK(N+1)=1H^ WORK(N+2)=XLATE(J-31) N=N+2 GO TO 80 100 CONTINUE IF(.NOT.(123.LE.J .AND. J.LE.126)) GO TO 110 C C 12 BIT CODE FOR FOUR SPECIAL CHARS. WORK(N+1)=1H^ WORK(N+2)=XLATE(J-74) N=N+2 GO TO 80 110 CONTINUE IF(.NOT.(J.EQ.64)) GO TO 120 C C 12 BIT CODE FOR AT SIGN. WORK(N+1)=1H@ WORK(N+2)=1HA N=N+2 GO TO 80 120 CONTINUE IF(.NOT.(J.EQ.94)) GO TO 130 C C 12 BIT CODE FOR CIRCUMFLEX. WORK(N+1)=1H@ WORK(N+2)=1HB N=N+2 GO TO 80 130 CONTINUE IF(.NOT.(J.EQ.96)) GO TO 140 C C 12 BIT CODE FOR ACCENT GRAVE. WORK(N+1)=1H@ WORK(N+2)=1HG N=N+2 GO TO 80 140 CONTINUE IF(.NOT.(J.EQ.58)) GO TO 150 C C 12 BIT CODE FOR COLON. WORK(N+1)=1H@ WORK(N+2)=1HD N=N+2 GO TO 80 150 CONTINUE C C LOOK FOR SPECIAL ASCII CHARACTERS 0-31. IF (.NOT.(0.LE.J .AND. J.LE.31)) GO TO 155 WORK(N+1) = 1H^ WORK(N+2) = SHIFT(J+32,54) N = N+2 GO TO 80 155 CONTINUE C C ALL OTHER ASCII CODES TRANSLATE TO 6 BIT CODES. WORK(N+1)=XLATE(J+1) N=N+1 80 CONTINUE NOUT=N 70 WRITE (OUFILE,30) (WORK(I),I=1,NOUT) 30 FORMAT (180A1) GO TO 50 C CLOSE 40 END FILE OUFILE C OPEN, RETURN 50 ACTION=0 RETURN END SUBROUTINE EXCHPA (BUFIN,BUF9T) C C CDC 6600/7600 VERSION C C WRITTEN BY -- K. HASKELL, SANDIA LABS C C REVISED JUN. 1, 1979. C C PACK A BLOCK OF NCH CHARACTERS WRITTEN ONE CHARACTER PER WORD C IN BUFIN TO 9-TRACK FORMAT OUTPUT BUFFER BUF9T. C INTEGER BUFIN(1),BUF9T(1) INTEGER TEMP DATA IPEEL8/377B/,IPEEL4/17B/ C C DEFINE NUMBER OF CHARACTERS TO PACK NCH=180 C C DEFINE THE NUMBER OF 15-CHARACTER GROUPS FOR NCH CHARACTERS NGR=NCH/15 C C FILL ONE GROUP (I.E. 15 CHARS) OF BUF9T AT ONCE C DO 50 I=1,NGR K=2*I-1 C PACK FIRST 7 CHARS OF GROUP TEMP=0 L=(I-1)*15 DO 20 J=1,7 L=L+1 C SHIFT 8 BITS INTO DESIRED POSITION TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),60-8*J),TEMP) 20 CONTINUE C PACK CHAR. WHICH SPANS TWO WORDS L=L+1 TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),-4),TEMP) C BUF9T(K)=TEMP C TEMP=AND(MASK(4),SHIFT(BUFIN(L),56)) C PACK LAST 7 CHARS. DO 40 J=1,7 L=L+1 TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),56-8*J),TEMP) 40 CONTINUE C BUF9T(K+1)=TEMP C 50 CONTINUE C RETURN END SUBROUTINE EXCHRT (ISTAT,DBLOCK) C C CDC 6600 VERSION C C MAY 6, 1977 -- K. H. HASKELL, R. J. HANSON, SANDIA LABS C DEC 20, 1978 -- MINOR MODS AS PER W V SNYDER, JPL C C READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE, INTAPE. C INPUT -- C ISTAT = 1 MEANS OPEN TAPE WITH NO REWIND. C ISTAT = 2 MEANS REWIND TAPE (OR CLOSE WITH REWIND). C ISTAT = 3 MEANS READ. C ISTAT = 4 MEANS CLOSE WITH NO REWIND. C (NOTE -- ISTAT = 1 OR 4 CAUSE NULL OPERATIONS.) C C OUTPUT -- C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR WAS DETECTED. C C DBLOCK IS THE RAW DATA BLOCK, EXACTLY AS IT COMES FROM THE C TAPE. C INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C I = ISTAT ISTAT = 0 GO TO (110,100,10,110), I C C READ A BLOCK (ISTAT=3) C 10 CONTINUE C CALCULATE NWORDS=NUMBER OF WORDS EXPECTED. FOR THE FIRST C BLOCK READ FROM THE TAPE (I.E., THE LABEL) NDATAI AND NERRCI C HAVE BEEN INITIALIZED IN THE MAIN PROGRAM TO NDATAI=171 AND C NERRCI=0, IN ORDER TO READ 180 CHARACTERS. AFTER THE LABEL C IS READ, NDATAI AND NERRCI ARE REASSIGNED ACCORDING TO THE C INFORMATION IN THE LABEL. C NDATAI IS DEFINED AS THE NUMBER OF DATA CHARACTERS PER BLOCK. C NERRCI IS DEFINED AS THE NUMBER OF ERROR CONTROL CHARACTERS C PER BLOCK. C SINCE THE CDC 6600/7600 HAS A 60-BIT WORD, EVERY 2 WORDS OF C DBLOCK WILL HOLD 15 8-BIT CHARACTERS OF DATA. C NWORDS = 2*((NDATAI + NERRCI + 9 + 14)/15) DO 50 I=1,2 BUFFER IN (INTAPE,1) (DBLOCK(1),DBLOCK(NWORDS)) IF (UNIT(INTAPE)) 20,40,80 C SET NCDBI TO INDICATE THE NUMBER OF CHARACTERS OF DATA IN DBLOCK. 20 L = LENGTH(INTAPE) NCDBI = MIN0(NDATAI+NERRCI+9,15*L/2) GO TO 110 C C AN END-OF-FILE WAS ENCOUNTERED. C 40 IF (BLKSQI.NE.0) GO TO 60 C ALLOW EXACTLY ONE END-OF-FILE IF TRYING TO READ THE LABEL. 50 CONTINUE 60 WRITE (PRINTR,70) 70 FORMAT (//30H0EOF ENCOUNTERED ON INPUT TAPE) ISTAT = 3 GO TO 110 C C PARITY ERROR ENCOUNTERED C 80 WRITE (PRINTR,90) 90 FORMAT (//39H0PARITY ERROR ENCOUNTERED ON INPUT TAPE) ISTAT=3 GO TO 110 C C REWIND THE EXCHANGE TAPE (ISTAT=2) C 100 CONTINUE REWIND INTAPE C C TO OPEN (OR CLOSE) INTAPE WITH NO REWIND. C (ISTAT=1 OR ISTAT=4) C 110 CONTINUE C RETURN C END SUBROUTINE EXCHUN (BUF9T,BUFOUT) C C CDC 6600/7600 VERSION C C MAY 6, 1977 -- K H HASKELL, SANDIA LABS C REVISED BY R. J. HANSON, SANDIA LABS., OCTOBER, 1979. C C READ A BLOCK NCH CHARACTERS LONG FROM THE INPUT BUFFER, BUF9T, C AND WRITE ONE 8-BIT CHARACTER IN EACH WORD OF THE OUTPUT BUFFER, C BUFOUT. C INTEGER BUF9T(1),BUFOUT(1) DATA IPEEL8 /377B/, IPEEL4 /17B/ C C DEFINE NUMBER OF CHARACTERS TO UNPACK. NCH = 180 C C DEFINE THE NUMBER OF 15-CHARACTER GROUPS FOR NCH CHARACTERS. NGR = NCH/15 C C PROCESS ONE GROUP (I.E., 2 WORDS) OF BUF9T AT ONCE. L=0 DO 50 I=1,NGR K = 2 * I - 1 C UNPACK FIRST 7 CHARS. OF GROUP. IBUF9T=BUF9T(K) DO 20 J=8,56,8 L=L+1 C SHIFT DESIRED 8 BITS INTO LOW-ORDER 8 POSITIONS. C MASK 52 ZEROS AND 8-BIT CHAR. INTO OUTPUT WORD. BUFOUT(L)=AND(IPEEL8, SHIFT(IBUF9T,J)) 20 CONTINUE C UNPACK CHAR. WHICH IS SPLIT BETWEEN 2 WORDS. L=L+1 C MASK AWAY 56 HIGH-ORDER BITS. C SHIFT LOW-ORDER 4 BITS LEFT 4 POSITIONS. C SHIFT HIGH-ORDER 4 BITS LEFT CIRC. INTO LOW-ORDER 4 POSITIONS. BUFOUT(L)=OR(SHIFT(AND(IPEEL4,BUF9T(K)),4), 1 AND(IPEEL4,SHIFT(BUF9T(K+1),4))) C UNPACK LAST 7 CHARS. OF GROUP. IBUF9T=BUF9T(K+1) DO 40 J=12,60,8 L=L+1 BUFOUT(L)=AND(IPEEL8,SHIFT(IBUF9T,J)) 40 CONTINUE C 50 CONTINUE C RETURN END SUBROUTINE EXCHWT (ISTAT,OUTBUF) C C CDC 6600/7600 VERSION C C WRITTEN BY -- K. HASKEL, SANDIA LABS C C REVISED JUN. 1, 1979. C C WRITE A BLOCK TO, OR CLOSE, THE EXCHANGE TAPE, OUTAPE. C C INPUT-- C ISTAT = 1 MEANS OPEN TAPE WITH NO REWIND C = 2 MEANS WRITE OUTBUF ON TAPE C = 3 MEANS WRITE ENDFILE AND CLOSE WITH NO REWIND C C OUTBUF THE DATA TO BE WRITTEN TO TAPE C C OUTPUT-- C ISTAT = 0 IF EVERYTHING IS OKAY C = 3 IF ERRORS OCCURRED (AN ERROR MESSAGE WILL C BE PRINTED) C INTEGER OUTBUF(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C I=ISTAT ISTAT=0 GO TO (50,10,20), I C C WRITE BUFFER TO TAPE (ISTAT=2 ON INPUT). C 10 CONTINUE C CALCULATE NWORDS=NUMBER OF WORDS OF DATA WRITTEN. EACH PAIR OF C CDC 60-BIT WORDS HOLDS 15 8-BIT CHARACTERS OF DATA. NWORDS=2*((CCDBO+14)/15) IF (BLKSQO.NE.0) NWORDS=2*((NDATAO+NERRCO+9+14)/15) BUFFER OUT (OUTAPE,1) (OUTBUF(1),OUTBUF(NWORDS)) IF (UNIT(OUTAPE))50,30,35 C C WRITE ENDFILE, CLOSE TAPE WITH NO REWIND (ISTAT=3) C 20 CONTINUE ENDFILE OUTAPE GO TO 50 C C AN END-OF-FILE WAS ENCOUNTERED C 30 WRITE (PRINTR,31) 31 FORMAT (//40H EOF ENCOUNTERED ON EXCHANGE OUTPUT TAPE) ISTAT=3 GO TO 50 C C PARITY ERROR OCCURRED ON OUTPUT TAPE C 35 WRITE (PRINTR,36) 36 FORMAT (//49H PARITY ERROR ENCOUNTERED ON EXCHANGE OUTPUT TAPE) ISTAT=3 C C TO OPEN TAPE WITH NO REWIND (ISTAT=1) C 50 CONTINUE C RETURN END SUBROUTINE EXCHAH (RECORD,NCHAR) C C CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO C HOLLERITH FORMAT. C THIS PROGRAM IS NOT MACHINE SENSITIVE. C C RECORD IS THE RECORD TO BE CONVERTED. THE HOLLERITH IS STORED C IN RECORD ALSO INTEGER RECORD(1) C C NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED C INTEGER XLATE(128) COMMON /EXCHXC/ XLATE C C DO 10 I=1,NCHAR J=RECORD(I) 10 RECORD(I)=XLATE(J+1) RETURN END SUBROUTINE EXCHFO (IOP) C C OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM. C IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS C OPEN FILE. IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3 C MEANS WORK FILE, = 4 MEANS INFILE. IOP = 4 IS USED ONLY BY THE C BOOTSTRAP PROGRAM. C INTEGER IOP C INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C RETURN C END SUBROUTINE EXCHSL C C LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS. C C EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE C SEGMENT. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C RETURN END SUBROUTINE EXCHTR (IBLOCK,OBLOCK) C C TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER. C INTEGER IBLOCK(1), OBLOCK(1) C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4. C CALL EXCHFO (1) CALL EXCHFO (2) WORKF=-IABS(WORKF) C 10 IF (TRANS.LE.0) RETURN CALL EXCHSL C LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS. GO TO (11,12,13,14,15,16,17,18,19), TRANS C COMMAND PARSER 11 CALL EXCHC1 (IBLOCK,OBLOCK) GO TO 10 C IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE 12 CALL EXCHC2 GO TO 10 C OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE. 13 CALL EXCHC3 (IBLOCK,OBLOCK) GO TO 10 C COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE. 14 CALL EXCHC4 (IBLOCK) GO TO 10 C COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE. 15 CALL EXCHC5 (IBLOCK,OBLOCK) GO TO 10 C COPY TEXT FROM INTAPE TO OUTAPE 16 CALL EXCHC6 (IBLOCK,OBLOCK) GO TO 10 C TEXT COMMAND 17 CALL EXCHC7 (IBLOCK,OBLOCK) GO TO 10 C ERROR MESSAGES 18 CALL EXCHC8 GO TO 10 C QUIT 19 CALL EXCHC9 (IBLOCK,OBLOCK) GO TO 10 END SUBROUTINE EXCHGB (ISTAT,DBLOCK) C C READ A BLOCK FROM THE EXCHANGE TAPE. C IGNORE THE ERROR CONTROL SEGMENT. C CHECK THE BLOCK SEQUENCE NUMBER. C CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER, C OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C C C READ A BLOCK FROM INTAPE. C BLKSQI=BLKSQI+1 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 160 C C GET INFORMATION OUT OF THE BLOCK HEADER. C CCDBI=NERRCI CWDBI=NWCBI*(CCDBI/NCCBI)+1 CPCBI=MOD(CCDBI,NCCBI) CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) DO 110 JUMP=1,9 CCDBI=CCDBI+1 CPCBI=CPCBI+1 IF (CCDBI.GT.NCDBI) GO TO 130 IF (CPCBI.LE.NCCBI) GO TO 10 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 10 GO TO (20,30,40,50,60,70,80,90,100), JUMP 20 NEWBLK=256*CBLCKI(CPCBI) GO TO 110 30 NEWBLK=NEWBLK+CBLCKI(CPCBI) GO TO 110 40 LASTI=CBLCKI(CPCBI) GO TO 110 50 L1PRGI=256*CBLCKI(CPCBI) GO TO 110 60 L1PRGI=L1PRGI+CBLCKI(CPCBI) GO TO 110 70 N1RECI=256*CBLCKI(CPCBI) GO TO 110 80 N1RECI=N1RECI+CBLCKI(CPCBI) GO TO 110 90 L1RECI=256*CBLCKI(CPCBI) GO TO 110 100 L1RECI=L1RECI+CBLCKI(CPCBI) 110 CONTINUE C C CHECK THE BLOCK SEQUENCE NUMBER. C IF (BLKSQI.EQ.NEWBLK) GO TO 150 ISTAT=1 WRITE (PRINTR,120) NEWBLK,BLKSQI 120 FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I 15//) BLKSQI=NEWBLK GO TO 160 C C FORMAT ERROR C 130 ISTAT=2 GO TO 160 C C CHECK L1PRGI AND L1RECI. C 150 IF (L1PRGI.GT.NCDBI) GO TO 130 IF (L1RECI.GT.NCDBI) GO TO 130 ISTAT=0 160 RETURN C END SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD) C C GET A RECORD FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK). C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE C SPACE ALLOWED BY THE USER. (POSITION IS STILL OK). C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM C CONTROL RECORDS. NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS. C ISTAT=0 NCHACT=0 10 JUMP=1 GO TO 260 20 NG=CBLCKI(CPCBI) IF (NG.EQ.0) GO TO 90 IF (NG.NE.255) GO TO 30 C C END OF SHORT TAPE BLOCK. C CCDBI=NCDBI GO TO 10 C C UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO C THE USER RECORD AREA. C 30 ITYPEI=0 IF (MODEI.EQ.0) GO TO 40 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG 40 IG=0 50 JUMP=2 GO TO 260 60 NR=CBLCKI(CPCBI) IF (MODEI.EQ.0) GO TO 70 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR GO TO 160 70 IR=0 C PUT REMVI INTO THE USER RECORD NR TIMES. 80 IF (IR.GE.NR) GO TO 160 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI IR=IR+1 GO TO 80 C C THE NEXT RECORD IS A CONTROL RECORD. FIND OUT WHAT KIND. C 90 JUMP=3 GO TO 260 100 ITYPEI=CBLCKI(CPCBI) IF (ITYPEI.LT.65) GO TO 250 C 65 = ASCII A IF (ITYPEI.GT.90) GO TO 250 C 90 = ASCII Z I=ITYPEI-64 C A B C D E F G H I J K L M N O GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160 1,110,160,220,160,160,160,160,160,160,160,160), I C P Q R S T U V W X Y Z C C P - PROGRAM HEADER C C CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER 110 REMVI=32 C RESET THE REMOVED CHARACTER TO ASCII BLANK. JUMP=4 GO TO 260 120 L1PRGI=256*CBLCKI(CPCBI) JUMP=5 GO TO 260 130 L1PRGI=L1PRGI+CBLCKI(CPCBI) JUMP=6 GO TO 260 140 N1RECI=256*CBLCKI(CPCBI) JUMP=7 GO TO 260 150 N1RECI=N1RECI+CBLCKI(CPCBI) C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 160 JUMP=8 GO TO 260 170 NC=CBLCKI(CPCBI) IF (ITYPEI.NE.0) GO TO 180 IF (MODEI.EQ.0) GO TO 180 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC C COPY NC CHARACTERS TO THE USER RECORD AREA. 180 IC=0 JUMP=9 190 IF (IC.GE.NC) IF (ITYPEI) 240,210,240 GO TO 260 200 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI) IC=IC+1 GO TO 190 210 IG=IG+1 IF (IG-NG) 50,240,240 C C J - UPDATING AND END OF INPUT TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 220 JUMP=10 GO TO 260 230 RECORD(1)=CBLCKI(CPCBI) NCHACT=1 IF (ITYPEI.EQ.82) REMVI=RECORD(1) C 82 = ASCII R C C RETURN TO THE USER PROGRAM. C 240 IF (NCHACT.GT.NCHMAX) ISTAT=4 GO TO 290 C C CONTROL RECORD TYPE CANNOT BE DETERMINED. C 250 ISTAT=5 GO TO 290 C C GET A CHARACTER FROM CBLOCK. UNPACK A NEW BLOCK IF NECESSARY. C READ MORE TAPE IF NECESSARY. C 260 CPCBI=CPCBI+1 CCDBI=CCDBI+1 IF (CCDBI.LE.NCDBI) GO TO 270 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 290,260,290 270 IF (CPCBI.LE.NCCBI) GO TO 280 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 280 GO TO (20,60,100,120,130,140,150,170,200,230), JUMP 290 RETURN C END SUBROUTINE EXCHNP (ISTAT,DBLOCK) C C SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE C TAPE. C THIS MODULE IS MACHINE INSENSITIVE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) ISTAT=0 IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20 C C CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK. C 10 IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20 C 76 = ASCII L C C NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK. CCDBI=L1PRGI-1 I=NWCBI*(CCDBI/NCCBI)+1 IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI) CWDBI=I CPCBI=MOD(CCDBI,NCCBI) GO TO 40 C C NO MORE HEADERS IN THIS BLOCK. C 20 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 40,10,40 C C END OF FILE. C 30 ISTAT=7 C 40 RETURN C END SUBROUTINE EXCHPB (ISTAT,DBLOCK) C C WRITE A BLOCK ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK. INTEGER WORK(9) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C C PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK. C BLKSQO=BLKSQO+1 WORK(1)=BLKSQO/256 WORK(2)=MOD(BLKSQO,256) WORK(3)=LASTO WORK(4)=L1PRGO/256 WORK(5)=MOD(L1PRGO,256) WORK(6)=N1RECO/256 WORK(7)=MOD(N1RECO,256) WORK(8)=L1RECO/256 WORK(9)=MOD(L1RECO,256) C CPCBO=MOD(NERRCO,NCCBO) CWDBO=(NERRCO/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) C DO 10 I=1,9 CPCBO=CPCBO+1 IF (CPCBO.LE.NCCBO) GO TO 10 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) CWDBO=CWDBO+NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) CPCBO=1 10 CBLCKO(CPCBO)=WORK(I) CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) C C WRITE THE DATA BLOCK ON TAPE. C ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L). C IF (LASTO.NE.76) GO TO 20 ISTAT=3 CALL EXCHWT (ISTAT,DBLOCK) GO TO 30 C C COMPUTE POINTERS FOR NEXT BLOCK OUT. C 20 L1PRGO=0 LLPRGO=0 N1RECO=0 L1RECO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 C 30 RETURN C END SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD) C C WRITE A RECORD ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A C TEXT RECORD CONTAINS MORE THAN 254 GROUPS. C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER GC,RC(255),CC(255) C GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C ISTAT=0 INCHAR=0 C C DETERMINE THE RECORD TYPE. C IF (NCHOUT.NE.255) GO TO 10 ITYPEO=255 GO TO 70 10 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO IF (ITYPEO.NE.0) GO TO 30 C C DATA RECORD. C IF (MODEO.NE.0) GO TO 170 C COMPRESS THE RECORD. CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255) IF (GC.GE.255) GO TO 210 IG=0 C OUTPUT THE GROUP COUNT. CBLCKO(CPCBO)=GC JUMP=1 GO TO 230 20 IG=IG+1 IF (IG.GT.GC) GO TO 250 NC=CC(IG) INCHAR=INCHAR+RC(IG) C OUTPUT REMOVED CHARACTER COUNT. CBLCKO(CPCBO)=RC(IG) JUMP=2 GO TO 230 C C THE USER SAYS HE HAS A CONTROL RECORD TO WRITE. FIND OUT C WHAT KIND. C 30 IF (ITYPEO.LT.65) GO TO 220 C 65 = ASCII A IF (ITYPEO.GT.90) GO TO 220 C 90 = ASCII Z I=ITYPEO-64 C A B C D E F G H I J K L M N O P Q R S GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40, 140,40,40,40,40,40,40), I C T U V W X Y Z C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE TYPE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 40 IF (NCHOUT-255) 100,100,210 C C END OF FILE. C 50 IF (NERRCO+NDATAO+7-CCDBO) 70,80,80 C C P - PROGRAM HEADER. C 60 IF (NCHOUT.GT.255) GO TO 210 REMVO=32 C RESET REMOVED CHARACTER TO ASCII BLANK. IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80 IF (CCDBO.EQ.NERRCO+10) GO TO 80 C C END OF SHORT TAPE BLOCK. C 70 CBLCKO(CPCBO)=255 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250 C 69 = ASCII E C 80 = ASCII P L1RECO=CCDBO-NERRCO 80 IF (LLPRGO.EQ.0) GO TO 90 C LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK. CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) NC=MOD(LLPRGO+1,NCCBO) NW=((LLPRGO+1)/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) CBLCKO(NC+1)=CCDBO/256 IF (NC+1.LT.NCCBO) GO TO 85 CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) NW=NW+NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) NC=-1 85 CBLCKO(NC+2)=MOD(CCDBO,256) CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) CALL EXCHUN (DBLOCK(CWDBO),CBLCKO) C UPDATE TABLE OF CONTENTS POINTERS 90 LLPRGO=CCDBO IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO NLRECO=NLRECO+1 IF (N1RECO.EQ.0) N1RECO=NLRECO 100 CBLCKO(CPCBO)=0 JUMP=3 GO TO 230 110 CBLCKO(CPCBO)=ITYPEO JUMP=4 GO TO 230 120 IF (ITYPEO.NE.69) GO TO 130 C 69 = ASCII E LASTO=76 GO TO 70 130 IF (ITYPEO.NE.80) GO TO 170 C 80 = ASCII P CBLCKO(CPCBO)=0 JUMP=5 GO TO 230 140 CBLCKO(CPCBO)=0 JUMP=6 GO TO 230 150 CBLCKO(CPCBO)=NLRECO/256 JUMP=7 GO TO 230 160 CBLCKO(CPCBO)=MOD(NLRECO,256) JUMP=8 GO TO 230 C 170 NC=NCHOUT 180 CBLCKO(CPCBO)=NC IC=0 JUMP=9 C PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD. IF (ITYPEO.EQ.82) GO TO 190 IF (ITYPEO.EQ.74) GO TO 190 IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230 190 IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250 INCHAR=INCHAR+1 IC=IC+1 CBLCKO(CPCBO)=RECORD(INCHAR) GO TO 230 C C J - UPDATING AND END OF TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 200 NCHOUT=1 IF (ITYPEO.EQ.82) REMVO=RECORD(1) C 82 = ASCII R GO TO 100 C C RECORD TOO LONG. C 210 ISTAT=4 GO TO 250 C C UNKNOWN CONTROL RECORD TYPE. C 220 ISTAT=5 GO TO 250 C C INCREMENT THE OUTPUT BUFFER POINTERS. PACK A CHARACTER BLOCK C IF NECESSARY. WRITE A TAPE BLOCK IF NECESSARY. C 230 CPCBO=CPCBO+1 CCDBO=CCDBO+1 IF (CPCBO.LE.NCCBO) GO TO 240 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CWDBO=CWDBO+NWCBO CPCBO=1 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240 CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 250 240 GO TO (20,180,110,120,140,150,160,170,190), JUMP 250 RETURN C END SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL) C C SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE C DATA TO BE REMOVED. DIVIDE DATA INTO GROUPS CONSISTING OF C STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT C DATA. THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE C REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP C ARE RECORDED IN RC() AND SC() RESPECTIVELY. MAXSL IS THE C MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC(). C INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL C C RC AND SC MUST BE AT LEAST (IMGLEN-1)//3. C GC=1 SC(1)=0 RC(1)=0 MODE=-1 INPLEN=IABS(IMGLEN) C C IDENTIFY DATA GROUPS. C DO 110 I=1,INPLEN IF (MODE) 40,60,90 C C MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE. C 40 IF (INPIMG(I).EQ.REMOVE) GO TO 50 C SWITCH TO SIGNIFICANT DATA SCAN. MODE=1 SC(GC)=1 GO TO 110 C CONTINUE REMOVE SCAN 50 RC(GC)=RC(GC)+1 IF (RC(GC)-MAXSL) 110,95,110 C C MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY C ONE OCCURRENCE OF REMOVE. CHANGE TO REMOVE MODE IF ANOTHER REMOVE C OCCURS OR BACK TO DATA MODE IF NOT. C 60 IF (INPIMG(I).EQ.REMOVE) GO TO 80 C SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT. MODE=1 IF (SC(GC).GE.MAXSL-2) GO TO 70 SC(GC)=SC(GC)+2 GO TO 110 C FULL GROUP 70 GC=GC+1 RC(GC)=1 SC(GC)=1 GO TO 110 C SWITCH TO REMOVE MODE. 80 GC=GC+1 SC(GC)=0 RC(GC)=2 MODE=-1 GO TO 110 C C MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA. C 90 IF (INPIMG(I).EQ.REMOVE) GO TO 100 SC(GC)=SC(GC)+1 IF (SC(GC).NE.MAXSL) GO TO 110 C FULL GROUP MODE=-1 95 IF (I.GE.INPLEN) GO TO 120 GC=GC+1 RC(GC)=0 SC(GC)=0 GO TO 110 100 MODE=0 110 CONTINUE 120 RETURN C END SUBROUTINE EXCHTP (RECORD,LINEI) C C MATERIALIZE INCLUDES IF INALT IS NON-ZERO. C CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE C AND THE PRINTER IF LISTING IS REQUESTED. C LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C INTEGER RECORD(1),LINEI C C ***** LOCAL VARIABLES ************************************ C C COPY DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR C SKIPPING TEXT NOT TO BE INCLUDED. INTEGER COPY C DASH CONTAINS '-' IN HOLLERITH. INTEGER DASH C ENDMRK HOLDS THE END SENTINEL. INTEGER ENDMRK(40) C NCHEND IS THE NUMBER OF CHARACTERS IN ENDMRK. INTEGER NCHEND C NCHSAV SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD. INTEGER NCHSAV C NCHTAR IS THE NUMBER OF CHARACTERS IN TARGET. INTEGER NCHTAR C STAR CONTAINS '*' IN HOLLERITH. INTEGER STAR C TARGET IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY). INTEGER TARGET(40) C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL DATA *************************************** C DATA DASH /1H-/, STAR /1H*/ C C ***** PROCEDURES ***************************************** C LINEO=LINEO+1 IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190 RECORD(180)=LINEO RECORD(179)=LINEI COPY=-1 C COPY=-1 MEANS NOT COPYING INCLUDED TEXT. IF (ITYPEO.EQ.0) GO TO 110 C PROCESS INCLUDE RECORD. DO 10 I=1,NCHOUT 10 RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I) C INSERT '-I '. RECORD(1)=45 RECORD(2)=73 RECORD(3)=32 NCHOUT=NCHOUT+3 IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110 C STORE SEARCH TARGET NCHTAR=MIN0(NCHOUT,40) DO 20 I=1,NCHTAR 20 TARGET(I)=RECORD(I) C STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). NCHSAV=NCHCMD DO 30 I=1,NUMBER 30 OUTREC(I)=COMAND(I) COPY=0 C COPY=0 MEANS SKIPPING MODULE ON INALT FILE. INALT=IABS(INALT) NEOF=0 40 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 IF (NCHCMD.LT.2) GO TO 40 IF (COMAND(1).NE.45) GO TO 40 C 45 = ASCII - IF (COMAND(2).EQ.45) GO TO 130 IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40 C 73 = ASCII I, 105 = ASCII LOWER CASE I. C COMPARE IMAGE WITH SEARCH TARGET. IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60 DO 50 I=2,NCHTAR K=COMAND(I) IF (K.GT.96 .AND. K.LT.123) K=K-32 IF (TARGET(I).NE.K) GO TO 60 50 CONTINUE NEOF=3 C PREVENT SEARCH LOOP. COPY=1 C COPY=1 MEANS COPYING INCLUDED TEXT. 60 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C STORE END OF INCLUDE MODULE SIGNAL. NCHEND=MIN0(40,NCHCMD) DO 70 I=1,NCHEND 70 ENDMRK(I)=COMAND(I) IF (COPY.EQ.0) GO TO 80 CHAR1L=DASH NCHOUT=NCHTAR DO 75 I = 1,NCHOUT 75 COMAND(I)=TARGET(I) COMAND(180)=LINEO COMAND(179)=LINEI C GO PRINT TARGET. CALL EXCHTW (COMAND,-1) GO TO 120 C COPY OR SKIP UNTIL ENDMRK SEEN AGAIN. 80 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF. C TEST FOR ENDMRK DO 90 I=1,NCHEND IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100 90 CONTINUE IF (COPY) 140,40,140 C OUTPUT TEXT RECORD. 100 COMAND(180)=LINEO COMAND(179)=LINEI NCHOUT=NCHCMD CALL EXCHTW (COMAND,OPTI) GO TO 120 C OUTPUT TEXT RECORD. 110 CALL EXCHTW (RECORD,1) 120 IF (COPY) 190,190,80 C WE ONLY GET HERE WITH COPY .GE. 0. 130 NEOF=NEOF+1 ACTION=2 C ACTION = 2 MEANS REOPEN INALT. CALL EXCHIM IF (NEOF.LT.2) GO TO 40 140 INALT=-IABS(INALT) NCHCMD=1 IF (COPY.GT.0) GO TO 170 C PROCESS TARGET AS THOUGH IT WERE TEXT. NCHOUT=NCHTAR C SAVE TARGET FOR ERROR MESSAGE. DO 150 I=1,NCHTAR 150 COMAND(I)=TARGET(I) CALL EXCHTW (COMAND,1) CALL EXCHAH (TARGET,NCHTAR) WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR) 160 FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8 10A1)) NERRS=MAX0(NERRS,3) C C RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). C 170 NCHCMD=NCHSAV DO 180 I=1,NUMBER 180 COMAND(I)=OUTREC(I) C 190 CHAR1L=STAR RETURN C END SUBROUTINE EXCHTW (RECORD,OPTION) C C WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING C EXCHOU. WRITE RECORD ON THE PRINTER IF LISTING REQUESTED. C RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C IF OPTION = ZERO, WRITE TO FILE ONLY. C IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING. C IF OPTION .LT. ZERO, WRITE TO LISTING ONLY. C INTEGER RECORD(1),OPTION C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** PROCEDURES ***************************************** C LINEI=RECORD(179) IF (OPTION.LT.0) GO TO 130 C C INSERT IDENTIFICATION IF REQUESTED. C IF (IDCOL2.LT.IDCOL1) GO TO 120 IF (IDTXTL+IDSTEP.EQ.0) GO TO 120 IF (NCHOUT.GE.IDCOL2) GO TO 20 J=IDCOL2-1 C FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2 DO 10 I=NCHOUT,J 10 RECORD(I+1)=32 C 32 = ASCII BLANK. 20 NCHOUT=MAX0(NCHOUT,IDCOL2) N=-1 IF (LINEI.EQ.0) GO TO 40 IF (IDOPTN.NE.73) GO TO 40 C 73 = ASCII I. IDENTIFY ONLY FROM INTAPE. N=(LINEI-1)*IDSTEP+IDSTRT GO TO 70 40 IF (IDOPTN.NE.79) GO TO 50 C 79 = ASCII O. IDENTIFY ONLY TO OUTAPE. N=(LINEO-1)*IDSTEP+IDSTRT GO TO 70 50 IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70 C 67 = ASCII C, 70 = ASCII F. IDENTIFY EVERYTHING. N=IDCUR 70 IF (N.LT.0) GO TO 120 IF (IDTXTL.EQ.0) GO TO 100 J=MIN0(IDCOL2,IDTXTL+IDCOL1-1) K=1 DO 80 I=IDCOL1,J RECORD(I)=IDTEXT(K) 80 K=K+1 100 IF (IDSTEP.EQ.0) GO TO 120 IDCUR=IDCUR+IDSTEP K=IDCOL2 110 RECORD(K)=MOD(N,10)+48 N=N/10 K=K-1 IF (N.EQ.0) GO TO 120 IF (K.GE.IDCOL1) GO TO 110 C C OUTPUT RECORD. C 120 IF (OUFILE.NE.0) CALL EXCHOU (RECORD) IF (OPTION.EQ.0) GO TO 220 130 IF (OPTL.NE.0) GO TO 140 IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220 140 CALL EXCHAH (RECORD,NCHOUT) IF (OPTV+VERT.NE.0) GO TO 200 IF (PHASE.NE.8) GO TO 180 IF (LINEI.EQ.0) GO TO 160 WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 150 FORMAT (1X,2I5,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 160 WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 170 FORMAT (5H NEW,I6,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 180 WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 190 FORMAT (1X,I5,A1,3X,110A1/(6H CONT,4X,110A1)) GO TO 220 200 WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT) 210 FORMAT (132A1) 220 RETURN C END SUBROUTINE EXCHC1 (IBLOCK,OBLOCK) C C COMMAND DECODER AND FORMAT VERIFIER. SOME COMMANDS ARE ALSO C COMPLETELY PROCESSED HERE. C C IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS. C INTEGER IBLOCK(1),OBLOCK(1) C C C ***** LOCAL VARIABLES ************************************ C C ALLOW TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED. VALUES ARE C SUMS OF PERMITTED VALUES OF PHASE. C 1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING, C 8 = UPDATING. C ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A C PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR C MAY BE VOID (EQUAL SIGN IS LAST CHARACTER). C 32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT. INTEGER ALLOW(35) C BLANK A CONSTANT. 1H . INTEGER BLANK C DATE IS THE DATE FROM UPDA=, DATE=, ORIG=. INTEGER DATE(3) C DAYS TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS. INTEGER DAYS(12) C I IS USED FREELY AS AN INDEX. C J IS USED FREELY AS AN INDEX. C JUMP USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE. C K IS USED FREELY AS AN INDEX. C KDATE IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD). C KQUIT IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD). C KTEXT IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD). C N IS USED FREELY AS AN INDEX. C NCNREC IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS. C ND IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER. C NM IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER. C NY IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER. C TVAL A VECTOR OF VALUES FOR TRANS. INDEXED BY ICOMD. INTEGER TVAL(35) C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL EQUIVALENCE ********************************** C EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND) C C ***** DATA STATEMENTS ************************************ C DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/ DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/ DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/ DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/ DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/ DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/ DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/ DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/ DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/ DATA BLANK /1H / DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/ DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/ DATA DAYS(11),DAYS(12) /30,31/ DATA KDATE /5/ DATA KQUIT /20/ DATA KTEXT /27/ DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/ DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/ DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/ DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/ DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/ DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/ DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/ C C ***** PROCEDURES ***************************************** C C GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER. C ECHO IT IF THE E OPTION IS SET. DETERMINE WHETHER IT IS A CHANGE C TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND. C 10 NCNREC=0 20 ACTION=0 IF (NCHCMD.LT.0) GO TO 220 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (OPTE.EQ.0) GO TO 27 WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD) 23 FORMAT (1X,80A1) CHAR1L=0 27 NCHCMD=MIN0(NCHCMD,MARGIN) IF (PHASE.LT.4) SIGNAL=45 C 45 = ASCII - IF (COMAND(1).NE.45) GO TO 50 C 45 = ASCII -. REQUEST TO CHANGE CONTROL RECORD. IF (PHASE.LT.4) GO TO 40 WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD) 30 FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT 1OR UPDATE/1X,80A1) NERRG=MAX0(NERRG,2) GO TO 200 40 ICOMD=0 EQUAL=2 TRANS=3 GO TO 370 50 IF (COMAND(1).NE.42) GO TO 70 C 42 = ASCII *. COMMENT RECORD. JUST ECHO IT. NCHCMD=MAX0(NCHCMD,2) WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD) 60 FORMAT (A1,1H*,78A1/(1X,80A1)) GO TO 10 C C SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR C EQUAL SIGN ARE FOUND. LOOK UP THE WORD IN THE COMMAND NAME TABLE. C 70 EQUAL=0 DO 80 I=1,NCHCMD IF (COMAND(I).EQ.32) GO TO 80 C 32 = ASCII BLANK EQUAL=EQUAL+1 ICOMD=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32 C ABOVE STATEMENT CONVERTS TO UPPER CASE. COMAND(I)=32 COMAND(EQUAL)=ICOMD IF (EQUAL.GE.4) GO TO 90 IF (ICOMD.EQ.61) GO TO 90 C 61 = ASCII =. IF (ICOMD.EQ.44) GO TO 90 C 44 = ASCII ,. 80 CONTINUE IF (EQUAL.EQ.0) GO TO 185 90 DO 110 ICOMD=1,NCOMDT DO 100 K=1,EQUAL IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110 100 CONTINUE IF (EQUAL.EQ.4) GO TO 130 IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130 C 32 = ASCII BLANK. 110 CONTINUE C C UNRECOGNIZED COMMAND. C 120 ICOMD=0 C C LOOK FOR AN EQUAL SIGN. SET THE VARIABLE NAMED EQUAL TO ZERO IF C THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK C CHARACTER FOLLOWING THE EQUAL SIGN. C 130 MODIFY=0 140 DO 150 I=EQUAL,NCHCMD K=COMAND(I) IF (K.EQ.61) GO TO 160 C 61 = ASCII =. IF (MODIFY.NE.0) GO TO 150 C USE FIRST MODIFIER. IF (K.EQ.44) GO TO 160 C 44 = ASCII ,. 150 CONTINUE EQUAL=0 GO TO 170 160 I=I+1 EQUAL=I IF (I.GT.NCHCMD) GO TO 170 IF (COMAND(I).EQ.32) GO TO 160 C 32 = ASCII BLANK IF (K.NE.44) GO TO 170 C 44 = ASCII ,. MODIFY=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32 C CONVERT TO UPPER CASE. GO TO 140 170 IF (K.NE.61) EQUAL=0 C 61 = ASCII =. IF (ICOMD.EQ.0) GO TO 180 IF (ICOMD.GT.NCOMDP) GO TO 180 IF (EQUAL.GT.NCHCMD) GO TO 175 IF (EQUAL.NE.0) GO TO 230 IF (ALLOW(ICOMD)/64.NE.0) GO TO 230 175 IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690 C PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK. NCHCMD=NCHCMD+1 EQUAL=NCHCMD COMAND(NCHCMD)=32 C 32 = ASCII BLANK HOLCMD(NCHCMD)=BLANK GO TO 230 C C GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX. C 180 CALL EXCHCX (0) C IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND. IF (ICOMD.NE.0) GO TO 730 185 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1)) NERRG=MAX0(NERRG,5) 200 CHAR1L=0 NCNREC=NCNREC+1 IF (NCNREC.LE.20) GO TO 20 WRITE (PRINTR,210) 210 FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU 1MES TEXT COMMAND IS MISSING.) GO TO 270 C C END OF FILE - SIMULATE A QUIT COMMAND. C 220 ICOMD=KQUIT C C RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME. C 230 IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240 TRANS=TVAL(ICOMD) C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300 1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7 230,370,730,370), ICOMD C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 C 32 33 34 35 C C THE COMMAND IS NOT ALLOWED AT THIS TIME. C 240 WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE 1D./1X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 C DECIDE WHETHER TO SKIP TEXT 260 IF (ICOMD.NE.KTEXT) GO TO 10 IF (EQUAL.NE.0) GO TO 10 270 WRITE (PRINTR,280) 280 FORMAT (//15H0SKIPPING TEXT.) 290 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (NCHCMD.LT.2) GO TO 290 IF (COMAND(1).NE.SIGNAL) GO TO 290 IF (COMAND(2).EQ.SIGNAL) GO TO 10 IF (NCHCMD.LT.3) GO TO 290 IF (COMAND(2).NE.61) GO TO 290 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 290 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING. C DATE=YYMMDD C ORIGIN=YYMMDD SITE C UPDATE=YYMMDD SITE C IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE C THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED. C 300 IF (EQUAL+5.GT.NCHCMD) GO TO 700 I=EQUAL DO 310 J=1,3 DATE(J)=0 DO 310 K=1,2 N=COMAND(I)-48 IF (N.LT.0) GO TO 320 IF (N.GT.9) GO TO 320 DATE(J)=10*DATE(J)+N 310 I=I+1 IF (NM.EQ.0) GO TO 320 IF (NM.GT.12) GO TO 320 IF (ND.LE.0) GO TO 320 DAYS(2)=28 IF (MOD(NY,4).EQ.0) DAYS(2)=29 IF (NY.EQ.0) DAYS(2)=28 IF (ND.LE.DAYS(NM)) GO TO 440 320 IF (ICOMD.EQ.KDATE) GO TO 700 IF (TODAY(1).EQ.32) GO TO 700 I=MIN0(NCHCMD+6,180) NCHCMD=I J=I-6 IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1 C 32 = ASCII BLANK IF (J.LT.EQUAL) GO TO 700 330 COMAND(I)=COMAND(J) HOLCMD(I)=HOLCMD(J) J=J-1 I=I-1 IF (J.GE.EQUAL) GO TO 330 DO 340 I=1,6 COMAND(I+EQUAL-1)=TODAY(I) 340 HOLCMD(I+EQUAL-1)=TODAY(I) CALL EXCHAH (HOLCMD(EQUAL),6) WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD) 345 FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1)) NERRG=MAX0(NERRG,1) GO TO 440 C C REWIND INTAPE C 350 IF (INTAPE.EQ.0) GO TO 680 IF (INTOPN.NE.0) GO TO 360 I=1 C OPEN INTAPE IF NOT ALREADY OPEN. DO NOT CHECK EXCH LABEL. CALL EXCHRT (I,IBLOCK) C IGNORE STATUS 360 I=2 CALL EXCHRT (I,IBLOCK) INTOPN=0 GO TO 725 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH C BEGINS WITH A NUMBER FOLLOWED BY A BLANK. C C INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA C INTAPE = NUMBER SYSTEM DEPENDENT DATA C LIMIT = NUMBER C MARGIN = NUMBER C OUTAPE = NUMBER SYSTEM DEPENDENT DATA C OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA C PRINTER = NUMBER C READER = NUMBER C SKIP = NUMBER C TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL) C WORK = NUMBER C 370 NUMBER=0 IF (EQUAL.EQ.0) GO TO 440 DO 410 J=EQUAL,NCHCMD IF (COMAND(J).EQ.32) GO TO 420 C 32 = ASCII BLANK N=COMAND(J)-48 C 48 = ASCII ZERO IF (N.GE.0) GO TO 400 380 WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD) 390 FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS. NOT PROCESSED./ 11X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 GO TO 260 400 IF (N.GT.9) GO TO 380 410 NUMBER=10*NUMBER+N EQUAL=NCHCMD+1 GO TO 440 420 EQUAL=J 430 EQUAL=EQUAL+1 IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440 C 32 = ASCII BLANK C C PRELIMINARY FORMAT CHECKING IS COMPLETE C 440 J=ICOMD+1 C 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6 120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595), 2J C 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 C C DATE=YYMMDD C 450 DO 460 I=1,6 460 TODAY(I)=COMAND(EQUAL+I-1) GO TO 10 C C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA. C 470 I=INFILE J=1 GO TO 500 C C INCLUDE = NUMBER SYSTEM DEPENDENT DATA. C 480 I=INALT J=3 INALT=IABS(INALT) GO TO 500 C C TEXT C 490 I=INTEXT J=2 IF (EQUAL.EQ.0) GO TO 560 C C OPEN AN INPUT FILE. C 500 IF (NUMBER.EQ.0) GO TO 505 IF (NUMBER.EQ.OUFILE) GO TO 710 IF (NUMBER.EQ.OUTAPE) GO TO 710 505 IF (J.EQ.2) GO TO 510 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (I.NE.0) CALL EXCHIM 510 IF (J-2) 520,530,540 520 INFILE=NUMBER GO TO 550 530 INTEXT=NUMBER GO TO 550 540 INALT=NUMBER 550 IF (NUMBER.EQ.0) GO TO 560 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND CALL EXCHCX (J+1) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHIM ACTION=2 C ACTION = 2 MEANS REWIND IF (J.EQ.3) CALL EXCHIM INALT=-IABS(INALT) 560 ACTION=0 C ACTION = 0 MEANS READ TEXT GO TO 730 C C INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 570 IF (INTOPN.EQ.0) GO TO 580 C CLOSE THE INPUT TAPE, IGNORE STATUS. I=4 CALL EXCHRT (I,IBLOCK) INTOPN=0 580 INTAPE=NUMBER C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (INTAPE.NE.0) CALL EXCHCX (6) GO TO 725 C C LIMIT = NUMBER C 590 LIMIT=NUMBER GO TO 10 C C MARGIN = NUMBER C C MINIMUM MARGIN IS 60 595 MARGIN=MAX0(NUMBER,60) GO TO 10 C C OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 600 IF (OUTOPN.EQ.0) GO TO 610 C WRITE AND END-OF-FILE MARK ON OUTAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (I,OBLOCK,OBLOCK) C IGNORE STATUS OUTOPN=0 PHASE=1 610 OUTAPE=NUMBER OUTUPD=MODIFY C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (OUTAPE.NE.0) CALL EXCHCX (7) GO TO 730 C C OUTPUT = NUMBER SYSTEM DEPENDENT INFORMATION C 620 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) OUFILE=NUMBER IDCUR=IDSTRT IF (OUFILE.EQ.0) GO TO 730 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND. CALL EXCHCX (5) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHOU (OUTREC) GO TO 730 C C PRINTER = NUMBER. C 630 CALL EXCHFO (-2) PRINTR=NUMBER CALL EXCHFO (2) GO TO 10 C C READER = NUMBER. C 640 IF (INFILE.NE.0) GO TO 670 CALL EXCHFO (-1) READER=NUMBER CALL EXCHCX (1) CALL EXCHFO (1) GO TO 10 C C WORK = NUMBER C 650 IF (WORKF.GT.0) CALL EXCHFO (-3) WORKF=NUMBER C WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4. GO TO 10 C C UPDATE C C DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR C SIMPLY TO OUTPUT THE UPDATE COMMAND. 660 IF (PHASE.GE.4) TRANS=5 GO TO 730 C C ERROR MESSAGES. C 670 NUMBER=3 C MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE. GO TO 720 680 NUMBER=4 C MESSAGE 4 - INTAPE IS NOT DEFINED. GO TO 720 690 NUMBER=12 C MESSAGE 12 - NO PARAMETER STRING. GO TO 720 700 NUMBER=13 C MESSAGE 13 - IMPROPER DATE. GO TO 720 710 NUMBER=31 C MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT. C C RETURN TO ERROR MESSAGE SEGMENT. C 720 TRANS=8 GO TO 740 c c Indicate the WORK file is empty. c 725 if (nrwork.le.0 .or. workf.le.0) go to 730 REWIND WORKF NRWORK=0 C C IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP. C 730 IF (TRANS.EQ.1) GO TO 10 740 RETURN C END SUBROUTINE EXCHCX (REASON) C C PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER C PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT, C INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS. C CDC6600/7600 VERSION. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER REASON,CDCMDE COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /CDCMDE/ CDCMDE C C REASON=0 FOR UNRECOGNIZED COMMAND. C REASON=1 BEFORE OPENING READER. C REASON=2 BEFORE OPENING INFILE. C REASON=3 BEFORE OPENING INTEXT. C REASON=4 BEFORE OPENING INALT. C REASON=5 BEFORE OPENING OUFILE. C REASON=6 BEFORE OPENING INTAPE. C REASON=7 BEFORE OPENING OUTAPE. C IF(REASON.GT.0 .OR. NCHCMD.LT.4) RETURN I=ICOMD-NCOMDP IF(I.LT.0 .OR. I.GT.2) RETURN CDCMDE=I RETURN C END SUBROUTINE EXCHC2 C C PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KINDE /32/ DATA KOPTI /14/ DATA KSITE /25/ C C FIGURE OUT WHICH COMMAND GOT US HERE. C IF (ICOMD-KOPTI) 60,150,10 10 IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270 C C ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT C WHERE C1, C2, STEP AND START ARE INTEGERS. C STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP, C START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF C CHARACTERS OF TEXT IN IDTXTL. IF AN ERROR OCCURS, C STORE ZERO IN IDSTEP AND IDTXTL. C IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO. C C STORE THE MODIFIER IN IDOPTN. C IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE C PRODUCED ONLY FOR IMAGES FROM INTAPE. IF THE O MODIFIER C IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES C WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT. IF THE F C MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION C OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE C PRODUCED FOR ALL IMAGES OUTPUT. IF THE C MODIFIER IS SPECIFIED, C SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH C RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR C ALL IMAGES OUTPUT. IF NONE OF THE I, F, OR C MODIFIERS ARE C SPECIFIED, THE O MODIFIER IS ASSUMED. C C IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED. C IF IDTXTL = ZERO, TEXT IS NOT EMITTED. C IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE C EMITTED. C C CONVERT C1,C2,STEP,START C IDOPTN=MODIFY IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79 C 70 = ASCII F, 73 = ASCII I, 79 = ASCII O. DO 40 J=1,4 NUMBER=0 20 IF (EQUAL.GT.NCHCMD) GO TO 40 IF (COMAND(EQUAL).EQ.44) GO TO 30 C 44 = ASCII , I=COMAND(EQUAL)-48 IF (I.LT.0) GO TO 350 IF (I.GT.9) GO TO 350 NUMBER=10*NUMBER+I EQUAL=EQUAL+1 GO TO 20 30 EQUAL=EQUAL+1 40 IDNBRS(J)=NUMBER IDCUR=IDSTRT IDCOL1=MAX0(1,MIN0(IDCOL1,178)) IDCOL2=MIN0(IDCOL2,178) C C STORE TEXT. C IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0) IF (IDTXTL.EQ.0) GO TO 330 DO 50 J=1,IDTXTL IDTEXT(J)=COMAND(EQUAL) 50 EQUAL=EQUAL+1 GO TO 330 C C INDEX = PARAMETER STRING C 60 J=0 IF (COMAND(EQUAL).NE.45) GO TO 70 C 45 = ASCII - J=-1 EQUAL=EQUAL+1 70 N=0 DO 80 I=1,26 80 INDEXS(I)=0 90 IF (EQUAL.GT.NCHCMD) GO TO 130 I=COMAND(EQUAL)-64 IF (I.EQ.-32) GO TO 120 C 32 = ASCII BLANK. IF (I.GE.32) I=I-32 C CONVERT TO UPPER CASE. IF (I.LE.0) GO TO 100 IF (I.LE.26) GO TO 110 100 N=EQUAL GO TO 120 110 INDEXS(I)=1 120 EQUAL=EQUAL+1 GO TO 90 130 INDEX=0 DO 140 I=1,26 INDEXS(I)=IABS(INDEXS(I)+J) 140 INDEX=INDEX+INDEXS(I) IF (MODIFY.EQ.76) INDEX=-INDEX C 76 = ASCII L. IF (N) 340,330,340 C C OPTION = PARAMETER STRING C 150 IF (MODIFY.NE.0) GO TO 170 DO 160 I=1,26 160 OPTVAL(I)=0 170 IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330 I=1 IF (MODIFY.EQ.67) I=0 C 67 = ASCII C. N=0 DO 190 J=EQUAL,NCHCMD K=COMAND(J) IF (K.GE.96) K=K-32 C CONVERT TO UPPER CASE. IF (K.EQ.32) GO TO 190 C 32 = ASCII BLANK IF (K.LT.65) GO TO 180 IF (K.GT.90) GO TO 180 C PROCESS ALPHABETIC OPTIONS. OPTVAL(K-64)=I GO TO 190 180 N=J 190 CONTINUE IF (N) 330,330,340 C C PROCESS PRED = ID REC A/X MASK STRING C WHERE ID = PREDICATE IDENTIFIER (A-H), C REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE, C A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH C IN EXACT POSITION, C MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE C TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED. C STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF C CONTROL RECORDS. C C THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR C PREDICATE A, ETC. C C PRED(1,*)=LENGTH OF STRING + 3 C PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED. C PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND). C PRED(3,*)=RECORD TYPE. C PRED(4,*)=A/X C PRED(5,*)=MASK CHARACTER. C PRED(6..42,*)=STRING. C 200 IF (EQUAL.NE.0) GO TO 240 C LIST ALL ACTIVE PREDICATES. DO 230 I=1,8 IF (PRED(1,I).EQ.0) GO TO 230 J=PRED(1,I)+1 COMAND(1)=I+64 DO 210 K=2,J 210 COMAND(K)=PRED(K+1,I) CALL EXCHAH (COMAND,J) WRITE (PRINTR,220) (COMAND(K),K=1,J) 220 FORMAT (6H PRED=,42A1) 230 CONTINUE GO TO 330 C SAVE PREDICATE IF VALID. 240 IF (NCHCMD.LE.EQUAL+3) GO TO 370 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.GT.72) GO TO 360 C 72 = ASCII H NUMBER=J-64 PRED(1,NUMBER)=0 EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.GT.90) GO TO 360 C 90 = ASCII Z IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.EQ.82) GO TO 360 C 82 = ASCII R PRED(3,NUMBER)=J EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.NE.65.AND.J.NE.88) GO TO 360 C 65 = ASCII A, 88 = ASCII X PRED(4,NUMBER)=J EQUAL=EQUAL+1 PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40) I=4 DO 250 J=EQUAL,NCHCMD I=I+1 IF (I.GT.42) GO TO 330 K=COMAND(J) IF (K.GT.96) K=K-32 C CONVERT TO UPPER CASE. 250 PRED(I,NUMBER)=K GO TO 330 C C SITE = SITE NAME C 260 JUMP=1 GO TO 280 C C TITLE = OUTPUT TAPE TITLE C 270 JUMP=2 280 K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 320 I=1,40 IF (K.GT.NCHCMD) GO TO 290 J=COMAND(K) K=K+1 GO TO 300 290 J=32 C 32 = ASCII BLANK. 300 IF (JUMP.EQ.2) GO TO 310 SITE(I)=J GO TO 320 310 TITLE(I)=J 320 CONTINUE C C RETURN TO COMMAND DECODER. C 330 TRANS=1 GO TO 390 C C ERROR MESSAGES C 340 NUMBER=14 C MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED. EQUAL=N GO TO 380 350 IDSTEP=0 IDTXTL=0 360 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED. GO TO 380 370 NUMBER=30 C MESSAGE 30 - COMMAND IS INCOMPLETE. C 380 TRANS=8 C 390 RETURN C END SUBROUTINE EXCHC3 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE C COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES. C C OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE C NAME COMMAND. C C OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING C COPY, NAME OR UPDATE COMMANDS. C C ID IS USED TO CONSTRUCT THE OUTPUT LABEL. INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/ C A N G E DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/ DATA KNAME /9/ DATA KSKIP /26/ C C OPEN INTAPE IF NECESSARY C IF (INTOPN.NE.0) GO TO 70 IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300 IF (INTAPE.EQ.OUTAPE) GO TO 360 CALL EXCHRH (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 310 INTOPN=1 C COPY THE LABEL TO A SAVE AREA. DO 10 I=1,180 10 LABELI(I)=CBLCKI(I) CALL EXCHAH (CBLCKI(13),138) WRITE (PRINTR,20) 20 FORMAT (25H0INPUT LABEL INFORMATION.) WRITE (PRINTR,30) (CBLCKI(I),I=13,104) 30 FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/ 1 20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1) IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150) 40 FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1) WRITE (PRINTR,50) NDATAI 50 FORMAT (28H DATA CHARACTERS PER BLOCK =,I6) IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI 60 FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6) CHAR1L=0 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 290 70 IF (ICOMD.EQ.KSKIP) GO TO 270 C C OPEN OUTAPE IF NECESSARY C 80 IF (ICOMD.EQ.0) GO TO 90 IF (ICOMD.LT.KNAME) GO TO 100 90 IF (INTAPE*OUTAPE.EQ.0) GO TO 100 IF (OUTUPD.NE.85) GO TO 370 C 85 = ASCII U. 100 IF (OUTOPN.NE.0) GO TO 240 IF (OUTAPE.EQ.0) GO TO 240 C CONSTRUCT THE OUTPUT LABEL. IF (TODAY(1).EQ.0) GO TO 340 IF (INTOPN.EQ.0) GO TO 160 DO 110 I=1,180 110 CBLCKO(I)=LABELI(I) IF (TITLE(1).EQ.32) GO TO 130 C 32 = ASCII BLANK DO 120 I=1,40 120 CBLCKO(I+18)=TITLE(I) 130 IF (OUTUPD.NE.85) GO TO 220 C 85 = ASCII U. IF (SITE(1).EQ.0) GO TO 350 DO 140 I=1,6 140 CBLCKO(I+104)=TODAY(I) DO 150 I=1,40 150 CBLCKO(I+110)=SITE(I) GO TO 220 160 IF (TITLE(1).EQ.32) GO TO 330 C 32 = ASCII BLANK IF (SITE(1).EQ.0) GO TO 350 IF (INTAPE*OUTAPE.EQ.0) GO TO 170 IF (INTAPE.EQ.OUTAPE) GO TO 360 170 DO 180 I=1,8 180 CBLCKO(I)=ID(I) DO 190 I=1,40 CBLCKO(I+18)=TITLE(I) 190 CBLCKO(I+64)=SITE(I) DO 200 I=1,6 200 CBLCKO(I+58)=TODAY(I) DO 210 I=105,180 210 CBLCKO(I)=0 220 CALL EXCHWH (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 320 OUTOPN=1 CBLCKO(1)=CBLCKO(105) CALL EXCHAH (CBLCKO(13),138) WRITE (PRINTR,230) WRITE (PRINTR,30) (CBLCKO(I),I=13,104) 230 FORMAT (26H0OUTPUT LABEL INFORMATION.) IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150) WRITE (PRINTR,50) NDATAO IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO CHAR1L=0 240 IF (ICOMD-KNAME) 250,260,280 C C COPY C 250 TRANS=4 MODEI=1-MIN0(1,OUFILE+OPTL) IF (ICOMD.EQ.0) MODEI=0 GO TO 390 C C NAME C 260 TRANS=5 IF (NRWORK.EQ.0) PHASE=4 GO TO 390 C C SKIP C 270 TRANS=4 GO TO 390 C C UPDATE C 280 TRANS=5 MODEI=0 GO TO 390 C C ERROR MESSAGES C 290 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. EQUAL=ISTAT GO TO 380 300 NUMBER=4 C MESSAGE 4 - INTAPE NOT DEFINED. GO TO 380 310 NUMBER=5 C MESSAGE 5 - UNABLE TO OPEN INTAPE. EQUAL=ISTAT GO TO 380 320 NUMBER=6 C MESSAGE 6 - UNABLE TO OPEN OUTAPE. EQUAL=ISTAT GO TO 380 330 NUMBER=7 C MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE. GO TO 380 340 NUMBER=8 C MESSAGE 8 - DATE NOT SUPPLIED. GO TO 380 350 NUMBER=9 C MESSAGE 9 - SITE NOT SUPPLIED. GO TO 380 360 NUMBER=10 C MESSAGE 10 - INTAPE = OUTAPE. GO TO 380 370 NUMBER=11 C MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED. 380 TRANS=8 C C RETURN TO TRANSITION PROGRAM C 390 RETURN C END SUBROUTINE EXCHRH (ISTAT,DBLOCK) C C READ THE HEADER LABEL FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE C NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C OPEN THE INPUT TAPE. C ISTAT=1 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C READ A BLOCK. C NDATAI=171 NERRCI=0 BLKSQI=0 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C FIND OUT IF IT IS A PROPER LABEL. C CALL EXCHUN (DBLOCK,CBLCKI) DO 10 I=1,8 IF (CBLCKI(I).NE.ID(I)) GO TO 20 10 CONTINUE C C GET READY TO READ THE REST OF THE TAPE. C CCDBI=NCDBI NDATAI=256*CBLCKI(9)+CBLCKI(10) NERRCI=256*CBLCKI(11)+CBLCKI(12) LASTI=0 L1PRGI=0 ISTAT=0 GO TO 30 C C NOT A LABEL. C 20 ISTAT=6 C C CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK. 25 I=4 CALL EXCHRT (I,DBLOCK) C 30 RETURN C END SUBROUTINE EXCHWH (ISTAT,DBLOCK) C C WRITE A HEADER ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE C WRITTEN ARE NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C MAKE SURE IT IS A PROPER LABEL. C DO 10 I=1,8 IF (CBLCKO(I).NE.ID(I)) GO TO 30 10 CONTINUE C C OPEN THE OUTPUT TAPE. C ISTAT=1 CALL EXCHWT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 40 C C CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR C CONTROL CHARACTERS C CBLCKO(9)=NDATAO/256 CBLCKO(10)=MOD(NDATAO,256) CBLCKO(11)=NERRCO/256 CBLCKO(12)=MOD(NERRCO,256) C C INSERT TODAYS DATE C DO 20 I=1,6 20 CBLCKO(I+12)=TODAY(I) C C WRITE THE BLOCK ON TAPE. C BLKSQO=0 CALL EXCHPA (CBLCKO,DBLOCK) CCDBO=180 ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C GET READY TO WRITE THE REST OF THE FILE. C L1PRGO=0 LLPRGO=0 N1RECO=0 NLRECO=0 L1RECO=0 LASTO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 GO TO 40 C C NOT A PROPER LABEL. C 30 ISTAT=6 C 40 RETURN C END SUBROUTINE EXCHC4 (IBLOCK) INTEGER IBLOCK(1) C C PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM C COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KCOPY /3/ C C ARE WE STARTING OR CONTINUING? C C ICOMD.EQ.0 MEANS CHANGE A CONTROL RECORD C ICOMD.GT.0 MEANS SKIP OR COPY COMMAND BEGIN C ICOMD.EQ.-1 MEANS CONTINUE COPY = NUMBERS C ICOMD.EQ.-2 MEANS CONTINUE COPY = PREDICATE EXPRESSION NEWP=0 IF (ITYPEI.EQ.80) VERT=0 C 80 = ASCII P. WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO C IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON C THE WORK FILE. IF (ICOMD.EQ.0) GO TO 190 C ICOMD=0 MEANS CHANGING A CONTROL RECORD. IF (ICOMD+1) 290,170,10 10 IF (ICOMD.EQ.KCOPY) GO TO 30 C C SKIP COMMAND. C IF (INTOPN.LT.0) GO TO 430 if (modify.eq.70) number=number+n1reci-1 c 70 = ASCII F. IF (NUMBER+1-N1RECI) 540,430,20 20 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.EQ.69) GO TO 460 C 69 = ASCII E. IF (N1RECI-NUMBER) 20,20,430 C C COPY COMMAND FORMAT VERIFICATION. C 30 IF (COMAND(EQUAL).LT.48) GO TO 180 C 48 = ASCII ZERO IF (COMAND(EQUAL).GT.57) GO TO 180 C 57 = ASCII NINE C C COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS. C CONVERT THE NUMBERS AND STORE THEM IN COMAND. IF THE NUMBER C IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER. C ICOMD=-1 I=0 J=44 C 44 = ASCII COMMA 40 I=I+1 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 480 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=NUMBER 50 EQUAL=EQUAL+1 IF (EQUAL.GT.NCHCMD) GO TO 60 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 60 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=10*COMAND(I)+NUMBER GO TO 50 60 IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70 70 IF (J.EQ.45) COMAND(I)=-COMAND(I) C 45 = ASCII DASH IF (EQUAL.GT.NCHCMD) GO TO 90 J=COMAND(EQUAL) IF (J.EQ.32 .OR. J.EQ.46) GO TO 90 C 32 = ASCII BLANK, 46 = ASCII PERIOD. IF (J.NE.44.AND.J.NE.45) GO TO 480 C 44 = ASCII COMMA, 45 = ASCII DASH 80 EQUAL=EQUAL+1 IF (COMAND(EQUAL)-32) 40,80,40 C 32 = ASCII BLANK 90 NUMBER=I C FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE C POSITION IN COMAND CURRENTLY BEING EXAMINED. EQUAL=-1 100 EQUAL=EQUAL+1 IF (EQUAL.GE.NUMBER) GO TO 470 IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100 IF (EQUAL.EQ.0) GO TO 120 WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD) 110 FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H) 1NOT COPIED./(1X,80A1)) NERRG=MAX0(NERRG,5) 120 IF (COMAND(EQUAL+1).GT.0) GO TO 130 EQUAL=EQUAL-1 COMAND(EQUAL+1)=N1RECI 130 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. C C PROCESS COPY = LIST OF NUMBERS C 140 EQUAL=EQUAL+1 C GO COPY THE PROGRAM IF IT IS THE RIGHT ONE. 150 IF (INTOPN.LT.0) GO TO 430 IF (COMAND(EQUAL)-N1RECI) 170,420,160 C SKIP TO DESIRED PROGRAM 160 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI-69) 150,460,150 C 69 = ASCII E 170 IF (EQUAL.GE.NUMBER) GO TO 430 IF (COMAND(EQUAL+1).GE.0) GO TO 140 COMAND(EQUAL)=IABS(COMAND(EQUAL))+1 IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420 EQUAL=EQUAL+1 GO TO 170 C C COPY = SELECTION STRING OR CHANGE CONTROL RECORD. C 180 ICOMD=-2 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. NRWORK=-1 C C DETERMINE NEED TO OPEN WORK FILE. C 190 IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0) 1IF (ICOMD) 290,430,290 IF (WORKF.EQ.0) GO TO 500 I=IABS(WORKF) IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510 IF (WORKF.GT.0) GO TO 200 WORKF=I CALL EXCHFO (3) 200 IF (ICOMD.NE.0) GO TO 280 C C CHANGE CONTROL RECORD. C if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520 c 69 = ascii E, 73 = ascii I. if (nrwork.eq.0) go to 210 if (itypei.eq.80) go to 520 c 80 = ascii P 210 IF (NUMBER-NRWORK-1) 530,220,410 220 NCHACT=NCHCMD+1-EQUAL IF (NCHACT.GT.0) GO TO 230 NCHACT=1 INTREC(1)=32 C 32 = ASCII BLANK GO TO 425 230 DO 240 I=1,NCHACT 240 INTREC(I)=COMAND(EQUAL+I-1) GO TO 425 C C COPY = SELECTION EXPRESSION. C C SKIP TO NEXT PROGRAM. 250 IF (INTOPN.LT.0) GO TO 430 if (itypei.eq.69) go to 460 c 69 = ASCII E. do 260 i = 1, 8 260 pred(2,i)=0 if (itypei.ne.80) go to 265 c If the current record is a new program, don't skip it (we haven't c processed it yet). if (nrwork.gt.0 .and. workf.gt.0) rewind workf nrwork=min0(nrwork,0) newp=0 go to 320 265 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 nxnewp=0 270 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.NE.80) GO TO 310 C 80 = ASCII P NEWP=nxnewp c Set NEWP non-zero when all control records for a module have been c seen. GO TO 320 280 NRWORK=MAX0(NRWORK,0) 290 DO 300 I=1,8 300 PRED(2,I)=0 c NEWP is non-zero when all control records have been read. 310 if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1 C 69 = ASCII E, 73 = ASCII I. 320 nxnewp=1 if (icomd.eq.0) if (newp) 520,210,520 IF (LIMIT.EQ.0) GO TO 340 IF (N1RECI.LE.LIMIT) GO TO 340 WRITE (PRINTR,330) LIMIT 330 FORMAT (7H LIMIT=,I6,9H REACHED.) GO TO 430 340 IF (NEWP.EQ.0) GO TO 360 CALL EXCHLX C EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'. NUMBER=NCHCMD IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415 C 73 = ASCII I. IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425 C 80 = ASCII P. IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425 C 83 = ASCII S. IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415 C 88 = ASCII X. IF (COMAND(180)) 450,250,420 C CONTROL RECORD. EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE. 360 I=1 DO 400 NUMBER=1,8 IF (PRED(1,NUMBER).EQ.0) GO TO 400 IF (PRED(2,NUMBER).NE.0) GO TO 400 IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390 NM=PRED(1,NUMBER)-3 IF (.NOT.(NCHACT.GT.0)) GO TO 390 DO 385 L = 1, NCHACT DO 380 J = 1, NM C C DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND C IN PREDICATE. IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380 IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370 C C NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS. K=32 GO TO 375 C USE CHARACTER FROM CONTROL RECORD. 370 K=INTREC(J+L-1) C C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (K.GT.96 .AND. K.LT.123) K=K-32 C C TEST FOR A MATCH ON A SINGLE CHARACTER. C IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE C PATTERN. IF THE SEARCH MODE IS X, TERMINATE THE SEARCH. 375 IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390 380 CONTINUE C C FOUND A MATCH IN CONTROL RECORD AND PREDICATE. PRED(2,NUMBER)=1 GO TO 400 385 CONTINUE 390 I=0 400 CONTINUE IF (I.NE.0) newp=1 IF (NRWORK.LT.0) GO TO 270 C AT LEAST ONE FALSE PREDICATE. WRITE THE CONTROL RECORD ON WORKF. 410 WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT) NRWORK=NRWORK+1 GO TO 270 C C GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM. C 415 ICOMD=-3 C RETURN TO EXCHC1 AFTER COPYING MODULE. 420 TRANS=5 GO TO 570 C C RETURN TO THE COMMAND PROCESSOR. C 425 TRANS=1 C REMEMBER CONTROL RECORDS ON WORKF. GO TO 570 430 TRANS=1 IF (ICOMD+1) 560,570,570 C C ERROR MESSAGES. C 440 NUMBER=1 C MESSAGE 1 - I/O ERROR. EQUAL=ISTAT GO TO 550 450 NUMBER=-COMAND(180) C MESSAGES GENERATED BY EXCHLX GO TO 550 460 IF (INTOPN.LT.0) GO TO 430 INTOPN=-1 EQUAL=NUMBER NUMBER=15 C MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE. GO TO 550 470 NUMBER=16 C MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION. GO TO 550 480 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER GO TO 550 490 NUMBER=18 C MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER. GO TO 550 500 NUMBER=19 C MESSAGE 19 - WORK FILE NOT DEFINED. GO TO 550 510 NUMBER=20 C MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE. GO TO 550 520 EQUAL=NUMBER NUMBER=21 C MESSAGE 21 - CONTROL RECORD NOT PRESENT GO TO 550 530 NUMBER=22 C MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER. GO TO 550 540 NUMBER=29 C MESSAGE 29 - BACKWARD SKIP IGNORED. C C RETURN TO THE ERROR MESSAGE PROCESSOR. C 550 TRANS=8 IF (ICOMD.EQ.0) GO TO 570 C C DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF. C 560 IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) C C RETURN TO TRANSITION PROGRAM. C 570 RETURN C END SUBROUTINE EXCHLX C C EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND. C C THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE C STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM C COPY=LOGICAL EXPRESSION. THE LOGICAL EXPRESSION CONSISTS OF THE C EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY C OPERATORS + - * / AND PARENEHESES. THE PRIMARY SYMBOLS A-H ARE C LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE C STATEMENTS. THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE C NULL PREDICATE, WHICH IS ALWAYS FALSE. THE OPERATORS + - * / ARE C THE BINARY LOGICAL OPERATIONS OR, OR NOT, AND, AND NOT C RESPECTIVELY. THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE C PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL C PRIORITY. THE RELATIVE PRIORITY MAY BE CHANGED BY USING C PARENTHESES. C C WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY C FALSE. AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL C FALSE PREDICATES IS DETERMINED. ONCE TRUE, A PREDICATE REMAINS C TRUE. THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND C A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE. WHEN ALL ACTIVE C PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM C HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND C IS EVALUATED. IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED. C IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED. THIS PROCESS C CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM C NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED. C C THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE C TABLE BELOW. INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS C APPENDED TO THE END OF THE LOGICAL EXPRESSION. C C PREVIOUS I CURRENT TOKEN I C TOKEN I + - * / I PRIMARY I ( I ) I ELSE I C ----------I---------I---------I---------I---------I---------I C + - * / I ERROR I OK I OK I ERROR I ERROR I C PRIMARY I OK I ERROR I ERROR I OK I ERROR I C ( I ERROR I OK I OK I OK I ERROR I C ) I OK I ERROR I ERROR I OK I ERROR I C ----------I---------I---------I---------I---------I---------I C C CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING C A STACK AND THE PRECEDENCE TABLE BELOW. TOS MEANS TOP-OF-STACK, C HOI MEANS HEAD-OF-INPUT. THE STACK INITIALLY CONTAINS (. C C TOS HOI C TOKEN I INDEX I INDEX I C ---------I---------I---------I C + - I 2 I 1 I C * / I 4 I 3 I C PRIMARY I 6 I 5 I C ( I 0 I 7 I C ) I N/A I 0 I C ---------I---------I---------I C C WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS C PUSHED ONTO THE STACK. WHEN THE TOS INDEX IS GREATER THAN THE HOI C INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY C SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT C PLACED IN THE SUFFIX LIST. THEN THE RELATION OF THE TOS INDEX TO C THE HOI INDEX IS RE-EXAMINED. WHEN THE TOS INDEX IS EQUAL TO THE C HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED. C C ***** INTERNAL VARIABLES ********************************* C C CHTAB RECOGNIZED CHARACTERS. INTERNAL PROCESSES USE THE INDEX C INTO CHTAB. C COLTAB CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX. C HOI CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE. C INFIX IS THE CURRENT POSITION IN THE INFIX. C IPREV IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN. C ISTACK IS THE CURRENT STACK INDEX. C ISUFIX IS THE CURRENT SUFFIX INDEX. C SYNTAX CONTAINS THE SYNTAX RULES. C TOS CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE. C INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15) C C ***** COMMON VARIABLES *********************************** C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** DATA STATEMENTS ************************************ C C A B C D DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/ C E F G H DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/ C N + - * DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/ C / ( ) DATA CHTAB(13),CHTAB(14),CHTAB(15) /47,40,41 / C A B C D DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/ C E F G H DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/ C N + - * DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/ C / ( ) DATA COLTAB(13),COLTAB(14),COLTAB(15) /1,3,4 / C A B C D E DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/ C F G H N + DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/ C - * / ( ) DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/ C CURRENT TOKEN IS +-*/. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/ C CURRENT TOKEN IS PRIM. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/ C CURRENT TOKEN IS (. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/ C CURRENT TOKEN IS ). NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/ C A B C D E DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/ C F G H N + DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/ C - * / ( ) DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/ C C ***** PROCEDURES ***************************************** C C COMAND IS USED FOR INFIX, STACK AND SUFFIX. UPON COMPLETION, C COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE C OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE C EXPRESSION IS TRUE. C ISTACK=NCHCMD+2 COMAND(ISTACK)=14 ISUFIX=181 IPREV=3 COMAND(NCHCMD+1)=41 INFIX=EQUAL-1 C C GET A CHARACTER FROM INFIX. LOOK UP IN CHTAB. CHECK SYNTAX. C 10 IF (INFIX.GT.NCHCMD) GO TO 180 INFIX=INFIX+1 J=COMAND(INFIX) IF (J.EQ.32) GO TO 10 C 32 = ASCII BLANK - IGNORE IT. IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. DO 20 I=1,15 IF (CHTAB(I).EQ.J) GO TO 30 20 CONTINUE GO TO 230 30 J=COLTAB(I) IF (SYNTAX(IPREV,J)-1) 40,190,200 C C CONVERT INFIX TO SUFFIX C 40 IPREV=J 50 J=COMAND(ISTACK) IF (TOS(J)-HOI(I)) 60,70,80 C PUSH INFIX ONTO STACK 60 ISTACK=ISTACK+1 COMAND(ISTACK)=I GO TO 10 C DELETE TOP OF STACK 70 ISTACK=ISTACK-1 IF (ISTACK.GT.NCHCMD+1) GO TO 10 IF (INFIX-NCHCMD) 220,220,250 C IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX. C IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX. 80 IF (J-9) 90,100,130 C PRIMARY IS SYMBOL A-H 90 IF (PRED(1,J).EQ.0) GO TO 210 J=PRED(2,J) GO TO 110 C NULL PREDICATE 100 J=0 110 ISUFIX=ISUFIX-1 120 COMAND(ISUFIX)=J ISTACK=ISTACK-1 GO TO 50 C OPERATOR 130 J=J-9 ISUFIX=ISUFIX+1 GO TO (140,150,160,170), J C + - * / 140 J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1) GO TO 120 150 J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1) GO TO 120 160 J=COMAND(ISUFIX)*COMAND(ISUFIX-1) GO TO 120 170 J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1)) GO TO 120 C 180 COMAND(180)=-23 C MESSAGE 23 - TOO MANY ( GO TO 240 190 COMAND(180)=-24 C MESSAGE 24 - MISSING PRIMARY GO TO 240 200 COMAND(180)=-25 C MESSAGE 25 - MISSING OPERATOR GO TO 240 210 EQUAL=CHTAB(J) CALL EXCHAH (EQUAL,1) COMAND(180)=-26 C MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE. GO TO 250 220 COMAND(180)=-27 C MESSAGE 27 - TOO MANY ) GO TO 240 230 COMAND(180)=-28 C MESSAGE 28 - UNRECOGNIZED CHARACTER C 240 EQUAL=INFIX 250 RETURN C END SUBROUTINE EXCHC5 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE, C AND INDEX IF SELECTED. COPY RECORDS FROM WORKF FIRST, IF ANY. C CREATE CONTROL RECORDS DEMANDED BY COMMANDS. C C THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF C THE PARAMETER STRING. C C AUTHOR C COMMENT C CONTROL (ITYPEO SET FROM MODIFY) C DATA TYPE C GROUPS C INSERT C KEYWORDS C MACHINE C ORIGIN C REFERENCES C REMOVE (FIRST CHARACTER OF PARAMETER STRING ONLY) C SIGNAL (FIRST CHARACTER OF PARAMETER STRING ONLY) C UPDATE C C IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS C ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A C CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND. C C ***** LOCAL VARIABLES ************************************ C C BLANK CONTAINS A HOLLERITH BLANK. INTEGER BLANK C C1 IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING. INTEGER C1 C COL1 THE FIRST COLUMN OF TEXT OF A CONTROL RECORD. DERIVED FROM C EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE. INTEGER COL1 C I,J USED FREELY AS INDICES. INTEGER I,J C KCONT THE INDEX IN COMD OF THE CONTROL COMMAND. INTEGER KCONT C KNAME IS THE INDEX IN COMD OF THE NAME COMMAND. INTEGER KNAME C KTEXT THE INDEX IN COMD OF THE TEXT COMMAND. INTEGER KTEXT C KUPDA THE INDEX IN COMD OF THE UPDATE COMMAND. INTEGER KUPDA C LIST CONTAINS THE WORD LIST IN ASCII. USED FOR THE A OPTION. INTEGER LIST(4) C NM IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED. INTEGER NM C NOUT IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED. INTEGER NOUT C NY IS THE PROGRAM NUMBER. IT IS THE NUMBER FROM INTAPE IF C OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE. INTEGER NY C ONE CONTAINS A HOLLERITH 1. INTEGER ONE C REASON REASON FOR COPYING A CONTROL RECORD. 1 = COPY COMMAND C PENDING. 2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8. C 3 = COMMAND. INTEGER REASON C RI CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A C GIVEN RECORD TYPE. RI IS SUBSCRIPTED BY (ITYPEO-64). INTEGER RI(26) C RT IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT. INTEGER RT(34) C STAR CONTAINS A HOLLERITH STAR. INTEGER STAR C ZERO CONTAINS A HOLLERITH ZERO. INTEGER ZERO C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL VARIABLE DATA ******************************** C DATA BLANK /1H / C L I S T DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/ C DATA KCONT /31/ DATA KNAME /9/ DATA KTEXT /27/ DATA KUPDA/29/ DATA ONE /1H1/ C A B C D E F DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/ C G H I J K L DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/ C M N O P Q R DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/ C S T U V W X DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/ C Y Z DATA RI(25),RI(26) /31,31 / C A C D G DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/ C P K DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/ C M O DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/ C B R DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/ C S DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/ C J DATA RT(31),RT(32),RT(33),RT(34) /-1, 0, 0,74/ C DATA STAR /1H*/ DATA ZERO /1H0/ C C ***** PROCEDURES ***************************************** C REASON=1 NY=N1RECI IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1 C ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P. C IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT. IF (PHASE.EQ.4) NY=0 C NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER. (IT IS PRINTED C IN THE INDEX). IF (ICOMD.LE.0) GO TO 10 IF (PHASE.GE.4) GO TO 100 IF (ICOMD.EQ.KNAME) GO TO 10 IF (ICOMD.NE.KUPDA) GO TO 100 REASON=2 PHASE=8 10 IF (NRWORK.GT.0) REWIND WORKF NM=0 NOUT=0 20 NM=NM+1 IF (NM.LE.NRWORK) GO TO 60 30 IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230 C 69 = ASCII E, 73 = ASCII I. IF (NOUT.EQ.0) GO TO 40 IF (ITYPEI.EQ.80) GO TO 230 C 80 = ASCII P. IF (NCHACT.NE.1) GO TO 40 IF (INTREC(1).EQ.32) GO TO 220 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 40 ITYPEO=ITYPEI NCHOUT=NCHACT DO 50 J=1,NCHOUT 50 OUTREC(J+5)=INTREC(J) GO TO 70 60 READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT) IF (NCHOUT.NE.1) GO TO 70 IF (NM.EQ.1) GO TO 70 IF (OUTREC(6).EQ.32) GO TO 200 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 70 NOUT=NOUT+1 J=RI(ITYPEO-64) DO 80 I=1,4 80 OUTREC(I)=COMD(I,J) OUTREC(5)=61 C 61 = ASCII = COL1=5 IF (J.NE.KCONT) GO TO 130 COL1=7 C CONTROL,*=... MOVE UP TWO CHARACTERS AND INSERT ITYPEO. DO 90 I=1,NCHOUT 90 OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I) OUTREC(5)=44 C 44 = ASCII COMMA. OUTREC(6)=ITYPEO OUTREC(7)=61 C 61 = ASCII = GO TO 130 100 IF (ICOMD.EQ.KTEXT) GO TO 240 COL1=EQUAL-1 NCHOUT=NCHCMD-COL1 NRWORK=NRWORK+1 C NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD. ITYPEO=RT(ICOMD) IF (ITYPEO.GT.0) GO TO 110 C PROCESS CONTROL,TYPE=TEXT COMMAND. ITYPEO=MODIFY IF (RI(ITYPEO-64).NE.KCONT) GO TO 320 110 NOUT=NRWORK REASON=3 DO 120 I=1,NCHCMD 120 OUTREC(I)=COMAND(I) 130 IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1) C 74 = ASCII J. IF (ITYPEO.EQ.80) VERT=0 C 80 = ASCII P IF (ITYPEO.NE.68) GO TO 150 C 68 = ASCII D IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150 DO 140 J=1,4 I=OUTREC(J+COL1) IF (I.GT.96 .AND. I.LT.123) I=I-32 C CONVERT TO UPPER CASE. IF (I.NE.LIST(J)) GO TO 150 140 CONTINUE VERT=1 C GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE. 150 CALL EXCHCG (OUTREC(COL1+1)) IF (OUTOPN.EQ.0) GO TO 160 CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1)) IF (ISTAT.NE.0) GO TO 340 NY=NLRECO 160 NCHOUT=NCHOUT+COL1 C TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER. OUTREC(180)=-NOUT IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC) C PRINT THE INDEX IF SELECTED. IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 1190 IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190 C1=BLANK C DOUBLE SKIP FOR PROGRAM HEADER (P). IF (ITYPEO.EQ.80) C1=ZERO IF (OPTV+VERT.NE.0) GO TO 170 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170 IF (CHAR1L.NE.ONE) C1=ONE CHAR1L=ONE 170 CALL EXCHAH (OUTREC,NCHOUT) WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT) 180 FORMAT (A1,2I5,1H*,(3X,105A1)) 190 IF (REASON.EQ.3) GO TO 310 200 IF (NM-NRWORK) 20,210,220 210 REWIND WORKF NRWORK=0 GO TO 30 220 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT) 330,30,330 230 IF (REASON.EQ.2) GO TO 300 240 IF (OUFILE.EQ.0) GO TO 260 DO 250 I=1,4 250 OUTREC(I)=COMD(I,KTEXT) OUTREC(180)=0 NCHOUT=0 C TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED. CALL EXCHCG (OUTREC) NCHOUT=4 ACTION=2-OPTC-OPTC C ACTION = 2 MEANS START OF PROGRAM. CALL EXCHOU (OUTREC) 260 IF (OPTV+VERT.NE.0) GO TO 280 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280 IF (OUTOPN.NE.0) NY=NLRECO I=BLANK IF (CHAR1L.NE.ONE) I=ONE WRITE (PRINTR,270) I,NY 270 FORMAT (A1,I5,1H*,8X,4HTEXT/) 280 CHAR1L=STAR NRWORK=MIN0(NRWORK,0) IF (IDOPTN.NE.67) IDCUR=IDSTRT C 67 = ASCII C IF (ICOMD.EQ.KTEXT) GO TO 290 C C WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL C RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED. C TRANS=6 GO TO 370 C C WORKING ON A TEXT STATEMENT. C 290 TRANS=7 GO TO 370 C C WORKING ON AN UPDATE STATMENT. C 300 NRWORK=NOUT GO TO 100 C C WRITING A SINGLE CONTROL RECORD. C 310 TRANS=1 GO TO 370 C C ERROR MESSAGES. C 320 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER. GO TO 360 330 NUMBER=1 GO TO 350 340 NUMBER=2 350 EQUAL=ISTAT 360 TRANS=8 C C RETURN TO TRANSITION PROGRAM. C 370 RETURN C END SUBROUTINE EXCHCG (RECORD) C C USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL. C WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED. C THIS IS THE PORTABLE VERSION. IT DOES NOT DO ANYTHING. C INTEGER RECORD(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C RETURN END SUBROUTINE EXCHC6 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE. C INTEGER KNAME,ONE,SVHCMD(180) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KNAME /9/ DATA ONE /1H1/ C LINEO=0 NERRS=0 C SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT. DO 5 I = 1,NCHCMD 5 SVHCMD(I)=HOLCMD(I) IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165 C 73 = ASCII I. IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE C A VOID MODULE. IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.EQ.7) GO TO 220 IF (ISTAT) 250,160,250 10 MODEO=MODEI ITYPEO=0 NBC=OPTL+OUFILE IF (INDEX.GT.0) NBC=1 20 NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTOPN.EQ.0) GO TO 120 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 260 C C CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD C INSTEAD OF BYTE-BY-BYTE). WE CAN DO A BLOCK COPY IF C WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT C FILE AND NOT PRINTING THE INDEX. ALSO, THE INPUT AND C OUTPUT CHARACTER POSITIONS MUST BE THE SAME. IF THE C PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH C THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE C CURRENT POSITION IN THE BYTE BUFFER BE THE SAME. C WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE C LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T C KNOW THE LOCATION OF THE END-OF-FILE RECORD. C IF (NBC.NE.0) GO TO 120 IF (CPCBI+1.NE.CPCBO) GO TO 120 IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120 C WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF. IF (L1PRGI.EQ.0) GO TO 25 IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30 25 IF (CCDBI+1.NE.CCDBO) GO TO 120 IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120 C WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE). C FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO. 30 LI=L1PRGI+NERRCI-1 IF (L1PRGI.NE.0) GO TO 40 LI=NERRCI+NDATAI+9 IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1 40 IF (CPCBI.GE.NCCBI) GO TO 50 IF (CCDBI.GE.LI) GO TO 160 CPCBI=CPCBI+1 CBLCKO(CPCBO)=CBLCKI(CPCBI) CPCBO=CPCBO+1 CCDBI=CCDBI+1 CCDBO=CCDBO+1 GO TO 40 C PACK COPIED BYTES. 50 CALL EXCHPA (CBLCKO,OBLOCK(CWDBO)) CPCBO=1 CPCBI=0 CWDBO=CWDBO+NWCBO CWDBI=CWDBI+NWCBI C NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM 60 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=L1RECI CALL EXCHPB (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 260 70 IF (CCDBI.LT.LI) GO TO 80 IF (L1PRGI.NE.0) GO TO 100 CALL EXCHGB (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 250 GO TO 30 80 NW=NWCBI*((LI-CCDBI)/NCCBI) IF (NW.EQ.0) GO TO 100 DO 90 I=1,NW OBLOCK(CWDBO)=IBLOCK(CWDBI) CWDBO=CWDBO+1 90 CWDBI=CWDBI+1 100 CCDBO=CCDBO+LI-CCDBI CCDBI=LI IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60 CPCBI=MOD(LI,NCCBI) CPCBO=MOD(CCDBO-1,NCCBO)+1 CALL EXCHUN (IBLOCK(CWDBI),CBLCKI) IF (CPCBI.EQ.0) GO TO 160 DO 110 I=1,CPCBI 110 CBLCKO(I)=CBLCKI(I) GO TO 160 C C END OF BLOCK COPY CODE. C 120 CALL EXCHTP (INTREC,LINEO) 160 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 250 IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20 C 73 = ASCII I. 165 IF (OPTL.NE.0) GO TO 180 IF (INDEX.LE.0) GO TO 195 WRITE (PRINTR,170) LINEO 170 FORMAT (I9,14H IMAGES COPIED) GO TO 200 180 WRITE (PRINTR,190) 190 FORMAT (1H1) 195 CHAR1L=ONE 200 IF (OUFILE.EQ.0) GO TO 210 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 210 IF (ITYPEI.EQ.69) GO TO 220 C 69 = ASCII E C C RETURN TO THE COPY CONTROL SEGMENT. C DO 215 I=1,NCHCMD 215 HOLCMD(I)=SVHCMD(I) IF (ICOMD.EQ.-3) GO TO 240 C ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE. TRANS=4 IF (ICOMD.NE.KNAME) GO TO 280 C MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME' C COMMAND SUBMITTED. GO PROCESS 'NAME' COMMAND. TRANS=5 PHASE=4 GO TO 280 C C END OF FILE ON INPUT TAPE. C 220 IF (INTOPN.LT.0) GO TO 240 WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD) 230 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1)) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 240 TRANS=1 GO TO 280 C C ERROR MESSAGES. C 250 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. GO TO 270 260 NUMBER=2 C MESSAGE 2 - I/O ERROR WRITING OUTAPE. 270 TRANS=8 EQUAL=ISTAT C C RETURN TO THE TRANSITION PROGRAM. C 280 IF (NERRS.EQ.0) GO TO 300 WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD) 290 FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./ 1(1X,80A1)) NERRG=MAX0(NERRS,NERRG) 300 RETURN C END SUBROUTINE EXCHC7 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40) C C PROCESS THE TEXT COMMAND. C C MSG IS USED TO PRINT A MESSAGE. INTEGER MSG(6,2) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/ DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/ DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/ DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/ DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/ C LINEI=1 LINEO=0 NERRS=0 INEND=0 CHAR1L=STAR C C SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND C K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 20 I=1,40 IF (K.GT.NCHCMD) GO TO 10 J=COMAND(K) K=K+1 GO TO 20 10 J=32 C 32 = ASCII BLANK. 20 TXDISK(I)=J IF (INTOPN.LE.0) ITYPEI=0 C C MAIN PROCESSING LOOP C 60 EDIT=0 70 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 80 C NCHCMD.LT.0 MEANS END OF FILE. IF (NCHCMD.LT.2) GO TO 100 IF (COMAND(1).NE.SIGNAL) GO TO 100 IF (COMAND(2).EQ.SIGNAL) GO TO 80 IF (COMAND(2).EQ.73) GO TO 370 IF (COMAND(2).EQ.105) GO TO 370 C 73,105 = ASCII I - REQUEST TO INCLUDE TEXT. IF (NCHCMD.LT.3) GO TO 100 IF (COMAND(2).NE.61) GO TO 100 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 70 C END OF TEXT FILE. 80 IF (INTEXT.EQ.0) GO TO 90 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE CALL EXCHIM INTEXT=0 NCHCMD=0 90 NCHCMD=MIN0(NCHCMD,0) IF (PHASE.NE.8) GO TO 660 IF (INEND) 660,630,660 100 IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110 110 IF (EDIT.EQ.0) GO TO 450 C C PARTIAL LINE EDITOR. C INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED. C EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES C THE FIRST NON-BLANK CHARACTER AFTER N2. N1 AND N2 ARE COLUMN C LIMITS UNDER WHICH TO PERFORM THE EDITING. N1 AND ,N2 ARE C OPTIONAL. IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT C LIMIT. IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS C ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE. WHEN C STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING C PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT C LENGTHS OF STRING1 AND STRING2. THE THIRD DELIMITER IS C OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED C AFTER STRING2 IS INSERTED. C IF (INEND.NE.0) GO TO 240 C CONVERT COLUMN NUMBERS. NBR1=0 NBR2=0 I=0 120 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.EQ.44) GO TO 150 C 44 = ASCII COMMA IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR1=10*NBR1+J-48 GO TO 120 130 WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD) 140 FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/ 1(1X,80A1)) NERRS=2 GO TO 70 150 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR2=10*NBR2+J-48 GO TO 150 C SCAN FOR DELIMITER 160 IF (J.NE.32) GO TO 170 C 32 = ASCII BLANK I=I+1 J=COMAND(I) GO TO 160 170 D1=I NBR1=MIN0(NBR1,180) NBR2=MIN0(NBR2,180) IF (NBR1.EQ.0) NBR1=1 IF (NBR2.EQ.0) GO TO 180 IF (NBR2.LT.NBR1) GO TO 130 180 I=I+1 IF (I.GT.NCHCMD) GO TO 130 IF (COMAND(I).NE.J) GO TO 180 D2=I D3=0 190 I=I+1 IF (I.GT.NCHCMD) GO TO 200 IF (COMAND(I).NE.J) GO TO 190 D3=I C LOOK FOR SEARCH STRING (STRING1) 200 NUMBER=D2-D1-1 J=NBR1 IF (NUMBER.EQ.0) GO TO 260 NY=NBR2 IF (NY.EQ.0) NY=NCHACT 210 DO 220 I=1,NUMBER IF (I+J-1.GT.NY) GO TO 240 IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230 220 CONTINUE GO TO 260 230 J=J+1 GO TO 210 240 WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1)) NERRS=2 GO TO 70 C FOUND SEARCH STRING. REPLACE WITH UPDATE STRING. 260 CHAR1L=PLUS IF (D3.NE.0) GO TO 300 C NO THIRD DELIMITER. REPLACE REST OF REGION. NY=NBR2 IF (NY.EQ.0) NY=180 D2=D2+1 IF (D2.GT.NCHCMD) GO TO 280 DO 270 I=D2,NCHCMD INTREC(J)=COMAND(I) J=J+1 IF (J.GT.NY) GO TO 280 270 CONTINUE 280 IF (NBR2.NE.0) GO TO 290 NCHACT=J-1 GO TO 70 290 IF (J.GT.NBR2) GO TO 70 INTREC(J)=32 C 32 = ASCII BLANK J=J+1 GO TO 290 C WE HAVE A THIRD DELIMITER. REPLACE ONLY THE SEARCH STRING. C SHIFT THE REST OF THE REGION AS NECESSARY. 300 NUMBER=(D3-D2)-(D2-D1) IF (NUMBER) 310,350,330 C SHIFT LEFT 310 I=J+D2-D1-1 NY=MIN0(NBR2,NCHACT) IF (NY.EQ.0) NY=NCHACT 320 IF (I.GT.NY) GO TO 350 INTREC(I+NUMBER)=INTREC(I) C NOTE - NUMBER .LT. 0 HERE INTREC(I)=32 C 32 = ASCII BLANK I=I+1 GO TO 320 C RIGHT SHIFT 330 I=NBR2 IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180) NY=J+NUMBER 340 IF (I.LT.NY) GO TO 350 INTREC(I)=INTREC(I-NUMBER) I=I-1 GO TO 340 C NO SHIFT NEEDED. 350 IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180) IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2) NY=NBR2 IF (NY.EQ.0) NY=NCHACT C MOVE UPDATE STRING (STRING2). 360 D2=D2+1 IF (D2.GE.D3) GO TO 70 INTREC(J)=COMAND(D2) J=J+1 IF (J-NY) 360,360,70 C C REQUEST TO INCLUDE TEXT. -I IN COLUMNS 1 AND 2. C 370 IF (EDIT.EQ.0) GO TO 390 WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD) 380 FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X 1,80A1)) NERRS=2 GO TO 70 390 ITYPEO=73 C 73 = ASCII I IF (NCHCMD.GE.4) GO TO 410 WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD) 400 FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A 11)) NERRS=2 GO TO 70 410 DO 420 I=4,NCHCMD IF (COMAND(I).NE.32) GO TO 430 420 CONTINUE C CONVERT TO UPPER CASE. WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM 430 K=0 DO 440 J=I,NCHCMD IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32 K=K+1 440 COMAND(K)=COMAND(J) NCHCMD=K GO TO 460 C C TEXT RECORD. C 450 ITYPEO=0 460 NCHOUT=NCHCMD IF (OUTOPN.EQ.0) GO TO 470 MODEO=0 CALL EXCHPR (ISTAT,OBLOCK,COMAND) IF (ISTAT.NE.0) GO TO 770 470 CALL EXCHTP (COMAND,0) GO TO 70 C C APPARENT CHANGE CONTROL COMMAND C 480 IF (INEND.EQ.0) GO TO 510 490 WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD) 500 FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT 1 END./(1X,80A1)) NERRS=1 GO TO 70 510 NUMBER=1 NBR1=0 EDIT=0 I=1 520 I=I+1 IF (I.GT.NCHCMD) GO TO 600 J=COMAND(I) IF (J.EQ.32) GO TO 600 C 32 = ASCII BLANK IF (EDIT.NE.0) GO TO 530 C EDIT CONTROL MUST BE BLANK AFTER $. IF (J.EQ.44) GO TO 570 C 44 = ASCII COMMA IF (J.EQ.36) GO TO 560 C 36 = ASCII $ IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.LE.57) GO TO 550 C 57 = ASCII 9 530 WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD) 540 FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1) NERRS=2 GO TO 60 550 NBR1=10*NBR1+J-48 GO TO 520 560 IF (NBR1.EQ.0) GO TO 530 EDIT=1 NBR1=NBR1-1 GO TO 520 570 NUMBER=2 NBR2=0 580 I=I+1 IF (I.GT.NCHCMD) GO TO 590 J=COMAND(I) IF (J.EQ.32) GO TO 590 C 32 = ASCII BLANK IF (IABS(J-44).EQ.1) GO TO 590 C 43 = ASCII +, 45 = ASCII - IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.GT.57) GO TO 530 C 57 = ASCII 9 NBR2=10*NBR2+J-48 GO TO 580 590 IF (NBR2.LT.NBR1) GO TO 530 NBR1=NBR1-1 600 IF (NBR1.GE.LINEI-1) GO TO 620 WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD) 610 FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1) NERRS=2 GO TO 60 620 IF (NCHCMD.LE.0) GO TO 630 IF (LINEI.LE.NBR1) GO TO 630 IF (NUMBER.EQ.1) GO TO 70 C SKIP INTAPE UNTIL NBR2 IS SKIPPED. MODEI=1 IF (LINEI.GE.NBR2) MODEI=0 IF (LINEI-NBR2) 650,650,70 C COPY FROM INTAPE UNTIL NBR1 COPIED. 630 MODEO=MODEI NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTAPE.EQ.0) GO TO 640 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 770 640 CALL EXCHTP (INTREC,LINEI) MODEI=0 IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650 IF (LINEI.EQ.NBR1) GO TO 650 MODEI=1 650 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 760 LINEI=LINEI+1 IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620 C 73 = ASCII I INEND=1 IF (NCHCMD.LE.0) GO TO 660 I=NBR2 IF (NUMBER.EQ.1) I=NBR1 IF (LINEI-I) 490,490,70 660 IF (NERRS.EQ.0) GO TO 675 J=1 IF (PHASE.EQ.8) J=2 WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS 670 FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.) 675 NERRG=MAX0(NERRG,NERRS) IF (OPTL+OPTS.NE.0) GO TO 690 IF (OUTAPE+OUFILE.EQ.0) LINEO=0 IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO 680 FORMAT (I9,14H IMAGES COPIED) GO TO 710 690 WRITE (PRINTR,700) 700 FORMAT (1H1) CHAR1L=ONE 710 IF (OUFILE.EQ.0) GO TO 720 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 720 IF (ITYPEI.NE.69) GO TO 750 C 69 = ASCII E C C END OF FILE ON INPUT TAPE (UPDATE MODE). C IF (INTOPN.LT.0) GO TO 750 DO 730 I=1,40 730 HOLCMD(I+1)=TXDISK(I) HOLCMD(1)=32 IF (TXDISK(1).NE.32) HOLCMD(1)=61 C 32 = ASCII BLANK, 61 = ASCII = CALL EXCHAH (HOLCMD,41) WRITE (PRINTR,740) (HOLCMD(I),I=1,41) 740 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 750 TRANS=1 GO TO 790 C C ERROR MESSAGES. C 760 NUMBER=1 GO TO 780 770 NUMBER=2 780 EQUAL=ISTAT TRANS=8 C C RETURN TO THE TRANSITION PROGRAM. C 790 PHASE=2 IF (OUTOPN.EQ.0) PHASE=1 RETURN C END SUBROUTINE EXCHC8 C C PRINT ERROR MESSAGES. C C ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE INTEGER S(31) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/ DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/ DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/ DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/ DATA S(29),S(30),S(31) /4,5,5 / C C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4 160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751), 2NUMBER C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 10 WRITE (PRINTR,20) EQUAL 20 FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.) GO TO 50 30 WRITE (PRINTR,40) EQUAL 40 FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.) 50 GO TO (60,80,100,120,140,160), EQUAL 60 WRITE (PRINTR,70) 70 FORMAT (22H BLOCK SEQUENCE ERROR.) GO TO 180 80 WRITE (PRINTR,90) 90 FORMAT (20H BLOCK IS TOO SHORT.) GO TO 180 100 WRITE (PRINTR,110) 110 FORMAT (11H I/O ERROR.) GO TO 180 120 WRITE (PRINTR,130) 130 FORMAT (18H RECORD TOO LARGE.) GO TO 180 140 WRITE (PRINTR,150) 150 FORMAT (21H UNKNOWN RECORD TYPE.) GO TO 180 160 WRITE (PRINTR,170) 170 FORMAT (25H FIRST BLOCK NOT A LABEL.) GO TO 760 180 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1) INFILE=0 C C RETURN TO QUIT SEGMENT. C TRANS=9 GO TO 800 C 200 WRITE (PRINTR,210) 210 FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.) GO TO 760 220 WRITE (PRINTR,230) 230 FORMAT (//20H0INTAPE NOT DEFINED.) GO TO 760 240 WRITE (PRINTR,250) 250 FORMAT (//23H0UNABLE TO OPEN INTAPE.) GO TO 10 260 WRITE (PRINTR,270) 270 FORMAT (//23H0UNABLE TO OPEN OUTAPE.) GO TO 30 280 WRITE (PRINTR,290) 290 FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.) GO TO 760 300 WRITE (PRINTR,310) 310 FORMAT (//19H0DATE NOT SUPPLIED.) GO TO 760 320 WRITE (PRINTR,330) 330 FORMAT (//19H0SITE NOT SUPPLIED.) GO TO 760 340 WRITE (PRINTR,350) INTAPE 350 FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4) GO TO 760 360 WRITE (PRINTR,370) 370 FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.) GO TO 760 380 WRITE (PRINTR,390) 390 FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.) GO TO 760 400 WRITE (PRINTR,410) 410 FORMAT (//27H0COMMAND HAS IMPROPER DATE.) GO TO 760 420 WRITE (PRINTR,430) EQUAL 430 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.) GO TO 780 440 WRITE (PRINTR,450) 450 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.) IF (ICOMD) 780,560,780 460 WRITE (PRINTR,470) N1RECI 470 FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO 1N (,I5,2H).) GO TO 760 480 WRITE (PRINTR,490) EQUAL 490 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 500 WRITE (PRINTR,510) 510 FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.) GO TO 760 520 WRITE (PRINTR,530) 530 FORMAT (//23H0WORK FILE NOT DEFINED.) GO TO 760 540 WRITE (PRINTR,550) 550 FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.) GO TO 760 560 WRITE (PRINTR,570) EQUAL 570 FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.) GO TO 760 580 WRITE (PRINTR,590) 590 FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE 1R.) GO TO 760 600 WRITE (PRINTR,610) 610 FORMAT (//12H0TOO MANY (.) GO TO 760 620 WRITE (PRINTR,630) EQUAL 630 FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.) GO TO 760 640 WRITE (PRINTR,650) EQUAL 650 FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.) GO TO 760 660 WRITE (PRINTR,670) EQUAL 670 FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.) GO TO 760 680 WRITE (PRINTR,690) EQUAL 690 FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.) GO TO 760 700 WRITE (PRINTR,710) EQUAL 710 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 720 WRITE (PRINTR,730) N1RECI 730 FORMAT (//21H0INTAPE POSITIONED AT,I5,25H. BACKWARD SKIP IGNORED. 1) GO TO 780 740 WRITE (PRINTR,750) 750 FORMAT (//23H0COMMAND IS INCOMPLETE.) GO TO 760 751 WRITE (PRINTR,752) 752 FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA 1PE OR OUTPUT.) 760 WRITE (PRINTR,770) 770 FORMAT (23H COMMAND NOT PROCESSED.) 780 WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD) 790 FORMAT ((1X,80A1)) C C RETURN TO COMMAND PROCESSSOR. C CHAR1L=0 NERRS=MAX0(S(NUMBER),NERRS) NERRG=MAX0(NERRG,NERRS) TRANS=1 C C RETURN TO TRANSITION PROGRAM. C 800 RETURN C END SUBROUTINE EXCHC9 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO C ERRORS. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KQUIT /20/ C IF (INFILE.EQ.0) GO TO 10 IF (MODIFY.NE.82) GO TO 5 C 82 = ASCII R ACTION=2 C ACTION = 2 MEANS REWIND INFILE. CALL EXCHIM 5 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. CALL EXCHIM INFILE=0 NCHCMD=0 GO TO 50 10 IF (OPTC*OUFILE.EQ.0) GO TO 20 ACTION=0 NCHOUT=4 CALL EXCHOU (COMD(1,KQUIT)) 20 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) IF (OUTOPN.EQ.0) GO TO 30 C WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (ISTAT,OBLOCK,OUTREC) C CLOSE THE INPUT TAPE. 30 IF (INTOPN.EQ.0) GO TO 40 ISTAT=4 CALL EXCHRT (ISTAT,OBLOCK) C C RETURN TO MAIN PROGRAM. C 40 TRANS=0 IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG 45 FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.) GO TO 60 C C RETURN TO THE COMMAND DECODER. C 50 TRANS=1 60 RETURN C END =TES FILE=4 @HDG,P EXCHMAIN/1100 @FTN,SVI EXCHMAIN/1100 C UNIVAC 1100 MAIN PROGRAM FOR TEXT EXCHANGE PROGRAMS. C C THE FOLLOWING STATEMENT ALLOCATES SPACE FOR TAPE INPUT. C INTEGER IBLOCK(1600) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) C PFS ARE PROGRAM FILE SEARCH PACKETS FOR INTAPE AND OUTAPE C IF OMN ELEMENTS ON DISK ARE USED (COMPREHENSIVE PROGRAM ONLY). INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE COMMON /EXEC8A/ FILES,ELTS,VERS,PFS DATA ELTS(1,6) /O050505050505/ @ FIELDATA BLANKS FOR INTAPE ELT DATA PFS(11,1) /0/ @ INTAPE SECTOR POSITION (FOR SIMPLE PROGRAM) DATA NWCBI /40/ DATA PRINTR /6/, READER /5/ C CALL EXCH (IBLOCK) CALL EXIT END @HDG,P EXCHBD @FTN,SVI EXCHBD BLOCK DATA C C BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/ DATA INTEXT /0/, INALT /0/ C DATA CHAR1L /1H1/ C A U T H DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1) /65,85,84,72/ C C O M M DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2) /67,79,77,77/ C C O P Y DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3) /67,79,80,89/ C D A T A DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4) /68,65,84,65/ C D A T E DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5) /68,65,84,69/ C G R O U DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6) /71,82,79,85/ C I N D E DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7) /73,78,68,69/ C I N P U DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8) /73,78,80,85/ C N A M E DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9) /78,65,77,69/ C I N T A DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/ C K E Y W DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/ C L I M I DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/ C M A C H DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/ C O P T I DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/ C O R I G DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/ C O U T A DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/ C O U T P DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/ C P R E D DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/ C P R I N DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/ C Q U I T DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/ C R E A D DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/ C R E F E DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/ C R E M O DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/ C R E W I DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/ C S I T E DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/ C S K I P DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/ C T E X T DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/ C T I T L DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/ C U P D A DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/ C W O R K DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/ C C O N T DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/ C I D E N DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/ C I N C L DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/ C S I G N DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/ C M A R G DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/ DATA IDSTEP /0/, IDTXTL /0/ DATA INDEX /0/ DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/ DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/ DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/ DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/ DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/ DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/ DATA INDEXS(25),INDEXS(26) /0,0 / DATA INTOPN /0/ DATA ITYPEI /0/ DATA LIMIT /0/ DATA MARGIN /180/ DATA NCCBI /180/ DATA NCCBO /180/ DATA NCHCMD /0/ DATA NCHMAX /180/ DATA NCOMDP /35/ DATA NCOMDT /35/ DATA NDATAO /3591/ DATA NERRCO /0/ DATA NERRG /0/ DATA NRWORK /0/ DATA OUTOPN /0/ DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/ DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/ DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/ DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/ DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/ DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/ DATA OPTVAL(25),OPTVAL(26) /0,0 / DATA PHASE /1/ C INDICATE THAT NO PREDICATES ARE DEFINED. DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/ DATA PRED(1,6),PRED(1,7),PRED(1,8) /0,0,0 / DATA SITE(1) /0/ DATA TITLE(1) /32/ C 32 = ASCII BLANK DATA TODAY (1) /0/ DATA TRANS /1/ C C TRANSLATION TABLE FROM ASCII TO HOLLERITH. USES ASCII GRAPHICS. C TRANSLATES CONTROL CHARACTERS (<32) TO '$'. C MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES. C DATA XLATE(1), XLATE(2), XLATE(3), XLATE(4) /1H$,1H$,1H$,1H$/ DATA XLATE(5), XLATE(6), XLATE(7), XLATE(8) /1H$,1H$,1H$,1H$/ DATA XLATE(9), XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/ DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/ DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/ DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/ DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/ DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/ DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/ DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/ DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/ DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H// DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/ DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/ DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/ DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/ DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/ DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/ DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/ DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/ DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/ DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/ DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/ DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/ DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/ DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/ DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/ DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/ DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/ DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/ DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/ DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/ END @HDG,P EXCH/1100 @FTN,SVI EXCH/1100 SUBROUTINE EXCH (IBLOCK) C C UNIVAC 1100 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM. C INTEGER IBLOCK(1) C C ALLOCATE SPACE FOR TAPE OUTPUT. C INTEGER OBLOCK(800) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER XLATE(128) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCHXC/ XLATE EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) INTEGER AFDFLG,WORKS(474,5) @ OUTPUT CODE, WORK AREAS COMMON /EXEC8/ AFDFLG,WORKS DATA AFDFLG /1/ @ DEFAULT OUTPUT CODE = ASCII. DATA NWCBO /40/ DATA WORKF /9/ C CALL XHINIT CALL EXCHTR (IBLOCK,OBLOCK) RETURN END @HDG,P EXCHEM/1100 @FTN,SVI EXCHEM/1100 SUBROUTINE EXCHEM (ISTAT) ENTRY EXCHM2 (ISTAT,ASGSTA) C C WRITE ERROR MESSAGES ASSOCIATED WITH PROGRAM FILE I/O FOR C UNIVAC-1100 SENSITIVE EXCHIM, EXCHOU, EXCHRT, EXCHWT. C C ASGSTA IS THE ASSIGN STATUS IF A FILE COULD NOT BE ASSIGNED. C ASGSTA IS USED ONLY IF ISTAT = 35, WHICH IS PRODUCED ONLY BY C EORSRO AND EORSWO. EXCHM2 IS THEREFORE ONLY CALLED FROM EXCHCX C AND EXCHOU. C INTEGER ISTAT,ASGSTA C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C IF (ISTAT.GT.32) GO TO 20 WRITE (PRINTR,10) ISTAT 10 FORMAT (//'0I/O ERROR STATUS = ',O2) GO TO 130 20 ISTAT=ISTAT-32 GO TO (30,50,70,90,110), ISTAT 30 WRITE (PRINTR,40) 40 FORMAT (//'0ELEMENT NOT FOUND') GO TO 130 50 WRITE (PRINTR,60) 60 FORMAT (//'0EXEC I/O ERROR') GO TO 130 70 if (asgsta.lt.0) go to 75 write (printr,72) 72 format (//'0File is not a program file.') go to 130 75 write (printr,80) asgsta 80 format (//'0File cannot be assigned, @ASG status =',o13) GO TO 130 90 WRITE (PRINTR,100) 100 FORMAT (//'0FILE/ELEMENT NOT OPENED') GO TO 130 110 WRITE (PRINTR,120) 120 FORMAT (//'0PROGRAM FILE OVERFLOW') C 130 NERRG=MAX0(NERRG,6) RETURN C END @HDG,P EXCHFO/1100-FTN @FTN,SVI EXCHFO/1100-FTN SUBROUTINE EXCHFO (IOP) C C OPEN AND CLOSE FILES FOR UNIVAC 1100 FTN VERSION OF EXCHANGE C PROGRAM. C C IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS C OPEN FILE. IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3 C MEANS WORK FILE, = 4 MEANS INFILE. IOP = 4 IS USED ONLY BY THE C BOOTSTRAP PROGRAM. C INTEGER IOP C INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C IF (IOP.EQ.2) THEN IF (PRINTR.NE.6) OPEN (UNIT=PRINTR,TYPE='APRNTA') END IF RETURN C END @HDG,P EXCHIM/1100 @FTN,SVI EXCHIM/1100 SUBROUTINE EXCHIM C C READ A COMMAND OR TEXT IMAGE FROM 1. ALTERNATE FILE C 2. TEXT FILE C 3. INPUT FILE C 4. SYSTEM READER. C PUT THE HOLLERITH COMMAND IN HOLCMD, C PUT THE ASCII EQUIVALENT IN COMAND, C PUT THE NUMBER OF CHARACTERS IN NCHCMD. C IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1. C C UNIVAC-1100 VERSION. C FIELDATA OR ASCII FILES OR ELEMENTS MAY BE READ. C INTEGER EXCH8I INTEGER AFDFLG,WORKS(474,5) @ OUTPUT CODE, WORK AREAS INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) COMMON /EXEC8/ AFDFLG,WORKS COMMON /EXEC8A/ FILES,ELTS,VERS,PFS C DATA WORKS(1,1) /0/ DATA WORKS(6,1),WORKS(6,2),WORKS(6,3),WORKS(6,4) /0,0,0,0/ DATA WORKS(10,1),WORKS(10,2),WORKS(10,3),WORKS(10,4) /0,0,0,0/ C C DECIDE WHAT TO DO. C IF (ACTION.EQ.1) GO TO 100 @ FILES OPENED BY EXCHCX C C DECIDE WHICH FILE TO READ. C VALUES OF J ARE DETERMINED BY ARGUMENT OF EXCHCX. C J=4 IF (INALT.GT.0) GO TO 10 J=3 IF (INTEXT.NE.0) GO TO 10 J=2 IF (INFILE.NE.0) GO TO 10 J=1 10 IF (ACTION.NE.0) GO TO 30 N1=EXCH8I(WORKS(1,J)) IF (N1.EQ.0) GO TO 100 CALL EXCHEM (N1) WRITE (PRINTR,20) 20 FORMAT (' WHILE READING INPUT. EOF SIMULATED.') GO TO 90 C C CLOSE AN INPUT FILE. C 30 CALL EORSRC (WORKS(1,J)) IF (ACTION.NE.2) GO TO 100 @ EXIT IF NOT REOPENING INCLUDE C C RE-OPEN INPUT FILE, IGNORE THE STATUS. C CALL EORSRO (WORKS(1,J),ELTS(1,J),VERS(1,J)) GO TO 100 C C END OF FILE ON INPUT. C 90 NCHCMD=-1 C 100 ACTION=0 RETURN C END @HDG,P EXCHOU/1100 @FTN,SVI EXCHOU/1100 SUBROUTINE EXCHOU (OUTPUT) C C NATIVE FORMAT OUTPUT SUBPROGRAM FOR THE EXCHANGE PROGRAM. C THIS MODULE IS FOR THE UNIVAC 1100 SERIES OF COMPUTERS. C IT EXAMINES THE SYSTEM DEPENDENT INFORMATION AFTER THE UNIT C NUMBER ON THE 'OUTP=...' COMMAND. IF THERE IS NO SUCH INFORMATION C THE OUTPUT FILE IS REWOUND. IF THE FIRST CHARACTER IS + OUTPUT C CONTINUES FROM THE CURRENT POSITION (THE UNIT NUMBER MUST NOT C CHANGE FROM ITS PREVIOUS VALUE, BUT THIS CANNOT BE CHECKED HERE). C OTHERWISE THE INFORMATION IS TREATED AS AN ELEMENT/VERSION C SPECIFICATION. IF AN ERROR OCCURS WHILE OPENING THE ELEMENT C THE FILE WILL BE REWOUND. C C OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN. C THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT. C C THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180), C THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179). IF OUTPUT(180) C IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE. IF OUTPUT(180) C IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW C IMAGE. C INTEGER OUTPUT(1) INTEGER EORSWO,EORSWW,EORSWC,EXCH8O INTEGER SDFF /O503011131350/ @ '*SDFF*' IN FD. INTEGER LABEL /O500130000000/ @ SDF LABEL ICW. INTEGER PLUS /1H+/ INTEGER FDBLNK /O050505050505/ @ FIELDATA BLANK INTEGER BIT28 /O002000000000/ @ USED TO SET ASCII/FD BIT C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER AFDFLG,WORKS(474,5) INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXEC8/ AFDFLG,WORKS COMMON /EXEC8A/ FILES,ELTS,VERS,PFS EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C DECIDE WHETHER TO OPEN, CLOSE OR WRITE. C IF (IABS(ACTION).EQ.2) GO TO 140 C IABS(ACTION)=2 MEANS START OR END OF PROGRAM. IF (ACTION) 40,10,60 C C WRITE. C 10 ISTAT=EXCH8O(OUTPUT) IF (ISTAT.EQ.0) GO TO 140 CALL EXCHEM (ISTAT) WRITE (PRINTR,30) 30 FORMAT (' WHILE WRITING OUTPUT FILE.') GO TO 140 C C CLOSE. C 40 IF (WORKS(1,5).EQ.0) GO TO 140 @ PUNCH FILE. ISTAT=EORSWC(WORKS(1,5),5,0,1) IF (ISTAT.EQ.0) GO TO 140 CALL EXCHEM (ISTAT) WRITE (PRINTR,50) 50 FORMAT (' WHILE CLOSING OUTPUT FILE.') GO TO 140 C C OPEN. C 60 WORKS(1,5)=0 @ SETUP FOR PUNCH FILE OUTPUT. IF (NTABDC(OUFILE).GE.32) GO TO 140 @ JUMP IF PUNCH FILE. C USE FIFTH ELEMENT OF FILES, ELTS, VERS. SEE EXCHCX. WORKS(1,5)=FILES(1,5) WORKS(2,5)=FILES(2,5) IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 90 IF (HOLCMD(EQUAL).NE.PLUS) GO TO 70 ELTS(1,5)=WORKS(6,5) @ GET CURRENT DISK ADDRESS GO TO 100 C C OPEN AN ELEMENT TO WRITE. C 70 IF (ELTS(1,5).NE.FDBLNK) GO TO 110 WRITE (PRINTR,80) (HOLCMD(I),I=1,NCHCMD) 80 FORMAT (//'0IMPROPER ELEMENT NAME, OPEN FILE'/(1X,80A1)) NERRG=MAX0(NERRG,5) 90 ELTS(1,5)=0 100 ELTS(2,5)=0 110 ISTAT=EORSWO(WORKS(1,5),ELTS(1,5),VERS(1,5)) IF (ISTAT.NE.0) GO TO 120 C SET ASCII FLAG. WORKS(468,5)=AND(WORKS(468,5),COMPL(BIT28))+AFDFLG*BIT28 ISTAT=EORSWW(WORKS(1,5),SDFF,LABEL+AFDFLG) IF (ISTAT.EQ.0) GO TO 140 c We can get away with using works(3,5) here because EORSWW does c not set ISTAT = 35. 120 call exchm2 (istat,works(3,5)) WRITE (PRINTR,130) (HOLCMD(I),I=1,NCHCMD) 130 FORMAT (' WHILE OPENING OUTPUT FILE.'/(1X,80A1)) C C RETURN C 140 ACTION=0 RETURN C END @HDG,P EXCHRT/1100 @FTN,SVI EXCHRT/1100 SUBROUTINE EXCHRT (ISTAT,DBLOCK) C C UNIVAC 1100. C C READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE. C INPUT: C ISTAT = 1 MEANS OPEN WITH NO REWIND. C ISTAT = 2 MEANS REWIND (CLOSE WITH REWIND). C ISTAT = 3 MEANS READ. C ISTAT = 4 MEANS CLOSE WITH NO REWIND. C C OUTPUT: C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR WAS DETECTED. C C DBLOCK IS THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). C INTEGER DBLOCK(1) C INTEGER EXCHIO,EXCHFN INTEGER FDBLNK /O050505050505/ @ FIELDATA BLANK INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXEC8A/ FILES,ELTS,VERS,PFS EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C I=ISTAT ISTAT=0 GO TO (10,60,30,110), I C C OPEN INTAPE. CONVERT UNIT NUMBER TO FD (FOR SIMPLE PROGRAM). C 10 FILES(1,6)=EXCHFN(INTAPE) FILES(2,6)=FDBLNK PFS(10,1)=PFS(11,1) GO TO 110 C C READ A BLOCK. C 30 I=0 40 NWORDS=2*((NDATAI+NERRCI+9+8)/9) @ NUMBER OF WORDS EXPECTED L=EXCHIO (FILES(1,6),16,NWORDS,DBLOCK,PFS(11,1)) IF (L.GT.0) GO TO 50 C ALLOW ONE END OF FILE IF TRYING TO READ LABEL. IF (BLKSQI.NE.0) GO TO 90 IF (I.NE.0) GO TO 80 IF (L.NE.-1) GO TO 90 I=1 GO TO 40 50 NCDBI=MIN0(NDATAI+NERRCI+9,9*L/2) PFS(11,1)=PFS(11,1)+(L+27)/28 @ UPDATE SECTOR ADDRESS GO TO 110 C C REWIND. C 60 L=EXCHIO (FILES(1,6),32,NWORDS,DBLOCK,PFS(11,1)) C IGNORE THE STATUS. PFS(11,1)=PFS(10,1) GO TO 110 C C I/O ERROR. C 80 L=-1 90 L=-L CALL EXCHEM (L) WRITE (PRINTR,100) L 100 FORMAT (' WHILE READING INTAPE.') ISTAT=3 110 RETURN C END @HDG,P EXCHWT/1100 @FTN,SVI EXCHWT/1100 SUBROUTINE EXCHWT (ISTAT,DBLOCK) C C UNIVAC 1100. C C WRITE A BLOCK ON THE EXCHANGE TAPE. C C INPUT: C ISTAT = 1 MEANS OPEN OUTPUT WITH NO REWIND C ISTAT = 2 MEANS WRITE C ISTAT = 3 MEANS WRITE END FILE AND CLOSE WITH NO REWIND. C C OUTPUT: C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ON C TAPE). INTEGER DBLOCK(1) C INTEGER EXCHIO INTEGER FDBLNK /O050505050505/ @ FIELDATA BLANK INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXEC8A/ FILES,ELTS,VERS,PFS EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C I=ISTAT ISTAT=0 GO TO (90,10,30), I C C WRITE C 10 NWORDS=2*((CCDBO+8)/9) IF (BLKSQO.NE.0) NWORDS=2*((NDATAO+NERRCO+9+8)/9) L=EXCHIO (FILES(1,7),8,NWORDS,DBLOCK,PFS(10,2)) IF (L.LT.0) GO TO 15 PFS(10,2)=PFS(10,2)+(L+27)/28 @ UPDATE SECTOR ADDRESS. GO TO 90 C C I/O ERROR. C 15 L=-L CALL EXCHEM (L) WRITE (PRINTR,20) 20 FORMAT (' WHILE WRITING OUTAPE - EOF WRITTEN.') C NOW CLOSE OUTAPE. C C CLOSE WITH NO REWIND (END FILE). C 30 L=EXCHIO (FILES(1,7),9,NWORDS,DBLOCK,PFS(10,2)) C IGNORE THE STATUS. WRITE (PRINTR,40) BLKSQO,OUTAPE 40 FORMAT (I6,23H BLOCKS WRITTEN ON TAPE,I4) IF (ELTS(1,7).EQ.FDBLNK) GO TO 90 I=PFS(10,2) PFS(10,2)=PFS(10,2)-PFS(11,2) @ COMPUTE ELEMENT LENGTH CALL PFIER (PFS(1,2),I,I) IF (I.EQ.0) GO TO 90 I=I+32 CALL EXCHEM (I) WRITE (PRINTR,50) OUTAPE 50 FORMAT (' WHILE TRYING TO CLOSE OUTAPE',I4, 1'. OUTPUT PROBABLY LOST.') IF (NCHCMD.LT.0) GO TO 90 WRITE (PRINTR,60) (HOLCMD(I),I=1,NCHCMD) 60 FORMAT (1X,80A1) GO TO 90 90 RETURN C END @HDG,P ASMEXCH1/1100 @MASM,SI ASMEXCH1/1100,,,FTN /. FTN EQU $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE. AXR$. . . CONVERT AN INTEGER TO LJSF FD. . FD=EXCHFN (INTEGER) . ONLY ONE WORD IS PRODUCED. . $(1),EXCHFN*. ON 1-FTN. SZ A3. FOR ADDR=IND. L A1,*0,X11. INTEGER. OFF. ON FTN. L,H2 A1,0,A0. ADDR OF INTEGER. L A1,0,A1. INTEGER. OFF. L A3,(' '). FNLOOP DSL A1,36. DI,U A1,10. PEEL OFF A DIGIT. A,U A2,'0'. CONVERT TO FD. DSL A2,6. SHIFT INTO A3. JNZ A1,FNLOOP. GET MORE DIGITS. S A3,A0. STORE FD. J 2-2*FTN,X11. RETURN /. PERFORM I/O WITHOUT USING NTRAN. . I=EXCHIO (FNAME,FUNC,NWORDS,DBLOCK,DSKADR) . FNAME=2 WORD FD FILE NAME. . FUNC=8 TO WRITE, 16 TO READ, 32 TO REWIND TAPE. . NWORDS=NUMBER OF WORDS TO TRANSFER. . DBLOCK=BUFFER ADDRESS. . DSKADR=DISK SECTOR ADDRESS. . AFTER RETURN, I<0 = -IO STATUS, I>0 = WORDS TRANSFERRED. . $(1),EXCHIO*. ON 1-FTN. SZ A3. FOR ADDR=IND. L A5,*4,X11. DSKADR. L A2,*1,X11. FUNC. DL A0,*0,X11. FNAME. LXI A3,*2,X11. NWORDS. LXM,U A3,*3,X11. DBLOCK. OFF. ON FTN. L,H2 A3,4,A0. ADDR OF DSKADR. L A5,0,A3. DSKADR. L,H2 A3,1,A0. ADDR OF FUNC. L A2,0,A3. FUNC. L,H2 A3,2,A0. ADDR OF NWORDS. LXI A3,0,A3. NWORDS. LXM,H2 A3,3,A0. DBLOCK. L,H2 A0,0,A0. ADDR OF FNAME. DL A0,0,A0. FNAME. OFF. DS A0,PKT. STORE FNAME. L,U A0,PKT. GET PACKET ADDRESS. JZ A2,TESTEQ. TEST EQUIPMENT IF FUNC=0. TNE,U A2,WEF$. TRYING TO WRITE EOF MARK? J TESTEQ. YES, TEST EQUIPMENT. TE,U A2,REW$. TRYING TO REWIND? J IO. NO, GO DO I/O. TESTEQ ER FACIL$. GET FILE DESCRIPTION. L,S1 A1,PKT+6. GET DEVICE CODE. JNZ A1,ASGD. L A0,(3,PKT-1). ER CSF$. ASSIGN WITH NO OPTIONS, IGNORE STATUS. L,U A0,PKT. ER FACIL$. GET EQUIP CODE AGAIN. L,S1 A1,PKT+6. ASGD JZ A2,6-6*FTN,X11. RETURN IF FACIL & ASG ONLY. AN,U A1,017. FIRST NON-TAPE EQCODE. JP A1,6-6*FTN,X11. YES, RETURN IF NOT TAPE. L,U A0,PKT. GET I/O PACKET ADDRESS. IO SZ PKT+2. SZ PKT+3. S,S2 A2,PKT+3. STORE FUNC. S A3,PKT+4. STORE NWORDS & DBLOCK. S A5,PKT+5. STORE DSKADR. ER IOW$. DO I/O, WAIT FOR COMPLETION. L,H2 A0,PKT+3. GET NUMBER OF WORDS. TZ,S1 PKT+3. TEST STATUS. LN,S1 A0,PKT+3. GET -STATUS IF STATUS NOT=0. J 6-6*FTN,X11. RETURN. . $(0) '@ASG '. PKT RES 9. I/O PACKET. /. UNPACK 9-TRACK FORMAT 8-BIT CHARACTER DATA (WHICH MAY HAVE . BEEN READ FROM DISK OR 7-TRACK TAPE) TO ONE CHARACTER PER . WORD RJZF. ALWAYS UNPACK NCH WORDS (DEFINED BY EQU). . . CALL EXCHUN (BUF9T,BUFOUT) . BUF9T=9-TRACK FORMAT BUFFER. . BUFOUT=RJZF ONE CHARACTER PER WORD BUFFER. . NCH EQU 180. NUMBER OF CHARACTERS TO UNPACK. . $(1),EXCHUN*. ON 1-FTN. SZ A3. FOR ADDR=IND. L,U A0,*0,X11. BUF9T ADDRESS. L,U A1,*1,X11. BUFOUT ADDRESS. OFF. ON FTN. L,H2 A1,1,A0. BUFOUT ADDRESS. L,H2 A0,0,A0. BUF9T ADDRESS. OFF. LXI,U A0,2. PROCESS DOUBLE WORDS OF BUF9T. LXI,U A1,1. PROCESS SINGLE WORDS OF BUFOUT. L,U R1,NCH/9-1. NUMBER OF 9 CHARACTER GROUPS. . GETNXT DL A3,0,*A0. GET 9 8-BIT CHARACTERS. L,U R2,8. LOOP COUNTER TO PROCESS 9 CHARACTERS NEXTCH LDSC A3,8. GET 8 BITS. AND,U A4,0377. LOW ORDER 8 BITS OF A4 -> A5. S A5,0,*A1. STORE IN BUFOUT. JGD R2,NEXTCH. PEEL OFF ANOTHER 8 BITS. JGD R1,GETNXT. GET ANOTHER DOUBLE WORD. J 3-3*FTN,X11. RETURN. END. @HDG,P ASMEXCH2/1100 @MASM,SI ASMEXCH2/1100,,,FTN /. FTN EQU $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE. AXR$. . GET THE DATE AND STORE IT IN 'TODAY' IN /EXCHPC/, . ONE CHARACTER PER WORD, RIGHT JUSTIFIED, ZERO FILLED. . NOTE THAT THE FIELDATA NUMBERS AND THE ASCII NUMBERS . HAVE THE SAME VALUES. . $(1),XHINIT*. L A2,(1,TODAY). PLACE TO PUT THE DATE. ER DATE$. GET THE DATE FROM EXEC SSC A0,12. CONVERT DATE FROM MMDDYY TO YYMMDD L,U R1,5. LOOP COUNTER NEXDAT SZ A1. LDSC A0,6. STRIP OFF ONE CHARACTER INTO A1 S A1,,*A2. STORE IT IN 'TODAY' VECTOR JGD R1,NEXDAT. LOOP . . STORE @XQT OPTIONS IN 'OPTVAL' VECTOR IN /EXCHPC/. . L A2,(1,OPTVAL). PLACE TO STORE THE OPTIONS. ER OPT$. GET OPTION BITS FROM EXEC. LSSL A0,10. A OPTION -> SIGN BIT. L,U A3,25. LOOP COUNTER - 1. OPTLOOP SZ A1. LDSC A0,1. SHIFT OPTION BIT INTO A1. S A1,0,*A2. STORE IN 'OPTVAL' VECTOR. JGD A3,OPTLOOP. PROCESS MORE OPTIONS. J 1-FTN,X11. RETURN . . DO A PROGRAM FILE SEARCH ER (PFS$). . CALL PFSER (PACKET,STATUS) . $(1),PFSER*. DO FTN , L A3,A0. SAVE CALLING SEQUENCE ADDRESS. DO FTN , L,H2 A0,0,A3. GET PACKET ADDRESS. DO 1-FTN , SZ A3. FOR INDIRECT ADDRESSING. DO 1-FTN , L,U A0,*0,X11. GET PACKET ADDRESS. ER PFS$. DO FTN , L,H2 A1,1,A3. GET STATUS ADDRESS. DO FTN , S A2,0,A1. STORE STATUS. DO 1-FTN , S A2,*1,X11. STORE STATUS. J 3-3*FTN,X11. RETURN. . . GET THE NEXT WRITE LOCATION FOR A PROGRAM FILE. . CALL PFWLER (PACKET,NWL,STATUS) . $(1),PFWLER*. DO FTN , L A3,A0. SAVE CALLING SEQUENCE ADDRESS. DO FTN , L,H2 A0,0,A3. GET PACKET ADDRESS. DO 1-FTN , SZ A3. FOR INDIRECT ADDRESSING. DO 1-FTN , L,U A0,*0,X11. GET PACKET ADDRESS. ER PFWL$. GET NEXT WRITE LOCATION. ON FTN. L,H2 A0,1,A3. GET WRITE LOCATION ADDRESS. S A1,0,A0. STORE WRITE LOCATION. L,H2 A0,2,A3. GET STATUS ADDRESS. S A2,0,A0. STORE STATUS. OFF. DO 1-FTN , S A1,*1,X11. STORE WRITE LOCATION. DO 1-FTN , S A2,*2,X11. STORE STATUS. J 4-4*FTN,X11. . . INSERT A NEW ELEMENT IN A PROGRAM FILE. . CALL PFIER (PACKET,NWL,STATUS) . $(1),PFIER*. ON FTN. L A3,A0. SAVE CALLING SEQUENCE ADDRESS. LN,H2 A0,0,A3. GET PACKET ADDRESS. L,H2 A1,1,A3. GET WRITE LOCATION ADDRESS. L A1,0,A1. GET WRITE LOCATION. OFF. ON 1-FTN. SZ A3. FOR INDIRECT ADDRESSING. LN,U A0,*0,X11. GET PACKET ADDRESS. L A1,*1,X11. GET WRITE LOCATION. OFF. ER PFI$. INSERT NEW ELEMENT. DO FTN , L,H2 A1,2,A3. GET STATUS ADDRESS. DO FTN , S A2,0,A1. STORE STATUS. DO 1-FTN , S A2,*2,X11. STORE STATUS. J 4-4*FTN,X11. . . RETRIEVE THE SYMBIONT INDICATOR FROM NTAB$. . I=NTABDC(UNIT) . $(1),NTABDC*. ON FTN. L,H2 A0,0,A0. GET ARGUMENT ADDRESS. L A0,0,A0. GET UNIT NUMBER. L,S2 A0,F2FRT$,A0. GET SYMBIONT INDICATOR. OFF. ON 1-FTN. SZ A3. FOR INDIRECT ADDRESSING. L A0,*0,X11. GET UNIT NUMBER. L,S2 A0,NTAB$,A0. GET SYMBIONT INDICATOR. OFF. J 2-2*FTN,X11. RETURN. /. PACK ONE CHARACTER PER WORD DATA INTO 9-TRACK FORMAT . ALWAYS USE "NCH" CHARACTERS (DEFINED BELOW). . . CALL EXCHPA (BUFIN,BUF9T) . BUFIN IS THE INPUT BUFFER (ONE CHARACTER PER WORD) . BUF9T IS THE 9-TRACK FORMAT OUTPUT BUFFER . NCH EQU 180. 180 CHARACTERS AT A TIME $(1),EXCHPA*. ON FTN. L A3,A0. SAVE CALLING SEQUENCE ADDRESS. L,H2 A0,0,A3. GET BUFIN ADDRESS. L,H2 A1,1,A3. GET BUF9T ADDRESS. OFF. ON 1-FTN. L,U A1,*1,X11. GET BUF9T ADDRESS. SZ A3. FOR INDIRECT ADDRESSING. L,U A0,*0,X11. GET BUFIN ADDRESS. OFF. LXI,U A0,1. INCREMENT 1 WORD EACH TIME LXI,U A1,2. INCREMENT 2 WORDS EACH TIME L,U R2,0377. 8 BIT MASK L,U R1,NCH/9-1. NUMBER OF 9-CHARACTER GROUPS . PUTNXT L,U R3,8. LOOP FOR 9 CHARACTERS NXTOUT LDSL A3,8. MAKE ROOM FOR NEXT CHARACTER MLU A4,,*A0. ADD IN NEXT CHARACTER S A5,A4. MOVE BACK INTO A4 JGD R3,NXTOUT. GO ADD NEXT CHARACTER DS A3,,*A1. STORE DOUBLE WORD JGD R1,PUTNXT. NCH/9 OUTER LOOP TRAVERSALS J 3-3*FTN,X11. RETURN /. PACK 12 CHARACTERS IN FIELDATA - FOR FILE, ELEMENT, VERSION NAMES. . . CALL EXCHPN (RJASCI,FD,NCHAR) . RJASCI=RIGHT JUSTIFIED ASCII, ONE CHARACTER PER WORD. . FD=PACKED FIELDATA EQUIVALENT PRODUCED HERE. . NCHAR=NUMBER OF RJASCI. . $(1),EXCHPN*. ON 1-FTN. SZ A3. FOR ADDR=IND. L,U A0,*0,X11. ADDR OF RJASCI. L,U A1,*1,X11. ADDR OF FD. L R1,*2,X11. NCHAR. OFF. ON FTN. L,H2 A1,2,A0. ADDR OF NCHAR. L R1,0,A1. NCHAR. L,H2 A1,1,A0. ADDR OF FD. L,H2 A0,0,A0. ADDR OF RJASCI. OFF. A A0,R1. COMPUTE END OF AN,U A0,1. RJASCI VECTOR. LXI,XU A0,-1. PROCESS RJASCI RIGHT TO LEFT. L A4,BLANKS. L A5,A4. J PNLT. PNLOOP L A2,0,*A0. GET RJASCI CHAR. L,S1 A3,AF,A2. GET FD EQUIVALENT. DSL A4,6. TRIPLE LSSL A4,6. SHIFT DSL A3,6. RIGHT. PNLT JGD R1,PNLOOP. DS A4,0,A1. STORE FD. J 4-4*FTN,X11. RETURN. /. UNIVAC-1100 EXEC SDF INPUT ROUTINE FOR THE EXCHANGE PROGRAM. . . STATUS=EXCH8I (WORK) . WORK IS THE 473 WORD WORK AREA REQUIRED BY EORSR. . STATUS IS AS FOR EORSRR EXCEPT NORMAL EOF = 0. . . DEFINITIONS. . BANKWL EQU 224. WORD LENGTH OF I/O BUFFERS. BANKSL EQU BANKWL//28. SECTOR LENGTH OF I/O BUFFERS. NX EQUF *0177777,*0,017. REMOVE X REG FROM EQUFS. . WORK AREA FCT EQUF 0,A0. SDFI WORK AREA. EQCODE EQUF FCT+6,,S1. EQUIPMENT CODE FROM FITEM$. KEY EQU FCT+11. OPEN FILE INDICATOR. SAVX1 EQU KEY+1. SAVE AREA FOR X1. SAVX11 EQU SAVX1+1. SAVE AREA FOR X11. BANK1 EQU SAVX11+1. FIRST I/O BUFFER. BANK2 EQU BANK1+BANKWL. SECOND I/O BUFFER ETABLE EQU BANK2+BANKWL. ELEMENT TABLE IF NEEDED ETFILE EQU ETABLE. ELEMENT FILE NAME. ETELT EQU ETABLE+2. ELEMENT NAME. ETVER EQU ETABLE+6. VERSION NAME. ETETYP EQUF ETABLE+5,,H1. ELEMENT TYPE. ETELOC EQU ETABLE+10. SECTOR LOCATION OF ELEMENT. . CALLING SEQUENCE PARAMETERS. DO FTN ,WORK EQUF 0,A0,H2. WORK AREA ADDRESS. DO 1-FTN ,WORK EQUF *0,X11,U. WORK AREA ADDRESS. . LOCAL USE OF WORK AREA. AFD EQUF KEY,,S2. ASCII/FD FLAG. FILTYP EQUF KEY,,S3. FILE TYPE /. SDDL DESCRIPTION OF PROCEDURE. . . PROCEDURE SDFASR TO READ SDF INTO ASCII, USING WORK, IMAGE, STATUS . THE WORK AREA CONTAINS THE FILE MODE (ELT/FILE/READ$) BY INTERPRETING . ELEMENT=0 MEANS FILE OR READ$, IF ELEMENT=0 THEN VERSION=0 MEANS FILE. . THE WORK AREA ALSO CONTAINS THE FILE CREATION TYPE (C,F,I,P,S,?) FROM A . TYPE 050 LABEL RECORD, IF ONE IS PRESENT. . LOOP . IF ELEMENT . CALL ELTR GIVING STATUS------------------------------------->( ) . ELSEIF FILE . CALL SDFR GIVING STATUS------------------------------------->( ) . ELSE . CALL READ$-------------------------------------------------->( ) . IF EOF . SET STATUS = 037 . <-----------EXITPROCEDURE . ELSE . SET ASCII / FD FLAG = ASCII . <--------EXITLOOP . ENDIF . ENDIF . IF STATUS NOT EQUAL 0 . <--------EXITPROCEDURE . ENDIF . IF RECORD TYPE = 050 . SET FILE CREATION TYPE AND ASCII / FD FLAG FROM ICW . <-----CYCLE . ENDIF . IF RECORD TYPE = 042 . SET ASCII / FD FLAG FROM ICW . <-----CYCLE . ENDIF . IF RECORD TYPE GREATER THAN 037 . <-----CYCLE . ENDIF . SELECT FILE CREATION TYPE . CASE C OR I . SET ASCII / FD FLAG FROM BIT 0 OF ICW . CASE P . SET FIRST BYTE OF IMAGE FROM IMAGE SPACING IN T2 OF ICW . SET ASCII / FD FLAG FROM BIT 0 OF ICW . CASE S . IF S4 OF ICW NOT EQUAL ZERO . <--------CYCLE . ENDIF . ENDSELECT . <--EXITLOOP . ENDLOOP . STORE IMAGE IN ASCII, USE ASCII / FD FLAG TO DETERMINE IMAGE TYPE. . <--EXITPROCEDURE . ENDPROCEDURE /. $(1),EXCH8I* S X11,SX11. DO 1-FTN , SZ A3. FOR INDIRECT ADDRESSING. L A0,WORK. GET WORK AREA ADDRESS. S A0,WORKSV. L A1,(1,0). S A1,BYTE1. BYTE LOCATION IN COMAND. LN,U A1,1. S A1,NCHCMD. EOF INDICATOR. L,U A1,040. ASCII ' '. S A1,COMAND. IN CASE OF ZERO LENGTH IMAGE. L A1,FCT. FILE NAME. JZ A1,READ$IN. NO FILE NAME, USE ER AREAD$. ELTLP. DO FTN , L,U A0,WORKSV. ADDRESS OF CALLING SEQUENCE. LMJ X11,EORSRR. DO FTN ,$(6). WORKSV + $-$. ADDRESS OF WORK AREA. + HOLCMD. INPUT IMAGE AREA. + ((180)). MAXIMUM IMAGE LENGTH. + ICW. IMAGE CONTROL WORD. + $-EXCH8I,0. WALBACK. DO FTN ,$(1). TNE,U A0,37. TEST FOR EOF. J EXITZ. NORMAL EOF. JNZ A0,EXITI. ABNORMAL EOF. L A0,WORKSV. RESTORE WORK AREA ADDRESS. TN ICW. CONTROL OR DATA? J GOTIMG. DATA. L,S1 A1,ICW. GET CONTROL RECORD TYPE. TE,U A1,050. LABEL RECORD? J ELTLP. NO. L,S3 A1,ICW. GET FILE TYPE. TNZ FILTYP. DON'T STORE FILTYP MORE THAN ONCE. S A1,FILTYP. STORE FILE TYPE IN WORK AREA. J ELTLP. GET ANOTHER RECORD. READ$IN L A0,(EXITZ,HOLCMD). ER AREAD$. READ IMAGE IN ASCII. TEP A0,(1*/31). J READ$IN. SKIP INFOR. LSSL A0,24. MOVE WORD COUNT. J GOTIMA. GO PROCESS ASCII IMAGE. GOTIMG L A1,FILTYP. GET FILE TYPE. TE,U A1,'C'. CARD FILE? TNE,U A1,'I'. INPUT SYMBIONT FILE? J CORIREC. ONE OR THE OTHER. TNE,U A1,'P'. PRINT FILE? J PREC. YES. TE,U A1,'X'. FTN? TNE,U A1,'F'. FORTRAN? J FREC. YES. TZ,S4 ICW. DELETED RECORD? J ELTLP. YES, GET ANOTHER RECORD. FREC L A2,AFD. GET ASCII/FD FLAG. J TIM. GO TEST IMAGE CODE. PREC L,S3 A1,ICW. LSSL A1,6. A,S4 A1,ICW. GET LINE SPACING FROM T2 OF ICW. L,U A5,060. ASCII '0'. TNE,U A1,0. L,U A5,053. ASCII '+'. TNE,U A1,1. L,U A5,040. ASCII ' '. TG,U A1,47. SKIP IF A1 .LE. 47 L,U A5,061. ASCII '1'. L A1,BYTE1. S A5,COMAND,*A1. STORE FORTRAN VERTICAL FORMAT CONTROL S A1,BYTE1. STORE INCREMENTED BYTE POINTER. CORIREC L A1,ICW. AND,U A1,1. ASCII/FD FLAG IS BIT ZERO. TIM L A0,ICW. JZ A2,GOTIMF. JUMP IF IMAGE FD. GOTIMA L A2,(1,0). L A1,BYTE1. GET BYTE POINTER. SSL A0,24. RJ WORD COUNT. JZ A0,ENDIMG. TG,U A0,45. L,U A0,44. MAXIMUM CAPACITY IS 44 WORDS. AN,U A0,1. LOOPA L,U R1,3. INNER LOOP COUNTER. L A4,HOLCMD,*A2. GET WORD OF 4 BYTES. SZ A3. LDSL A3,9. GET ONE BYTE. S A3,COMAND,*A1. JGD R1,$-3. JGD A0,LOOPA. ENDIMG L,U A2,040. ASCII ' '. S A2,COMAND,A1. GET READY TO STRIP OFF TRAILING BLANKS. LXI,XU A1,-1. SCAN BACKWARD. TNE A2,COMAND,A1. STRIP OFF TRAILING BLANKS. JMGI A1,$-1. LOOP FOR A WHILE. L,U A2,1,A1. INCREMENT POINTER TO MAKE COUNT. JNZ A2,$+3. L,U A2,1. AT LEAST ONE BYTE. LXM,U A1,0. S A2,NCHCMD. SAVE NUMBER OF CHARACTERS. ASCHOL L A2,COMAND,A1. GET ASCII CHARACTER. L A2,XLATE,A2. TRANSLATE TO HOLLERITH. S A2,HOLCMD,A1. STORE. JMGI A1,ASCHOL. LOOP FOR A WHILE. EXITZ SZ A0. INDICATE NORMAL EXIT. EXITI L X11,SX11. J 2-2*FTN,X11. RETURN. GOTIMF L A2,(1,0). L A1,BYTE1. SSL A0,24. POSITION WORD COUNT. JZ A0,ENDIMG. TG,U A0,30. L,U A0,29. MAXIMUM CAPACITY IS 29 WORDS. AN,U A0,1. LOOPF L,U R1,5. INNER LOOP COUNTER. L A4,HOLCMD,*A2. GET ONE WORD OF 6 BYTES. SZ A3. LDSL A3,6. GET ONE BYTE. L A3,FA,A3. CONVERT TO ASCII S A3,COMAND,*A1. JGD R1,$-4. JGD A0,LOOPF. J ENDIMG. /. UNIVAC-1100 EXEC SDF OUTPUT ROUTINE FOR THE EXCHANGE PROGRAM. . . STATUS=EXCH8O (OUTPUT) . OUTPUT IS THE OUTPUT VECTOR, RJZF ASCII. . STATUS IS AS FOR EORSWW. . . DEFINITIONS. . . CALLING SEQUENCE PARAMETERS. DO FTN ,OUTPUT EQUF 0,A0,H2. OUTPUT BUFFER ADDRESS. DO 1-FTN ,OUTPUT EQUF *0,X11,U. OUTPUT BUFFER ADDRESS. . $(1),EXCH8O* S X11,SX11. SAVE X11. DO 1-FTN , SZ A3. FOR ADDR=IND. L A1,OUTPUT. GET ADDR OF OUTPUT VECTOR. LXI,U A1,1. PUT IN INCREMENTOR. L R1,NCHOUT. NUMBER OF CHARACTERS OF OUTPUT. L A2,AFDFLG. ASCII=1, FD=0. L A0,(1,0). POINTER INTO OUTPUT BUFFER. JZ A2,PACKF. J PACKA. . ASCII PACKING LOOP. PACKAL L A5,0,*A1. GET CHAR OF ASCII. LSSL A5,27. LJ. LDSL A4,9. ADD TO ACCUMULATING STRING. JGD R2,$+3. WORD FULL? S A4,BUFOUT,*A0. PUT WORD IN OUTPUT BUFFER. PACKA L R2,LOOPCT+1. GET LOOP COUNTER. JGD R1,PACKAL. J FINL. . FIELDATA PACKING LOOP. PACKFL L A3,0,*A1. GET CHAR OF FD. L A5,AF,A3. TRANSLATE TO FD. LDSL A4,6. ADD TO ACCUMULATING STRING. JGD R2,$+3. WORD FULL? S A4,BUFOUT,*A0. PUT WORKD IN OUTPUT BUFFER. PACKF L R2,LOOPCT. GET LOOP COUNTER. JGD R1,PACKFL. . FINISH UP PACKING, ADD TRAILING BLANKS TO LAST WORD. FINL L A3,R2. TNE A3,LOOPCT,A2. HOW MUCH OF LOOP IS LEFT? J FIN. NONE. A,U A3,1. MSI A3,SHIFT,A2. COMPUTE SHIFT. L A5,BLANKS,A2. LDSL A4,0,A3. SHIFT IN TRAILING BLANKS. S A4,BUFOUT,*A0. STORE WORD WITH TRAILING BLANKS. FIN TZ WORKOUT. PUNCH? J FILE. NO. LSSL A0,18. CONSTRUCT PUNCH$ OR APUNCH$ PKT. LXM,U A0,BUFOUT. JNZ A2,ASCPCH. ER PUNCH$. FD PUNCH. SZ A0. CLEAR STATUS. J EXITO. ASCPCH ER APUNCH$. ASCII PUNCH. SZ A0. CLEAR STATUS. J EXITO. . FILE OUTPUT. FILE LSSL A0,24. S A0,ICW. STORE ICW. DO FTN , L,U A0,CALSEQ. CALLING SEQUENCE LMJ X11,EORSWW. WRITE SDF RECORD. DO FTN ,$(6),CALSEQ. + WORKOUT. WORK AREA ADDRESS. + BUFOUT. OUTPUT BUFFER. + ICW. IMAGE CONTROL WORD. + $-EXCH8O,0. WKBK. DO FTN ,$(1). EXITO L X11,SX11. RECOVER X11. J 2-2*FTN,X11. RETURN. /. COMMON DEFINITIONS. . INFO 2 'EXCHOC',3. $(3). BLKSQO RES 1. OUTPUT BLOCK SEQUENCE. CBLCKO RES 180. OUTPUT CHARACTER OUTPUT BLOCK. CCDBO RES 1. CURRENT OUTPUT CHARACTER POSITION. CPCBO RES 1. CURRENT POSITION IN CBLCKO. CWDBO RES 1. CURRENT OUTPUT WORD POSITION. ITYPEO RES 1. OUTPUT RECORD TYPE. LASTO RES 1. FLAG FOR LAST BLOCK OF TAPE. LLPRGO RES 1. LOCATION OF LAST PROGRAM. L1PRGO RES 1. LOCATION OF FIRST PROGRAM IN BLOCK. L1RECO RES 1. LOCATION OF FIRST RECORD IN BLOCK. MODEO RES 1. MODE OF OUTPUT RECORD. NCCBO RES 1. NUMBER OF CHARACTERS TO PACK. NCHOUT RES 1. NUMBER OF CHARACTERS IN OUTPUT RECORD. NDATAO RES 1. NUMBER OF DATA CHARACTERS PER BLOCK. NERRCO RES 1. ERROR DETECTION CHARACTERS PER BLOCK. NLRECO RES 1. PROGRAM NUMBER OF LAST RECORD OUTPUT. NWCBO RES 1 WORDS NEEDED FOR NCCBO CHARACTERS. N1RECO RES 1. PROGRAM NUMBER OF FIRST RECORD IN BLOCK. OUTREC RES 180. SPACE FOR OUTPUT RECORD. OUTUPD RES 1. ASCII U (85) IF UPDATE OK. REMVO RES 1. CHARACTER REMOVED FOR COMPRESSION. . INFO 2 'EXCHPC',2. $(2). ACTION RES 1. EXCHIM/EXCHOU ACTION FLAG. CHAR1L RES 1. CHARACTER AFTER LINE NUMBER ON LIST. COMAND RES 180. ASCII INPUT BUFFER. COMD RES 4*40. COMMAND TABLE. EQUAL RES 1. LOCATION OF EQUAL SIGN IN COMMAND. HOLCMD RES 180. HOLLERITH INPUT BUFFER. ICOMD RES 1. COMMAND INDEX. IDCUR RES 1. CURRENT SEQUENCE NUMBER. IDOPTN RES 1. SEQUENCE NUMBERING OPTION. IDNBRS RES 4. C1,C2,STEP,START FOR SEQUENCE NUMBERS. IDTEXT RES 40. TEXT TO EMIT WITH SEQUENCE NUMBERS. IDTXTL RES 1. LENGTH OF TEXT TO EMIT. INDEX RES 1. SUM OF INDEXS - INDEXING FLAG. INDEXS RES 26. INDIVIDUAL INDEX FLAGS. INTOPN RES 1. INTAPE OPEN FLAG. LIMIT RES 1. LIMIT OF PRED CONTROLLED SEARCH. LINEO RES 1. OUTPUT LINE NUMBER (FOR LISTING). MARGIN RES 1. RIGHT MARGIN OF COMMANDS. MODIFY RES 1. MODIFIER FIELD OF COMMAND. NCHCMD RES 1. NUMBER OF CHARACTERS OF INPUT. NCOMDP RES 1. SIZE OF PORTABLE COMMAND TABLE. NCOMDT RES 1. SIZE OF TOTAL COMMAND TABLE. NERRG RES 1. GLOBAL ERROR FLAG. NERRS RES 1. LOCAL ERROR FLAG. NRWORK RES 1. NUMBER OF CONTROL RECORDS ON WORKF. NUMBER RES 1. FIRST NUMBER FROM COMMAND PARAMETER FIELD. OPTVAL RES 26. ALPHABETIC OPTION SELECTIONS. OUTOPN RES 1. OUTAPE OPEN FLAG. PHASE RES 1. PROGRAM OPERATION PHASE. PRED RES 42*8. STORED PREDICATES. SIGNAL RES 1. END OF TEXT SIGNAL. INITIALLY -. SITE RES 40. SITE. TITLE RES 40. TITLE. TODAY RES 6. DATE. TRANS RES 1. CONTROLS TRANSITION BETWEEN SEGMENTS. VERT RES 1. VERTICAL SPACING CONTROL FLAG. . INFO 2 'EXCHXC',4. $(4),XLATE RES 128. TRANSLATE TABLE ASCII -> HOLLERITH. DO 1-FTN ,AF EQU XLATE. TRANSLATE TABLE ASCII -> FD. . INFO 2 'EXEC8',5. $(5). AFDFLG RES 1. FD=0, ASCII=1 OUTPUT CODE. WORKIN RES 474*4. INPUT WORK AREAS. WORKOUT RES 474. OUTPUT WORK AREA. . . SCRATCH AREAS. . $(0). BYTE1 RES 1. ICW RES 1. SX11 RES 1. BUFOUT RES 45. OUTPUT BUFFER. BLANKS ' '. FD BLANKS. + 040,040,040,040. ASCII BLANKS. SHIFT + 6. FD SHIFT. + 9. ASCII SHIFT. LOOPCT + 5. FD LOOP COUNTER. + 3. ASCII LOOP COUNTER. . . TRANSLATE TABLE FROM FIELDATA TO ASCII. . ASCII FA. + '@'. + '['. + ']'. + '#'. + '^'. + ' '. + 'A'. + 'B'. + 'C'. + 'D'. + 'E'. + 'F'. + 'G'. + 'H'. + 'I'. + 'J'. + 'K'. + 'L'. + 'M'. + 'N'. + 'O'. + 'P'. + 'Q'. + 'R'. + 'S'. + 'T'. + 'U'. + 'V'. + 'W'. + 'X'. + 'Y'. + 'Z'. + ')'. + '-'. + '+'. + '<'. + '='. + '>'. + '&'. + '$'. + '*'. + '('. + '%'. + ':'. + '?'. + '!'. + ','. + '\'. + '0'. + '1'. + '2'. + '3'. + '4'. + '5'. + '6'. + '7'. + '8'. + '9'. + ''''. + ';'. + '/'. + '.'. + '"'. + '_'. . . ASCII -> FD TRANSLATION. . ON FTN. FIELDATA. AF. DO 32 , '$'. ' '. '!'. '"'. '#'. '$'. '%'. '&'. ''''. '('. ')'. '*'. '+'. ','. '-'. '.'. '/'. I DO 10 , + ('0'+I-1)*/30 ':'. ';'. '<'. '='. '>'. '?'. '@'. I DO 26 , + ('A'+I-1)*/30 '['. '\'. ']'. '^'. '_'. '@'. I DO 26 , + ('A'+I-1)*/30 '['. '\'. ']'. '^'. '_'. OFF. END. @HDG,P EORSR/1100 @MASM,SI EORSR/1100,,,FTN /. . READ ELEMENTS OR SDF FILES. . . S = EORSRO (WORK,ELT,VER) OPENS AN ELEMENT OR SDF FILE. . THE FIRST TWO WORDS OF WORK MUST BE THE FILENAME. . ELT DETERMINES WHETHER A FILE OR ELEMENT IS TO BE READ. . IF ELT = 0, ELT IS A SCALAR AND A FILE IS TO BE READ, IN . WHICH CASE WORK MUST BE AT LEAST 462 WORDS AND . VER IS IGNORED. . IF ELT NOT ZERO, IT IS THE FIRST WORD OF A TWO WORD VECTOR . CONTAINING THE ELEMENT NAME, VER IS THE TWO WORD VERSION . AND WORK MUST CONTAIN AT LEAST 474 WORDS. . S IS THE STATUS (DECIMAL): . 00 = NORMAL COMPLETION, . 1 - 32 = I/O ERROR, . 33 = ELEMENT NOT FOUND, . 34 = EXEC I/O ERROR, . 35 = THE FILE CANNOT BE ASSIGNED, OR THE FILE CAN BE . ASSIGNED BUT ELT NOT = ZERO AND THE FILE IS NOT A . PROGRAM FILE. IF THE FILE CANNOT BE ASSIGNED THE . CSF$ STATUS IS RETURNED IN WORK(3). IF THE FILE CAN . BE ASSIGNED, WORK(3) IS NON-NEGATIVE. . . S = EORSRR (WORK,IMAGE,MAXLEN,ICW) READS SDF FILE OR ELEMENT. . WORK IS AS FOR EORSRO (MUST NOT BE CHANGED BY USER), . IMAGE IS THE PLACE THE USER DESIRES THE IMAGE TO BE PLACED, . MAXLEN IS THE MAXIMUM NUMBER OF WORDS OF IMAGE TO BE . DELIVERED TO THE USER. THE ACTUAL NUMBER OF WORDS . DELIVERED IS PART OF THE ICW. IMAGE IS NOT SPACE FILLED, . BUT MAY BE TRUNCATED IF MAXLEN IS LESS THAN THE ACTUAL . RECORD SIZE. . ICW IS THE SDF IMAGE CONTROL WORD (SEE PRM VOLUME 3). . S IS AS FOR EORSRO, PLUS TWO MORE POSSIBLE VALUES: . 36 = FILE OR ELEMENT NOT OPENED, . 37 = END OF FILE ENCOUNTERED. . . CALL EORSRC (WORK) STOPS ANYNCHRONOUS I/O AND . RELEASES THE ASSOCIATION OF WORK AND THE FILE OR ELEMENT. . /. DEFINITIONS. AXR$. REGISTERS, ETC. FTN EQU $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE. BANKWL EQU 224. WORD LENGTH OF I/O BUFFERS. BANKSL EQU BANKWL//28. SECTOR LENGTH OF I/O BUFFERS. NX EQUF *0177777,*0,017. REMOVE X REG FROM EQUFS. . WORK AREA FCT EQUF 0,X1. SDFI WORK AREA. EQCODE EQUF FCT+6,,S1. EQUIPMENT CODE FROM FACIL$. KEY EQU FCT+11. OPEN FILE INDICATOR. FILELT EQUF KEY,,S1. 0=FILE, 1=ELT. ASCFD EQUF KEY,,S2. ASCII/FD CODE SAVX1 EQU KEY+1. SAVE AREA FOR X1. SAVX11 EQU SAVX1+1. SAVE AREA FOR X11. DO FTN ,SAVA3 EQUF SAVX1+1,,H1. SAVE AREA FOR A3. BANK1 EQU SAVX11+1. FIRST I/O BUFFER. BANK2 EQU BANK1+BANKWL. SECOND I/O BUFFER ETABLE EQU BANK2+BANKWL. ELEMENT TABLE IF NEEDED ETFILE EQU ETABLE. ELEMENT FILE NAME. ETELT EQU ETABLE+2. ELEMENT NAME. ETVER EQU ETABLE+6. VERSION NAME. ETETYP EQUF ETABLE+5,,H1. ELEMENT TYPE. ETELOC EQU ETABLE+10. SECTOR LOCATION OF ELEMENT. . CALLING SEQUENCE PARAMETERS. ON 1-FTN. ASSEMBLE IF FTN=0. WORK EQUF *0,X11,U. FCT ADDRESS. ELT EQUF *1,X11. FIRST WORD OF ELEMENT. VER EQUF *2,X11. VERSION NAME. IMAGE EQUF *1,X11,U. ADDRESS OF IMAGE. MAXLEN EQUF *2,X11. MAXIMUM WORDS OF IMAGE. ICW EQUF *3,X11. IMAGE CONTROL WORD. OFF. ON FTN. ASSEMBLE IF FTN=1. WORK EQUF 0,A3,H2. FCT ADDRESS. ELT EQUF 1,A3,H2. FIRST WORD OF ELEMENT. VER EQUF 2,A3,H2. FIRST WORD OF VERSION. IMAGE EQUF 1,A3,H2. ADDRESS OF IMAGE. MAXLEN EQUF 2,A3,H2. ICW EQUF 3,A3,H2. OFF. . RETURNS RETO EQUF 4*(1-FTN),X11. RETURN FROM EORSRO. RETR EQUF 5*(1-FTN),X11. RETURN FROM EORSRR. RETC EQUF 2*(1-FTN),X11. RETURN FROM EORSRC. . /. S = EORSRO (WORK,ELT,VER) . $(1),EORSRO*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET CALLING SEQUENCE ADDRESS. L A0,WORK. ADDR OF FCT. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. SETUP FCT POINTER. S X11,SAVX11. SAVE X11. ER FACIL$. IS FILE OPEN? L A1,EQCODE. JNZ A1,GOTFILE. JUMP IF DEVICE CODE. DL A0,('@ASG,A '). DS A0,BANK1. DL A0,FCT. GET FILE NAME. DS A0,BANK1+2. L,U A0,BANK1. USE I/O BUFFER FOR CSF$ IMAGE. LXI,U A0,4. LENGTH OF CSF$ IMAGE. ER CSF$. TRY TO ASSIGN FILE. JN A0,NOFILE. ERROR EXIT. GOTFILE SZ R2. INDICATE ASSIGNABLE FILE. L,U A0,R$. SETUP I/O PACKET FOR SDFI. S,S2 A0,FCT+3. FUNCTION CODE = R$. SZ,S1 FCT+3. STATUS (T2 WOULD BE PSR SENSITIVE). L,U A0,BANKWL. I/O BUFFER WORD LENGTH. S,H1 A0,FCT+4. L,U A0,BANK2. LXI,U A0,BANK1. S A0,FCT+6. I/O BUFFER ADDRESSES. L,U A0,BANKSL. I/O BUFFER SECTOR LENGTH. S,H1 A0,FCT+7. L,U A0,1. S,H1 A0,FCT+8. INCREMENTOR FOR BT. S,H1 A0,FCT+9. INCREMENTOR FOR BT. SZ KEY. CLEAR OPEN, TYPE. DO 1-FTN , DL A0,ELT. GET ELEMENT NAME. DO FTN , L A0,ELT. GET ADDRESS OF ELEMENT NAME. DO FTN , DL A0,0,A0. GET ELEMENT NAME. JZ A0,NOELT. JUMP IF SDF FILE DESIRED. . SETUP PFS$ PACKET. DS A0,ETELT. STORE ELEMENT NAME. DO 1-FTN , DL A0,VER. GET VERSION. DO FTN , L A0,VER. GET ADDRESS OF VERSION. DO FTN , DL A0,0,A0. GET VERSION. DS A0,ETVER. STORE ELEMENT VERSION. DL A0,FCT. DS A0,ETFILE. STORE FILE NAME. L,U A0,1. SYMBOLIC ELEMENTS. S A0,ETETYP. STORE ELEMENT TYPE. S A0,FILELT. INDICATE ELT. L,U A0,ETABLE. ADDRESS OF PFS$ PACKET. ER PFS$. DO PROGRAM FILE SEARCH. JNZ A2,PFS$ERR. JUMP IF ERROR. L A0,ETELOC. GET ELEMENT LOCATION. NOELT S A0,FCT+5. SECTOR ADDRESS (ZERO IF FILE). L,U A0,FCT. GET FCT ADDRESS INTO A0. LMJ X11,SDFIO$. OPEN FILE. J SDFIO$ERR. ERROR RETURN. SZ A5. NORMAL RETURN. L,U A0,'OPN'. S A0,KEY. INDICATE WORK OPEN. SDFIO$ERR L A0,A5. GET STATUS. EXITO L X11,SAVX11. RECOVER X11. L X1,SAVX1. RECOVER X1. J RETO. RETURN. NOFILE L,U A2,3. S A0,R2. STORE CSF$ STATUS. PFS$ERR L,U A0,32,A2. SHIFT PFS$ ERROR CODES. S R2,FCT+2. WORK(3) = ASSIGN STATUS OR ZERO. J EXITO. /. S = EORSRR (WORK,IMAGE,MAXLEN,ICW) . $(1),EORSRR*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET ADDRESS OF CALLING SEQUENCE. L A0,WORK. GET FCT ADDRESS. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. PUT FCT ADDRESS IN X1. S X11,SAVX11. SAVE X11. DO FTN , S A3,SAVA3. MUST SAVE A3 TO STORE ICW AFTER SAVING X11 L,H2 A1,KEY. IS FILE OPEN? TE,U A1,'OPN'. J EORSR$NOT. JUMP IF NOT OPEN. L A1,IMAGE. S,H2 A1,FCT+8. STORE IMAGE ADDRESS. DO 1-FTN , L A1,MAXLEN. GET MAXIMUM IMAGE LENGTH. DO FTN , L A1,MAXLEN. GET ADDRESS OF MAXIMUM IMAGE LENGTH. DO FTN , L A1,0,A1. GET MAXIMUM IMAGE LENGTH. S,H2 A1,FCT+7. STORE MAXIMUM IMAGE LENGTH. LMJ X11,SDFI$. READ (NOTE A0 = FCT ADDRESS). J SDFI$ERR. ERROR. J SDFI$EOF. EOF. L A1,FCT+10. GET ICW. SZ A0. NORMAL RETURN IF STATUS = 0. J EXITR. EORSR$NOT L,U A0,36. NOT OPEN. J EXITR. SDFI$EOF L,U A5,37. STATUS CODE FOR EOF. SDFI$ERR L A0,A5. GET STATUS FROM SDFI. EXITR L X11,SAVX11. RECOVER X11. DO 1-FTN , SZ A3. FOR ADDR=IND. DO 1-FTN , S A1,ICW. STORE ICW. DO FTN , L A3,SAVA3. RECOVER CALLING SEQUENCE ADDRESS. DO FTN , L A2,ICW. GET ICW ADDRESS. DO FTN , S A1,0,A2. STORE ICW. DSL A1,30. SSL A2,6. TE,U A1,042. ASCII/FD SWITCH? TNE,U A1,050. LABEL? S A2,ASCFD. YES, REMEMBER ASCII/FD CODE. L X1,SAVX1. RECOVER X1. J RETR. RETURN. /. CALL EORSRC (WORK) . $(1),EORSRC*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET ADDRESS OF CALLING SEQUENCE. L A0,WORK. GET FCT ADDRESS. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. PUT FCT ADDRESS IN X1. L,H2 A1,KEY. TE,U A1,'OPN'. IS FILE OPEN? J EXITC. NO, SIMPLY EXIT. SZ KEY. S X11,SAVX11. SAVE X11. LMJ X11,SDFIC$. CLOSE SDF I/O. L X11,SAVX11. RECOVER X11. EXITC L X1,SAVX1. RECOVER X1. J RETC. RETURN. END. @HDG,P EORSW/1100 @MASM,SI EORSW/1100,,,FTN /. . WRITE ELEMENTS OR SDF FILES. . . S = EORSWO (WORK,ELT,VER) OPENS AN ELEMENT OR SDF FILE. . THE FIRST TWO WORDS OF WORK MUST BE THE FILENAME. . ELT DETERMINES WHETHER A FILE OR ELEMENT IS TO BE WRITTEN. . IF THE SECOND WORD OF ELT = ZERO, THE FIRST WORD IS THE STARTING . SECTOR ADDRESS OF THE FILE TO BE WRITTEN, WORK MUST BE 466 . WORDS, AND VER IS IGNORED. IF THE SECOND WORD OF ELT IS NOT ZERO, . AN ELEMENT IS TO BE WRITTEN, THE ELEMENT NAME IS CONTAINED IN THE . TWO WORDS OF ELT, AND WORK MUST BE 474 WORDS. . S IS THE STATUS (DECIMAL): . 00 = NORMAL COMPLETION, . 1 - 32 = I/O ERROR, . 33 = ELEMENT NOT FOUND, . 34 = EXEC I/O ERROR, . 35 = FILE NOT ASSIGNABLE, IN WHICH CASE WORK(3) CONTAINS . THE @ASG STATUS, OR ELT NOT = ZERO AND THE FILE IS . NOT A PROGRAM FILE, IN WHICH CASE WORK(3) = 0. . 37 = PROGRAM FILE OVERFLOW. . IF THE FILE IS NOT ASSIGNED, IT WILL BE ASSIGNED WITH NO OPTIONS. . . S = EORSWW (WORK,IMAGE,ICW) WRITES SDF FILE OR ELEMENT. . WORK IS AS FOR EORSWO (MUST NOT BE CHANGED BY USER), . IMAGE IS THE LOCATION OF THE IMAGE TO BE WRITTEN, . ICW IS THE SDF IMAGE CONTROL WORD (SEE PRM VOLUME 3). . S IS AS FOR EORSWO, PLUS ONE MORE POSSIBLE VALUE: . 36 = FILE OR ELEMENT NOT OPENED, . . S = EORSWC (WORK,CYCLIM,HICYCLE,NCYCLE) STOPS ANYNCHRONOUS I/O AND . RELEASES THE ASSOCIATION OF WORK AND THE FILE OR ELEMENT. . CYCLIM IS THE MAXIMUM NUMBER OF CYCLES TO BE RETAINED FOR THE . ELEMENT OR FILE. IT SHOULD BE AT LEAST 1 PLUS THE DIFFERENCE . BETWEEN THE LARGEST AND SMALLEST VALUES SUPPLIED IN S4 AND S6 . OF ANY ICW. IF ZERO HAS BEEN USED FOR THOSE FIELDS, A DEFAULT . OF 5 IS RECOMMENDED FOR CYCLIM. . HICYCL IS THE MAXIMUM VALUE SUPPLIED IN S4 OR S6 OF ANY ICW. IF . EVERY ICW CONTAINED ZERO IN THESE FIELDS, A DEFAULT VALUE OF . ZERO IS RECOMMENDED. . NCYCLE IS THE NUMBER OF CYCLES THE USER CLAIMS ARE CONTAINED IN . THE ELEMENT OR FILE WRITTEN. THIS IS THE MINIMUM VALUE THE . USER COULD HAVE SPECIFIED FOR CYCLIM. IF S4 AND S6 OF EVERY . ICW WRITTEN CONTAINED ZERO, A DEFAULT VALUE OF 1 IS RECOMMENDED. . S IS AS FOR EORSWW. . . IF YOU WANT TO CHANGE THE ELEMENT TYPE, IT IS IN S3 OF WORK(468). . IF YOU WANT TO CHANGE THE ELEMENT SUBTYPE, IT IS IN S1 OF WORK(472). . IF YOU WANT TO CHANGE THE DATE OF CREATION, IT IS IN WORK(474), . THE FORMAT IS AS FROM TDATE$ SHIFTED CIRCURLARLY 18 BITS. . THE DEFAULT ELEMENT TYPE IS SYMBOLIC, THE DEFAULT ELEMENT SUBTYPE . IS UNTYPED, THE DEFAULT DATE AND TIME IS THE CURRENT DATE AND TIME. . CHANGES MUST BE MADE BETWEEN CALLING EORSWO AND EORSWC. /. DEFINITIONS. AXR$. REGISTERS, ETC. FTN EQU $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE. BANKWL EQU 224. WORD LENGTH OF I/O BUFFERS. BANKSL EQU BANKWL//28. SECTOR LENGTH OF I/O BUFFERS. NX EQUF *0177777,*0,017. REMOVE X REG FROM EQUFS. . WORK AREA FCT EQUF 0,X1. SDFO WORK AREA. EQCODE EQUF FCT+6,,S1. EQUIPMENT CODE FROM FACIL$. KEY EQU FCT+11. OPEN FILE INDICATOR. FILELT EQUF KEY,,S1. 0=FILE, 1=ELT. ASCFD EQUF KEY,,S2. ASCII/FD CODE SAVX1 EQU KEY+1. SAVE AREA FOR X1. SAVX11 EQU SAVX1+1. SAVE AREA FOR X11. DO FTN ,SAVA3 EQUF SAVX1+1,,H1. SAVE AREA FOR A3. BANK1 EQU SAVX11+1. FIRST I/O BUFFER. BANK2 EQU BANK1+BANKWL. SECOND I/O BUFFER ETABLE EQU BANK2+BANKWL. ELEMENT TABLE IF NEEDED ETFILE EQU ETABLE. ELEMENT FILE NAME. ETELT EQU ETABLE+2. ELEMENT NAME. ETVER EQU ETABLE+6. VERSION NAME. ETETYP EQUF ETABLE+5,,H1. ELEMENT TYPE. ETCYCL EQU ETABLE+8. ETELEN EQUF ETABLE+9,,H2. ELEMENT LENGTH. ETELOC EQU ETABLE+10. SECTOR LOCATION OF ELEMENT. ETEDAT EQU ETABLE+11. TIME AND DATE. . CALLING SEQUENCE PARAMETERS. ON 1-FTN. ASSEMBLE IF FTN=0. WORK EQUF *0,X11,U. FCT ADDRESS. ELT EQUF *1,X11. FIRST WORD OF ELEMENT. VER EQUF *2,X11. VERSION NAME. IMAGE EQUF *1,X11,U. ADDRESS OF IMAGE. ICW EQUF *2,X11. IMAGE CONTROL WORD. CYCLIM EQUF *1,X11. CYCLE LIMIT. HICYCL EQUF *2,X11. HIGHEST CYCLE NUMBER. NCYCLE EQUF *3,X11. NUMBER OF CYCLES. OFF. ON FTN. ASSEMBLE IF FTN=1. WORK EQUF 0,A3,H2. FCT ADDRESS. ELT EQUF 1,A3,H2. FIRST WORD OF ELEMENT NAME. VER EQUF 2,A3,H2. FIRST WORD OF VERSION IMAGE EQUF 1,A3,H2. ADDRESS OF IMAGE. ICW EQUF 2,A3,H2. IMAGE CONTROL WORD. CYCLIM EQUF 1,A3,H2. CYCLE LIMIT. HICYCL EQUF 2,A3,H2. HIGHEST CYCLE NUMBER. NCYCLE EQUF 3,A3,H2. NUMBER OF CYCLES. OFF. . RETURNS RETO EQUF 4*(1-FTN),X11. RETURN FROM EORSWO. RETW EQUF 4*(1-FTN),X11. RETURN FROM EORSWW. RETC EQUF 5*(1-FTN),X11. RETURN FROM EORSWC. . /. S = EORSWO (WORK,ELT,VER) . $(1),EORSWO*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET CALLING SEQUENCE ADDRESS. L A0,WORK. ADDR OF FCT. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. SETUP FCT POINTER. S X11,SAVX11. SAVE X11. ER FACIL$. IS FILE OPEN? L A1,EQCODE. JNZ A1,FILASGD. JUMP IF FILE ASG'D. L A0,('@ASG '). S A0,ETFILE-1. DL A0,FCT. DS A0,ETFILE. BUILD '@ASG FILE' L,U A0,ETFILE-1. LXI,U A0,3. ER CSF$. ASSIGN FILE, IGNORE STATUS. JN A0,NOFILE. ERROR EXIT. FILASGD SZ R2. SIMULATE GOOD CSF$ STATUS. L,U A0,W$. SETUP I/O PACKET FOR SDFO. S,S2 A0,FCT+3. FUNCTION CODE = R$. SZ,S1 FCT+3. STATUS (T2 WOULD BE PSR SENSITIVE). L,U A0,BANKWL. I/O BUFFER WORD LENGTH. S,H1 A0,FCT+4. L,U A0,BANK2. LXI,U A0,BANK1. S A0,FCT+6. I/O BUFFER ADDRESSES. L,U A0,BANKSL. I/O BUFFER SECTOR LENGTH. S,H1 A0,FCT+7. L,U A0,1. S,H1 A0,FCT+8. INCREMENTORS FOR BT IN SDFO. S,H1 A0,FCT+9. SZ KEY. CLEAR OPEN, TYPE. DO 1-FTN , DL A1,ELT. GET ELEMENT NAME. DO FTN , L A1,ELT. GET ADDRESS OF ELEMENT NAME. DO FTN , DL A1,0,A1. GET ELEMENT NAME. . SETUP PFWL$ PACKET. DS A1,ETELT. STORE ELEMENT NAME. JZ A2,NOELT. JUMP IF SDF FILE DESIRED. DO 1-FTN , DL A0,VER. GET VERSION. DO FTN , L A0,VER. GET ADDRESS OF VERSION. DO FTN , DL A0,0,A0. GET VERSION. DS A0,ETVER. STORE ELEMENT VERSION. DL A0,FCT. DS A0,ETFILE. STORE FILE NAME. L,U A0,ETABLE. ADDRESS OF PFWL$ PACKET. ER PFWL$. GET WRITE LOCATION. JNZ A2,PFWL$ERR. JUMP IF ERROR. L,U A0,1. S A0,ETETYP. STORE ELEMENT TYPE=SYMBOLIC. S A0,FILELT. INDICATE ELT. SZ ETEDAT. USE CURRENT DATE AND TIME. SZ ETELEN. LENGTH IS ZERO NOW. S A1,ETELOC. STORE WRITE LOCATION IN ELT PKT. NOELT S A1,FCT+5. SECTOR ADDRESS (ZERO IF FILE). L,U A0,FCT. GET FCT ADDRESS INTO A0. LMJ X11,SDFOO$. OPEN FILE. L,U A0,'OPN'. S A0,KEY. INDICATE WORK OPEN. SZ A0. INDICATE NORMAL STATUS. EXITO L X11,SAVX11. RECOVER X11. L X1,SAVX1. RECOVER X1. J RETO. RETURN. NOFILE L,U A2,3. GENERATE ERROR 35. S A0,R2. SAVE CSF$ STATUS. PFWL$ERR L,U A0,32,A2. SHIFT PFWL$ ERROR CODES. S R2,FCT+2. STORE @ASG STATUS IN WORK(3). J EXITO. /. S = EORSWW (WORK,IMAGE,ICW) . $(1),EORSWW*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET CALLING SEQUENCE ADDRESS. L A0,WORK. GET FCT ADDRESS. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. PUT FCT ADDRESS IN X1. S X11,SAVX11. SAVE X11. L,H2 A1,KEY. IS FILE OPEN? TE,U A1,'OPN'. J EORSW$NOT. JUMP IF NOT OPEN. L A1,IMAGE. S,H2 A1,FCT+8. STORE IMAGE ADDRESS. L A1,ICW. DO FTN , L A1,0,A1. S A1,FCT+10. STORE ICW. DSL A1,30. SSL A2,6. TE,U A1,042. ASCII/FD SWITCH? TNE,U A1,050. LABEL? S A2,ASCFD. YES, REMEMBER ASCII/FD CODE. LMJ X11,SDFO$. WRITE (NOTE A0 = FCT ADDRESS). J SDFO$ERR. ERROR. SZ A0. CLEAR ERROR STATUS. J EXITW. EORSW$NOT L,U A5,36. NOT OPEN. SDFO$ERR L A0,A5. GET STATUS FROM SDFO. EXITW L X11,SAVX11. RECOVER X11. L X1,SAVX1. RECOVER X1. J RETW. RETURN. /. S = EORSWC (WORK,CYCLIM,HICYCL,NCYCLE) . $(1),EORSWC*. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,A0. GET CALLING SEQUENCE ADDRESS. L A0,WORK. GET FCT ADDRESS. S X1,SAVX1**NX,A0. SAVE X1. S A0,X1. PUT FCT ADDRESS IN X1. S X11,SAVX11. SAVE X11. DO FTN , S A3,SAVA3. MUST SAVE A3 AFTER SAVING X11. L,H2 A1,KEY. SZ KEY. MARK WORK AREA CLOSED. TE,U A1,'OPN'. IS FILE OPEN? J EORSWC$NOT. NO, RETURN ERROR STATUS. LMJ X11,SDFOC$. CLOSE FILE / ELT J SDFOC$ERR. ERROR RETURN. TNZ ETELT+1. FILE OR ELEMENT? J EORSWC$F. FILE. L A1,FCT+5. GET NEXT SECTOR ADDRESS. ANU A1,ETELOC. COMPUTE ELEMENT LENGTH. SM A2,ETELEN. STORE IN ELT TABLE. L X11,SAVX11. RECOVER X11. DO 1-FTN , SZ A3. FOR ADDR=IND. DO FTN , L A3,SAVA3. RECOVER CALLING SEQUENCE ADDRESS. L A0,CYCLIM. CYCLE LIMIT. DO FTN , L A0,0,A0. LSSL A0,12. DO 1-FTN , A A0,HICYCL. HIGH CYCLE. DO FTN , L A2,HICYCL. HIGH CYCLE ADDRESS. DO FTN , A A0,0,A2. HIGH CYCLE. LSSL A0,12. DO 1-FTN , A A0,NCYCLE. NUMBER OF CYCLES. DO FTN , L A2,NCYCLE. ADDRESS OF NUMBER OF CYCLES. DO FTN , A A0,0,A2. NUMBER OF CYCLES. S A0,ETCYCL. STORE CYCLE WORD. LN,U A0,ETABLE. A0 = - ELEMENT TABLE ADDRESS. ER PFI$. INSERT ELEMENT. L A0,A2. GET STATUS. JZ A0,PFI$OK. JUMP IF NO ERROR. L,U A5,32,A2. SHIFT STATUS CODES. SDFOC$ERR L A0,A5. GET STATUS FROM PFI$ OR SDFOC$. PFI$OK L X11,SAVX11. RECOVER X11. L X1,SAVX1. RECOVER X1. J RETC. RETURN. EORSWC$F SZ A0. SET STATUS ZERO FOR FILE CLOSED OK. J PFI$OK. EORSWC$NOT L,U A0,36. USE S = 36 IF WORK NOT OPEN. J PFI$OK. END. @HDG,P EXCHAH @FTN,SVI EXCHAH SUBROUTINE EXCHAH (RECORD,NCHAR) C C CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO C HOLLERITH FORMAT. C THIS PROGRAM IS NOT MACHINE SENSITIVE. C C RECORD IS THE RECORD TO BE CONVERTED. THE HOLLERITH IS STORED C IN RECORD ALSO INTEGER RECORD(1) C C NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED C INTEGER XLATE(128) COMMON /EXCHXC/ XLATE C C DO 10 I=1,NCHAR J=RECORD(I) 10 RECORD(I)=XLATE(J+1) RETURN END @HDG,P EXCHSL @FTN,SVI EXCHSL SUBROUTINE EXCHSL C C LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS. C C EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE C SEGMENT. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C RETURN END @HDG,P EXCHTR @FTN,SVI EXCHTR SUBROUTINE EXCHTR (IBLOCK,OBLOCK) C C TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER. C INTEGER IBLOCK(1), OBLOCK(1) C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4. C CALL EXCHFO (1) CALL EXCHFO (2) WORKF=-IABS(WORKF) C 10 IF (TRANS.LE.0) RETURN CALL EXCHSL C LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS. GO TO (11,12,13,14,15,16,17,18,19), TRANS C COMMAND PARSER 11 CALL EXCHC1 (IBLOCK,OBLOCK) GO TO 10 C IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE 12 CALL EXCHC2 GO TO 10 C OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE. 13 CALL EXCHC3 (IBLOCK,OBLOCK) GO TO 10 C COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE. 14 CALL EXCHC4 (IBLOCK) GO TO 10 C COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE. 15 CALL EXCHC5 (IBLOCK,OBLOCK) GO TO 10 C COPY TEXT FROM INTAPE TO OUTAPE 16 CALL EXCHC6 (IBLOCK,OBLOCK) GO TO 10 C TEXT COMMAND 17 CALL EXCHC7 (IBLOCK,OBLOCK) GO TO 10 C ERROR MESSAGES 18 CALL EXCHC8 GO TO 10 C QUIT 19 CALL EXCHC9 (IBLOCK,OBLOCK) GO TO 10 END @HDG,P EXCHGB @FTN,SVI EXCHGB SUBROUTINE EXCHGB (ISTAT,DBLOCK) C C READ A BLOCK FROM THE EXCHANGE TAPE. C IGNORE THE ERROR CONTROL SEGMENT. C CHECK THE BLOCK SEQUENCE NUMBER. C CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER, C OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C C C READ A BLOCK FROM INTAPE. C BLKSQI=BLKSQI+1 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 160 C C GET INFORMATION OUT OF THE BLOCK HEADER. C CCDBI=NERRCI CWDBI=NWCBI*(CCDBI/NCCBI)+1 CPCBI=MOD(CCDBI,NCCBI) CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) DO 110 JUMP=1,9 CCDBI=CCDBI+1 CPCBI=CPCBI+1 IF (CCDBI.GT.NCDBI) GO TO 130 IF (CPCBI.LE.NCCBI) GO TO 10 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 10 GO TO (20,30,40,50,60,70,80,90,100), JUMP 20 NEWBLK=256*CBLCKI(CPCBI) GO TO 110 30 NEWBLK=NEWBLK+CBLCKI(CPCBI) GO TO 110 40 LASTI=CBLCKI(CPCBI) GO TO 110 50 L1PRGI=256*CBLCKI(CPCBI) GO TO 110 60 L1PRGI=L1PRGI+CBLCKI(CPCBI) GO TO 110 70 N1RECI=256*CBLCKI(CPCBI) GO TO 110 80 N1RECI=N1RECI+CBLCKI(CPCBI) GO TO 110 90 L1RECI=256*CBLCKI(CPCBI) GO TO 110 100 L1RECI=L1RECI+CBLCKI(CPCBI) 110 CONTINUE C C CHECK THE BLOCK SEQUENCE NUMBER. C IF (BLKSQI.EQ.NEWBLK) GO TO 150 ISTAT=1 WRITE (PRINTR,120) NEWBLK,BLKSQI 120 FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I 15//) BLKSQI=NEWBLK GO TO 160 C C FORMAT ERROR C 130 ISTAT=2 GO TO 160 C C CHECK L1PRGI AND L1RECI. C 150 IF (L1PRGI.GT.NCDBI) GO TO 130 IF (L1RECI.GT.NCDBI) GO TO 130 ISTAT=0 160 RETURN C END @HDG,P EXCHGR @FTN,SVI EXCHGR SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD) C C GET A RECORD FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK). C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE C SPACE ALLOWED BY THE USER. (POSITION IS STILL OK). C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM C CONTROL RECORDS. NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS. C ISTAT=0 NCHACT=0 10 JUMP=1 GO TO 260 20 NG=CBLCKI(CPCBI) IF (NG.EQ.0) GO TO 90 IF (NG.NE.255) GO TO 30 C C END OF SHORT TAPE BLOCK. C CCDBI=NCDBI GO TO 10 C C UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO C THE USER RECORD AREA. C 30 ITYPEI=0 IF (MODEI.EQ.0) GO TO 40 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG 40 IG=0 50 JUMP=2 GO TO 260 60 NR=CBLCKI(CPCBI) IF (MODEI.EQ.0) GO TO 70 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR GO TO 160 70 IR=0 C PUT REMVI INTO THE USER RECORD NR TIMES. 80 IF (IR.GE.NR) GO TO 160 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI IR=IR+1 GO TO 80 C C THE NEXT RECORD IS A CONTROL RECORD. FIND OUT WHAT KIND. C 90 JUMP=3 GO TO 260 100 ITYPEI=CBLCKI(CPCBI) IF (ITYPEI.LT.65) GO TO 250 C 65 = ASCII A IF (ITYPEI.GT.90) GO TO 250 C 90 = ASCII Z I=ITYPEI-64 C A B C D E F G H I J K L M N O GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160 1,110,160,220,160,160,160,160,160,160,160,160), I C P Q R S T U V W X Y Z C C P - PROGRAM HEADER C C CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER 110 REMVI=32 C RESET THE REMOVED CHARACTER TO ASCII BLANK. JUMP=4 GO TO 260 120 L1PRGI=256*CBLCKI(CPCBI) JUMP=5 GO TO 260 130 L1PRGI=L1PRGI+CBLCKI(CPCBI) JUMP=6 GO TO 260 140 N1RECI=256*CBLCKI(CPCBI) JUMP=7 GO TO 260 150 N1RECI=N1RECI+CBLCKI(CPCBI) C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 160 JUMP=8 GO TO 260 170 NC=CBLCKI(CPCBI) IF (ITYPEI.NE.0) GO TO 180 IF (MODEI.EQ.0) GO TO 180 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC C COPY NC CHARACTERS TO THE USER RECORD AREA. 180 IC=0 JUMP=9 190 IF (IC.GE.NC) IF (ITYPEI) 240,210,240 GO TO 260 200 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI) IC=IC+1 GO TO 190 210 IG=IG+1 IF (IG-NG) 50,240,240 C C J - UPDATING AND END OF INPUT TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 220 JUMP=10 GO TO 260 230 RECORD(1)=CBLCKI(CPCBI) NCHACT=1 IF (ITYPEI.EQ.82) REMVI=RECORD(1) C 82 = ASCII R C C RETURN TO THE USER PROGRAM. C 240 IF (NCHACT.GT.NCHMAX) ISTAT=4 GO TO 290 C C CONTROL RECORD TYPE CANNOT BE DETERMINED. C 250 ISTAT=5 GO TO 290 C C GET A CHARACTER FROM CBLOCK. UNPACK A NEW BLOCK IF NECESSARY. C READ MORE TAPE IF NECESSARY. C 260 CPCBI=CPCBI+1 CCDBI=CCDBI+1 IF (CCDBI.LE.NCDBI) GO TO 270 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 290,260,290 270 IF (CPCBI.LE.NCCBI) GO TO 280 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 280 GO TO (20,60,100,120,130,140,150,170,200,230), JUMP 290 RETURN C END @HDG,P EXCHNP @FTN,SVI EXCHNP SUBROUTINE EXCHNP (ISTAT,DBLOCK) C C SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE C TAPE. C THIS MODULE IS MACHINE INSENSITIVE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) ISTAT=0 IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20 C C CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK. C 10 IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20 C 76 = ASCII L C C NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK. CCDBI=L1PRGI-1 I=NWCBI*(CCDBI/NCCBI)+1 IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI) CWDBI=I CPCBI=MOD(CCDBI,NCCBI) GO TO 40 C C NO MORE HEADERS IN THIS BLOCK. C 20 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 40,10,40 C C END OF FILE. C 30 ISTAT=7 C 40 RETURN C END @HDG,P EXCHPB @FTN,SVI EXCHPB SUBROUTINE EXCHPB (ISTAT,DBLOCK) C C WRITE A BLOCK ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK. INTEGER WORK(9) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C C PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK. C BLKSQO=BLKSQO+1 WORK(1)=BLKSQO/256 WORK(2)=MOD(BLKSQO,256) WORK(3)=LASTO WORK(4)=L1PRGO/256 WORK(5)=MOD(L1PRGO,256) WORK(6)=N1RECO/256 WORK(7)=MOD(N1RECO,256) WORK(8)=L1RECO/256 WORK(9)=MOD(L1RECO,256) C CPCBO=MOD(NERRCO,NCCBO) CWDBO=(NERRCO/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) C DO 10 I=1,9 CPCBO=CPCBO+1 IF (CPCBO.LE.NCCBO) GO TO 10 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) CWDBO=CWDBO+NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) CPCBO=1 10 CBLCKO(CPCBO)=WORK(I) CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) C C WRITE THE DATA BLOCK ON TAPE. C ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L). C IF (LASTO.NE.76) GO TO 20 ISTAT=3 CALL EXCHWT (ISTAT,DBLOCK) GO TO 30 C C COMPUTE POINTERS FOR NEXT BLOCK OUT. C 20 L1PRGO=0 LLPRGO=0 N1RECO=0 L1RECO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 C 30 RETURN C END @HDG,P EXCHPR @FTN,SVI EXCHPR SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD) C C WRITE A RECORD ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A C TEXT RECORD CONTAINS MORE THAN 254 GROUPS. C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER GC,RC(255),CC(255) C GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C ISTAT=0 INCHAR=0 C C DETERMINE THE RECORD TYPE. C IF (NCHOUT.NE.255) GO TO 10 ITYPEO=255 GO TO 70 10 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO IF (ITYPEO.NE.0) GO TO 30 C C DATA RECORD. C IF (MODEO.NE.0) GO TO 170 C COMPRESS THE RECORD. CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255) IF (GC.GE.255) GO TO 210 IG=0 C OUTPUT THE GROUP COUNT. CBLCKO(CPCBO)=GC JUMP=1 GO TO 230 20 IG=IG+1 IF (IG.GT.GC) GO TO 250 NC=CC(IG) INCHAR=INCHAR+RC(IG) C OUTPUT REMOVED CHARACTER COUNT. CBLCKO(CPCBO)=RC(IG) JUMP=2 GO TO 230 C C THE USER SAYS HE HAS A CONTROL RECORD TO WRITE. FIND OUT C WHAT KIND. C 30 IF (ITYPEO.LT.65) GO TO 220 C 65 = ASCII A IF (ITYPEO.GT.90) GO TO 220 C 90 = ASCII Z I=ITYPEO-64 C A B C D E F G H I J K L M N O P Q R S GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40, 140,40,40,40,40,40,40), I C T U V W X Y Z C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE TYPE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 40 IF (NCHOUT-255) 100,100,210 C C END OF FILE. C 50 IF (NERRCO+NDATAO+7-CCDBO) 70,80,80 C C P - PROGRAM HEADER. C 60 IF (NCHOUT.GT.255) GO TO 210 REMVO=32 C RESET REMOVED CHARACTER TO ASCII BLANK. IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80 IF (CCDBO.EQ.NERRCO+10) GO TO 80 C C END OF SHORT TAPE BLOCK. C 70 CBLCKO(CPCBO)=255 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250 C 69 = ASCII E C 80 = ASCII P L1RECO=CCDBO-NERRCO 80 IF (LLPRGO.EQ.0) GO TO 90 C LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK. CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) NC=MOD(LLPRGO+1,NCCBO) NW=((LLPRGO+1)/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) CBLCKO(NC+1)=CCDBO/256 IF (NC+1.LT.NCCBO) GO TO 85 CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) NW=NW+NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) NC=-1 85 CBLCKO(NC+2)=MOD(CCDBO,256) CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) CALL EXCHUN (DBLOCK(CWDBO),CBLCKO) C UPDATE TABLE OF CONTENTS POINTERS 90 LLPRGO=CCDBO IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO NLRECO=NLRECO+1 IF (N1RECO.EQ.0) N1RECO=NLRECO 100 CBLCKO(CPCBO)=0 JUMP=3 GO TO 230 110 CBLCKO(CPCBO)=ITYPEO JUMP=4 GO TO 230 120 IF (ITYPEO.NE.69) GO TO 130 C 69 = ASCII E LASTO=76 GO TO 70 130 IF (ITYPEO.NE.80) GO TO 170 C 80 = ASCII P CBLCKO(CPCBO)=0 JUMP=5 GO TO 230 140 CBLCKO(CPCBO)=0 JUMP=6 GO TO 230 150 CBLCKO(CPCBO)=NLRECO/256 JUMP=7 GO TO 230 160 CBLCKO(CPCBO)=MOD(NLRECO,256) JUMP=8 GO TO 230 C 170 NC=NCHOUT 180 CBLCKO(CPCBO)=NC IC=0 JUMP=9 C PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD. IF (ITYPEO.EQ.82) GO TO 190 IF (ITYPEO.EQ.74) GO TO 190 IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230 190 IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250 INCHAR=INCHAR+1 IC=IC+1 CBLCKO(CPCBO)=RECORD(INCHAR) GO TO 230 C C J - UPDATING AND END OF TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 200 NCHOUT=1 IF (ITYPEO.EQ.82) REMVO=RECORD(1) C 82 = ASCII R GO TO 100 C C RECORD TOO LONG. C 210 ISTAT=4 GO TO 250 C C UNKNOWN CONTROL RECORD TYPE. C 220 ISTAT=5 GO TO 250 C C INCREMENT THE OUTPUT BUFFER POINTERS. PACK A CHARACTER BLOCK C IF NECESSARY. WRITE A TAPE BLOCK IF NECESSARY. C 230 CPCBO=CPCBO+1 CCDBO=CCDBO+1 IF (CPCBO.LE.NCCBO) GO TO 240 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CWDBO=CWDBO+NWCBO CPCBO=1 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240 CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 250 240 GO TO (20,180,110,120,140,150,160,170,190), JUMP 250 RETURN C END @HDG,P EXCHSC @FTN,SVI EXCHSC SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL) C C SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE C DATA TO BE REMOVED. DIVIDE DATA INTO GROUPS CONSISTING OF C STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT C DATA. THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE C REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP C ARE RECORDED IN RC() AND SC() RESPECTIVELY. MAXSL IS THE C MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC(). C INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL C C RC AND SC MUST BE AT LEAST (IMGLEN-1)//3. C GC=1 SC(1)=0 RC(1)=0 MODE=-1 INPLEN=IABS(IMGLEN) C C IDENTIFY DATA GROUPS. C DO 110 I=1,INPLEN IF (MODE) 40,60,90 C C MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE. C 40 IF (INPIMG(I).EQ.REMOVE) GO TO 50 C SWITCH TO SIGNIFICANT DATA SCAN. MODE=1 SC(GC)=1 GO TO 110 C CONTINUE REMOVE SCAN 50 RC(GC)=RC(GC)+1 IF (RC(GC)-MAXSL) 110,95,110 C C MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY C ONE OCCURRENCE OF REMOVE. CHANGE TO REMOVE MODE IF ANOTHER REMOVE C OCCURS OR BACK TO DATA MODE IF NOT. C 60 IF (INPIMG(I).EQ.REMOVE) GO TO 80 C SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT. MODE=1 IF (SC(GC).GE.MAXSL-2) GO TO 70 SC(GC)=SC(GC)+2 GO TO 110 C FULL GROUP 70 GC=GC+1 RC(GC)=1 SC(GC)=1 GO TO 110 C SWITCH TO REMOVE MODE. 80 GC=GC+1 SC(GC)=0 RC(GC)=2 MODE=-1 GO TO 110 C C MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA. C 90 IF (INPIMG(I).EQ.REMOVE) GO TO 100 SC(GC)=SC(GC)+1 IF (SC(GC).NE.MAXSL) GO TO 110 C FULL GROUP MODE=-1 95 IF (I.GE.INPLEN) GO TO 120 GC=GC+1 RC(GC)=0 SC(GC)=0 GO TO 110 100 MODE=0 110 CONTINUE 120 RETURN C END @HDG,P EXCHTP @FTN,SVI EXCHTP SUBROUTINE EXCHTP (RECORD,LINEI) C C MATERIALIZE INCLUDES IF INALT IS NON-ZERO. C CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE C AND THE PRINTER IF LISTING IS REQUESTED. C LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C INTEGER RECORD(1),LINEI C C ***** LOCAL VARIABLES ************************************ C C COPY DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR C SKIPPING TEXT NOT TO BE INCLUDED. INTEGER COPY C DASH CONTAINS '-' IN HOLLERITH. INTEGER DASH C ENDMRK HOLDS THE END SENTINEL. INTEGER ENDMRK(40) C NCHEND IS THE NUMBER OF CHARACTERS IN ENDMRK. INTEGER NCHEND C NCHSAV SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD. INTEGER NCHSAV C NCHTAR IS THE NUMBER OF CHARACTERS IN TARGET. INTEGER NCHTAR C STAR CONTAINS '*' IN HOLLERITH. INTEGER STAR C TARGET IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY). INTEGER TARGET(40) C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL DATA *************************************** C DATA DASH /1H-/, STAR /1H*/ C C ***** PROCEDURES ***************************************** C LINEO=LINEO+1 IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190 RECORD(180)=LINEO RECORD(179)=LINEI COPY=-1 C COPY=-1 MEANS NOT COPYING INCLUDED TEXT. IF (ITYPEO.EQ.0) GO TO 110 C PROCESS INCLUDE RECORD. DO 10 I=1,NCHOUT 10 RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I) C INSERT '-I '. RECORD(1)=45 RECORD(2)=73 RECORD(3)=32 NCHOUT=NCHOUT+3 IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110 C STORE SEARCH TARGET NCHTAR=MIN0(NCHOUT,40) DO 20 I=1,NCHTAR 20 TARGET(I)=RECORD(I) C STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). NCHSAV=NCHCMD DO 30 I=1,NUMBER 30 OUTREC(I)=COMAND(I) COPY=0 C COPY=0 MEANS SKIPPING MODULE ON INALT FILE. INALT=IABS(INALT) NEOF=0 40 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 IF (NCHCMD.LT.2) GO TO 40 IF (COMAND(1).NE.45) GO TO 40 C 45 = ASCII - IF (COMAND(2).EQ.45) GO TO 130 IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40 C 73 = ASCII I, 105 = ASCII LOWER CASE I. C COMPARE IMAGE WITH SEARCH TARGET. IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60 DO 50 I=2,NCHTAR K=COMAND(I) IF (K.GT.96 .AND. K.LT.123) K=K-32 IF (TARGET(I).NE.K) GO TO 60 50 CONTINUE NEOF=3 C PREVENT SEARCH LOOP. COPY=1 C COPY=1 MEANS COPYING INCLUDED TEXT. 60 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C STORE END OF INCLUDE MODULE SIGNAL. NCHEND=MIN0(40,NCHCMD) DO 70 I=1,NCHEND 70 ENDMRK(I)=COMAND(I) IF (COPY.EQ.0) GO TO 80 CHAR1L=DASH NCHOUT=NCHTAR DO 75 I = 1,NCHOUT 75 COMAND(I)=TARGET(I) COMAND(180)=LINEO COMAND(179)=LINEI C GO PRINT TARGET. CALL EXCHTW (COMAND,-1) GO TO 120 C COPY OR SKIP UNTIL ENDMRK SEEN AGAIN. 80 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF. C TEST FOR ENDMRK DO 90 I=1,NCHEND IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100 90 CONTINUE IF (COPY) 140,40,140 C OUTPUT TEXT RECORD. 100 COMAND(180)=LINEO COMAND(179)=LINEI NCHOUT=NCHCMD CALL EXCHTW (COMAND,OPTI) GO TO 120 C OUTPUT TEXT RECORD. 110 CALL EXCHTW (RECORD,1) 120 IF (COPY) 190,190,80 C WE ONLY GET HERE WITH COPY .GE. 0. 130 NEOF=NEOF+1 ACTION=2 C ACTION = 2 MEANS REOPEN INALT. CALL EXCHIM IF (NEOF.LT.2) GO TO 40 140 INALT=-IABS(INALT) NCHCMD=1 IF (COPY.GT.0) GO TO 170 C PROCESS TARGET AS THOUGH IT WERE TEXT. NCHOUT=NCHTAR C SAVE TARGET FOR ERROR MESSAGE. DO 150 I=1,NCHTAR 150 COMAND(I)=TARGET(I) CALL EXCHTW (COMAND,1) CALL EXCHAH (TARGET,NCHTAR) WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR) 160 FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8 10A1)) NERRS=MAX0(NERRS,3) C C RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). C 170 NCHCMD=NCHSAV DO 180 I=1,NUMBER 180 COMAND(I)=OUTREC(I) C 190 CHAR1L=STAR RETURN C END @HDG,P EXCHTW @FTN,SVI EXCHTW SUBROUTINE EXCHTW (RECORD,OPTION) C C WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING C EXCHOU. WRITE RECORD ON THE PRINTER IF LISTING REQUESTED. C RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C IF OPTION = ZERO, WRITE TO FILE ONLY. C IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING. C IF OPTION .LT. ZERO, WRITE TO LISTING ONLY. C INTEGER RECORD(1),OPTION C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** PROCEDURES ***************************************** C LINEI=RECORD(179) IF (OPTION.LT.0) GO TO 130 C C INSERT IDENTIFICATION IF REQUESTED. C IF (IDCOL2.LT.IDCOL1) GO TO 120 IF (IDTXTL+IDSTEP.EQ.0) GO TO 120 IF (NCHOUT.GE.IDCOL2) GO TO 20 J=IDCOL2-1 C FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2 DO 10 I=NCHOUT,J 10 RECORD(I+1)=32 C 32 = ASCII BLANK. 20 NCHOUT=MAX0(NCHOUT,IDCOL2) N=-1 IF (LINEI.EQ.0) GO TO 40 IF (IDOPTN.NE.73) GO TO 40 C 73 = ASCII I. IDENTIFY ONLY FROM INTAPE. N=(LINEI-1)*IDSTEP+IDSTRT GO TO 70 40 IF (IDOPTN.NE.79) GO TO 50 C 79 = ASCII O. IDENTIFY ONLY TO OUTAPE. N=(LINEO-1)*IDSTEP+IDSTRT GO TO 70 50 IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70 C 67 = ASCII C, 70 = ASCII F. IDENTIFY EVERYTHING. N=IDCUR 70 IF (N.LT.0) GO TO 120 IF (IDTXTL.EQ.0) GO TO 100 J=MIN0(IDCOL2,IDTXTL+IDCOL1-1) K=1 DO 80 I=IDCOL1,J RECORD(I)=IDTEXT(K) 80 K=K+1 100 IF (IDSTEP.EQ.0) GO TO 120 IDCUR=IDCUR+IDSTEP K=IDCOL2 110 RECORD(K)=MOD(N,10)+48 N=N/10 K=K-1 IF (N.EQ.0) GO TO 120 IF (K.GE.IDCOL1) GO TO 110 C C OUTPUT RECORD. C 120 IF (OUFILE.NE.0) CALL EXCHOU (RECORD) IF (OPTION.EQ.0) GO TO 220 130 IF (OPTL.NE.0) GO TO 140 IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220 140 CALL EXCHAH (RECORD,NCHOUT) IF (OPTV+VERT.NE.0) GO TO 200 IF (PHASE.NE.8) GO TO 180 IF (LINEI.EQ.0) GO TO 160 WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 150 FORMAT (1X,2I5,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 160 WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 170 FORMAT (5H NEW,I6,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 180 WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 190 FORMAT (1X,I5,A1,3X,110A1/(6H CONT,4X,110A1)) GO TO 220 200 WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT) 210 FORMAT (132A1) 220 RETURN C END @HDG,P EXCHC1 @FTN,SVI EXCHC1 SUBROUTINE EXCHC1 (IBLOCK,OBLOCK) C C COMMAND DECODER AND FORMAT VERIFIER. SOME COMMANDS ARE ALSO C COMPLETELY PROCESSED HERE. C C IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS. C INTEGER IBLOCK(1),OBLOCK(1) C C C ***** LOCAL VARIABLES ************************************ C C ALLOW TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED. VALUES ARE C SUMS OF PERMITTED VALUES OF PHASE. C 1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING, C 8 = UPDATING. C ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A C PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR C MAY BE VOID (EQUAL SIGN IS LAST CHARACTER). C 32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT. INTEGER ALLOW(35) C BLANK A CONSTANT. 1H . INTEGER BLANK C DATE IS THE DATE FROM UPDA=, DATE=, ORIG=. INTEGER DATE(3) C DAYS TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS. INTEGER DAYS(12) C I IS USED FREELY AS AN INDEX. C J IS USED FREELY AS AN INDEX. C JUMP USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE. C K IS USED FREELY AS AN INDEX. C KDATE IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD). C KQUIT IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD). C KTEXT IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD). C N IS USED FREELY AS AN INDEX. C NCNREC IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS. C ND IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER. C NM IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER. C NY IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER. C TVAL A VECTOR OF VALUES FOR TRANS. INDEXED BY ICOMD. INTEGER TVAL(35) C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL EQUIVALENCE ********************************** C EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND) C C ***** DATA STATEMENTS ************************************ C DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/ DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/ DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/ DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/ DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/ DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/ DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/ DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/ DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/ DATA BLANK /1H / DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/ DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/ DATA DAYS(11),DAYS(12) /30,31/ DATA KDATE /5/ DATA KQUIT /20/ DATA KTEXT /27/ DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/ DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/ DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/ DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/ DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/ DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/ DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/ C C ***** PROCEDURES ***************************************** C C GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER. C ECHO IT IF THE E OPTION IS SET. DETERMINE WHETHER IT IS A CHANGE C TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND. C 10 NCNREC=0 20 ACTION=0 IF (NCHCMD.LT.0) GO TO 220 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (OPTE.EQ.0) GO TO 27 WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD) 23 FORMAT (1X,80A1) CHAR1L=0 27 NCHCMD=MIN0(NCHCMD,MARGIN) IF (PHASE.LT.4) SIGNAL=45 C 45 = ASCII - IF (COMAND(1).NE.45) GO TO 50 C 45 = ASCII -. REQUEST TO CHANGE CONTROL RECORD. IF (PHASE.LT.4) GO TO 40 WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD) 30 FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT 1OR UPDATE/1X,80A1) NERRG=MAX0(NERRG,2) GO TO 200 40 ICOMD=0 EQUAL=2 TRANS=3 GO TO 370 50 IF (COMAND(1).NE.42) GO TO 70 C 42 = ASCII *. COMMENT RECORD. JUST ECHO IT. NCHCMD=MAX0(NCHCMD,2) WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD) 60 FORMAT (A1,1H*,78A1/(1X,80A1)) GO TO 10 C C SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR C EQUAL SIGN ARE FOUND. LOOK UP THE WORD IN THE COMMAND NAME TABLE. C 70 EQUAL=0 DO 80 I=1,NCHCMD IF (COMAND(I).EQ.32) GO TO 80 C 32 = ASCII BLANK EQUAL=EQUAL+1 ICOMD=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32 C ABOVE STATEMENT CONVERTS TO UPPER CASE. COMAND(I)=32 COMAND(EQUAL)=ICOMD IF (EQUAL.GE.4) GO TO 90 IF (ICOMD.EQ.61) GO TO 90 C 61 = ASCII =. IF (ICOMD.EQ.44) GO TO 90 C 44 = ASCII ,. 80 CONTINUE IF (EQUAL.EQ.0) GO TO 185 90 DO 110 ICOMD=1,NCOMDT DO 100 K=1,EQUAL IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110 100 CONTINUE IF (EQUAL.EQ.4) GO TO 130 IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130 C 32 = ASCII BLANK. 110 CONTINUE C C UNRECOGNIZED COMMAND. C 120 ICOMD=0 C C LOOK FOR AN EQUAL SIGN. SET THE VARIABLE NAMED EQUAL TO ZERO IF C THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK C CHARACTER FOLLOWING THE EQUAL SIGN. C 130 MODIFY=0 140 DO 150 I=EQUAL,NCHCMD K=COMAND(I) IF (K.EQ.61) GO TO 160 C 61 = ASCII =. IF (MODIFY.NE.0) GO TO 150 C USE FIRST MODIFIER. IF (K.EQ.44) GO TO 160 C 44 = ASCII ,. 150 CONTINUE EQUAL=0 GO TO 170 160 I=I+1 EQUAL=I IF (I.GT.NCHCMD) GO TO 170 IF (COMAND(I).EQ.32) GO TO 160 C 32 = ASCII BLANK IF (K.NE.44) GO TO 170 C 44 = ASCII ,. MODIFY=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32 C CONVERT TO UPPER CASE. GO TO 140 170 IF (K.NE.61) EQUAL=0 C 61 = ASCII =. IF (ICOMD.EQ.0) GO TO 180 IF (ICOMD.GT.NCOMDP) GO TO 180 IF (EQUAL.GT.NCHCMD) GO TO 175 IF (EQUAL.NE.0) GO TO 230 IF (ALLOW(ICOMD)/64.NE.0) GO TO 230 175 IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690 C PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK. NCHCMD=NCHCMD+1 EQUAL=NCHCMD COMAND(NCHCMD)=32 C 32 = ASCII BLANK HOLCMD(NCHCMD)=BLANK GO TO 230 C C GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX. C 180 CALL EXCHCX (0) C IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND. IF (ICOMD.NE.0) GO TO 730 185 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1)) NERRG=MAX0(NERRG,5) 200 CHAR1L=0 NCNREC=NCNREC+1 IF (NCNREC.LE.20) GO TO 20 WRITE (PRINTR,210) 210 FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU 1MES TEXT COMMAND IS MISSING.) GO TO 270 C C END OF FILE - SIMULATE A QUIT COMMAND. C 220 ICOMD=KQUIT C C RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME. C 230 IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240 TRANS=TVAL(ICOMD) C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300 1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7 230,370,730,370), ICOMD C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 C 32 33 34 35 C C THE COMMAND IS NOT ALLOWED AT THIS TIME. C 240 WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE 1D./1X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 C DECIDE WHETHER TO SKIP TEXT 260 IF (ICOMD.NE.KTEXT) GO TO 10 IF (EQUAL.NE.0) GO TO 10 270 WRITE (PRINTR,280) 280 FORMAT (//15H0SKIPPING TEXT.) 290 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (NCHCMD.LT.2) GO TO 290 IF (COMAND(1).NE.SIGNAL) GO TO 290 IF (COMAND(2).EQ.SIGNAL) GO TO 10 IF (NCHCMD.LT.3) GO TO 290 IF (COMAND(2).NE.61) GO TO 290 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 290 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING. C DATE=YYMMDD C ORIGIN=YYMMDD SITE C UPDATE=YYMMDD SITE C IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE C THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED. C 300 IF (EQUAL+5.GT.NCHCMD) GO TO 700 I=EQUAL DO 310 J=1,3 DATE(J)=0 DO 310 K=1,2 N=COMAND(I)-48 IF (N.LT.0) GO TO 320 IF (N.GT.9) GO TO 320 DATE(J)=10*DATE(J)+N 310 I=I+1 IF (NM.EQ.0) GO TO 320 IF (NM.GT.12) GO TO 320 IF (ND.LE.0) GO TO 320 DAYS(2)=28 IF (MOD(NY,4).EQ.0) DAYS(2)=29 IF (NY.EQ.0) DAYS(2)=28 IF (ND.LE.DAYS(NM)) GO TO 440 320 IF (ICOMD.EQ.KDATE) GO TO 700 IF (TODAY(1).EQ.32) GO TO 700 I=MIN0(NCHCMD+6,180) NCHCMD=I J=I-6 IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1 C 32 = ASCII BLANK IF (J.LT.EQUAL) GO TO 700 330 COMAND(I)=COMAND(J) HOLCMD(I)=HOLCMD(J) J=J-1 I=I-1 IF (J.GE.EQUAL) GO TO 330 DO 340 I=1,6 COMAND(I+EQUAL-1)=TODAY(I) 340 HOLCMD(I+EQUAL-1)=TODAY(I) CALL EXCHAH (HOLCMD(EQUAL),6) WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD) 345 FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1)) NERRG=MAX0(NERRG,1) GO TO 440 C C REWIND INTAPE C 350 IF (INTAPE.EQ.0) GO TO 680 IF (INTOPN.NE.0) GO TO 360 I=1 C OPEN INTAPE IF NOT ALREADY OPEN. DO NOT CHECK EXCH LABEL. CALL EXCHRT (I,IBLOCK) C IGNORE STATUS 360 I=2 CALL EXCHRT (I,IBLOCK) INTOPN=0 GO TO 725 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH C BEGINS WITH A NUMBER FOLLOWED BY A BLANK. C C INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA C INTAPE = NUMBER SYSTEM DEPENDENT DATA C LIMIT = NUMBER C MARGIN = NUMBER C OUTAPE = NUMBER SYSTEM DEPENDENT DATA C OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA C PRINTER = NUMBER C READER = NUMBER C SKIP = NUMBER C TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL) C WORK = NUMBER C 370 NUMBER=0 IF (EQUAL.EQ.0) GO TO 440 DO 410 J=EQUAL,NCHCMD IF (COMAND(J).EQ.32) GO TO 420 C 32 = ASCII BLANK N=COMAND(J)-48 C 48 = ASCII ZERO IF (N.GE.0) GO TO 400 380 WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD) 390 FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS. NOT PROCESSED./ 11X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 GO TO 260 400 IF (N.GT.9) GO TO 380 410 NUMBER=10*NUMBER+N EQUAL=NCHCMD+1 GO TO 440 420 EQUAL=J 430 EQUAL=EQUAL+1 IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440 C 32 = ASCII BLANK C C PRELIMINARY FORMAT CHECKING IS COMPLETE C 440 J=ICOMD+1 C 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6 120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595), 2J C 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 C C DATE=YYMMDD C 450 DO 460 I=1,6 460 TODAY(I)=COMAND(EQUAL+I-1) GO TO 10 C C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA. C 470 I=INFILE J=1 GO TO 500 C C INCLUDE = NUMBER SYSTEM DEPENDENT DATA. C 480 I=INALT J=3 INALT=IABS(INALT) GO TO 500 C C TEXT C 490 I=INTEXT J=2 IF (EQUAL.EQ.0) GO TO 560 C C OPEN AN INPUT FILE. C 500 IF (NUMBER.EQ.0) GO TO 505 IF (NUMBER.EQ.OUFILE) GO TO 710 IF (NUMBER.EQ.OUTAPE) GO TO 710 505 IF (J.EQ.2) GO TO 510 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (I.NE.0) CALL EXCHIM 510 IF (J-2) 520,530,540 520 INFILE=NUMBER GO TO 550 530 INTEXT=NUMBER GO TO 550 540 INALT=NUMBER 550 IF (NUMBER.EQ.0) GO TO 560 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND CALL EXCHCX (J+1) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHIM ACTION=2 C ACTION = 2 MEANS REWIND IF (J.EQ.3) CALL EXCHIM INALT=-IABS(INALT) 560 ACTION=0 C ACTION = 0 MEANS READ TEXT GO TO 730 C C INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 570 IF (INTOPN.EQ.0) GO TO 580 C CLOSE THE INPUT TAPE, IGNORE STATUS. I=4 CALL EXCHRT (I,IBLOCK) INTOPN=0 580 INTAPE=NUMBER C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (INTAPE.NE.0) CALL EXCHCX (6) GO TO 725 C C LIMIT = NUMBER C 590 LIMIT=NUMBER GO TO 10 C C MARGIN = NUMBER C C MINIMUM MARGIN IS 60 595 MARGIN=MAX0(NUMBER,60) GO TO 10 C C OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 600 IF (OUTOPN.EQ.0) GO TO 610 C WRITE AND END-OF-FILE MARK ON OUTAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (I,OBLOCK,OBLOCK) C IGNORE STATUS OUTOPN=0 PHASE=1 610 OUTAPE=NUMBER OUTUPD=MODIFY C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (OUTAPE.NE.0) CALL EXCHCX (7) GO TO 730 C C OUTPUT = NUMBER SYSTEM DEPENDENT INFORMATION C 620 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) OUFILE=NUMBER IDCUR=IDSTRT IF (OUFILE.EQ.0) GO TO 730 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND. CALL EXCHCX (5) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHOU (OUTREC) GO TO 730 C C PRINTER = NUMBER. C 630 CALL EXCHFO (-2) PRINTR=NUMBER CALL EXCHFO (2) GO TO 10 C C READER = NUMBER. C 640 IF (INFILE.NE.0) GO TO 670 CALL EXCHFO (-1) READER=NUMBER CALL EXCHCX (1) CALL EXCHFO (1) GO TO 10 C C WORK = NUMBER C 650 IF (WORKF.GT.0) CALL EXCHFO (-3) WORKF=NUMBER C WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4. GO TO 10 C C UPDATE C C DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR C SIMPLY TO OUTPUT THE UPDATE COMMAND. 660 IF (PHASE.GE.4) TRANS=5 GO TO 730 C C ERROR MESSAGES. C 670 NUMBER=3 C MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE. GO TO 720 680 NUMBER=4 C MESSAGE 4 - INTAPE IS NOT DEFINED. GO TO 720 690 NUMBER=12 C MESSAGE 12 - NO PARAMETER STRING. GO TO 720 700 NUMBER=13 C MESSAGE 13 - IMPROPER DATE. GO TO 720 710 NUMBER=31 C MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT. C C RETURN TO ERROR MESSAGE SEGMENT. C 720 TRANS=8 GO TO 740 c c Indicate the WORK file is empty. c 725 if (nrwork.le.0 .or. workf.le.0) go to 730 REWIND WORKF NRWORK=0 C C IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP. C 730 IF (TRANS.EQ.1) GO TO 10 740 RETURN C END @HDG,P EXCHCX/1100 @FTN,SVI EXCHCX/1100 SUBROUTINE EXCHCX (REASON) C C PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER C PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT, C INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS. C UNIVAC-1100 VERSION. C C IF THE COMMAND IS 'ASCII', SET OUTPUT MODE TO ASCII; C IF THE COMMAND IS 'FIELDATA', SET OUTPUT MODE TO FIELDATA C INTEGER REASON C C REASON=0 FOR UNRECOGNIZED COMMAND. C REASON=1 BEFORE OPENING READER. C REASON=2 BEFORE OPENING INFILE. C REASON=3 BEFORE OPENING INTEXT. C REASON=4 BEFORE OPENING INALT. C REASON=5 BEFORE OPENING OUFILE. C REASON=6 BEFORE OPENING INTAPE. C REASON=7 BEFORE OPENING OUTAPE. C C ***** EXTERNAL FUNCTIONS ********************************* C INTEGER EORSRO INTEGER EXCHFN C C ***** LOCAL VARIABLES ************************************ C C BLANK CONTAINS A HOLLERITH BLANK. INTEGER BLANK C BYPASS IS A BYPASS (040) ICW. INTEGER BYPASS C DUMMY IS USED TO ACCESS A WORD REFERENCED BY ITS ADDRESS. INTEGER DUMMY(1) C FDBLNK IS 6 BLANKS IN FIELDATA CODE. INTEGER FDBLNK C I IS USED AS AN INDEX AND TEMPORARY VARIABLE. INTEGER I C ICW IS A FD/ASCII SWITCH ICW (042). INTEGER ICW C IEOF CONTAINS O77 IS S1 AND ZERO ELSEWHERE - EOF ICW. INTEGER IEOF C IOPN IS '@@@OPN' IN FIELDATA CODE. INTEGER IOPN C J IS USED AS AN INDEX AND TEMPORARY VARIABLE. INTEGER J C N IS USED AS AN INDEX AND TEMPORARY VARIABLE. INTEGER N C PLUS CONTAINS A HOLLERITH PLUS SIGN. INTEGER PLUS C RHW CONTAINS O777777 - MASK TO GET RIGHT HALFWORD. INTEGER RHW C SLASH CONTAINS A HOLLERITH SLASH. INTEGER SLASH C C KNAME AND NAMET ARE USED TO PROVIDE TEMPORARY COMPATIBILITY OF C THE INSERT COMMAND WITH PREVIOUS VERSIONS OF THE PROGRAM. C C C ***** COMMON VARIABLES *********************************** C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF INTEGER AFDFLG,WORKS(474,5) INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2) COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXEC8/ AFDFLG,WORKS COMMON /EXEC8A/ FILES,ELTS,VERS,PFS EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL DATA ***************************************** C C PUT COMMANDS INTO COMD AFTER NCOMDP. THE POSITION OF THIS C DATA IN COMD MUST BE CHANGED IF NCOMDP IS CHANGED. C C A S C I DATA COMD(1,36),COMD(2,36),COMD(3,36),COMD(4,36) /65,83,67,73/ C F I E L DATA COMD(1,37),COMD(2,37),COMD(3,37),COMD(4,37) /70,73,69,76/ C DATA NCOMDT /37/ C DATA SLASH /1H// DATA RHW /O7777777/ @ RIGHT HALFWORD MASK DATA PLUS /1H+/ DATA IOPN /O000000242523/ @ '@@@OPN' IN FIELDATA DATA IEOF /O770000000000/ @ EOF ICW DATA ICW /O420000000000/ @ ASCII/FD SWITCH ICW DATA FDBLNK /O050505050505/ @ FD BLANK DATA BYPASS /O400000000000/ @ BYPASS ICW DATA BLANK /1H / C C ***** PROCEDURES ***************************************** C IF (REASON.NE.0) GO TO 40 IF (ICOMD.EQ.0) GO TO 220 J=ICOMD-NCOMDP IF (AFDFLG.EQ.2-J) GO TO 220 AFDFLG=2-J IF (AND(WORKS(12,5),RHW).NE.IOPN) GO TO 220 @ NOT OPEN ISTAT=EORSWW(WORKS(1,5),0,ICW+AFDFLG) IF (ISTAT.EQ.0) GO TO 220 CALL EXCHEM (ISTAT) WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD) 30 FORMAT (' WHILE WRITING OUTPUT FILE'/(1X,80A1)) GO TO 220 C C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND. C 40 FILES(1,REASON)=EXCHFN(NUMBER) FILES(2,REASON)=FDBLNK IF (HOLCMD(EQUAL).EQ.PLUS) IF (REASON-5) 110,220,220 ELTS(1,REASON)=FDBLNK ELTS(2,REASON)=FDBLNK IF (EQUAL.GT.NCHCMD.OR.EQUAL.EQ.0) GO TO 100 VERS(1,REASON)=FDBLNK VERS(2,REASON)=FDBLNK IF (HOLCMD(EQUAL).EQ.SLASH) GO TO 100 J=EQUAL+12 DO 50 I=EQUAL,J IF (I.GT.NCHCMD) GO TO 60 IF (HOLCMD(I).EQ.SLASH) GO TO 60 IF (HOLCMD(I).EQ.BLANK) GO TO 60 50 CONTINUE I=J 60 J=I-EQUAL CALL EXCHPN (COMAND(EQUAL),ELTS(1,REASON),J) K=EQUAL+J IF (K.GT.NCHCMD) GO TO 100 IF (HOLCMD(K).NE.SLASH) GO TO 100 70 K=K+1 IF (HOLCMD(K).EQ.BLANK) GO TO 70 J=K+12 DO 80 I=K,J IF (I.GT.NCHCMD) GO TO 90 IF (HOLCMD(I).EQ.BLANK) GO TO 90 80 CONTINUE I=J 90 J=I-K CALL EXCHPN (COMAND(K),VERS(1,REASON),J) 100 IF (REASON-5) ,220,170 C C OPEN INPUT. C C IF THE ENTRY IN NTAB$ INDICATES THE UNIT IS ASSOCIATED WITH C A SYMBIONT UNIT THE FILE IS READ USING READ$. C C IF THE UNIT IS NOT ASSOCIATED WITH A SYMBIONT FILE THE SYSTEM C DEPENDENT INFORMATION IS EXAMINED. IF THERE IS NONE, THE UNIT C IS ASSUMED TO BE ASSOCIATED WITH AN SDF FILE, AND THE FILE IS C READ FROM THE BEGINNING (SECTOR ZERO IF DISK). IF THE SYSTEM C DEPENDENT INFORMATION BEGINS WITH A + SIGN, THE FILE IS READ C FROM THE CURRENT POSITION. OTHERWISE, THE SYSTEM DEPENDENT C INFORMATION IS TREATED AS A FILE/ELEMENT SPECIFICATION. C 110 WORKS(1,REASON)=0 IF (NTABDC(NUMBER).GE.32) GO TO 150 @ CHECK DEVICE CODE. WORKS(1,REASON)=FILES(1,REASON) WORKS(2,REASON)=FILES(2,REASON) IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 140 IF (HOLCMD(EQUAL).NE.PLUS) GO TO 120 N=AND(WORKS(10,REASON),RHW) @ BUFFER IMAGE LOCATOR IF (WORKS(6,REASON)+N.EQ.0) GO TO 140 I=223-(N-AND(WORKS(7,REASON),RHW)) @ REMAINING SPACE I=MOD(I,28) @ REM SPACE IN SECTOR OR EOF N=N-LOC(DUMMY)+1 @ CHANGE N FROM ADDR TO SUBSCR. C IF EOF ICW (S1=077) CHANGE TO BYPASS ICW (S1=040, S2=LENGTH). IF (AND(DUMMY(N),IEOF).EQ.IEOF) DUMMY(N)=BYPASS+2**24*I GO TO 220 C C OPEN AN SDF ELEMENT TO READ C 120 IF (ELTS(1,REASON).NE.FDBLNK) GO TO 150 WRITE (PRINTR,130) (HOLCMD(I),I=1,NCHCMD) 130 FORMAT (//'0NO ELEMENT NAME, TREAT AS FILE.'/(1X,80A1)) NERRG=MAX0(NERRG,5) 140 ELTS(1,REASON)=0 150 N=EORSRO(WORKS(1,REASON),ELTS(1,REASON),VERS(1,REASON)) IF (N.EQ.0) GO TO 220 call exchm2 (n,works(3,reason)) WRITE (PRINTR,160) (HOLCMD(I),I=1,NCHCMD) 160 FORMAT (' WHILE OPENING INPUT ELEMENT OR FILE. NOT OPENED.'/(1X,8 10A1)) GO TO 220 C C OPEN INTAPE OR OUTAPE. C C ASSIGN FILE IF NOT ASSIGNED 170 CALL EXCHIO (FILES(1,REASON),0,0,0,0) PFS(10,REASON-5)=0 PFS(11,REASON-5)=0 IF (EQUAL.GT.NCHCMD.OR.EQUAL.EQ.0) GO TO 220 DO 180 I=1,2 PFS(I,REASON-5)=FILES(I,REASON) PFS(I+2,REASON-5)=ELTS(I,REASON) 180 PFS(I+6,REASON-5)=VERS(I,REASON) PFS(6,REASON-5)=2**18*7 @ OMN ELEMENT IF (REASON.GT.6) GO TO 200 C C OPEN INTAPE ELEMENT. C CALL PFSER (PFS(1,1),I) IF (I.EQ.0) GO TO 220 I=I+32 call exchm2 (i,0) WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (' WHILE OPENING INTAPE. NOT OPENED.'/(1X,80A1)) INTAPE=0 GO TO 220 C C OPEN OUTAPE ELEMENT. C 200 CALL PFWLER (PFS(1,2),PFS(11,2),I) PFS(10,2)=PFS(11,2) IF (I.EQ.0) GO TO 220 I=I+32 call exchm2 (i,0) WRITE (PRINTR,210) (HOLCMD(I),I=1,NCHCMD) 210 FORMAT (' WHILE TRYING TO OPEN OUTAPE. NOT OPENED.'/(1X,80A1)) OUTAPE=0 ELTS(1,7)=FDBLNK C 220 RETURN C END @HDG,P EXCHC2 @FTN,SVI EXCHC2 SUBROUTINE EXCHC2 C C PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KINDE /32/ DATA KOPTI /14/ DATA KSITE /25/ C C FIGURE OUT WHICH COMMAND GOT US HERE. C IF (ICOMD-KOPTI) 60,150,10 10 IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270 C C ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT C WHERE C1, C2, STEP AND START ARE INTEGERS. C STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP, C START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF C CHARACTERS OF TEXT IN IDTXTL. IF AN ERROR OCCURS, C STORE ZERO IN IDSTEP AND IDTXTL. C IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO. C C STORE THE MODIFIER IN IDOPTN. C IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE C PRODUCED ONLY FOR IMAGES FROM INTAPE. IF THE O MODIFIER C IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES C WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT. IF THE F C MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION C OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE C PRODUCED FOR ALL IMAGES OUTPUT. IF THE C MODIFIER IS SPECIFIED, C SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH C RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR C ALL IMAGES OUTPUT. IF NONE OF THE I, F, OR C MODIFIERS ARE C SPECIFIED, THE O MODIFIER IS ASSUMED. C C IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED. C IF IDTXTL = ZERO, TEXT IS NOT EMITTED. C IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE C EMITTED. C C CONVERT C1,C2,STEP,START C IDOPTN=MODIFY IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79 C 70 = ASCII F, 73 = ASCII I, 79 = ASCII O. DO 40 J=1,4 NUMBER=0 20 IF (EQUAL.GT.NCHCMD) GO TO 40 IF (COMAND(EQUAL).EQ.44) GO TO 30 C 44 = ASCII , I=COMAND(EQUAL)-48 IF (I.LT.0) GO TO 350 IF (I.GT.9) GO TO 350 NUMBER=10*NUMBER+I EQUAL=EQUAL+1 GO TO 20 30 EQUAL=EQUAL+1 40 IDNBRS(J)=NUMBER IDCUR=IDSTRT IDCOL1=MAX0(1,MIN0(IDCOL1,178)) IDCOL2=MIN0(IDCOL2,178) C C STORE TEXT. C IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0) IF (IDTXTL.EQ.0) GO TO 330 DO 50 J=1,IDTXTL IDTEXT(J)=COMAND(EQUAL) 50 EQUAL=EQUAL+1 GO TO 330 C C INDEX = PARAMETER STRING C 60 J=0 IF (COMAND(EQUAL).NE.45) GO TO 70 C 45 = ASCII - J=-1 EQUAL=EQUAL+1 70 N=0 DO 80 I=1,26 80 INDEXS(I)=0 90 IF (EQUAL.GT.NCHCMD) GO TO 130 I=COMAND(EQUAL)-64 IF (I.EQ.-32) GO TO 120 C 32 = ASCII BLANK. IF (I.GE.32) I=I-32 C CONVERT TO UPPER CASE. IF (I.LE.0) GO TO 100 IF (I.LE.26) GO TO 110 100 N=EQUAL GO TO 120 110 INDEXS(I)=1 120 EQUAL=EQUAL+1 GO TO 90 130 INDEX=0 DO 140 I=1,26 INDEXS(I)=IABS(INDEXS(I)+J) 140 INDEX=INDEX+INDEXS(I) IF (MODIFY.EQ.76) INDEX=-INDEX C 76 = ASCII L. IF (N) 340,330,340 C C OPTION = PARAMETER STRING C 150 IF (MODIFY.NE.0) GO TO 170 DO 160 I=1,26 160 OPTVAL(I)=0 170 IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330 I=1 IF (MODIFY.EQ.67) I=0 C 67 = ASCII C. N=0 DO 190 J=EQUAL,NCHCMD K=COMAND(J) IF (K.GE.96) K=K-32 C CONVERT TO UPPER CASE. IF (K.EQ.32) GO TO 190 C 32 = ASCII BLANK IF (K.LT.65) GO TO 180 IF (K.GT.90) GO TO 180 C PROCESS ALPHABETIC OPTIONS. OPTVAL(K-64)=I GO TO 190 180 N=J 190 CONTINUE IF (N) 330,330,340 C C PROCESS PRED = ID REC A/X MASK STRING C WHERE ID = PREDICATE IDENTIFIER (A-H), C REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE, C A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH C IN EXACT POSITION, C MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE C TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED. C STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF C CONTROL RECORDS. C C THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR C PREDICATE A, ETC. C C PRED(1,*)=LENGTH OF STRING + 3 C PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED. C PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND). C PRED(3,*)=RECORD TYPE. C PRED(4,*)=A/X C PRED(5,*)=MASK CHARACTER. C PRED(6..42,*)=STRING. C 200 IF (EQUAL.NE.0) GO TO 240 C LIST ALL ACTIVE PREDICATES. DO 230 I=1,8 IF (PRED(1,I).EQ.0) GO TO 230 J=PRED(1,I)+1 COMAND(1)=I+64 DO 210 K=2,J 210 COMAND(K)=PRED(K+1,I) CALL EXCHAH (COMAND,J) WRITE (PRINTR,220) (COMAND(K),K=1,J) 220 FORMAT (6H PRED=,42A1) 230 CONTINUE GO TO 330 C SAVE PREDICATE IF VALID. 240 IF (NCHCMD.LE.EQUAL+3) GO TO 370 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.GT.72) GO TO 360 C 72 = ASCII H NUMBER=J-64 PRED(1,NUMBER)=0 EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.GT.90) GO TO 360 C 90 = ASCII Z IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.EQ.82) GO TO 360 C 82 = ASCII R PRED(3,NUMBER)=J EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.NE.65.AND.J.NE.88) GO TO 360 C 65 = ASCII A, 88 = ASCII X PRED(4,NUMBER)=J EQUAL=EQUAL+1 PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40) I=4 DO 250 J=EQUAL,NCHCMD I=I+1 IF (I.GT.42) GO TO 330 K=COMAND(J) IF (K.GT.96) K=K-32 C CONVERT TO UPPER CASE. 250 PRED(I,NUMBER)=K GO TO 330 C C SITE = SITE NAME C 260 JUMP=1 GO TO 280 C C TITLE = OUTPUT TAPE TITLE C 270 JUMP=2 280 K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 320 I=1,40 IF (K.GT.NCHCMD) GO TO 290 J=COMAND(K) K=K+1 GO TO 300 290 J=32 C 32 = ASCII BLANK. 300 IF (JUMP.EQ.2) GO TO 310 SITE(I)=J GO TO 320 310 TITLE(I)=J 320 CONTINUE C C RETURN TO COMMAND DECODER. C 330 TRANS=1 GO TO 390 C C ERROR MESSAGES C 340 NUMBER=14 C MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED. EQUAL=N GO TO 380 350 IDSTEP=0 IDTXTL=0 360 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED. GO TO 380 370 NUMBER=30 C MESSAGE 30 - COMMAND IS INCOMPLETE. C 380 TRANS=8 C 390 RETURN C END @HDG,P EXCHC3 @FTN,SVI EXCHC3 SUBROUTINE EXCHC3 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE C COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES. C C OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE C NAME COMMAND. C C OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING C COPY, NAME OR UPDATE COMMANDS. C C ID IS USED TO CONSTRUCT THE OUTPUT LABEL. INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/ C A N G E DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/ DATA KNAME /9/ DATA KSKIP /26/ C C OPEN INTAPE IF NECESSARY C IF (INTOPN.NE.0) GO TO 70 IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300 IF (INTAPE.EQ.OUTAPE) GO TO 360 CALL EXCHRH (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 310 INTOPN=1 C COPY THE LABEL TO A SAVE AREA. DO 10 I=1,180 10 LABELI(I)=CBLCKI(I) CALL EXCHAH (CBLCKI(13),138) WRITE (PRINTR,20) 20 FORMAT (25H0INPUT LABEL INFORMATION.) WRITE (PRINTR,30) (CBLCKI(I),I=13,104) 30 FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/ 1 20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1) IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150) 40 FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1) WRITE (PRINTR,50) NDATAI 50 FORMAT (28H DATA CHARACTERS PER BLOCK =,I6) IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI 60 FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6) CHAR1L=0 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 290 70 IF (ICOMD.EQ.KSKIP) GO TO 270 C C OPEN OUTAPE IF NECESSARY C 80 IF (ICOMD.EQ.0) GO TO 90 IF (ICOMD.LT.KNAME) GO TO 100 90 IF (INTAPE*OUTAPE.EQ.0) GO TO 100 IF (OUTUPD.NE.85) GO TO 370 C 85 = ASCII U. 100 IF (OUTOPN.NE.0) GO TO 240 IF (OUTAPE.EQ.0) GO TO 240 C CONSTRUCT THE OUTPUT LABEL. IF (TODAY(1).EQ.0) GO TO 340 IF (INTOPN.EQ.0) GO TO 160 DO 110 I=1,180 110 CBLCKO(I)=LABELI(I) IF (TITLE(1).EQ.32) GO TO 130 C 32 = ASCII BLANK DO 120 I=1,40 120 CBLCKO(I+18)=TITLE(I) 130 IF (OUTUPD.NE.85) GO TO 220 C 85 = ASCII U. IF (SITE(1).EQ.0) GO TO 350 DO 140 I=1,6 140 CBLCKO(I+104)=TODAY(I) DO 150 I=1,40 150 CBLCKO(I+110)=SITE(I) GO TO 220 160 IF (TITLE(1).EQ.32) GO TO 330 C 32 = ASCII BLANK IF (SITE(1).EQ.0) GO TO 350 IF (INTAPE*OUTAPE.EQ.0) GO TO 170 IF (INTAPE.EQ.OUTAPE) GO TO 360 170 DO 180 I=1,8 180 CBLCKO(I)=ID(I) DO 190 I=1,40 CBLCKO(I+18)=TITLE(I) 190 CBLCKO(I+64)=SITE(I) DO 200 I=1,6 200 CBLCKO(I+58)=TODAY(I) DO 210 I=105,180 210 CBLCKO(I)=0 220 CALL EXCHWH (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 320 OUTOPN=1 CBLCKO(1)=CBLCKO(105) CALL EXCHAH (CBLCKO(13),138) WRITE (PRINTR,230) WRITE (PRINTR,30) (CBLCKO(I),I=13,104) 230 FORMAT (26H0OUTPUT LABEL INFORMATION.) IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150) WRITE (PRINTR,50) NDATAO IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO CHAR1L=0 240 IF (ICOMD-KNAME) 250,260,280 C C COPY C 250 TRANS=4 MODEI=1-MIN0(1,OUFILE+OPTL) IF (ICOMD.EQ.0) MODEI=0 GO TO 390 C C NAME C 260 TRANS=5 IF (NRWORK.EQ.0) PHASE=4 GO TO 390 C C SKIP C 270 TRANS=4 GO TO 390 C C UPDATE C 280 TRANS=5 MODEI=0 GO TO 390 C C ERROR MESSAGES C 290 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. EQUAL=ISTAT GO TO 380 300 NUMBER=4 C MESSAGE 4 - INTAPE NOT DEFINED. GO TO 380 310 NUMBER=5 C MESSAGE 5 - UNABLE TO OPEN INTAPE. EQUAL=ISTAT GO TO 380 320 NUMBER=6 C MESSAGE 6 - UNABLE TO OPEN OUTAPE. EQUAL=ISTAT GO TO 380 330 NUMBER=7 C MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE. GO TO 380 340 NUMBER=8 C MESSAGE 8 - DATE NOT SUPPLIED. GO TO 380 350 NUMBER=9 C MESSAGE 9 - SITE NOT SUPPLIED. GO TO 380 360 NUMBER=10 C MESSAGE 10 - INTAPE = OUTAPE. GO TO 380 370 NUMBER=11 C MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED. 380 TRANS=8 C C RETURN TO TRANSITION PROGRAM C 390 RETURN C END @HDG,P EXCHRH @FTN,SVI EXCHRH SUBROUTINE EXCHRH (ISTAT,DBLOCK) C C READ THE HEADER LABEL FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE C NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C OPEN THE INPUT TAPE. C ISTAT=1 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C READ A BLOCK. C NDATAI=171 NERRCI=0 BLKSQI=0 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C FIND OUT IF IT IS A PROPER LABEL. C CALL EXCHUN (DBLOCK,CBLCKI) DO 10 I=1,8 IF (CBLCKI(I).NE.ID(I)) GO TO 20 10 CONTINUE C C GET READY TO READ THE REST OF THE TAPE. C CCDBI=NCDBI NDATAI=256*CBLCKI(9)+CBLCKI(10) NERRCI=256*CBLCKI(11)+CBLCKI(12) LASTI=0 L1PRGI=0 ISTAT=0 GO TO 30 C C NOT A LABEL. C 20 ISTAT=6 C C CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK. 25 I=4 CALL EXCHRT (I,DBLOCK) C 30 RETURN C END @HDG,P EXCHWH @FTN,SVI EXCHWH SUBROUTINE EXCHWH (ISTAT,DBLOCK) C C WRITE A HEADER ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE C WRITTEN ARE NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C MAKE SURE IT IS A PROPER LABEL. C DO 10 I=1,8 IF (CBLCKO(I).NE.ID(I)) GO TO 30 10 CONTINUE C C OPEN THE OUTPUT TAPE. C ISTAT=1 CALL EXCHWT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 40 C C CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR C CONTROL CHARACTERS C CBLCKO(9)=NDATAO/256 CBLCKO(10)=MOD(NDATAO,256) CBLCKO(11)=NERRCO/256 CBLCKO(12)=MOD(NERRCO,256) C C INSERT TODAYS DATE C DO 20 I=1,6 20 CBLCKO(I+12)=TODAY(I) C C WRITE THE BLOCK ON TAPE. C BLKSQO=0 CALL EXCHPA (CBLCKO,DBLOCK) CCDBO=180 ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C GET READY TO WRITE THE REST OF THE FILE. C L1PRGO=0 LLPRGO=0 N1RECO=0 NLRECO=0 L1RECO=0 LASTO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 GO TO 40 C C NOT A PROPER LABEL. C 30 ISTAT=6 C 40 RETURN C END @HDG,P EXCHC4 @FTN,SVI EXCHC4 SUBROUTINE EXCHC4 (IBLOCK) INTEGER IBLOCK(1) C C PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM C COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KCOPY /3/ C C ARE WE STARTING OR CONTINUING? C C ICOMD.EQ.0 MEANS CHANGE A CONTROL RECORD C ICOMD.GT.0 MEANS SKIP OR COPY COMMAND BEGIN C ICOMD.EQ.-1 MEANS CONTINUE COPY = NUMBERS C ICOMD.EQ.-2 MEANS CONTINUE COPY = PREDICATE EXPRESSION NEWP=0 IF (ITYPEI.EQ.80) VERT=0 C 80 = ASCII P. WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO C IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON C THE WORK FILE. IF (ICOMD.EQ.0) GO TO 190 C ICOMD=0 MEANS CHANGING A CONTROL RECORD. IF (ICOMD+1) 290,170,10 10 IF (ICOMD.EQ.KCOPY) GO TO 30 C C SKIP COMMAND. C IF (INTOPN.LT.0) GO TO 430 if (modify.eq.70) number=number+n1reci-1 c 70 = ASCII F. IF (NUMBER+1-N1RECI) 540,430,20 20 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.EQ.69) GO TO 460 C 69 = ASCII E. IF (N1RECI-NUMBER) 20,20,430 C C COPY COMMAND FORMAT VERIFICATION. C 30 IF (COMAND(EQUAL).LT.48) GO TO 180 C 48 = ASCII ZERO IF (COMAND(EQUAL).GT.57) GO TO 180 C 57 = ASCII NINE C C COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS. C CONVERT THE NUMBERS AND STORE THEM IN COMAND. IF THE NUMBER C IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER. C ICOMD=-1 I=0 J=44 C 44 = ASCII COMMA 40 I=I+1 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 480 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=NUMBER 50 EQUAL=EQUAL+1 IF (EQUAL.GT.NCHCMD) GO TO 60 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 60 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=10*COMAND(I)+NUMBER GO TO 50 60 IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70 70 IF (J.EQ.45) COMAND(I)=-COMAND(I) C 45 = ASCII DASH IF (EQUAL.GT.NCHCMD) GO TO 90 J=COMAND(EQUAL) IF (J.EQ.32 .OR. J.EQ.46) GO TO 90 C 32 = ASCII BLANK, 46 = ASCII PERIOD. IF (J.NE.44.AND.J.NE.45) GO TO 480 C 44 = ASCII COMMA, 45 = ASCII DASH 80 EQUAL=EQUAL+1 IF (COMAND(EQUAL)-32) 40,80,40 C 32 = ASCII BLANK 90 NUMBER=I C FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE C POSITION IN COMAND CURRENTLY BEING EXAMINED. EQUAL=-1 100 EQUAL=EQUAL+1 IF (EQUAL.GE.NUMBER) GO TO 470 IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100 IF (EQUAL.EQ.0) GO TO 120 WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD) 110 FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H) 1NOT COPIED./(1X,80A1)) NERRG=MAX0(NERRG,5) 120 IF (COMAND(EQUAL+1).GT.0) GO TO 130 EQUAL=EQUAL-1 COMAND(EQUAL+1)=N1RECI 130 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. C C PROCESS COPY = LIST OF NUMBERS C 140 EQUAL=EQUAL+1 C GO COPY THE PROGRAM IF IT IS THE RIGHT ONE. 150 IF (INTOPN.LT.0) GO TO 430 IF (COMAND(EQUAL)-N1RECI) 170,420,160 C SKIP TO DESIRED PROGRAM 160 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI-69) 150,460,150 C 69 = ASCII E 170 IF (EQUAL.GE.NUMBER) GO TO 430 IF (COMAND(EQUAL+1).GE.0) GO TO 140 COMAND(EQUAL)=IABS(COMAND(EQUAL))+1 IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420 EQUAL=EQUAL+1 GO TO 170 C C COPY = SELECTION STRING OR CHANGE CONTROL RECORD. C 180 ICOMD=-2 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. NRWORK=-1 C C DETERMINE NEED TO OPEN WORK FILE. C 190 IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0) 1IF (ICOMD) 290,430,290 IF (WORKF.EQ.0) GO TO 500 I=IABS(WORKF) IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510 IF (WORKF.GT.0) GO TO 200 WORKF=I CALL EXCHFO (3) 200 IF (ICOMD.NE.0) GO TO 280 C C CHANGE CONTROL RECORD. C if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520 c 69 = ascii E, 73 = ascii I. if (nrwork.eq.0) go to 210 if (itypei.eq.80) go to 520 c 80 = ascii P 210 IF (NUMBER-NRWORK-1) 530,220,410 220 NCHACT=NCHCMD+1-EQUAL IF (NCHACT.GT.0) GO TO 230 NCHACT=1 INTREC(1)=32 C 32 = ASCII BLANK GO TO 425 230 DO 240 I=1,NCHACT 240 INTREC(I)=COMAND(EQUAL+I-1) GO TO 425 C C COPY = SELECTION EXPRESSION. C C SKIP TO NEXT PROGRAM. 250 IF (INTOPN.LT.0) GO TO 430 if (itypei.eq.69) go to 460 c 69 = ASCII E. do 260 i = 1, 8 260 pred(2,i)=0 if (itypei.ne.80) go to 265 c If the current record is a new program, don't skip it (we haven't c processed it yet). if (nrwork.gt.0 .and. workf.gt.0) rewind workf nrwork=min0(nrwork,0) newp=0 go to 320 265 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 nxnewp=0 270 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.NE.80) GO TO 310 C 80 = ASCII P NEWP=nxnewp c Set NEWP non-zero when all control records for a module have been c seen. GO TO 320 280 NRWORK=MAX0(NRWORK,0) 290 DO 300 I=1,8 300 PRED(2,I)=0 c NEWP is non-zero when all control records have been read. 310 if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1 C 69 = ASCII E, 73 = ASCII I. 320 nxnewp=1 if (icomd.eq.0) if (newp) 520,210,520 IF (LIMIT.EQ.0) GO TO 340 IF (N1RECI.LE.LIMIT) GO TO 340 WRITE (PRINTR,330) LIMIT 330 FORMAT (7H LIMIT=,I6,9H REACHED.) GO TO 430 340 IF (NEWP.EQ.0) GO TO 360 CALL EXCHLX C EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'. NUMBER=NCHCMD IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415 C 73 = ASCII I. IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425 C 80 = ASCII P. IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425 C 83 = ASCII S. IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415 C 88 = ASCII X. IF (COMAND(180)) 450,250,420 C CONTROL RECORD. EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE. 360 I=1 DO 400 NUMBER=1,8 IF (PRED(1,NUMBER).EQ.0) GO TO 400 IF (PRED(2,NUMBER).NE.0) GO TO 400 IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390 NM=PRED(1,NUMBER)-3 IF (.NOT.(NCHACT.GT.0)) GO TO 390 DO 385 L = 1, NCHACT DO 380 J = 1, NM C C DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND C IN PREDICATE. IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380 IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370 C C NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS. K=32 GO TO 375 C USE CHARACTER FROM CONTROL RECORD. 370 K=INTREC(J+L-1) C C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (K.GT.96 .AND. K.LT.123) K=K-32 C C TEST FOR A MATCH ON A SINGLE CHARACTER. C IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE C PATTERN. IF THE SEARCH MODE IS X, TERMINATE THE SEARCH. 375 IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390 380 CONTINUE C C FOUND A MATCH IN CONTROL RECORD AND PREDICATE. PRED(2,NUMBER)=1 GO TO 400 385 CONTINUE 390 I=0 400 CONTINUE IF (I.NE.0) newp=1 IF (NRWORK.LT.0) GO TO 270 C AT LEAST ONE FALSE PREDICATE. WRITE THE CONTROL RECORD ON WORKF. 410 WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT) NRWORK=NRWORK+1 GO TO 270 C C GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM. C 415 ICOMD=-3 C RETURN TO EXCHC1 AFTER COPYING MODULE. 420 TRANS=5 GO TO 570 C C RETURN TO THE COMMAND PROCESSOR. C 425 TRANS=1 C REMEMBER CONTROL RECORDS ON WORKF. GO TO 570 430 TRANS=1 IF (ICOMD+1) 560,570,570 C C ERROR MESSAGES. C 440 NUMBER=1 C MESSAGE 1 - I/O ERROR. EQUAL=ISTAT GO TO 550 450 NUMBER=-COMAND(180) C MESSAGES GENERATED BY EXCHLX GO TO 550 460 IF (INTOPN.LT.0) GO TO 430 INTOPN=-1 EQUAL=NUMBER NUMBER=15 C MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE. GO TO 550 470 NUMBER=16 C MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION. GO TO 550 480 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER GO TO 550 490 NUMBER=18 C MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER. GO TO 550 500 NUMBER=19 C MESSAGE 19 - WORK FILE NOT DEFINED. GO TO 550 510 NUMBER=20 C MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE. GO TO 550 520 EQUAL=NUMBER NUMBER=21 C MESSAGE 21 - CONTROL RECORD NOT PRESENT GO TO 550 530 NUMBER=22 C MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER. GO TO 550 540 NUMBER=29 C MESSAGE 29 - BACKWARD SKIP IGNORED. C C RETURN TO THE ERROR MESSAGE PROCESSOR. C 550 TRANS=8 IF (ICOMD.EQ.0) GO TO 570 C C DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF. C 560 IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) C C RETURN TO TRANSITION PROGRAM. C 570 RETURN C END @HDG,P EXCHLX @FTN,SVI EXCHLX SUBROUTINE EXCHLX C C EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND. C C THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE C STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM C COPY=LOGICAL EXPRESSION. THE LOGICAL EXPRESSION CONSISTS OF THE C EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY C OPERATORS + - * / AND PARENEHESES. THE PRIMARY SYMBOLS A-H ARE C LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE C STATEMENTS. THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE C NULL PREDICATE, WHICH IS ALWAYS FALSE. THE OPERATORS + - * / ARE C THE BINARY LOGICAL OPERATIONS OR, OR NOT, AND, AND NOT C RESPECTIVELY. THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE C PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL C PRIORITY. THE RELATIVE PRIORITY MAY BE CHANGED BY USING C PARENTHESES. C C WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY C FALSE. AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL C FALSE PREDICATES IS DETERMINED. ONCE TRUE, A PREDICATE REMAINS C TRUE. THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND C A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE. WHEN ALL ACTIVE C PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM C HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND C IS EVALUATED. IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED. C IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED. THIS PROCESS C CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM C NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED. C C THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE C TABLE BELOW. INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS C APPENDED TO THE END OF THE LOGICAL EXPRESSION. C C PREVIOUS I CURRENT TOKEN I C TOKEN I + - * / I PRIMARY I ( I ) I ELSE I C ----------I---------I---------I---------I---------I---------I C + - * / I ERROR I OK I OK I ERROR I ERROR I C PRIMARY I OK I ERROR I ERROR I OK I ERROR I C ( I ERROR I OK I OK I OK I ERROR I C ) I OK I ERROR I ERROR I OK I ERROR I C ----------I---------I---------I---------I---------I---------I C C CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING C A STACK AND THE PRECEDENCE TABLE BELOW. TOS MEANS TOP-OF-STACK, C HOI MEANS HEAD-OF-INPUT. THE STACK INITIALLY CONTAINS (. C C TOS HOI C TOKEN I INDEX I INDEX I C ---------I---------I---------I C + - I 2 I 1 I C * / I 4 I 3 I C PRIMARY I 6 I 5 I C ( I 0 I 7 I C ) I N/A I 0 I C ---------I---------I---------I C C WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS C PUSHED ONTO THE STACK. WHEN THE TOS INDEX IS GREATER THAN THE HOI C INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY C SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT C PLACED IN THE SUFFIX LIST. THEN THE RELATION OF THE TOS INDEX TO C THE HOI INDEX IS RE-EXAMINED. WHEN THE TOS INDEX IS EQUAL TO THE C HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED. C C ***** INTERNAL VARIABLES ********************************* C C CHTAB RECOGNIZED CHARACTERS. INTERNAL PROCESSES USE THE INDEX C INTO CHTAB. C COLTAB CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX. C HOI CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE. C INFIX IS THE CURRENT POSITION IN THE INFIX. C IPREV IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN. C ISTACK IS THE CURRENT STACK INDEX. C ISUFIX IS THE CURRENT SUFFIX INDEX. C SYNTAX CONTAINS THE SYNTAX RULES. C TOS CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE. C INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15) C C ***** COMMON VARIABLES *********************************** C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** DATA STATEMENTS ************************************ C C A B C D DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/ C E F G H DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/ C N + - * DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/ C / ( ) DATA CHTAB(13),CHTAB(14),CHTAB(15) /47,40,41 / C A B C D DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/ C E F G H DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/ C N + - * DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/ C / ( ) DATA COLTAB(13),COLTAB(14),COLTAB(15) /1,3,4 / C A B C D E DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/ C F G H N + DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/ C - * / ( ) DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/ C CURRENT TOKEN IS +-*/. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/ C CURRENT TOKEN IS PRIM. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/ C CURRENT TOKEN IS (. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/ C CURRENT TOKEN IS ). NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/ C A B C D E DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/ C F G H N + DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/ C - * / ( ) DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/ C C ***** PROCEDURES ***************************************** C C COMAND IS USED FOR INFIX, STACK AND SUFFIX. UPON COMPLETION, C COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE C OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE C EXPRESSION IS TRUE. C ISTACK=NCHCMD+2 COMAND(ISTACK)=14 ISUFIX=181 IPREV=3 COMAND(NCHCMD+1)=41 INFIX=EQUAL-1 C C GET A CHARACTER FROM INFIX. LOOK UP IN CHTAB. CHECK SYNTAX. C 10 IF (INFIX.GT.NCHCMD) GO TO 180 INFIX=INFIX+1 J=COMAND(INFIX) IF (J.EQ.32) GO TO 10 C 32 = ASCII BLANK - IGNORE IT. IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. DO 20 I=1,15 IF (CHTAB(I).EQ.J) GO TO 30 20 CONTINUE GO TO 230 30 J=COLTAB(I) IF (SYNTAX(IPREV,J)-1) 40,190,200 C C CONVERT INFIX TO SUFFIX C 40 IPREV=J 50 J=COMAND(ISTACK) IF (TOS(J)-HOI(I)) 60,70,80 C PUSH INFIX ONTO STACK 60 ISTACK=ISTACK+1 COMAND(ISTACK)=I GO TO 10 C DELETE TOP OF STACK 70 ISTACK=ISTACK-1 IF (ISTACK.GT.NCHCMD+1) GO TO 10 IF (INFIX-NCHCMD) 220,220,250 C IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX. C IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX. 80 IF (J-9) 90,100,130 C PRIMARY IS SYMBOL A-H 90 IF (PRED(1,J).EQ.0) GO TO 210 J=PRED(2,J) GO TO 110 C NULL PREDICATE 100 J=0 110 ISUFIX=ISUFIX-1 120 COMAND(ISUFIX)=J ISTACK=ISTACK-1 GO TO 50 C OPERATOR 130 J=J-9 ISUFIX=ISUFIX+1 GO TO (140,150,160,170), J C + - * / 140 J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1) GO TO 120 150 J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1) GO TO 120 160 J=COMAND(ISUFIX)*COMAND(ISUFIX-1) GO TO 120 170 J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1)) GO TO 120 C 180 COMAND(180)=-23 C MESSAGE 23 - TOO MANY ( GO TO 240 190 COMAND(180)=-24 C MESSAGE 24 - MISSING PRIMARY GO TO 240 200 COMAND(180)=-25 C MESSAGE 25 - MISSING OPERATOR GO TO 240 210 EQUAL=CHTAB(J) CALL EXCHAH (EQUAL,1) COMAND(180)=-26 C MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE. GO TO 250 220 COMAND(180)=-27 C MESSAGE 27 - TOO MANY ) GO TO 240 230 COMAND(180)=-28 C MESSAGE 28 - UNRECOGNIZED CHARACTER C 240 EQUAL=INFIX 250 RETURN C END @HDG,P EXCHC5 @FTN,SVI EXCHC5 SUBROUTINE EXCHC5 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE, C AND INDEX IF SELECTED. COPY RECORDS FROM WORKF FIRST, IF ANY. C CREATE CONTROL RECORDS DEMANDED BY COMMANDS. C C THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF C THE PARAMETER STRING. C C AUTHOR C COMMENT C CONTROL (ITYPEO SET FROM MODIFY) C DATA TYPE C GROUPS C INSERT C KEYWORDS C MACHINE C ORIGIN C REFERENCES C REMOVE (FIRST CHARACTER OF PARAMETER STRING ONLY) C SIGNAL (FIRST CHARACTER OF PARAMETER STRING ONLY) C UPDATE C C IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS C ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A C CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND. C C ***** LOCAL VARIABLES ************************************ C C BLANK CONTAINS A HOLLERITH BLANK. INTEGER BLANK C C1 IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING. INTEGER C1 C COL1 THE FIRST COLUMN OF TEXT OF A CONTROL RECORD. DERIVED FROM C EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE. INTEGER COL1 C I,J USED FREELY AS INDICES. INTEGER I,J C KCONT THE INDEX IN COMD OF THE CONTROL COMMAND. INTEGER KCONT C KNAME IS THE INDEX IN COMD OF THE NAME COMMAND. INTEGER KNAME C KTEXT THE INDEX IN COMD OF THE TEXT COMMAND. INTEGER KTEXT C KUPDA THE INDEX IN COMD OF THE UPDATE COMMAND. INTEGER KUPDA C LIST CONTAINS THE WORD LIST IN ASCII. USED FOR THE A OPTION. INTEGER LIST(4) C NM IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED. INTEGER NM C NOUT IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED. INTEGER NOUT C NY IS THE PROGRAM NUMBER. IT IS THE NUMBER FROM INTAPE IF C OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE. INTEGER NY C ONE CONTAINS A HOLLERITH 1. INTEGER ONE C REASON REASON FOR COPYING A CONTROL RECORD. 1 = COPY COMMAND C PENDING. 2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8. C 3 = COMMAND. INTEGER REASON C RI CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A C GIVEN RECORD TYPE. RI IS SUBSCRIPTED BY (ITYPEO-64). INTEGER RI(26) C RT IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT. INTEGER RT(34) C STAR CONTAINS A HOLLERITH STAR. INTEGER STAR C ZERO CONTAINS A HOLLERITH ZERO. INTEGER ZERO C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL VARIABLE DATA ******************************** C DATA BLANK /1H / C L I S T DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/ C DATA KCONT /31/ DATA KNAME /9/ DATA KTEXT /27/ DATA KUPDA/29/ DATA ONE /1H1/ C A B C D E F DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/ C G H I J K L DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/ C M N O P Q R DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/ C S T U V W X DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/ C Y Z DATA RI(25),RI(26) /31,31 / C A C D G DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/ C P K DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/ C M O DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/ C B R DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/ C S DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/ C J DATA RT(31),RT(32),RT(33),RT(34) /-1, 0, 0,74/ C DATA STAR /1H*/ DATA ZERO /1H0/ C C ***** PROCEDURES ***************************************** C REASON=1 NY=N1RECI IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1 C ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P. C IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT. IF (PHASE.EQ.4) NY=0 C NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER. (IT IS PRINTED C IN THE INDEX). IF (ICOMD.LE.0) GO TO 10 IF (PHASE.GE.4) GO TO 100 IF (ICOMD.EQ.KNAME) GO TO 10 IF (ICOMD.NE.KUPDA) GO TO 100 REASON=2 PHASE=8 10 IF (NRWORK.GT.0) REWIND WORKF NM=0 NOUT=0 20 NM=NM+1 IF (NM.LE.NRWORK) GO TO 60 30 IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230 C 69 = ASCII E, 73 = ASCII I. IF (NOUT.EQ.0) GO TO 40 IF (ITYPEI.EQ.80) GO TO 230 C 80 = ASCII P. IF (NCHACT.NE.1) GO TO 40 IF (INTREC(1).EQ.32) GO TO 220 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 40 ITYPEO=ITYPEI NCHOUT=NCHACT DO 50 J=1,NCHOUT 50 OUTREC(J+5)=INTREC(J) GO TO 70 60 READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT) IF (NCHOUT.NE.1) GO TO 70 IF (NM.EQ.1) GO TO 70 IF (OUTREC(6).EQ.32) GO TO 200 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 70 NOUT=NOUT+1 J=RI(ITYPEO-64) DO 80 I=1,4 80 OUTREC(I)=COMD(I,J) OUTREC(5)=61 C 61 = ASCII = COL1=5 IF (J.NE.KCONT) GO TO 130 COL1=7 C CONTROL,*=... MOVE UP TWO CHARACTERS AND INSERT ITYPEO. DO 90 I=1,NCHOUT 90 OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I) OUTREC(5)=44 C 44 = ASCII COMMA. OUTREC(6)=ITYPEO OUTREC(7)=61 C 61 = ASCII = GO TO 130 100 IF (ICOMD.EQ.KTEXT) GO TO 240 COL1=EQUAL-1 NCHOUT=NCHCMD-COL1 NRWORK=NRWORK+1 C NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD. ITYPEO=RT(ICOMD) IF (ITYPEO.GT.0) GO TO 110 C PROCESS CONTROL,TYPE=TEXT COMMAND. ITYPEO=MODIFY IF (RI(ITYPEO-64).NE.KCONT) GO TO 320 110 NOUT=NRWORK REASON=3 DO 120 I=1,NCHCMD 120 OUTREC(I)=COMAND(I) 130 IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1) C 74 = ASCII J. IF (ITYPEO.EQ.80) VERT=0 C 80 = ASCII P IF (ITYPEO.NE.68) GO TO 150 C 68 = ASCII D IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150 DO 140 J=1,4 I=OUTREC(J+COL1) IF (I.GT.96 .AND. I.LT.123) I=I-32 C CONVERT TO UPPER CASE. IF (I.NE.LIST(J)) GO TO 150 140 CONTINUE VERT=1 C GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE. 150 CALL EXCHCG (OUTREC(COL1+1)) IF (OUTOPN.EQ.0) GO TO 160 CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1)) IF (ISTAT.NE.0) GO TO 340 NY=NLRECO 160 NCHOUT=NCHOUT+COL1 C TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER. OUTREC(180)=-NOUT IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC) C PRINT THE INDEX IF SELECTED. IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 1190 IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190 C1=BLANK C DOUBLE SKIP FOR PROGRAM HEADER (P). IF (ITYPEO.EQ.80) C1=ZERO IF (OPTV+VERT.NE.0) GO TO 170 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170 IF (CHAR1L.NE.ONE) C1=ONE CHAR1L=ONE 170 CALL EXCHAH (OUTREC,NCHOUT) WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT) 180 FORMAT (A1,2I5,1H*,(3X,105A1)) 190 IF (REASON.EQ.3) GO TO 310 200 IF (NM-NRWORK) 20,210,220 210 REWIND WORKF NRWORK=0 GO TO 30 220 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT) 330,30,330 230 IF (REASON.EQ.2) GO TO 300 240 IF (OUFILE.EQ.0) GO TO 260 DO 250 I=1,4 250 OUTREC(I)=COMD(I,KTEXT) OUTREC(180)=0 NCHOUT=0 C TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED. CALL EXCHCG (OUTREC) NCHOUT=4 ACTION=2-OPTC-OPTC C ACTION = 2 MEANS START OF PROGRAM. CALL EXCHOU (OUTREC) 260 IF (OPTV+VERT.NE.0) GO TO 280 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280 IF (OUTOPN.NE.0) NY=NLRECO I=BLANK IF (CHAR1L.NE.ONE) I=ONE WRITE (PRINTR,270) I,NY 270 FORMAT (A1,I5,1H*,8X,4HTEXT/) 280 CHAR1L=STAR NRWORK=MIN0(NRWORK,0) IF (IDOPTN.NE.67) IDCUR=IDSTRT C 67 = ASCII C IF (ICOMD.EQ.KTEXT) GO TO 290 C C WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL C RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED. C TRANS=6 GO TO 370 C C WORKING ON A TEXT STATEMENT. C 290 TRANS=7 GO TO 370 C C WORKING ON AN UPDATE STATMENT. C 300 NRWORK=NOUT GO TO 100 C C WRITING A SINGLE CONTROL RECORD. C 310 TRANS=1 GO TO 370 C C ERROR MESSAGES. C 320 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER. GO TO 360 330 NUMBER=1 GO TO 350 340 NUMBER=2 350 EQUAL=ISTAT 360 TRANS=8 C C RETURN TO TRANSITION PROGRAM. C 370 RETURN C END @HDG,P EXCHCG @FTN,SVI EXCHCG SUBROUTINE EXCHCG (RECORD) C C USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL. C WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED. C THIS IS THE PORTABLE VERSION. IT DOES NOT DO ANYTHING. C INTEGER RECORD(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C RETURN END @HDG,P EXCHC6 @FTN,SVI EXCHC6 SUBROUTINE EXCHC6 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE. C INTEGER KNAME,ONE,SVHCMD(180) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KNAME /9/ DATA ONE /1H1/ C LINEO=0 NERRS=0 C SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT. DO 5 I = 1,NCHCMD 5 SVHCMD(I)=HOLCMD(I) IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165 C 73 = ASCII I. IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE C A VOID MODULE. IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.EQ.7) GO TO 220 IF (ISTAT) 250,160,250 10 MODEO=MODEI ITYPEO=0 NBC=OPTL+OUFILE IF (INDEX.GT.0) NBC=1 20 NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTOPN.EQ.0) GO TO 120 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 260 C C CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD C INSTEAD OF BYTE-BY-BYTE). WE CAN DO A BLOCK COPY IF C WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT C FILE AND NOT PRINTING THE INDEX. ALSO, THE INPUT AND C OUTPUT CHARACTER POSITIONS MUST BE THE SAME. IF THE C PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH C THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE C CURRENT POSITION IN THE BYTE BUFFER BE THE SAME. C WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE C LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T C KNOW THE LOCATION OF THE END-OF-FILE RECORD. C IF (NBC.NE.0) GO TO 120 IF (CPCBI+1.NE.CPCBO) GO TO 120 IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120 C WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF. IF (L1PRGI.EQ.0) GO TO 25 IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30 25 IF (CCDBI+1.NE.CCDBO) GO TO 120 IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120 C WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE). C FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO. 30 LI=L1PRGI+NERRCI-1 IF (L1PRGI.NE.0) GO TO 40 LI=NERRCI+NDATAI+9 IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1 40 IF (CPCBI.GE.NCCBI) GO TO 50 IF (CCDBI.GE.LI) GO TO 160 CPCBI=CPCBI+1 CBLCKO(CPCBO)=CBLCKI(CPCBI) CPCBO=CPCBO+1 CCDBI=CCDBI+1 CCDBO=CCDBO+1 GO TO 40 C PACK COPIED BYTES. 50 CALL EXCHPA (CBLCKO,OBLOCK(CWDBO)) CPCBO=1 CPCBI=0 CWDBO=CWDBO+NWCBO CWDBI=CWDBI+NWCBI C NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM 60 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=L1RECI CALL EXCHPB (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 260 70 IF (CCDBI.LT.LI) GO TO 80 IF (L1PRGI.NE.0) GO TO 100 CALL EXCHGB (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 250 GO TO 30 80 NW=NWCBI*((LI-CCDBI)/NCCBI) IF (NW.EQ.0) GO TO 100 DO 90 I=1,NW OBLOCK(CWDBO)=IBLOCK(CWDBI) CWDBO=CWDBO+1 90 CWDBI=CWDBI+1 100 CCDBO=CCDBO+LI-CCDBI CCDBI=LI IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60 CPCBI=MOD(LI,NCCBI) CPCBO=MOD(CCDBO-1,NCCBO)+1 CALL EXCHUN (IBLOCK(CWDBI),CBLCKI) IF (CPCBI.EQ.0) GO TO 160 DO 110 I=1,CPCBI 110 CBLCKO(I)=CBLCKI(I) GO TO 160 C C END OF BLOCK COPY CODE. C 120 CALL EXCHTP (INTREC,LINEO) 160 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 250 IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20 C 73 = ASCII I. 165 IF (OPTL.NE.0) GO TO 180 IF (INDEX.LE.0) GO TO 195 WRITE (PRINTR,170) LINEO 170 FORMAT (I9,14H IMAGES COPIED) GO TO 200 180 WRITE (PRINTR,190) 190 FORMAT (1H1) 195 CHAR1L=ONE 200 IF (OUFILE.EQ.0) GO TO 210 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 210 IF (ITYPEI.EQ.69) GO TO 220 C 69 = ASCII E C C RETURN TO THE COPY CONTROL SEGMENT. C DO 215 I=1,NCHCMD 215 HOLCMD(I)=SVHCMD(I) IF (ICOMD.EQ.-3) GO TO 240 C ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE. TRANS=4 IF (ICOMD.NE.KNAME) GO TO 280 C MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME' C COMMAND SUBMITTED. GO PROCESS 'NAME' COMMAND. TRANS=5 PHASE=4 GO TO 280 C C END OF FILE ON INPUT TAPE. C 220 IF (INTOPN.LT.0) GO TO 240 WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD) 230 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1)) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 240 TRANS=1 GO TO 280 C C ERROR MESSAGES. C 250 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. GO TO 270 260 NUMBER=2 C MESSAGE 2 - I/O ERROR WRITING OUTAPE. 270 TRANS=8 EQUAL=ISTAT C C RETURN TO THE TRANSITION PROGRAM. C 280 IF (NERRS.EQ.0) GO TO 300 WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD) 290 FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./ 1(1X,80A1)) NERRG=MAX0(NERRS,NERRG) 300 RETURN C END @HDG,P EXCHC7 @FTN,SVI EXCHC7 SUBROUTINE EXCHC7 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40) C C PROCESS THE TEXT COMMAND. C C MSG IS USED TO PRINT A MESSAGE. INTEGER MSG(6,2) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/ DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/ DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/ DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/ DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/ C LINEI=1 LINEO=0 NERRS=0 INEND=0 CHAR1L=STAR C C SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND C K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 20 I=1,40 IF (K.GT.NCHCMD) GO TO 10 J=COMAND(K) K=K+1 GO TO 20 10 J=32 C 32 = ASCII BLANK. 20 TXDISK(I)=J IF (INTOPN.LE.0) ITYPEI=0 C C MAIN PROCESSING LOOP C 60 EDIT=0 70 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 80 C NCHCMD.LT.0 MEANS END OF FILE. IF (NCHCMD.LT.2) GO TO 100 IF (COMAND(1).NE.SIGNAL) GO TO 100 IF (COMAND(2).EQ.SIGNAL) GO TO 80 IF (COMAND(2).EQ.73) GO TO 370 IF (COMAND(2).EQ.105) GO TO 370 C 73,105 = ASCII I - REQUEST TO INCLUDE TEXT. IF (NCHCMD.LT.3) GO TO 100 IF (COMAND(2).NE.61) GO TO 100 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 70 C END OF TEXT FILE. 80 IF (INTEXT.EQ.0) GO TO 90 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE CALL EXCHIM INTEXT=0 NCHCMD=0 90 NCHCMD=MIN0(NCHCMD,0) IF (PHASE.NE.8) GO TO 660 IF (INEND) 660,630,660 100 IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110 110 IF (EDIT.EQ.0) GO TO 450 C C PARTIAL LINE EDITOR. C INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED. C EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES C THE FIRST NON-BLANK CHARACTER AFTER N2. N1 AND N2 ARE COLUMN C LIMITS UNDER WHICH TO PERFORM THE EDITING. N1 AND ,N2 ARE C OPTIONAL. IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT C LIMIT. IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS C ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE. WHEN C STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING C PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT C LENGTHS OF STRING1 AND STRING2. THE THIRD DELIMITER IS C OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED C AFTER STRING2 IS INSERTED. C IF (INEND.NE.0) GO TO 240 C CONVERT COLUMN NUMBERS. NBR1=0 NBR2=0 I=0 120 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.EQ.44) GO TO 150 C 44 = ASCII COMMA IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR1=10*NBR1+J-48 GO TO 120 130 WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD) 140 FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/ 1(1X,80A1)) NERRS=2 GO TO 70 150 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR2=10*NBR2+J-48 GO TO 150 C SCAN FOR DELIMITER 160 IF (J.NE.32) GO TO 170 C 32 = ASCII BLANK I=I+1 J=COMAND(I) GO TO 160 170 D1=I NBR1=MIN0(NBR1,180) NBR2=MIN0(NBR2,180) IF (NBR1.EQ.0) NBR1=1 IF (NBR2.EQ.0) GO TO 180 IF (NBR2.LT.NBR1) GO TO 130 180 I=I+1 IF (I.GT.NCHCMD) GO TO 130 IF (COMAND(I).NE.J) GO TO 180 D2=I D3=0 190 I=I+1 IF (I.GT.NCHCMD) GO TO 200 IF (COMAND(I).NE.J) GO TO 190 D3=I C LOOK FOR SEARCH STRING (STRING1) 200 NUMBER=D2-D1-1 J=NBR1 IF (NUMBER.EQ.0) GO TO 260 NY=NBR2 IF (NY.EQ.0) NY=NCHACT 210 DO 220 I=1,NUMBER IF (I+J-1.GT.NY) GO TO 240 IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230 220 CONTINUE GO TO 260 230 J=J+1 GO TO 210 240 WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1)) NERRS=2 GO TO 70 C FOUND SEARCH STRING. REPLACE WITH UPDATE STRING. 260 CHAR1L=PLUS IF (D3.NE.0) GO TO 300 C NO THIRD DELIMITER. REPLACE REST OF REGION. NY=NBR2 IF (NY.EQ.0) NY=180 D2=D2+1 IF (D2.GT.NCHCMD) GO TO 280 DO 270 I=D2,NCHCMD INTREC(J)=COMAND(I) J=J+1 IF (J.GT.NY) GO TO 280 270 CONTINUE 280 IF (NBR2.NE.0) GO TO 290 NCHACT=J-1 GO TO 70 290 IF (J.GT.NBR2) GO TO 70 INTREC(J)=32 C 32 = ASCII BLANK J=J+1 GO TO 290 C WE HAVE A THIRD DELIMITER. REPLACE ONLY THE SEARCH STRING. C SHIFT THE REST OF THE REGION AS NECESSARY. 300 NUMBER=(D3-D2)-(D2-D1) IF (NUMBER) 310,350,330 C SHIFT LEFT 310 I=J+D2-D1-1 NY=MIN0(NBR2,NCHACT) IF (NY.EQ.0) NY=NCHACT 320 IF (I.GT.NY) GO TO 350 INTREC(I+NUMBER)=INTREC(I) C NOTE - NUMBER .LT. 0 HERE INTREC(I)=32 C 32 = ASCII BLANK I=I+1 GO TO 320 C RIGHT SHIFT 330 I=NBR2 IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180) NY=J+NUMBER 340 IF (I.LT.NY) GO TO 350 INTREC(I)=INTREC(I-NUMBER) I=I-1 GO TO 340 C NO SHIFT NEEDED. 350 IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180) IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2) NY=NBR2 IF (NY.EQ.0) NY=NCHACT C MOVE UPDATE STRING (STRING2). 360 D2=D2+1 IF (D2.GE.D3) GO TO 70 INTREC(J)=COMAND(D2) J=J+1 IF (J-NY) 360,360,70 C C REQUEST TO INCLUDE TEXT. -I IN COLUMNS 1 AND 2. C 370 IF (EDIT.EQ.0) GO TO 390 WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD) 380 FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X 1,80A1)) NERRS=2 GO TO 70 390 ITYPEO=73 C 73 = ASCII I IF (NCHCMD.GE.4) GO TO 410 WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD) 400 FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A 11)) NERRS=2 GO TO 70 410 DO 420 I=4,NCHCMD IF (COMAND(I).NE.32) GO TO 430 420 CONTINUE C CONVERT TO UPPER CASE. WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM 430 K=0 DO 440 J=I,NCHCMD IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32 K=K+1 440 COMAND(K)=COMAND(J) NCHCMD=K GO TO 460 C C TEXT RECORD. C 450 ITYPEO=0 460 NCHOUT=NCHCMD IF (OUTOPN.EQ.0) GO TO 470 MODEO=0 CALL EXCHPR (ISTAT,OBLOCK,COMAND) IF (ISTAT.NE.0) GO TO 770 470 CALL EXCHTP (COMAND,0) GO TO 70 C C APPARENT CHANGE CONTROL COMMAND C 480 IF (INEND.EQ.0) GO TO 510 490 WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD) 500 FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT 1 END./(1X,80A1)) NERRS=1 GO TO 70 510 NUMBER=1 NBR1=0 EDIT=0 I=1 520 I=I+1 IF (I.GT.NCHCMD) GO TO 600 J=COMAND(I) IF (J.EQ.32) GO TO 600 C 32 = ASCII BLANK IF (EDIT.NE.0) GO TO 530 C EDIT CONTROL MUST BE BLANK AFTER $. IF (J.EQ.44) GO TO 570 C 44 = ASCII COMMA IF (J.EQ.36) GO TO 560 C 36 = ASCII $ IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.LE.57) GO TO 550 C 57 = ASCII 9 530 WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD) 540 FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1) NERRS=2 GO TO 60 550 NBR1=10*NBR1+J-48 GO TO 520 560 IF (NBR1.EQ.0) GO TO 530 EDIT=1 NBR1=NBR1-1 GO TO 520 570 NUMBER=2 NBR2=0 580 I=I+1 IF (I.GT.NCHCMD) GO TO 590 J=COMAND(I) IF (J.EQ.32) GO TO 590 C 32 = ASCII BLANK IF (IABS(J-44).EQ.1) GO TO 590 C 43 = ASCII +, 45 = ASCII - IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.GT.57) GO TO 530 C 57 = ASCII 9 NBR2=10*NBR2+J-48 GO TO 580 590 IF (NBR2.LT.NBR1) GO TO 530 NBR1=NBR1-1 600 IF (NBR1.GE.LINEI-1) GO TO 620 WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD) 610 FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1) NERRS=2 GO TO 60 620 IF (NCHCMD.LE.0) GO TO 630 IF (LINEI.LE.NBR1) GO TO 630 IF (NUMBER.EQ.1) GO TO 70 C SKIP INTAPE UNTIL NBR2 IS SKIPPED. MODEI=1 IF (LINEI.GE.NBR2) MODEI=0 IF (LINEI-NBR2) 650,650,70 C COPY FROM INTAPE UNTIL NBR1 COPIED. 630 MODEO=MODEI NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTAPE.EQ.0) GO TO 640 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 770 640 CALL EXCHTP (INTREC,LINEI) MODEI=0 IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650 IF (LINEI.EQ.NBR1) GO TO 650 MODEI=1 650 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 760 LINEI=LINEI+1 IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620 C 73 = ASCII I INEND=1 IF (NCHCMD.LE.0) GO TO 660 I=NBR2 IF (NUMBER.EQ.1) I=NBR1 IF (LINEI-I) 490,490,70 660 IF (NERRS.EQ.0) GO TO 675 J=1 IF (PHASE.EQ.8) J=2 WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS 670 FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.) 675 NERRG=MAX0(NERRG,NERRS) IF (OPTL+OPTS.NE.0) GO TO 690 IF (OUTAPE+OUFILE.EQ.0) LINEO=0 IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO 680 FORMAT (I9,14H IMAGES COPIED) GO TO 710 690 WRITE (PRINTR,700) 700 FORMAT (1H1) CHAR1L=ONE 710 IF (OUFILE.EQ.0) GO TO 720 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 720 IF (ITYPEI.NE.69) GO TO 750 C 69 = ASCII E C C END OF FILE ON INPUT TAPE (UPDATE MODE). C IF (INTOPN.LT.0) GO TO 750 DO 730 I=1,40 730 HOLCMD(I+1)=TXDISK(I) HOLCMD(1)=32 IF (TXDISK(1).NE.32) HOLCMD(1)=61 C 32 = ASCII BLANK, 61 = ASCII = CALL EXCHAH (HOLCMD,41) WRITE (PRINTR,740) (HOLCMD(I),I=1,41) 740 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 750 TRANS=1 GO TO 790 C C ERROR MESSAGES. C 760 NUMBER=1 GO TO 780 770 NUMBER=2 780 EQUAL=ISTAT TRANS=8 C C RETURN TO THE TRANSITION PROGRAM. C 790 PHASE=2 IF (OUTOPN.EQ.0) PHASE=1 RETURN C END @HDG,P EXCHC8 @FTN,SVI EXCHC8 SUBROUTINE EXCHC8 C C PRINT ERROR MESSAGES. C C ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE INTEGER S(31) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/ DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/ DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/ DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/ DATA S(29),S(30),S(31) /4,5,5 / C C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4 160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751), 2NUMBER C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 10 WRITE (PRINTR,20) EQUAL 20 FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.) GO TO 50 30 WRITE (PRINTR,40) EQUAL 40 FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.) 50 GO TO (60,80,100,120,140,160), EQUAL 60 WRITE (PRINTR,70) 70 FORMAT (22H BLOCK SEQUENCE ERROR.) GO TO 180 80 WRITE (PRINTR,90) 90 FORMAT (20H BLOCK IS TOO SHORT.) GO TO 180 100 WRITE (PRINTR,110) 110 FORMAT (11H I/O ERROR.) GO TO 180 120 WRITE (PRINTR,130) 130 FORMAT (18H RECORD TOO LARGE.) GO TO 180 140 WRITE (PRINTR,150) 150 FORMAT (21H UNKNOWN RECORD TYPE.) GO TO 180 160 WRITE (PRINTR,170) 170 FORMAT (25H FIRST BLOCK NOT A LABEL.) GO TO 760 180 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1) INFILE=0 C C RETURN TO QUIT SEGMENT. C TRANS=9 GO TO 800 C 200 WRITE (PRINTR,210) 210 FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.) GO TO 760 220 WRITE (PRINTR,230) 230 FORMAT (//20H0INTAPE NOT DEFINED.) GO TO 760 240 WRITE (PRINTR,250) 250 FORMAT (//23H0UNABLE TO OPEN INTAPE.) GO TO 10 260 WRITE (PRINTR,270) 270 FORMAT (//23H0UNABLE TO OPEN OUTAPE.) GO TO 30 280 WRITE (PRINTR,290) 290 FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.) GO TO 760 300 WRITE (PRINTR,310) 310 FORMAT (//19H0DATE NOT SUPPLIED.) GO TO 760 320 WRITE (PRINTR,330) 330 FORMAT (//19H0SITE NOT SUPPLIED.) GO TO 760 340 WRITE (PRINTR,350) INTAPE 350 FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4) GO TO 760 360 WRITE (PRINTR,370) 370 FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.) GO TO 760 380 WRITE (PRINTR,390) 390 FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.) GO TO 760 400 WRITE (PRINTR,410) 410 FORMAT (//27H0COMMAND HAS IMPROPER DATE.) GO TO 760 420 WRITE (PRINTR,430) EQUAL 430 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.) GO TO 780 440 WRITE (PRINTR,450) 450 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.) IF (ICOMD) 780,560,780 460 WRITE (PRINTR,470) N1RECI 470 FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO 1N (,I5,2H).) GO TO 760 480 WRITE (PRINTR,490) EQUAL 490 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 500 WRITE (PRINTR,510) 510 FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.) GO TO 760 520 WRITE (PRINTR,530) 530 FORMAT (//23H0WORK FILE NOT DEFINED.) GO TO 760 540 WRITE (PRINTR,550) 550 FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.) GO TO 760 560 WRITE (PRINTR,570) EQUAL 570 FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.) GO TO 760 580 WRITE (PRINTR,590) 590 FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE 1R.) GO TO 760 600 WRITE (PRINTR,610) 610 FORMAT (//12H0TOO MANY (.) GO TO 760 620 WRITE (PRINTR,630) EQUAL 630 FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.) GO TO 760 640 WRITE (PRINTR,650) EQUAL 650 FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.) GO TO 760 660 WRITE (PRINTR,670) EQUAL 670 FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.) GO TO 760 680 WRITE (PRINTR,690) EQUAL 690 FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.) GO TO 760 700 WRITE (PRINTR,710) EQUAL 710 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 720 WRITE (PRINTR,730) N1RECI 730 FORMAT (//21H0INTAPE POSITIONED AT,I5,25H. BACKWARD SKIP IGNORED. 1) GO TO 780 740 WRITE (PRINTR,750) 750 FORMAT (//23H0COMMAND IS INCOMPLETE.) GO TO 760 751 WRITE (PRINTR,752) 752 FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA 1PE OR OUTPUT.) 760 WRITE (PRINTR,770) 770 FORMAT (23H COMMAND NOT PROCESSED.) 780 WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD) 790 FORMAT ((1X,80A1)) C C RETURN TO COMMAND PROCESSSOR. C CHAR1L=0 NERRS=MAX0(S(NUMBER),NERRS) NERRG=MAX0(NERRG,NERRS) TRANS=1 C C RETURN TO TRANSITION PROGRAM. C 800 RETURN C END @HDG,P EXCHC9 @FTN,SVI EXCHC9 SUBROUTINE EXCHC9 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO C ERRORS. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KQUIT /20/ C IF (INFILE.EQ.0) GO TO 10 IF (MODIFY.NE.82) GO TO 5 C 82 = ASCII R ACTION=2 C ACTION = 2 MEANS REWIND INFILE. CALL EXCHIM 5 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. CALL EXCHIM INFILE=0 NCHCMD=0 GO TO 50 10 IF (OPTC*OUFILE.EQ.0) GO TO 20 ACTION=0 NCHOUT=4 CALL EXCHOU (COMD(1,KQUIT)) 20 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) IF (OUTOPN.EQ.0) GO TO 30 C WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (ISTAT,OBLOCK,OUTREC) C CLOSE THE INPUT TAPE. 30 IF (INTOPN.EQ.0) GO TO 40 ISTAT=4 CALL EXCHRT (ISTAT,OBLOCK) C C RETURN TO MAIN PROGRAM. C 40 TRANS=0 IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG 45 FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.) GO TO 60 C C RETURN TO THE COMMAND DECODER. C 50 TRANS=1 60 RETURN C END @HDG,P EXCHMAP @MAP,SI EXCHMAP,EXCH SEG MAIN IN EXCHMAIN,EXCHBD SEG EXCH$C1*,(MAIN) IN EXCHC1,EXCHCX SEG EXCH$C2*,(MAIN) IN EXCHC2 SEG EXCH$C3*,(MAIN) IN EXCHC3,EXCHRH,EXCHWH SEG EXCH$C4*,(MAIN) IN EXCHC4,EXCHLX SEG EXCH$C5*,(MAIN) IN EXCHC5,EXCHCG SEG EXCH$C6*,(MAIN) IN EXCHC6 SEG EXCH$C7*,(MAIN) IN EXCHC7 SEG EXCH$C8*,(MAIN) IN EXCHC8 SEG EXCH$C9*,(MAIN) IN EXCHC9 END =TES FILE=5 PROGRAM TES C======================== C EXCHANGE PROGRAMS C DISTRIBUTED BY W. VAN SNYDER, JET PROPULSION LABORATORY C C THIS IS THE MAIN PROGRAM FOR THE VAX/VMS V2.4 IMPLEMENTATIONS C C KAREN HASKELL, SNLA -- JUNE, 1982 C AND R.J. HANSON. C======================== C INTEGER IBLOCK(0900) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF CHARACTER*1 TABS CHARACTER*40 FNAMES(3) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES C NWCBI = 45 READER = 5 PRINTR = 6 C PROVIDE INITIAL CONDITIONS FOR SIMPLE PROGRAM. WORKF = 7 CALL EXCH (IBLOCK) STOP END BLOCK DATA C C BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/ DATA INTEXT /0/, INALT /0/ C DATA CHAR1L /1H1/ C A U T H DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1) /65,85,84,72/ C C O M M DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2) /67,79,77,77/ C C O P Y DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3) /67,79,80,89/ C D A T A DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4) /68,65,84,65/ C D A T E DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5) /68,65,84,69/ C G R O U DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6) /71,82,79,85/ C I N D E DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7) /73,78,68,69/ C I N P U DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8) /73,78,80,85/ C N A M E DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9) /78,65,77,69/ C I N T A DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/ C K E Y W DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/ C L I M I DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/ C M A C H DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/ C O P T I DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/ C O R I G DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/ C O U T A DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/ C O U T P DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/ C P R E D DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/ C P R I N DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/ C Q U I T DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/ C R E A D DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/ C R E F E DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/ C R E M O DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/ C R E W I DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/ C S I T E DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/ C S K I P DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/ C T E X T DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/ C T I T L DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/ C U P D A DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/ C W O R K DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/ C C O N T DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/ C I D E N DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/ C I N C L DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/ C S I G N DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/ C M A R G DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/ DATA IDSTEP /0/, IDTXTL /0/ DATA INDEX /0/ DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/ DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/ DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/ DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/ DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/ DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/ DATA INDEXS(25),INDEXS(26) /0,0 / DATA INTOPN /0/ DATA ITYPEI /0/ DATA LIMIT /0/ DATA MARGIN /180/ DATA NCCBI /180/ DATA NCCBO /180/ DATA NCHCMD /0/ DATA NCHMAX /180/ DATA NCOMDP /35/ DATA NCOMDT /35/ DATA NDATAO /3591/ DATA NERRCO /0/ DATA NERRG /0/ DATA NRWORK /0/ DATA OUTOPN /0/ DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/ DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/ DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/ DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/ DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/ DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/ DATA OPTVAL(25),OPTVAL(26) /0,0 / DATA PHASE /1/ C INDICATE THAT NO PREDICATES ARE DEFINED. DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/ DATA PRED(1,6),PRED(1,7),PRED(1,8) /0,0,0 / DATA SITE(1) /0/ DATA TITLE(1) /32/ C 32 = ASCII BLANK DATA TODAY (1) /0/ DATA TRANS /1/ END SUBROUTINE EXCH (IBLOCK) C C VAX/VMS INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM. C IT KNOWS HOW TO FETCH THE DATE FROM THE SYSTEM. C INTEGER IBLOCK(1) C C ALLOCATE SPACE FOR TAPE OUTPUT C INTEGER OBLOCK(0900) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF CHARACTER*1 TABS CHARACTER*40 FNAMES(3) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C INTEGER MKDTTD,MKDTOD C C MAKE DATE TENS DIGIT AND MAKE DATE ONES DIGIT. MKDTTD(M) = M/10 + 48 MKDTOD(N) = MOD(N,10) + 48 C NWCBO = 45 WORKF = 7 TABS='Y' C C THIS PRESET IS NEEDED SO THAT THE CORRECT OPEN C SEQUENCE IS DONE FOR THE PRINTER AT THE BEGINNING. NCHCMD=0 EQUAL=1 C GET THE DATE FROM THE SYSTEM. CALL IDATE(I,J,K) TODAY(1) = MKDTTD(K) TODAY(2) = MKDTOD(K) TODAY(3) = MKDTTD(I) TODAY(4) = MKDTOD(I) TODAY(5) = MKDTTD(J) TODAY(6) = MKDTOD(J) C C THE FOLLOWING SITE INFO. IS FOR SANDIA NATL. LABS. ONLY. C C SITE(1)=83 C SITE(2)=65 C SITE(3)=78 C SITE(4)=68 C SITE(5)=73 C SITE(6)=65 C SITE(7)=32 C SITE(8)=78 C SITE(9)=97 C SITE(10)=116 C SITE(11)=108 C SITE(12)=46 C SITE(13)=32 C SITE(14)=76 C SITE(15)=97 C SITE(16)=98 C SITE(17)=115 C SITE(18)=46 C SITE(19)=32 C SITE(20)=56 C SITE(21)=55 C SITE(22)=49 C SITE(23)=56 C SITE(24)=53 C SITE(25)=32 C SITE(26)=50 C SITE(27)=54 C SITE(28)=48 C SITE(29)=48 C SITE(30)=32 C SITE(31)=86 C SITE(32)=65 C SITE(33)=88 C DO 10 I=34,40 C 10 SITE(I)=32 C C END OF SANDIA LABS. SITE DEFN. C C DEFINE THE COMMAND 'TABS='. NCOMDT=NCOMDP+1 COMD(1,NCOMDT)=84 COMD(2,NCOMDT)=65 COMD(3,NCOMDT)=66 COMD(4,NCOMDT)=83 CALL EXCHTR (IBLOCK,OBLOCK) RETURN END SUBROUTINE EXCHAH (RECORD,NCHAR) C C CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO C HOLLERITH FORMAT. C INTEGER RECORD(1),NCHAR INTEGER BLANKZ,I DATA BLANKZ /'20202000'X/ C DO 10 I = 1, NCHAR 10 RECORD(I)=RECORD(I) + BLANKZ C RETURN END SUBROUTINE EXCHFO (IOP) C C VAX-11 USING VMS V2.4 C THIS VERSION IS FOR THE COMPREHENSIVE PROGRAM ONLY. C C OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM. C IOP LESS THAN ZERO MEANS CLOSE FILE, C IOP GREATER THAN ZERO MEANS OPEN FILE. C IABS(IOP) = 1 MEANS READER, C = 2 MEANS PRINTER, C = 3 MEANS WORK FILE, C = 4 MEANS INFILE. IOP = 4 IS USED ONLY BY THE C BOOTSTRAP PROGRAM. C C INTEGER IOP, JUMP CHARACTER*11 PNAME CHARACTER*40 NAME logical OD C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF DATA PNAME/'EXCHXX.LIS '/ C JUMP=IABS(IOP) IF (IOP.LT.0) GO TO (10,20,30), JUMP GO TO (50,60,70), JUMP C C CLOSE FILES. 10 GO TO 90 20 CLOSE (UNIT=PRINTR) GO TO 90 30 CLOSE (UNIT=WORKF) GO TO 90 C C OPEN FILES. 50 GO TO 90 60 CONTINUE K=MIN0(NCHCMD-EQUAL+1,40) IF(K.GT.0.AND.PRINTR.NE.6) THEN NAME=' ' DO 65 I=1,K NAME(I:I)=CHAR(COMAND(EQUAL+I-1)) 65 CONTINUE ELSE IF(PRINTR.EQ.6) THEN NAME='TT:' ELSE NAME=PNAME NAME(5:6)=CHAR(PRINTR/10+48)//CHAR(MOD(PRINTR,10)+48) END IF inquire (file=name,number=inum,opened=od) if (.not.od .or. (inum.ne.printr)) 1OPEN(UNIT=PRINTR,FILE=NAME,STATUS='UNKNOWN',ERR=100) GO TO 90 70 CONTINUE OPEN(UNIT=WORKF,DISP='DELETE',ERR=120,FORM= * 'UNFORMATTED',STATUS='UNKNOWN') C 90 RETURN C 100 print 110 110 FORMAT (' Unable to open PRINTER file.') GO TO 140 120 WRITE (PRINTR,130) 130 FORMAT (' Unable to open WORK file.') 140 STOP END C======================== C EXCHANGE PROGRAM, VAX/VMS IMPLEMENTATION. C C READ A COMMAND OR TEXT IMAGE FROM 1. ALTERNATE CORRECTION FILE C 2. TEXT FILE C 3. INPUT FILE C 4. SYSTEM READER C IF READING FROM -READER-, PUT A PROMPT ON THE TERMINAL C PUT THE HOLLERITH COMMAND IN HOLCMD C PUT THE ASCII EQUIVALENT IN COMAND C PUT THE NUMBER OF CHARACTERS IN NCHCMD C IF END-OF-FILE IS SENSED, SET NCHCMD=-1 C IF THE VARIABLE -TABS- IS TRUE, KEEP THE TAB CHARACTERS C C ROUTINE READS 133 CHARACTER IMAGES C======================== C SUBROUTINE EXCHIM C INTEGER BLANK,BFILL,RDFILE INTEGER TMPLIN(133) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF CHARACTER*1 TABS CHARACTER*40 FNAMES(3) COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) EQUIVALENCE (TMPLIN(1),COMAND(1)) DATA BLANK/1H / C C DETERMINE WHICH FILE TO WORK ON. RDFILE = INALT IF (RDFILE .GT. 0) GO TO 1000 RDFILE = INTEXT IF (RDFILE .NE. 0) GO TO 1000 RDFILE = INFILE IF (RDFILE .EQ. 0) RDFILE = READER C C PERFORM ACTION. FILES ARE OPENED IN EXCHCX. 1000 I = ACTION + 2 GO TO (5000,4000,7000,2000),I RETURN C C REWIND INALT 2000 REWIND RDFILE GO TO 7000 C C READ IN A LINE, MAPPING TABS IF NECESSARY C C THE FOLLOWING TEST MUST BE CHANGED IF TTY IS OTHER THAN UNIT 5. 4000 IF (RDFILE .EQ. 5 .AND. PRINTR.EQ. 6) WRITE(PRINTR,601) READ (RDFILE,501,END=8000) M,(TMPLIN(I),I=1,M) NCHCMD=0 IF (M .EQ. 0) GO TO 7000 DO 4090 I=1,M IF(TABS.EQ.'Y') GO TO 4070 IF((TMPLIN(I).AND."0177) .NE. 9) GO TO 4070 C 9 IS ASCII HT (HORIZONTAL TAB). BFILL = 8 - MOD(NCHCMD,8) DO 4040 J=1,BFILL NCHCMD=NCHCMD+1 HOLCMD(NCHCMD)=BLANK 4040 CONTINUE GO TO 4090 4070 NCHCMD=NCHCMD+1 HOLCMD(NCHCMD)=TMPLIN(I) 4090 CONTINUE DO 4190 I=1,NCHCMD COMAND(I) = HOLCMD(I) .AND. "0177 4190 CONTINUE M=NCHCMD DO 4200 I=1,M IF (COMAND(M-I+1).EQ.32) GO TO 4200 C 32 = ASCII BLANK. NCHCMD=M-I+1 GO TO 7000 4200 CONTINUE NCHCMD=0 GO TO 7000 C C CLOSE A FILE. C DO NOT CLOSE INPUT FILES IF 'T' OPTION SPECIFIED. 5000 IF (OPTVAL(20).EQ.0) CLOSE (UNIT=RDFILE) C 7000 ACTION = 0 RETURN C 8000 NCHCMD = -1 GO TO 7000 501 FORMAT(Q,133A1) 601 FORMAT('$*') END SUBROUTINE EXCHOU (OUTPUT) C C NATIVE FORMAT OUTPUT PROGRAM. FOR THE TEXT EXCHANGE PROGRAM. C VAX/VMS IMPLEMENTATION. C C OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN. C THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT. C C THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180), C THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179). IF OUTPUT(180) C IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE. IF OUTPUT(180) C IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW C IMAGE. C INTEGER OUTPUT(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C DECIDE WHETHER TO OPEN, CLOSE OR WRITE. C IF (ACTION.NE.0) IF (ACTION+1) 70,40,70 WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT) 30 FORMAT (133A1) GO TO 70 40 CLOSE(UNIT=OUFILE) C 70 ACTION=0 RETURN END SUBROUTINE EXCHPA (BUFIN,BUF9T) C C CHARACTER PACKING ROUTINE FOR THE VAX-11 SERIES MACHINES. C OPERATING SYSTEM VAX/VMS VERSION V2.1 C THE BYTE DATA TYPE IS USED TO PACK THE CHARACTERS FROM THE C WORKING BUFFER BUFIN(*), WHERE THEY ARE STORED ONE CHARACTER C PER WORD, TO BUF9T(*). C C WRITTEN BY R. J. HANSON AND K. H. HASKELL, C SANDIA LABS., JUNE, 1981. C BYTE BUFIN(720),BUF9T(180) C DO 10 I=1,180 BUF9T(I)=BUFIN(4*I-3) 10 CONTINUE RETURN END SUBROUTINE EXCHRT (ISTAT,INPBUF) C C TAPE INPUT ROUTINE FOR THE VAX-11 SERIES MACHINES. C OPERATING SYSTEM VAX/VMS VERSION V2.4 C NOTE -- INTEGER*4 IS ASSUMED DEFAULT. C C KAREN HASKELL, SNLA -- JUNE, 1981 C AND R. J. HANSON. C REVISED 820616 1500 C C INPUT PARAMETERS C ISTAT = 1 OPEN INPUT TAPE, NO REWIND C = 2 REWIND AND CLOSE INPUT TAPE C = 3 READ FROM TAPE INTO INPBUF(*) C = 4 CLOSE INPUT TAPE, NO REWIND C INPBUF -- THE BUFFER INTO WHICH THE DATA IS TO BE READ. C C OUTPUT PARAMETERS C ISTAT = 0 IF NO ERRORS OCCURRED C = 3 IF ANY TYPE OF ERROR OCCURRED. C (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED) C INTEGER ISTAT,INPBUF(1) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF CHARACTER*40 FNAMES(3) CHARACTER*1 TABS COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES C IF ((ISTAT.LT.1) .OR. (ISTAT.GT.4)) GO TO 240 GO TO (10,60,70,120), ISTAT C C OPEN TAPE, NO REWIND 10 CONTINUE OPEN (UNIT=INTAPE,FILE=FNAMES(2),ERR=130,IOSTAT=IERR, * RECL=3600,STATUS='OLD',RECORDTYPE='VARIABLE', * CARRIAGECONTROL='NONE',READONLY) GO TO 230 C C REWIND AND CLOSE INPUT TAPE 60 CONTINUE REWIND (UNIT=INTAPE,ERR=150,IOSTAT=IERR) GO TO 230 C C READ INTO INPBUF 70 CONTINUE NCDBI=NDATAI+NERRCI+9 NWORDS=(NCDBI+3)/4 DO 110 I=1,2 C C READ A BUFFER FROM INTAPE INTO INPBUF. READ(INTAPE,80,END=100,ERR=100,IOSTAT=IERR)(INPBUF(J),J=1,NWORDS) 80 FORMAT(255(10A4)) GO TO 230 C C ALLOW ONE END-OF-FILE IF EXPECTING LABEL. 100 IF (IERR.EQ.(-1).AND.BLKSQI.NE.0) GO TO 170 IF (IERR.GT.0) GO TO 175 110 CONTINUE GO TO 170 C C CLOSE INPUT TAPE WITH NO REWIND. 120 CONTINUE GO TO 230 C C PROCESS ERROR CONDITIONS 130 CONTINUE IF (IERR .NE.(-1)) GO TO 140 WRITE (PRINTR,180) GO TO 240 140 CONTINUE WRITE (PRINTR,190) IERR GO TO 240 C 150 CONTINUE IF (IERR .NE.(-1)) GO TO 160 WRITE (PRINTR,200) GO TO 240 160 CONTINUE WRITE (PRINTR,210) IERR GO TO 240 C 170 CONTINUE IF (IERR.EQ.(-1)) WRITE (PRINTR,220) GO TO 240 C 175 CONTINUE WRITE (PRINTR,225) IERR GO TO 240 C 180 FORMAT ('0Attempted open at end-of-file on INTAPE') 190 FORMAT ('0Error condition occurred while opening INTAPE, IOSTAT=', * Z8) 200 FORMAT ('0End-of-file on close/rewind of INTAPE') 210 FORMAT ('0Error condition occurred with close/rewind on INTAPE, IO *STAT=',Z8) 220 FORMAT ('0Unexpected end-of-file on INTAPE.') 225 FORMAT ('0Error condition occurred while reading INTAPE, IOSTAT=', * Z8) C 230 CONTINUE ISTAT=0 RETURN 240 CONTINUE CALL LIB$SIGNAL (%VAL(IERR)) 250 CONTINUE ISTAT=3 RETURN C END SUBROUTINE EXCHUN (BUF9T,BUFOUT) C C CHARACTER UNPACKING ROUTINE FOR THE VAX-11 SERIES MACHINES. C OPERATING SYSTEM VAX/VMS VERSION V2.1 C THE BYTE DATA TYPE IS USED TO UNPACK THE CHARACTERS FROM THE C INPUT BLOCK BUF9T(*) TO THE OUTPUT BUFFER BUFOUT(*), ONE C CHARACTER PER WORD. C NOTE -- INTEGER*4 IS ASSUMED DEFAULT. C C WRITTEN BY R. J. HANSON AND K. H. HASKELL, C SANDIA LABS., JUNE, 1981. C BYTE BUF9T(180),BUFOUT(720) BYTE IZERO DATA IZERO /'00'X/ C DO 10 I = 1, 180 BUFOUT(4*I-3)=BUF9T(I) BUFOUT(4*I-2)=IZERO BUFOUT(4*I-1)=IZERO BUFOUT(4*I)=IZERO 10 CONTINUE RETURN END SUBROUTINE EXCHWT(ISTAT,OUTBUF) C C TAPE OUTPUT ROUTINE FOR THE VAX-11 SERIES MACHINES. C OPERATING SYSTEM VAX/VMS VERSION V2.4 C NOTE -- INTEGER*4 IS ASSUMED DEFAULT. C C KAREN HASKELL, SNLA -- JUNE, 1981 C AND R. J. HANSON. C REVISED 820616 1500 C C INPUT PARAMETERS C ISTAT = 1 OPEN OUTPUT TAPE, NO REWIND C = 2 WRITE CONTENTS OF OUTBUF(*) TO OUTPUT TAPE C = 3 CLOSE OUTPUT TAPE, NO REWIND C OUTBUF -- THE BUFFER FROM WHICH THE DATA IS TO BE WRITTEN C C OUTPUT PARAMETERS C ISTAT = 0 IF NO ERRORS OCCURRED C = 3 IF ANY TYPE OF ERROR OCCURRED C (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED) C INTEGER ISTAT,OUTBUF(1) INTEGER EXPSIZ C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF CHARACTER*40 FNAMES(3) CHARACTER*1 TABS COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES C IF ((ISTAT.LT.1) .OR. (ISTAT.GT.3)) GO TO 150 GO TO (10,50,80), ISTAT C C OPEN OUTAPE, NO REWIND. 10 CONTINUE OPEN (UNIT=OUTAPE,FILE=FNAMES(3),ERR=100,IOSTAT=IERR, * RECL=3600,STATUS='NEW',RECORDTYPE='VARIABLE', * CARRIAGECONTROL='NONE') GO TO 90 C C WRITE CONTENTS OF OUTBUF(*) TO OUTAPE 50 CONTINUE EXPSIZ=CCDBO IF (BLKSQO.NE.0) EXPSIZ=NDATAO+NERRCO+9 NWORDS=(EXPSIZ+3)/4 WRITE (OUTAPE,60,ERR=135,IOSTAT=IERR) (OUTBUF(I),I=1,NWORDS) 60 FORMAT(255(10A4)) GO TO 90 C C CLOSE OUTAPE, NO REWIND. 80 CONTINUE CLOSE (UNIT=OUTAPE,ERR=120) GO TO 90 C C FUNCTION COMPLETED NORMALLY. 90 CONTINUE ISTAT=0 RETURN C C PROCESS ERROR CONDITIONS. 100 CONTINUE WRITE (PRINTR,110) IERR 110 FORMAT ('0Error condition occurred while opening OUTAPE, IOSTAT=', * Z8) GO TO 140 C 120 CONTINUE WRITE (PRINTR,130) 130 FORMAT ('0Error condition occurred while closing OUTAPE.') C 135 CONTINUE WRITE (PRINTR,136) IERR 136 FORMAT ('0Error condition occurred while writing OUTAPE, IOSTAT=', * Z8) C 140 CONTINUE CALL LIB$SIGNAL (%VAL(IERR)) 150 CONTINUE ISTAT=3 RETURN END SUBROUTINE EXCHSL C C LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS. C C EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE C SEGMENT. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C RETURN END SUBROUTINE EXCHTR (IBLOCK,OBLOCK) C C TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER. C INTEGER IBLOCK(1), OBLOCK(1) C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4. C CALL EXCHFO (1) CALL EXCHFO (2) WORKF=-IABS(WORKF) C 10 IF (TRANS.LE.0) RETURN CALL EXCHSL C LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS. GO TO (11,12,13,14,15,16,17,18,19), TRANS C COMMAND PARSER 11 CALL EXCHC1 (IBLOCK,OBLOCK) GO TO 10 C IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE 12 CALL EXCHC2 GO TO 10 C OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE. 13 CALL EXCHC3 (IBLOCK,OBLOCK) GO TO 10 C COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE. 14 CALL EXCHC4 (IBLOCK) GO TO 10 C COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE. 15 CALL EXCHC5 (IBLOCK,OBLOCK) GO TO 10 C COPY TEXT FROM INTAPE TO OUTAPE 16 CALL EXCHC6 (IBLOCK,OBLOCK) GO TO 10 C TEXT COMMAND 17 CALL EXCHC7 (IBLOCK,OBLOCK) GO TO 10 C ERROR MESSAGES 18 CALL EXCHC8 GO TO 10 C QUIT 19 CALL EXCHC9 (IBLOCK,OBLOCK) GO TO 10 END SUBROUTINE EXCHGB (ISTAT,DBLOCK) C C READ A BLOCK FROM THE EXCHANGE TAPE. C IGNORE THE ERROR CONTROL SEGMENT. C CHECK THE BLOCK SEQUENCE NUMBER. C CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER, C OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF C C C READ A BLOCK FROM INTAPE. C BLKSQI=BLKSQI+1 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 160 C C GET INFORMATION OUT OF THE BLOCK HEADER. C CCDBI=NERRCI CWDBI=NWCBI*(CCDBI/NCCBI)+1 CPCBI=MOD(CCDBI,NCCBI) CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) DO 110 JUMP=1,9 CCDBI=CCDBI+1 CPCBI=CPCBI+1 IF (CCDBI.GT.NCDBI) GO TO 130 IF (CPCBI.LE.NCCBI) GO TO 10 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 10 GO TO (20,30,40,50,60,70,80,90,100), JUMP 20 NEWBLK=256*CBLCKI(CPCBI) GO TO 110 30 NEWBLK=NEWBLK+CBLCKI(CPCBI) GO TO 110 40 LASTI=CBLCKI(CPCBI) GO TO 110 50 L1PRGI=256*CBLCKI(CPCBI) GO TO 110 60 L1PRGI=L1PRGI+CBLCKI(CPCBI) GO TO 110 70 N1RECI=256*CBLCKI(CPCBI) GO TO 110 80 N1RECI=N1RECI+CBLCKI(CPCBI) GO TO 110 90 L1RECI=256*CBLCKI(CPCBI) GO TO 110 100 L1RECI=L1RECI+CBLCKI(CPCBI) 110 CONTINUE C C CHECK THE BLOCK SEQUENCE NUMBER. C IF (BLKSQI.EQ.NEWBLK) GO TO 150 ISTAT=1 WRITE (PRINTR,120) NEWBLK,BLKSQI 120 FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I 15//) BLKSQI=NEWBLK GO TO 160 C C FORMAT ERROR C 130 ISTAT=2 GO TO 160 C C CHECK L1PRGI AND L1RECI. C 150 IF (L1PRGI.GT.NCDBI) GO TO 130 IF (L1RECI.GT.NCDBI) GO TO 130 ISTAT=0 160 RETURN C END SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD) C C GET A RECORD FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG. C ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK). C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE C SPACE ALLOWED BY THE USER. (POSITION IS STILL OK). C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM C CONTROL RECORDS. NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS. C ISTAT=0 NCHACT=0 10 JUMP=1 GO TO 260 20 NG=CBLCKI(CPCBI) IF (NG.EQ.0) GO TO 90 IF (NG.NE.255) GO TO 30 C C END OF SHORT TAPE BLOCK. C CCDBI=NCDBI GO TO 10 C C UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO C THE USER RECORD AREA. C 30 ITYPEI=0 IF (MODEI.EQ.0) GO TO 40 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG 40 IG=0 50 JUMP=2 GO TO 260 60 NR=CBLCKI(CPCBI) IF (MODEI.EQ.0) GO TO 70 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR GO TO 160 70 IR=0 C PUT REMVI INTO THE USER RECORD NR TIMES. 80 IF (IR.GE.NR) GO TO 160 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI IR=IR+1 GO TO 80 C C THE NEXT RECORD IS A CONTROL RECORD. FIND OUT WHAT KIND. C 90 JUMP=3 GO TO 260 100 ITYPEI=CBLCKI(CPCBI) IF (ITYPEI.LT.65) GO TO 250 C 65 = ASCII A IF (ITYPEI.GT.90) GO TO 250 C 90 = ASCII Z I=ITYPEI-64 C A B C D E F G H I J K L M N O GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160 1,110,160,220,160,160,160,160,160,160,160,160), I C P Q R S T U V W X Y Z C C P - PROGRAM HEADER C C CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER 110 REMVI=32 C RESET THE REMOVED CHARACTER TO ASCII BLANK. JUMP=4 GO TO 260 120 L1PRGI=256*CBLCKI(CPCBI) JUMP=5 GO TO 260 130 L1PRGI=L1PRGI+CBLCKI(CPCBI) JUMP=6 GO TO 260 140 N1RECI=256*CBLCKI(CPCBI) JUMP=7 GO TO 260 150 N1RECI=N1RECI+CBLCKI(CPCBI) C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 160 JUMP=8 GO TO 260 170 NC=CBLCKI(CPCBI) IF (ITYPEI.NE.0) GO TO 180 IF (MODEI.EQ.0) GO TO 180 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC C COPY NC CHARACTERS TO THE USER RECORD AREA. 180 IC=0 JUMP=9 190 IF (IC.GE.NC) IF (ITYPEI) 240,210,240 GO TO 260 200 NCHACT=NCHACT+1 IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI) IC=IC+1 GO TO 190 210 IG=IG+1 IF (IG-NG) 50,240,240 C C J - UPDATING AND END OF INPUT TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 220 JUMP=10 GO TO 260 230 RECORD(1)=CBLCKI(CPCBI) NCHACT=1 IF (ITYPEI.EQ.82) REMVI=RECORD(1) C 82 = ASCII R C C RETURN TO THE USER PROGRAM. C 240 IF (NCHACT.GT.NCHMAX) ISTAT=4 GO TO 290 C C CONTROL RECORD TYPE CANNOT BE DETERMINED. C 250 ISTAT=5 GO TO 290 C C GET A CHARACTER FROM CBLOCK. UNPACK A NEW BLOCK IF NECESSARY. C READ MORE TAPE IF NECESSARY. C 260 CPCBI=CPCBI+1 CCDBI=CCDBI+1 IF (CCDBI.LE.NCDBI) GO TO 270 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 290,260,290 270 IF (CPCBI.LE.NCCBI) GO TO 280 CWDBI=CWDBI+NWCBI CPCBI=1 CALL EXCHUN (DBLOCK(CWDBI),CBLCKI) 280 GO TO (20,60,100,120,130,140,150,170,200,230), JUMP 290 RETURN C END SUBROUTINE EXCHNP (ISTAT,DBLOCK) C C SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE C TAPE. C THIS MODULE IS MACHINE INSENSITIVE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) ISTAT=0 IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20 C C CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK. C 10 IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20 C 76 = ASCII L C C NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK. CCDBI=L1PRGI-1 I=NWCBI*(CCDBI/NCCBI)+1 IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI) CWDBI=I CPCBI=MOD(CCDBI,NCCBI) GO TO 40 C C NO MORE HEADERS IN THIS BLOCK. C 20 CALL EXCHGB (ISTAT,DBLOCK) IF (ISTAT) 40,10,40 C C END OF FILE. C 30 ISTAT=7 C 40 RETURN C END SUBROUTINE EXCHPB (ISTAT,DBLOCK) C C WRITE A BLOCK ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK. INTEGER WORK(9) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C C PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK. C BLKSQO=BLKSQO+1 WORK(1)=BLKSQO/256 WORK(2)=MOD(BLKSQO,256) WORK(3)=LASTO WORK(4)=L1PRGO/256 WORK(5)=MOD(L1PRGO,256) WORK(6)=N1RECO/256 WORK(7)=MOD(N1RECO,256) WORK(8)=L1RECO/256 WORK(9)=MOD(L1RECO,256) C CPCBO=MOD(NERRCO,NCCBO) CWDBO=(NERRCO/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) C DO 10 I=1,9 CPCBO=CPCBO+1 IF (CPCBO.LE.NCCBO) GO TO 10 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) CWDBO=CWDBO+NWCBO CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO) CPCBO=1 10 CBLCKO(CPCBO)=WORK(I) CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1)) C C WRITE THE DATA BLOCK ON TAPE. C ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L). C IF (LASTO.NE.76) GO TO 20 ISTAT=3 CALL EXCHWT (ISTAT,DBLOCK) GO TO 30 C C COMPUTE POINTERS FOR NEXT BLOCK OUT. C 20 L1PRGO=0 LLPRGO=0 N1RECO=0 L1RECO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 C 30 RETURN C END SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD) C C WRITE A RECORD ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A C TEXT RECORD CONTAINS MORE THAN 254 GROUPS. C ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) C C RECORD = THE USERS RECORD AREA. INTEGER RECORD(1) C INTEGER GC,RC(255),CC(255) C GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C ISTAT=0 INCHAR=0 C C DETERMINE THE RECORD TYPE. C IF (NCHOUT.NE.255) GO TO 10 ITYPEO=255 GO TO 70 10 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO IF (ITYPEO.NE.0) GO TO 30 C C DATA RECORD. C IF (MODEO.NE.0) GO TO 170 C COMPRESS THE RECORD. CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255) IF (GC.GE.255) GO TO 210 IG=0 C OUTPUT THE GROUP COUNT. CBLCKO(CPCBO)=GC JUMP=1 GO TO 230 20 IG=IG+1 IF (IG.GT.GC) GO TO 250 NC=CC(IG) INCHAR=INCHAR+RC(IG) C OUTPUT REMOVED CHARACTER COUNT. CBLCKO(CPCBO)=RC(IG) JUMP=2 GO TO 230 C C THE USER SAYS HE HAS A CONTROL RECORD TO WRITE. FIND OUT C WHAT KIND. C 30 IF (ITYPEO.LT.65) GO TO 220 C 65 = ASCII A IF (ITYPEO.GT.90) GO TO 220 C 90 = ASCII Z I=ITYPEO-64 C A B C D E F G H I J K L M N O P Q R S GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40, 140,40,40,40,40,40,40), I C T U V W X Y Z C C A - AUTHOR C B - BIBLIOGRAPHIC REFERENCE C C - COMMENTS C D - DATA TYPE C G - GROUPS C I - INCLUDE TEXT REQUEST C K - KEYWORDS C M - MACHINE TYPE C O - ORIGINATING SITE C S - UPDATING SITE C FHLNQTUVWXYZ - UNSPECIFIED TYPES C 40 IF (NCHOUT-255) 100,100,210 C C END OF FILE. C 50 IF (NERRCO+NDATAO+7-CCDBO) 70,80,80 C C P - PROGRAM HEADER. C 60 IF (NCHOUT.GT.255) GO TO 210 REMVO=32 C RESET REMOVED CHARACTER TO ASCII BLANK. IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80 IF (CCDBO.EQ.NERRCO+10) GO TO 80 C C END OF SHORT TAPE BLOCK. C 70 CBLCKO(CPCBO)=255 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250 C 69 = ASCII E C 80 = ASCII P L1RECO=CCDBO-NERRCO 80 IF (LLPRGO.EQ.0) GO TO 90 C LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK. CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) NC=MOD(LLPRGO+1,NCCBO) NW=((LLPRGO+1)/NCCBO)*NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) CBLCKO(NC+1)=CCDBO/256 IF (NC+1.LT.NCCBO) GO TO 85 CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) NW=NW+NWCBO CALL EXCHUN (DBLOCK(NW+1),CBLCKO) NC=-1 85 CBLCKO(NC+2)=MOD(CCDBO,256) CALL EXCHPA (CBLCKO,DBLOCK(NW+1)) CALL EXCHUN (DBLOCK(CWDBO),CBLCKO) C UPDATE TABLE OF CONTENTS POINTERS 90 LLPRGO=CCDBO IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO NLRECO=NLRECO+1 IF (N1RECO.EQ.0) N1RECO=NLRECO 100 CBLCKO(CPCBO)=0 JUMP=3 GO TO 230 110 CBLCKO(CPCBO)=ITYPEO JUMP=4 GO TO 230 120 IF (ITYPEO.NE.69) GO TO 130 C 69 = ASCII E LASTO=76 GO TO 70 130 IF (ITYPEO.NE.80) GO TO 170 C 80 = ASCII P CBLCKO(CPCBO)=0 JUMP=5 GO TO 230 140 CBLCKO(CPCBO)=0 JUMP=6 GO TO 230 150 CBLCKO(CPCBO)=NLRECO/256 JUMP=7 GO TO 230 160 CBLCKO(CPCBO)=MOD(NLRECO,256) JUMP=8 GO TO 230 C 170 NC=NCHOUT 180 CBLCKO(CPCBO)=NC IC=0 JUMP=9 C PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD. IF (ITYPEO.EQ.82) GO TO 190 IF (ITYPEO.EQ.74) GO TO 190 IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230 190 IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250 INCHAR=INCHAR+1 IC=IC+1 CBLCKO(CPCBO)=RECORD(INCHAR) GO TO 230 C C J - UPDATING AND END OF TEXT SIGNAL. C R - CHANGE REMOVED CHARACTER. C 200 NCHOUT=1 IF (ITYPEO.EQ.82) REMVO=RECORD(1) C 82 = ASCII R GO TO 100 C C RECORD TOO LONG. C 210 ISTAT=4 GO TO 250 C C UNKNOWN CONTROL RECORD TYPE. C 220 ISTAT=5 GO TO 250 C C INCREMENT THE OUTPUT BUFFER POINTERS. PACK A CHARACTER BLOCK C IF NECESSARY. WRITE A TAPE BLOCK IF NECESSARY. C 230 CPCBO=CPCBO+1 CCDBO=CCDBO+1 IF (CPCBO.LE.NCCBO) GO TO 240 CALL EXCHPA (CBLCKO,DBLOCK(CWDBO)) CWDBO=CWDBO+NWCBO CPCBO=1 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240 CALL EXCHPB (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 250 240 GO TO (20,180,110,120,140,150,160,170,190), JUMP 250 RETURN C END SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL) C C SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE C DATA TO BE REMOVED. DIVIDE DATA INTO GROUPS CONSISTING OF C STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT C DATA. THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE C REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP C ARE RECORDED IN RC() AND SC() RESPECTIVELY. MAXSL IS THE C MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC(). C INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL C C RC AND SC MUST BE AT LEAST (IMGLEN-1)//3. C GC=1 SC(1)=0 RC(1)=0 MODE=-1 INPLEN=IABS(IMGLEN) C C IDENTIFY DATA GROUPS. C DO 110 I=1,INPLEN IF (MODE) 40,60,90 C C MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE. C 40 IF (INPIMG(I).EQ.REMOVE) GO TO 50 C SWITCH TO SIGNIFICANT DATA SCAN. MODE=1 SC(GC)=1 GO TO 110 C CONTINUE REMOVE SCAN 50 RC(GC)=RC(GC)+1 IF (RC(GC)-MAXSL) 110,95,110 C C MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY C ONE OCCURRENCE OF REMOVE. CHANGE TO REMOVE MODE IF ANOTHER REMOVE C OCCURS OR BACK TO DATA MODE IF NOT. C 60 IF (INPIMG(I).EQ.REMOVE) GO TO 80 C SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT. MODE=1 IF (SC(GC).GE.MAXSL-2) GO TO 70 SC(GC)=SC(GC)+2 GO TO 110 C FULL GROUP 70 GC=GC+1 RC(GC)=1 SC(GC)=1 GO TO 110 C SWITCH TO REMOVE MODE. 80 GC=GC+1 SC(GC)=0 RC(GC)=2 MODE=-1 GO TO 110 C C MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA. C 90 IF (INPIMG(I).EQ.REMOVE) GO TO 100 SC(GC)=SC(GC)+1 IF (SC(GC).NE.MAXSL) GO TO 110 C FULL GROUP MODE=-1 95 IF (I.GE.INPLEN) GO TO 120 GC=GC+1 RC(GC)=0 SC(GC)=0 GO TO 110 100 MODE=0 110 CONTINUE 120 RETURN C END SUBROUTINE EXCHTP (RECORD,LINEI) C C MATERIALIZE INCLUDES IF INALT IS NON-ZERO. C CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE C AND THE PRINTER IF LISTING IS REQUESTED. C LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C INTEGER RECORD(1),LINEI C C ***** LOCAL VARIABLES ************************************ C C COPY DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR C SKIPPING TEXT NOT TO BE INCLUDED. INTEGER COPY C DASH CONTAINS '-' IN HOLLERITH. INTEGER DASH C ENDMRK HOLDS THE END SENTINEL. INTEGER ENDMRK(40) C NCHEND IS THE NUMBER OF CHARACTERS IN ENDMRK. INTEGER NCHEND C NCHSAV SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD. INTEGER NCHSAV C NCHTAR IS THE NUMBER OF CHARACTERS IN TARGET. INTEGER NCHTAR C STAR CONTAINS '*' IN HOLLERITH. INTEGER STAR C TARGET IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY). INTEGER TARGET(40) C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL DATA *************************************** C DATA DASH /1H-/, STAR /1H*/ C C ***** PROCEDURES ***************************************** C LINEO=LINEO+1 IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190 RECORD(180)=LINEO RECORD(179)=LINEI COPY=-1 C COPY=-1 MEANS NOT COPYING INCLUDED TEXT. IF (ITYPEO.EQ.0) GO TO 110 C PROCESS INCLUDE RECORD. DO 10 I=1,NCHOUT 10 RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I) C INSERT '-I '. RECORD(1)=45 RECORD(2)=73 RECORD(3)=32 NCHOUT=NCHOUT+3 IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110 C STORE SEARCH TARGET NCHTAR=MIN0(NCHOUT,40) DO 20 I=1,NCHTAR 20 TARGET(I)=RECORD(I) C STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). NCHSAV=NCHCMD DO 30 I=1,NUMBER 30 OUTREC(I)=COMAND(I) COPY=0 C COPY=0 MEANS SKIPPING MODULE ON INALT FILE. INALT=IABS(INALT) NEOF=0 40 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 IF (NCHCMD.LT.2) GO TO 40 IF (COMAND(1).NE.45) GO TO 40 C 45 = ASCII - IF (COMAND(2).EQ.45) GO TO 130 IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40 C 73 = ASCII I, 105 = ASCII LOWER CASE I. C COMPARE IMAGE WITH SEARCH TARGET. IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60 DO 50 I=2,NCHTAR K=COMAND(I) IF (K.GT.96 .AND. K.LT.123) K=K-32 IF (TARGET(I).NE.K) GO TO 60 50 CONTINUE NEOF=3 C PREVENT SEARCH LOOP. COPY=1 C COPY=1 MEANS COPYING INCLUDED TEXT. 60 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C STORE END OF INCLUDE MODULE SIGNAL. NCHEND=MIN0(40,NCHCMD) DO 70 I=1,NCHEND 70 ENDMRK(I)=COMAND(I) IF (COPY.EQ.0) GO TO 80 CHAR1L=DASH NCHOUT=NCHTAR DO 75 I = 1,NCHOUT 75 COMAND(I)=TARGET(I) COMAND(180)=LINEO COMAND(179)=LINEI C GO PRINT TARGET. CALL EXCHTW (COMAND,-1) GO TO 120 C COPY OR SKIP UNTIL ENDMRK SEEN AGAIN. 80 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 130 C BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF. C TEST FOR ENDMRK DO 90 I=1,NCHEND IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100 90 CONTINUE IF (COPY) 140,40,140 C OUTPUT TEXT RECORD. 100 COMAND(180)=LINEO COMAND(179)=LINEI NCHOUT=NCHCMD CALL EXCHTW (COMAND,OPTI) GO TO 120 C OUTPUT TEXT RECORD. 110 CALL EXCHTW (RECORD,1) 120 IF (COPY) 190,190,80 C WE ONLY GET HERE WITH COPY .GE. 0. 130 NEOF=NEOF+1 ACTION=2 C ACTION = 2 MEANS REOPEN INALT. CALL EXCHIM IF (NEOF.LT.2) GO TO 40 140 INALT=-IABS(INALT) NCHCMD=1 IF (COPY.GT.0) GO TO 170 C PROCESS TARGET AS THOUGH IT WERE TEXT. NCHOUT=NCHTAR C SAVE TARGET FOR ERROR MESSAGE. DO 150 I=1,NCHTAR 150 COMAND(I)=TARGET(I) CALL EXCHTW (COMAND,1) CALL EXCHAH (TARGET,NCHTAR) WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR) 160 FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8 10A1)) NERRS=MAX0(NERRS,3) C C RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM). C 170 NCHCMD=NCHSAV DO 180 I=1,NUMBER 180 COMAND(I)=OUTREC(I) C 190 CHAR1L=STAR RETURN C END SUBROUTINE EXCHTW (RECORD,OPTION) C C WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING C EXCHOU. WRITE RECORD ON THE PRINTER IF LISTING REQUESTED. C RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR C NEW TEXT. C IF OPTION = ZERO, WRITE TO FILE ONLY. C IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING. C IF OPTION .LT. ZERO, WRITE TO LISTING ONLY. C INTEGER RECORD(1),OPTION C C ***** COMMON VARIABLES *********************************** C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** PROCEDURES ***************************************** C LINEI=RECORD(179) IF (OPTION.LT.0) GO TO 130 C C INSERT IDENTIFICATION IF REQUESTED. C IF (IDCOL2.LT.IDCOL1) GO TO 120 IF (IDTXTL+IDSTEP.EQ.0) GO TO 120 IF (NCHOUT.GE.IDCOL2) GO TO 20 J=IDCOL2-1 C FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2 DO 10 I=NCHOUT,J 10 RECORD(I+1)=32 C 32 = ASCII BLANK. 20 NCHOUT=MAX0(NCHOUT,IDCOL2) N=-1 IF (LINEI.EQ.0) GO TO 40 IF (IDOPTN.NE.73) GO TO 40 C 73 = ASCII I. IDENTIFY ONLY FROM INTAPE. N=(LINEI-1)*IDSTEP+IDSTRT GO TO 70 40 IF (IDOPTN.NE.79) GO TO 50 C 79 = ASCII O. IDENTIFY ONLY TO OUTAPE. N=(LINEO-1)*IDSTEP+IDSTRT GO TO 70 50 IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70 C 67 = ASCII C, 70 = ASCII F. IDENTIFY EVERYTHING. N=IDCUR 70 IF (N.LT.0) GO TO 120 IF (IDTXTL.EQ.0) GO TO 100 J=MIN0(IDCOL2,IDTXTL+IDCOL1-1) K=1 DO 80 I=IDCOL1,J RECORD(I)=IDTEXT(K) 80 K=K+1 100 IF (IDSTEP.EQ.0) GO TO 120 IDCUR=IDCUR+IDSTEP K=IDCOL2 110 RECORD(K)=MOD(N,10)+48 N=N/10 K=K-1 IF (N.EQ.0) GO TO 120 IF (K.GE.IDCOL1) GO TO 110 C C OUTPUT RECORD. C 120 IF (OUFILE.NE.0) CALL EXCHOU (RECORD) IF (OPTION.EQ.0) GO TO 220 130 IF (OPTL.NE.0) GO TO 140 IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220 140 CALL EXCHAH (RECORD,NCHOUT) IF (OPTV+VERT.NE.0) GO TO 200 IF (PHASE.NE.8) GO TO 180 IF (LINEI.EQ.0) GO TO 160 WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 150 FORMAT (1X,2I5,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 160 WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 170 FORMAT (5H NEW,I6,A1,3X,105A1/(6H CONT,9X,105A1)) GO TO 220 180 WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT) 190 FORMAT (1X,I5,A1,3X,110A1/(6H CONT,4X,110A1)) GO TO 220 200 WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT) 210 FORMAT (132A1) 220 RETURN C END SUBROUTINE EXCHC1 (IBLOCK,OBLOCK) C C COMMAND DECODER AND FORMAT VERIFIER. SOME COMMANDS ARE ALSO C COMPLETELY PROCESSED HERE. C C IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS. C INTEGER IBLOCK(1),OBLOCK(1) C C C ***** LOCAL VARIABLES ************************************ C C ALLOW TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED. VALUES ARE C SUMS OF PERMITTED VALUES OF PHASE. C 1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING, C 8 = UPDATING. C ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A C PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR C MAY BE VOID (EQUAL SIGN IS LAST CHARACTER). C 32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT. INTEGER ALLOW(35) C BLANK A CONSTANT. 1H . INTEGER BLANK C DATE IS THE DATE FROM UPDA=, DATE=, ORIG=. INTEGER DATE(3) C DAYS TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS. INTEGER DAYS(12) C I IS USED FREELY AS AN INDEX. C J IS USED FREELY AS AN INDEX. C JUMP USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE. C K IS USED FREELY AS AN INDEX. C KDATE IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD). C KQUIT IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD). C KTEXT IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD). C N IS USED FREELY AS AN INDEX. C NCNREC IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS. C ND IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER. C NM IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER. C NY IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER. C TVAL A VECTOR OF VALUES FOR TRANS. INDEXED BY ICOMD. INTEGER TVAL(35) C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL EQUIVALENCE ********************************** C EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND) C C ***** DATA STATEMENTS ************************************ C DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/ DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/ DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/ DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/ DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/ DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/ DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/ DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/ DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/ DATA BLANK /1H / DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/ DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/ DATA DAYS(11),DAYS(12) /30,31/ DATA KDATE /5/ DATA KQUIT /20/ DATA KTEXT /27/ DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/ DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/ DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/ DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/ DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/ DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/ DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/ C C ***** PROCEDURES ***************************************** C C GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER. C ECHO IT IF THE E OPTION IS SET. DETERMINE WHETHER IT IS A CHANGE C TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND. C 10 NCNREC=0 20 ACTION=0 IF (NCHCMD.LT.0) GO TO 220 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (OPTE.EQ.0) GO TO 27 WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD) 23 FORMAT (1X,80A1) CHAR1L=0 27 NCHCMD=MIN0(NCHCMD,MARGIN) IF (PHASE.LT.4) SIGNAL=45 C 45 = ASCII - IF (COMAND(1).NE.45) GO TO 50 C 45 = ASCII -. REQUEST TO CHANGE CONTROL RECORD. IF (PHASE.LT.4) GO TO 40 WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD) 30 FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT 1OR UPDATE/1X,80A1) NERRG=MAX0(NERRG,2) GO TO 200 40 ICOMD=0 EQUAL=2 TRANS=3 GO TO 370 50 IF (COMAND(1).NE.42) GO TO 70 C 42 = ASCII *. COMMENT RECORD. JUST ECHO IT. NCHCMD=MAX0(NCHCMD,2) WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD) 60 FORMAT (A1,1H*,78A1/(1X,80A1)) GO TO 10 C C SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR C EQUAL SIGN ARE FOUND. LOOK UP THE WORD IN THE COMMAND NAME TABLE. C 70 EQUAL=0 DO 80 I=1,NCHCMD IF (COMAND(I).EQ.32) GO TO 80 C 32 = ASCII BLANK EQUAL=EQUAL+1 ICOMD=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32 C ABOVE STATEMENT CONVERTS TO UPPER CASE. COMAND(I)=32 COMAND(EQUAL)=ICOMD IF (EQUAL.GE.4) GO TO 90 IF (ICOMD.EQ.61) GO TO 90 C 61 = ASCII =. IF (ICOMD.EQ.44) GO TO 90 C 44 = ASCII ,. 80 CONTINUE IF (EQUAL.EQ.0) GO TO 185 90 DO 110 ICOMD=1,NCOMDT DO 100 K=1,EQUAL IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110 100 CONTINUE IF (EQUAL.EQ.4) GO TO 130 IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130 C 32 = ASCII BLANK. 110 CONTINUE C C UNRECOGNIZED COMMAND. C 120 ICOMD=0 C C LOOK FOR AN EQUAL SIGN. SET THE VARIABLE NAMED EQUAL TO ZERO IF C THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK C CHARACTER FOLLOWING THE EQUAL SIGN. C 130 MODIFY=0 140 DO 150 I=EQUAL,NCHCMD K=COMAND(I) IF (K.EQ.61) GO TO 160 C 61 = ASCII =. IF (MODIFY.NE.0) GO TO 150 C USE FIRST MODIFIER. IF (K.EQ.44) GO TO 160 C 44 = ASCII ,. 150 CONTINUE EQUAL=0 GO TO 170 160 I=I+1 EQUAL=I IF (I.GT.NCHCMD) GO TO 170 IF (COMAND(I).EQ.32) GO TO 160 C 32 = ASCII BLANK IF (K.NE.44) GO TO 170 C 44 = ASCII ,. MODIFY=COMAND(I) C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32 C CONVERT TO UPPER CASE. GO TO 140 170 IF (K.NE.61) EQUAL=0 C 61 = ASCII =. IF (ICOMD.EQ.0) GO TO 180 IF (ICOMD.GT.NCOMDP) GO TO 180 IF (EQUAL.GT.NCHCMD) GO TO 175 IF (EQUAL.NE.0) GO TO 230 IF (ALLOW(ICOMD)/64.NE.0) GO TO 230 175 IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690 C PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK. NCHCMD=NCHCMD+1 EQUAL=NCHCMD COMAND(NCHCMD)=32 C 32 = ASCII BLANK HOLCMD(NCHCMD)=BLANK GO TO 230 C C GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX. C 180 CALL EXCHCX (0) C IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND. IF (ICOMD.NE.0) GO TO 730 185 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1)) NERRG=MAX0(NERRG,5) 200 CHAR1L=0 NCNREC=NCNREC+1 IF (NCNREC.LE.20) GO TO 20 WRITE (PRINTR,210) 210 FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU 1MES TEXT COMMAND IS MISSING.) GO TO 270 C C END OF FILE - SIMULATE A QUIT COMMAND. C 220 ICOMD=KQUIT C C RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME. C 230 IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240 TRANS=TVAL(ICOMD) C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300 1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7 230,370,730,370), ICOMD C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 C 32 33 34 35 C C THE COMMAND IS NOT ALLOWED AT THIS TIME. C 240 WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE 1D./1X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 C DECIDE WHETHER TO SKIP TEXT 260 IF (ICOMD.NE.KTEXT) GO TO 10 IF (EQUAL.NE.0) GO TO 10 270 WRITE (PRINTR,280) 280 FORMAT (//15H0SKIPPING TEXT.) 290 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 220 IF (NCHCMD.LT.2) GO TO 290 IF (COMAND(1).NE.SIGNAL) GO TO 290 IF (COMAND(2).EQ.SIGNAL) GO TO 10 IF (NCHCMD.LT.3) GO TO 290 IF (COMAND(2).NE.61) GO TO 290 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 290 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING. C DATE=YYMMDD C ORIGIN=YYMMDD SITE C UPDATE=YYMMDD SITE C IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE C THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED. C 300 IF (EQUAL+5.GT.NCHCMD) GO TO 700 I=EQUAL DO 310 J=1,3 DATE(J)=0 DO 310 K=1,2 N=COMAND(I)-48 IF (N.LT.0) GO TO 320 IF (N.GT.9) GO TO 320 DATE(J)=10*DATE(J)+N 310 I=I+1 IF (NM.EQ.0) GO TO 320 IF (NM.GT.12) GO TO 320 IF (ND.LE.0) GO TO 320 DAYS(2)=28 IF (MOD(NY,4).EQ.0) DAYS(2)=29 IF (NY.EQ.0) DAYS(2)=28 IF (ND.LE.DAYS(NM)) GO TO 440 320 IF (ICOMD.EQ.KDATE) GO TO 700 IF (TODAY(1).EQ.32) GO TO 700 I=MIN0(NCHCMD+6,180) NCHCMD=I J=I-6 IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1 C 32 = ASCII BLANK IF (J.LT.EQUAL) GO TO 700 330 COMAND(I)=COMAND(J) HOLCMD(I)=HOLCMD(J) J=J-1 I=I-1 IF (J.GE.EQUAL) GO TO 330 DO 340 I=1,6 COMAND(I+EQUAL-1)=TODAY(I) 340 HOLCMD(I+EQUAL-1)=TODAY(I) CALL EXCHAH (HOLCMD(EQUAL),6) WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD) 345 FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1)) NERRG=MAX0(NERRG,1) GO TO 440 C C REWIND INTAPE C 350 IF (INTAPE.EQ.0) GO TO 680 IF (INTOPN.NE.0) GO TO 360 I=1 C OPEN INTAPE IF NOT ALREADY OPEN. DO NOT CHECK EXCH LABEL. CALL EXCHRT (I,IBLOCK) C IGNORE STATUS 360 I=2 CALL EXCHRT (I,IBLOCK) INTOPN=0 GO TO 725 C C THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH C BEGINS WITH A NUMBER FOLLOWED BY A BLANK. C C INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA C INTAPE = NUMBER SYSTEM DEPENDENT DATA C LIMIT = NUMBER C MARGIN = NUMBER C OUTAPE = NUMBER SYSTEM DEPENDENT DATA C OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA C PRINTER = NUMBER C READER = NUMBER C SKIP = NUMBER C TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL) C WORK = NUMBER C 370 NUMBER=0 IF (EQUAL.EQ.0) GO TO 440 DO 410 J=EQUAL,NCHCMD IF (COMAND(J).EQ.32) GO TO 420 C 32 = ASCII BLANK N=COMAND(J)-48 C 48 = ASCII ZERO IF (N.GE.0) GO TO 400 380 WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD) 390 FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS. NOT PROCESSED./ 11X,80A1) NERRG=MAX0(NERRG,5) CHAR1L=0 GO TO 260 400 IF (N.GT.9) GO TO 380 410 NUMBER=10*NUMBER+N EQUAL=NCHCMD+1 GO TO 440 420 EQUAL=J 430 EQUAL=EQUAL+1 IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440 C 32 = ASCII BLANK C C PRELIMINARY FORMAT CHECKING IS COMPLETE C 440 J=ICOMD+1 C 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6 120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595), 2J C 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 C C DATE=YYMMDD C 450 DO 460 I=1,6 460 TODAY(I)=COMAND(EQUAL+I-1) GO TO 10 C C INPUT FILE = NUMBER SYSTEM DEPENDENT DATA. C 470 I=INFILE J=1 GO TO 500 C C INCLUDE = NUMBER SYSTEM DEPENDENT DATA. C 480 I=INALT J=3 INALT=IABS(INALT) GO TO 500 C C TEXT C 490 I=INTEXT J=2 IF (EQUAL.EQ.0) GO TO 560 C C OPEN AN INPUT FILE. C 500 IF (NUMBER.EQ.0) GO TO 505 IF (NUMBER.EQ.OUFILE) GO TO 710 IF (NUMBER.EQ.OUTAPE) GO TO 710 505 IF (J.EQ.2) GO TO 510 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (I.NE.0) CALL EXCHIM 510 IF (J-2) 520,530,540 520 INFILE=NUMBER GO TO 550 530 INTEXT=NUMBER GO TO 550 540 INALT=NUMBER 550 IF (NUMBER.EQ.0) GO TO 560 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND CALL EXCHCX (J+1) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHIM ACTION=2 C ACTION = 2 MEANS REWIND IF (J.EQ.3) CALL EXCHIM INALT=-IABS(INALT) 560 ACTION=0 C ACTION = 0 MEANS READ TEXT GO TO 730 C C INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 570 IF (INTOPN.EQ.0) GO TO 580 C CLOSE THE INPUT TAPE, IGNORE STATUS. I=4 CALL EXCHRT (I,IBLOCK) INTOPN=0 580 INTAPE=NUMBER C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (INTAPE.NE.0) CALL EXCHCX (6) GO TO 725 C C LIMIT = NUMBER C 590 LIMIT=NUMBER GO TO 10 C C MARGIN = NUMBER C C MINIMUM MARGIN IS 60 595 MARGIN=MAX0(NUMBER,60) GO TO 10 C C OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION C 600 IF (OUTOPN.EQ.0) GO TO 610 C WRITE AND END-OF-FILE MARK ON OUTAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (I,OBLOCK,OBLOCK) C IGNORE STATUS OUTOPN=0 PHASE=1 610 OUTAPE=NUMBER OUTUPD=MODIFY C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND IF (OUTAPE.NE.0) CALL EXCHCX (7) GO TO 730 C C OUTPUT = NUMBER SYSTEM DEPENDENT INFORMATION C 620 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) OUFILE=NUMBER IDCUR=IDSTRT IF (OUFILE.EQ.0) GO TO 730 C STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND. CALL EXCHCX (5) ACTION=1 C ACTION = 1 MEANS OPEN FILE. CALL EXCHOU (OUTREC) GO TO 730 C C PRINTER = NUMBER. C 630 CALL EXCHFO (-2) PRINTR=NUMBER CALL EXCHFO (2) GO TO 10 C C READER = NUMBER. C 640 IF (INFILE.NE.0) GO TO 670 CALL EXCHFO (-1) READER=NUMBER CALL EXCHCX (1) CALL EXCHFO (1) GO TO 10 C C WORK = NUMBER C 650 IF (WORKF.GT.0) CALL EXCHFO (-3) WORKF=NUMBER C WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4. GO TO 10 C C UPDATE C C DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR C SIMPLY TO OUTPUT THE UPDATE COMMAND. 660 IF (PHASE.GE.4) TRANS=5 GO TO 730 C C ERROR MESSAGES. C 670 NUMBER=3 C MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE. GO TO 720 680 NUMBER=4 C MESSAGE 4 - INTAPE IS NOT DEFINED. GO TO 720 690 NUMBER=12 C MESSAGE 12 - NO PARAMETER STRING. GO TO 720 700 NUMBER=13 C MESSAGE 13 - IMPROPER DATE. GO TO 720 710 NUMBER=31 C MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT. C C RETURN TO ERROR MESSAGE SEGMENT. C 720 TRANS=8 GO TO 740 c c Indicate the WORK file is empty. c 725 if (nrwork.le.0 .or. workf.le.0) go to 730 REWIND WORKF NRWORK=0 C C IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP. C 730 IF (TRANS.EQ.1) GO TO 10 740 RETURN C END SUBROUTINE EXCHCX (REASON) C C======================== C C PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER C PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT, C INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS. C VAX-11 VMS V2.4 VERSION C REVISED 820616 1500 C C RECOGNIZE THE TABS COMMAND. C TABS=Y or D MEANS HT IS DATA, TABS=N or T MEANS HT IS TAB. C INTEGER REASON C C REASON=0 FOR UNRECOGNIZED COMMAND. C REASON=1 BEFORE OPENING READER. C REASON=2 BEFORE OPENING INFILE (=INPUT FILE). C REASON=3 BEFORE OPENING INTEXT (=TEXT FILE). C REASON=4 BEFORE OPENING INALT (=INCLUDE FILE). C REASON=5 BEFORE OPENING OUFILE (=OUTPUT FILE). C REASON=6 BEFORE OPENING INTAPE. C REASON=7 BEFORE OPENING OUTAPE. C C C======================== C LOGICAL THERE C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF C CHARACTER*1 TABS CHARACTER*40 FNAMES(3) CHARACTER*11 FNMDEF(3) COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF COMMON /EXCVAX/ TABS,FNAMES EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA FNMDEF(1)/'EXCHXX.TMP '/,FNMDEF(2)/'TEIOXX.TES '/, * FNMDEF(3)/'TEIOXX.TES '/ C IF (REASON.NE.0) GO TO 10 C C COMMAND NOT RECOGNIZED BY EXCHC1. IF ICOMD=0 IT IS NOT A C COMMAND, ELSE CHECK PARAMETER OF TABS COMMAND. C IF (ICOMD.EQ.0) GO TO 150 IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 110 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 IF (J.EQ.68 .OR. J.EQ.89) THEN C 68 = ASCII D, 89 = ASCII Y. TABS='Y' GO TO 150 END IF IF (J.EQ.78 .OR. J.EQ.84) THEN C 78 = ASCII N, 84 = ASCII T. TABS='N' GO TO 150 END IF GO TO 110 C C PROCESS SYSTEM DEPENDENT INFORMATION 10 J=MAX0(REASON-4,1) K=MIN0(NCHCMD-EQUAL+1,40) IF (K.GT.0) THEN C C FIRST BLANK OUT FNAMES, THEN FILL IN FILE NAME FROM COMAND. FNAMES(J)=' ' DO 20 I=1,K L=COMAND(EQUAL+I-1) IF (L.GT.96 .AND. L.LT.123) L=L-32 20 FNAMES(J)(I:I)=CHAR(L) ELSE C C PLACE DEFAULT FILE NAMES IN FNAMES(*:*) FNAMES(J)=FNMDEF(J) C C PUT ASCII FORM OF LOGICAL UNIT NUMBER INTO (DEFAULT) FILE NAME. FNAMES(J)(5:6)=CHAR(NUMBER/10+48)//CHAR(MOD(NUMBER,10)+48) END IF IF (REASON-5) 50,70,150 C C OPEN INPUT FILE. C 50 CONTINUE C C IF THE 'T' OPTION HAS BEEN SELECTED AND THE FILE IS ALREADY OPEN, C DON'T OPEN IT AGAIN. C IF (OPTVAL(20).NE.0) THEN INQUIRE (FILE=FNAMES(1),OPENED=THERE,NUMBER=NUMOLD) IF (THERE .AND. NUMOLD.EQ.NUMBER) GO TO 150 END IF C MAKE A SPECIAL TEST FOR READER=5=TT:. IF (REASON.EQ.1 .AND. READER.EQ. 5) THEN FNAMES(1)='TT:' OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='OLD',ERR=90, * IOSTAT=IER) ELSE OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='UNKNOWN',ERR=90, * IOSTAT=IER) END IF GO TO 150 C C OPEN OUTPUT FILE. C 70 inquire (file=fnames(1),number=numold,opened=there) if (.not.there .or. (numold.ne.number)) *open (unit=number,file=fnames(1),status='UNKNOWN',err=90, *iostat=ier) GO TO 150 C C ERROR WHILE OPENING FILE. C 90 WRITE (PRINTR,100) IER,NUMBER,FNAMES(1) 100 FORMAT (//'0IOSTAT = ',Z8,', Unable to open unit',I3,' for file ', * A40) CALL LIB$SIGNAL(%VAL(IER)) GO TO 130 C C ERROR WHILE PROCESSING TABS COMMAND. C 110 WRITE (PRINTR,120) 120 FORMAT (//'0Missing or unrecognized parameter on TABS command.') C 130 WRITE (PRINTR,140) (HOLCMD(I),I=1,NCHCMD) 140 FORMAT (1X,80A1) C 150 CONTINUE RETURN C END SUBROUTINE EXCHC2 C C PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS. C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KINDE /32/ DATA KOPTI /14/ DATA KSITE /25/ C C FIGURE OUT WHICH COMMAND GOT US HERE. C IF (ICOMD-KOPTI) 60,150,10 10 IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270 C C ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT C WHERE C1, C2, STEP AND START ARE INTEGERS. C STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP, C START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF C CHARACTERS OF TEXT IN IDTXTL. IF AN ERROR OCCURS, C STORE ZERO IN IDSTEP AND IDTXTL. C IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO. C C STORE THE MODIFIER IN IDOPTN. C IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE C PRODUCED ONLY FOR IMAGES FROM INTAPE. IF THE O MODIFIER C IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES C WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT. IF THE F C MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION C OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE C PRODUCED FOR ALL IMAGES OUTPUT. IF THE C MODIFIER IS SPECIFIED, C SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH C RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR C ALL IMAGES OUTPUT. IF NONE OF THE I, F, OR C MODIFIERS ARE C SPECIFIED, THE O MODIFIER IS ASSUMED. C C IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED. C IF IDTXTL = ZERO, TEXT IS NOT EMITTED. C IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE C EMITTED. C C CONVERT C1,C2,STEP,START C IDOPTN=MODIFY IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79 C 70 = ASCII F, 73 = ASCII I, 79 = ASCII O. DO 40 J=1,4 NUMBER=0 20 IF (EQUAL.GT.NCHCMD) GO TO 40 IF (COMAND(EQUAL).EQ.44) GO TO 30 C 44 = ASCII , I=COMAND(EQUAL)-48 IF (I.LT.0) GO TO 350 IF (I.GT.9) GO TO 350 NUMBER=10*NUMBER+I EQUAL=EQUAL+1 GO TO 20 30 EQUAL=EQUAL+1 40 IDNBRS(J)=NUMBER IDCUR=IDSTRT IDCOL1=MAX0(1,MIN0(IDCOL1,178)) IDCOL2=MIN0(IDCOL2,178) C C STORE TEXT. C IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0) IF (IDTXTL.EQ.0) GO TO 330 DO 50 J=1,IDTXTL IDTEXT(J)=COMAND(EQUAL) 50 EQUAL=EQUAL+1 GO TO 330 C C INDEX = PARAMETER STRING C 60 J=0 IF (COMAND(EQUAL).NE.45) GO TO 70 C 45 = ASCII - J=-1 EQUAL=EQUAL+1 70 N=0 DO 80 I=1,26 80 INDEXS(I)=0 90 IF (EQUAL.GT.NCHCMD) GO TO 130 I=COMAND(EQUAL)-64 IF (I.EQ.-32) GO TO 120 C 32 = ASCII BLANK. IF (I.GE.32) I=I-32 C CONVERT TO UPPER CASE. IF (I.LE.0) GO TO 100 IF (I.LE.26) GO TO 110 100 N=EQUAL GO TO 120 110 INDEXS(I)=1 120 EQUAL=EQUAL+1 GO TO 90 130 INDEX=0 DO 140 I=1,26 INDEXS(I)=IABS(INDEXS(I)+J) 140 INDEX=INDEX+INDEXS(I) IF (MODIFY.EQ.76) INDEX=-INDEX C 76 = ASCII L. IF (N) 340,330,340 C C OPTION = PARAMETER STRING C 150 IF (MODIFY.NE.0) GO TO 170 DO 160 I=1,26 160 OPTVAL(I)=0 170 IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330 I=1 IF (MODIFY.EQ.67) I=0 C 67 = ASCII C. N=0 DO 190 J=EQUAL,NCHCMD K=COMAND(J) IF (K.GE.96) K=K-32 C CONVERT TO UPPER CASE. IF (K.EQ.32) GO TO 190 C 32 = ASCII BLANK IF (K.LT.65) GO TO 180 IF (K.GT.90) GO TO 180 C PROCESS ALPHABETIC OPTIONS. OPTVAL(K-64)=I GO TO 190 180 N=J 190 CONTINUE IF (N) 330,330,340 C C PROCESS PRED = ID REC A/X MASK STRING C WHERE ID = PREDICATE IDENTIFIER (A-H), C REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE, C A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH C IN EXACT POSITION, C MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE C TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED. C STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF C CONTROL RECORDS. C C THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR C PREDICATE A, ETC. C C PRED(1,*)=LENGTH OF STRING + 3 C PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED. C PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND). C PRED(3,*)=RECORD TYPE. C PRED(4,*)=A/X C PRED(5,*)=MASK CHARACTER. C PRED(6..42,*)=STRING. C 200 IF (EQUAL.NE.0) GO TO 240 C LIST ALL ACTIVE PREDICATES. DO 230 I=1,8 IF (PRED(1,I).EQ.0) GO TO 230 J=PRED(1,I)+1 COMAND(1)=I+64 DO 210 K=2,J 210 COMAND(K)=PRED(K+1,I) CALL EXCHAH (COMAND,J) WRITE (PRINTR,220) (COMAND(K),K=1,J) 220 FORMAT (6H PRED=,42A1) 230 CONTINUE GO TO 330 C SAVE PREDICATE IF VALID. 240 IF (NCHCMD.LE.EQUAL+3) GO TO 370 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.GT.72) GO TO 360 C 72 = ASCII H NUMBER=J-64 PRED(1,NUMBER)=0 EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.GT.90) GO TO 360 C 90 = ASCII Z IF (J.LT.65) GO TO 360 C 65 = ASCII A IF (J.EQ.82) GO TO 360 C 82 = ASCII R PRED(3,NUMBER)=J EQUAL=EQUAL+1 J=COMAND(EQUAL) IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. IF (J.NE.65.AND.J.NE.88) GO TO 360 C 65 = ASCII A, 88 = ASCII X PRED(4,NUMBER)=J EQUAL=EQUAL+1 PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40) I=4 DO 250 J=EQUAL,NCHCMD I=I+1 IF (I.GT.42) GO TO 330 K=COMAND(J) IF (K.GT.96) K=K-32 C CONVERT TO UPPER CASE. 250 PRED(I,NUMBER)=K GO TO 330 C C SITE = SITE NAME C 260 JUMP=1 GO TO 280 C C TITLE = OUTPUT TAPE TITLE C 270 JUMP=2 280 K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 320 I=1,40 IF (K.GT.NCHCMD) GO TO 290 J=COMAND(K) K=K+1 GO TO 300 290 J=32 C 32 = ASCII BLANK. 300 IF (JUMP.EQ.2) GO TO 310 SITE(I)=J GO TO 320 310 TITLE(I)=J 320 CONTINUE C C RETURN TO COMMAND DECODER. C 330 TRANS=1 GO TO 390 C C ERROR MESSAGES C 340 NUMBER=14 C MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED. EQUAL=N GO TO 380 350 IDSTEP=0 IDTXTL=0 360 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED. GO TO 380 370 NUMBER=30 C MESSAGE 30 - COMMAND IS INCOMPLETE. C 380 TRANS=8 C 390 RETURN C END SUBROUTINE EXCHC3 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE C COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES. C C OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE C NAME COMMAND. C C OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING C COPY, NAME OR UPDATE COMMANDS. C C ID IS USED TO CONSTRUCT THE OUTPUT LABEL. INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/ C A N G E DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/ DATA KNAME /9/ DATA KSKIP /26/ C C OPEN INTAPE IF NECESSARY C IF (INTOPN.NE.0) GO TO 70 IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300 IF (INTAPE.EQ.OUTAPE) GO TO 360 CALL EXCHRH (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 310 INTOPN=1 C COPY THE LABEL TO A SAVE AREA. DO 10 I=1,180 10 LABELI(I)=CBLCKI(I) CALL EXCHAH (CBLCKI(13),138) WRITE (PRINTR,20) 20 FORMAT (25H0INPUT LABEL INFORMATION.) WRITE (PRINTR,30) (CBLCKI(I),I=13,104) 30 FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/ 1 20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1) IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150) 40 FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1) WRITE (PRINTR,50) NDATAI 50 FORMAT (28H DATA CHARACTERS PER BLOCK =,I6) IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI 60 FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6) CHAR1L=0 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 290 70 IF (ICOMD.EQ.KSKIP) GO TO 270 C C OPEN OUTAPE IF NECESSARY C 80 IF (ICOMD.EQ.0) GO TO 90 IF (ICOMD.LT.KNAME) GO TO 100 90 IF (INTAPE*OUTAPE.EQ.0) GO TO 100 IF (OUTUPD.NE.85) GO TO 370 C 85 = ASCII U. 100 IF (OUTOPN.NE.0) GO TO 240 IF (OUTAPE.EQ.0) GO TO 240 C CONSTRUCT THE OUTPUT LABEL. IF (TODAY(1).EQ.0) GO TO 340 IF (INTOPN.EQ.0) GO TO 160 DO 110 I=1,180 110 CBLCKO(I)=LABELI(I) IF (TITLE(1).EQ.32) GO TO 130 C 32 = ASCII BLANK DO 120 I=1,40 120 CBLCKO(I+18)=TITLE(I) 130 IF (OUTUPD.NE.85) GO TO 220 C 85 = ASCII U. IF (SITE(1).EQ.0) GO TO 350 DO 140 I=1,6 140 CBLCKO(I+104)=TODAY(I) DO 150 I=1,40 150 CBLCKO(I+110)=SITE(I) GO TO 220 160 IF (TITLE(1).EQ.32) GO TO 330 C 32 = ASCII BLANK IF (SITE(1).EQ.0) GO TO 350 IF (INTAPE*OUTAPE.EQ.0) GO TO 170 IF (INTAPE.EQ.OUTAPE) GO TO 360 170 DO 180 I=1,8 180 CBLCKO(I)=ID(I) DO 190 I=1,40 CBLCKO(I+18)=TITLE(I) 190 CBLCKO(I+64)=SITE(I) DO 200 I=1,6 200 CBLCKO(I+58)=TODAY(I) DO 210 I=105,180 210 CBLCKO(I)=0 220 CALL EXCHWH (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 320 OUTOPN=1 CBLCKO(1)=CBLCKO(105) CALL EXCHAH (CBLCKO(13),138) WRITE (PRINTR,230) WRITE (PRINTR,30) (CBLCKO(I),I=13,104) 230 FORMAT (26H0OUTPUT LABEL INFORMATION.) IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150) WRITE (PRINTR,50) NDATAO IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO CHAR1L=0 240 IF (ICOMD-KNAME) 250,260,280 C C COPY C 250 TRANS=4 MODEI=1-MIN0(1,OUFILE+OPTL) IF (ICOMD.EQ.0) MODEI=0 GO TO 390 C C NAME C 260 TRANS=5 IF (NRWORK.EQ.0) PHASE=4 GO TO 390 C C SKIP C 270 TRANS=4 GO TO 390 C C UPDATE C 280 TRANS=5 MODEI=0 GO TO 390 C C ERROR MESSAGES C 290 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. EQUAL=ISTAT GO TO 380 300 NUMBER=4 C MESSAGE 4 - INTAPE NOT DEFINED. GO TO 380 310 NUMBER=5 C MESSAGE 5 - UNABLE TO OPEN INTAPE. EQUAL=ISTAT GO TO 380 320 NUMBER=6 C MESSAGE 6 - UNABLE TO OPEN OUTAPE. EQUAL=ISTAT GO TO 380 330 NUMBER=7 C MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE. GO TO 380 340 NUMBER=8 C MESSAGE 8 - DATE NOT SUPPLIED. GO TO 380 350 NUMBER=9 C MESSAGE 9 - SITE NOT SUPPLIED. GO TO 380 360 NUMBER=10 C MESSAGE 10 - INTAPE = OUTAPE. GO TO 380 370 NUMBER=11 C MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED. 380 TRANS=8 C C RETURN TO TRANSITION PROGRAM C 390 RETURN C END SUBROUTINE EXCHRH (ISTAT,DBLOCK) C C READ THE HEADER LABEL FROM THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE C NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C OPEN THE INPUT TAPE. C ISTAT=1 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C READ A BLOCK. C NDATAI=171 NERRCI=0 BLKSQI=0 ISTAT=3 CALL EXCHRT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 25 C C FIND OUT IF IT IS A PROPER LABEL. C CALL EXCHUN (DBLOCK,CBLCKI) DO 10 I=1,8 IF (CBLCKI(I).NE.ID(I)) GO TO 20 10 CONTINUE C C GET READY TO READ THE REST OF THE TAPE. C CCDBI=NCDBI NDATAI=256*CBLCKI(9)+CBLCKI(10) NERRCI=256*CBLCKI(11)+CBLCKI(12) LASTI=0 L1PRGI=0 ISTAT=0 GO TO 30 C C NOT A LABEL. C 20 ISTAT=6 C C CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK. 25 I=4 CALL EXCHRT (I,DBLOCK) C 30 RETURN C END SUBROUTINE EXCHWH (ISTAT,DBLOCK) C C WRITE A HEADER ONTO THE EXCHANGE TAPE. C C ISTAT = 0 IF EVERYTHING IS OK. C ISTAT = 3 IF AN I/O ERROR OCCURRED. C ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE C WRITTEN ARE NOT EQUAL EXCHANGE. C C DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO C TAPE). INTEGER DBLOCK(1) INTEGER ID(8) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C E X C H DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/ C A N G E DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/ C C MAKE SURE IT IS A PROPER LABEL. C DO 10 I=1,8 IF (CBLCKO(I).NE.ID(I)) GO TO 30 10 CONTINUE C C OPEN THE OUTPUT TAPE. C ISTAT=1 CALL EXCHWT (ISTAT,DBLOCK) IF (ISTAT.NE.0) GO TO 40 C C CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR C CONTROL CHARACTERS C CBLCKO(9)=NDATAO/256 CBLCKO(10)=MOD(NDATAO,256) CBLCKO(11)=NERRCO/256 CBLCKO(12)=MOD(NERRCO,256) C C INSERT TODAYS DATE C DO 20 I=1,6 20 CBLCKO(I+12)=TODAY(I) C C WRITE THE BLOCK ON TAPE. C BLKSQO=0 CALL EXCHPA (CBLCKO,DBLOCK) CCDBO=180 ISTAT=2 CALL EXCHWT (ISTAT,DBLOCK) C C GET READY TO WRITE THE REST OF THE FILE. C L1PRGO=0 LLPRGO=0 N1RECO=0 NLRECO=0 L1RECO=0 LASTO=0 CCDBO=NERRCO+10 CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1 CPCBO=MOD(CCDBO-1,NCCBO)+1 GO TO 40 C C NOT A PROPER LABEL. C 30 ISTAT=6 C 40 RETURN C END SUBROUTINE EXCHC4 (IBLOCK) INTEGER IBLOCK(1) C C PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM C COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA KCOPY /3/ C C ARE WE STARTING OR CONTINUING? C C ICOMD.EQ.0 MEANS CHANGE A CONTROL RECORD C ICOMD.GT.0 MEANS SKIP OR COPY COMMAND BEGIN C ICOMD.EQ.-1 MEANS CONTINUE COPY = NUMBERS C ICOMD.EQ.-2 MEANS CONTINUE COPY = PREDICATE EXPRESSION NEWP=0 IF (ITYPEI.EQ.80) VERT=0 C 80 = ASCII P. WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO C IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON C THE WORK FILE. IF (ICOMD.EQ.0) GO TO 190 C ICOMD=0 MEANS CHANGING A CONTROL RECORD. IF (ICOMD+1) 290,170,10 10 IF (ICOMD.EQ.KCOPY) GO TO 30 C C SKIP COMMAND. C IF (INTOPN.LT.0) GO TO 430 if (modify.eq.70) number=number+n1reci-1 c 70 = ASCII F. IF (NUMBER+1-N1RECI) 540,430,20 20 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.EQ.69) GO TO 460 C 69 = ASCII E. IF (N1RECI-NUMBER) 20,20,430 C C COPY COMMAND FORMAT VERIFICATION. C 30 IF (COMAND(EQUAL).LT.48) GO TO 180 C 48 = ASCII ZERO IF (COMAND(EQUAL).GT.57) GO TO 180 C 57 = ASCII NINE C C COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS. C CONVERT THE NUMBERS AND STORE THEM IN COMAND. IF THE NUMBER C IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER. C ICOMD=-1 I=0 J=44 C 44 = ASCII COMMA 40 I=I+1 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 480 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=NUMBER 50 EQUAL=EQUAL+1 IF (EQUAL.GT.NCHCMD) GO TO 60 NUMBER=COMAND(EQUAL)-48 C 48 = ASCII ZERO IF (NUMBER.LT.0) GO TO 60 IF (NUMBER.GT.9) GO TO 480 COMAND(I)=10*COMAND(I)+NUMBER GO TO 50 60 IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70 70 IF (J.EQ.45) COMAND(I)=-COMAND(I) C 45 = ASCII DASH IF (EQUAL.GT.NCHCMD) GO TO 90 J=COMAND(EQUAL) IF (J.EQ.32 .OR. J.EQ.46) GO TO 90 C 32 = ASCII BLANK, 46 = ASCII PERIOD. IF (J.NE.44.AND.J.NE.45) GO TO 480 C 44 = ASCII COMMA, 45 = ASCII DASH 80 EQUAL=EQUAL+1 IF (COMAND(EQUAL)-32) 40,80,40 C 32 = ASCII BLANK 90 NUMBER=I C FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE C POSITION IN COMAND CURRENTLY BEING EXAMINED. EQUAL=-1 100 EQUAL=EQUAL+1 IF (EQUAL.GE.NUMBER) GO TO 470 IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100 IF (EQUAL.EQ.0) GO TO 120 WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD) 110 FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H) 1NOT COPIED./(1X,80A1)) NERRG=MAX0(NERRG,5) 120 IF (COMAND(EQUAL+1).GT.0) GO TO 130 EQUAL=EQUAL-1 COMAND(EQUAL+1)=N1RECI 130 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. C C PROCESS COPY = LIST OF NUMBERS C 140 EQUAL=EQUAL+1 C GO COPY THE PROGRAM IF IT IS THE RIGHT ONE. 150 IF (INTOPN.LT.0) GO TO 430 IF (COMAND(EQUAL)-N1RECI) 170,420,160 C SKIP TO DESIRED PROGRAM 160 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI-69) 150,460,150 C 69 = ASCII E 170 IF (EQUAL.GE.NUMBER) GO TO 430 IF (COMAND(EQUAL+1).GE.0) GO TO 140 COMAND(EQUAL)=IABS(COMAND(EQUAL))+1 IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420 EQUAL=EQUAL+1 GO TO 170 C C COPY = SELECTION STRING OR CHANGE CONTROL RECORD. C 180 ICOMD=-2 IF (NRWORK.GT.0) GO TO 420 C IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED. NRWORK=-1 C C DETERMINE NEED TO OPEN WORK FILE. C 190 IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0) 1IF (ICOMD) 290,430,290 IF (WORKF.EQ.0) GO TO 500 I=IABS(WORKF) IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510 IF (WORKF.GT.0) GO TO 200 WORKF=I CALL EXCHFO (3) 200 IF (ICOMD.NE.0) GO TO 280 C C CHANGE CONTROL RECORD. C if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520 c 69 = ascii E, 73 = ascii I. if (nrwork.eq.0) go to 210 if (itypei.eq.80) go to 520 c 80 = ascii P 210 IF (NUMBER-NRWORK-1) 530,220,410 220 NCHACT=NCHCMD+1-EQUAL IF (NCHACT.GT.0) GO TO 230 NCHACT=1 INTREC(1)=32 C 32 = ASCII BLANK GO TO 425 230 DO 240 I=1,NCHACT 240 INTREC(I)=COMAND(EQUAL+I-1) GO TO 425 C C COPY = SELECTION EXPRESSION. C C SKIP TO NEXT PROGRAM. 250 IF (INTOPN.LT.0) GO TO 430 if (itypei.eq.69) go to 460 c 69 = ASCII E. do 260 i = 1, 8 260 pred(2,i)=0 if (itypei.ne.80) go to 265 c If the current record is a new program, don't skip it (we haven't c processed it yet). if (nrwork.gt.0 .and. workf.gt.0) rewind workf nrwork=min0(nrwork,0) newp=0 go to 320 265 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440 nxnewp=0 270 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 440 IF (ITYPEI.NE.80) GO TO 310 C 80 = ASCII P NEWP=nxnewp c Set NEWP non-zero when all control records for a module have been c seen. GO TO 320 280 NRWORK=MAX0(NRWORK,0) 290 DO 300 I=1,8 300 PRED(2,I)=0 c NEWP is non-zero when all control records have been read. 310 if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1 C 69 = ASCII E, 73 = ASCII I. 320 nxnewp=1 if (icomd.eq.0) if (newp) 520,210,520 IF (LIMIT.EQ.0) GO TO 340 IF (N1RECI.LE.LIMIT) GO TO 340 WRITE (PRINTR,330) LIMIT 330 FORMAT (7H LIMIT=,I6,9H REACHED.) GO TO 430 340 IF (NEWP.EQ.0) GO TO 360 CALL EXCHLX C EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'. NUMBER=NCHCMD IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415 C 73 = ASCII I. IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425 C 80 = ASCII P. IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425 C 83 = ASCII S. IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415 C 88 = ASCII X. IF (COMAND(180)) 450,250,420 C CONTROL RECORD. EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE. 360 I=1 DO 400 NUMBER=1,8 IF (PRED(1,NUMBER).EQ.0) GO TO 400 IF (PRED(2,NUMBER).NE.0) GO TO 400 IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390 NM=PRED(1,NUMBER)-3 IF (.NOT.(NCHACT.GT.0)) GO TO 390 DO 385 L = 1, NCHACT DO 380 J = 1, NM C C DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND C IN PREDICATE. IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380 IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370 C C NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS. K=32 GO TO 375 C USE CHARACTER FROM CONTROL RECORD. 370 K=INTREC(J+L-1) C C CONVERT LOWER CASE LETTERS TO UPPER CASE. IF (K.GT.96 .AND. K.LT.123) K=K-32 C C TEST FOR A MATCH ON A SINGLE CHARACTER. C IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE C PATTERN. IF THE SEARCH MODE IS X, TERMINATE THE SEARCH. 375 IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390 380 CONTINUE C C FOUND A MATCH IN CONTROL RECORD AND PREDICATE. PRED(2,NUMBER)=1 GO TO 400 385 CONTINUE 390 I=0 400 CONTINUE IF (I.NE.0) newp=1 IF (NRWORK.LT.0) GO TO 270 C AT LEAST ONE FALSE PREDICATE. WRITE THE CONTROL RECORD ON WORKF. 410 WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT) NRWORK=NRWORK+1 GO TO 270 C C GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM. C 415 ICOMD=-3 C RETURN TO EXCHC1 AFTER COPYING MODULE. 420 TRANS=5 GO TO 570 C C RETURN TO THE COMMAND PROCESSOR. C 425 TRANS=1 C REMEMBER CONTROL RECORDS ON WORKF. GO TO 570 430 TRANS=1 IF (ICOMD+1) 560,570,570 C C ERROR MESSAGES. C 440 NUMBER=1 C MESSAGE 1 - I/O ERROR. EQUAL=ISTAT GO TO 550 450 NUMBER=-COMAND(180) C MESSAGES GENERATED BY EXCHLX GO TO 550 460 IF (INTOPN.LT.0) GO TO 430 INTOPN=-1 EQUAL=NUMBER NUMBER=15 C MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE. GO TO 550 470 NUMBER=16 C MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION. GO TO 550 480 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER GO TO 550 490 NUMBER=18 C MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER. GO TO 550 500 NUMBER=19 C MESSAGE 19 - WORK FILE NOT DEFINED. GO TO 550 510 NUMBER=20 C MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE. GO TO 550 520 EQUAL=NUMBER NUMBER=21 C MESSAGE 21 - CONTROL RECORD NOT PRESENT GO TO 550 530 NUMBER=22 C MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER. GO TO 550 540 NUMBER=29 C MESSAGE 29 - BACKWARD SKIP IGNORED. C C RETURN TO THE ERROR MESSAGE PROCESSOR. C 550 TRANS=8 IF (ICOMD.EQ.0) GO TO 570 C C DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF. C 560 IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF NRWORK=MIN0(NRWORK,0) C C RETURN TO TRANSITION PROGRAM. C 570 RETURN C END SUBROUTINE EXCHLX C C EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND. C C THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE C STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM C COPY=LOGICAL EXPRESSION. THE LOGICAL EXPRESSION CONSISTS OF THE C EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY C OPERATORS + - * / AND PARENEHESES. THE PRIMARY SYMBOLS A-H ARE C LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE C STATEMENTS. THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE C NULL PREDICATE, WHICH IS ALWAYS FALSE. THE OPERATORS + - * / ARE C THE BINARY LOGICAL OPERATIONS OR, OR NOT, AND, AND NOT C RESPECTIVELY. THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE C PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL C PRIORITY. THE RELATIVE PRIORITY MAY BE CHANGED BY USING C PARENTHESES. C C WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY C FALSE. AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL C FALSE PREDICATES IS DETERMINED. ONCE TRUE, A PREDICATE REMAINS C TRUE. THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND C A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE. WHEN ALL ACTIVE C PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM C HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND C IS EVALUATED. IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED. C IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED. THIS PROCESS C CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM C NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED. C C THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE C TABLE BELOW. INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS C APPENDED TO THE END OF THE LOGICAL EXPRESSION. C C PREVIOUS I CURRENT TOKEN I C TOKEN I + - * / I PRIMARY I ( I ) I ELSE I C ----------I---------I---------I---------I---------I---------I C + - * / I ERROR I OK I OK I ERROR I ERROR I C PRIMARY I OK I ERROR I ERROR I OK I ERROR I C ( I ERROR I OK I OK I OK I ERROR I C ) I OK I ERROR I ERROR I OK I ERROR I C ----------I---------I---------I---------I---------I---------I C C CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING C A STACK AND THE PRECEDENCE TABLE BELOW. TOS MEANS TOP-OF-STACK, C HOI MEANS HEAD-OF-INPUT. THE STACK INITIALLY CONTAINS (. C C TOS HOI C TOKEN I INDEX I INDEX I C ---------I---------I---------I C + - I 2 I 1 I C * / I 4 I 3 I C PRIMARY I 6 I 5 I C ( I 0 I 7 I C ) I N/A I 0 I C ---------I---------I---------I C C WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS C PUSHED ONTO THE STACK. WHEN THE TOS INDEX IS GREATER THAN THE HOI C INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY C SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT C PLACED IN THE SUFFIX LIST. THEN THE RELATION OF THE TOS INDEX TO C THE HOI INDEX IS RE-EXAMINED. WHEN THE TOS INDEX IS EQUAL TO THE C HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED. C C ***** INTERNAL VARIABLES ********************************* C C CHTAB RECOGNIZED CHARACTERS. INTERNAL PROCESSES USE THE INDEX C INTO CHTAB. C COLTAB CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX. C HOI CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE. C INFIX IS THE CURRENT POSITION IN THE INFIX. C IPREV IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN. C ISTACK IS THE CURRENT STACK INDEX. C ISUFIX IS THE CURRENT SUFFIX INDEX. C SYNTAX CONTAINS THE SYNTAX RULES. C TOS CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE. C INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15) C C ***** COMMON VARIABLES *********************************** C INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** DATA STATEMENTS ************************************ C C A B C D DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/ C E F G H DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/ C N + - * DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/ C / ( ) DATA CHTAB(13),CHTAB(14),CHTAB(15) /47,40,41 / C A B C D DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/ C E F G H DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/ C N + - * DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/ C / ( ) DATA COLTAB(13),COLTAB(14),COLTAB(15) /1,3,4 / C A B C D E DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/ C F G H N + DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/ C - * / ( ) DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/ C CURRENT TOKEN IS +-*/. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/ C CURRENT TOKEN IS PRIM. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/ C CURRENT TOKEN IS (. NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/ C CURRENT TOKEN IS ). NEXT TOKEN IS +-*/ P ( ) DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/ C A B C D E DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/ C F G H N + DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/ C - * / ( ) DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/ C C ***** PROCEDURES ***************************************** C C COMAND IS USED FOR INFIX, STACK AND SUFFIX. UPON COMPLETION, C COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE C OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE C EXPRESSION IS TRUE. C ISTACK=NCHCMD+2 COMAND(ISTACK)=14 ISUFIX=181 IPREV=3 COMAND(NCHCMD+1)=41 INFIX=EQUAL-1 C C GET A CHARACTER FROM INFIX. LOOK UP IN CHTAB. CHECK SYNTAX. C 10 IF (INFIX.GT.NCHCMD) GO TO 180 INFIX=INFIX+1 J=COMAND(INFIX) IF (J.EQ.32) GO TO 10 C 32 = ASCII BLANK - IGNORE IT. IF (J.GT.96) J=J-32 C CONVERT TO UPPER CASE. DO 20 I=1,15 IF (CHTAB(I).EQ.J) GO TO 30 20 CONTINUE GO TO 230 30 J=COLTAB(I) IF (SYNTAX(IPREV,J)-1) 40,190,200 C C CONVERT INFIX TO SUFFIX C 40 IPREV=J 50 J=COMAND(ISTACK) IF (TOS(J)-HOI(I)) 60,70,80 C PUSH INFIX ONTO STACK 60 ISTACK=ISTACK+1 COMAND(ISTACK)=I GO TO 10 C DELETE TOP OF STACK 70 ISTACK=ISTACK-1 IF (ISTACK.GT.NCHCMD+1) GO TO 10 IF (INFIX-NCHCMD) 220,220,250 C IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX. C IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX. 80 IF (J-9) 90,100,130 C PRIMARY IS SYMBOL A-H 90 IF (PRED(1,J).EQ.0) GO TO 210 J=PRED(2,J) GO TO 110 C NULL PREDICATE 100 J=0 110 ISUFIX=ISUFIX-1 120 COMAND(ISUFIX)=J ISTACK=ISTACK-1 GO TO 50 C OPERATOR 130 J=J-9 ISUFIX=ISUFIX+1 GO TO (140,150,160,170), J C + - * / 140 J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1) GO TO 120 150 J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1) GO TO 120 160 J=COMAND(ISUFIX)*COMAND(ISUFIX-1) GO TO 120 170 J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1)) GO TO 120 C 180 COMAND(180)=-23 C MESSAGE 23 - TOO MANY ( GO TO 240 190 COMAND(180)=-24 C MESSAGE 24 - MISSING PRIMARY GO TO 240 200 COMAND(180)=-25 C MESSAGE 25 - MISSING OPERATOR GO TO 240 210 EQUAL=CHTAB(J) CALL EXCHAH (EQUAL,1) COMAND(180)=-26 C MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE. GO TO 250 220 COMAND(180)=-27 C MESSAGE 27 - TOO MANY ) GO TO 240 230 COMAND(180)=-28 C MESSAGE 28 - UNRECOGNIZED CHARACTER C 240 EQUAL=INFIX 250 RETURN C END SUBROUTINE EXCHC5 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE, C AND INDEX IF SELECTED. COPY RECORDS FROM WORKF FIRST, IF ANY. C CREATE CONTROL RECORDS DEMANDED BY COMMANDS. C C THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF C THE PARAMETER STRING. C C AUTHOR C COMMENT C CONTROL (ITYPEO SET FROM MODIFY) C DATA TYPE C GROUPS C INSERT C KEYWORDS C MACHINE C ORIGIN C REFERENCES C REMOVE (FIRST CHARACTER OF PARAMETER STRING ONLY) C SIGNAL (FIRST CHARACTER OF PARAMETER STRING ONLY) C UPDATE C C IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS C ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A C CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND. C C ***** LOCAL VARIABLES ************************************ C C BLANK CONTAINS A HOLLERITH BLANK. INTEGER BLANK C C1 IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING. INTEGER C1 C COL1 THE FIRST COLUMN OF TEXT OF A CONTROL RECORD. DERIVED FROM C EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE. INTEGER COL1 C I,J USED FREELY AS INDICES. INTEGER I,J C KCONT THE INDEX IN COMD OF THE CONTROL COMMAND. INTEGER KCONT C KNAME IS THE INDEX IN COMD OF THE NAME COMMAND. INTEGER KNAME C KTEXT THE INDEX IN COMD OF THE TEXT COMMAND. INTEGER KTEXT C KUPDA THE INDEX IN COMD OF THE UPDATE COMMAND. INTEGER KUPDA C LIST CONTAINS THE WORD LIST IN ASCII. USED FOR THE A OPTION. INTEGER LIST(4) C NM IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED. INTEGER NM C NOUT IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED. INTEGER NOUT C NY IS THE PROGRAM NUMBER. IT IS THE NUMBER FROM INTAPE IF C OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE. INTEGER NY C ONE CONTAINS A HOLLERITH 1. INTEGER ONE C REASON REASON FOR COPYING A CONTROL RECORD. 1 = COPY COMMAND C PENDING. 2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8. C 3 = COMMAND. INTEGER REASON C RI CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A C GIVEN RECORD TYPE. RI IS SUBSCRIPTED BY (ITYPEO-64). INTEGER RI(26) C RT IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT. INTEGER RT(34) C STAR CONTAINS A HOLLERITH STAR. INTEGER STAR C ZERO CONTAINS A HOLLERITH ZERO. INTEGER ZERO C C ***** COMMON VARIABLES *********************************** C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C C ***** LOCAL VARIABLE DATA ******************************** C DATA BLANK /1H / C L I S T DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/ C DATA KCONT /31/ DATA KNAME /9/ DATA KTEXT /27/ DATA KUPDA/29/ DATA ONE /1H1/ C A B C D E F DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/ C G H I J K L DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/ C M N O P Q R DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/ C S T U V W X DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/ C Y Z DATA RI(25),RI(26) /31,31 / C A C D G DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/ C P K DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/ C M O DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/ C B R DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/ C S DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/ C J DATA RT(31),RT(32),RT(33),RT(34) /-1, 0, 0,74/ C DATA STAR /1H*/ DATA ZERO /1H0/ C C ***** PROCEDURES ***************************************** C REASON=1 NY=N1RECI IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1 C ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P. C IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT. IF (PHASE.EQ.4) NY=0 C NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER. (IT IS PRINTED C IN THE INDEX). IF (ICOMD.LE.0) GO TO 10 IF (PHASE.GE.4) GO TO 100 IF (ICOMD.EQ.KNAME) GO TO 10 IF (ICOMD.NE.KUPDA) GO TO 100 REASON=2 PHASE=8 10 IF (NRWORK.GT.0) REWIND WORKF NM=0 NOUT=0 20 NM=NM+1 IF (NM.LE.NRWORK) GO TO 60 30 IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230 C 69 = ASCII E, 73 = ASCII I. IF (NOUT.EQ.0) GO TO 40 IF (ITYPEI.EQ.80) GO TO 230 C 80 = ASCII P. IF (NCHACT.NE.1) GO TO 40 IF (INTREC(1).EQ.32) GO TO 220 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 40 ITYPEO=ITYPEI NCHOUT=NCHACT DO 50 J=1,NCHOUT 50 OUTREC(J+5)=INTREC(J) GO TO 70 60 READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT) IF (NCHOUT.NE.1) GO TO 70 IF (NM.EQ.1) GO TO 70 IF (OUTREC(6).EQ.32) GO TO 200 C 32 = ASCII BLANK. DELETE BLANK CONTROL RECORDS. 70 NOUT=NOUT+1 J=RI(ITYPEO-64) DO 80 I=1,4 80 OUTREC(I)=COMD(I,J) OUTREC(5)=61 C 61 = ASCII = COL1=5 IF (J.NE.KCONT) GO TO 130 COL1=7 C CONTROL,*=... MOVE UP TWO CHARACTERS AND INSERT ITYPEO. DO 90 I=1,NCHOUT 90 OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I) OUTREC(5)=44 C 44 = ASCII COMMA. OUTREC(6)=ITYPEO OUTREC(7)=61 C 61 = ASCII = GO TO 130 100 IF (ICOMD.EQ.KTEXT) GO TO 240 COL1=EQUAL-1 NCHOUT=NCHCMD-COL1 NRWORK=NRWORK+1 C NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD. ITYPEO=RT(ICOMD) IF (ITYPEO.GT.0) GO TO 110 C PROCESS CONTROL,TYPE=TEXT COMMAND. ITYPEO=MODIFY IF (RI(ITYPEO-64).NE.KCONT) GO TO 320 110 NOUT=NRWORK REASON=3 DO 120 I=1,NCHCMD 120 OUTREC(I)=COMAND(I) 130 IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1) C 74 = ASCII J. IF (ITYPEO.EQ.80) VERT=0 C 80 = ASCII P IF (ITYPEO.NE.68) GO TO 150 C 68 = ASCII D IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150 DO 140 J=1,4 I=OUTREC(J+COL1) IF (I.GT.96 .AND. I.LT.123) I=I-32 C CONVERT TO UPPER CASE. IF (I.NE.LIST(J)) GO TO 150 140 CONTINUE VERT=1 C GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE. 150 CALL EXCHCG (OUTREC(COL1+1)) IF (OUTOPN.EQ.0) GO TO 160 CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1)) IF (ISTAT.NE.0) GO TO 340 NY=NLRECO 160 NCHOUT=NCHOUT+COL1 C TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER. OUTREC(180)=-NOUT IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC) C PRINT THE INDEX IF SELECTED. IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 1190 IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190 C1=BLANK C DOUBLE SKIP FOR PROGRAM HEADER (P). IF (ITYPEO.EQ.80) C1=ZERO IF (OPTV+VERT.NE.0) GO TO 170 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170 IF (CHAR1L.NE.ONE) C1=ONE CHAR1L=ONE 170 CALL EXCHAH (OUTREC,NCHOUT) WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT) 180 FORMAT (A1,2I5,1H*,(3X,105A1)) 190 IF (REASON.EQ.3) GO TO 310 200 IF (NM-NRWORK) 20,210,220 210 REWIND WORKF NRWORK=0 GO TO 30 220 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT) 330,30,330 230 IF (REASON.EQ.2) GO TO 300 240 IF (OUFILE.EQ.0) GO TO 260 DO 250 I=1,4 250 OUTREC(I)=COMD(I,KTEXT) OUTREC(180)=0 NCHOUT=0 C TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED. CALL EXCHCG (OUTREC) NCHOUT=4 ACTION=2-OPTC-OPTC C ACTION = 2 MEANS START OF PROGRAM. CALL EXCHOU (OUTREC) 260 IF (OPTV+VERT.NE.0) GO TO 280 IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280 IF (OUTOPN.NE.0) NY=NLRECO I=BLANK IF (CHAR1L.NE.ONE) I=ONE WRITE (PRINTR,270) I,NY 270 FORMAT (A1,I5,1H*,8X,4HTEXT/) 280 CHAR1L=STAR NRWORK=MIN0(NRWORK,0) IF (IDOPTN.NE.67) IDCUR=IDSTRT C 67 = ASCII C IF (ICOMD.EQ.KTEXT) GO TO 290 C C WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL C RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED. C TRANS=6 GO TO 370 C C WORKING ON A TEXT STATEMENT. C 290 TRANS=7 GO TO 370 C C WORKING ON AN UPDATE STATMENT. C 300 NRWORK=NOUT GO TO 100 C C WRITING A SINGLE CONTROL RECORD. C 310 TRANS=1 GO TO 370 C C ERROR MESSAGES. C 320 NUMBER=17 C MESSAGE 17 - UNRECOGNIZED CHARACTER. GO TO 360 330 NUMBER=1 GO TO 350 340 NUMBER=2 350 EQUAL=ISTAT 360 TRANS=8 C C RETURN TO TRANSITION PROGRAM. C 370 RETURN C END SUBROUTINE EXCHCG (RECORD) C C USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL. C WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED. C THIS IS THE PORTABLE VERSION. IT DOES NOT DO ANYTHING. C INTEGER RECORD(1) C INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO C RETURN END SUBROUTINE EXCHC6 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE. C INTEGER KNAME,ONE,SVHCMD(180) C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KNAME /9/ DATA ONE /1H1/ C LINEO=0 NERRS=0 C SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT. DO 5 I = 1,NCHCMD 5 SVHCMD(I)=HOLCMD(I) IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165 C 73 = ASCII I. IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE C A VOID MODULE. IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10 CALL EXCHNP (ISTAT,IBLOCK) IF (ISTAT.EQ.7) GO TO 220 IF (ISTAT) 250,160,250 10 MODEO=MODEI ITYPEO=0 NBC=OPTL+OUFILE IF (INDEX.GT.0) NBC=1 20 NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTOPN.EQ.0) GO TO 120 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 260 C C CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD C INSTEAD OF BYTE-BY-BYTE). WE CAN DO A BLOCK COPY IF C WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT C FILE AND NOT PRINTING THE INDEX. ALSO, THE INPUT AND C OUTPUT CHARACTER POSITIONS MUST BE THE SAME. IF THE C PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH C THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE C CURRENT POSITION IN THE BYTE BUFFER BE THE SAME. C WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE C LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T C KNOW THE LOCATION OF THE END-OF-FILE RECORD. C IF (NBC.NE.0) GO TO 120 IF (CPCBI+1.NE.CPCBO) GO TO 120 IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120 C WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF. IF (L1PRGI.EQ.0) GO TO 25 IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30 25 IF (CCDBI+1.NE.CCDBO) GO TO 120 IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120 C WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE). C FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO. 30 LI=L1PRGI+NERRCI-1 IF (L1PRGI.NE.0) GO TO 40 LI=NERRCI+NDATAI+9 IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1 40 IF (CPCBI.GE.NCCBI) GO TO 50 IF (CCDBI.GE.LI) GO TO 160 CPCBI=CPCBI+1 CBLCKO(CPCBO)=CBLCKI(CPCBI) CPCBO=CPCBO+1 CCDBI=CCDBI+1 CCDBO=CCDBO+1 GO TO 40 C PACK COPIED BYTES. 50 CALL EXCHPA (CBLCKO,OBLOCK(CWDBO)) CPCBO=1 CPCBI=0 CWDBO=CWDBO+NWCBO CWDBI=CWDBI+NWCBI C NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM 60 IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70 IF (N1RECO.EQ.0) N1RECO=NLRECO IF (L1RECO.EQ.0) L1RECO=L1RECI CALL EXCHPB (ISTAT,OBLOCK) IF (ISTAT.NE.0) GO TO 260 70 IF (CCDBI.LT.LI) GO TO 80 IF (L1PRGI.NE.0) GO TO 100 CALL EXCHGB (ISTAT,IBLOCK) IF (ISTAT.NE.0) GO TO 250 GO TO 30 80 NW=NWCBI*((LI-CCDBI)/NCCBI) IF (NW.EQ.0) GO TO 100 DO 90 I=1,NW OBLOCK(CWDBO)=IBLOCK(CWDBI) CWDBO=CWDBO+1 90 CWDBI=CWDBI+1 100 CCDBO=CCDBO+LI-CCDBI CCDBI=LI IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60 CPCBI=MOD(LI,NCCBI) CPCBO=MOD(CCDBO-1,NCCBO)+1 CALL EXCHUN (IBLOCK(CWDBI),CBLCKI) IF (CPCBI.EQ.0) GO TO 160 DO 110 I=1,CPCBI 110 CBLCKO(I)=CBLCKI(I) GO TO 160 C C END OF BLOCK COPY CODE. C 120 CALL EXCHTP (INTREC,LINEO) 160 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 250 IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20 C 73 = ASCII I. 165 IF (OPTL.NE.0) GO TO 180 IF (INDEX.LE.0) GO TO 195 WRITE (PRINTR,170) LINEO 170 FORMAT (I9,14H IMAGES COPIED) GO TO 200 180 WRITE (PRINTR,190) 190 FORMAT (1H1) 195 CHAR1L=ONE 200 IF (OUFILE.EQ.0) GO TO 210 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 210 IF (ITYPEI.EQ.69) GO TO 220 C 69 = ASCII E C C RETURN TO THE COPY CONTROL SEGMENT. C DO 215 I=1,NCHCMD 215 HOLCMD(I)=SVHCMD(I) IF (ICOMD.EQ.-3) GO TO 240 C ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE. TRANS=4 IF (ICOMD.NE.KNAME) GO TO 280 C MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME' C COMMAND SUBMITTED. GO PROCESS 'NAME' COMMAND. TRANS=5 PHASE=4 GO TO 280 C C END OF FILE ON INPUT TAPE. C 220 IF (INTOPN.LT.0) GO TO 240 WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD) 230 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1)) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 240 TRANS=1 GO TO 280 C C ERROR MESSAGES. C 250 NUMBER=1 C MESSAGE 1 - I/O ERROR READING INTAPE. GO TO 270 260 NUMBER=2 C MESSAGE 2 - I/O ERROR WRITING OUTAPE. 270 TRANS=8 EQUAL=ISTAT C C RETURN TO THE TRANSITION PROGRAM. C 280 IF (NERRS.EQ.0) GO TO 300 WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD) 290 FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./ 1(1X,80A1)) NERRG=MAX0(NERRS,NERRG) 300 RETURN C END SUBROUTINE EXCHC7 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40) C C PROCESS THE TEXT COMMAND. C C MSG IS USED TO PRINT A MESSAGE. INTEGER MSG(6,2) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/ DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/ DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/ DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/ DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/ C LINEI=1 LINEO=0 NERRS=0 INEND=0 CHAR1L=STAR C C SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND C K=EQUAL IF (K.EQ.0) K=NCHCMD+1 DO 20 I=1,40 IF (K.GT.NCHCMD) GO TO 10 J=COMAND(K) K=K+1 GO TO 20 10 J=32 C 32 = ASCII BLANK. 20 TXDISK(I)=J IF (INTOPN.LE.0) ITYPEI=0 C C MAIN PROCESSING LOOP C 60 EDIT=0 70 CALL EXCHIM IF (NCHCMD.LT.0) GO TO 80 C NCHCMD.LT.0 MEANS END OF FILE. IF (NCHCMD.LT.2) GO TO 100 IF (COMAND(1).NE.SIGNAL) GO TO 100 IF (COMAND(2).EQ.SIGNAL) GO TO 80 IF (COMAND(2).EQ.73) GO TO 370 IF (COMAND(2).EQ.105) GO TO 370 C 73,105 = ASCII I - REQUEST TO INCLUDE TEXT. IF (NCHCMD.LT.3) GO TO 100 IF (COMAND(2).NE.61) GO TO 100 C 61 = ASCII = SIGNAL=COMAND(3) GO TO 70 C END OF TEXT FILE. 80 IF (INTEXT.EQ.0) GO TO 90 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE CALL EXCHIM INTEXT=0 NCHCMD=0 90 NCHCMD=MIN0(NCHCMD,0) IF (PHASE.NE.8) GO TO 660 IF (INEND) 660,630,660 100 IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110 110 IF (EDIT.EQ.0) GO TO 450 C C PARTIAL LINE EDITOR. C INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED. C EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES C THE FIRST NON-BLANK CHARACTER AFTER N2. N1 AND N2 ARE COLUMN C LIMITS UNDER WHICH TO PERFORM THE EDITING. N1 AND ,N2 ARE C OPTIONAL. IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT C LIMIT. IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS C ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE. WHEN C STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING C PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT C LENGTHS OF STRING1 AND STRING2. THE THIRD DELIMITER IS C OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED C AFTER STRING2 IS INSERTED. C IF (INEND.NE.0) GO TO 240 C CONVERT COLUMN NUMBERS. NBR1=0 NBR2=0 I=0 120 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.EQ.44) GO TO 150 C 44 = ASCII COMMA IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR1=10*NBR1+J-48 GO TO 120 130 WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD) 140 FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/ 1(1X,80A1)) NERRS=2 GO TO 70 150 I=I+1 IF (I.GT.NCHCMD) GO TO 130 J=COMAND(I) IF (J.LT.48) GO TO 160 C 48 = ASCII ZERO IF (J.GT.57) GO TO 160 C 57 = ASCII NINE NBR2=10*NBR2+J-48 GO TO 150 C SCAN FOR DELIMITER 160 IF (J.NE.32) GO TO 170 C 32 = ASCII BLANK I=I+1 J=COMAND(I) GO TO 160 170 D1=I NBR1=MIN0(NBR1,180) NBR2=MIN0(NBR2,180) IF (NBR1.EQ.0) NBR1=1 IF (NBR2.EQ.0) GO TO 180 IF (NBR2.LT.NBR1) GO TO 130 180 I=I+1 IF (I.GT.NCHCMD) GO TO 130 IF (COMAND(I).NE.J) GO TO 180 D2=I D3=0 190 I=I+1 IF (I.GT.NCHCMD) GO TO 200 IF (COMAND(I).NE.J) GO TO 190 D3=I C LOOK FOR SEARCH STRING (STRING1) 200 NUMBER=D2-D1-1 J=NBR1 IF (NUMBER.EQ.0) GO TO 260 NY=NBR2 IF (NY.EQ.0) NY=NCHACT 210 DO 220 I=1,NUMBER IF (I+J-1.GT.NY) GO TO 240 IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230 220 CONTINUE GO TO 260 230 J=J+1 GO TO 210 240 WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD) 250 FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1)) NERRS=2 GO TO 70 C FOUND SEARCH STRING. REPLACE WITH UPDATE STRING. 260 CHAR1L=PLUS IF (D3.NE.0) GO TO 300 C NO THIRD DELIMITER. REPLACE REST OF REGION. NY=NBR2 IF (NY.EQ.0) NY=180 D2=D2+1 IF (D2.GT.NCHCMD) GO TO 280 DO 270 I=D2,NCHCMD INTREC(J)=COMAND(I) J=J+1 IF (J.GT.NY) GO TO 280 270 CONTINUE 280 IF (NBR2.NE.0) GO TO 290 NCHACT=J-1 GO TO 70 290 IF (J.GT.NBR2) GO TO 70 INTREC(J)=32 C 32 = ASCII BLANK J=J+1 GO TO 290 C WE HAVE A THIRD DELIMITER. REPLACE ONLY THE SEARCH STRING. C SHIFT THE REST OF THE REGION AS NECESSARY. 300 NUMBER=(D3-D2)-(D2-D1) IF (NUMBER) 310,350,330 C SHIFT LEFT 310 I=J+D2-D1-1 NY=MIN0(NBR2,NCHACT) IF (NY.EQ.0) NY=NCHACT 320 IF (I.GT.NY) GO TO 350 INTREC(I+NUMBER)=INTREC(I) C NOTE - NUMBER .LT. 0 HERE INTREC(I)=32 C 32 = ASCII BLANK I=I+1 GO TO 320 C RIGHT SHIFT 330 I=NBR2 IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180) NY=J+NUMBER 340 IF (I.LT.NY) GO TO 350 INTREC(I)=INTREC(I-NUMBER) I=I-1 GO TO 340 C NO SHIFT NEEDED. 350 IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180) IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2) NY=NBR2 IF (NY.EQ.0) NY=NCHACT C MOVE UPDATE STRING (STRING2). 360 D2=D2+1 IF (D2.GE.D3) GO TO 70 INTREC(J)=COMAND(D2) J=J+1 IF (J-NY) 360,360,70 C C REQUEST TO INCLUDE TEXT. -I IN COLUMNS 1 AND 2. C 370 IF (EDIT.EQ.0) GO TO 390 WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD) 380 FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X 1,80A1)) NERRS=2 GO TO 70 390 ITYPEO=73 C 73 = ASCII I IF (NCHCMD.GE.4) GO TO 410 WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD) 400 FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A 11)) NERRS=2 GO TO 70 410 DO 420 I=4,NCHCMD IF (COMAND(I).NE.32) GO TO 430 420 CONTINUE C CONVERT TO UPPER CASE. WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM 430 K=0 DO 440 J=I,NCHCMD IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32 K=K+1 440 COMAND(K)=COMAND(J) NCHCMD=K GO TO 460 C C TEXT RECORD. C 450 ITYPEO=0 460 NCHOUT=NCHCMD IF (OUTOPN.EQ.0) GO TO 470 MODEO=0 CALL EXCHPR (ISTAT,OBLOCK,COMAND) IF (ISTAT.NE.0) GO TO 770 470 CALL EXCHTP (COMAND,0) GO TO 70 C C APPARENT CHANGE CONTROL COMMAND C 480 IF (INEND.EQ.0) GO TO 510 490 WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD) 500 FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT 1 END./(1X,80A1)) NERRS=1 GO TO 70 510 NUMBER=1 NBR1=0 EDIT=0 I=1 520 I=I+1 IF (I.GT.NCHCMD) GO TO 600 J=COMAND(I) IF (J.EQ.32) GO TO 600 C 32 = ASCII BLANK IF (EDIT.NE.0) GO TO 530 C EDIT CONTROL MUST BE BLANK AFTER $. IF (J.EQ.44) GO TO 570 C 44 = ASCII COMMA IF (J.EQ.36) GO TO 560 C 36 = ASCII $ IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.LE.57) GO TO 550 C 57 = ASCII 9 530 WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD) 540 FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1) NERRS=2 GO TO 60 550 NBR1=10*NBR1+J-48 GO TO 520 560 IF (NBR1.EQ.0) GO TO 530 EDIT=1 NBR1=NBR1-1 GO TO 520 570 NUMBER=2 NBR2=0 580 I=I+1 IF (I.GT.NCHCMD) GO TO 590 J=COMAND(I) IF (J.EQ.32) GO TO 590 C 32 = ASCII BLANK IF (IABS(J-44).EQ.1) GO TO 590 C 43 = ASCII +, 45 = ASCII - IF (J.LT.48) GO TO 530 C 48 = ASCII ZERO IF (J.GT.57) GO TO 530 C 57 = ASCII 9 NBR2=10*NBR2+J-48 GO TO 580 590 IF (NBR2.LT.NBR1) GO TO 530 NBR1=NBR1-1 600 IF (NBR1.GE.LINEI-1) GO TO 620 WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD) 610 FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1) NERRS=2 GO TO 60 620 IF (NCHCMD.LE.0) GO TO 630 IF (LINEI.LE.NBR1) GO TO 630 IF (NUMBER.EQ.1) GO TO 70 C SKIP INTAPE UNTIL NBR2 IS SKIPPED. MODEI=1 IF (LINEI.GE.NBR2) MODEI=0 IF (LINEI-NBR2) 650,650,70 C COPY FROM INTAPE UNTIL NBR1 COPIED. 630 MODEO=MODEI NCHOUT=NCHACT ITYPEO=ITYPEI IF (OUTAPE.EQ.0) GO TO 640 CALL EXCHPR (ISTAT,OBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 770 640 CALL EXCHTP (INTREC,LINEI) MODEI=0 IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650 IF (LINEI.EQ.NBR1) GO TO 650 MODEI=1 650 CALL EXCHGR (ISTAT,IBLOCK,INTREC) IF (ISTAT.NE.0) GO TO 760 LINEI=LINEI+1 IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620 C 73 = ASCII I INEND=1 IF (NCHCMD.LE.0) GO TO 660 I=NBR2 IF (NUMBER.EQ.1) I=NBR1 IF (LINEI-I) 490,490,70 660 IF (NERRS.EQ.0) GO TO 675 J=1 IF (PHASE.EQ.8) J=2 WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS 670 FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.) 675 NERRG=MAX0(NERRG,NERRS) IF (OPTL+OPTS.NE.0) GO TO 690 IF (OUTAPE+OUFILE.EQ.0) LINEO=0 IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO 680 FORMAT (I9,14H IMAGES COPIED) GO TO 710 690 WRITE (PRINTR,700) 700 FORMAT (1H1) CHAR1L=ONE 710 IF (OUFILE.EQ.0) GO TO 720 OUTREC(1)=SIGNAL OUTREC(2)=SIGNAL NCHOUT=2 OUTREC(180)=0 ACTION=OPTC+OPTC-2 C ACTION = -2 MEANS END OF PROGRAM. CALL EXCHOU (OUTREC) 720 IF (ITYPEI.NE.69) GO TO 750 C 69 = ASCII E C C END OF FILE ON INPUT TAPE (UPDATE MODE). C IF (INTOPN.LT.0) GO TO 750 DO 730 I=1,40 730 HOLCMD(I+1)=TXDISK(I) HOLCMD(1)=32 IF (TXDISK(1).NE.32) HOLCMD(1)=61 C 32 = ASCII BLANK, 61 = ASCII = CALL EXCHAH (HOLCMD,41) WRITE (PRINTR,740) (HOLCMD(I),I=1,41) 740 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1) INTOPN=-1 C C RETURN TO THE COMMAND DECODER. C 750 TRANS=1 GO TO 790 C C ERROR MESSAGES. C 760 NUMBER=1 GO TO 780 770 NUMBER=2 780 EQUAL=ISTAT TRANS=8 C C RETURN TO THE TRANSITION PROGRAM. C 790 PHASE=2 IF (OUTOPN.EQ.0) PHASE=1 RETURN C END SUBROUTINE EXCHC8 C C PRINT ERROR MESSAGES. C C ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE INTEGER S(31) INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) C DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/ DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/ DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/ DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/ DATA S(29),S(30),S(31) /4,5,5 / C C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4 160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751), 2NUMBER C 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 10 WRITE (PRINTR,20) EQUAL 20 FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.) GO TO 50 30 WRITE (PRINTR,40) EQUAL 40 FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.) 50 GO TO (60,80,100,120,140,160), EQUAL 60 WRITE (PRINTR,70) 70 FORMAT (22H BLOCK SEQUENCE ERROR.) GO TO 180 80 WRITE (PRINTR,90) 90 FORMAT (20H BLOCK IS TOO SHORT.) GO TO 180 100 WRITE (PRINTR,110) 110 FORMAT (11H I/O ERROR.) GO TO 180 120 WRITE (PRINTR,130) 130 FORMAT (18H RECORD TOO LARGE.) GO TO 180 140 WRITE (PRINTR,150) 150 FORMAT (21H UNKNOWN RECORD TYPE.) GO TO 180 160 WRITE (PRINTR,170) 170 FORMAT (25H FIRST BLOCK NOT A LABEL.) GO TO 760 180 WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD) 190 FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1) INFILE=0 C C RETURN TO QUIT SEGMENT. C TRANS=9 GO TO 800 C 200 WRITE (PRINTR,210) 210 FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.) GO TO 760 220 WRITE (PRINTR,230) 230 FORMAT (//20H0INTAPE NOT DEFINED.) GO TO 760 240 WRITE (PRINTR,250) 250 FORMAT (//23H0UNABLE TO OPEN INTAPE.) GO TO 10 260 WRITE (PRINTR,270) 270 FORMAT (//23H0UNABLE TO OPEN OUTAPE.) GO TO 30 280 WRITE (PRINTR,290) 290 FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.) GO TO 760 300 WRITE (PRINTR,310) 310 FORMAT (//19H0DATE NOT SUPPLIED.) GO TO 760 320 WRITE (PRINTR,330) 330 FORMAT (//19H0SITE NOT SUPPLIED.) GO TO 760 340 WRITE (PRINTR,350) INTAPE 350 FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4) GO TO 760 360 WRITE (PRINTR,370) 370 FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.) GO TO 760 380 WRITE (PRINTR,390) 390 FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.) GO TO 760 400 WRITE (PRINTR,410) 410 FORMAT (//27H0COMMAND HAS IMPROPER DATE.) GO TO 760 420 WRITE (PRINTR,430) EQUAL 430 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.) GO TO 780 440 WRITE (PRINTR,450) 450 FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.) IF (ICOMD) 780,560,780 460 WRITE (PRINTR,470) N1RECI 470 FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO 1N (,I5,2H).) GO TO 760 480 WRITE (PRINTR,490) EQUAL 490 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 500 WRITE (PRINTR,510) 510 FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.) GO TO 760 520 WRITE (PRINTR,530) 530 FORMAT (//23H0WORK FILE NOT DEFINED.) GO TO 760 540 WRITE (PRINTR,550) 550 FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.) GO TO 760 560 WRITE (PRINTR,570) EQUAL 570 FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.) GO TO 760 580 WRITE (PRINTR,590) 590 FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE 1R.) GO TO 760 600 WRITE (PRINTR,610) 610 FORMAT (//12H0TOO MANY (.) GO TO 760 620 WRITE (PRINTR,630) EQUAL 630 FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.) GO TO 760 640 WRITE (PRINTR,650) EQUAL 650 FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.) GO TO 760 660 WRITE (PRINTR,670) EQUAL 670 FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.) GO TO 760 680 WRITE (PRINTR,690) EQUAL 690 FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.) GO TO 760 700 WRITE (PRINTR,710) EQUAL 710 FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.) GO TO 760 720 WRITE (PRINTR,730) N1RECI 730 FORMAT (//21H0INTAPE POSITIONED AT,I5,25H. BACKWARD SKIP IGNORED. 1) GO TO 780 740 WRITE (PRINTR,750) 750 FORMAT (//23H0COMMAND IS INCOMPLETE.) GO TO 760 751 WRITE (PRINTR,752) 752 FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA 1PE OR OUTPUT.) 760 WRITE (PRINTR,770) 770 FORMAT (23H COMMAND NOT PROCESSED.) 780 WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD) 790 FORMAT ((1X,80A1)) C C RETURN TO COMMAND PROCESSSOR. C CHAR1L=0 NERRS=MAX0(S(NUMBER),NERRS) NERRG=MAX0(NERRG,NERRS) TRANS=1 C C RETURN TO TRANSITION PROGRAM. C 800 RETURN C END SUBROUTINE EXCHC9 (IBLOCK,OBLOCK) INTEGER IBLOCK(1),OBLOCK(1) C C PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO C ERRORS. C INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI, 1 NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180) INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO, 1 L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO, 2 NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180), 1 ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX, 2 INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP, 3 NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE, 4 PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT, 1 WORKF COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI, 1 NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT, 2 ITYPEI,MODEI,REMVI,LABELI,INTREC COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO, 1 LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO, 2 NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD, 1 IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN, 2 LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS, 3 NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE, 4 TODAY,TRANS,VERT COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT, 1 INALT,WORKF EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2) EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT) EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE) EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS) EQUIVALENCE (OPTVAL(22),OPTV) DATA KQUIT /20/ C IF (INFILE.EQ.0) GO TO 10 IF (MODIFY.NE.82) GO TO 5 C 82 = ASCII R ACTION=2 C ACTION = 2 MEANS REWIND INFILE. CALL EXCHIM 5 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. CALL EXCHIM INFILE=0 NCHCMD=0 GO TO 50 10 IF (OPTC*OUFILE.EQ.0) GO TO 20 ACTION=0 NCHOUT=4 CALL EXCHOU (COMD(1,KQUIT)) 20 ACTION=-1 C ACTION = -1 MEANS CLOSE FILE. IF (OUFILE.NE.0) CALL EXCHOU (OUTREC) IF (OUTOPN.EQ.0) GO TO 30 C WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE. ITYPEO=69 C 69 = ASCII E CALL EXCHPR (ISTAT,OBLOCK,OUTREC) C CLOSE THE INPUT TAPE. 30 IF (INTOPN.EQ.0) GO TO 40 ISTAT=4 CALL EXCHRT (ISTAT,OBLOCK) C C RETURN TO MAIN PROGRAM. C 40 TRANS=0 IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG 45 FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.) GO TO 60 C C RETURN TO THE COMMAND DECODER. C 50 TRANS=1 60 RETURN C END =TES FILE=6 ! This is the HELP input file for the VAX/VMS ! version of TES. Invoked with ! LIBRARY/CREATE/HELP ! Processor will prompt for file names. ! Prepared by R. Hanson, Aug., 1982 1 TES The TES supports those computing activities associated with archiving, retrieving, updating and exporting textual material. It is a program that operates on files having a "universal" format and delivers and reads text files in native format on the host system. When asking for HELP on TES commands, the complete command is listed. Only the first four (4) characters are required. This is also true for the TES program. The symbols [ ] enclose optional specifications; the ( ) symbols enclose alternatives--choose one; the < > enclose a CHARACTER string; FUN is a Fortran unit number; the { } enclose an integer string; MN denotes a module number in a TES format file. Note: Simultaneously, distinct positive Fortran unit numbers must be used. 2 AUTHORS R. J. Hanson, Division 1642, Sandia National Laboratories, 844-1715 and W. V. Snyder, Jet Propulsion Laboratory, Pasadena, California 3 REFERENCES 1. W. V. Snyder and R. J. Hanson, "Text Exchange System: A Transportable System for Management and Exchange of Programs and Other Text," JPL internal document number 1846-108, Aug. 1981. 2. W. V. Snyder and R. J. Hanson, "Text Exchange System, Installation Instructions and Description of System Dependent Variants," JPL internal document number 1846-109, Aug. 1981. 3. W. V. Snyder and R. J. Hanson, "Text Exchange System, Program Descriptions," JPL internal document number 1846-110, Aug. 1981. 2 COMMANDS 3 INTAPE INTAPE=FUN [] Default name=TEIO{FUN}.TES;vers. Define TES format input file. If the identical INTAPE designation is used, and the read position is at End-of-File, an End-of-File is skipped. 3 INPUT INPUT FILE=FUN [] Default name=EXCH{FUN}.TMP;vers. Define native format file from which to read commands and text. Goes to READER file for commands after completion. 3 INCLUDE INCLUDE=FUN [] Default name=EXCH{FUN}.TMP;vers. Define file to be searched for modules of text to be auto- matically inserted as text is copied to the user file. FUN=0 closes the INCLUDE file. 3 TEXT TEXT Indicate the text of a module follows the command. TEXT=FUN [] Default name=EXCH{FUN}.TMP;vers. Define file containing the text of a module. 3 READER READER=FUN [] Default name=EXCH{FUN}.TMP;vers. Define native format file from which to read commands. A default value is provided, FUN=5, =TT:. If FUN=5 is used, will be TT: Can contain text and other 'INPUT FILE=' commands but not other 'READER=' commands. FUN must be positive. 3 MARGIN MARGIN=integer Define last column of input to be examined when interpreting commands. A default value (180) is provided. This command does not limit input text line lengths. 3 SIGNAL SIGNAL=<1 character> A character used in col. 1 of text to identify INCLUDE requests and corrections, and in cols. 1-2 to identify the end of text or correction input. If this command is not given a dash (-) is used. This command goes after NAME= command, and before TEXT or TEXT= command. 3 REMOVE REMOVE=<1 character> A character to be removed to compress text. This character is reinserted in OUTPUT files or other native text. If this command is not given, excess blanks are removed. 3 QUIT QUIT [,R] Stop reading commands and text from the file containing this command. If the R modifier is used the file is rewound. This command gracefully closes all the files used during execution. 3 EXIT Use QUIT. 3 STOP Use QUIT. 3 HALT Use QUIT. 3 REWIND Rewind the TES format input file, INTAPE. (When INTAPE is attached as a magnetic tape, this command rewinds the entire reel.) 3 SKIP SKIP=MN Position the TES format input file immediately after module number MN. 3 LIMIT LIMIT=MN Module number MN on the TES format input file is the last one to be examined when executing the second (predicate controlled) form of the COPY command. 3 OUTAPE OUTAPE [,U]=FUN [] Default name = TEIO{FUN}.TES;vers. Define TES format output file. The [,U] qualifier is needed when text is being changed or merged. If an OUTAPE was already open it is closed and a new one then opened. (If the same OUTAPE is designated, an End-of-File is written.) FUN=0 closes the OUTAPE. Nothing further will be written to this file. 3 OUTPUT_FILE OUTPUT FILE=FUN [] Default name=EXCH{FUN}.TMP;vers. Define native format file to receive text. If an OUTPUT FILE was already open it is closed and a new one then opened. FUN=0 closes the OUTPUT FILE. Nothing further will be written to this file. 3 PRINTER PRINTER=FUN . Default name=EXCH{FUN}.LIS;vers. Define native format file to receive listings, remarks or error messages. Default of FUN=6 provided, with =TT:. If FUN=6 is used, will be TT:. FUN must be positive. 3 WORK_FILE WORK FILE=FUN TES uses new file for work area. This file is deleted by TES when program terminates normally. 3 TITLE TITLE= Provide a title for the TES format output file. If none provided uses TITLE from INTAPE, if one is currently assigned. 3 SITE SITE= Indicates where the TES format file was written. This is provided automatically on this machine. The SITE information can be overwritten if desired. 3 DATE DATE=integer The integer must be ANSI standard form of day: YYMMDD. Used to note when OUTAPE was written. DATE is provided by the system but can be over- written if desired. 3 IDENTIFY IDENTIFY OUTPUT [,modifier] = first col., last col., step,start,