GSIMOVER CSECT 00010014 *************************************************************** 00011085 * THIS PROGRAMS READS A FILE AND LOADS THE TSCACMRB WITH EACH 00012085 * RECORD. THE FILE IS LEFT OPEN (EVEN WHEN PROGRAM EXITS) 00013088 * UNTIL PROGRAM IS CALLED AGAIN AND EOF IS REACHED. 00013188 * 00013288 * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00013388 * !! RETURN CODES ARE SENT BACK THRU TSCAUFBL !! 00014088 * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00014188 * 00014288 * TSCAUFBL = 0 RECORD RETURNED THRU TSCACMRB 00015085 * = 4 EOF HIT 00016085 * = 12 FILE IS EMPTY 00017085 * = 16 FATAL ERROR (YOU PROBABLY WILL GET A BAD ABEND 00018088 * INSTEAD OF THIS, BUT I'LL TRY ANYWAY 00019088 * INPUT DDNAME = RECIN, LRECL = 512, BLOCK = 5120, RECFM = FB 00019185 **************************************************************** 00019285 PRINT GEN OR PRINT GEN 00020051 *******STANDARD STARTUP************************************************ 00021084 STM R14,R12,12(R13) SAVE ALL CALLER REGS IN CALLER AREA 00022000 LR R12,R15 GET ENTRY ADDRESS TO MY PROG 00023000 USING GSIMOVER,R12 SET BASE R12 00024014 LA R8,SAVEAREA GET SAVE AREA ADDRESS 00025000 ST R13,4(R8) SAVE CALLER SAVE AREA ADDRESS 00026000 ST R8,8(R13) SAVE MINE TOO 00027000 LR R13,R8 NOW LET R13 POINT TO MINE 00028000 B START 00028185 DC CL20'BOB BARNES 3/9/93 ' 00028285 DC CL20' VERSION 1.0 ' 00028391 DC CL20'DD=RECIN 512/5120 FB' 00028491 *******END***********END*********************************************** 00028584 START L R8,0(R1) GET PARAM POINTER 00028685 USING TSCA,R8 LINK TSCA DSECT 00028700 * 00028800 * WTO '-----STARTING GSIMOVER ',ROUTCDE=11 00028988 L R4,TSCAUFLD RECORD COUNTER 00029084 LA R5,TSCAUFLD 00029157 LA R6,BLANK4 00029257 CLC 0(1,R5),0(R6) IF EQUAL TO X40 THEN FIRST TIME 00029384 BNE ADD1 ELSE SKIP FILE OPEN 00029484 * WTO 'THEY WERE = ',ROUTCDE=11 00029588 *************************************** 00029688 * OPEN INPUT FILE AND SET UP DCB. * 00029788 * THE FILE WILL REMAIN OPEN EVEN WHEN * 00029888 * PROGRAM EXITS UNTIL EOF IS HIT * 00029988 *************************************** 00030088 L R4,FZERO INITIALIZE RECORD COUNTER 00030184 LA R5,DCBEND SET ADDR OF END OF DCB 00030284 LA R0,DCB SET ADDR OF BEGINNING OF DCB 00030384 SR R5,R0 R5 = R5 - R0 00030484 LA R5,8(R5) GET SIZE OF DCB 00030584 GETMAIN R,LV=(R5) GET STORAGE 00030684 ST R5,0(R1) STORE SIZE INTO R1 00030784 BCTR R5,R0 00030871 EX R5,MVC MVC = MVC 8(0,1),DCB 00030984 LR R6,R1 R1 NOW HAS DCB INFO 00031084 ST R6,TSCAUPTR STORE IT INTO TSCAUPTR 00031184 LA R6,8(R6) 00031271 OPEN ((R6),INPUT) OPEN THE FILE 00031384 LOAD EP=GSIMOVER LOAD ME 00031484 ************** FILE IS OPEN **************************** 00031572 ADD1 A R4,ONE ADD 1 TO RECORD COUNTER 00031784 ST R4,TSCAUFLD STORE IT 00031884 L R6,TSCAUPTR GET DCB INFO 00031984 LA R5,8(R6) GET DCB ADDR 00032084 USING IHADCB,R5 SET UP ADDRESSING INTO IHADCB 00032184 LA R7,EOF TELL DCB WHERE EOF IS 00032384 ST R7,DCBEODAD DITTO 00032484 DROP 5 00032682 READ GET (5),LINERCD GET A RECORD 00032784 * CLEAR OUT CMRB 00032888 MVI TSCACMRB,C' ' CLEAR OUT THE CMRB 00033384 MVC TSCACMRB+1(255),TSCACMRB 00033483 MVC TSCACMRB+256(256),TSCACMRB+256 00033583 * LOAD CMRB AND SET SIZE 00033688 MVC TSCACMOF,=F'512' SIZE OF CMRB 00033784 MVC TSCACMRB+0(256),LINERCD LOAD THE CMRB 00033884 MVC TSCACMRB+256(256),LINERCD+256 LOAD THE CMRB 00033984 * SNAP OPEN (SS,OUTPUT) 00034091 ************************************************** 00034188 * CHECK FOR BLANK FIELDS (,1, IS OK; , , IS NOT) * 00034288 ************************************************** 00034388 SR R9,R9 INTIALIZE COUNTER TO ZERO 00034591 LA R7,TSCACMRB SET START ADDRESS OF LINE 00034888 * SNAP SNAP DCB=SS,ID=1,PDATA=REGS * DEBUG * 00034991 CLI 0(R7),COMMA OOPS! FIRST CHAR IS A COMMA, THIS 00035089 BNE CLOOP IS NOT ALLOWED, BLANK IT OUT 00035189 MVI 0(R7),BLANK 00035289 CLOOP CL R9,TSCACMOF SEE IF WE ARE AT THE END OF LINE 00035491 BE CLEANUP YES, DONE, EXIT PROGRAM 00035591 A R9,ONE NO, START LOOKING FOR COMMA 00035691 A R7,ONE 00035791 * SNAP SNAP DCB=SS,ID=3,PDATA=REGS * DEBUG * 00035891 CLI 0(R7),COMMA 00035987 BNE CLOOP 00036086 A R9,ONE FOUND A COMMA 00036291 A R7,ONE 00036391 CLI 0(R7),BLANK IS NEXT CHAR A BLANK? 00036488 BE WATCH YES, SEE IF ALL BLANKS 00036588 B CLOOP NO, GO BACK AND LOOK FOR NEXT COMMA 00036688 WATCH CL R9,TSCACMOF SEE IF WE ARE AT THE END OF LINE 00036791 BE CLEANUP YES, DONE, EXIT PROGRAM 00036891 A R9,ONE 00037091 A R7,ONE 00037191 CLI 0(R7),COMMA FOUND ANOTHER COMMA WITH ALL LEADING 00037288 BE BLNKFD BLANKS, THIS IS BAD, FIX IT 00037388 CLI 0(R7),BLANK FOUND ANOTHER BLANK, STILL LOOKING 00037488 BE WATCH FOR A COMMA, CHK NEXT CHAR.... 00037588 B CLOOP 00037686 BLNKFD S R7,ONE BACK UP ONE CHAR AND INSERT A 00037791 S R9,ONE HAT (^) 00037891 MVI 0(R7),HAT 00038087 B CLOOP FIXED UP, LOOP BACK TO NEXT CHAR 00038188 ********************************************** 00038288 * WRAP UP SECTION * 00038388 ********************************************** 00038488 EOF MVC TSCAUFBL,=F'4' DONE, EOF 00038584 BCT R4,WRAP IF R4 = 1 (NO RECS), 00038685 MVC TSCAUFBL,=F'12' FILE WAS EMPTY 00038784 WRAP L R6,TSCAUPTR GET DCB INFO 00038884 LA R5,8(R6) GET DCB ADDR 00038984 CLOSE ((R5)) CLOSE THE FILE 00039084 DELETE EP=GSIMOVER DELETE ME 00039184 L R0,0(R6) 00039271 FREEMAIN R,LV=(R0),A=(6) RELEASE STORAGE 00039384 B CLEANUP RESET REGS 00039484 KILL MVC TSCAUFBL,=F'16' 00039583 * SNAP CLOSE (SS) 00039791 CLEANUP L R13,4(R13) LOAD CALLER SAVE AREA BACK TO REG13 00039891 LM R14,R12,12(R13) RESTORE ALL CALLER REGS 00039900 SR R15,R15 ZEROS R15 - RETURN CODE 00040000 BR R14 00040100 DBUG DS 0H 00040216 LR R2,R0 00040316 MVC DBUGWORK(2),1(R2) 00040416 UNPK DBUGCHAR(5),DBUGWORK(3) 00040516 TR DBUGCHAR(4),DBUGTBL-240 00040616 MVC DBUGWTO+8+33(4),DBUGCHAR 00040716 DBUGWTO WTO 'SYNAD ENTERED, EXCEPTION VALUE = ', X00040817 ROUTCDE=11 00040916 ABEND 1234 00041016 MVC MVC 8(0,1),DCB 00041174 *********************************************************************** 00041200 R0 EQU 0 00041300 R1 EQU 1 00041400 R2 EQU 2 00041500 R3 EQU 3 00041600 R4 EQU 4 00041700 R5 EQU 5 00041800 R6 EQU 6 00041900 R7 EQU 7 00042000 R8 EQU 8 00042100 R9 EQU 9 00042200 R10 EQU 10 00042300 R11 EQU 11 00042400 R12 EQU 12 00042500 R13 EQU 13 00042600 R14 EQU 14 00042700 R15 EQU 15 00042800 DS 0F INSURE DOUBLEWORD BOUNDARIES 00042900 SAVEAREA DS 18F REGISTER SAVE AREA 00043016 DBUGWORK DS CL3 00043116 DBUGCHAR DS CL5 00043216 DBUGTBL DC C'0123456789ABCDEF' 00043316 RNID DS F 00043404 LINERCD DS 2CL256 00043576 SP DS F 00043664 COMMA EQU C',' 00043787 HAT EQU C'^' 00043887 BLANK EQU C' ' 00043987 ONE DC F'1' 00044054 FZERO DC F'0' 00044158 BLANK4 DC 8X'40404040' 00044257 DUM DS F 00044504 DCB DCB DDNAME=RECIN,DSORG=PS,MACRF=GM, X00044683 RECFM=FB,LRECL=512,BLKSIZE=5120,SYNAD=KILL 00044783 DCBEND DS 0D 00044871 * SS DCB DSORG=PS,RECFM=VBA,MACRF=(W),LRECL=125,BLKSIZE=882, 00044991 * SNAP DDNAME=SNAP 00045091 DCBD DSORG=PS,DEVD=DA 00045174 ***************************************************************** 00045200 ** 00045300 ** TERMINAL SIMULATOR COMMUNICATIONS AREA 00045400 ** 00045500 ***************************************************************** 00045600 TSCA DSECT * TERMINAL SIMULATOR COMM AREA 00045700 DS 0F 00045800 TSCAACRN DS CL4 * "TSCA" ACRONYM 00045900 TSCAFRET DS F * FUNCTION RETURN CODE 00046000 TSCAFRES DS F * FUNCTION REASON CODE 00046100 TSCACPNL DS CL8 * THE CURRENT INFO/ PANEL NAME 00046200 TSCALFID DS CL8 * THE REC ID OF LAST FILED RECORD 00046300 TSCACRID DS CL8 * THE REC ID OF CURRENT RECORD 00046400 TSCAUFLD DS CL8 * USER DEFINABLE FIELD 00046500 TSCAMSGC DS F * THE # OF MESSAGES ON MSG CHAIN 00046600 TSCACPOS DS F * BYTE # OF STRING FOUND IN TESTFIELD 00046700 TSCATPLC DS F * # OF LINES ON THE CURRENT TABLE PNL 00046800 TSCATPLN DS F * LINE # OF THE CURR. LINE ON TBL PNL 00046900 TSCAMTBL DS F * MAX. DATA LEN. ALLOWED FOR TSCATBLL 00047000 TSCACTBL DS F * CURRENT LENGTH OF DATA IN TSCATBLL 00047100 TSCATBLL DS CL256 * CURRENT TABLE PANEL LINE 00047200 TSCAVDA DS 0CL12 * VARIABLE DATA AREA 00047300 TSCAVDAM DS F * MAX. LEN. OF VARIABLE DATA AREA 00047400 TSCAVDAL DS F * CURRENT LEN. OF VARIABLE DATA AREA 00047500 TSCAVDAP DS A * ADDRESS OF THE VARIABLE DATA AREA 00047600 TSCAFB DS 0CL8 * FLATTEN BUFFER INFO 00048000 TSCAFBL DS F * SIZE OF THE FLATTEN BUFFER 00049000 TSCAFBP DS A * -> FLATTEN BUFFER 00050000 TSCAUFB DS 0CL8 * UNFLATTEN BUFFER INFO 00051000 TSCAUFBL DS F * SIZE OF THE UNFLATTEN BUFFER 00051100 TSCAUFBP DS A * -> UNFLATTEN BUFFER 00051200 TSCAUPTR DS A * FULL WORD PTR RESERVED FOR USER 00051300 *************************************************************** 00051400 ** 00051500 ** FIELDS TSCAVPHR, TSCARSWD, TSCARPWD, TSCASDFL AND TSCASDF 00051600 ** ARE USED BY THE FINDSDATA AND FINDSJRNL FUNCTIONS 00051700 ** 00051800 *************************************************************** 00051900 TSCAVPHR DS 0CL20 * VIS. PHRASE RET. BY FSD,FSJ 00052000 TSCAVPHL DS F * LENGTH OF THE VISIBLE PHRASE 00053000 TSCAVPH DS CL16 * THE ASSOCIATED VISIBLE PHRASE 00054000 TSCARSWD DS 0CL14 * S-WORD RET. BY FINDSATA,FINDSJRNL 00055000 TSCARSDL DS F * ACTUAL RETURNED S-WORD LENGTH 00056000 TSCARSD DS CL10 * ACTUAL RETURNED S-WORD VALUE 00057000 TSCARRBL DS H * TSCARRB DATA LENGTH 00058000 TSCARPWD DS 0CL14 * P-WORD RET. BY FINDSATA,FINDSJRNL 00059000 TSCARPDL DS F * ACTUAL RETURNED P-WORD LENGTH 00060000 TSCARPD DS CL10 * ACTUAL RETURNED P-WORD VALUE 00070000 TSCARSV9 DS CL2 * RESERVED 00080000 TSCASDFL DS F * LENGTH OF STRUCTURED DATA 00090000 TSCASDF DS CL256 * STRUCT. DATA-TEXT OR S/PWORD DATA 00100000 TSCACMOF DS F * OFFSET IN COMMAND BUFF. NEXT BYTE 00110000 TSCACMRB DS 2CL256 * COMMAND LINE REPLY BUFFER 00120000 TSCARRB DS 2CL256 * RESIDUAL REPLY BUFFER 00130000 *************************************************************** 00140000 ** 00150000 ** TERMINAL SIMULATION CONTROL 00160000 ** 00170000 *************************************************************** 00180000 TSCACLIN DS 0CL208 * CONTROL LINES 00190000 TSCAFUNC DS CL10 * FUNCTION NAME 00200000 TSCA0FLG DS XL1 * CONTROL FLAG "0" 00210000 TSCA0VAR EQU X'80' * A: GET VARIABLE DATA 00220000 TSCA0FST EQU X'40' * B: FIND FIRST OR NEWEST OCC FSD,FJR 00230000 TSCA0LST EQU X'20' * C: FIND LAST OR OLDEST OCC FSD,FJR 00240000 TSCA0FLO EQU X'10' * D: TESTFLOW: 0=PANEL 1=MESSAGE 00250000 TSCA0FND EQU X'08' * E: FIND STRING ANYWHERE 00260000 TSCA0TRO EQU X'04' * F: TRACE CONTROL LINES 00270000 TSCA0TRL EQU X'02' * G: TRACE LINK FUNCTION 00280000 TSCAMODL EQU X'01' * H: WHEN SET USER ELSE IBM EXIT 00290000 TSCA1FLG DS XL1 * CONTROL FLAG "1" 00300000 TSCA1ANL EQU X'80' * I: APPLY NOT LOGIC 00310000 TSCA1STG EQU X'40' * J: TREAT AS STRING DATA 00320000 TSCA1PNL EQU X'20' * K: PRINT THE CURRENT PANEL 00330000 TSCA1MSG EQU X'10' * L: PRINT THE MESSAGE CHAIN 00340000 TSCA1TSC EQU X'08' * M: PRINT THE TSCA 00350000 TSCA1CRD EQU X'04' * N: FLATTEN CURRENT RECORD 00360000 TSCA1LRD EQU X'02' * O: FLATTEN LAST RECORD FILED 00370000 TSCA1RET EQU X'01' * P: RETAIN RECORD ID, UNFLATTEN 00380000 TSCA2FLG DS XL1 * CONTROL FLAG "2" 00390000 TSCA2RS1 EQU X'80' * RESERVED 00400000 TSCA2SGM EQU X'40' * R: SAVE GENERATED MESSAGE 00410000 TSCA2IDT EQU X'20' * S: INSERT DATA TYPE, HEX = ON 00420000 TSCA2RSV EQU X'1F' * RESERVED 00430000 TSCA3FLG DS XL1 * CONTROL FLAG "3" - RESERVED 00440000 TSCASHDR DS 0CL13 * S-WORD INFORMATION 00450000 TSCASIX DS H * S-WORD INDEX 00460000 TSCASWDL DS XL1 * S-WORD DATA LENGTH 00470000 TSCASWD DS CL10 * S-WORD DATA 00480000 TSCARSV1 DS XL1 * RESERVED 00490000 TSCAPHDR DS 0CL9 * PWORD INFORMATION 00500000 TSCAPIX DS H * PWORD INDEX 00510000 TSCAPFXL DS XL1 * PREFIX LENGTH 00520000 TSCAPFX DS CL6 * ACTUAL PREFIX 00530000 TSCARSV2 DS XL1 * RESERVED 00540000 TSCAVHDR DS 0CL33 * VALIDATION DATA INFORMATION 00550000 TSCAVALL DS XL1 * VALIDATION DATA LENGTH 00560000 TSCAVAL DS CL32 * VALIDATION DATA 00570000 TSCARSV3 DS XL1 * RESERVED 00580000 TSCANHDR DS 0CL13 * NEW S-WORD INFORMATION 00590000 TSCANSIX DS H * NEW S-WORD INDEX 00600000 TSCANSDL DS XL1 * NEW S-WORD DATA LENGTH 00610000 TSCANSWD DS CL10 * NEW S-WORD DATA 00620000 TSCARSV4 DS XL1 * RESERVED 00630000 TSCATFLD DS 0CL13 * TSCA FIELD INFORMATION 00640000 TSCAFLD DS CL8 * TSCA FIELD NAME 00650000 TSCAATTR DS XL1 * FIELD ATTRIBUTE - SEE CONSTANT 00660000 TSCAMASK DS XL1 * MASK OFFSET TO TSCA BIT 00670000 TSCAFLEN DS H * TSCA FIELD LENGTH 00680000 TSCAOFFS DS H * OFFSET TO TSCA FIELD 00690000 TSCARSV5 DS XL1 * RESERVED 00700000 TSCAIFLL DS XL1 * SETFIELD FIELD LENGTH 00710000 TSCALHDR DS 0CL33 * LITERAL/TEST DATA INFO 00720000 TSCALITL DS XL1 * LITERAL DATA / TEST DATA LENGTH 00730000 TSCALIT DS CL32 * LITERAL DATA / TEST DATA 00740000 TSCANLHD DS 0CL33 * NEW DATA INFORMATION 00750000 TSCANDAL DS XL1 * NEW DATA LENGTH 00760000 TSCANDAT DS CL32 * NEW DATA 00770000 TSCALABE DS 0CL10 * CONTROL LINE LABEL INFORMATION 00780000 TSCATNUM DS H * TARGET CONTROL LINE OF BRANCH 00790000 TSCALABL DS CL8 * LABEL NAME 00800000 TSCAPANL DS CL8 * PANEL NAME/ MESSAGE ID 00810000 TSCAFUEX DS CL8 * FUNCTION EXIT NAME 00820000 TSCAVNAM DS CL8 * VERIFY NAME 00830000 TSCAIFLD DS CL8 * PANEL INPUT FROM SETFIELD 00840000 TSCANPHD DS 0CL9 * NEW P-WORD INFORMATION 00850000 TSCANPIX DS XL2 * NEW P-WORD INDEX 00860000 TSCANPFL DS XL1 * NEW P-WORD LENGTH 00870000 TSCANPFX DS CL6 * ACTUAL NEW PREFIX 00880000 TSCARSV7 DS XL1 * RESERVED 00890000 TSCANVHD DS 0CL33 * NEW VALIDATION DATA INFORMATION 00900000 TSCANVLL DS XL1 * NEW VALIDATION DATA LENGTH 00910000 TSCANVAL DS CL32 * NEW VALIDATION DATA 00920000 TSCARSV6 DS XL1 * RESERVED 00930000 TSCAPTCH DS CL24 * EXPANSION AREA 00940000 ***************************************************************** 00950000 ** 00960000 ** THE FOLLOWING ARE CONSTANTS USED FOR THE ATTRIBUTE OF THE TSCA 00970000 ** FIELDS. THEY ARE THE ONLY LEGAL SETTINGS FOR THE TSCA ATTR. 00980000 ** 00990000 ***************************************************************** 01000000 TSCACHAR EQU X'01' * ATTRIBUTE IS CHARACTER 01010000 TSCAFIXD EQU X'02' * ATTRIBUTE IS FIXED 01020000 TSCABIT EQU X'03' * ATTRIBUTE IS BIT 01030000 TSCAPOIN EQU X'04' * ATTRIBUTE IS POINTER 01040000 TSCAACRY EQU C'TSCA' * TSCA ACRONYM 01050000 END GSIMOVER 01060014