|
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: 20320 (0x4f60)
Types: s3xseg
Names: »S$E110«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E110«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* TITLE: $E110 - NEW REQUEST SET-UP ROUTINE * 00040000
.* * 00050000
.* STATUS: V2 M0 * 00060000
.* * 00070000
.* FUNCTION: DETERMINE TYPE OF OPERATION REQUESTED. * 00080000
.* GETMAIN FOR PL (IF REQUIRED),GETMAIN * 00090000
.* FOR RECORD AREA (IF REQUIRED),QUEUE * 00100000
.* PL ON CLB FOR THE REQUESTED LINE. * 00110000
.* IF LINE IS BUSY, THEN DETERMINE WHETHER * 00120000
.* TO ACCEPT OR REJECT THIS NEW REQUEST. * 00130000
.* EXIT TO POST THIS REQUEST IF REJECTED. * 00140000
.* EXIT TO PERFORM REQUESTED OP OR TO STOP * 00150000
.* POLLING SO OP MAY BE PERFORMED. * 00160000
.* * 00170000
.* INPUT: XR1 --> NEW REQUEST PARM LIST * 00180000
.* XR2 --> PREVIOUS PL * 00190000
.* * 00200000
.* OUTPUT: PARM LIST READY TO PERFORM REQUESTED OP * 00210000
.* * 00220000
.* EXTERNAL REFERENCES: CSCLBQ - SUBROUTINE TO DO GETMAINS * 00230000
.* TRANSIENTS - * 00240000
.* $CC4US - STOP INVITE * 00250000
.* $CC4UD - PUT TO TUB IN ERP * 00260000
.* * 00270000
.* EXITS: TO $E100 - CHECK FOR MORE WORK * 00280000
.* $E140 - SCHEDULE THIS LINE * 00290000
.* * 00300000
.********************************************************************** 00310000
.* GBLB &NDF * NO * DFF SUPPORT * 00330000
.* GBLB &NPBY * NO * BUSY PRINTER SUPPORT (328X PRINTERS)* 00340000
.* GBLB &NCPOR * NO * BSCC PORTLINE SUPPORT * 00345000
.********************************************************************** 00350000
.* * 00352000
.* GBLB &CSIO 0=PORT SUPPORTED,1=PORT NOT SUPPORTED * 00354000
.* * 00356000
.********************************************************************** 00358000
$E110 00360000
GBLB &NDF 00370000
GBLB &CSIO,&NPBY,&NCPOR 00375000
TEXT 00380000
TITLE '$ E 1 1 0 N E W R E Q U E S T R O U T I N E ' 00390000
* DEQUEUE PL FROM @CSNRQ AND DECREMENT NEW REQUEST COUNT 00400000
SPACE 1 00410000
CSNWRQ EQU * 00420000
AIF (&CSIO EQ '1').PT130 00420400
AGO .PT140 00420800
.PT130 ANOP 00421200
AIF (&NCPOR).PT150 00421600
.PT140 ANOP 00422000
SPACE 1 00422400
******************************************************************* @14 00422800
******* 00423200
ST CSSPL,XR2 SAVE REGISTER 2 TO RESTORE 00423600
L PLTUBA(,PL),XR2 XR2 --> TUB (PORT) 00424000
TBN TUBAT2(,XR2),TUBOWN DOES THIS TUB OWN THE LINE ? 00424400
TBN TUBPHY(,XR2),TUBAPT *AND* IS THIS A PORTLINE DEVICE? 00424800
TBF PLOPM(,PL),OPSTOP *AND* IS THIS NOT A STOP INVITE? 00425200
BT CSNMOR YES - THE NEW REQUEST CANNOT BE 00425600
* HANDLED YET, CHECK FOR MORE WORK 00426000
L CSSPL,XR2 RESTORE REGISTER 2 AND CONTINUE 00426400
******* 00426800
******************************************************************* @14 00427200
SPACE 1 00427600
.PT150 ANOP 00428000
MVC PLCHN(2,XR2),PLCHN(,PL) DEQUEUE PL FROM REQ QUEUE 00430000
L PLTUBA(,PL),TUB XR2 --> TUB 00440000
L TUBLCB(,TUB),CLB XR2 --> CLB 00450000
SLC CLBNW#(1,CLB),X$0001 DECREMENT NEW REQUEST COUNT 00460000
SPACE 2 00470000
* PREPARE THE PL FOR SCHEDULING ON THE BSCC LINE 00480000
CSPREP EQU * 00490000
SLC PLCHN(2,PL),PLCHN(,PL) ZIP THE CHAIN POINTER 00500000
SLC PL$OPC(2,PL),PL$OPC(,PL) ZIP PL$OPM ,PL$OPC 00510000
CLI PLOPC(,PL),OPCOPY+OPPUT IS THIS A COPY OPERATION ? 00520000
JE CSNCPY YES - LEAVE PL$RTC, THIS WILL 00530000
* BE THE 'FROM' TERMINAL ADDRESS 00540000
SLC PL$RTC(2,PL),PL$RTC(,PL) ZIP PL$RTC 00550000
CSNCPY EQU * 00560000
ST CSSPL,PL SAVE PL ADDRESS 00570000
ST CSNWPL,PL SAVE PL @ FOR POSTING 00580000
ST CSSCLB,CLB SAVE CLB ADDRESS 00590000
SBN CSSWIT,CSNRIP SET IND 'NEW REQ IN PROCESS' 00600000
SPACE 2 00610000
* IF THIS IS A GET TYPE OP, THEN SET OFF CLEAR IND IN TUB 00620000
SPACE 1 00630000
TBN PLOPC(,PL),OPGET GET TYPE OP 00640000
L PLTUBA(,PL),TUB XR2 --> TUB 00650000
JF CSNOTG NO - JUMP 00660000
SBF TUBSCS(,TUB),TUBCLR SET OFF CLEAR INDICATOR 00670000
SPACE 1 00680000
AIF (&NPBY).BP100 BUSY PRINTER SUPPORT? 00680600
* ------START------------------@07 00681200
TBN TUBAT4(,TUB),TUBBSY IS THIS A BUSY PRINTER TUB? 00681800
JF CSNBY NO - JUMP. 00682400
L TUBDTF(,TUB),XR2 XR2 --> CLB. 00683000
TBN CLBCNT(,XR2),ALLBIT CONTINUOUS POLL? 00683600
MVC CLBCNT-1(1,XR2),CLBCNT(,XR2) SAVE LOOP COUNT. 00684200
SBN CLBBA3(,XR2),BA3BYP INDICATE POLLING BUSY PRINTER. 00684800
JF CSNCHG NOT CONTINUOUS - JUMP. 00685400
MVI CLBCNT(,XR2),I0002 SET LOOP COUNT TO 2 00686000
CSNCHG EQU * * LOCAL 00686600
L PLTUBA(,PL),TUB FIND THE TUB AGAIN. 00687200
CSNBY EQU * * LOCAL 00687800
* -------END-------------------@07 00688400
.BP100 ANOP * 00689000
* CHECK FOR STOP INVITE/PURGE REQUEST - IF SO, CALL TRANSIENT $CC4US 00690000
SPACE 1 00700000
CSNOTG EQU * 00710000
MNN PL$OPM(,PL),PLOPC(,PL) SAVE NUM PORTION OF OP CODE 00720000
TBN PLOPM(,PL),OPSTOP STOP INVITE REQUEST? 00730000
JF CSNSTP NO - JUMP 00740000
SBF CSSWIT,CSNRIP SET OFF NEW REQUEST IND 00750000
L TUBLCB(,TUB),CLB XR2--> CLB 00760000
B CC4TA CALL TRANSIENT AREA HANDLER 00770000
DC AL1(CC4US) TRANSIENT ID 00780000
SPACE 1 00790000
* TRANSIENT RETURNS ON ARR IF STOP SUCCESSFUL - ARR+4 IF MUST 00800000
* STOP THE BSCC LINE (STOP POLL OR ABORT) 00810000
SPACE 1 00820000
B CSNMOR CHECK FOR MORE WORK 00830000
SPACE 1 00840000
B CSCHED GO ATTEMPT TO STOP POLL/ABORT 00850000
SPACE 2 00860000
CSNSTP EQU * NOT A STOP REQUEST 00870000
SPACE 1 00880000
* IF OP IS A PUT-THEN-GET, HANDLE THE PUT PORTION FIRST 00890000
SPACE 1 00900000
TBN PLOPC(,PL),OPPUT+OPGET PUT-THEN-GET? 00910000
JF CSNPTG NO - JUMP 00920000
SBF PL$OPM(,PL),OPGET SET OFF THE GET IND 00930000
SPACE 2 00940000
* CHECK FOR A PUT TO A TERMINAL IN ERP - CALL $CC4UD IF SO 00950000
CSNPTG EQU * 00960000
SPACE 1 00970000
TBN TUBAT3(,TUB),TUBERP TUB IN ERP AND - 00980000
TBN PL$OPM(,PL),OPPUT THIS A PUT? 00990000
JF CSNIRP NO - JUMP 01000000
SPACE 1 01010000
* IF THIS IS A WRAP TEST - ALLOW IT TO GO THROUGH 01020000
TBN PLOPM(,PL),OPOLT ONLINE TEST AND 01030000
CLC PLLEN+1(2,PL),DEC99 WRAP TEST ? 01040000
JC CSNIRP,TRUAEQ YES - JUMP 01050000
SPACE 1 01060000
* CALL XIENT TO HANDLE PUT TO TERM IN ERP 01070000
B CC4TA CALL TRANSIENT AREA HANDLER 01080000
DC AL1(CC4UD) TRANSIENT ID 01090000
* RETURN HERE TO CHECK FOR MORE WORK FOR CS 01100000
B CSPSTN GO POST AND CHECK FOR MORE WORK 01110000
* RETURN HERE IF OP WAS ALSO A GET 01120000
SPACE 2 01130000
CSNIRP EQU * * 01140000
AIF (&CSIO EQ '1').PT010 01140900
AGO .PT020 01141000
.PT010 ANOP 01141100
AIF (&NCPOR).PT030 01141200
.PT020 ANOP 01141300
SPACE 1 01141600
******************************************************************* @14 01142400
******* 01143200
TBN TUBPHY(,TUB),TUBAPT PORTLINE DEVICE 01144000
TBN PLOPC(,PL),OPPNW PUT-NO-WAIT 01144800
JT CSNWAT MAKE OP A WAIT OP 01145600
******* 01146400
******************************************************************* @14 01146800
SPACE 1 01147200
.PT030 ANOP 01148800
TBN PLOPC(,PL),OPPNW PUT-NO-WAIT REQUEST AND 01150000
TBF PLOPM(,PL),OP$SYS A USER OP AND 01160000
CLI PLOPC(,PL),OPMSG NOT MSG MODE? 01170000
JC CSSVAT,FLSNLO NO - JUMP 01180000
CSNWAT EQU * * 01185000
SBF PL$OPM(,PL),OPNOW YES - MAKE IT A WAIT OP 01190000
SPACE 1 01200000
* SAVE THIS TUB'S ATTRIBUTES AND LENGTHS IN THE CLB 01210000
CSSVAT EQU * 01220000
B CSTASV SAVE THIS TUB'S ATTRIBUTES 01230000
MNN PL$OPC(,PL),PL$OPM(,PL) SAVE OP (INTERNAL) 01240000
AIF (&NDF).F0100 NO DFF SUPPORT. 01250000
* IF THIS IS A DFF PUT REQUEST - HANDLE IT HERE 01260000
SPACE 2 01270000
TBN TUBTA1(,TUB),TASDFF DFF TUB AND ------------------| 01280000
TBN PL$OPM(,PL),OPPUT A PUT OP AND -----------------| 01290000
TBF PLOPM(,PL),OP$SYS A USER REQUEST AND -----------| 01300000
TBF PLRECA-1(,PL),ALLBIT A GETMAIN REQUIRED? ----------| 01310000
JF CSREJC NO - CHECK IF OP SHOULD BE <--| 01320000
* REJECTED 01330000
SPACE 2 01340000
* DO A GETMAIN FOR DFF AND PUT PL ON DFF'S QUEUE 01350000
SBF CSSWIT,CSNRIP SET OFF NEW REQ SWITCH 01360000
CCP MASK,PMR MASK INTERRUPTS 01370000
SPACE 1 01370500
L TUBDTF(,TUB),CLB LOCATE BSCC CLB @13 01371000
TBN CLBATA(,CLB),CLBDFF Q-DFF BUFFER SUPPORTED? @13 01371500
JF CSGMMV NO-BRANCH @13 01372000
SPACE 1 01372500
CSGDFF TBN CLBATA(,CLB),CLBDFB Q-DFF BUFFER BUSY? @13 01373000
JF CSGDF1 NO. CONTINUE @13 01373500
SPACE 1 01374000
SBN PL$OPM(,PL),OPGETQ SET GET MAIN REQUIRED @13 01374500
J CSREJC PUT PL ON WAITING QUEUE @13 01375000
SPACE 1 01375500
CSGDF1 SBN CLBATA(,CLB),CLBDFB MAKE DFF BUFFER BUSY @13 01376000
MVC PLRECA(,PL),@LOBND(2) BUILD DFF BUFFER... @13 01376500
ALC PLRECA(,PL),RND2K(2) ...START... @13 01377000
SBF PLRECA(,PL),ALLBIT ....ADDRESS... @13 01377500
SBF PLRECA-1(,PL),BND2K .....IN PLRECA. @13 01378000
J CSGMC1 POST DFF @13 01378500
SPACE 1 01379000
CSGMMV EQU * * 01380000
MVC GMLIST+GMSIZE(2),PLOUTL(,PL) PUT SIZE IN GM PARM LIST 01390000
ALC GMLIST+GMSIZE(2),X$0004 ADD 4 FOR GM PARM LIST 01400000
CLC #GMS+1,GMLIST+GMSIZE(2) ENOUGH TP BUFF? 01410000
JNL CSGMCR YES - DO THE GETMAIN 01420000
* GETMAIN WILL FAIL-DECREMENT LENGTH UNTIL IT WILL WORK OR UNTIL <256 01430000
SBF PLOUTL(,PL),ALLBIT MAKE LENGTH A 256 INCREMENT 01440000
TBF #GMS+1,FC #GMS = NNN4 OR GREATER? 01450000
JF CSGMCK YES - SEE IF GM WILL WORK 01460000
CSGMAG EQU * * 01470000
SLC PLOUTL-1(1,PL),X$0001 DECREMENT BY 256 01480000
JL CSROUT OUTL LESS THAN 256 - JUMP 01490000
CSGMCK EQU * * 01500000
CLI PLOUTL-1(,PL),HEX512 OUTL LESS THAN 512? 01510000
JL CSROUT YES - JUMP 01520000
CLC #GMS+1,PLOUTL(2,PL) ENOUGH TP BUFF NOW? 01530000
BNH CSGMAG NO - GO DECREMENT AGAIN 01540000
B CSGMMV YES - DO THE GETMAIN 01550000
SPACE 2 01560000
* CAN'T GET TP BUFFER - MARK PL AS NEEDING CORE AND PUT IT ON CLBWCQ 01570000
CSROUT EQU * 01580000
MVC PLOUTL(2,PL),X0200 SET LENGTH TO 512 01590000
CSROU1 B CSWCRQ GO PUT PL ON WAITING QUEUE @13 01600000
CCP UNMASK,PMR UNMASK INTERRUPTS 01610000
B CSNMOR CHECK FOR MORE WORK 01620000
SPACE 2 01630000
CSGMCR EQU * *** 01640000
SBN $FLGC,#PUTTP SET IND 'GM FROM ANYWHERE' 01650000
B CSGMRQ GO DO THE GM 01660000
MVC PLRECA(2,PL),GMADDR(,XR2) PUT OBTAINED AREA IN PL 01670000
ALC PLRECA(2,PL),X$0004 BUMP TO TEXT AREA 01680000
CSGMC1 B CSDFFQ PUT PL ON DFF Q AND POST DFFF@13 01690000
SPACE 2 01700000
B CSNMOR GO CHECK FOR MORE WORK 01710000
.F0100 ANOP * 01720000
EJECT 01730000
* IF LINE IS ACTIVE - SEE IF THIS OP SHOULD BE REJECTED 01740000
SPACE 1 01750000
CSREJC EQU * 01760000
L TUBLCB(,TUB),CLB XR2 --> CLB 01770000
AIF (&CSIO EQ '1').PT040 01770900
AGO .PT050 01771000
.PT040 ANOP 01771100
AIF (&NCPOR).PT060 01771200
.PT050 ANOP 01771300
SPACE 1 01771800
******************************************************************* @14 01772200
******* 01773600
L PLTUBA(,PL),XR1 XR1 --> TUB 01774000
TBN TUBPHY(,XR1),TUBAPT PORTLINE DEVICE ? 01774500
L CSSPL,PL XR1 --> CURRENT PARAMETER LIST 01774900
BT CSQREQ YES,SKIP REJECT TESTS 01775400
******* 01776300
******************************************************************* @14 01776700
SPACE 1 01778100
.PT060 ANOP 01779000
TBN CLBBA2(,CLB),BA2ACT LINE ACTIVE NOW? 01780000
BF CSQREQ NO - PUT PL ON THE QUEUE 01790000
SPACE 1 * 01800000
TBN CLBBA2(,CLB),BA2RCI POLLING 01810000
BT CSQREQ YES - PUT PL ON THE QUEUE 01820000
SPACE 1 01830000
L PLTUBA(,PL),XR1 XR1 --> TUB 01840000
CLC TUBTCB(,XR1),CLBOWN(2,CLB) THIS TASK OWN THE LINE? 01850000
L CSSPL,PL XR1 --> PL 01860000
JNE CSQREQ NO - PUT PL ON THE QUEUE 01870000
SPACE 1 01880000
TBN PL$OPM(,PL),OPPNW PUT-NO-WAIT? (NOTE THAT RECORD 01890000
* OR BLOCK PUTS ARE ALWAYS PUT- 01900000
* WAIT TYPE OPS) 01910000
JT CSQREQ YES - PUT PL ON THE QUEUE 01920000
SPACE 1 01930000
L CLBPL@(,CLB),PL XR1 --> CURRENT PL ON THE LINE 01940000
TBN PLOPC(,PL),OPPNW+OPMSG PUT-NO-WAIT AND 01950000
TBN PL$OPC(,PL),OPNOW STILL A NO-WAIT? 01960000
TBF CLBBA1(,CLB),BA1NTQ AND PL STILL IN THE QUEUE? 01970000
JT CSQREQ YES - PUT PL ON THE QUEUE 01980000
SPACE 1 01990000
TBF PL$OPC(,PL),OPRFSH CURRENT OP A CLEAR MSG OR 02000000
TBF PLOPM(,PL),OP$SYS A SYSTEM OP? 02010000
JF CSQREQ YES - PUT PL ON THE QUEUE 02020000
SPACE 1 02030000
TBN PL$OPC(,PL),OPINV INVITE AND 02040000
TBN CLBTBS-4(,CLB),TASMSG MSG MODE? 02050000
JT CSQREQ YES - PUT PL ON THE QUEUE 02060000
SPACE 1 02070000
MNN CSTOPT+1,CLBOPL(,CLB) PUT CURRENT OP IN TBN INST 02080000
SBF CSTOPT+1,OPNOW SET OFF NO-WAIT BIT 02090000
L CSSPL,PL XR1 --> PL 02100000
L PLTUBA(,PL),TUB XR2 --> TUB 02110000
SPACE 1 02120000
TBN TUBAT2(,TUB),TUBOWN THIS TUB OWN THE LINE? 02130000
L TUBLCB(,TUB),CLB XR2 --> CLB 02140000
TBN CLBBA1(,CLB),BA1NTQ PARM LIST NOT QUEUED ? 02150000
CSTOPT TBN PL$OPM(,PL),# SAME TYPE OP AS LAST OP AND 02160000
JF CSREJP NO - REJECT THIS PL 02170000
EJECT 02180000
*---------------------------------------------------------------------* 02190000
* ANOTHER BLOCK OR RECORD OPERATION TO THE OWNED TERMINAL. * 02200000
* --> IF A GET - THEN GETMAIN FOR A DATA AREA FROM TP BUFFER. * 02210000
* --> IF A PUT - THEN IT MUST BE A WAIT TYPE OP ( THIS IS ENSURED 02220000
* BY CS AT LABEL CSNIRP IN THIS MACRO) - A GETMAIN 02230000
* WILL BE DONE AND DATA MOVED TO THE TP BUFFER. 02240000
* --> THE LINE WILL THEN BE STARTED. 02250000
*---------------------------------------------------------------------* 02260000
SPACE 1 02270000
B CSCLBQ GO QUEUE PL ON CLBPLQ 02280000
SBF CLBBA1(,CLB),BA1NTQ+BA1INT SET OFF 'NOT IN QUEUE' AND 02290000
* 'INTERRUPT WITH NO PL' 02300000
ST CLBPL@(,CLB),PL SAVE NEW PL ADDRESS 02310000
ST CSSPL,PL SAVE NEW PL ADDRESS 02320000
SPACE 1 02330000
TBN PL$OPM(,PL),OPGET INPUT OP ? 02340000
JF CSNGET NO - JUMP 02350000
SPACE 1 02360000
* HAVE AN INPUT OP - GETMAIN FOR INPUT TEXT AND GO START THE LINE 02370000
SPACE 1 02380000
MVC GMLIST+GMSIZE,PLINL(2,PL) PUT SIZE TO GETMAIN FOR IN 02390000
ALC GMLIST+GMSIZE,X$0004(2) ADD 4 FOR GM PARM LIST 02400000
B CSGMRQ GO DO THE GETMAIN 02410000
CCP UNMASK,PMR ALLOW INTERRUPTS 02420000
L CSSCLB,CLB XR2--> CLB 02430000
JNOL CSNGMW JUMP IF GETMAIN WORKED 02440000
SPACE 1 02450000
* GETMAIN FAILED - MARK THIS PL AS WAITING FOR TP BUFFER 02460000
* ALSO COME HERE FROM GETMAIN FAIL FOR THE PUT (BELOW) 02470000
SPACE 1 02480000
CSNGM EQU * * 02490000
SBN CLBBA1(,CLB),BA1NTQ SET 'REMOVED FROM THE QUEUE' 02500000
B CSDEQ GO DEQUEUE FROM CLBPLQ 02510000
B CSWCRQ PUT THIS PL ON CLBWCQ 02520000
B CSNMOR GO CHECK FOR MORE WORK 02530000
SPACE 1 02540000
CSNGMW EQU * * 02550000
MVC CLBIBA(2,CLB),GMLIST+GMADDR PUT RETURNED ADDRESS IN CLB 02560000
ALC CLBIBA(2,CLB),X$0004 BUMP TO TEXT AREA 02570000
MVC CLBIBL(2,CLB),PLINL(,PL) PUT LENGTH IN CLB 02580000
B CSCHED GO START THIS LINE 02590000
SPACE 1 02600000
* HAVE A PUT (RECORD OR BLOCK) - GETMAIN FOR TEXT AND MOVE IT TO 02610000
* TP BUFFER 02620000
SPACE 1 02630000
CSNGET EQU * * 02640000
AIF (&NDF).F0200 NO DFF SUPPORT. 02650000
L PLTUBA(,PL),TUB XR2--> TUB 02660000
TBN TUBTA1(,TUB),TASDFF DFF TERMINAL ? 02670000
L TUBLCB(,TUB),CLB XR2--> CLB 02680000
BT CSCHED YES - NO GM REQUIRED GO START 02690000
* THIS LINE 02700000
.F0200 ANOP * 02710000
MVC GMLIST+GMSIZE,PLOUTL(2,PL) PUT REQUESTED LENGTH IN GM PL 02720000
ALC GMLIST+GMSIZE(2),X$0004 ADD 4 FOR GM PARM LIST 02730000
B CSGMRQ GO DO THE GETMAIN 02740000
CCP UNMASK,PMR ALLOW INTERRUPTS 02750000
L CSSCLB,CLB XR2--> CLB 02760000
BOL CSNGM BRANCH IF GETMAIN FAILED 02770000
SPACE 1 02780000
* GETMAIN WORKED - MOVE DATA TO THE TP BUFFER 02790000
SPACE 1 02800000
B CSQMOV GO MOVE DATA TO TP BUFFER 02810000
TBF PLOPC(,PL),OPMSG RECORD MODE OPERATION ? 02820000
JF CSNREC NO - JUMP 02830000
SPACE 1 02840000
* RECORD MODE OPERATION - IF PLOUTL IS GREATER THAN TERMINAL'S 02850000
* RECORD LENGTH THEN TRUNCATE THE DATA 02860000
SPACE 1 02870000
CLC PLOUTL(2,PL),CLBTBS-2(,CLB) PLOUTL GREATER THAN REC LNTH? 02880000
JNH CSNRCH NO - GO SCHEDULE THIS OP 02890000
MVC CLBREL(2,CLB),CLBTBS-2(,CLB) MAKE REC LNTH TUB REC LNTH 02900000
CSNDTR EQU * * 02910000
SBN CLBBA2(,CLB),BA2TRC SET 'DATA TRUNCATED' IND 02920000
MVI PL$RTC(,PL),RCXDTR PUT DATA TRUNCATED R.C. IN PL 02930000
J CSNRCH GO SCHEDULE THIS OP 02940000
SPACE 1 02950000
* MSG OR BLOCK MODE OP - IF PLOUTL IS GREATER THAN LINE BLOCK 02960000
* LENGTH THEN TRUNCATE THE DATA 02970000
SPACE 1 02980000
CSNREC EQU * * 02990000
CLC PLOUTL(2,PL),CLBTBS(,CLB) GREATER THAN BLOCK LENGTH ? 03000000
JNH CSNRCH NO - GO SCHEDULE THIS OP 03010000
MVC CLBREL(2,CLB),CLBTBS(,CLB) MAKE LENGTH THE BLOCK LENGTH 03020000
B CSNDTR GO SET'DATA TRUNCATED' 03030000
CSNRCH EQU * * 03040000
SPACE 1 03050000
B CSCHED GO START THIS LINE 03060000
SPACE 1 03070000
* REJECT THIS OP - IT CONFLICTS 03080000
SPACE 1 03090000
CSREJP EQU * 03100000
B CC4TA CALL TRANSIENT AREA HANDLER 03110000
DC AL1(CC4UR) TRANSIENT ID 03120000
SBF CSSWIT,CSNRIP SET OFF NEW REQ IN PROCESS 03130000
B CSNMOR CHECK FOR MORE WORK 03140000
EJECT 03150000
CSQREQ EQU * * 03160000
L CSSPL,PL XR1 --> PL 03170000
L CSSCLB,CLB XR2--> CLB 03180000
B CSCLBQ Q IT, GM, MOVE DATA 03190000
AIF (&CSIO EQ '1').PT070 03190300
AGO .PT080 03190340
.PT070 ANOP 03190380
AIF (&NCPOR).PT090 03190420
.PT080 ANOP 03190460
SPACE 1 03190500
******************************************************************* @14 03190540
******* 03190600
L PLTUBA(,PL),XR1 XR1 --> TUB 03191300
TBN TUBPHY(,XR1),TUBAPT PORTLINE DEVICE ? 03191500
JF CSQNPT NO - CONTINUE 03191800
SBN CLBBA3(,CLB),BA3POR SET ON THE PORTLINE BIT 03191850
CLI CLBDEV(,CLB),DEVSIO IS THIS SIOC ? 03191900
JE CSQPON YES - DON'T SET ON BA3PON 03191950
SBN CLBBA3(,CLB),BA3PON NO - MUST BE PORTLINE 03192000
CSQPON EQU * 03192050
CLI TUBDCH-1(,XR1),NOBIT DATA ALREADY IN TPBUFF 03192400
L CSSPL,PL XR1--> PL 03192700
JE CSQNPT NO 03193000
TBN PL$OPM(,PL),OPPUT NEW REQUEST A PUT? 03193300
JF CSQDAT NO, GET DATA FROM TPBUFF CHAIN 03193600
MVI PLRTC(,PL),RCXDPD DATA PENDING RETURN CODE 03193900
MVI PL$RTC(,PL),RCXDPD DATA PENDING RETURN CODE 03194200
J CSQPFR POST PARM LIST OWNER 03194500
* IF PORT DEVICE AND DATA ALREADY IN TPBUFF, 03194800
* GIVE DATA TO USER AND POST HIM 03195100
* IF A USER OPERATION AND THERE IS COMMAND DATA, 03195400
* THE COMMAND DATA WILL GO TO THE COMMAND PROCESSOR, THE USER WILL 03195700
* GET AN 08 RETURN CODE, AND THE PORT WILL BE RELEASED FROM THE USER 03196000
* ROUTINE CSZUDT WILL DO THESE TESTS 03196300
CSQDAT EQU * * 03196600
B CSZUDT GO TAKE DATA OFF TPBUFF Q 03196900
CSQPFR EQU * * 03197200
B CSPSTE GO POST AND FREE FOR DATA 03197500
B CSPSTN GO POST PARM LIST OWNER 03197800
CSQNPT EQU * * 03198100
******* 03198400
******************************************************************* @14 03198500
SPACE 1 03198700
.PT090 ANOP 03199300
* CSCLBQ RETURNS WITH XR1--> PL, XR2--> CLB 03200000
SPACE 1 03210000
TBN CLBBA2(,CLB),BA2ACT LINE ACTIVE NOW? 03220000
BF CSCHED NO - GO SCHEDULE THIS OP 03230000
TBN CLBBA2(,CLB),BA2RCI POLLING? 03240000
BF CSPSTN NO - GO POST THIS OP (NO RETURN) 03250000
AIF (&CSIO EQ '1').PT100 03250500
AGO .PT110 03250570
.PT100 ANOP 03250640
AIF (&NCPOR).PT120 03250710
.PT110 ANOP 03250780
SPACE 1 03250850
******************************************************************* @14 03250920
******* 03251000
* IF PORT DEVICE AND A GET, NO NEED TO STOP POLLING 03252500
* IF PORT SYSTEM GET, NEED TO PUT LENGTH IN PARM LIST 03253000
TBN CLBBA3(,CLB),BA3POR PORTLINE DEVICE ? 03253500
TBN PL$OPM(,PL),OPGET GET OP CODE 03254000
JF CSNNGT IF NOT PORT GET, JUMP 03254500
TBF PLOPM(,PL),OP$SYS SYSTEM OP 03255000
BF CSHPSI YES,GO FILL IN PARM LIST 03255500
B CSPSTN GO POST 03256000
CSNNGT EQU * * 03256500
******* 03257000
******************************************************************* @14 03257200
.PT120 ANOP 03258500
SPACE 2 03260000
* LINE IS ACTIVE WITH A POLL REQUEST - ATTEMPT TO STOP POLL TO PUT 03270000
* THIS NEW REQUEST ON THE LIST (IF A GET) OR TO DO IT (IF A PUT) 03280000
SPACE 2 03290000
TBN PL$OPM(,PL),OPPUT NEW REQUEST A PUT? 03300000
JF CSNNPT NO - JUMP 03310000
SBN CLBBA2(,CLB),BA2PUT SET IND 'PUT PENDING' 03320000
CSNNPT EQU * 03330000
TBF CLBBA1(,CLB),BA1CRI+BA1PRI ALREADY REQUESTED A STOP ? --| 03340000
SBN CLBBA1(,CLB),BA1PRI SET 'PRIORITY CANCEL' IND | 03350000
BT CSCHED NO - GO SCHEDULE THE STOP <---| 03360000
B CSPSTN GO POST (WAIT FOR THE OP END) 03370000
MEND 03380000