$CHAREQU

*******************************************************************************
* SOURCE CODE and DOCUMENTATION COPYRIGHT (C) 1987 KEVIN G. RHOADS AND THE *
* HIGH VOLTAGE RESEARCH LAB., L.E.E.S, Massachusetts Institute of Technology *
*******************************************************************************
*******************************************************************************
* *
* This file is part of the UTILS.LIB library, other components are in files: *
* FUTIL.FOR, FDUTIL.FOR, DUTIL.FOR, GUTIL.FOR, XUTIL.FOR, KUTIL.FOR, *
* PFUTIL.PAS, PASUTIL.PAS, DEFNS.PAS, FHACKER.FOR, and FPUTIL.FOR. In addition
* to routines from other parts of UTILS these use routines from the *
* ASMUTILS.LIB libraries and should be listed before it at link time. *
*-----------------------------------------------------------------------------*
$SEGMENT HACKER
*compiler is directed to place object code in segment HACKER *
*-----------------------------------------------------------------------------*
$CHAREQU
*compiler is directed NOT to barf on CHARACTER and numeric data types mixed in*
*same COMMON BLOCK or EQUIVALENCE *
*******************************************************************************
* *
* *
* SUBROUTINE CHAIN(FILE) *
* ENTRY UCHAIN(FILE) *
* ENTRY OCHAIN(FILE) *
* ENTRY CCHAIN(FILE) *
* ENTRY SCHAIN(FILE) *
* ENTRY ZCHAIN(FILE,UNITS) *
*-----------------------------------------------------------------------------*
* SUBROUTINE OPESYS *
*-----------------------------------------------------------------------------*
* SUBROUTINE LOADB(FILE,ADDRES,ERROR) *
*******************************************************************************
*----------------------------------------------------------------------
SUBROUTINE CHAIN(FILE)
CHARACTER*(*) FILE
CHARACTER VOL*6,NAME*8,EXT*3,FNAME*22,FNAMA(24)*1,FNAM2*24
INTEGER*4 ERROR
INTEGER*1 IVOL(6),INAME(8),IEXT(3),UNITS(0:3)
LOGICAL*1 USER,SYSTEM,CLOSES,Z,FILEXS*4
EQUIVALENCE (FNAM2,FNAMA(1)),(FNAME,FNAMA(3))
EQUIVALENCE (VOL,IVOL(1)),(NAME,INAME(1)),(EXT,IEXT(1))
EXTERNAL FNCHCK,STRIPF
CLOSES = .FALSE.
USER = .FALSE.
SYSTEM = .FALSE.
11 CONTINUE
Z = .FALSE.
111 CONTINUE
CALL FNCHCK(FILE,'BIN',FNAME)
INQUIRE (FILE=FNAME,EXIST=FILEXS)
1111 CONTINUE
VOL = ' '
NAME = ' '
EXT = 'BIN'
IDRV = 4
FILE = FNAME
CALL EXPAND(FILE,VOL,NAME,EXT)
IF (.NOT.FILEXS) THEN
 IF (VOL.NE.' '.AND.IDRV.EQ.4) THEN
