Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0174/format.for
There are 6 other files named format.for in the archive. Click here to see a list.
BLOCK DATA
C RENBR(FORMAT/DECISION TREE FOR COMMAND RECOGNITION)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
C THE DECISION TREE WHICH IS DEFINED BY THIS BLOCK DATA
C ROUTINE IS USED BY THE FORMAT PROGRAM FOR RECOGNIZING
C COMMANDS. THIS DECISION TREE WAS PRODUCED BY THE
C KEYWRD PROGRAM WHICH WAS WRITTEN BY THE SAME AUTHOR.
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
C COMMAND 1 IS FOR ALL AMBIGUOUS ABBREVIATIONS OF WHICH
C LEFT CHARACTERS HAVE BEEN DEFINED AS ANOTHER COMMAND
C 1 PR
C 2 B
C 2 BLANK
C 3 BREAK
C 4 CENTER
C 4 CENTRE
C 5 END OF FILE
C 6 F
C 6 FILL
C 7 FL
C 7 FLAGS ALL
C 8 FLAGS C
C 8 FLAGS CAPITALIZE
C 9 CARRIAGE
C 10 FLAGS CONTROL
C 11 FLAGS LOWER CASE
C 12 FLAGS QUOTE
C 13 FLAGS SPACE
C 14 FLAGS UPPER CASE
C 15 CONTINUE
C 15 FORMAT
C 16 I
C 16 IN
C 16 INDENT
C 17 INPUT WIDTH
C 18 INSERT
C 19 JUSTIFY
C 20 LEFT MARGIN
C 21 LENGTH
C 21 OUTPUT LENGTH
C 22 LOWER CASE
C 23 NO F
C 23 NO FILL
C 24 NO FL
C 24 NO FLAGS ALL
C 25 NO FLAGS C
C 25 NO FLAGS CAPITALIZE
C 26 NO CARRIAGE
C 27 NO FLAGS CONTROL
C 28 NO FLAGS LOWER CASE
C 29 NO FLAGS QUOTE
C 30 NO FLAGS SPACE
C 31 NO FLAGS UPPER CASE
C 32 NO JUSTIFY
C 33 NO TRAILING
C 34 OFFSET
C 35 OUTPUT WIDTH
C 36 P
C 36 PARAGRAPH
C 37 PREFACE
C 38 PROGRAM
C 39 RESET
C 40 RIGHT MARGIN
C 41 S
C 41 SKIP
C 42 SPACING
C 43 TRAILING
C 44 UPPER CASE
C 45 US
C 45 USE
C 46 FLAGS INSERT
C 47 FLAGS REMARK
C 48 FLAGS FENCE
C 49 NO FLAGS INSERT
C 50 NO FLAGS REMARK
C 51 NO FLAGS FENCE
C 52 LEADING
C 53 NO LEADING
C 54 EJECT
C 55 USE H
C 56 COPY
C 57 MASK
C 58 NO PREFACE
C 59 NO MASK
C 60 NO COPY
C 61 NO INSERT
C 62 NO OFFSET
C 63 BEGIN
C 63 TEXT
C 64 DEFINE PREFACE
C 65 BOTTOM
C 66 DEFINE BOTTOM
C 67 PAGE LENGTH
C 68 PAG
C 68 PAGE
C 69 PAGING
C 70 NO PAGING
C 71 TEST PAGE
C 72 PAGE CARRIAGE
C 73 NO PAGE CARRIAGE
C 74 TEST SPACING
C 75 COMMENT
C 76 END DEFINITION
C 76 END DEFINE
C 77 NO BOTTOM
C 78 TOP
C 79 DEFINE TOP
C 80 NO TOP
C 81 RESUME TOP
C 82 RESUME PREFACE
C 83 RESUME BOTTOM
C 84 GROUP
C 85 DEFINE GROUP
C 86 NO GROUP
C 87 RESUME GROUP
C 88 PAGE POSITION
C
C FINAL STORAGE USED= 305, MOST USED= 2722, LIMIT=18600
C
C CHECKSUMS 8407, 677,7631,7398,2410
C
C COUNT 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
C COMMAND 2 63 2 2 2 65 3 3 3 0 9 4 4 4 4
C LETTER -B E L A N O R E A -C A E N T E
C SUCCESS 2256 4 5167245 8 9167 11213 13 14 15 16
C FAILURE 10 3 6 0 0 7 0 0 0 27 12 18 0 0 17
C
C COUNT 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
C COMMAND 4 4 0 75 75 15 15 15 15 15 56 0 0 0 0
C LETTER R R O M M N T I N U P -D E F I
C SUCCESS 0304 19 20 79 22 23 24 25304159 28 29 30 31
C FAILURE 0 0 0 21 0 26 0 0 0 0 0 37 33 33 33
C
C COUNT 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
C COMMAND 0 0 66 85 64 79 0 54 54 54 0 0 76 76 76
C LETTER N E -B -G -P -T -E J E C N D -D E F
C SUCCESS 32 33244250260266 38 39 40276 42 43 44 45 46
C FAILURE 33 33 34 35 36 0 54 41 0 0 43 43 49 0 0
C
C COUNT 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
C COMMAND 76 76 76 5 5 5 5 5 6 6 7 0 0 0 15
C LETTER I N E -O F -F I L -F I L A G S O
C SUCCESS 47 48 0 50 51 52 53304 55105 57 58 59 64 61
C FAILURE 0 0225 0 51 0 0 0 75 56 60 64 64 64 64
C
C COUNT 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
C COMMAND 15 15 15 7 8 8 10 48 46 11 12 47 13 14 84
C LETTER R M A -A -C A O -F -I -L -Q -R -S -U -G
C SUCCESS 62 63276111 66114122128149132135139144146250
C FAILURE 0 0 0 65 68 67 0 69 70 71 72 73 74 0 76
C
C COUNT 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
C COMMAND 16 16 16 0 0 17 17 17 18 17 19 0 0 52 20
C LETTER -I N D E N P U T S -W -J -L E A F
C SUCCESS 77 78 79 80276 82 83 85151192154 88 89163241
C FAILURE 86 85 81 0 0 84 85 85 85 0 87 95 92 90 91
C
C COUNT 91 92 93 94 95 96 97 98 99100101102103104105
C COMMAND 21 22 22 20 57 0 0 77 0 26 60 60 23 23 0
C LETTER N O -C -M -M -N O -B -C A O P -F I L
C SUCCESS 219133302254165 97 98244100213102159104105126
C FAILURE 94 93 94 0 96180 98 99103101 0 0147106149
C
C COUNT 106107108109110111112113114115116117118119120
C COMMAND 24 0 0 0 24 0 25 25 0 0 0 0 0 0 0
C LETTER L A G S -A L -C A P I T A L I Z
C SUCCESS 107108109110111126113114115116117118119120304
C FAILURE 110110110110112 0127121 0 0 0 0 0 0 0
C
C COUNT 121122123124125126127128129130131132133134135
C COMMAND 27 0 0 0 0 0 51 0 0 49 28 0 0 29 0
C LETTER O N T R O L -F E N -I -L O W -Q U
C SUCCESS 122123124125126 0128129264149132133296135136
C FAILURE 0 0 0 0 0 0130 0 0131134298298138 0
C
C COUNT 136137138139140141142143144145146147148149150
C COMMAND 0 0 50 0 0 0 0 30 0 31 0 86 61 0 0
C LETTER O T -R E M A R -S P -U P -G -I N S
C SUCCESS 137304139140141142167144263146295250149150151
C FAILURE 0 0143 0 0 0 0145 0 0298148153 0 0
C
C COUNT 151152153154155156157158159160161162163164165
C COMMAND 0 0 32 0 0 0 0 0 0 53 53 53 0 59 0
C LETTER E R -J U S T I F Y -L E A D -M A
C SUCCESS 152276154155156157158159 0161162163290165166
C FAILURE 0 0160 0 0 0 0 0 0164 0 0 0168 0
C
C COUNT 166167168169170171172173174175176177178179180
C COMMAND 0 0 62 62 0 0 0 73 70 58 73 0 80 33 0
C LETTER S K -O F -P A G E I R -C -T O R -O
C SUCCESS 167 0169182171172173176291261212178278280181
C FAILURE 0 0170 0177175176174176176 0 0179 0194
C
C COUNT 181182183184185186187188189190191192193194195
C COMMAND 34 0 0 0 0 0 0 0 0 21 35 0 0 36 0
C LETTER F F S E U T P U T -L -W I D -P A
C SUCCESS 182183184276186187188189190217192193220195196
C FAILURE 185 0 0 0190190190190190191 0 0 0229205
C
C COUNT 196197198199200201202203204205206207208209210
C COMMAND 68 68 69 36 36 36 36 36 36 1 37 38 38 38 38
C LETTER G E I R A G R A P R E O G R A
C SUCCESS 197211291200201202203204221206262208209210248
C FAILURE 199198211211 0 0 0 0 0211207 0 0 0 0
C
C COUNT 211212213214215216217218219220221222223224225
C COMMAND 72 0 0 0 0 67 0 0 0 0 0 88 88 88 0
C LETTER -C A R R I -L E N G T H -P O S I
C SUCCESS 212213214215284217218219220221 0223224225226
C FAILURE 216 0 0 0 0222 0 0 0 0 0 0 0 0 0
C
C COUNT 226227228229230231232233234235236237238239240
C COMMAND 0 0 0 0 0 0 39 0 0 0 83 87 40 40 40
C LETTER T I O -R E S E U M E -B -G I G H
C SUCCESS 227228258230231232276234235236244250239240241
C FAILURE 0 0 0267238236233236236236237259243242242
C
C COUNT 241242243244245246247248249250251252253254255
C COMMAND 0 0 83 0 0 0 0 0 87 0 0 0 40 0 0
C LETTER T -M -B O T T O M -G R O U -M A R
C SUCCESS 242254244245246247248 0250251252278254255256
C FAILURE 242 0249 0 0 0 0 0253 0 0 0259 0 0
C
C COUNT 256257258259260261262263264265266267268269270
C COMMAND 0 0 0 82 0 0 0 0 0 81 0 41 41 41 42
C LETTER G I N -P R E F A C -T O -S K I P
C SUCCESS 257258 0260261262263264304266278268269278288
C FAILURE 0 0 0265 0 0 0 0 0 0 0271270 0 0
C
C COUNT 271272273274275276277278279280281282283284285
C COMMAND 0 0 0 0 63 0 78 0 43 0 0 0 71 0 0
C LETTER -T E S T X T O P R A I L -P A G
C SUCCESS 272273274283276 0278 0280281282290284285304
C FAILURE 293277275283283 0279 0283 0 0 0286 0 0
C
C COUNT 286287288289290291292293294295296297298299300
C COMMAND 74 74 0 0 0 0 0 0 44 0 0 0 0 45 45
C LETTER -S P A C I N G -U P P E R -C S E
C SUCCESS 287288289290291292 0294295296297298302300305
C FAILURE 0 0 0 0 0 0 0 0299298298298 0301305
C
C COUNT 301302303304305
C COMMAND 44 0 0 0 55
C LETTER -C A S E -H
C SUCCESS 302303304 0 0
C FAILURE 305 0 0 0 0
C
C DIMENSION MCHPNT(305)
DIMENSION MCHPN1(105),MCH106(106),MCH212(94)
EQUIVALENCE (MCHPN1(1),MCHPNT(1)),
1(MCH106(1),MCHPNT(106)),(MCH212(1),MCHPNT(212))
C DIMENSION NOTPNT(305)
DIMENSION NOTPN1(97),NOTP98(96),NOT194(99),
1NOT293(13)
EQUIVALENCE (NOTPN1(1),NOTPNT(1)),
1(NOTP98(1),NOTPNT(98)),(NOT194(1),NOTPNT(194)),
2(NOT293(1),NOTPNT(293))
DATA KNTPNT,KNTXTR/ 305, 0/
DATA MCHPN1/614,19534,616,617,779,20135,926,927,1085,
111,2967,1237,1238,1239,1240,1224,1528,19,22970,23029,
24612,4613,4614,4615,4894,17295,28,29,30,31,32,33,
320440,26260,19844,24440,38,16563,16564,16800,42,43,
423300,23301,23302,23303,23304,23256,1580,1581,1582,
51583,1834,1891,1941,2199,58,59,64,4651,4652,4653,
64866,2253,2514,2562,3182,14816,14225,3498,3807,14521,
74122,4430,25954,4973,4974,4975,80,276,5284,5285,5287,
85659,5394,5968,88,89,16075,6361,6645,6865,7034,6374,
917607,97,98,23806,100,8169,18462,18519,7142,7143,126/
DATA MCH106/7451,108,109,110,7455,126,7763,7764,115,
1116,117,118,119,120,304,8384,123,124,125,126,0,15734,
2129,264,15143,8700,133,296,9009,136,137,304,15439,
3140,141,142,167,9324,263,9632,295,26566,18815,150,
4151,152,276,9946,155,156,157,158,159,0,16379,16380,
516381,290,18219,166,167,0,19141,19154,171,172,173,
622514,21711,18009,22550,178,24758,10378,181,10586,
7183,184,276,186,187,188,189,190,6643,10902,193,220,
811211,196,21005,21019,21405,11216,11217,11218,11219,
911220,11237,512,11584,11836,11837,11838,11876,22244/
DATA MCH212/213,214,215,284,20719,218,219,220,221,0,
127151,27152,27153,226,227,228,258,230,231,232,12210,
2234,235,236,25642,26872,12479,12480,12481,242,254,
325642,245,246,247,248,0,26872,251,252,278,12494,255,
4256,257,258,0,25352,261,262,263,264,304,25052,278,
512814,12815,12824,13140,272,273,274,283,19554,0,
624146,0,13438,281,282,290,22010,285,304,22931,22932,
7289,290,291,292,0,294,13759,296,297,298,302,14070,
814075,13766,303,304,0,16830/
DATA NOTPN1/-622,1533,3678,306,4284,4597,5508,1530,
1306,-945,318,1548,4284,6120,1547,5508,5508,4590,3999,
23978,4310,6120,2754,4284,6426,4896,-1261,1563,1869,
32787,4317,1563,-646,-2177,-4932,-6120,-1584,3101,
41530,918,4327,1267,-1273,1530,1836,2754,4284,1755,
5-4590,1887,-1836,2754,3672,-1911,2810,3732,370,2206,
65878,4654,5508,3978,306,-371,-986,373,4590,-1905,
7-2824,-3743,-5274,-5581,-5888,-6426,-2218,-2840,4369,
81305,1530,4284,4980,6511,6205,5899,-7038,-3147,-3767,
91622,396,1927,4378,4683,-1012,-3978,-4074,-4464,4688/
DATA NOTP98/-711,-1021,407,4590,4896,-1983,2860,3821,
13782,416,2252,5924,-418,3672,-1045,427,4896,2754,
26120,306,3672,2754,7956,4590,4284,6120,5508,4590,
33672,-1966,1530,4284,-2885,-3806,4888,7336,-5340,
46426,4590,6120,-5651,1530,3978,306,5508,-5959,4896,
5-6426,5194,-2290,-2907,4284,5814,1530,5508,-3220,
66426,5814,6120,2754,1836,7650,-3836,1530,306,1224,
7-4146,306,5814,3366,-4760,1836,-5073,481,2318,1704,
82930,5684,-918,-6120,4769,5508,-4784,2021,1836,5814,
91530,6616,6310,5086,6616,6310,-3863,-7038,2754,1224/
DATA NOT194/-5125,511,2341,1728,2965,5719,306,2142,
15508,306,4896,5719,1737,4590,2142,5508,306,-1134,306,
25508,5508,2754,-3894,1530,4284,2142,6120,2448,-4896,
34590,5814,2754,6120,2754,4590,-5775,1768,6050,1763,
46662,4214,1766,-849,-2401,2997,2384,2690,6362,-3978,
5-861,4590,6120,6120,4590,3978,-2395,5508,4590,6426,
6-4237,306,5508,2142,2754,4284,-5161,5508,1530,1836,
7306,918,-6120,4590,-6085,3636,2754,4896,-6413,1807,
86089,6403,7627,6120,4869,4896,5791,306,2754,3672,
9-5182,306,2142,-5814,4896,306,918,2754,4284,2142/
DATA NOT293/-6426,5195,5194,1828,5806,-918,6115,1835,
1-1223,306,5814,1530,-2448/
C
C KMDARG = -2 OR LESS, CHARACTER OR TEXT STRING
C ARGUMENT WHICH CANNOT EXTEND ACROSS NORMAL
C END OF COMMAND. VALUE IS 1 LESS THAN
C NEGATIVE OF MAXIMUM NUMBER OF CHARACTERS IN
C STRING
C = -1, NO ARGUMENT ALLOWED
C = 0, TEXT STRING ARGUMENT WHICH CAN EXTEND
C ACROSS NORMAL END OF COMMAND CHARACTERS
C = 1 OR GREATER, NUMBER OF NUMERIC ARGUMENTS
C
C DATA / ,BLA,BRE,CEN,EOF,FIL,FAL,FCA,CAR,FCO,
C 1 FLC,FQU,FSP,FUC,CON,IND,IWI,INS,JUS,LMA,
C 2 LEN,LCA,NFI,NFA,NFC,NCA,NFC,NFL,NFQ,NFS,
C 3 NFU,NJU,NTR,OFF,OWI,PAR,EVE,PRO,RES,RMA,
C 4 SKI,SPA,TRA,UCA,USE,FIN,FRE,FFE,NFI,NFR,
C 5 NFF,LEA,NLE,EJE,USH,COP,MAS,NEV,NMA,NCO,
C 6 NIN,NOF,TEX,DPR,BOT,DBO,PLE,PAG,PAG,NOP,
C 7 TPA,PCA,NPC,TSP,COM,EDE,NBO,TOP,DTO,NTO,
C 8 RTO,REV,RBO,NEW,DNE,NNE,RNE,PPO/
DATA KMDARG/ 0, 1, -1, 1, -1, -1, -1, -2, -3, -2,
1 -2, -2, -2, -2, 2, 1, 1, 0, -1, 1,
2 1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
3 -1, -1, -1, 1, 1, 3, 0, 2, -1, 1,
4 1, 1, -1, -1, -2, -2, -2, -2, -1, -1,
5 -1, -1, -1, -1, -1, 2, 0, -1, -1, -1,
6 -1, -1, 2, -1, 0, -1, 1, -1, -1, -1,
7 1, -3, -1, 1, 0, -1, -1, 0, -1, 0,
8 -1, -1, -1, 0, -1, -1, -1, 1/
C
C KMDBRK = 0, APPLY COMMAND WITHOUT BREAKING TEXT.
C NEXT TEXT WILL BE APPENDED TO CURRENT LINE
C = 1, TERMINATE CURRENT LINE. OUTPUT CURRENT
C STATEMENT. EXIT
C = 2 THRU 5, TERMINATE CURRENT LINE. OUTPUT
C CURRENT STATEMENT. FOLLOWING TEXT WILL BE
C PLACED IN NEW FORMAT STATEMENT
C = 1, END OF FILE COMMAND
C = 2, RESTORE COMMAND
C = 3, BEGIN COMMAND
C = 4, FORMAT COMMAND
C = 5, PROGRAM COMMAND
C = 6, TERMINATE CURRENT LINE. FOLLOWING TEXT
C WILL BE APPENDED TO CURRENT FORMAT STATEMENT
C ALL BLANK LINES ARE FORCED INTO OUTPUT
C = 7, TERMINATE CURRENT LINE. FOLLOWING TEXT
C WILL BE APPENDED TO CURRENT FORMAT STATEMENT
C BLANK LINES ARE NOT FORCED INTO OUTPUT
C
C DATA / ,BLA,BRE,CEN,EOF,FIL,FAL,FCA,CAR,FCO,
C 1 FLC,FQU,FSP,FUC,CON,IND,IWI,INS,JUS,LMA,
C 2 LEN,LCA,NFI,NFA,NFC,NCA,NFC,NFL,NFQ,NFS,
C 3 NFU,NJU,NTR,OFF,OWI,PAR,EVE,PRO,RES,RMA,
C 4 SKI,SPA,TRA,UCA,USE,FIN,FRE,FFE,NFI,NFR,
C 5 NFF,LEA,NLE,EJE,USH,COP,MAS,NEV,NMA,NCO,
C 6 NIN,NOF,TEX,DPR,INT,DIN,PLE,PAG,PAG,NOP,
C 6 NIN,NOF,BEG,DEV,BOT,DBO,PLE,PAG,PAG,NOP,
C 7 TPA,PCA,NPC,TSP,COM,EDE,NBO,TOP,DTO,NTO,
C 8 RTO,REV,RBO,NEW,DNE,NNE,RNE,PPO/
DATA KMDBRK/ 0, 7, 7, 7, 1, 7, 0, 0, 0, 0,
1 0, 0, 0, 0, 4, 7, 0, 0, 7, 7,
2 0, 0, 7, 0, 0, 0, 0, 0, 0, 0,
3 0, 7, 0, 7, 0, 7, 0, 5, 2, 7,
4 7, 7, 0, 0, 0, 0, 0, 0, 0, 0,
5 0, 0, 0, 6, 0, 7, 0, 0, 0, 7,
6 0, 7, 3, 0, 0, 0, 0, 7, 7, 7,
7 7, 0, 0, 7, 0, 0, 0, 0, 0, 0,
8 0, 0, 0, 0, 0, 0, 0, 6/
C
C THE VARIABLE NAMED LTRTAB CONTAINS THE TAB CHARACTER.
C THIS VARIABLE IS DEFINED IN FROFF USING THE
C DECSYSTEM10/20 OCTAL NOTATION, A DOUBLE QUOTE
C FOLLOWED BY THE 12 CHARACTER NUMBER, SINCE THE TAB
C CHARACTER IS CONVERTED BY SOME VIDEO EDITORS TO THE
C CORRESPONDING NUMBER OF SPACES. LTRTAB CAN INSTEAD
C BY DEFINED AS A SINGLE SPACE, EITHER 1H OR ' ', ON
C SYSTEMS WHICH DO NOT SUPPORT THE TAB CHARACTER.
C
DATA LTRTAB/"045004020100/
C
DATA LTRABC /1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
1 1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,
2 1HX,1HY,1HZ/
DATA LWRABC /1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
1 1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,1Hu,1Hv,1Hw,
2 1Hx,1Hy,1Hz/
DATA LTRDGT /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA LTRMNS,LTRPLS/1H-,1H+/
DATA LTRSPA/1H /
DATA LTRCOM,LTREQU,LTRHHH,LTRRIG,LTRSLA,LTRXXX,LWRHHH/
1 1H, ,1H= ,1HH ,1H) ,1H/ ,1HX ,1Hh /
DATA LTRFLG/1H;,1H<,1H.,1H$,1H\,1H_,1H!,1H#,1H^/
C
C 2 SPACES ARE NEEDED TO RIGHT OF FOLLOWING IN FILL MODE.
C THESE VARIABLES ARE NOT REFERENCED OTHERWISE.
DATA LTRTWO/1H;,1H:,1H!,1H.,1H?/
C
C ARRAY DIMENSIONS
DATA LMTBGN,LMTMID,LMTEND,LMTTEM,LMTSTR,LMTLST/
1300,300,72,300,500,30/
DATA LMTSPL,LMTLNG/500,50/
C
C DEFINE DEVICE UNIT NUMBERS
DATA IDISK,JDISK,KDISK,ITTY,JTTY/1,20,21,5,5/
END
C RENBR(FORMAT/CONSTRUCTS FORTRAN FORMAT STATEMENTS)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
MASTER=0
C
C ASK USER FOR FILE NAMES AND OPEN THESE FILES
C MASTER = 0, FIRST TIME USER ASKED TO SPECIFY FILES
C = 1, SECOND AND SUBSEQUENT TIME USER ASKED TO
C SPECIFY FILES
1 CALL FMTASK(MASTER,ITTY,JTTY,IDISK,JDISK,KDISK)
C MASTER = -1, NOT FIRST TIME FMTASK CALLED, BUT USER
C HAS SPECIFIED THAT ANOTHER FILE BE PROCESSED
C = 0, FIRST TIME FMTASK WAS CALLED
C = 1, MASTER WAS INPUT SET TO 1, AND NO
C FILES WERE SPECIFIED BY USER.
IF(MASTER.GT.0)GO TO 7
C
C INITIALIZE OR RESET VARIABLES
C MASTER = 0, INITIALIZE EVERYTHING INCLUDING SORTED
C ALPHABETS
C = -1, INITIALIZE EVERYTHING EXCEPT ALPHABETS
C WHICH ARE NEVER CHANGED DURING EXECUTION.
C DISCARD REST OF CURRENT INPUT LINE
C = 2, INITIALIZE EVERYTHING EXCEPT ALPHABETS
C WHICH ARE NEVER CHANGED DURING EXECUTION.
C RETAIN THE REST OF CURRENT INPUT LINE
C = 3, PREPARE FOR NEW SEQUENCE OF FORMAT
C STATEMENTS
C = 4 OR 5, PREPARE FOR A NEW FORMAT STATEMENT
C IN CURRENT SEQUENCE
2 CALL FMTNEW
C
C GET NEXT COMMAND OR NEXT LINE OF TEXT
C MASTER = NE.9, GET NEXT COMMAND OR NEW LINE OF TEXT
C = 9, GET REST OF TEXTUAL ARGUMENT OF COMMAND
3 CALL FMTGET
C MASTER = 0, TEXT RETURNED
C = 1, END OF FILE READ
C = 2, DOT COMMAND FOUND OR REST OF TEXTUAL
C ARGUMENT OF SUCH A COMMAND FOUND
IF(MASTER.LE.1)GO TO 4
C
C IDENTIFY DOT COMMAND AND EVALUATE ITS ARGUMENTS
C MASTER = INPUT VALUE IS IGNORED
CALL FMTHOW
C MASTER = 0, APPLY COMMAND WITHOUT BREAKING TEXT.
C NEXT TEXT WILL BE APPENDED TO CURRENT LINE
C = 1, TERMINATE CURRENT LINE. OUTPUT CURRENT
C STATEMENT. EXIT
C = 2 THRU 5, TERMINATE CURRENT LINE. OUTPUT
C CURRENT STATEMENT. FOLLOWING TEXT WILL BE
C PLACED IN NEW FORMAT STATEMENT
C = 2, RESTORE COMMAND
C = 3, TEXT COMMAND
C = 4, CONTINUE COMMAND
C = 5, PROGRAM COMMAND
C = 6, TERMINATE CURRENT LINE. FOLLOWING TEXT
C WILL BE APPENDED TO CURRENT FORMAT STATEMENT
C = 7, BREAK COMMAND FORCING BLANK LINES
C = 8, ILLEGAL COMMAND OR ILLEGAL ARGUMENT
C = 9, NEED REST OF TEXTUAL ARGUMENT OF COMMAND
IF(MASTER.GE.8)GO TO 3
IF(MASTER.EQ.0)GO TO 5
C
C COPY LINE OF TEXT INTO FORMAT STATEMENT OUTPUT
C MASTER = 0, LINE HAS FILLED, COMMAND WAS NOT ISSUED.
C MOVE LINE INTO CURRENT FORMAT STATEMENT.
C DO NOT CHANGE DIRECTION OF BLANK FILL.
C = 1 THRU 5, MOVE LINE INTO CURRENT FORMAT
C STATEMENT, DUMP CURRENT FORMAT STATEMENT,
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT
C = 6, MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. FORCE OUT BLANK LINES
C = 7, MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. DO NOT FORCE OUT BLANK LINES
C = 8 (SET BY FMTSET ROUTINE, NOT BY FMTHOW),
C MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. FORCE OUT BLANK LINES. DUMP
C CURRENT STATEMENT.
C = 10 (SET BY FMTSET ROUTINE, NOT BY FMTHOW),
C PRODUCE TOP LINES IF .PAGE POSITION COMMAND
C ADDS LINES TO EMPTY PAGE.
4 CALL FMTPUT
C MASTER = RETURNED UNCHANGED
IF(MASTER.EQ.0)GO TO 3
IF(MASTER.EQ.1)GO TO 6
IF(MASTER.GE.8)GO TO 3
C
C APPLY DOT COMMAND
C MASTER = NOT USED, AND RETURNED UNCHANGED
5 CALL FMTSET
C MASTER = 0, COMMANDS WHICH DO NOT MOVE CURRENT LINE
C TO FORMAT STATEMENT
C = 1, END OF FILE COMMAND
C = 2, RESTORE COMMAND
C = 3, BEGIN COMMAND
C = 4, FORMAT COMMAND
C = 5, PROGRAM COMMAND
C = 6 OR 7, COMMANDS WHICH CAUSE A LINE BREAK
C BUT DO NOT DUMP CURRENT FORMAT STATEMENT
C = 8, PAGE EJECT FOR SCREEN SYSTEMS
C = 10, PAGE START FOR SCREEN SYSTEMS
IF(MASTER.EQ.0)GO TO 3
IF(MASTER.GE.8)GO TO 4
IF(MASTER.GE.6)GO TO 3
IF(MASTER.GT.1)GO TO 2
C
C CLOSE OUTPUT FILES WHEN DONE
6 CALL FMTEND(JDISK,KDISK)
GO TO 1
7 STOP
END
SUBROUTINE FMTNEW
C RENBR(/RETURN CONDITIONS TO ORIGINAL SETTINGS)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
IF(MASTER.NE.0)GO TO 7
C
C SORT LOWER CASE LETTERS INTO INCREASING NUMERICAL
C ORDER, KEEPING UPPER CASE LETTERS PARALLEL.
C RESULTING SORTED ARRAYS ARE USED IN A TERNARY SEARCH.
DO 1 I=1,26
LTRONL(I)=LTRABC(I)
1 LWRONL(I)=LWRABC(I)
DO 3 I=1,25
J=I
LTRNOW=LWRONL(I)
DO 2 K=I,26
IF(LTRNOW.LE.LWRONL(K))GO TO 2
J=K
LTRNOW=LWRONL(K)
2 CONTINUE
LWRONL(J)=LWRONL(I)
LWRONL(I)=LTRNOW
LTRNOW=LTRONL(J)
LTRONL(J)=LTRONL(I)
3 LTRONL(I)=LTRNOW
C
C SORT UPPER CASE LETTERS INTO INCREASING NUMERICAL
C ORDER, KEEPING LOWER CASE LETTERS PARALLEL.
C RESULTING SORTED ARRAYS ARE USED IN A TERNARY SEARCH.
DO 4 I=1,26
LTRONU(I)=LTRABC(I)
4 LWRONU(I)=LWRABC(I)
DO 6 I=1,25
J=I
LTRNOW=LTRONU(I)
DO 5 K=I,26
IF(LTRNOW.LE.LTRONU(K))GO TO 5
J=K
LTRNOW=LTRONU(K)
5 CONTINUE
LTRONU(J)=LTRONU(I)
LTRONU(I)=LTRNOW
LTRNOW=LWRONU(J)
LWRONU(J)=LWRONU(I)
6 LWRONU(I)=LTRNOW
IBYTE=KNTPNT+1
C
C ********************************
C * *
C * PREPARE FOR NEW INPUT FILE *
C * *
C ********************************
C
7 IF(MASTER.GT.1)GO TO 8
KNTLIN=0
LNGBGN=0
KPYBGN=0
MAXBGN=132
LMTKAS=132
JSKIP=0
C
C ***************************************************
C * *
C * REDEFINE CONDITIONS WHICH COMMANDS CAN CHANGE *
C * *
C ***************************************************
C
8 IF(MASTER.GT.2)GO TO 9
C
C NO ACTIVE COMMAND
KOMAND=0
C
C .INPUT WIDTH 132
NXTBGN=132
C
C .UPPER CASE
KASLCL=0
KASALL=0
C
C .NO MASK
LNGTEM=0
C
C .NO COPY
KPYWID=0
KPYKNT=0
C
C .NO LEADING
IHEADR=-2
C
C .NO FILL
IFFILL=1
C
C .INDENT 0
INDENT=0
C
C NO .CENTER
ICENTR=0
C
C .PARAGRAPH 5,-1,3
NOWIND=5
NOWSKP=-1
ITSPAG=3
C
C .OFFSET 1
NOWOFF=1
IOFFST=NOWOFF
C
C .LEFT MARGIN 0
NOWLFT=0
MRGLFT=IOFFST+NOWLFT
C
C .RIGHT MARGIN 60
NOWRIT=60
MRGFAR=NOWRIT
MRGRIT=IOFFST+NOWRIT
C
C .SPACING 1
ISPACE=0
C
C .OUTPUT WIDTH 72
MAXEND=72
C
C .LENGTH 20
MAXLIN=20
C
C .JUSTIFY
JSTIFY=1
IREVRS=1
C
C .BEGIN 1,1
INITAL=1
INTRVL=1
MOVBAC=0
C
C .NO TRAILING
ITRAIL=0
C
C .USE H
IFQUOT=0
LTRQUO=LTRHHH
C
C .PAGE LENGTH 22
LNGPAG=22
C
C .NO PAGING
IFPAGE=0
C
C .NO NEW
ININEW=1
MAXNEW=0
INILNE=1
LINNEW=0
MRKNEW=0
C
C .NO TOP
INITOP=1
MAXTOP=0
INILTO=1
LINTOP=0
MRKTOP=0
C
C .NO PREFACE
INIPRE=1
MAXPRE=0
INILPR=1
LINPRE=0
MRKPRE=0
C
C .NO BOTTOM
INIBOT=1
MAXBOT=0
INILBO=1
LINBOT=0
MRKBOT=0
C
C NO OVERAL STORAGE OF PREFIX, TOP, BOTTOM
MAXSTR=0
MAXLST=0
C
C SET INITIAL FLAGS
LTRSEM=LTRFLG(1)
LTRLES=LTRFLG(2)
LTRDOT=LTRFLG(3)
LTRDOL=LTRFLG(4)
LTRBAC=LTRFLG(5)
LTRUND=LTRFLG(6)
LTREXC=LTRFLG(7)
LTRNUM=LTRFLG(8)
LTRCAR=LTRFLG(9)
MRKSEM=1
MRKLES=0
MRKDOT=1
MRKDOL=1
MRKBAC=1
MRKUND=1
MRKEXC=1
MRKNUM=1
MRKCAR=1
IFFLAG=1
C
C CARRIAGE CONTROLS
MRK0CC=0
MRK1CC=0
MRK2CC=0
MRK3CC=0
LTR1CC=LTRSPA
LTR1QD=LTRSPA
LTR3CC=LTRSPA
LTR3QD=LTRSPA
LTR2CC=LTRSPA
LTR2QD=LTRSPA
C
C *****************************************************
C * *
C * PREPARE FOR A NEW SEQUENCE OF OUTPUT STATEMENTS *
C * *
C *****************************************************
C
9 IF(MASTER.GT.3)GO TO 10
C
C NOTHING YET WRITTEN ON PAGE
KNTOUT=0
KNTBGN=0
NEWTOP=0
C
C .NO INSERT
MAXSPL=0
MAXLNG=0
NOWSPL=0
NOWLNG=1
C
C NO .PROGRAM
LITERL=0
C
C NO .DEFINE
IDEFIN=0
C
C .LEADING OR .NO LEADING
ISKIP=IHEADR
C
C ****************************************
C * *
C * PREPARE FOR A NEW OUTPUT STATEMENT *
C * *
C ****************************************
C
10 LNGMID=0
KPYMID=0
NOWLIN=MAXLIN-1
MRKLIN=0
LNGEND=0
LEDING=13
RETURN
END
SUBROUTINE FMTGET
C RENBR(/GET NEXT LINE OF TEXT)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
C READ NEXT LINE FROM INPUT FILE
IF(MASTER.EQ.9)GO TO 4
MASTER=0
KASFLG=0
IF(JSKIP.EQ.0)GO TO 1
IF(JSKIP.LT.0)GO TO 43
IF(JSKIP.GT.0)GO TO 65
1 IF(KPYBGN.LT.LNGBGN)GO TO 44
IF(LMTKAS.LT.MAXBGN)GO TO 3
MAXBGN=NXTBGN
KNTLIN=KNTLIN+1
READ(IDISK,2,END=67)(LTRBGN(I),I=1,MAXBGN)
2 FORMAT(300A1)
LMTKAS=0
KPYKAS=0
LNGBGN=0
KPYPRT=0
KPYBGN=0
3 ISTART=KPYKAS+1
C
C GET REST OF TEXTUAL ARGUMENT OF DOT COMMAND
4 KOMENT=0
C
C GET NEXT CHARACTER FROM LINE READ FROM INPUT FILE
C KOMENT = -1, IN COMMAND
C = 0, NOT IN COMMAND, OR EXTENDING REST OF TEXTUAL
C OF PREVIOUSLY FOUND COMMAND
C = 1, IN COMMENT FOLLOWING COMMAND
5 LMTKAS=LMTKAS+1
IF(LMTKAS.GT.MAXBGN)GO TO 42
LTRNOW=LTRBGN(LMTKAS)
IF(KOMENT.EQ.0)GO TO 9
IF(MRKSEM.LE.0)GO TO 6
IF(LTRNOW.EQ.LTRSEM)GO TO 41
6 IF(KOMENT.GT.0)GO TO 9
IF(MRKDOT.LE.0)GO TO 7
IF(LTRNOW.EQ.LTRDOT)GO TO 40
7 IF(MRKEXC.LE.0)GO TO 9
IF(LTRNOW.EQ.LTREXC)GO TO 8
GO TO 9
8 KOMENT=1
GO TO 27
9 IF(LTRNOW.EQ.LTRSPA)GO TO 31
IF(LTRNOW.EQ.LTRTAB)GO TO 30
IF(MRKNUM.LE.0)GO TO 10
IF(LTRNOW.EQ.LTRNUM)GO TO 32
10 IF(MRKUND.LE.0)GO TO 11
IF(LTRNOW.EQ.LTRUND)GO TO 33
11 IF(MRKCAR.LE.0)GO TO 12
IF(LTRNOW.EQ.LTRCAR)GO TO 36
12 IF(MRKBAC.LE.0)GO TO 13
IF(LTRNOW.EQ.LTRBAC)GO TO 38
13 IF(MRKLES.LE.0)GO TO 14
IF(LTRNOW.EQ.LTRLES)GO TO 29
14 IF(KASLCL.LT.0)GO TO 15
IF(KASLCL.GT.0)GO TO 21
C KASFLG = 0, NOT IN LESS THAN WORD CAPITALIZATION
C = 1, IN RANGE OF LESS THAN WORD CAPITALIZATION
IF(KASFLG.NE.0)GO TO 21
IF(KASALL.EQ.0)GO TO 27
C
C ATTEMPT TO CONVERT TO LOWER CASE
C THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C OF ALPHABET BEING NEARLY 3**3. THE 3RD OF THE ARRAY
C CONTAINING THE DESIRED LETTER IS FIRST FOUND, THEN
C THE 3RD OF THIS 3RD, AND FINALLY EACH OF THE
C REMAINING 3 LETTERS ARE TESTED INDIVIDUALLY. TO
C PREVENT TESTING AGAINST THE 27TH LETTER WHICH DOES
C NOT EXIST, UPPER 3RD IS TAKEN AS UPPER 9 SORTED
C LETTERS, RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C SO LTRONU(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C BE LARGER THAN THIS.
15 KASLCL=0
IF(LTRNOW.GT.LTRONU(18))GO TO 17
IF(LTRNOW.GT.LTRONU(9))GO TO 16
IF(LTRNOW.LT.LTRONU(1))GO TO 27
NXTLST=3
GO TO 18
16 NXTLST=12
GO TO 18
17 IF(LTRNOW.GT.LTRONU(26))GO TO 27
NXTLST=20
18 IF(LTRNOW.LE.LTRONU(NXTLST))GO TO 19
NXTLST=NXTLST+3
IF(LTRNOW.GT.LTRONU(NXTLST))NXTLST=NXTLST+3
19 IF(LTRNOW.EQ.LTRONU(NXTLST))GO TO 20
NXTLST=NXTLST-1
IF(LTRNOW.EQ.LTRONU(NXTLST))GO TO 20
NXTLST=NXTLST-1
IF(LTRNOW.NE.LTRONU(NXTLST))GO TO 27
20 KPYKAS=KPYKAS+1
IF(KOMENT.LE.0)LNGBGN=KPYKAS
KPYPRT=KPYKAS
LTRBGN(KPYKAS)=LWRONU(NXTLST)
MSKBGN(KPYKAS)=-1
GO TO 5
C
C ATTEMPT TO CONVERT TO UPPER CASE
21 KASLCL=0
IF(LTRNOW.GT.LWRONL(18))GO TO 23
IF(LTRNOW.GT.LWRONL(9))GO TO 22
IF(LTRNOW.LT.LWRONL(1))GO TO 27
NXTLST=3
GO TO 24
22 NXTLST=12
GO TO 24
23 IF(LTRNOW.GT.LWRONL(26))GO TO 27
NXTLST=20
24 IF(LTRNOW.LE.LWRONL(NXTLST))GO TO 25
NXTLST=NXTLST+3
IF(LTRNOW.GT.LWRONL(NXTLST))NXTLST=NXTLST+3
25 IF(LTRNOW.EQ.LWRONL(NXTLST))GO TO 26
NXTLST=NXTLST-1
IF(LTRNOW.EQ.LWRONL(NXTLST))GO TO 26
NXTLST=NXTLST-1
IF(LTRNOW.NE.LWRONL(NXTLST))GO TO 27
26 KPYKAS=KPYKAS+1
IF(KOMENT.LE.0)LNGBGN=KPYKAS
KPYPRT=KPYKAS
LTRBGN(KPYKAS)=LTRONL(NXTLST)
MSKBGN(KPYKAS)=-1
GO TO 5
C
C MAINTAIN CASE OF PRINTING CHARACTER
27 KASLCL=0
KPYKAS=KPYKAS+1
IF(KOMENT.LE.0)LNGBGN=KPYKAS
KPYPRT=KPYKAS
LTRBGN(KPYKAS)=LTRNOW
MSKBGN(KPYKAS)=-1
IF(MRKDOL.LE.0)GO TO 28
IF(LTRNOW.EQ.LTRDOL)MSKBGN(KPYKAS)=-2
28 IF(KPYKAS.GT.ISTART)GO TO 5
IF(MRKDOT.LE.0)GO TO 5
IF(LTRNOW.EQ.LTRDOT)KOMENT=-1
GO TO 5
C
C LESS THAN SIGN MAY INDICATE FLAGGED UPPER CASE
29 KASFLG=1-KASFLG
GO TO 5
C
C SPACE, OR CONVERT TAB TO SPACE
30 IF(LITERL.NE.0)GO TO 27
IF(IDEFIN.NE.0)GO TO 27
31 KASFLG=0
KASLCL=0
KPYKAS=KPYKAS+1
LTRBGN(KPYKAS)=LTRSPA
MSKBGN(KPYKAS)=0
GO TO 5
C
C TREAT NUMBER SIGN LIKE UNDERSCORE AND SPACE
32 LTRBGN(LMTKAS)=LTRSPA
GO TO 34
C
C MAINTAIN CHARACTER FOLLOWING UNDERSCORE
33 LMTKAS=LMTKAS+1
34 KASLCL=0
KPYKAS=KPYKAS+1
IF(KOMENT.LE.0)LNGBGN=KPYKAS
KPYPRT=KPYKAS
MSKBGN(KPYKAS)=1
IF(LMTKAS.GT.MAXBGN)GO TO 35
LTRBGN(KPYKAS)=LTRBGN(LMTKAS)
GO TO 5
35 LTRBGN(KPYKAS)=LTRSPA
GO TO 42
C
C NEXT CHARACTER IS TO BE UPPER CASE
36 IF(LMTKAS.GE.MAXBGN)GO TO 37
IF(MRKCAR.LE.0)GO TO 37
IF(LTRBGN(LMTKAS+1).NE.LTRCAR)GO TO 37
LMTKAS=LMTKAS+1
KASALL=0
KASLCL=0
GO TO 5
37 KASLCL=1
GO TO 5
C
C NEXT CHARACTER IS TO BE LOWER CASE
38 IF(LMTKAS.GE.MAXBGN)GO TO 39
IF(MRKBAC.LE.0)GO TO 39
IF(LTRBGN(LMTKAS+1).NE.LTRBAC)GO TO 39
LMTKAS=LMTKAS+1
KASALL=1
KASLCL=0
GO TO 5
39 KASLCL=-1
GO TO 5
40 LMTKAS=LMTKAS-1
GO TO 42
41 KPYKAS=KPYKAS+1
KPYPRT=KPYKAS
LTRBGN(KPYKAS)=LTRNOW
MSKBGN(KPYKAS)=-1
IF(LMTKAS.EQ.MAXBGN)JSKIP=-1
42 KASLCL=0
GO TO 44
C
C ***************************************************
C * *
C * 2ND PASS, WRAP AND JUSTIFY LTRBGN INTO LTRMID *
C * *
C ***************************************************
C
C BRANCH IF COMMAND OR IF IN NOFILL MODE
43 JSKIP=0
KOMENT=0
ISTART=KPYKAS+1
44 IF(MASTER.GT.0)GO TO 83
IF(KOMENT.NE.0)GO TO 66
IF(IDEFIN.NE.0)GO TO 69
IF(LITERL.NE.0)GO TO 68
IF(ICENTR.NE.0)GO TO 60
IF(IFFILL.EQ.0)GO TO 60
IF(ISKIP.LE.0)GO TO 45
IF(LNGBGN.GE.ISTART)GO TO 65
C
C INSERT NEXT WORD INTO LTRMID ARRAY
45 KPYBGN=KPYBGN+1
IF(KPYBGN.GT.LNGBGN)GO TO 1
IF(MSKBGN(KPYBGN).EQ.0)GO TO 45
KPYBGN=KPYBGN-1
MAXWRD=KPYBGN
LENGTH=0
46 MAXWRD=MAXWRD+1
IF(MAXWRD.GT.LNGBGN)GO TO 47
IF(MSKBGN(MAXWRD).EQ.0)GO TO 47
LENGTH=LENGTH+1
GO TO 46
47 IF(LNGMID.LE.0)GO TO 51
NEEDED=1
C MSKMID = -2, DOLLAR SIGN NOT IN RANGE OF UNDERSCORE
C = -1, INITIAL SPACES AND ALL PRINTING
C CHARACTERS NOT IN RANGE OF UNDERSCORE
C = 0, SPACES BETWEEN WORDS
C = 1, CHARACTERS RIGHT OF UNDERSCORE
IF(MSKMID(LNGMID).GT.0)GO TO 49
LTRNOW=LTRMID(LNGMID)
DO 48 I=1,5
IF(LTRNOW.NE.LTRTWO(I))GO TO 48
NEEDED=2
GO TO 49
48 CONTINUE
49 IF((LNGMID+NEEDED+LENGTH).GT.MRGRIT)GO TO 55
DO 50 I=1,NEEDED
LNGMID=LNGMID+1
LTRMID(LNGMID)=LTRSPA
50 MSKMID(LNGMID)=-1
MSKMID(LNGMID)=0
KNTSPC=KNTSPC+1
GO TO 53
51 NEEDED=MRGLFT+INDENT
INDENT=0
IF(LENGTH.GT.LMTMID)LENGTH=LMTMID
IF(NEEDED.GT.(LMTMID-LENGTH))NEEDED=LMTMID-LENGTH
KNTSPC=0
IF(NEEDED.LE.0)GO TO 53
DO 52 I=1,NEEDED
LNGMID=LNGMID+1
MSKMID(LNGMID)=-1
LTRMID(LNGMID)=LTRSPA
52 CONTINUE
53 DO 54 I=1,LENGTH
KPYBGN=KPYBGN+1
LNGMID=LNGMID+1
LTRMID(LNGMID)=LTRBGN(KPYBGN)
MSKMID(LNGMID)=MSKBGN(KPYBGN)
54 CONTINUE
GO TO 1
C
C JUSTIFY TEXT WHEN LINE OVERFLOWS
55 IREVRS=-IREVRS
IF(LNGMID.GE.MRGRIT)GO TO 83
IF(KNTSPC.LE.0)GO TO 83
IF(JSTIFY.EQ.0)GO TO 83
IGROUP=(MRGRIT-LNGMID)/KNTSPC
JGROUP=MRGRIT-LNGMID-(KNTSPC*IGROUP)
IF(IREVRS.GT.0)JGROUP=JGROUP-KNTSPC-1
J=MRGRIT
56 IF(MSKMID(LNGMID).NE.0)GO TO 58
JGROUP=JGROUP+IREVRS
NEEDED=IGROUP
IF(JGROUP.GE.0)NEEDED=IGROUP+1
IF(NEEDED.LE.0)GO TO 58
DO 57 I=1,NEEDED
LTRMID(J)=LTRSPA
MSKMID(J)=0
57 J=J-1
IF(J.LE.LNGMID)GO TO 59
58 LTRMID(J)=LTRMID(LNGMID)
MSKMID(J)=MSKMID(LNGMID)
J=J-1
LNGMID=LNGMID-1
GO TO 56
59 LNGMID=MRGRIT
GO TO 83
C
C DIRECT COPY OF CHARACTERS IN NOFILL MODE
60 IF(LNGBGN.LT.ISTART)GO TO 63
IF(ISKIP.GT.0)GO TO 65
LNGMID=1
KPYMID=0
NEEDED=MRGLFT+INDENT
INDENT=0
IF(ICENTR.LT.0)NEEDED=MRGLFT+
1((MRGRIT-MRGLFT-LNGBGN+ISTART-1)/2)
IF(ICENTR.GT.0)NEEDED=IOFFST+
1((ICENTR-LNGBGN+ISTART-1)/2)
ICENTR=0
IF(NEEDED.LE.0)GO TO 62
DO 61 I=1,NEEDED
IF(KPYMID.GE.LMTMID)GO TO 62
KPYMID=KPYMID+1
MSKMID(KPYMID)=-1
LTRMID(KPYMID)=LTRSPA
61 CONTINUE
62 IF(KPYBGN.GE.LNGBGN)GO TO 83
IF(KPYMID.GE.LMTMID)GO TO 83
KPYBGN=KPYBGN+1
KPYMID=KPYMID+1
LTRMID(KPYMID)=LTRBGN(KPYBGN)
MSKMID(KPYMID)=MSKBGN(KPYBGN)
IF(MSKMID(KPYMID).NE.0)LNGMID=KPYMID
GO TO 62
C
C SIMULATE LINES IN RANGE OF SKIP COMMAND
63 IF(ISKIP.LT.0)ISKIP=0
JSKIP=1
ICENTR=0
INDENT=0
WRITE(KDISK,64)
64 FORMAT(1H )
65 LNGMID=0
GO TO 83
66 MASTER=2
GO TO 83
67 MASTER=1
GO TO 83
C
C OUTPUT TEXT IN RANGE OF PROGRAM (NOT FORMAT) COMMAND
68 KPYBGN=ISTART-1
GO TO 83
C
C STORE TEXT IN RANGE OF VARIOUS DEFINE COMMANDS
69 KPYBGN=ISTART-1
J=KPYBGN+1
IF(KPYBGN.GE.LNGBGN)WRITE(KDISK,64)
IF(KPYBGN.LT.LNGBGN)WRITE(KDISK,70)(LTRBGN(I),I=J,LNGBGN)
70 FORMAT(300A1)
IF(MAXLST.GE.LMTLST)GO TO 79
IF((MAXSTR+LNGBGN-KPYBGN).GT.LMTSTR)GO TO 81
GO TO(71,73,75,77),IDEFIN
C
C TEXT IN RANGE OF .DEFINE BOTTOM
71 LINBOT=LINBOT+1
MAXLST=MAXLST+1
MAXBOT=MAXBOT+LNGBGN-KPYBGN
LINSTR(MAXLST)=LNGBGN-KPYBGN
72 IF(KPYBGN.GE.LNGBGN)GO TO 1
KPYBGN=KPYBGN+1
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(KPYBGN)
LTRSTR(MAXSTR)=LTRBGN(KPYBGN)
GO TO 72
C
C TEXT IN RANGE OF .DEFINE PREFACE
73 LINPRE=LINPRE+1
MAXLST=MAXLST+1
MAXPRE=MAXPRE+LNGBGN-KPYBGN
LINSTR(MAXLST)=LNGBGN-KPYBGN
74 IF(KPYBGN.GE.LNGBGN)GO TO 1
KPYBGN=KPYBGN+1
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(KPYBGN)
LTRSTR(MAXSTR)=LTRBGN(KPYBGN)
GO TO 74
C
C TEXT IN RANGE OF .DEFINE TOP
75 LINTOP=LINTOP+1
MAXLST=MAXLST+1
MAXTOP=MAXTOP+LNGBGN-KPYBGN
LINSTR(MAXLST)=LNGBGN-KPYBGN
76 IF(KPYBGN.GE.LNGBGN)GO TO 1
KPYBGN=KPYBGN+1
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(KPYBGN)
LTRSTR(MAXSTR)=LTRBGN(KPYBGN)
GO TO 76
C
C TEXT IN RANGE OF .DEFINE NEW
77 LINNEW=LINNEW+1
MAXLST=MAXLST+1
MAXNEW=MAXNEW+LNGBGN-KPYBGN
LINSTR(MAXLST)=LNGBGN-KPYBGN
78 IF(KPYBGN.GE.LNGBGN)GO TO 1
KPYBGN=KPYBGN+1
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(KPYBGN)
LTRSTR(MAXSTR)=LTRBGN(KPYBGN)
GO TO 78
C
C OVERFLOW DURING VARIOUS DEFINE COMMANDS
C 01234567890123456789012345678901234567890123456789
79 WRITE(ITTY,80)KNTLIN,(LTRBGN(I),I=LOCATE,LNGBGN)
80 FORMAT(6H (Line,1I5,
143H) Too many lines in active .DEFINE commands/
213H Discarding: ,300A1)
KPYBGN=LNGBGN
GO TO 1
81 WRITE(ITTY,82)KNTLIN,(LTRBGN(I),I=LOCATE,LNGBGN)
82 FORMAT(6H (Line,1I5,
148H) Too many characters in active .DEFINE commands/
213H Discarding: ,300A1)
KPYBGN=LNGBGN
GO TO 1
C
C RETURN TO CALLING PROGRAM
83 RETURN
END
SUBROUTINE FMTHOW
C RENBR(/EVALUATE COMMAND)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
KPYBGN=KPYKAS
IF(KOMENT.EQ.0)GO TO 25
C
C GET NEXT LINE OF TEXT TO BE INTERPRETED
KOMAND=0
LOWBFR=ISTART
LOCPNT=1
C
C GET NEXT CHARACTER TO BE TESTED
1 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.LNGBGN)GO TO 7
C
C ATTEMPT TO IDENTIFY THE CHARACTER
2 IF(LOCPNT.LE.0)GO TO 7
KVALUE=NOTPNT(LOCPNT)
LOCABC=KVALUE
IF(KVALUE.LT.0)LOCABC=-LOCABC
LOCABC=LOCABC/IBYTE
3 IF(LTRBGN(LOWBFR).EQ.LTRABC(LOCABC))GO TO 6
IF(LTRBGN(LOWBFR).EQ.LWRABC(LOCABC))GO TO 6
C
C LETTERS DID NOT MATCH
IF(KVALUE.GE.0)GO TO 5
KVALUE=-KVALUE
C
C CHECK FOR SPACES BEFORE NEXT WORD
4 IF(LTRBGN(LOWBFR).NE.LTRSPA)GO TO 3
LOWBFR=LOWBFR+1
IF(LOWBFR.LE.LNGBGN)GO TO 4
GO TO 7
C
C GET NEXT LETTER TO BE TESTED IF FAILURE
5 LOCPNT=KVALUE-(IBYTE*LOCABC)
GO TO 2
C
C LETTERS MATCHED
6 KVALUE=MCHPNT(LOCPNT)
KMDNEW=KVALUE/IBYTE
LOCPNT=KVALUE-(IBYTE*KMDNEW)
IF(KMDNEW.NE.0)KOMAND=KMDNEW
LOCATE=LOWBFR
GO TO 1
C
C ENTIRE TREE SEARCHED
7 IF(LOCPNT.EQ.1)GO TO 30
IF(KOMAND.LE.1)GO TO 28
IF(KMDARG(KOMAND).EQ.0)GO TO 24
IF(KMDARG(KOMAND).LT.0)GO TO 17
C
C EVALUATE NUMBER TO RIGHT OF SWITCH
KNTARG=0
8 KVALUE=0
KMINUS=0
9 LOCATE=LOCATE+1
IF(LOCATE.GT.LNGBGN)GO TO 13
LTRNOW=LTRBGN(LOCATE)
IF(LTRNOW.EQ.LTRSPA)GO TO 11
IF(LTRNOW.EQ.LTRCOM)GO TO 12
DO 10 I=1,10
IF(LTRNOW.NE.LTRDGT(I))GO TO 10
IF(KMINUS.EQ.0)KMINUS=1
IF(KVALUE.LT.10000)KVALUE=(10*KVALUE)+I-1
GO TO 9
10 CONTINUE
IF(KMINUS.NE.0)GO TO 13
IF(LTRNOW.EQ.LTRMNS)KMINUS=-2
IF(LTRNOW.EQ.LTRPLS)KMINUS=-1
IF(KMINUS.EQ.0)GO TO 28
GO TO 9
11 IF(KMINUS.EQ.0)GO TO 9
12 LOCATE=LOCATE+1
13 IF(KMINUS.EQ.-2)KVALUE=-KVALUE
KNTARG=KNTARG+1
IF(KMINUS.EQ.0)GO TO 14
IF(KNTARG.GT.KMDARG(KOMAND))GO TO 28
14 IF(KNTARG.GT.2)GO TO 16
IF(KNTARG.EQ.2)GO TO 15
IMINUS=KMINUS
IVALUE=KVALUE
GO TO 16
15 JMINUS=KMINUS
JVALUE=KVALUE
16 IF(LOCATE.GT.LNGBGN)GO TO 31
LOCATE=LOCATE-1
GO TO 8
C
C FIND START OF TEXT STRING WHICH CANNOT EXTEND ACROSS
C NORMAL END OF COMMAND CHARACTERS
17 J=LOCATE+1
LOCATE=LNGBGN+1
KNTARG=0
IF(J.GT.LNGBGN)GO TO 23
LTRNOW=LTRBGN(J)
IF(LTRNOW.EQ.LTRSPA)GO TO 19
DO 18 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 28
IF(LTRNOW.EQ.LWRABC(I))GO TO 28
18 CONTINUE
J=J-1
19 I=1
20 J=J+1
IF(J.GT.LNGBGN)GO TO 22
IF(MSKBGN(J).EQ.0)GO TO 20
IF(MSKBGN(J).GT.0)GO TO 21
IF(LTRBGN(J).NE.LTRCOM)GO TO 21
IF(I.EQ.0)GO TO 19
KNTARG=KNTARG+1
IF(KNTARG.EQ.2)LOWBFR=LNGBGN+1
GO TO 20
21 KNTARG=KNTARG+1
IF(KNTARG.EQ.1)LOCATE=J
IF(KNTARG.EQ.2)LOWBFR=J
I=0
GO TO 20
22 IF(I.EQ.0)GO TO 23
KNTARG=KNTARG+1
IF(KNTARG.EQ.2)LOWBFR=LNGBGN+1
23 IF((-KNTARG).LE.KMDARG(KOMAND))GO TO 28
GO TO 31
C
C CONVERT CASE OF LETTERS IN REST OF TEXTUAL ARGUMENT
24 LNGBGN=KPYPRT
MASTER=9
GO TO 32
C
C INSURE SPACE FOLLOWS COMMAND WITH TEXTUAL ARGUMENT
25 LOCATE=LOCATE+1
IF(LOCATE.GT.LNGBGN)GO TO 31
LTRNOW=LTRBGN(LOCATE)
IF(LTRNOW.EQ.LTRSPA)GO TO 27
DO 26 I=1,26
IF(LTRNOW.EQ.LTRABC(I))GO TO 28
IF(LTRNOW.EQ.LWRABC(I))GO TO 28
26 CONTINUE
GO TO 31
27 LOCATE=LOCATE+1
GO TO 31
C
C REPORT ILLEGAL COMMAND TO USER
28 WRITE(ITTY,29)KNTLIN,(LTRBGN(I),I=ISTART,LNGBGN)
29 FORMAT(6H (Line,1I5,19H) Unknown command: ,300A1)
30 KOMAND=0
MASTER=8
GO TO 32
C
C DETERMINE WHETHER LEGAL COMMAND REQUIRES BREAK
31 MASTER=KMDBRK(KOMAND)
C
C RETURN TO CALLING PROGRAM
32 RETURN
END
SUBROUTINE FMTPUT
C RENBR(/COPY LINE OF TEXT INTO FORMAT STATEMENT)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
C MASTER = 0, LINE HAS FILLED
C = 1, END FILE COMMAND
C = 2, RESTORE COMMAND
C = 3, TEXT COMMAND
C = 4, CONTINUE COMMAND
C = 5, PROGRAM COMMAND
C = 6, EJECT, PAGE POSITION COMMAND
C = 7, BY MOST COMMANDS THAT BREAK A LINE
C = 8, PAGE, TEST PAGE, TEST SPACING SET BY FMTSET
C
C MASTER = 0, LINE HAS FILLED, COMMAND WAS NOT ISSUED.
C MOVE LINE INTO CURRENT FORMAT STATEMENT.
C DO NOT CHANGE DIRECTION OF BLANK FILL.
C = 1 THRU 5, MOVE LINE INTO CURRENT FORMAT
C STATEMENT, DUMP CURRENT FORMAT STATEMENT,
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT
C = 6, MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. FORCE OUT BLANK LINES
C = 7, MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. DO NOT FORCE OUT BLANK LINES
C = 8, (SET BY FMTSET ROUTINE, NOT BY FMTHOW),
C MOVE LINE INTO CURRENT FORMAT STATEMENT
C AND SET DIRECTION OF BLANK FILL TO BE FROM
C RIGHT. FORCE OUT BLANK LINES. DUMP
C CURRENT STATEMENT.
C = 10 (SET BY FMTSET ROUTINE, NOT BY FMTHOW),
C PRODUCE TOP LINES IF .PAGE POSITION COMMAND
C ADDS LINES TO EMPTY PAGE.
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
IF(MASTER.EQ.0)GO TO 1
IREVRS=1
IF(LNGMID.EQ.0)GO TO 87
GO TO 2
1 IF(LITERL.NE.0)GO TO 124
C
C INSERT CARRIAGE CONTROL REQUESTED BY .CARRIAGE
2 IF(LNGMID.LE.0)GO TO 18
I=LNGMID
GO TO 4
3 IF(MRK1CC.EQ.0)GO TO 18
LNGMID=1
MSKMID(1)=-1
LTRMID(1)=LTRSPA
I=0
4 KPYLNG=NOWLNG
KPYSPL=NOWSPL
KPYKLM=LNGMID
C
C INSERT TEMPLATE REQUESTED BY .MASK
IF(LNGTEM.LE.0)GO TO 10
5 IF(LNGMID.GE.IOFFST)GO TO 6
IF(LNGMID.GE.LMTMID)GO TO 11
LNGMID=LNGMID+1
LTRMID(LNGMID)=LTRSPA
MSKMID(LNGMID)=0
GO TO 5
6 J=IOFFST
DO 9 I=1,LNGTEM
J=J+1
IF(J.GT.LMTMID)GO TO 11
IF(LNGMID.GE.J)GO TO 7
LNGMID=J
GO TO 8
7 IF(LTRMID(J).NE.LTRSPA)GO TO 9
IF(MSKMID(J).GT.0)GO TO 9
8 LTRMID(J)=LTRTEM(I)
MSKMID(J)=MSKTEM(I)
9 CONTINUE
GO TO 11
C
C COPY LINE OF TEXT IF REQUESTED BY .COPY
10 IF(I.LE.IOFFST)GO TO 16
11 KPYKLM=LNGMID
KPYUSD=KPYWID
IF(KPYUSD.LT.(LNGMID-IOFFST))KPYUSD=LNGMID-IOFFST
I=IOFFST+KPYUSD
J=I
IF(J.GT.LNGMID)J=LNGMID
L=KPYKNT
K=LNGMID
12 IF(L.LE.0)GO TO 16
L=L-1
13 IF(K.GE.I)GO TO 14
IF(LNGMID.GE.LMTMID)GO TO 16
K=K+1
LNGMID=LNGMID+1
MSKMID(LNGMID)=0
LTRMID(LNGMID)=LTRSPA
GO TO 13
14 K=IOFFST
15 IF(K.GE.J)GO TO 12
IF(LNGMID.GE.LMTMID)GO TO 16
K=K+1
LNGMID=LNGMID+1
MSKMID(LNGMID)=MSKMID(K)
LTRMID(LNGMID)=LTRMID(K)
GO TO 15
16 IF(MRK1CC.EQ.0)GO TO 18
IF(MSKMID(1).NE.-1)GO TO 17
IF(LTRMID(1).NE.LTRSPA)GO TO 17
LTRMID(1)=LTR1CC
MSKMID(1)=-3
IF(ISKIP.GT.0)MSKMID(1)=-4
17 LTR1CC=LTR1QD
IF(MRK1CC.GT.0)MRK1CC=0
C
C PREPARE TO GENERATE NEW OUTPUT LINE
18 KPYMID=0
IPASS=0
IF(IFPAGE.LE.0)GO TO 20
IF(LNGPAG.LE.0)GO TO 20
I=KNTOUT
IF(ITRAIL.GT.0)GO TO 19
IF(ISKIP.GT.0)I=I+ISKIP
19 IF(I.GE.LNGPAG)GO TO 97
20 CONTINUE
21 INICLM=LNGEND
INILIN=NOWLIN
INILED=LEDING
INISPL=NOWSPL
INILNG=NOWLNG
INIKPY=KPYKLM
22 LFTOVR=MAXEND-LEDING-LNGEND
C
C TEST FOR INITIAL FIELD DESCRIPTION
IF(KPYMID.GE.LNGMID)GO TO 25
INISPC=KPYMID+1
IF(MSKMID(INISPC).EQ.-2)GO TO 50
C
C TEST FOR INITIAL MULTIPLE SPACES
INSERT=0
23 IF(LTRMID(INISPC).NE.LTRSPA)GO TO 24
INSERT=INSERT+1
INISPC=INISPC+1
IF(INISPC.LE.LNGMID)GO TO 23
GO TO 65
24 IF(INSERT.GE.3)GO TO 65
C
C SEARCH FOR EMBEDDED OR RIGHTMOST SPACES
25 MAXPRT=KPYMID
26 MAXPRT=MAXPRT+1
IF(MAXPRT.GT.LNGMID)GO TO 29
IF(LTRMID(MAXPRT).NE.LTRSPA)GO TO 26
INISPC=MAXPRT
27 INISPC=INISPC+1
IF(INISPC.GT.LNGMID)GO TO 28
IF(LTRMID(INISPC).EQ.LTRSPA)GO TO 27
INSERT=INISPC-MAXPRT
IF(INSERT.GE.6)GO TO 29
MAXPRT=INISPC
GO TO 26
28 INSERT=INISPC-MAXPRT
IF(INSERT.GE.3)GO TO 29
MAXPRT=INISPC
29 MAXPRT=MAXPRT-1
IF(KPYMID.GE.MAXPRT)GO TO 47
IF(IFQUOT.NE.0)GO TO 39
C
C DETERMINE LENGTH OF LINE IN H NOTATION WHICH WILL FIT
IF(LFTOVR.LT.4)GO TO 74
INSERT=MAXPRT-KPYMID
IF(INSERT.GT.9)GO TO 30
IF(INSERT.GT.(LFTOVR-3))INSERT=LFTOVR-3
GO TO 31
30 IF(INSERT.LE.(LFTOVR-4))GO TO 31
INSERT=LFTOVR-3
IF(INSERT.GE.10)INSERT=INSERT-1
C
C DETERMINE IF FIELD DESCRIPTION APPEARS IN TEXT
31 KONVRT=KPYMID
32 IF(KONVRT.GE.(KPYMID+INSERT))GO TO 33
KONVRT=KONVRT+1
IF(MSKMID(KONVRT).NE.-2)GO TO 32
INSERT=KONVRT-KPYMID-1
C
C INSERT LINE IN H NOTATION
33 IF(IPASS.NE.0)GO TO 34
KPYMID=KPYMID+INSERT
LNGEND=LNGEND+INSERT+3
IF(INSERT.GE.10)LNGEND=LNGEND+1
GO TO 72
34 LFTDGT=INSERT
ININUM=LNGEND+1
35 LNGEND=LNGEND+1
I=LFTDGT
LFTDGT=LFTDGT/10
I=I-(10*LFTDGT)
J=LNGEND
36 IF(J.LE.ININUM)GO TO 37
LTREND(J)=LTREND(J-1)
J=J-1
GO TO 36
37 LTREND(ININUM)=LTRDGT(I+1)
IF(LFTDGT.GT.0)GO TO 35
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRQUO
DO 38 I=1,INSERT
KPYMID=KPYMID+1
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRMID(KPYMID)
38 CONTINUE
GO TO 71
C
C DETERMINE LENGTH OF LINE IN ' NOTATION WHICH WILL FIT
39 IF(LFTOVR.LT.4)GO TO 74
KONVRT=KPYMID
KNTQOT=0
40 INSERT=MAXPRT+KNTQOT-KPYMID
IF(INSERT.GT.(LFTOVR-3))INSERT=LFTOVR-3
41 KONVRT=KONVRT+1
IF(KONVRT.GT.(KPYMID+INSERT-KNTQOT))GO TO 44
IF(MSKMID(KONVRT).NE.-2)GO TO 42
INSERT=KONVRT-1-KPYMID+KNTQOT
GO TO 44
42 IF(LTRMID(KONVRT).NE.LTRQUO)GO TO 41
IF((KONVRT-KPYMID+KNTQOT).LT.(LFTOVR-3))GO TO 43
INSERT=INSERT-1
IF(INSERT.LE.0)GO TO 74
GO TO 44
43 KNTQOT=KNTQOT+1
GO TO 40
C
C INSERT LINE IN ' NOTATION
44 IF(IPASS.NE.0)GO TO 45
KPYMID=KPYMID+INSERT-KNTQOT
LNGEND=LNGEND+3+INSERT
GO TO 72
45 LNGEND=LNGEND+1
LTREND(LNGEND)=LTRQUO
INSERT=INSERT-KNTQOT
DO 46 I=1,INSERT
KPYMID=KPYMID+1
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRMID(KPYMID)
IF(LTRMID(KPYMID).NE.LTRQUO)GO TO 46
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRQUO
46 CONTINUE
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRQUO
GO TO 71
C
C INSERT ZERO LENGTH LINE AS MERELY TERMINAL SLASH
47 IF(MRK1CC.NE.0)GO TO 3
IF(LNGTEM.GT.0)GO TO 4
IF(LFTOVR.LE.0)GO TO 74
IF(IPASS.EQ.0)GO TO 72
KNTOUT=KNTOUT+1
IF(ISKIP.LE.0)GO TO 48
ISKIP=ISKIP-1
GO TO 71
48 WRITE(KDISK,49)
49 FORMAT(1X)
ISKIP=ISPACE
JSKIP=0
GO TO 71
C
C FIND NEXT SECTION OF FIELD DESCRIPTION
50 IF(KPYMID.LT.KPYKLM)GO TO 51
KPYKLM=KPYKLM+KPYUSD
NOWLNG=KPYLNG
NOWSPL=KPYSPL
51 KONVRT=NOWSPL
INSERT=0
IF(NOWLNG.GT.MAXLNG)GO TO 56
52 IF(INSERT.GE.LFTOVR)GO TO 73
IF(KONVRT.GE.LNGDEF(NOWLNG))GO TO 54
KONVRT=KONVRT+1
IF(MSKDEF(KONVRT).GT.0)GO TO 53
IF(LTRDEF(KONVRT).EQ.LTRCOM)GO TO 61
53 INSERT=INSERT+1
GO TO 52
54 IF(IPASS.EQ.0)GO TO 56
I=1
IF(NOWLNG.GT.1)I=LNGDEF(NOWLNG-1)+1
J=LNGDEF(NOWLNG)
IF(I.LE.J)WRITE(KDISK,55)(LTRDEF(K),K=I,J)
55 FORMAT(300A1)
56 NOWLNG=NOWLNG+1
57 KPYMID=KPYMID+1
IF(KPYMID.GT.LNGMID)GO TO 58
IF(KPYMID.GT.KPYKLM)GO TO 58
IF(MSKMID(KPYMID).EQ.-2)GO TO 57
58 KPYMID=KPYMID-1
IF(INSERT.GT.0)GO TO 61
IF(NOWLNG.GT.(MAXLNG+1))GO TO 60
IF(NOWLNG.GT.2)GO TO 59
IF(NOWLNG.EQ.1)GO TO 60
IF(LNGDEF(1).GT.0)GO TO 61
GO TO 60
59 IF(LNGDEF(NOWLNG-1).GT.LNGDEF(NOWLNG-2))GO TO 61
60 IF(KPYMID.LT.LNGMID)GO TO 22
IF(IPASS.EQ.0)GO TO 77
GO TO 88
C
C INSERT FIELD DESCRIPTION
61 IF(IPASS.NE.0)GO TO 62
LNGEND=LNGEND+INSERT+1
NOWSPL=KONVRT
GO TO 72
62 IF(INSERT.LE.0)GO TO 64
DO 63 I=1,INSERT
NOWSPL=NOWSPL+1
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRDEF(NOWSPL)
63 CONTINUE
64 NOWSPL=KONVRT
GO TO 71
C
C INSERT MULTIPLE SPACES IN X NOTATION
65 IF(LFTOVR.LT.3)GO TO 74
IF(INSERT.LT.10)GO TO 66
IF(LFTOVR.EQ.3)INSERT=9
IF(INSERT.LT.100)GO TO 66
IF(LFTOVR.EQ.4)INSERT=99
66 KPYMID=KPYMID+INSERT
IF(IPASS.NE.0)GO TO 67
LNGEND=LNGEND+3
IF(INSERT.GE.10)LNGEND=LNGEND+1
IF(INSERT.GE.100)LNGEND=LNGEND+1
GO TO 72
67 LFTDGT=INSERT
ININUM=LNGEND+1
68 LNGEND=LNGEND+1
I=LFTDGT
LFTDGT=LFTDGT/10
I=I-(10*LFTDGT)
J=LNGEND
69 IF(J.LE.ININUM)GO TO 70
LTREND(J)=LTREND(J-1)
J=J-1
GO TO 69
70 LTREND(ININUM)=LTRDGT(I+1)
IF(LFTDGT.GT.0)GO TO 68
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRXXX
C
C END OF CURRENT FIELD IN 2ND PASS
71 LNGEND=LNGEND+1
IF(KPYMID.GE.LNGMID)GO TO 89
LTREND(LNGEND)=LTRCOM
GO TO 22
C
C END OF CURRENT FIELD IN 1ST PASS
72 IF(KPYMID.LT.LNGMID)GO TO 22
GO TO 77
C
C INPUT LINE OVERFLOWS CURRENT OUTPUT LINE
73 IMACRO=1
GO TO 75
74 IMACRO=0
75 IF(IPASS.NE.0)GO TO 98
LNGEND=0
LEDING=6
NOWLIN=NOWLIN-1
IF(NOWLIN.GE.0)GO TO 22
IF(INILIN.LT.(MAXLIN-1))GO TO 77
IF(INICLM.GT.0)GO TO 77
C
C CANCEL LINE WHICH IS IMPOSSIBLE TO OUTPUT
WRITE(ITTY,76)KNTLIN,INITAL
76 FORMAT(6H (Line,1I5,26H) Output line in statement,
11I6,12H is too long)
MOVBAC=0
INITAL=INITAL+INTRVL
IF(INITAL.LT.1)INITAL=1
IF(INITAL.GT.99999)INITAL=99999
LNGMID=0
KPYMID=0
IF(ISKIP.GT.0)ISKIP=0
IF(IMACRO.EQ.0)GO TO 106
NOWSPL=LNGDEF(NOWLNG)
NOWLNG=NOWLNG+1
JSKIP=0
GO TO 106
C
C PREPARE FOR 2ND PASS OR FOR ANOTHER 1ST PASS
77 KPYMID=0
LNGEND=INICLM
NOWSPL=INISPL
NOWLNG=INILNG
KPYKLM=INIKPY
IF(NOWLIN.LT.0)GO TO 98
IPASS=1
NOWLIN=INILIN
LEDING=INILED
IF(MRKLIN.NE.0)GO TO 22
IF(LNGEND.NE.0)GO TO 22
C
C CHECK IF LINE IS NEEDED BEFORE FIRST STATEMENT
78 IF(KNTBGN.NE.0)GO TO 80
KNTBGN=1
IF(MRKNEW.EQ.0)GO TO 80
KPYINT=ININEW-1
LOCINT=ININEW-1
NOWINT=INILNE-1
79 NOWINT=NOWINT+1
IF(NOWINT.GE.(INILNE+LINNEW))GO TO 80
LOCINT=LOCINT+LINSTR(NOWINT)
GO TO 128
80 CONTINUE
C
C CHECK IF TOP OF PAGE LINE IS NEEDED
C NEWTOP IS USED ONLY TO PREVENT PAGE POSITION WITH
C ARGUMENT APPEARING AFTER PAGE POSITION WITHOUT
C ARGUMENT FROM PRODUCING A SECOND TOP OF PAGE.
IF(NEWTOP.NE.0)GO TO 83
IF(MASTER.EQ.10)GO TO 81
IF(KNTOUT.NE.0)GO TO 83
81 IF(IFPAGE.EQ.0)GO TO 83
IF(MRKTOP.EQ.0)GO TO 83
NEWTOP=1
KPYINT=INITOP-1
LOCINT=INITOP-1
NOWINT=INILTO-1
82 NOWINT=NOWINT+1
IF(NOWINT.GE.(INILTO+LINTOP))GO TO 83
LOCINT=LOCINT+LINSTR(NOWINT)
GO TO 127
83 CONTINUE
IF(MASTER.EQ.10)GO TO 162
C
C CHECK IF PREFACE LINE IS NEEDED
IF(MRKPRE.EQ.0)GO TO 85
KPYINT=INIPRE-1
LOCINT=INIPRE-1
NOWINT=INILPR-1
84 NOWINT=NOWINT+1
IF(NOWINT.GE.(INILPR+LINPRE))GO TO 85
LOCINT=LOCINT+LINSTR(NOWINT)
GO TO 126
85 CONTINUE
C
C INDICATE NEW FORMAT STATEMENT AFTER PREFACE
WRITE(KDISK,86)INITAL
86 FORMAT(1I5,8H FORMAT()
GO TO 22
C
C OUTPUT COMPLETED LINE OF FORMAT STATEMENT
87 IF(LNGEND.NE.0)GO TO 89
IF(MASTER.EQ.8)GO TO 94
IF(MASTER.EQ.10)GO TO 78
IF(KNTOUT.NE.0)GO TO 106
GO TO 119
88 IF(LNGEND.EQ.0)GO TO 119
89 LTREND(LNGEND)=LTRSLA
IF(LNGMID.LE.0)GO TO 92
KNTOUT=KNTOUT+1
IF(ISKIP.LE.0)GO TO 90
ISKIP=ISKIP-1
GO TO 92
90 ISKIP=ISPACE
JSKIP=0
WRITE(KDISK,91)(LTRMID(I),I=1,LNGMID)
91 FORMAT(300A1)
92 LNGMID=0
IF(IFPAGE.LE.0)GO TO 93
IF(LNGPAG.LE.0)GO TO 93
I=KNTOUT
IF(ISKIP.GT.0)I=I+ISKIP
IF(I.LT.LNGPAG)GO TO 93
IF(ITRAIL.GT.0)GO TO 96
KNTOUT=LNGPAG
IF(ISKIP.GT.0)ISKIP=0
GO TO 96
93 IF(MASTER.EQ.0)GO TO 162
IF(MASTER.EQ.4)GO TO 97
IF(MASTER.EQ.6)GO TO 121
IF(MASTER.EQ.5)GO TO 95
IF(MASTER.EQ.7)GO TO 162
C IF(MASTER.EQ.8)GO TO 90
94 IF(ITRAIL.GT.0)GO TO 96
IF(IFPAGE.EQ.0)GO TO 97
IF(ISKIP.GT.0)ISKIP=0
GO TO 97
95 IF(ITRAIL.GT.0)GO TO 96
GO TO 97
96 IF(ISKIP.GT.0)GO TO 3
IF(JSKIP.NE.0)GO TO 3
97 NOWLIN=0
98 IF(LNGEND.LE.0)GO TO 105
IF(NOWLIN.LE.0)LTREND(LNGEND)=LTRRIG
IF(MRKLIN.GT.0)GO TO 103
IF(NOWLIN.GT.0)GO TO 100
IF(LNGEND.GT.1)GO TO 100
WRITE(JDISK,99)INITAL
99 FORMAT(1I5,11H FORMAT(1X))
GO TO 102
100 WRITE(JDISK,101)INITAL,(LTREND(I),I=1,LNGEND)
101 FORMAT(I5,8H FORMAT(,59A1)
102 MOVBAC=0
INITAL=INITAL+INTRVL
IF(INITAL.LT.1)INITAL=1
IF(INITAL.GT.99999)INITAL=99999
GO TO 105
103 WRITE(JDISK,104)MRKLIN,(LTREND(I),I=1,LNGEND)
104 FORMAT(5X,1I1,66A1)
105 CONTINUE
C
C SPECIFY APPEARANCE OF NEXT LINE OF FORMAT STATEMENT
IF(NOWLIN.LE.0)GO TO 106
LNGEND=0
LEDING=6
MRKLIN=MRKLIN+1
IF(MRKLIN.GT.9)MRKLIN=1
NOWLIN=NOWLIN-1
GO TO 118
106 NOWLIN=MAXLIN-1
MRKLIN=0
LNGEND=0
LEDING=13
GO TO 107
C
C CHECK IF SCREEN PAGE IS FULL
107 IF(MASTER.EQ.8)GO TO 109
IF(IFPAGE.LE.0)GO TO 118
IF(LNGPAG.LE.0)GO TO 118
I=KNTOUT
IF(ITRAIL.GT.0)GO TO 108
IF(ISKIP.GT.0)I=I+ISKIP
108 IF(I.LT.LNGPAG)GO TO 118
GO TO 110
109 IF(ISKIP.GT.0)GO TO 118
110 CONTINUE
C
C SET CARRIAGE CONTROL FOR NEXT PAGE
IF(MRK0CC.NE.0)GO TO 111
MRK0CC=1
MRK2CC=MRK1CC
LTR2CC=LTR1CC
LTR2QD=LTR1QD
111 MRK1CC=MRK3CC
LTR1CC=LTR3CC
LTR1QD=LTR3QD
C
C CHECK IF BOTTOM LINE IS AVAILABLE
IF(KNTOUT.EQ.0)GO TO 113
NEWTOP=0
IF(MRKBOT.EQ.0)GO TO 113
LNGEND=0
KPYINT=INIBOT-1
LOCINT=INIBOT-1
NOWINT=INILBO-1
112 NOWINT=NOWINT+1
IF(NOWINT.GE.(INILBO+LINBOT))GO TO 113
LOCINT=LOCINT+LINSTR(NOWINT)
GO TO 125
113 IF(IHEADR.EQ.-2)ISKIP=-2
IF(ITRAIL.LE.0)ISKIP=-2
114 KNTOUT=0
C
C CHECK IF FORMAT STATEMENT IS READY TO BE OUTPUT
IF(KPYMID.GE.LNGMID)GO TO 119
IF(MSKMID(1).EQ.-3)GO TO 116
IF(MSKMID(1).EQ.-4)GO TO 115
GO TO 117
115 IF(IHEADR.NE.-2)GO TO 116
LNGMID=0
GO TO 119
116 MSKMID(1)=-1
LTRMID(1)=LTRSPA
117 GO TO 16
C
C COPY NEXT SECTION OF LINE
118 IF(KPYMID.LT.LNGMID)GO TO 21
C
C LINE OF TEXT IS ENTIRELY SHIFTED TO FORMAT STATEMENT
119 IF(MASTER.EQ.0)GO TO 122
IF(MASTER.EQ.4)GO TO 122
IF(MASTER.EQ.6)GO TO 121
IF(MASTER.EQ.5)GO TO 120
IF(MASTER.EQ.7)GO TO 122
IF(MASTER.EQ.8)GO TO 121
IF(ITRAIL.GT.0)GO TO 121
IF(IFPAGE.EQ.0)GO TO 122
IF(ISKIP.GT.0)ISKIP=0
GO TO 122
120 IF(ITRAIL.GT.0)GO TO 121
GO TO 123
121 IF(ISKIP.GT.0)GO TO 3
IF(JSKIP.NE.0)GO TO 3
122 IF(ISKIP.LE.0)GO TO 123
IF(ITRAIL.EQ.0)GO TO 123
IF(IFPAGE.LE.0)GO TO 123
IF((KNTOUT+ISKIP).GE.LNGPAG)GO TO 3
123 LNGMID=0
GO TO 162
C
C **************************************************
C * *
C * INTERNAL ROUTINE TO WRITE TEXT NOT IN FORMAT *
C * *
C **************************************************
C
C PREPARE TO COPY TEXT IN RANGE OF PROGRAM COMMAND
124 IRETRN=1
KPYINT=KPYBGN
LOCINT=LNGBGN
GO TO 129
C
C PREPARE TO COPY TEXT AT END OF FULL PAGE
125 IRETRN=2
GO TO 129
C
C PREPARE TO COPY TEXT BEFORE NEXT STATEMENT
126 IRETRN=3
GO TO 129
C
C PREPARE TO COPY TEXT AT TOP OF PAGE
127 IRETRN=4
GO TO 129
C
C PREPARE TO COPY TEXT BEFORE FIRST STATEMENT
128 IRETRN=5
GO TO 129
C
C PREPARE TO SEARCH FOR NEW GROUP OF DOLLAR SIGNS
129 IWIDTH=0
JOFFST=0
KOFFST=0
LFTDGT=INITAL
C
C GET NEXT CHARACTER IN LINE
130 IF(KPYINT.GE.LOCINT)GO TO 141
KPYINT=KPYINT+1
IF(IRETRN.NE.1)GO TO 131
MSKNOW=MSKBGN(KPYINT)
LTRNOW=LTRBGN(KPYINT)
GO TO 132
131 MSKNOW=MSKSTR(KPYINT)
LTRNOW=LTRSTR(KPYINT)
132 CONTINUE
C
C CHECK FOR INITIAL DOLLAR SIGN
IF(KOFFST.LT.0)GO TO 134
IF(KOFFST.NE.0)GO TO 138
IF(MSKNOW.NE.-2)GO TO 133
IWIDTH=IWIDTH+1
GO TO 130
C
C COPY CHARACTER IF NOT DOLLAR SIGN
133 IF(IWIDTH.NE.0)GO TO 134
IF(LNGEND.GE.LMTEND)GO TO 153
LNGEND=LNGEND+1
LTREND(LNGEND)=LTRNOW
GO TO 130
C
C CHECK FOR PLUS OR MINUS SIGN TO RIGHT OF DOLLAR SIGN
134 IF(MSKNOW.NE.-1)GO TO 140
IF(LTRNOW.EQ.LTRPLS)GO TO 135
IF(LTRNOW.EQ.LTRMNS)GO TO 136
IF(KOFFST.NE.0)GO TO 138
IF(LTRNOW.EQ.LTREQU)GO TO 137
GO TO 140
135 KOFFST=KOFFST+2
GO TO 130
136 KOFFST=KOFFST+4
GO TO 130
137 KOFFST=-1
GO TO 130
C
C CHECK FOR DIGITS TO RIGHT OF PLUS OR MINUS SIGN
138 IF(MSKNOW.NE.-1)GO TO 140
DO 139 I=1,10
IF(LTRNOW.NE.LTRDGT(I))GO TO 139
JOFFST=(10*JOFFST)+I-1
IF(IWIDTH.GT.0)IWIDTH=-IWIDTH
GO TO 130
139 CONTINUE
140 KPYINT=KPYINT-1
GO TO 142
C
C ADJUST THE NUMBER BY OFFSET RIGHT OF DOLLAR
141 IF(IWIDTH.EQ.0)GO TO 154
142 IF(IWIDTH.GT.0)GO TO 143
IWIDTH=-IWIDTH
GO TO 144
143 IF(KOFFST.NE.0)JOFFST=INTRVL
IF(KOFFST.LT.0)KOFFST=1
144 IF(KOFFST.GE.3)JOFFST=-JOFFST
LFTDGT=LFTDGT+JOFFST
IF(KOFFST.LT.0)LFTDGT=JOFFST
IF(LFTDGT.LT.1)LFTDGT=1
IF(LFTDGT.GT.99999)LFTDGT=99999
IF(KOFFST.LT.0)GO TO 145
IF(KOFFST.EQ.1)GO TO 145
IF(KOFFST.EQ.3)GO TO 145
GO TO 146
145 INITAL=LFTDGT
MOVBAC=1
GO TO 129
C
C REPLACE DOLLAR IN LITERAL OR PREFACE BY NUMBER
146 ININUM=LNGEND+1
147 IF(LNGEND.GE.LMTEND)GO TO 153
IWIDTH=IWIDTH-1
LNGEND=LNGEND+1
I=LFTDGT
LFTDGT=LFTDGT/10
I=I-(10*LFTDGT)
J=LNGEND
148 IF(J.LE.ININUM)GO TO 149
LTREND(J)=LTREND(J-1)
J=J-1
GO TO 148
149 LTREND(ININUM)=LTRDGT(I+1)
IF(LFTDGT.GT.0)GO TO 147
IF(IWIDTH.GT.(LMTEND-LNGEND))IWIDTH=LMTEND-LNGEND
IF(IWIDTH.LE.0)GO TO 152
I=LNGEND
LNGEND=LNGEND+IWIDTH
J=LNGEND
150 LTREND(J)=LTREND(I)
I=I-1
J=J-1
IF(I.GE.ININUM)GO TO 150
151 LTREND(J)=LTRSPA
J=J-1
IF(J.GE.ININUM)GO TO 151
152 GO TO 129
C
C INSERT LITERAL OR PREFACE INTO PROOF AND FORMAT FILES
153 KPYINT=LOCINT
154 IF(LNGEND.GT.0)GO TO 157
WRITE(JDISK,155)
155 FORMAT(1H )
WRITE(KDISK,156)
156 FORMAT(1H )
GO TO 160
157 WRITE(JDISK,158)(LTREND(I),I=1,LNGEND)
158 FORMAT(300A1)
WRITE(KDISK,159)(LTREND(I),I=1,LNGEND)
159 FORMAT(300A1)
LNGEND=0
160 GO TO(161,112,84,82,79),IRETRN
161 KPYBGN=LNGBGN
GO TO 162
C
C RETURN TO CALLING PROGRAM
162 RETURN
END
SUBROUTINE FMTSET
C RENBR(/APPLY COMMAND)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
COMMON/FMTONE/I ,IBYTE ,ICENTR,IDEFIN,IDISK ,
1IFFILL,IFFLAG,IFPAGE,IFQUOT,IGROUP,IHEADR,IMACRO,
2IMINUS,INDENT,INIBOT,INICLM,INIKPY,INILBO,INILED,
3INILIN,INILNE,INILNG,INILPR,INILTO,ININEW,ININUM,
4INIPRE,INISPC,INISPL,INITAL,INITOP,INSERT,INTRVL,
5IOFFST,IPASS ,IREVRS,ISKIP ,ISPACE,ISTART,ITRAIL,
6ITSPAG,ITTY ,IVALUE,IWIDTH,J ,JDISK ,JGROUP,
7JMINUS,JSKIP ,JSTIFY,JTTY ,JVALUE,K ,KASALL,
8KASFLG,KASLCL,KDISK ,KMINUS,KNTARG,KNTBGN,KNTLIN,
9KNTOUT,KNTPNT,KNTQOT,KNTSPC,KNTXTR,KOMAND,KOMENT
COMMON/FMTTWO/KONVRT,KPYBGN,KPYKAS,KPYKLM,KPYKNT,
1KPYLNG,KPYMID,KPYPRT,KPYSPL,KPYUSD,KPYWID,KVALUE,
2LEDING,LENGTH,LFTDGT,LFTOVR,LINBOT,LINNEW,LINPRE,
3LINTOP,LITERL,LMTBGN,LMTEND,LMTKAS,LMTLNG,LMTLST,
4LMTMID,LMTSPL,LMTSTR,LMTTEM,LNGBGN,LNGEND,LNGMID,
5LNGPAG,LNGTEM,LOCABC,LOCATE,LOCPNT,LOWBFR,MASTER,
6MAXBGN,MAXBOT,MAXEND,MAXLIN,MAXLNG,MAXLST,MAXNEW,
7MAXPRE,MAXPRT,MAXSPL,MAXSTR,MAXTOP,MAXWRD,MOVBAC,
8MRGFAR,MRGLFT,MRGRIT,MRKBAC,MRKBOT,MRKCAR,MRKDOL,
9MRKDOT,MRKEXC,MRKLES,MRKLIN,MRKNEW,MRKNUM,MRKPRE
COMMON/FMTTHR/MRKSEM,MRKTOP,MRKUND,MRK0CC,MRK1CC,
1MRK2CC,MRK3CC,NEEDED,NEWTOP,NOWIND,NOWLFT,NOWLIN,
2NOWLNG,NOWOFF,NOWRIT,NOWSKP,NOWSPL,NXTBGN,NXTLST
COMMON/FMTFOU/KMDARG(88) ,KMDBRK(88) ,LINSTR(30) ,
1 LNGDEF(50) ,MCHPNT(350) ,MSKBGN(300) ,MSKDEF(500) ,
2 MSKMID(300) ,MSKSTR(500) ,MSKTEM(300) ,NOTPNT(350)
COMMON/FMTFIV/LTRBAC,LTRCAR,LTRCOM,LTRDOL,LTRDOT,
1LTREQU,LTREXC,LTRHHH,LTRLES,LTRMNS,LTRNOW,LTRNUM,
2LTRPLS,LTRQUO,LTRRIG,LTRSEM,LTRSLA,LTRSPA,LTRTAB,
3LTRUND,LTRXXX,LTR1CC,LTR1QD,LTR2CC,LTR2QD,LTR3CC,
4LTR3QD,LWRHHH
COMMON/FMTSIX/LTRABC(26) ,LTRBGN(300) ,LTRDEF(500) ,
1 LTRDGT(10) ,LTREND(72) ,LTRFLG(9) ,LTRMID(300) ,
2 LTRONL(26) ,LTRONU(26) ,LTRSTR(500) ,LTRTEM(300) ,
3 LTRTWO(5) ,LWRABC(26) ,LWRONL(26) ,LWRONU(26)
C
C
WRITE(KDISK,1)(LTRBGN(I),I=ISTART,LNGBGN)
1 FORMAT(300A1)
C
C GO TO( ,BLA,BRE,CEN,EOF,FIL,FAL,FCA,CAR,FCO,
C 1 FLC,FQU,FSP,FUC,CON,IND,IWI,INS,JUS,LMA,
C 2 LEN,LCA,NFI,NFA,NFC,NCA,NFC,NFL,NFQ,NFS,
C 3 NFU,NJU,NTR,OFF,OWI,PAR,EVE,PRO,RES,RMA,
C 4 SKI,SPA,TRA,UCA,USE,FIN,FRE,FFE,NFI,NFR,
C 5 NFF,LEA,NLE,EJE,USH,COP,MAS,NEV,NMA,NCO,
C 6 NIN,NOF,TEX,DPR,INT,DIN,PLE,PAG,PAG,NOP,
C 7 NIN,NOF,BEG,DEV,BOT,DBO,PLE,PAG,PAG,NOP,
C 8 TPA,PCA,NPC,TSP,COM,EDE,NBO,TOP,DTO,NTO,
C 9 RTO,REV,RBO,NEW,DNE,NNE,RNE,PPO)
GO TO( 161, 2, 161, 20, 161, 27, 28, 29, 16, 30,
1 32, 34, 36, 37, 136, 48, 49, 50, 57, 59,
2 91, 60, 66, 67, 68, 64, 69, 71, 73, 75,
3 76, 79, 88, 89, 92, 105, 111, 121, 161, 126,
4 127, 131, 153, 154, 155, 31, 35, 33, 70, 74,
5 72, 58, 80, 161, 156, 21, 61, 86, 81, 65,
6 78, 82, 136, 24, 6, 22, 97, 93, 100, 84,
7 132, 95, 83, 133, 161, 26, 63, 143, 25, 87,
8 125, 124, 122, 38, 23, 77, 123,98),KOMAND
C
C .BLANK
2 IF(IVALUE.LT.0)GO TO 5
IF(IFPAGE.EQ.0)GO TO 3
IF(KNTOUT.NE.0)GO TO 4
IF(IHEADR.EQ.-2)GO TO 161
GO TO 4
3 IF(ISKIP.LT.-1)GO TO 161
4 IF(ISKIP.LT.0)ISKIP=0
IF(IVALUE.LE.0)IVALUE=1
ISKIP=ISKIP+IVALUE
GO TO 161
5 IVALUE=LNGPAG-KNTOUT+IVALUE
IF(ISKIP.LT.0)ISKIP=0
IF(ISKIP.LT.IVALUE)ISKIP=IVALUE
GO TO 161
C
C .BOTTOM
6 IDEFIN=0
7 IF(MAXBOT.EQ.0)GO TO 10
I=INIBOT+MAXBOT
J=INIBOT
8 IF(I.GT.MAXSTR)GO TO 9
MSKSTR(J)=MSKSTR(I)
LTRSTR(J)=LTRSTR(I)
I=I+1
J=J+1
GO TO 8
9 IF(INIPRE.GT.INIBOT)INIPRE=INIPRE-MAXBOT
IF(INITOP.GT.INIBOT)INITOP=INITOP-MAXBOT
IF(ININEW.GT.INIBOT)ININEW=ININEW-MAXBOT
MAXSTR=MAXSTR-MAXBOT
10 IF(LINBOT.EQ.0)GO TO 13
I=INILBO+LINBOT
J=INILBO
11 IF(I.GT.MAXLST)GO TO 12
LINSTR(J)=LINSTR(I)
I=I+1
J=J+1
GO TO 11
12 IF(INILPR.GT.INILBO)INILPR=INILPR-LINBOT
IF(INILTO.GT.INILBO)INILTO=INILTO-LINBOT
IF(INILNE.GT.INILBO)INILNE=INILNE-LINBOT
MAXLST=MAXLST-LINBOT
13 MRKBOT=1
INIBOT=MAXSTR+1
MAXBOT=0
INILBO=MAXLST+1
LINBOT=0
IF(IDEFIN.NE.0)GO TO 161
IF(LOCATE.GE.LNGBGN)GO TO 161
IF(MAXLST.GE.LMTLST)GO TO 157
IF((MAXSTR+LNGBGN-LOCATE+1).GT.LMTSTR)GO TO 159
DO 14 I=LOCATE,LNGBGN
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(I)
LTRSTR(MAXSTR)=LTRBGN(I)
14 CONTINUE
15 LINBOT=1
MAXLST=MAXLST+1
MAXBOT=LNGBGN-LOCATE+1
LINSTR(MAXLST)=MAXBOT
GO TO 161
C
C .CARRIAGE
16 MRK2CC=0
IF(LOCATE.GT.LNGBGN)GO TO 17
LTR2CC=LTRBGN(LOCATE)
LTR2QD=LTR2CC
MRK2CC=1
17 IF(KNTARG.LT.2)GO TO 18
IF(LOWBFR.GT.LNGBGN)GO TO 18
LTR2QD=LTRBGN(LOWBFR)
IF(MRK2CC.EQ.0)LTR2CC=LTR2QD
MRK2CC=-1
18 IF(MRK0CC.NE.0)GO TO 19
MRK1CC=MRK2CC
LTR1CC=LTR2CC
LTR1QD=LTR2QD
19 GO TO 161
C
C .CENTER
20 ICENTR=-1
IF(IVALUE.GT.0)ICENTR=IVALUE
IF(IMINUS.LE.0)ICENTR=MRGFAR+IVALUE
INDENT=0
GO TO 161
C
C .COPY
21 IF(IMINUS.NE.0)KPYWID=IVALUE
IF(KNTARG.GT.1)KPYKNT=JVALUE
GO TO 161
C
C .DEFINE BOTTOM
22 IDEFIN=1
GO TO 7
C
C .DEFINE GROUP
23 IDEFIN=4
GO TO 39
C
C .DEFINE PREFACE
24 IDEFIN=2
GO TO 112
C
C .DEFINE TOP
25 IDEFIN=3
GO TO 144
C
C .END DEFINITION
26 IDEFIN=0
GO TO 161
C
C .FILL
27 IFFILL=1
GO TO 161
C
C .FLAGS ALL
28 IFFLAG=1
IF(MRKLES.EQ.-1)MRKLES=1
IF(MRKDOL.EQ.-1)MRKDOL=1
IF(MRKBAC.EQ.-1)MRKBAC=1
IF(MRKUND.EQ.-1)MRKUND=1
IF(MRKNUM.EQ.-1)MRKNUM=1
IF(MRKCAR.EQ.-1)MRKCAR=1
GO TO 161
C
C .FLAGS CAPITALIZE
29 IF(LOCATE.LE.LNGBGN)LTRLES=LTRBGN(LOCATE)
MRKLES=IFFLAG
GO TO 161
C
C .FLAGS CONTROL
30 IF(LOCATE.LE.LNGBGN)LTRDOT=LTRBGN(LOCATE)
GO TO 161
C
C .FLAGS INSERT
31 IF(LOCATE.LE.LNGBGN)LTRDOL=LTRBGN(LOCATE)
MRKDOL=IFFLAG
GO TO 161
C
C .FLAGS LOWER CASE
32 IF(LOCATE.LE.LNGBGN)LTRBAC=LTRBGN(LOCATE)
MRKBAC=IFFLAG
GO TO 161
C
C .FLAGS FENCE
33 IF(LOCATE.LE.LNGBGN)LTRSEM=LTRBGN(LOCATE)
MRKSEM=1
GO TO 161
C
C .FLAGS QUOTE
34 IF(LOCATE.LE.LNGBGN)LTRUND=LTRBGN(LOCATE)
MRKUND=IFFLAG
GO TO 161
C
C .FLAGS REMARK
35 IF(LOCATE.LE.LNGBGN)LTREXC=LTRBGN(LOCATE)
MRKEXC=1
GO TO 161
C
C .FLAGS SPACE
36 IF(LOCATE.LE.LNGBGN)LTRNUM=LTRBGN(LOCATE)
MRKNUM=IFFLAG
GO TO 161
C
C .FLAGS UPPER CASE
37 IF(LOCATE.LE.LNGBGN)LTRCAR=LTRBGN(LOCATE)
MRKCAR=IFFLAG
GO TO 161
C
C .GROUP
38 IDEFIN=0
39 IF(MAXNEW.EQ.0)GO TO 42
I=ININEW+MAXNEW
J=ININEW
40 IF(I.GT.MAXSTR)GO TO 41
MSKSTR(J)=MSKSTR(I)
LTRSTR(J)=LTRSTR(I)
I=I+1
J=J+1
GO TO 40
41 IF(INIPRE.GT.ININEW)INIPRE=INIPRE-MAXNEW
IF(INIBOT.GT.ININEW)INIBOT=INIBOT-MAXNEW
IF(INITOP.GT.ININEW)INITOP=INITOP-MAXNEW
MAXSTR=MAXSTR-MAXNEW
42 IF(LINNEW.EQ.0)GO TO 45
I=INILNE+LINNEW
J=INILNE
43 IF(I.GT.MAXLST)GO TO 44
LINSTR(J)=LINSTR(I)
I=I+1
J=J+1
GO TO 43
44 IF(INILPR.GT.INILNE)INILPR=INILPR-LINNEW
IF(INILBO.GT.INILNE)INILBO=INILBO-LINNEW
IF(INILTO.GT.INILNE)INILTO=INILTO-LINNEW
MAXLST=MAXLST-LINNEW
45 MRKNEW=1
ININEW=MAXSTR+1
MAXNEW=0
INILNE=MAXLST+1
LINNEW=0
IF(IDEFIN.NE.0)GO TO 161
IF(LOCATE.GE.LNGBGN)GO TO 161
IF(MAXLST.GE.LMTLST)GO TO 157
IF((MAXSTR+LNGBGN-LOCATE+1).GT.LMTSTR)GO TO 159
DO 46 I=LOCATE,LNGBGN
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(I)
LTRSTR(MAXSTR)=LTRBGN(I)
46 CONTINUE
47 LINNEW=1
MAXLST=MAXLST+1
MAXNEW=LNGBGN-LOCATE+1
LINSTR(MAXLST)=MAXNEW
GO TO 161
C
C .INDENT
48 INDENT=5
IF(IMINUS.NE.0)INDENT=IVALUE
ICENTR=0
GO TO 161
C
C .INPUT WIDTH
49 IF(IMINUS.LT.0)IVALUE=NXTBGN+IVALUE
IF(IVALUE.GT.LMTBGN)IVALUE=LMTBGN
IF(IVALUE.GT.0)NXTBGN=IVALUE
GO TO 161
C
C .INSERT
C USED DEFINITIONS ARE REMOVED BEFORE NEW ONE IS ADDED
50 I=0
51 IF(NOWLNG.GT.MAXLNG)GO TO 52
I=I+1
LNGDEF(I)=LNGDEF(NOWLNG)-NOWSPL
NOWLNG=NOWLNG+1
GO TO 51
52 NOWLNG=1
MAXLNG=I
I=0
53 IF(NOWSPL.GE.MAXSPL)GO TO 54
I=I+1
NOWSPL=NOWSPL+1
LTRDEF(I)=LTRDEF(NOWSPL)
MSKDEF(I)=MSKDEF(NOWSPL)
GO TO 53
54 NOWSPL=0
MAXSPL=I
IF(MAXLNG.GE.LMTLNG)GO TO 161
IF(LOCATE.GE.LNGBGN)GO TO 56
IF((MAXSPL+LNGBGN-LOCATE+1).GT.LMTSPL)GO TO 161
DO 55 I=LOCATE,LNGBGN
MAXSPL=MAXSPL+1
LTRDEF(MAXSPL)=LTRBGN(I)
55 MSKDEF(MAXSPL)=MSKBGN(I)
56 MAXLNG=MAXLNG+1
LNGDEF(MAXLNG)=MAXSPL
GO TO 161
C
C .JUSTIFY
57 JSTIFY=1
GO TO 161
C
C .LEADING
58 IHEADR=-1
IF(ISKIP.LT.0)ISKIP=-1
GO TO 161
C
C .LEFT MARGIN
59 IF(IMINUS.LT.0)IVALUE=NOWLFT+IVALUE
NOWLFT=IVALUE
MRGLFT=NOWLFT+IOFFST
IF(MRGLFT.LT.IOFFST)MRGLFT=IOFFST
GO TO 161
C
C .LOWER CASE, CORRESPONDS TO \\ IN TEXT
60 KASALL=1
GO TO 161
C
C .MASK
61 LNGTEM=0
IF(LOCATE.GE.LNGBGN)GO TO 161
DO 62 I=LOCATE,LNGBGN
IF(LNGTEM.GE.LMTTEM)GO TO 161
LNGTEM=LNGTEM+1
MSKTEM(LNGTEM)=MSKBGN(I)
62 LTRTEM(LNGTEM)=LTRBGN(I)
GO TO 161
C
C .NO BOTTOM
63 MRKBOT=0
GO TO 161
C
C .NO CARRIAGE
64 MRK1CC=0
GO TO 161
C
C .NO COPY
65 KPYKNT=0
GO TO 161
C
C .NO FILL
66 IFFILL=0
GO TO 161
C
C .NO FLAGS ALL
67 IFFLAG=-1
IF(MRKLES.EQ.1)MRKLES=-1
IF(MRKDOL.EQ.1)MRKDOL=-1
IF(MRKBAC.EQ.1)MRKBAC=-1
IF(MRKUND.EQ.1)MRKUND=-1
IF(MRKNUM.EQ.1)MRKNUM=-1
IF(MRKCAR.EQ.1)MRKCAR=-1
GO TO 161
C
C .NO FLAGS CAPITALIZE
68 MRKLES=0
GO TO 161
C
C .NO FLAGS CONTROL
69 MRKDOT=0
GO TO 161
C
C .NO FLAGS INSERT
70 MRKDOL=0
GO TO 161
C
C .NO FLAGS LOWER CASE
71 MRKBAC=0
GO TO 161
C
C .NO FLAGS FENCE
72 MRKSEM=0
GO TO 161
C
C .NO FLAGS QUOTE
73 MRKUND=0
GO TO 161
C
C .NO FLAGS REMARK
74 MRKEXC=0
GO TO 161
C
C .NO FLAGS SPACE
75 MRKNUM=0
GO TO 161
C
C .NO FLAGS UPPER CASE
76 MRKCAR=0
GO TO 161
C
C .NO GROUP
77 MRKNEW=0
GO TO 161
C
C .NO INSERT
78 MAXSPL=0
MAXLNG=0
NOWSPL=0
NOWLNG=1
GO TO 161
C
C .NO JUSTIFY
79 JSTIFY=0
GO TO 161
C
C .NO LEADING
80 IHEADR=-2
IF(ISKIP.LT.0)ISKIP=-2
GO TO 161
C
C .NO MASK
81 LNGTEM=0
GO TO 161
C
C .NO OFFSET
82 IVALUE=0
GO TO 90
C
C .NO PAGE CARRIAGE
83 MRK3CC=0
LTR3CC=LTRSPA
LTR3QD=LTRSPA
GO TO 99
C
C .NO PAGING
84 IFPAGE=0
IF(MRK0CC.EQ.0)GO TO 85
MRK0CC=0
MRK1CC=MRK2CC
LTR1CC=LTR2CC
LTR1QD=LTR2QD
85 GO TO 161
C
C .NO PREFACE
86 MRKPRE=0
GO TO 161
C
C .NO TOP
87 MRKTOP=0
GO TO 161
C
C .NO TRAILING
88 ITRAIL=0
GO TO 161
C
C .OFFSET
89 IF(IMINUS.LE.0)IVALUE=NOWOFF+IVALUE
90 NOWOFF=IVALUE
IOFFST=NOWOFF
IF(IOFFST.LT.0)IOFFST=0
MRGLFT=NOWLFT+IOFFST
IF(MRGLFT.LT.IOFFST)MRGLFT=IOFFST
MRGRIT=NOWRIT+IOFFST
IF(MRGRIT.GT.LMTMID)MRGRIT=LMTMID
GO TO 161
C
C .OUTPUT LENGTH
91 IF(IMINUS.LT.0)IVALUE=MAXLIN+IVALUE
IF(IVALUE.LE.0)GO TO 161
NOWLIN=IVALUE+NOWLIN-MAXLIN
MAXLIN=IVALUE
GO TO 161
C
C .OUTPUT WIDTH
92 IF(IMINUS.LT.0)IVALUE=MAXEND+IVALUE
IF(IVALUE.GT.LMTEND)IVALUE=LMTEND
IF(IVALUE.GT.0)MAXEND=IVALUE
GO TO 161
C
C .PAGE
93 IF(IFPAGE.EQ.0)IFPAGE=-1
IF(ISKIP.GT.0)GO TO 94
IF(KNTOUT.EQ.0)GO TO 101
94 MASTER=8
I=LNGPAG-KNTOUT
IF(ISKIP.LT.I)ISKIP=I
GO TO 161
C
C .PAGE CARRIAGE
C MRK0CC = 0, NO NON-PAGING TEXT CARRIAGE CONTROLS ARE
C STORED IN LTR2CC AND LTR2QD
C = 1, NON-PAGING TEXT CARRIAGE CONTROLS ARE
C STORED IN LTR2CC AND LTR2QD. LTR1CC AND
C LTR1QD CONTAIN THE PAGING CARRIAGE CONTROLS
C NORMALLY STORED IN LTR3CC AND LTR3QD
C MRK3CC = -1, BOTH TYPES OF CARRIAGE CONTROLS DEFINED FOR
C USE WHILE PAGING
C = 0, NO CARRIAGE CONTROLS DEFINED FOR PAGING
C = 1, TOP OF PAGE CARRIAGE CONTROL DEFINED, BUT NONE
C FOR SUBSEQUENT LINES ON PAGE
C LTR3CC = CARRIAGE CONTROL FOR TOP LINE ON PAGE
C LTR3QD = CARRIAGE CONTROL FOR SUBSEQUENT LINES ON PAGE.
C QD STANDS FOR QUEUED SINCE AT THE TOP OF THE
C PAGE, THIS CHARACTER IS QUEUED UP FOR NEXT LINE.
95 MRK3CC=0
IF(LOCATE.GT.LNGBGN)GO TO 96
LTR3CC=LTRBGN(LOCATE)
LTR3QD=LTR3CC
MRK3CC=1
96 IF(KNTARG.LT.2)GO TO 99
IF(LOWBFR.GT.LNGBGN)GO TO 99
LTR3QD=LTRBGN(LOWBFR)
IF(MRK3CC.EQ.0)LTR3CC=LTR3QD
MRK3CC=-1
GO TO 99
C
C .PAGE LENGTH
97 IF(IMINUS.LT.0)IVALUE=LNGPAG+IVALUE
IF(IVALUE.GE.0)LNGPAG=IVALUE
GO TO 161
C
C .PAGE POSITION
98 IF(IMINUS.EQ.0)IVALUE=KNTOUT
IF(IMINUS.LT.0)IVALUE=KNTOUT+IVALUE
I=KNTOUT
IF(IVALUE.GE.0)KNTOUT=IVALUE
IF(I.GT.0)GO TO 99
IF(IFPAGE.EQ.0)GO TO 99
IF(ISKIP.LT.0)ISKIP=0
MASTER=10
99 IF(MRK0CC.NE.0)GO TO 102
GO TO 161
C
C .PAGING
100 IFPAGE=1
101 IF(MRK0CC.NE.0)GO TO 104
MRK2CC=MRK1CC
LTR2CC=LTR1CC
LTR2QD=LTR1QD
MRK0CC=1
102 IF(KNTOUT.EQ.0)GO TO 103
MRK1CC=MRK3CC
IF(MRK3CC.GT.0)MRK1CC=0
LTR1CC=LTR3QD
LTR1QD=LTR3QD
GO TO 104
103 MRK1CC=MRK3CC
LTR1CC=LTR3CC
LTR1QD=LTR3QD
104 GO TO 161
C
C .PARAGRAPH
105 INDENT=NOWIND
IF(IMINUS.NE.0)INDENT=IVALUE
NOWIND=INDENT
IF(KNTARG.EQ.1)GO TO 106
IF(JMINUS.NE.0)NOWSKP=JVALUE
IF(KNTARG.EQ.2)GO TO 106
IF(KMINUS.NE.0)ITSPAG=KVALUE
106 IF(ISKIP.LT.0)GO TO 161
IF(IHEADR.NE.-2)GO TO 107
IF(KNTOUT.EQ.0)GO TO 161
107 IF(NOWSKP.LT.0)GO TO 108
ISKIP=ISKIP+(NOWSKP*(ISPACE+1))
GO TO 109
108 ISKIP=ISKIP-NOWSKP
109 IF(IFPAGE.LE.0)GO TO 161
IF(LNGPAG.LE.0)GO TO 161
IF(ITSPAG.LT.0)GO TO 110
IVALUE=ITSPAG
GO TO 133
110 IVALUE=-ITSPAG
GO TO 132
C
C .PREFACE
111 IDEFIN=0
112 IF(MAXPRE.EQ.0)GO TO 115
I=INIPRE+MAXPRE
J=INIPRE
113 IF(I.GT.MAXSTR)GO TO 114
MSKSTR(J)=MSKSTR(I)
LTRSTR(J)=LTRSTR(I)
I=I+1
J=J+1
GO TO 113
114 IF(INITOP.GT.INIPRE)INITOP=INITOP-MAXPRE
IF(INIBOT.GT.INIPRE)INIBOT=INIBOT-MAXPRE
IF(ININEW.GT.INIPRE)ININEW=ININEW-MAXPRE
MAXSTR=MAXSTR-MAXPRE
115 IF(LINPRE.EQ.0)GO TO 118
I=INILPR+LINPRE
J=INILPR
116 IF(I.GT.MAXLST)GO TO 117
LINSTR(J)=LINSTR(I)
I=I+1
J=J+1
GO TO 116
117 IF(INILTO.GT.INILPR)INILTO=INILTO-LINPRE
IF(INILBO.GT.INILPR)INILBO=INILBO-LINPRE
IF(INILNE.GT.INILPR)INILNE=INILNE-LINPRE
MAXLST=MAXLST-LINPRE
118 MRKPRE=1
INIPRE=MAXSTR+1
MAXPRE=0
INILPR=MAXLST+1
LINPRE=0
IF(IDEFIN.NE.0)GO TO 161
IF(LOCATE.GE.LNGBGN)GO TO 161
IF(MAXLST.GE.LMTLST)GO TO 157
IF((MAXSTR+LNGBGN-LOCATE+1).GT.LMTSTR)GO TO 159
DO 119 I=LOCATE,LNGBGN
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(I)
LTRSTR(MAXSTR)=LTRBGN(I)
119 CONTINUE
120 LINPRE=1
MAXLST=MAXLST+1
MAXPRE=LNGBGN-LOCATE+1
LINSTR(MAXLST)=MAXPRE
GO TO 161
C
C .PROGRAM, LITERAL COPY OF INPUT TO OUTPUT
121 LITERL=1
IDEFIN=0
GO TO 137
C
C .RESUME BOTTOM
122 MRKBOT=1
GO TO 161
C
C .RESUME GROUP
123 MRKNEW=1
GO TO 161
C
C .RESUME PREFACE
124 MRKPRE=1
GO TO 161
C
C .RESUME TOP
125 MRKTOP=1
GO TO 161
C
C .RIGHT MARGIN
126 IF(IMINUS.LT.0)IVALUE=NOWRIT+IVALUE
IF(IMINUS.EQ.0)IVALUE=MRGFAR
NOWRIT=IVALUE
IF(MRGFAR.LT.NOWRIT)MRGFAR=NOWRIT
MRGRIT=NOWRIT+IOFFST
IF(MRGRIT.GT.LMTMID)MRGRIT=LMTMID
GO TO 161
C
C .SKIP
127 IF(IVALUE.LT.0)GO TO 130
IF(IFPAGE.EQ.0)GO TO 128
IF(KNTOUT.NE.0)GO TO 129
IF(IHEADR.EQ.-2)GO TO 161
GO TO 129
128 IF(ISKIP.LT.-1)GO TO 161
129 IF(ISKIP.LT.0)ISKIP=0
IF(IVALUE.LE.0)IVALUE=1
ISKIP=ISKIP+(IVALUE*(ISPACE+1))
GO TO 161
130 IVALUE=LNGPAG-KNTOUT+(IVALUE*(ISPACE+1))+ISPACE
IF(ISKIP.LT.0)ISKIP=0
IF(ISKIP.LT.IVALUE)ISKIP=IVALUE
GO TO 161
C
C .SPACING
131 ISPACE=0
IF(IVALUE.GT.0)ISPACE=IVALUE-1
GO TO 161
C
C .TEST PAGE
132 GO TO 134
C
C .TEST SPACING
133 IVALUE=(IVALUE*(ISPACE+1))-ISPACE
134 IF(LNGPAG.LE.0)GO TO 161
IF(ISKIP.GT.0)GO TO 135
IF(KNTOUT.EQ.0)GO TO 161
135 I=LNGPAG-KNTOUT-ISKIP
IF(I.LT.IVALUE)GO TO 93
GO TO 161
C
C .TEXT OR .CONTINUE
136 LITERL=0
IDEFIN=0
137 IF(MOVBAC.LT.0)GO TO 138
IF(MOVBAC.EQ.0)GO TO 139
C CURRENT STATEMENT NUMBER DUE TO PROGRAM OR PREFACE
IF(IMINUS.LT.0)INITAL=INITAL+IVALUE
IF(IMINUS.GT.0)INITAL=IVALUE
GO TO 140
C CURRENT STATEMENT NUMBER DUE TO BEGIN OR FORMAT COMMAND
138 IF(IMINUS.LT.0)INITAL=INITAL+IVALUE
IF(IMINUS.EQ.0)INITAL=INITAL+INTRVL
IF(IMINUS.GT.0)INITAL=IVALUE
GO TO 140
C CURRENT STATEMENT NUMBER DUE TO GENERATION OF STATEMENT
139 IF(IMINUS.LT.0)INITAL=INITAL-INTRVL+IVALUE
IF(IMINUS.GT.0)INITAL=IVALUE
140 IF(INITAL.LT.1)INITAL=1
IF(INITAL.GT.99999)INITAL=99999
IF(KNTARG.LE.1)JVALUE=0
IF(JVALUE.NE.0)INTRVL=JVALUE
MOVBAC=-1
IF(LITERL.NE.0)MOVBAC=1
C .TEXT MUST SET CARRIAGE CONTROL IF PAGING
IF(KOMAND.NE.63)GO TO 161
IF(IFPAGE.GT.0)GO TO 141
IFPAGE=0
IF(MRK0CC.EQ.0)GO TO 142
MRK0CC=0
MRK1CC=MRK2CC
LTR1CC=LTR2CC
LTR1QD=LTR2QD
GO TO 142
141 MRK0CC=1
MRK1CC=MRK3CC
LTR1CC=LTR3CC
LTR1QD=LTR3QD
142 GO TO 161
C
C .TOP
143 IDEFIN=0
144 IF(MAXTOP.EQ.0)GO TO 147
I=INITOP+MAXTOP
J=INITOP
145 IF(I.GT.MAXSTR)GO TO 146
MSKSTR(J)=MSKSTR(I)
LTRSTR(J)=LTRSTR(I)
I=I+1
J=J+1
GO TO 145
146 IF(INIPRE.GT.INITOP)INIPRE=INIPRE-MAXTOP
IF(INIBOT.GT.INITOP)INIBOT=INIBOT-MAXTOP
IF(ININEW.GT.INITOP)ININEW=ININEW-MAXTOP
MAXSTR=MAXSTR-MAXTOP
147 IF(LINTOP.EQ.0)GO TO 150
I=INILTO+LINTOP
J=INILTO
148 IF(I.GT.MAXLST)GO TO 149
LINSTR(J)=LINSTR(I)
I=I+1
J=J+1
GO TO 148
149 IF(INILPR.GT.INILTO)INILPR=INILPR-LINTOP
IF(INILBO.GT.INILTO)INILBO=INILBO-LINTOP
IF(INILNE.GT.INILTO)INILNE=INILNE-LINTOP
MAXLST=MAXLST-LINTOP
150 MRKTOP=1
INITOP=MAXSTR+1
MAXTOP=0
INILTO=MAXLST+1
LINTOP=0
IF(IDEFIN.NE.0)GO TO 161
IF(LOCATE.GE.LNGBGN)GO TO 161
IF(MAXLST.GE.LMTLST)GO TO 157
IF((MAXSTR+LNGBGN-LOCATE+1).GT.LMTSTR)GO TO 159
DO 151 I=LOCATE,LNGBGN
MAXSTR=MAXSTR+1
MSKSTR(MAXSTR)=MSKBGN(I)
LTRSTR(MAXSTR)=LTRBGN(I)
151 CONTINUE
152 LINTOP=1
MAXLST=MAXLST+1
MAXTOP=LNGBGN-LOCATE+1
LINSTR(MAXLST)=MAXTOP
GO TO 161
C
C .TRAILING
153 ITRAIL=1
GO TO 161
C
C .UPPER CASE, CORRESPONDS TO ^^ IN TEXT
154 KASALL=0
GO TO 161
C
C .USE
155 IF(LOCATE.GT.LNGBGN)GO TO 161
LTRQUO=LTRBGN(LOCATE)
IFQUOT=1
GO TO 161
C
C .USE H
156 LTRQUO=LTRBGN(LOWBFR-1)
IFQUOT=0
GO TO 161
C
C OVERFLOW DURING VARIOUS DEFINE COMMANDS
C 01234567890123456789012345678901234567890123456789
157 WRITE(ITTY,158)KNTLIN,(LTRBGN(I),I=LOCATE,LNGBGN)
158 FORMAT(6H (Line,1I5,
143H) Too many lines in active .DEFINE commands/
213H Discarding: ,300A1)
GO TO 161
159 WRITE(ITTY,160)KNTLIN,(LTRBGN(I),I=LOCATE,LNGBGN)
160 FORMAT(6H (Line,1I5,
148H) Too many characters in active .DEFINE commands/
213H Discarding: ,300A1)
GO TO 161
C
C COMMAND COMPLETED
161 RETURN
END
SUBROUTINE FMTASK(MASTER,ITTY,JTTY,IDISK,JDISK,KDISK)
C RENBR(/USER INTERACTION, DECSYSTEM 10 VERSION)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
C THIS ROUTINE IS CALLED BY FORMAT STATEMENT GENERATOR
C TO ASK USER FOR NAMES OF INPUT AND OUTPUT FILES, AND
C THEN TO OPEN THESE FILES.
C
C MASTER = 0 ON INPUT, FIRST TIME THAT THE USER IS
C BEING ASKED TO SPECIFY FILES. USER IS
C REQUIRED TO SPECIFY INPUT FILE. MASTER IS
C RETURNED UNCHANGED BY THIS PROGRAM.
C = 1 ON INPUT, SECOND OR SUBSEQUENT TIME THAT
C USER IS BEING ASKED TO SPECIFY FILES. IF NO
C INPUT FILE IS SPECIFIED, THEN MASTER IS
C RETURNED UNCHANGED AND EXIT IS ASSUMED BY
C MAIN PROGRAM. IF INPUT FILE IS SPECIFIED,
C THEN MASTER IS RETURNED SET TO -1.
C ITTY = UNIT NUMBER FOR MESSAGES TO BE SEEN BY USER
C JTTY = UNIT NUMBER FROM WHICH USER RESPONSE IS READ
C IDISK = UNIT NUMBER FROM WHICH INPUT SOURCE FILE IS
C TO BE READ
C JDISK = UNIT NUMBER TO WHICH OUTPUT FORTRAN FILE IS
C TO BE WRITTEN
C KDISK = UNIT NUMBER TO WHICH OUTPUT PROOF FILE IS TO
C BE WRITTEN
C
DOUBLE PRECISION NAMSRC,NAMPRF,NAMFMT,NAMNON
DATA NAMNON/10H /
C
C TELL USER THAT ARE DONE WITH PREVIOUS INPUT
IF(MASTER.EQ.0)WRITE(ITTY,1)
1 FORMAT(15H FORMAT (08/83)/
137H CONSTRUCTS FORTRAN FORMAT STATEMENTS/1X)
IF(MASTER.NE.0)WRITE(ITTY,2)
2 FORMAT(1X/24H TYPE EMPTY LINE TO EXIT/1X)
C
C OPEN INPUT FILE
3 WRITE(ITTY,4)
4 FORMAT(20H INPUT SOURCE FILE: ,$)
READ(JTTY,5)NAMSRC
5 FORMAT(1A10)
IF(MASTER.EQ.0)GO TO 6
IF(NAMSRC.EQ.NAMNON)GO TO 13
6 OPEN(UNIT=IDISK,FILE=NAMSRC,ACCESS='SEQIN',ERR=7)
GO TO 9
7 WRITE(ITTY,8)
8 FORMAT(17H CANNOT OPEN FILE)
GO TO 3
C
C OPEN OUTPUT FORMAT STATEMENT FILE
9 WRITE(ITTY,10)
10 FORMAT(22H OUTPUT FORTRAN FILE: ,$)
READ(JTTY,5)NAMFMT
OPEN(UNIT=JDISK,FILE=NAMFMT,ACCESS='SEQOUT',ERR=9)
C
C OPEN OUTPUT PROOF FILE
11 WRITE(ITTY,12)
12 FORMAT(20H OUTPUT PROOF FILE: ,$)
READ(JTTY,5)NAMPRF
OPEN(UNIT=KDISK,FILE=NAMPRF,ACCESS='SEQOUT',ERR=11)
C
C INFORM CALLING PROGRAM THAT FILES OPENED SUCCESSFULLY
MASTER=-MASTER
13 RETURN
END
SUBROUTINE FMTEND(JDISK,KDISK)
C RENBR(/CLOSE FILES, DECSYSTEM 10 VERSION)
C
C DONALD E. BARTH, HARVARD BUSINESS SCHOOL
C
C THIS ROUTINE IS CALLED BY FORMAT STATEMENT GENERATOR
C TO CLOSE THE OUTPUT FILES.
C
C JDISK = UNIT NUMBER TO WHICH OUTPUT FORTRAN FILE WAS
C WRITTEN
C KDISK = UNIT NUMBER TO WHICH OUTPUT PROOF FILE WAS
C WRITTEN
C
CLOSE(UNIT=JDISK)
CLOSE(UNIT=KDISK)
RETURN
END