SPL,L,O,M 
!     NAME:   IN..
!     SOURCE: 92070-18021 
!     RELOC:  92070-16021 
!     PGMR:   G.A.A.
!     MOD:    M.L.K.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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..(7) "  92070-1X021  REV.2004  800123"
! 
! 
!     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        IS THE NEW CARTRIDGE LABEL (MUST BE NUMERIC > 0).
! 
!     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 ).
! 
!     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 AT GENERATION 
!     AND MUST MATCH THEREAFTER.
! 
! 
! 
!  EXTERNAL SUBROUTINES 
      LET CLD.R     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET D.RIO     BE SUBROUTINE,EXTERNAL
      LET DR.RD     BE SUBROUTINE,EXTERNAL
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET IMESS     BE SUBROUTINE,EXTERNAL
      LET LOCK.     BE SUBROUTINE,EXTERNAL
      LET MVW       BE SUBROUTINE,EXTERNAL
      LET MSS.      BE SUBROUTINE,EXTERNAL
      LET NAM..     BE SUBROUTINE,EXTERNAL
      LET PR.IT     BE SUBROUTINE,EXTERNAL
      LET READF     BE SUBROUTINE,EXTERNAL
      LET REIO      BE SUBROUTINE,EXTERNAL
      LET WRITF     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET FID.      BE FUNCTION,EXTERNAL
      LET MSC.      BE FUNCTION,EXTERNAL
      LET SY.TR     BE FUNCTION,EXTERNAL
      LET TR.SC     BE FUNCTION,EXTERNAL
!  EXTERNAL LABELS
      LET FM.AB     BE LABEL,EXTERNAL 
!  EXTERNAL INTEGERS
      LET .P1       BE INTEGER,EXTERNAL 
      LET .P2       BE INTEGER,EXTERNAL 
      LET .P3       BE INTEGER,EXTERNAL 
      LET .P4       BE INTEGER,EXTERNAL 
      LET .P5       BE INTEGER,EXTERNAL 
      LET .P6       BE INTEGER,EXTERNAL 
      LET .P7       BE INTEGER,EXTERNAL 
      LET .R1       BE INTEGER,EXTERNAL 
      LET BOOTX(512) BE INTEGER,EXTERNAL
      LET C.BUF     BE INTEGER,EXTERNAL 
      LET CAM.O     BE INTEGER,EXTERNAL 
      LET D.LB      BE INTEGER,EXTERNAL 
      LET D.LT      BE INTEGER,EXTERNAL 
      LET D.SDR     BE INTEGER,EXTERNAL 
      LET DS.DF     BE INTEGER,EXTERNAL 
      LET DS.F1     BE INTEGER,EXTERNAL 
      LET DS.LU     BE INTEGER,EXTERNAL 
      LET O.BUF     BE INTEGER,EXTERNAL 
      LET P.6       BE INTEGER,EXTERNAL 
      LET PK.DR     BE INTEGER,EXTERNAL 
!  INTERNAL SUBROUTINES 
      LET PTST      BE SUBROUTINE 
! 
      LET LK0(3),LK3,LK4,LK5,LK6,LK7,LK8,TMP(2)  \
                     BE INTEGER 
      LET PRMPT(31)  BE INTEGER 
      INITIALIZE PRMPT TO "FMGR 060 DO YOU REALLY WANT TO PURGE THIS ",\
                          "DISC? (YES OR NO).",20137K 
! 
      INITIALIZE LK0    TO     "BOOTEX"          !FILE NAME 
      INITIALIZE LK3    TO     1                 !TYPE
      INITIALIZE LK4    TO     0                 !STARTING TRACK
      INITIALIZE LK5    TO     0                 !STARTING SECTOR 
      INITIALIZE LK6    TO     8                 !SIZE IN 64 WORD SECTORS 
      INITIALIZE LK7    TO     0                 !RECORD LENGTH 
      INITIALIZE LK8    TO     -32767            !SECURITY CODE 
