Google
 

Trailing-Edge - PDP-10 Archives - BB-K829A-BM_1981 - sources/go.for
There are no other files named go.for in the archive.
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C go> Operating-system-dependent functions
C DEC character and flag definitions, some duplicates of "gdef"
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C  copyright notice
C 
C 
C   			C O P Y R I G H T
C 
C 
C   		Copyright (C) 1980 by
C   		Digital Equipment Corporation, Maynard, Mass.
C 
C 
C   	This software is furnished under a license and may be used and
C   	copied  only  in accordance with the terms of such license and
C   	with the  inclusion  of  the  above  copyright  notice.   This
C   	software  or  any  other copies thereof may not be provided or
C   	otherwise made available to any other person.  No title to and
C   	ownership of the software is hereby transferred.
C 
C   	The information in this software is subject to change  without
C   	notice  and should not be construed as a commitment by Digital
C   	Equipment Corporation.
C 
C   	DIGITAL assumes no responsibility for the use  or  reliability
C   	of its software on equipment that is not supplied by DIGITAL.
C 
C ========== Ratfor character definitions ==========
C 	 9-FEB-79
C 	12-MAY-80
C  ampersand
C  exclamation mark
C  ASCIZ strings as used by SYSLIB
C  max element count in packed char array
C  input record size
C  must be 2 more than MAXRECORD
C  alternative to YES, NO
C  a linefeed
C  for OPENF calls
C 	"
C 	"
C 	"
C  char i/o format:  "r1" for TOPS-20; "a1" otherwise
C  quoted string version of above
C  first char for single space with LIST carriagecontrol:
C 	' ' for RSTS, nothing for VMS
C  ascii numeric value corresponding to LISTSS, above
C  if "#", omit packed string code for this machine
C  5 for TOPS-20, 1 otherwise
C  if "#", omit TOPS20 code
C character and global parameter definitions
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C  copyright notice
C 
C 
C   			C O P Y R I G H T
C 
C 
C   		Copyright (C) 1980 by
C   		Digital Equipment Corporation, Maynard, Mass.
C 
C 
C   	This software is furnished under a license and may be used and
C   	copied  only  in accordance with the terms of such license and
C   	with the  inclusion  of  the  above  copyright  notice.   This
C   	software  or  any  other copies thereof may not be provided or
C   	otherwise made available to any other person.  No title to and
C   	ownership of the software is hereby transferred.
C 
C   	The information in this software is subject to change  without
C   	notice  and should not be construed as a commitment by Digital
C   	Equipment Corporation.
C 
C   	DIGITAL assumes no responsibility for the use  or  reliability
C   	of its software on equipment that is not supplied by DIGITAL.
C 
C ** Symbolic definitions **
C  data types
C 	define character byte
C max string storage
C max string index storage
C  important string indices (see gs module)
C  cdisp - function codes
C  coord - axis codes
C  cpystr - option codes
C  da1 - function codes
C  da2 - function codes
C  dcs - function codes
C  ffopen - modes
C  frtyp - record types
C  (careful - used in computed goto's)
C  ftran - function codes
C  undo - function codes
C  utty - function codes
C  codes returned by keypad function
C  character types
C  composites
C  CTKEY  = CTALPHA + CTNUM + CTHYPH
C  CTFILE = CTALPHA + CTNUM + CTDOT + CTSLASH + CTCOLON
C  colors - temporarily all white
C  screen dimensions (pixels)
C  displays in area 3
C  must match showtab in gm
C  maximum mosaic dimensions
C  dimensions of mosaic display window
C  quan to subtract from char to get fmat/fmatc subscript
C  lowest, highest, number of characters in VK100 font
C  number of loadable fonts in VK100
C  character definitions
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C  character definitions
C 	include logdef
C offset for logical file numbers
C ffcls - close file
C  lfn: logical file #
      subroutine ffcls ( lfn )
      implicit integer ( a - z )
C 	include logcom
      u = lfn + 30
C compute unit #
      close ( unit = u )
C close the file
C 	LOGSTAR 'ffcls>', lfn, u
C 	call dmpstr	# dump string table
      end
C ffdel - delete file
C  sno: string # of filename
      subroutine ffdel ( sno )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C 	include logcom
      logical openf
      err = - 1
      p = sx ( sno )
C get sv subscript
      call pflnm ( p , 0 , 0 )
C parse filespec
C 	LOGSTAR 'ffdel>', sno, err
C 	call putarg (fname)
      if(.not.( .not. openf ( 20 , fname , 0 ) ))goto 23000
      goto 200
C open file
C  then, delete it as it's closed
C 	LOGIF	write (LOGTTOUT, 143);	143 format (' good open prior to delete!')
23000 continue
      close ( unit = 20 , dispose ='DELETE' , err = 200 )
C 	LOGIF	write (LOGTTOUT, 243);	243 format (' good delete!')
      err = 0
200   continue
C 	LOGSTAR 'ffdel+', sno, err
C 	call putarg (fname)
      end
C ffgc - get next character from file
C  lfn: logical file # (file must be open with mode FOREADC)
C  returns character or -1 for eof
      integer function ffgc ( lfn )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C 	include logcom
      continue
23002 if(.not.( . true . ))goto 23003
C 	LOGSTAR 'ffgc>', fptr, frec(fptr)
      ch = frec ( fptr )
      fptr = fptr + 1
C get char from buffer
      if(.not.( ch .ne. 0 ))goto 23004
C if non-zero, give to caller
      ffgc = ch
      return
23004 continue
      u = lfn + 30
C compute unit #
C 	read(u,100,end=200) len, (frec(i),i=1,FRECN)	#get record from file
C 	100 format(q, FRECN CHARFORMAT)
      len = 150 - 1
      read ( u , 100 , end = 200 ) ( frec ( i ) , i = 1 , 150 )
C get record from file
100   format ( 150 r1 )
C 	LOGSTAR 'ffgc-read:', len, FRECN
C 	call putarg (frec)
      if(.not.( len .ge. 150 ))goto 23006
      call pdiag ( 19 )
23006 continue
C @19 input record truncated
      continue
       i = min0 ( len , 150 - 2 )
23008 if(.not.(i.gt.0))goto 23010
C remove trailing spaces
      if(.not.( frec ( i ) .ne. 32 ))goto 23011
      goto 23010
23011 continue
23009 i=i-1
      goto 23008
23010 continue
      frec ( i + 1 ) = 10
C  RJF - assume a newline
      frec ( i + 2 ) = 0
      fptr = 1
C reset pointer to start of rec
      goto 23002
23003 continue
200   ffgc = - 1
C end-of-file
      end
C ffopen - open file
C  lfn:  logical file #
C  sno:  string # of file name
C  mode:	FOREAD  - read access
C 	FOREADC - read access, using ffgc (1 character at a time)
C 		  NOTE: only one file can be open in FOREADC mode
C 			at any given time
C 	FOCREAT - creating new file, write access
C  returns 0 successful open, 1 open failed
      integer function ffopen ( lfn , sno , mode )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C 	include logcom
      integer acc
C access ("openf" code)
      logical openf
      p = sx ( sno )
C get sv subscript
C 	LOGSTAR 'ffopen>', lfn+LFU, lfn, sno, mode, p, ffopen
C 	call putarg (sv(p))
C 	call putarg (fname)
      call pflnm ( p , 0 , 0 )
C set up fname, fdev
C 	LOGSTAR 'ffopen+', lfn+LFU, lfn, sno, mode, p, ffopen
C 	call putarg (fname)
C all set, now open the file
      if(.not.( mode .eq. 2 ))goto 23013
      acc = 1
      goto 23014
23013 continue
      acc = 2
23014 continue
      if(.not.( mode .eq. 1 ))goto 23015
C set up context for ffgc
      fptr = 1
C initialize index to frec
      frec ( 1 ) = 0
C set buffer empty
23015 continue
      u = lfn + 30
C compute unit # from lfn
      if(.not.( .not. openf ( u , fname , acc ) ))goto 23017
      goto 100
23017 continue
      crec ( lfn ) = 0
C record # = start of file
      ffopen = 0
      return
100   ffopen = 1
C failed
C 	LOGSTAR 'ffopen-', lfn+LFU, lfn, sno, mode, p, ffopen
C 	call putarg (fname)
      end
C ffread - read record from file into SNUST
C  lfn: logical file #
C  rec: record # to read, or 0 to read next record
C  returns record number just read, or 0 if end-of-file
      integer function ffread ( lfn , rec )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
      r = 1
C assume want current record
      u = lfn + 30
C compute unit #
      if(.not.( rec .ne. 0 ))goto 23019
      if(.not.( rec .le. crec ( lfn ) ))goto 23021
      call ffrew ( lfn )
23021 continue
C rewind if beyond req
      r = rec - crec ( lfn )
C compute # of records to read
23019 continue
      ffread = 0
C assume eof
      continue
23023 continue
C loop once per record
      r = r - 1
C 	read(u,100,end=200) len, (sv(iuptr+i),i=0,IRECSZ-1)
C 	100 format(q, IRECSZ CHARFORMAT)
      len = 100 - 1
      read ( u , 100 , end = 200 ) ( sv ( iuptr + i ) , i = 0 , 100 - 1 
     *)
100   format ( 100 r1 )
      if(.not.( len .ge. 100 ))goto 23026
      call pdiag ( 19 )
C remove trailing spaces
23026 continue
      continue
       i = 100 - 1
23028 if(.not.(sv(iuptr+i).eq.32.and.i.ge.0))goto 23030
      sv ( iuptr + i ) = 0
23029 i=i-1
      goto 23028
23030 continue
      crec ( lfn ) = crec ( lfn ) + 1
C count it
23024 if(.not.( r .le. 0 ))goto 23023
23025 continue
      ffread = crec ( lfn )
C return record # to caller
200   continue
C eof
      end
C ffrenm - rename a file
C  old: string # of old filename
C  new: string # of new filename
C  returns 0 if successful, else -1
      integer function ffrenm ( old , new )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C 	include logcom
      integer oldn ( 50 )
      logical openf
C 	character recbuf (IRECSZ)
C 	LOGSTAR 'ffrenm>', old, new
C 	call putarg (sv(sx(old)))
C 	call putarg (sv(sx(new)))
      ffrenm = - 1
C assume failed
      p = sx ( old )
C get sv subscript
      call pflnm ( p , 0 , 0 )
C pack old filespec
      call scopy ( fname , oldn )
C save device, name
      p = sx ( new )
C get sv subscript
      call pflnm ( p , 0 , 0 )
C pack new filespec
C 	LOGSTAR 'ffrenm+', old, new, ffrenm
C 	call putarg (fname)
C 	call putarg (oldn)
      if(.not.( .not. openf ( 20 , oldn , 0 ) ))goto 23031
      goto 200
C open under old name
C  on TOPS20, can rename file just by closing with new name
C 	LOGIF	write (LOGTTOUT, 143) pcknam;	143 format (' new name=' a)
23031 continue
      close ( unit = 20 , file = pcknam , err = 200 )
C 	LOGIF	write (LOGTTOUT, 243);	243 format (' good rename!')
C  for VMS and RSTS, we copy file to a new file of same name (for now)
C 	if (!openf (21, fname, NEWFILE))	goto 190
C 	repeat
C 	{	read (20, 100, err=190, end=150) l, (recbuf(i), i=1, min0(l,IRECSZ))
C 		write (21, 110, err=190) (recbuf(i), i=1, min0(l,IRECSZ))
C 		if (l > IRECSZ)
C 			call pdiag(19)
C 		100 format (q, IRECSZ CHARFORMAT)
C 		110 format (LISTSS  IRECSZ CHARFORMAT)
C 	}
150   ffrenm = 0
C successful
C 	190 close (unit=21, err=195)
C 	195 close (unit=20, err=200, dispose='DELETE')
200   continue
C 	LOGSTAR 'ffrenm++', old, new, ffrenm
      end
C ffrew - rewind file
C  lfn: logical file #
      subroutine ffrew ( lfn )
      implicit integer ( a - z )
C 	include logcom
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
      u = lfn + 30
C compute unit # from lfn
      rewind u
C rewind it
      crec ( lfn ) = 0
C reset pointer
C 	LOGSTAR 'ffrew>', lfn, u
      end
C ffwrt - write record in SNUST to font file
C  lfn: logical file #
      subroutine ffwrt ( lfn )
      implicit integer ( a - z )
C 	include logcom
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
      i = 0
      continue
23033 if(.not.( sv ( iuptr + i ) .ne. 0 ))goto 23034
      i = i + 1
      goto 23033
23034 continue
C find end of string
      u = lfn + 30
C compute unit #
      write ( u , 100 ) ( sv ( iuptr + i1 ) , i1 = 0 , i - 1 )
C write string to file
100   format ( 255 r1 )
C 	LOGSTAR 'ffwrt>', lfn, u
C 	call putarg (sv(iuptr))
      end
C fillsa - hack to fill string arrays sv and sx
      subroutine fillsa
      implicit integer ( a - z )
C this subroutine is no longer necessary because sv and sx
C are now initialized by the BLOCK DATA subprogram in GB
C 	include logcom
C 	logical openf
C 	stringdcl  cec CELOG.CTL
C 	stringdcl  cel CE.LOG
C 	stringdata cec CELOG.CTL
C 	stringdata cel CE.LOG
C 	data logsw /.false./
C 	logsw = .false.
C 	if (openf(20, cec, READONLYFILE))
C 	{	read (20,*) logsw	# read logging control flag
C 		close (unit=20)
C 	}
C 	if (logsw)
C 		if (!openf(LOGTTOUT, cel, NEWFILE+FORTRANCC))
C 			stop 'CE -- cannot open log file'
      end
C pflnm - parse a filespec
C   Functions:
C    1) call pflnm(pptr,0,0)
C 	Called during command line scan to check syntax of filespec
C 	and get the parsing pointer (pptr) past the filespec
C    2) call pflnm(saved-pptr,save-string#,type-string#)
C 	Called after command line scan to save the filespec in a
C 	permanent string for later use
C    3) call pflnm(sv-index-to-start-of-save-string,0,0)
C 	Called to dissect the filespec (saved by step 2) into the
C 	components (fdev and fname) that can be passed to the monitor;
C 	these calls will originate within the go or so module
C  p:	sv subscript pointing to start of filespec
C 	updated to point to character following filespec
C  sav:	string # where a copy of the filespec is to be placed
C 	or 0 for no copy
C  typ:	string # of default file type (including ".")
C 	ignored if sav == 0
C  returns 0 successful parse; values in gocom/socom
C 		fdev:  device name
C 		fname: file name.type
C 		(in VMS/RSTS version, fname contains full file spec)
C 	  -1 parse failed, diagnostic message typed
      integer function pflnm ( p , sav , typ )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C max # of characters per record in FOREADC mode
C max # of characters per file spec
      common / gocom /  crec ( 5 ) , fptr , fname , frec
C lfn -> number of last record read from file
C sv subscript for indexing SNFREC
C dev:name.typ of filespec, parsed by pflnm
C record read from file
      integer crec , fptr
      integer fname ( 50 )
C unpacked file name; used in calls to "openf"
      integer frec ( 150 )
      common / gocom / pcknam
      real * 8 pcknam
C packed file name (for TOPS20)
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C 	include logcom
      logical typf
C .true. = file type seen
      logical indir
C .true. = in directory brackets
      pflnm = - 1
C assume failure
C 	LOGSTAR 'pflnm>', p, sav, typ, pflnm
C 	call putarg (sv(p))
      if(.not.( sv ( p ) .eq. 63 ))goto 23035
C want help?
      call pdiag ( 127 )
C yes	#@127 Filespec
      return
C error return
23035 continue
      fname ( 1 ) = 0
C tie off old string
      typf = . false .
C no type seen yet
      indir = . false .
C not in directory brackets
      icolon = - 1
      i = 0
C length of filespec
      continue
23037 if(.not.( . true . ))goto 23038
C loop once per character
      ch = sv ( p )
C get a character
      if(.not.( ch .eq. 0 ))goto 23039
      goto 23038
