TITLE 'IKJEFLPA -- TOD && DATE TEXT PREPARATION' 71000120 * GENERATE; 71000220 FLPA TITLE 'IKJEFLPA -- TOD && TEXT PREPARATION -- MODULE PROLOGUE *71000320 && SPECIFICATIONS' 71000420 LCLA &T,&SPN,&LDAY(12),&I,&LNDESCR 71000520 LCLC &LUPDAT 71000620 &SPN SETA 1 OBTAIN DYNAMIC AREA FROM SUBPOOL 1 71000720 &LUPDAT SETC '70166' DATE OF LAST MODULE UPDATE 71000820 IKJEFLPA START 0 FORCE ASSIGNMENT OF ADDRESSES TO IKJEFLPA FIRST 71000920 * /*******************************************************************/ 71001020 * /* */ 71001120 * /* STATUS -- */ 71001220 * /* RELEASE 20, MODIFICATION LEVEL 01 */ 71001320 * /* A 0-999999 S20032 */ 71001420 * /* C 21974 */ 71001520 * /* */ 71001620 * /* FUNCTION -- */ 71001720 * /* THIS MODULE ACCEPTS TWO BUFFERS AS INPUT AND FORMATS THE TWO */ 71001820 * /* INTO THE FORM OF TEXT INSERTION BUFFERS CONTAINING THE TIME */ 71001920 * /* OF DAY IN THE FORMAT 'HH:MM:SS' AND THE DATE IN THE FORMAT */ 71002020 * /* 'MONTH DAY, YEAR' */ 71002120 * /* */ 71002220 * /* ENTRY POINTS -- */ 71002320 * /* IKJEFLPA */ 71002420 * /* */ 71002520 * /* INPUT -- */ 71002620 * /* R1 = THE ADDRESS OF A TYPE I PARAMETER LIST CONSISTING OF TWO*/ 71002720 * /* POINTERS, THE FIRST OF WHICH MUST CONTAIN THE ADDRESS OF*/ 71002820 * /* A WRITABLE BUFFER AT LEAST 22 BYTES IN LENGTH; THIS */ 71002920 * /* BUFFER IS KNOWN AS THE TIME-OF-DAY OR TOD BUFFER WITHIN */ 71003020 * /* THIS MODULE. THE SECOND POINTER MUST CONTAIN THE */ 71003120 * /* ADDRESS OF A WRITABLE BUFFER AT LEAST 22 BYTES IN */ 71003220 * /* LENGTH; THIS BUFFER IS KNOWN AS THE DATE BUFFER WITHIN */ 71003320 * /* THIS MODULE. */ 71003420 * /* R13 = THE ADDRESS OF A 72-BYTE SAVE AREA */ 71003520 * /* R14 = THE ADDRESS TO WHICH CONTROL SHOULD BE RETURNED */ 71003620 * /* R15 = THE ADDRESS OF THE ENTRY POINT OF IKJEFLPA */ 71003720 * /* */ 71003820 * /* OUTPUT -- */ 71003920 * /* R1 = ADDRESS OF INPUT PARAMETER LIST. THE TOD BUFFER HAS BEEN*/ 71004020 * /* PROVIDED WITH A LENGTH FIELD AND TEXT DESCRIBING THE */ 71004120 * /* TIME OF DAY, AND THE DATE BUFFER HAS BEEN PROVIDED WITH */ 71004220 * /* A LENGTH FIELD AND TEXT DESCRIBING THE DATE. */ 71004320 * /* R13 = THE SAME VALUE AS ON INPUT */ 71004420 * /* R14 = THE SAME VALUE AS ON INPUT */ 71004520 * /* R15 = THE SAME VALUE AS ON INPUT */ 71004620 * /* */ 71004720 * /* EXTERNAL REFERENCES -- */ 71004820 * /* NONE */ 71004920 * /* */ 71005020 * /* EXITS, NORMAL -- */ 71005120 * /* INVOKER */ 71005220 * /* */ 71005320 * /* EXITS, ERROR -- */ 71005420 * /* NONE */ 71005520 * /* */ 71005620 * /* TABLE/WORK AREAS -- */ 71005720 * /* NONE */ 71005820 * /* */ 71005920 * /* ATTRIBUTES -- */ 71006020 * /* REENTRANT, REFRESHABLE */ 71006120 * /* */ 71006220 * /* NOTES -- */ 71006320 * /* SEE THE FOLLOWING SPECIFICATIONS FOR A MORE DETAILED */ 71006420 * /* DESCRIPTION OF THE MODULE. THIS MODULE IS CHARACTER CODE */ 71006520 * /* DEPENDENT ON THE INTERNAL CONFIGURATION OF THE EBCDIC */ 71006620 * /* CHARACTERS. REASSEMBLY IS NECESSARY IF A DIFFERENT */ 71006720 * /* CHARACTER SET IS TO BE USED DURING EXECUTION. */ 71006820 * /* */ 71006920 * /*******************************************************************/ 71007020 * /* START OF SPECIFICATIONS **** 71007120 *1MODULE-NAME = IKJEFLPA 71007220 * 2PROCESSOR = BSL 71007320 ** THE RELEASE FOR WHICH THIS MODULE WAS MOST RECENTLY UPDATED 71007420 *1STATUS = 20 MODIFICATION LEVEL 00 71007520 *1DESCRIPTIVE-NAME = TOD & TEXT PREPARATION 71007620 *1DESCRIPTION = THIS MODULE ACCEPTS TWO BUFFERS AS INPUT AND FORMATS - 71007720 *THE TWO INTO THE FORM OF TEXT INSERTION BUFFERS CONTAINING THE TIME - 71007820 *OF DAY IN THE FORMAT 'HH:MM:SS' AND THE DATE IN THE FORMAT 'MONTH - 71007920 *DAY, YEAR' 71008020 *1ASSUMPTIONS = OS/360 OPERATING ENVIRONMENT 71008120 *1FUNCTION = SEE DESCRIPTION 71008220 *1MODULE-TYPE = PROCEDURE 71008320 *1MODULE-SIZE = 1024 BYTES 71008420 *1CODE-ATTRIBUTES = REENTERABLE 71008520 *1LOAD-ATTRIBUTES = SCATTER, REFRESHABLE 71008620 *1ENTRY-POINT = IKJEFLPA 71008720 * 2LINKAGE = LINK 71008820 * * THE FOLLOWING DESCRIBES THE REQUIRED INPUT TO THIS MODULE. 71008920 * * DATA MADE AVAILABLE THROUGH THE STANDARD INVOCATION SEQUENCE 71009020 * * BUT NOT USED IN ANY WAY IS NOT NECESSARILY MENTIONED HERE. 71009120 * 2PARAMETER-RECEIVED = POINTER-TO-PARAMETER-LIST 71009220 * 2HOW-PASSED = REGISTER 1 71009320 * 2LENGTH-OF-LIST = 8 BYTES 71009420 * *****************************************************************/ 71009520 * /***************************************************************** 71009620 * 3FIELD = PARAM1 71009720 * 4REFERENCE-TYPE = READ 71009820 * 4DISPLACEMENT = 0 BYTES 71009920 * 4TYPE = ADDRESS 71010020 * 4ADDRESS-LENGTH = 32 BITS 71010120 * 4ADDRESS-OF = TOD 71010220 * 5REFERENCE-TYPE = WRITE 71010320 * 5TYPE-ADDRESSED = TABLE 71010420 * 5PURPOSE = PROVIDE ADDRESSIBILITY TO A BUFFER TO BE - 71010520 * FORMATTED INTO A TEXT INSERTION BUFFER CONTAINING THE TIME - 71010620 * OF DAY 71010720 * 5SCOPE = INTERNAL 71010820 * 5TABLE-SIZE = 12 BYTES 71010920 * *************************************************************/ 71011020 * /************************************************************* 71011120 * 5FIELD = TODLEN 71011220 * 6REFERENCE-TYPE = WRITE 71011320 * 6DISPLACEMENT = 0 BYTES 71011420 * 6TYPE = ARITHMETIC 71011520 * 6MODE = BINARY 71011620 * 6LENGTH = 15 BITS 71011720 * 6SIGN = SIGNED 71011820 * 6VALUE = IGNORED ON INPUT. 71011920 * *************************************************************/ 71012020 * /************************************************************* 71012120 * 5FIELD = TODOFF 71012220 * 6DISPLACEMENT = 2 BYTES 71012320 * 6TYPE = ARITHMETIC 71012420 * 6MODE = BINARY 71012520 * 6LENGTH = 15 BITS 71012620 * 6SIGN = SIGNED 71012720 * 6VALUE = IGNORED ON INPUT. 71012820 * *************************************************************/ 71012920 * /************************************************************* 71013020 * 5FIELD = TODTXT 71013120 * 6REFERENCE-TYPE = WRITE 71013220 * 6DISPLACEMENT = 4 BYTES 71013320 * 6TYPE = CHARACTER STRING 71013420 * 6LENGTH+MODE = 8 CHARACTERS 71013520 * 6VALUE = IGNORED ON INPUT. 71013620 * *****************************************************************/ 71013720 * /***************************************************************** 71013820 * 3FIELD = PARAM2 71013920 * 4REFERENCE-TYPE = READ 71014020 * 4DISPLACEMENT = 4 BYTES 71014120 * 4TYPE = ADDRESS 71014220 * 4ADDRESS-LENGTH = 32 BITS 71014320 * 4ADDRESS-OF = DATE 71014420 * 5REFERENCE-TYPE = WRITE 71014520 * 5TYPE-ADDRESSED = TABLE 71014620 * 5PURPOSE = PROVIDE ADDRESSIBILITY TO A BUFFER TO BE - 71014720 * FORMATTED INTO A TEXT INSERTION BUFFER CONTAINING THE DATE 71014820 * 5SCOPE = INTERNAL 71014920 * 5TABLE-SIZE = 22 BYTES 71015020 * *************************************************************/ 71015120 * /************************************************************* 71015220 * 5FIELD = DATELEN 71015320 * 6REFERENCE-TYPE = WRITE 71015420 * 6DISPLACEMENT = 0 BYTES 71015520 * 6TYPE = ARITHMETIC 71015620 * 6MODE = BINARY 71015720 * 6LENGTH = 15 BITS 71015820 * 6SIGN = SIGNED 71015920 * 6VALUE = IGNORED ON INPUT. 71016020 * *************************************************************/ 71016120 * /************************************************************* 71016220 * 5FIELD = DATEOFF 71016320 * 6DISPLACEMENT = 2 BYTES 71016420 * 6TYPE = ARITHMETIC 71016520 * 6MODE = BINARY 71016620 * 6LENGTH = 15 BITS 71016720 * 6SIGN = SIGNED 71016820 * 6VALUE = IGNORED ON INPUT. 71016920 * *************************************************************/ 71017020 * /************************************************************* 71017120 * 5FIELD = DATETXT 71017220 * 6REFERENCE-TYPE = WRITE 71017320 * 6DISPLACEMENT = 4 BYTES 71017420 * 6TYPE = CHARACTER STRING 71017520 * 6LENGTH+MODE = 18 CHARACTERS 71017620 * 6VALUE = IGNORED ON INPUT. 71017720 **********************************************************************/ 71017820 * /******************************************************************** 71017920 *1EXIT = INVOKER 71018020 * 2CONDITIONS-WHEN-TAKEN = ALWAYS 71018120 * 2LINKAGE = RETURN 71018220 * * THE FOLLOWING DESCRIBES THE OUTPUT OF THIS MODULE. 71018320 * * DATA MADE AVAILABLE TO THE FOLLOWING MODULE AS A 71018420 * * RESULT OF THE CURRENT IMPLEMENTATION BUT NOT GUARANTEED 71018520 * * TO THAT MODULE IS NOT ENUMERATED. 71018620 * 2PARAMETER-RETURNED = POINTER-TO-PARAMETER-LIST 71018720 * 2HOW-PASSED = REGISTER 1 71018820 * 2LENGTH-OF-LIST = 8 BYTES 71018920 * *****************************************************************/ 71019020 * /***************************************************************** 71019120 * 3FIELD = PARAM1 71019220 * 4REFERENCE-TYPE = READ 71019320 * 4DISPLACEMENT = 0 BYTES 71019420 * 4TYPE = ADDRESS 71019520 * 4ADDRESS-LENGTH = 32 BITS 71019620 * 4ADDRESS-OF = TOD 71019720 * 5REFERENCE-TYPE = WRITE 71019820 * 5TYPE-ADDRESSED = TABLE 71019920 * 5PURPOSE = DESCRIBE THE TIME OF DAY IN THE FORM 'HH:MM:SS'. 71020020 * 5REMARKS-ON-USE = THIS BUFFER IS IN SUITABLE CONDITION TO - 71020120 * BE USED AS A TEXT-INSERTION BUFFER EXCEPT FOR THE TODOFF - 71020220 * FIELD WHICH MAY BE SUPPLIED BY THE INVOKER EITHER BEFORE - 71020320 * OR AFTER INVOKING IKJEFLPA. 71020420 * 5SCOPE = INTERNAL 71020520 * 5TABLE-SIZE = 12 BYTES 71020620 * *************************************************************/ 71020720 * /************************************************************* 71020820 * 5FIELD = TODLEN 71020920 * 6REFERENCE-TYPE = WRITE 71021020 * 6DISPLACEMENT = 0 BYTES 71021120 * 6TYPE = ARITHMETIC 71021220 * 6MODE = BINARY 71021320 * 6LENGTH = 15 BITS 71021420 * 6SIGN = SIGNED 71021520 * 6VALUE = 12 71021620 * *************************************************************/ 71021720 * /************************************************************* 71021820 * 5FIELD = TODOFF 71021920 * 6DISPLACEMENT = 2 BYTES 71022020 * 6TYPE = ARITHMETIC 71022120 * 6MODE = BINARY 71022220 * 6LENGTH = 15 BITS 71022320 * 6SIGN = SIGNED 71022420 * 6VALUE = SAME AS ON INPUT. 71022520 * *************************************************************/ 71022620 * /************************************************************* 71022720 * 5FIELD = TODTXT 71022820 * 6REFERENCE-TYPE = WRITE 71022920 * 6DISPLACEMENT = 4 BYTES 71023020 * 6TYPE = CHARACTER STRING 71023120 * 6LENGTH+MODE = 8 CHARACTERS 71023220 * 6VALUE = TIME OF DAY IN THE FORM 'HH:MM:SS'. 71023320 * *****************************************************************/ 71023420 * /***************************************************************** 71023520 * 3FIELD = PARAM2 71023620 * 4REFERENCE-TYPE = READ 71023720 * 4DISPLACEMENT = 4 BYTES 71023820 * 4TYPE = ADDRESS 71023920 * 4ADDRESS-LENGTH = 32 BITS 71024020 * 4ADDRESS-OF = DATE 71024120 * 5REFERENCE-TYPE = WRITE 71024220 * 5TYPE-ADDRESSED = TABLE 71024320 * 5PURPOSE = DESCRIBE THE DATE IN THE FORM 'MONTH DAY, YEAR'. 71024420 * 5REMARKS-ON-USE = THIS BUFFER IS IN SUITABLE CONDITION TO - 71024520 * BE USED AS A TEXT-INSERTION BUFFER EXCEPT FOR THE DATEOFF - 71024620 * FIELD WHICH MAY BE SUPPLIED BY THE INVOKER EITHER BEFORE - 71024720 * OR AFTER INVOKING IKJEFLPA. 71024820 * 5SCOPE = INTERNAL 71024920 * 5TABLE-SIZE = 22 BYTES 71025020 * *************************************************************/ 71025120 * /************************************************************* 71025220 * 5FIELD = DATELEN 71025320 * 6REFERENCE-TYPE = WRITE 71025420 * 6DISPLACEMENT = 0 BYTES 71025520 * 6TYPE = ARITHMETIC 71025620 * 6MODE = BINARY 71025720 * 6LENGTH = 15 BITS 71025820 * 6SIGN = SIGNED 71025920 * 6VALUE = LENGTH OF TEXT-INSERTION BUFFER CONTENTS. - 71026020 * 15-22 BYTES 71026120 * *************************************************************/ 71026220 * /************************************************************* 71026320 * 5FIELD = DATEOFF 71026420 * 6DISPLACEMENT = 2 BYTES 71026520 * 6TYPE = ARITHMETIC 71026620 * 6MODE = BINARY 71026720 * 6LENGTH = 15 BITS 71026820 * 6SIGN = SIGNED 71026920 * 6VALUE = SAME AS ON INPUT. 71027020 * *************************************************************/ 71027120 * /************************************************************* 71027220 * 5FIELD = DATETXT 71027320 * 6REFERENCE-TYPE = WRITE 71027420 * 6DISPLACEMENT = 4 BYTES 71027520 * 6TYPE = CHARACTER STRING 71027620 * 6LENGTH+MODE = 18 CHARACTERS 71027720 * 6VALUE = DATE IN THE FORM 'MONTH DAY, YEAR' 71027820 **********************************************************************/ 71027920 * /******************************************************************** 71028020 *1EXTERNAL-MACRO = IEFDCL1 71028120 * 2PURPOSE = PROVIDE PRE-PROCESSOR VARIABLE DECLARATIONS 71028220 * 2PARAMETER-PASSED = NONE 71028320 **********************************************************************/ 71028420 * /******************************************************************** 71028520 *1EXTERNAL-MACRO = IEFDCL2 71028620 * 2PURPOSE = PROVIDE DECLARATIONS OF REGISTERS, A SAVEAREA, AND A - 71028720 * TYPE 1 PARAMETER LIST 71028820 * *******************************************************************/ 71028920 * /******************************************************************* 71029020 * 2PARAMETER-PASSED = REGISTER 71029120 * 2HOW-PASSED = KEYWORD 71029220 * 2TYPE = ARITHMETIC 71029320 * 2MODE = BINARY 71029420 * 2LENGTH = 31 BITS 71029520 * 2SIGN = SIGNED 71029620 * 2VALUE = 1. THIS CAUSES IEFDCL2 TO PROVIDE A MAPPING OF THE - 71029720 * GENERAL PURPOSE REGISTERS. 71029820 * *******************************************************************/ 71029920 * /******************************************************************* 71030020 * 2PARAMETER-PASSED = R0STAT 71030120 * 2HOW-PASSED = KEYWORD 71030220 * 2TYPE = CHARACTER STRING 71030320 * 2LENGTH+MODE = 32767 BYTES 71030420 * 2VALUE = 'RESTRICTED' 71030520 * *******************************************************************/ 71030620 * /******************************************************************* 71030720 * 2PARAMETER-PASSED = R1STAT 71030820 * 2HOW-PASSED = KEYWORD 71030920 * 2TYPE = CHARACTER STRING 71031020 * 2LENGTH+MODE = 32767 BYTES 71031120 * 2VALUE = 'RESTRICTED' 71031220 * *******************************************************************/ 71031320 * /******************************************************************* 71031420 * 2PARAMETER-PASSED = R4TYPE 71031520 * 2HOW-PASSED = KEYWORD 71031620 * 2TYPE = CHARACTER STRING 71031720 * 2LENGTH+MODE = 32767 BYTES 71031820 * 2VALUE = 'FIXED(15)' 71031920 * *******************************************************************/ 71032020 * /******************************************************************* 71032120 * 2PARAMETER-PASSED = R5TYPE 71032220 * 2HOW-PASSED = KEYWORD 71032320 * 2TYPE = CHARACTER STRING 71032420 * 2LENGTH+MODE = 32767 BYTES 71032520 * 2VALUE = 'FIXED(15)' 71032620 * *******************************************************************/ 71032720 * /******************************************************************* 71032820 * 2PARAMETER-PASSED = SAVEAREA 71032920 * 2HOW-PASSED = KEYWORD 71033020 * 2TYPE = ARITHMETIC 71033120 * 2MODE = BINARY 71033220 * 2LENGTH = 31 BITS 71033320 * 2SIGN = SIGNED 71033420 * 2VALUE = 1. THIS CAUSES IEFDCL2 TO PROVIDE A MAPPING OF A SAVEAREA. 71033520 * *******************************************************************/ 71033620 * /******************************************************************* 71033720 * 2PARAMETER-PASSED = PARAM 71033820 * 2HOW-PASSED = KEYWORD 71033920 * 2TYPE = ARITHMETIC 71034020 * 2MODE = BINARY 71034120 * 2LENGTH = 31 BITS 71034220 * 2SIGN = SIGNED 71034320 * 2VALUE = 1. THIS CAUSES IEFDCL2 TO PROVIDE A MAPPING OF A TYPE I - 71034420 * PARAMETER LIST. 71034520 **********************************************************************/ 71034620 * /******************************************************************** 71034720 *1SYSTEM-MACROS = TIME, GETMAIN, FREEMAIN 71034820 *1INTERNAL-PROCEDURES = NONE 71034920 * 71035020 **** END OF SPECIFICATIONS ***/ 71035120 */*IKJEFLPA: CHART (DTYPE,AMODE,IBM68,NSAVE,NSEQ) */ 71035220 */* HEADER 71035320 */*IKJEFLPA -- TOD & DATE TEXT INSERTION BUFFER PREPARATION */ 71035420 */*IKJEFLPA: E BUFFER PREPARATION FUNCTION */ 71035520 * GENERATE; 71035620 IKJEFLPA CSECT 71035720 PA000100 B PA000300-PA000100(0,R15) BRANCH AROUND IDENTIFIER 71035820 ** /* 71035920 DC AL1(L'PA000200) LENGTH OF IDENTIFIER 71036020 ** */ 71036120 PA000200 DC C'IKJEFLPA&LUPDAT' IDENTIFIER 71036220 PA000300 DS 0H BRANCH TARGET 71036320 AGO .@001 71036420 *IKJEFLPA:PROCEDURE/*(TOD, DATE)*/ OPTIONS(REENTRANT); 71036520 LCLA &T,&SPN 0003 71036620 .@001 ANOP 0003 71036720 IKJEFLPA CSECT , 0003 71036820 STM @E,@C,12(@D) 0003 71036920 BALR @B,0 0003 71037020 @PSTART DS 0H 0003 71037120 USING @PSTART+00000,@B 0003 71037220 L @0,@SIZ001 0003 71037320 GETMAIN R,LV=(0) 0003 71037420 LR @C,@1 0003 71037520 USING @DATD+00000,@C 0003 71037620 LM @0,@1,20(@D) 0003 71037720 XC @TEMPS(@L),@TEMPS 0003 71037820 ST @D,@SAV001+4 0003 71037920 LA @F,@SAV001 0003 71038020 ST @F,8(0,@D) 0003 71038120 LR @D,@F 0003 71038220 * GENERATE; 71038320 TITLE 'IKJEFLPA -- TOD && DATE TEXT PREPARATION -- DEFINE *71038420 VARIABLES' 71038520 DS 0H 71038620 * 71038720 * 71038820 * /*******************************************************************/ 71038920 * /* DEFINE THE GENERAL PURPOSE REGISTERS */ 71039020 * /*******************************************************************/ 71039120 * DECLARE 71039220 * R0 POINTER(31) REGISTER(0) RESTRICTED, 71039320 * /***********************************************************/ 71039420 * /* STANDARD LINKAGE CONVENTION PARAMETER LIST POINTER */ 71039520 * /***********************************************************/ 71039620 * R1 POINTER(31) REGISTER(1) RESTRICTED, 71039720 * R2 POINTER(31) REGISTER(2) UNRESTRICTED, 71039820 * R3 POINTER(31) REGISTER(3) UNRESTRICTED, 71039920 * R4 FIXED(15) REGISTER(4) UNRESTRICTED, 71040020 * R5 FIXED(15) REGISTER(5) UNRESTRICTED, 71040120 * R6 POINTER(31) REGISTER(6) UNRESTRICTED, 71040220 * R7 POINTER(31) REGISTER(7) UNRESTRICTED, 71040320 * R8 POINTER(31) REGISTER(8) UNRESTRICTED, 71040420 * R9 POINTER(31) REGISTER(9) UNRESTRICTED, 71040520 * R10 POINTER(31) REGISTER(10) UNRESTRICTED, 71040620 * R11 POINTER(31) REGISTER(11) UNRESTRICTED, 71040720 * R12 POINTER(31) REGISTER(12) UNRESTRICTED, 71040820 * /***********************************************************/ 71040920 * /* STANDARD LINKAGE CONVENTION SAVE AREA POINTER */ 71041020 * /***********************************************************/ 71041120 * R13 POINTER(31) REGISTER(13) UNRESTRICTED, 71041220 * /***********************************************************/ 71041320 * /* STANDARD LINKAGE CONVENTION RETURN POINTER */ 71041420 * /***********************************************************/ 71041520 * R14 POINTER(31) REGISTER(14) UNRESTRICTED, 71041620 * /***********************************************************/ 71041720 * /* STANDARD LINKAGE CONVENTION SUBROUTINE ENTRY POINTER */ 71041820 * /***********************************************************/ 71041920 * R15 POINTER(31) REGISTER(15) UNRESTRICTED; 71042020 * 71042120 * /*******************************************************************/ 71042220 * /* DEFINE A SAVE AREA */ 71042320 * /*******************************************************************/ 71042420 * DECLARE 71042520 * 1 SAVEAREA BASED( R13) BOUNDARY( WORD), 71042620 * /***********************************************************/ 71042720 * /* PL/I USES THIS WORD TO INDICATE THE LENGTH OF THE */ 71042820 * /* DYNAMIC STORAGE AREA REPRESENTED BY THIS SAVE AREA */ 71042920 * /***********************************************************/ 71043020 * 2 SAVEWRD1 POINTER(32), 71043120 * 3 SAVEPFLG POINTER(8), 71043220 * 3 SAVEPLGH POINTER(24), 71043320 * /***********************************************************/ 71043420 * /* POINTER TO THE PREVIOUS SAVE AREA, THE SAVE AREA OF */ 71043520 * /* THE INVOKER UNLESS THIS SUBROUTINE PROVIDES NO SAVE */ 71043620 * /* AREA OF ITS OWN */ 71043720 * /***********************************************************/ 71043820 * 2 SAVELAST POINTER(32), 71043920 * /***********************************************************/ 71044020 * /* POINTER TO THE NEXT SAVE AREA FOR ALL BUT THE LOWEST */ 71044120 * /* LEVEL SUBROUTINE ON THE STACK */ 71044220 * /***********************************************************/ 71044320 * 2 SAVENEXT POINTER(32), 71044420 * /***********************************************************/ 71044520 * /* SAVE AREA WORD FOR INPUT REGISTER 14, THE ADDRESS TO */ 71044620 * /* WHICH CONTROL IS NORMALLY TO BE RETURNED AFTER A */ 71044720 * /* SUBROUTINE HAS CONCLUDED PROCESSING. THE HIGH-ORDER */ 71044820 * /* BYTE OF THIS POINTER SHOULD BE SET TO 'FF'X IF THIS */ 71044920 * /* ROUTINE HAS CONTROL AFTER A RETURN HAS BEEN MADE FROM*/ 71045020 * /* A SUBROUTINE. */ 71045120 * /***********************************************************/ 71045220 * 2 SAVER14 POINTER(32), 71045320 * 3 SAVERETF POINTER(8), 71045420 * /***********************************************************/ 71045520 * /* SAVE AREA FOR INPUT REGISTERS 15 THROUGH 12 */ 71045620 * /***********************************************************/ 71045720 * 2 SAVER15 POINTER(32), 71045820 * 2 SAVER0 POINTER(32), 71045920 * 2 SAVER1 POINTER(32), 71046020 * 2 SAVER2 POINTER(32), 71046120 * 2 SAVER3 POINTER(32), 71046220 * 2 SAVER4 POINTER(32), 71046320 * 2 SAVER5 POINTER(32), 71046420 * 2 SAVER6 POINTER(32), 71046520 * 2 SAVER7 POINTER(32), 71046620 * 2 SAVER8 POINTER(32), 71046720 * 2 SAVER9 POINTER(32), 71046820 * 2 SAVER10 POINTER(32), 71046920 * 2 SAVER11 POINTER(32), 71047020 * 2 SAVER12 POINTER(32), 71047120 * /***********************************************************/ 71047220 * /* AREA USED BY PL/I AND BSL FOR TEMPORARY AND AUTOMATIC */ 71047320 * /* STORAGE AREAS */ 71047420 * /***********************************************************/ 71047520 * 2 SAVEXTNT CHARACTER( 8); 71047620 * 71047720 * /*******************************************************************/ 71047820 * /* DEFINE A TYPE I PARAMETER LIST */ 71047920 * /*******************************************************************/ 71048020 * DECLARE 71048120 * 1 PARAM BASED( R1) BOUNDARY( WORD), 71048220 * 2 PARAM1 POINTER(32), 71048320 * 2 PARAM2 POINTER(32), 71048420 * 2 PARAM3 POINTER(32), 71048520 * 2 PARAM4 POINTER(32), 71048620 * 2 PARAM5 POINTER(32), 71048720 * 2 PARAM6 POINTER(32), 71048820 * 2 PARAM7 POINTER(32), 71048920 * 2 PARAM8 POINTER(32), 71049020 * 2 PARAM9 POINTER(32), 71049120 * 2 PARAM10 POINTER(32), 71049220 * 2 PARAM11 POINTER(32), 71049320 * 2 PARAM12 POINTER(32), 71049420 * 2 PARAM13 POINTER(32), 71049520 * 2 PARAM14 POINTER(32), 71049620 * 2 PARAM15 POINTER(32), 71049720 * 2 PARAM16 POINTER(32), 71049820 * 2 PARAM17 POINTER(32), 71049920 * 2 PARAM18 POINTER(32), 71050020 * 2 PARAM19 POINTER(32), 71050120 * 2 PARAM20 POINTER(32), 71050220 * 2 PARAM21 POINTER(32), 71050320 * 2 PARAM22 POINTER(32), 71050420 * 2 PARAM23 POINTER(32), 71050520 * 2 PARAM24 POINTER(32), 71050620 * 2 PARAM25 POINTER(32), 71050720 * 2 PARAM26 POINTER(32), 71050820 * 2 PARAM27 POINTER(32), 71050920 * 2 PARAM28 POINTER(32), 71051020 * 2 PARAM29 POINTER(32), 71051120 * 2 PARAM30 POINTER(32); 71051220 * 71051320 * DECLARE 71051420 * /***********************************************************/ 71051520 * /* INTERNAL AUTOMATIC VARIABLES */ 71051620 * /***********************************************************/ 71051720 * 71051820 * CNVRT1 CHARACTER(8) AUTOMATIC BOUNDARY(DWORD), /*CONVERSION 71051920 * BUFFER FOR CONVERSION FROM 71052020 * DECIMAL TO BINARY, FROM DECIMAL 71052120 * TO EBCDIC, & FROM BINARY TO 71052220 * DECIMAL */ 71052320 * CNVRT2 CHARACTER(4) AUTOMATIC BOUNDARY(WORD), /*CONVERSION 71052420 * BUFFER FOR CONVERSION FROM 71052520 * DECIMAL TO EBCDIC */ 71052620 * /***********************************************************/ 71052720 * /* INTERNAL BASED VARIABLES, GENERATED CSECT VARIABLES, */ 71052820 * /* & ARGUMENTS PASSED INTO IKJEFLPA */ 71052920 * /***********************************************************/ 71053020 * 1 TOD BASED BOUNDARY(BYTE), 71053120 * 2 TODLEN FIXED(15) BOUNDARY(BYTE), 71053220 * 2 TODOFF FIXED(15) BOUNDARY(BYTE), 71053320 * 2 TODTXT CHARACTER(8) BOUNDARY(BYTE), 71053420 * DATEBUF CHARACTER(18) BASED BOUNDARY(BYTE), 71053520 * 1 DATE BASED BOUNDARY(BYTE), 71053620 * 2 DATELEN FIXED(15) BOUNDARY(BYTE), 71053720 * 2 DATEOFF FIXED(15) BOUNDARY(BYTE), 71053820 * 2 DATETXT CHARACTER(18) BOUNDARY(BYTE), 71053920 * IKJEFLPB LABEL EXTERNAL, 71054020 * PBORIGIN LABEL GENERATED, 71054120 * PBCNTURY GENERATED CHARACTER(1) BOUNDARY(BYTE), 71054220 * PBCOLON GENERATED CHARACTER(1) BOUNDARY(BYTE), 71054320 * PBCOMBL GENERATED CHARACTER(2) BOUNDARY(BYTE), 71054420 * PBCOMMA GENERATED CHARACTER(1) BOUNDARY(BYTE), 71054520 * PBBLANK GENERATED CHARACTER(1) BOUNDARY(BYTE), 71054620 * 1 PBMDESCR(12) GENERATED BOUNDARY(HWORD), 71054720 * 2 PBMLDAY FIXED(15) BOUNDARY(HWORD), 71054820 * 2 PBMLEN FIXED(15) BOUNDARY(HWORD), 71054920 * 2 PBMOFF FIXED(15) BOUNDARY(HWORD), 71055020 * PBMONTH CHARACTER(9) BASED BOUNDARY(BYTE); 71055120 */* L GET TIME OF DAY AND DATE FROM THE SYSTEM */ 71055220 * GENERATE; 71055320 TITLE 'IKJEFLPA -- TOD && TEXT PREPARATION -- IKJEFLPB EBCDIC *71055420 CHARACTERS FOR TOD && DATE' 71055520 * /******************************************************************/ 71055620 * /* DEFINE ALL CHARACTER-SET AND LANGUAGE-DEPENDENT DATA */ 71055720 * /* REQUIRED FOR IKJEFLPA OPERATION */ 71055820 * /******************************************************************/ 71055920 IKJEFLPB CSECT 71056020 PBORIGIN EQU IKJEFLPB SYNONYM FOR IKJEFLPB 71056120 PBCNTURY DC X'19' PACKED DECIMAL DIGITS FOR THE CURRENT CENTURY 71056220 PBCOLON DC C':' IMAGE OF AN EBCDIC COLON 71056320 PBCOMBL DS C', ' IMAGE OF COMMA AND BLANK 71056420 ORG PBCOMBL 71056520 PBCOMMA DC C',' IMAGE OF AN EBCDIC COMMA 71056620 PBBLANK DC C' ' IMAGE OF AN EBCDIC BLANK 71056720 &LNDESCR SETA 6 LENGTH OF PBMDESCR ARRAY ELEMENT 71056820 SPACE 71056920 * /******************************************************************/ 71057020 * /* ALLOW AT LEAST ENOUGH SPACE IN IKJEFLPB FOR 2 ARRAY */ 71057120 * /* ELEMENTS BEFORE GENERATING THE PBMDESCR ARRAY */ 71057220 * /******************************************************************/ 71057320 ORG IKJEFLPB RESET THE LOCATION COUNTER TO IKJEFLPB 71057420 DS CL(2*&LNDESCR) FORCE THE LOCATION COUNTER TO 2 TIMES *71057520 THE LENGTH OF ONE PBDESCR ARRAY ELEMENT 71057620 ORG , SET THE LOCATION COUNTER TO THE HIGHEST VALUE *71057720 IT HAS YET ASSUMED 71057820 DS 0H ALIGN PBMDESCR ARRAY ON HALFWORD 71057920 PBMDESCR DS CL&LNDESCR ARRAY ELEMENT 71058020 ORG PBMDESCR GENERATE INITIALIZED ARRAY OF *71058120 MONTH-DESCRIPTORS 71058220 &LDAY(1) SETA 31 LAST DAY OF JANUARY 71058320 &LDAY(2) SETA &LDAY(1)+28 LAST DAY OF FEBRUARY 71058420 &LDAY(3) SETA &LDAY(2)+31 LAST DAY OF MARCH 71058520 &LDAY(4) SETA &LDAY(3)+30 LAST DAY OF APRIL 71058620 &LDAY(5) SETA &LDAY(4)+31 LAST DAY OF MAY 71058720 &LDAY(6) SETA &LDAY(5)+30 LAST DAY OF JUNE 71058820 &LDAY(7) SETA &LDAY(6)+31 LAST DAY OF JULY 71058920 &LDAY(8) SETA &LDAY(7)+31 LAST DAY OF AUGUST 71059020 &LDAY(9) SETA &LDAY(8)+30 LAST DAY OF SEPTEMBER 71059120 &LDAY(10) SETA &LDAY(9)+31 LAST DAY OF OCTOBER 71059220 &LDAY(11) SETA &LDAY(10)+30 LAST DAY OF NOVEMBER 71059320 &LDAY(12) SETA &LDAY(11)+31 LAST DAY OF DECEMBER 71059420 ** /* 71059520 &I SETA 0 71059620 .PB00100 ANOP 71059720 &I SETA &I+1 71059820 DC H'&LDAY(&I)' LAST DAY OF MONTH 71059920 DC AL2(L'PB&I) LENGTH OF THE NAME OF THE MONTH 71060020 DC AL2(PB&I-IKJEFLPB) OFFSET OF THE NAME OF THE MONTH 71060120 AIF (&I LT 12).PB00100 71060220 PB1 DC C'JANUARY' ENGLISH NAME FOR 1ST MONTH IN EBCDIC 71060320 PB2 DC C'FEBRUARY' ENGLISH NAME FOR 2ND MONTH IN EBCDIC 71060420 PB3 DC C'MARCH' ENGLISH NAME FOR 3RD MONTH IN EBCDIC 71060520 PB4 DC C'APRIL' ENGLISH NAME FOR 4TH MONTH IN EBCDIC 71060620 PB5 DC C'MAY' ENGLISH NAME FOR 5TH MONTH IN EBCDIC 71060720 PB6 DC C'JUNE' ENGLISH NAME FOR 6TH MONTH IN EBCDIC 71060820 PB7 DC C'JULY' ENGLISH NAME FOR 7TH MONTH IN EBCDIC 71060920 PB8 DC C'AUGUST' ENGLISH NAME FOR 8TH MONTH IN EBCDIC 71061020 PB9 DC C'SEPTEMBER' ENGLISH NAME FOR 9TH MONTH IN EBCDIC 71061120 PB10 DC C'OCTOBER' ENGLISH NAME FOR 10TH MONTH IN EBCDIC 71061220 PB11 DC C'NOVEMBER' ENGLISH NAME FOR 11TH MONTH IN EBCDIC 71061320 PB12 DC C'DECEMBER' ENGLISH NAME FOR 12TH MONTH IN EBCDIC 71061420 TITLE 'IKJEFLPA -- TOD && DATE TEXT PREPARATION -- PREPARE *71061520 TOD BUFFER' 71061620 IKJEFLPA CSECT 71061720 ** */ 71061820 * /***********************************************************/ 71061920 * /* R0 = 'HHMMSSTQ' WHERE HH IS THE HOUR, MM IS THE */ 71062020 * /* MINUTE, SS IS THE SECOND, T IS THE TENTH OF A */ 71062120 * /* SECOND, AND Q IS THE HUNDREDTH */ 71062220 * /* R1 = '00YYDDDZ' WHERE YY IS THE YEAR DDD IS THE DAY */ 71062320 * /* AND Z IS A ZONE WHICH INDICATES A POSITIVE */ 71062420 * /* DECIMAL NUMBER */ 71062520 * /***********************************************************/ 71062620 TIME DEC OBTAIN TIME IN R0, DATE IN R1 71062720 DS 0H 71062820 * CNVRT2 = R0; /*CNVRT2 = '00HHMMSS' WHERE HH 71062920 * IS THE HOUR, MM IS THE MINUTE, 71063020 * AND SS IS THE SECOND */ 71063120 ST @0,CNVRT2 0010 71063220 * RESPECIFY( R0) UNRESTRICTED; /*ALLOW IMPLICIT REFERENCES TO 71063320 * R0 */ 71063420 * RESPECIFY( R2, R3) RESTRICTED; /*RESERVE VARIABLES FOR 71063520 * EXPLICIT REFERENCES */ 71063620 * /***********************************************************/ 71063720 * /* ESTABLISH A POINTER TO THE TIME-OF-DAY (TOD) TEXT */ 71063820 * /* INSERTION BUFFER */ 71063920 * /***********************************************************/ 71064020 * R2 = SAVELAST -> SAVER1 -> PARAM1; 71064120 L @8,4(0,@D) 0013 71064220 L @8,24(0,@8) SAVEAREA 0013 71064320 L @2,0(0,@8) 0013 71064420 * RESPECIFY( TOD) BASED(R2); 71064520 * R3 = ADDR(IKJEFLPB); /*ESTABLISH A POINTER TO 71064620 * IKJEFLPB */ 71064720 L @9,@V1 ADDRESS OF IKJEFLPB 0015 71064820 LR @3,@9 0015 71064920 */* P PLACE TOD IN BYTES 7-12 OF BUFFER */ 71065020 * GENERATE; 71065120 USING IKJEFLPB,R3 TELL THE ASSEMBLER HOW TO FIND *71065220 IKJEFLPB 71065320 SPACE 71065420 * /************************************************************ 71065520 * PLACE TOD IN BYTES 7-12 OF BUFFER 71065620 * ************************************************************/ 71065720 MVO CNVRT1(4),CNVRT2(3) SHIFT OUT TENTHS OF SECONDS DIGIT 71065820 UNPK TODTXT+2-TOD(6,R2),CNVRT1(4) CONVERT TIME OF DAY TO *71065920 CHARACTER FORMAT 71066020 MVZ TODTXT+7-TOD(1,R2),TODTXT+2-TOD(R2) INSERT PROPER ZONE *71066120 FIELD INTO THE FINAL SECONDS DIGIT 71066220 DS 0H 71066320 * /***********************************************************/ 71066420 */* P SET LENGTH OF TOD BUFFER */ 71066520 * /***********************************************************/ 71066620 * TODLEN = 12; 71066720 MVC 0(2,@2),@D1 0017 71066820 * 71066920 * /***********************************************************/ 71067020 */* P MOVE DIGITS OF HOUR TO BYTES 5-6 OF BUFFER */ 71067120 * /***********************************************************/ 71067220 * TODTXT( 1: 2) = TODTXT( 3: 4); 71067320 MVC 4(2,@2),6(@2) 0018 71067420 * 71067520 * /***********************************************************/ 71067620 */* P MOVE COLON TO BYTE 7 OF BUFFER */ 71067720 * /***********************************************************/ 71067820 * TODTXT( 3) = PBCOLON; 71067920 MVC 6(1,@2),PBCOLON 0019 71068020 * 71068120 * /***********************************************************/ 71068220 */* P MOVE DIGITS OF MINUTE TO BYTES 8-9 OF BUFFER */ 71068320 * /***********************************************************/ 71068420 * TODTXT( 4: 5) = TODTXT( 5: 6); 71068520 MVC 7(2,@2),8(@2) 0020 71068620 * 71068720 * /***********************************************************/ 71068820 */* P MOVE COLON TO BYTE 10 OF BUFFER */ 71068920 * /***********************************************************/ 71069020 * TODTXT( 6) = PBCOLON; 71069120 MVC 9(1,@2),PBCOLON 0021 71069220 * GENERATE; 71069320 TITLE 'IKJEFLPA -- TOD && DATE TEXT PREPARATION -- PREPARE *71069420 DATE BUFFER' 71069520 DS 0H 71069620 * 71069720 * /***********************************************************/ 71069820 * /* DATE PROCESSING */ 71069920 * /***********************************************************/ 71070020 * CNVRT2 = R1; /*SET CNVRT2 TO THE DATE IN 71070120 * DECIMAL */ 71070220 ST @1,CNVRT2 0023 71070320 * RESPECIFY( R1) UNRESTRICTED; /*ALLOW IMPLICIT REFERENCES 71070420 * TO R1 */ 71070520 * 71070620 * /***********************************************************/ 71070720 * /* ESTABLISH POINTER TO DATE TEXT INSERTION BUFFER */ 71070820 * /***********************************************************/ 71070920 * R2 = SAVELAST -> SAVER1 -> PARAM2; 71071020 L @2,4(0,@8) 0025 71071120 * RESPECIFY( DATE) BASED(R2); 71071220 * 71071320 * /***********************************************************/ 71071420 * /* CNVRT1 = '000000000000DDDZ'X */ 71071520 * /***********************************************************/ 71071620 * CNVRT1( 1: 6) = CNVRT1( 1: 6) && CNVRT1( 1: 6); 71071720 XC CNVRT1(6),CNVRT1 0027 71071820 * CNVRT1( 7: 8) = CNVRT2( 3: 4); 71071920 MVC CNVRT1+6(2),CNVRT2+2 0028 71072020 * RESPECIFY( R4, R5) RESTRICTED; /*RESERVE VARIABLES FOR 71072120 * EXPLICIT REFERENCES */ 71072220 * 71072320 * /***********************************************************/ 71072420 * /* R4 = DAY OF YEAR IN BINARY */ 71072520 * /* R5 = YEAR IN BINARY */ 71072620 * /***********************************************************/ 71072720 * GENERATE; 71072820 CVB R4,CNVRT1 R4 = DAY OF YEAR IN BINARY 71072920 MVO CNVRT1+6(2),CNVRT2+1(1) CNVRT1 = YEAR IN DECIMAL 71073020 CVB R5,CNVRT1 R5 = YEAR IN BINARY 71073120 DS 0H 71073220 * 71073320 * RESPECIFY( R7) RESTRICTED; /*RESERVE VARIABLE FOR 71073420 * EXPLICIT REFERENCES */ 71073520 * 71073620 * /***********************************************************/ 71073720 */* P SET INDEX OF MONTH TO JANUARY */ 71073820 * /***********************************************************/ 71073920 * R7 = 1; 71074020 LA @7,1 0032 71074120 * 71074220 * /***********************************************************/ 71074320 */* D (YES,PA000620,NO,) 71074420 */* MONTH = JANUARY */ 71074520 * /* IF THE DAY IS WITHIN JANUARY, CONSTRUCT THE DATE TEXT*/ 71074620 * /* INSERTION BUFFER */ 71074720 * /***********************************************************/ 71074820 * IF R4 <= PBMLDAY(1) 71074920 * THEN 71075020 CH @4,PBMDESCR 0033 71075120 * GO TO PA000620; 71075220 BC 12,PA000620 0034 71075320 * 71075420 * /***********************************************************/ 71075520 */* D (YES,,NO,PA000400) 71075620 */* LEAP YEAR? */ 71075720 * /* IF THE DAY IS NOT WITHIN JANUARY AND THE YEAR IS */ 71075820 * /* DIVISIBLE BY FOUR, TREAT THE YEAR AS A LEAP YEAR */ 71075920 * /***********************************************************/ 71076020 * R5 = R5 // 4; 71076120 LR @E,@5 0035 71076220 SRDA @E,32 0035 71076320 LA @0,4 0035 71076420 DR @E,@0 0035 71076520 LR @5,@E 0035 71076620 * IF R5 = 0 71076720 * THEN 71076820 LTR @5,@5 0036 71076920 BC 07,@9FF 0036 71077020 * /*****************************************************/ 71077120 */* P DECREMENT DAY OF YEAR TO COMPENSATE FOR LONG 71077220 */* FEBRUARY */ 71077320 * /*****************************************************/ 71077420 * R4 = R4 - 1; 71077520 BCTR @4,0 0037 71077620 * 71077720 *PA000400:/***********************************************************/ 71077820 */*PA000400: P INCREMENT INDEX OF MONTH */ 71077920 * /***********************************************************/ 71078020 * R7 = R7 + 1; 71078120 @9FF EQU * 0038 71078220 PA000400 AH @7,@D2 0038 71078320 * 71078420 * /***********************************************************/ 71078520 */* D (YES,PA000600,NO,) 71078620 */* INDEX OF MONTH > 11 */ 71078720 * /***********************************************************/ 71078820 * IF R7 > 11 71078920 * THEN 71079020 CH @7,@D3 0039 71079120 * GO TO PA000600; 71079220 BC 02,PA000600 0040 71079320 * 71079420 * /***********************************************************/ 71079520 */* D (YES,PA000400,NO,) 71079620 */* DAY OF YEAR > LAST DAY OF INDEXED MONTH */ 71079720 * /***********************************************************/ 71079820 * IF R4 > PBMLDAY( R7) 71079920 * THEN 71080020 LR @1,@7 0041 71080120 MH @1,@D4 0041 71080220 CH @4,PBMDESCR-6(@1) 0041 71080320 * GO TO PA000400; 71080420 BC 02,PA000400 0042 71080520 * 71080620 * /***********************************************************/ 71080720 */* D (YES,,NO,PA000600) 71080820 */* MONTH = FEBRUARY & LEAP YEAR */ 71080920 * /***********************************************************/ 71081020 * IF R7 = 2 & R5 = 0 71081120 * THEN 71081220 CH @7,@D5 0043 71081320 BC 07,@9FE 0043 71081420 LTR @5,@5 0043 71081520 BC 07,@9FD 0043 71081620 * /*****************************************************/ 71081720 */* P INCREMENT DAY OF YEAR TO ALLOW FEBRUARY 29 DAYS */ 71081820 * /*****************************************************/ 71081920 * R4 = R4 + 1; 71082020 AH @4,@D2 0044 71082120 * RESPECIFY( R5) UNRESTRICTED; /*ALLOW IMPLICIT REFERENCES 71082220 * TO R5 */ 71082320 @9FD EQU * 0045 71082420 @9FE EQU * 0045 71082520 * 71082620 *PA000600:/***********************************************************/ 71082720 */*PA000600: P DAY OF MONTH = DAY OF YEAR - LAST DAY OF 71082820 */* PREVIOUS MONTH */ 71082920 * /***********************************************************/ 71083020 * R4 = R4 - PBMLDAY( R7 - 1); 71083120 PA000600 LR @1,@7 0046 71083220 MH @1,@D4 0046 71083320 LH @F,PBMDESCR-12(@1) 0046 71083420 LCR @F,@F 0046 71083520 AR @4,@F 0046 71083620 * RESPECIFY( R5, R6) RESTRICTED; /*RESERVE VARIABLES FOR 71083720 * EXPLICIT REFERENCES */ 71083820 *PA000620:/***********************************************************/ 71083920 */*PA000620: P MOVE NAME OF THE MONTH TO DATE BUFFER */ 71084020 * /***********************************************************/ 71084120 * R5 = PBMLEN( R7); /*R5 = LENGTH OF THE NAME OF 71084220 * THE MONTH */ 71084320 PA000620 LR @1,@7 0048 71084420 MH @1,@D4 0048 71084520 LH @5,PBMDESCR-4(@1) 0048 71084620 * R6 = ADDR( PBORIGIN) + PBMOFF( R7);/*R6 = ADDRESS OF THE NAME 71084720 * OF THE MONTH */ 71084820 LH @F,PBMDESCR-2(@1) 0049 71084920 LA @0,PBORIGIN 0049 71085020 AR @F,@0 0049 71085120 LR @6,@F 0049 71085220 * RESPECIFY( R7) UNRESTRICTED;/*ALLOW IMPLICIT REFERENCES TO A 71085320 * VARIABLE */ 71085420 * 71085520 * /***********************************************************/ 71085620 * /* MOVE NAME OF THE MONTH TO DATE BUFFER */ 71085720 * /***********************************************************/ 71085820 * DATETXT( 1: R5) = R6 -> PBMONTH( 1: R5); 71085920 LR @E,@6 0051 71086020 LR @7,@5 0051 71086120 BCTR @7,0 0051 71086220 LA @A,4(0,@2) 0051 71086320 EX @7,@MVC 0051 71086420 * R6 = ADDR( DATETXT( R5 + 1)); /*R6 = ADDRESS OF FIRST UNUSED 71086520 * CHARACTER OF DATE BUFFER */ 71086620 LA @7,1 0052 71086720 AR @7,@5 0052 71086820 LA @6,3(@7,@2) 0052 71086920 * 71087020 * /***********************************************************/ 71087120 */* P MOVE BLANK AFTER THE NAME OF THE MONTH */ 71087220 * /***********************************************************/ 71087320 * R6 -> DATEBUF( 1) = PBBLANK; 71087420 MVC 0(1,@6),PBBLANK 0053 71087520 * 71087620 * /***********************************************************/ 71087720 * /* CNVRT1 = '0000000000000DDZ'X WHERE DD IS THE DAY */ 71087820 * /* WITHIN THE MONTH AND Z IS A POSITIVE ZONE FIELD */ 71087920 * /***********************************************************/ 71088020 * GENERATE(CVD R4,CNVRT1); 71088120 CVD R4,CNVRT1 71088220 DS 0H 71088320 * RESPECIFY( R4) UNRESTRICTED; /*ALLOW IMPLICIT REFERENCES 71088420 * TO R4 */ 71088520 * /***********************************************************/ 71088620 * /* CNVRT1 = '0000000DDZ000DDZ'X */ 71088720 * /***********************************************************/ 71088820 * CNVRT1( 4: 5) = CNVRT1( 7: 8); 71088920 MVC CNVRT1+3(2),CNVRT1+6 0056 71089020 * GENERATE; 71089120 SPACE 71089220 * /***********************************************************/ 71089320 * /* CNVRT1 = '0000000DDZ000YYZ'X */ 71089420 * /***********************************************************/ 71089520 MVO CNVRT1+6(2),CNVRT2+1(1) 71089620 SPACE 71089720 * /***********************************************************/ 71089820 * /* CNVRT1 = '0000000DDZ0CCYYZ'X WHERE DD IS THE DAY OF */ 71089920 * /* THE MONTH, Z IS A POSITIVE ZONE, CC IS THE CENTURY, */ 71090020 * /* AND YY IS THE YEAR */ 71090120 * /***********************************************************/ 71090220 MVO CNVRT1+5(2),PBCNTURY 71090320 DS 0H 71090420 * 71090520 * /***********************************************************/ 71090620 */* D (YES,PA000700,NO,PA000800) 71090720 */* DAY OF MONTH < 10 */ 71090820 * /***********************************************************/ 71090920 * IF CNVRT1( 4) = '00'X 71091020 * THEN 71091120 CLI CNVRT1+3,X'00' 0058 71091220 BC 07,@9FC 0058 71091320 */*PA000700: P MOVE DIGITS OF DATE TO BUFFER. ONE DIGIT FOR DAY */ 71091420 * 71091520 *PA000700: DO; 71091620 * /*****************************************************/ 71091720 * /* DATE = '????MONTH D??CCY' || 'ZY'X WHERE D IS THE */ 71091820 * /* FINAL DIGIT OF THE DAY OF THE MONTH, CC IS THE */ 71091920 * /* CENTURY, Y IS THE FIRST DIGIT OF THE YEAR, Z IS A */ 71092020 * /* POSITIVE ZONE DIGIT, AND Y IS THE SECOND DIGIT OF */ 71092120 * /* THE YEAR */ 71092220 * /*****************************************************/ 71092320 * GENERATE(UNPK DATEBUF+1-DATEBUF(7,R6),CNVRT1+4(4)); 71092420 PA000700 UNPK DATEBUF+1-DATEBUF(7,R6),CNVRT1+4(4) 71092520 DS 0H 71092620 * /*****************************************************/ 71092720 */* P (,%A000900) 71092820 */* SET DATE BUFFER LENGTH FIELD */ 71092920 * /*****************************************************/ 71093020 * DATELEN = R5 + 12; 71093120 LA @F,12 0061 71093220 AR @F,@5 0061 71093320 ST @F,@TEMP4 0061 71093420 MVC 0(2,@2),@TEMP4+2 0061 71093520 * /*****************************************************/ 71093620 * /* R6 = ADDRESS OF THE LAST CHARACTER OF THE NAME OF */ 71093720 * /* THE MONTH WITHIN THE DATE BUFFER */ 71093820 * /*****************************************************/ 71093920 * R6 = R6 - 1; 71094020 BCTR @6,0 0062 71094120 BC 15,@9FB 0064 71094220 * END PA000700; 71094320 * 71094420 * /***********************************************************/ 71094520 * /* IF THE FIRST DIGIT OF THE DAY OF THE MONTH IS NONZERO, */ 71094620 * /* PLACE A TWO-DIGIT DAY OF THE MONTH IN THE DATE BUFFER */ 71094720 * /***********************************************************/ 71094820 * ELSE 71094920 */*PA000800: P MOVE DIGITS OF DATE TO BUFFER. TWO DIGITS FOR DAY */ 71095020 * 71095120 *PA000800: DO; 71095220 @9FC EQU * 0064 71095320 * /*****************************************************/ 71095420 * /* DATE = '????MONTH DD??CCY' || 'ZY'X WHERE DD IS */ 71095520 * /* THE DAY OF THE MONTH, CC IS THE CENTURY, Y IS */ 71095620 * /* THE FIRST DIGIT OF THE YEAR, Z IS A POSITIVE ZONE */ 71095720 * /* DIGIT, AND Y IS THE SECOND DIGIT OF THE YEAR */ 71095820 * /*****************************************************/ 71095920 * 71096020 * GENERATE(UNPK DATEBUF+1-DATEBUF(8,R6),CNVRT1+3(5)); 71096120 PA000800 UNPK DATEBUF+1-DATEBUF(8,R6),CNVRT1+3(5) 71096220 DS 0H 71096320 * 71096420 * /*****************************************************/ 71096520 */* P (,%A000900) 71096620 */* SET DATE BUFFER LENGTH FIELD */ 71096720 * /*****************************************************/ 71096820 * DATELEN = R5 + 13; 71096920 LA @F,13 0066 71097020 AR @F,@5 0066 71097120 ST @F,@TEMP4 0066 71097220 MVC 0(2,@2),@TEMP4+2 0066 71097320 * END PA000800; 71097420 * 71097520 * /***********************************************************/ 71097620 */*%A000900: P MOVE COMMA AND BLANK AFTER DIGIT(S) OF MONTH */ 71097720 * /***********************************************************/ 71097820 * R6 -> DATEBUF( 4: 5) = PBCOMBL; 71097920 @9FB MVC 3(2,@6),PBCOMBL 0068 71098020 * GENERATE; 71098120 SPACE 71098220 * /***********************************************************/ 71098320 * /* PROVIDE PROPER ZONE FIELD FOR FINAL DIGIT OF THE YEAR*/ 71098420 * /***********************************************************/ 71098520 MVZ DATEBUF+8-DATEBUF(1,R6),DATEBUF+2-DATEBUF(R6) 71098620 TITLE 'IKJEFLPA -- TOD && DATE TEXT PREPARATION -- EPILOGUE' 71098720 DS 0H 71098820 * /***********************************************************/ 71098920 */* R RETURN TO INVOKER */ 71099020 */*IKJEFLPA: END */ 71099120 * /***********************************************************/ 71099220 * RETURN; 71099320 * END IKJEFLPA 71099420 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. * 71099520 */*%INCLUDE SYSLIB (IEFDCL1 ) * 71099620 */*%INCLUDE SYSLIB (IEFDCL2 ) * 71099720 *; 71099820 @EL01 L @D,4(0,@D) 0071 71099920 LR @1,@C 0071 71100020 L @0,@SIZ001 0071 71100120 FREEMAIN R,LV=(0),A=(1) 0071 71100220 LM @E,@C,12(@D) 0071 71100320 BCR 15,@E 0071 71100420 @DATA1 EQU * 71100520 @0 EQU 00 EQUATES FOR REGISTERS 0-15 71100620 @1 EQU 01 71100720 @2 EQU 02 71100820 @3 EQU 03 71100920 @4 EQU 04 71101020 @5 EQU 05 71101120 @6 EQU 06 71101220 @7 EQU 07 71101320 @8 EQU 08 71101420 @9 EQU 09 71101520 @A EQU 10 71101620 @B EQU 11 71101720 @C EQU 12 71101820 @D EQU 13 71101920 @E EQU 14 71102020 @F EQU 15 71102120 @D1 DC H'12' 71102220 @D2 DC H'1' 71102320 @D3 DC H'11' 71102420 @D4 DC H'6' 71102520 @D5 DC H'2' 71102620 @MVC MVC 0(1,@A),0(@E) 71102720 @V1 DC V(IKJEFLPB) 71102820 DS 0F 71102920 @SIZ001 DC AL1(&SPN) 71103020 DC AL3(@DATEND-@DATD) 71103120 DS 0F 71103220 DS 0D 71103320 @DATA EQU * 71103420 R0 EQU 00000000 FULLWORD POINTER REGISTER 71103520 R1 EQU 00000001 FULLWORD POINTER REGISTER 71103620 R2 EQU 00000002 FULLWORD POINTER REGISTER 71103720 R3 EQU 00000003 FULLWORD POINTER REGISTER 71103820 R4 EQU 00000004 FULLWORD INTEGER REGISTER 71103920 R5 EQU 00000005 FULLWORD INTEGER REGISTER 71104020 R6 EQU 00000006 FULLWORD POINTER REGISTER 71104120 R7 EQU 00000007 FULLWORD POINTER REGISTER 71104220 R8 EQU 00000008 FULLWORD POINTER REGISTER 71104320 R9 EQU 00000009 FULLWORD POINTER REGISTER 71104420 R10 EQU 00000010 FULLWORD POINTER REGISTER 71104520 R11 EQU 00000011 FULLWORD POINTER REGISTER 71104620 R12 EQU 00000012 FULLWORD POINTER REGISTER 71104720 R13 EQU 00000013 FULLWORD POINTER REGISTER 71104820 R14 EQU 00000014 FULLWORD POINTER REGISTER 71104920 R15 EQU 00000015 FULLWORD POINTER REGISTER 71105020 SAVEAREA EQU 00000000 80 BYTE(S) ON WORD 71105120 SAVEWRD1 EQU SAVEAREA+00000000 FULLWORD POINTER 71105220 SAVEPFLG EQU SAVEAREA+00000000 1 BYTE POINTER 71105320 SAVEPLGH EQU SAVEAREA+00000001 3 BYTE POINTER ON WORD+1 71105420 SAVELAST EQU SAVEAREA+00000004 FULLWORD POINTER 71105520 SAVENEXT EQU SAVEAREA+00000008 FULLWORD POINTER 71105620 SAVER14 EQU SAVEAREA+00000012 FULLWORD POINTER 71105720 SAVERETF EQU SAVEAREA+00000012 1 BYTE POINTER 71105820 SAVER15 EQU SAVEAREA+00000016 FULLWORD POINTER 71105920 SAVER0 EQU SAVEAREA+00000020 FULLWORD POINTER 71106020 SAVER1 EQU SAVEAREA+00000024 FULLWORD POINTER 71106120 SAVER2 EQU SAVEAREA+00000028 FULLWORD POINTER 71106220 SAVER3 EQU SAVEAREA+00000032 FULLWORD POINTER 71106320 SAVER4 EQU SAVEAREA+00000036 FULLWORD POINTER 71106420 SAVER5 EQU SAVEAREA+00000040 FULLWORD POINTER 71106520 SAVER6 EQU SAVEAREA+00000044 FULLWORD POINTER 71106620 SAVER7 EQU SAVEAREA+00000048 FULLWORD POINTER 71106720 SAVER8 EQU SAVEAREA+00000052 FULLWORD POINTER 71106820 SAVER9 EQU SAVEAREA+00000056 FULLWORD POINTER 71106920 SAVER10 EQU SAVEAREA+00000060 FULLWORD POINTER 71107020 SAVER11 EQU SAVEAREA+00000064 FULLWORD POINTER 71107120 SAVER12 EQU SAVEAREA+00000068 FULLWORD POINTER 71107220 SAVEXTNT EQU SAVEAREA+00000072 8 BYTE(S) 71107320 PARAM EQU 00000000 120 BYTE(S) ON WORD 71107420 PARAM1 EQU PARAM+00000000 FULLWORD POINTER 71107520 PARAM2 EQU PARAM+00000004 FULLWORD POINTER 71107620 PARAM3 EQU PARAM+00000008 FULLWORD POINTER 71107720 PARAM4 EQU PARAM+00000012 FULLWORD POINTER 71107820 PARAM5 EQU PARAM+00000016 FULLWORD POINTER 71107920 PARAM6 EQU PARAM+00000020 FULLWORD POINTER 71108020 PARAM7 EQU PARAM+00000024 FULLWORD POINTER 71108120 PARAM8 EQU PARAM+00000028 FULLWORD POINTER 71108220 PARAM9 EQU PARAM+00000032 FULLWORD POINTER 71108320 PARAM10 EQU PARAM+00000036 FULLWORD POINTER 71108420 PARAM11 EQU PARAM+00000040 FULLWORD POINTER 71108520 PARAM12 EQU PARAM+00000044 FULLWORD POINTER 71108620 PARAM13 EQU PARAM+00000048 FULLWORD POINTER 71108720 PARAM14 EQU PARAM+00000052 FULLWORD POINTER 71108820 PARAM15 EQU PARAM+00000056 FULLWORD POINTER 71108920 PARAM16 EQU PARAM+00000060 FULLWORD POINTER 71109020 PARAM17 EQU PARAM+00000064 FULLWORD POINTER 71109120 PARAM18 EQU PARAM+00000068 FULLWORD POINTER 71109220 PARAM19 EQU PARAM+00000072 FULLWORD POINTER 71109320 PARAM20 EQU PARAM+00000076 FULLWORD POINTER 71109420 PARAM21 EQU PARAM+00000080 FULLWORD POINTER 71109520 PARAM22 EQU PARAM+00000084 FULLWORD POINTER 71109620 PARAM23 EQU PARAM+00000088 FULLWORD POINTER 71109720 PARAM24 EQU PARAM+00000092 FULLWORD POINTER 71109820 PARAM25 EQU PARAM+00000096 FULLWORD POINTER 71109920 PARAM26 EQU PARAM+00000100 FULLWORD POINTER 71110020 PARAM27 EQU PARAM+00000104 FULLWORD POINTER 71110120 PARAM28 EQU PARAM+00000108 FULLWORD POINTER 71110220 PARAM29 EQU PARAM+00000112 FULLWORD POINTER 71110320 PARAM30 EQU PARAM+00000116 FULLWORD POINTER 71110420 TOD EQU 00000000 12 BYTE(S) 71110520 TODLEN EQU TOD+00000000 2 BYTE INTEGER 71110620 TODOFF EQU TOD+00000002 2 BYTE INTEGER 71110720 TODTXT EQU TOD+00000004 8 BYTE(S) 71110820 DATEBUF EQU 00000000 18 BYTE(S) 71110920 DATE EQU 00000000 22 BYTE(S) 71111020 DATELEN EQU DATE+00000000 2 BYTE INTEGER 71111120 DATEOFF EQU DATE+00000002 2 BYTE INTEGER 71111220 DATETXT EQU DATE+00000004 18 BYTE(S) 71111320 PBMLDAY EQU PBMDESCR+00000000 HALFWORD INTEGER 71111420 PBMLEN EQU PBMDESCR+00000002 HALFWORD INTEGER 71111520 PBMOFF EQU PBMDESCR+00000004 HALFWORD INTEGER 71111620 PBMONTH EQU 00000000 9 BYTE(S) 71111720 DS 00000000C 71111820 @L EQU 1 71111920 @DATD DSECT 71112020 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 71112120 CNVRT1 EQU @DATD+00000072 8 BYTE(S) ON DWORD 71112220 CNVRT2 EQU @DATD+00000080 4 BYTE(S) ON WORD 71112320 DS 00000084C 71112420 @TEMPS DS 0F 71112520 @TEMP4 DC F'0' 71112620 @DATEND EQU * 71112720 IKJEFLPA CSECT , 71112820 END IKJEFLPA 71112920