!     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 DMSIN    BE CONSTANT(26455K)           ! "--" 
! 
! 
! 
IN..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL 
      LET NCAM,PLIST,MSNO BE INTEGER
! 
      DDIR_@D.SDR 
      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                                     !INIT FOR NO ERRORS
! 
!     TEST FOR LEGAL PARAMETERS 
! 
      IF NCAM>3 THEN GO TO IN2                   !IF MORE THAN 3 PARMS
                                                 !CONTINUE AT IN2 
      IF NCAM#1 THEN GOTO NOPRM                  !IF < 3, MUST BE 1 
! 
!     MASTER SECURITY CODE (MSC) CHANGE 
! 
      IFNOT MSC.(PLIST) THEN GOTO SCER           !SECURITY CODE LEGAL?
      IF $(@PLIST+2)#DMSIN THEN GOTO NOPRM       !SECOND 2 CHARS ARE DASHES 
      T2_[IF([T_$(@PLIST+3)]AND 77400K)=20000K THEN 0,ELSE T] 
! 
!     GO PRIV AND SET NEW MASTER SECURITY CODE
! 
      ASSEMBLE["  JSB .DRCT";                    \
               "  EXT $XECM";                    \
               "  DEF $XECM";                    \
               "  STA 1    ";                    \SAVE ADDRESS IN B 
               "  LDA DEFT2";                    \GET ADRS OF NEW CODE
               "  EXT PMOVE";                    \
               "  JSB PMOVE";                    \
               "  OCT 1    "]                    !
      RETURN                                     !RETURN
! 
DEFT2: ASSEMBLE "  DEF T2"
! 
! 
! 
LABER:DO[MSNO_53;RETURN]                         !LABEL ERROR 
NOPRM:DO[MSNO_50;RETURN]                         !NOT ENOUGH PARMS, EXIT
! 
!     INITIALIZE DISC 
! 
IN2:  IFNOT MSC.(PLIST)THEN GOTO SCER            !CHECK SECURITY
! 
!     CHECK LABEL PARAMETERS
! 
IN6:  IFNOT -$LIST9<0 THEN GOTO LABER            !LABEL MUST BE > 0 
      IF $(@PLIST+12)#3 THEN GOTO LABER          !MUST BE ASCII 
      NAM..($(LIS13    ))                        !MUST BE VALID NAMR
      AREG_$A 
      IF AREG THEN GOTO LABER 
! 
!     SET UP TO TEST THE REST OF THE PRAMS. 
! 
       FOR T_4 TO 13 DO[PTST($(@PLIST+T*4))]
       IFNOT$[T_(LIS21)]THEN $T_1                !MUST HAVE DRTRK 
! 
!    READ BLOCK ZERO
! 
IN7:  DR.RD(READI,$LIST5,0)?[MSNO_-32;RETURN] 
      IF TR.SC($DS.LU,T,SECT)  THEN[MSNO_ -18; RETURN] !GET SECTRTRACK
      T_@PLIST+25                                !SET # OF SECTORS ADRS 
      IFNOT $T THEN $T_ SECT                     !IF # SECTORS NOT GIVEN
                                                 !USE SECTORS/TRACK 
      LTR_$$@D.LT                                !SET CURRENT LAST TRACK
      NEW,TN_LTR-[FTR_$LIS17]+1                  !SET 1ST TRK,TOTAL TRACKS
      IF TN<[ND_$LIS21]  THEN GOTO BADPM
      IF ND>((TN-ND)>-3)+1 THEN GOTO BADPM       !DISALLOW UNREASONABLE 
                                                 !NUMBER OF DIR TRACKS
! 
!     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 END OF 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, DO AGAIN 
! 
      IFNOT LAST THEN GOTO IN13                  !IF NO BAD TRACKS, SKIP
      IF $(LIS29)<FTR  THEN GOTO BTER 
      IF LAST > LTR-ND  THEN GOTO BTER
