IUSER V01L02 1130 PLAN (1130-CX-25X) 08/30/71 * // ASM IUS00020 *XREF IUS00040 *LIST IUS00060 *MACLIB PMAC1 IUS00080 ENT IUSER IUS00100 ENT GUSER IUS00120 ENT NUSER IUS00140 ENT EUSER IUS00160 DATE IUSER IUS00180 PSCLB OFF IUS00200 HDNG IUSER - USER EXIT SUBROUTINE PACKAGE IUS00220 *************************************************** IUS00240 * USER EXIT-PSCAN COMMUNICATION SUBROUTINE * IUS00260 * IUSER-ROUTINE TO SET UP THE INITIAL LINKAGE * IUS00280 * BETWEEN EXIT MODULE AND PSCAN. * IUS00300 * GUSER-ROUTINE TO LINK INTO PSCAN AND FETCH THE * IUS00320 * NEXT CHARACTER FROM THE INPUT STREAM * IUS00340 * NUSER-ROUTINE TO INCREMENT THE SUBSCRIPT POINTER* IUS00360 * AND SET ISW ON IF STORING IS PROHIBITED * IUS00380 * BY THE EXIT ROUTINE * IUS00400 * EUSER-RETURN.ROUTINE TO PASS CONTROL BACK TO * IUS00420 * PSCAN * IUS00440 *************************************************** IUS00460 * IUS00480 * SET UP INITIAL LINKAGE IUS00500 IUSER DC *-* IUS00520 LDX I1 $XSAV SET XR1 TO COMM BLOCK IUS00540 STX 1 EUSR1 SAVE COMM BLOCK POINTER IUS00560 STX L3 $XSAV SET USER XR3 FOR LIBF'S IUS00580 LD 1 ISUB SET IUS00600 S K1 INITIAL IUS00620 STO 1 ISUB SUBSCRIPT IUS00640 LD 1 USGET SET GET IUS00660 STO GTCHR CHARACTER ADDRESS IUS00680 B I IUSER AND RETURN IUS00700 * IUS00720 * FETCH NEXT INPUT STREAM CHARACTER IUS00740 GURET MDM GUSER,+1 INCREMENT RETURN ADDRESS IUS00760 LDX L1 *-* RESTORE XR1 IUS00780 B L *-* AND RETURN IUS00800 GUSER EQU *-1 IUS00820 STX 1 GURET+3 SAVE XR1 IUS00840 LDX I1 EUSR1 SET XR1 TO COMM BLOCK IUS00860 LD GUSER SET PARAMETER IUS00880 STO CHSTO ADDRESS IUS00900 LD GTCHR HAS BSI ADDRESS IUS00920 BZ GURET BEEN SET AND BR NO IUS00940 LD 1 UN2BK GET CHARACTER IUS00960 EOR XCOMA CHECK FOR COMMA IUS00980 SKP Z AND SKIP YES IUS01000 EOR X35 OR SEMICOLON IUS01020 SKP Z AND SKIP YES IUS01040 EOR X5E RESTORE CHARACTER IUS01060 STO I *-* AND GIVE TO USER IUS01080 CHSTO EQU *-1 AND IUS01100 BZ GURET BR IF COMMA OR SEMIC IUS01120 BSI L *-* GO TO PSCAN IUS01140 GTCHR EQU *-1 TO GET NEXT IUS01160 STO 1 UN2BK AND SAVE IT IUS01180 B GURET BRANCH IUS01200 * IUS01220 * DECLARATIVES * IUS01240 XCOMA DC /6B IUS01260 X35 DC /35 IUS01280 X5E DC /5E IUS01300 K1 DC 1 IUS01320 LIBF DUSER IUS01340 ULIT EQU 0 CHAR AND LIT POINTER BUCKET IUS01360 UN2BK EQU -1 N2 ERROR PARAM BUCKET IUS01380 UN1BK EQU -2 N1 ERROR PARAM BUCKET IUS01400 ISW EQU -3 INHIBIT SWITCH BUCKET IUS01420 ISUB EQU -4 SUBSCRIPT BUCKET IUS01440 MAXIM EQU -5 MAXIMUM SUBSCRIPT IUS01460 USGET EQU -6 GET CHARACTER ROUTINE ADDRESS IUS01480 USRAD EQU -7 PSCAN RETURN ADDRESS BUCKET IUS01500 * IUS01520 * INCREMENT SUBSCRIPT AND SET I-SWITCH IUS01540 NURET MDM NUSER,+2 INCREMENT RETURN ADDRESS IUS01560 B L *-* AND RETURN IUS01580 NUSER EQU *-1 IUS01600 STX 1 LDXL1+1 SAVE XR1 IUS01620 STX 2 LDXL2+1 SAVE XR2 IUS01640 LDX I1 EUSR1 SET XR1 TO COMM BLOCK IUS01660 LDX I2 NUSER GET PARAM LIST IUS01680 LD EUSR1 WAS IUSER EVER CALLED IUS01700 BZ NUSR1 AND BR NO IUS01720 LD 1 ISUB INCREMENT IUS01740 A K1 SUBSCRIPT IUS01760 STO I2 0 AND GIVE TO USER IUS01780 BN NUSR1 BR IF ILLEGAL IUS01800 STO 1 ISUB AND SAVE IUS01820 S 1 MAXIM IS IT TOO BIG IUS01840 BNP *+2 AND BR NO IUS01860 NUSR1 EQU * IUS01880 LD K1 TURN ON IUS01900 B *+1 ISW AND BRANCH IUS01920 LD 1 ISW GIVE ISW IUS01940 STO I2 1 TO USER IUS01960 LDXL1 LDX L1 *-* RESTORE XR1 IUS01980 LDXL2 LDX L2 *-* RESTORE XR2 IUS02000 B NURET AND BRANCH IUS02020 * IUS02040 * RETURN TO PSCAN WITH ERRAT PARAMETERS IUS02060 EUSER DC *-* IUS02080 LDX I2 EUSER ACCESS PARAMETER LIST IUS02100 LDX L1 *-* SET XR1 TO COMM BLOCK IUS02120 EUSR1 EQU *-1 IUS02140 LD I2 0 MOVE IUS02160 STO 1 UN1BK N1, IUS02180 LD I2 1 N2 IUS02200 STO 1 UN2BK AND IUS02220 LD 2 2 N3 TO IUS02240 STO 1 ULIT PSCAN IUS02260 B I1 USRAD RETURN TO PSCAN IUS02280 END IUS02300 // DUP IUS02320 *DUMP WS CD IUSER IUS02340 *DELETE IUSER IUS02360 *STORE WS UA IUSER IUS02380