devtype     !    1K   !    2K   !     4K  !
  ------------+---------+---------+---------+ 
  3330 Bl/cyl !     209 !     114 !      57 !
  3330 KB/cyl !     209 !     228 !     228 !
  3330 KB/vol !  168872 !  184224 !  184224 !
  ------------+---------+---------+---------+ 
  .....
  3390 Bl/cyl !     495 !     315 !     180 !
  3390 KB/cyl !     495 !     630 !     720 !
  3390 KB/vol ! 4958415 ! 6310710 ! 7212240 !
  ------------+---------+---------+---------+ 

   ! /**********************************************************************/
   ! /* DASDCAP                                                            */
   ! /* Function : creates DASD SIZES A showing the DASDS Capacities       */
   ! /**********************************************************************/
 1 ! Address Command
 2 ! parse upper source . . myname .
 3 ! parse upper arg parms .
 4 ! validtypes='3330 3340 3350 3375 3380 9345 3390'
 5 ! outl1='+--------+---------+---------+---------+'
 6 ! lout.1=' DASD CAPACITIES extracted from $DASD$ CONSTS '
 7 ! outlnr=2
 8 ! 'ERASE DASD SIZES A'
 9 ! 'ESTATE $DASD$ CONSTS *'
10 ! if RC<>0 then call error_exit rc,'$DASD$ CONSTS file not found'
   ! /* silly check as this file should be on 190 *** (one never knows) ****/
11 ! 'EXECIO * DISKR $DASD$ CONSTS * (FINIS STEM LIN.'
12 ! if RC<>0 then call Error_Exit RC,'cannot read $DASD$ CONSTS *'
   ! /* reading from bottom to top, use the dasd_type line to build new box */
13 ! do i=lin.0 to 1 by -1
14 ! parse var lin.i test1 +2 1 test2 +1 1 test3 +7 1 desc '.' dtype '=' val . 
15 !    if test1<>'/*' & test2<>';' & test3<>'ctmbits' & dtype<>' ' then do
16 !       if wordpos(dtype,validtypes)>0 then do
17 !          if desc='dasd_type' then do
18 !             call build_line sepaline
19 !             call build_line headline
20 !             call build_line sepaline
21 !          end
22 !          if desc='cylinders' then cyls=val
23 !          if desc='blocks1k' then b1ks=val
24 !          if desc='blocks2k' then b2ks=val
25 !          if desc='blocks4k' then do           /* we have all we need  */
26 !             b4ks=val
27 !             call build_line bl_cyl
28 !             call build_line kb_cyl
29 !             call build_line kb_vol
30 !          end
31 !       end
32 !    end
33 ! end
34 ! call build_line sepaline
35 ! 'EXECIO 'outlnr-1' DISKW DASD SIZES A (FINIS STEM LOUT.'
36 ! call Error_Exit 00,'DASD SIZES A file created successfully'
   ! /****************** Exit routine ********************************/
37 ! Error_Exit:
38 !  parse arg retc,errmsg
39 !  if errmsg<>'' then say myname':' errmsg
40 !  exit retc
   ! /********************** build_line subroutine ********************/
41 ! BUILD_LINE:
42 ! parse arg linetype
43 ! if linetype=headline then lout.outlnr='! 'dtype'  !    1K   !     2K  !    4K   !'
44 ! if linetype=sepaline then lout.outlnr=outl1
45 ! if linetype=bl_cyl then lout.outlnr='! Bl/cyl !'right(b1ks,8)' !'right(b2ks,8)' !'right(b4ks,8)' !'
46 ! if linetype=kb_cyl then lout.outlnr='! Kb/cyl !'right(b1ks,8)' !'right(b2ks*2,8)' !'right(b4ks*4,8)' !'
47 ! if linetype=kb_vol then lout.outlnr='! Kb/vol !'right(b1ks*cyls,8)' !'right(b2ks*2*cyls,8)' !'right(b4ks*4*cyls,8)' !'
48 ! outlnr=outlnr+1
49 ! return

