还是那只鱼-newcoin's blog » 大型机资料

cobol+cics实例练习

newcoin — Tue, 19 May 2009 01:48:22 +0000

这个程序主要作用是从数据库中读取相关的学生信息，运用了cursor的fetch，由于返回结果很多，一个屏幕显示不了，需要添加翻页功能，既按F7和F8可以实现前翻和后翻的效果。在CICS中mapset上可以看到。

IDENTIFICATION DIVISION.
*
PROGRAM-ID. SECADD.
*
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 SWITCHES.
*
05 VALID-DATA-SW          PIC X(01)     VALUE ‘Y’.
88 VALID-DATA                        VALUE ‘Y’.
05   END-OF-ACCID-SW        PIC X   VALUE ‘N’.
88 END-OF-ACCID               VALUE ‘Y’.
*
01 FLAGS.
*
05 DISPLAY-FLAG        PIC X(01).
88 DISPLAY-NEW-ECINFO          VALUE ’1′.
88 DISPLAY-SPACES                VALUE ’2′.
88 DISPLAY-LOW-VALUES            VALUE ’3′.
05 SEND-FLAG           PIC X(01).
88 SEND-ERASE                    VALUE ’1′.
88 SEND-DATAONLY                 VALUE ’2′.
88 SEND-DATAONLY-ALARM           VALUE ’3′.
*
01 WORK-FIELDS.
*
05 ECINFO-SUB   PIC S9(4) COMP.
*
01 COMMUNICATION-AREA.
05 CA-TS-RECORD-COUNT             PIC   S9(4) COMP.
05 CA-FIRST-RECORD-ON-DISPLAY     PIC   S9(4) COMP.
*
01 RESPONSE-CODE                  PIC S9(8) COMP.
*
01 TEMPORARY-STORAGE-FIELDS.
05 TS-QUEUE-NAME.
10 TS-TERMINAL-ID     PIC X(4).
10 FILLER             PIC X(4) VALUE ‘ECIF’.
05 TS-ITEM-NUMBER         PIC S9(4) COMP VALUE ZERO.
*
01 ELECTIVE-COURSE-INFO.
*
77 CTYPEX   PIC   X(01) VALUE ’1′.
*
01 PERSONAL-COURSE-INFO.
*
COPY DFHAID.
*
COPY ERRPARM.
*
EXEC SQL
INCLUDE ECINFO
END-EXEC.
*
EXEC SQL
INCLUDE PECINFO
END-EXEC.
*
EXEC SQL
INCLUDE CINFO
END-EXEC.
*
EXEC SQL
INCLUDE CTINFO
END-EXEC.
*
EXEC SQL
INCLUDE THINFO
END-EXEC.

