TITLE 'IGCDC10D - 3705 DISPLAY STORAGE ROUTINE *00001000 ' 00002000 IGCDC10D CSECT , 0001 00003000 @PROLOG BALR @12,0 0001 00004000 @PSTART DS 0H 0001 00005000 USING @PSTART,@12 0001 00006000 USING IGCDC10D,RBASE @G36XRRU 00007000 LR RBASE,REG15 SET UP BASE ADDRESS @G36XRRU 00008000 IGCDC10D IEDHJN AFTERHJN,JHN @G36XRRU 00009000 * ROPCAVT=RPARM; /* BASE FOR OP CONTROL AVT */ 00010000 LR ROPCAVT,RPARM 0489 00011000 * RFY 0490 00012000 * RPARM UNRSTD; /* @G36XRRU*/ 00013000 * IEDQAPTR=OPCAVTPT; /* BASE FOR TCAM AVT */ 00014000 L IEDQAPTR,OPCAVTPT(,ROPCAVT) 0491 00015000 * ROPCE=OPCCOPCE; /* GET ELEMENT POINTER */ 00016000 L ROPCE,OPCCOPCE(,ROPCAVT) 0492 00017000 * RWORKA=OPCWORK; /* ADDRESS OF WORK AREA */ 00018000 L RWORKA,OPCWORK(,ROPCAVT) 0493 00019000 */********************************************************************/ 00020000 */* IF RESPONSE INDICATED IN OPCE, THEN PROCESS THE RESPONSE BDU */ 00021000 */* IN THE BUFFER UNIT ADDRESSED BY OCUNIT. OTHERWISE, PROCESS A */ 00022000 */* DISPLAY STORAGE REQUEST COMMAND. */ 00023000 */********************************************************************/ 00024000 * 0494 00025000 * IF ROPCE->PRFPRI=PRISSBUF|OCRESP=ON THEN/* RESPONSE BDU FOR A 0494 00026000 * DISPLAY STOR REQ@ZM47883 */ 00027000 CLI PRFPRI(ROPCE),X'E2' 0494 00028000 BE @RT00494 0494 00029000 TM OCRESP(ROPCE),B'00000001' 0494 00030000 BO @RT00494 0494 00031000 * GOTO PRORESP; /* YES, PROCESS THE BDU */ 00032000 * 0496 00033000 */********************************************************************/ 00034000 */* EXAMINE THE 3705 NCP PU NAME OPERAND @G36XRRU*/ 00035000 */********************************************************************/ 00036000 * 0496 00037000 * ROPERAND=OCELEM; /* OCELEM POINTS TO 1ST OPER */ 00038000 L ROPERAND,OCELEM(,ROPCE) 0496 00039000 * RSORCFLD=ROPERAND; /* SAVE ADDRESS OF OPERAND */ 00040000 LR RSORCFLD,ROPERAND 0497 00041000 * RCOUNTER=ZERO; /* SET COUNT OF CHARACTERS IN NCP 00042000 * NAME TO ZERO @G36XRRU*/ 00043000 SLR RCOUNTER,RCOUNTER 0498 00044000 *NAMELOOP: 0499 00045000 * IF OPERAND=COMMA THEN /* END OF RNNAME ? */ 00046000 NAMELOOP CLC OPERAND(1,ROPERAND),COMMA 0499 00047000 BNE @RF00499 0499 00048000 * DO; /* YES */ 00049000 * IF RCOUNTER=ZERO THEN /* NUMBER OF CHARACTERS SCANNED 00050000 * IS ZERO ? */ 00051000 LTR RCOUNTER,RCOUNTER 0501 00052000 BZ @RT00501 0501 00053000 * GOTO ERROR1; /* YES, ERROR */ 00054000 * END; 0503 00055000 * ELSE 0504 00056000 * DO; /* NOT END OF OPERANDS */ 00057000 B @RC00499 0504 00058000 @RF00499 DS 0H 0505 00059000 * RCOUNTER=RCOUNTER+ONE; /* INCREMENT NO. OF OPERANDS */ 00060000 LA @15,1 0505 00061000 ALR RCOUNTER,@15 0505 00062000 * IF RCOUNTERTRMNCPHI THEN/* @OZ31069*/ 00140000 LR @14,RTRM 0537 00141000 SL @14,@CF00060 0537 00142000 CLI TRMTYPE(@14),X'01' 0537 00143000 BL @RT00537 0537 00144000 CLI TRMTYPE(@14),X'0F' 0537 00145000 BNH @RF00537 0537 00146000 @RT00537 DS 0H 0538 00147000 * DO; /* @G36XRRU*/ 00148000 * RZERO=NUM173; /* INVALID NCP ENTRY @G36XRRU*/ 00149000 LA RZERO,173 0539 00150000 * GOTO ERROR; /* WRITE ERROR MSG @G36XRRU*/ 00151000 B ERROR 0540 00152000 * END; /* @G36XRRU*/ 00153000 * ELSE 0542 00154000 * DO; /* VERIFY THAT THE NCP IS ACTIVE 00155000 * AND NOT IN THE PROCESS OF 0542 00156000 * BEING ACT/DEACT OR IPL/DUMP 0542 00157000 * @G36XRRU*/ 00158000 @RF00537 DS 0H 0543 00159000 * IF TRMRSACT=OFF|TRMINPG=ON|TRMIPLDM=ON/* STATE OK @G36XRRU*/ 00160000 * THEN 0543 00161000 LR @14,RTRM 0543 00162000 SL @14,@CF00060 0543 00163000 TM TRMINPG(@14),B'00100000' 0543 00164000 BNZ @RT00543 0543 00165000 TM TRMRSACT(@14),B'10000000' 0543 00166000 BNO @RT00543 0543 00167000 TM TRMIPLDM(@14),B'10000000' 0543 00168000 BNO @RF00543 0543 00169000 @RT00543 DS 0H 0544 00170000 * DO; /* NO, ERROR @G36XRRU*/ 00171000 * RZERO=NUM400; /* NCP NOT ACTIVE MSG @G36XRRU*/ 00172000 LA RZERO,400 0545 00173000 * GOTO ERROR; /* WRITE ERROR MSG @G36XRRU*/ 00174000 B ERROR 0546 00175000 * END; /* @G36XRRU*/ 00176000 * RFY 0548 00177000 * RTRM UNRSTD; /* @G36XRRU*/ 00178000 @RF00543 DS 0H 0549 00179000 * RFY 0549 00180000 * (RZERO, 0549 00181000 * RPARM) UNRSTD; /* @G36XRRU*/ 00182000 * 0550 00183000 */********************************************************************/ 00184000 */* EXAMINE STORAGE ADDRESS OPERAND */ 00185000 */********************************************************************/ 00186000 * 0550 00187000 * ROPERAND=ROPERAND+ONE; /* BUMP OPERAND POINTER PAST 0550 00188000 * COMMA */ 00189000 LA ROPERAND,1(,ROPERAND) 0550 00190000 * RSORCFLD=ROPERAND; /* SAVE ADDRESS OF OPERAND */ 00191000 LR RSORCFLD,ROPERAND 0551 00192000 * OCBACKUP(ONE:FIVE)=STORADDR(ONE:FIVE);/* SAVE ADDR @ZM47883*/ 00193000 MVC OCBACKUP(5,ROPCE),STORADDR(RSORCFLD) 0552 00194000 * RCOUNTER=ZERO; /* INITIALIZE COUNT OF CHAR IN 0553 00195000 * OPERAND */ 00196000 SLR RCOUNTER,RCOUNTER 0553 00197000 *LOOP: 0554 00198000 * IF OPERAND^=BLANK THEN /* END OF OPERANDS ? */ 00199000 LOOP CLI OPERAND(ROPERAND),X'40' 0554 00200000 BE @RF00554 0554 00201000 * DO; /* NO */ 00202000 * RCOUNTER=RCOUNTER+ONE; /* INCREMENT COUNT OF CHAR */ 00203000 LA RCOUNTER,1(,RCOUNTER) 0556 00204000 * IF RCOUNTER>FIVE THEN /* MORE THAN 5 CHAR @ZM47883*/ 00205000 C RCOUNTER,@CF00180 0557 00206000 BH @RT00557 0557 00207000 * GOTO ERROR1; /* YES, ERROR */ 00208000 * IF OPERAND>=CHAR0& /* CHAR BETWEEN '0' AND */ 00209000 * OPERAND<=CHAR9 THEN /* '9', INCLUSIVE ? */ 00210000 CLC OPERAND(1,ROPERAND),CHAR0 0559 00211000 BL @RF00559 0559 00212000 CLC OPERAND(1,ROPERAND),CHAR9 0559 00213000 BNH @RT00559 0559 00214000 * GOTO VALID; /* YES, VALID CHARACTER */ 00215000 * IF OPERAND>=CHARA& /* CHAR BETWEEN 'A' AND */ 00216000 * OPERAND<=CHARF THEN /* 'F', INCLUSIVE ? */ 00217000 @RF00559 CLC OPERAND(1,ROPERAND),CHARA 0561 00218000 BL @RF00561 0561 00219000 CLC OPERAND(1,ROPERAND),CHARF 0561 00220000 BH @RF00561 0561 00221000 * OPERANDF=OPERANDF+NUMSHIFT;/* YES, SHIFT CHARACTER */ 00222000 LA @14,57 0562 00223000 SLR @11,@11 0562 00224000 IC @11,OPERANDF(,ROPERAND) 0562 00225000 ALR @14,@11 0562 00226000 STC @14,OPERANDF(,ROPERAND) 0562 00227000 * ELSE /* NO */ 00228000 * GOTO ERROR1; /* ERROR */ 00229000 *VALID: 0564 00230000 * ROPERAND=ROPERAND+ONE; /* POINT TO NEXT CHARACTER */ 00231000 VALID LA ROPERAND,1(,ROPERAND) 0564 00232000 * GOTO LOOP; /* CONTINUE SCAN FOR END OF 0565 00233000 * OPERANDS */ 00234000 B LOOP 0565 00235000 * END; 0566 00236000 * IF RCOUNTER=ZERO THEN /* WAS OPERAND SKIPPED ? */ 00237000 @RF00554 LTR RCOUNTER,RCOUNTER 0567 00238000 BZ @RT00567 0567 00239000 * GOTO ERROR1; /* YES, ERROR */ 00240000 */********************************************************************/ 00241000 */* PACK THE DISPLAY ADDRESS AND SAVE IT. A LENGTH GREATER THAN */ 00242000 */* THAT OF THE OPERAND IS USED TO SEPARATE THE SIGN FROM THE */ 00243000 */* ADDRESS. */ 00244000 */********************************************************************/ 00245000 * 0569 00246000 * GEN( EX RCOUNTER,PACKADDR );/* PACK DISPLAY ADDRESS */ 00247000 EX RCOUNTER,PACKADDR 00248000 * RCOUNTER=RCOUNTER+ONE; /* INSERT BLANKS PAST END OF */ 00249000 LA @14,1 0570 00250000 ALR RCOUNTER,@14 0570 00251000 * OCBACKUP(RCOUNTER:EIGHT)=BLANKS;/* SAVED ADDR IN OCBACKUP */ 00252000 LR @01,ROPCE 0571 00253000 ALR @01,RCOUNTER 0571 00254000 LA @11,8 0571 00255000 SLR @11,RCOUNTER 0571 00256000 EX @11,@SM02063 0571 00257000 * 0572 00258000 */********************************************************************/ 00259000 */* GET BUFFER UNIT INTO WHICH PRU WILL BE BUILT. */ 00260000 */********************************************************************/ 00261000 * 0572 00262000 * RFY 0572 00263000 * (RPARM, 0572 00264000 * RSAVE) RSTD; /* @G36XRRU*/ 00265000 * RSAVE=ADDR(OPCSAVE); /* LOAD SAVE AREA ADDRESS */ 00266000 LA RSAVE,OPCSAVE(,ROPCAVT) 0573 00267000 * RPARM=ONE; /* NUMBER OF UNITS REQUESTED */ 00268000 LR RPARM,@14 0574 00269000 * CALL GETBUFF; /* GET A BUFFER UNIT @G36XRRU*/ 00270000 L @15,OPCGETBF(,ROPCAVT) 0575 00271000 BALR @14,@15 0575 00272000 * OCUNIT=RPARM; /* SAVE PTR TO BUFFER */ 00273000 ST RPARM,OCUNIT(,ROPCE) 0576 00274000 * RFY 0577 00275000 * RPRU RSTD; /* @G36XRRU*/ 00276000 * RPRU=RPARM; /* SET UP PRU BASE @G36XRRU*/ 00277000 LR RPRU,RPARM 0578 00278000 * IEDPRUQD=IEDPRUQD&&IEDPRUQD;/* ZERO BASIC PRU @G36XRRU*/ 00279000 XC IEDPRUQD(12,RPRU),IEDPRUQD(RPRU) 0579 00280000 * IEDPRUND=IEDPRUND&&IEDPRUND;/* ZERO NEG PRU @G36XRRU*/ 00281000 LR @14,RPRU 0580 00282000 SL @14,@CF00069 0580 00283000 XC IEDPRUND(8,@14),IEDPRUND(@14) 0580 00284000 * CMDDATA=CMDDATA&&CMDDATA; /* ZERO COMMAND FLD @G36XRRU*/ 00285000 XC CMDDATA(13,RPRU),CMDDATA(RPRU) 0581 00286000 * PRURHTH=RHTHFID1; /* SET UP RH/TH FLAGS @ZM47762*/ 00287000 MVC PRURHTH(4,@14),@CB02000 0582 00288000 * PRUTTCIN=OCTRMTBL; /* SET UP TTCIN @G36XRRU*/ 00289000 LH @14,OCTRMTBL(,ROPCE) 0583 00290000 N @14,@CF02065 0583 00291000 STH @14,PRUTTCIN(,RPRU) 0583 00292000 * RPARM=OCTRMTBL; /* SET TTCIN AS INPUT TO IEDIAP04 00293000 * TO GET NETWORK ADDRESS 0584 00294000 * @G36XRRU*/ 00295000 LR RPARM,@14 0584 00296000 * CALL IEDIAP04; /* FIND NETWORK ADDR @G36XRRU*/ 00297000 L @11,AVTSAVTP(,IEDQAPTR) 0585 00298000 L @15,SAVTTNTX(,@11) 0585 00299000 BALR @14,@15 0585 00300000 * RFY 0586 00301000 * (RPARM, 0586 00302000 * RSAVE) UNRSTD; /* @G36XRRU*/ 00303000 * CMDNETA=REG15; /* PUT IT IN REQUEST @G36XRRU*/ 00304000 STCM REG15,3,CMDNETA(RPRU) 0587 00305000 * PRUDATCT=LENGTH(CMDDATA); /* SET UP DATA COUNT @G36XRRU*/ 00306000 MVC PRUDATCT(2,RPRU),@CH00599 0588 00307000 * PRUTIC=INVALTIC; /* SET INVALID TIC @G36XRRU*/ 00308000 MVC PRUTIC(4,RPRU),@CB01354 0589 00309000 * BDUHEADR=ON; /* TURN ON HEADER FLG @G36XRRU*/ 00310000 OI BDUHEADR+12(RPRU),B'01000000' 0590 00311000 * CMDCODES=DRUFLAG; /* SET COMMAND FLAGS @G36XRRU*/ 00312000 MVC CMDCODES(3,RPRU),@CB02004 0591 00313000 * CMDTYPE=TYPE; /* COMMAND TYPE @G36XRRU*/ 00314000 MVI CMDTYPE(RPRU),X'01' 0592 00315000 * CMDLEN=DISPLEN; /* SET DISPLAY LENGTH @G36XRRU*/ 00316000 MVC CMDLEN(2,RPRU),@CB02006 0593 00317000 * CMDADDR=OCMODNME(1:4); /* BEGIN ADDRESS @ZM47883*/ 00318000 MVC CMDADDR(4,RPRU),OCMODNME(ROPCE) 0594 00319000 * OPCMODID=MOD02; /* RU DISPATCHER ID @G36XRRU*/ 00320000 MVC OPCMODID(2,ROPCAVT),MOD02 0595 00321000 * OCMODNME=OPCDOUBL; /* SAVE RNNAME */ 00322000 MVC OCMODNME(8,ROPCE),OPCDOUBL(ROPCAVT) 0596 00323000 * OCWTG=THISMOD; /* SET FOR RETURN XCTL */ 00324000 MVC OCWTG(2,ROPCE),THISMOD 0597 00325000 * GOTO XCTL; /* CALL NEXT MODULE */ 00326000 B XCTL 0598 00327000 * RFY 0599 00328000 * RPRU UNRSTD; /* @G36XRRU*/ 00329000 * 0600 00330000 */********************************************************************/ 00331000 */* PROCESS THE RETURN BDU FROM A DISPLAY STORAGE BDU COMMAND. */ 00332000 */********************************************************************/ 00333000 * 0600 00334000 *PRORESP: 0600 00335000 * RFY 0600 00336000 * RPRU RSTD; /* @G36XRRU*/ 00337000 PRORESP DS 0H 0601 00338000 * RPRU=OCUNIT; /* PRU ADDRESS @G36XRRU*/ 00339000 L RPRU,OCUNIT(,ROPCE) 0601 00340000 * IF ROPCE->PRFPRI^=PRISSBUF THEN/* NOT A RECORD STOR @ZM47883*/ 00341000 CLI PRFPRI(ROPCE),X'E2' 0602 00342000 BE @RF00602 0602 00343000 * DO; /* REQ BUFFER @ZM47883*/ 00344000 * IF PRURHSDI=ON THEN /* GOOD RESPONSE @ZM47883*/ 00345000 LR @14,RPRU 0604 00346000 AL @14,@CF02067 0604 00347000 TM PRURHSDI(@14),B'00000100' 0604 00348000 BO @RT00604 0604 00349000 * GOTO BADRESP; /* NO, PROCESS BAD RETURN */ 00350000 * IF CMDCODES=DRUFLAG THEN/* RESPONSE BDU @ZM47883*/ 00351000 CLC CMDCODES(3,RPRU),@CB02004 0606 00352000 BNE @RF00606 0606 00353000 * DO; /* YES @ZM47883*/ 00354000 * RFY 0608 00355000 * RELEMNT RSTD; /* GET 1ST ELEM ON Q @ZM47883*/ 00356000 * RELEMNT=OPCDSRWT; /* OPCDSRWT @ZM47883*/ 00357000 L RELEMNT,OPCDSRWT(,ROPCAVT) 0609 00358000 * IF RELEMNT=AVTFZERO THEN/* IF Q IS EMPTY @ZM47883*/ 00359000 L @14,AVTFZERO(,IEDQAPTR) 0610 00360000 CR RELEMNT,@14 0610 00361000 BNE @RF00610 0610 00362000 * DO; /* @ZM47883*/ 00363000 * OPCDSRWT=ROPCE; /* PUT OPCE ON Q @ZM47883*/ 00364000 ST ROPCE,OPCDSRWT(,ROPCAVT) 0612 00365000 * OCLINK=AVTFZERO;/* ZERO LINK FIELD @ZM47883*/ 00366000 ST @14,OCLINK(,ROPCE) 0613 00367000 * END; /* @ZM47883*/ 00368000 * ELSE 0615 00369000 * DO; /* @ZM47883*/ 00370000 B @RC00610 0615 00371000 @RF00610 DS 0H 0616 00372000 * OCLINK=RELEMNT; /* CHAIN 1ST ELEM @ZM47883*/ 00373000 ST RELEMNT,OCLINK(,ROPCE) 0616 00374000 * OPCDSRWT=ROPCE; /* MAKE OPCE 1ST ON Q @ZM47883*/ 00375000 ST ROPCE,OPCDSRWT(,ROPCAVT) 0617 00376000 * END; /* @ZM47883*/ 00377000 * RFY 0619 00378000 * RELEMNT UNRSTD; /* @ZM47883*/ 00379000 @RC00610 DS 0H 0620 00380000 * RPARM=RPRU; /* PARM EQU BUFFER ADR@ZM47883 */ 00381000 LR RPARM,RPRU 0620 00382000 * PRUTIC=INVALTIC; /* SET INVALID TIC @ZM47938*/ 00383000 MVC PRUTIC(4,RPRU),@CB01354 0621 00384000 * CALL FREEBUF; /* FREE RESPONSE BUF @ZM47883*/ 00385000 L @15,OPCFREBF(,ROPCAVT) 0622 00386000 BALR @14,@15 0622 00387000 * RZERO=ZERO; /* PARM FOR 00 @ZM47883*/ 00388000 SLR RZERO,RZERO 0623 00389000 * OPCCOPCE=AVTFZERO; /* ZERO OPCE POINTER @ZM47883*/ 00390000 L @14,AVTFZERO(,IEDQAPTR) 0624 00391000 ST @14,OPCCOPCE(,ROPCAVT) 0624 00392000 * OPCMODID=MOD00; /* SET XCTL MOD ID @ZM47883*/ 00393000 MVC OPCMODID(2,ROPCAVT),MOD00 0625 00394000 * GOTO XCTL; /* EXIT @ZM47883*/ 00395000 B XCTL 0626 00396000 * END; /* @ZM47883*/ 00397000 * END; /* @ZM47883*/ 00398000 @RF00606 DS 0H 0629 00399000 * RFY 0629 00400000 * RPRU UNRSTD; /* @ZM47883*/ 00401000 @RF00602 DS 0H 0630 00402000 */* @ZM47883*/ 00403000 */* ASSUME THIS IS A RECORD STORAGE REQUEST. SETUP @ZM47883*/ 00404000 */* NCP STORAGE DATA IN WTO PLIST TO BE WRITTEN TO @ZM47883*/ 00405000 */* PRIMARY OPERATOR CONTROL TERMINAL. @ZM47883*/ 00406000 */* @ZM47883*/ 00407000 * 0630 00408000 * RFY 0630 00409000 * RELEMNT RSTD; /* @ZM47883*/ 00410000 * RELEMNT=OPCDSRWT; /* DEQUEUE THE @ZM47883*/ 00411000 L RELEMNT,OPCDSRWT(,ROPCAVT) 0631 00412000 * OPCDSRWT=RELEMNT->OCLINK; /* OPCE FROM WAIT CHN @ZM47883*/ 00413000 L @14,OCLINK(,RELEMNT) 0632 00414000 ST @14,OPCDSRWT(,ROPCAVT) 0632 00415000 * OPCCOPCE=RELEMNT; /* RESET OPCE FOR 07 @ZM47883*/ 00416000 ST RELEMNT,OPCCOPCE(,ROPCAVT) 0633 00417000 * LENGT=DISPLEN*TWO+LENGTH(MESSAGE);/* SET MSG LENGTH-- LENGTH 00418000 * OF MESSAGE PLUS 2 CHAR FOR 0634 00419000 * EACH BYTE OF DATA TO INSERT 0634 00420000 * @G36XRRU*/ 00421000 MVC LENGT(2,RWORKA),@CH02059 0634 00422000 * MESSAGE=MSGFILD; /* MOVE MESSAGE TO WORK AREA */ 00423000 MVC MESSAGE(28,RWORKA),MSGFILD 0635 00424000 * NAME=RELEMNT->OCMODNME; /* PLACE NAME IN MSG @ZM47883*/ 00425000 MVC NAME(8,RWORKA),OCMODNME(RELEMNT) 0636 00426000 * RWORKPTR=ADDR(STARTTXT); /* POINT TO START OF MESSAGE 0637 00427000 * INSERT */ 00428000 LA RWORKPTR,STARTTXT(,RWORKA) 0637 00429000 * RFY 0638 00430000 * IEDQPRF BASED(ROPCE); /* @ZM47883*/ 00431000 * PRFTIC=INVALTIC; /* SET INVALID TIC @ZM47920*/ 00432000 MVC PRFTIC(4,ROPCE),@CB01354 0639 00433000 * RSORCFLD=AVTHDRSZ+ADDR(PRFSUNIT)+PRFISIZE+LENGTH(CMDDATA);/* 00434000 * POINT TO SOURCE FLD@ZM47883 */ 00435000 LA RSORCFLD,PRFSUNIT(,ROPCE) 0640 00436000 AL RSORCFLD,@CF00474 0640 00437000 SLR @14,@14 0640 00438000 IC @14,PRFISIZE(,ROPCE) 0640 00439000 ALR RSORCFLD,@14 0640 00440000 LA RSORCFLD,13(,RSORCFLD) 0640 00441000 * RFY 0641 00442000 * IEDQPRF BASED(OCUNIT); /* @ZM47883*/ 00443000 * RELEMNT=ROPCE; /* SAVE BUFFER ADDRESS@ZM47938 */ 00444000 LR RELEMNT,ROPCE 0642 00445000 * ROPCE=OPCCOPCE; /* RESET OPCE POINTER @ZM47883*/ 00446000 L @14,OPCCOPCE(,ROPCAVT) 0643 00447000 LR ROPCE,@14 0643 00448000 * RFY 0644 00449000 * IEDQOPCE BASED(ROPCE); /* */ 00450000 * OCUNIT=RELEMNT; /* CHAIN BUF OFF OPCE @ZM47920*/ 00451000 ST RELEMNT,OCUNIT(,ROPCE) 0645 00452000 * RFY 0646 00453000 * RELEMNT UNRSTD; /* */ 00454000 * RESPECIFY 0647 00455000 * (RTEXTC) RESTRICTED; 0647 00456000 * RTEXTC=ZERO; /* ZERO TEXT LENGTH COUNT */ 00457000 SLR RTEXTC,RTEXTC 0648 00458000 */********************************************************************/ 00459000 */* CONVERT TWO CHARACTERS OF TEXT AT A TIME. THE THIRD EXTRA */ 00460000 */* CHARACTER PICKED UP BY THE 'UNPACK' IS OBTAINED ONLY TO ADJUST */ 00461000 */* FOR THE SIGN AND IS DISREGARDED. */ 00462000 */********************************************************************/ 00463000 * 0649 00464000 *BUILDMSG: 0649 00465000 * GEN( UNPK 0(5,RWORKPTR),0(3,RSORCFLD));/* @G36XRRU*/ 00466000 BUILDMSG UNPK 0(5,RWORKPTR),0(3,RSORCFLD) 00467000 * RCOUNTER=ONE; /* INITIALIZE COUNTER */ 00468000 LA RCOUNTER,1 0650 00469000 *CONVERT: 0651 00470000 * IF RCOUNTERCHAR9 THEN /* DOES CHAR NEED CONVERTING ? */ 00476000 CLC OUTCHAR(1,RWORKPTR),CHAR9 0653 00477000 BNH @RF00653 0653 00478000 * OUTCHARF=OUTCHARF-NUMSHIFT;/* YES, SHIFT IT TO 0654 00479000 * ALPHABETIC */ 00480000 SLR @14,@14 0654 00481000 IC @14,OUTCHARF(,RWORKPTR) 0654 00482000 SL @14,@CF01965 0654 00483000 STC @14,OUTCHARF(,RWORKPTR) 0654 00484000 * RCOUNTER=RCOUNTER+ONE; /* INCREMENT CHAR COUNT */ 00485000 @RF00653 LA @14,1 0655 00486000 ALR RCOUNTER,@14 0655 00487000 * RWORKPTR=RWORKPTR+ONE; /* POINT TO NEXT OUTPUT CHAR */ 00488000 ALR RWORKPTR,@14 0656 00489000 * GOTO CONVERT; /* CONTINUE CONVERSION */ 00490000 B CONVERT 0657 00491000 * END; 0658 00492000 * RTEXTC=RTEXTC+TWO; /* BUMP NO. OF SOURCE CHARACTERS 00493000 * PROCESSED */ 00494000 @RF00651 LA @14,2 0659 00495000 ALR RTEXTC,@14 0659 00496000 * IF RTEXTC