mirror of
https://github.com/moshix/mvs.git
synced 2026-01-30 13:06:39 +00:00
446 lines
15 KiB
Plaintext
446 lines
15 KiB
Plaintext
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
|
||
|