* * $Id: getinh.s,v 1.1.1.1 1996/03/08 15:44:22 mclareni Exp $ * * $Log: getinh.s,v $ * Revision 1.1.1.1 1996/03/08 15:44:22 mclareni * Cspack * * #if defined(CERNLIB_IBMMVS) * $GETINH (PL/I) * GETINH (FORTRAN,PASCAL) * * PROMPT A MESSAGE ON A TSO TERMINAL AND READ TYPED ANSWER * ON THE SAME LINE * * AUTHOR: * G. WEIL CENTRE DE CALCUL DE STRASBOURG (CNRS) * * 17/02/91: /MK/,GSI * MODIFIED TO RUN IN AMODE=31,RMODE=ANY. * 18/02/91: /MK/,GSI * DO NOT ECHO USER RESPONSE (E.G. FOR PASSWORDS) * 19/02/91: /MK/,GSI * SEPARATE ENTRIES FOR FORTRAN/PASCAL AND PL/I * * PL/I USAGE: * ============== * * DCL OUT,IN CHAR(*) VAR; ! PROMPT & READ STRING * OR DCL OUT,IN CHAR(*); ! PROMPT & READ STRING * BIN FIXED(31) IST; ! RETURN CODE * * CALL $GETINH( OUT, IN, IST ); * * FORTRAN USAGE: * ============== * * CHARACTER*(*) OUT, IN ! PROMPT & READ STRING * INTEGER LGOUT, LGIN ! THEIR MAX. LENGTH * INTEGER IST ! RETURN CODE * CALL GETINH ( OUT, LGOUT, IN, LGIN, IST ) * * PASCAL USAGE: * ============== * * program test; * type * stringxx = packed array [1..xx] of char; * Procedure GETINH( var cbufin: stringxx; * var lbufin: integer; * var cbufout: stringxx; * var lbufout: integer; * var irc: integer ); * external; * var * cprompt : packed array [1..80] of char; * cc : packed array [1..80] of char; * lin, lout, nn : integer; * * begin; * cprompt:='enter password 1'; * lin := 16; lout := 80; nn := 0; * GETINH( cprompt, lin, cc, lout, nn ); * end. * * IST STATUS (OUTPUT) * >0 NB OF CHARACTERS READ * -01 BAD LGOUT * -02 BAD LGIN * -08 'ATTN' INTERRUPT RECEIVED * -12 BUFFER TOO SMALL * -20 TERMINAL DISCONNECTED * * * $GETINH AMODE 31 $GETINH RMODE ANY * MACRO REGS PUSH PRINT PRINT ON,NOGEN R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 F0 EQU 0 F2 EQU 2 F4 EQU 4 F6 EQU 6 POP PRINT MEND * $GETINH CSECT PL/I ENTRY ENTRY GETINH REGS USING $GETINH,R15 addressability SAVE (14,12) SAVE REGISTERS LM R2,R4,0(R1) LOAD PL/I PARAMETER ADDRESSES LR R6,R4 SAME REG.S AS FORTRAN LR R4,R3 SR R7,R7 RESET PTR. TO VAR. STRING PREFIX * * PL/I STRING HANDLING, PROMPT * LA R3,4(0,R2) PTR. TO MAX LENGTH L R2,0(0,R2) PTR. TO STRING ITSELF TM 2(R3),X'80' FIXED/VARYING ? BZ OUT_FIXED LA R3,0(0,R2) PTR. TO PREFIX LA R2,2(0,R2) PTR. TO STRING OUT_FIXED EQU * LH R3,0(0,R3) LOAD STRING LENGTH * * PL/I STRING HANDLING, input buffer * LA R5,4(0,R4) PTR. TO MAX LENGTH L R4,0(0,R4) PTR. TO STRING TM 2(R5),X'80' FIXED/VARYING ? BZ IN_FIXED LA R7,0(0,R4) PTR. TO PREFIX SR R0,R0 STH R0,0(0,R7) RETURN NULL STRING (DEFAULT) LA R4,2(0,R4) PTR. TO STRING IN_FIXED EQU * LH R5,0(0,R5) LOAD MAX. STRING LENGTH LA BASE,$GETINH_START ADDRESSABILITY DROP R15 GIVE UP USING $GETINH_START,BASE SAME BASE AS FORTRAN ENTRY B $GETINH_START * * *** * GETINH EQU * FORTRAN & PASCAL ENTRY * DROP BASE USING GETINH,R15 ADDRESSABILITY SAVE (14,12) LM R2,R6,0(R1) PICKUP PARAMETER ADDRESSES L R3,0(0,R3) LENGTH PROMPT STRING L R5,0(0,R5) LENGTH BUFFER STRING SR R7,R7 LA BASE,$GETINH_START DROP R15 USING $GETINH_START,BASE $GETINH_START EQU * COMMON START & BASE REFERENCE * * *** CHECK REASONABLE LENGTH OF GIVEN I/O BUFFERS * SR R15,R15 BCTR R15,0 -1 LTR R3,R3 BNH GO_HOME BCTR R15,0 -2 LTR R5,R5 BNH GO_HOME * * *** DYNAMIC SAVE AREA FOR TPUT/GET * GETMAIN RC,LV=72 ST R13,4(R1) ST R1,8(R13) LR R13,R1 * * *** ALLOCATE LOCAL BUFFER SPACE < 16MB FOR TPUT/GET * LR R11,R5 GETMAIN R,LV=(R11) INPUT BUF LR R10,R1 LA R9,1(0,R3) LENGTH+1 GETMAIN R,LV=(R9) OUTPUT BUF LR R8,R1 ADDRESS OF BUFFER LR R0,R8 ADDRESS OF BUFFER LR R1,R3 LENGTH MVCL R0,R2 COPY OUTPUT BUFFER LR R2,R0 MVI 0(R2),BYP_INP INSERT BYPASS/INHIBIT CHARACTER * * *** TPUT PROMPT STRING AND TGET ANSWER * ICM R8,B'1000',=AL1(PUTFLG) INSERT FLAG TPUT (R8),(R9),ASIS LTR R15,R15 BNZ ERREUR ICM R10,B'1000',=AL1(GETFLG) TGET (R10),(R11),R LTR R15,R15 BNZ ERREUR LNR R15,R1 * * *** COPY BACK THE DATA READ * LR R0,R10 BUFFER ADDRESS ICM R1,B'1000',=CL1' ' PAD WITH BLANKS MVCL R4,R0 COPY BACK RECEIVED DATA * * *** ERROR HANDLING AND CLEANUP * ERREUR LCR R15,R15 ST R15,0(R6) LTR R7,R7 BE SKIP_VAR1 RETURN PL/I CHAR(*) VARYING ?? LTR R15,R15 BNH SKIP_VAR1 STH R15,0(0,R7) SKIP_VAR1 EQU * L R3,4(R13) FREEMAIN RC,LV=72,A=(R13) FREEMAIN R,LV=(R11),A=(R10) FREEMAIN R,LV=(R9),A=(R8) LR R13,R3 RETURN (14,12),T,RC=0 * GO_HOME EQU * ST R15,0(R6) LTR R7,R7 BE SKIP_VAR2 RETURN PL/I CHAR(*) VARYING ?? LTR R15,R15 BNH SKIP_VAR2 STH R15,0(0,R7) SKIP_VAR2 EQU * RETURN (14,12),T,RC=0 * * *** CONSTANT DEFINITIONS * PUTFLG EQU B'00000001' GETFLG EQU B'10000000' BYP_INP EQU X'24' BYPASS/INHIBIT CHARACTER * BASE EQU R12 * END #endif