*
EXEC SQL
INCLUDE SQLCA
END-EXEC.
*
EXEC SQL
DECLARE ECINFO1 CURSOR FOR
SELECT C.CID,CName,CTime,CAddr,TName,
CHour,CCredit,ToNum,LNum
FROM CN0010.ECINFO AS E,CN0010.CINFO AS C,
CN0010.THINFO AS T,CN0010.CTINFO AS CT
WHERE C.CID = E.CID AND C.CID = CT.CID AND CT.TID = T.TID
AND C.CTYPE = :CTYPEX
END-EXEC.
*
LINKAGE SECTION.
*
01 DFHCOMMAREA    PIC X(04).
*   02   SNO   PIC X(13).
*
PROCEDURE DIVISION.
*
0000-PROCESS-ECINFO-INQUIRY.
*
EVALUATE TRUE
*
*        WHEN EIBCALEN > ZERO
*            MOVE DFHCOMMAREA TO SNO
*            MOVE LOW-VALUE TO SECMPA1O
*            MOVE ‘SECA’ TO TRANID1O
*            SET SEND-ERASE TO TRUE
*            PERFORM 1600-SEND-INQUIRY-MAP
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘SECA’ TO TRANID1O
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
MOVE ‘SECA’ TO EIBTRNID
PERFORM 1200-DELETE-TS-QUEUE
PERFORM 1300-SELECT-ECINFO-ROW
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘SECA’ TO TRANID1O
PERFORM 1300-SELECT-ECINFO-ROW
PERFORM 1400-DISPLAY-INQUIRY-RESULTS
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
*
WHEN EIBAID = DFHPF3 OR DFHPF12
EXEC CICS
XCTL PROGRAM(‘SECMENU’)
END-EXEC
*
WHEN EIBAID = DFHPF7 OR DFHPF8
PERFORM 2000-DISPLAY-SCROLLED-DATA
*
WHEN EIBAID = DFHENTER
PERFORM 1000-DISPLAY-SELECTED-ECINFO
*
WHEN OTHER
MOVE LOW-VALUE TO SECMPA1O
MOVE ‘Invalid key pressed.’ TO MSG1O
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
END-EVALUATE.
*
EXEC CICS
RETURN TRANSID(‘SECA’)
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
*
1000-DISPLAY-SELECTED-ECINFO.
*
PERFORM 1100-RECEIVE-INQUIRY-MAP
*        MOVE ‘Y’ TO VALID-DATA-SW
PERFORM 1500-ADD-ECINFO-CID
IF VALID-DATA
PERFORM 1510-ADD-ECINFO-INSERT
END-IF.
*
1100-RECEIVE-INQUIRY-MAP.
*
EXEC CICS
RECEIVE MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
INTO(SECMPA1I)
END-EXEC.
*
INSPECT SECMPA1I
REPLACING ALL ‘_’ BY SPACE.
*
1200-DELETE-TS-QUEUE.
*
MOVE EIBTRMID TO TS-TERMINAL-ID.
EXEC CICS
DELETEQ TS QUEUE(TS-QUEUE-NAME)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
AND RESPONSE-CODE NOT = DFHRESP(QIDERR)
EXEC CICS
ABEND
END-EXEC.
*
1300-SELECT-ECINFO-ROW.
*
EXEC SQL
SELECT   C.CID,CName,CTime,CAddr,TName,
CHour,CCredit,ToNum,LNum
INTO   :CCID, :CName, :CTime, :CAddr, :TName,
:CHour, :CCredit, :ToNum, :LNum
FROM CN0010.ECINFO AS E,CN0010.CINFO AS C,
CN0010.THINFO AS T,CN0010.CTINFO AS CT
WHERE C.CID=E.CID AND C.CID=CT.CID AND CT.TID=T.TID
AND C.CTYPE = :CTYPEX AND E.LNum > 0
END-EXEC.
*
IF SQLCODE = 100
MOVE ‘That course information does not exist.’ TO MSG1O
ELSE
IF SQLCODE NOT = 0
SET DISPLAY-NEW-ECINFO TO TRUE
*            PERFORM 9999-TERMINATE-PROGRAM
END-IF
END-IF.
*
1400-DISPLAY-INQUIRY-RESULTS.
*
EVALUATE TRUE
WHEN DISPLAY-NEW-ECINFO
PERFORM 1410-OPEN-ECINFO-CURSOR
PERFORM 1420-FORMAT-ECINFO-LINE
*                VARYING ECINFO-SUB FROM 1 BY 1
*                UNTIL ECINFO-SUB > 12
PERFORM 1440-CLOSE-ECINFO-CURSOR
*            MOVE SPACE        TO MSG1O
SET SEND-DATAONLY TO TRUE
WHEN DISPLAY-SPACES
SET SEND-DATAONLY-ALARM TO TRUE
WHEN DISPLAY-LOW-VALUES
SET SEND-DATAONLY-ALARM TO TRUE
END-EVALUATE.
PERFORM 1600-SEND-INQUIRY-MAP.
*
1410-OPEN-ECINFO-CURSOR.
*
EXEC SQL
OPEN ECINFO1
END-EXEC.
*
IF SQLCODE NOT = 0
PERFORM 9999-TERMINATE-PROGRAM
END-IF.
*
1420-FORMAT-ECINFO-LINE.
*
MOVE 1 TO     CA-TS-RECORD-COUNT
PERFORM 1430-FETCH-NEXT-ECINFO
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL SQLCODE = 100.
*
1430-FETCH-NEXT-ECINFO.
*
EXEC SQL
FETCH ECINFO1
INTO     :CCID, :CName, :CTime, :CAddr, :TName,
:CHour, :CCredit, :ToNum, :LNum
END-EXEC.
*
EVALUATE SQLCODE
WHEN 0
MOVE   CCID      TO     CIDX,
MOVE   CName    TO     CNameX,
MOVE   CTime    TO      CTimeX,
MOVE   CAddr    TO      CAddrX,
MOVE   TName    TO     TNameX,
MOVE   CHour    TO     CHourX,
MOVE CCredit   TO     CCreditX,
MOVE   CCredit TO     CCreditX,
MOVE    ToNum   TO     ToNumX
MOVE   LNum     TO     LNumX
*           MOVE ELECTIVE-COURSE-INFO TO SEC(ECINFO-SUB)
END-EVALUATE
*
EXEC CICS
WRITEQ TS QUEUE(TS-QUEUE-NAME)
FROM(ELECTIVE-COURSE-INFO)
END-EXEC
ADD 1 TO    CA-TS-RECORD-COUNT.
*
1440-CLOSE-ECINFO-CURSOR.
*
EXEC SQL
CLOSE ECINFO1
END-EXEC
*
MOVE 1 TO ECINFO-SUB, TS-ITEM-NUMBER
CA-FIRST-RECORD-ON-DISPLAY
MOVE LOW-VALUE TO ELECTIVE-COURSE-INFO
PERFORM 2010-MOVE-ROW-DATA-TO-MAP
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL ECINFO-SUB > 5
*
IF SQLCODE NOT = 0
PERFORM 9999-TERMINATE-PROGRAM
END-IF.
*
2000-DISPLAY-SCROLLED-DATA.
*
MOVE DFHCOMMAREA   TO COMMUNICATION-AREA.
MOVE EIBTRMID      TO TS-TERMINAL-ID.
MOVE LOW-VALUE     TO SECMPA1O.
MOVE SPACE         TO MSG1O
IF CA-TS-RECORD-COUNT = 0
MOVE ‘No record found!.’ TO MSG1O
ELSE
IF EIBAID = DFHPF7
IF CA-FIRST-RECORD-ON-DISPLAY > 5
SUBTRACT 5 FROM CA-FIRST-RECORD-ON-DISPLAY
END-IF
ELSE
IF CA-FIRST-RECORD-ON-DISPLAY + 4 < CA-TS-RECORD-COUNT

