COMPILATION LISTING OF SEGMENT tape_io
	Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985
	Compiled at: Honeywell Multics Op. - System M
	Compiled on: 03/17/86  1448.7 mst Mon
	    Options: optimize map

        1 
        2 
        3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
        4 	/*							*/
        5 	/* COMPILED OUTPUT OF SEGMENT  tape_io.rd                      	*/
        6 	/* Compiled by:  reduction_compiler, Version 2.5 of Oct 21, 1985      */
        7 	/* Compiled on:  03/17/86  1448.7 mst Mon                             */
        8 	/*							*/
        9 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
       10 
       11 /* ***********************************************************
       12*   *                                                         *
       13*   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
       14*   *                                                         *
       15*   *********************************************************** */
       16 /* tape_inout: Created 3/15/76 by J.B. Phillipps */
       17 /* Modified extensively 6/79 by Michael R. Jordan to fix many bugs */
       18 /* Modified extensively 4/82 by J. A. Bush for installation in MR10.0 */
       19 /* format: style4 */
       20 
       21 /*++
       22*BEGIN	/<no-token>
       23*		/Error (1)			/RETURN\
       24*
       25*newVol	/Volume :
       26*		/build_vcb
       27*		 LEX (2)				/Volume\
       28*3	/<any-token>
       29*		/Error (2)			/RETURN\
       30*4	/<no-token>
       31*		/				/RETURN\
       32*
       33*Volume	/<valid_volidp>
       34*		/[ii = 1]
       35*		 [vcb.volid(ii) = token_value]
       36*		 LEX (1)				/morevols\
       37*6	/<any-token>
       38*		/Error (6)
       39*		 NEXT_STMT			/global\
       40*7	/<no-token>
       41*		/				/notoken\
       42*nextvol	/<valid_volidp>
       43*		/[ii = ii + 1]
       44*		 [if ii <= hbound (vcb.volid, 1)
       45*		      then vcb.volid(ii) = token_value]
       46*		 [else if ii = hbound (vcb.volid, 1)+1
       47*		      then call Error (25)]
       48*		 LEX (1)				/morevols\
       49*9	/<any-token>
       50*		/Error (6)
       51*		 NEXT_STMT			/global\
       52*10	/<no-token>
       53*		/				/notoken\
       54*
       55*morevols  /"-comment"
       56*		/LEX (1)				/comment\
       57*12	/"-com"
       58*		/LEX (1)				/comment\
       59*13	/<any-token>
       60*		/				/ck_pun\
       61*14	/<no-token>
       62*		/				/notoken\
       63*
       64*comment	/<quoted-string>
       65*		/[vcb.comment (ii) = token_value]
       66*		 LEX (1)				/ck_pun\
       67*16	/<name>
       68*		/[vcb.comment (ii) = token_value]
       69*		 LEX (1)				/ck_pun\
       70*17	/<any-token>
       71*		/[vcb.comment (ii) = token_value]
       72*		 LEX (1)				/ck_pun\
       73*18	/<no-token>
       74*		/				/notoken\
       75*
       76*ck_pun	/;
       77*		/[vcb.nvols = min (ii, hbound (vcb.volid, 1))]
       78*		 LEX (1)				/global\
       79*20	/,
       80*		/LEX (1)				/nextvol\
       81*21	/<any-token>
       82*		/Error (5)
       83*		 NEXT_STMT			/global\
       84*22	/<no-token>
       85*		/				/notoken\
       86*
       87*global	/File :
       88*		/LEX (2)
       89*		 build_fcb (vcb.first_fcb_ptr, current_fcb_ptr)
       90*		 [fcb.file_token_ptr = Ptoken]
       91*		 [if current_default_fcb_ptr ^= null then
       92*		     fcb.default_fcb_ptr = current_default_fcb_ptr]
       93*						/File\
       94*24	/End ;
       95*		/end_vcb
       96*		 LEX (2)				/newVol\
       97*25	/Volume :
       98*		/Error (4)
       99*		 end_vcb				/newVol\
      100*26	/Tape :
      101*		/[if vcb.tape_type ^= 0
      102*		      then call Error (20)]
      103*		 LEX (2)				/Tape\
      104*27	/Density :
      105*		/[if vcb.density ^= 0
      106*		      then call Error (14)]
      107*		 LEX (2)				/Density\
      108*
      109*28	/<any-token>
      110*		/PUSH (global)
      111*		 [if ^build_default_fcb then do;
      112*		    call build_fcb (vcb.first_default_fcb_ptr, current_default_fcb_ptr);
      113*		    build_default_fcb = "1"b;
      114*		  end]
      115*						/gloop\
      116*29	/<no-token>
      117*		/				/notoken\
      118*
      119*gloop	/Storage :
      120*		/LEX (2)				/Storage\
      121*31        /Expiration :
      122*		/LEX (2)				/Expires\
      123*32	/Mode :
      124*		/LEX (2)				/Mode\
      125*33	/Format :
      126*		/LEX (2)				/Format\
      127*34	/Block :
      128*		/LEX (2)				/Block\
      129*35	/Record :
      130*		/LEX (2)				/Record\
      131*
      132*36	/mode :
      133*		/Error (50)
      134*		 NEXT_STMT			/STACK_POP\
      135*37	/storage :
      136*		/Error (50)
      137*		 NEXT_STMT			/STACK_POP\
      138*38	/expiration :
      139*		/Error (50)
      140*		 NEXT_STMT			/STACK_POP\
      141*39	/number :
      142*		/Error (50)
      143*		 NEXT_STMT			/STACK_POP\
      144*40	/replace :
      145*		/Error (50)
      146*		 NEXT_STMT			/STACK_POP\
      147*41    	/modify ;
      148*		/Error (50)
      149*		 NEXT_STMT			/STACK_POP\
      150*42    	/generate ;
      151*		/Error (50)
      152*		 NEXT_STMT			/STACK_POP\
      153*43    	/tape_extend ;
      154*		/Error (50)
      155*		 NEXT_STMT			/STACK_POP\
      156*44    	/storage_extend ;
      157*		/Error (50)
      158*		 NEXT_STMT			/STACK_POP\
      159*45	/format :
      160*		/Error (50)
      161*		 NEXT_STMT			/STACK_POP\
      162*46	/block :
      163*		/Error (50)
      164*		 NEXT_STMT			/STACK_POP\
      165*47	/record :
      166*		/Error (50)
      167*		 NEXT_STMT			/STACK_POP\
      168*48	/<any-token>
      169*		/Error (5)
      170*		 NEXT_STMT			/STACK_POP\
      171*
      172*Tape	/ANSI ;
      173*		/[if vcb.tape_type ^= 0
      174*		      then call Error (20)]
      175*		 [else vcb.tape_type = 1]
      176*		 LEX (2)				/global\
      177*50        /ansi ;
      178*		/[if vcb.tape_type ^= 0
      179*		      then call Error (20)]
      180*		 [else vcb.tape_type = 1]
      181*		 LEX (2)				/global\
      182*51	/IBMSL ;
      183*		/[if vcb.tape_type ^= 0
      184*		      then call Error (20)]
      185*		 [else vcb.tape_type = 2]
      186*		 LEX (2)				/global\
      187*52        /ibmsl ;
      188*		/[if vcb.tape_type ^= 0
      189*		      then call Error (20)]
      190*		 [else vcb.tape_type = 2]
      191*		 LEX (2)				/global\
      192*53	/IBMNL ;
      193*		/[if vcb.tape_type ^= 0
      194*		      then call Error (20)]
      195*		 [else vcb.tape_type = 3]
      196*		 LEX (2)				/global\
      197*54        /ibmnl ;
      198*		/[if vcb.tape_type ^= 0
      199*		      then call Error (20)]
      200*		 [else vcb.tape_type = 3]
      201*		 LEX (2)				/global\
      202*55	/IBMDOS ;
      203*		/[if vcb.tape_type ^= 0
      204*		      then call Error (20)]
      205*		 [else vcb.tape_type = 4]
      206*		 LEX (2)				/global\
      207*56        /ibmdos ;
      208*		/[if vcb.tape_type ^= 0
      209*		      then call Error (20)]
      210*		 [else vcb.tape_type = 4]
      211*		 LEX (2)				/global\
      212*57	/<any-token> ;
      213*		/Error (21)
      214*		 LEX (2)				/global\
      215*58	/<any-token>
      216*		/Error (5)
      217*		 NEXT_STMT			/global\
      218*59	/<no-token>
      219*		/				/notoken\
      220*
      221*Density	/6250 ;
      222*		/[if vcb.density ^= 0
      223*		      then call Error (14)]
      224*		 [else vcb.density = 4]
      225*		 LEX (2)				/global\
      226*61	/4 ;
      227*		/[if vcb.density ^= 0
      228*		      then call Error (14)]
      229*		 [else vcb.density = 4]
      230*		 LEX (2)				/global\
      231*62	/1600 ;
      232*		/[if vcb.density ^= 0
      233*		      then call Error (14)]
      234*		 [else vcb.density = 3]
      235*		 LEX (2)				/global\
      236*63	/3 ;
      237*		/[if vcb.density ^= 0
      238*		      then call Error (14)]
      239*		 [else vcb.density = 3]
      240*		 LEX (2)				/global\
      241*64	/800 ;
      242*		/[if vcb.density ^= 0
      243*		      then call Error (14)]
      244*		 [else vcb.density = 2]
      245*		 LEX (2)				/global\
      246*65	/2 ;
      247*		/[if vcb.density ^= 0
      248*		      then call Error (14)]
      249*		 [else vcb.density = 2]
      250*		 LEX (2)				/global\
      251*66	/<decimal-integer> ;
      252*		/Error (7)
      253*		 LEX (2)				/global\
      254*67	/<any-token>
      255*		/Error (5)
      256*		 NEXT_STMT			/global\
      257*68	/<no-token>
      258*		/				/notoken\
      259*
      260*Storage	/unstructured ;
      261*		/[if fcb.segment.format ^= 0
      262*		      then call Error (33)]
      263*		 [else fcb.segment.format = 1]
      264*		 LEX (2)				/STACK_POP\
      265*
      266*70	/sequential ;
      267*		/[if fcb.segment.format ^= 0
      268*		      then call Error (33)]
      269*		 [else fcb.segment.format = 2]
      270*		 LEX (2)				/STACK_POP\
      271*71	/<any-token> ;
      272*		/Error (12)
      273*		 LEX (2)				/STACK_POP\
      274*72	/<any-token>
      275*		/Error (5)
      276*		 NEXT_STMT			/STACK_POP\
      277*73	/<no-token>
      278*		/				/notoken\
      279*
      280*Expires   /<valid_datep> ;
      281*		/[if fcb.tape.expiration ^= "" ""
      282*		      then call Error (34)]
      283*		 [else fcb.tape.expiration = token_value]
      284*		 LEX (2)				/STACK_POP\
      285*75        /<any-token> ;
      286*		/Error (22)
      287*		 LEX (2)				/STACK_POP\
      288*76	/<any-token>
      289*		/Error (5)
      290*		 NEXT_STMT			/STACK_POP\
      291*77	/<no-token>
      292*		/				/notoken\
      293*
      294*Mode	/ascii ;
      295*		/[if fcb.tape.cmode ^= 0
      296*		      then call Error (44)]
      297*		 [else fcb.tape.cmode = 1]
      298*		 LEX (2)				/STACK_POP\
      299*79	/ASCII ;
      300*		/[if fcb.tape.cmode ^= 0
      301*		      then call Error (44)]
      302*		 [else fcb.tape.cmode = 1]
      303*		 LEX (2)				/STACK_POP\
      304*80	/ebcdic ;
      305*		/[if fcb.tape.cmode ^= 0
      306*		      then call Error (44)]
      307*		 [else fcb.tape.cmode = 2]
      308*		 LEX (2)				/STACK_POP\
      309*81	/EBCDIC ;
      310*		/[if fcb.tape.cmode ^= 0
      311*		      then call Error (44)]
      312*		 [else fcb.tape.cmode = 2]
      313*		 LEX (2)				/STACK_POP\
      314*82	/binary ;
      315*		/[if fcb.tape.cmode ^= 0
      316*		      then call Error (44)]
      317*		 [else fcb.tape.cmode = 3]
      318*		 LEX (2)				/STACK_POP\
      319*83	/BINARY ;
      320*		/[if fcb.tape.cmode ^= 0
      321*		      then call Error (44)]
      322*		 [else fcb.tape.cmode = 3]
      323*		 LEX (2)				/STACK_POP\
      324*84	/<any-token> ;
      325*		/Error (8)
      326*		 LEX (2)				/STACK_POP\
      327*85	/<any-token>
      328*		/Error (5)
      329*		 NEXT_STMT			/STACK_POP\
      330*86	/<no-token>
      331*		/				/notoken\
      332*
      333*Format	/U ;
      334*		/[if fcb.tape.format ^= 0
      335*		      then call Error (45)]
      336*		 [else fcb.tape.format = 1]
      337*		 LEX (2)				/STACK_POP\
      338*88	/u ;
      339*		/[if fcb.tape.format ^= 0
      340*		      then call Error (45)]
      341*		 [else fcb.tape.format = 1]
      342*		 LEX (2)				/STACK_POP\
      343*89	/F ;
      344*		/[if fcb.tape.format ^= 0
      345*		      then call Error (45)]
      346*		 [else fcb.tape.format = 2]
      347*		 LEX (2)				/STACK_POP\
      348*90	/f ;
      349*		/[if fcb.tape.format ^= 0
      350*		      then call Error (45)]
      351*		 [else fcb.tape.format = 2]
      352*		 LEX (2)				/STACK_POP\
      353*91	/FB ;
      354*		/[if fcb.tape.format ^= 0
      355*		      then call Error (45)]
      356*		 [else fcb.tape.format = 5]
      357*		 LEX (2)				/STACK_POP\
      358*92	/fb ;
      359*		/[if fcb.tape.format ^= 0
      360*		      then call Error (45)]
      361*		 [else fcb.tape.format = 5]
      362*		 LEX (2)				/STACK_POP\
      363*93	/D ;
      364*		/[if fcb.tape.format ^= 0
      365*		      then call Error (45)]
      366*		 [else fcb.tape.format = 3]
      367*		 LEX (2)				/STACK_POP\
      368*94	/d ;
      369*		/[if fcb.tape.format ^= 0
      370*		      then call Error (45)]
      371*		 [else fcb.tape.format = 3]
      372*		 LEX (2)				/STACK_POP\
      373*95	/DB ;
      374*		/[if fcb.tape.format ^= 0
      375*		      then call Error (45)]
      376*		 [else fcb.tape.format = 6]
      377*		 LEX (2)				/STACK_POP\
      378*96	/db ;
      379*		/[if fcb.tape.format ^= 0
      380*		      then call Error (45)]
      381*		 [else fcb.tape.format = 6]
      382*		 LEX (2)				/STACK_POP\
      383*97	/S ;
      384*		/[if fcb.tape.format ^= 0
      385*		      then call Error (45)]
      386*		 [else fcb.tape.format = 8]
      387*		 LEX (2)				/STACK_POP\
      388*98	/s ;
      389*		/[if fcb.tape.format ^= 0
      390*		      then call Error (45)]
      391*		 [else fcb.tape.format = 8]
      392*		 LEX (2)				/STACK_POP\
      393*99        /SB ;
      394*		/[if fcb.tape.format ^= 0
      395*		      then call Error (45)]
      396*		 [else fcb.tape.format = 9]
      397*		 LEX (2)				/STACK_POP\
      398*100	/sb ;
      399*		/[if fcb.tape.format ^= 0
      400*		      then call Error (45)]
      401*		 [else fcb.tape.format = 9]
      402*		 LEX (2)				/STACK_POP\
      403*101       /V ;
      404*		/[if fcb.tape.format ^= 0
      405*		      then call Error (45)]
      406*		 [else fcb.tape.format = 4]
      407*		 LEX (2)				/STACK_POP\
      408*102	/v ;
      409*		/[if fcb.tape.format ^= 0
      410*		      then call Error (45)]
      411*		 [else fcb.tape.format = 4]
      412*		 LEX (2)				/STACK_POP\
      413*103	/VB ;
      414*		/[if fcb.tape.format ^= 0
      415*		      then call Error (45)]
      416*		 [else fcb.tape.format = 7]
      417*		 LEX (2)				/STACK_POP\
      418*104	/vb ;
      419*		/[if fcb.tape.format ^= 0
      420*		      then call Error (45)]
      421*		 [else fcb.tape.format = 7]
      422*		 LEX (2)				/STACK_POP\
      423*105	/VS ;
      424*		/[if fcb.tape.format ^= 0
      425*		      then call Error (45)]
      426*		 [else fcb.tape.format = 10]
      427*		 LEX (2)				/STACK_POP\
      428*106	/vs
      429*		;			/[if fcb.tape.format ^= 0
      430*		      then call Error (45)]
      431*		 [else fcb.tape.format = 10]
      432*		 LEX (2)				/STACK_POP\
      433*107	/VBS ;
      434*		/[if fcb.tape.format ^= 0
      435*		      then call Error (45)]
      436*		 [else fcb.tape.format = 11]
      437*		 LEX (2)				/STACK_POP\
      438*108	/vbs ;
      439*		/[if fcb.tape.format ^= 0
      440*		      then call Error (45)]
      441*		 [else fcb.tape.format = 11]
      442*		 LEX (2)				/STACK_POP\
      443*109	/<any-token> ;
      444*		/Error (9)
      445*		 LEX (2)				/STACK_POP\
      446*110	/<any-token>
      447*		/Error (5)
      448*		 NEXT_STMT			/STACK_POP\
      449*111	/<no-token>
      450*		/				/notoken\
      451*
      452*Block	/<valid_block_sizep> ;
      453*		/[if fcb.tape.blklen ^= 0
      454*		      then call Error (46)]
      455*		 [else fcb.tape.blklen = token.Nvalue]
      456*		 LEX (2)				/STACK_POP\
      457*113	/<any-token> ;
      458*		/Error (10)
      459*		 LEX (2)				/STACK_POP\
      460*114	/<any-token>
      461*		/Error (5)
      462*		 NEXT_STMT			/STACK_POP\
      463*115	/<no-token>
      464*		/				/notoken\
      465*
      466*Record	/<valid_record_sizep> ;
      467*		/[if fcb.tape.reclen ^= 0
      468*		      then call Error (47)]
      469*		 [else fcb.tape.reclen = token.Nvalue]
      470*		 LEX (2)				/STACK_POP\
      471*117	/<any-token> ;
      472*		/Error (11)
      473*		 LEX (2)				/STACK_POP\
      474*118	/<any-token>
      475*		/Error (5)
      476*		 NEXT_STMT			/STACK_POP\
      477*119	/<no-token>
      478*		/				/notoken\
      479*
      480*File      /<valid_file_namep> ;
      481*		/[fcb.tape.file_id = token_value]
      482*		 [build_default_fcb = "0"b]
      483*		 LEX (2)				/local\
      484*121	/<any-token> ;
      485*		/Error (37)
      486*		 LEX (2)				/local\
      487*122	/<any-token>
      488*		/Error (5)
      489*		 NEXT_STMT			/local\
      490*123	/<no-token>
      491*		/				/notoken\
      492*
      493*local	/<any-token>
      494*		/PUSH (local)			/lloop\
      495*125	/<no-token>
      496*		/				/notoken\
      497*
      498*lloop	/path :
      499*		/LEX (2)				/path\
      500*127	/mode :
      501*		/LEX (2)				/Mode\
      502*128	/storage :
      503*		/LEX (2)				/Storage\
      504*129	/expiration :
      505*		/LEX (2)				/Expires\
      506*130	/number :
      507*		/LEX (2)				/number\
      508*131	/replace :
      509*		/LEX (2)				/replace\
      510*132	/format :
      511*		/LEX (2)				/Format\
      512*133	/block :
      513*		/LEX (2)				/Block\
      514*134	/record :
      515*		/LEX (2)				/Record\
      516*135   	/modify ;
      517*		/[if fcb.tape.output_mode ^= 0
      518*		      then call Error (38)]
      519*		 [else fcb.tape.output_mode = 2]
      520*		 LEX (2)				/STACK_POP\
      521*136   	/generate ;
      522*		/[if fcb.tape.output_mode ^= 0
      523*		      then call Error (38)]
      524*		 [else fcb.tape.output_mode = 3]
      525*		 LEX (2)				/STACK_POP\
      526*137   	/tape_extend ;
      527*		/[if fcb.tape.output_mode ^= 0
      528*		      then call Error (38)]
      529*		 [else fcb.tape.output_mode = 1]
      530*		 LEX (2)				/STACK_POP\
      531*138   	/storage_extend ;
      532*		/[if fcb.segment.extend ^= 0
      533*		      then call Error (27)]
      534*		 [fcb.segment.extend = 2]
      535*		 LEX (2)				/STACK_POP\
      536*139	/File :
      537*		/POP
      538*						/global\
      539*140	/End
      540*		/POP				/global\
      541*141	/Storage :
      542*		/POP
      543*		 				/global\
      544*142	/Expiration :
      545*		/POP
      546*		 				/global\
      547*143	/Mode :
      548*		/POP
      549*		 				/global\
      550*144       /Format :
      551*		/POP
      552*		 				/global\
      553*145	/Block :
      554*		/POP
      555*		 				/global\
      556*146       /Record :
      557*		/POP
      558*		 				/global\
      559*
      560*147	/<any-token>
      561*		/Error (5)
      562*		 NEXT_STMT			/STACK_POP\
      563*148	/<no-token>
      564*		/				/notoken\
      565*
      566*path	/<valid_pathnamep> ;
      567*		/[if fcb.segment.ename ^= "" ""
      568*		      then call Error (23)]
      569*		 [fcb.segment.dirname = dirname]
      570*		 [fcb.segment.ename = ename]
      571*		 LEX (2)				/STACK_POP\
      572*150	/<any-token> ;
      573*		/Error (13)
      574*		 LEX (2)				/STACK_POP\
      575*151	/<any-token>
      576*		/Error (5)
      577*		 NEXT_STMT			/STACK_POP\
      578*152	/<no-token>
      579*		/				/notoken\
      580*
      581*number	/<valid_file_numberp> ;
      582*		/[if fcb.tape.sequence ^= 0
      583*		      then call Error (51)]
      584*		 [else fcb.tape.sequence = token.Nvalue]
      585*		 LEX (2)				/STACK_POP\
      586*154	/<any-token> ;
      587*		/Error (48)
      588*		 LEX (2)				/STACK_POP\
      589*155	/<any-token>
      590*		/Error (5)
      591*		 NEXT_STMT			/STACK_POP\
      592*156	/<no-token>
      593*		/				/notoken\
      594*
      595*replace	/<valid_file_namep> ;
      596*		/[if fcb.tape.output_mode ^= 0
      597*		      then call Error (38)]
      598*		 [else fcb.tape.output_mode = 4]
      599*		 [fcb.tape.replace_id = token_value]
      600*		 LEX (2)				/STACK_POP\
      601*158	/<any-token> ;
      602*		/Error (37)
      603*		 LEX (2)				/STACK_POP\
      604*159	/<any-token>
      605*		/Error (5)
      606*		 NEXT_STMT			/STACK_POP\
      607*
      608*notoken	/<no-token>
      609*		/Error (3)			/RETURN\
      610*++*/
      611 
      612 tape_io: procedure;
      613 
      614 /* CONSTANTS */
      615 
      616 dcl  ANSI fixed bin internal static options (constant) init (1);
      617 dcl  IBMNL fixed bin internal static options (constant) init (3);
      618 dcl  DEFAULT_DENSITY (4) fixed bin internal static options (constant) init (2, 3, 3, 3);
      619 dcl  SERROR_CONTROL bit (2) internal static options (constant) init ("10"b);
      620 dcl  USAGE_MESSAGE char (115) internal static options (constant) init
      621 	("^a^/Usage:  ^a tcl_path {-control_args}^/where control args are: -check, -ck, -force, -fc, -severityN, -svN, -ring");
      622 dcl  sys_info$max_seg_size fixed bin (35) external static;	/* maximum segment size in words */
      623 
      624 dcl  1 EMPTY_FCB aligned static internal options (constant),
      625        2 file_token_ptr ptr init (null),		/* none */
      626        2 next_fcb_ptr ptr init (null),			/* none */
      627        2 prev_fcb_ptr ptr init (null),			/* none */
      628        2 default_fcb_ptr ptr init (null),		/* none */
      629        2 segment,
      630          3 dirname char (168) init ((168)" "),
      631          3 ename char (32) init ((32)" "),
      632          3 format fixed bin init (0),			/* not specified */
      633          3 extend fixed bin init (0),			/* not specified */
      634          3 truncate_lines fixed bin init (0),		/* not specified */
      635        2 tape,
      636          3 cmode fixed bin init (0),			/* not specified */
      637          3 format fixed bin init (0),			/* not specified */
      638          3 output_mode fixed bin init (0),		/* not specified */
      639          3 file_id char (17) init (""),			/* not specified */
      640          3 replace_id char (17) init (""),		/* not specified */
      641          3 expiration char (16) init (""),		/* not specified */
      642          3 sequence fixed bin init (0),			/* not specified */
      643          3 blklen fixed bin init (0),			/* not specified */
      644          3 reclen fixed bin (21) init (0);		/* not specified */
      645 
      646 dcl  1 EMPTY_VCB aligned static internal options (constant),
      647        2 volume_token_ptr ptr init (null),		/* none */
      648        2 next_vcb_ptr ptr init (null),			/* none */
      649        2 first_fcb_ptr ptr init (null),			/* none */
      650        2 first_default_fcb_ptr ptr init (null),		/* none */
      651        2 nvols fixed bin init (0),			/* no volumes */
      652        2 volid (64) char (32) init ((64) (32)" "),
      653        2 comment (64) char (64) init ((64) (64)" "),
      654        2 tape_type fixed bin init (0),			/* not specified */
      655        2 density fixed bin init (0);			/* not specified */
      656 
      657 
      658 /* STATIC STORAGE */
      659 
      660 dcl  breaks char (128) varying aligned internal static;	/* break characters for lex_string_ */
      661 dcl  ignored_breaks char (128) varying aligned internal static; /* ignored breaks for lex_string_ */
      662 dcl  init_req bit (1) internal static initial ("1"b);	/* initialization switch: 0-not required; 1-required */
      663 dcl  lex_control_chars char (128) varying aligned internal static; /* control characters for lex_string_ */
      664 dcl  lex_delims char (128) varying aligned internal static; /* delimiters for lex_string_ */
      665 
      666 
      667 /* AUTOMATIC STORAGE */
      668 
      669 dcl  1 tid like tape_io_data aligned;
      670 dcl  1 ai like area_info aligned;
      671 
      672 dcl  aL fixed bin;
      673 dcl  aP ptr;
      674 dcl  arg_num fixed bin;
      675 dcl  clk_val fixed bin (71);
      676 dcl  bc fixed bin (24);
      677 dcl  code fixed bin (35);
      678 dcl  current_default_fcb_ptr ptr init (null);
      679 dcl  current_fcb_ptr ptr init (null);
      680 dcl  dfcbp ptr;
      681 dcl  dirname char (168);
      682 dcl  ename char (32);
      683 dcl  error_count fixed bin;
      684 dcl  ii fixed bin;
      685 dcl  j fixed bin;
      686 dcl  max_severity_num fixed bin;			/* max severity printed by lex_error_ */
      687 dcl  name char (8);					/* command name */
      688 dcl  nargs fixed bin;
      689 dcl  serror_printed (dimension (error_control_table, 1)) bit (1) unaligned; /* is "1"b if error msg printed prev. */
      690 dcl  temp_ptr ptr;
      691 dcl  writing bit (1);				/* ON => tape_out */
      692 dcl  build_default_fcb bit (1) aligned init ("0"b);
      693 
      694 /* BASED STORAGE */
      695 
      696 dcl  arg char (aL) based (aP);
      697 dcl  my_area area based (tape_io_data.temp (1));
      698 
      699 
      700 /* ERROR CODES */
      701 
      702 dcl  error_table_$active_function fixed bin (35) ext static;
      703 dcl  error_table_$badopt fixed bin (35) ext static;
      704 dcl  error_table_$noarg fixed bin (35) ext static;
      705 dcl  error_table_$not_act_fnc fixed bin (35) ext static;
      706 dcl  error_table_$translation_failed fixed bin (35) ext static;
      707 
      708 
      709 /* BUILTIN FUNCTIONS */
      710 
      711 dcl  (addr, collate, dimension, divide, hbound, min, mod, null, substr, unspec) builtin;
      712 
      713 /* CONDITIONS */
      714 
      715 dcl  cleanup condition;
      716 
      717 
      718 /* EXTERNAL PROCEDURES */
      719 
      720 dcl  active_fnc_err_ entry options (variable);
      721 dcl  com_err_ ext entry options (variable);
      722 dcl  convert_date_to_binary_ ext entry (char (*), fixed bin (71), fixed bin (35));
      723 dcl  cu_$af_arg_count ext entry (fixed bin, fixed bin (35));
      724 dcl  cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35));
      725 dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
      726 dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
      727 dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
      728 dcl  translator_temp_$get_next_segment entry (ptr, ptr, fixed bin (35));
      729 dcl  translator_temp_$get_segment entry (char (*) aligned, ptr, fixed bin (35));
      730 dcl  translator_temp_$release_segment entry (ptr, fixed bin (35));
      731 dcl  define_area_ entry (ptr, fixed bin (35));
      732 dcl  release_area_ entry (ptr);
      733 dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
      734 dcl  hcs_$terminate_noname ext entry (ptr, fixed bin (35));
      735 dcl  ioa_ ext entry options (variable);
      736 dcl  lex_error_ ext entry options (variable);
      737 dcl  lex_string_$init_lex_delims ext entry (char (*), char (*), char (*), char (*),
      738 	char (*), bit (*), char (*) varying aligned, char (*) varying aligned, char (*) varying aligned,
      739 	char (*) varying aligned);
      740 dcl  lex_string_$lex ext entry (ptr, fixed bin (21), fixed bin (21), ptr, bit (*), char (*), char (*), char (*),
      741 	char (*), char (*), char (*) varying aligned, char (*) varying aligned, char (*) varying aligned,
      742 	char (*) varying aligned, ptr, ptr, fixed bin (35));
      743 dcl  tape_io_interpret_ entry (ptr);
      744 
      745 tape_in: tin: entry;
      746 
      747 	name = "tape_in";				/* set command name */
      748 	writing = "0"b;				/* not writing tape */
      749 	go to common_code;				/* begin processing */
      750 
      751 tape_out: tout: entry;
      752 
      753 	name = "tape_out";				/* set command name */
      754 	writing = "1"b;				/* writing tape */
      755 
      756 common_code:
      757 
      758 	tape_io_data_ptr = addr (tid);
      759 	tape_io_data.temp (*) = null;
      760 	tape_io_data.first_vcb_ptr = null;
      761 	tape_io_data.source.dirname = "";
      762 	tape_io_data.source.ename = "";
      763 	tape_io_data.source.ptr = null;
      764 	tape_io_data.control.ck = "0"b;
      765 	tape_io_data.control.force = "0"b;
      766 	tape_io_data.control.ring = "0"b;
      767 	tape_io_data.control.writing_tape = writing;
      768 	tape_io_data.control.max_severity = 0;
      769 
      770 	call cu_$af_arg_count (nargs, code);
      771 	if code = error_table_$not_act_fnc then
      772 	     code = 0;
      773 	else if code = 0 then do;
      774 	     call active_fnc_err_ (error_table_$active_function, name);
      775 	     return;
      776 	end;
      777 	else do;
      778 	     call com_err_ (code, name);
      779 	     return;
      780 	end;
      781 	if nargs < 1 then do;
      782 	     call com_err_ (error_table_$noarg, name, USAGE_MESSAGE,
      783 		"Control file pathname is missing.", name);
      784 	     return;
      785 	end;
      786 	call cu_$arg_ptr (1, aP, aL, (0));
      787 	call expand_pathname_$add_suffix (arg, "tcl",
      788 	     tape_io_data.source.dirname, tape_io_data.source.ename, code);
      789 	if code ^= 0 then do;
      790 	     call com_err_ (code, name, "^a", arg);
      791 	     return;
      792 	end;
      793 
      794 	on cleanup call Cleaner;
      795 
      796 	call hcs_$initiate_count (tape_io_data.source.dirname,
      797 	     tape_io_data.source.ename, "", bc, 0, tape_io_data.source.ptr,
      798 	     code);
      799 	if tape_io_data.source.ptr = null then do;
      800 	     call com_err_ (code, name, "^a^[>^]^a", tape_io_data.source.dirname,
      801 		(tape_io_data.source.dirname ^= ">"), tape_io_data.source.ename);
      802 	     return;
      803 	end;
      804 	unspec (ai) = "0"b;				/* clear out area info */
      805 	ai.version = area_info_version_1;		/* set up area info block */
      806 	ai.control.extend = "1"b;
      807 	ai.control.zero_on_alloc = "1"b;
      808 	ai.owner = name;
      809 	ai.size = sys_info$max_seg_size;
      810 	ai.version_of_area = area_info_version_1;
      811 	ai.areap = null;
      812 	call define_area_ (addr (ai), code);		/* get an area */
      813 	if code ^= 0 then do;
      814 	     call com_err_ (code, name, "Cannot define an area");
      815 	     go to EXIT;
      816 	end;
      817 	tape_io_data.temp (1) = ai.areap;		/* copy area ptr */
      818 	call translator_temp_$get_segment ((name), tape_io_data.temp (2), code);
      819 	if code = 0 then
      820 	     call translator_temp_$get_next_segment (tape_io_data.temp (2), tape_io_data.temp (3), code);
      821 	if tape_io_data.temp (2) = null | tape_io_data.temp (3) = null then do;
      822 	     call com_err_ (code, name, "Cannot allocate necessary temporary segments.");
      823 	     go to EXIT;
      824 	end;
      825 
      826 	do arg_num = 2 repeat arg_num + 1 while (arg_num <= nargs);
      827 	     call cu_$arg_ptr (arg_num, aP, aL, (0));
      828 	     if arg = "-check" | arg = "-ck" then
      829 		tape_io_data.control.ck = "1"b;
      830 	     else if arg = "-severity" | arg = "-sv" then do;
      831 		arg_num = arg_num + 1;
      832 		if arg_num > nargs then do;
      833 		     call com_err_ (error_table_$noarg, name,
      834 			"Severity level missing following ^a.", arg);
      835 		     goto EXIT;
      836 		end;
      837 		call cu_$arg_ptr (arg_num, aP, aL, (0));
      838 		tape_io_data.control.max_severity = cv_dec_check_ (arg, code);
      839 		if code ^= 0 then
      840 		     go to bad_arg;
      841 	     end;
      842 	     else if arg = "-force" | arg = "-fc" then
      843 		tape_io_data.control.force = "1"b;	/* force all file expiration dates */
      844 	     else if arg = "-ring" then
      845 		tape_io_data.control.ring = "1"b;
      846 	     else do;
      847 bad_arg:		call com_err_ (error_table_$badopt, name, "^a", arg);
      848 		goto EXIT;
      849 	     end;
      850 	end;
      851 	error_count = 0;				/* initialize syntatical error counter */
      852 	if init_req then do;			/* initialize static values if necessary */
      853 	     breaks = substr (collate, 1, 33);		/* control characters */
      854 	     breaks = breaks || ":;, ";		/* my definitions */
      855 	     breaks = breaks || substr (collate, 128, 1); /* ....and the null (pad) character */
      856 	     ignored_breaks = substr (collate, 1, 8);	/* control characters.... */
      857 	     ignored_breaks = ignored_breaks || substr (collate, 10, 24); /* ....excluding backspace */
      858 	     ignored_breaks = ignored_breaks || substr (collate, 128, 1); /* and null character */
      859 	     init_req = "0"b;			/* initialization no longer necessary */
      860 	end;
      861 
      862 	call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "1"b, /* initialize the lexing routine */
      863 	     breaks, ignored_breaks, lex_delims, lex_control_chars);
      864 
      865 /* call to parse character string input into tokens  */
      866 /* chained list of token descriptors generated in temp seg pointed to by temp (2)  */
      867 
      868 	call lex_string_$lex (tape_io_data.source.ptr, divide (bc, 9, 21, 0),
      869 	     0, tape_io_data.temp (2), "1"b, """", """", "/*", "*/", ";",
      870 	     breaks, ignored_breaks, lex_delims, lex_control_chars, Pstmt,
      871 	     Pthis_token, code);
      872 	if code ^= 0 then
      873 	     call com_err_ (code, name);
      874 	if Pthis_token = null then do;
      875 	     call com_err_ (error_table_$translation_failed, name, "The source file is uninterpretable.");
      876 	     goto EXIT;
      877 	end;
      878 
      879 /* invoke subroutine which translates tokens */
      880 
      881 	max_severity_num = 0;			/* initialize */
      882 
      883 	call SEMANTIC_ANALYSIS ();
      884 	if max_severity_num > 1 then do;
      885 	     call com_err_ (error_table_$translation_failed, name);
      886 	     goto EXIT;
      887 	end;
      888 
      889 /* if user only wants syntax checking then that's all here  */
      890 
      891 	if ^tape_io_data.control.ck then
      892 	     call tape_io_interpret_ (tape_io_data_ptr);	/* go do the requested I/O */
      893 	else call ioa_ ("^/^a: Translation finished; Number of errors encountered was ^d", name, error_count);
      894 EXIT:
      895 	call Cleaner;
      896 	return;
      897 
      898 Cleaner: procedure;
      899 
      900 	if tape_io_data.source.ptr ^= null then
      901 	     call hcs_$terminate_noname (tape_io_data.source.ptr, 0);
      902 	if tape_io_data.temp (1) ^= null then
      903 	     call release_area_ (tape_io_data.temp (1));
      904 	if tape_io_data.temp (2) ^= null then
      905 	     call translator_temp_$release_segment (tape_io_data.temp (2), code);
      906 	if tape_io_data.temp (3) ^= null then
      907 	     call translator_temp_$release_segment (tape_io_data.temp (3), code);
      908 
      909      end Cleaner;
      910 
      911 
      912 Error: proc (en);					/* subroutine to check severify before printing errors */
      913 
      914 dcl  en fixed bin;
      915 dcl  pstmt ptr;
      916 
      917 	if Ptoken = null () then pstmt = null ();
      918 	else pstmt = token.Pstmt;
      919 	if error_control_table (en).severity >= tape_io_data.control.max_severity then
      920 	     call lex_error_ (en, serror_printed (en),
      921 		error_control_table (en).severity, max_severity_num, pstmt, null (),
      922 		SERROR_CONTROL, error_control_table (en).message, error_control_table (en).brief_message);
      923 
      924 	error_count = error_count + 1;
      925 
      926 
      927      end Error;
      928 
      929 valid_block_sizep: procedure returns (bit (1) aligned);	/* defines <valid_block_sizep> token */
      930 
      931 	token.Nvalue = cv_dec_check_ (token_value, code);
      932 	if code ^= 0 then return ("0"b);
      933 	if token.Nvalue < 18 then return ("0"b);	/* not valid if too small */
      934 	if token.Nvalue > 99996 then return ("0"b);	/* not valid if too large */
      935 	return ("1"b);				/* valid */
      936 
      937      end valid_block_sizep;
      938 
      939 valid_file_namep: procedure returns (bit (1) aligned);	/* defines valid_file_namep */
      940 
      941 	if token.Lvalue < 1 then return ("0"b);
      942 	if token.Lvalue > 17 then return ("0"b);
      943 	return ("1"b);
      944      end valid_file_namep;
      945 
      946 valid_file_numberp: procedure returns (bit (1) aligned);	/* defines <valid_file_numberp> token */
      947 
      948 	if token_value = "*" then do;			/* file number not specified */
      949 	     token.Nvalue = -1;
      950 	     return ("1"b);
      951 	end;
      952 	token.Nvalue = cv_dec_check_ (token_value, code);
      953 	if code ^= 0 then return ("0"b);
      954 	if token.Nvalue > 9999 then return ("0"b);
      955 	if token.Nvalue <= 0 then return ("0"b);
      956 	return ("1"b);				/* valid */
      957      end valid_file_numberp;
      958 
      959 valid_pathnamep: procedure returns (bit (1) aligned);	/* defines <valid_pathnamep> token */
      960 
      961 	call expand_pathname_ (token_value, dirname, ename, code);
      962 	return (code = 0);
      963      end valid_pathnamep;
      964 
      965 valid_record_sizep: procedure returns (bit (1) aligned);	/* defines <valid_record_sizep> token */
      966 
      967 	token.Nvalue = cv_dec_check_ (token_value, code);
      968 	if code ^= 0 then return ("0"b);
      969 	if token.Nvalue < 1 then return ("0"b);		/* not valid if 0 (or negative) */
      970 	if token.Nvalue > sys_info$max_seg_size * 4 then return ("0"b); /* not valid if > segment size in chars */
      971 	return ("1"b);				/* meets requirements */
      972      end valid_record_sizep;
      973 
      974 valid_volidp: procedure returns (bit (1) aligned);	/* defines <valid_volidp> token */
      975 
      976 	if token.Lvalue > 32 then return ("0"b);	/* not <valid_volidp> if greater than 32 characters */
      977 	if token.Lvalue < 1 then return ("0"b);		/* not <valid_volidp> if less than 1 character */
      978 	return ("1"b);				/* no other requirements */
      979      end valid_volidp;
      980 
      981 valid_datep: procedure returns (bit (1) aligned);		/* defines <valid_datep> token */
      982 
      983 	call convert_date_to_binary_ (token_value, clk_val, code); /* convert date */
      984 	return (code = 0);
      985      end valid_datep;
      986 
      987 build_vcb: procedure;				/* procedure to build a vcb */
      988 
      989 	allocate vcb in (my_area) set (temp_ptr);
      990 	if tid.first_vcb_ptr = null then
      991 	     tid.first_vcb_ptr = temp_ptr;
      992 	else vcb.next_vcb_ptr = temp_ptr;
      993 	vcb_ptr = temp_ptr;
      994 	vcb = EMPTY_VCB;				/* Initialize the vcb */
      995 
      996      end build_vcb;
      997 
      998 
      999 end_vcb: procedure;					/* procedure to add defaults to VCBs and FCBs */
     1000 
     1001 	if vcb.tape_type = 0 then
     1002 	     vcb.tape_type = ANSI;
     1003 	if vcb.density = 0 then			/* Must set the default density */
     1004 	     vcb.density = DEFAULT_DENSITY (vcb.tape_type);
     1005 	if vcb.first_fcb_ptr = null then do;		/* no file-groups in this volume-group */
     1006 	     Ptoken = vcb.volume_token_ptr;		/* no source line to be printed */
     1007 	     call Error (52);
     1008 	     return;
     1009 	end;
     1010 
     1011 	do fcb_ptr = vcb.first_fcb_ptr repeat fcb.next_fcb_ptr while (fcb_ptr ^= null ());
     1012 	     call Complete_FCB ();			/* add defaults to FCB */
     1013 	     call Check_FCB ();			/* and validate FCB */
     1014 	end;
     1015 
     1016      end end_vcb;
     1017 
     1018 build_fcb: procedure (head, tail);			/* procedure to allocate and initialize an FCB */
     1019 
     1020 dcl  (head, tail) ptr;				/* ptr to head & tail of FCB chain */
     1021 
     1022 	allocate fcb in (my_area) set (temp_ptr);
     1023 	if head = null then
     1024 	     head = temp_ptr;
     1025 	else tail -> fcb.next_fcb_ptr = temp_ptr;
     1026 	fcb_ptr = temp_ptr;
     1027 	fcb = EMPTY_FCB;				/* reset for next <file-group> */
     1028 	if tail ^= null then
     1029 	     fcb.prev_fcb_ptr = tail;			/* set backward fcb thread */
     1030 	tail = temp_ptr;				/* and update fcb tail for next allocation */
     1031 
     1032      end build_fcb;
     1033 
     1034 Complete_FCB: procedure;				/* procedure to add defaults to FCB */
     1035 
     1036 /* first, add in global default values, if any */
     1037 
     1038 	do dfcbp = fcb.default_fcb_ptr repeat dfcbp -> fcb.prev_fcb_ptr while (dfcbp ^= null);
     1039 	     if fcb.tape.blklen = 0 then fcb.tape.blklen = dfcbp -> fcb.tape.blklen;
     1040 	     if fcb.tape.reclen = 0 then fcb.tape.reclen = dfcbp -> fcb.tape.reclen;
     1041 	     if fcb.tape.format = 0 then fcb.tape.format = dfcbp -> fcb.tape.format;
     1042 	     if fcb.tape.cmode = 0 then fcb.tape.cmode = dfcbp -> fcb.tape.cmode;
     1043 	     if fcb.tape.expiration = "" then fcb.tape.expiration = dfcbp -> fcb.tape.expiration;
     1044 	     if fcb.segment.format = 0 then fcb.segment.format = dfcbp -> fcb.segment.format;
     1045 	end;
     1046 
     1047 /* Set the defaults up according to what kind of tape is to be processed */
     1048 
     1049 	if vcb.tape_type = ANSI then do;		/* If ANSI tape, set the ANSI defaults */
     1050 	     if fcb.tape.cmode = 0 then		/* if recording mode not specified.. */
     1051 		fcb.tape.cmode = 1;			/* set ANSI default to ASCII */
     1052 	     if tape_io_data.control.writing_tape then do;/* if tape output */
     1053 		if fcb.tape.format = 0 then		/* if tape format not specified.. */
     1054 		     fcb.tape.format = 6;		/* set ANSI default to DB */
     1055 		if fcb.tape.blklen = 0 then		/* if block length not specified.. */
     1056 		     fcb.tape.blklen = 2048;		/* set ANSI default */
     1057 		if fcb.tape.reclen = 0 then		/* if Record length not specified.. */
     1058 		     fcb.tape.reclen = 2048;		/* set ANSI default  */
     1059 	     end;
     1060 	end;
     1061 	else do;					/* No, its an IBMSL, IBMNL, or IBMDOS tape */
     1062 	     if fcb.tape.cmode = 0 then		/* if recording mode not specified.. */
     1063 		fcb.tape.cmode = 2;			/* set IBM default to EBCDIC */
     1064 	     if tape_io_data.control.writing_tape then do;/* if tape output */
     1065 		if fcb.tape.format = 0 then		/* if tape format not specified.. */
     1066 		     fcb.tape.format = 7;		/* set IBM default to VB */
     1067 		if fcb.tape.blklen = 0 then		/* if block length not specified.. */
     1068 		     fcb.tape.blklen = 8192;		/* set IBM default */
     1069 		if fcb.tape.reclen = 0 then		/* if Record length not specified.. */
     1070 		     fcb.tape.reclen = 8188;		/* set IBM default  */
     1071 	     end;
     1072 	end;
     1073 
     1074 /* Now do the common defaults */
     1075 
     1076 	if tape_io_data.control.writing_tape then	/* if tape output */
     1077 	     if fcb.tape.output_mode = 0 then		/* if no output mode specified... */
     1078 		fcb.tape.output_mode = 4;		/* The default is "Create or Replace" */
     1079 	if fcb.segment.format = 0 then		/* if no segment format specified... */
     1080 	     fcb.segment.format = 1;			/* The default is "Unstructured" */
     1081 	if fcb.segment.extend = 0 then		/* if no extend action specified... */
     1082 	     fcb.segment.extend = 1;			/* The default is "Truncate" */
     1083 	if fcb.segment.truncate_lines = 0 then		/* if no long lines action specified... */
     1084 	     fcb.segment.truncate_lines = 1;		/* The default is to "Fold" long lines */
     1085 
     1086      end Complete_FCB;
     1087 
     1088 Check_FCB: procedure;				/* procedure to validate the FCB for completness */
     1089 
     1090 	Ptoken = null;				/* no source line to be printed */
     1091 	if fcb.segment.dirname = "" | fcb.segment.ename = "" then /* no "path" statement */
     1092 	     call Error (24);
     1093 	if fcb.tape.file_id = "" then			/* No file statement */
     1094 	     call Error (18);
     1095 	if fcb.tape.sequence = -1 then		/* if number statement specified as "*".. */
     1096 	     if fcb.tape.output_mode ^= 4 then		/* mode has to be append */
     1097 		call Error (49);
     1098 	if vcb.tape_type ^= ANSI then do;		/* tape volume.tape_type not ANSI */
     1099 	     if fcb.tape.output_mode = 3 then		/* generate option not supported by IBM */
     1100 		call Error (19);
     1101 	     if fcb.tape.output_mode > 0 then		/* some output option  specified */
     1102 		if fcb.tape.blklen ^= 0 then		/* block size specified */
     1103 		     if mod (fcb.tape.blklen, 4) ^= 0 then /* blklen not word multiple */
     1104 			call Error (28);
     1105 	     if fcb.tape.blklen > 32760 then		/* block size too large for tape_ibm_ */
     1106 		call Error (10);
     1107 	end;
     1108 	if vcb.tape_type = IBMNL then do;		/* unlabeled volume specified */
     1109 	     if fcb.tape.file_id ^= "*" then		/* file names not allowed with unlabled volumes */
     1110 		call Error (29);
     1111 	     if fcb.tape.sequence = 0 then		/* if no file sequence number specified */
     1112 		call Error (31);
     1113 	     if fcb.tape.replace_id ^= "" then		/* replace statement specified for unlabeled tape */
     1114 		call Error (30);
     1115 	     if fcb.tape.output_mode = 1 then		/* extend specified for unlabeled tape */
     1116 		call Error (32);
     1117 	     else if fcb.tape.output_mode = 2 then	/* modify specified for unlabeled tape */
     1118 		call Error (55);
     1119 	     if fcb.tape.expiration ^= "" then		/* expires specified for unlabeled tape */
     1120 		call Error (56);
     1121 	     if tape_io_data.control.force then		/* -force option  specified for unlabeled tape */
     1122 		call Error (35);
     1123 	end;
     1124 	else do;					/* ANSI and labeled IBM checks */
     1125 	     if fcb.tape.output_mode = 4 then		/* ANSI and IBM checks  -  create */
     1126 		if fcb.tape.file_id = "*" then	/* invalid file id for create */
     1127 		     call Error (53);
     1128 		else ;
     1129 	     else if fcb.tape.output_mode = 0 then do;	/* tape input mode */
     1130 		if fcb.tape.format = 0 then		/* no format specified on input */
     1131 		     if fcb.tape.reclen > 0 | fcb.tape.blklen > 0 then /* reclen or blklen illegal */
     1132 			call Error (42);
     1133 		if fcb.tape.format > 1 then		/* if format was specified, record and/or block */
     1134 		     if fcb.tape.reclen = 0 | fcb.tape.blklen = 0 then /*  length must be specified */
     1135 			call Error (42);
     1136 	     end;
     1137 	     else if fcb.tape.output_mode < 3 then do;	/* output mode is extend or modify */
     1138 		if fcb.tape.expiration ^= "" then	/* and expiration specified */
     1139 		     if fcb.tape.output_mode = 1 then	/* if extend.. */
     1140 			call Error (39);
     1141 		     else call Error (40);		/* if modify */
     1142 	     end;
     1143 	     if fcb.tape.sequence = 0 | fcb.tape.sequence = -1 then /* no explicit sequence  or "*" */
     1144 		if fcb.tape.file_id = "*" then	/* and no <fileid> */
     1145 		     call Error (41);
     1146 	end;
     1147 
     1148 	go to test (fcb.tape.format);			/* now go validate the format */
     1149 
     1150 test (1):						/* U-format   */
     1151 	if fcb.tape.reclen ^= 0 then
     1152 	     fcb.tape.reclen = 0;			/* reclen must be zero */
     1153 	if fcb.tape.blklen = 0 then do;
     1154 	     call Error (43);
     1155 	     call ioa_ ("Tape file block size is ^d", fcb.tape.blklen);
     1156 	end;
     1157 	go to out;
     1158 test (2):						/* F-format  */
     1159 test (5):						/* FB-format */
     1160 	if fcb.tape.blklen ^= 0 & fcb.tape.reclen ^= 0 then do; /* non zero block & record length  */
     1161 	     if fcb.tape.format = 5 then do;		/* FB check */
     1162 		if mod (fcb.tape.blklen, fcb.tape.reclen) ^= 0 then do;
     1163 		     call Error (16);
     1164 		     call ioa_ ("Tape file record size is ^d", fcb.tape.reclen);
     1165 		     call ioa_ ("Tape file block size is ^d", fcb.tape.blklen);
     1166 		end;
     1167 	     end;
     1168 	     else if fcb.tape.blklen ^= fcb.tape.reclen then do; /* F format check */
     1169 		call Error (15);
     1170 		call ioa_ ("Tape file record size is ^d", fcb.tape.reclen);
     1171 		call ioa_ ("Tape file block size is ^d", fcb.tape.blklen);
     1172 	     end;
     1173 	end;
     1174 	go to out;
     1175 test (3):						/* D-format */
     1176 test (4):						/* V-format */
     1177 test (6):						/* DB-format  */
     1178 test (7):						/* VB-format */
     1179 	if fcb.tape.blklen ^= 0 & fcb.tape.reclen ^= 0 then do; /* d/v format */
     1180 	     if vcb.tape_type = ANSI then
     1181 		j = 0;				/* don't allow for BDW if ANSI */
     1182 	     else j = 4;				/* IBM - allow for 4 byte BDW */
     1183 	     if fcb.tape.format > 4 then do;		/* blocked: reclen must be <= blklen */
     1184 		if fcb.tape.blklen < fcb.tape.reclen + j then do;
     1185 		     call Error (17);
     1186 		     call ioa_ ("Tape file record size is ^d", fcb.tape.reclen);
     1187 		     call ioa_ ("Tape file block size is ^d", fcb.tape.blklen);
     1188 		end;
     1189 	     end;
     1190 	     else if fcb.tape.blklen ^= fcb.tape.reclen + j then do; /* V-format, D-format */
     1191 		call Error (15);
     1192 		call ioa_ ("Tape file record size is ^d", fcb.tape.reclen);
     1193 		call ioa_ ("Tape file block size is ^d", fcb.tape.blklen);
     1194 	     end;
     1195 	end;
     1196 test (8): test (9):
     1197 test (10): test (11):				/* S, SB, VS, VB, VS, VBS formats, all is possible */
     1198 test (0):						/* for reading, format code is 0 */
     1199 out:
     1200 	return;
     1201 
     1202      end Check_FCB;
     1203 
  1     1 /*	BEGIN INCLUDE FILE tape_io_data.incl.pl1 ... Michael R. Jordan 3/81 */
  1     2 
  1     3 dcl (fcb_ptr, vcb_ptr, tape_io_data_ptr) ptr;
  1     4 
  1     5 dcl 1 tape_io_data aligned based (tape_io_data_ptr),
  1     6     2 temp (3) ptr,					/* (1) -> code to interpret; (2) -> lex temp; (3) -> buffer */
  1     7     2 first_vcb_ptr ptr,				/* ptr to first vcb */
  1     8     2 source,					/* info about source file */
  1     9       3 dirname char (168) unal,
  1    10       3 ename char (32) unal,
  1    11       3 ptr ptr,
  1    12     2 control,					/* control flags */
  1    13       3 ck bit (1),					/* ON => -check specified */
  1    14       3 force bit (1),				/* ON => -force specified */
  1    15       3 ring bit (1),				/* ON => -ring specified */
  1    16       3 writing_tape bit (1),				/* ON => tape_out, OFF => tape_in */
  1    17       3 max_severity fixed bin;			/* maximum error severity to be printed */
  1    18 
  1    19 dcl 1 fcb aligned based (fcb_ptr),			/* file control block - governs file i/o */
  1    20     2 file_token_ptr ptr,				/* ptr to "File" token */
  1    21     2 next_fcb_ptr ptr,				/* pointer to next block, if any */
  1    22     2 prev_fcb_ptr ptr,				/* pointer to previous fcb */
  1    23     2 default_fcb_ptr ptr,				/* pointer to last default fcb */
  1    24     2 segment,					/* storage system data */
  1    25       3 dirname char (168),				/* directory name of file to be read/written */
  1    26       3 ename char (32),				/* entry name of file to be read/written */
  1    27       3 format fixed bin,				/* 0 = not specified; 1 = unstructured; 2 = sequential */
  1    28       3 extend fixed bin,				/* 0 = not specified; 1 = truncate (^extend); 2 = extend */
  1    29       3 truncate_lines fixed bin,			/* 0 = not specified; 1 = fold or; 2 = truncate long lines */
  1    30     2 tape,					/* tape file data */
  1    31       3 cmode fixed bin,				/* 0 = not specified; 1 = ASCII; 2 = EBCDIC; 3 = BINARY */
  1    32       3 format fixed bin,				/* 0 = not specified; 1 = Undefined; 2 = Fixed; 3 = D */
  1    33 						/* 4 = Variable; 5 = Fixed Blocked; 6 = DB */
  1    34 						/* 7 = Variable Blocked; 8 = Spanned; 9 = Spanned Blocked */
  1    35 						/* 10 = Variable Spanned; 11 = Variable Spanned Blocked */
  1    36       3 output_mode fixed bin,			/* 0 = not specified; 1 = extend; 2 = modify */
  1    37 						/* 3 = generate; 4 = create or replace */
  1    38       3 file_id char (17),				/* file identifier; "*" => no file name */
  1    39       3 replace_id char (17),				/* replace file ID; "" =>  create new file */
  1    40       3 expiration char (16),				/* expiration date, "" => immediate expiration */
  1    41       3 sequence fixed bin,				/* file seq. #; -1 = append to file-set; 0 = not specified */
  1    42       3 blklen fixed bin,				/* physical block length */
  1    43       3 reclen fixed bin (21);			/* logical record length */
  1    44 
  1    45 dcl 1 vcb aligned based (vcb_ptr),			/* volume control block - governs volume attachment */
  1    46     2 volume_token_ptr ptr,				/* ptr to Volume token for this volume group */
  1    47     2 next_vcb_ptr ptr,				/* pointer to next block, if any */
  1    48     2 first_fcb_ptr ptr,				/* first fcb for this volume set */
  1    49     2 first_default_fcb_ptr ptr,			/* first default fcb for this volume-set */
  1    50     2 nvols fixed bin,				/* number of volumes in current volume-set */
  1    51     2 volid (64) char (32),				/* volume identification string (serial number) */
  1    52     2 comment (64) char (64),
  1    53     2 tape_type fixed bin,				/* 0 = not specified; 1 = ANSI; 2 = IBMSL */
  1    54 						/* 3 = IBMNL; 4 = IBMDOS */
  1    55     2 density fixed bin;				/* 0 = not specified; 2 = 800; 3 = 1600; 4 = 6250 (BPI) */
  1    56 
  1    57 /*	END INCLUDE FILE tape_io_data.incl.pl1 */
     1204 
     1205 
  2     1 /* BEGIN INCLUDE FILE area_info.incl.pl1  12/75 */
  2     2 
  2     3 dcl  area_info_version_1 fixed bin static init (1) options (constant);
  2     4 
  2     5 dcl  area_infop ptr;
  2     6 
  2     7 dcl 1 area_info aligned based (area_infop),
  2     8     2 version fixed bin,				/* version number for this structure is 1 */
  2     9     2 control aligned like area_control,		/* control bits for the area */
  2    10     2 owner char (32) unal,				/* creator of the area */
  2    11     2 n_components fixed bin,				/* number of components in the area (returned only) */
  2    12     2 size fixed bin (18),				/* size of the area in words */
  2    13     2 version_of_area fixed bin,			/* version of area (returned only) */
  2    14     2 areap ptr,					/* pointer to the area (first component on multisegment area) */
  2    15     2 allocated_blocks fixed bin,			/* number of blocks allocated */
  2    16     2 free_blocks fixed bin,				/* number of free blocks not in virgin */
  2    17     2 allocated_words fixed bin (30),			/* number of words allocated in the area */
  2    18     2 free_words fixed bin (30);			/* number of words free in area not in virgin */
  2    19 
  2    20 dcl 1 area_control aligned based,
  2    21     2 extend bit (1) unal,				/* says area is extensible */
  2    22     2 zero_on_alloc bit (1) unal,			/* says block gets zerod at allocation time */
  2    23     2 zero_on_free bit (1) unal,			/* says block gets zerod at free time */
  2    24     2 dont_free bit (1) unal,			/* debugging aid, turns off free requests */
  2    25     2 no_freeing bit (1) unal,			/* for allocation method without freeing */
  2    26     2 system bit (1) unal,				/* says area is managed by system */
  2    27     2 pad bit (30) unal;
  2    28 
  2    29 /* END INCLUDE FILE area_info.incl.pl1 */
     1206 
     1207 
  3     1 /*	BEGIN INCLUDE FILE tape_io_errors.incl.pl1  */
  3     2 
  3     3 dcl 1 error_control_table (56) aligned internal static options (constant), /* error messages */
  3     4     2 severity fixed bin (17) aligned initial (		/* severity codes */
  3     5       3, 3, 3, 1, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
  3     6       2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
  3     7       3, 3, 2, 2),
  3     8     2 Soutput_stmt bit (1) unaligned initial (		/* write statement switch */
  3     9       "0"b, (55) (1) "1"b),
  3    10     2 message char (252) varying initial (		/* long message texts */
  3    11 /* ERR 1 */ "The control file contains no statements.",
  3    12 /* ERR 2 */ "The control file does not begin with a Volume statement.",
  3    13 /* ERR 3 */ "The control file does not end with an End statement.",
  3    14 /* ERR 4 */ "The Volume statement has prematurely terminated the previous volume-group.
  3    15 An End statement has been supplied.;",
  3    16 /* ERR 5 */ "A syntax error has occured in this statement.",
  3    17 /* ERR 6 */ "Invalid volume specification.",
  3    18 /* ERR 7 */ "Invalid density specification.",
  3    19 /* ERR 8 */ "Invalid tape mode specification.",
  3    20 /* ERR 9 */ "Invalid record format specification.",
  3    21 /* ERR 10 */ "Invalid physical block length specification.",
  3    22 /* ERR 11 */ "Invalid logical record length specification.",
  3    23 /* ERR 12 */ "Invalid file format specified.",
  3    24 /* ERR 13 */ "Invalid pathname.",
  3    25 /* ERR 14 */ "Illegal Density statement.
  3    26 A volume-group can contain only one Density statement.",
  3    27 /* ERR 15 */ "The logical record length specified is not allowed.
  3    28 For F, D, or V format, the logical record length must equal the physical block length.",
  3    29 /* ERR 16 */ "The physical block length specified is not allowed.
  3    30 For FB format, the physical block length must be an integral multiple of the logical record length.",
  3    31 /* ERR 17 */ "An invalid combination of logical record length and physical block length has been specified.
  3    32 For DB or VB format, the logical record length cannot exceed the physical block length.",
  3    33 /* ERR 18 */ "A file-group must contain a File statement.",
  3    34 /* ERR 19 */ "Generate output mode is not allowed for IBM tapes.",
  3    35 /* ERR 20 */ "Illegal Tape statement.
  3    36 A volume-group can contain only one Tape statement.",
  3    37 /* ERR 21 */ "Invalid Tape specification.",
  3    38 /* ERR 22 */ "Invalid expiration date.",
  3    39 /* ERR 23 */ "The specified pathname is in conflict with previous statement(s).",
  3    40 /* ERR 24 */ "A file-group must contain a path statement.",
  3    41 /* ERR 25 */ "A volume-set may consist of at most 64 volume identifiers.",
  3    42 /* ERR 26 */ "A logical record length cannot be specified for U format tapes.",
  3    43 /* ERR 27 */ "The specified storage_extend statement is in conflict with previous statement(s).",
  3    44 /* ERR 28 */ "Physical block length specifications must be a multiple of 4.",
  3    45 /* ERR 29 */ "The file identifier must be * for unlabeled tapes.",
  3    46 /* ERR 30 */ "The replace statement is not permitted with unlabeled tapes.",
  3    47 /* ERR 31 */ "A numeric file number is required for unlabeled volume-sets.",
  3    48 /* ERR 32 */ "The extend statement is not permitted with unlabeled tapes.",
  3    49 /* ERR 33 */ "The specified Storage statement is in conflict with previous statement(s).",
  3    50 /* ERR 34 */ "The specified Expires statement is in conflict with previous statement(s).",
  3    51 /* ERR 35 */ "The -force control argument cannot be specified for unlabelled volume-sets.",
  3    52 /* ERR 36 */ "A file identifier of * is not permitted for output volume-sets.",
  3    53 /* ERR 37 */ "The file identifier specified is not valid.",
  3    54 /* ERR 38 */ "The specified output mode is in conflict with previous statement(s).",
  3    55 /* ERR 39 */ "The tape_extend and expiration statements may not be specified in the same file-group.",
  3    56 /* ERR 40 */ "The modify and expiration statements may not be specified in the same file-group.",
  3    57 /* ERR 41 */ "A file identifier or file number must be specified for each file-group.",
  3    58 /* ERR 42 */ "<file-group> contains inconsistencies.",
  3    59 /* ERR 43 */ "A physical block length must be specified for U format volume-sets.",
  3    60 /* ERR 44 */ "The specified Mode statement is in conflict with previous statement(s).",
  3    61 /* ERR 45 */ "The specified Format statement is in conflict with previous statement(s).",
  3    62 /* ERR 46 */ "The specified Block statement is in conflict with previous statement(s).",
  3    63 /* ERR 47 */ "The specified Record statement is in conflict with previous statement(s).",
  3    64 /* ERR 48 */ "Invalid file number specified.  Valid values are ""*"" or a decimal integer from 1 to 9999.",
  3    65 /* ERR 49 */ "A numeric file number must be specified with tape_extend, generate, or modify.",
  3    66 /* ERR 50 */ "A local statement has been encountered outside a file-group.
  3    67 Statement ignored.",
  3    68 /* ERR 51 */ "The specified number statement is in conflict with previous statement(s).",
  3    69 /* ERR 52 */ "No file group has been specified for the preceding volume-group.",
  3    70 /* ERR 53 */ "Invalid file identifier.  A file identifier of * is only permitted for input or unlabeled volume-sets.",
  3    71 /* ERR 54 */ "Missing file number.",
  3    72 /* ERR 55 */ "The modify statement is not permitted with unlabeled tapes.",
  3    73 /* ERR 56 */ "The expiration statement is not permitted with unlabeled tapes."),
  3    74     2 brief_message char (4) varying initial ((56) (1) " ");
  3    75 
  3    76 /*	END INCLUDE FILE tape_io_errors.incl.pl1  */
     1208 
     1209 
     1210 
     1211      dcl	TRACING			bit(1) aligned int static init("0"b);
     1212 
     1213 
  4     1 	/* START OF:	rdc_start_.incl.pl1		  *  *  *  *  *  *  */
  4     2 
  4     3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  4     4 	/*							*/
  4     5 	/* N__a_m_e:  rdc_start_.incl.pl1					*/
  4     6 	/*							*/
  4     7 	/*      This include segment is used by compilers generated by the	*/
  4     8 	/* reduction_compiler.  Such compilers include a SEMANTIC_ANALYSIS	*/
  4     9 	/* subroutine generated by the reduction_compiler.  This subroutine	*/
  4    10 	/* compares a chain of input tokens with token requirements		*/
  4    11 	/* specified in reductions.  This include segment declares the 	*/
  4    12 	/* structure of the input tokens (which are generated by lex_string_),*/
  4    13 	/* defines the beginning of the SEMANTIC_ANALYSIS procedure, and	*/
  4    14 	/* declares Pthis_token, a global pointer variable which points to	*/
  4    15 	/* the "current" token being referenced by SEMANTIC_ANALYSIS.	*/
  4    16 	/*							*/
  4    17 	/* S__t_a_t_u_s							*/
  4    18 	/*							*/
  4    19 	/* 0) Created:  April, 1974 by G. C. Dixon			*/
  4    20 	/*							*/
  4    21 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  4    22 
  4    23      dcl	Pthis_token		ptr;		/* ptr to the "current" token being acted upon.	*/
  4    24 
  5     1 	/*  START OF:	lex_descriptors_.incl.pl1	  *  *  *  *  *  *  */
  5     2 	
  5     3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  5     4 	/*							*/
  5     5 	/* Name:  lex_descriptors_.incl.pl1				*/
  5     6 	/*							*/
  5     7 	/*      This include segment defines the structure of the token	*/
  5     8 	/* descriptor, statement descriptor, and comment descriptor created	*/
  5     9 	/* by the lex_string_ program.				*/
  5    10 	/*							*/
  5    11 	/* Status:						*/
  5    12 	/*							*/
  5    13 	/* 0) Created:  Dec, 1973 by G. C. Dixon			*/
  5    14 	/*							*/
  5    15 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  5    16 	
  5    17 	
  5    18 	
  5    19 	
  5    20      dcl	
  5    21 	1 comment			aligned based (Pcomment),
  5    22 						/* descriptor for a comment.			*/
  5    23 	  2 group1		unaligned,
  5    24 	    3 version		fixed bin(17),	/* comment descriptor version.		*/
  5    25 	    3 size		fixed bin(17),	/* comment descriptor size (in words).		*/
  5    26 	  2 Pnext			ptr unal,		/* ptr to next comment descriptor.		*/
  5    27 	  2 Plast			ptr unal,		/* ptr to last comment descriptor.		*/
  5    28 	  2 Pvalue		ptr unal,		/* ptr to comment.				*/
  5    29 	  2 Lvalue		fixed bin(18),	/* length of comment.			*/
  5    30 	  2 group2		unaligned,
  5    31 	    3 line_no		fixed bin(17),	/* line no of line containing comment.		*/
  5    32 	    3 S,					/* switches:				*/
  5    33 	      4 before_stmt		bit(1),		/* comment is before 1st token of stmt.		*/
  5    34 	      4 contiguous		bit(1),		/* no tokens between this and last comment.	*/
  5    35 	      4 pad		bit(16),
  5    36 	comment_value		char(comment.Lvalue) based (comment.Pvalue),
  5    37 						/* body of comment.				*/
  5    38 	Pcomment			ptr;		/* ptr to comment descriptor.			*/
  5    39 	
  5    40      dcl	
  5    41 	1 stmt			aligned based (Pstmt),
  5    42 						/* descriptor for a statement.		*/
  5    43 	  2 group1		unaligned,
  5    44 	    3 version		fixed bin(17),	/* statement descriptor version.		*/
  5    45 	    3 size		fixed bin(17),	/* statement descriptor size (in words).	*/
  5    46 	  2 Pnext			ptr unal,		/* ptr to next statement descriptor.		*/
  5    47 	  2 Plast			ptr unal,		/* ptr to last statement descriptor.		*/
  5    48 	  2 Pvalue		ptr unal,		/* ptr to statement.			*/
  5    49 	  2 Lvalue		fixed bin(18),	/* length of statement.			*/
  5    50 	  2 Pfirst_token		ptr unal,		/* ptr to 1st token of statement.		*/
  5    51 	  2 Plast_token		ptr unal,		/* ptr to last token of statement.		*/
  5    52 	  2 Pcomments		ptr unal,		/* ptr to comments in statement.		*/
  5    53 	  2 Puser			ptr unal,		/* user-defined ptr.			*/
  5    54 	  2 group2		unaligned,
  5    55 	    3 Ntokens		fixed bin(17),	/* number of tokens in statement.		*/
  5    56 	    3 line_no		fixed bin(17),	/* line no of line on which statement begins.	*/
  5    57 	    3 Istmt_in_line		fixed bin(17),	/* number of stmts in line containing this stmt.	*/
  5    58 						/* (the number includes this stmt.)		*/
  5    59 	    3 semant_type		fixed bin(17),	/* semantic type of the statement.		*/
  5    60 	    3 S,					/* switches:				*/
  5    61 	      4 error_in_stmt	bit(1),		/* stmt contains a syntactic error.		*/
  5    62 	      4 output_in_err_msg	bit(1),		/* stmt has been output in previous error message.*/
  5    63 	      4 pad		bit(34),
  5    64 	stmt_value		char(stmt.Lvalue) based (stmt.Pvalue),
  5    65 						/* text of the statement.			*/
  5    66 	Pstmt			ptr;		/* ptr to a stmt descriptor. 			*/
  5    67 	
  5    68      dcl	
  5    69 	1 token			aligned based (Ptoken),
  5    70 						/* descriptor for a token.			*/
  5    71 	  2 group1		unaligned,
  5    72 	    3 version		fixed bin(17),	/* token descriptor version.			*/
  5    73 	    3 size		fixed bin(17),	/* token descriptor size (in words).		*/
  5    74 	  2 Pnext			ptr unal,		/* ptr to next token descriptor.		*/
  5    75 	  2 Plast			ptr unal,		/* ptr to last token descriptor.		*/
  5    76 	  2 Pvalue		ptr unal,		/* ptr to token.				*/
  5    77 	  2 Lvalue		fixed bin(18),	/* length of token.				*/
  5    78 	  2 Pstmt			ptr unal,		/* ptr to descriptor of stmt containing token.	*/
  5    79 	  2 Psemant		ptr unal,		/* ptr to descriptor(s) of token's semantic value.*/
  5    80 	  2 group2		unaligned,
  5    81 	    3 Itoken_in_stmt	fixed bin(17),	/* position of token within its statement.	*/
  5    82 	    3 line_no		fixed bin(17),	/* line number of the line containing the token.	*/
  5    83 	    3 Nvalue		fixed bin(35),	/* numeric value of decimal-integer tokens.	*/
  5    84 	    3 S,					/* switches:				*/
  5    85 	      4 end_of_stmt		bit(1),		/* token is an end-of-stmt token.		*/
  5    86 	      4 quoted_string	bit(1),		/* token is a quoted string.			*/
  5    87 	      4 quotes_in_string	bit(1),		/* on if quote-close delimiters appear in quoted	*/
  5    88 						/* string (as doubled quotes on input.)		*/
  5    89 	      4 quotes_doubled	bit(1),		/* on if quotes in the string are doubled after	*/
  5    90 						/* string has been lexed into a token.		*/
  5    91 	      4 pad2		bit(32),
  5    92 	token_value		char(token.Lvalue) based (token.Pvalue),
  5    93 						/* value of the token.			*/
  5    94 	Ptoken			ptr;		/* ptr to a token descriptor.			*/
  5    95 
  5    96 	/*  END OF:	lex_descriptors_.incl.pl1	  *  *  *  *  *  *  */
  4    25 
  4    26 
  4    27 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  4    28 
  4    29 
  4    30 SEMANTIC_ANALYSIS:	procedure;			/* procedure which analyzes the syntax and	*/
  4    31 						/* semantics of the tokens in the input list.	*/
  4    32 
  4    33      dcl						/*	automatic variables			*/
  4    34 	LTOKEN_REQD_VALUE		fixed bin(18),	/* length of a token requirement.		*/
  4    35 	NRED			fixed bin,	/* number of the reduction tokens are being	*/
  4    36 						/* compared to.				*/
  4    37 	PRED			ptr,		/* ptr to the reduction tokens are being	*/
  4    38 						/* compared to.				*/
  4    39 	PTOKEN_REQD		ptr,		/* ptr to token requirement descriptor associated	*/
  4    40 						/* with reduction tokens are being compared to.	*/
  4    41 	PTOKEN_REQD_VALUE		ptr,		/* ptr to a token requirement.		*/
  4    42 	STOKEN_FCN		bit(1) aligned,	/* return value from a relative syntax function.	*/
  4    43 	CODE			fixed bin(35),	/* an error code.				*/
  4    44 	I			fixed bin,	/* a do-group index.			*/
  4    45 	NUMBER			fixed bin(35);	/* fixed binary representation of a decimal 	*/
  4    46 						/* number character string.			*/
  4    47 
  4    48      dcl						/*	based variables			*/
  4    49 	1 RED			aligned based (PRED),
  4    50 						/* descriptor for reduction tokens are being 	*/
  4    51 						/* compared to.				*/
  4    52 	  2 TOKEN_REQD		unaligned,
  4    53 	    3 IFIRST		fixed bin(17) unal,	/* index of first token requirement.		*/
  4    54 	    3 ILAST		fixed bin(17) unal,	/* index of last  token requirement associated	*/
  4    55 						/* with this reduction.			*/
  4    56 	1 TOKEN_REQD		aligned based (PTOKEN_REQD),
  4    57 						/* a token requirement descriptor.		*/
  4    58 	  2 FORM			fixed bin(17) unal,	/* form of the token requirement:		*/
  4    59 						/*  -1 = relative token requirement function;	*/
  4    60 						/*       TYPE = index of the particular token	*/
  4    61 						/*	      function in the token_fcn array.	*/
  4    62 						/*   0 = built-in token requirement function;	*/
  4    63 						/*       TYPE = as defined below.		*/
  4    64 						/*  >0 = absolute token requirement:		*/
  4    65 						/*       FORM = index(TOKEN_STRINGS,TOKEN_REQD);	*/
  4    66 						/*       TYPE = length(TOKEN_REQD);		*/
  4    67 	  2 TYPE			fixed bin(17) unal,	/* TYPE of built-in token requirement function:	*/
  4    68 						/*   1 = compile test to see if input token 	*/
  4    69 						/*       chain is exhausted (<no-token>).	*/
  4    70 						/*   2 = compile test for any token value	*/
  4    71 						/*       (<any-token>).			*/
  4    72 						/*   3 = compile test for a PL/I identifier	*/
  4    73 						/*       (<name>) of 32 or fewer characters.	*/
  4    74 						/*   4 = compile test for token which is a	*/
  4    75 						/*       <decimal-integer>.			*/
  4    76 						/*   5 = compile test for token which is a single	*/
  4    77 						/*       backspace character (<BS>).		*/
  4    78 						/*   6 = compile test for a token which is a	*/
  4    79 						/*       <quoted-string>.			*/
  4    80 
  4    81 	1 TOKEN_REQD_STRING		aligned based (PTOKEN_REQD),
  4    82 						/* overlay for an absolute token requirement	*/
  4    83 						/* descriptor.				*/
  4    84 	  2 I			fixed bin(17) unal,	/* index into list of token strings of the	*/
  4    85 						/* absolute token string assoc w/ descriptor.	*/
  4    86 	  2 L			fixed bin(17) unal,	/* length of the absolute token string.		*/
  4    87 	TOKEN_REQD_VALUE		char(LTOKEN_REQD_VALUE) based (PTOKEN_REQD_VALUE);
  4    88 						/* absolute token string which token is reqd	*/
  4    89 						/* to match in order for tokens which are	*/
  4    90 						/* "current" on the list to match the reduction.	*/
  4    91 
  4    92      dcl						/*	builtin functions			*/
  4    93          (addr, max, null, search, substr, verify)
  4    94 				builtin;
  4    95 
  4    96      dcl						/*	entries				*/
  4    97 	cv_dec_check_		entry (char(*), fixed bin(35)) returns (fixed bin(35));
  4    98 
  4    99      dcl						/*	static variables			*/
  4   100 	BACKSPACE			char(1) aligned int static init ("");
  4   101 
  4   102 	/* END OF:	rdc_start_.incl.pl1		  *  *  *  *  *  *  */
     1214 
     1215 
     1216      dcl	DIRECTION			fixed bin init(+1);	/* direction in which tokens compared.		*/
     1217      dcl	STACK (10)   		fixed bin,	/* reduction label stack.			*/
     1218 	STACK_DEPTH		fixed bin init (0);	/* index into STACK.			*/
     1219 
     1220 
     1221      dcl	1 REDUCTION (160)		unaligned based (addr (REDUCTIONS)),
     1222 						/* object reductions.			*/
     1223 	  2 TOKEN_REQD,
     1224 	    3 IFIRST		fixed bin(17),	/* index of first required token.		*/
     1225 	    3 ILAST		fixed bin(17),	/* index of last required token.		*/
     1226 
     1227 	REDUCTIONS  (320)		fixed bin(17) unaligned internal static options(constant) initial (
     1228 	         1,     1,	/*     1/  <no-token>                                                           */
     1229 	         2,     3,	/*     2/  Volume :                                                             */
     1230 	         4,     4,	/*     3/  <any-token>                                                          */
     1231 	         1,     1,	/*     4/  <no-token>                                                           */
     1232 	         5,     5,	/*     5/  <valid_volidp>                                                       */
     1233 	         4,     4,	/*     6/  <any-token>                                                          */
     1234 	         1,     1,	/*     7/  <no-token>                                                           */
     1235 	         5,     5,	/*     8/  <valid_volidp>                                                       */
     1236 	         4,     4,	/*     9/  <any-token>                                                          */
     1237 	         1,     1,	/*    10/  <no-token>                                                           */
     1238 	         6,     6,	/*    11/  "-comment"                                                           */
     1239 	         7,     7,	/*    12/  "-com"                                                               */
     1240 	         4,     4,	/*    13/  <any-token>                                                          */
     1241 	         1,     1,	/*    14/  <no-token>                                                           */
     1242 	         8,     8,	/*    15/  <quoted-string>                                                      */
     1243 	         9,     9,	/*    16/  <name>                                                               */
     1244 	         4,     4,	/*    17/  <any-token>                                                          */
     1245 	         1,     1,	/*    18/  <no-token>                                                           */
     1246 	        10,    10,	/*    19/  ;                                                                    */
     1247 	        11,    11,	/*    20/  ,                                                                    */
     1248 	         4,     4,	/*    21/  <any-token>                                                          */
     1249 	         1,     1,	/*    22/  <no-token>                                                           */
     1250 	        12,    13,	/*    23/  File :                                                               */
     1251 	        14,    15,	/*    24/  End ;                                                                */
     1252 	         2,     3,	/*    25/  Volume :                                                             */
     1253 	        16,    17,	/*    26/  Tape :                                                               */
     1254 	        18,    19,	/*    27/  Density :                                                            */
     1255 	         4,     4,	/*    28/  <any-token>                                                          */
     1256 	         1,     1,	/*    29/  <no-token>                                                           */
     1257 	        20,    21,	/*    30/  Storage :                                                            */
     1258 	        22,    23,	/*    31/  Expiration :                                                         */
     1259 	        24,    25,	/*    32/  Mode :                                                               */
     1260 	        26,    27,	/*    33/  Format :                                                             */
     1261 	        28,    29,	/*    34/  Block :                                                              */
     1262 	        30,    31,	/*    35/  Record :                                                             */
     1263 	        32,    33,	/*    36/  mode :                                                               */
     1264 	        34,    35,	/*    37/  storage :                                                            */
     1265 	        36,    37,	/*    38/  expiration :                                                         */
     1266 	        38,    39,	/*    39/  number :                                                             */
     1267 	        40,    41,	/*    40/  replace :                                                            */
     1268 	        42,    43,	/*    41/  modify ;                                                             */
     1269 	        44,    45,	/*    42/  generate ;                                                           */
     1270 	        46,    47,	/*    43/  tape_extend ;                                                        */
     1271 	        48,    49,	/*    44/  storage_extend ;                                                     */
     1272 	        50,    51,	/*    45/  format :                                                             */
     1273 	        52,    53,	/*    46/  block :                                                              */
     1274 	        54,    55,	/*    47/  record :                                                             */
     1275 	         4,     4,	/*    48/  <any-token>                                                          */
     1276 	        56,    57,	/*    49/  ANSI ;                                                               */
     1277 	        58,    59,	/*    50/  ansi ;                                                               */
     1278 	        60,    61,	/*    51/  IBMSL ;                                                              */
     1279 	        62,    63,	/*    52/  ibmsl ;                                                              */
     1280 	        64,    65,	/*    53/  IBMNL ;                                                              */
     1281 	        66,    67,	/*    54/  ibmnl ;                                                              */
     1282 	        68,    69,	/*    55/  IBMDOS ;                                                             */
     1283 	        70,    71,	/*    56/  ibmdos ;                                                             */
     1284 	        72,    73,	/*    57/  <any-token> ;                                                        */
     1285 	         4,     4,	/*    58/  <any-token>                                                          */
     1286 	         1,     1,	/*    59/  <no-token>                                                           */
     1287 	        74,    75,	/*    60/  6250 ;                                                               */
     1288 	        76,    77,	/*    61/  4 ;                                                                  */
     1289 	        78,    79,	/*    62/  1600 ;                                                               */
     1290 	        80,    81,	/*    63/  3 ;                                                                  */
     1291 	        82,    83,	/*    64/  800 ;                                                                */
     1292 	        84,    85,	/*    65/  2 ;                                                                  */
     1293 	        86,    87,	/*    66/  <decimal-integer> ;                                                  */
     1294 	         4,     4,	/*    67/  <any-token>                                                          */
     1295 	         1,     1,	/*    68/  <no-token>                                                           */
     1296 	        88,    89,	/*    69/  unstructured ;                                                       */
     1297 	        90,    91,	/*    70/  sequential ;                                                         */
     1298 	        72,    73,	/*    71/  <any-token> ;                                                        */
     1299 	         4,     4,	/*    72/  <any-token>                                                          */
     1300 	         1,     1,	/*    73/  <no-token>                                                           */
     1301 	        92,    93,	/*    74/  <valid_datep> ;                                                      */
     1302 	        72,    73,	/*    75/  <any-token> ;                                                        */
     1303 	         4,     4,	/*    76/  <any-token>                                                          */
     1304 	         1,     1,	/*    77/  <no-token>                                                           */
     1305 	        94,    95,	/*    78/  ascii ;                                                              */
     1306 	        96,    97,	/*    79/  ASCII ;                                                              */
     1307 	        98,    99,	/*    80/  ebcdic ;                                                             */
     1308 	       100,   101,	/*    81/  EBCDIC ;                                                             */
     1309 	       102,   103,	/*    82/  binary ;                                                             */
     1310 	       104,   105,	/*    83/  BINARY ;                                                             */
     1311 	        72,    73,	/*    84/  <any-token> ;                                                        */
     1312 	         4,     4,	/*    85/  <any-token>                                                          */
     1313 	         1,     1,	/*    86/  <no-token>                                                           */
     1314 	       106,   107,	/*    87/  U ;                                                                  */
     1315 	       108,   109,	/*    88/  u ;                                                                  */
     1316 	       110,   111,	/*    89/  F ;                                                                  */
     1317 	       112,   113,	/*    90/  f ;                                                                  */
     1318 	       114,   115,	/*    91/  FB ;                                                                 */
     1319 	       116,   117,	/*    92/  fb ;                                                                 */
     1320 	       118,   119,	/*    93/  D ;                                                                  */
     1321 	       120,   121,	/*    94/  d ;                                                                  */
     1322 	       122,   123,	/*    95/  DB ;                                                                 */
     1323 	       124,   125,	/*    96/  db ;                                                                 */
     1324 	       126,   127,	/*    97/  S ;                                                                  */
     1325 	       128,   129,	/*    98/  s ;                                                                  */
     1326 	       130,   131,	/*    99/  SB ;                                                                 */
     1327 	       132,   133,	/*   100/  sb ;                                                                 */
     1328 	       134,   135,	/*   101/  V ;                                                                  */
     1329 	       136,   137,	/*   102/  v ;                                                                  */
     1330 	       138,   139,	/*   103/  VB ;                                                                 */
     1331 	       140,   141,	/*   104/  vb ;                                                                 */
     1332 	       142,   143,	/*   105/  VS ;                                                                 */
     1333 	       144,   145,	/*   106/  vs ;                                                                 */
     1334 	       146,   147,	/*   107/  VBS ;                                                                */
     1335 	       148,   149,	/*   108/  vbs ;                                                                */
     1336 	        72,    73,	/*   109/  <any-token> ;                                                        */
     1337 	         4,     4,	/*   110/  <any-token>                                                          */
     1338 	         1,     1,	/*   111/  <no-token>                                                           */
     1339 	       150,   151,	/*   112/  <valid_block_sizep> ;                                                */
     1340 	        72,    73,	/*   113/  <any-token> ;                                                        */
     1341 	         4,     4,	/*   114/  <any-token>                                                          */
     1342 	         1,     1,	/*   115/  <no-token>                                                           */
     1343 	       152,   153,	/*   116/  <valid_record_sizep> ;                                               */
     1344 	        72,    73,	/*   117/  <any-token> ;                                                        */
     1345 	         4,     4,	/*   118/  <any-token>                                                          */
     1346 	         1,     1,	/*   119/  <no-token>                                                           */
     1347 	       154,   155,	/*   120/  <valid_file_namep> ;                                                 */
     1348 	        72,    73,	/*   121/  <any-token> ;                                                        */
     1349 	         4,     4,	/*   122/  <any-token>                                                          */
     1350 	         1,     1,	/*   123/  <no-token>                                                           */
     1351 	         4,     4,	/*   124/  <any-token>                                                          */
     1352 	         1,     1,	/*   125/  <no-token>                                                           */
     1353 	       156,   157,	/*   126/  path :                                                               */
     1354 	        32,    33,	/*   127/  mode :                                                               */
     1355 	        34,    35,	/*   128/  storage :                                                            */
     1356 	        36,    37,	/*   129/  expiration :                                                         */
     1357 	        38,    39,	/*   130/  number :                                                             */
     1358 	        40,    41,	/*   131/  replace :                                                            */
     1359 	        50,    51,	/*   132/  format :                                                             */
     1360 	        52,    53,	/*   133/  block :                                                              */
     1361 	        54,    55,	/*   134/  record :                                                             */
     1362 	        42,    43,	/*   135/  modify ;                                                             */
     1363 	        44,    45,	/*   136/  generate ;                                                           */
     1364 	        46,    47,	/*   137/  tape_extend ;                                                        */
     1365 	        48,    49,	/*   138/  storage_extend ;                                                     */
     1366 	        12,    13,	/*   139/  File :                                                               */
     1367 	        14,    14,	/*   140/  End                                                                  */
     1368 	        20,    21,	/*   141/  Storage :                                                            */
     1369 	        22,    23,	/*   142/  Expiration :                                                         */
     1370 	        24,    25,	/*   143/  Mode :                                                               */
     1371 	        26,    27,	/*   144/  Format :                                                             */
     1372 	        28,    29,	/*   145/  Block :                                                              */
     1373 	        30,    31,	/*   146/  Record :                                                             */
     1374 	         4,     4,	/*   147/  <any-token>                                                          */
     1375 	         1,     1,	/*   148/  <no-token>                                                           */
     1376 	       158,   159,	/*   149/  <valid_pathnamep> ;                                                  */
     1377 	        72,    73,	/*   150/  <any-token> ;                                                        */
     1378 	         4,     4,	/*   151/  <any-token>                                                          */
     1379 	         1,     1,	/*   152/  <no-token>                                                           */
     1380 	       160,   161,	/*   153/  <valid_file_numberp> ;                                               */
     1381 	        72,    73,	/*   154/  <any-token> ;                                                        */
     1382 	         4,     4,	/*   155/  <any-token>                                                          */
     1383 	         1,     1,	/*   156/  <no-token>                                                           */
     1384 	       154,   155,	/*   157/  <valid_file_namep> ;                                                 */
     1385 	        72,    73,	/*   158/  <any-token> ;                                                        */
     1386 	         4,     4,	/*   159/  <any-token>                                                          */
     1387 	         1,     1);	/*   160/  <no-token>                                                           */
     1388 
     1389      dcl	1 TOKEN_REQUIREMENT (161)	unaligned based (addr (TOKEN_REQUIREMENTS)),
     1390 						/* object token requirements.			*/
     1391 	  2 FORM			fixed bin(17),	/* form of the token requirement:		*/
     1392 						/*  -1 = relative token requirement function;	*/
     1393 						/*       TYPE = index of the particular token	*/
     1394 						/*	      function in the token_fcn array.	*/
     1395 						/*   0 = built-in token requirement function;	*/
     1396 						/*       TYPE = as defined below.		*/
     1397 						/*  >0 = absolute token requirement:		*/
     1398 						/*       FORM = index(TOKEN_STRINGS,TOKEN_REQD);	*/
     1399 						/*       TYPE = length(TOKEN_REQD);		*/
     1400 	  2 TYPE			fixed bin(17) unal,	/* type of the built-in token requirement	*/
     1401 						/* function:				*/
     1402 						/*   1 = compile test to see if input token 	*/
     1403 						/*       chain is exhausted (<no-token>).	*/
     1404 						/*   2 = compile test for any token value	*/
     1405 						/*       (<any-token>).			*/
     1406 						/*   3 = compile test for a PL/I identifier	*/
     1407 						/*       (<name>) of 32 or fewer characters.	*/
     1408 						/*   4 = compile test for token which is a	*/
     1409 						/*       <decimal-integer>.			*/
     1410 						/*   5 = compile test for token which is a single	*/
     1411 						/*       backspace character (<BS>).		*/
     1412 						/*   6 = compile test for a token which is a	*/
     1413 						/*       <quoted-string>.			*/
     1414 
     1415 	TOKEN_REQUIREMENTS  (322)	fixed bin(17) unaligned internal static options(constant) initial (
     1416 	         0,    1,       1,    6,       7,    1,       0,    2,      -1,    1,       8,    8,       8,    4,   
     1417 	         0,    6,       0,    3,      16,    1,      17,    1,      18,    4,       7,    1,      22,    3,   
     1418 	        16,    1,      25,    4,       7,    1,      29,    7,       7,    1,      36,    7,       7,    1,   
     1419 	        43,   10,       7,    1,      53,    4,       7,    1,      57,    6,       7,    1,      63,    5,   
     1420 	         7,    1,      68,    6,       7,    1,      74,    4,       7,    1,      78,    7,       7,    1,   
     1421 	        85,   10,       7,    1,      95,    6,       7,    1,     101,    7,       7,    1,     108,    6,   
     1422 	        16,    1,     114,    8,      16,    1,     122,   11,      16,    1,     133,   14,      16,    1,   
     1423 	       147,    6,       7,    1,     153,    5,       7,    1,     158,    6,       7,    1,     164,    4,   
     1424 	        16,    1,     168,    4,      16,    1,     172,    5,      16,    1,     177,    5,      16,    1,   
     1425 	       182,    5,      16,    1,     187,    5,      16,    1,     192,    6,      16,    1,     198,    6,   
     1426 	        16,    1,       0,    2,      16,    1,     204,    4,      16,    1,     208,    1,      16,    1,   
     1427 	       209,    4,      16,    1,     213,    1,      16,    1,     214,    3,      16,    1,     205,    1,   
     1428 	        16,    1,       0,    4,      16,    1,     217,   12,      16,    1,     229,   10,      16,    1,   
     1429 	        -1,    2,      16,    1,     239,    5,      16,    1,     244,    5,      16,    1,     249,    6,   
     1430 	        16,    1,     255,    6,      16,    1,     261,    6,      16,    1,     267,    6,      16,    1,   
     1431 	       273,    1,      16,    1,       4,    1,      16,    1,      18,    1,      16,    1,     112,    1,   
     1432 	        16,    1,     274,    2,      16,    1,     276,    2,      16,    1,      29,    1,      16,    1,   
     1433 	        24,    1,      16,    1,     278,    2,      16,    1,     280,    2,      16,    1,      36,    1,   
     1434 	        16,    1,      32,    1,      16,    1,     282,    2,      16,    1,     284,    2,      16,    1,   
     1435 	         1,    1,      16,    1,     286,    1,      16,    1,     287,    2,      16,    1,     289,    2,   
     1436 	        16,    1,     291,    2,      16,    1,     293,    2,      16,    1,     295,    3,      16,    1,   
     1437 	       298,    3,      16,    1,      -1,    3,      16,    1,      -1,    4,      16,    1,      -1,    5,   
     1438 	        16,    1,     301,    4,       7,    1,      -1,    6,      16,    1,      -1,    7,      16,    1);
     1439 
     1440 
     1441      dcl	TOKEN_STRINGS		char(304) aligned based (addr (TOKEN_STRING_ARRAYS)),
     1442 						/* object token values.			*/
     1443 	TOKEN_STRING_ARRAYS (4)	char(100) aligned internal static options(constant) initial (
     1444 	     "Volume:-comment;,FileEndTapeDensityStorageExpirationModeFormatBlockRecordmodestorageexpirationnumber",
     1445 	     "replacemodifygeneratetape_extendstorage_extendformatblockrecordANSIansiIBMSLibmslIBMNLibmnlIBMDOSibm",
     1446 	     "dos6250416003800unstructuredsequentialasciiASCIIebcdicEBCDICbinaryBINARYUFBfbDBdbSBsbvVBvbVSvsVBSvbs",
     1447 	     "path");
     1448 
     1449 	/* START OF:	rdc_end_.incl.pl1		  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  6     2 
  6     3 
  6     4 /****^  HISTORY COMMENTS:
  6     5*  1) change(86-02-14,GWMay), approve(), audit(), install():
  6     6*     old history comments:
  6     7*      0) Created: April, 1974 by G. C. Dixon
  6     8*      1) Modified: Feb, 1975  by G. C. Dixon
  6     9*         a) support for Version 2.0 of reduction_compiler.
  6    10*      2) Modified: Feb, 1981  by G. C. Dixon
  6    11*         a) support for Version  2.2 of reduction_compiler
  6    12*      3) Modified: Aug, 1983  by G. C. Dixon - support for Version 2.3 of
  6    13*                        reductions command.
  6    14*  2) change(86-03-04,GDixon), approve(86-03-04,MCR7362), audit(86-03-17,GWMay),
  6    15*     install(86-03-17,MR12.0-1032):
  6    16*     Changed how the PUSH DOWN LANGUAGE (SPDL) definition of <no-token> is
  6    17*     implemented to avoid references through a null pointer.  The two
  6    18*     accepted uses are:
  6    19*     
  6    20*        / <no-token>               / ... / ... \
  6    21*                    A
  6    22*                    |
  6    23*           Pthis_token (points to top of push down stack)
  6    24*     
  6    25*     which checks to see if the push down stack is totally exhausted (ie,
  6    26*     Ptoken = null); and:
  6    27*     
  6    28*        / SPEC1 ... SPECN <no-token>         / ... / ... \
  6    29*                           A
  6    30*                           |
  6    31*                 Pthis_token (points to top of push down stack)
  6    32*     
  6    33*     which checks to see whether SPECN is topmost on the push down stack
  6    34*     AND is the final token in the input list.
  6    35*                                                   END HISTORY COMMENTS */
  6    36 
  6    37 
  6    38 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  6    39 	/*									*/
  6    40 	/* NAME:  rdc_end_.incl.pl1							*/
  6    41 	/*									*/
  6    42 	/*      This include segment is used by compilers generated by the reduction_compiler.	*/
  6    43 	/* Such compilers include a SEMANTIC_ANALYSIS subroutine generated by the		*/
  6    44 	/* reduction_compiler.  This subroutine compares a chain of input tokens with token	*/
  6    45 	/* requirements specified in reductions.  The code in this include segment performs the	*/
  6    46 	/* actual comparisons.  This code is the middle part of the SEMANTIC_ANALYSIS procedure.	*/
  6    47 	/*									*/
  6    48 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  6    49 
  6    50 	TRACING = TRACING;				/* Kludge to prevent pl1 from making TRACING	*/
  6    51 						/*   options(constant) because it is never set.	*/
  6    52 	NRED = 1;
  6    53 	go to RD_TEST_REDUCTION;
  6    54 
  6    55 RD_NEXT_REDUCTION:
  6    56 	NRED = NRED + 1;
  6    57 
  6    58 RD_TEST_REDUCTION:
  6    59 	PRED = addr(REDUCTION(NRED));
  6    60 	Ptoken = Pthis_token;
  6    61 
  6    62 	do I = RED.TOKEN_REQD.IFIRST to RED.TOKEN_REQD.ILAST by DIRECTION;
  6    63 	     PTOKEN_REQD = addr(TOKEN_REQUIREMENT(I));
  6    64 	     if Ptoken = null then do;
  6    65 		if TOKEN_REQD.FORM = 0 then		/* No more tokens.  Only matches <no-token> spec.	*/
  6    66 		     if TOKEN_REQD.TYPE = 1 then
  6    67 			go to RD_TEST_TOKEN(1);
  6    68 		go to RD_NEXT_REDUCTION;
  6    69 		end;
  6    70 	     if TOKEN_REQD.FORM = 0 then do;		/* built-in syntax function.			*/
  6    71 		go to RD_TEST_TOKEN(TOKEN_REQD.TYPE);
  6    72 
  6    73 RD_TEST_TOKEN(1):   if SPDL then			/* <no-token>				*/
  6    74 						/* In push-down-language, there are 2 		*/
  6    75 						/*   interpretations of <no-token>.		*/
  6    76 		     if      RED.TOKEN_REQD.IFIRST = RED.TOKEN_REQD.ILAST &
  6    77 			   Ptoken = null then	/* When <no-token> is only spec, the spec asks 	*/
  6    78 			go to RD_MATCH_NO_TOKEN;	/* "Is push down stack empty (all input gone)?"   */
  6    79 		     else if RED.TOKEN_REQD.IFIRST^= RED.TOKEN_REQD.ILAST &
  6    80 			   RED.TOKEN_REQD.IFIRST = I &
  6    81 			   token.Pnext = null then	/* For SPEC1 ... SPECN <no-token>, the spec asks  */
  6    82 			go to RD_MATCH_NO_TOKEN;	/* "Are the topmost tokens on stack SPEC1 - SPECN,*/
  6    83 						/*  and is SPECN the final input token?"	*/
  6    84 		     else go to RD_NEXT_REDUCTION;	/* Those are the only two defs allowed in push	*/
  6    85 						/* down language mode for <no-token>.		*/
  6    86 		else if Ptoken = null then
  6    87 		     go to RD_MATCH_NO_TOKEN;
  6    88 		go to RD_NEXT_REDUCTION;
  6    89 
  6    90 RD_TEST_TOKEN(2):	go to RD_MATCH;			/* <any-token>				*/
  6    91 
  6    92 RD_TEST_TOKEN(3):	if token.Lvalue > 0 &		/* <name>					*/
  6    93 		   token.Lvalue <= 32 & ^token.S.quoted_string then
  6    94 		     if search(substr(token_value,1,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
  6    95 		     > 0 then
  6    96 			if verify(token_value,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$")
  6    97 			= 0 then
  6    98 			     go to RD_MATCH;
  6    99 		go to RD_NEXT_REDUCTION;
  6   100 
  6   101 RD_TEST_TOKEN(4):					/* <decimal-integer>			*/
  6   102 		if token.Nvalue ^= 0 then		/* token already determined to be a number.	*/
  6   103 		     go to RD_MATCH;
  6   104 		if token.S.quoted_string then
  6   105 		     go to RD_NEXT_REDUCTION;
  6   106 		NUMBER = cv_dec_check_ (token_value, CODE);
  6   107 		if CODE = 0 then do;
  6   108 		     token.Nvalue = NUMBER;
  6   109 		     go to RD_MATCH;
  6   110 		     end;
  6   111 		go to RD_NEXT_REDUCTION;
  6   112 
  6   113 RD_TEST_TOKEN(5):	if token.Lvalue = 1 then		/* <BS>					*/
  6   114 		     if token_value = BACKSPACE & ^token.S.quoted_string then
  6   115 			go to RD_MATCH;
  6   116 		go to RD_NEXT_REDUCTION;
  6   117 
  6   118 RD_TEST_TOKEN(6):	if token.S.quoted_string then		/* <quoted-string>				*/
  6   119 		     go to RD_MATCH;
  6   120 		go to RD_NEXT_REDUCTION;
  6   121 		end;
  6   122 
  6   123 	     else if TOKEN_REQD.FORM > 0 then do;	/* absolute syntax specification.		*/
  6   124 		if token.S.quoted_string then
  6   125 		     go to RD_NEXT_REDUCTION;
  6   126 		PTOKEN_REQD_VALUE = addr(substr(TOKEN_STRINGS,TOKEN_REQD_STRING.I));
  6   127 		LTOKEN_REQD_VALUE = TOKEN_REQD_STRING.L;
  6   128 		if token_value = TOKEN_REQD_VALUE then
  6   129 		     go to RD_MATCH;
  6   130 		go to RD_NEXT_REDUCTION;
  6   131 		end;
  6   132 
  6   133 	/* END OF:	rdc_end_.incl.pl1		  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
     1449 
     1450 
     1451 	     else do;				/* relative syntax function.			*/
     1452 		go to RD_TOKEN_FCN(TOKEN_REQD.TYPE);
     1453 
     1454 RD_TOKEN_FCN(1):	STOKEN_FCN = valid_volidp();
     1455 		go to RD_TEST_RESULT;
     1456 RD_TOKEN_FCN(2):	STOKEN_FCN = valid_datep();
     1457 		go to RD_TEST_RESULT;
     1458 RD_TOKEN_FCN(3):	STOKEN_FCN = valid_block_sizep();
     1459 		go to RD_TEST_RESULT;
     1460 RD_TOKEN_FCN(4):	STOKEN_FCN = valid_record_sizep();
     1461 		go to RD_TEST_RESULT;
     1462 RD_TOKEN_FCN(5):	STOKEN_FCN = valid_file_namep();
     1463 		go to RD_TEST_RESULT;
     1464 RD_TOKEN_FCN(6):	STOKEN_FCN = valid_pathnamep();
     1465 		go to RD_TEST_RESULT;
     1466 RD_TOKEN_FCN(7):	STOKEN_FCN = valid_file_numberp();
     1467 		go to RD_TEST_RESULT;
     1468 
     1469 RD_TEST_RESULT:	if STOKEN_FCN then go to RD_MATCH;
     1470 		else go to RD_NEXT_REDUCTION;
     1471 		end;
     1472 
     1473 RD_MATCH:      Ptoken = token.Pnext;
     1474 RD_MATCH_NO_TOKEN:
     1475 	     end;
     1476 	Ptoken = Pthis_token;
     1477 	go to RD_ACTION(NRED);
     1478 
     1479 		/* START OF:	rdc_stack_fcns_.incl.pl1	  *  *  *  *  *  *  */
  7     2 
  7     3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  7     4 	/*							*/
  7     5 	/* N__a_m_e:  rdc_stack_fcns_.incl.pl1				*/
  7     6 	/*							*/
  7     7 	/*      This include segment is used by compilers generated by the	*/
  7     8 	/* reduction_compiler.  It includes code for manipulating the 	*/
  7     9 	/* reduction label stack.					*/
  7    10 	/*							*/
  7    11 	/* S__t_a_t_u_s							*/
  7    12 	/*							*/
  7    13 	/* 0) Created:  April, 1974 by G. C. Dixon			*/
  7    14 	/*							*/
  7    15 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  7    16 
  7    17 RD_STACK:	if STACK_DEPTH > 0 then do;
  7    18 	     NRED = STACK (STACK_DEPTH);
  7    19 	     go to RD_TEST_REDUCTION;
  7    20 	     end;
  7    21 	else
  7    22 	     go to RD_NEXT_REDUCTION;
  7    23 
  7    24 RD_STACK_POP:
  7    25 	if STACK_DEPTH > 0 then do;
  7    26 	     NRED = STACK (STACK_DEPTH);
  7    27 	     STACK_DEPTH = max (STACK_DEPTH-1, 0);
  7    28 	     go to RD_TEST_REDUCTION;
  7    29 	     end;
  7    30 	else
  7    31 	     go to RD_NEXT_REDUCTION;
  7    32 
  7    33 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  7    34 
  7    35 
  7    36 PUSH:	procedure (N);				/* invoked to push reduction number 'N' onto	*/
  7    37 						/* the reduction stack.			*/
  7    38      dcl	N			fixed bin;
  7    39 
  7    40      dcl (addr, dimension, length, null)
  7    41 				builtin;
  7    42 
  7    43      dcl	cu_$cl			entry,
  7    44 	iox_$put_chars		entry (ptr, ptr, fixed bin, fixed bin(35)),
  7    45 	iox_$error_output		ptr ext static,
  7    46 	lex_error_		entry options(variable);
  7    47 
  7    48      dcl	brief_error		char(4) varying initial ("") int static,
  7    49 	long_error		char(234) varying int static init(
  7    50 "An internal stack (the reduction stack) has overflowed.
  7    51 The translation has failed.  Contact translator maintenance
  7    52 personnel for assistance.
  7    53      Processing reduction: ^d
  7    54      Reduction being stacked: ^d
  7    55      Maximum stack depth: ^d"),
  7    56 	non_restart_error		char(33) int static init ("Translation cannot be restarted.
  7    57 ");
  7    58 
  7    59 	if STACK_DEPTH >= dimension (STACK, 1) then do;
  7    60 	     call lex_error_ (0, "0"b, 4, 0, null, null, "11"b, long_error, brief_error, NRED, N,
  7    61 			  dimension(STACK,1));
  7    62 get_to_cl:     call cu_$cl();
  7    63 	     call iox_$put_chars (iox_$error_output, addr(non_restart_error), length(non_restart_error), 0);
  7    64 	     go to get_to_cl;
  7    65 	     end;					/* stack overflow is a non-recoverable error.	*/
  7    66 	else
  7    67 	     STACK_DEPTH = STACK_DEPTH + 1;
  7    68 	STACK (STACK_DEPTH) = N;
  7    69 
  7    70 	end PUSH;
  7    71 
  7    72 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  7    73 
  7    74 	/* END OF:	rdc_stack_fcns_.incl.pl1	  *  *  *  *  *  *  */
     1479 
     1480 
     1481 
     1482 RD_ACTION(1):					/* /					*/
     1483 	call 					     Error ( 1 );
     1484 	return;					/* / RETURN	\			*/
     1485 
     1486 RD_ACTION(2):					/* /					*/
     1487 	call					     build_vcb();
     1488 	call 					     LEX ( 2 );
     1489 	NRED = 5;
     1490 	go to RD_TEST_REDUCTION;			/* / Volume \                          		*/
     1491 
     1492 RD_ACTION(3):					/* /					*/
     1493 	call 					     Error ( 2 );
     1494 	return;					/* / RETURN	\			*/
     1495 
     1496 RD_ACTION(4):					/* /					*/
     1497 	return;					/* / RETURN	\			*/
     1498 
     1499 RD_ACTION(5):					/* /					*/
     1500 						     ii = 1;
     1501 						     vcb.volid ( ii ) = token_value;
     1502 	call 					     LEX ( 1 );
     1503 	NRED = 11;
     1504 	go to RD_TEST_REDUCTION;			/* / morevols \                        		*/
     1505 
     1506 RD_ACTION(6):					/* /					*/
     1507 	call 					     Error ( 6 );
     1508 	call					     NEXT_STMT();
     1509 	NRED = 23;
     1510 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1511 
     1512 RD_ACTION(7):					/* /					*/
     1513 	NRED = 160;
     1514 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1515 
     1516 RD_ACTION(8):					/* /					*/
     1517 						     ii = ii +1;
     1518 						     if ii <= hbound ( vcb.volid, 1 ) then vcb.volid ( ii ) = token_value;
     1519 						     else if ii = hbound ( vcb.volid, 1 ) +1 then call Error ( 25 );
     1520 	call 					     LEX ( 1 );
     1521 	NRED = 11;
     1522 	go to RD_TEST_REDUCTION;			/* / morevols \                        		*/
     1523 
     1524 RD_ACTION(9):					/* /					*/
     1525 	call 					     Error ( 6 );
     1526 	call					     NEXT_STMT();
     1527 	NRED = 23;
     1528 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1529 
     1530 RD_ACTION(10):					/* /					*/
     1531 	NRED = 160;
     1532 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1533 
     1534 RD_ACTION(11):					/* /					*/
     1535 	call 					     LEX ( 1 );
     1536 	NRED = 15;
     1537 	go to RD_TEST_REDUCTION;			/* / comment \                         		*/
     1538 
     1539 RD_ACTION(12):					/* /					*/
     1540 	call 					     LEX ( 1 );
     1541 	NRED = 15;
     1542 	go to RD_TEST_REDUCTION;			/* / comment \                         		*/
     1543 
     1544 RD_ACTION(13):					/* /					*/
     1545 	NRED = 19;
     1546 	go to RD_TEST_REDUCTION;			/* / ck_pun \                          		*/
     1547 
     1548 RD_ACTION(14):					/* /					*/
     1549 	NRED = 160;
     1550 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1551 
     1552 RD_ACTION(15):					/* /					*/
     1553 						     vcb.comment ( ii ) = token_value;
     1554 	call 					     LEX ( 1 );
     1555 	NRED = 19;
     1556 	go to RD_TEST_REDUCTION;			/* / ck_pun \                          		*/
     1557 
     1558 RD_ACTION(16):					/* /					*/
     1559 						     vcb.comment ( ii ) = token_value;
     1560 	call 					     LEX ( 1 );
     1561 	NRED = 19;
     1562 	go to RD_TEST_REDUCTION;			/* / ck_pun \                          		*/
     1563 
     1564 RD_ACTION(17):					/* /					*/
     1565 						     vcb.comment ( ii ) = token_value;
     1566 	call 					     LEX ( 1 );
     1567 	NRED = 19;
     1568 	go to RD_TEST_REDUCTION;			/* / ck_pun \                          		*/
     1569 
     1570 RD_ACTION(18):					/* /					*/
     1571 	NRED = 160;
     1572 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1573 
     1574 RD_ACTION(19):					/* /					*/
     1575 						     vcb.nvols = min ( ii, hbound ( vcb.volid, 1 ) );
     1576 	call 					     LEX ( 1 );
     1577 	NRED = 23;
     1578 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1579 
     1580 RD_ACTION(20):					/* /					*/
     1581 	call 					     LEX ( 1 );
     1582 	NRED = 8;
     1583 	go to RD_TEST_REDUCTION;			/* / nextvol \                         		*/
     1584 
     1585 RD_ACTION(21):					/* /					*/
     1586 	call 					     Error ( 5 );
     1587 	call					     NEXT_STMT();
     1588 	NRED = 23;
     1589 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1590 
     1591 RD_ACTION(22):					/* /					*/
     1592 	NRED = 160;
     1593 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1594 
     1595 RD_ACTION(23):					/* /					*/
     1596 	call 					     LEX ( 2 );
     1597 	call 					     build_fcb ( vcb.first_fcb_ptr, current_fcb_ptr );
     1598 						     fcb.file_token_ptr = Ptoken;
     1599 						     if current_default_fcb_ptr ^= null then fcb.default_fcb_ptr = current_default_fcb_ptr;
     1600 	NRED = 120;
     1601 	go to RD_TEST_REDUCTION;			/* / File \                            		*/
     1602 
     1603 RD_ACTION(24):					/* /					*/
     1604 	call					     end_vcb();
     1605 	call 					     LEX ( 2 );
     1606 	NRED = 2;
     1607 	go to RD_TEST_REDUCTION;			/* / newVol \                          		*/
     1608 
     1609 RD_ACTION(25):					/* /					*/
     1610 	call 					     Error ( 4 );
     1611 	call					     end_vcb();
     1612 	NRED = 2;
     1613 	go to RD_TEST_REDUCTION;			/* / newVol \                          		*/
     1614 
     1615 RD_ACTION(26):					/* /					*/
     1616 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1617 	call 					     LEX ( 2 );
     1618 	NRED = 49;
     1619 	go to RD_TEST_REDUCTION;			/* / Tape \                            		*/
     1620 
     1621 RD_ACTION(27):					/* /					*/
     1622 						     if vcb.density ^= 0 then call Error ( 14 );
     1623 	call 					     LEX ( 2 );
     1624 	NRED = 60;
     1625 	go to RD_TEST_REDUCTION;			/* / Density \                         		*/
     1626 
     1627 RD_ACTION(28):					/* /					*/
     1628 	call PUSH(23);				/*   PUSH(global)                                 */
     1629 						     if ^ build_default_fcb then do;
     1630 						     call build_fcb ( vcb.first_default_fcb_ptr, current_default_fcb_ptr );
     1631 						     build_default_fcb = "1"b;
     1632 						     end;
     1633 	NRED = 30;
     1634 	go to RD_TEST_REDUCTION;			/* / gloop \                           		*/
     1635 
     1636 RD_ACTION(29):					/* /					*/
     1637 	NRED = 160;
     1638 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1639 
     1640 RD_ACTION(30):					/* /					*/
     1641 	call 					     LEX ( 2 );
     1642 	NRED = 69;
     1643 	go to RD_TEST_REDUCTION;			/* / Storage \                         		*/
     1644 
     1645 RD_ACTION(31):					/* /					*/
     1646 	call 					     LEX ( 2 );
     1647 	NRED = 74;
     1648 	go to RD_TEST_REDUCTION;			/* / Expires \                         		*/
     1649 
     1650 RD_ACTION(32):					/* /					*/
     1651 	call 					     LEX ( 2 );
     1652 	NRED = 78;
     1653 	go to RD_TEST_REDUCTION;			/* / Mode \                            		*/
     1654 
     1655 RD_ACTION(33):					/* /					*/
     1656 	call 					     LEX ( 2 );
     1657 	NRED = 87;
     1658 	go to RD_TEST_REDUCTION;			/* / Format \                          		*/
     1659 
     1660 RD_ACTION(34):					/* /					*/
     1661 	call 					     LEX ( 2 );
     1662 	NRED = 112;
     1663 	go to RD_TEST_REDUCTION;			/* / Block \                           		*/
     1664 
     1665 RD_ACTION(35):					/* /					*/
     1666 	call 					     LEX ( 2 );
     1667 	NRED = 116;
     1668 	go to RD_TEST_REDUCTION;			/* / Record \                          		*/
     1669 
     1670 RD_ACTION(36):					/* /					*/
     1671 	call 					     Error ( 50 );
     1672 	call					     NEXT_STMT();
     1673 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1674 
     1675 RD_ACTION(37):					/* /					*/
     1676 	call 					     Error ( 50 );
     1677 	call					     NEXT_STMT();
     1678 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1679 
     1680 RD_ACTION(38):					/* /					*/
     1681 	call 					     Error ( 50 );
     1682 	call					     NEXT_STMT();
     1683 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1684 
     1685 RD_ACTION(39):					/* /					*/
     1686 	call 					     Error ( 50 );
     1687 	call					     NEXT_STMT();
     1688 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1689 
     1690 RD_ACTION(40):					/* /					*/
     1691 	call 					     Error ( 50 );
     1692 	call					     NEXT_STMT();
     1693 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1694 
     1695 RD_ACTION(41):					/* /					*/
     1696 	call 					     Error ( 50 );
     1697 	call					     NEXT_STMT();
     1698 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1699 
     1700 RD_ACTION(42):					/* /					*/
     1701 	call 					     Error ( 50 );
     1702 	call					     NEXT_STMT();
     1703 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1704 
     1705 RD_ACTION(43):					/* /					*/
     1706 	call 					     Error ( 50 );
     1707 	call					     NEXT_STMT();
     1708 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1709 
     1710 RD_ACTION(44):					/* /					*/
     1711 	call 					     Error ( 50 );
     1712 	call					     NEXT_STMT();
     1713 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1714 
     1715 RD_ACTION(45):					/* /					*/
     1716 	call 					     Error ( 50 );
     1717 	call					     NEXT_STMT();
     1718 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1719 
     1720 RD_ACTION(46):					/* /					*/
     1721 	call 					     Error ( 50 );
     1722 	call					     NEXT_STMT();
     1723 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1724 
     1725 RD_ACTION(47):					/* /					*/
     1726 	call 					     Error ( 50 );
     1727 	call					     NEXT_STMT();
     1728 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1729 
     1730 RD_ACTION(48):					/* /					*/
     1731 	call 					     Error ( 5 );
     1732 	call					     NEXT_STMT();
     1733 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1734 
     1735 RD_ACTION(49):					/* /					*/
     1736 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1737 						     else vcb.tape_type = 1;
     1738 	call 					     LEX ( 2 );
     1739 	NRED = 23;
     1740 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1741 
     1742 RD_ACTION(50):					/* /					*/
     1743 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1744 						     else vcb.tape_type = 1;
     1745 	call 					     LEX ( 2 );
     1746 	NRED = 23;
     1747 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1748 
     1749 RD_ACTION(51):					/* /					*/
     1750 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1751 						     else vcb.tape_type = 2;
     1752 	call 					     LEX ( 2 );
     1753 	NRED = 23;
     1754 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1755 
     1756 RD_ACTION(52):					/* /					*/
     1757 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1758 						     else vcb.tape_type = 2;
     1759 	call 					     LEX ( 2 );
     1760 	NRED = 23;
     1761 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1762 
     1763 RD_ACTION(53):					/* /					*/
     1764 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1765 						     else vcb.tape_type = 3;
     1766 	call 					     LEX ( 2 );
     1767 	NRED = 23;
     1768 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1769 
     1770 RD_ACTION(54):					/* /					*/
     1771 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1772 						     else vcb.tape_type = 3;
     1773 	call 					     LEX ( 2 );
     1774 	NRED = 23;
     1775 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1776 
     1777 RD_ACTION(55):					/* /					*/
     1778 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1779 						     else vcb.tape_type = 4;
     1780 	call 					     LEX ( 2 );
     1781 	NRED = 23;
     1782 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1783 
     1784 RD_ACTION(56):					/* /					*/
     1785 						     if vcb.tape_type ^= 0 then call Error ( 20 );
     1786 						     else vcb.tape_type = 4;
     1787 	call 					     LEX ( 2 );
     1788 	NRED = 23;
     1789 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1790 
     1791 RD_ACTION(57):					/* /					*/
     1792 	call 					     Error ( 21 );
     1793 	call 					     LEX ( 2 );
     1794 	NRED = 23;
     1795 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1796 
     1797 RD_ACTION(58):					/* /					*/
     1798 	call 					     Error ( 5 );
     1799 	call					     NEXT_STMT();
     1800 	NRED = 23;
     1801 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1802 
     1803 RD_ACTION(59):					/* /					*/
     1804 	NRED = 160;
     1805 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1806 
     1807 RD_ACTION(60):					/* /					*/
     1808 						     if vcb.density ^= 0 then call Error ( 14 );
     1809 						     else vcb.density = 4;
     1810 	call 					     LEX ( 2 );
     1811 	NRED = 23;
     1812 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1813 
     1814 RD_ACTION(61):					/* /					*/
     1815 						     if vcb.density ^= 0 then call Error ( 14 );
     1816 						     else vcb.density = 4;
     1817 	call 					     LEX ( 2 );
     1818 	NRED = 23;
     1819 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1820 
     1821 RD_ACTION(62):					/* /					*/
     1822 						     if vcb.density ^= 0 then call Error ( 14 );
     1823 						     else vcb.density = 3;
     1824 	call 					     LEX ( 2 );
     1825 	NRED = 23;
     1826 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1827 
     1828 RD_ACTION(63):					/* /					*/
     1829 						     if vcb.density ^= 0 then call Error ( 14 );
     1830 						     else vcb.density = 3;
     1831 	call 					     LEX ( 2 );
     1832 	NRED = 23;
     1833 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1834 
     1835 RD_ACTION(64):					/* /					*/
     1836 						     if vcb.density ^= 0 then call Error ( 14 );
     1837 						     else vcb.density = 2;
     1838 	call 					     LEX ( 2 );
     1839 	NRED = 23;
     1840 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1841 
     1842 RD_ACTION(65):					/* /					*/
     1843 						     if vcb.density ^= 0 then call Error ( 14 );
     1844 						     else vcb.density = 2;
     1845 	call 					     LEX ( 2 );
     1846 	NRED = 23;
     1847 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1848 
     1849 RD_ACTION(66):					/* /					*/
     1850 	call 					     Error ( 7 );
     1851 	call 					     LEX ( 2 );
     1852 	NRED = 23;
     1853 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1854 
     1855 RD_ACTION(67):					/* /					*/
     1856 	call 					     Error ( 5 );
     1857 	call					     NEXT_STMT();
     1858 	NRED = 23;
     1859 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     1860 
     1861 RD_ACTION(68):					/* /					*/
     1862 	NRED = 160;
     1863 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1864 
     1865 RD_ACTION(69):					/* /					*/
     1866 						     if fcb.segment.format ^= 0 then call Error ( 33 );
     1867 						     else fcb.segment.format = 1;
     1868 	call 					     LEX ( 2 );
     1869 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1870 
     1871 RD_ACTION(70):					/* /					*/
     1872 						     if fcb.segment.format ^= 0 then call Error ( 33 );
     1873 						     else fcb.segment.format = 2;
     1874 	call 					     LEX ( 2 );
     1875 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1876 
     1877 RD_ACTION(71):					/* /					*/
     1878 	call 					     Error ( 12 );
     1879 	call 					     LEX ( 2 );
     1880 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1881 
     1882 RD_ACTION(72):					/* /					*/
     1883 	call 					     Error ( 5 );
     1884 	call					     NEXT_STMT();
     1885 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1886 
     1887 RD_ACTION(73):					/* /					*/
     1888 	NRED = 160;
     1889 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1890 
     1891 RD_ACTION(74):					/* /					*/
     1892 						     if fcb.tape.expiration ^= ""  then call Error ( 34 );
     1893 						     else fcb.tape.expiration = token_value;
     1894 	call 					     LEX ( 2 );
     1895 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1896 
     1897 RD_ACTION(75):					/* /					*/
     1898 	call 					     Error ( 22 );
     1899 	call 					     LEX ( 2 );
     1900 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1901 
     1902 RD_ACTION(76):					/* /					*/
     1903 	call 					     Error ( 5 );
     1904 	call					     NEXT_STMT();
     1905 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1906 
     1907 RD_ACTION(77):					/* /					*/
     1908 	NRED = 160;
     1909 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1910 
     1911 RD_ACTION(78):					/* /					*/
     1912 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1913 						     else fcb.tape.cmode = 1;
     1914 	call 					     LEX ( 2 );
     1915 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1916 
     1917 RD_ACTION(79):					/* /					*/
     1918 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1919 						     else fcb.tape.cmode = 1;
     1920 	call 					     LEX ( 2 );
     1921 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1922 
     1923 RD_ACTION(80):					/* /					*/
     1924 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1925 						     else fcb.tape.cmode = 2;
     1926 	call 					     LEX ( 2 );
     1927 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1928 
     1929 RD_ACTION(81):					/* /					*/
     1930 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1931 						     else fcb.tape.cmode = 2;
     1932 	call 					     LEX ( 2 );
     1933 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1934 
     1935 RD_ACTION(82):					/* /					*/
     1936 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1937 						     else fcb.tape.cmode = 3;
     1938 	call 					     LEX ( 2 );
     1939 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1940 
     1941 RD_ACTION(83):					/* /					*/
     1942 						     if fcb.tape.cmode ^= 0 then call Error ( 44 );
     1943 						     else fcb.tape.cmode = 3;
     1944 	call 					     LEX ( 2 );
     1945 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1946 
     1947 RD_ACTION(84):					/* /					*/
     1948 	call 					     Error ( 8 );
     1949 	call 					     LEX ( 2 );
     1950 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1951 
     1952 RD_ACTION(85):					/* /					*/
     1953 	call 					     Error ( 5 );
     1954 	call					     NEXT_STMT();
     1955 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1956 
     1957 RD_ACTION(86):					/* /					*/
     1958 	NRED = 160;
     1959 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     1960 
     1961 RD_ACTION(87):					/* /					*/
     1962 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1963 						     else fcb.tape.format = 1;
     1964 	call 					     LEX ( 2 );
     1965 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1966 
     1967 RD_ACTION(88):					/* /					*/
     1968 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1969 						     else fcb.tape.format = 1;
     1970 	call 					     LEX ( 2 );
     1971 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1972 
     1973 RD_ACTION(89):					/* /					*/
     1974 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1975 						     else fcb.tape.format = 2;
     1976 	call 					     LEX ( 2 );
     1977 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1978 
     1979 RD_ACTION(90):					/* /					*/
     1980 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1981 						     else fcb.tape.format = 2;
     1982 	call 					     LEX ( 2 );
     1983 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1984 
     1985 RD_ACTION(91):					/* /					*/
     1986 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1987 						     else fcb.tape.format = 5;
     1988 	call 					     LEX ( 2 );
     1989 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1990 
     1991 RD_ACTION(92):					/* /					*/
     1992 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1993 						     else fcb.tape.format = 5;
     1994 	call 					     LEX ( 2 );
     1995 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     1996 
     1997 RD_ACTION(93):					/* /					*/
     1998 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     1999 						     else fcb.tape.format = 3;
     2000 	call 					     LEX ( 2 );
     2001 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2002 
     2003 RD_ACTION(94):					/* /					*/
     2004 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2005 						     else fcb.tape.format = 3;
     2006 	call 					     LEX ( 2 );
     2007 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2008 
     2009 RD_ACTION(95):					/* /					*/
     2010 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2011 						     else fcb.tape.format = 6;
     2012 	call 					     LEX ( 2 );
     2013 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2014 
     2015 RD_ACTION(96):					/* /					*/
     2016 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2017 						     else fcb.tape.format = 6;
     2018 	call 					     LEX ( 2 );
     2019 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2020 
     2021 RD_ACTION(97):					/* /					*/
     2022 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2023 						     else fcb.tape.format = 8;
     2024 	call 					     LEX ( 2 );
     2025 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2026 
     2027 RD_ACTION(98):					/* /					*/
     2028 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2029 						     else fcb.tape.format = 8;
     2030 	call 					     LEX ( 2 );
     2031 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2032 
     2033 RD_ACTION(99):					/* /					*/
     2034 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2035 						     else fcb.tape.format = 9;
     2036 	call 					     LEX ( 2 );
     2037 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2038 
     2039 RD_ACTION(100):					/* /					*/
     2040 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2041 						     else fcb.tape.format = 9;
     2042 	call 					     LEX ( 2 );
     2043 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2044 
     2045 RD_ACTION(101):					/* /					*/
     2046 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2047 						     else fcb.tape.format = 4;
     2048 	call 					     LEX ( 2 );
     2049 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2050 
     2051 RD_ACTION(102):					/* /					*/
     2052 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2053 						     else fcb.tape.format = 4;
     2054 	call 					     LEX ( 2 );
     2055 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2056 
     2057 RD_ACTION(103):					/* /					*/
     2058 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2059 						     else fcb.tape.format = 7;
     2060 	call 					     LEX ( 2 );
     2061 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2062 
     2063 RD_ACTION(104):					/* /					*/
     2064 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2065 						     else fcb.tape.format = 7;
     2066 	call 					     LEX ( 2 );
     2067 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2068 
     2069 RD_ACTION(105):					/* /					*/
     2070 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2071 						     else fcb.tape.format = 10;
     2072 	call 					     LEX ( 2 );
     2073 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2074 
     2075 RD_ACTION(106):					/* /					*/
     2076 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2077 						     else fcb.tape.format = 10;
     2078 	call 					     LEX ( 2 );
     2079 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2080 
     2081 RD_ACTION(107):					/* /					*/
     2082 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2083 						     else fcb.tape.format = 11;
     2084 	call 					     LEX ( 2 );
     2085 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2086 
     2087 RD_ACTION(108):					/* /					*/
     2088 						     if fcb.tape.format ^= 0 then call Error ( 45 );
     2089 						     else fcb.tape.format = 11;
     2090 	call 					     LEX ( 2 );
     2091 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2092 
     2093 RD_ACTION(109):					/* /					*/
     2094 	call 					     Error ( 9 );
     2095 	call 					     LEX ( 2 );
     2096 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2097 
     2098 RD_ACTION(110):					/* /					*/
     2099 	call 					     Error ( 5 );
     2100 	call					     NEXT_STMT();
     2101 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2102 
     2103 RD_ACTION(111):					/* /					*/
     2104 	NRED = 160;
     2105 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2106 
     2107 RD_ACTION(112):					/* /					*/
     2108 						     if fcb.tape.blklen ^= 0 then call Error ( 46 );
     2109 						     else fcb.tape.blklen = token.Nvalue;
     2110 	call 					     LEX ( 2 );
     2111 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2112 
     2113 RD_ACTION(113):					/* /					*/
     2114 	call 					     Error ( 10 );
     2115 	call 					     LEX ( 2 );
     2116 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2117 
     2118 RD_ACTION(114):					/* /					*/
     2119 	call 					     Error ( 5 );
     2120 	call					     NEXT_STMT();
     2121 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2122 
     2123 RD_ACTION(115):					/* /					*/
     2124 	NRED = 160;
     2125 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2126 
     2127 RD_ACTION(116):					/* /					*/
     2128 						     if fcb.tape.reclen ^= 0 then call Error ( 47 );
     2129 						     else fcb.tape.reclen = token.Nvalue;
     2130 	call 					     LEX ( 2 );
     2131 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2132 
     2133 RD_ACTION(117):					/* /					*/
     2134 	call 					     Error ( 11 );
     2135 	call 					     LEX ( 2 );
     2136 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2137 
     2138 RD_ACTION(118):					/* /					*/
     2139 	call 					     Error ( 5 );
     2140 	call					     NEXT_STMT();
     2141 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2142 
     2143 RD_ACTION(119):					/* /					*/
     2144 	NRED = 160;
     2145 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2146 
     2147 RD_ACTION(120):					/* /					*/
     2148 						     fcb.tape.file_id = token_value;
     2149 						     build_default_fcb = "0"b;
     2150 	call 					     LEX ( 2 );
     2151 	NRED = 124;
     2152 	go to RD_TEST_REDUCTION;			/* / local \                           		*/
     2153 
     2154 RD_ACTION(121):					/* /					*/
     2155 	call 					     Error ( 37 );
     2156 	call 					     LEX ( 2 );
     2157 	NRED = 124;
     2158 	go to RD_TEST_REDUCTION;			/* / local \                           		*/
     2159 
     2160 RD_ACTION(122):					/* /					*/
     2161 	call 					     Error ( 5 );
     2162 	call					     NEXT_STMT();
     2163 	NRED = 124;
     2164 	go to RD_TEST_REDUCTION;			/* / local \                           		*/
     2165 
     2166 RD_ACTION(123):					/* /					*/
     2167 	NRED = 160;
     2168 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2169 
     2170 RD_ACTION(124):					/* /					*/
     2171 	call PUSH(124);				/*   PUSH(local)                                  */
     2172 	NRED = 126;
     2173 	go to RD_TEST_REDUCTION;			/* / lloop \                           		*/
     2174 
     2175 RD_ACTION(125):					/* /					*/
     2176 	NRED = 160;
     2177 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2178 
     2179 RD_ACTION(126):					/* /					*/
     2180 	call 					     LEX ( 2 );
     2181 	NRED = 149;
     2182 	go to RD_TEST_REDUCTION;			/* / path \                            		*/
     2183 
     2184 RD_ACTION(127):					/* /					*/
     2185 	call 					     LEX ( 2 );
     2186 	NRED = 78;
     2187 	go to RD_TEST_REDUCTION;			/* / Mode \                            		*/
     2188 
     2189 RD_ACTION(128):					/* /					*/
     2190 	call 					     LEX ( 2 );
     2191 	NRED = 69;
     2192 	go to RD_TEST_REDUCTION;			/* / Storage \                         		*/
     2193 
     2194 RD_ACTION(129):					/* /					*/
     2195 	call 					     LEX ( 2 );
     2196 	NRED = 74;
     2197 	go to RD_TEST_REDUCTION;			/* / Expires \                         		*/
     2198 
     2199 RD_ACTION(130):					/* /					*/
     2200 	call 					     LEX ( 2 );
     2201 	NRED = 153;
     2202 	go to RD_TEST_REDUCTION;			/* / number \                          		*/
     2203 
     2204 RD_ACTION(131):					/* /					*/
     2205 	call 					     LEX ( 2 );
     2206 	NRED = 157;
     2207 	go to RD_TEST_REDUCTION;			/* / replace \                         		*/
     2208 
     2209 RD_ACTION(132):					/* /					*/
     2210 	call 					     LEX ( 2 );
     2211 	NRED = 87;
     2212 	go to RD_TEST_REDUCTION;			/* / Format \                          		*/
     2213 
     2214 RD_ACTION(133):					/* /					*/
     2215 	call 					     LEX ( 2 );
     2216 	NRED = 112;
     2217 	go to RD_TEST_REDUCTION;			/* / Block \                           		*/
     2218 
     2219 RD_ACTION(134):					/* /					*/
     2220 	call 					     LEX ( 2 );
     2221 	NRED = 116;
     2222 	go to RD_TEST_REDUCTION;			/* / Record \                          		*/
     2223 
     2224 RD_ACTION(135):					/* /					*/
     2225 						     if fcb.tape.output_mode ^= 0 then call Error ( 38 );
     2226 						     else fcb.tape.output_mode = 2;
     2227 	call 					     LEX ( 2 );
     2228 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2229 
     2230 RD_ACTION(136):					/* /					*/
     2231 						     if fcb.tape.output_mode ^= 0 then call Error ( 38 );
     2232 						     else fcb.tape.output_mode = 3;
     2233 	call 					     LEX ( 2 );
     2234 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2235 
     2236 RD_ACTION(137):					/* /					*/
     2237 						     if fcb.tape.output_mode ^= 0 then call Error ( 38 );
     2238 						     else fcb.tape.output_mode = 1;
     2239 	call 					     LEX ( 2 );
     2240 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2241 
     2242 RD_ACTION(138):					/* /					*/
     2243 						     if fcb.segment.extend ^= 0 then call Error ( 27 );
     2244 						     fcb.segment.extend = 2;
     2245 	call 					     LEX ( 2 );
     2246 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2247 
     2248 RD_ACTION(139):					/* /					*/
     2249 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2250 	NRED = 23;
     2251 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2252 
     2253 RD_ACTION(140):					/* /					*/
     2254 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2255 	NRED = 23;
     2256 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2257 
     2258 RD_ACTION(141):					/* /					*/
     2259 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2260 	NRED = 23;
     2261 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2262 
     2263 RD_ACTION(142):					/* /					*/
     2264 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2265 	NRED = 23;
     2266 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2267 
     2268 RD_ACTION(143):					/* /					*/
     2269 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2270 	NRED = 23;
     2271 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2272 
     2273 RD_ACTION(144):					/* /					*/
     2274 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2275 	NRED = 23;
     2276 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2277 
     2278 RD_ACTION(145):					/* /					*/
     2279 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2280 	NRED = 23;
     2281 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2282 
     2283 RD_ACTION(146):					/* /					*/
     2284 	STACK_DEPTH = max(STACK_DEPTH-1,0);		/*   POP					*/
     2285 	NRED = 23;
     2286 	go to RD_TEST_REDUCTION;			/* / global \                          		*/
     2287 
     2288 RD_ACTION(147):					/* /					*/
     2289 	call 					     Error ( 5 );
     2290 	call					     NEXT_STMT();
     2291 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2292 
     2293 RD_ACTION(148):					/* /					*/
     2294 	NRED = 160;
     2295 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2296 
     2297 RD_ACTION(149):					/* /					*/
     2298 						     if fcb.segment.ename ^= ""  then call Error ( 23 );
     2299 						     fcb.segment.dirname = dirname;
     2300 						     fcb.segment.ename = ename;
     2301 	call 					     LEX ( 2 );
     2302 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2303 
     2304 RD_ACTION(150):					/* /					*/
     2305 	call 					     Error ( 13 );
     2306 	call 					     LEX ( 2 );
     2307 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2308 
     2309 RD_ACTION(151):					/* /					*/
     2310 	call 					     Error ( 5 );
     2311 	call					     NEXT_STMT();
     2312 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2313 
     2314 RD_ACTION(152):					/* /					*/
     2315 	NRED = 160;
     2316 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2317 
     2318 RD_ACTION(153):					/* /					*/
     2319 						     if fcb.tape.sequence ^= 0 then call Error ( 51 );
     2320 						     else fcb.tape.sequence = token.Nvalue;
     2321 	call 					     LEX ( 2 );
     2322 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2323 
     2324 RD_ACTION(154):					/* /					*/
     2325 	call 					     Error ( 48 );
     2326 	call 					     LEX ( 2 );
     2327 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2328 
     2329 RD_ACTION(155):					/* /					*/
     2330 	call 					     Error ( 5 );
     2331 	call					     NEXT_STMT();
     2332 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2333 
     2334 RD_ACTION(156):					/* /					*/
     2335 	NRED = 160;
     2336 	go to RD_TEST_REDUCTION;			/* / notoken \                         		*/
     2337 
     2338 RD_ACTION(157):					/* /					*/
     2339 						     if fcb.tape.output_mode ^= 0 then call Error ( 38 );
     2340 						     else fcb.tape.output_mode = 4;
     2341 						     fcb.tape.replace_id = token_value;
     2342 	call 					     LEX ( 2 );
     2343 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2344 
     2345 RD_ACTION(158):					/* /					*/
     2346 	call 					     Error ( 37 );
     2347 	call 					     LEX ( 2 );
     2348 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2349 
     2350 RD_ACTION(159):					/* /					*/
     2351 	call 					     Error ( 5 );
     2352 	call					     NEXT_STMT();
     2353 	go to RD_STACK_POP;				/* / STACK_POP	\			*/
     2354 
     2355 RD_ACTION(160):					/* /					*/
     2356 	call 					     Error ( 3 );
     2357 	return;					/* / RETURN	\			*/
     2358 
     2359 
     2360 	end SEMANTIC_ANALYSIS;
     2361 
     2362 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
     2363 
     2364      dcl	SPDL			bit(1) aligned init ("0"b);
     2365 						/* off: This compiler parses a non-PUSH DOWN	*/
     2366 						/*      LANGUAGE.				*/
     2367 	/* START OF:	rdc_lex_.incl.pl1			  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  8     2 
  8     3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  8     4 	/*									*/
  8     5 	/* N__a_m_e:  rdc_lex_.incl.pl1							*/
  8     6 	/*									*/
  8     7 	/*      This include segment is used by compilers generated by the reduction_compiler.	*/
  8     8 	/* It contains the LEX subroutine which is used to manipulate the pointer to the	*/
  8     9 	/* "current" token, Pthis_token.						*/
  8    10 	/*									*/
  8    11 	/* E__n_t_r_y:  LEX								*/
  8    12 	/*									*/
  8    13 	/*      This entry makes the |_nth|-next (or -preceding) token the "current" token, where	*/
  8    14 	/* _n is its positive (or negative) input argument.				*/
  8    15 	/*									*/
  8    16 	/* U__s_a_g_e									*/
  8    17 	/*									*/
  8    18 	/*      call LEX(n);							*/
  8    19 	/*									*/
  8    20 	/* 1) n   is the number of the token to be made the "current" token, relative to the	*/
  8    21 	/*        token identified by Pthis_token (the present "current" token).  If n is	*/
  8    22 	/*        positive, the nth token following the "current" token made "current".  If n	*/
  8    23 	/*        is negative, the nth token preceding the "current" token is made "current".	*/
  8    24 	/*									*/
  8    25 	/* S__t_a_t_u_s									*/
  8    26 	/*									*/
  8    27 	/* 0) Created by:  G. C. Dixon  in  February, 1975				*/
  8    28 	/*									*/
  8    29 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
  8    30 
  8    31 LEX:	procedure (n);
  8    32 
  8    33      dcl	n			fixed bin,
  8    34 	i			fixed bin;
  8    35 
  8    36 	Ptoken = Pthis_token;			/* do everything relative to "current" token.	*/
  8    37 	if Ptoken = null then return;			/* can't lex if token list exhausted.		*/
  8    38 	if n >= 0 then do;				/* new "current" token will follow present one.	*/
  8    39 	     do i = 1 to n while (token.Pnext ^= null);	/* find new "current" token, taking care not to	*/
  8    40 		Ptoken = token.Pnext;		/*   run off end of token list.		*/
  8    41 		end;
  8    42 	     if ^SPDL then if i <= n then Ptoken = null;	/* if not in 'PUSH DOWN LANGUAGE' mode, allow	*/
  8    43 						/*   running off end of token list.		*/
  8    44 	     end;
  8    45 	else					/* new "current" token precedes present one.	*/
  8    46 	     do i = -1 to n by -1 while (token.Plast ^= null);
  8    47 		Ptoken = token.Plast;
  8    48 		end;
  8    49 	Pthis_token = Ptoken;			/* simple wasn't it.			*/
  8    50 
  8    51 	end LEX;
  8    52 
  8    53 /* END OF:	rdc_lex_.incl.pl1			  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
     2367 
     2368 
     2369 		/* START OF:	rdc_next_stmt_.incl.pl1	  *  *  *  *  *  *  */
  9     2 
  9     3 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  9     4 	/*							*/
  9     5 	/* N__a_m_e:  rdc_next_stmt_.incl.pl1				*/
  9     6 	/*							*/
  9     7 	/*      This include segment is used by compilers generated by the	*/
  9     8 	/* reduction_compiler.  It includes a procedure which shifts the	*/
  9     9 	/* compilation process to the next source statement.		*/
  9    10 	/*							*/
  9    11 	/* S__t_a_t_u_s							*/
  9    12 	/*							*/
  9    13 	/* 0) Created:  April, 1974 by G. C. Dixon			*/
  9    14 	/*							*/
  9    15 	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  9    16 
  9    17 
  9    18 NEXT_STMT:	procedure;			/* invoked to begin parsing the next statement of	*/
  9    19 						/* the input tokens.			*/
  9    20 
  9    21      dcl	null			builtin,
  9    22 	Ssearching		bit(1) aligned;
  9    23 
  9    24 	Ptoken = Pthis_token;			/* make sure these pointers are the same.	*/
  9    25 	Pstmt = token.Pstmt;			/* address "current" statement's descriptor.	*/
  9    26 	Ssearching = "1"b;				/* start scanning forward for next statement.	*/
  9    27 	do while (Ssearching & token.Pnext ^= null);
  9    28 	     Ptoken = token.Pnext;
  9    29 	     if token.Pstmt = Pstmt then;
  9    30 	     else Ssearching = "0"b;
  9    31 	     end;
  9    32 	if token.Pstmt = Pstmt then			/* if there is no next statement, and		*/
  9    33 	     if SPDL then				/*   in PUSH DOWN LANGUAGE mode, can't run off	*/
  9    34 		Ptoken = Ptoken;			/*   end of input list.			*/
  9    35 	     else Ptoken, Pthis_token = null;		/*   otherwise, input list exhausted.		*/
  9    36 	else Pthis_token = Ptoken;			/* normally, next statement exists and Ptoken	*/
  9    37 						/*   points to its 1st _n_o_n-__d_e_l_e_t_e_d token.	*/
  9    38 
  9    39 	end NEXT_STMT;
  9    40 
  9    41 	/* END OF:	rdc_next_stmt_.incl.pl1	  *  *  *  *  *  *  */
     2369 
     2370 
     2371 	end tape_io;
	SOURCE FILES USED IN THIS COMPILATION.

LINE      NUMBER  DATE MODIFIED     NAME			PATHNAME
             0    03/17/86  1448.7  tape_io.pl1                       >spec>install>1032>tape_io.pl1
1204         1    06/10/82  1045.3  tape_io_data.incl.pl1             >ldd>include>tape_io_data.incl.pl1
1206         2    06/11/76  1043.4  area_info.incl.pl1                >ldd>include>area_info.incl.pl1
1208         3    06/10/82  1045.3  tape_io_errors.incl.pl1           >ldd>include>tape_io_errors.incl.pl1
1214         4    04/18/75  1242.4  rdc_start_.incl.pl1               >ldd>include>rdc_start_.incl.pl1
4-25         5    04/18/75  1242.4  lex_descriptors_.incl.pl1         >ldd>include>lex_descriptors_.incl.pl1
1449         6    03/17/86  1404.9  rdc_end_.incl.pl1                 >spec>install>1032>rdc_end_.incl.pl1
1479         7    04/18/75  1242.4  rdc_stack_fcns_.incl.pl1          >ldd>include>rdc_stack_fcns_.incl.pl1
2367         8    04/18/75  1242.4  rdc_lex_.incl.pl1                 >ldd>include>rdc_lex_.incl.pl1
2369         9    04/18/75  1242.4  rdc_next_stmt_.incl.pl1           >ldd>include>rdc_next_stmt_.incl.pl1
	NAMES DECLARED IN THIS COMPILATION.

IDENTIFIER	     OFFSET    LOC STORAGE CLASS   DATA TYPE		ATTRIBUTES AND REFERENCES
								(* indicates a set context)

NAMES DECLARED BY DECLARE STATEMENT.
ANSI                                   constant        fixed bin(17,0)          initial dcl 616 ref 1001 1049 1098 1180
BACKSPACE                       024260 constant        char(1)                  initial dcl 4-99 ref 6-113
CODE                            000535 automatic       fixed bin(35,0)          dcl 4-33 set ref 6-106* 6-107
DEFAULT_DENSITY                 013670 constant        fixed bin(17,0)          initial array dcl 618 ref 1003
DIRECTION                       000540 automatic       fixed bin(17,0)          initial dcl 1216 set ref 6-62 1216*
EMPTY_FCB                       000000 constant        structure                level 1 dcl 624 ref 1027
EMPTY_VCB                       000122 constant        structure                level 1 dcl 646 ref 994
FORM                                   based           fixed bin(17,0)          level 2 packed unaligned dcl 4-48 ref 6-65 6-70
                                                                                  6-123
I                               000536 automatic       fixed bin(17,0)          dcl 4-33 in procedure "SEMANTIC_ANALYSIS" set ref
                                                                                  6-62* 6-63 6-79*
I                                      based           fixed bin(17,0)          level 2 in structure "TOKEN_REQD_STRING" packed
                                                                                  unaligned dcl 4-48 in procedure
                                                                                  "SEMANTIC_ANALYSIS" ref 6-126
IBMNL                                  constant        fixed bin(17,0)          initial dcl 617 ref 1108
IFIRST                                 based           fixed bin(17,0)          level 3 packed unaligned dcl 4-48 ref 6-62 6-73 6-79
                                                                                  6-79
ILAST                     0(18)        based           fixed bin(17,0)          level 3 packed unaligned dcl 4-48 ref 6-62 6-73 6-79
L                         0(18)        based           fixed bin(17,0)          level 2 packed unaligned dcl 4-48 ref 6-127
LTOKEN_REQD_VALUE               000524 automatic       fixed bin(18,0)          dcl 4-33 set ref 6-127* 6-128
Lvalue                    4            based           fixed bin(18,0)          level 2 dcl 5-68 ref 931 931 941 942 948 952 952 961
                                                                                  961 967 967 976 977 983 983 6-92 6-92 6-92 6-92
                                                                                  6-106 6-106 6-113 6-113 6-128 1501 1518 1552 1558
                                                                                  1564 1893 2147 2341
N                                      parameter       fixed bin(17,0)          dcl 7-38 set ref 7-36 7-60* 7-68
NRED                            000525 automatic       fixed bin(17,0)          dcl 4-33 set ref 6-52* 6-55* 6-55 6-58 1477 7-18*
                                                                                  7-26* 1489* 1503* 1509* 1512* 1521* 1527* 1530*
                                                                                  1536* 1541* 1544* 1548* 1555* 1561* 1567* 1570*
                                                                                  1577* 1582* 1588* 1591* 1600* 1606* 1612* 1618*
                                                                                  1624* 1633* 1636* 1642* 1647* 1652* 1657* 1662*
                                                                                  1667* 1739* 1746* 1753* 1760* 1767* 1774* 1781*
                                                                                  1788* 1794* 1800* 1803* 1811* 1818* 1825* 1832*
                                                                                  1839* 1846* 1852* 1858* 1861* 1887* 1907* 1957*
                                                                                  2103* 2123* 2143* 2151* 2157* 2163* 2166* 2172*
                                                                                  2175* 2181* 2186* 2191* 2196* 2201* 2206* 2211*
                                                                                  2216* 2221* 2250* 2255* 2260* 2265* 2270* 2275*
                                                                                  2280* 2285* 2293* 2314* 2334* 7-60*
NUMBER                          000537 automatic       fixed bin(35,0)          dcl 4-33 set ref 6-106* 6-108
Nvalue                   10            based           fixed bin(35,0)          level 3 packed unaligned dcl 5-68 set ref 931* 933
                                                                                  934 949* 952* 954 955 967* 969 970 6-101 6-108*
                                                                                  2109 2129 2320
PRED                            000526 automatic       pointer                  dcl 4-33 set ref 6-58* 6-62 6-62 6-73 6-73 6-79 6-79
                                                                                  6-79
PTOKEN_REQD                     000530 automatic       pointer                  dcl 4-33 set ref 6-63* 6-65 6-65 6-70 6-71 6-123
                                                                                  6-126 6-127 1452
PTOKEN_REQD_VALUE               000532 automatic       pointer                  dcl 4-33 set ref 6-126* 6-128
Plast                     2            based           pointer                  level 2 packed unaligned dcl 5-68 ref 8-45 8-47
Pnext                     1            based           pointer                  level 2 packed unaligned dcl 5-68 ref 6-79 1473 8-39
                                                                                  8-40 9-27 9-28
Pstmt                     5            based           pointer                  level 2 in structure "token" packed unaligned
                                                                                  dcl 5-68 in procedure "tape_io" ref 918 9-25 9-29
                                                                                  9-32
Pstmt                           000362 automatic       pointer                  dcl 5-40 in procedure "tape_io" set ref 868* 9-25*
                                                                                  9-29 9-32
Pthis_token                     000360 automatic       pointer                  dcl 4-23 set ref 868* 874 6-60 1476 8-36 8-49* 9-24
                                                                                  9-35* 9-36*
Ptoken                          000364 automatic       pointer                  dcl 5-68 set ref 917 918 931 931 931 931 933 934 941
                                                                                  942 948 948 949 952 952 952 952 954 955 961 961
                                                                                  961 967 967 967 967 969 970 976 977 983 983 983
                                                                                  1006* 1090* 6-60* 6-64 6-73 6-79 6-86 6-92 6-92
                                                                                  6-92 6-92 6-92 6-92 6-92 6-101 6-104 6-106 6-106
                                                                                  6-106 6-108 6-113 6-113 6-113 6-113 6-118 6-124
                                                                                  6-128 6-128 1473* 1473 1476* 1501 1501 1518 1518
                                                                                  1552 1552 1558 1558 1564 1564 1598 1893 1893 2109
                                                                                  2129 2147 2147 2320 2341 2341 8-36* 8-37 8-39
                                                                                  8-40* 8-40 8-42* 8-45 8-47* 8-47 8-49 9-24* 9-25
                                                                                  9-27 9-28* 9-28 9-29 9-32 9-32* 9-32 9-35* 9-36
Pvalue                    3            based           pointer                  level 2 packed unaligned dcl 5-68 ref 931 948 952
                                                                                  961 967 983 6-92 6-92 6-106 6-113 6-128 1501 1518
                                                                                  1552 1558 1564 1893 2147 2341
RED                                    based           structure                level 1 dcl 4-48
REDUCTION                              based           structure                array level 1 packed unaligned dcl 1221 set ref 6-58
REDUCTIONS                      013373 constant        fixed bin(17,0)          initial array unaligned dcl 1221 set ref 6-58
S                        11            based           structure                level 3 packed unaligned dcl 5-68
SERROR_CONTROL                  013742 constant        bit(2)                   initial unaligned dcl 619 set ref 919*
SPDL                            000366 automatic       bit(1)                   initial dcl 2364 set ref 2364* 6-73 8-42 9-32
STACK                           000541 automatic       fixed bin(17,0)          array dcl 1217 set ref 7-18 7-26 7-59 7-60 7-60
                                                                                  7-68*
STACK_DEPTH                     000553 automatic       fixed bin(17,0)          initial dcl 1217 set ref 7-17 7-18 7-24 7-26 7-27*
                                                                                  7-27 1217* 2248* 2248 2253* 2253 2258* 2258 2263*
                                                                                  2263 2268* 2268 2273* 2273 2278* 2278 2283* 2283
                                                                                  7-59 7-66* 7-66 7-68
STOKEN_FCN                      000534 automatic       bit(1)                   dcl 4-33 set ref 1454* 1456* 1458* 1460* 1462* 1464*
                                                                                  1466* 1469
Ssearching                      000626 automatic       bit(1)                   dcl 9-21 set ref 9-26* 9-27 9-30*
TOKEN_REQD                             based           structure                level 2 in structure "RED" packed unaligned dcl 4-48
                                                                                  in procedure "SEMANTIC_ANALYSIS"
TOKEN_REQD                             based           structure                level 1 dcl 4-48 in procedure "SEMANTIC_ANALYSIS"
TOKEN_REQD_STRING                      based           structure                level 1 dcl 4-48
TOKEN_REQD_VALUE                       based           char                     unaligned dcl 4-48 ref 6-128
TOKEN_REQUIREMENT                      based           structure                array level 1 packed unaligned dcl 1389 set ref 6-63
TOKEN_REQUIREMENTS              013132 constant        fixed bin(17,0)          initial array unaligned dcl 1389 set ref 6-63
TOKEN_STRINGS                          based           char(304)                dcl 1441 set ref 6-126
TOKEN_STRING_ARRAYS             012766 constant        char(100)                initial array dcl 1441 set ref 6-126
TRACING                         000215 internal static bit(1)                   initial dcl 1211 set ref 6-50* 6-50
TYPE                      0(18)        based           fixed bin(17,0)          level 2 packed unaligned dcl 4-48 ref 6-65 6-71 1452
USAGE_MESSAGE                   013633 constant        char(115)                initial unaligned dcl 620 set ref 782*
aL                              000226 automatic       fixed bin(17,0)          dcl 672 set ref 786* 787 787 790 790 827* 828 828
                                                                                  830 830 833 833 837* 838 838 842 842 844 847 847
aP                              000230 automatic       pointer                  dcl 673 set ref 786* 787 790 827* 828 828 830 830
                                                                                  833 837* 838 842 842 844 847
active_fnc_err_                 000342 constant        entry                    external dcl 720 ref 774
addr                                                   builtin function         dcl 4-92 in procedure "SEMANTIC_ANALYSIS" ref 6-58
                                                                                  6-58 6-63 6-63 6-126 6-126
addr                                                   builtin function         dcl 711 in procedure "tape_io" ref 756 812 812
addr                                                   builtin function         dcl 7-40 in procedure "PUSH" ref 7-63 7-63
ai                              000202 automatic       structure                level 1 dcl 670 set ref 804* 812 812
area_control                           based           structure                level 1 dcl 2-20
area_info                              based           structure                level 1 dcl 2-7
area_info_version_1                    constant        fixed bin(17,0)          initial dcl 2-3 ref 805 810
areap                    16     000202 automatic       pointer                  level 2 dcl 670 set ref 811* 817
arg                                    based           char                     unaligned dcl 696 set ref 787* 790* 828 828 830 830
                                                                                  833* 838* 842 842 844 847*
arg_num                         000232 automatic       fixed bin(17,0)          dcl 674 set ref 826* 826* 827* 831* 831 832 837* 850
bc                              000236 automatic       fixed bin(24,0)          dcl 676 set ref 796* 868 868
blklen                  117            based           fixed bin(17,0)          level 3 dcl 1-19 set ref 1039 1039* 1039 1055 1055*
                                                                                  1067 1067* 1101 1101 1105 1130 1133 1153 1155*
                                                                                  1158 1162 1165* 1168 1171* 1175 1184 1187* 1190
                                                                                  1193* 2107 2109*
breaks                          000010 internal static varying char(128)        dcl 660 set ref 853* 854* 854 855* 855 862* 868*
brief_error                     000216 internal static varying char(4)          initial dcl 7-48 set ref 7-60*
brief_message           102     003135 constant        varying char(4)          initial array level 2 dcl 3-3 set ref 919*
build_default_fcb               000343 automatic       bit(1)                   initial dcl 692 set ref 692* 1629 1631* 2149*
ck                       74            based           bit(1)                   level 3 dcl 1-5 set ref 764* 828* 891
cleanup                         000344 stack reference condition                dcl 715 ref 794
clk_val                         000234 automatic       fixed bin(71,0)          dcl 675 set ref 983*
cmode                    75            based           fixed bin(17,0)          level 3 dcl 1-19 set ref 1042 1042* 1042 1050 1050*
                                                                                  1062 1062* 1911 1913* 1917 1919* 1923 1925* 1929
                                                                                  1931* 1935 1937* 1941 1943*
code                            000237 automatic       fixed bin(35,0)          dcl 677 set ref 770* 771 771* 773 778* 787* 789 790*
                                                                                  796* 800* 812* 813 814* 818* 819 819* 822* 838*
                                                                                  839 868* 872 872* 904* 906* 931* 932 952* 953 961*
                                                                                  962 967* 968 983* 984
collate                                                builtin function         dcl 711 ref 853 855 856 857 858
com_err_                        000344 constant        entry                    external dcl 721 ref 778 782 790 800 814 822 833 847
                                                                                  872 875 885
comment                1011            based           char(64)                 array level 2 dcl 1-45 set ref 1552* 1558* 1564*
control                  74            based           structure                level 2 in structure "tape_io_data" dcl 1-5
                                                                                  in procedure "tape_io"
control                   1     000202 automatic       structure                level 2 in structure "ai" dcl 670 in procedure
                                                                                  "tape_io"
convert_date_to_binary_         000346 constant        entry                    external dcl 722 ref 983
cu_$af_arg_count                000350 constant        entry                    external dcl 723 ref 770
cu_$arg_ptr                     000352 constant        entry                    external dcl 724 ref 786 827 837
cu_$cl                          000414 constant        entry                    external dcl 7-43 ref 7-62
current_default_fcb_ptr         000240 automatic       pointer                  initial dcl 678 set ref 678* 1599 1599 1630*
current_fcb_ptr                 000242 automatic       pointer                  initial dcl 679 set ref 679* 1597*
cv_dec_check_                   000354 constant        entry                    external dcl 725 in procedure "tape_io" ref 838 931
                                                                                  952 967
cv_dec_check_                   000412 constant        entry                    external dcl 4-96 in procedure "SEMANTIC_ANALYSIS"
                                                                                  ref 6-106
default_fcb_ptr           6            based           pointer                  level 2 dcl 1-19 set ref 1038 1599*
define_area_                    000370 constant        entry                    external dcl 731 ref 812
density                3012            based           fixed bin(17,0)          level 2 dcl 1-45 set ref 1003 1003* 1621 1807 1809*
                                                                                  1814 1816* 1821 1823* 1828 1830* 1835 1837* 1842
                                                                                  1844*
dfcbp                           000244 automatic       pointer                  dcl 680 set ref 1038* 1038* 1039 1040 1041 1042 1043
                                                                                  1044* 1045
dimension                                              builtin function         dcl 711 in procedure "tape_io" ref 689
dimension                                              builtin function         dcl 7-40 in procedure "PUSH" ref 7-59 7-60 7-60
dirname                         000246 automatic       char(168)                unaligned dcl 681 in procedure "tape_io" set ref
                                                                                  961* 2299
dirname                  10            based           char(168)                level 3 in structure "fcb" dcl 1-19 in procedure
                                                                                  "tape_io" set ref 1091 2299*
dirname                  10            based           char(168)                level 3 in structure "tape_io_data" packed unaligned
                                                                                  dcl 1-5 in procedure "tape_io" set ref 761* 787*
                                                                                  796* 800* 800
divide                                                 builtin function         dcl 711 ref 868 868
en                                     parameter       fixed bin(17,0)          dcl 914 set ref 912 919 919* 919 919 919 919
ename                           000320 automatic       char(32)                 unaligned dcl 682 in procedure "tape_io" set ref
                                                                                  961* 2300
ename                    62            based           char(32)                 level 3 in structure "fcb" dcl 1-19 in procedure
                                                                                  "tape_io" set ref 1091 2297 2300*
ename                    62            based           char(32)                 level 3 in structure "tape_io_data" packed unaligned
                                                                                  dcl 1-5 in procedure "tape_io" set ref 762* 787*
                                                                                  796* 800*
error_control_table             003135 constant        structure                array level 1 dcl 3-3 set ref 689
error_count                     000330 automatic       fixed bin(17,0)          dcl 683 set ref 851* 893* 924* 924
error_table_$active_function    000330 external static fixed bin(35,0)          dcl 702 set ref 774*
error_table_$badopt             000332 external static fixed bin(35,0)          dcl 703 set ref 847*
error_table_$noarg              000334 external static fixed bin(35,0)          dcl 704 set ref 782* 833*
error_table_$not_act_fnc        000336 external static fixed bin(35,0)          dcl 705 ref 771
error_table_$translation_failed 000340 external static fixed bin(35,0)          dcl 706 set ref 875* 885*
expand_pathname_                000356 constant        entry                    external dcl 726 ref 961
expand_pathname_$add_suffix     000360 constant        entry                    external dcl 727 ref 787
expiration              112            based           char(16)                 level 3 dcl 1-19 set ref 1043 1043* 1043 1119 1138
                                                                                  1891 1893*
extend                    1     000202 automatic       bit(1)                   level 3 in structure "ai" packed unaligned dcl 670
                                                                                  in procedure "tape_io" set ref 806*
extend                   73            based           fixed bin(17,0)          level 3 in structure "fcb" dcl 1-19 in procedure
                                                                                  "tape_io" set ref 1081 1081* 2242 2244*
fcb                                    based           structure                level 1 dcl 1-19 set ref 1022 1027*
fcb_ptr                         000352 automatic       pointer                  dcl 1-3 set ref 1011* 1011* 1014 1026* 1027 1028
                                                                                  1038 1039 1039 1040 1040 1041 1041 1042 1042 1043
                                                                                  1043 1044 1044 1050 1050 1053 1053 1055 1055 1057
                                                                                  1057 1062 1062 1065 1065 1067 1067 1069 1069 1076
                                                                                  1076 1079 1079 1081 1081 1083 1083 1091 1091 1093
                                                                                  1095 1095 1099 1101 1101 1101 1105 1109 1111 1113
                                                                                  1115 1117 1119 1125 1125 1129 1130 1130 1130 1133
                                                                                  1133 1133 1137 1138 1138 1143 1143 1143 1148 1150
                                                                                  1150 1153 1155 1158 1158 1161 1162 1162 1164 1165
                                                                                  1168 1168 1170 1171 1175 1175 1183 1184 1184 1186
                                                                                  1187 1190 1190 1192 1193 1598 1599 1865 1867 1871
                                                                                  1873 1891 1893 1911 1913 1917 1919 1923 1925 1929
                                                                                  1931 1935 1937 1941 1943 1961 1963 1967 1969 1973
                                                                                  1975 1979 1981 1985 1987 1991 1993 1997 1999 2003
                                                                                  2005 2009 2011 2015 2017 2021 2023 2027 2029 2033
                                                                                  2035 2039 2041 2045 2047 2051 2053 2057 2059 2063
                                                                                  2065 2069 2071 2075 2077 2081 2083 2087 2089 2107
                                                                                  2109 2127 2129 2147 2224 2226 2230 2232 2236 2238
                                                                                  2242 2244 2297 2299 2300 2318 2320 2338 2340 2341
file_id                 100            based           char(17)                 level 3 dcl 1-19 set ref 1093 1109 1125 1143 2147*
file_token_ptr                         based           pointer                  level 2 dcl 1-19 set ref 1598*
first_default_fcb_ptr
                          6            based           pointer                  level 2 dcl 1-45 set ref 1630*
first_fcb_ptr             4            based           pointer                  level 2 dcl 1-45 set ref 1005 1011 1597*
first_vcb_ptr             6            based           pointer                  level 2 in structure "tape_io_data" dcl 1-5
                                                                                  in procedure "tape_io" set ref 760*
first_vcb_ptr             6     000100 automatic       pointer                  level 2 in structure "tid" dcl 669 in procedure
                                                                                  "tape_io" set ref 990 990*
force                    75            based           bit(1)                   level 3 dcl 1-5 set ref 765* 842* 1121
format                   72            based           fixed bin(17,0)          level 3 in structure "fcb" dcl 1-19 in procedure
                                                                                  "tape_io" set ref 1044 1044* 1044 1079 1079* 1865
                                                                                  1867* 1871 1873*
format                   76            based           fixed bin(17,0)          level 3 in structure "fcb" dcl 1-19 in procedure
                                                                                  "tape_io" set ref 1041 1041* 1041 1053 1053* 1065
                                                                                  1065* 1130 1133 1148 1161 1183 1961 1963* 1967
                                                                                  1969* 1973 1975* 1979 1981* 1985 1987* 1991 1993*
                                                                                  1997 1999* 2003 2005* 2009 2011* 2015 2017* 2021
                                                                                  2023* 2027 2029* 2033 2035* 2039 2041* 2045 2047*
                                                                                  2051 2053* 2057 2059* 2063 2065* 2069 2071* 2075
                                                                                  2077* 2081 2083* 2087 2089*
group2                    7            based           structure                level 2 packed unaligned dcl 5-68
hbound                                                 builtin function         dcl 711 ref 1518 1519 1574
hcs_$initiate_count             000374 constant        entry                    external dcl 733 ref 796
hcs_$terminate_noname           000376 constant        entry                    external dcl 734 ref 900
head                                   parameter       pointer                  dcl 1020 set ref 1018 1023 1023*
i                               000614 automatic       fixed bin(17,0)          dcl 8-33 set ref 8-39* 8-42 8-45*
ignored_breaks                  000051 internal static varying char(128)        dcl 661 set ref 856* 857* 857 858* 858 862* 868*
ii                              000331 automatic       fixed bin(17,0)          dcl 684 set ref 1499* 1501 1516* 1516 1518 1518 1519
                                                                                  1552 1558 1564 1574
init_req                        000112 internal static bit(1)                   initial unaligned dcl 662 set ref 852 859*
ioa_                            000400 constant        entry                    external dcl 735 ref 893 1155 1164 1165 1170 1171
                                                                                  1186 1187 1192 1193
iox_$error_output               000420 external static pointer                  dcl 7-43 set ref 7-63*
iox_$put_chars                  000416 constant        entry                    external dcl 7-43 ref 7-63
j                               000332 automatic       fixed bin(17,0)          dcl 685 set ref 1180* 1182* 1184 1190
length                                                 builtin function         dcl 7-40 ref 7-63 7-63
lex_control_chars               000113 internal static varying char(128)        dcl 663 set ref 862* 868*
lex_delims                      000154 internal static varying char(128)        dcl 664 set ref 862* 868*
lex_error_                      000422 constant        entry                    external dcl 7-43 in procedure "PUSH" ref 7-60
lex_error_                      000402 constant        entry                    external dcl 736 in procedure "tape_io" ref 919
lex_string_$init_lex_delims     000404 constant        entry                    external dcl 737 ref 862
lex_string_$lex                 000406 constant        entry                    external dcl 740 ref 868
long_error                      000220 internal static varying char(234)        initial dcl 7-48 set ref 7-60*
max                                                    builtin function         dcl 4-92 ref 7-27 2248 2253 2258 2263 2268 2273 2278
                                                                                  2283
max_severity            100            based           fixed bin(17,0)          level 3 dcl 1-5 set ref 768* 838* 919
max_severity_num                000333 automatic       fixed bin(17,0)          dcl 686 set ref 881* 884 919*
message                   2     003135 constant        varying char(252)        initial array level 2 dcl 3-3 set ref 919*
min                                                    builtin function         dcl 711 ref 1574
mod                                                    builtin function         dcl 711 ref 1101 1162
my_area                                based           area(1024)               dcl 697 ref 989 1022
n                                      parameter       fixed bin(17,0)          dcl 8-33 ref 8-31 8-38 8-39 8-42 8-45
name                            000334 automatic       char(8)                  unaligned dcl 687 set ref 747* 753* 774* 778* 782*
                                                                                  782* 790* 800* 808 814* 818 822* 833* 847* 872*
                                                                                  875* 885* 893*
nargs                           000336 automatic       fixed bin(17,0)          dcl 688 set ref 770* 781 826 832
next_fcb_ptr              2            based           pointer                  level 2 dcl 1-19 set ref 1014 1025*
next_vcb_ptr              2            based           pointer                  level 2 dcl 1-45 set ref 992*
non_restart_error               000314 internal static char(33)                 initial unaligned dcl 7-48 set ref 7-63 7-63 7-63
                                                                                  7-63
null                                                   builtin function         dcl 7-40 in procedure "PUSH" ref 7-60 7-60 7-60 7-60
null                                                   builtin function         dcl 711 in procedure "tape_io" ref 678 679 759 760
                                                                                  763 799 811 821 821 874 900 902 904 906 917 917
                                                                                  919 919 990 1005 1011 1023 1028 1038 1090 8-37
                                                                                  8-39 8-42 8-45
null                                                   builtin function         dcl 4-92 in procedure "SEMANTIC_ANALYSIS" ref 6-64
                                                                                  6-73 6-79 6-86 1599
null                                                   builtin function         dcl 9-21 in procedure "NEXT_STMT" ref 9-27 9-35
nvols                    10            based           fixed bin(17,0)          level 2 dcl 1-45 set ref 1574*
output_mode              77            based           fixed bin(17,0)          level 3 dcl 1-19 set ref 1076 1076* 1095 1099 1101
                                                                                  1115 1117 1125 1129 1137 1138 2224 2226* 2230
                                                                                  2232* 2236 2238* 2338 2340*
owner                     2     000202 automatic       char(32)                 level 2 packed unaligned dcl 670 set ref 808*
prev_fcb_ptr              4            based           pointer                  level 2 dcl 1-19 set ref 1028* 1045
pstmt                           000404 automatic       pointer                  dcl 915 set ref 917* 918* 919*
ptr                      72            based           pointer                  level 3 dcl 1-5 set ref 763* 796* 799 868* 900 900*
quoted_string            11(01)        based           bit(1)                   level 4 packed unaligned dcl 5-68 ref 6-92 6-104
                                                                                  6-113 6-118 6-124
reclen                  120            based           fixed bin(21,0)          level 3 dcl 1-19 set ref 1040 1040* 1040 1057 1057*
                                                                                  1069 1069* 1130 1133 1150 1150* 1158 1162 1164*
                                                                                  1168 1170* 1175 1184 1186* 1190 1192* 2127 2129*
release_area_                   000372 constant        entry                    external dcl 732 ref 902
replace_id              105            based           char(17)                 level 3 dcl 1-19 set ref 1113 2341*
ring                     76            based           bit(1)                   level 3 dcl 1-5 set ref 766* 844*
search                                                 builtin function         dcl 4-92 ref 6-92
segment                  10            based           structure                level 2 dcl 1-19
sequence                116            based           fixed bin(17,0)          level 3 dcl 1-19 set ref 1095 1111 1143 1143 2318
                                                                                  2320*
serror_printed                  000337 automatic       bit(1)                   array unaligned dcl 689 set ref 919*
severity                        003135 constant        fixed bin(17,0)          initial array level 2 dcl 3-3 set ref 919 919*
size                     13     000202 automatic       fixed bin(18,0)          level 2 dcl 670 set ref 809*
source                   10            based           structure                level 2 dcl 1-5
substr                                                 builtin function         dcl 711 in procedure "tape_io" ref 853 855 856 857
                                                                                  858
substr                                                 builtin function         dcl 4-92 in procedure "SEMANTIC_ANALYSIS" ref 6-92
                                                                                  6-126
sys_info$max_seg_size           000326 external static fixed bin(35,0)          dcl 622 ref 809 970
tail                                   parameter       pointer                  dcl 1020 set ref 1018 1025 1028 1028 1030*
tape                     75            based           structure                level 2 dcl 1-19
tape_io_data                           based           structure                level 1 dcl 1-5
tape_io_data_ptr                000356 automatic       pointer                  dcl 1-3 set ref 756* 759 760 761 762 763 764 765 766
                                                                                  767 768 787 787 796 796 796 799 800 800 800 817
                                                                                  818 819 819 821 821 828 838 842 844 868 868 891
                                                                                  891* 900 900 902 902 904 904 906 906 919 989 1022
                                                                                  1052 1064 1076 1121
tape_io_interpret_              000410 constant        entry                    external dcl 743 ref 891
tape_type              3011            based           fixed bin(17,0)          level 2 dcl 1-45 set ref 1001 1001* 1003 1049 1098
                                                                                  1108 1180 1615 1735 1737* 1742 1744* 1749 1751*
                                                                                  1756 1758* 1763 1765* 1770 1772* 1777 1779* 1784
                                                                                  1786*
temp                                   based           pointer                  array level 2 dcl 1-5 set ref 759* 817* 818* 819*
                                                                                  819* 821 821 868* 902 902* 904 904* 906 906* 989
                                                                                  1022
temp_ptr                        000340 automatic       pointer                  dcl 690 set ref 989* 990 992 993 1022* 1023 1025
                                                                                  1026 1030
tid                             000100 automatic       structure                level 1 dcl 669 set ref 756
token                                  based           structure                level 1 dcl 5-68
token_value                            based           char                     unaligned dcl 5-68 set ref 931* 948 952* 961* 967*
                                                                                  983* 6-92 6-92 6-106* 6-113 6-128 1501 1518 1552
                                                                                  1558 1564 1893 2147 2341
translator_temp_$get_next_segment
                                000362 constant        entry                    external dcl 728 ref 819
translator_temp_$get_segment    000364 constant        entry                    external dcl 729 ref 818
translator_temp_$release_segment
                                000366 constant        entry                    external dcl 730 ref 904 906
truncate_lines           74            based           fixed bin(17,0)          level 3 dcl 1-19 set ref 1083 1083*
unspec                                                 builtin function         dcl 711 set ref 804*
vcb                                    based           structure                level 1 dcl 1-45 set ref 989 994*
vcb_ptr                         000354 automatic       pointer                  dcl 1-3 set ref 992 993* 994 1001 1001 1003 1003
                                                                                  1003 1005 1006 1011 1049 1098 1108 1180 1501 1518
                                                                                  1518 1519 1552 1558 1564 1574 1574 1597 1615 1621
                                                                                  1630 1735 1737 1742 1744 1749 1751 1756 1758 1763
                                                                                  1765 1770 1772 1777 1779 1784 1786 1807 1809 1814
                                                                                  1816 1821 1823 1828 1830 1835 1837 1842 1844
verify                                                 builtin function         dcl 4-92 ref 6-92
version                         000202 automatic       fixed bin(17,0)          level 2 dcl 670 set ref 805*
version_of_area          14     000202 automatic       fixed bin(17,0)          level 2 dcl 670 set ref 810*
volid                    11            based           char(32)                 array level 2 dcl 1-45 set ref 1501* 1518 1518* 1519
                                                                                  1574
volume_token_ptr                       based           pointer                  level 2 dcl 1-45 set ref 1006
writing                         000342 automatic       bit(1)                   unaligned dcl 691 set ref 748* 754* 767
writing_tape             77            based           bit(1)                   level 3 dcl 1-5 set ref 767* 1052 1064 1076
zero_on_alloc             1(01) 000202 automatic       bit(1)                   level 3 packed unaligned dcl 670 set ref 807*

NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED.
Pcomment                               automatic       pointer                  dcl 5-20
area_infop                             automatic       pointer                  dcl 2-5
comment                                based           structure                level 1 dcl 5-20
comment_value                          based           char                     unaligned dcl 5-20
stmt                                   based           structure                level 1 dcl 5-40
stmt_value                             based           char                     unaligned dcl 5-40

NAMES DECLARED BY EXPLICIT CONTEXT.
Check_FCB                       017102 constant        entry                    internal dcl 1088 ref 1013
Cleaner                         015777 constant        entry                    internal dcl 898 ref 794 894
Complete_FCB                    016723 constant        entry                    internal dcl 1034 ref 1012
EXIT                            015771 constant        label                    dcl 894 ref 815 823 835 848 876 886
Error                           016076 constant        entry                    internal dcl 912 ref 1007 1091 1093 1095 1099 1101
                                                                                  1105 1109 1111 1113 1115 1117 1119 1121 1125 1130
                                                                                  1133 1138 1141 1143 1154 1163 1169 1185 1191 1482
                                                                                  1492 1506 1519 1524 1585 1609 1615 1621 1670 1675
                                                                                  1680 1685 1690 1695 1700 1705 1710 1715 1720 1725
                                                                                  1730 1735 1742 1749 1756 1763 1770 1777 1784 1791
                                                                                  1797 1807 1814 1821 1828 1835 1842 1849 1855 1865
                                                                                  1871 1877 1882 1891 1897 1902 1911 1917 1923 1929
                                                                                  1935 1941 1947 1952 1961 1967 1973 1979 1985 1991
                                                                                  1997 2003 2009 2015 2021 2027 2033 2039 2045 2051
                                                                                  2057 2063 2069 2075 2081 2087 2093 2098 2107 2113
                                                                                  2118 2127 2133 2138 2154 2160 2224 2230 2236 2242
                                                                                  2288 2297 2304 2309 2318 2324 2329 2338 2345 2350
                                                                                  2355
LEX                             023676 constant        entry                    internal dcl 8-31 ref 1488 1502 1520 1534 1539 1554
                                                                                  1560 1566 1576 1580 1595 1605 1617 1623 1640 1645
                                                                                  1650 1655 1660 1665 1738 1745 1752 1759 1766 1773
                                                                                  1780 1787 1793 1810 1817 1824 1831 1838 1845 1851
                                                                                  1868 1874 1879 1894 1899 1914 1920 1926 1932 1938
                                                                                  1944 1949 1964 1970 1976 1982 1988 1994 2000 2006
                                                                                  2012 2018 2024 2030 2036 2042 2048 2054 2060 2066
                                                                                  2072 2078 2084 2090 2095 2110 2115 2130 2135 2150
                                                                                  2156 2179 2184 2189 2194 2199 2204 2209 2214 2219
                                                                                  2227 2233 2239 2245 2301 2306 2321 2326 2342 2347
NEXT_STMT                       023763 constant        entry                    internal dcl 9-18 ref 1508 1526 1587 1672 1677 1682
                                                                                  1687 1692 1697 1702 1707 1712 1717 1722 1727 1732
                                                                                  1799 1857 1884 1904 1954 2100 2120 2140 2162 2290
                                                                                  2311 2331 2352
PUSH                            023535 constant        entry                    internal dcl 7-36 ref 1627 2170
RD_ACTION                       012526 constant        label                    array(160) dcl 1482 ref 1477
RD_MATCH                        020275 constant        label                    dcl 1473 ref 6-90 6-92 6-101 6-109 6-113 6-118 6-128
                                                                                  1469
RD_MATCH_NO_TOKEN               020300 constant        label                    dcl 1474 ref 6-73 6-79 6-86
RD_NEXT_REDUCTION               017757 constant        label                    dcl 6-55 ref 6-68 6-84 6-88 6-99 6-104 6-111 6-116
                                                                                  6-120 6-124 6-130 1470 7-17 7-24
RD_STACK                        020307 constant        label                    dcl 7-17
RD_STACK_POP                    020314 constant        label                    dcl 7-24 ref 1673 1678 1683 1688 1693 1698 1703 1708
                                                                                  1713 1718 1723 1728 1733 1869 1875 1880 1885 1895
                                                                                  1900 1905 1915 1921 1927 1933 1939 1945 1950 1955
                                                                                  1965 1971 1977 1983 1989 1995 2001 2007 2013 2019
                                                                                  2025 2031 2037 2043 2049 2055 2061 2067 2073 2079
                                                                                  2085 2091 2096 2101 2111 2116 2121 2131 2136 2141
                                                                                  2228 2234 2240 2246 2291 2302 2307 2312 2322 2327
                                                                                  2332 2343 2348 2353
RD_TEST_REDUCTION               017760 constant        label                    dcl 6-58 ref 6-53 7-19 7-28 1490 1504 1510 1514 1522
                                                                                  1528 1532 1537 1542 1546 1550 1556 1562 1568 1572
                                                                                  1578 1583 1589 1593 1601 1607 1613 1619 1625 1634
                                                                                  1638 1643 1648 1653 1658 1663 1668 1740 1747 1754
                                                                                  1761 1768 1775 1782 1789 1795 1801 1805 1812 1819
                                                                                  1826 1833 1840 1847 1853 1859 1863 1889 1909 1959
                                                                                  2105 2125 2145 2152 2158 2164 2168 2173 2177 2182
                                                                                  2187 2192 2197 2202 2207 2212 2217 2222 2251 2256
                                                                                  2261 2266 2271 2276 2281 2286 2295 2316 2336
RD_TEST_RESULT                  020271 constant        label                    dcl 1469 ref 1455 1457 1459 1461 1463 1465 1467
RD_TEST_TOKEN                   012511 constant        label                    array(6) dcl 6-73 ref 6-65 6-71
RD_TOKEN_FCN                    012517 constant        label                    array(7) dcl 1454 ref 1452
SEMANTIC_ANALYSIS               017746 constant        entry                    internal dcl 4-30 ref 883
bad_arg                         015322 constant        label                    dcl 847 ref 839
build_fcb                       016663 constant        entry                    internal dcl 1018 ref 1597 1630
build_vcb                       016571 constant        entry                    internal dcl 987 ref 1486
common_code                     014301 constant        label                    dcl 756 ref 749
end_vcb                         016617 constant        entry                    internal dcl 999 ref 1603 1611
get_to_cl                       023641 constant        label                    dcl 7-62 ref 7-64
out                             017745 constant        label                    dcl 1196 ref 1157 1174
tape_in                         014244 constant        entry                    external dcl 745
tape_io                         014224 constant        entry                    external dcl 612
tape_out                        014267 constant        entry                    external dcl 751
test                            012475 constant        label                    array(0:11) dcl 1150 ref 1148
tin                             014234 constant        entry                    external dcl 745
tout                            014257 constant        entry                    external dcl 751
valid_block_sizep               016201 constant        entry                    internal dcl 929 ref 1458
valid_datep                     016534 constant        entry                    internal dcl 981 ref 1456
valid_file_namep                016257 constant        entry                    internal dcl 939 ref 1462
valid_file_numberp              016276 constant        entry                    internal dcl 946 ref 1466
valid_pathnamep                 016370 constant        entry                    internal dcl 959 ref 1464
valid_record_sizep              016431 constant        entry                    internal dcl 965 ref 1460
valid_volidp                    016515 constant        entry                    internal dcl 974 ref 1454

THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION.

STORAGE REQUIREMENTS FOR THIS PROGRAM.

	Object	Text	Link	Symbol	Defs	Static
Start          0       0     24700       25324   24265       24710
Length     26004   24265       424         443     412         316

BLOCK NAME	         STACK SIZE     TYPE		WHY NONQUICK/WHO SHARES STACK FRAME
tape_io                             828 external procedure  is an external procedure.  
on unit on line 794                  64 on unit               
Cleaner                              72 internal procedure  is called by several nonquick procedures.  
Error                                   internal procedure  shares stack frame of external procedure tape_io.  
valid_block_sizep                       internal procedure  shares stack frame of external procedure tape_io.  
valid_file_namep                        internal procedure  shares stack frame of external procedure tape_io.  
valid_file_numberp                      internal procedure  shares stack frame of external procedure tape_io.  
valid_pathnamep                         internal procedure  shares stack frame of external procedure tape_io.  
valid_record_sizep                      internal procedure  shares stack frame of external procedure tape_io.  
valid_volidp                            internal procedure  shares stack frame of external procedure tape_io.  
valid_datep                             internal procedure  shares stack frame of external procedure tape_io.  
build_vcb                               internal procedure  shares stack frame of external procedure tape_io.  
end_vcb                                 internal procedure  shares stack frame of external procedure tape_io.  
build_fcb                               internal procedure  shares stack frame of external procedure tape_io.  
Complete_FCB                            internal procedure  shares stack frame of external procedure tape_io.  
Check_FCB                               internal procedure  shares stack frame of external procedure tape_io.  
SEMANTIC_ANALYSIS                       internal procedure  shares stack frame of external procedure tape_io.  
PUSH                                    internal procedure  shares stack frame of external procedure tape_io.  
LEX                                     internal procedure  shares stack frame of external procedure tape_io.  
NEXT_STMT                               internal procedure  shares stack frame of external procedure tape_io.  

STORAGE FOR INTERNAL STATIC VARIABLES.

   LOC IDENTIFIER                  BLOCK NAME
000010 breaks                      tape_io
000051 ignored_breaks              tape_io
000112 init_req                    tape_io
000113 lex_control_chars           tape_io
000154 lex_delims                  tape_io
000215 TRACING                     tape_io
000216 brief_error                 PUSH
000220 long_error                  PUSH
000314 non_restart_error           PUSH

STORAGE FOR AUTOMATIC VARIABLES.

STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME
tape_io                  000100 tid                         tape_io
                         000202 ai                          tape_io
                         000226 aL                          tape_io
                         000230 aP                          tape_io
                         000232 arg_num                     tape_io
                         000234 clk_val                     tape_io
                         000236 bc                          tape_io
                         000237 code                        tape_io
                         000240 current_default_fcb_ptr     tape_io
                         000242 current_fcb_ptr             tape_io
                         000244 dfcbp                       tape_io
                         000246 dirname                     tape_io
                         000320 ename                       tape_io
                         000330 error_count                 tape_io
                         000331 ii                          tape_io
                         000332 j                           tape_io
                         000333 max_severity_num            tape_io
                         000334 name                        tape_io
                         000336 nargs                       tape_io
                         000337 serror_printed              tape_io
                         000340 temp_ptr                    tape_io
                         000342 writing                     tape_io
                         000343 build_default_fcb           tape_io
                         000352 fcb_ptr                     tape_io
                         000354 vcb_ptr                     tape_io
                         000356 tape_io_data_ptr            tape_io
                         000360 Pthis_token                 tape_io
                         000362 Pstmt                       tape_io
                         000364 Ptoken                      tape_io
                         000366 SPDL                        tape_io
                         000404 pstmt                       Error
                         000524 LTOKEN_REQD_VALUE           SEMANTIC_ANALYSIS
                         000525 NRED                        SEMANTIC_ANALYSIS
                         000526 PRED                        SEMANTIC_ANALYSIS
                         000530 PTOKEN_REQD                 SEMANTIC_ANALYSIS
                         000532 PTOKEN_REQD_VALUE           SEMANTIC_ANALYSIS
                         000534 STOKEN_FCN                  SEMANTIC_ANALYSIS
                         000535 CODE                        SEMANTIC_ANALYSIS
                         000536 I                           SEMANTIC_ANALYSIS
                         000537 NUMBER                      SEMANTIC_ANALYSIS
                         000540 DIRECTION                   SEMANTIC_ANALYSIS
                         000541 STACK                       SEMANTIC_ANALYSIS
                         000553 STACK_DEPTH                 SEMANTIC_ANALYSIS
                         000614 i                           LEX
                         000626 Ssearching                  NEXT_STMT

THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
r_e_as              r_ne_as             unpk_to_pk          call_ext_out_desc   call_ext_out        call_int_this
call_int_other      return              alloc_auto_adj      mod_fx1             enable              ext_entry
int_entry           alloc_based

THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
active_fnc_err_               com_err_                      convert_date_to_binary_       cu_$af_arg_count
cu_$arg_ptr                   cu_$cl                        cv_dec_check_                 cv_dec_check_
define_area_                  expand_pathname_              expand_pathname_$add_suffix   hcs_$initiate_count
hcs_$terminate_noname         ioa_                          iox_$put_chars                lex_error_
lex_error_                    lex_string_$init_lex_delims   lex_string_$lex               release_area_
tape_io_interpret_            translator_temp_$get_next_segment                           translator_temp_$get_segment
translator_temp_$release_segment

THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
error_table_$active_function  error_table_$badopt           error_table_$noarg            error_table_$not_act_fnc
error_table_$translation_failed                             iox_$error_output             sys_info$max_seg_size




   LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC   
    678 014203       679 014205       689 014206       692 014215      2364 014216       919 014217       612 014223
    745 014232       747 014252       748 014254       749 014255       751 014256       753 014275       754 014277
    756 014301       759 014303       760 014320       761 014322       762 014325       763 014330       764 014331
    765 014332       766 014333       767 014334       768 014336       770 014337       771 014350       773 014356
    774 014360       775 014374       778 014375       779 014411       781 014412       782 014415       784 014447
    786 014450       787 014467       789 014526       790 014530       791 014562       794 014563       796 014605
    799 014650       800 014655       802 014724       804 014725       805 014730       806 014732       807 014734
    808 014736       809 014741       810 014744       811 014746       812 014750       813 014762       814 014764
    815 015013       817 015014       818 015016       819 015042       821 015060       822 015071       823 015115
    826 015116       827 015123       828 015141       830 015157       831 015167       832 015170       833 015173
    835 015226       837 015227       838 015245       839 015273       841 015275       842 015276       844 015312
    847 015322       848 015354       850 015355       851 015357       852 015360       853 015363       854 015370
    855 015402       856 015411       857 015415       858 015427       859 015436       862 015437       868 015520
    872 015637       874 015656       875 015662       876 015706       881 015707       883 015710       884 015711
    885 015714       886 015731       891 015732       893 015745       894 015771       896 015775       898 015776
    900 016004       902 016023       904 016037       906 016056       909 016075       912 016076       917 016100
    918 016107       919 016112       924 016177       927 016200       929 016201       931 016203       932 016233
    933 016240       934 016246       935 016253       939 016257       941 016261       942 016267       943 016273
    946 016276       948 016300       949 016311       950 016313       952 016316       953 016344       954 016351
    955 016357       956 016364       959 016370       961 016372       962 016424       965 016431       967 016433
    968 016463       969 016470       970 016476       971 016511       974 016515       976 016517       977 016525
    978 016531       981 016534       983 016536       984 016564       987 016571       989 016572       990 016600
    992 016606       993 016610       994 016611       996 016616       999 016617      1001 016620      1003 016625
   1005 016632      1006 016636      1007 016640      1008 016644      1011 016645      1012 016654      1013 016655
   1014 016656      1016 016662      1018 016663      1022 016665      1023 016673      1025 016702      1026 016705
   1027 016706      1028 016712      1030 016721      1032 016722      1034 016723      1038 016724      1039 016734
   1040 016742      1041 016747      1042 016754      1043 016761      1044 016771      1045 016776      1049 017002
   1050 017006      1052 017013      1053 017016      1055 017022      1057 017026      1060 017032      1062 017033
   1064 017040      1065 017043      1067 017047      1069 017053      1076 017057      1079 017065      1081 017071
   1083 017075      1086 017101      1088 017102      1090 017103      1091 017105      1093 017122      1095 017133
   1098 017146      1099 017152      1101 017162      1105 017176      1108 017206      1109 017212      1111 017223
   1113 017232      1115 017243      1117 017254      1119 017262      1121 017273      1123 017302      1125 017303
   1128 017317      1129 017320      1130 017322      1133 017334      1136 017350      1137 017351      1138 017353
   1141 017366      1143 017372      1148 017407      1150 017412      1153 017415      1154 017417      1155 017423
   1157 017444      1158 017445      1161 017451      1162 017454      1163 017460      1164 017464      1165 017505
   1167 017526      1168 017527      1169 017532      1170 017536      1171 017557      1174 017600      1175 017601
   1180 017605      1182 017613      1183 017615      1184 017620      1185 017624      1186 017630      1187 017651
   1189 017672      1190 017673      1191 017677      1192 017703      1193 017724      1196 017745    4   30 017746
   1216 017747      1217 017751    6   50 017752    6   52 017755    6   53 017756    6   55 017757    6   58 017760
 6   60 017763    6   62 017765    6   63 020010    6   64 020013    6   65 020017    6   68 020027    6   70 020030
 6   71 020034    6   73 020036    6   79 020055    6   84 020066    6   86 020067    6   88 020073    6   90 020074
 6   92 020075    6   99 020131    6  101 020132    6  104 020135    6  106 020140    6  107 020164    6  108 020166
 6  109 020171    6  111 020172    6  113 020173    6  116 020207    6  118 020210    6  120 020214    6  123 020215
 6  124 020216    6  126 020222    6  127 020227    6  128 020233    6  130 020241      1452 020242      1454 020244
   1455 020246      1456 020247      1457 020251      1458 020252      1459 020254      1460 020255      1461 020257
   1462 020260      1463 020262      1464 020263      1465 020265      1466 020266      1467 020270      1469 020271
   1470 020274      1473 020275      1474 020300      1476 020303      1477 020305    7   17 020307    7   18 020311
 7   19 020313    7   24 020314    7   26 020316    7   27 020320    7   28 020326      1482 020327      1484 020333
   1486 020334      1488 020335      1489 020341      1490 020343      1492 020344      1494 020350      1496 020351
   1499 020352      1501 020354      1502 020366      1503 020372      1504 020374      1506 020375      1508 020401
   1509 020402      1510 020404      1512 020405      1514 020407      1516 020410      1518 020411      1519 020427
   1520 020436      1521 020442      1522 020444      1524 020445      1526 020451      1527 020452      1528 020454
   1530 020455      1532 020457      1534 020460      1536 020464      1537 020466      1539 020467      1541 020473
   1542 020475      1544 020476      1546 020500      1548 020501      1550 020503      1552 020504      1554 020517
   1555 020523      1556 020525      1558 020526      1560 020541      1561 020545      1562 020547      1564 020550
   1566 020563      1567 020567      1568 020571      1570 020572      1572 020574      1574 020575      1576 020603
   1577 020607      1578 020611      1580 020612      1582 020616      1583 020620      1585 020621      1587 020625
   1588 020626      1589 020630      1591 020631      1593 020633      1595 020634      1597 020640      1598 020651
   1599 020653      1600 020662      1601 020664      1603 020665      1605 020666      1606 020672      1607 020674
   1609 020675      1611 020701      1612 020702      1613 020704      1615 020705      1617 020714      1618 020720
   1619 020722      1621 020723      1623 020732      1624 020736      1625 020740      1627 020741      1629 020745
   1630 020747      1631 020760      1633 020762      1634 020764      1636 020765      1638 020767      1640 020770
   1642 020774      1643 020776      1645 020777      1647 021003      1648 021005      1650 021006      1652 021012
   1653 021014      1655 021015      1657 021021      1658 021023      1660 021024      1662 021030      1663 021032
   1665 021033      1667 021037      1668 021041      1670 021042      1672 021046      1673 021047      1675 021050
   1677 021054      1678 021055      1680 021056      1682 021062      1683 021063      1685 021064      1687 021070
   1688 021071      1690 021072      1692 021076      1693 021077      1695 021100      1697 021104      1698 021105
   1700 021106      1702 021112      1703 021113      1705 021114      1707 021120      1708 021121      1710 021122
   1712 021126      1713 021127      1715 021130      1717 021134      1718 021135      1720 021136      1722 021142
   1723 021143      1725 021144      1727 021150      1728 021151      1730 021152      1732 021156      1733 021157
   1735 021160      1737 021170      1738 021172      1739 021176      1740 021200      1742 021201      1744 021211
   1745 021213      1746 021217      1747 021221      1749 021222      1751 021232      1752 021234      1753 021240
   1754 021242      1756 021243      1758 021253      1759 021255      1760 021261      1761 021263      1763 021264
   1765 021274      1766 021276      1767 021302      1768 021304      1770 021305      1772 021315      1773 021317
   1774 021323      1775 021325      1777 021326      1779 021336      1780 021340      1781 021344      1782 021346
   1784 021347      1786 021357      1787 021361      1788 021365      1789 021367      1791 021370      1793 021374
   1794 021400      1795 021402      1797 021403      1799 021407      1800 021410      1801 021412      1803 021413
   1805 021415      1807 021416      1809 021426      1810 021430      1811 021434      1812 021436      1814 021437
   1816 021447      1817 021451      1818 021455      1819 021457      1821 021460      1823 021470      1824 021472
   1825 021476      1826 021500      1828 021501      1830 021511      1831 021513      1832 021517      1833 021521
   1835 021522      1837 021532      1838 021534      1839 021540      1840 021542      1842 021543      1844 021553
   1845 021555      1846 021561      1847 021563      1849 021564      1851 021570      1852 021574      1853 021576
   1855 021577      1857 021603      1858 021604      1859 021606      1861 021607      1863 021611      1865 021612
   1867 021622      1868 021624      1869 021630      1871 021631      1873 021641      1874 021643      1875 021647
   1877 021650      1879 021654      1880 021660      1882 021661      1884 021665      1885 021666      1887 021667
   1889 021671      1891 021672      1893 021704      1894 021713      1895 021717      1897 021720      1899 021724
   1900 021730      1902 021731      1904 021735      1905 021736      1907 021737      1909 021741      1911 021742
   1913 021752      1914 021754      1915 021760      1917 021761      1919 021771      1920 021773      1921 021777
   1923 022000      1925 022010      1926 022012      1927 022016      1929 022017      1931 022027      1932 022031
   1933 022035      1935 022036      1937 022046      1938 022050      1939 022054      1941 022055      1943 022065
   1944 022067      1945 022073      1947 022074      1949 022100      1950 022104      1952 022105      1954 022111
   1955 022112      1957 022113      1959 022115      1961 022116      1963 022126      1964 022130      1965 022134
   1967 022135      1969 022145      1970 022147      1971 022153      1973 022154      1975 022164      1976 022166
   1977 022172      1979 022173      1981 022203      1982 022205      1983 022211      1985 022212      1987 022222
   1988 022224      1989 022230      1991 022231      1993 022241      1994 022243      1995 022247      1997 022250
   1999 022260      2000 022262      2001 022266      2003 022267      2005 022277      2006 022301      2007 022305
   2009 022306      2011 022316      2012 022320      2013 022324      2015 022325      2017 022335      2018 022337
   2019 022343      2021 022344      2023 022354      2024 022356      2025 022362      2027 022363      2029 022373
   2030 022375      2031 022401      2033 022402      2035 022412      2036 022414      2037 022420      2039 022421
   2041 022431      2042 022433      2043 022437      2045 022440      2047 022450      2048 022452      2049 022456
   2051 022457      2053 022467      2054 022471      2055 022475      2057 022476      2059 022506      2060 022510
   2061 022514      2063 022515      2065 022525      2066 022527      2067 022533      2069 022534      2071 022544
   2072 022546      2073 022552      2075 022553      2077 022563      2078 022565      2079 022571      2081 022572
   2083 022602      2084 022604      2085 022610      2087 022611      2089 022621      2090 022623      2091 022627
   2093 022630      2095 022634      2096 022640      2098 022641      2100 022645      2101 022646      2103 022647
   2105 022651      2107 022652      2109 022662      2110 022665      2111 022671      2113 022672      2115 022676
   2116 022702      2118 022703      2120 022707      2121 022710      2123 022711      2125 022713      2127 022714
   2129 022724      2130 022727      2131 022733      2133 022734      2135 022740      2136 022744      2138 022745
   2140 022751      2141 022752      2143 022753      2145 022755      2147 022756      2149 022766      2150 022767
   2151 022773      2152 022775      2154 022776      2156 023002      2157 023006      2158 023010      2160 023011
   2162 023015      2163 023016      2164 023020      2166 023021      2168 023023      2170 023024      2172 023030
   2173 023032      2175 023033      2177 023035      2179 023036      2181 023042      2182 023044      2184 023045
   2186 023051      2187 023053      2189 023054      2191 023060      2192 023062      2194 023063      2196 023067
   2197 023071      2199 023072      2201 023076      2202 023100      2204 023101      2206 023105      2207 023107
   2209 023110      2211 023114      2212 023116      2214 023117      2216 023123      2217 023125      2219 023126
   2221 023132      2222 023134      2224 023135      2226 023145      2227 023147      2228 023153      2230 023154
   2232 023164      2233 023166      2234 023172      2236 023173      2238 023203      2239 023205      2240 023211
   2242 023212      2244 023221      2245 023224      2246 023227      2248 023230      2250 023236      2251 023240
   2253 023241      2255 023247      2256 023251      2258 023252      2260 023260      2261 023262      2263 023263
   2265 023271      2266 023273      2268 023274      2270 023302      2271 023304      2273 023305      2275 023313
   2276 023315      2278 023316      2280 023324      2281 023326      2283 023327      2285 023335      2286 023337
   2288 023340      2290 023344      2291 023345      2293 023346      2295 023350      2297 023351      2299 023362
   2300 023366      2301 023371      2302 023375      2304 023376      2306 023402      2307 023406      2309 023407
   2311 023413      2312 023414      2314 023415      2316 023417      2318 023420      2320 023430      2321 023433
   2322 023437      2324 023440      2326 023444      2327 023450      2329 023451      2331 023455      2332 023456
   2334 023457      2336 023461      2338 023462      2340 023472      2341 023474      2342 023504      2343 023510
   2345 023511      2347 023515      2348 023521      2350 023522      2352 023526      2353 023527      2355 023530
   2357 023534    7   36 023535    7   59 023537    7   60 023542    7   62 023641    7   63 023646    7   64 023670
 7   66 023671    7   68 023672    7   70 023675    8   31 023676    8   36 023700    8   37 023702    8   38 023707
 8   39 023711    8   40 023723    8   41 023725    8   42 023727    8   44 023737    8   45 023740    8   47 023753
 8   48 023755    8   49 023760    8   51 023762    9   18 023763    9   24 023764    9   25 023766    9   26 023771
 9   27 023773    9   28 024002    9   29 024004    9   30 024011    9   31 024012    9   32 024013    9   35 024024
 9   36 024030    9   39 024031


                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL
and BULL HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture 
for managing computer hardware properly and for executing programs. Many subsequent operating systems 
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by BULL HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved