FTN4,L,M
C  NAME:    START 
C  SOURCE:  92070-18160 
C  RELOC:   92070-16160 
C  PGMR:    HLC 
C 
C 
C  **************************************************************** 
C  *  (C)  COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    * 
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
C  **************************************************************** 
C 
C 
C  PURPOSE: START WILL PERFORM THE FOLLOWING TASKS: 
C 
C           *  ALLOCATE AND INITIALIZE THE SWAP FILE. 
C           *  SET UP AN ID SEGMENT FOR FMGR AND SCHEDULE IT. 
C           *  PASS A STRING TO FMGR THAT WILL TRANSFER TO WELCOM.
C 
C 
C  INVOKE:  RU, START, SWAP, FMGR, WELCOME, CARTRIDGE 
C 
C           OR
C 
C           DESIGNATE START AS THE START-UP PROGRAM DURING THE
C           USER PROGRAM RELOCATION PHASE AT GENERATION TIME. 
C 
C           WHERE:
C             'SWAP' IS THE SWAP FILE SECURITY CODE 
C             'FMGR' IS THE FMGR FILE SECURITY CODE 
C             'WELCOME' IS THE WELCOME FILE SECURITY CODE 
C             'CARTRIDGE' IS THE CARTRIDGE REFERENCE FOR ALL THREE FILES
C 
C 
C  SUBROUTINES UNIQUE TO START
C 
C  CDPX:    PATCHES THE FIRST WORD OF THE CARTRIDGE DIRECTORY 
C           IF THE FIRST WORD OF THE DIRECTORY IS EQUAL OR
C           LESS THAN ZERO. 
C 
C           INVOKE: CALL CDPX(LU) 
C 
C                   OR
C 
C                   OLD = CDPX(LU)
C 
C           WHERE:  'LU' IS THE VALUE TO BE PLACED IN THE FIRST WORD OF 
C                   THE CARTRIDGE DIRECTORY.
C 
C                   'OLD' IS THE PREVIOUS CONTENTS OF THE CARTRIDGE 
C                   DIRECTORY.
C 
C 
C           IF:     'LU' IS SET TO ZERO, THE DIRECTORY WILL NOT BE
C                   MODIFIED. 
C 
C                   'OLD' IS RETURNED AS A VALUE GREATER THAN ZERO, THEN
C                   THE FIRST WORD OF THE DIRECTORY ALREADY HAD A POSITIVE
C                   VALUE IN IT, AND WAS NOT PATCHED. 
C 
C  SWPIN:   INITIALIZES THE SWAP TABLE TO BE USED BY THE SWAP FILE, AND 
C           RETURNS THE ACTUAL NUMBER OF BLOCKS USED, TO ALLOW  
C           FOR TRUNCATION. 
C 
C           INVOKE: I=SWPIN(DCB, ERR, BLKS) 
C 
C           WHERE:  'DCB' IS THE DATA CONTROL BLOCK USED BY "SWAP". 
C 
C                   'ERR' (SAME AS 'I') IS AN ERROR CODE RETURNED   
C                   TO THE CALLING PROGRAM AS FOLLOWS:  
C 
C                    0      NO ERROR
C                   -7      WRONG SECURITY CODE 
C                   -11     FILE NOT OPEN 
C                   -42     SWAPPING ACTIVE 
C                   -43     SYSTEM DOES NOT ALLOW SWAPPING
C                   -44     WRONG FILE TYPE 
C                   -45     FILE TOO SMALL
C 
C                   'BLKS' IS THE NUMBER OF BLOCKS USED.
C 
C 
      PROGRAM START  (3,45) ,  92070-16160  REV.1941  800124
      IMPLICIT INTEGER  (A-Z) 
      INTEGER DCB (144) 
      INTEGER FMGR (3)
      INTEGER RBUF (5)
      INTEGER WELCOM (12) 
      INTEGER SWAP (3)
      DATA FMGR/2HFM,2HGR,2H  / 
      DATA SWAP/2HSW,2HAP,2H  / 
      DATA WELCOM/2H::,2HWE,2HLC,2HOM,2H: ,2HXX,2HXX,2HXX,2H: / 
C 
C 
C 
C  OBTAIN THE SECURITY CODES AND THE CARTRIDGE REFERENCE NUMBERS OF 
C  THE SWAP, FMGR, AND WELCOME FILES. 
C 
      CALL RMPAR (RBUF) 
C 
C  CONVERT THE WELCOME FILE SECURITY CODE AND CARTRIDGE REFERENCE 
C  NUMBER TO AN ASCII STRING. 
C 
      CALL CNUMD (RBUF (3) ,WELCOM (6) )
      CALL CNUMD (RBUF (4) ,WELCOM (10) ) 
C 
C  LOG = LOGICAL UNIT NUMBER OF THE SYSTEM CONSOLE. 
C 
      LOG = LOGLU (SN)
C 
C  DETERMINE IF AN INITIAL CARTRIDGE WAS SPECIFIED AT GENERATION TO 
C  BE MOUNTED AT BOOT UP. IF NOT, PROMPT FOR THE SYSTEM DISC  LU. 
C 
      CALL FSTAT (FIRST,1)
      IF (FIRST.NE.0) GOTO 50 
5     WRITE (LOG,10)
10    FORMAT ("PLEASE ENTER THE LU OF THE SYSTEM DISC") 
      READ (LOG,*) FIRST
C 
C  PATCH THE CARTRIDGE DIRECTORY WITH THE SYSTEM DISC  LU NUMBER. 
C 
      CALL CDPX (FIRST) 
C 
C  CLEAR THE DCB HEADER 
C 
50    DO 60 I = 1,16
      DCB (I)  = 0
60    CONTINUE
C 
C 
C 
C  *** SWAP FILE INITIALIZATION *** 
C 
C 
C 
C  DETERMINE IF THE SYSTEM SUPPORTS SWAPPING.  IF NOT, GO AND 
C  SCHEDULE FILE MANAGER. 
C 
      IF (SWPIN (DCB,IDFLG,BLKS) .EQ.-43)  GOTO 2000
C 
C  DOES THE SWAP FILE ALREADY EXIST?
C 
      CRFLAG=OPEN (DCB,ERR,SWAP,0,RBUF(1),RBUF(4) ) 
      IF (CRFLAG.GE.0)  GOTO 100
C 
C  MAKE SURE THAT THE CARTRIDGE DIRECTORY WAS PATCHED SUCCESSFULLY. 
C  IF NOT, TRY AGAIN. 
C 
      CALL FSTAT (FIRST,1)
      IF (FIRST.GE.0)  GOTO 90
70    WRITE (LOG,80)
80    FORMAT ("  *DISC  MOUNT FAILED*") 
      GOTO 5
90    IF (CRFLAG.NE.-6)  GOTO 300 
C 
C 
C  IF NO SWAP FILE EXISTS, CREATE ONE.
C 
      IF (CREAT (DCB,ERR,SWAP,-1,1,RBUF(1),RBUF(4) ).LT.0)  GOTO 300
C 
C  INITIALIZE THE SWAP TABLE AND RETURN THE NUMBER OF SWAP AREAS
C  AVAILABLE IN THE SWAP FILE.
C 
100   IF (SWPIN (DCB,ERR,BLKS) .LT.0)  GOTO 300 
      WRITE  (LOG,200)  ERR 
200   FORMAT (I4," SWAP AREAS AVAILABLE") 
C 
C  IF THE SWAP FILE WAS CREATED NOW,
C  DETERMINE THE ACTUAL SIZE OF THE SWAP FILE,
C 
      IF(CRFLAG.NE.-6) GOTO 1000
      IF (LOCF (DCB,ERR,SN,SN,SN,SEC) .LT.0)  GOTO 300
      SEC  = SEC/2-BLKS 
C 
C    THEN TRUNCATE ANY PART OF THE SWAP FILE THAT IS NOT NEEDED.
C 
      IF (CLOSE (DCB,ERR,SEC) .GE.0)  GOTO 2000 
C 
C  IF ERROR EXISTS WHEN CLOSING THE FILE, NOTIFY OPERATOR,
C  AND TRY TO CLOSE WITHOUT TRUNCATING. 
C 
300   WRITE (LOG,500)  ERR,SWAP 
500   FORMAT ("  FMP ERROR " I4 " ON " 3A2 "INITIALIZATION")
      IDFLG = 0 