ADD 5 TO CA-FIRST-RECORD-ON-DISPLAY
END-IF
END-IF
MOVE CA-FIRST-RECORD-ON-DISPLAY TO TS-ITEM-NUMBER
PERFORM 2010-MOVE-ROW-DATA-TO-MAP
VARYING ECINFO-SUB FROM 1 BY 1
UNTIL ECINFO-SUB > 5
SET SEND-ERASE TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP.
*
2010-MOVE-ROW-DATA-TO-MAP.
*
IF TS-ITEM-NUMBER <= CA-TS-RECORD-COUNT
EXEC CICS
READQ TS QUEUE(TS-QUEUE-NAME)
INTO (ELECTIVE-COURSE-INFO)
ITEM(TS-ITEM-NUMBER)
END-EXEC
MOVE ELECTIVE-COURSE-INFO TO SEC(ECINFO-SUB)
ADD 1 TO TS-ITEM-NUMBER
ELSE
MOVE SPACE TO SEC(ECINFO-SUB).
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP.
*
1500-ADD-ECINFO-CID.
*
IF     CID1L = 0
OR   CID1I = SPACE
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘Please input the CID ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
ELSE
IF    CID1L < 10
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘The CID is wrong ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-IF
*
EXEC SQL
SELECT CID INTO :ECID
FROM CN0010.ECINFO
WHERE CID = :CID1I
END-EXEC
IF SQLCODE NOT = 0
MOVE ‘N’ TO VALID-DATA-SW
MOVE ‘The CID is wrong ‘ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-IF.
*
1510-ADD-ECINFO-INSERT.
*
MOVE   CID1I TO PECIDY
MOVE   ’123456789123′   TO SNOY
EXEC SQL
INSERT INTO CN0010.PECINFO
(CID,SID)
VALUES (:PECIDY, :SNOY)
END-EXEC
*
EVALUATE SQLCODE
WHEN 0
MOVE ‘ADD COURSE SUCCESSFULLY’ TO MSG1O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
*
EXEC SQL
UPDATE CN0010.ECINFO
SET LNum = LNum – 1
WHERE CID = :CID1I
END-EXEC
WHEN OTHER
MOVE ‘The course may have existed or CID is wrong’ to MSG1O O
SET SEND-DATAONLY TO TRUE
PERFORM 1600-SEND-INQUIRY-MAP
END-EVALUATE.
*
1600-SEND-INQUIRY-MAP.
*
MOVE ‘SECA’ TO TRANID1O
EVALUATE TRUE
WHEN SEND-ERASE
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
ERASE
END-EXEC
WHEN SEND-DATAONLY
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
DATAONLY
END-EXEC
WHEN SEND-DATAONLY-ALARM
EXEC CICS
SEND MAP(‘SECMPA1′)
MAPSET(‘SECSTA1′)
FROM(SECMPA1O)
DATAONLY
ALARM
END-EXEC
END-EVALUATE.
*
9999-TERMINATE-PROGRAM.
*
MOVE EIBRESP TO ERR-RESP.
MOVE EIBRESP2 TO ERR-RESP2.
MOVE EIBTRNID TO ERR-TRNID.
MOVE EIBRSRCE TO ERR-RSRCE.
*
EXEC CICS
XCTL PROGRAM(‘SYSERR’)
COMMAREA(ERROR-PARAMETERS)
END-EXEC.

大型机/IBM大型机简介

newcoin — Mon, 27 Apr 2009 06:16:33 +0000

大型机（mainframe）这个词，最初是指装在非常大的带框铁盒子里的大型计算机系统，以用来同小一些的迷你机和微型机有所区别。虽然这个词已经通过不同方式被使用了很多年，大多数时候它却是指system/360 开始的一系列的IBM计算机。这个词也可以用来指由其他厂商，如Amdahl, Hitachi Data Systems (HDS) 制造的兼容的系统。

80年代以来,网络化和微型化的日趋明显,传统的集中式处理和主机/哑终端模式越来越不能适应人们的需要,在这种情况下,传统的大型机和小型机都陷入了危机。为了应对危机,一些大型机和小型机改变了原先的一些功能和模式,以C/S模式中的服务器角色重新适应了人们的需求。在微型计算机、UNIX服务器、集群技术、工作站的冲击下,不能适应这种变化的传统小型机已经淘汰,而IBM大型主机却长盛不衰,这其中主要的原因是：RAS（Reliability, Availability, Serviceability 高可靠性、高可用性、高服务性），I/O处理能力以及ISA。

今日而言,大型主机在MIPS(每秒百万指令数)已经不及微型计算机(microcomputer),但是它的I/O能力、非数值计算能力、稳定性、安全性却是微型计算机所望尘莫及的。

而IBM大型机现在绝大多数用于商业应用，北美典型的行业有银行、保险、政府、交通、零售等。全球五十大银行以及500强中业务量需求较大的公司都依靠 IBM 大型机来执行世界上复杂的事务。大型机的优势是海量并发I/O, 利于在线联机交易，成千上万人同时登录。要知道现在中国的几大银行的核心系统都使用大型机，而且都集中到两个大型机系统，一个在北京，一个在上海。要不是考虑到灾难备份的因素，一个大型机系统完全可以应付过来，也就是一个系统搞定数亿人的银行交易。当然一个大型机系统是指并行处理系统（Parallel Sysplex), 参与的机器可能有好几台。每个参与的系统都可以安排在维护时段退出，以进行软件和硬件的维护。但是整个生产系统可以从来不用停止。

当然大型机的造价也是相当的昂贵，随便一台造价都是已数十亿美元计算的，所以用得起的都是一些大公司。

IEBCOPY对PDS库的压缩功能

newcoin — Wed, 22 Apr 2009 09:28:56 +0000

在大机上，JCL中的IEBCOPY语句通常用来COPY文件,这里我们主要介绍一下其对PDS库的压缩功能; 我们可能常会碰到以下问题:

很多项目组成员都在操作一个CODING共用的SOURCE库,当你要往里面添加新成员或是在修改后进行SAVE时,出现错误信息; 这时退出来后如果没有其它人使用该PDS的话可以通过在该PDS前用Z命令等来压缩,不过如果很多人还没有退出的话就压缩不了!

解决之道:

用IEBCOPY,采用下面三个STEP来提交一个JOB来例行使命!