DO 1113 IKLKL = 1,7
IF (FNAME(IKLKL:IKLKL).EQ.':') THEN
FNAME(1:IKLKL) = ' '
CALL STRIPF(FNAME)
GOTO 1111
ENDIF
1113 CONTINUE
ENDIF
WRITE (11,'(A,A,A)',ERR=1112) 'CHAIN: CANNOT FIND ',FNAME,' ON DEFAULT
DRIVE'
1112 CONTINUE
FNAMA(2) = ':'
FNAMA(1) = CHAR(IDRV+$30)
IDRV = IDRV + 1
IF (IDRV.EQ.8) IDRV = 0
IF (IDRV.EQ.4) GOTO 1114
INQUIRE (FILE=FNAM2,EXIST=FILEXS)
IF (FILEXS) THEN
FILE = FNAM2
GOTO 1111
ENDIF
IF (IDRV.LE.7) GOTO 1112
ENDIF
1114 CONTINUE
IF (NAME.EQ.' ') THEN
PRINT *,'CANNOT CHAIN TO FILE: ',FILE
CALL WBOOT
ELSEIF (EXT.EQ.'DRV') THEN
SYSTEM = .TRUE.
USER = .FALSE.
ENDIF
CALL SYSCLO(72,ERROR)
DO 1 I = 0,15
CALL SYSCLO(I,ERROR)
1 CONTINUE
CALL SYSCLO(52,ERROR)
CALL SYSCLO(51,ERROR)
IF (CLOSES) THEN
DO 21 I = 0,255
CALL SYSCLO(I,ERROR)
21 CONTINUE
ENDIF
CALL TRPSOF
IF (USER) THEN
CALL SUPERM
CALL USERM
ELSEIF (SYSTEM) THEN
CALL SUPERM
ENDIF
CALL ACHAIN(IVOL,INAME,IEXT)
*----------
ENTRY UCHAIN(FILE)
USER = .TRUE.
CLOSES = .TRUE.
SYSTEM = .FALSE.
GOTO 11
*----------
ENTRY OCHAIN(FILE)
 USER = .TRUE.
CLOSES = .FALSE.
SYSTEM = .FALSE.
GOTO 11
*----------
ENTRY CCHAIN(FILE)
USER = .FALSE.
CLOSES = .TRUE.
SYSTEM = .FALSE.
GOTO 11
*----------
ENTRY SCHAIN(FILE)
SYSTEM = .TRUE.
CLOSES = .FALSE.
USER = .FALSE.
GOTO 11
*----------
ENTRY ZCHAIN(FILE,UNITS)
SYSTEM = .FALSE.
CLOSES = .FALSE.
USER = .FALSE.
Z = .TRUE.
I = UNITS(0)
DO 1243 J = 1,I
K = UNITS(J)
CALL SYSCLO(K,ERROR)
1243 CONTINUE
GOTO 111
END
*----------------------------------------------------------------------
SUBROUTINE OPESYS
* CLOSE (246,ERR=1)
* 1 CLOSE (249,ERR=2)
* 2 CLOSE (250,ERR=3)
3 CONTINUE
* CALL SYSCLO(246,IERR)
* CALL SYSCLO(249,IERR)
* CALL SYSCLO(250,IERR)
CALL SYSOPE(249,'#SCRN0',0,0,0,-1,IERR)
CALL SYSOPE(246,'#CON',1,0,0,-1,IERR)
CALL SYSOPE(250,'#CNSL0',0,0,0,-1,IERR)
RETURN
END
*----------------------------------------------------------------------
SUBROUTINE LOADB(FILE,ADDRES,ERROR)
CHARACTER*(*) FILE
INTEGER*4 ADDRES,ERROR,GETSR
CHARACTER VOL*6,NAME*8,EXT*3,FNAME*24
INTEGER*1 IVOL(6),INAME(8),IEXT(3)
EQUIVALENCE (VOL,IVOL(1)),(NAME,INAME(1)),(EXT,IEXT(1))
EXTERNAL FNCHCK
VOL = ' '
NAME = ' '
EXT = 'BIN'
CALL FNCHCK(FILE,'BIN',FNAME)
FILE = FNAME
CALL EXPAND(FILE,VOL,NAME,EXT)
IF (NAME.EQ.' ') THEN
PRINT *,'CANNOT LOAD FILE: ',FILE
 ADDRES = 0
ERROR = -1
RETURN
ENDIF
CALL SYSCLO(72,ERROR)
CALL ALOADB(ADDRES,ERROR,IVOL,INAME,IEXT)
I = GETSR()
IF (I.LT.$2000.AND.I.GE.0) THEN
CALL RSTSSP
ENDIF
RETURN
END