|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 15494 (0x3c86)
Types: s3xseg
Names: »S$E077«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E077«
MACRO 00010000
.********************************************************************** 00015000
.* NAME: $E077 V-14, M-00. * 00040000
.* R14 MARKS THE CHANGES FOR APAR S307846 * 00042000
.********************************************************************** 00045000
$E077 00640000
GBLB &ONE,&NOB,&NOM,&N32,&NAS,&NMSG,&NMOVE,&NBFR,&NRUF 00650000
GBLB &NCS,&NSWL 00670000
TEXT 00690000
* R-14,C-00 CHANGE LEVEL 00700000
$CC4CM TITLE '$E077/CMRDMV---READ-MOVE/TRANSLATE' 00710000
*********************************************************************** 00720000
* MOVING/TRANSLATING OF DATA TO RECORD AREA * 00730000
*********************************************************************** 00740000
SPACE 00750000
CMRDMV EQU * MOVE/TRANSLATE DATA INTO RECORD 00760000
AIF (&ONE).C0270 00770000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 00780000
BF CMRMLT NO-GO HANDLE MLTA DTF 2 00790000
.C0270 ANOP 00800000
AIF (&NRUF).E0096 00801000
* -----START-------------------@06 00802000
L PLTUBA(,PL),XR2 XR2->TUB. 00803000
TBN TUBSCS(,XR2),TUBRUF RUF DATA INPUT ? 00804000
L TUBDTF(,XR2),DTF DTF->DTF. 00805000
JT CMRMSG YES - HANDLE AS GET MESSAGE 00806000
* -----END---------------------@06 00807000
.E0096 ANOP 00808000
AIF (&NOB).C0280 00810000
AIF (&NMSG).E0100 00820000
SPACE 00830000
* FOR GET-MSG OPERATION TAKE CARE OF BLOCKING THE DATA TOGETHER AS GB 00840000
* IT COMES IN. DO NOT DO ANY TRANSLATE UNTIL THE EOT IS RECEIVEG. 00850000
SPACE 00860000
TBF PLOPM(,PL),OPREQR USER REQUEST, AND GB 00870000
TBN SAVTA2,TASMSG * GET-MSG MODE ? GB 00880000
JF CMRBMV NO-GO CHECK FOR XLATE NOW. GB 00890000
AIF (&NRUF).EN999 00891000
* -----START-------------------@06 00892000
CMRMSG EQU * 00893000
* -----END---------------------@06 00894000
.EN999 ANOP 00895000
CLC $BDREL(2,DTF),PLINL(,PL) THIS HUNK FILL UP REST OF AREAGB 00900000
JNE CMRBFL NO-GO TO UPDATE CONTROL PTRS. GB 00910000
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT/ DEQ ON FIND. GB 00920000
CMRBFL EQU * * GB 00930000
ALC PLRECA(2,PL),$BDREL(,DTF) UP REC ADDR TO NEXT FREE AREA.GB 00940000
SLC PLINL(2,PL),$BDREL(,DTF) DECREMENT COUNT OF FREE SPACE.GB 00950000
ALC LCBMRL(2,DTF),$BDREL(,DTF) KEEP COUNT OF TOTAL DATA IN. GB 00960000
B CMFORM GO TO GET THE NEXT BLOCK. GB 00970000
SPACE 00980000
.E0100 ANOP 00990000
CMRBMV EQU * * B 01000000
MVC TRL+TLFRML,$BDREL(2,DTF) SET UP TRANSLATE PARAMETER LISTB 01010000
MVC TRL+TLTOL,PLINL(2,PL) * B 01020000
MVC TRL+TLFRMA,PLRECA(2,PL) * B 01030000
MVC TRL+TLTOA,PLRECA(2,PL) * B 01040000
TBF PLOPM(,PL),OPREQR USER REQUEST, AND B 01050000
TBN SAVTA1,TASTRN DON'T TRANSLATE ? B 01060000
JT CMRBNK YES-GO CHECK FOR BLANKING REST.B 01070000
AIF (&NAS).A0100 01080000
TBN $BDATT(,DTF),$BCASK ASCII ADAPTER ? AB 01090000
JF CMRLCX NO-GO CHECK FOR LOWER CASE. AB 01100000
LA TRL,XR1 POINT TO TRANSLATE LIST. AB 01110000
B $CC4PI GO TO CALL IN THE TRANSLATE AB 01120000
DC AL1(CC4JE) * TRANSIENT. AB 01130000
SPACE 01140000
L LCBPL@(,DTF),PL RELOAD THE PARM LIST REG. AB 01150000
CMRLCX EQU * * AB 01160000
.A0100 ANOP 01170000
TBF SAVTA1,TASCAS FORCE UPPER CASE CHARS ? B 01180000
JF CMRBNK NO-GO CHECK TO BLANK REST BUFRB 01190000
SPACE 01200000
* FIND AND USE SHORTEST OF PLINL OR $BDREL FOR FORCE UPPER CASE. B 01210000
SPACE 01220000
MVC LCBWRK(2,DTF),PLINL(,PL) SAVE INL IN WORK AREA. B 01230000
CLC $BDREL(2,DTF),PLINL(,PL) FROM AREA GT THAN TO AREA ? B 01240000
JH CMRUCX YES-THEN USE PLINL AS IS SET. B 01250000
CLC $BDREL(2,DTF),CC0000 RECORD LENGTH EQUAL ZERO ? B 01253000
JE CMRNTR YES- THEN DON'T TRANSLATE B 01256000
MVC LCBWRK(2,DTF),$BDREL(,DTF) ELSE USE DTF RECORD LENGTH. B 01260000
CMRUCX EQU * UPPER CASE XLATE ROUTINE. B 01270000
L PLRECA(,PL),XR1 LOAD ADDR OF START OF BUFFER. B 01280000
CMRUPX EQU * * B 01290000
CLI 0(,XR1),BLANK THIS CHAR BLANK OR GREATER ? B 01300000
JL CMRUPC NO-GO UP TO NEXT CHARACTER. B 01310000
SBN 0(,XR1),BLANK SET ON UPPER CASE ZONE BIT. B 01320000
CMRUPC EQU * UPDATE TO NEXT CHARACTER. B 01330000
LA 1(,XR1),XR1 INCREMENT REG TO NEXT CHAR. B 01340000
SLC LCBWRK(2,DTF),CC0001 DECREMENT COUNT, ANY LEFT ? B 01350000
BNZ CMRUPX YES-GO CHECK NEXT CHAR. B 01360000
CMRNTR EQU * * B 01365000
L LCBPL@(,DTF),PL RELOAD THE PARM LIST REG. B 01370000
CMRBNK EQU * CHECK NEED TO BLANK REST BUFFR.B 01380000
TBF PLOPC(,PL),OPNOW AN INVITE INPUT OPERATION, OR B 01390000
CLC $BDREL(2,DTF),PLINL(,PL) * FROM AREA NOT LESS THAN TO ? B 01400000
JC CMSETL,FLSNLO YES-ONE OF THESE, GO READY EXITB 01410000
LA MVL,XR2 LOAD REG PTR TO PARM LIST. B 01420000
USING MVL,XR2 ESTABLISH BASE REGISTER 01430000
ALC TLTOA(2,XR2),TLFRML(,XR2) UPDATE PAST DATA RECEIVED. B 01440000
SLC TLTOL(2,XR2),TLFRML(,XR2) CORRECT TO LEN FOR CHARS NOT USD 01450000
MVC TLFRML(4,XR2),BNKRST(,XR2) MOVEFROM @ / LEN- DUMMY FIELD.B 01460000
B $CC4MX GO TO MOVE/CLEAR SUBROUTINE. B 01470000
SPACE 01480000
CMSETL EQU * SET USER RECORD LENGTH B 01490000
L CMSDTF,DTF RELOAD DTF REGISTER. B 01500000
TBF PLOPM(,PL),OPREQR USER REQUEST, AND B 01510000
TBN LCBAT2(,DTF),LCBTRC TRUNCATED BLOCK INDICATED ? B 01520000
SBF LCBAT2(,DTF),LCBTRC SET IT OFF B 01525000
JF CMSBFL NO-GO SET BSCA EFFL COUNT. B 01540000
TBN SAVTA2,TASBLK BLOCK READ OPERATION ? B 01550000
JT CMSBLK YES-GO BUMP BKX PAST THIS BLK. B 01560000
CLC PLINL(2,PL),SAVRCL INL LESS THAN TAS TECL ? B 01570000
JNL CMSBFL NO-MORE REC'S IN THE BLOCK. B 01580000
SLC $BDBKX(2,DTF),PLINL(,PL) ADJUST BKX TO GET THE NEXT REC.B 01590000
CMSBLK EQU * * B 01600000
ALC $BDBKX(2,DTF),SAVRCL BUMP TO NEXT REC/BLK. B 01610000
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED IND TO USEER. B 01620000
CMSBFL EQU * * B 01630000
MVC PLEFFL(,PL),$BDREL(2,DTF) MOVE IN RETURNED RECORD LEN. B 01640000
AIF (&N32).T0200 01650000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST, AND 0B 01660000
CLI CMSPHY,TUB5M2 A 3270 TERMINAL ? 0B 01670000
JC CMSLOD,FLSOHI NO-GO SET RETURN CODE. 0B 01680000
* R14 01680050
AIF (&NRUF).T0205 R14 01680100
* R14 01680150
L PLTUBA(,PL),TUB POINT TO THE TUB R14 01680200
TBN TUBSCS(,TUB),TUBRUF PRUF TUB? R14 01680250
L LCBPL@(,DTF),PL RELOAD THE PARM LIST PTR R14 01680300
JF CMCFRM NO, CONTINUE R14 01680350
LA $CCCOM,XR1 ---> XR1 TO CCCOM AREA R14 01680400
MVC CMRFCK(2),#RUFCL(,XR1) SET MAX PRUF LENGTH R14 01680450
L LCBPL@(,DTF),PL RELOAD THE PARM LIST PTR R14 01680500
SLC CMRFCK(2),CMSEVN ALLOW FOR PGM NAME SHIFT R14 01680550
CLC PLEFFL(2,PL),CMRFCK DATA LENGTH > ADJ PRUF LNGTH R14 01680600
JNH CMCFRM NO, SKIP ADJUSTMENT R14 01680650
MVC PLEFFL(2,PL),CMRFCK DEFAULT TO THE LEAST R14 01680700
SBN PL$RTC(,PL),RCXDTR INDICATE DATA TRUNCATED R14 01680750
CMCFRM EQU * R14 01680800
* R14 01680850
.T0205 ANOP R14 01680900
* R14 01680950
* -----START-------------------@07 01681000
AIF (&NSWL).T0208 01682000
AIF (&NCS).T0206 01683000
TBF $BDATR(,DTF),$BCMPT NOT MULTI-POINT LINE ? 01684000
JF CMB0C1 NO - CALL CONTROL LINE FORMAT 0B 01685000
.T0206 ANOP 01686000
B $CC4PI CALL IN THE 3275 SW LINE FORMATB 01690000
DC AL1(CC4S0) * TRANSIENT FOR COMMAND INPUT.0B 01700000
B CMRETC GO SET RETURN CODE. 0B 01705000
SPACE 01710000
.T0208 ANOP 01711000
CMB0C1 EQU * * LOCAL 0B 01712000
B $CC4PI CALL IN THE 3270 FORMATTING 0B 01713000
DC AL1(CC4B0) * TRANSIENT FOR COMMAND INPUT.0B 01714000
* -----END---------------------@07 01715000
CMSLOD EQU * * 0B 01720000
.T0200 ANOP 01730000
B CMRETC GO SET RETURN CODE. B 01740000
SPACE 01750000
.C0280 ANOP 01760000
AIF (&ONE).C0290 01770000
EJECT 01780000
CMRMLT EQU * * 01790000
.C0290 ANOP 01800000
AIF (&NOM).M0600 01810000
SPACE 01820000
* XR1 POINTS AT PARM LIST M 01830000
* XR2 POINTS AT DTF M 01840000
* ANALYZE THE RECORD LENGTH REQUESTED BY THE USER AGAINST THE RECORD M 01850000
* LENGTH ACTUALLY RECEIVED AS A RESULT OF THE READ M 01860000
* IF RECEIVED EQUAL OR LESS THAN REQUESTED - GIVE USER ONLY WHAT RECVDM 01870000
* IF RECEIVED GREATER THAN LENGTH REQUESTED, TRANSLATE ONLY UP TO M 01880000
* LENGTH REQUESTED BY USER AND PUT INDICATION IN RETURN CODE THAT M 01890000
* ALTHOUGH READ WAS SUCCESSFUL, TERMINAL OPERATOR TRANSMITTED MORE M 01900000
* DATA THAN WAS REQUESTED BY THE USER M 01910000
SPACE 01920000
* BEGIN TO SET UP THE PARM LIST FOR MOVE OR TRANSLATE M 01930000
* SET UP PARAMETER LIST FOR THE MOVE OR TRANSLATE M 01940000
* MOVE IN 'FROM' AND 'TO' ADDRESSES WHICH ARE THE SAME FOR BOTH THE M 01950000
* TRANSLATE AND THE MOVE LIST M 01960000
SPACE 01970000
MVC MVL+MVLFRA(2),$MDCRA(,XR2) MOVE FROM ADDR TO MOVE LIST M 01980000
MVC MVL+MVLTOA(2),PLRECA(,XR1) MOVE TO ADDR TO MOVE LIST M 01990000
SPACE 02000000
AIF (&NMOVE).M5000 02010000
* DETERMINE IF TRANSLATE WAS REQUESTED VM 02020000
* FOR SYSTEM REQUEST - ALWAYS TRANSLATE VM 02030000
SPACE 02040000
TBF PLOPM(,XR1),OPREQR IS IT USER REQUEST VM 02050000
TBN SAVTA1,TASTRN IS DON'T TRANSLATE BIT ON VM 02060000
JT CMRMOV IF NOT, JUMP TO STRAIGHT MOVE VM 02070000
.M5000 ANOP 02080000
SPACE 02090000
* WE ARE GOING TO TRANSLATE M 02100000
* MOVE 'TO' LENGTH AND 'FROM' LENGTH TO M 02110000
* THE TRANSLATE LIST M 02120000
SPACE 02130000
MVC TRL+TLFRML(2),$MDCRL(,XR2) MOVE 'FROM' LENGTH TO TRANS M 02140000
MVC TRL+TLTOL(2),PLINL(,XR1) MOVE 'TO' LENGTH TO TRANS LST M 02150000
SPACE 02160000
* DETERMINE IF UPPER OR LOWER CASE REQUESTED M 02170000
* AND MOVE TRANSIENT ID OF APPROPRIATE TRANSLATE TRANSIENT TO THE M 02180000
* BYTE FOLLOWING THE BRANCH TO $CC4PI M 02190000
* FOR SYSTEM REQUEST - ALWAYS TRANSLATE TO UPPER CASE M 02200000
SPACE 02210000
AIF (&NOB).C0300 02220000
CMRXLT EQU * * B 02230000
.C0300 ANOP 02240000
TBN SAVTA1,TASCAS IS LOWER CASE TRANSLATE BIT ON M 02250000
TBF PLOPM(,XR1),OPREQR IS IT USER REQUEST M 02260000
LA TRL,XR1 POINT XR1 AT TRANSLATE LIST M 02270000
SPACE 02280000
* MOVE IN ID OF UPPER CASE TRANSLATE TRANSIENT M 02290000
SPACE 02300000
MVC CMTRD(1),LCBLCE(,XR2) MOVE UPPER CASE TRANSIENT ID M 02310000
JF CMDOTR JUMP IF LOWER CASE BIT NOT ON M 02320000
SPACE 02330000
* TRANSLATE TO LOWER CASE EBCDIC SO M 02340000
* MOVE IN TRANSIENT ID OF TRANSLATE TRANSIENT FOR LOWER CASE EBCDIC M 02350000
SPACE 02360000
MVC CMTRD(1),LCBLLE(,XR2) MOVE IN LOWER CASE TRANSIENT IDM 02370000
SPACE 02380000
* TRANSLATE THE DATA FROM THE LINE BUFFER TO THE RECORD AREA POINTED M 02390000
* TO BY THE PARAMETER LIST M 02400000
* THE TRANSLATE ROUTINE WILL ALWAYS POST CLEAR THE INPUT AREA TO BLNKSM 02410000
SPACE 02420000
CMDOTR EQU * TRANSLATE THE DATA M 02430000
B $CC4PI BRANCH TO CALL IN TRANSIENT M 02440000
CMTRD DC AL1(0) TRANSLATE TRANSIENT ID M 02450000
SPACE 02460000
* AFTER TRANSLATE XR1 POINTS TO TRANSLATE TABLE M 02470000
SPACE 02480000
* TRANSLATE RETURN CODE IS AS FOLLOWS M 02490000
* X'00' GOOD TRANSLATE M 02500000
* X'01' INVALID CHAR TRANSLATED BUT REPLACED M 02510000
SPACE 02520000
CMGTRC EQU * GET TRANSLATE RETURN CODE M 02530000
TBN TLRTC(,XR1),TLERR WAS THERE TRANSLATE ERROR M 02540000
L CMSPL,XR1 POINT XR1 AT PARM LIST M 02550000
JF CMTCR JUMP IF NO TRANSLATE ERROR M 02560000
SPACE 02570000
* HAD TRANSLATE ERROR M 02580000
SPACE 02590000
* BRANCH TO TRANSIENT TO HANDLE M 02600000
SPACE 02610000
* XR2 POINTS AT PARM LIST M 02620000
SPACE 02630000
B $CC4PI BRANCH TO BRING IN TRANSINET M 02640000
DC AL1(CC4WR) TRANSLATE ERROR TRANSIENT ID M 02650000
B CMRETC JUMP AND HANDLE AS TP ERROR M 02660000
SPACE 02680000
* IF RETURN AT THIS POINT - THE TERMINAL HAS BEEN PUT INTO ERP M 02690000
* THEREFORE BRANCH TO RESCHEUDLE THE LINE M 02700000
B CMRSCH BR TO RESCHEUDLE THE LINE M 02710000
SPACE 02720000
CMTCR EQU * CHK LAST CHAR FOR CARRIAGE R:N M 02730000
L PLTUBA(,XR1),XR1 POINT XR1 AT THE TUB M 02740000
SBF TUBCHR(,XR1),TUB@SL+TUBNID SET OFF LINE LOCATION BITS M 02750000
TBN TRL+TLRTC,TLCREL WAS LAST CHAR A CARRIAGE RETURNM 02760000
JF CMNOCR JUMP IF NOT CARRIAGE RETURN M 02770000
SPACE 02780000
* LAST CHARACTER TRANSLATED WAS CARRIAGE RETURN SO TYPEWRITER M 02790000
* IS AT THE START OF A NEW LINE M 02800000
* INDICATE THIS IN THE TERMINAL CHARACTERISTICS BYTE M 02810000
SPACE 02820000
SBN TUBCHR(,XR1),TUB@SL SET AT START OF LINE BIT ON M 02830000
SPACE 02840000
* DETERMINE FROM LENGTH OF INPUT WHETHER IDLE CHARACTERS ARE M 02850000
* NEEDED AT BEGINNING OF NEXT OUTPUT M 02860000
* (MUST HAVE TIME FOR CARRIAGE TO RETURN TO HOME POSITION) M 02870000
AIF (&NBFR).R5100 RM 02880000
* THIS ANALYSIS DOES NOT APPLY TO BUFFERRED RECEIVE TERMINALS SINCE RM 02890000
* THEY DO NOT NEED IDLE CHARACTERS RM 02900000
SPACE 02910000
L CMSLCB,XR2 POINT XR2 AT THE DTF RM 02920000
TBF $MDTFR(,XR2),$MTBFR CHECK FOR NOT BUFFER RECEIVD RM 02930000
CLI TRL+TLTOL,CMCRTM COMPARE AGNST MAX THAT CAN RM 02940000
* HANDLED WITHOUT IDLES RM 02950000
JC CMNOCR,ANY+LO+FALSE JUMP IF LT MAX OR BUF REC M 02960000
AGO .R5150 M 02970000
.R5100 ANOP M 02980000
SPACE 02990000
CLI TRL+TLTOL,CMCRTM COMPARE AGAINST MAX THAT CAN BEM 03000000
* HANDLED WITHOUT IDLES M 03010000
JL CMNOCR JUMP IF LESS THAN MAX M 03020000
.R5150 ANOP M 03030000
SPACE 03040000
* HAVE LARGE INPUT LINE FOLLOWED BY CARRIAGE RETURN M 03050000
* INDICATE IDLES NEEDED ON NEXT OUTPUT TO THIS TERMINAL TO ALLOW M 03060000
* CARRIAGE TO RETURN TO HOME POSITION M 03070000
SPACE 03080000
SBN TUBCHR(,XR1),TUBNID SET ON IDLES NEEDED BIT M 03090000
SPACE 03100000
CMNOCR L CMSPL,XR1 POINT XR1 AT PARM LIST M 03110000
AIF (&NMOVE).M5100 VM 03120000
J CMSEFL JUMP TO SET LENGTH FOR USER VM 03130000
SPACE 03140000
* PERFORM STRAIGHT MOVE ON DATA WITHOUT TRANSLATING OR ANALYZING IT VM 03150000
SPACE 03160000
CMRMOV EQU * MOVE DATA FOR A READ OP END VM 03170000
SPACE 03180000
* DETERMINE WHICH IS LESS- THE LENGTH OF THE RECORD REQUESTED WHICH VM 03190000
* SITS IN THE PARM LIST - OR - THE LENGTH OF THE DATA KEYED WHICH IS VM 03200000
* IN THE MLTA DTF VM 03210000
* USE THE LESSER OF THE TWO VM 03220000
SPACE 03230000
CLC $MDCRL(2,XR2),PLINL(,XR1) COMPARE ACTUAL VS ASKED LNGTHVM 03240000
JNH CMACTL JUMP IF NOT HIGH TO USE ACTUALVM 03250000
SBN PL$RTC(,XR1),RCXDTR INPUT MSG TRUNCATED RTN CODE VM 03260000
SPACE 03270000
* USE REQUESTED LENGTH AND SET BIT ON TO INDICATE VM 03280000
* INPUT MESSAGE TRUNCATED VM 03290000
SPACE 03300000
MVC MVL+MVLTOL(2),PLINL(,XR1) MOVE ASKED LENGTH TO MOVE LISTVM 03310000
* ACTUAL GT REQUESTED READ LNGTHVM 03320000
J CMDOMV JUMP TO DO THE MOVE VM 03330000
CMACTL EQU * USE ACTUAL LENGTH FOR MOVE VM 03340000
MVC MVL+MVLTOL(2),$MDCRL(,XR2) MOVE ACT LENGTH TO MOVE LIST VM 03350000
SPACE 03360000
CMDOMV EQU * DO THE MOVE VM 03370000
LA MVL,XR2 POINT XR2 AT MOVELIST VM 03380000
B $CC4MV BR TO MOVE ROUTINE VM 03390000
.M5100 ANOP M 03400000
SPACE 03410000
SPACE 03420000
* COMPARE LENGTH REQUESTED VS LENGTH RECEIVED AND IF RECEVIED GREATER M 03430000
* SET BIT ON IN RETURN CODE TO INDICATE MESSAGE TRUNCATED M 03440000
SPACE 03450000
CMSEFL EQU * * M 03451000
MVC PLEFFL(2,XR1),TRL+TLTOL MOVE EFFECTIVE READ LENGTH M 03460000
CLC PLEFFL(2,XR1),PLINL(,XR1) COMPARE ACTUAL VS ASKED LENGTH M 03470000
BNH CMRETC JUMP TO DE QUEUE PARM LIST M 03480000
SBN PL$RTC(,XR1),RCXDTR SET DATA TRUNCATED RETURN CODE M 03490000
* INPUT MESSAGE TRUNCATED M 03500000
MVC PLEFFL(2,XR1),PLINL(,XR1) SET EFFECTIVE LENGTH TO ASKED M 03510000
SPACE 03520000
B CMRETC JUMP TO DE QUE OP M 03530000
.M0600 ANOP M 03540000
MEND 03550000