好处就是出现存取错误信息时,不用退出编辑操作,提交下面IEBCOPY的JOB后就能很快在该PDS中进行SAVE等UPDATE操作了,避免要通知所有人都退出该PDS;

备注: 实际的JCL中,用你需要压缩的PDS名来替代下面的TARGET!

//**********************************************************************

//STEP1 EXEC PGM=IEBCOPY,REGION=2048K

//SYSPRINT DD SYSOUT=*

//INOUT1 DD DSN=TARGET,DISP=SHR

//INOUT2 DD DSN=TARGET.TMP0,

// DISP=(NEW,CATLG,DELETE),

// UNIT=SYSDA,

// SPACE=(CYL,(5,5,100),RLSE)

//SYSUT3 DD UNIT=SYSDA,SPACE=(TRK,(1))

//SYSUT4 DD UNIT=SYSDA,SPACE=(TRK,(1))

//SYSIN DD *

COPY OUTDD=INOUT2

INDD=INOUT1

//**********************************************************************

//* STEP2 — DATASET COMPRESS-IN-PLACE

//**********************************************************************

//STEP2 EXEC PGM=IEBCOPY,REGION=2048K

//SYSPRINT DD SYSOUT=*

//INOUT1 DD DSN=TARGET,DISP=SHR

//SYSUT3 DD UNIT=SYSDA,SPACE=(TRK,(1))

//SYSUT4 DD UNIT=SYSDA,SPACE=(TRK,(1))

//SYSIN DD *

COPY OUTDD=INOUT1

INDD=INOUT1

//**********************************************************************

//* STEP3 — DELETE THE TEMPERARY DATASET

//**********************************************************************

//STEP3 EXEC PGM=IEFBR14,REGION=2048K

//SYSPRINT DD SYSOUT=*

//DD1 DD DSN=TARGET.TMP0,DISP=(OLD,DELETE),

// UNIT=SYSDA

大型机ISPF必备操作指令

newcoin — Tue, 14 Apr 2009 01:33:04 +0000

1).TSO是什么？

2.Command Processor

2).ISPF是什么？

3.会话式系统

3）.在AMS HOST上，USER PASSWORD错误输入限制次数是多少？

2.3次

4）.对于JAPAN AMS的USER PASSWORD的使用期限是多少？

1.6个月

5）.如何分配一个新的顺序数据或者分区数据集？

1.TSO ALLOCATE命令

2.ISPF UTILITY 3.2.A

6）.如何向其它的用户发送数据集或者数据文件？

（文章来源：http://www.newcoin.info）

3.XMIT命令

4.TRANSMIT命令

7）.如何从其它的用户接受数据集或者数据文件？

1.RECEIVE命令

8）.如何让其它USER存取自己的数据资源？

3.PERMIT命令

9）.如何查看对数据集GROUP拥有存取权限？

4.LISTUSER

10）.如何COPY/MOVE数据集或者MEMBER文件？

1.ISPF UTILITY 3.3 2 ISPF UTILITY 3.1

4.ISPF UTILITY 3.4

11）.如何删除数据集？

1.DELETE命令2.ISPF UTILITY 3.4

（文章来源：http://www.newcoin.info）

12）.如何删除MEMBER文件？

1.DELETE命令2.ISPF UTILITY 3.4

3.ISPF UTILITY 3.1

13）.如何压缩数据集？

2.ISPF UTILITY 3.4

3.ISPF UTILITY 3.1

14）.如何查看数据集的属性信息？

1.LISTDS命令2.ISPF UTILITY 3.4

3.ISPF UTILITY 3.1 4.ISPF UTILITY 3.2

15）.如何确定分区数据集中的MEMBER编目数？

2.ISPF UTILITY 3.4

3.ISPF UTILITY 3.1 4.ISPF UTILITY 3.2

16）.在JOB LOG UTILITY操作中，一般都使用哪些基本命令?

H,I,O,DA,ST,OWNER *

17).在JOB LOG UTILITY操作中，一般都使用哪些行命令?

（文章来源：http://www.newcoin.info）

//…//C,C,P,S,?

18).如何把JOB LOG信息存到数据集中?

1.XDC行命令2.ISPF UTILITY 3.8

19).数据文件编辑用的行命令或者基本命令问题：

1.line插入命令是什么？à I,In

2.line拷贝命令是什么？à C,CC…CC,Cn

3.line删除命令是什么？à D,DD…DD,Dn

4.line移动命令是什么？à M,MM…MM,Mn

5.line覆盖命令是什么？ à OO…OO,O,On

6.line复制命令是什么？ à RR…RR,R,Rn

7.列标识表示line命令是什么？ à COLS

8.查看文件profile的基本命令是什么？ à PROFILE

9.从其它文件拷贝/移动数据的基本命令是什么？ à COPY

10.改变字符串的命令是什么？ à CHANGE

11.查找字符串的命令是什么？ à CHANGE

12.排序命令是什么？ à SORT

13.根据当前文件数据建立一个新的文件的命令是什么？àCREATE

14.查看十六进制数据的命令是什么？ à HEX ON/HEX OFF

20）.如何在指定的数据集中搜索数据？

3.ISPF UTILITY 3.14 4.ISPF UTILITY 3.15

21）.如何比较两个数据？

2.ISPF UTILITY 3.13

4.ISPF UTILITY 3.12

23）.在编辑MEMBER文件时，如果SAVE命令失败的话，该如何查找原因？

1.使用START命令打开另一个SESSION,在3.4下压缩MEMBER所在的分区数据集

2.1.不能解决的话，请查看MEMBER所在的分区数据集的MEMBER编目数是否不够？，

如果不够的话，请重新分配一个编目数足够大的分区数据集，并把旧的数据集下

