github.com/arnoldrobbins.qed-archive
1
0
Fork 0
mirror of synced 2026-05-03 14:58:46 +00:00
Code Issues Releases Wiki Activity

QED 12.5 for Multics

Browse Source
This commit is contained in:
Arnold D. Robbins
2014-11-22 19:32:04 +00:00
parent bb8bf891cc
commit 980bb84c95
19 changed files with 5916 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
multics/documentation/info_segments/qedx.errors.info Executable file
View File

@@ -0,0 +1,53 @@
09/21/87 qedx
Known errors in the current release of qedx.
# Associated TR's
Description
0016 phx17590 phx18344
If the user types an input/request line longer than 512 characters,
qedx will overwrite parts of the stack causing subsequent faults or
fatal process errors.
0011 phx16226
The "wake_tbl" tty_ mode, which causes the user's process to only
be awoken when a "\" is typed, is not reset if the current buffer
overflows (ie: exceeds 1044480 characters) during input.
0010 phx15534 phx15664
qedx should not create files whose names require the use of quoting
or special control arguments (eg: rename's "-name") as the
manipulation of such files pose severe problems for naive (and not
so naive) users. Thus, qedx should reject the use of whitespace,
command language characters ("()[];), starname characters (*?),
and equalname characters (=%) when creating a new file.
0009 phx15606
qedx ignores empty buffers when deciding whether to ask for permis-
sion to exit with modified buffers. However, the list of
modified buffers displayed in the query includes empty buffers.
Empty buffers should not be listed. This is a bug because a user
will not be able to reset the modified state of these buffers as
qedx does not allow the user to write an empty buffer but the
empty buffers will continue to be listed as long as there is one
non-empty, modified buffer.
0008 phx15457 phx19279
Given the following sequence of qedx requests:
r FILE
b(other) $a \b(0) \f
the text appended to buffer "other" will not contain the contents
of the file that was just read into buffer "0".
0007 phx15204 phx18060
Given the following sequence of requests in an empty buffer:
.r FILE
1p 1,$d
.r FILE
1p 1,$d
.r FILE
1p
the first read request will execute properly. However, the second
read request will insert a NUL at the beginning of the file as
seen by the print request. The third and subsequent read requests
will insert a newline at the beginning of the file.

332
multics/documentation/info_segments/qedx.info Executable file
View File

@@ -0,0 +1,332 @@
03/03/83 qedx, qx
Syntax: qx {-control_args} {macro_path} {macro_args}
Function: The qedx editor is used to create and edit ASCII segments.
This description summarizes the editing requests and addressing
features provided by qedx. Complete tutorial information on qedx is
available in the qedx Text Editor Users' Guide, Order No. CG40.
Arguments:
macro_path
specifies the pathname of a segment from which the editor is to take
its initial instructions. Such a set of instructions is commonly
referred to as a macro. The editor automatically concatenates the
suffix qedx to path to obtain the complete pathname of the segment
containing the qedx instructions. The editor executes the qedx
requests contained in the specified segment and then waits for you
to type further requests. If macro_path is omitted, the editor
waits for you to type a qedx request. The archive component
pathname convention (::) is accepted.
macro_args
are optional arguments that are appended, each as a separate line,
to the buffer named args (the first optional argument becomes the
first line in the buffer and the last optional argument becomes the
last line). Arguments are used in conjunction with a macro
specified by the macro_path argument.
Control arguments:
-pathname path, -pn path
causes qedx to read the segment specified by path into buffer 0,
simulating "r path", before executing a macro (see macro_path).
This control argument must precede macro_path. If no macro is
specified, the user is placed in the editor request loop. The
archive component pathname convention (::) is accepted.
-no_rw_path
prevents the user from making read (r) or write (w) requests with a
pathname. All read and write requests affect the pathname specified
by the -pathname control argument. The -no_rw_path control argument
is intended to be used within exec_coms which are providing a
limited environment; the user is prevented from examining or
altering segments other than the one specified with -pathname.
Notes: You can create and edit any number of segments with a single
invocation of the editor as long as the contents of the buffer are
deleted before work is started on each new segment.
Notes on addressing: Most editing requests are preceded by an address
specifying the line or lines in the buffer on which the request is to
operate. Lines in the buffer can be addressed by absolute line number;
relative line number, i.e., relative to the "current" line (+2 means
the line that is two lines ahead of the current line, -2 means the line
that is two lines behind); and context (locate the line containing /any
string between these slashes/). Current line is denoted by period (.);
last line of buffer, by dollar sign ($).
Notes on regular expressions: The following characters have
specialized meanings when used in a regular expression. A regular
expression is the character string between delimiters, such as in a
substitute request, or a search string. You can reinvoke the last used
regular expression by giving a null regular expression (//).
*
signifies any number (or none) of the preceding character.
^
when used as the first character of a regular expression, signifies
the (imaginary) character preceding the first character on a line.
$
when used as the last character of a regular expression, signifies
the (imaginary) character following the last character on a line.
.
matches any character on a line.
List of escape sequence requests:
\f
exits from input mode and terminates the input request; returns the
user in edit mode. It is used constantly when editing a document,
and is the key to understanding the difference between input mode
and edit mode.
\c
suppresses the meaning of the escape sequence or special character
following it.
\b(X)
redirects editor stream to read subsequent input from buffer X.
\r
temporarily redirects the input stream to read a single line from
your terminal.
Notes on requests: In the list given below, editor requests are
divided into four categories: input requests, basic edit requests,
extended edit requests, and buffer requests. The input requests and
basic edit requests are sufficient to allow a user to create and edit
segments. The extended requests give the user the ability to execute
commands in the Multics system without leaving the editor and also to
effect global changes. Because the extended requests are, in general,
more difficult to use properly, they should be learned only after
mastering the input and basic edit requests. The buffer requests
require a knowledge of auxiliary buffers. (Since the nothing and
comment requests are generally used in macros, they are included with
the buffer requests.) The buffer requests, used with any of the other
requests, and special escape sequences allow the user to make qedx
function as an interpretive programming language through the use of
macros.
The character given in parentheses is the actual character used to
invoke the request in qedx and does not always bear a relation to the
name of the request. The second part of each entry shows the format,
default in parentheses, and brief description. For the value of ADR,
see "Notes on Addressing" above; for the value of regexp, see "Notes on
Regular Expressions" above.
List of input requests:
These requests enter input mode and must be terminated with \f.
append (a)
ADRa (.a)
Enter input mode, append lines typed from the terminal after a
specified line.
change (c)
ADR1,ADR2c (.,.c)
Enter input mode, replace the specified line or lines with
lines typed from the terminal.
insert (i)
ADRi (.i)
Enter input mode, insert lines typed from the terminal before a
specified line.
List of basic edit requests:
delete (d)
ADR1,ADR2d (.,.d)
Delete specified line or lines from the buffer.
print (p)
ADR1,ADR2p (.,.p)
Print specified line or lines on the terminal; special case print
needs address only.
print-line-number (=)
ADR= (.=)
Print line number of specified line.
quit (q)
q exits the editor but first checks for modified buffers. If any
modified buffers are present, qedx will display their status and
ask for permission to exit. If permission is granted, all
changes made to those buffers since they were last written will
be lost.
quit-force (qf) (Q)
qf exits the editor without checking for modified buffers. If any
modified buffers are present, all changes made to those buffers
since they were last written will be lost.
read (r)
ADRr {path} ($r path)
appends the contents of the segment named path after the
specified line. The archive component pathname convention (::)
is accepted. If path is ommitted, a default pathname is used if
possible. See "Notes of default pathnames" below for more
information.
substitute (s)
ADR1,ADR2s/regexp/string/ (.,.s/regexp/string/)
substitute every string matching regexp in the line(s) with
string. If string contains &, & is replaced by the characters
which matched regexp. First character after s is delimiter; it
can be any character not in either regexp or string. Strings
matching regexp do not overlap and the result of substitution is
not rescanned.
write (w)
ADR1,ADR2w {path} (1,$w path)
writes the specified lines of the buffer into the segment named
path. The archive component pathname convention (::) is not
accepted. If path is ommitted, a default pathname is used if
possible; however, if the default pathname identifies an archive
component, an error message is printed. See "Notes on default
pathnames" below for more information.
List of extended edit requests:
execute (e)
e <command line>
passes the remainder of a request line to the Multics command
processor without leaving the qedx editor.
global (g)
ADR1,ADR2gX/regexp/ (1,$gX/regexp/)
perform operation on lines that contain a match for regexp; X can
be d for delete, p for print, or = for print line numbers.
exclude (v)
ADR1,ADR2vX/regexp/ (1,$vX/regexp/)
perform operation on lines that do not contain a match for
regexp; X can be d for delete, p for print, or = for print line
numbers.
List of buffer requests:
buffer (b)
b(X)
switches all subsequent editor operations to the specified
buffer X.
move (m)
ADR1,ADR2m(X) (.,.m(X))
move line(s) from current buffer into buffer named X; destroy
old contents of buffer X.
status (x)
x
prints a summary status of all buffers currently in use.
nothing (n)
ADRn (.n)
does not perform a task; addresses a line with no other action.
comment (")
ADR" (.")
ignores rest of line; used for comments.
Notes on default pathnames: qedx maintains a default pathname for each
buffer. This default pathname is used whenever a read (r) or write (w)
request is given without a pathname.
Initially, the default pathname for a buffer is null; ie: any attempt
to read or write without a pathname results in an error message.
Whenever a read request is issued with a pathname and the buffer is
empty, qedx saves that pathname as the default for the buffer.
Whenever, a write request is issued with a pathname which writes the
entire contents of the buffer (ie: no address range is given), qedx
saves that pathname as the default for the buffer.
If a read request is given when the buffer is not empty or a write
request is given which does not write the entire buffer, qedx will
consider the default pathname of that buffer to no longer be
trustworthy. The next use of the read or write requests without a
pathname in that buffer will cause qedx to ask for permission to use
the default pathname. If permission is given, qedx will once again
consider the pathname to be trustworthy.
For example, given the following sequence --
qedx
r first
r second
w
qedx will ask for permission to write the buffer to the segment named
"first" because the "r second" request was issued when the buffer was
not empty.
On the other hand, if the following sequence were given --
qedx
r first
<editing requests>
1,$d
r second
<editing requests>
w
qedx will write the buffer to the segment named "second" without asking
permission because the buffer was empty when the "r second" request was
given.
Notes on spacing: The following rules govern the use of spaces in
editor requests.
1. Spaces are taken as literal text when appearing inside of regular
expressions. Thus, /the n/ is not the same as /then/.
2. Spaces cannot appear in numbers, e.g., if 13 is written as 1 3, it
is interpreted as 1+3 or 4.
3. Spaces within addresses except as indicated above are ignored.
4. The treatment of spaces in the body of an editor request depends on
the nature of the request.
Responses from the editor: In general, the editor does not respond
with output on the terminal unless explicitly requested to do so (e.g.,
with a print or print line number request). The editor does not
comment when you enter or exit from the editor or change to and from
input and edit modes. The use of frequent print requests is
recommended for new users of the qedx editor. If you inadvertently
request a large amount of terminal output from the editor and wish to
abort the output without abandoning all previous editing, you can issue
the quit signal (by pressing the proper key on your terminal, e.g.,
BREAK, ATTN, INTERRUPT), and, after the quit response, you can reenter
the editor by invoking the program_interrupt (pi) command. This action
causes the editor to abandon its printout, but leaves the value of "."
as if the printout had gone to completion.
If an error is encountered by the editor, an error message is printed
on your terminal and any editor requests already input (i.e., read
ahead from the terminal) are discarded.
If you interrupt an invocation of qedx (eg: via use of the quit signal)
and invoke qedx again before using the "start", "program_interrupt", or
"release" commands, qedx will inform you that you have one or more
suspended invocations and ask if you wish to continue. If you answer
"?" to this query, qedx will print an explanation of the implications
of answering "yes" to this query along with our recommendation of the
proper response to this situation.
Notes on macro usage: You can place elaborate editor request sequences
(called macros) into auxiliary buffers and then use the editor as an
interpretive language. This use of qedx requires a fairly detailed
understanding of the editor. To invoke a qedx macro from command
level, you merely place your macro in a segment that has the letters
qedx as the last component of its name, then type:
! qedx macro_path macro_args
Notes on I/O switches: While most users interact with the qedx editor
through a terminal, the editor is designed to accept input through the
user_input I/O switch and transmit output through the user_output I/O
switch. These switches can be controlled (using the iox_ subroutine
described in the MPM Subroutines) to interface with other devices/files
in addition to the user's terminal. For convenience, the qedx editor
description assumes that the user's input/output device is a terminal.

350
multics/documentation/info_segments/qedx_.info Executable file
View File

@@ -0,0 +1,350 @@
02/07/83 qedx_
Syntax:
dcl qedx_ entry (ptr, fixed bin (35));
call qedx_ (qedx_info_ptr, code);
Function: provides a subroutine interface to the Multics qedx Editor
for use by subsystems wishing to edit arbitrary strings of ASCII text.
Arguments:
qedx_info_ptr
is a pointer to the qedx_info structure which defines the buffers
initially available in qedx_ along with other options. See "The
qedx_info structure" below. (Input)
code
is a standard system status code. See "List of status code" below.
(Output)
Notes:
The caller of qedx_ does not need to print an error message when a
non-zero status code is returned by the subroutine. Any appropriate
error messages will have already been printed by qedx_ itself. The
returned code is only intended to inform the caller of conditions
requiring further attention.
List of status codes:
0 editing completed successfully.
error_table_$unimplemented_version
qedx_ does not recognize the version of the qedx_info structure
supplied by the caller.
error_table_$fatal_error
an error occured during initialization of qedx_ which prevented the
user from performing any editing. The caller of qedx_ should abort
its execution.
error_table_$recoverable_error
one of several non-fatal conditions were detected upon exit from
qedx_. The exact condition is reflected to the caller in the
qedx_info structure (see below). The caller of qedx_ must decide
how to proceed after each of the possible conditions. (Eg: the
program may decide not to update the permanent copy of the data
being edited if the user exited via quit-force (qf).)
Notes on initial buffers:
The qedx_info structure defines the initial environment to be presented
to the user by qedx_. This environment includes an initial set of
buffers along with their contents and default pathnames. The contents
of these buffers can be read or written from the storage system, from
regions supplied by the caller (eg: the message in send_mail), or by
using a caller supplied procedure (eg: to read/write abbreviation
definitions). The caller may also request that the initial contents of
one or more of these buffers be executed as qedx requests before
reading the first request line from the user.
qedx_ always creates a buffer named "0" which it makes the current
buffer before executing any requests. If the initial buffers marked
for execution do not use the buffer (b) request to change the default
buffer, buffer "0" will remain the current buffer when the first
request line is read from the terminal.
Each initial buffer must have a default pathname. As part of
initialization, qedx_ will read the contents of the object specified by
this default pathname into the buffer. If the buffer is read and
written from the storage system, the default pathname must identify an
existing segment or archive component. If the buffer is read and
written from a caller supplied region, the default pathname may be
omitted but is normally used as comment to described the contents of
the buffer (eg: "<send_mail message>") as the data is read directly
from the caller's region. If the buffer is read and written by a
caller supplied procedure, the default pathname must identify an
existing object (eg: abbreviation definition) as defined by that
procedure.
For each initial buffer, the caller may specify whether or not the
default pathname of the buffer is locked. If the default pathname is
locked, use of the read (r) and write (w) requests with a pathname will
never change the default pathname of the buffer nor cause qedx_ to
consider the default pathname untrustworthy. (See "Notes on default
pathnames" in the description of the qedx command).
With a locked default pathname, use of the read and write requests
without a pathname will always read/write the original segment, region,
or whatever (when using the caller's I/O module) specified by the
caller of qedx_. In this case, use of the read request with a pathname
will simplly insert the contents of a segment into the buffer and use
of the write request with a pathname will simply make a copy of the
buffer in a segment for later use.
Locking the default pathname is useful in cases where it would be
difficult (if not impossible) for the user to reconstruct the default
pathname. For example, in send_mail, buffer "0" contains the message
being created. The default pathname in this case identifies the region
supplied by send_mail and there is no mechanism by which the user can
explicitly specify this default by a pathname. Therefore, send_mail
locks the default pathname to insure that the write (w) request without
a pathname will always update send_mail's copy of the message.
For each initial buffer which is being read and written from a caller
supplied region, the caller may request that qedx_ automatically write
the contents of the buffer into the region upon exit. If the user
exits qedx_ via the quit-force (qf) request, however, the automatic
write will be suppressed. If, when writing a buffer to the caller's
region, the buffer is too long to fit in that region, qedx_ will issue
a warning to the user and the buffer will be marked as truncated.
While still in qedx_, the user can make any necessary changes to the
buffer to shorten it sufficiently to fit within the caller's region.
If, on exit from qedx_, there are truncated buffers, the user will be
asked for permission to exit and actually truncate those buffers. Once
again, this query is suppressed if the quit-force request is used.
The qedx_info structure:
The qedx_info structure and the named constants referenced below are
defined in the qedx_info.incl.pl1 include file.
dcl 1 qedx_info aligned based (qedx_info_ptr),
2 header,
3 version character (8),
3 editor_name character (72) unaligned,
3 buffer_io entry (pointer, fixed binary (35)),
3 flags,
4 no_rw_path bit (1) unaligned,
4 query_if_modified bit (1) unaligned,
4 caller_does_io bit (1) unaligned,
4 quit_forced bit (1) unaligned,
4 buffers_truncated bit (1) unaligned,
4 pad bit (29) unaligned,
3 n_buffers fixed binary,
2 buffers (qedx_info_n_buffers refer (qedx_info.n_buffers)),
3 buffer_name character (16) unaligned,
3 buffer_pathname character (256) unaligned,
3 region_ptr pointer,
3 region_max_lth fixed binary (21),
3 region_initial_lth fixed binary (21),
3 region_final_lth fixed binary (21),
3 flags,
4 read_write_region bit (1) unaligned,
4 locked_pathname bit (1) unaligned,
4 execute_buffer bit (1) unaligned,
4 default_read_ok bit (1) unaligned,
4 default_write_ok bit (1) unaligned,
4 auto_write bit (1) unaligned,
4 truncated bit (1) unaligned,
4 pad bit (29) unaligned;
version
identifies the version of the qedx_info structure supplied by the
caller. It must have the value of the named constant
QEDX_INFO_VERSION_1. (Input)
editor_name
is the name to be used by qedx_ in error messages and queries.
(Eg: "send_mail (qedx)") (Input)
buffer_io
is only used if flags.caller_does_io is set and is the procedure to
be invoked by qedx_ to read/write buffers. See "Notes on buffer
I/O" below. (Input)
flags.no_rw_path
specifies whether any read (r) or write (w) request within qedx_ may
ever be given an explicit pathname. (Input)
flags.query_if_modified
specifies whether qedx_ should query when the quit (q) request is
issued and there are buffers which have been modified since they
were last written. Initial buffers with the buffers.auto_write flag
set are not considered as modified as they are always written before
exit. (Input)
flags.caller_does_io
specifies whether qedx_ should call the buffer_io procedure above or
perform I/O itself when reading/writing buffers. (Input)
flags.quit_forced
is set by qedx_ to "1"b to indicate that the user either used the
quit-force (qf) request or answered "yes" to the modified buffers
query in order to exit; it is set to "0"b to indicate that the user
used the quit (q) request and there were no modified buffers
present. (Output)
flags.buffers_truncated
is set by qedx_ to "1"b to indicate that the final contents of one
or more initial buffers were truncated on exit from qedx_. The
buffers which were truncated are marked by the buffers.truncated
flag. (Output)
n_buffers
is the number of initial buffers defined below. (Input)
buffers
defines the initial buffers available within this invocation of
qedx_. See "Notes on initial buffers" above.
buffers.buffer_name
is the name of this buffer. (Input)
buffers.buffer_pathname
is the initial default pathname for this buffer. (Input)
buffers.region_ptr
is a pointer to the region where qedx_ will read and write this
buffer if buffers.read_write_region is set. (Input)
buffers.region_max_lth
is the maximum number of characters which may be written into the
above region if buffers.read_write_region is set. (Input)
buffers.region_initial_lth
is the number of characters present in the caller's region on entry
to qedx_ if buffers.read_write_region is set. qedx_ will
automatically read the specified characters into the buffer. (Input)
buffers.region_final_lth
is set by qedx_ to the number of characters written into the
caller's region upon exit from qedx_ if bufers.read_write_region is
set. This value will be larger than buffers.region_max_lth if
buffers.truncated is set by qedx_. (Output)
buffers.read_write_region
specifies that qedx_ will use the caller's region to read/write the
contents of this buffer until the user changes the default pathname.
Use of this flag is incompatible with flags.caller_does_io. (Input)
buffers.locked_pathname
specifies that the default pathname of this buffer is locked and can
not be changed by read (r) or write (w) requests. (Input)
buffers.execute_buffer
specifies that the contents of this buffer should be executed as
qedx requests before reading requests from the user. (Input)
buffers.default_read_ok
specifies that the read (r) request can be given without a pathname
to read the current contents of the caller's region. This flag is
ignored if flags.read_write_region is not set or the default
pathname is not the caller's region. (Input)
buffers.default_write_ok
specifies that the write (w) request can be given without a pathname
to write the buffer to the caller's region. This flag is ignored if
flags.read_write_region is not set or the default pathname is not
the caller's region. (Input)
buffers.auto_write
specifies that the contents of this buffer will be written to the
caller's region on exit from qedx_ unless the user uses the
quit-force (qf) request or answers "yes" to the query to exit with
modified buffers. (Input)
buffers.truncated
is set by qedx_ to "1"b if the entire contents of the buffer could
not be written to the caller's region on exit from qedx_. (Output)
Notes on buffer I/O:
If flags.caller_does_io is set, qedx_ will invoke the caller supplied
buffer_io procedure in order to read and write the contents of any
buffer. qedx_ determines the pathname to which the buffer is to be
read or written; the interpretation of this pathname is the
responsibility of the caller's buffer_io procedure. (Eg: the procedure
may use the pathname as the name of an abbreviation whose definition is
to be read/written).
For a read (r) request, qedx_ supplies an I/O region into which the
buffer_io procedure should place the text copied from the object
designated by the pathname; qedx_ will then insert this text into its
proper place in the buffer. For a write (w) request, qedx_ copies the
text from the buffer into an I/O region; the buffer_io procedure should
then place this text into the object designated by the pathname.
The buffer_io procedure:
qedx_ invokes the buffer_io procedure as follows --
dcl buffer_io entry (ptr, bit(1) aligned);
call buffer_io (qedx_buffer_io_info_ptr, success);
Arguments--
qedx_buffer_io_info_ptr
is a pointer to the qedx_buffer_io_info structure describing the
read/write operation to be undertaken. (Input)
success
is set by the buffer_io procedure to "1"b if the operation was
successfull and to "0"b if it failed. (Output)
Notes--
It is the responsibilty of the buffer_io procedure to print any
appropriate error messages if the operation does not succeed.
The qedx_buffer_io_info structure:
The qedx_buffer_io_info structure and the named constants referenced
below are defined in the qedx_buffer_io_info.incl.pl1 include file.
dcl 1 qedx_buffer_io_info aligned based (qbii_ptr),
2 version character (8),
2 editor_name character (72),
2 pathname character (256) unaligned,
2 buffer_ptr pointer,
2 buffer_max_lth fixed binary (21),
2 buffer_lth fixed binary (21),
2 direction fixed binary,
2 flags,
3 default_pathname bit (1) unaligned,
3 pad bit (35) unaligned;
version
identifies the version of the qedx_buffer_io_info structure supplied
by qedx_. This version of the structure is given by the named
constant QEDX_BUFFER_IO_INFO_VERSION_1. (Output)
editor_name
is the name of the editor to be used by the buffer_io procedure in
any error messages and queries. (Input)
pathname
is the pathname to be read/written as determined by qedx_. (Input)
buffer_ptr
is a pointer to the I/O buffer allocated by qedx_. When reading
from the pathname, the buffer_io procedure must place the text into
this buffer; when writing to the pathname, the buffer_io procedure
must take the text from this buffer. (Input)
buffer_max_lth
is the maximum size of the I/O buffer. This value is only used when
reading from the pathname and specifies a limit on the amount of
text which may be returned by the buffer_io procedure. (Input)
buffer_lth
is the length of the text read/written from the pathname. When
reading from the pathname, the buffer_io procedure must set this
value to the number of characters read from the pathname and placed
in the I/O buffer. (Output) When writing to the pathname, this
value is set by qedx_ to the number of characters to be written into
the pathname. (Input)
direction
specifies the operation to be undertaken. If it has the value of
the named constant QEDX_READ_FILE, the text is to be read from the
pathname and placed into the I/O buffer. It is has the value of the
named constant QEDX_WRITE_FILE, the text is to be written from the
I/O buffer into the pathname. (Input)
flags.default_pathname
is "1"b if the pathname supplied above by qedx_ is the default
pathname of the buffer being read/written. (Input)

55
multics/documentation/subsystem/bce/qedx.info Executable file
View File

@@ -0,0 +1,55 @@
04/05/85 qedx, qx
Syntax as a command: qx {-control_args} {macro_path} {macro_args}
Function: invokes the qedx text editor to edit a BCE file system file.
All requests of the standard Multics qedx editor are supported except
for the "e" request. For complete information, see the description of
qedx in the Multics Commands and Active Functions manual, Order No.
AG92. This command is valid at all BCE command levels.
Arguments:
macro_path
specifies the pathname of a segment from which the editor is to take
its initial instructions. Such a set of instructions is commonly
referred to as a macro. The editor automatically concatenates the
suffix "qedx" to macro_path to obtain the complete pathname of the
segment containing the qedx instructions.
macro_args
are optional arguments that are appended, each as a separate line,
to the buffer named "args" (the first optional argument becomes the
first line in the buffer and the last optional argument becomes the
last line). Arguments are used in conjunction with a macro
specified by the macro_path argument.
The editor executes the qedx requests contained in the segment
selected and then waits for you to type further requests. If
macro_path is omitted, the editor waits for you to type a qedx
request.
Control arguments:
-no_rw_path
prevents the user from making read (r) or write (w) requests with a
pathname. All read and write requests for buffer 0 affect the
pathname specified by the -pathname control argument. The
-no_rw_path control argument is intended to be used within exec_coms
which are providing a limited environment; the user is prevented
from examining or altering segments other than the one specified
with -pathname.
-pathname path, -pn path
causes qedx to read the segment given by path into buffer 0,
simulating "r path," before executing a macro (see macro_path).
This control argument must precede macro_path. If no macro is
specified, the user is placed immediately in the editor request
loop.
Notes: Complete tutorial information on qedx is available in the qedx
Text Editor User's Guide, Order No. CG40.

26
multics/documentation/subsystem/linus/qedx.info Executable file
View File

@@ -0,0 +1,26 @@
09/06/83 qedx, qx
Syntax: qedx {-control_args}
Function: Invokes the qedx editor with the current query, or a new
query. The edited query becomes the current query if the changes are
saved before terminating qedx.
Control Arguments:
-new
specifies that qedx should be given an empty buffer when it is
invoked.
-old
specifies that the existing query should be made available for
editing with qedx (DEFAULT).
Notes:
The user must write the changed query for it to become the current
query.

28
multics/library_dir_dir/include/qedx_buffer_io_info.incl.pl1 Executable file
View File

@@ -0,0 +1,28 @@
/* BEGIN INCLUDE FILE ... qedx_buffer_io_info.incl.pl1 */
/* Created: January 1983 by G. Palter */
/* Data structure used by qedx_ to invoke the caller's buffer_io procedure to read/write all or part of an editor buffer
to the specified "file" */
dcl 1 qedx_buffer_io_info aligned based (qbii_ptr),
2 version character (8),
2 editor_name character (72), /* for error messages */
2 pathname character (256) unaligned, /* pathname of "file" to be read/written */
2 buffer_ptr pointer, /* -> the buffer to write/read */
2 buffer_max_lth fixed binary (21), /* read: maximum size of above buffer; write: ignored */
2 buffer_lth fixed binary (21), /* read: amount of data read into buffer from the "file";
write: amount of data to write into the "file" */
2 direction fixed binary, /* whether to read/write */
2 flags,
3 default_pathname bit (1) unaligned, /* ON => pathname above is the default for this buffer */
3 pad bit (35) unaligned;
dcl qbii_ptr pointer;
dcl QEDX_BUFFER_IO_INFO_VERSION_1 character (8) static options (constant) initial ("qbii_001");
dcl (QEDX_READ_FILE initial (1), /* read data from the "file" */
QEDX_WRITE_FILE initial (2)) /* write data into the "file" */
fixed binary static options (constant);
/* END INCLUDE FILE ... qedx_buffer_io_info.incl.pl1 */

46
multics/library_dir_dir/include/qedx_info.incl.pl1 Executable file
View File

@@ -0,0 +1,46 @@
/* BEGIN INCLUDE FILE ... qedx_info.incl.pl1 */
/* Created: January 1983 by G. Palter */
/* Data structure which supplies input/output arguments to qedx_ subroutine */
dcl 1 qedx_info aligned based (qedx_info_ptr),
2 header, /* allows use of like to build automatic version */
3 version character (8),
3 editor_name character (72) unaligned,
3 buffer_io entry (pointer, bit (1) aligned), /* procedure invoked to read/write an editor buffer */
3 flags,
4 no_rw_path bit (1) unaligned, /* ON => no r/w may use a pathname and R/W are illegal */
4 query_if_modified bit (1) unaligned, /* ON => query on exit if modified buffers exist */
4 caller_does_io bit (1) unaligned, /* ON => caller does actual work of read/write requests */
4 quit_forced bit (1) unaligned, /* set ON => user used Q or asked to punt modified buffers */
4 buffers_truncated bit (1) unaligned, /* set ON => some editing lost when written */
4 pad bit (29) unaligned,
3 n_buffers fixed binary, /* # of buffers supplied by caller */
2 buffers (qedx_info_n_buffers refer (qedx_info.n_buffers)),
3 buffer_name character (16) unaligned, /* name of the buffer */
3 buffer_pathname character (256) unaligned, /* initial default pathname of buffer */
3 region_ptr pointer, /* -> caller's optional region */
3 region_max_lth fixed binary (21), /* # of characters which will fit in caller's region */
3 region_initial_lth fixed binary (21), /* # of characters in caller's region for initial read */
3 region_final_lth fixed binary (21), /* set to # of characters placed in caller's region on exit */
3 flags,
4 read_write_region bit (1) unaligned, /* ON => use caller's region as default for read/write;
OFF => use file specified by pathname as default */
4 locked_pathname bit (1) unaligned, /* ON => read/write will never change default pathname or
prevent qedx from trusting the default path;
OFF => read with pathname sets ^trusted and write with
pathname changes the default */
4 execute_buffer bit (1) unaligned, /* ON => execute it's contents before reading from terminal */
/*** following switches apply only when read_write_region is ON ... */
4 default_read_ok bit (1) unaligned, /* ON => r without explicit pathname is OK */
4 default_write_ok bit (1) unaligned, /* ON => w without explicit pathname is OK */
4 auto_write bit (1) unaligned, /* ON => automatically write buffer contents on "q" */
4 truncated bit (1) unaligned, /* set ON => edited version is too long for caller's region */
4 pad bit (29) unaligned;
dcl qedx_info_ptr pointer;
dcl qedx_info_n_buffers fixed binary; /* needed to allocate above structure */
dcl QEDX_INFO_VERSION_1 character (8) static options (constant) initial ("qxi_01.1");
/* END INCLUDE FILE ... qedx_info.incl.pl1 */

88
multics/library_dir_dir/include/qedx_internal_data.incl.pl1 Executable file
View File

@@ -0,0 +1,88 @@
/* BEGIN INCLUDE FILE ... qedx_internal_data.incl.pl1 */
/* Created: January 1983 by G. Palter */
/* Data used by a single invocation of qedx or qedx_ */
dcl 1 qid aligned based (qid_ptr),
2 editor_name character (72) unaligned, /* name of the editor (eg: "send_mail (qedx)") */
2 editor_area_ptr pointer, /* -> area used to allocate data */
2 qedx_info_ptr pointer, /* -> caller's definition of this qedx invocation */
2 edx_util_data_ptr pointer, /* -> data used by edx_util_ */
2 regexp_data_ptr pointer, /* -> data used by qx_search_file_ */
2 flags,
3 no_rw_path bit (1) unaligned,
3 query_if_modified bit (1) unaligned,
3 pad bit (34) unaligned,
2 b0 like b, /* buffer 0 */
2 tw like b; /* typewriter buffer */
dcl qid_ptr pointer;
dcl editor_area area based (qid.editor_area_ptr);
/* Description of an element of the buffer recursion stack */
dcl 1 sv based aligned,
2 prev pointer, /* pointer to previous element in stack */
2 bp pointer, /* pointer to control block for this element */
2 (ti, te) fixed binary (21); /* saved copies of buffer read indexes */
%page;
/* Description of a single qedx buffer: Buffers are managed in two sections, a top and a bottom. The gap between the
sections is the end of the current line, and permits easy insertion and deletion of text, without extraineous data
movement.
An empty section is indicated when the pointers are out-of-sequence. For example for the bottom section if lb
(last_bottom) is < 1 then the bottom is empty. If ft (first_top) is > (file_end) then the top is empty.
In addition only one temporary file is needed to support operations on the buffers
Line and range pointers:
li - Start index of current line.
le - End index of current line. Points to NL.
lli - Start index of last line of range.
lle - End index of last line of range. Points to NL.
fli - Start index of first line of range.
fle - End index of first line of range.
Gapped buffer standards:
1 - Start index of buffer.
ilb - End index of first part of buffer. Should point to NL.
ift - Start index of second part of buffer.
ife - End index of buffer. Should be one of: 1024*4*4, 1024*4*16, 1024*4*64, or 1024*4*255;
Gapped standards permit the range to split across the gap, but a line of text cannot split across the gap. Therefore
when the gap is moved one should also move li and le if they are in the moved section of buffer.
The gap, when processing insert, delete, change, substitute, is either immediately before, or immediately after the
range specified. This is dependant upon the type of operation. I/O such as writing and printing of buffer contents,
or searching and line indexing is done without moving the gap, and is done in sections as appropriate for the current
operational positioning and the current gap position */
dcl 1 b based (bp) aligned,
2 name character (16), /* buffer name */
2 next pointer, /* pointer to next buffer control block (if any) */
2 dp pointer, /* pointer to beginning of buffer data */
2 default_path character (256), /* default output pathname for this buffer */
2 lb fixed binary (21), /* index of last character of bottom section */
2 ft fixed binary (21), /* index of first character of top section */
2 de fixed binary (21), /* index of last character in buffer */
2 li fixed binary (21), /* index of first character of current line */
2 le fixed binary (21), /* index of last character of current line */
2 ti fixed binary (21), /* index of next char. to be read from buffer */
2 te fixed binary (21), /* index of last char. of line being read from buffer */
2 tw_sw bit (1), /* typewriter buffer switch (OFF for normal buffers) */
2 callers_idx fixed binary, /* index in caller's qedx_info.buffers of this buffer */
2 flags,
3 modified bit (1) unaligned, /* buffer has been modified since last write */
3 default_was_region bit (1) unaligned, /* default pathname was originally caller's region */
3 default_is_region bit (1) unaligned, /* default pathname is currently caller's region */
3 default_locked bit (1) unaligned, /* default pathname can not be changed by r/w requests */
3 default_untrusted bit (1) unaligned, /* buffer pathname is not trustworthy */
3 pad bit (31) unaligned;
dcl bp pointer;
/* END INCLUDE FILE ... qedx_internal_data.incl.pl1 */

28
multics/library_dir_dir/system_library_1/info/maps.archive/bound_qedx_.bindmap Executable file
View File

@@ -0,0 +1,28 @@
bound_qedx_ 10/26/92 2212.1 mst Mon
Bindmap for >ldd>h>e>bound_qedx_
Created on 11/11/89 1109.6 mst Sat, by Hirneisen.SysMaint.a
using Multics Binder, Version 12 of Tuesday, March 26, 1985
>spec>install>1111>bound_qedx_.archive
Object Text Defs Link Symb Static
Start 0 0 30230 31510 32004 31520
Length 33404 30230 1260 274 1364 72
Component Text Int-Stat Symbol
Start Length Start Length Start Length
edx_util_ 0 4476 0 0 100 154
get_addr_ 4476 1500 0 0 254 104
search_file_ 6176 2162 0 70 360 122
qedx_ 10360 14774 70 0 502 222
check_entryname_ 25354 56 70 0 724 124
qedx 25432 2576 70 2 1050 150
Bindfile
bound_qedx_.bind

37
multics/library_dir_dir/system_library_1/object/bound_qedx_.archive/bound_qedx_.bind Executable file
View File

@@ -0,0 +1,37 @@
/* Bindfile for: bound_qedx_ -- the Multics qedx Editor */
/* Created: 18 February 1971 by Dan Bricklin */
/* Modified: 30 November 1971 by C. Garman */
/* Modified: 4 August 1975 by M. A. Meer */
/* Modified: 3 March 1982 by S. Herbst to add copyrl and qx_search_file_ */
/* Modified: 3 November 1982 by S. Herbst to add search_file_$silent */
/* Modified: 12 January 1982 by G. Palter to add qedx_ and delete copyrl */
/* Modified: 11 March 1985 by Keith Loepere so it can go into hardcore. */
Objectname: bound_qedx_;
Global: delete;
Order: edx_util_,
get_addr_,
search_file_,
qedx_,
check_entryname_,
qedx;
/* Instructions for individual components */
objectname: check_entryname_;
retain: check_entryname_;
objectname: qedx;
synonym: qx;
retain: qedx, qx;
objectname: qedx_;
retain: qedx_;
objectname: search_file_;
synonym: qx_search_file_;
retain: search_file_, silent;
/* end; */

281
multics/library_dir_dir/system_library_1/source/bound_bce_paged.s.archive/bootload_qedx.pl1 Executable file
View File

@@ -0,0 +1,281 @@
/****^ ***********************************************************
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1983 *
* *
*********************************************************** */
/* format: off */
/* bootload Multics qedx Editor command interface */
/* Created: April 1983 by Keith Loepere from
January 1983 creation by G. Palter as part of implementation of qedx_ subroutine interface */
/* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
bootload_qedx:
procedure (ss_info_ptr);
dcl argument character (argument_lth) unaligned based (argument_ptr);
dcl argument_ptr pointer;
dcl argument_lth fixed binary (21);
dcl (n_arguments, argument_idx) fixed binary;
dcl input_filename character (32);
dcl input_file_ptr pointer;
dcl exec_filename character (32);
dcl exec_buffer_lth fixed binary (21);
dcl exec_buffer_ptr pointer;
dcl args_buffer character (args_buffer_lth) based (args_buffer_ptr);
dcl args_buffer_lth fixed bin (21);
dcl args_buffer_used fixed binary (21);
dcl args_buffer_ptr ptr;
dcl 1 local_qi aligned, /* describes how we want the invocation setup */
2 header like qedx_info.header,
2 buffers (6) like qedx_info.buffers; /* 0, 1, 2, 3, exec, args */
dcl ok_to_continue bit (1) aligned;
dcl (no_rw_path, have_pathname, have_macro_pathname, have_macro_arguments) bit (1) aligned;
dcl idx fixed binary;
dcl code fixed binary (35);
dcl invocation_level fixed binary static initial (0); /* # of active invocations of qedx */
dcl NL character (1) static options (constant) initial ("
");
dcl QEDX character (32) static options (constant) initial ("bootload_qedx");
/* format: off */
dcl (error_table_$badopt, error_table_$bigarg, error_table_$inconsistent, error_table_$noarg, error_table_$too_many_args)
fixed binary (35) external;
dcl sys_info$max_seg_size fixed bin (18) static external;
/* format: on */
dcl bootload_fs_$get_ptr entry (char (*), ptr, fixed bin (21), fixed bin (35));
dcl com_err_ entry () options (variable);
dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35));
dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
dcl get_temp_segment_ entry (character (*), pointer, fixed binary (35));
dcl qedx_ entry (pointer, fixed binary (35));
dcl release_temp_segment_ entry (character (*), pointer, fixed binary (35));
dcl (cleanup, request_abort_) condition;
dcl (divide, length, index, null, segno, substr, string) builtin;
%page;
/* bootload_qedx: procedure (ss_info_ptr); */
call cu_$arg_count_rel (n_arguments, ss_info.arg_list_ptr, code);
if code ^= 0 then do;
call com_err_ (code, QEDX);
signal request_abort_;
end;
if invocation_level > 0 then do; /* it would be nice to eliminate this... */
call com_err_ (0, QEDX, "A suspended invocation is somehow on the stack.");
return;
end;
invocation_level = invocation_level + 1; /* another qedx */
input_file_ptr, /* for cleanup handler */
exec_buffer_ptr, args_buffer_ptr = null ();
on condition (cleanup) call cleanup_qedx_invocation ();
/* format: off */
/* Process arguments: syntax of the qedx command is --
qedx {-control_args} {macro_path {macro_arguments}} */
/* format: on */
no_rw_path, /* allow r/w with pathnames and R/W */
have_pathname, /* haven't seen -pathname yet */
have_macro_pathname, /* haven't seen first non-control argument yet */
have_macro_arguments = "0"b; /* haven't seen any macro arguments */
do argument_idx = 1 to n_arguments;
call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, ss_info.arg_list_ptr);
if code ^= 0 then do; /* sigh */
call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx);
go to RETURN_FROM_QEDX;
end;
if ^have_macro_pathname then /* no non-control argument yet: can still accept -ca's */
if index (argument, "-") = 1 then /* ... a control argument */
if argument = "-no_rw_path" then no_rw_path = "1"b;
else if argument = "-rw_path" then no_rw_path = "0"b;
else if (argument = "-pathname") | (argument = "-pn") then
if have_pathname then do;
call com_err_ (error_table_$too_many_args, QEDX,
"""-pathname"" may only be specified once for this command.");
go to RETURN_FROM_QEDX;
end;
else do; /* initial contents for buffer 0 ... */
have_pathname = "1"b;
if argument_idx = n_arguments then do;
call com_err_ (error_table_$noarg, QEDX, "Pathname after ""^a"".", argument);
go to RETURN_FROM_QEDX;
end;
argument_idx = argument_idx + 1;
call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code,
ss_info.arg_list_ptr);
if code ^= 0 then do;
call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx);
go to RETURN_FROM_QEDX;
end;
input_filename = argument;
call bootload_fs_$get_ptr (argument, input_file_ptr, (0), code);
if code ^= 0 then do; /* the file doesn't exist (sigh) */
call com_err_ (code, QEDX, "-pathname ^a", argument);
go to RETURN_FROM_QEDX;
end;
input_file_ptr = null ();
end;
else do;
call com_err_ (error_table_$badopt, QEDX, """^a""", argument);
go to RETURN_FROM_QEDX;
end;
else do; /* first non-control argument: macro pathname */
have_macro_pathname = "1"b;
if index (reverse (rtrim (argument)), "xdeq.") = 1 then
exec_filename = argument;
else exec_filename = rtrim (argument) || ".qedx";
call bootload_fs_$get_ptr (exec_filename, exec_buffer_ptr, exec_buffer_lth, code);
if code ^= 0 then do; /* the file doesn't exist (sigh) */
call com_err_ (code, QEDX, "Macro file: ^a", exec_filename);
go to RETURN_FROM_QEDX;
end;
end;
else do; /* Nth non-control argument: a macro argument */
if ^have_macro_arguments then do; /* ... first macro argument */
call get_temp_segment_ (QEDX, args_buffer_ptr, code);
if code ^= 0 then do;
call com_err_ (code, QEDX, "Obtaining buffer space for macro arguments");
go to RETURN_FROM_QEDX;
end;
args_buffer_lth = sys_info$max_seg_size * 4;
args_buffer_used = 0;
have_macro_arguments = "1"b;
end;
call add_to_args_buffer (argument);
call add_to_args_buffer (NL);
end;
end;
if no_rw_path & ^have_pathname then do;
call com_err_ (error_table_$inconsistent, QEDX, """-no_rw_path"" must be used with ""-pathname"".");
go to RETURN_FROM_QEDX;
end;
/* Arguments have been validated: setup qedx_info data structure and invoke qedx_ */
local_qi.header.version = QEDX_INFO_VERSION_1;
local_qi.header.editor_name = QEDX;
string (local_qi.header.flags) = ""b;
local_qi.header.no_rw_path = no_rw_path;
local_qi.header.query_if_modified = "1"b; /* finally after all these years ... */
local_qi.header.n_buffers = 0; /* no initial buffers yet */
if have_pathname then do; /* include a buffer 0 containing requested file ... */
local_qi.header.n_buffers, idx = 1;
local_qi.buffers (idx).buffer_name = "0";
local_qi.buffers (idx).buffer_pathname = input_filename;
string (local_qi.buffers (idx).flags) = ""b;
end;
if have_macro_pathname then do; /* exec buffer containing a macro to execute ... */
local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1;
local_qi.buffers (idx).buffer_name = "exec";
local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */
local_qi.buffers (idx).region_ptr = exec_buffer_ptr;
local_qi.buffers (idx).region_max_lth, /* ... get size from the system */
local_qi.buffers (idx).region_initial_lth = exec_buffer_lth;
string (local_qi.buffers (idx).flags) = ""b;
local_qi.buffers (idx).read_write_region, local_qi.buffers (idx).execute_buffer = "1"b;
end; /* ... get initial content from us but can't write back */
if have_macro_arguments then do; /* a "file" of arguments to the macro ... */
local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1;
local_qi.buffers (idx).buffer_name = "args";
local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */
local_qi.buffers (idx).region_ptr = args_buffer_ptr;
local_qi.buffers (idx).region_max_lth, local_qi.buffers (idx).region_initial_lth = args_buffer_used;
string (local_qi.buffers (idx).flags) = ""b;
local_qi.buffers (idx).read_write_region = "1"b;
end; /* ... get initial content from us but can't write back */
call qedx_ (addr (local_qi), code); /* INVOKE THE EDITOR */
RETURN_FROM_QEDX:
call cleanup_qedx_invocation ();
return;
%page;
/* Add a character string to the macro arguments buffer */
add_to_args_buffer:
procedure (p_string);
dcl p_string character (*) parameter;
if (args_buffer_used + length (p_string)) > length (args_buffer) then do;
call com_err_ (error_table_$bigarg, QEDX, "Too many macro arguments. First failing argument: ""^a"".", argument);
go to RETURN_FROM_QEDX;
end;
substr (args_buffer, (args_buffer_used + 1), length (p_string)) = p_string;
args_buffer_used = args_buffer_used + length (p_string);
return;
end add_to_args_buffer;
/* Cleanup after an invocation of qedx */
cleanup_qedx_invocation:
procedure ();
if args_buffer_ptr ^= null () then do;
call release_temp_segment_ (QEDX, args_buffer_ptr, (0));
args_buffer_ptr = null ();
end;
invocation_level = invocation_level - 1; /* all gone */
return;
end cleanup_qedx_invocation;
%page;
%include qedx_info;
%page;
%include access_mode_values;
%page;
%include bce_subsystem_info_;
end bootload_qedx;

45
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/check_entryname_.pl1 Executable file
View File

@@ -0,0 +1,45 @@
/****^ ***********************************************************
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
* Copyright (c) 1972 by Massachusetts Institute of *
* Technology and Honeywell Information Systems, Inc. *
* *
*********************************************************** */
/* CHECK_ENTRYNAME_ - See if the entryname x is "troublesome."
THVV */
/* Modified 81-02-13 by S. G. Harris (UNCA) to allow slash in an entryname. */
/* Changes merged and edited 03/03/82 S. Herbst */
/* Fixed to call check_star_name_$entry 05/05/82 S. Herbst */
/****^ HISTORY COMMENTS:
1) change(86-08-18,JSLove), approve(86-08-18,MCR7518),
audit(86-08-19,Parisek), install(86-10-02,MR12.0-1174):
Changed to call check_star_name_, which returns more informative error
codes.
END HISTORY COMMENTS */
/* format: style3,delnl,linecom */
check_entryname_:
proc (x, ec);
dcl x char (*),
ec fixed bin (35); /* Arguments */
dcl check_star_name_ entry (char (*), bit (36) aligned, fixed bin (2), fixed bin (35));
%page;
%include check_star_name;
%page;
call check_star_name_ (x, CHECK_STAR_ENTRY_DEFAULT | CHECK_STAR_REJECT_WILD, (0), ec);
return;
end check_entryname_;

784
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/edx_util_.pl1 Executable file
View File

@@ -0,0 +1,784 @@
/****^ ***********************************************************
* *
* Copyright, (C) BULL HN Information Systems Inc., 1989 *
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
* Copyright (c) 1972 by Massachusetts Institute of *
* Technology and Honeywell Information Systems, Inc. *
* *
*********************************************************** */
/****^ HISTORY COMMENTS:
1) change(89-02-02,Huen), approve(89-02-02,MCR8057), audit(89-05-24,RWaters),
install(89-05-31,MR12.3-1051):
Fix Bug 203 in qedx
editor - Set up the wakeup table on the user_input switch when entering
append mode.
END HISTORY COMMENTS */
/* format: off */
/* Utility functions for Multics qedx Editor: handles input streams and manages buffers. */
/* Initial coding by R. C. Daley, August 1970 */
/* Latest change to use the search builtin and for large segments by M. A. Meer, August 1975 */
/* Modified 9/9/81 by E. N. Kittlitz to remove b.default_len, clean up */
/* Modifications to make qx efficient and change buffer operation by T. Oke, June 1980 */
/* Modification to twbuf size to utilize the 512 character buffer length which is available. T. Oke 81-05-19 */
/* Changes merged and edited 03/03/82 S. Herbst */
/* Changed $list_buffers to list only modified buffers for quit query 04/16/82 S. Herbst */
/* Fixed $read_ptr to use whole temp seg and not flush for long_record 04/29/82 S. Herbst */
/* Modified: January 1983 by G. Palter as part of making qedx reentrant (includes using get/release_temp_segment_) */
/* Modified April 1983 by K. Loepere to make run in Bootload Multics */
/* Modified August 1983 by K. Loepere for new bce switches */
/* Modified March 1985 by Keith Loepere to run in bce and Multics. */
/* Modified Feb 1989 by S. Huen to set up the wakeup table on the user_input switch instead of the user_i/o switch when entering append mode. */
/* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
edx_util_:
procedure;
dcl atp ptr; /* pointer to caller's input buffer */
dcl code fixed bin (35);
dcl i fixed bin (21);
dcl indx fixed bin (17); /* index for special character after conceal */
dcl j fixed bin (21);
dcl k fixed bin (21);
dcl ka fixed bin (21);
dcl ki fixed bin (21);
dcl kik fixed bin (21);
dcl kx fixed bin (21); /* check for special characters */
dcl nelem fixed bin (21); /* maximum number of characters to read */
dcl nelemt fixed bin (21); /* number of characters actually read (output) */
dcl p ptr; /* temporary storage */
dcl te fixed bin (21);
dcl ti fixed bin (21);
dcl tline char (512); /* NOTE: This variable can be no shorter than qedx's iline */
dcl tp ptr;
dcl 1 edx_data aligned based (qid.edx_util_data_ptr),
2 cbname character (16), /* current buffer name */
2 curp pointer, /* -> current input control block */
2 level fixed binary, /* buffer recursion counter */
2 top pointer, /* -> top of buffer stack (null for level 0) */
2 swt aligned like swt_info; /* set_wakeup_table data */
dcl NL char (1) static options (constant) init ("
");
dcl special_char_string char (5) static options (constant) aligned init ("
\"); /* the string is \012 || \ || \c || \b || \r */
dcl a_string char (sys_info$max_seg_size * 4) based aligned;
dcl wstring (sys_info$max_seg_size * 4) char (1) based; /* for use with iox_$put_chars */
dcl error_table_$long_record fixed bin (35) ext;
dcl sys_info$max_seg_size fixed bin (18) external;
dcl sys_info$service_system bit (1) aligned external;
dcl bce_data$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)) external variable;
dcl bce_data$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)) external variable;
dcl iox_$user_output external ptr;
dcl iox_$user_input external ptr;
dcl bce_check_abort entry;
dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl (
ioa_,
ioa_$ioa_switch,
com_err_
) entry options (variable),
iox_$control entry (ptr, char (*), ptr, fixed bin (35)),
iox_$modes entry (ptr, char (*), char (*), fixed bin (35)),
get_temp_segment_ entry (char (*), ptr, fixed bin (35)),
release_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl (addr, divide, index, length, min, null, search, substr, string, unspec) builtin;
dcl (program_interrupt, sub_request_abort_) condition;
%page;
/* Initialize data required by an invocation of edx_util_: also initializes input stream, buffer 0, teletype buffer, and
gets the temporary segment used for buffer 0 */
edx_init:
entry (P_qid_ptr, atwp, aifp, abp, acode); /* entry to initialize input stream and buffers */
dcl P_qid_ptr pointer, /* -> qedx per-invocation data */
atwp ptr, /* pointer to typewriter buffer (char(512)) */
aifp ptr, /* pointer to buffer input file (output) */
abp ptr, /* pointer to control block for buffer "0" (output) */
acode fixed bin (35); /* error status code (output) */
qid_ptr = P_qid_ptr;
allocate edx_data in (editor_area) set (qid.edx_util_data_ptr);
call get_temp_segment_ (qid.editor_name, aifp, acode);
if acode ^= 0 then do; /* could not create buffer 0 buffer */
call com_err_ (acode, qid.editor_name, "Obtaining temporary space for buffer 0.");
return;
end;
top = null (); /* indicate buffer recursion stack is empty */
level = 0; /* and set buffer level to 0 */
cbname = "0"; /* set initial buffer name */
b0.name = "0"; /* give it a name */
b0.tw_sw = "0"b;
b0.next = null (); /* buffer "0" is first and only buffer on chain */
b0.dp = aifp; /* initialize buffer "0" to input buffer file */
b0.lb = 0; /* indicate that no data exists */
if sys_info$service_system then
b0.de = 4 * 1024 * 4; /* indicate buffer empty */
else b0.de = 4 * sys_info$max_seg_size; /* in bce, no need to grow buffers */
b0.ft = b0.de + 1;
b0.default_path = ""; /* .. */
b0.li = 1; /* no current line either */
b0.le = 0;
b0.callers_idx = 0;
string (b0.flags) = ""b;
curp = addr (tw); /* set console typewriter as current input buffer */
tw.name = "typewriter";
tw.next = null ();
tw.dp = atwp; /* initialize pointer to tw buffer */
tw.default_path = ""; /* no default path */
tw.lb = 0;
tw.ft = 513; /* no top section */
tw.de = 512; /* maximum tw buffer size */
tw.li = 0; /* not used for tw */
tw.le = 0; /* not used for tw */
tw.ti = 1; /* force read by indicating buffer exhaust condition */
tw.te = 0; /* .. */
tw.tw_sw = "1"b; /* typewriter buffer switch (ON) */
tw.callers_idx = 0;
string (tw.flags) = ""b;
if sys_info$service_system then do;
unspec (swt) = ""b; /* setup for cheap input later */
swt.version = swt_info_version_1;
swt.new_table.wake_map (24), /* eb, octal 030 */
swt.new_table.wake_map (25), /* ec, octal 031 */
swt.new_table.wake_map (28), /* ef, octal 034 */
swt.new_table.wake_map (30), /* er, octal 036 */
swt.new_table.wake_map (92) = "1"b; /* backslash, octal 134 */
call iox_$control (iox_$user_input, "set_wakeup_table", addr (swt), code);
end;
abp = addr (b0); /* return pointer to buffer "0" control block */
acode = 0; /* indicate successful initialization */
return;
%page;
/* Prime the terminal input buffer from the supplied string: setup length and pointer */
prime:
entry (P_qid_ptr, pptr, plen);
dcl pptr ptr, /* pointer to string to place in tw input buffer */
plen fixed bin (21); /* length of string to place in tw input buffer */
qid_ptr = P_qid_ptr;
substr (tw.dp -> a_string, 1, plen) = substr (pptr -> a_string, 1, plen);
/* initialize tw input buffer */
tw.ti = 1; /* .. */
tw.te = plen; /* .. */
tw.lb = plen; /* fill in first section */
tw.ft = tw.de + 1; /* empty top */
return;
%page;
/* Cleanup all data managed by edx_util_ */
edx_cleanup:
entry (P_qid_ptr);
qid_ptr = P_qid_ptr;
if qid.edx_util_data_ptr = null () then return; /* nothing there */
do while (level ^= 0); /* unwind buffer recursion stack */
p = top; /* get pointer to top of stack */
top = p -> sv.prev; /* find previous level */
curp = p -> sv.bp; /* find previous buffer control block */
free p -> sv in (editor_area); /* release top level of stack */
level = level - 1; /* decrement recursion level count */
end;
bp = addr (b0); /* start with buffer 0 */
do while (bp ^= null ()); /* delete auxiliary buffers and free control blocks */
p = b.next; /* pointer to next control block (if any) */
call release_temp_segment_ (qid.editor_name, b.dp, (0));
if bp ^= addr (b0) then free bp -> b in (editor_area);
bp = p; /* repeat for next buffer in chain (if any) */
end;
if sys_info$service_system then do;
swt.new_table = swt.old_table; /* put back old table */
call iox_$control (iox_$user_input, "set_wakeup_table", addr (swt), code);
end;
free qid.edx_util_data_ptr -> edx_data in (editor_area);
qid.edx_util_data_ptr = null ();
return;
%page;
/* Read_ptr is a moderately complex routine which will read data either
from the terminal, or from the supplied buffer.
Read_ptr will also pop a buffer level with resetread if it empties the
buffer.
Gap modifications are done to have the buffer divided into a lower and
upper half. Initially the lower half is processed, and when this is
exhausted, the upper half is tried. */
read_ptr:
entry (P_qid_ptr, atp, nelem, nelemt);
qid_ptr = P_qid_ptr;
tp = atp; /* get pointer to caller's input buffer */
te = nelem; /* also, get maximum characters to be read */
if ^ sys_info$service_system then
on condition (sub_request_abort_) begin;
call resetread (qid_ptr);
go to restart;
end;
restart:
bp = curp; /* get pointer to current buffer control block */
b.modified = b.modified & (b.default_path ^= ""); /* reading makes buffer unmodified if it has no pathname */
ti = 1; /* start input into top of buffer */
retry:
if ^ sys_info$service_system then call bce_check_abort; /* stop infinite loop */
if b.ti > b.te then do; /* check if buffer being read is exhausted */
if b.ti > b.lb & b.ti <= b.ft then do; /* move to top half */
b.te = b.de;
b.ti = b.ft;
if b.ft <= b.de then goto retry; /* continue processing top half */
end;
if b.tw_sw then do; /* was input from console typewriter (level 0) */
if sys_info$service_system then
call iox_$get_line (iox_$user_input, b.dp, sys_info$max_seg_size * 4, b.te, code);
else call bce_data$get_line (addr (bce_data$get_line), b.dp, 256, b.te, code);
/* if so, refresh line from typewriter */
if code ^= 0 then
if code ^= error_table_$long_record then do;
call com_err_ (code, qid.editor_name, "edx_util_$read_ptr");
if sys_info$service_system then
call iox_$control (iox_$user_input, "resetread", null (), (0));
b.ti = 1; /* re-start buffer */
b.te = 0; /* setup to read again */
go to retry;
end;
if b.te > b.de then b.de = 1024 * (divide (b.te, 1024, 21, 0) + 2);
b.ft = b.de + 1; /* make top section empty */
b.lb = b.te; /* all text in bottom section */
b.ti = 1; /* reset current read index */
go to retry; /* and try again to read data to caller */
end;
else do; /* here on end of buffer */
call end_buffer (qid_ptr, (0)); /* pop buffer recursion level by one */
bp = curp; /* re-establish previous buffer control block */
go to retry; /* resume reading from previous buffer */
end;
end;
k = search (substr (b.dp -> a_string, b.ti, (b.te - b.ti + 1)), special_char_string);
if k = 0 then do;
ki = (b.te - b.ti + 1);
copy_string:
substr (tp -> a_string, ti, ki) = substr (b.dp -> a_string, b.ti, ki);
ti = ti + ki; /* update input index */
b.ti = b.ti + ki; /* update output index */
if ki < k then
go to end_read; /* end of input buffer */
else go to retry; /* get more */
end;
if ti + k - 1 > te then do;
ki = te - ti + 1;
go to copy_string;
end;
kx = index (special_char_string, substr (b.dp -> a_string, b.ti + k - 1, 1));
/* found which one */
go to rd_case (kx);
rd_case (1): /* found an new line */
substr (tp -> a_string, ti, k) = substr (b.dp -> a_string, b.ti, k);
/* copy thru new line */
ti = ti + k - 1; /* update input index */
b.ti = b.ti + k; /* update output index */
nelemt = ti;
return;
rd_case (2): /* found an escape character "\" */
if b.ti + k <= b.te then do;
ka = 1; /* possible two character symbol */
kik = index ("cbrCBR", substr (b.dp -> a_string, b.ti + k, 1));
/* if so, what is second character */
if kik = 0 then do;
ki = k;
go to copy_string;
end;
go to rd_action (kik); /* go take appropriate action */
end;
else go to past_end_of_input;
rd_case (3): /* single character conceal */
ka = 0;
rd_action (1):
rd_action (4):
rd_conceal:
if b.ti + k + ka > b.te then do; /* beyond end of input */
past_end_of_input:
k = 0;
ki = b.te - b.ti + 1; /* ignore action */
go to copy_string;
end;
indx = index (special_char_string, substr (b.dp -> a_string, b.ti + k + ka, 1));
if indx = 2 then do; /* found \ */
/* is this a two character special */
if index ("bcfrBCFR", substr (b.dp -> a_string, b.ti + k + ka + 1, 1)) ^= 0 then
ki = k + ka + 1; /* set for two character special */
else ki = k + ka; /* not a special */
go to copy_string;
end;
else if indx = 3 then do; /* single character conceal */
ki = k + ka + 1; /* keep it */
go to copy_string;
end;
else if indx ^= 0 /* some other special ? */
then
go to add_special; /* single character special */
else do; /* no special */
ki = k + ka; /* set copy length */
go to copy_string;
end;
add_special:
substr (tp -> a_string, ti, k) =
substr (b.dp -> a_string, b.ti, k - 1) || substr (b.dp -> a_string, b.ti + k + ka, 1);
/* copy thru special character */
b.ti = b.ti + k + ka + 1; /* update input index */
ti = ti + k; /* update output index */
go to retry; /* try for more */
rd_case (4): /* insert contents of buffer */
ka = 0;
rd_action (2):
rd_action (5):
rd_exp_buff:
substr (tp -> a_string, ti, k - 1) = substr (b.dp -> a_string, b.ti, k - 1);
/* copy up to buffer expansion */
ti = ti + k - 1; /* update output index */
b.ti = b.ti + k + ka; /* update input index */
rd_buff:
call find_buffer (b.dp, b.ti, b.te, p, "0"b); /* try to find named buffer */
if p = null () then do; /* error if named buffer does not already exist */
rd_err:
call resetread (qid_ptr); /* reset back to typewriter level (level 0) */
go to restart; /* and restart this call from scratch */
end;
if level > 500 then go to rd_err; /* check buffer recursion level */
level = level + 1; /* bump recursion level */
curp = p; /* make new buffer control block the current block */
allocate sv in (editor_area) set (p); /* save current level of buffer recursion */
p -> sv.prev = top; /* save current ptr to top of stack */
p -> sv.bp = bp; /* save ptr to current buffer control block */
p -> sv.ti = b.ti; /* save current position in current buffer */
p -> sv.te = b.te; /* .. */
top = p; /* push buffer recursion stack */
bp = curp; /* set ptr to new current buffer control block */
b.ti = 1; /* initialize buffer read index */
b.te = b.lb; /* set index of last character in lower half of buffer */
b.modified = b.modified & (b.default_path ^= ""); /* reading makes buffer unmodified if it has no pathname */
go to retry; /* resume reading after processing */
rd_case (5): /* read from console one line */
ka = 0;
rd_action (3):
rd_action (6):
rd_read:
substr (tp -> a_string, ti, k - 1) = substr (b.dp -> a_string, b.ti, k - 1);
/* copy up to special symbol */
b.ti = b.ti + k + ka; /* update input index */
ti = ti + k - 1; /* update output index */
if sys_info$service_system then
call iox_$modes (iox_$user_input, "^wake_tbl", "", (0));
/* exit cheap input */
read_one_line: /* NOTE modification here limits amount able to be read to remainder possible in
buffer. */
if sys_info$service_system then
call iox_$get_line (iox_$user_input, addr (tline), min (length (tline), te - ti + 1), j, code);
else call bce_data$get_line (addr (bce_data$get_line), addr (tline), min (length (tline), te - ti + 1), j, code);
if code ^= 0 /* error reading from typewriter */
then do;
call com_err_ (code, qid.editor_name, "edx_util_$read_ptr read one line - PLEASE RE-ENTER LINE");
if sys_info$service_system then
call iox_$control (iox_$user_input, "resetread", null (), (0));
go to read_one_line;
end;
substr (tp -> a_string, ti, j) = tline; /* move as much as will fit to caller's buffer */
te = ti + j - 1; /* number of characters moved */
go to end_read; /* and terminate the read call */
end_read:
nelemt = te; /* here if caller's buffer full, return characters read */
return; /* and return */
%page;
/* Pops the buffer recursion level by one and returns the new (old) buffer */
end_buffer:
entry (P_qid_ptr, ecode);
dcl ecode fixed bin; /* error code, 1= already at level 0, 0= ok */
qid_ptr = P_qid_ptr;
if level = 0 then do; /* check recursion level */
ecode = 1; /* error if level already 0 */
return; /* return error condition to caller */
end;
level = level - 1; /* decrement recursion level */
p = top; /* pop buffer stack one level */
top = p -> sv.prev; /* .. restore previous level */
curp, bp = p -> sv.bp; /* .. restore previous buffer control block */
b.ti = p -> sv.ti; /* .. restore current line index within buffer */
b.te = p -> sv.te; /* .. */
free p -> sv in (editor_area); /* release current stack level */
ecode = 0; /* indicate that all is ok */
return; /* and return to caller */
%page;
/* Flush read-ahead: output unexecuted portion of current buffer (if any), revert input back to the terminal, and
perform a resetread on the terminal itself */
resetread:
entry (P_qid_ptr);
qid_ptr = P_qid_ptr;
if level ^= 0 then do; /* if buffer recursion level > 0 */
bp = curp; /* get pointer to current buffer control block */
call ioa_ ("Error in buffer (^a) at level ^d.", b.name, level);
if sys_info$service_system then
on condition (program_interrupt) go to prskip;
else on condition (sub_request_abort_) go to prskip;
/* set up program interrupt handler */
if b.ti > b.lb & b.ti < b.ft then b.ti = b.ft;
/* move across gap */
if b.de > b.ft then
b.te = b.de;
else b.te = b.lb;
if b.te <= b.lb | b.ti >= b.ft then do; /* portion addressed is purely in bottom or top */
i = b.te - b.ti + 1;
if i > 0 then do;
call ioa_ ("Unexecuted lines in buffer:");
if sys_info$service_system then
call iox_$put_chars (iox_$user_output, addr (b.dp -> wstring (b.ti)), i, code);
else call bce_data$put_chars (addr (bce_data$put_chars), addr (b.dp -> wstring (b.ti)), i, code);
end; /* print specified portion of buffer on user's console */
end;
else if b.ti <= b.lb then do; /* top in top, bottom in bottom */
i = b.te - b.ft + 1 + b.lb - b.ti;
if i > 0 then do;
call ioa_ ("Unexecuted lines in buffer:");
if sys_info$service_system then do;
call iox_$put_chars (iox_$user_output, addr (b.dp -> wstring (b.ti)), b.lb - b.ti + 1, code);
call iox_$put_chars (iox_$user_output, addr (b.dp -> wstring (b.ft)), b.te - b.ft + 1, code);
end;
else do;
call bce_data$put_chars (addr (bce_data$put_chars), addr (b.dp -> wstring (b.ti)), b.lb - b.ti + 1, code);
call bce_data$put_chars (addr (bce_data$put_chars), addr (b.dp -> wstring (b.ft)), b.te - b.ft + 1, code);
end; /* print specified portion of buffer on user's console */
end; /* print specified portion of buffer on user's console */
end;
prskip:
if sys_info$service_system then
revert condition (program_interrupt);
else revert condition (sub_request_abort_);
do while (level ^= 0); /* release buffer recursion stack */
p = top; /* get pointer to top of stack */
top = p -> sv.prev; /* find previous level */
curp = p -> sv.bp; /* find previous buffer control block */
free p -> sv in (editor_area); /* release top level of stack */
level = level - 1; /* decrement recursion level */
end;
call ioa_ ("^/Current buffer is (^a) at level 0. ^/", cbname);
end;
bp = curp; /* get pointer to level 0 control block */
b.ti = 1; /* reset current line index */
b.te = 0; /* .. to give buffer exhaust and re-read from typwriter */
if sys_info$service_system then
call iox_$control (iox_$user_input, "resetread", null (), code);
/* reset "user_input" I/O stream */
return;
%page;
/* Get a buffer from existing buffers or create one */
get_buffer:
entry (P_qid_ptr, gtp, gti, gte, gtname, gtbp);
dcl gtp ptr, /* pointer to string containing buffer name */
gti fixed bin (21), /* index of first character of buffer name */
gte fixed bin (21), /* index of last character in string */
gtname char (16), /* buffer name (returned) */
gtbp ptr; /* pointer to buffer control block (returned) */
qid_ptr = P_qid_ptr;
call find_buffer (gtp, gti, gte, bp, "1"b); /* find (or create) buffer control block */
if bp = null () then do; /* reflect errors to caller if any */
gtbp = null (); /* .. */
return; /* and return */
end;
gtbp = bp; /* otherwise, return pointer to buffer control block */
gtname = b.name; /* return buffer name */
cbname = b.name; /* save it here also */
return;
%page;
/* Locate the specified buffer creating it if necessary */
locate_buffer:
entry (P_qid_ptr, gtname, gtbp);
qid_ptr = P_qid_ptr;
call locate_buffer (gtname, bp, "1"b); /* find (or create) buffer control block */
if bp = null () then do; /* reflect errors to caller if any */
gtbp = null (); /* .. */
return; /* and return */
end;
gtbp = bp; /* otherwise, return pointer to buffer control block */
cbname = b.name; /* save it here also */
return;
%page;
dcl P_current_buffer character (16) parameter;
dcl (P_iocb_ptr, P_bp) pointer parameter;
dcl list_only_modified bit (1) aligned;
/* List status of all buffers */
list_buffers:
entry (P_qid_ptr, P_current_buffer, P_iocb_ptr);
list_only_modified = "0"b;
go to BEGIN_LIST_BUFFERS;
/* List status of only those buffers which have been modified since the last write */
list_modified_buffers:
entry (P_qid_ptr, P_current_buffer, P_iocb_ptr);
list_only_modified = "1"b;
go to BEGIN_LIST_BUFFERS;
BEGIN_LIST_BUFFERS:
qid_ptr = P_qid_ptr;
bp = addr (b0); /* get pointer to first buffer control block */
do while (bp ^= null ()); /* list status of all buffers */
call list_one_buffer ();
bp = b.next; /* get pointer to next control block (if any) */
end;
return; /* return to caller */
%page;
/* List status of a single buffer */
list_single_buffer:
entry (P_qid_ptr, P_current_buffer, P_iocb_ptr, P_bp);
qid_ptr = P_qid_ptr;
list_only_modified = "0"b;
bp = P_bp;
call list_one_buffer (); /* does all the work */
return;
/* Internal procedure which lists a single buffer (called by several different entrypoints) */
list_one_buffer:
procedure ();
dcl (n_lines, start, nl_idx) fixed binary (21);
n_lines = 0;
if (b.de < b.ft) & (b.lb < 1) then /* don't need to count lines in an empty buffer */
go to DISPLAY_BUFFER_STATUS;
start = 1; /* count lines in the buffer */
do while (start <= b.de);
if (start > b.lb) & (start < b.ft) then /* switch to upper half of buffer */
start = b.ft;
if start >= b.ft then /* search for next newline */
nl_idx = index (substr (b.dp -> a_string, start, (b.de - start)), NL);
else nl_idx = index (substr (b.dp -> a_string, start, (b.lb - start)), NL);
if nl_idx ^= 0 then /* found a newline: move past it */
start = start + nl_idx;
else if start >= b.ft then /* no more newlines in upper half: terminate the loop */
start = b.de + 1;
else start = b.ft; /* no more newlines in lower half: move to upper */
n_lines = n_lines + 1; /* count the line */
end;
DISPLAY_BUFFER_STATUS:
if b.modified | ^list_only_modified then
call ioa_$ioa_switch (P_iocb_ptr, "^6d ^[->^;^2x^] ^[mod^;^3x^] (^a) ^[[untrusted] ^]^a", n_lines,
(b.name = P_current_buffer), (b.modified & ^list_only_modified), b.name, b.default_untrusted,
b.default_path);
return;
end list_one_buffer;
%page;
/* Check for modified buffers */
modified_buffers:
entry (P_qid_ptr) returns (bit (1));
qid_ptr = P_qid_ptr;
bp = addr (b0); /* start with the standard buffer */
do while (bp ^= null ());
if (b.de < b.ft) & (b.lb < 1) then /* ignore empty buffers */
go to IGNORE_THIS_BUFFER;
if b.modified then do; /* a candidate... */
if b.callers_idx ^= 0 then
if qid.qedx_info_ptr -> qedx_info.buffers (b.callers_idx).auto_write then
go to IGNORE_THIS_BUFFER; /* ... but it's gonna get written automaticaly */
return ("1"b); /* ... found one */
end;
IGNORE_THIS_BUFFER: /* try next buffer */
bp = b.next;
end;
return ("0"b); /* can only get here if all not modified */
%page;
/* Extract buffer name and find (or create) buffer */
find_buffer:
procedure (ftp, fti, fte, fbp, crsw);
dcl ftp ptr, /* pointer to string containing buffer name */
fti fixed bin (21), /* index in string to first character of buffer name */
fte fixed bin (21), /* index of last character of string */
fbp ptr, /* pointer to buffer control block if found (returned) */
crsw bit (1), /* create switch ("1"b = create if not found) */
p_name char (16); /* used by locate_buffer entrypoint */
dcl lbp ptr, /* temporary storage */
(i, j, l) fixed bin (21),
tch char (1),
tname char (16);
do fti = fti to fte; /* skip blanks */
tch = substr (ftp -> a_string, fti, 1); /* get a character */
if tch ^= " " then go to get_name; /* jump out on first non-blank character */
end;
buf_err:
call ioa_ ("Syntax error in buffer name.");
fbp = null (); /* indicate error by returning null pointer */
return; /* return to caller */
get_name:
if tch ^= "(" /* if one character buffer name given */
then
if tch ^= NL then do;
tname = tch; /* pick up single character name */
fti = fti + 1; /* skip index over buffer name */
end;
else go to buf_err;
else do; /* if multiple characters in name */
l = fte - fti; /* find end of buffer name */
if l < 2 then go to buf_err; /* by looking for matching ")" */
i = fti + 1; /* start search next character after " (" */
j = index (substr (ftp -> a_string, i, l), ")");
/* look for ")" */
if j < 2 then go to buf_err; /* error if not found or null buffer name */
fti = i + j; /* move line index after ")" */
tname = substr (ftp -> a_string, i, (j - 1));/* pick up buffer name */
end;
go to SKIP_LOCATE_BUFFER_ENTRY;
/* Locates the buffer whose name is given */
locate_buffer:
entry (p_name, fbp, crsw);
tname = p_name;
SKIP_LOCATE_BUFFER_ENTRY:
fbp = addr (b0); /* search existing buffers for buffer name */
do while (fbp ^= null ()); /* .. */
if fbp -> b.name = tname then return; /* if found, return pointer to buffer's control block */
lbp = fbp; /* save pointer to this control block */
fbp = fbp -> b.next; /* and move to next buffer (if any) in list */
end;
if ^crsw then do; /* not found, take error return if crsw = "0"b */
call ioa_ ("Buffer (^a) not found.", tname);
return; /* return with control block ptr (fbp) = null */
end;
allocate b in (editor_area) set (fbp); /* otherwise, try to create new buffer */
call get_temp_segment_ (qid.editor_name, fbp -> b.dp, code);
if code ^= 0 then do; /* if failed to create buffer */
free fbp -> b in (editor_area); /* free buffer control block */
call com_err_ (code, qid.editor_name, "Obtaining temporary space for buffer ^a.", tname);
fbp = null (); /* indicate failure by returning null pointer to caller */
return; /* return to caller */
end;
lbp -> b.next = fbp; /* buffer created, thread with previous control block */
fbp -> b.name = tname; /* initialize new buffer control block */
fbp -> b.next = null (); /* .. (now last block in chain) */
fbp -> b.lb = 0; /* buffer is empty low */
if sys_info$service_system then
fbp -> b.de = 4 * 4 * 1024; /* .. current buffer size */
else fbp -> b.de = 4 * sys_info$max_seg_size; /* don't grow bce segs */
fbp -> b.li = 1; /* .. current line index */
fbp -> b.ft = fbp -> b.de + 1; /* buffer is empty high */
fbp -> b.le = 0; /* .. current line end */
fbp -> b.tw_sw = "0"b; /* .. current typewriter switch */
fbp -> b.default_path = ""; /* .. current default pathname */
fbp -> b.callers_idx = 0; /* .. don't know if caller asked us to create it yet */
string (fbp -> b.flags) = ""b; /* .. all flags are off in the default state */
return;
end find_buffer;
%page;
%include qedx_internal_data;
%page;
%include qedx_info;
%page;
%include set_wakeup_table_info;
end edx_util_;