C end of string
23039 continue
      if(.not.( ch .eq. 58 ))goto 23041
      icolon = i
23041 continue
      if(.not.( ch .eq. 91 .or.  ch .eq. 60 ))goto 23043
C are we in directory name?
      indir = . true .
C yes
      goto 23044
23043 continue
      if(.not.( ch .eq. 93 .or.  ch .eq. 62 ))goto 23045
      indir = . false .
23045 continue
23044 continue
C no, not in directory
      if(.not.( ch .eq. 46 ))goto 23047
      typf = ( .not. indir )
C  type seen if dot is outside of dir name
C is character part of device, filename, or filetype?
23047 continue
      if(.not.( iand ( ctype ( p ) , 1 + 2 ) .ne. 0 .or.  ch .eq. 46 .or
     *.  ch .eq. 91 .or.  ch .eq. 93 .or.  ch .eq. 45 .or.  ch .eq. 60 .
     *or.  ch .eq. 62 .or.  ch .eq. 44 .or.  ch .eq. 58 .or.  ch .eq. 59
     * ))goto 23049
C yes
      p = p + 1
C bump input pointer
      i = i + 1
C count the character
      if(.not.( i .gt. 50 - 1 ))goto 23051
      goto 100
23051 continue
C check if too long
      fname ( i ) = ch