的MEMBER移到新建的DATASET上，然后删除旧的数据集。

3.查看数据集有效空间是否已经没有了.

（文章来源：http://www.newcoin.info）

24）.***友情提示：

顺序文件(QSAM)

MEMBER文件

VSAM文件

文件

顺序数据集

分区数据集

扩展分区数据集

VSAM数据集(标识,INDEX,DATA)

PL/1基础入门教程

admin — Thu, 26 Mar 2009 11:43:01 +0000

一、PL/1的字符集及书写

1、PL/1的字符集

PL/1的字符集一般分为48个字符与60个字符两种，目前采用60个字符的字符集。

1.1 29个字母字符

A，B，…….,Z，＄，＠，＃

1.2 10个数字

0，1，2，3，4，5，6，7，8，9

1.3 21个专用字符（如下所示）






♀


空格 


% 


百分号




= 


等号 


; 


分号 




+ 


加号 


: 


冒号 




- 


减号 


< 


小于 




＊


星号(乘号)


> 


大于 




/ 


斜线(除号)


| 


或 




( 


左括号 


& 


与 




) 


右括号 


┒


非 




, 


逗号 


_ 


短划号




. 


小数点 


? 


问号 




’


引号

2、L/I源程序的书写

2.1源程序从第2列开始写至第72列为止

2.2每个语句(Statement)以“；”结束

2.3注释(Comment)以“/*”开始，以“*/”结束，其间可出现任何字符。

2.4第1列上的字符用作打印时的控制字符






1


:


换新页




♀


:


换一行




0


:


换二行(空一行,现换一行)




-


:


换三行(空二行,再换一行)

二、数据和表达式（DATA  and  Expression）

数据类型分两类：

n 运算型数据

A、 算术数据

a：定点十进数（Fixed　decimal  data）

b: 定点二进数(Fixed  binary  data)

B、 数值字符数据（numeric  character  data）

C、 字符串数据（String  data）

n 控制型数据

A、 文件数据（file  data）

B、 标号数据（label  data）

C、 入口数据（entry　data）

D、 定位数据(locator  data)

1、运算型数据

1.1算术数据有下列4个特性

进位制(Base)：   十进位、二进位；

记数法（scale）： 定点、浮点

精确度（precision）：（P：表示有效数位；q：表示有效小数位）

型（mode）：  实型、复型等。

1.1.1定点十进数

例:

定点十进数

3.1416

0.0012

-528

精确度

(5.4)

(3.0)

(3.0)

(4.4)

(4.0)

存储形式

(十六进制)

31,41,60

73,20

00,30

0,01,20

528,0

注:  对定点十进数(p,q)

² 占用存贮的字符数==[p/2]+1

² P最大值是15,占8个字符

² (p,q)未指明时,系统约定为(5,0)

1.1.2定点二进数

例:  定点二进数   0001 0110         11111111

十六进制表示    16               F F

十进制表示      22               - 1

注:

² 最大有效数位31,占4字符

² 未指明时系统约定值为FIXED  BIN(15), 占2字符.

² 位数低于15位的也占2字符

² 位数高于15位的,则占4字符

² 变量名以I,J,K,L,M,N开始,若未指明时,约定为FIXED  BIN(15);以其它

字母开始约定为FIXED  DEC(6)

1.2 数值字符数据

它是介于算术数据与字符串数据间的数据

数

732.10

98.7

书写

PIC ‘999’

PIC ‘999V.99’

PIC ‘99V9’

存贮形式

F1

F2

F3

F7

F3

F2

4B

F1

F0

F9

F8

F7

其中:  V表明在数据域中该位置出现一个隐含的十进位或二进位小数点.

若V后面还有“.”，表明相应数据域位置包含一个小数点

注：

u 数值字符数据主要是构成定点十进数，定点二进数可打印的形式；

u 在PIC后面引号（''）中的数字字符个数最多15个；

u 数值字符数据可进行算术运算，但须经转换；

u 如果一个数字字符定义为PIC ‘ZZZV.’,则不管此字符是否有值，都显示为“ .”。

（文章来源：http://www.newcoin.info）

1.2.1定点十进数(FD)、定点二进数（FB）和PIC间的转换

例： DCL    A     PIC‘99’

DCL    B     PIC‘99’

DCL    C     PIC‘99’

C==A+B

则为欲求得C，须经：

A FIXED  DEC，

B       FIXED  DEC

A_FD + B_FD

FIXED  DEC         PIC   赋予C

在算术运算时，必须转为FIXED  DEC 才能进行

转换表






R        C


FB


FD


PIC




FB


——


C       FB


C       FD  FD      FB




FD


R      FB


——


C       FD




PIC


R      FD 

FD     FB


R      FD


C       FD   R      FD

注：一般金额采用  FIXED  DEC

 整数采用  FIXED  BIN

 PIC用于   输入/输出 它是字符与算术数据间的桥梁。

1.3 串数据(String  data)

1.3.1 字符串数据(Character  String  data)

值           PL/1写法         存贮形式

‘ABC’ CHAR(6)        C1,C2,C3，40，40，40

‘A102’ CHAR(4)        C1,F1,F0,F2

‘A’ CHAR(4)        C1,40,40,40

²  字符串数据通常在程序内赋值时用.

例:  X==‘THIS  REPORT IS ’

²  赋值时，字符串数据括于单引号内

²  赋值时，在字符串右边不足部分，系统自动以“空白 ”符补足

例： DCL  X  CHAR（5）

 … …

 X =‘A’；  X值会是   A后跟随4个空格

² 字符串内出现单引号时，必须以两个单引号（称为Null  String）表示，否则会引起

混淆。