1. Line 4. We did explicitly ask not to hard-code the DASD types...  The procedure should be able to get all info from the file even if new DASD types are announced in the future... 
2. Line 10. An extra check is better than none.  So, it is not silly... a good programmer always "never knows" ;-)
3. Line 13. This is a nice solution to be able to limit the logic to a single DO-loop...
4. Line 14. Clever parsing !
5. Lines 15 and 16 could be combined as follows:

    if test1<>'/*' & test2<>';' & test3<>'ctmbits' & wordpos(dtype,validtypes)>0 then do
   

6. Line 17... As a blank can not be considered to be a word, we would prefer to see a select here.  Now, for each record, all the tests are done.  With a select, the tests are performed until one is true.  A select is easier to read too.  Then, statements 15 and 16 could even be included in the select, as here:

    select
     when test1='/*' ! test2=';' ! test3='cmtbits' ! wordpos(dtype,validtypes)=0 then nop
     when desc='dasd_type' then do
     end
     when desc='cylinders' then cyls=val
     ...
     otherwise nop                      /* unknown record type, ignore it */
    end
   

   The first test can even be omitted, as the otherwise will exclude these records anyway. 

   As as consequence, the parse at line 14 can become as short as this:

     parse var lin.i desc '.' dtype '=' val . 
   

7. Line 41. Nice subroutine use.  It is a very good technique to build an array to let EXECIO write the records in one shot.  Look at this, very similar construction that uses a subroutine and has less complex variables:

     /* ... */
     out=0
     call output 'This string to write...'
     ...
     out.0=out
     'EXECIO' out.0 'DISKW OUTPUT FILE A (FINIS STEM OUT.'
     exit
     OUTPUT:    /* output subroutine */
      parse arg string_to_write
      out=out+1 ; out.out = string_to_write
      return
   

   At first glance, it may be confusing to use homonym variables both for the stem (OUT.) and for the index (OUT), but once you get used to it, it is very easy...  Remark also that the index is incremented before an element is created, with the advantage that the index has not to be diminished by one before you issue the EXECIO. 

Our solution

We come to present now our solutions.  The first one uses EXECIO and has full stack recovery.

   ! /* DASDCAP : Produce Dasd Capacity table from $DASD$ CONSTS S file     */
 1 ! parse upper source . . myname mytype . 
 2 ! parse value 0 with l disks disk. capac. 
 3 ! address command
   !
 4 ! 'MAKEBUF' ; oq=queued()
 5 ! Signal on error ; Signal on Syntax ; Signal on Halt
 6 ! 'EXECIO * DISKR $DASD$ CONSTS S (FINIS'
 7 ! do queued()-oq
 8 !    parse pull line 1 type 4
 9 !    Select
10 !     When type='blo' then do   /* Handle Blocks record */
11 !        parse var line 7 nk 8 k 9 10 devt . '=' nblks . 
12 !        if k<>'k' ! devt='' then iterate /* not a good line */
13 !        if disk.devt='' then parse value 1 disks devt with disk.devt disks
14 !        capac.nk.devt=nblks
15 !     end
16 !     When type='cyl' then do   /* Handle Cylinders record  */
17 !        parse var line '.' devt . '=' ncyls . 
18 !        capac.1cyls.devt=ncyls
19 !     end
20 !     Otherwise nop
21 !    end
22 ! end
   !
   ! /* Make report */
23 ! l=l+1;l.l='devtype     !    1K   !    2K   !     4K  !'
24 ! sep=      '------------+---------+---------+---------+'
25 ! l=l+1;l.l= sep
26 ! do while disks<>'';    parse var disks devt disks
27 !    l=l+1;l.l= devt' Bk/cyl !' right(capac.1.devt,7),
   !                           '!' right(capac.2.devt,7),
   !                           '!' right(capac.4.devt,7) '!'
28 !    l=l+1;l.l= devt' KB/cyl !' right(capac.1.devt,7),
   !                           '!' right(capac.2.devt*2,7),
   !                           '!' right(capac.4.devt*4,7) '!'
29 !    l=l+1;l.l= devt' KB/vol !' right(capac.1.devt*capac.1cyls.devt,7),
   !                   '!' right(capac.2.devt*capac.1cyls.devt*2,7),
   !                   '!' right(capac.4.devt*capac.1cyls.devt*4,7) '!'
30 !    l=l+1;l.l= sep
31 ! end
32 ! signal off Error ; 'ERASE DASD CAPACITY A' ; signal on Error
33 ! 'EXECIO' l 'DISKW DASD CAPACITY A (FINIS STEM L.'
34 ! call exit 0
   ! /*--------------------------------------------------------------------*/
