SPL,L,O,M 
!     NAME:   IN..
!     SOURCE: 92067-18217 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME IN..(8) "92067-16185 REV.2040 800731"
! 
!     MODIFICATION RECORD:
! 
!         DATE     REASON 
!     1) 771229    TO CORRECTLY INITIALIZE LU3 THE FIRST TIME (GLM) 
!     2) 780413    TO CORRECTLY RELEASE LOCK ON ABORT OF INIT. (GLM)
!     3) 780512    TO USE 256-WORD CARTRIDGE DIRECTORY (BL) 
!     4) 780516    TO HANDLE LOCK. ERROR RETURN PARAMETER (BL)
!     5) 780630    TO GET SECTORS/TRACK VALUE FROM DRIVER (BL)
!     6) 790103    TO CORRECTLY HANDLE ?? RESPONSE TO FMGR 060 (BL) 
!     7) 790113    TO MASK OFF LOCK IN LU WORD FROM DS.LU 
!     8) 790122    TO SAVE MASKED MASTER SECURITY CODE IN $CES
!     9) 790403    TO CHECK FOR TYPE 6 FILES REFERENCED BY ID SEGS. 
!    10) 790802    TO SAVE MASKED MASTER SECURITY CODE ON DISC
!    11) 800731    TO TREAT NEW NUMERIC MASTER SECURITY CODES 
!                  AS NUMERIC, NOT ASCII  (SST #4904) 
! 
! 
!     IN.. IS THE RTE FILE MANAGER ACTION ROUTINE 
!     FOR THE IN DIRECTIVE. 
! 
!     THE IN DIRECTIVE HAS THE FORM:
! 
!     IN,MSC,CR,LABEL,ILAB,#FT,#DTR,#SEC/TR,BTL 
!PARAMETER 1  5   9    13   17   21    25    29 
! 
!     OR
! 
!     IN,MSC--NMSC
! 
!     W H E R E:
! 
!     MSC          IS THE TWO CHARACTER MASTER SECURITY CODE
! 
!     CR           IS EITHER THE CARTRIDGE LABEL(+) OR ITS
!                  LOGICAL UNIT(-)   (MUST BE NUMERIC)
! 
!     LABEL        NEW CARTRIDGE LABEL (NUMERIC > 0, OR 2 ASCII CHARS)
! 
!     ILAB         IS THE CARTRIDGE INFORMATION LABEL (MUST BE ASCII).
! 
!     #FT          IS THE FIRST FMP TRACK.
! 
!     #DTR         IS THE NUMBER OF DIRECTORY TRACK 
!                  (NULL (SET TO 1) OR NUMERIC) 
! 
!     #SEC/TR      IS THE NUMBER OF 64 WORD SECTORS 
!                  PER TRACK (NUMERIC (MAY BE NULL )).
! 
!     BTL          IS A BAD TRACK LIST - UP TO 6 BAD TRACK NUMBERS. 
! 
!     NMSC         IS A NEW MASTER SECURITY CODE. 
! 
!     THE MASTER SECURITY CODE IS SET WHEN LU2 IS FIRST 
!     INITIALIZED AND MUST MATCH THEREAFTER.
! 
      LET .PARS,                     \FMGR PARSE ROUTINE
          D.RIO,                     \FM.UT ROUTINE TO READ CL
          DR.RD,                     \FM.UT ROUTINE TO READ DIRECTORY 
          EXEC,                      \RTE EXEC
          FM.ER,                     \FMGR MESSAGE OUTPUT ROUTINE 
          IPUT,                      \ROUTINE TO WRITE WORD IN MEMORY 
          ISMVE,                     \ROUTINE TO MOVE WORDS FROM SCB
          J.PUT,                     \
          LOCK.,                     \ROUTINE TO LOCK DISC CARTRIDGE
          MSS.,                      \FMGR ERROR MESSAGE ROUTINE
          NAM..,                     \ROUTINE TO VALIDATE FILE NAME 
          PARSE,                     \ASCII PARSE SUBROUTINE
          READC,                     \
          READF,                     \FMP FILE READ ROUTINE 
          SESSN,                     \ROUTINE TO DECIDE IF IN SESSION 
          WRITF                      \FMP FILE WRITE ROUTINE
             BE SUBROUTINE,EXTERNAL 
! 
      ASSEMBLE ["EXT $CES";"EXT IXPUT"] 
ADCES:ASSEMBLE ["DEF $CES"] 
      LET PK.DR,D.SDR,IFLG.,D.LT,D.LB,C.BUF, \
      DS.DF,  \ 
      D.,DS.LU,.E.R.,ECH. BE INTEGER,EXTERNAL 
      LET CAM.O,NO.RD         BE INTEGER,EXTERNAL 
      LET PNAM(3),IRBUF(33)   BE INTEGER
      LET PDIRS     BE SUBROUTINE 
      LET TRAK.     BE SUBROUTINE 
      LET PTST,GT BE SUBROUTINE 
      LET BADTR  BE SUBROUTINE
      LET FID.     BE FUNCTION,EXTERNAL 
      LET MSC.     BE FUNCTION,EXTERNAL 
! 
!     CONSTANTS 
! 
      LET YE       BE CONSTANT(54505K)
      LET NO       BE CONSTANT(47117K)
      LET A        BE CONSTANT(0     )
      LET B        BE CONSTANT(1     )
      LET WRIT     BE CONSTANT(2     )
      LET READI    BE CONSTANT(1     )
      LET XEQT     BE CONSTANT(1717K) 
      LET SECT2    BE CONSTANT(1757K )
      LET SECT3    BE CONSTANT(1760K )
      LET TAT      BE CONSTANT(1656K )
      LET KEYWD    BE CONSTANT(1657K )
      LET TATLG    BE CONSTANT(1755K )
      LET TATSD    BE CONSTANT(1756K )
      LET DMSIN    BE CONSTANT(26455K)
IN..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL 
      LET NCAM,PLIST,MSNO BE INTEGER
      ASSEMBLE ["EXT $SMID";"LDA $SMID";"STA SMID"] 
      CLPTR_[DDIR_@D.SDR]+2 
      PDIR2_[PDIR1_[PDIR_@PK.DR]+1]+1 
      PDIR9_[PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR4_[PDIR3_\ 
         PDIR2+1]+1]+1]+1]+1]+1]+1
      LIS29_[LIS21_[LIS17_[LIS13_[LIST9_[LIST5_@PLIST+5]+4]+4]+4]+4]+8
      MSNO_0                       !INITIALIZE FOR NO ERRORS