例：  设赋值给X，其值为：JOHN’S  CAP

 则必须写为   X==‘JOHN’’S  CAP’

（注：若写为X==‘JOHN’S  CAP’，则S  CAP’被略）

² 重复的字符串数据可用重复因子表示

例： X==（N）’BCC  ‘表示X有值为 BCC ，BCC ，…….(N个)

1) 重复因子必须放在括号内;

2) 重复因子只对紧接的一个字符生效

例:  PIC’(4)AB’ 乃表示PIC’AAAAB’

² CHARACTER  PICTURE  SPECIFICATION

PIC’9’表示数字0~9

PIC’A’表示字母A~z

PIC’X’表示任何字符

1.3.2 (二进)位串数据(BIT  String  data)

值                PL/I写法          存贮形式

‘1’B              BIT(1)            占1字符

‘1111’B           BIT(4)            占1字符

(64)’0’B          BIT(64)           占8字符

² 位串数据赋给变量是从左到右进行,若串数据长度,超过变量说明的长度,则以变量

长度为准,截去串数据右端的位;若串数据长度短于变量说明的长度,也以变量长度

为准,右边自动以0补足.

² 位串数据通常用于检查 真/假 条件

（文章来源：http://www.newcoin.info）

真    TRUE_______’1’B

假   FALSE_______’0’B

例:  DCL  EOF  BIT(1)

 --------

__在检查“真”时可写：IF   EOF=‘1’B 或   IF  EOF

—在检查“假”时可写：IF  EOF=‘0’B 或   IF  ﹁EOF

2、控制型数据

2.1文件数据(File  data):它表示PL/I文件的信息

l 它是PL/1的输入/输出文件名字

l 即JCL的输入/输出DD名字,File　name和DDname互相对应

例:  DCL    INFILE  INPUT  RECCRD   FILE

 DCL    OUTFILE  OUTPUT  STREAM  FILE

2.2标号数据(label  data)

l 作为语句标号引用

例:  LOOP:-------

   -------

   -------

 GO TO LOOP；

l 作为语句标号变量

例: DCL  CIRCLE  LABEL

 LOOP1:---------

 --------

 ---------

LOOP2:--------

 --------

 --------

CIRCLE==LOOP1；

… …

GO  TO  CIRCLE； -------->  等价于  GO  TO  LOOP1

… …

2.3 入口数据(ENTRY  Data)

——用作过程（Procedure）的入口点（entry  point）

例：A：PROC   OPTIONS（MAIN）

 … …

B：PROC；

A，B即为入口点，称为入口数据，可由CALL语句来调用   CALL B；

——用作入口变量（entry  variable）

例：DCL  A  ENTRY  VARIABLE；

DCL（A1，A2）ENTRY；

IF  X   THEN   A=A1；

ELSE   A=A2；

CALL  A；

等价于：

IF   X   THEN  CALL A1；

 ELSE  CALL A2；

2.4 定位数据(Locator  data)

根据POINTER变量所取的值作为指定的地址

例:    DCL  P   POINTER

DCL  A   CHAR(8)

DCL  X   CHAR(8)

l 基于POINTER

DCL  B  FIXED  DEC(15)  BASED(P);

P=ADDR(A)

此时B不占空间,根据P描述,也即为B 描述为FIXED  DEC(15)

若P=ADDR(X)

则B又随P描述X了,于是B是活动的,随P变化.

l 基于ADDRess

DCL  B  FIXED  DEC(7)  BASED (ADDR(A))

此时,B 是固定的,它由A的地址唯一确定

（文章来源：http://www.newcoin.info）

001500 DCL CIC1               FIXED BIN(15);

001600  DCL CIC2               FIXED BIN(15);

001700  DCL CIC3               FIXED BIN(15);

001800  DCL CIC4               FIXED BIN(15);

001900  DCL CI1PTR             POINTER;

002000 DCL CI1PTRF            FIXED BIN(31) BASED(ADDR(CI1PTR));

002100 DCL CI2PTR             POINTER;

002200 DCL CI2PTRF            FIXED BIN(31) BASED(ADDR(CI2PTR));

002300  DCL UTSCIFC            CHAR(4089) VAR;

002400  DCL 1 CIF1             BASED(ADDR(UTSCIFC)),

002500        2 CITOTL         FIXED BIN(15),  /* TOTAL RECORD LENGTH       */

002600        2 UTSCIFC_BEG_DMY

002800        2 CIIDQTY        FIXED BIN(15),  /* ID QUANTITY               */

009800        2 CIMTCAC        FIXED DEC(15),     RELATIVE MTC SAVING AC NO.*/

009810        2 CIHKDAC        FIXED DEC(15),  /* RELATIVE HKD SAVING AC NO.*/

009820        2 CIFCYAC        FIXED DEC(15),  /* RELATIVE FCY SAVING AC NO.*/

009830        2 CIPBCINT       CHAR(1),        /* PBC INT INDICATOR         */

009900        2 CIPCLASS       FIXED DEC(1),   /* PRIVILEGE CLASS           */

009910        2 CINAT          CHAR(9),        /* NATIONNALITY              */

009920        2 CICDTDAT(10)   CHAR(6),        /* TAX RATE FOR BRANCH       */

010000        2 CIHKDPVC       FIXED DEC(15,2),/* STAFF HKD PRIV.CERT TOT P */

010100        2 CIHKDP         FIXED DEC(15,2),/* HKD CERT TOTAL PRINCIPAL  */

010200        2 CIUSDP         FIXED DEC(15,2),/* USD CERT TOTAL PRINCIPAL  */

011300        2 CIIDNO(CIC1 REFER(CIIDQTY))

011410                         CHAR(19),       /* ID NUMBER                 */