35 ! ERREXIT:;EXIT:/* general (error)exit routine                          */
36 !         do i=2 to arg() ; say myname':' arg(i) ; end /* error msgs ?  */
37 !         If symbol('oq')='VAR' then 'DROPBUF'         /* Cleanup Stack */
38 !         exit arg(1)
39 ! SYNTAX: /*---we come here when SIGNAL ON SYNTAX traps an error--------*/
40 !         call errexit rc,'REXX problem in' myname mytype 'line' sigl':' ,
   !              'ERRORTEXT'(rc), sigl':'!!'SOURCELINE'(sigl)
41 ! HALT:   /*---we come here when user enters HI on terminal-------------*/
42 !         call errexit 77, myname mytype 'halted by HI command.'
43 ! ERROR:  /*---we come here when SIGNAL ON ERROR traps an error---------*/
44 !         call errexit rc, 'Retcode' rc 'from' 'CONDITION'('D')

The second solution uses CMS Pipelines:

   ! /***********************************************************************/
   ! /* List DASD capacities using maximum of CMS Pipelines.                */
   ! /***********************************************************************/
 1 ! parse upper source . . . . . . pip . 
 2 ! if pip='?' then signal calcul                            /* pipe stage */
 3 ! address command
 4 ! out=0
 5 ! 'PIPE (end ?)' !< $DASD$ CONSTS S',                   /* read the file */
   !     '!CY:FIND cylinders',                      /* get cylinder records */
   !     '!NFIND cylinders._',                   /* eliminate unwanted ones */
   !     '!SORT 11-14 A',                            /* sort on device type */
   !     '!SPECS 11-14 1 W3 Nextw / / N',         /* take devtype and ncyls */
   !     '!J:FANIN',                             /* combine with blocksizes */
   !     '!SNAKE 2',                         /* join records per devicetype */
 A !     '!REXX (DASDCAP3 EXEC)',           /* do calculations in sub-stage */
   !     '!LITERAL ------------+---------+---------+---------+',
   !     '!LITERAL Devtype     :   1 K   :   2 K   :   4 K   :',
   !     '!> DASD CAPACITY A?',                           /* output to stem */
   !  'CY:!FIND blocks',               /* second stream, find block records */
   !     '!NFIND blocks512',                     /* eliminate unwanted ones */
   !     '!NFIND blocks.',
   !     '!NFIND blocks1k._',
   !     '!NFIND blocks2k._',
   !     '!NFIND blocks4k._',
   !     '!SORT 10-13 A 7-7 A',            /* sort on devtype and blocksize */
   !     '!SPECS W3 1',                            /* take number of blocks */
   !     '!JOIN 2 / /',              /* combine 1k, 2k and 4k to one record */
   !     '!J:'                               /* send them to primary stream */
 8 ! exit
   ! /***********************************************************************/
 9 ! CALCUL:
10 ! 'READTO REC'
11 ! do while rc=0                         /* while there are still records */
12 !    parse var rec dtype ncyl k1 k2 k4 . 
13 !    'OUTPUT' left(dtype,4) 'Bl/Cyl !'right(k1,8),
   !                                  '!'right(k2,8),
   !                                  '!'right(k4,8)' !'
14 !    'OUTPUT' left(dtype,4) 'KB/Cyl !'right(k1,8),
   !                                  '!'right(k2*2,8),
   !                                  '!'right(k4*4,8)' !'
15 !    'OUTPUT' left(dtype,4) 'KB/Vol !'right(ncyl*k1,8),
   !                                  '!'right(ncyl*k2*2,8),
   !                                  '!'right(ncyl*k4*4,8)' !'
16 !    'OUTPUT ------------+---------+---------+---------+'
17 !    'READTO REC'
18 ! end
19 ! return

We won't elaborate on this solution, except for this: it is another example of a self-contained procedure.  At line A, the Pipeline calls a user-written stage, which is part of our main procedure itself.  With the parse source instruction, we are able to analyze the 7th parameter, and if it has the value ?, it implies that our procedure was called by a PIPE command, so we jump to the subroutine. 

See you all back in the CMS Pipeline Telecourse then ?