! 
!     FIX FOR OLD NUMERIC MASTER SECURITY CODE  
! 
      T_@PLIST+1
      CALL PARSE($T,2,IRBUF)
      $T_$(@IRBUF+1)
! 
!     TEST FOR LEGAL PARAMETERS 
! 
      IF NCAM#1 THEN GOTO IN2      !IF ONE PARAMETER, THEN
      IF IFLG. THEN GOTO NOPRM     !IF EXPECTING REPLY TO 002 OR 003
!                                   THEN ERROR 50 
! 
!     MSC CHANGE? 
! 
      IFNOT MSC.(PLIST) THEN GOTO SCER !INCORRECT SECURITY CODE?
!                                       NOTE: MSC. DOES THE D.RIO READ
! 
      IF $(@PLIST+2)#DMSIN THEN GOTO NOPRM  !IF NOT "--", ERROR 50
! 
!     FIX FOR NEW NUMERIC MASTER SECURITY CODE
! 
      T_@PLIST+3                           !ADDR OF NEW MSC 
      CALL PARSE($T,2,IRBUF)               !PARSE NEW MSC 
      $T_$(@IRBUF+1)                       !PROPERLY PARSED MSC 
      MSCD_[IF $T = 0 THEN 0, ELSE $T]     !IF NULL OR 0, USE 0 
      $(DDIR+254),CES_[IFNOT MSCD THEN 0,  \SET $CES TO 0 IF MSC=0, ELSE
         ELSE (MSCD-1) XOR 31178]          !MASK MASTER SECURITY CODE 
      D.RIO(WRIT)              !WRITE NEW MSC, OR 0 TO REMOVE EXISTING
      ASSEMBLE ["JSB IXPUT";    \SAVE SECURITY CODE IN $CES 
                "DEF *+3";      \ 
                "DEF ADCES";    \ 
                "DEF CES"]
      RETURN                   !RETURN