434
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/get_addr_.pl1 Executable file
View File

@@ -0,0 +1,434 @@
/****^ ***********************************************************
* *
* Copyright, (C) BULL HN Information Systems Inc., 1989 *
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
* Copyright (c) 1972 by Massachusetts Institute of *
* Technology and Honeywell Information Systems, Inc. *
* *
*********************************************************** */
/****^ HISTORY COMMENTS:
1) change(89-04-05,Huen), approve(89-04-05,MCR8093), audit(89-05-24,RWaters),
install(89-05-31,MR12.3-1051):
Fix Bug 209 in qedx
editor - Extend the ignoring of leading spaces to include <TAB> character.
END HISTORY COMMENTS */
/* format: off */
/* get_addr_ .......... subroutine to find address portion of qedx request and locate addressed line in buffer */
/* Initial coding by R. C. Daley, August 1970 */
/* Modified for gapped buffer by T. Oke, June 1980 */
/* Changes merged and edited 03/03/82 S. Herbst */
/* Modified: January 1983 by G. Palter as part of making qedx reentrant */
/* Modified: March 1989 by S Huen - Extend the ignoring of leading spaces to
include <TAB> character. (209) */
/* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
get_addr_:
procedure (aqidp, atp, ati, ate, afp, alb, aft, afe, ali, ale, api, ape, acode);
dcl aqidp ptr, /* pointer to qedx per-invocation data */
atp ptr, /* pointer to current typewriter input request line */
ati fixed bin (21), /* index of first unprocessed character in tw line */
ate fixed bin (21), /* index of last character in tw line */
afp ptr, /* pointer to current buffer file */
alb fixed bin (21), /* index of last character in lower half */
aft fixed bin (21), /* index of first character in upper half */
afe fixed bin (21), /* index of last character in buffer file */
ali fixed bin (21), /* index of first character of current line */
ale fixed bin (21), /* index of last character of current line */
api fixed bin (21), /* index of first character of addressed line (output) */
ape fixed bin (21), /* index of last character of addressed line (output) */
acode fixed bin; /* status code, 0= null address, 1= single address,
2= address pair expected (comma seen),
3= address pair expected (semi-colon seen),
4= search failed, 5= other error */
dcl (tp, fp) ptr, /* temporary storage */
(ti, te, lb, ft, fe, li, le, i, j, num, code) fixed bin (21),
temp_reg fixed bin init (0),
digit fixed bin (9),
(relsw, negsw, evalsw) bit (1) init ("0"b),
(ch, nl) char (1);
dcl last_index fixed bin (21); /* used in last_line scan */
dcl 1 t based (tp) aligned, /* structure to treat tw line as character array */
2 c (1048576) char (1) unaligned;
dcl 1 f based (fp) aligned, /* structure to treat buffer file as character array */
2 c (1048576) char (1) unaligned;
dcl string char (1048576) based aligned; /* based character string for use with substr and index */
dcl ioa_ entry options (variable), /* external procedures used by get_addr_ */
qx_search_file_
entry (ptr, ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (21),
fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (21));
dcl (fixed, index, reverse, substr, unspec) builtin;
%page;
tp = atp; /* pointer to tw line buffer */
ti = ati; /* index to next character in tw line */
te = ate; /* index of last character in tw line */
fp = afp; /* pointer to input file */
lb = alb; /* index of last character of bottom half */
ft = aft; /* index of first character of top half */
fe = afe; /* index of last character in input file */
li = ali; /* index of first character of current line */
le = ale; /* index of last character of current line */
acode = 0; /* initialize acode to indicate null address */
unspec (nl) = "000001010"b; /* initialize nl character */
go to scan2; /* begin (or resume) scan of tw input line */
scan:
acode = 1; /* resume scan after processing address component */
relsw = "1"b; /* number are relative after first address component */
scan1:
ti = ti + 1; /* bump tw input character index */
scan2:
if ti > te then do; /* check for end of line */
bad_addr:
call ioa_ ("Address syntax error.");
go to fail;
end;
ch = t.c (ti); /* pick up next character from tw input line */
/* Bug 209: Extend the ignoring of leading spaces to include the <TAB> char */
if (ch = " " | ch = " ")
then go to scan1; /* ignore whitespace at this level */
if ch = "/" then go to reg; /* "/" indicates start of regular expression */
if ch = "$" then go to last; /* "$" go to end of input file */
if ch = "-" then go to neg; /* "-" note minus sign seen */
if ch = "+" then go to pos; /* "+" note plus sign seen */
if ch = "." then go to scan; /* ignore "." for compatability */
if ch >= "0" then
if ch <= "9" then go to get_num; /* check for integer 0-9 */
if ch = "," then do; /* "," delimits line addresses */
ti = ti + 1; /* bump tw input line index */
acode = 2; /* indicate second address expected ("," seen) */
end;
if ch = ";" then do; /* ";" also delimits line addresses */
ti = ti + 1; /* bump tw input line index */
acode = 3; /* indicate second address expected (";" seen) */
end;
if evalsw then call eval; /* if numerically addressed line, get begin and end indices */
if li > lb & li < ft then
api = ft;
else api = li; /* exit from scan on comma or unrecognized character */
if le > lb & le < ft then
ape = ft;
else ape = le; /* return current line address */
ati = ti; /* update caller's tw line index to point after address */
return; /* normal return to caller (acode= 0, 1 or 2) */
reg_fail:
acode = 4; /* here if regular expression search failed */
return;
fail:
acode = 5; /* here on any other failure during address scan */
return;
%page;
reg:
if evalsw then call eval; /* if numerically addressed line, get begin and end indices first */
i = ti + 1; /* look for regular expression */
do ti = i to te; /* scan expression and try to find matching "/" */
if t.c (ti) = "/" then go to reg1; /* found match */
if t.c (ti) = "" then ti = ti + 1; /* skip next if conceal character */
else if t.c (ti) = "\" then
if te > ti then
if t.c (ti + 1) = "c" then ti = ti + 2;
/* two character conceal symbol */
end;
call ioa_ ("Syntax error in regular expression.");/* error if no terminal "/" found */
go to fail;
reg1:
j = ti - i; /* compute length of regular expression */
/* Processing is broken into two parts, starting in the top, and starting
in the bottom. Processing then enters into a string of part processing.
If in the bottom, we either search to whole bottom, or part of the bottom.
If searching the bottom, and we were in the top then we quit, else we search
the top next. Sounds complex (and it is) but perservere and the mud thins */
if le + 1 <= lb then do; /* we are starting in the bottom */
call search_section ((le + 1), (lb), (ft), (fe), (1), (le));
/* search rest bot, top, bot */
end;
else do;
call search_section ((le + 1), (fe), (1), (lb), (ft), (le));
end;
goto scan;
last:
if ft > fe & lb < 1 then go to scan; /* here after "$" found, find last line */
if fe < ft then
le = lb; /* look in the bottom */
else le = fe; /* set current line end to last character in buffer */
/* Modified last_line search to use index function across gapped buffer. */
li = le - 1; /* miss current nl */
retry:
if li >= ft then do;
last_index = index (reverse (substr (fp -> string, ft, li - ft + 1)), nl);
/* search upper */
if last_index = 0 then
if lb > 0 then do; /* move across gap to lower and re-try search */
li = lb;
goto retry;
end;
else do; /* this must be the first line */
li = ft;
goto scan; /* limit to section for line */
end;
end;
else do; /* search lower section */
if li < 1 then do; /* limit to 1st line */
li = 1;
goto scan;
end;
if li > lb then li = lb; /* force across gap */
last_index = index (reverse (substr (fp -> string, 1, li)), nl);
if last_index = 0 then do; /* not found - force to 1st character */
li = 1;
goto scan; /* continue address scan */
end;
end;
li = li - last_index + 1; /* setup start index */
/* correct for overstep */
if li = lb then
li = ft; /* force up */
else li = li + 1; /* correct for pointing at nl */
go to scan; /* and resume address scan */
neg:
negsw = "1"b; /* here after "-" found, note that minus sign seen */
go to scan; /* and continue address scan */
pos:
negsw = "0"b; /* here after "+" found, note that plus sign seen */
go to scan; /* and continue address scan */
get_num:
num = 0; /* here after digit (0-9) found */
do i = ti to te; /* convert ingeter to binary */
ch = t.c (i); /* pick up first or next digit of integer */
if ch < "0" then go to end_num; /* terminate conversion on first non-digit (0-9) */
if ch > "9" then go to end_num; /* .. */
digit = fixed (unspec (ch) & "000001111"b, 9);
/* get numerical portion of ascii digit */
num = (num * 10) + digit; /* convert into binary number */
end;
go to bad_addr; /* error if no nl character to terminate conversion */
end_num:
ti = i - 1; /* here after non-digit found, re-adjust line index */
evalsw = "1"b; /* set switch to later evaluate */
if ^relsw then do; /* if line number address is absolute */
li, le = 0; /* reset line indexes to beginning of buffer */
if num = 0 then li = 1; /* special case for 0th line of buffer (li=1, le=0) */
end;
if negsw then do; /* backup */
negsw = "0"b; /* first turn off sw */
temp_reg = temp_reg - num; /* then subtract */
end;
else temp_reg = temp_reg + num; /* else go forward */
go to scan; /* continue address scan */
eval:
proc;
/* Internal proceedure to evaluate numerical addresses and return character indices
of beginning and end of addressed line. */
evalsw = "0"b; /* numerical address evaluated */
if fe = 0 then
if temp_reg ^= 0 then do; /* check for empty buffer */
call ioa_ ("Buffer empty.");
go to fail;
end;
if temp_reg > 0 /* if positive address then go forward */
then do i = 1 to temp_reg; /* skip foreward temp_reg lines in buffer */
if le + 1 > lb & le + 1 < ft then /* move to upper half */
le = ft - 1;
retry_forward:
if le = fe then do; /* check if already at end of buffer */
call ioa_ ("Address out of buffer (too big).");
go to fail;
end;
li = le + 1; /* move line index foreward one line */
if li <= lb then do; /* search in bottom */
j = index (substr (fp -> string, li, (lb - li + 1)), nl);
/* find end of line */
if j = 0 & ft <= fe then do;
j = index (substr (fp -> string, ft, (fe - ft + 1)), nl);
/* find end of line split */
le = ft - 1; /* jump last end of line to start of top */
end;
end;
else j = index (substr (fp -> string, li, (fe - li + 1)), nl);
/* find end of line in top */
if j = 0 then
le = fe; /* worry about buffer with no nl on last line */
else le = le + j; /* otherwise, adjust index to last char of line in file */
end;
else do i = 1 to -temp_reg; /* loop to move backward temp_reg lines in buffer */
if li - 1 < ft & li - 1 > lb then /* move to lower buffer */
li = lb + 1;
if li = 1 then do; /* check if already at first line */
call ioa_ ("Address out of buffer (negative address).");
go to fail;
end;
le = li - 1; /* set current line end back one line */
/* Modified last_line search to use index function across gapped buffer. */
li = le - 1; /* miss current nl */
retry:
if li >= ft then do;
last_index = index (reverse (substr (fp -> string, ft, li - ft + 1)), nl);
/* search upper */
if last_index = 0 then
if lb > 0 then do; /* move across gap to lower and re-try search */
li = lb;
goto retry;
end;
else do; /* this must be the first line */
li = ft;
go to bk_next;
end;
end;
else do; /* search lower section */
if li < 1 then do;
li = 1; /* limit to 1st line */
go to bk_next;
end;
if li > lb then li = lb; /* force across gap */
last_index = index (reverse (substr (fp -> string, 1, li)), nl);
if last_index = 0 then do; /* not found - force to 1st character */
li = 1;
go to bk_next;
end;
end;
li = li - last_index + 1; /* setup start index */
/* correct for overstep */
if li = lb then
li = ft; /* force up */
else li = li + 1; /* correct for pointing at nl */
bk_next:
end;
temp_reg = 0; /* clear temp register before returning */
return;
end;
%page;
/* Search sections of the gapped text buffer. */
search_section:
proc (x1, y1, x2, y2, x3, y3);
dcl (x1, x2, x3, y1, y2, y3) fixed bin (21);
dcl (x, y, xx, yy) fixed bin (21);
/* search_section is a recursive searching routine which will search
each of up to three sections of text in turn and order. It is passed
a series of three indicies governing search extents, and then goes through
them to pick out a textual match. This routine is only called after i and
j have been setup to limit the search master string extents in the tw
buffer. */
/* At the end and return of search_section the values of li and le delimit
the matched line. Any other return is a non-local error exit goto. */
if x1 > lb & x1 < ft then
x = ft;
else x = x1;
if y1 > lb & y1 < ft then
y = ft;
else y = y1;
if y > x then do; /* and extent to search */
call qx_search_file_ (aqidp, tp, i, j, fp, x, y, li, le, lb, ft, code);
if code = 0 then goto breakout_line; /* string find - delimit line */
if code = 2 then goto fail; /* bad master search string */
end;
if x1 = 0 then goto reg_fail; /* couldn't find string in three tries */
call search_section ((x2), (y2), (x3), (y3), (0), (0));
return;
breakout_line:
le = index (substr (fp -> string, li, (y - li + 1)), nl);
/* delimit start and end of line containing text match. */
if le = 0 then do; /* section end without nl */
if x2 > lb & x2 < ft then
xx = ft;
else xx = x2;
if y2 > lb & y2 < ft then
yy = ft;
else yy = y2;
/* search in next section, if it exists, for end of line */
if xx > y then /* search superior section */
le = index (substr (fp -> string, xx, (yy - xx + 1)), nl);
if le = 0 then
le = y;
else le = xx + le - 1; /* find true end of line */
end;
else le = li + le - 1;
do li = (li - 1) by -1 to x; /* find previous nl */
if f.c (li) = nl then do;
li = li + 1;
return; /* found and delimited */
end;
end;
li = x; /* must be start of buffer */
end;
end get_addr_;

