//IBMUSERS JOB (ACCT#),COB2SYS,
// NOTIFY=&SYSUID,
// CLASS=A,MSGCLASS=X,COND=(0,NE)
//*
//COB2 EXEC PGM=IGYCRCTL				IBM COBOL II
 CBL NOLIB,APOST,NODECK,OBJECT,NOSEQ,NONAME
 CBL NOMAP,NOLIST,NOOFFSET,NOXREF
       Identification Division.
         Program-ID. Cob2Sys.
         Author. Gilbert Saint-Flour.
      *----------------------------------------------------------------*
      *                                                                *
      *    This program retrieves specific system-related data from    *
      *    MVS control blocks and moves it to Working-storage.         *
      *                                                                *
      *    The name of the control-block is indicated in pos 1-6 of    *
      *    the Procedure Division lines.                               *
      *    The layout of the MVS control blocks is described in the    *
      *    MVS Data Areas manuals, which can be found on any MVS or    *
      *    OS/390 CD collection or viewed on-line by going to:         *
      *        http://www.s390.ibm.com/bookmgr-cgi/bookmgr.cmd/library *
      *    and searching for:                                          *
      *        MVS DATA AREAS                                          *
      *                                                                *
      *   Origin = http://gsf-soft.com/Freeware/                       *
      *                                                                *
      *----------------------------------------------------------------*
       Data Division.
        Working-Storage Section.
         01 Results.
           05 sys-name Pic x(8).
           05 real-storage-m Pic s9(6) comp.
           05 prodi Pic x(8).
           05 prodn Pic x(8).
           05 mdl Pic 9999.
           05 smf-name Pic x(4).
           05 ipl-jdate Pic 9(7) comp-3.
           05 SU-sec Pic s9(6) comp.
           05 cpu-type Pic x(6).
           05 cpu-model Pic x(3).
           05 sysplex-name  Pic x(8).
           05 os390-release Pic 9(6).
           05 hardware-name Pic x(8).
           05 lpar-name Pic x(8).
           05 VM-userid Pic x(8).
         01 four-bytes.
           05 full-word Pic s9(8) Comp.
           05 ptr4      Redefines full-word Pointer.
           05 pl4       Redefines full-word Pic 9(7) comp-3.
        Linkage Section.
         01 cb1.  05 ptr1 Pointer Occurs 512.
         01 cvt.  05 cvt1 Pointer Occurs 512.

       Procedure Division.
 PSA       SET ADDRESS OF cb1 TO NULL
 CVT       SET ADDRESS OF cvt TO ptr1(5)
           MOVE cvt(341:8) TO sys-name
           MOVE cvt(857:4) TO four-bytes
           COMPUTE real-storage-m = (full-word + 1023) / 1024
           DISPLAY ' SYSNAME='  sys-name
           DISPLAY ' STOR='     real-storage-m 'M'
CVTFIX     SET ptr4 to ADDRESS OF cvt
           SUBTRACT 256 FROM full-word
           SET ADDRESS OF cb1 TO ptr4
           MOVE cb1(217:8) TO prodi
           MOVE cb1(225:8) TO prodn
           MOVE ZERO to pl4
           MOVE cb1(251:2) TO four-bytes(1:2)
           COMPUTE mdl = pl4 / 1000
           DISPLAY ' PRODI=' prodi
           DISPLAY ' PRODN=' prodn
           DISPLAY ' MODEL=' mdl
 SMCA      SET ADDRESS OF cb1 TO cvt1(50)
           MOVE cb1(17:4) TO smf-name
           MOVE cb1(341:4) TO four-bytes
           COMPUTE ipl-jdate = pl4 + 1900000
           DISPLAY ' SMFSID='   smf-name
           DISPLAY ' IPL='      ipl-jdate
 RMCT      SET ADDRESS OF cb1 TO cvt1(152)
           MOVE cb1(65:4) TO four-bytes
           COMPUTE SU-sec = 16000000 / full-word
           DISPLAY ' Speed='   SU-sec ' SU/s'
 HID       SET ADDRESS OF cb1 TO cvt1(268)
           MOVE cb1(27:6) TO cpu-type
           MOVE cb1(33:3) TO cpu-model
           DISPLAY ' CPU='     cpu-type '-' cpu-model
 ECVT      SET ADDRESS OF cb1 TO cvt1(36)
           MOVE cb1(9:8) TO sysplex-name
           MOVE cb1(337:8) TO hardware-name
           MOVE cb1(345:8) TO lpar-name
           MOVE cb1(353:8) TO VM-userid
           MOVE cb1(513:6) TO os390-release
           DISPLAY ' SYSPLEX=' sysplex-name
           DISPLAY ' HWNAME='  hardware-name
           DISPLAY ' LPAR='    lpar-name
           DISPLAY ' VM='      VM-userid
           DISPLAY ' OS/390='  os390-release
           GOBACK.
/*
//SYSUT1 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT2 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT3 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT4 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT5 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT6 DD UNIT=VIO,SPACE=(TRK,1)
//SYSUT7 DD UNIT=VIO,SPACE=(TRK,1)
//SYSLIN DD UNIT=VIO,SPACE=(TRK,1),DISP=(,PASS),BLKSIZE=3200
//SYSPRINT DD SYSOUT=*
//*
//GO    EXEC PGM=LOADER,PARM=PRINT
//SYSLIN DD DSN=*.COB2.SYSLIN,DISP=(OLD,PASS)
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSLOUT DD SYSOUT=*
//SYSOUT DD SYSOUT=*