C copy character to array
      fname ( i + 1 ) = 0
C always terminated
      goto 23050
23049 continue
      goto 23038
C other characters terminate loop
23050 continue
C reached end of filespec
      goto 23037
23038 continue
      if(.not.( i .eq. 0 ))goto 23053
      goto 100
23053 continue
C missing filespec
      if(.not.( ch .ne. 32 .and. ch .ne. 0 ))goto 23055
      goto 100
C space or eol must follow filespec
C filespec is legal; if the user didn't give a file type, supply default
23055 continue
      if(.not.( ( .not. typf ) .and. typ .ne. 0 ))goto 23057
C was filetype specified?
      call scopy ( sv ( sx ( typ ) ) , fname ( length ( fname ) + 1 ) )
23057 continue
C if not, default
      if(.not.( sav .ne. 0 ))goto 23059
C saving filespec?
      call scopy ( fname , sv ( sx ( sav ) ) )
23059 continue
      encode ( 10 , 200 , pcknam ) ( fname ( i ) , i = icolon + 2 , leng
     *th ( fname ) )
200   format ( 10 r1 )
      pflnm = 0
C success
C 	LOGSTAR 'pflnm+', p, sav, typ, pflnm
C 	call putarg (fname)
      return
C syntactical error detected during filespec parse -- error return
100   call pdiag ( 126 )
C @126 Filespec illegal or missing
C 	LOGSTAR 'pflnm-', p, sav, typ, i, ch+0, pflnm
C 	call putarg (fname)
      end