! 
LABER:DO[MSNO_53;RETURN]
! 
NOPRM:DO[MSNO_50;RETURN]       !NOT ENOUGH PRAMS - EXIT 
! 
IN2:  IFNOT IFLG. THEN GOTO IN5!NOT INITIALIZING -JMP 
      IF IFLG.=2 THEN[\ 
      IF PLIST THEN[IF PLIST#3 THEN GOTO SCER] ;\1ST PARM NON-ASCII?
      DS.DF_@PLIST+1;        \SET THE MASTER SECURITY CODE
      $(DDIR+254)_[IFNOT $DS.DF THEN 0, \0 IF NONE, ELSE
         ELSE ($DS.DF-1) XOR 31178]]    !MASK IT
! 
! 
      IF IFLG.# -$(LIST5   )THEN[MSNO_52;RETURN] !DOES LU MATCH IFLG.?
      IF IFLG.=3 THEN[IFNOT$LIST9 THEN  RETURN] !NO LU 3 RETURN 
IN5:  IFNOT MSC.(PLIST)THEN GO TO SCER   !CHECK SECURITY CODE 
! 
!     CHECK LABEL PARAMETERS (CRN AND INFORMATION LABEL)
! 
! 
IN6:  IFNOT -$LIST9<0 THEN GO TO LABER !CRN MUST BE > 0 
      CALL SESSN($XEQT)?[GO TO IN6A]   !IF IN SESSION, THEN 
      SESWD _ .B.                      !GET SCB ADDRESS 
      CALL ISMVE(SESWD,SMID,CODE,1)    !GET USER ID FROM SCB
      IF CODE # 7777K THEN GO TO IN6A  !SKIP TEST IF NOT SYS MGR
      WHILE ($(CLPTR-2)#0) DO          \SEARCH TO END OF CL 
         [IF $CLPTR=$LIST9 THEN        \IF FIND CRN MATCH AND 
            [IDCOD_$(CLPTR+1) AND 7777K;  \GET DISC ID FROM CL
            IF (IDCOD # 7777K) AND (IDCOD # 1) THEN \IF NOT SYS, THEN 
               [MSNO_12;RETURN]];      \RETURN DUPLICATE CRN
          CLPTR_CLPTR+4]               !ELSE TRY NEXT CL ENTRY
! 
IN6A: IF $(@PLIST+12)#3 THEN GO TO LABER !IF LABEL NON-ASCII,ERROR 53 
      NAM..($(LIS13    ))                !NAME CHECKING ROUTINE 
      DO[AREG_$A; IF AREG THEN GO TO LABER] 
! 
!     SET UP TO TEST THE REST OF THE PRAMS. 
! 
       FOR T_4 TO 13 DO[PTST($(@PLIST+T*4))] !CHECK FOR ASCII OR NEGATIVE 
! 
       IFNOT$[T_(LIS21    )]THEN $T_1  !DEFAULT #DIR TRACKS TO 1
       IFNOT IFLG. THEN GOTO IN7       !IF NOT INIT SKIP
         IF IFLG.=2 THEN [FOR T_2 TO 252 DO $(DDIR+T)_0;\ 
             $DDIR_2;$(DDIR+3)_7777K],ELSE \SET LU, LAST TRK AND ID 
                [$(DDIR+4)_3;$(DDIR+7)_7777K]  !IN DISC DIRECTORY 
             LTR_[IF IFLG.=2 THEN [$(DDIR+1)_$TATSD-1],\
                   ELSE[$(DDIR+5)_ -$TATSD -$TATLG-1]]
      D.RIO(WRIT)                      !WRITE CARTRIDGE DIRECTORY 
! 
IN7:  DR.RD(READI,$LIST5     ,0)?  \
         [IF .A. THEN MSNO_54, ELSE MSNO_43;RETURN] 
! 
      LUNBR_$$@DS.LU AND 377K       !GET LU, MASKING OFF LOCK FLAG
      T_@PLIST+25                   !SET TO SEC/TRK PARAMETER ADDR
      IF LUNBR=2 THEN $T_$SECT2,    \IF LU 2, USE SECT2 FOR SEC/TRK 
         ELSE [IF LUNBR=3 THEN      \IF LU 3, USE SECT3 FOR SEC/TRK 
               $T_$SECT3, ELSE      \ 
               [CALL EXEC(1,LUNBR,SECTK,1,-1,0);  \GET SEC/TRK
                IF $T > SECTK THEN  \IF LARGER THAN ACTUAL SEC/TRK
                   [MSNO_70;RETURN],\RETURN ERROR, ELSE DEFAULT TO
                ELSE [IFNOT $T THEN $T_SECTK]]] !SEC/TRK FROM DRIVER
! 
      LTR_$$@D.LT                   !GET LAST TRACK 
      NEW,TN_LTR-[FTR_$LIS17]+1  !SET FIRST TRACK,TOTAL NO. TRACKS
      IF TN<[ND_$LIS21      ]THEN GOTO BADPM
! 
      IF ND>((TN-ND)>-3)+1 THEN GO TO BADPM !DISALLOW UNREASONABLE
!                                           NUMBER OF DIRECTORY TRACKS
      IF LUNBR=2 THEN[IF FTR<($1761K>-7)+8 THEN GO TO BADPM] ! MUST 
!        LEAVE SOME TRACKS FOR THE SYSTEM 
! 
!     CHECK THE BAD TRACKS AND ARRANGE IN ASCENDING ORDER 
! 
      LIS49_[T1_LIS29]+20 
      FOR T_LIS29 TO LIS49 BY 4 DO[\
         IF $T THEN[$T1_$T;T1_T1+1]]
      FOR T_T1 TO LIS29+6 DO[$T_0] ! ZERO THE END OF THE LIST 
IN10: SWP,LAST_0                   !INITIALIZE THE SORT 
      FOR T_LIS29 TO T1-1 DO[\   SWAP LOOP
         IF $T<LAST THEN[SWP,$(T-1)_$T;$T_LAST];LAST_$T]!SWAP 
      IF SWP THEN GO TO IN10  !IF NOT IN ORDER THEN GO DO ANOTHER CYCLE 
! 
      IFNOT LAST THEN GOTO IN13        !IF NO BAD TRACKS SKIP 
      IF $(LIS29    )<FTR THEN GOTO BTER
      IF LAST > LTR-ND THEN GO TO BTER
IN13: T3_$$@DS.LU AND 377K          !SET LU, MASKING OFF LOCK FLAG
      DLB_D.LB      !SET THE LABEL ADDRESS
      IF IFLG.=2 THEN GOTO IN20 
! 
      IF $LIST9=$DLB THEN GO TO IN12!IS SAME LABEL SKIP 
      DR.RD(READI,$LIST9,0)?  \ 
         [IF .A. THEN [DR.RD(READI,$LIST5,0);GO TO IN12]] 
      MSNO_12                     !DUPLICATE LABEL ERROR
! 
!    (GLM) -FIX FOR INITIALIZE LU3 PROBLEM
! 
!    IF INIT ON 3 WE MUST CLEAR THE LU3 FLAG (SET BY IN.IT) 
!    SO WE WILL MAINTAIN THE FMGR 003 ERROR UNTIL A GOOD IN CMND
!    COMES IN.
! 
      IF IFLG.=3 THEN[D.RIO(READI) ;TZ_@D.SDR+255;\  CLEAR THE LU3
                 $TZ_ ($TZ AND 77777K);D.RIO(WRIT)]! PROMPT FLAG
! 
      RETURN
IN12: IF IFLG.=3 THEN GOTO IN20 ! FILES NOT SAVED ON LU3
      IF [TX,NEW_FID. ($(LIST5   ))] THEN[  \IF NO VALID FILE SYS, THEN 
        IFNOT IFLG. THEN[                   \IF NOT FIRST CALL
         LOCK_($$@DS.LU -> 8) AND 377K;     \IF NOT LOCKED AND NOT LOCKABLE 
         KPTR_LOCK+$KEYWD-1;                \OFFSET IN KEYWD BLOCK
         IFNOT LOCK THEN [MSNO_61;RETURN], ELSE \ 
           [IF $KPTR # $XEQT THEN               \ 
            [MSNO_61;RETURN]]                \RETURN ERROR (DISMOUNTED WITH 
         ];                                  \OUT TELLING US) NO-NO 
         GO TO IN20                         \ELSE WE ARE OK 
       ]
! 
      LOCK.($LIST5,3,LKER)?[MSS.(LKER);RETURN]  !REQUEST LOCK 
!     A DIRECTORY EXISTS - IS THE NEW PRAM SET
!     COMPATIBLE? 
      ENDBL_ -$PDIR8*$PDIR6/2+[IF T3          =2 THEN -1 ,ELSE 0] 
! 
      IF FTR>$(PDIR4 ) THEN GOTO IN35   !IF RAISING FIRST TRACK OR
      IF $(PDIR9 )>(LTR-ND+1)THEN GOTO IN35  !LOWERING DIR INTO A FILE
      IF ND+$PDIR8 <0 THEN GO TO IN35  !IF FEWER DIRECTORY TRACKS ASK 
      IF $PDIR6 # $(@PLIST+25) THEN GO TO IN35 !IF SEC/TRK MISMATCH 
! 
IN20: IF T3          =2 THEN GT($TAT)  !IF LU TWO OR THREE
      IF T3=3 THEN GT($TAT+$TATSD)!GO SET THE TAT 
!     FULL SPEED AHEAD! 
      $PDIR_$(LIS13    )+100000K
      $(PDIR1 )_$(@PLIST+14)
      $(PDIR2 )_$(@PLIST+15)
      $(PDIR3 )_$LIST9
      $(PDIR4 )_FTR 
      IF NEW THEN [$(PDIR5 )_0;$(PDIR9 )_FTR] 
      $(PDIR6 )_$(@PLIST+25)                !SET SECTORS/TRACK VALUE
      $(PDIR7 )_LTR-ND+1
      $(PDIR8 )_-ND 
      FOR T_10 TO 15 DO $(PDIR+T)_$(@PLIST+T+19)  !SET BAD TRACKS 
      IF NEW THEN[FOR T_16 TO 127 DO $(PDIR+T)_0] 
      BL_0
! 
!     NOW WRITE IT OUT
IN22: DR.RD(WRIT,$LIST5     ,BL)?[GO TO IN25] 
! 
      FOR T_0 TO 127 DO $(PDIR+T)_0 
      IFNOT NEW THEN [BL,NEW_ENDBL;GOTO IN22]!SET TO ZERO ADDED DIRECTORY 
      DO[BL_BL+1;GO TO IN22]!ZERO THE NEXT BLOCK
! 
IN25: $DLB_$LIST9             !SET THE DIRECTORY LABEL WORD 
IN30: D.RIO(WRIT);IFNOT IFLG. THEN LOCK.($LIST5,5) !RELEASE LOCK*780413*
      EXEC(5,-1)      !RETURN ANY LEFT OVER TRACKS
      RETURN                           !WE DID IT - EXIT
! 
IN35: IFNOT IFLG. THEN               \IF NOT 1ST CALL AND 
        [IF LUNBR<4 THEN             \IF LU 2 OR 3, THEN
           TRAK.(LUNBR)?[GO TO IN30]]!CHECK TYPE 6 FILE REFERENCES
! 
IN15: MSS.(60);EXEC(2,CAM.O,35137K,1)     ;\ SEND COLON PROMPT
               EXEC(1,CAM.O OR 400K,C.BUF,36);ECH._$1 
      IF ECH.<1 THEN GOTO IN15
      IF C.BUF=YE THEN[NEW_1; GO TO IN20], ELSE [   \ 
                IF C.BUF=NO THEN [IF IFLG. THEN GOTO MSPRM,\
                   ELSE GOTO IN30],ELSE[IF C.BUF="??" THEN[\
                                     NO.RD_-1;LOCK.($LIST5,5);\ 
                                     RETURN],ELSE \ 
                                         GO TO IN15]] 
! 
BADPM:DO[MSNO_56;RETURN]
! 
MSPRM:DO[MSNO_55;RETURN]
! 
BTER: DO[MSNO_57;RETURN]
SCER: MSNO_51 
      RETURN
      END 
PTST: SUBROUTINE(PTR)                !CHECK FOR BAD PARMS (ASCII/NEG) 
! 
      IF PTR=3 THEN GOTO BADPM         !MUST NOT BE ASCII 
! 
! 
      IF $(@PTR+1)<0 THEN GOTO BADPM   !IF <0 - BAD NEWS
! 
      RETURN                           !OK !RETURN
      END 
! 
TRAK.:SUBROUTINE(LOGUN) FEXIT 
! 
!     TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE FMP TRACKS. 
!     IF ANY ARE FOUND, THE PROGRAM NAME IS PRINTED AND FEXIT IS TAKEN. 
! 
      LU3_LOGUN AND 1                !SET LU 3 FLAG 
      NFLG_0                         !FOUND FLAG
      NTR_($PDIR4 -< 7)              !NEXT TRACK
      KPTR_$KEYWD                    !POINTER TO KEYWORD BLOCK
NEXT: DMAN_[NAM3_[NAM2_[NAM1_$KPTR+12]+1]+1]+12  !PTRS TO ID SEGMENT
      IF $NAM3 AND 20K THEN DMAN_NAM3+5    !ADJUST FOR SHORT ID SEGS. 
      IF [K2_$NAM3 AND 7]=1 THEN GO TO OK  !NO CHECK NEEDED FOR TYPE1 
      IF (($DMAN -< 1) AND 1)#LU3 THEN GO TO OK  !COMPARE DISC LU 
      IF ($DMAN AND 77600K) < NTR THEN GO TO OK  !
      IFNOT NFLG THEN MSS.(11)             !SEND FMGR 011 IF 1ST ONE
      NFLG_1
      $@PNAM_$NAM1                               !1ST WORD OF NAME
      $([PN_@PNAM+1]+1)_($NAM3 AND 77400K)+40K   !3RD NAME WD, PADDED 
      $PN_$NAM2                                  !2ND WORD OF NAME
      FM.ER(2,PNAM,3)                            !WRITE PROGRAM NAME
OK:   KPTR_KPTR+1                                !BUMP KEYWD POINTER
      IF $KPTR THEN GO TO NEXT                   !CONTINUE IF NOT END 
      IF NFLG THEN FRETURN                       !FEXIT IF ANY FOUND
      RETURN
      END 
! 
GT:   SUBROUTINE(TRLOC) 
!     SUBROUTINE TO CHECK ON TRACK ASSIGNMENTS FOR
!     CHANGES TO THE SYSTEM OR AUX DISC FILE AREAS
! 
      IF IFLG. THEN RETURN  !  IF INIT THE LET MAIN DO IT 
      IF TX  THEN GO TO TRASN ! NEW SO GO GET ALL THE TRACKS
      IF FTR<[T_$(PDIR4 )] THEN GO TO TRASN ! IF LARGER AREA GET TR 
! 
!     RETURN THE LEFT OVER TRACKS 
      FOR ADD_T TO FTR-1 DO[T1_ADD+TRLOC;\
           IF $T1=77776K THEN IPUT(T1,$XEQT)] 
      EXEC(5,-1)   !RETURN THE TRACKS 
      RETURN    !AND RETURN 
! 
TRASN:T1_FTR+TRLOC  !SET UP FIRST AND LAST ADDRESSES
      T2_[IF TX THEN LTR,ELSE T-1]+TRLOC
      FOR ADD_T2 TO T1 BY -1 DO[J.PUT(ADD,$XEQT,JER);\
        IF JER THEN BADTR]
! 
      FOR ADD_T1 TO T2 DO[IF $ADD=$XEQT THEN IPUT(ADD,77776K)]
      RETURN
      END 
BADTR:SUBROUTINE
      T_ADD-TRLOC  !CHECK IF UNAVAILABLE TRACK IS ALSO BAD
      FOR X_LIS29 TO LIS49 BY 4 DO[IF $X=T THEN RETURN] 
      MSS.(1059,T) !NOT FOUND SO BAD TRACK ERROR OR TRACK NOT AVAILABLE 
      GO TO IN30  !GO EXIT
      END 
      END 
      END$
                                