011500        2 CIIDNO_END_DMY CHAR(0),

011600        2 CISIGNO(CIC2 REFER(CISIGQTY))

011700                         CHAR(8),        /* SIGNATURE NO              */

011800        2 CISIGNO_END_DMY

011900                         CHAR(0),

012000        2 CINAME         CHAR(CIC3 REFER(CINAMEL)),

012100                                         /* CUSTOMER NAME             */

012200        2 CINAME_END_DMY CHAR(0),

012300        2 CITRAILER      CHAR(1);        /* OFF SET                   */

012400  DCL 1 CIF12            BASED(CI1PTR),

012500        2 CIADDUM        CHAR(1),        /* ADDRESS                   */

012620        2 CIADDR(3)      CHAR(32);       /* ADDRESS        040717 ADD */

012700  DCL 1 CIF13            BASED(CI2PTR),

012800        2 CIACCTQ        FIXED BIN(15),  /* RELATED ACCOUNT QUANTITY  */

012900        2 CIACCT(CIC4 REFER(CIACCTQ))

013000                         FIXED DEC(15);  /* ACCOUNT NUMBER            */

013080                                         /* ' ' GET TAX RATE FROM CIN */

****** **************************** Bottom of Data ***************************

有关指针CI1PTR和指针CI2PTR的使用如下：

CI1PTR  = ADDR(CITRAILER);

CI2PTRF = CI1PTRF + 97;

（文章来源：http://www.newcoin.info）

３、数据组织（data  cyganigation）

3.1数组(array)

l 一组同属性(attribute)的数据元素

l 一个数组只有一个名字

l 数组内的各项由其在数组内的相应位置表明

一维数组

例: DCL   A(8)  FIXED  DEC(3);

 表示数组A有8个元素,每个都是FIXED的三位数字,分别称A(1),A(2),A(3),……,A(8).

二维数组

例: DCL  B(4,2)  FIXED  DEC(3);

PL/I中元素排序以“行”为主

B(1,1),B(1,2),B(2,1),B(2,2),

B(3,1),B(3,2),B(4,1),B(4,2)

界(bound)         下界        上界

数组A  1            8

数组B  1            4

数组B   1           2

范围(extent)

数组A:   8

数组B:   4,2

l 数组维数最大为15维

l 下界不为1时,上、下界必须明确写

一维数组   DCL  C（4：11） 下界为4，上界为11，范围是8。

二维数组   DCL  D（-4：3，4：11）

第一维下界为-4，上界为3

第二维下界为4， 上界为11

范围是8，8

l A(I)其中A表示数组名称(array name),I表示下标(Subscript)

下标值若非定点二进整数,则一定转为FIXED  BINARY(15)

 3.2结构(Structure)

l 有逻辑性的数据成分(data  element)的组合

l 各数据成分的属性(attribute)可以不同

l 组成形式是层次结构(hierarchy)

例:  DCL  1  PAYROLL,

 2  NAME,

3  FNAME   CHAR,

3  LNAME   CHAR，

 2  HOURS，

 3  REGULAR  FIXED  DEC，

 3  OVERTIME  FIXED  DEC

 2  RATE，

 3   REGULAR  FIXED  DEC，

 3   OVERTIME  FIXED  DEC；

注：PAYROLL是主结构（major  structure），NAME、HOURS、RATE是次结构（minor  structure），FNAME、LNAME、REGULAR、OVETTIME等是基本名字（elementary  name）

l 结构名字必须是单义唯一的，为免混淆采用限定名（qualified name）

 如    HOURS.REGULAR

RATE. EGULAR

l 结构数组(array  of  structure)

结构内是以数组出现如:

一维结构数组：DCL  1  A（8），

 2  B  CHAR（3），

 2  C  FIXED  DEC（4）；

 二维结构数组：DCL  1  A（6，6），

 2  B （4），

3  C   FIXED  BIN（4）

3   D  FIXED  BIN（4）

 2  E…….

指称元素采用限定名如  A(1,2),B(3),C

3.3其它属性(attribute)

3.3.1  DEFINE

 变量数组元素的存储位置可被其它变量(或数组元素)所定义,并可指定位置(position)

例1.      DCL  A(10,10);

DCL  B(10,10)  DEF  A;

例2.      DCL  A   CHAR(50);

DCL  B   CHAR(10)  DEF  A;

DCL  C   CHAR(15)  DEF  A  POS(11);

DCL  D   CHAR(25)  DEF  A  POS(26);

3.3.2  LIKE

 结构与结构间其结构形式、名字、属性等，可在说明语句（DECLARE）中用LIKE这个属性照抄。

 例：   DCL    1 A

 2 B

 2 C

 3 D

 3 E

 当有说明语句：

DCL  1  X  LIKE  A；

即为：DCL    1 X

 2 B

 2 C

 3 D

 3 E

可以有：

² 主结构与主结构间用LIKE属性

² 主结构与次结构间用LIKE属性

² 次结构与主结构间用LIKE属性

² 次结构与次结构间用LIKE属性

3.3.3  INIT   赋初值(可为常数、字符串、表达式等)

² 赋常数为初值

DCL  A  FIXED  DEC（5，4）  INIT（3.1416）;

² 赋字符串为初值

DCL  NAME  CHAR(B)  INIT(‘BANK  OF  CHINA’)

² 用表达式作为赋初值

DCL  B  INIT(M*N);

² 用内部函数来赋初值

DCL  DATE  BUILTIN;

DCL  YMD  PIC’99/99/99’  INIT(DATE);

² 对数组赋初值

整个数组元素： DCL  A(10)  FIXED  BIN(15)  INIT((10)0)

