Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/sp.for
There are no other files named sp.for in the archive.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sp> Command prompting and parsing
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches from RATLIB
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 number of string indices
C important string indices (see ss module)
C coord - axis codes
C cpystr - option codes
C dcs - function codes
C ffopen - modes
C ffopen - logical file numbers
C utty - function codes
C codes returned by keypad function
C parameter codes
C screen areas
C column number of text in aea 2
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C legal filename characters are defined in pflnm (sp module)
C colors
C maximum time between slides
C screen dimensions (pixels)
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
C chkeol - skip blanks and return 1 iff end-of-line
integer function chkeol ( dum )
implicit integer ( a - z )
chkeol = 0
if(.not.( pskip ( 4 ) .eq. 8 ))goto 23000
chkeol = 1
23000 continue
end
C ctype - classify character
C svp: subscript of sv where character lives
integer function ctype ( svp )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
ctype = 0
ch = sv ( svp )
C get character
if(.not.( ch .ge. 48 .and. ch .le. 57 ))goto 23002
ctype = 2
23002 continue
if(.not.( ( ch .ge. 97 .and. ch .le. 122 ) .or. ( ch .ge. 65 .and.
* ch .le. 90 ) ))goto 23004
ctype = 1
23004 continue
if(.not.( ch .eq. 32 ))goto 23006
ctype = 4
23006 continue
if(.not.( ch .eq. 45 ))goto 23008
ctype = 16
23008 continue
if(.not.( ch .eq. 63 ))goto 23010
ctype = 128
23010 continue
if(.not.( ch .eq. 0 ))goto 23012
ctype = 8
23012 continue
end
C helpcr - restore carriage for help
C nlf is # of line feeds
subroutine helpcr ( nlf )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
hline = hline + nlf
C compute new line #
call postc ( hline * 80 + 42 )
C position cursor
end
C helpx - preparation for giving help
C sno is help message
subroutine helpx ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
call clr ( 2 , - 2 )
C clear help area
hline = 0
C set to top of area 2
call helpcr ( 0 )
C position text-mode cursor
call pr0 ( sno )
C write help string
end
C keypad - check input for one of the keypad or arrow characters
C pptr must be pointing to start of SNINP
C returns -1 if no match, else KPxxx (see sdef)
integer function keypad ( dum )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
integer ch , kpc ( 23 )
C should be character
data kpc ( 1 ) , kpc ( 2 ) , kpc ( 3 ) , kpc ( 4 ) , kpc ( 5 ) / 1
*12 , 113 , 114 , 115 , 116 /
data kpc ( 6 ) , kpc ( 7 ) , kpc ( 8 ) , kpc ( 9 ) , kpc ( 10 ) /
*117 , 118 , 119 , 120 , 121 /
data kpc ( 11 ) , kpc ( 12 ) , kpc ( 13 ) , kpc ( 14 ) , kpc ( 15
*) / 77 , 109 , 108 , 110 , 80 /
data kpc ( 16 ) , kpc ( 17 ) , kpc ( 18 ) , kpc ( 19 ) , kpc ( 20
*) / 81 , 82 , 83 , 65 , 66 /
data kpc ( 21 ) , kpc ( 22 ) / 67 , 68 /
keypad = - 1
if(.not.( sv ( pptr ) .eq. 0 ))goto 23014
C RETURN ?
call read1 ( 0 )
C yes, eat the extra CR
C the VK100 sends in SC1 mode
keypad = 22
C tell caller what I got
return
23014 continue
if(.not.( sv ( pptr ) .eq. 27 .and. sv ( pptr + 1 ) .ne. 0 ))goto
*23016
ch = sv ( pptr + 2 )
C get identifying character
continue
keypad = 23 - 1
23018 if(.not.(keypad.ge.0))goto 23020
if(.not.( ch .eq. kpc ( keypad + 1 ) ))goto 23021
return
23021 continue
23019 keypad=keypad-1
goto 23018
23020 continue
23016 continue
end
C lower - convert uppercase to lowercase
integer function lower ( ch )
implicit integer ( a - z )
lower = ch
if(.not.( ch .ge. 65 .and. ch .le. 90 ))goto 23023
lower = ch + 97 - 65
23023 continue
end
C pdec - parse decimal number
C low,high: limits for number
integer function pdec ( low , high )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
pdec = - 1
C assume failure
if(.not.( pskip ( 4 ) .ne. 2 ))goto 23025
if(.not.( sv ( pptr ) .eq. 63 ))goto 23027
call pdiag ( 121 )
C @121 Decimal number between
call pr2 ( 122 , low , high )
C @122 %d and %d
goto 23028
23027 continue
call pdiag ( 123 )
23028 continue
C @123 Number missing
return
23025 continue
continue
ac = 0
23029 if(.not.(ctype(pptr).eq.2))goto 23031
if(.not.( ac .gt. 1000 ))goto 23032
ac = 32767
C defend against overflow
goto 23033
23032 continue
ac = ac * 10 + sv ( pptr ) - 48
23033 continue
23030 pptr=pptr+1
goto 23029
23031 continue
if(.not.( ctype ( pptr ) .eq. 1 ))goto 23034
call pdiag ( 120 )
C @120 Malformed number
return
23034 continue
if(.not.( ac .ge. low .and. ac .le. high ))goto 23036
pdec = ac
return
23036 continue
call pdiag ( 124 )
C @124 Number not between
call pr2 ( 122 , low , high )
end
C pdiag - type diagnostic message
C sno: string to be typed
subroutine pdiag ( sno )
implicit integer ( a - z )
call pdiag1 ( sno , 0 )
C no substitutions in string, I hope!
end
C pdiag1 - type diagnostic message with argument substitution
C sno: string to be typed
C arg: argument
subroutine pdiag1 ( sno , arg )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
if(.not.( . not . diagf ))goto 23038
C diagnostic given yet?
if(.not.( filcmd ))goto 23040
C no, command coming from a file?
call dcs ( 7 )
C yes
call pr0 ( 2 )
C display line from file
call dcs ( 8 )
C seek to diagnostic area
goto 23041
23040 continue
call dcs ( 4 )
23041 continue
C seek to tty-command diag area
call pr1 ( sno , arg )
C print string
diagf = . true .
C remember diagnostic given
23038 continue
end
C peol - parse end-of-line
C returns 0 OK, -1 bad
integer function peol ( dum )
implicit integer ( a - z )
peol = 0
if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23042
return
23042 continue
C OK if at eol
call pdiag ( 125 )
C @125 Garbage at end of line
peol = - 1
end
C pkey - parse a keyword using table
C sno: table string, of the form
C <entry>^<entry>^...^<entry>
C where <entry> is of the form: nnxxxxx
C nn is a two-digit decimal number associated with the entry
C xxxxx is a string beginning with (and possibly containing
C only) a keyword composed of CTKEY characters (sdef).
C Text beyond the keyword is ignored; it is
C used only for display when the user wants help.
C The user need type only enough characters of the keyword to
C identify it uniquely.
C returns keyword number upon successful parse, otherwise -1
C (getting this routine to work was a nontrivial exercise)
integer function pkey ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
pkey = - 1
C assume failure
ki = sx ( sno )
C pointer to scan keyword table
if(.not.( iand ( pskip ( 4 ) , 19 ) .eq. 0 ))goto 23044
C non-keyword
if(.not.( sv ( pptr ) .eq. 63 ))goto 23046
goto 100
23046 continue
C wants help
call pdiag ( 128 )
C @128 Keyword expected
return
C loop: one iteration per table entry
23044 continue
continue
23048 continue
p = pptr
C get copy of pointer to input
kin = ( sv ( ki ) - 48 ) * 10 + sv ( ki + 1 ) - 48
C keyword #
ki = ki + 2
C move past keyword #
C loop: compare this keyword against input
continue
23051 continue
if(.not.( iand ( ctype ( p ) , 19 ) .eq. 0 ))goto 23054
C end of input
if(.not.( pkey .ge. 0 ))goto 23056
C check for ambiguity
call pdiag ( 129 )
C @129 Ambiguous
pkey = - 1
return
23056 continue
pkey = kin
C found a match
goto 23053
C still scanning user's input
23054 continue
if(.not.( iand ( ctype ( ki ) , 19 ) .eq. 0 ))goto 23058
goto 23053
C input > keywd
23058 continue
uch = sv ( p )
C convert to integer data type
diff = sv ( ki ) - lower ( uch )
C check if still matching
ki = ki + 1
p = p + 1
23052 if(.not.( diff .ne. 0 ))goto 23051
23053 continue
C if different, abort comparison
C find next keyword in table (or end of table)
continue
23060 continue
ch = sv ( ki )
ki = ki + 1
23061 if(.not.( ch .eq. 94 .or. ch .eq. 0 ))goto 23060
23062 continue
23049 if(.not.( ch .eq. 0 ))goto 23048
23050 continue
if(.not.( pkey .eq. - 1 ))goto 23063
call pdiag ( 64 )
C @64 Unrecognized keyword
goto 23064
23063 continue
call pskip ( 19 )
23064 continue
C get scanner past the input keyword
return
C give user help
100 call helpx ( 61 )
C @61 Legal keywords (V1.00):
call helpcr ( 1 )
C return carriage
continue
23065 continue
C one iteration per kwyword
uptr = iuptr
C init pointer to copy of keyword
ki = ki + 2
C skip nn at beginning of entry
ch = sv ( ki )
C get 1st char of keyword
continue
23068 if(.not.( ch .ne. 0 .and. ch .ne. 94 ))goto 23069
sv ( uptr ) = ch
C copy char to ustr
uptr = uptr + 1
ki = ki + 1
ch = sv ( ki )
C get next char
goto 23068
23069 continue
sv ( uptr ) = 0
C tie off ustr
call helpcr ( 1 )
C get to next line
call pr0 ( 6 )
C write it out
ki = ki + 1
C move past uparrow
23066 if(.not.( ch .eq. 0 ))goto 23065
23067 continue
call pdiag ( 1 )
C set diagf
end
C prdtty - prompt, read tty string into SNINP, initialize pptr for scan
C sno: prompt string
subroutine prdtty ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
call dcs ( 3 )
C position cursor
call dcs ( 6 )
C restore original TM
call read1 ( sno )
C read until CR
diagf = . false .
C enable printing of diagnostics
filcmd = . false .
C remember command came from the terminal
call dcs ( 5 )
C put VK100 in ANSI mode
call dcs ( 4 )
C clear diagnostic area
end
C pskip - skip to the next character not of the specified type(s)
C and return its type
C typ: logical OR of types to skip
C returns type of following character
integer function pskip ( typ )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
continue
23070 if(.not.( . true . ))goto 23071
i = ctype ( pptr )
C get character type
pskip = i
if(.not.( iand ( i , typ ) .eq. 0 ))goto 23072
goto 23071
23072 continue
pptr = pptr + 1
C next char
goto 23070
23071 continue
end
C ptagob - parse tray-file tag or record number
C or parse object name
C func: 0 tag/recnumber, 1 objectname
C sno: string to receive tag or objectname (see 0 return below)
C returns -1 parse failed
C 0 tag or objectname parsed, copied into caller's string
C n record # parsed, n is record #
integer function ptagob ( func , sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
ptagob = - 1
i = pskip ( 4 )
C get character type
if(.not.( i .eq. 128 ))goto 23074
C want help?
call pdiag ( 68 + func )
C @68 Record number or tag in tray file
C @69 Object name, 1 to 10 alphanumeric characters
return
23074 continue
if(.not.( i .eq. 1 ))goto 23076
C tag
d = sx ( sno )
C set up pointer to return string
n = 0
C length
ptagob = 0
C returning string
continue
23078 if(.not.( iand ( ctype ( pptr ) , 1 + 2 ) .ne. 0 ))goto 23079
C scan it
n = n + 1
C count length
if(.not.( n .gt. 10 ))goto 23080
goto 100
23080 continue
C too long
sv ( d ) = sv ( pptr )
C copy char to destination
d = d + 1
pptr = pptr + 1
sv ( d ) = 0
C tie it off
goto 23078
23079 continue
return
23076 continue
if(.not.( func .eq. 0 .and. i .eq. 2 ))goto 23082
C tag/rec# ?
ptagob = pdec ( 1 , 1000 )
C yes, parse it
return
C blew it
23082 continue
100 call pdiag ( 65 + func )
C @65 Illegal tag or record number
C @66 Illegal object name
ptagob = - 1
end
C ustpar - prepare file input for parsing:
C copy SNUST to SNINP, set pptr = ipptr, filcmd = .true.
subroutine ustpar
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
i = - 1
continue
23084 continue
i = i + 1
sv ( ipptr + i ) = sv ( iuptr + i )
C copy 1 character
23085 if(.not.( sv ( iuptr + i ) .eq. 0 ))goto 23084
23086 continue
C loop until eos
pptr = ipptr
C init scanning pointer
filcmd = . true .
C input came from a file
end