example Cobol program that calls a routine.
the routine returns a field containing two subfields (binary of 64 bits)
that contain the seconds since 01.01.1972 (the first) and from 01.01.1979
(the second).
IDENTIFICATION DIVISION.
PROGRAM-ID. PRd1970.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 D1970 PIC X(8) VALUE 'D1970'.
01 sd18.
************** secondi da 01/01/1972
02 sd72 PIC s9(18) binary.
************** secondi da 01/01/1970
02 sd70 PIC s9(18) binary.
01 zd18.
02 zd1872 PIC zzzzzzzzzzzzzzz9.
02 filler PIC x value '-'.
02 zd1870 PIC zzzzzzzzzzzzzzz9.
02 filler PIC x value '.'.
procedure division.
call d1970 using sd18
move sd72 to zd1872
move sd70 to zd1870
display zd18
stop run.
D1970 RSECT
D1970 AMODE 31
D1970 RMODE ANY
BAKR 14,0
XR 4,4
ICM 4,15,0(1) . TS ADDR
STCK 0(4) . STORE NEW CLOCK
LG 7,0(4) . IN R6
XR 6,6
LARL 1,X1972
LG 8,0(1)
SGR 7,8
SRLG 7,7,12
LARL 1,MILIONE
LG 8,0(1)
XR 6,6
DSGR 6,8
STG 7,0(4)
LARL 1,A1970
LG 8,0(1)
SGR 7,8
STG 7,8(4)
XR 15,15
PR
PR
MILIONE DC FL8'1000000'
A1970 DC FL8'6307200'
X1972 DC XL8'8126D60E46000000'
END
Aldo Crosio
tel: 051-4991812 /3488858416
fax: 051-6255762
CSE Consorzio Servizi Bancari
Società consortile a responsabilità limitata
Via Emilia n. 272
40068-San Lazzaro di Savena (BO)
Ai sensi del D.Lgs. 196/2003 si precisa che le informazioni contenute nel
presente messaggio, corredato dei relativi allegati, sono strettamente
riservate ed a uso esclusivo dei destinatari. Qualora Le fosse pervenuto per
errore, La invitiamo ad eliminarlo immediatamente, dandocene gentilmente
comunicazione. Grazie.
------------ *** ------------ *** ------------ *** ------------
