TITLE 'PC/370 APPLICATION PROGRAM INTERFACE SURBOUTINES' * PGMID. API.MLC * AUTHOR. DON HIGGINS. * DATE. 11/03/87 * REMARKS. THIS SET OF CALLABLE SUBROUTINES SUPPORTS THE * IBM PC 3270 APPLICATION PROGRAM INTERFACE (API) TO * ALLOW PROGRAM SIMULATION OF 3270 TRANSACTIONS. * * THE CURRENT ENTRY POINTS AND ARGUMENTS ARE AS FOLLOWS: * * ENTRY FUNCTION ARGUMENTS * * APISTART START SESSION NONE * APIAID WRITE AID KEY R1 = AID SCAN CODE * APIWRITE WRITE KEYBOARD R1 = KEYBOARD PARM LIST WITH LENGTH * FOLLOWED BY ASCII+SHIFT HWORDS * APIREAD READ SCREEN R1 = ADDRESS OF 24 X 80 SCREEN AREA * APIWAIT WAIT A WHILE R1 = SECONDS TO WAIT * * MAINTENANCE. * * 11/04/87 DSH 1. DEBUG ON LIVE SYSTEM TO FIX REVERSED LIST SEG:OFF, * MVC'S WITHOUT EXPLICIT LENGTH TO ARG. LISTS, ETC. * 11/05/87 DSH 1. ADD ARG. LIST RETURN CODE CHECKS TO QID, AID, AND * COPY FUNCTIONS; FIX CKD ARG MVC, FIX WAIT TIME LOGIC. * REMOVE TEST HOOKS TO SKIP INT 7A TEST AND SVC NOP * 2. CHECK IF KEYBOARD ALREADY CONNECTED. * 3. ADD READ OPERATOR INFORMATION TO DETECT INHIBIT AND * WAIT FOR AID FUNCTION TO COMPLETE * 11/09/87 DSH 1. ADD MIDNIGHT CHECK TO ELIMINATE ENDLESS LOOP * 12/29/87 DSH 1. ADD APITRAN TO ISSUE ASCII CICS TRANSACTION ID * PASSED IN R1 WITH LENGTH IN R2. * API CSECT * * START API INTERFACE TO ALLOW FOLLOWING READ/WRITE CALLS * ENTRY APISTART APISTART EQU * STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R11,PCB USING IHAPCB,R11 * * VERIFY API INTERRUPT INSTALLED * LA R1,4*X'7A' ABSOLUTE ADDRESS OF PC INTERRUPT 7A LA R2,4 LENGTH MVCP ADDRAPI(R2),0,R1 COPY ADDRESS TO PC/370 ADDR SPACE L R0,ADDRAPI LTR R0,R0 *** * B APIOK ******* FORCE OK FOR TEST WITH SVC NOP'D *** BNZ APIOK WTO 'API INTERRUPT 7A NOT INSTALLED' SVC EXIT APIOK EQU * LM R0,R3,=A(BUFFER,2*1920,0,X'20000000') MVCL R0,R2 * * GET GATE ID'S * LA R1,=C"SESSMGR " BAL R14,GETID MVC SESGID,PCDX SAVE SESSMGR GATE ID LA R1,=C"KEYBOARD" BAL R14,GETID MVC KEYGID,PCDX SAVE KEYBOARD GATE ID LA R1,=C"COPY " BAL R14,GETID MVC CPYGID,PCDX SAVE COPY GATE ID LA R1,=C"OIAM " BAL R14,GETID MVC OIAGID,PCDX SAVE OIAM GATE ID * * GET SESSION ID * MVC PCAX,=X'0901' SET PARMS TO OBTAIN SESSION ID MVC PCBX,=X'8020' MVC PCCX,=X'0000' MVC PCDX,SESGID LA R1,QSIDPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO QUERY SESSION ID PARM LA R1,QSNARRAY SVC CVVASG STCM 0,X'8',QSIDNASG+1 STCM 0,X'4',QSIDNASG STCM 0,X'2',QSIDNAOF+1 SET SEG:OFFSET TO NAME ARRAY IN PARM STCM 0,X'1',QSIDNAOF SET SEG:OFFSET TO NAME ARRAY IN PARM SVC TRACE DC C'QID' BAL R10,APISVC GET SESSION ID CLI QSIDPARM,0 CHECK API QID RETURN CODE (SEE 2-18) BNE APIERR * * CONNECT TO KEYBOARD * MVC PCAX,=X'0901' SET PARMS TO CONNECT KEYBOARD MVC PCBX,=X'8020' MVC PCCX,=X'0000' MVC PCDX,KEYGID MVC KEYPARM(10),=XL10'00' CLEAR KEYPARM 2-28 MVC KEYPARM+2(1),SESSID LA R1,KEYPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM SVC TRACE DC C'CKD' BAL R10,APISVC CONNECT KEYBOARD CLI KEYPARM,4 IS KEYBOARD ALREADY CONNECTED BE CKDOK CLI KEYPARM,0 CHECK CKD RETURN CODE (SEE 2-28) BNE APIERR CKDOK EQU * LM R14,R12,12(R13) SR R15,R15 BR R14 * * WRITE AID CODE IN R1 * ENTRY APIAID APIAID EQU * STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R11,PCB BAL R14,UNLOCK UNLOCK KEYBOARD MVC PCAX,=X'0904' SET PARMS TO WRITE TO KEYBOARD MVC PCBX,=X'8020' MVC PCCX,=X'0000' MVC PCDX,KEYGID MVC KEYPARM(12),=XL12'00' CLEAR KEYPARM 2-37 MVC KEYPARM+2(1),SESSID MVI KEYPARM+6,X'20' SINGLE KEY OPTION STC R1,KEYPARM+8 STORE AID CHARACTER MVI KEYPARM+9,X'00' SET AID SHIFT CODE TO ZERO (A-2) LA R1,KEYPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM SVC TRACE DC C'AID' BAL R10,APISVC WRITE KEYBOARD CLI KEYPARM,X'12' CHECK API AID RC FOR AID GENERATED (2-39) BNE APIERR LM R14,R12,12(R13) SR R15,R15 BR R14 * * WRITE ASCII TRANSACTION (R1=ADDRESS AND R2=LENGTH) * ENTRY APITRAN APITRAN EQU * STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R0,1(R2) R0 = NUMBER OF CHAR +1 (FOR ENTER KEY) MH R0,=H'2' STCM R0,X'2',WTRAN+1 STCM R0,X'1',WTRAN+0 LA R3,WTRAN+2 WMOVE EQU * MVC 0(1,R3),0(R1) MOVE ASCII TRANACTION BYTE MVI 1(R3),ASCICODE MOVE ASCII SHIFT BYTE LA R1,1(R1) LA R3,2(R3) BCT R2,WMOVE MVC 0(2,R3),=AL1(ENTERKEY,SCANCODE) LA R1,WTRAN B APIWRBE * * WRITE THE KEYBOARD STRING POINTED TO BY R1 (SEE 2-37) * * R1 MUST POINT TO 2 BYTE LENGTH CONTAINING 2*(NUMBER OF KEYS) FOLLOWED * BY PAIRS OF ASCII CHARACTERS PLUS SHIFT CODES. * ENTRY APIWRITE APIWRITE EQU * STM R14,R12,12(R13) APIWRBE EQU * BRANCH ENTRY FROM APITRAN BALR R12,0 USING *,R12 LA R11,PCB BAL R14,UNLOCK UNLOCK KEYBOARD MVC PCAX,=X'0904' SET PARMS TO WRITE TO KEYBOARD MVC PCBX,=X'8020' MVC PCCX,=X'0000' MVC PCDX,KEYGID MVC KEYPARM(12),=XL12'00' CLEAR KEYPARM 2-37 MVC KEYPARM+2(1),SESSID MVI KEYPARM+6,X'30' MULTIPLE KEY OPTION SVC CVVASG CONVERT R1 KEY LIST ADDR TO SEG:OFFSET STCM 0,X'8',KEYPARM+10+1 STCM 0,X'4',KEYPARM+10 STCM 0,X'2',KEYPARM+8+1 STORE SEGlOFF TO KEY LIST PARM STCM 0,X'1',KEYPARM+8 STORE SEGlOFF TO KEY LIST PARM LA R1,KEYPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM SVC TRACE DC C'WKL' BAL R10,APISVC WRITE KEYBOARD CLI KEYPARM,X'12' AID KEY GENERATED BE APIWROK CLI KEYPARM,0 CHECK API WKL WRITE RETURN CODE BNE APIERR APIWROK EQU * LM R14,R12,12(R13) SR R15,R15 BR R14 * * READ CURRENT 24 X 80 3270 SCREEN INTO AREA AT R1 * ENTRY APIREAD APIREAD EQU * STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R11,PCB BAL R14,UNLOCK LR R9,R1 SAVE SCREEN ADDRESS MVC PCAX,=X'0901' SET PARMS TO READ SCREEN MVC PCBX,=X'8020' MVC PCCX,=X'00FF' MVC PCDX,CPYGID MVC CPYPARM(26),=XL26'00' CLEAR COPY PARM 2-60 MVC CPYPARM+2(1),SESSID L R1,=A(BUFFER) SVC CVVASG CONVERT BUFFER TO SEG:OFFSET STCM 0,X'8',CPYPARM+18+1 STCM 0,X'4',CPYPARM+18 STCM 0,X'2',CPYPARM+16+1 STORE SEG:OFF TO BUFFER STCM 0,X'1',CPYPARM+16 STORE SEG:OFF TO BUFFER MVI CPYPARM+9,X'02' SET SOURCE TYPE LA R0,1919 STCM R0,2,CPYPARM+13 STC R0,CPYPARM+12 SET SOURCE ENDING CHARACTER OFFSET MVI CPYPARM+21,X'05' SET TARGET TYPE TO PC ASCII BUFFER MVI CPYPARM+24,X'00' SET NO 3270 ATTRIBUTES (SEE 2-62) LA R1,CPYPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM SVC TRACE DC C'CPY' BAL R10,APISVC READ SCREEN CLI CPYPARM,0 CHECK READ OK BNE APIERR L R2,=A(BUFFER) LA R3,24 ROWLOOP EQU * LA R1,80 LR R4,R9 SAVE STARTING ROW ADDRESS OF SCREEN COLLOOP EQU * COPY ASCII TO SCREEN AREA FROM BUFFER MVC 0(1,R9),0(R2) LA R9,1(R9) LA R2,2(R2) SKIP ATTIRBUTES BCT R1,COLLOOP TR 0(80,R4),TRTTAB CONVERT X'00' TO ASCII BLANKS MVC 78(2,R4),=X'0D0A' FORCE CR AND LINE FEED ON EACH LINE BCT R3,ROWLOOP LM R14,R12,12(R13) SR R15,R15 BR R14 * * WAIT FOR (R1) SECONDS * ENTRY APIWAIT APIWAIT EQU * STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R11,PCB MH R1,=H'100' CONVERT TO 100TH SEC ST R1,TARGET LA R15,APISAVE CONNECT STD. SAVE AREA FOR CALL TO TIMER ST R13,APISAVE+4 ST R15,8(R13) LR R13,R15 CALL TIMER ST R0,NOW TIME NOW A R0,TARGET ST R0,TARGET TIME AT END OF WAIT IN 100TH SEC. WAITLOOP EQU * CALL TIMER CL R0,NOW CHECK IF TIME LESS DUE TO MIDNIGHT RESET BL WAITEXIT YES, EXIT WAIT NOW CL R0,TARGET BL WAITLOOP WAITEXIT EQU * L R13,4(R13) LM R14,R12,12(R13) SR R15,R15 BR R14 * * COMMON SUPPORT ROUTINES * * GETID - R1 = GATE NAME IN ASCII PADDED TO 8 CHARACTERS/ DX SET TO GATE ID * GETID EQU * BALR R8,0 USING *,R8 ST R14,RTNSAV14 SVC CVVASG CONVERT R1=VA TO R0=SEG:OFF STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO NAME ID REQUEST PARM MVC PCAX,=X'8100' LA 1,PCB SVC TRACE DC C'GID' BAL R10,APISVC ISSUE 7AH API INTERRUPT WITH PCB REGS VIA SVC L R14,RTNSAV14 BR R14 * * UNLOCK KEYBOARD WAIT LOOP * UNLOCK EQU * RETRY READ ON KEYBAORD INHIBIT * * CHECK IF INPUT INHIBITED AND REPEAT UNTIL CLEAR * BALR R8,0 USING *,R8 ST R14,RTNSAV14 STM R1,R2,UNLKSAVE UNLKLOOP EQU * SVC TRACE DC C'ULK' MVC PCAX,=X'0902' SET PARMS TO OBTAIN OIAM INHIBIT STATUS MVC PCBX,=X'8020' MVC PCCX,=X'00FF' MVC PCDX,OIAGID LA R1,OIAMPARM SVC CVVASG STCM 0,X'C',PCES STCM 0,X'3',PCDI SET ES:DI TO OIAM PARM MVC OIAMPARM(9),=XL9'00' CLEAR PARM MVC OIAMPARM+2(1),SESSID LA R1,OIABUF SVC CVVASG CONVERT BUFFER TO SEG:OFFSET STCM 0,X'8',OIAMPARM+6+1 STCM 0,X'4',OIAMPARM+6 STCM 0,X'2',OIAMPARM+4+1 STORE SEG:OFF TO BUFFER STCM 0,X'1',OIAMPARM+4 STORE SEG:OFF TO BUFFER MVI OIAMPARM+8,X'08' SET REQUIRED PARM SVC TRACE DC C'OIA' BAL R10,APISVC GET OIA INHIBIT STATUS CLI OIAMPARM,0 CHECK API OIA RETURN CODE (SEE 2-74) BNE APIERR TM OIABUF,X'38' TEST FOR ANY CHECK BNZ APIERR TM OIABUF,X'07' TEST FOR INHIBIT BNZ UNLKLOOP YES, RETRY LM R1,R2,UNLKSAVE L R14,RTNSAV14 EXIT WHEN KEYBOARD UNLOCKED BR R14 * * API SVC * APISVC EQU * BALR R7,0 USING *,R7 LR R1,R11 SVC TRACE DC C'API ' *** SVC INT86 *** ******* NOP SVC FOR TEST ********** * MVC PCCX,=X'1200' ******* FORCE RC FOR TEST ********** *** SR R15,R15 IC R15,PCCX+1 SET R15 = RC CLC PCCX,=X'1200' CHECK API ID AND SYSTEM RETURN CODE BNE APIERR BR R10 * * FORCE INTERACTIVE DEBUG ON API ERROR FOR NOW * APIERR EQU * SVC TRACE DC C'BUG ' SVC EXIT * * COMMON DATA * LTORG SESGID DC H'0' SESSMGR GATE ID KEYGID DC H'0' KEYBOARD GATE ID CPYGID DC H'0' COPY GATE ID OIAGID DC H'0' OIAM GATE ID DC C'*** OIAMPARM ***' OIAMPARM DC XL9'00' DC C'*** OIABUF ***' OIABUF DC XL5'00' DC C'*** QSIDPARM ***' QSIDPARM DS 0X QUERY SESSION ID PARMLIST 2-12 DC X'00' RETURN CODE DC X'00' FUNCTION CODE DC X'01' OPTION CODE DC X'45' DATA CODE QSIDNAOF DC AL2(0) OFFSET TO NAME ARRAY QSIDNASG DC AL2(0) SEGMENT FOR NAME ARRAY DC CL8"SESSION" SESSION LONG NAME DC C'*** QSNARRAY ***' QSNARRAY DS 0X QUERY SESSION ID NAME ARRAY 2-13 DC X'0E' NAME ARRAY LENGTH (MANUAL SHOWS X'14' ?) DC X'00' NUMBER OF MATCHING SESSIONS DC X'00' SHORT NAME OF SESSION DC X'00' TYPE OF SESSION SESSID DC X'00' SESSION ID DC X'00' RESERVED DC CL8"SESSION" LONG NAME OF SESSION DC C'*** KEYPARM ***' KEYPARM DC XL12'00' KEYBOARD AID AND WRITE LIST PARM DC C'*** CPYPARM ***' CPYPARM DC XL26'00' SCREEN COPY PARM ADDRAPI DC A(0) API INTERRUPT ADDRESS TESTED FOR NOT ZERO TARGET DC F'0' TIME IN 100TH SECONDS AT END OF WAIT INTERVAL NOW DC F'0' CURRENT TIME FOR MIDNIGHT CHECK APISAVE DC 18F'0' RTNSAV14 DC A(0) UNLKSAVE DC 2F'0' PCB DS 0F PC REGISTER AREA FOR MS-DOS INTERRUPTS VIA SVC 34 DC C'PCVT' IDENTIFIER REQUIRED BY SVC 34 DC X'007A' INTERRUPT FOR API COMMUNICATION WITH PC 3270 EMULATION DC H'0' FLAG STATUS AFTER INTERRUPT DC 4H'0' AX-DX DC 4H'0' DS,SI,ES,DI DC C'*** BUFFER ***' TRTTAB DC X'20',255AL1(*-TRTTAB) CVT X'00' TO ASCII BLANK ASCICODE EQU X'40' ASCII SHIFT CODE (SEE A-2) SCANCODE EQU X'00' SCAN SHIFT CODE ENTERKEY EQU X'58' SCANCODE ENTER KEY WTRAN DS XL(2*1920+2+2) WORK AREA FOR ASCII TRANSACTION WITH SCANCODES BUFFER DS XL(2*1920) WORK AREA FOR PC ASCII AND ATTRIBUTES COPY OF SCREEN COPY CPY\EQUREGS COPY CPY\EQUSVCS COPY CPY\IHAPCB END