1000  IF (CLOSE (DCB,ERR).GE.0) GOTO 2000 
C 
C  IF CLOSE ERROR STILL EXISTS, CONTINUE WITHOUT CLOSING THE SWAP 
C  FILE, AND NOTIFY OPERATOR OF THE ERROR.
C 
      IF (ERR.EQ.-11) GOTO 2000 
      WRITE (LOG,500)  ERR,SWAP 
      IDFLG = 0 
C 
C 
C 
C  *** SCHEDULE THE FILE MANAGER INTERACTIVELY ***
C 
C 
C 
C  WLNG = LENGTH OF THE STRING THAT TRANSFERS TO THE WELCOM FILE. 
C 
2000  WLNG = 12 
C 
C  DETERMINE IF FMGR ALREADY HAS AN ID SEGMENT. 
C 
      IF (OPEN (DCB,ERR,FMGR,4,RBUF(2),RBUF(4) ).LT.0)  GOTO 2300 
C 
C  SET UP AN ID SEGMENT FOR FMGR. 
C 
      IF (IDRPL (DCB,ERR,FMGR,1) .EQ.23)  GOTO 2050 
      IF (ERR.NE.0) GOTO 2300 
2050  IF (CLOSE (DCB,ERR) .LT.0)  GOTO 2300 
C 
C 
C  SCHEDULE FMGR AND PASS IT THE STRING THAT CAUSES A TRANSFER TO THE 
C  WELCOM FILE.  SET THE NO ABORT BIT SO A SCHEDULING ERROR CAN BE
C  DETECTED.
C 
C 
      P1=LOG
      P2=LOG
      P3=LOG
2100  CALL EXEC  (100012B,FMGR,P1,P2,P3,0,0,WELCOM,WLNG)  
      GOTO 2800 
2150  CALL ABREG (A,B)
      IF  (A.EQ.0)  GOTO 9999 
      WRITE (LOG,2200)
2200  FORMAT ("  FMGR ACTIVE")
      IDFLG = 0 
      GOTO 9999 
C 
C  DETERMINE IF THE CARTRIDGE DIRECTORY WAS SUCCESSFULLY PATCHED. 
C  IF NOT, TRY AGAIN. 
C 
2300  CALL FSTAT (FIRST,1)
      IF (FIRST.LT.0)  GOTO 70
      WRITE (LOG,500)  ERR,FMGR 
      IDFLG = 0 
      IF (CLOSE (DCB,ERR) .GE.0)  GOTO 9999 
      IF (ERR.EQ.-11)  GOTO 9999
      WRITE  (LOG,500)  ERR,FMGR
      IDFLG = 0 
      GOTO 9999 
C 
C  CHECK FOR SCHEDULING ERRORS. 
C  SC05 = FMGR NOT FOUND. 
C         TRY TO SCHEDULE AGAIN.
C  SC10 = NOT ENOUGH SAM TO PASS STRING THAT SCHEDULES WELCOM.
C         TRY TO SCHEDULE AGAIN WITHOUT WELCOM FILE TRANSFER STRING.
C         (THE CARTRIDGE REFERENCE NUMBER IS LOST.) 
C 
C 
2800  CALL ABREG (A,B)
      IF (B.EQ.2H05) GOTO 2000
      IF (B.NE.2H10) GOTO 3300
      IF (WLNG.EQ.0) GOTO 3300
      WLNG = 0
      P1=WELCOM(2)
      P2=WELCOM(3)
      P3=WELCOM(4)
      GOTO 2100 
C 
C  PRINT ERROR MESSAGE IF SCHEDULING ERROR IS OTHER THAN SC05 OR SC10.
C 
3300  WRITE (LOG,3500)  A,B 
3500  FORMAT ("  FMGR SCHEDULING ERROR  "2A2) 
      IDFLG = 0 
C 
C  IF A NON-SWAPPING SYSTEM, RETURN THE ID SEGMENT OF START UPON
C  COMPLETION.
C 
9999  IF (IDFLG.EQ.-43)  CALL IDCLR 
      END 
      END$
                                                              