TITLE 'IEAVAD51 - SNAP FORMAT20 AND FORMAT22 ROUTINES' 00050002 * /* START OF SPECIFICATIONS **** 00060000 * 00070000 *01* MODULE-NAME = IEAVAD51 ( VS2 ) 00080000 * 00090000 *01* DESCRIPTIVE-NAME = SNAP FORMAT20 AND FORMAT22 ROUTINES 00094002 * 00096000 *01* COPYRIGHT = NONE 00098000 * 00098400 *01* STATUS = VERSION 1 00098800 * 00099200 *01* FUNCTION = FORMAT20 TRANSLATES THE LINE INTO 32 OR 64 PRINTABLE 00156840 * CHARACTERS AND UNPACKS THREE BYTES OF DATA INTO THE BEGINNING OF 00160100 * THE LINE. FORMAT22 UNPACKS UP TO FOUR BYTES OF DATA INTO ANY 00163400 * POSITION OF THE LINE 00166700 * 00170000 *01* OPERATION = THIS ROUTINE IS CALLED BY IEAVAD71 TO TRANSLATE 00170440 * INTO EBCDIC FORM THE 32 OR 64 BYTES OF STORAGE TO BE PLACED 00170840 * INTO THIS PRINT LINE. THIS TRANSLATION IS MOVED INTO THE 00171240 * END OF THE PRINT LINE. IT WILL ALSO UNPACK THE THREE BYTE 00171640 * ADDRESS PORTION AT THE BEGINNING OF THE PRINT LINE. 00172040 * ENTRY IEAVAD61 IS ENTERED TO TRANSLATE THE STORAGE AREA IN 00172440 * THE LINE TO PRINTABLE FORM. IF THE LONG LINE IS USED, THE 00173340 * FIRST HEX DIGIT OF EACH WORD IS TRANSLATED SO THAT THE 3800 00173940 * PRINTER WILL PRINT IT AS AN UNDERSCORED DIGIT. Z40MPXH 00174540 *01* NOTES 00175140 * 00176600 *02* CHARACTER-CODE-DEPENDENCIES = THIS MODULE IS EBCDIC CHARACTER 00186600 * CODE DEPENDENT. 00196600 * 00197000 *02* DEPENDENCIES = NONE 00198600 * 00199000 *02* PERFORMANCE = NONE 00199400 * 00199800 *02* RESTRICTIONS = NONE 00199900 * 00209900 *02* REGISTER-CONVENTIONS = THE REGISTER CONVENTIONS ARE DESCRIBED 00226600 * UNDER REGISTER EQUATES. 00236600 * 00238600 *02* PATCH-LABEL = NONE 00246600 * 00248600 *01* MODULE-TYPE = MODULE 00249000 * 00255800 *02* PROCESSOR = ASSEMBLER-370R 00262600 * 00264600 *02* MODULE-SIZE = BYTES 00269440 * 00279400 *02* ATTRIBUTES = REENTERABLE 00279500 * 00281500 *01* ENTRY = IEAVAD51 00283100 * 00285100 *02* PURPOSE = TRANSLATE THE OUTPUT LINE TO PRINTABLE CHARACTERS IN 00285500 * FINAL 32 OR 64 BYTES OF THE LINE AND TO UNPACK 3 BYTES OF DATA 00285640 * AS THE ADDRESS OF THE LINE 00285740 * 00286100 *02* LINKAGE = BALR 00286300 * 00288300 *02* INPUT = GPR 1 MUST CONTAIN THE ADDRESS OF SNAP'S WORK AREA.GPR 00291802 * 14 MUST CONTAIN THE RETURN ADDRESS. GPR 15 MUST CONTAIN THE 00291900 * ADDRESS OF IEAVAD51.ABDBPTR CONTAINS THE ADDRESS OF THE DATA TO 00292000 * BE UNPACKED INTO THE BEGINNING OF THE OUTPUT LINE. ABDSTAD 00292100 * CONTAINS THE ADDRESS OF THE DATA TO BE TRANSLATED INTO 00292200 * PRINTABLE CHARACTERS. IF A UPR EVENT IS ANTICIPATED THEN 00292600 * UPRFMT20 MUST BE SET TO 1. OTHERWISE IT SHOULD BE ZERO 00292700 * 00294700 *02* OUTPUT = GPR 15 IS SET TO ZERO. ABDBPTR IS ADDRESS OF FIRST 00295600 * BYTE AFTER LAST DATA UNPACKED.ABDUPRXT IS SET TO ZERO 00296000 * AND ABDLINE CONTAINS TRANSLATED DATA 00297000 * 00299000 *02* EXIT-NORMAL = BACK TO CALLER 00300000 * 00310000 *02* EXIT-ERROR = BACK TO CALLER WITH REGISTER 15 SET TO EIGHT 00324400 * 00326400 *01* ENTRY = IEAVAD61 00326900 * 00327000 *02* PURPOSE = UNPACK UP TO 4 BYTES OF DATA INTO ABDLINE 00327100 * 00327500 *02* LINKAGE = BALR 00327900 * 00328300 *02* INPUT = SAME AS FOR IEAVAD51 WITH FOLLOWING DIFERENCES: 00329100 * 1. ABDSTAD IS NOT USED. 00329200 * 2. ABDLLINE MUST CONTAIN ADDRESS OF LAYOUT LINE USED TO CONTROL 00329400 * UNPACKING OF DATA 00329600 * 00379600 *02* OUTPUT = SAME AS FOR IEAVAD51 BUT ABDLLINE SET TO BYTE 00429600 * FOLLOWING SUPPLIED LAYOUT LINE 00479600 * 00489600 *02* EXIT-NORMAL = BACK TO CALLER 00529600 * 00539600 *02* EXIT-ERROR = BACK TO CALLER WITH GPR 15 SET TO 8 00579600 * 00589600 *01* EXTERNAL-REFERENCES 00629600 * 00639600 *02* ROUTINES = NONE 00679600 * 00689600 *02* DATA-SETS = NONE 00729600 * 00739600 *02* DATA-AREA = ABDAREA 00779602 * 00789600 *01* TABLES = NONE 00829600 * 00839600 *01* MACROS = NONE 00879600 * 00889600 *01* CHANGE-ACTIVITY = YM2513,Z40MPX-,G33SPHW 00890643 * PERFORMANCE CHANGE DUE TO APAR ZA18175 CHANGE TRANSLATE TABLE 00892643 * TO FULL 256 BYTE TABLE NOT CHECKING EACH CHRACTER TO TRANSLATE 00899643 * ZA18175 00906643 * 00913643 **** END OF SPECIFICATIONS ***/ 00929600 IEAVAD51 CSECT 00979600 ENTRY IEAVAD61 04700000 * THE LAYOUT LINE USED TO CONTROL UNPACKING IN FORMAT22 HAS THE 04750000 * FOLLOWING FORMAT 04800000 * X'AABB'...X'FF' 04850000 * WHERE AA IS THE DISPLACEMENT FROM THE BEGINNING OF ABDLINE WHERE THE 04900000 * UNPACKED DATA IS TO GO AND WHERE BB IS THE SIZE OF THE DATA FIELD 04950000 * MINUS ONE (MAXIMUM VALUE IS 3). THE X'FF' IS THE INDICATOR THAT THE 05000000 * LAST ENTRY HAS BEEN PROCESSED. 05050000 * 05100000 * 05150000 * REGISTER EQUATES 05200000 * 05250000 R0 EQU 0 NAME FOR REG 0 05300000 ABDARPTR EQU 1 ADDRESS OF ABDAREA 05350000 CORE EQU 2 ADDRESS OF STORAGE TO BE FORMATTED 05400000 WORK EQU 3 GENERAL WORK REGISTER 05450000 LAYOUT EQU 4 ADDRESS OF LAYOUT LINE 05500000 BLOKADDR EQU 4 ADDR OF BLOCK IN ABDLINE Z40MPXG 05520040 SIZEM1 EQU 5 SIZE OF FIELD BEING HANDLED MINUS 1 05550000 SIZEM3 EQU 5 LENGTH HOLDER FOR MVC Z40MPXG 05560040 INDENT1 EQU 8 WORK REGISTER Z40MPXG 05570040 INDENT2 EQU 9 WORK REGISTER Z40MPXG 05580040 LINE2 EQU 6 ADDRESS OF ABDLINE Z40MPXG 05590040 OFFSET EQU 6 OFFSET IN OUTPUT LINE TO LOCATION 05600000 * WHERE DATA TO BE PLACED 05650000 LINE EQU 7 ADDRESS OF ABDLINE 05700000 INCR EQU 8 INCREMENT REGISTER IN BXLE LOOP 05750000 ENDLOOP EQU 9 CONTROL REGISTER IN BXLE LOOP 05800000 BASE EQU 12 BASE REGISTER 05850000 SAVEAREA EQU 13 ADDRESS OF CALLERS SAVE AREA 05900000 RETREG EQU 14 RETURN ADDRESS 05950000 BASEIN EQU 15 ENTRY POINT ADDRESS 06000000 RETCODE EQU 15 RETURN CODE REGISTER 06050000 * 06100000 * GENERAL EQUATES 06150000 * 06200000 ZERO EQU 0 CONSTANT 06250000 ONE EQU 1 CONSTANT 06300000 TWO EQU 2 CONSTANT 06350000 FOUR EQU 4 CONSTANT 06400000 FIVE EQU 5 CONSTANT 06450000 EIGHT EQU 8 CONSTANT 06500000 NINE EQU 9 CONSTANT 06550000 TWELVE EQU 12 CONSTANT 06600000 TWENTY EQU 20 CONSTANT 06650000 TWENTY4 EQU 24 CONSTANT 06700000 K31 EQU 31 CONSTANT 06750000 K240 EQU 240 CONSTANT 06800000 K204 EQU 204 LINE LENGTH FOR LONG LINES Z40MPXG 06808040 SIX EQU 6 LENGTH FOR BIT SHIFT Z40MPXG 06816040 K63 EQU 63 LINE SIZE - 1, LONG LINE Z40MPXG 06824040 K64 EQU 64 LINE SIZE, LONG LINE Z40MPXG 06832040 K32 EQU 32 LINE SIZE, SHORT LINE Z40MPXG 06840040 K33 EQU 33 INDEX INTO LINE FOR EBCDIC ZM40130 06845040 X0F EQU X'0F' USED IN TABLE LOOK UP 06850000 X3F EQU X'3F' USED IN TABLE LOOK UP 06900000 X40 EQU X'40' USED IN TABLE LOOK UP 06950000 XC0 EQU X'C0' USED IN TABLE LOOK UP 07000000 STAR EQU C'*' DELIMITER CONSTANT 07050000 FINI EQU X'FF' TERMINATE LAYOUT LINE CHARACTER 07100000 ALL EQU X'FF' USED TO RESET BIT 07150000 BLANK EQU C' ' CLEAR TO BLANK 07200000 USING *,BASEIN 07250000 MODID BR=YES 07450002 DROP BASEIN 07500000 STM RETREG,BASE,TWELVE(SAVEAREA) SAVE CALLERS REGISTERS 07550000 BALR BASE,ZERO ESTABLISH ADDRESSIBILITY 07600000 USING *,BASE 07650000 USING ABDAREA,ABDARPTR 07700000 BASE1 LA LINE,ABDLINE SET ADDRESS OF ABDLINE 07760002 LR LINE2,LINE SET ADDRESS OF ABDLINE 07765040 * TWO BASE REGS ARE USED FOR THE ADDRESS OF ABDLINE BECAUSE OF THE 07770040 * TWO DSECTS USED, ONE FOR A SHORT 120 CHARACTER LINE, AND ONE FOR 07775040 * A LONG 204 CHARACTER LINE. SINCE A USING CANNOT BE ISSUED FOR TWO 07780040 * DSECTS ON THE SAME BASE REGISTER, TWO REGISTERS HAD TO BE USED IN 07785040 * ORDER TO ASSEMBLE THE MODULE. Z40MPXG 07790040 USING PRNTLINE,LINE 07800000 USING PRNTLN2,LINE2 SET ADDRESS TO LONGLINE Z40MPXG 07820040 L CORE,ABDSTAD GET ADDR CORE TO BE TRANSLATED 07850000 CLI ABDLLNGH,K204 CHECK FOR LONG LINE OPTION Z40MPXG 07855040 BNE SHORTLN NO, RESUME NORMAL CODE Z40MPXG 07860040 SRL CORE,SIX ROUND TO 64 BYTE BNDY Z40MPXG 07865040 SLL CORE,SIX FOR LONG LINE PROCESSING Z40MPXG 07870040 LA SIZEM3,K63 SET LINE CAPACITY - 1 Z40MPXG 07875040 LA BLOKADDR,COREBLK2 SET ADDR OF BLK IN ABDLINE Z40MPXG 07877040 B CONT1 CONTINUE NORMAL CODE Z40MPXG 07880040 SHORTLN SRL CORE,FIVE ROUND ADDRESS DOWN TO 32 Z40MPXG 07885040 SLL CORE,FIVE BYTE BOUNDARY Z40MPXG 07890040 LA SIZEM3,K31 SET LINE CAPACITY - 1 Z40MPXG 07895040 LA BLOKADDR,COREBLOK SET ADDR OF BLK IN ABDLINE Z40MPXG 07915040 CONT1 TM ABDUPRF,UPRFMT20 IS UPR ANTICIPATED 08000040 BNO NOUPR20 NO, BRANCH 08050000 LA WORK,FORM20X ESTABLISH FORM20X AS ROUTINE 08100000 ST WORK,ABDUPRXT TO GET CONTROL ON UPR 08150000 NOUPR20 CLI ABDLLNGH,K204 CONDENSED FORMAT ? 08156040 BNE SHORTMVE NO DO REGULAR MOVE ZM40130 08162040 MVC ZERO(K32,BLOKADDR),ZERO(CORE) MOVE FIRST HALF ZM40130 08172040 MVI K32(BLOKADDR),X40 MOVE BLANK IN MIDDLE ZM40130 08182040 MVC K33(K32,BLOKADDR),K32(CORE) MOVE LAST HALF ZM40130 08192040 B ZEROUPR CONTINUE ZM40130 08202040 SHORTMVE EX SIZEM3,MOVE3 MOVE DATA TO ABDLINE ZM40130 08212040 ZEROUPR XC ABDUPRXT(FOUR),ABDUPRXT DISALLOW UPR EVENT 08250040 LH INDENT1,ABDIND GET INDENTATION FACTOR Z40MPXG 08250540 LTR INDENT1,INDENT1 ANY INDENTATION FACTOR ? Z40MPXG 08251040 BE NOINDENT NO, CHECK FOR TRUNCATION Z40MPXG 08252040 CLI INDENT1,K32 CHECK FOR 32 TO INDENT ZM40130 08252240 BNH NOIDUP NOT MORE, LENGTH OKAY ZM40130 08252440 LA INDENT1,ONE(,INDENT1) ADD ONE FOR EXTRA BLANK ZM40130 08252640 NOIDUP MVI ZERO(BLOKADDR),X'40' BLANK FIRST CHARACTER Z40MPXG 08253040 BCTR INDENT1,ZERO SUBTRACT BLANKED BYTE Z40MPXG 08255040 BCTR INDENT1,ZERO DECREMENT FOR EXECUTE Z40MPXG 08256040 EX INDENT1,MOVE4 BLANK THE REST Z40MPXG 08257040 NOINDENT L INDENT1,ABDLCNT GET COMPLETE LINE COUNT Z40MPXG 08258040 SR INDENT2,INDENT2 ZERO WORK REG FOR COMPARE Z40MPXG 08259040 CR INDENT1,INDENT2 LINE COUNT ZERO ? Z40MPXG 08260040 BNE NOTLAST NO, NOT LAST LINE THEN Z40MPXG 08261040 CLI ABDLLNGH,K204 LONG LINE REQUEST ? Z40MPXG 08262040 BNE SHORT2 NO, PROCESS SHORT LENGTH Z40MPXG 08263040 LA INDENT1,K64 PICK UP LINE CAPACITY Z40MPXG 08264040 B FIGLNGH GO FIGURE LEN TO BLANK OUT Z40MPXG 08265040 SHORT2 LA INDENT1,K32 PICK UP LINE CAPACITY Z40MPXG 08266040 * NOW SUBTRACT THE NUMBER OF BYTES TO BE PRINTED (ABDINCPL) Z40MPXG 08267040 * FROM THE LINE CAPACITY TO GET THE LENGTH TO BLANK OUT AT THE Z40MPXG 08268040 * END OF THE LINE. Z40MPXG 08269040 FIGLNGH SH INDENT1,ABDINCPL FIGURE LENGTH TO BLANK Z40MPXG 08270040 CR INDENT1,INDENT2 ANY LEFT TO BLANK OUT ? Z40MPXG 08271040 BE NOTLAST NO, THEN COMPLETE LINE TO GO Z40MPXG 08272040 LR INDENT2,BLOKADDR GET LINE ADDRESS Z40MPXG 08273040 AH INDENT2,ABDINCPL INDEX TO PLACE TO START BLNK Z40MPXG 08275040 CLI INDENT1,K32 CHECK FOR MORE THAN 32 ZM40130 08275240 BL UPSTART LESS, INCREMENT START ADDR ZM40130 08275440 LA INDENT1,ONE(,INDENT1) ADD ONE TO LENGTH TO BLNK ZM40130 08275640 MVI ZERO(INDENT2),X'40' BLANK THE FIRST CHARACTER Z40MPXG 08276040 B TRUNC1 CONTINUE TRUNCATION PROCESS ZM40130 08276240 UPSTART LA INDENT2,ONE(,INDENT2) INCREMENT START ADDRESS ZM40130 08276440 MVI ZERO(INDENT2),X40 BLANK FIRST CHARACTER ZM40130 08276640 TRUNC1 BCTR INDENT1,ZERO ALLOW FOR BYTE BLANKED OUT Z40MPXG 08277040 BCTR INDENT1,ZERO DECREMENT FOR EXECUTE INSTR Z40MPXG 08278040 EX INDENT1,MOVE5 BLANK REST OF END OF LINE Z40MPXG 08279040 * IF LONGCLINE BEING WRITTEN, THEN NO ASTERISKS IN LINE Z40MPXG 08320040 NOTLAST CLI ABDLLNGH,K204 LONG LINE ? ZA18175 08325043 BE LOOP2A BYPASS ASTERISK SETTINGS ZM40130 08340040 MVI DELIMITA,STAR SET ASTERISK BEFORE AND 08400000 MVI DELIMITB,STAR AFTER TRANSLATED DATA 08450000 *************************************************************** ZA18175 08460043 * CODE REMOVED FOR APAR ZA18175 ******************* ZA18175 08470043 * LOOP TM COREBLOK,XC0 COMPARE CHARACTER TO X'C0' 08800043 * BO LEAVEIT BRANCH IF HIGH OR EQUAL 08830043 * CLI COREBLOK,BLANK CHECK IF BLANK 08860043 * BE GOLOOP YES, THEN CHARACTER NEED NOT CHANGE 08890043 * MVI COREBLOK,X0F REPLACE CHARACTER WITH X'0F' 08920043 * LEAVIT NI COREBLOK,X3F TURN OFF HIGH ORDER TWO BITS 08950043 * GOLOOP BXLE LINE,INCR,LOOP BRANCH TO PROCESS NEXT CHAR 08980043 * CODE REMOVED FOR APAR ZA18175 ZA18175 09010043 *************************************************************** ZA18175 09040043 B TRANS2 GO TRANSLATE CHARACTERS Z40MPXG 09100540 *************************************************************** ZA18175 09100843 * LOOP2A LA ENDLOOP,ONE(,ENDLOOP) ADD ONE FOR EXTRA BLANK ZM40130 09100943 * CODE REMOVED FOR APAR ZA18175 ******************* ZA18175 09101043 * LOOP2 TM COREBLK2,XC0 COMPARE FOR EBCDIC Z40MPXG 09101143 * BO LEAVEIT2 BR HIGH OR EQUAL Z40MPXG 09101443 * CLI COREBLK2,BLANK CHECK FOR A BLANK Z40MPXG 09101843 * BE GOLOOP2 YES, GET NEXT CHARACTER Z40MPXG 09102043 * MVI COREBLK2,X0F REPLACE CHAR WITH X0F Z40MPXG 09102543 *EAVEIT2 NI COREBLK2,X3F TURN OFF HI TWO BITS Z40MPXG 09103043 *GOLOOP2 BXLE LINE2,INCR,LOOP2 LOOP UNTIL ALL DONE Z40MPXG 09103543 * CODE REMOVED FOR APAR ZA18175 ZA18175 09104043 *************************************************************** ZA18175 09104343 * IF LONG LINE, THEN TRANSLATE USING COREBLOK WITH ITS Z40MPXG 09105040 * DECLARED LENGTH OF 64, ELSE USE EBCBLOCK WITH ITS 32 BYTE Z40MPXG 09110040 * DECLARATION. Z40MPXG 09115040 LOOP2A LR LINE2,LINE RESET BASE TO BEGINNING ZA18175 09118043 TR COREBLK2,XLATE XLATE ALL 64 BYTES Z40MPXG 09130040 LA LAYOUT,LAYLINE SET LAYOUT LINE FOR AD61 Z40MPXG 09140040 B INTO22 GO CONVERT LINE ADDRESS Z40MPXG 09145040 TRANS2 TR COREBLOK,XLATE TRANSLATE CHARACTERS TO PRINTABLES 09270043 * ZA18175 09300043 DROP LINE 09350000 DROP LINE2 09370040 LA LAYOUT,LAYLINE SET LAYOUT LINE FOR FORMAT22 09400000 B INTO22 GO TO FORMAT22 09450000 IEAVAD61 EQU * 09500000 USING *,BASEIN 09550000 BASE2 STM RETREG,BASE,TWELVE(SAVEAREA) SAVE CALLERS REGISTERS 09600000 LA WORK,BASE2-BASE1 CALC DIFFERENCE BETWEEN BASES 09650000 SR BASEIN,WORK SET TO BASE1 VALUE 09700000 LR BASE,BASEIN SET IN RIGHT REGISTER 09750000 DROP BASEIN 09800000 USING BASE1,BASE 09850002 L LAYOUT,ABDLLINE GET ADDR OF LAYOUT LINE 09900000 INTO22 L CORE,ABDBPTR GET ADDR OF CORE TO BE UNPACKED 09950000 REPEAT LA LINE,ABDLINE GET ADDR OF OUTPUT LINE 10000000 TM ZERO(LAYOUT),FINI IS REQUEST COMPLETE 10050000 BO EXIT YES, RETURN TO CALLER 10100000 SR OFFSET,OFFSET INITIALIZE REGISTER 10150000 SR SIZEM1,SIZEM1 INITIALIZE REGISTER 10200000 IC OFFSET,ZERO(LAYOUT) GET DISPLACEMENT TO WHERE UNPACKED 10250000 * DATA IS TO BE PLACED 10300000 IC SIZEM1,ONE(LAYOUT) GET SIZE - 1 OF FIELD TO BE 10350000 * UNPACKED 10400000 AR LINE,OFFSET ADD DISPLACEMENT TO INIT LINE ADDR 10450000 TM ABDUPRF,UPRFMT20 IS UPR ANTICIPATED 10500000 BNO NOUPR22 NO, BRANCH 10550000 LA WORK,FORM20X ESTABLISH ADDR OF ROUTINE TO 10600000 ST WORK,ABDUPRXT BE GIVEN CONTROL IF UPR HAPPENS 10650000 NOUPR22 EX SIZEM1,MOVE1 MOVE DATA TO WORK AREA 10700000 XC ABDUPRXT(FOUR),ABDUPRXT DISALLOW UPR EVENT 10750000 UNPK ABDFMTWK(NINE),ABDFMTWK(FIVE) UNPACK DATA 10800000 TR ABDFMTWK(EIGHT),TBL-K240 TRANSLATE TO PRINTABLES 10850000 LA WORK,TWO LENGTH FOR CHECK Z40MPXG 10855040 CR WORK,SIZEM1 ONLY XLATING THREE BYTES Z40MPXG 10860040 BE CONT2 YES, NO UNDERSCORE HERE Z40MPXG 10865040 CLI ABDLLNGH,K204 LONG LINE FORMAT ? Z40MPXG 10870040 BNE CONT2 NO, NO UNDERSCORES HERE Z40MPXG 10875040 * AND OFF TWO HIGH ORDER BYTES TO TRANSLATE CHARACTER TO THE Z40MPXG 10880040 * SAME CHARACTER WITH AN UNDERSCORE FOR THE 3800 PRINTER. Z40MPXG 10885040 NI ABDFMTWK,X'3F' KNOCK OFF TWO TOP BITS Z40MPXG 10890040 CONT2 LA CORE,ONE(SIZEM1,CORE) STEP TO NEXT STORAGE FIELD 10900040 LA SIZEM1,ONE(SIZEM1,SIZEM1) CALC SIZE-1 UNPACKED DATA 10950000 EX SIZEM1,MOVE2 MOVE DATA TO OUTPUT LINE 11000000 LA LAYOUT,TWO(LAYOUT) STEP TO NEXT LAYOUT LINE ENTRY 11050000 B REPEAT CHECK IF MORE TO BE DONE 11100000 EXIT LA LAYOUT,ONE(LAYOUT) STEP OVER END INDICATOR 11150000 ST LAYOUT,ABDLLINE SAVE UPDATED POINTER 11200000 ST CORE,ABDBPTR SAVE UPDATED FIELD POINTER 11250000 LA RETCODE,ZERO SET RET CODE TO ZERO 11300000 CEXIT NI ABDUPRF,ALL-UPRFMT20 RESET UPR INDICATOR BIT 11350000 L RETREG,TWELVE(SAVEAREA) RESTORE REG 14 CONTENTS 11400000 LM R0,BASE,TWENTY(SAVEAREA) RESTORE REGISTERS 11450000 BR RETREG RETURN TO CALLER 11500000 FORM20X L ABDARPTR,TWENTY4(SAVEAREA) RESTORE ABDAREA POINTER 11550000 MVI ABDCC,BLANK SET ABDCC TO BLANK 11600000 MVC ABDLINE(L'ABDLINE),ABDCC SET REST OF LINE TO BLANK 11650000 LA RETCODE,EIGHT SET RET CODE TO UPR 11700000 B CEXIT RETURN TO CALLER 11750000 * 11800000 * CONSTANTS 11850000 * 11900000 XLATE DC C'................' TABLE TO TRANSLATE TO ZA18175 11950043 DC C'................' EITHER TO A ALPHABETIC ZA18175 11960043 DC C'................' OR TO A NUMERIC OR TO ZA18175 11970043 DC C'................' A PERIOD ZA18175 11976043 DC C' ...............' ZA18175 11990043 DC C'................' ZA18175 12000043 DC C'................' ZA18175 12010043 DC C'................' ZA18175 12020043 DC C'................' ZA18175 12030043 DC C'................' ZA18175 12040043 DC C'................' ZA18175 12050043 DC C'................' ZA18175 12060043 DC C'.ABCDEFGHI......' ZA18175 12070043 DC C'.JKLMNOPQR......' ZA18175 12080043 DC C'..STUVWXYZ......' ZA18175 12090043 DC C'0123456789......' ZA18175 12100043 TBL DC C'0123456789ABCDEF' TABLE TO TRANS LATE UNPACKED DATA 12200000 LAYLINE DC X'0002',X'FF' STANDARD LAYOUT LINE TO UNPACK 12250000 * THE LOCATION COUNTER 12300000 * 12350000 * EXECUTED INSTRUCTIONS 12400000 * 12450000 MOVE1 MVC ABDFMTWK(ONE),ZERO(CORE) MOVE DATA TO WORK AREA 12500000 MOVE2 MVC ZERO(ONE,LINE),ABDFMTWK MOVE WORK AREA TO OUTPUT LINE 12550000 MOVE3 MVC ZERO(ONE,BLOKADDR),ZERO(CORE) MOVE IN TO XLATE Z40MPXG 12560040 MOVE4 MVC ONE(ONE,BLOKADDR),ZERO(BLOKADDR) BLNK BEGINNING Z40MPXG 12566040 MOVE5 MVC ONE(ONE,INDENT2),ZERO(INDENT2) BLANK END OF LINE Z40MPXG 12580040 * 12600000 * 12650000 * DSECT OF 64 BYTE OUTPUT LINE 12700040 * 12750000 PRNTLINE DSECT 12800000 DS CL55 DEAD SPACE 12850000 EBCBLOCK DS 0CL32 LABEL FOR MOVE 12900000 DS CL31 DEAD SPACE 12950000 DELIMITA DS CL1 ASTERISK ON ONE SIDE OF TRANSLATION 13000000 COREBLOK DS CL32 TRANSLATED DATA AREA 13050040 DELIMITB DS CL1 ASTERISK ON OTHER SIDE OF DATA 13100000 * 13105040 * Z40MPXG 13110040 * DSECT FOR 64 BYTE OUTPUT LINE Z40MPXG 13115040 * Z40MPXG 13120040 PRNTLN2 DSECT Z40MPXG 13125040 DS CL75 DEAD SPACE Z40MPXG 13130040 EBCBLK2 DS CL64 DEAD SPACE Z40MPXG 13135040 COREBLK2 DS CL65 TRANSLATED OUTPUT AREA ZM40130 13140040 * 13150000 * 13200000 * DSECT MAP OF ABDAREA 13250000 IHAABDA 13300000 */*IEAVAD51: CHART */ 13301040 */* HEADER 13302040 */* EBCDIC TRANSLATION ROUTINE AND ADDRESS TRANSLATION ROUTINE 13303040 */* FEBRUARY 13, 1975 C. KEN WRIGHT PAGE# */ 13304040 */* E IEAVAD51 MAINLINE */ 13305040 */* P SAVE REGISTERS */ 13306040 */* P SET ADDRESSABILITY - REG 12 */ 13307040 */* P SET ADDRESS OF OUTPUT LINE - LINE */ 13308040 */* P SET ADDRESSABILITY TO OUTPUT LINE - LINE2 */ 13308340 */* P GET CORE ADDRESS TO TRANSLATE */ 13309040 */* D (YES,,NO,%M1) 204 CHARACTER LINE ? */ 13309240 */* P ROUND TO 64 BYTE BOUNDARY */ 13309440 */* P SET 64 BYTE LINE SIZE - SIZEM3=63 */ 13309640 */* P (,CONT1) SET ADDR OF OUTPUT BLOCK - BLOKADDR */ 13309740 */*%M1: P ROUND ADDRESS TO A 32 BYTE BOUNDARY */ 13310040 */* P SET 32 BYTE LINE SIZE - SIZEM3=31 */ 13310340 */* P SET ADDRESS OF OUTPUT BLOCK - BLOKADDR */ 13310640 */*CONT1: D (YES,,NO,%K1) UPR EXPECTED ? */ 13311040 */* P GET ADDRESS OF FORMAT 20X - UPR ROUTINE */ 13312040 */*%K1: P MOVE DATA TO ABDLINE VIA EX WITH LENGTH IN SIZEM3 */ 13313040 */* P CLEAR UPR FIELD */ 13314040 */* P GET INDENTATION FACTOR - ABDIND */ 13314140 */* D (YES,,NO,NOINDENT) IS THERE INDENTATION ? */ 13314340 */* P MOVE A BLANK TO FIRST CHAR IN OUTPUT BLOCK */ 13314440 */* P SUBTRACT TWO FROM INDENTATION FACTOR */ 13316240 */* P BLANK OUT REST OF INDENTATION PART */ 13316340 */*NOINDENT: P GET LINE COUNT - ABDLCNT */ 13316440 */* D (YES,,NO,NOTLAST) IS THIS LAST LINE IN DUMP */ 13316540 */* P PICK UP BYTE COUNT - ABDINCPL */ 13316640 */* D (YES,NOTLAST,NO,) COMPLETE LINE TO WRITE ? */ 13316740 */* P INCREMENT INTO COREBLOK BY ABDINCPL */ 13316840 */* P MOVE A BLANK INTO FIRST BYTE TO SUPPRESS */ 13316940 */* D (YES,,NO,SHORT2) 204 CHARACTER LINE ABDLLNGH */ 13317040 */* P (,FIGLNGH) SET LINE CAPACITY TO 64 BYTES */ 13317140 */*SHORT2: P SET LINE CAPACITY TO 32 BYTES */ 13317240 */*FIGLNGH: P FIGURE LENGTH TO SUPPRESS, CAPACITY - ABDINCPL */ 13317340 */* P SUBTRACT TWO FROM LENGTH */ 13317440 */* P MOVE BLANKS INTO REST OF SUPPRESSED AREA */ 13317540 */*NOTLAST: P SET LOOP CONTROL TO 1 */ 13317640 */* P SET END LOOP CONTROL FROM SIZEM3 */ 13317740 */* D (YES,LOOP2,NO,) 204 CHARACTER LINE ? */ 13317840 */* P PLACE ASTERISK BEFORE AND AFTER DATA FIELD */ 13318440 */*LOOP: D (YES,LEAVEIT,NO,) IS CHARACTER > 'C0'X ? */ 13318740 */* D (YES,GOLOOP,NO,) IS CHARACTER A BLANK ? */ 13319140 */* P SET '0F'X DEFAULT VALUE */ 13320040 */*LEAVEIT: P AND OFF THE TWO HIGH ORDER BITS */ 13321040 */* P INCREMENT TO NEXT CHARACTER */ 13321340 */*GOLOOP: D (YES,TRANS2,NO,LOOP) ARE WE DONE WITH ALL CHARACTERS ? */ 13322040 */*LOOP2: D (YES,LEAVEIT2,NO,) EBCDIC CHARACTER ? */ 13322140 */* D (YES,GOLOOP2,NO,) BLANK ? */ 13322240 */* P SET CHARACTER TO X'0F' */ 13322340 */*LEAVEIT2: P AND OFF TWO HIGH ORDER BITS */ 13322440 */* P INCREMENT TO NEXT CHARACTER */ 13322540 */*GOLOOP2: D (YES,,NO,LOOP2) ALL DONE ? */ 13322640 */* P TRANSLATE CHARACTERS VIA COREBLK2 */ 13322940 */* P (,INTO22) GET ADDRESS OF LAYOUT LINE */ 13323040 */*TRANS2: P TRANSLATE THE CHARACTERS VIA EBCBLOCK */ 13323540 */* P (,INTO22) GET ADDRESS OF THE LAYOUT LINE */ 13324040 */*IEAVAD61: E IEAVAD61 MAINLINE */ 13325040 */* P STORE REGISTERS */ 13326040 */* P CALCULATE BASEREG VALUE - REG 12 */ 13327040 */* P GET ADDRESS OF LAYOUT LINE */ 13328040 */*INTO22: P GET ADDRESS OF ABDLINE */ 13329040 */*REPEAT: D (YES,EXIT,NO,) AT END OF LAYOUT LINE ? */ 13329640 */* P INITIALIZE REGISTERS */ 13331040 */* P GET OFFSET INTO LINE */ 13332040 */* P GET SIZE OF FIELD TO UNPACK */ 13333040 */* P ADD OFFSET TO LINE ADDRESS */ 13334040 */* D (YES,,NO,%K4) UPR EXPECTED ? */ 13335040 */* P SET ADDRESS OF FORMAT 20X - UPR ROUTINE */ 13336040 */*%K4: P MOVE DATA TO WORKAREA */ 13337040 */* P CLEAR UPR FIELD */ 13338040 */* P UNPACK THE DATA */ 13339040 */* P TRANSLATE A WORD OF DATA */ 13350040 */* D (YES,,NO,%M4) 204 CHARACTER LINE ? */ 13400040 */* P AND OFF 2 BITS OF 1ST BYTE TO UNDERLINE */ 13450040 */*%M4: P UPDATE TO NEXT CORE BLOCK */ 16350040 */* P GET SIZE OF UNPACKED DATA */ 19350040 */* P MOVE TO OUTPUT LINE */ 22350040 */* P (,REPEAT) GET NEXT LAYOUT LINE ENTRY */ 25350040 */*EXIT: P INCREMENT OVER THE FF IN THE LAYOUT LINE */ 28350040 */* P SAVE POINTER IN ABDLINE */ 31350040 */* P SAVE ADDRESS OF NEXT CORE BLOCK IN ABDBPTR */ 34350040 */* P SET RETURN CODE OF ZERO */ 37350040 */*CEXIT: P RESET UPR FLAGS OFF */ 40350040 */* P RESTORE REG 14 */ 43350040 */* P RESTORE OTHER REGISTERS */ 46350040 */* R RETURN TO CALLER */ 49350040 */* E FORMAT 20X */ 52350040 */* COMMENT (4,15) UPR ROUTINE */ 55350040 */* P RESTORE ABDAREA POINTER */ 58350040 */* P BLANK OUT ABDCC */ 61350040 */* P BLANK OUT REST OF LINE */ 64350040 */* P (,CEXIT) SET RETURN CODE OF 8 */ 67350040 */*IEAVAD51: END */ 70350040 END IEAVAD51 73350040