IN13: T3_$$@DS.LU                                !SET LU
      DLB_D.LB                                   !SET THE LABEL ADDRESS 
      IF $LIST9=$DLB THEN GO TO IN12             !IF SAME LABEL, SKIP 
! 
!    CHECK FOR DUPLICATE LABEL
! 
      DR.RD(READI,$LIST9,0)?[DR.RD(READI,$LIST5,0);GO TO IN12]
      MSNO_12                                    !DUPLICATE LABEL 
      RETURN                                     !ERROR RETURN
! 
!   WE MUST PROTECT TRACK AND SECTOR 0
! 
IN12: .P1_ 3                                     !LOCK DISC, RET IF ERROR 
      .P2_ $LIST5 
      CLD.R                                      !CALL D.RTR FOR LOCK 
      DS.DF_ 0                                   !SET FOR RE- READ
      DS.F1_ 0                                   !  OF DIRECTORY
      IF .R1 < 0  THEN[                          \IF ERROR, BUT NOT 
         IF .R1# -103 THEN [MSNO_.R1; RETURN]]   !CORRUPT, RETURN 
      IF [TX,NEW_FID. ($(LIST5))]  THEN GOTO IN20!TEST FOR FILE SYSTEM
! 
!     A DIRECTORY EXISTS - IS THE NEW PRAM SET COMPATIBLE?
! 
!    CALCULATE # BLOCKS IN DIRECTORY
! 
      IF $(PDIR+16) = 0  THEN[ NEW_ 1]           !IF NO FILES, TREAT AS NEW 
      ENDBL_ -$PDIR8*($PDIR6 AND 377K)/2
      IF FTR>$(PDIR4 ) THEN GOTO IN15 
      IF $(PDIR9 )>(LTR-ND+1)  THEN GOTO IN15 
      IF ND+$PDIR8 <0 THEN GO TO IN15            !IF FEWER DIREC TRACKS ASK 
      IFNOT FTR THEN[                            \IF INIT DOWN
         IF $PDIR4 THEN GOTO IN15]               !TO TRK 0 THEN ASK 
! 
!     FULL SPEED AHEAD! 
! 
IN20: FLCR_16                                    !OFFSET VALUE FOR DIR CLEAR
      $PDIR_$(LIS13)+100000K                     !SET ID+SIGN BIT 
      $(PDIR1)_ $(@PLIST+14)                     !SET LAST 2 WORDS OF ID
      $(PDIR2)_ $(@PLIST+15)
      $(PDIR3)_ $LIST9                           !SET LABEL 
      $(PDIR4)_ FTR                              !SET 1ST AVAILABLE TRACK 
      IFNOT NEW THEN GOTO IN21                   !DON'T SET NXTRK & SECT IF OLD 
                                                 !SKIP SECT/TRK INFO AS DIRECTORY 
                                                 !AND FILES ARE ALREADY WRITTEN 
! 
!   IF FIRST TRACK=0 THEN SET FIRST SECTOR (PDIR5)  
!   TO 8 AND MOVE BOOTX CODE INTO FIRST FILE
! 
      $(PDIR9)_FTR                               !SET NEXT TRACK TO 1ST 
      $(PDIR5)_0                                 !SET NEXT SECTOR 
      IFNOT FTR THEN[                            \IF TRACK = 0
           MVW(@LK0,PDIR+16,9);                  \THEN MOVE DUMMY ENTRY IN
           FLCR_25;                              \AND SET TO CLEAR FOLLOWING ENTRY
           $(PDIR5)_ 8;                          \SET NEXT SECT PAST DUMMY
           EXEC(13,$DS.LU+10000K,T,T,BOOTX(7),8);\GET DISC PARAMETERS 
           EXEC(2,$DS.LU+7700K,BOOTX,BOOTX(3),0,0);\WRITE INTO FILE 
           IF .B. # BOOTX(3)  THEN[              \CHECK XMISSION LOG
              MSS.(1,$DS.LU);                    \WRITE OUT DISC ERROR
              GOTO FM.AB]]                       !ABORT REQUEST 
       $(PDIR6 )_$(@PLIST+25)                    !SET SECTORS/TRACK 
