Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / cmsqueens / cm2full.asm next >

Wrap

Assembly Source File | 2020-01-01 | 18KB | 220 lines

FULL TITLE 'FULL SCREEN I/O SERVICE FOR CMS' FUL00010 SPACE FUL00020 * FUL00030 * THIS SUBROUTINE PROVIDES A REASONABLY SYSTEM INDEPENDENT FUL00040 * INTERFACE TO PROBLEM PROGRAMS FOR 3270-STYLE I/O. FUL00050 * FUL00060 * ATTRIBUTES: NOT REENTRANT. SERIALLY REUSABLE IF INITIALIZE FUL00070 * AND TERMINATE CALLS ARE PAIRED. FUL00080 * FUL00090 * ENTRY CONDITIONS: FUL00100 * R15 --> ENTRY POINT FUL00110 * R14 = RETURN ADDRESS FUL00120 * R13 --> OS/STYLE SAVE AREA FUL00130 * R1 --> OS/STYLE PARAMETER LIST. FUL00140 * PARAMETERS: FUL00150 * 0(R1) --> H'FUNCTION CODE' FUL00160 * 4(R1) --> BUFFER FUL00170 * 8(R1) --> H'LENGTH' OF BUFFER. FUL00180 * 12(R1) --> HALFWORD RETURNED LENGTH FOR READ OPERATIONS. FUL00190 * FUNCTION CODES: FUL00200 * 0 -- GET CONTROL OF SCREEN FUL00210 * 1 -- PERFORM ERASE WRITE OF BUFFER DATA FUL00220 * 2 -- PERFORM NORMAL WRITE OF BUFFER DATA FUL00230 * 3 -- PERFORM READ MODIFIED INTO BUFFER AFTER WAITING FUL00240 * FOR ATTENTION FUL00250 * 4 -- PERFORM READ BUFFER INTO BUFFER FUL00260 * 5 -- RELINQUISH CONTROL FUL00270 * FUL00280 * OPERATING NOTES: FUL00290 * FUL00300 * FUNCTION 0 MUST BE ISSUED FIRST. FUNCTION 5 SHOULD BE ISSUED FUL00310 * BEFORE THE FULL SCREEN APPLICATION TERMINATES. FUL00320 * AFTER WRITING A WCC TO UNLOCK THE KEYBOARD, FUNCTION 3 SHOULD FUL00330 * BE ISSUED TO WAIT FOR ATTENTION. AN I/O ERROR MIGHT OCCUR FUL00340 * IF AN ATTENTION IS PENDING AND THE NEXT I/O IS A FUL00350 * WRITE. FUL00360 * THIS ROUTINE USES A STAX EXIT. THE APPLICATION SHOULD NOT FUL00370 * ISSUE THE STAX MACRO BETWEEN INITIALIZING AND TERMINATING THIS FUL00380 * INTERFACE. FUL00390 * RETURN CODE 4 CAN INDICATE: FUL00400 * 1. NOT PROPERLY INITIALIZED. FUL00410 * 2. SCREEN STOLEN BY THE OPERATING SYSTEM (ISSUE ERASE WRITE FUL00420 * GET IT BACK: THIS IS A CMS-DEPENDENT CONVENTION). FUL00430 * 3. NON FULL-SCREEN INPUT PENDING. USE STANDARD INPUT FUL00440 * ROUTINES TO ACQUIRE IT. FUL00450 * FUL00460 * RETURN CODES: FUL00470 * 0 -- SUCCESSFUL COMPLETION FUL00480 * 4 -- SCREEN NOT FORMATTED FUL00490 * 8 -- I/O ERROR ON DEVICE. FUL00500 * 12 -- ILLEGAL FUNCTION FUL00510 * 16 -- DEVICE NOT OPERATIONAL OR OF INCORRECT TYPE FUL00520 * FUL00530 FULLSERV CSECT FUL00540 SAVE (14,12),,* FUL00550 LR R12,R15 FUL00560 USING FULLSERV,R12 FUL00570 LM R8,R11,0(R1) R8 --> FUNCTION CODE FUL00580 * R9 --> BUFFER FUL00590 * R10 --> BUFFER LENGTH FUL00600 * R11 --> RETURNED LENGTH FOR READ FUL00610 LA R7,12 SET ILLEGAL FUNCTION FUL00620 ST R8,FUNCRET QK FUL00630 LH R8,0(,R8) GET FUNCTION CODE FUL00640 CL R8,=A(FUNCMAX) TEST FOR LEGAL FUNCTION FUL00650 BH RETURN WORST FEARS REALIZED FUL00660 SLL R8,2 MAKE BRANCHABLE FUL00670 B *+4(R8) AND BRANCH FUL00680 FUNC0 B INIT 0 -- INITIALIZE FUL00690 B EWRITE 1 -- ERASE WRITE FUL00700 B WRITE 2 -- NORMAL WRITE FUL00710 B READM 3 -- READ MODIFIED FUL00720 B READB 4 -- READ BUFFER FUL00730 B TERMIN 5 -- TERMINATE FUL00740 FUNCMAX EQU (*-FUNC0)/4-1 FUL00750 SPACE FUL00760 * RETURN TO CALLER. RC IN R7 FUL00770 SPACE FUL00780 RETURN ST R7,16(,R13) SET RETURN CODE IN R15 POSITION FUL00790 L R8,FUNCRET QK FUL00800 ST R7,0(,R8) set FUNCTION CODE to return code FUL00810 RETURN (14,12) RETURN TO CALLER FUL00820 EJECT FUL00830 * FUL00840 * ESTABLISH CONTROL. FUL00850 * 1. CHECK CONSOLE TYPE. FUL00860 * 2. DISABLE FOR ALL INTERRUPTS. FUL00870 * 3. TAKE CONTROL OF ATTENTIONS VIA STAX. FUL00880 * 4. ISSUE ERASE WRITE TO CLEAR SCREEN AND PUT CONSOLE IN FUL00890 * FULL SCREEN MODE. FUL00900 * FUL00910 INIT LA R7,16 GET TENTATIVE RETURN CODE FUL00920 L R1,=F'-1' VIRTUAL CONSOLE DIAGNOSE FUL00930 DIAG R1,R2,X'24' DO IT FUL00940 BNZ RETURN DON'T ALLOW ANYTHING SLEAZY FUL00950 CLM R3,B'0100',=X'04' ACCEPT ONLY 3277 OR 3278 TYPES FUL00960 BE TYPEOK FUL00970 CLM R3,B'0100',=X'01' ACCEPT ONLY 3277 OR 3278 TYPES FUL00980 BNE RETURN FUL00990 TYPEOK STCM R1,B'0011',CONSADDR SAVE CONSOLE ADDRESS FUL01000 SSM *+1 DISABLE FOR INTERRUPTS FUL01010 MVI STAXECB,0 CLEAR ECB FUL01020 STAX CATCHATN PLAN TO CATCH ATTENTIONS FUL01030 LA R1,GETSCRN --> CCWS TO GET SCREEN FUL01040 B DIAG58 DO THE I/O FUL01050 * FUL01060 * RELINQUISH CONTROL. FUL01070 * 1. CLEAR CONSOLE ADDRESS FUL01080 * 2. CANCEL STAX FUL01090 * FUL01100 TERMIN XC CONSADDR,CONSADDR CLEAR CONSOLE ADDRESS FUL01110 STAX , CANCEL STAX FUL01120 SR R7,R7 SET RETURN CODE FUL01130 B RETURN FUL01140 EJECT FUL01150 * FUL01160 * WRITE, READ BUFFER, OR ERASE WRITE. FUL01170 * 1. --> CORRECT CCW. FUL01180 * 2. FILL IN ADDRESSES AND DO I/O FUL01190 * FUL01200 EWRITE LA R1,EWCCW --> ERASE WRITE CCW FUL01210 B FILLIN GO FILL IN THE DATA FUL01220 WRITE LA R1,WCCW --> NORMAL WRITE CCW FUL01230 B FILLIN GO FILL IN THE DATA FUL01240 READB LA R1,RBCCW --> READ BUFFER CCW FUL01250 B FILLIN GO FILL IN THE DATA FUL01260 * FUL01270 * READ MODIFIED FUL01280 * 1. WAIT FOR ATTENTION. FUL01290 * 2. --> CORRECT CCW. FUL01300 * 3. FILL IN ADDRESSES AND DO I/O FUL01310 * FUL01320 READM MVC DEBUG1,STAXECB SAVE ECB STATE FOR DEBUGGING FUL01330 WAIT 1,ECB=STAXECB WAIT FOR ATTN FUL01340 MVC DEBUG2,X'44' SAVE CSW STATUS FOR DEBUGGING FUL01350 LA R1,RMCCW --> READ MODIFIED CCW FUL01360 B FILLIN GO FILL IN THE DATA FUL01370 EJECT FUL01380 * FUL01390 * FILL IN DATA FOR READ OR WRITE OPERATIONS PRIOR TO DIAGNOSE FUL01400 * FUL01410 FILLIN STCM R9,B'0111',1(R1) MOVE 3 BYTE ADDRESS INTO CCW FUL01420 MVC 6(2,R1),0(R10) MOVE 2 BYTE LENGTH INTO CCW FUL01430 * FUL01440 * PERFORM DIAGNOSE X'58' I/O FUL01450 * FUL01460 DIAG58 LR R2,R1 SAVE CCW REGISTER FUL01470 LH R3,CONSADDR PICK UP CONSOLE ADDRESS FUL01480 LA R7,4 ASSUME NOT IN CONTROL FUL01490 LTR R3,R3 ARE WE? FUL01500 BZ RETURN NO. FUL01510 WAITT , YES. LET CONSOLE QUIESCE. FUL01520 LA R4,10 RETRY 10 TIMES (ARBITRARY) IF BUSY FUL01530 LA R7,8 ASSUME ERROR FUL01540 DO58 DIAG R2,R3,X'58' PERFORM THE DIAGNOSE FUL01550 BZ WAITEND OPERATION STARTED FUL01560 BM CHECKEND CCW STORED FUL01570 BO RETURN CC=3: RETURN ERROR. FUL01580 SSM =X'FE' CC=2: RETRY UP TO 10 TIMES FUL01590 SSM *+1 (OPEN INTERRUPT WINDOW: IT MIGHT BE FUL01600 BCT R4,DO58 INTERRUPT PENDING ON ANOTHER CUU) FUL01610 B RETURN RETURN ERROR IF RETRY EXHAUSTED FUL01620 WAITEND TIO 0(R3) WAIT FOR OPERATION TO END FUL01630 BO RETURN CC=3: RETURN ERROR FUL01640 BZ RETURN CC=0 IS IMPOSSIBLE! FUL01650 BP WAITEND LOOP ON BUSY. WILL NOT SPIN. FUL01660 TM X'44',X'04' INCLUDES DEVICE END? FUL01670 BNO WAITEND NO. KEEP WAITING FUL01680 CHECKEND LA R7,4 ASSUME SCREEN STOLEN FUL01690 CLI X'44',X'8E' WAS IT? FUL01700 BE RETURN YES. DONE FUL01710 LA R7,8 ASSUME I/O ERROR FUL01720 MVI STAXECB,X'40' PSEUDO PREPOST THE ECB FUL01730 TM X'44',X'80' ATTENTION STRUCK? FUL01740 BO RETURN YES. RETURN ERROR. FUL01750 MVI STAXECB,0 NO. CLEAR ECB FOR EVENTUAL WAIT FUL01760 TM X'44',X'F3' ANY FUNNY BITS ON? FUL01770 BNZ RETURN YES. ERROR FUL01780 CLI X'45',0 ANY CHANNEL STATUS? FUL01790 BNE RETURN YES. ERROR FUL01800 SR R7,R7 OTHERWISE, CALL IT A SUCCESS FUL01810 CH R8,=Y(4*3) IS IT READ MODIFIED? FUL01820 BL RETURN RETURN IF LESS FUL01830 CH R8,=Y(4*4) HOW ABOUT READ BUFFER? FUL01840 BH RETURN RETURN IF MORE FUL01850 LH R1,X'46' PICK UP CSW RESIDUAL COUNT FUL01860 LNR R1,R1 COMPLEMENT IT FUL01870 AH R1,0(,R10) ADD ORIGINAL COUNT FUL01880 STH R1,0(,R11) AND STORE DIFFERENCE (BYTES MOVED) FUL01890 B RETURN AND GET OUT OF HERE FUL01900 EJECT FUL01910 * FUL01920 * STAX ROUTINE (SIMPLICITY ITSELF FUL01930 * FUL01940 CATCHATN SAVE (14,12) FUL01950 DROP , NO ADDRESSABILITY REALLY FUL01960 LR R12,R15 GET SOME FUL01970 USING CATCHATN,R12 FUL01980 POST STAXECB INDICATE SOMETHING FUL01990 RETURN (14,12) FUL02000 EJECT FUL02010 * STATIC DATA FUL02020 SPACE FUL02030 GETSCRN DS 0D CCWS TO GET CONTROL OF SCREEN FUL02040 DC X'1900000060FF0001' FUL02050 DC X'29',AL3(NULLWCC),X'20800001' FUL02060 EWCCW DC X'2900000020800000' ERASE WRITE CCW FUL02070 WCCW DC X'2900000020000000' WRITE CCW FUL02080 RMCCW DC X'2A00000020800000' READ MODIFIED CCW FUL02090 RBCCW DC X'2A00000020000000' READ BUFFER CCW FUL02100 STAXECB DC F'0' ECB FOR ATTENTION FUL02110 CONSADDR DC H'0' CONSOLE ADDRESS FUL02120 NULLWCC DC X'C0' FUL02130 DEBUG1 DC X'FF' PLACE TO SAVE DEBUGGING INFORMATION FUL02140 DEBUG2 DC X'FFFF' PLACE TO SAVE DEBUGGING INFORMATION FUL02150 FUNCRET DS F FUL02160 LTORG FUL02170 REGEQU FUL02180 END FUL02190