部分数组元素： DCL  A(15)  CHAR(10)

INIT(‘ASM’,’COBOL’,*,’PL/I’)

 则仅对A(1),A(2),A(4)分别赋初值为：ASM  COBOL  PL/I

² 对几个变量同时赋初值

DCL   (A,B,C)  FIXED  BIN(15)  INIT(0);

即同时对A，B，C赋以0

² 对一个内存进行初始化：

如：

0DCL TEST_RECORD CHAR(31);

 DCL 1 TEST_REC BASED(ADDR(TEST_RECORD)),

 2 TEST_BKNO          FIXED DEC(3),

 2 TEST_BK2C          FIXED DEC(3),

 2 TEST_CUR           CHAR(3),

 TEST_REC = ‘’；

这样可以对TEST_BKNO、TEST_BK2C、TEST_CUR按它们对应的类型进行初始化。

² 动态初始化：

DCL W                 FIXED BIN(15) INIT(REMQTY);

注：REMQTY是一个带返回值的程序。有REMQTY在编译前处理，因此REMQTY程序内用的变量最好是局部变量，特别读的COPY BOOK一定要定义为局部变量。

（文章来源：http://www.newcoin.info）

4、表达式（expression）

4.1运算符

算术运算    +，-，*，/，**

逻辑运算    ┑，|，&

比较运算 <,=,>,<=,>=,┑<,┑=,┑>

连接运算    ‖

4.2算术运算的优先级

**	*	+
**	/	-

若要更改运算的优先顺序，可采用括号或前缀符作人为规定

4.3逻辑运算

┑A

┑B

A & B

A | B

4.4比较运算

4.4.1算术比较

当运算对进行比较时，若进位制、精确度、型等不同则先进行数据转换

4.4.2字符比较

从左到右逐个字符相比

4.4.3位（二进位）的比较

从左到右逐位进行比较

注：1.　不同长的串进行比较时，把短者延长与长者相等后再作比较，

字符，延长部分是以空格补足

二进位，延长部分是以“0”B补足

2. 优先顺序

属性相同时：代数的、字符的、二进位的

属性不同时：二进位的、字符的、代数的

 例：BIT与　FIXED  DEC  作比较

则BIT -->　FIXED  BIN和FIXED DEC -->  FIXED BIN再相比

3. 比较结果以BIT的一位表示

真-------’1’B        假-------’0’B

4.5 连接运算

把串（字符串、二进位字符串）进行合并的运算，

但若BIT与CHAR进行此运算，BIT一定要转换成CHAR再作合并。

4.6运算符的优先顺序

**，prefix+, prefix-,┑

*,/

infix+, infix-

‖

<,┑<,<=,=,┑=,>=,>,┑>

4.7数组表达式(Harray  Expression)

4.7.1数组是由一组数据元素组成,而IF语句是只试验单一条件,所以数组不能用于IF语句里.

 例:  设A为数组

 则只能有IF  A(I)……THEN 其中A(I)为A的某一元素,

不能写IF  A…… THEN…….

4.7.2数组的运算

例:设数组A(3,2)

 则 A*3的结果是:A(1,1)*3, A(1,2)*3,

 A(2,1)*3,A(2,2)*3,

 A(3,1)*3,A(3,2)*3

 若B=A*3 则B必须与A有相同的界和范围

² A+-B  对应元素相加、减

² A*/B  对应元素相乘、除

4.8结构表达式(Structure  expression)

4.8.1 结构与变量的运算,即是结构中基本名字与变量进行相应运算

例: DCL  1 A

 2 B

 3 C

 3 D

 2 E

 3 F

设A * X即  A.C * X

 A.D * X

 A.F * X

4.8.2 结构与结构的运算,两结构的组成形式应一样,结果是:两结构的相应基本名字作所规定的运算.

 例: DCL  1   A

 2 B

3 C

3 D

2 E

3 F

 DCL  1   X

  2 Y

3 V

3 W

2 Z

3 P

 求A*X  结果是:  C*V

D*W

F*P

（文章来源：http://www.newcoin.info）

4.8.3结构和结构的赋值

将一个结构的某些元素的数据赋给另一结构内,同名的元素(用BY NAME 的赋值语句)

例: DCL      1   A

2  B

2  C

3 D

3 E

   2  F

   2  G

 DCL  1   X

   2  C

   3  D

3 W

 2  F

2 Z

3 P

 若  X=A   BY  NAME;

 则  X.C.D=A.C.D

 X.F=A.F

4.8.4数组与结构的表达式

例:  DCL  1 A

2B

2C

DCL  X(2)

DCL  Y(2)  LIKE  A

为求   Y=X+A

计算结果是:   Y(1).B=X(1)+A.B

Y(2).B=X(2)+A.B

Y(1).C=X(1)+A.C

Y(2).C=X(2)+A.C

♀	空格	%	百分号
=	等号	;	分号
+	加号	:	冒号
-	减号	<	小于
＊	星号(乘号)	>	大于
/	斜线(除号)	\|	或
(	左括号	&	与
)	右括号	┒	非
,	逗号	_	短划号
.	小数点	?	问号
’	引号

1	:	换新页
♀	:	换一行
0	:	换二行(空一行,现换一行)
-	:	换三行(空二行,再换一行)

R C	FB	FD	PIC
FB	——	C FB	C FD FD FB
FD	R FB	——	C FD
PIC	R FD FD FB	R FD	C FD R FD

还是那只鱼-newcoin's blog » 大型机资料

cobol+cics实例练习

大型机/IBM大型机 简介

IEBCOPY对PDS库的压缩功能

大型机ISPF必备操作指令

PL/1基础入门教程

大型机/IBM大型机简介