342
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/qedx.pl1 Executable file
View File

@@ -0,0 +1,342 @@
/****^ ***********************************************************
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1983 *
* *
*********************************************************** */
/* format: off */
/* Multics qedx Editor command interface */
/* Created: January 1983 by G. Palter as part of implementation of qedx_ subroutine interface */
/* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
qedx:
qx:
procedure () options (variable);
dcl argument character (argument_lth) unaligned based (argument_ptr);
dcl argument_ptr pointer;
dcl argument_lth fixed binary (21);
dcl (n_arguments, argument_idx) fixed binary;
dcl input_dirname character (168);
dcl input_ename character (32);
dcl input_component character (32);
dcl input_file_ptr pointer;
dcl exec_dirname character (168);
dcl exec_ename character (32);
dcl exec_component character (32);
dcl exec_buffer_bc fixed binary (24);
dcl exec_buffer_ptr pointer;
dcl args_buffer character (4 * sys_info$max_seg_size) based (args_buffer_ptr);
dcl args_buffer_used fixed binary (21);
dcl args_buffer_ptr pointer;
dcl 1 local_qi aligned, /* describes how we want the invocation setup */
2 header like qedx_info.header,
2 buffers (3) like qedx_info.buffers; /* 0, exec, args */
dcl ok_to_continue bit (1); /* command_query_$yes_no should have used aligned */
dcl (no_rw_path, have_pathname, have_macro_pathname, have_macro_arguments) bit (1) aligned;
dcl idx fixed binary;
dcl code fixed binary (35);
dcl invocation_level fixed binary static initial (0); /* # of active invocations of qedx */
dcl NL character (1) static options (constant) initial ("
");
dcl QEDX character (32) static options (constant) initial ("qedx");
dcl 1 RECURSION_EXPLANATION_SECTIONS aligned static options (constant),
2 part1 character (200) unaligned
initial ("There ^[are^;is^] ^d suspended invocation^[s^] of the qedx command which you have
interrupted (eg: by a quit signal) that are still active. If you
answer ""yes"" to this query, you will have an additio"),
2 part2 character (200) unaligned initial ("nal invocation of
qedx. Any changes that you have made to files in prior invocations
which you have not yet written will not be available to this new qedx.
In addition, any changes you make to files "),
2 part3 character (200) unaligned initial ("in this qedx which you are
also editing in prior invocations will not be reflected in those prior
invocations and could be lost if you later write out the same file in
one of those other invocations.
"),
2 part4 character (200) unaligned initial ("
We suggest that you answer ""no"" to this query and use either the
""start"" or ""program_interrupt"" command to resume one of your previous
invocations of qedx or that you use the ""release"" command to abo"),
2 part5 character (200) unaligned initial ("rt
those older invocations if you are certain there aren't any modified
buffers in them.
qedx: Do you wish to continue?");
dcl RECURSION_EXPLANATION character (920) defined (RECURSION_EXPLANATION_SECTIONS.part1) position (1);
/* last part is only 120 characters */
dcl sys_info$max_seg_size fixed binary (19) external;
/* format: off */
dcl (error_table_$badopt, error_table_$bigarg, error_table_$inconsistent, error_table_$noarg, error_table_$too_many_args)
fixed binary (35) external;
/* format: on */
dcl com_err_ entry () options (variable);
dcl command_query_$yes_no entry () options (variable);
dcl cu_$arg_count entry (fixed binary, fixed binary (35));
dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35));
dcl expand_pathname_$component entry (character (*), character (*), character (*), character (*), fixed binary (35));
dcl expand_pathname_$component_add_suffix
entry (character (*), character (*), character (*), character (*), character (*), fixed binary (35));
dcl get_temp_segment_ entry (character (*), pointer, fixed binary (35));
dcl initiate_file_$component
entry (character (*), character (*), character (*), bit (*), pointer, fixed binary (24), fixed binary (35));
dcl pathname_$component entry (character (*), character (*), character (*)) returns (character (194));
dcl qedx_ entry (pointer, fixed binary (35));
dcl release_temp_segment_ entry (character (*), pointer, fixed binary (35));
dcl terminate_file_ entry (pointer, fixed binary (24), bit (*), fixed binary (35));
dcl cleanup condition;
dcl (divide, length, index, null, substr, string) builtin;
%page;
/* qedx: qx: procedure () options (variable); */
call cu_$arg_count (n_arguments, code);
if code ^= 0 then do;
call com_err_ (code, QEDX);
return;
end;
if invocation_level > 0 then do; /* it would be nice to eliminate this... */
call command_query_$yes_no (ok_to_continue, 0, QEDX, RECURSION_EXPLANATION,
"There ^[are^;is^] ^d suspended invocation^[s^;^] of qedx in your process.^/Do you wish to continue?",
(invocation_level > 1), invocation_level, (invocation_level > 1));
if ^ok_to_continue then return;
end;
invocation_level = invocation_level + 1; /* another qedx */
input_file_ptr, /* for cleanup handler */
exec_buffer_ptr, args_buffer_ptr = null ();
on condition (cleanup) call cleanup_qedx_invocation ();
/* format: off */
/* Process arguments: syntax of the qedx command is --
qedx {-control_args} {macro_path {macro_arguments}} */
/* format: on */
no_rw_path, /* allow r/w with pathnames and R/W */
have_pathname, /* haven't seen -pathname yet */
have_macro_pathname, /* haven't seen first non-control argument yet */
have_macro_arguments = "0"b; /* haven't seen any macro arguments */
do argument_idx = 1 to n_arguments;
call cu_$arg_ptr (argument_idx, argument_ptr, argument_lth, code);
if code ^= 0 then do; /* sigh */
call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx);
go to RETURN_FROM_QEDX;
end;
if ^have_macro_pathname then /* no non-control argument yet: can still accept -ca's */
if index (argument, "-") = 1 then /* ... a control argument */
if argument = "-no_rw_path" then no_rw_path = "1"b;
else if argument = "-rw_path" then no_rw_path = "0"b;
else if (argument = "-pathname") | (argument = "-pn") then
if have_pathname then do;
call com_err_ (error_table_$too_many_args, QEDX,
"""-pathname"" may only be specified once for this command.");
go to RETURN_FROM_QEDX;
end;
else do; /* initial contents for buffer 0 ... */
have_pathname = "1"b;
if argument_idx = n_arguments then do;
call com_err_ (error_table_$noarg, QEDX, "Pathname after ""^a"".", argument);
go to RETURN_FROM_QEDX;
end;
argument_idx = argument_idx + 1;
call cu_$arg_ptr (argument_idx, argument_ptr, argument_lth, code);
if code ^= 0 then do;
call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx);
go to RETURN_FROM_QEDX;
end;
call expand_pathname_$component (argument, input_dirname, input_ename, input_component,
code);
if code ^= 0 then do;
call com_err_ (code, QEDX, "-pathname ^a", argument);
go to RETURN_FROM_QEDX;
end;
call initiate_file_$component (input_dirname, input_ename, input_component, R_ACCESS,
input_file_ptr, (0), code);
if code ^= 0 then do; /* the file doesn't exist (sigh) */
call com_err_ (code, QEDX, "-pathname ^a",
pathname_$component (input_dirname, input_ename, input_component));
go to RETURN_FROM_QEDX;
end;
call terminate_file_ (input_file_ptr, 0, TERM_FILE_TERM, (0));
input_file_ptr = null ();
end;
else do;
call com_err_ (error_table_$badopt, QEDX, """^a""", argument);
go to RETURN_FROM_QEDX;
end;
else do; /* first non-control argument: macro pathname */
have_macro_pathname = "1"b;
call expand_pathname_$component_add_suffix (argument, QEDX, exec_dirname, exec_ename,
exec_component, code);
if code ^= 0 then do;
call com_err_ (code, QEDX, "Macro file: ^a", argument);
go to RETURN_FROM_QEDX;
end;
call initiate_file_$component (exec_dirname, exec_ename, exec_component, R_ACCESS,
exec_buffer_ptr, exec_buffer_bc, code);
if code ^= 0 then do; /* the file doesn't exist (sigh) */
call com_err_ (code, QEDX, "Macro file: ^a",
pathname_$component (exec_dirname, exec_ename, exec_component));
go to RETURN_FROM_QEDX;
end;
end;
else do; /* Nth non-control argument: a macro argument */
if ^have_macro_arguments then do; /* ... first macro argument */
call get_temp_segment_ (QEDX, args_buffer_ptr, code);
if code ^= 0 then do;
call com_err_ (code, QEDX, "Obtaining buffer space for macro arguments.");
go to RETURN_FROM_QEDX;
end;
args_buffer_used = 0;
have_macro_arguments = "1"b;
end;
call add_to_args_buffer (argument);
call add_to_args_buffer (NL);
end;
end;
if no_rw_path & ^have_pathname then do;
call com_err_ (error_table_$inconsistent, QEDX, """-no_rw_path"" must be used with ""-pathname"".");
go to RETURN_FROM_QEDX;
end;
/* Arguments have been validated: setup qedx_info data structure and invoke qedx_ */
local_qi.header.version = QEDX_INFO_VERSION_1;
local_qi.header.editor_name = QEDX;
string (local_qi.header.flags) = ""b;
local_qi.header.no_rw_path = no_rw_path;
local_qi.header.query_if_modified = "1"b; /* finally after all these years ... */
local_qi.header.n_buffers = 0; /* no initial buffers yet */
if have_pathname then do; /* include a buffer 0 containing requested file ... */
local_qi.header.n_buffers, idx = 1;
local_qi.buffers (idx).buffer_name = "0";
local_qi.buffers (idx).buffer_pathname = pathname_$component (input_dirname, input_ename, input_component);
string (local_qi.buffers (idx).flags) = ""b;
end;
if have_macro_pathname then do; /* exec buffer containing a macro to execute ... */
local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1;
local_qi.buffers (idx).buffer_name = "exec";
local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */
local_qi.buffers (idx).region_ptr = exec_buffer_ptr;
local_qi.buffers (idx).region_max_lth, /* ... get size from the system */
local_qi.buffers (idx).region_initial_lth = divide ((exec_buffer_bc + 8), 9, 21, 0);
string (local_qi.buffers (idx).flags) = ""b;
local_qi.buffers (idx).read_write_region, local_qi.buffers (idx).execute_buffer = "1"b;
end; /* ... get initial content from us but can't write back */
if have_macro_arguments then do; /* a "file" of arguments to the macro ... */
local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1;
local_qi.buffers (idx).buffer_name = "args";
local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */
local_qi.buffers (idx).region_ptr = args_buffer_ptr;
local_qi.buffers (idx).region_max_lth, local_qi.buffers (idx).region_initial_lth = args_buffer_used;
string (local_qi.buffers (idx).flags) = ""b;
local_qi.buffers (idx).read_write_region = "1"b;
end; /* ... get initial content from us but can't write back */
call qedx_ (addr (local_qi), code); /* INVOKE THE EDITOR */
RETURN_FROM_QEDX:
call cleanup_qedx_invocation ();
return;
%page;
/* Add a character string to the macro arguments buffer */
add_to_args_buffer:
procedure (p_string);
dcl p_string character (*) parameter;
if (args_buffer_used + length (p_string)) > length (args_buffer) then do;
call com_err_ (error_table_$bigarg, QEDX, "Too many macro arguments. First failing argument: ""^a"".",
argument);
go to RETURN_FROM_QEDX;
end;
substr (args_buffer, (args_buffer_used + 1), length (p_string)) = p_string;
args_buffer_used = args_buffer_used + length (p_string);
return;
end add_to_args_buffer;
/* Cleanup after an invocation of qedx */
cleanup_qedx_invocation:
procedure ();
if input_file_ptr ^= null () then do; /* a very small window nonetheless ... */
call terminate_file_ (input_file_ptr, 0, TERM_FILE_TERM, (0));
input_file_ptr = null ();
end;
if exec_buffer_ptr ^= null () then do;
call terminate_file_ (exec_buffer_ptr, 0, TERM_FILE_TERM, (0));
exec_buffer_ptr = null ();
end;
if args_buffer_ptr ^= null () then do;
call release_temp_segment_ (QEDX, args_buffer_ptr, (0));
args_buffer_ptr = null ();
end;
invocation_level = invocation_level - 1; /* all gone */
return;
end cleanup_qedx_invocation;
%page;
%include qedx_info;
%page;
%include access_mode_values;
%include terminate_file;
end qedx;

2162
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/qedx_.pl1 Executable file
View File

File diff suppressed because it is too large Load Diff

542
multics/library_dir_dir/system_library_1/source/bound_qedx_.s.archive/search_file_.pl1 Executable file
View File

@@ -0,0 +1,542 @@
/****^ ***********************************************************
* *
* Copyright, (C) Honeywell Bull Inc., 1987 *
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
* Copyright (c) 1972 by Massachusetts Institute of *
* Technology and Honeywell Information Systems, Inc. *
* *
*********************************************************** */
/* format: off */
/* search_file_ ... qedx utility procedure to search addressed portion of buffer with specified regular expression */
/* This procedure parses a regular expression and stores an executable version of same in its internal storage.
A regular expression can contain up to 132 characters and up to 20 subexpressions as defined below.
Certain special cases are recognized and optimized. The follow subexpressions are currently supported:
Type Meaning
0 The first string search of the regular expression.
1 The first string search of the regular expression has an initial newline. Anchor search to the
beginning of a line.
2 A string search following a dot-star subexpression.
3 A string search following a star or dot subexpression.
4 A star subexpression.
5 A dot subexpression. */
/* The following non-standard error codes are returned by search_file_:
1 Search failed.
2 Invalid syntax in a regular expression. (A message is always printed.)
*/
/* Initial coding by R. C. Daley, August 1970 */
/* Recoded in V2 PL/I by D. S. Levin, August 1974 */
/* Modified for gapped buffer first line detection by T. Oke 80-07-14. */
/* Changes merged and edited 03/03/82 S. Herbst */
/* Fixed argument reference bug 11/03/82 S. Herbst */
/* Added $silent 11/12/82 S. Herbst */
/* Modified: January 1983 by G. Palter to make reentrant and always return standard codes for $silent entrypoint */
/* format: on,style4,delnl,insnl,ifthenstmt,ifthen */
/* Previous compatability entry point for mail system use */
search_file_:
proc (atp, ati, atl, afp, afi, afe, ami, ame, acode);
dcl atp ptr, /* Pointer to string containing regular expression. */
ati fixed bin (21), /* Index of first character of regular expression. */
atl fixed bin (21), /* Length of regular expression. */
afp ptr, /* Pointer to buffer file to be searched. */
afi fixed bin (21), /* Index of first character to be searched. */
afe fixed bin (21), /* Index of last character to be searched. */
ami fixed bin (21), /* Index of first character of string matched (Output). */
ame fixed bin (21), /* Index of last character of string matched (Output). */
alb fixed bin (21), /* start of lower buffer */
aft fixed bin (21), /* start of upper buffer */
acode fixed bin (35), /* Error status code (Output) */
P_qid_ptr pointer parameter; /* -> qedx internal data */
dcl (tp, fp) ptr, /* Automatic storage. */
silent_sw bit (1), /* ON for search_file_$silent */
(lb, ft, ti, tl, te, fi, fe, j) fixed bin (21),
match_start (20) fixed bin (21), /* Index of first character of match. */
reentry_point (20) fixed bin (21), /* Restart or reentry stack. Reenter if element ^= 0. */
(i, l, type, st, last_string, last_star) fixed bin;
dcl 1 rd aligned based (rd_ptr), /* completely describes a regular expression */
2 reg_info (20),
3 search_char char (1) unal,
3 len fixed bin (8) unaligned,
3 start fixed bin (8) unaligned,
3 search_type fixed bin (8) unaligned,
2 regl fixed binary (21), /* length of the regular expression */
2 omit_newline bit (1) aligned, /* differentiates between $ and \cNL */
2 reg character (132); /* string accumulator */
dcl rd_ptr pointer;
dcl 1 external_rd static aligned like rd; /* for use by non-qedx entrypoints */
dcl first_call bit (1) aligned static initial ("1"b); /* ... so non-qedx entrypoints can initialize above */
dcl /* Constants. */
special_char char (5) aligned internal static initial (".*\$"),
/* 5th character is \c. */
nl char (1) aligned internal static initial ("
");
dcl exp char (te) based aligned;
dcl text char (fe) based aligned;
dcl error_table_$nomatch fixed binary (35) external;
dcl error_table_$regexp_invalid_star fixed bin (35) ext;
dcl error_table_$regexp_too_complex fixed bin (35) ext;
dcl error_table_$regexp_too_long fixed bin (35) ext;
dcl error_table_$regexp_undefined fixed bin (35) ext;
dcl ioa_ entry options (variable);
dcl (hbound, index, length, search, substr, unspec, verify) builtin;
%page;
silent_sw = "0"b; /* normal entry point prints error messages */
go to RETAINED_COMMON;
silent:
entry (atp, ati, atl, afp, afi, afe, ami, ame, acode);
silent_sw = "1"b;
RETAINED_COMMON:
lb = afe; /* presets lb and ft for single buffer */
ft = lb + 1; /* first section full, second section empty */
rd_ptr = addr (external_rd); /* use non-qedx saved expression (if any) */
if first_call then do; /* ... need to initialize the expression */
first_call = "0"b;
rd.regl = 0; /* ... no initial saved expression */
end;
go to COMMON;
/* qedx only */
qx_search_file_:
entry (P_qid_ptr, atp, ati, atl, afp, afi, afe, ami, ame, alb, aft, acode);
silent_sw = "0"b; /* qedx relies on this entrypoint to print error messages */
lb = alb;
ft = aft;
qid_ptr = P_qid_ptr; /* get saved regular expression (if any) */
rd_ptr = qid.regexp_data_ptr;
COMMON:
tp = atp; /* Pointer to string containing regular expression. */
ti = ati; /* Index of first character of regular expression. */
tl = atl; /* Length of regular expression. */
fp = afp; /* Pointer to buffer area to be searched. */
fi = afi; /* Index of first character of area to be searched. */
fe = afe; /* Index of last character of area to be searched. */
if tl = 0 /* Check for null regular expression "//". */
then if rd.regl > 0 /* "//" given, use previous regular expression if any. */
then go to match;
else do;
if silent_sw then
acode = error_table_$regexp_undefined;
else call ioa_ ("// undefined in regular expression.");
/* Error, // and no previous regular expression. */
fatal:
rd.regl = 0; /* No previous regular expression. */
if ^silent_sw then acode = 2; /* Fatal error. Cannot be retried. */
return;
end;
te = ti + tl - 1; /* Get index of last character of regular expression. */
st = 1; /* Initialize string accumulator length to zero. */
l = 0; /* Initialize sub-expression string length to zero. */
type = 0; /* Assume simple expression until we know otherwise. */
if substr (tp -> exp, ti, 1) = "^" /* Anchor to the beginning of line? */
then do; /* Yes, make first character a newline. */
type = 1; /* String must begin at newline. */
ti = ti + 1; /* Get next character. */
substr (rd.reg, 1, 1) = nl; /* First character is a newline. */
st = st + 1; /* Length does not include newline. */
end;
rd.regl = 0; /* Initialize to no subexpressions. */
last_string = 0; /* Index to immediately previous string search. */
last_star = 0; /* Index to immediately previous star subexpression. */
rd.omit_newline = "0"b; /* No "$" found. Do not shorten matched string. */
parse_expression: /* Parse the regular expression, forming subexpressions. */
tl = te - ti + 1; /* Get the length of the remainder of the RE. */
if tl <= 0 then goto expression_parsed; /* No more regular expr. Go execute what we have. */
i = search (substr (tp -> exp, ti, tl), special_char) - 1;
/* Find first special character. */
if i < 0 then i = tl; /* None found. Get number of remaining characters. */
if i > 0 /* If count is nonzero, add those characters to string. */
then do;
if st + l + i > length (rd.reg) then go to long_string;
/* Can't store all those characters. */
substr (rd.reg, st + l, i) = substr (tp -> exp, ti, i);
/* Add the characters to the string. */
l = l + i; /* Bump the string length. */
ti = ti + i; /* Skip those characters in the regular expression. */
if ti > te then go to expression_parsed; /* If no special characters then done parsing. */
end;
go to special_case (index (special_char, substr (tp -> exp, ti, 1)));
/* Go to appropriate routine. */
special_case (1): /* Period or dot. */
call end_sub_expression; /* Previous string search must be terminated. */
i = 0; /* Initialize to only one occurance of dot. */
tl = te - ti + 1; /* Get the length of the remainder of the RE. */
if tl - 1 > 0 then i = verify (substr (tp -> exp, ti + 1, tl - 1), ".");
/* Count all following dots. */
if i = 0 then i = tl; /* This equals the total number of dots. */
ti = ti + i; /* Skip over all the dots. */
if ti <= te then
if substr (tp -> exp, ti, 1) = "*" /* Last dot is part of ".*". */
then do;
type = 2; /* Indicates next string search is preceeded by ".*". */
ti = ti + 1; /* Skip over "*". */
i = i - 1; /* Reduce dot count by one. */
end;
if i > 0 then call builder (5, i); /* Dot subexpression. Dot-star stored by end_sub_expression */
if type ^= 2 then type = 3; /* No dot-star, just a normal string search. */
go to parse_expression; /* Continue. */
special_case (2): /* Asterisk or star. */
if l = 0 /* No character precedes the star. */
then do;
if silent_sw then
acode = error_table_$regexp_invalid_star;
else call ioa_ ("Invalid use of * in regular expression.");
go to fatal;
end;
l = l - 1; /* The character must be removed from previous string. */
ti = ti + 1; /* Skip the star. */
call end_sub_expression; /* Build search subexpression for previous string. */
if type = 2 then go to parse_expression; /* Do not build if star preceded by dot-star. */
if rd.regl > 0 & rd.regl = last_star /* Do not build if previous subexpression is identical. */
then if rd.reg_info (last_star).search_char = substr (rd.reg, st, 1) then go to parse_expression;
call builder (4, 0); /* A star subexpression. */
last_star = rd.regl; /* This is now the most recent star subexpression. */
rd.reg_info (last_star).search_char = substr (rd.reg, st, 1);
/* Store character for star subexpression. */
type = 3; /* No dot-star, just a normal string search. */
go to parse_expression; /* Continue the parse. */
special_case (3): /* Backslash. Could be part of \c or \C. */
if ti = te then go to store_char; /* Obviously no character follows it. */
if substr (tp -> exp, ti + 1, 1) ^= "c" & substr (tp -> exp, ti + 1, 1) ^= "C" then go to store_char;
ti = ti + 1; /* Found "\c" or "\C". Skip the backslash. */
special_case (5): /* Backslash-c as single character. */
ti = ti + 1; /* Skip the "\c", or skip "c" from above. */
store_char: /* Add a single character to the string being created. */
if st + l = length (rd.reg) /* Check for string overflow. */
then do;
long_string: /* Expression has too many characters. */
if silent_sw then
acode = error_table_$regexp_too_long;
else call ioa_ ("Regular expression is too long.");
go to fatal;
end;
substr (rd.reg, st + l, 1) = substr (tp -> exp, ti, 1);
/* Add the character. */
ti = ti + 1; /* Continue scan with next character. */
l = l + 1; /* Bump string length. */
go to parse_expression; /* Continue parse. */
special_case (4): /* Dollar sign or end of line anchor. */
if ti ^= te then go to store_char; /* Special meaning only at end of expression. */
rd.omit_newline = "1"b; /* Found a "$". Omit newline at end of string. */
if st + l = length (rd.reg) then go to long_string;
/* No room. */
substr (rd.reg, st + l, 1) = nl; /* Store a newline to provide the anchor. */
l = l + 1; /* Adjust string length. */
ti = ti + 1; /* Now we are done. */
/* End of parsing loop. */
expression_parsed:
call end_sub_expression; /* Create final search subexpression, if any. */
if type = 2 then call builder (2, 0); /* Dot-star is last subexpression of RE. */
%page;
match:
if fe = 0 | fi > fe then go to fail; /* Search fails on empty buffer. */
do i = 1 to rd.regl; /* Reset the reentry stack to no reentry points. */
reentry_point (i) = 0;
end;
restart_search: /* Match the entire regular expression. */
match_start (1) = fi; /* Assume expression is anchored. */
i = 1; /* Initialize to first subexpression. */
st = 1; /* Start at the beginning of the string accumulator. */
te = fi - 1; /* Initialize to zero length string. */
search_loop:
tl = fe - fi + 1; /* Get length of remainder of the text buffer. */
l = rd.reg_info (i).len; /* Get length field. */
go to string_search (rd.reg_info (i).search_type);/* Execute the subexpression. */
string_search (0): /* Initial search without initial newline. */
if l > tl then go to fail; /* Not enough characters to satisfy the match. */
j = index (substr (fp -> text, fi, tl), substr (rd.reg, 1, l)) - 1;
/* Find occurance of the string. */
if j < 0 then go to fail; /* Not there. Search fails. */
st = st + l; /* Skip over string in accumulator. */
go to found_first_match; /* Go save all information about first match. */
string_search (1): /* Initial search with initial newline. */
if fi > 1 & (lb > 0 | fi ^= ft) then do; /* not first line of buffer */
if (lb > 0 & fi = ft) then do; /* pointers will be valid for check */
if substr (fp -> text, lb, 1) = nl then goto nl_found;
/* nl end of first section */
end;
else if substr (fp -> text, fi - 1, 1) = nl then goto nl_found;
/* nl is previous char */
j = index (substr (fp -> text, fi, tl), nl); /* Search for newline. */
if j = 0 then go to fail; /* No more lines. Search fails. */
fi = fi + j; /* Go to first character after newline. */
tl = tl - j; /* Reduce the buffer length. */
if tl <= 0 then go to fail; /* That newline was the last character in buffer. */
end;
nl_found:
st = st + l + 1; /* Point to next string. Skip this string and newline. */
j = 0; /* Offset if string matches the current line. */
if l = 0 then go to found_first_match; /* Just had to find the beginning of a line. */
if l > tl then go to fail; /* Not enough characters to satisfy the match. */
if substr (fp -> text, fi, l) ^= substr (rd.reg, 2, l)
/* Check this line but omit newline. */
then do; /* Not in current line. Search remainder of buffer. */
j = index (substr (fp -> text, fi, tl), substr (rd.reg, 1, l + 1));
/* Include the newline in the search. */
if j = 0 then go to fail; /* Not found in buffer. Search fails. */
end;
found_first_match:
match_start (1) = fi + j; /* This is first search. The match starts here. */
go to found_field; /* Get next subexpression. */
string_search (2): /* Dot-star string search. Match as few characters as possible. */
if l = 0 /* If length is zero, then RE ends with ".*". */
then do; /* Treat like ".*$". */
te = fi + index (substr (fp -> text, fi, tl), nl) - 2;
/* Find end of the current line, without newline. */
if te < fi - 1 then te = fe; /* No newline, take the rest of the buffer. */
go to next_field; /* Pretend there is something next. */
end;
if l > tl then go to fail_reset; /* Must have enough characters for the match. */
j = index (substr (fp -> text, fi, tl), substr (rd.reg, st, l)) - 1;
/* Find a match. */
if j < 0 then go to fail_reset; /* None found. Could be someone else's fault. */
te = 0; /* If offset is zero, there is no newline. */
if j > 0 then te = index (substr (fp -> text, fi, j), nl);
/* Dot does not match a newline. */
if te > 0 /* At least one intervening newline. */
then do; /* Advance one line and try again. */
fi = fi + te; /* Point to next line. */
reentry_point (i) = 0; /* Remove from stack until needed. */
go to restart_search; /* Try to match entire RE. */
end;
reentry_point (i) = fi + j + 1; /* Stack a reentry point if future subexpression fails. */
st = st + l; /* Advance string offset pointer. */
go to found_field; /* Tell everyone we found something. */
string_search (3): /* Search subexpression. Match string at current buffer position. */
if l > tl then go to fail_retry; /* Cannot match if not enough characters. */
j = 0; /* Offset if the following is a match. */
if substr (fp -> text, fi, l) ^= substr (rd.reg, st, l) then go to fail_retry;
/* Do they match? */
st = st + l; /* Skip over string in accumulator. */
go to found_field; /* Get next subexpression. */
string_search (4): /* Star subexpression. Match as many of a particular character as possible. */
reentry_point (i) = 0; /* Assume a match on zero length string. */
if tl <= 0 then go to next_field; /* Match a zero length string. */
match_start (i) = fi; /* Match starts at current buffer position. */
l = verify (substr (fp -> text, fi, tl), rd.reg_info (i).search_char) - 1;
/* Count the occurances. */
if l < 0 then l = tl; /* Rest of buffer is a match. */
if l = 0 then go to next_field; /* Matches a zero length string. */
reentry_point (i) = fi + l - 1; /* Restart point matches one fewer characters. */
j = 0; /* String offset for the match. */
go to found_field;
string_search (5): /* Dots. */
if tl < l then go to fail_retry; /* Must have enough characters. */
j = 0; /* Offset. */
if index (substr (fp -> text, fi, l), nl) ^= 0 /* Dot does not match a newline. */
then go to fail_retry; /* Dot does not match a newline. */
found_field: /* Code to store a match. */
fi = fi + j + l; /* Next search will begin immediately after match. */
te = fi - 1; /* Address of last matched character. */
next_field: /* Get next subexpression. */
i = i + 1; /* Bump subexpression counter. */
if i <= rd.regl then go to search_loop; /* Execute next subexpression or match SUCCEEDS! */
if rd.omit_newline /* If last char is "$", do not match final newline. */
then te = te - 1; /* Match the line without the newline character. */
ami = match_start (1); /* Return index of first character matched. */
ame = te; /* Return index of last character matched. */
acode = 0;
return;
fail_reset: /* A reentry point is no longer valid. Reset it. */
reentry_point (i) = 0;
fail_retry: /* A subexpression failed. Iterate if possible. */
i = i - 1; /* Try previous subexpression. */
if i <= 0 then do;
match_start (1) = match_start (1) + 1; /* Restart one character further in. */
if match_start (1) > fe /* Search fails on empty buffer. */
then do;
fail: /* Regular expression cannot be matched. */
if silent_sw then
acode = error_table_$nomatch; /* always return standard codes for search_file_$silent */
else acode = 1;
return;
end;
fi = match_start (1); /* Get new starting offset. */
go to restart_search;
end;
fi = reentry_point (i); /* Pick up a potential restart point. */
if fi = 0 then go to fail_retry; /* Must be a useful restart point. */
st = rd.reg_info (i).start; /* It's OK. Reset the string accumulator offset. */
if rd.reg_info (i).search_type = 2 then go to search_loop;
/* It's ".*". Go find next occurrence of string. */
if reentry_point (i) < match_start (i) then go to fail_reset;
/* It's "a*". No restart if no a's matched. */
reentry_point (i) = reentry_point (i) - 1; /* Decrement number of a's matched. */
go to next_field;
%page;
/* Initializes qedx per-invocation regular expression data */
init:
entry (P_qid_ptr);
qid_ptr = P_qid_ptr;
allocate rd in (editor_area) set (rd_ptr);
rd.regl = 0; /* no saved regular expression yet */
qid.regexp_data_ptr = rd_ptr;
return;
/* Terminates qedx per-invocation regular expression data */
cleanup:
entry (P_qid_ptr);
qid_ptr = P_qid_ptr;
if qid.regexp_data_ptr ^= null () then do;
free qid.regexp_data_ptr -> rd in (editor_area);
qid.regexp_data_ptr = null ();
end;
return;
%page;
/* Creates current search subexpression */
end_sub_expression:
procedure ();
dcl (dot_count, ir) fixed bin;
if l > 0 | type = 1 /* If current search string subexpression outstanding. */
then do;
if type = 2 /* A string search preceded by ".*". */
then do;
dot_count = 0; /* initialize to no dots. */
do ir = rd.regl to last_string + 1 by -1;
/* Scan the RE. */
if rd.reg_info (ir).search_type = 5/* A dot subexpressionn. */
then dot_count = dot_count + rd.reg_info (ir).len;
/* Add in its count. */
else if rd.reg_info (ir).search_type ^= 4
/* A star subexpression. */
then go to done_dot_star;
rd.regl = rd.regl - 1; /* Remove dot or star subexpression from RE. */
end;
done_dot_star:
if dot_count > 0 then call builder (5, dot_count);
/* Build dot subexpression if necessary. */
last_star = 0; /* Forget about those star subexpressions. */
end;
if last_string = rd.regl - 1 & last_star = rd.regl
/* Optimize ab*b to abb*. Also b*b to bb*. */
then do;
ir = verify (substr (rd.reg, st, l), rd.reg_info (last_star).search_char) - 1;
if ir < 0 then ir = l; /* Entire string matches the character. */
if ir > 0 /* Move the matches to the previous string. */
then do;
if last_string = 0 /* Oops, there was really no previous string. */
then do; /* Guess we'll have to make one. */
last_string = 1; /* String search is first subexpression. */
unspec (rd.reg_info (2)) = unspec (rd.reg_info (1));
/* Copy star subexpression. */
last_star = last_star + 1; /* Remember that. */
rd.reg_info (2).start = ir + 1;
/* Set the correct accumulator offset. */
rd.reg_info (1).search_type = 0;
/* First subexpression is a string search. */
rd.regl = 2; /* Now there are two subexpressions. */
end;
rd.reg_info (last_string).len = rd.reg_info (last_string).len + ir;
/* Add to previous string length. */
st = st + ir; /* Bump offset pointer. */
l = l - ir; /* Reduce string length. */
if l = 0 then return; /* String is eliminated. */
end;
end;
call builder (type, l); /* Any type of search string subexpression. */
type = 3; /* Set to 3 in case it was 0, 1, or 2. */
last_string = rd.regl; /* Remember position of last string. */
st = st + l; /* Bump accumulator offset. */
l = 0; /* Initialize string length to zero. */
end;
return;
end end_sub_expression;
%page;
/* Creates any subexpression */
builder:
procedure (id, size);
dcl (id, size) fixed bin;
if rd.regl = hbound (rd.reg_info, 1) /* Insure we have not exceeded the stack. */
then do;
if silent_sw then
acode = error_table_$regexp_too_complex;
else call ioa_ ("Regular expression is too complex.");
go to fatal;
end;
rd.regl = rd.regl + 1; /* Bump stack size. */
rd.reg_info (rd.regl).search_type = id; /* Store type of subexpression. */
rd.reg_info (rd.regl).len = size; /* Store length of the subexpression. */
rd.reg_info (rd.regl).start = st; /* Store accumulator offset. */
return;
end builder;
%page;
%include qedx_internal_data;
end search_file_;

115
multics/library_dir_dir/system_library_unbundled/source/bound_linus_.2.s.archive/linus_qedx.pl1 Executable file
View File

@@ -0,0 +1,115 @@
/* ***********************************************************
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
*********************************************************** */
/* format: off */
%skip(3);
/* This is the main level procedure called by ssu_ to implement the
linus qedx request. Description and usage follows.
Description:
This request allows a user to edit the current query or a new query
through the qedx editor.
Usage: qedx -new | -old
The control argument -new specifies that the user should start off with
an empty query. The control argument -old specifies that the user should
use the existing query. -old is the default.
Both parameters are passed to this request by ssu_.
Known Bugs:
Other Problems:
History:
Written - Al Dupuis - August 1983
*/
%page;
linus_qedx: proc (
sci_ptr_parm, /* input: ptr to the subsystem control info structure */
lcb_ptr_parm /* input: ptr to the linus control block info structure */
);
%skip(1);
dcl sci_ptr_parm ptr parm;
dcl lcb_ptr_parm ptr parm;
%skip(1);
/*
Mainline Processing Overview:
(1) Check to make sure a data base is open. Process control args.
(2) Get the subroutine to qedx the query.
*/
%skip(1);
call initialize;
%skip(1);
call linus_qedx_the_query (lcb_ptr, new_or_old_query_flag);
%skip(1);
return;
%page;
initialize: proc;
%skip(3);
sci_ptr = sci_ptr_parm;
lcb_ptr = lcb_ptr_parm;
%skip(1);
if lcb.db_index = 0
then call ssu_$abort_line (sci_ptr, linus_error_$no_db);
%skip(1);
new_or_old_query_flag = OFF;
%skip(1);
call ssu_$arg_count (sci_ptr, number_of_args_supplied);
if number_of_args_supplied = 0
then return;
%skip(1);
do current_arg_number = 1 to number_of_args_supplied;
call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length);
if arg = "-new"
then new_or_old_query_flag = ON;
else if arg = "-old"
then new_or_old_query_flag = OFF;
else call ssu_$abort_line (sci_ptr, error_table_$badopt,
"^/Unrecognized control argument ^a.", arg);
end;
%skip(1);
return;
%skip(1);
end initialize;
%page;
dcl OFF bit (1) aligned static internal options (constant) init ("0"b);
dcl ON bit (1) aligned static internal options (constant) init ("1"b);
%skip(1);
dcl addr builtin;
dcl arg char (arg_length) based (arg_ptr);
dcl arg_length fixed bin (21);
dcl arg_ptr ptr;
%skip(1);
dcl current_arg_number fixed bin;
%skip(1);
dcl error_table_$badopt fixed bin(35) ext static;
%skip(1);
dcl fixed builtin;
%skip(1);
dcl linus_error_$no_db fixed bin(35) ext static;
dcl linus_qedx_the_query entry (ptr, bit(1) aligned);
%skip(1);
dcl new_or_old_query_flag bit (1) aligned;
dcl number_of_args_supplied fixed bin;
%skip(1);
dcl rel builtin;
%skip(1);
dcl sci_ptr ptr;
dcl ssu_$abort_line entry() options(variable);
dcl ssu_$arg_count entry (ptr, fixed bin);
dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21));
dcl sys_info$max_seg_size fixed bin(35) ext static;
%page;
%include linus_lcb;
%skip(3);
end linus_qedx;

168
multics/library_dir_dir/system_library_unbundled/source/bound_linus_.2.s.archive/linus_qedx_the_query.pl1 Executable file
View File

@@ -0,0 +1,168 @@
/* ***********************************************************
* *
* Copyright, (C) Honeywell Information Systems Inc., 1982 *
* *
*********************************************************** */
/* format: off */
%skip(3);
/* This is the subroutine called by requests to implement the
qedx'ing of the current query. Description and usage follows.
Description:
This subroutine takes the current query and calls qedx_ with it in
a buffer, or calls qedx with an empty buffer depending on the setting
of the second parameter. Unless the user did a quit_force the edited
query replaces the original.
Usage: call linus_qedx_the_query (lcb_ptr, new_query_flag);
lcb_ptr - input - pointer to linus control block structure
new_query_flag - input - on means start a new query, off means use the old
Known Bugs:
Other Problems:
History:
Written - Al Dupuis - August 1983
*/
%page;
linus_qedx_the_query: proc (
lcb_ptr_parm, /* input: ptr to the linus control block info structure */
new_flag_parm /* input: on if caller wants to start with a new query */
);
%skip(3);
dcl lcb_ptr_parm ptr parm;
dcl new_flag_parm bit (1) aligned parm;
%skip(3);
/*
Mainline Processing Overview:
(1) Get the current query placed in a temp segment, or get an empty
temp segment if there is no current query. Set the temp segment
length to zero if a new query was requested.
(2) Fill in the qedx_information structure.
(3) Call qedx and let the user do some editing.
(4) If user didn't do a quit force then make the result of editing
the current query.
*/
%skip(1);
call initialize;
call call_qedx;
if query_should_be_replaced
then do;
call linus_query_mgr$put (lcb_ptr, query_segment_ptr,
qedx_information.buffers (1).region_final_lth, code);
if code ^= 0
then call ssu_$abort_line (sci_ptr, code);
else;
end;
else;
%skip(1);
return;
%page;
call_qedx: proc;
%skip(1);
query_should_be_replaced = OFF;
call qedx_ (addr (qedx_information), code);
if code ^= 0
then if code = error_table_$fatal_error
then call ssu_$abort_line (sci_ptr, 0);
else if code = error_table_$recoverable_error
then if qedx_information.flags.quit_forced
then return;
else;
else call ssu_$abort_line (sci_ptr, 0);
else;
%skip(1);
query_should_be_replaced = ON;
%skip(1);
return;
%skip(1);
end call_qedx;
%page;
initialize: proc;
%skip(3);
lcb_ptr = lcb_ptr_parm;
new_query = new_flag_parm;
sci_ptr = lcb.subsystem_control_info_ptr;
%skip(1);
call linus_query_mgr$get (lcb_ptr, query_segment_ptr,
query_segment_length, code);
if code ^= 0
then if code = linus_error_$no_current_query
then;
else call ssu_$abort_line (sci_ptr, code);
else;
%skip(1);
if new_query
then query_segment_length = 0;
%skip(1);
qedx_information.header.version = QEDX_INFO_VERSION_1;
qedx_information.editor_name = "linus (qedx)";
unspec (qedx_information.header.flags) = OFF;
qedx_information.header.flags.query_if_modified = ON;
qedx_information.n_buffers = 1;
%skip(1);
qedx_information.buffers (1).buffer_name = "0";
qedx_information.buffers (1).buffer_pathname = "<linus query>";
qedx_information.buffers (1).region_ptr = query_segment_ptr;
qedx_information.buffers (1).region_max_lth = sys_info$max_seg_size * 4;
qedx_information.buffers (1).region_initial_lth = query_segment_length;
%skip(1);
unspec (qedx_information.buffers (1).flags) = OFF;
qedx_information.buffers (1).flags.read_write_region = ON;
qedx_information.buffers (1).flags.locked_pathname = ON;
qedx_information.buffers (1).flags.default_read_ok = ON;
qedx_information.buffers (1).flags.default_write_ok = ON;
%skip(1);
return;
%skip(1);
end initialize;
%page;
dcl OFF bit (1) aligned static internal options (constant) init ("0"b);
dcl ON bit (1) aligned static internal options (constant) init ("1"b);
%page;
dcl addr builtin;
%skip(1);
dcl code fixed bin (35);
%skip(1);
dcl error_table_$fatal_error fixed bin(35) ext static;
dcl error_table_$recoverable_error fixed bin(35) ext static;
%skip(1);
dcl fixed builtin;
%skip(1);
dcl linus_error_$no_current_query fixed bin(35) ext static;
dcl linus_query_mgr$get entry (ptr, ptr, fixed bin(21), fixed bin(35));
dcl linus_query_mgr$put entry (ptr, ptr, fixed bin(21), fixed bin(35));
%skip(1);
dcl new_query bit (1) aligned;
%skip(1);
dcl qedx_ entry (ptr, fixed bin(35));
dcl 1 qedx_information aligned,
2 header like qedx_info.header,
2 buffers (1) like qedx_info.buffers;
dcl query_segment_ptr ptr;
dcl query_segment_length fixed bin (21);
dcl query_should_be_replaced bit (1) aligned;
%skip(1);
dcl rel builtin;
%skip(1);
dcl sci_ptr ptr;
dcl ssu_$abort_line entry() options(variable);
dcl sys_info$max_seg_size fixed bin(35) ext static;
%skip(1);
dcl unspec builtin;
%page;
%include linus_lcb;
%page;
%include qedx_info;
%skip(3);
end linus_qedx_the_query;