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