C  read1 - read a line from the terminal into SNINP
C 	 the CR and/or LF at the end is replaced by a null
C  sno: prompt string, or 0 if no prompt
      subroutine read1 ( sno )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
      integer sv ( 4000 )
      integer sx ( 150 )
      common / gscom /  iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
C 		include logcom
C 	include ttecho
      s = sno
      if(.not.( s .eq. 0 ))goto 23061
      s = 1
C check for no prompt
23061 continue
      call macrd1 ( sv ( sx ( s ) ) , sv ( sx ( 2 ) ) )
C call assembler routine
      pptr = sx ( 2 )
C 	call pflush
C 	DEBUG		LOGSTAR
C 	p = sx(s)
C 	call putln ( sv(p), length(sv(p)) )	# prompt
C 	DEBUG		LOGSTAR 'read1 prompt>', s, sx(s)
C 	DEBUG		call putarg (sv(p))
C 	p = sx(SNINP)
C 	pptr = p					#init pptr
C 	repeat
C 	{
C 		if (echosw)
C 			i = getlnec (sv(p), 100)	# get line
C 		else
C 			i = getlnne (sv(p), 100)
C 		p = p + i
C 		if (sv(p-1) == CTLZ)
C 			stop 'CE -- end of input stream (control-Z)?'
C 	}
C 		until (sv(p-1) == CR)		# gather til CR
C 	DEBUG		LOGSTAR 'read1>', sno, pptr, p, p-pptr
C 		call putarg (sv(pptr))
C 	sv(p-1) = EOS
      end
C  dmpstr -- dump the string table to a file for debugging purposes
      subroutine dmpstr
C 	implicit integer (a-z)
C 	include logcom
C 	include gscom
C 	logical openf
C 	integer dmplun
C 	dmplun = LOGTTOUT+1
C 	LOGSTAR 'dmpstr>'
C 	LOGIF
C 	{	if (openf (dmplun, 'DMPSTR.LOG', NEWFILE))
C 		{
C 			do i=1, SVMAX
C 				if ( (sv(i) & \177) == 27)
C 					sv(i) = TILDE | \200	# change escapes to tildes
C 			do i=1, SXMAX
C 			{
C 	NOTTOPS20		write (dmplun,*) 'string entry #', i, sx(i)
C 				if (sx(i) < 1 | sx(i) > SVMAX)	next	# out of range index
C 	
C 				lensvi = length (sv(sx(i)))
C 	NOTTOPS20		write (dmplun,*) 'length=', lensvi
C 				lensvi = min (SVMAX-sx(i), lensvi)
C 				write (dmplun,100) (sv(j), j=sx(i), sx(i)-1+lensvi)
C 				100 format (LISTSS  255a1)
C 			}
C 			for (i=1 ; i < SVMAX ; i=i+length(sv(i))+1)
C 			{
C 				if (sv(i) != 0)
C 				{
C 	NOTTOPS20			write (dmplun,*) 'starting at sv #', i, length(sv(i))
C 					call putstr (dmplun, sv(i), LISTSSV)
C 				}
C 			}
C 			do i=1, SVMAX
C 				if ( (sv(i) & \177) == TILDE & sv(i) != TILDE)
C 					sv(i) = ESCAPE	# change tildes back to escapes
C 			close (unit=dmplun)
C 			LOGSTAR 'dmpstr--done'
C 		}
C 	}
C 	return
      end