! 
IN21: $(PDIR7 )_LTR-ND+1                         !SET LOWEST DIR TRACK
      $(PDIR8 )_-ND                              !SET #DIR TRACKS 
! 
!   SET BAD TRACKS
! 
      FOR T_10 TO 15 DO $(PDIR+T)_$(@PLIST+T+19)
! 
!  IF NEW CLEAR REST OF DIRECTORY 
! 
      IF NEW THEN[FOR T_FLCR TO 127 DO $(PDIR+T)_0] 
      BL_0                                       !SET THE BLOCK TO ZERO 
! 
!     NOW WRITE IT OUT
! 
IN22: DR.RD(WRIT,$LIST5,BL)?[GO TO IN30]
! 
!     CLEAR BUFFER
! 
      FOR T_0 TO 127 DO $(PDIR+T)_0 
      IFNOT NEW THEN [BL,NEW_ENDBL;GOTO IN22]    !SET TO 0 ADDED DIR
      BL_BL+1 
      GOTO IN22                                  !ZERO THE NEXT BLOCK 
! 
!  SET UP FOR CALL TO D.RTR TO UPDATE THE CRN 
! 
IN30:  IF $LIST9=$DLB THEN GO TO EXNOW           !SKIP UPDATE OF CRN IF SAME
      .P1_7                                      !SET FUNCTION CODE 
      .P2_$LIST9                                 !SET THE LABEL 
      .P3_ $$@DS.LU                              !SET THE LU
      .P7_ -1                                    !UPDATE CRN ONLY 
      CALL CLD.R                                 !CALL D.RTR
! 
!      IF DUP CRN THEN ERROR 12 WILL RETURN 
!      IN THIS CASE--THE DISK WILL HAVE BEEN INITIALIZED
!      BUT THE MASTER DIRECTORY WILL NOT HAVE IT'S CRN
!      THAT WORD WILL BE ZERO 
       MSNO_ .R1                                 !SET THE ERROR CODE
EXNOW: LOCK.(-($DS.LU),5)                        !RELEASE THE LOCK
      RETURN                                     !EXIT
! 
IN15: IF SY.TR($LIST5,O.BUF,128,T,T) THEN[       \IS SYSTEM USING DISC? 
         MSS.(38);                               \YES, ERROR 38 
         PR.IT(O.BUF,128);                       \PRINT OFFENDING PROGRAMS
         GOTO EXNOW]                             !UNLOCK AND EXIT 
IN40: REIO(2,CAM.O,PRMPT,31)                     !SEND FMGR 060 PROMPT
      REIO(1,CAM.O OR 400K,C.BUF,36)             !READ RESPONSE 
      LN_ $1                                     !SET LENGTH RECIEVED 
      IF LN<1 THEN GOTO IN40
      IF C.BUF=YE THEN[NEW_1; GO TO IN20], ELSE [   \ 
                IF C.BUF=NO THEN GOTO EXNOW ,\
                              ELSE GOTO IN40] 
! 
BADPM:DO[MSNO_56;RETURN]
MSPRM:DO[MSNO_55;RETURN]
BTER: DO[MSNO_57;RETURN]
SCER: MSNO_51 
      RETURN
      END 
PTST: SUBROUTINE(PTR)                            !PARAMETER TEST. 0 OR 1 OK 
      IF PTR=3 THEN GOTO BADPM                   !MUST NOT BE ASCII 
      IF $(@PTR+1)<0 THEN GOTO BADPM             !ILLEGAL IF < 0
      RETURN                                     !OK, RETURN
! 
      END 
      END 
! 
      END$
                                                                                                      