github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-21 16:52:34 +00:00
Code Issues Releases Wiki Activity

Files from archives.

Browse Source
This commit is contained in:
Lars Brinkhoff
2018-02-25 18:40:37 +01:00
parent 239b967dd1
commit 309936c2eb
153 changed files with 24732 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
arc/ar1:c/BARBER ORAL Normal file
View File

@@ -0,0 +1,87 @@
.device xgp; font 1 "carl;30vrs"; font 2 "carl;25vgbs"; font 3 "carl;30vrbs"; font 4 "fonts;25vri"; font 5 "carl;37vrbs"; font 6 "carl;s30grk";
.require "CARL;PUBMAC >" sourcefile
.!xgpcommands_";squish"
.area text lines 3 to 45
.page frame 45 high 85 wide
.title area heading line 1 to 2
.tabspace
.every heading (5DRAFT*,{page},5DRAFT*)
.tabspace
.place text
.next page
.fill
.begin center
.turn on "{"
.comment "}";
{date}
.end
.skip 4
.begin nofill
TO: Area II Committee
FROM: Carl Hewitt
SUBJECT: Oral Examination for Mr. Gerald Barber
.end
.begin para
The oral examination for Mr. Barber was held on November 23, 1977.
The committee members were Professors Gallager, Winston, and Hewitt
[Chairperson].
On the basis of demonstrated research potential
and performance on the oral examination, the committee recommends that Mr. Barber
be deemed to have passed his
oral examination.
.end
.begin para
The examination began with Mr. Barber presenting his masters thesis
which was done at the University of Idaho.
The topic of the research was a program to do optical character recognition.
The committee feels that Mr. Barber explained his research quite clearly.
.end
.begin para
Mr. Barber described some research which he is currently doing
with Professor Hewitt on the development of formal techniques for the
description of office procedures in which he has made several important contributions.
Professor Hewitt is quite pleased with his progress and a doctoral thesis proposal
should be forthcoming before the end of the academic year.
.end
.begin para
Professor Gallager asked Mr. Barber to consider the problem of synchronizing
the action of two modules which can only communicate via a noisy channel which
can drop messages. If the two modules have no prior agreement as to the time at which
they will act and neither can act alone without being certain that the other will
act at the same time then the problem is impossible to solve.
After some guidance Mr. Barber was able to give an informal proof of this
result.
Professor Hewitt asked Mr. Barber to write a recursive LISP procedure to
reverse a list at all levels. Mr. Barber was able to do this with only one minor
false start.
Professor Winston asked him how he would program a depth first tree search.
After this he was asked how he would program a breadth first tree search and
then how he would program a best first search. With some guidance Mr. Barber
realized that all of the programs are variants of one basic schema.
.end
.begin para
The committee feels that Mr. Barber should speak more forcefully and
be more dynamic and definitive in his presentations and answers to questions. Mr. Barber
seemed quite nervous at the examination which could account for some
of this difficulty. The committee feels that some teaching experience could help him overcome
some of these problems.
.end
.begin para
Mr. Barber ranked 50 out of 110 on the Preliminary Written Examination.
He did rather poorly in the topic of
discrete mathematics. The committee recommends that he work to remedy this
deficiency.
.end


59
arc/ar1:c/DBA RECOM Normal file
View File

@@ -0,0 +1,59 @@
.ss
.sp 4
.center
January 7, 1974
.sp 4
Ms. Sylvia A. Bressey
.br
Senior Administrative Assistant
.br
School of Mathematical Studies
.br
University of Essex
.br
Wivenhoe Park
.br
Colchester CO 3SQ
.br
England
.sp
Dear Ms. Bressey:
.sp
I consider Bruce Anderson to be eminently qualified for the
post of Lecturer in the Computing Center.
Bruce has a sharp mind, knows the literature of the field,
and expresses himself well.
From my visit to Essex last summer and from your description
of the post, I believe that Bruce would fit in well
with the research and teaching interests of the Computer
Science division.
.sp
I have known Bruce for over two years.
We first met at IJCAI-71 in London.
I got to know him better when I visited Edinburgh
after the conference.
Since that time our paths have crossed regularly
and we have had extensive discussions on developments in the field.
Bruce is one of the people
whose comments and criticisms I value most highly.
.sp
In summary I consider Bruce Anderson to be extremely
well qualified for the post of Lecturer in the Computing Center
and recommend that you appoint him.
.sp
.center
Sincerely,
.sp 4
.center
Professor Carl Hewitt
.center
M.I.T.
.center
Room 813
.center
545 Technology Square
.center
Cambridge, Mass. 02139
.end
 

77
arc/ar1:c/DOYLE AREA Normal file
View File

@@ -0,0 +1,77 @@
.device xgp; font 1 "carl;30vrs"; font 2 "carl;25vgbs"; font 3 "carl;30vrbs"; font 4 "fonts;25vri"; font 5 "carl;37vrbs"; font 6 "carl;s30grk";
.require "CARL;PUBMAC >" sourcefile
.!xgpcommands_";squish"
.area text lines 3 to 45
.page frame 45 high 85 wide
.title area heading line 1 to 2
.tabspace
.every heading (5DRAFT*,{page},5DRAFT*)
.tabspace
.place text
.next page
.fill
.begin center
.turn on "{"
.comment "}";
{date}
.end
.skip 4
.begin nofill
TO: Area II Committee
FROM: Carl Hewitt
SUBJECT: Area Examination for Jon Doyle
.end
.begin para
The area examination for Jon Doyle was held on November 30, 1977.
The committee members were Professors Goldstein, Martin, and Hewitt [Chairperson].
The committee examined Mr Doyle in the general area of representation of knowledge.
On the basis of good oral presentation and originality in his critique of
the papers,
the committee recommends that Mr. Doyle be deemed to have passed his
area examination.
.end
.begin para
The papers assigned for the exam within the topic of "Languages for Knowledge
Representation"
were:
.skip
.begin narrow 12,0
.begin para
"Experience with KRL-0, One Cycle of a Knowledge Representation Language" by
Daniel G. Bobrow, Terry Winograd, and the KRL research group. Xerox Palo Alto
Research Center Technical Report.
.end
.begin para
"An Overview of Owl, A Language for Knowledge Representation"
by Pter Szolovits, Lowell B. Hawkinson, and William A Martin.
LCS Technical Memorandum 86. June 1977.
.end
.begin para
"Nudge, A Knowledge-Based Scheduling Program" by Ira P. Goldstein and R. Bruce Roberts.
AI Memo 405. February 1977.
.end
.end
.skip
Comparing the approaches used in the above represented a
challenging task.
Mr. Doyle demonstrated a good grasp of the of the strengths and
limitations of the various representation languages.
In fact his paper was considered sufficiently perceptive that
Professor Szolovits used it in his knowledge based engineering course.
.end


BIN
arc/ar1:c/GLS ORAL Normal file
View File

Binary file not shown.

70
arc/ar1:c/HOARE CSP Normal file
View File

@@ -0,0 +1,70 @@
review of: Communicating Sequential Processes
In general I have very ambivalent feelings about this paper.
On one hand it has nice examples of the use of parallelism in
an intuitive way for some programming problems. In general the style
used corresponds with my own prejudices as to how to program using
parallel processing. On the other hand the language being an amalgam
of many currently existing constructs has many
loose ends. In addition there are many peculiar restrictions
in the constructs of the language which are poorly motivated.
The guarded commands are rather complicated and ill-defined.
The author needs to provide a more rigorous and intuitive explanation
of the terms "fail", "delay", and "wait" as being distinct states
in which a guarded command can be.
There appears to be a problem of fairness in the constructs
proposed. In particular it appears to be impossible to test to see
if there is an item in the output buffer of a "process".
This inability shows up in example (4) on page 10 of the paper
*[(i:1..10)console(i)?c->X!(i,c);console(i)!ack()]
which inputs characters from consoles and sends back acknowledgements.
As the program stands there is nothing to prevent all of the characters
from being input from console(1).
Implementing recursive subroutines as arrays of "processes"
seems like a total KLUDGE.
The excuse given is that this method is "necessitated by the 'static'
design of the language". However, it is presumably going to be necessary
to dynamically allocate an new array for each "new" invocation
of a recursive procedure in order to implement mutually recursive routines.
This same problem shows up in recursive data representation.
It becomes even worse in section 5 on monitors and scheduling where the claim
is made using arrays of processes and guards of the appropriate kind can be used
to implement monitors. I am doubtful that monitors can be implemented
quite so easily using the constructs provided. In particular I would like
to see the implementations of the readers-writers problem for the cases
involving giving readers priority and giving writers priority.
Also I would also be interested in seeing an implementation of a disk-head scheduler.
The problem is compounded by the fact that it seems difficult to implement
fair (starvation-free) scheduling using the primitives provided.
For example the integer semaphore implementation in section 5.2 does not
guard against starvation. The problem continues to plague the paper in
the next section where it spoils some of the beauty of the sieve of
Eratosthenes where it is not immediately evident that 100 sieve processes
are sufficient to produce all primes less than 100000 (although it is
obvious that it will produce all primes less than 10000).
The iterative array example is very pretty.
I believe that the way in which arrays of processes
are treated is one of the worst defects of the paper and should be corrected
before the paper is published in the CACM.
Also some of the decisions about the language need to be better motivated.
For example the decision that an output command must wait until
some other process has input the value output seems arbitrary.
Perhaps a short section describing the hardware model that seems
to underly many of the decisions: each "process" is a hardware module
connected by physical wires to the other hardware modules with which it
communicates.
The term "process" as used in the paper differs from the meaning
which the author has previously attached to the term in his paper
on "monitors". Some comment as to this difference in terminology should
be inserted to warn readers.
In summary I believe that the paper will make an important contribution
to the state of the art when these defects are overcome. The major thrust of the
paper is in the right direction.
Sincerely,
Carl Hewitt


BIN
arc/ar1:c/KAHN ORAL Normal file
View File

Binary file not shown.

BIN
arc/ar1:c/KAPUR AREA Normal file
View File

Binary file not shown.

73
arc/ar1:c/KEN EECS Normal file
View File

@@ -0,0 +1,73 @@
.!xgpcommands_";squish;botmar 100"
.device xgp;
.if xcribl then font 1 "carl;30vrs"
.if xcribl then font 2 "carl;25vgbs"
.if xcribl then font 3 "carl;30vrbs"
.if xcribl then font 4 "fonts;25vri"
.if xcribl then font 5 "carl;37vrbs"
.if xcribl then font 6 "fonts;plunk"
.if xcribl then font 7 "carl;25evnt"
.if xcribl then font 8 "fonts;30fg"
.if xcribl then font 9 "fonts;s30grk"
.alpha _ "9a*" << lower-case greek alpha >>
.beta _ "9b*" << lower-case greek beta >>
.gamma _ "9g*" << lower-case greek gamma >>
.delta _ "9d*" << lower-case greek delta >>
.lambda _ "6F*" << lower-case greek lambda >>
.bottom _ "6T*" << upside down capital T >>
.natural _ "3N*"
.turnstile _ "6p*"
.inclusive _ "6I*" << inclusive subset symbol >>
.union _ "6U*" << big set union symbol >>
.phi _ "9F*"
.require "CARL;BMAC >" sourcefile
.area text lines 4 to 42
.page frame 44 high 85 wide
.title area heading line 1 to 2
.title area footing line 44
.every heading(,,5{page}1)
.turn on "{"
.comment "}";
.tabspace
.place text
.fill
\\\\{date}
.skip 3
.begin nofill
Professor Horace Smith
Secretary of the Committee on Graduate Admissions
Graduate Office, Department of EECS 38-444
.end
.skip
Dear Professor Smith:
.begin para
I would like to nominate Kenneth Kahn for a Junior Fellowship at the University
of Michigan. As Ken's thesis supervisor, I find that his research is very original and
creative. He has an excellent record and has published several papers in the fields
of Artificial Intelligence and Computer Graphics.
.end
.begin para
During his graduate study at MIT, he has worked with different research groups. First
he worked with the Clinical Decision Making Group and did his Master Thesis with them on the
mechanization of temporal knowledge. He then moved on the the Logo Group of the Artificial
Intelligence Laboratory where he taught elementary school children computer animation and
language processing. He developed a computer language for that purpose which he has continued
to improve. For the last two years he has been honored by holding an IBM graduate fellowship.
During this period he has been working on his doctoral thesis which is exploration of the
processes of creation as exemplified by a computer system that he created that is capable of
making animated films in response to a high level script. He is expected to finish his
thesis by August 1978.
.end
.skip 1
.begin nofill
\\\\Sincerely,
.skip 3
\\\\Carl Hewitt
\\\\Associate Professor of EECS
.end

88
arc/ar1:c/KEN IBM2 Normal file
View File

@@ -0,0 +1,88 @@
.!xgpcommands_";squish;botmar 150"
.comment "title page for working paper in ai:baker phead >";
.device xgp;
.if xcribl then font 1 "carl;30vrs"
.if xcribl then font 2 "carl;25vgbs"
.if xcribl then font 3 "carl;30vrbs"
.if xcribl then font 4 "fonts;25vri"
.if xcribl then font 5 "carl;37vrbs"
.if xcribl then font 6 "fonts;plunk"
.if xcribl then font 7 "carl;25evnt"
.if xcribl then font 8 "fonts;30fg"
.if xcribl then font 9 "fonts;s30grk"
.alpha _ "9a*" << lower-case greek alpha >>
.beta _ "9b*" << lower-case greek beta >>
.gamma _ "9g*" << lower-case greek gamma >>
.delta _ "9d*" << lower-case greek delta >>
.lambda _ "6F*" << lower-case greek lambda >>
.bottom _ "6T*" << upside down capital T >>
.natural _ "3N*"
.turnstile _ "6p*"
.inclusive _ "6I*" << inclusive subset symbol >>
.union _ "6U*" << big set union symbol >>
.phi _ "9F*"
.require "carl;cmac >" sourcefile
.page frame 48 high 85 wide
.area text lines 3 to 45
.title area heading line 1 to 2
.title area footing line 47 to 48
.place text
.at null 
.begin para; nofill
Professor Albert Meyer
Chairman
Area II Committee
.skip
Dear Sir:
.end
.begin para
This letter is in support of the renewal of the IBM fellowship
for Kenneth Kahn. It is intended to supplement the letter which I wrote
last year when Ken was first proposed for the fellowship.
.end
.begin para
In the last year Ken has vigorously pursued his thesis research.
In the course of this research
he has developed a new approach to knowledge-based animation and a scenario
exemplifing it. He has improved the syntax, speed, and cleanliness of his actor-based
animation language and added new capabilities since last Spring.
.end
.begin para
Ken has written two publishable papers in the last year.
He attended and has a paper in the proceedings of the Siggraph/ACM
Workshop on "User-oriented design of Interactive Computer Graphics Systems". He
has nearly completed an article reviewing the field of computer animation for
Technology Review.
.end
.begin para
Last fall he participated in a graduate experimental film course, producing
several films. This school year he is taking courses and reading the
relevant literature in Aesthetics and
Art History for his thesis project.
Ken was a place winner of Byte magazine's Computer Art Contest. His entry will
appear on a cover of the magazine.
One
of his animated films is being shown in various film festivals, theatres and cable television.
.end
.begin para
Last summer he worked on the problems of representing the specifications
and commentary of simple LISP
programs for data structures. The purpose of the research was to explore how a system with
the specifications, commentary and their interconnections would be able to help a program
in modifying either the program or the specifications.
.end
.begin para
In summary, the fellowship has enabled Ken to devote his entire energy to
the pursuit of his research free of other distracting responsibilities.
This freedom has resulted in his outstanding performance during the period
which he has held the fellowship. If his fellowship is renewed, he will be able
to continue his thesis research developing a knowledge-based approach to
computer graphics.
This is an area in which we currently do not have any research contracts which
could provide him with a assistanship. Ken needs a fellowship if he is
to continue to devote his full time to making further progress in his doctoral
research.
.end


114
arc/ar1:c/KEN RECMND Normal file
View File

@@ -0,0 +1,114 @@
.!xgpcommands_";squish;botmar 100"
.device xgp;
.if xcribl then font 1 "carl;30vrs"
.if xcribl then font 2 "carl;25vgbs"
.if xcribl then font 3 "carl;30vrbs"
.if xcribl then font 4 "fonts;25vri"
.if xcribl then font 5 "carl;37vrbs"
.if xcribl then font 6 "fonts;plunk"
.if xcribl then font 7 "carl;25evnt"
.if xcribl then font 8 "fonts;30fg"
.if xcribl then font 9 "fonts;s30grk"
.alpha _ "9a*" << lower-case greek alpha >>
.beta _ "9b*" << lower-case greek beta >>
.gamma _ "9g*" << lower-case greek gamma >>
.delta _ "9d*" << lower-case greek delta >>
.lambda _ "6F*" << lower-case greek lambda >>
.bottom _ "6T*" << upside down capital T >>
.natural _ "3N*"
.turnstile _ "6p*"
.inclusive _ "6I*" << inclusive subset symbol >>
.union _ "6U*" << big set union symbol >>
.phi _ "9F*"
.require "CARL;BMAC >" sourcefile
.area text lines 4 to 42
.page frame 44 high 85 wide
.title area heading line 1 to 2
.title area footing line 44
.every heading(,,5{page}1)
.turn on "{"
.comment "}";
.tabspace
.place text
.fill
\\\\January 6, 1978
.skip 3
.begin nofill
Michigan Society of Fellows
c/o Karina Niemeyer
Rackham School of Graduate Studies
The University of Michigan
Ann Arbor, Michigan 48109
.end
.skip
Dear Ms. Niemeyer:
.begin para
I would like to strongly support
Kenneth Kahn for consideration as a Junior Fellow at the University
of Michigan. As Ken's thesis supervisor, I find that his research is very original and
creative. He has an excellent record and has published several papers in the fields
of Artificial Intelligence and Computer Graphics.
.end
.begin para
During his graduate study at MIT, he has worked with different research groups. First
he worked with the Clinical Decision Making Group and did his Master Thesis with them on the
mechanization of temporal knowledge. This research has been published in the A.I. Journal
(co-authored by his supervisor)
and is considered to be a substantial contribution to the state of the art.
.end
.begin para
He then moved on the the Logo Group of the Artificial
Intelligence Laboratory where he taught elementary school children computer animation and
language processing. He developed an actor-based
computer language called DIRECTOR which he has continued
to improve.
He attended and has a paper in the proceedings of the Siggraph/ACM Workshop
on "User-oriented Design of Interactive Computer Graphics
Systems". During this period he participated in a graduate experimental film
course, producing several films. Byte magazine sponsored a Computer Art Contest
in which Ken was a first place winner and his entry is to appear on the cover of
the magazine.
Also he did an excellent job in teaching a section of our
undergraduate course on Artificial Intelligence Problem-Solving Paradigms.
.end
.begin para
For the last two years he has been honored by holding an IBM graduate fellowship.
During this period he has been working on his doctoral thesis which is an exploration of the
processes of creativity as exemplified by a computer system that he is building
that is capable of
making animated films in response to a high level script. He is expected to finish his
thesis by August 1978.
In the course of his thesis research he has improved the syntax, speed, and
cleanliness of DIRECTOR and added new capabilities since last spring.
In addition Technology Review has published his excellent survey of the
the field of computer animation (co-authored with Henry Lieberman).
.end
.begin para
In terms of comparison with other students, Ken is our best graduate student
in the area of computer graphics and animation since Ron Baecker graduated in 1969.
In many respects Ken is already more mature and broadly based than Ron was at a similar
stage of his career. Ron is currently a professor at the University of Toronto
directing their computer graphics research.
.end
.begin para
In summary I believe that Ken has outstanding potential as a teacher and
research worker in computer science with a particularly strong background
in the areas of computer animation, artificial intelligence, and programming
languages.
.end
.skip 1
.begin nofill
\\\\Sincerely,
.skip 3
\\\\Carl Hewitt
\\\\Associate Professor of EECS
.end


78
arc/ar1:c/KWLSKI CONTRO Normal file
View File

@@ -0,0 +1,78 @@
Review of ALGORITHM = LOGIC + CONTROL
My major recommendation for this paper is that it should be submitted
to the JACM instead of CACM as the subject of the paper really is theorem
proving using resolution. I shall attempt to substantiate this recommendation
in the remainder of the review. First of all the input language that is used in the
paper is very limited, being restricted to sentences of first order logic in
[slightly sugared] disjunctive normal form.
The expressions admitted by the "programming language" are
of the form
B1,...,Bm <- A1,...,An
which is logically equivalent to the following clause in disjunctive normal
form:
B1 v ... v Bm v -A1 v ... V -An
Formulas in disjunctive normal form are too primitive and disjointed to
serve as a well structured programming language. A good example of this disjointedness
is found in the paper on the definition of the subset relation.
In first order quantificational calculus the relation can be simply expressed
by saying that "x is a subset of y if, for all z, if z belongs to x then z belongs
to y". However in clausal form the relation must be expressed by two distinct clauses
which are quite difficult to understand by themselves:
x is a subset of y, arb(x,y) belongs to x <-
x is a subset of y <- arb(x,y) belongs to y
Neither one of the above clauses makes much sense by itself.
Both need to be considered together as a unit. Unfortunately
this grouping is not expressible by the language considered in the paper being
reviewed.
I find that the arguments at the beginning of the paper in favor of
separating factual considerations from control considerations in programming
to be unconvincing. A major problem in programming is to devise good ways
to combine factual and control information in order to produce good algorithms.
Simple minded schemes such as using a given clause only "top-down" or "bottom-up"
will not suffice as uniform strategies. The arrow notation used in the paper
is slightly better than this but what is needed is a full fledged control
language [which might be viewed as a generalization of one of the PLANNER-like
which uses parallelism and nondeterminancy instead of backtracking]. In such a
language control questions can be explicitly dealt with so that the section
"A Notation for Expressing Control Information" can have the following example
explicitly written out:
|
V
Grandparent(x,y) <- Parent(x,z),Parent(z,y)
| |
V V
The control infomation
ought to be expressed explicitly by a program of the following form:
top-down-grandparent-rule:
TO SHOW Grandparent(x,y)
IF given(x)
then SHOW Parent(x,z)
then SHOW Parent(z,y)
IF given(y)
then SHOW Parent(z,y)
then SHOW Parent(x,z)
The hard part of programming is devising languages and
building up programs such as the one given immediately above
so that factual knowledge and control knowledge can be effectively COMBINED.
My principle criticism of the paper under review is that it
does not recognize that this is the essential problem to be tackled.
Instead the paper simply concedes that the above example cannot be handled by the
arrow notation. If the paper were rewritten to show how to
combine factual information and control information to produce efficient
algorithms then it would be a useful contribution to JACM.


12
arc/ar1:c/LING REC Normal file
View File

@@ -0,0 +1,12 @@
Dear Sirs:
Without qualifications I would recommend Michael Freiling for a position on your
faculty. In his years at our lab, he has performed research of top quality.
His research has concentrated on developing techniques for representing general
causal structures, and in applying these techniques to problems involving simple
machines.
He has demonstrated a remarkable ability to plan and coordinate his own research
project.
He is also quite friendly, diligent, and open minded. His ability to form
freindships and get along with others would make him a great asset to your
faculty. 

BIN
arc/ar1:c/MCDONA ORAL Normal file
View File

Binary file not shown.

BIN
arc/ar1:c/REED AREA Normal file
View File

Binary file not shown.

73
arc/ar1:c/REED ORAL Normal file
View File

@@ -0,0 +1,73 @@
DRAFT
TO: Area II Committee
DATE: April 22, 1975
RE: Oral Qualifying Examination for Mr. Dave Reed
An oral examination of Mr. Reed was held on Friday April 18,
by a committee consisting of Professors Mitter, Schroeder and Hewitt
(chairman). Mr. Reed spent about forty five minutes discussing his
thesis work, and after a recess spent over an hour answering questions
and solving problems on the blackboard. Dave performed exceedingly
well on the problems and his masters thesis research is first rate.
On the basis of all the evidence the committee felt that Mr. Reed
should be p_a_s_s_e_d_ and be q_u_a_l_i_f_i_e_d_ at this time in the doctoral program.
Dave's thesis concerns simplifying and generalizing the
implementation of processes in MULTICS. Currently processes in
MULTICS provide many useful services for the user but they are
expensive to create and maintain. Dave has taken the approach of
building a small fixed number of virtual processors as a base on which
to build the general MULTICS processes. The capabilities of virtual
processors are closely matched to the capabilities of the actual
physical processors of the machine. Two very important design goals
of his thesis are to simplify and increase the security of MULTICS.
Professor Mitter asked how Dave could be sure that the security of
MULTICS had in fact been increased by these measures. Professor
Hewitt asked Dave to describe similarities and differences of his
virtual processors and the virtual machines as implemented on the
IBM-370. Professor Mitter asked Dave about the possibilities for
formally modeling his implementation with Petri Nets. Dave had tried
this but found the restriction of not being able to add new places or
transitions to a Petri to be a crucial deficiency in the model. This
limitation restricts Petri Nets to finite state control.
Professor Schroeder then asked Dave to describe the techniques
of contiguous allocation and block allocation memory schemes. Dave
answered the question succinctly pointing out the relative advantages and
disadvantages of each scheme. Professor Schroeder then asked Dave to
give a rough calculation of the wasted space for each scheme. Dave
did the calculation assuring a uniform distribution of block sizes.
Professor Schroeder then pointed out that a uniform distribution was
not a realistic assumption.
Professor Hewitt asked Dave to implement LISP lists in the   lambda-
calculus. Dave proceeded to do this by giving lambda-expressions for
CONS, CAR, CDR. He was asked whether his definitions would run if
translated into LISP. Dave answered that it depended on the version
of LISP and explained two common schemes for implementing LISP.
Professor Hewitt then asked if he could translate his definitions of CONS
into an ALGOL-like language with procedures as values. Dave easily did this
and explained how the usual implementation of ALGOL would have to be changed.
Dave was then asked to add operations RPLACA and RPLACD to his definition of
CONS. He did this and explained how the change further affected the
implementation of the language.
Professor Mitter asked Dave to formally define the notion of a
finite state machine. Dave was a little rusty on his automata theory
but was able to come up with the defintion. He was then asked to
define the reduced machine after some thrashing around he hit upon the
idea of a homorphism.
Sincerely,
Carl E. Hewitt
CEH/yw

109
arc/ar1:c/RICH AREA1 Normal file
View File

@@ -0,0 +1,109 @@
.device xgp; font 1 "carl;30vrs"; font 2 "carl;25vgbs"; font 3 "carl;30vrbs"; font 4 "fonts;25vri"; font 5 "carl;37vrbs"; font 6 "carl;s30grk";
.require "CARL;PUBMAC >" sourcefile
.!xgpcommands_";squish"
.area text lines 3 to 45
.page frame 45 high 85 wide
.title area heading line 1 to 2
.tabspace
.every heading (,{page},)
.tabspace
.place text
.next page
.fill
.begin center
.turn on "{"
.comment "}";
July 15, 1976
.end
.skip 4
.begin nofill
TO: Area II Committee
FROM: Carl Hewitt
SUBJECT: Area Examination for Charles Rich
.end
.begin para
The area examination for Charles Rich was held on May 24, 1976.
The committee members were Professors Szolovitz, Winston, and Hewitt [Chairperson].
The committee examined Mr. Rich in the general area of Automating the Construction
of Reliable Software.
On the basis of disappointing performance in answering technical
questions in his proposed thesis area,
the committee recommends that Mr. Rich retake the
area examination in the fall.
.end
.begin para
The papers assigned for the exam within the topic of "Control Structures
in Artificial Intelligence"
were:
.skip
.begin narrow 12,0
.begin para
"An Overview of Production Systems"
Davis and King. Stanford. AI Memo. AIM-J71.
.end
.begin para
"Micro-PLANNER Reference Manual"
Sussman, Winograd, and Charniak. MIT AI Memo. 203A.
.end
.begin para
"An Actor-Based Computer Animation Language".
Kenneth Kahn. AI Working Paper 120.
.end
.end
.skip
The committee was not very happy with the written critique produced
by Mr. Rich but felt that it was probably difficult to produce a better one.
In his oral presentation, Mr. Rich presented a quite good discussion
of the overall issues in control structure for A.I. systems.
The committee felt that Mr. Rich did a quite good job throughout the
examination in explaining top level goals and methodology.
However, his performance was disappointing on the technical questions
discussed below.
.end
.begin para
Mr. Rich was asked to construct a LISP function which computed
the set of all subsets of its argument. Mr. Rich had considerably difficulty
with this problem.
Professor Hewitt asked Mr. Rich to provide a specification
for an integer division algorithm for positive integers.
Mr. Rich was able to come up with
the specification that the numerator should be equal to the quotient times
the divisor plus the remainder.
However, he left out the specification that the remainder should be
non-negative and less than the divisor.
He was then asked to develop a flow chart which implemented the specifications.
Unfortunately, the flow chart developed was overly complicated for the
task. Twice during the development of the implementation,
Mr. Rich completed a flow chart and thought that the program was correct.
However, both on both cases it turned out that there was a bug.
Mr. Rich had tremendous difficulty in attempting to prove that
his final flow chart was correct.
.end
.begin para
In general, the committee found that Mr. Rich's performance on
constructing programs and proving them correct was disappointing.
The programs which he developed were overly complicated. They
were developed by a process of patching with no obvious overview
of the entire process.
Therefore the recommendation is that he retake the examination in the
fall with emphasis on technical aspects of the area.
In particular the committee recommends that the next examination concentrate
on the formal mathematical basis for program semantics and
proofs of correctness.
.end

BIN
arc/ar1:c/RUSS ORAL Normal file
View File

Binary file not shown.

BIN
arc/ar1:c/STEIGE AREA Normal file
View File

Binary file not shown.

BIN
arc/ar1:c/STEVEN ORAL Normal file
View File

Binary file not shown.

BIN
arc/ar1:c/VALDIS AREA Normal file
View File

Binary file not shown.

169
arc/ar1:c/WOODAM AREA Normal file
View File

@@ -0,0 +1,169 @@
.device xgp; font 1 "carl;30vrs"; font 2 "carl;25vgbs"; font 3 "carl;30vrbs"; font 4 "fonts;25vri"; font 5 "carl;37vrbs"; font 6 "carl;s30grk";
.require "CARL;PUBMAC >" sourcefile
.!xgpcommands_";squish"
.area text lines 3 to 45
.page frame 45 high 85 wide
.title area heading line 1 to 2
.tabspace
.every heading (5DRAFT*,{page},5DRAFT*)
.tabspace
.place text
.next page
.fill
.begin center
.turn on "{"
.comment "}";
{date}
.end
.skip 4
.begin nofill
TO: Area II Committee
FROM: Carl Hewitt
SUBJECT: Area Examination for Robert Woodham
.end
.begin para
The area examination for Robert Woodham was held on February 9, 1976.
The committee members were Professors Horn, Minsky, Ward, and Hewitt [Chairperson].
The committee examined Mr. Woodham in the general area of Artificial Intelligence
with special reference to common sense reasoning.
On the basis of a well written paper and good performance in answering questions,
the committee recommends that Mr. Woodham be deemed to have passed his
area examination.
.end
.begin para
The examination began with a request for Mr. Woodham to describe the
general area of vision research with particular emphasis on applications.
Mr. Woodham gave a coherent discussion of the field. He feels that
the main applications of vision in the next five years or so will
be in the areas of inspection and monitoring.
.end
.begin para
The papers assigned for the exam within the topic of "Common Sense Reasoning"
were:
.skip
.begin narrow 12,0
.begin para
"Concepts for Representing Mundane Reality in Plans" by Abelson.
Representation and Understanding edited by Bobrow and Collins.
.end
.begin para
"Organization and Inference in a Frame-like System of Common Sense Knowledge" by Charniak. Proceedings of Workshop on Theoretical Issues in Natural Language Processing.
10-13 June 1975.
.end
.begin para
"Scripts, Plans, and Knowledge" by Schank and Abelson
Proceedings of IJCAI-75.
.end
.begin para
"One System for two Tasks: A Commonsense Algorithm Memory that Solves Problem and Comprehends Language" by Reiger.
A. I. Working Paper 114.
.end
.end
.skip
The committee felt that reading and criticizing the above four papers represented a
challenging task. The critique produced by Mr. Woodham was very clear containing
detailed criticisms of some of the authors.
.end
.begin para
The examination turned to an oral critique by Mr. Woodham of
the papers which he had been assigned to read.
Mr. Woodham began with an analysis of common sense reasoning which
is trivial and mundane knowledge about the world that people commonly
use in everyday activities.
He pointed out that all of the authors assume that they can analyze common
sense reasoning by analyzing the mechanisms needed to understand stories.
Professor Horn questioned whether this assumption was valid pointing out
that the authors had not analyzed spatial knowledge to any degree.
.end
.begin para
Mr. Woodham then turned to the issues of representation, inference,
and control. Representation concerns the issue of the use of primitives.
Inference concerns making explicit what was previously only implicit in the
the representation. Control concerns issues of how to use available inference
mechanisms.
Professor Ward questioned whether there is any alternative to the use of
primitives. Mr. Woodham clarified his remarks by noting that it is the
number and use of primitives that is at issue with some authors (notably Schank)
favoring a very small number whereas others (such as Charniak) permitting
large numbers.
Having only a small number of primitives seems to require that English
sentences must be expanded to the level of primitives in order to
be used. Mr. Woodham gave the example of how the sentence
.begin outquote; narrow 12,12
John killed Mary for a reason.
.end
.skip
would be represented as a conceptual dependency graph whose meaning is equivalent to:
.begin outquote; narrow 12,12
John though something, which caused him to do something, which caused
Mary to become in a state of worst possible health.
.end
.skip
Professor Minsky suggested that perhaps Schank had recently withdrawn somewhat
from the above position on expanding everything in terms of a very few
primitives.
.end
.begin para
Mr. Woodham then turned to the issue of canonical forms. He maintained
that for English that it was not realistic to hope for canonical forms in a
representation in the sense that two English sentences would mean the same
if and only if they had the same representation.
Professor Ward raised the issue of canonical forms for lambda expressions
pointing out that normal forms are a canonical form in that if two forms
have the same normal form then they are equivalent.
Professor Minsky pointed out that the meaning of a sentence in English
is analogous to the function which
corresponds to a lambda expression.
There is no unique lambda expression that corresponds to a function
considered as a set of ordered pairs.
.end
.begin para
Professor Hewitt asked the relationship between the plans
of high-level goal-oriented languages like PLANNER and the scripts
of Schank and Abelson. Mr. Woodham pointed out that the scripts were not
just plans of how to carry some activity such as how to eat in
a restaurant. Rather the scripts were directions on how to process
stories about people eating in restaurants.
.end
.begin para
Professor Horn asked Mr. Woodham to rank the work represented
in the papers which he had read on a spectrum of development of
implementation on a scale from vague ideas to precise specified in terms
that would make implementation straight forward. Mr. Woodham was
able to construct this spectrum and argue persuasively for
his ranking.
Professor Ward asked Mr. Woodham to elaborate on his criticism of Abelson.
Professor Hewitt asked him to relate Reiger's By-Passable Networks
to production systems.
Mr. Woodham was able to make the correspondence between production systems
and Reiger's networks and show how the by-pass mechanism corresponds to adding
more productions.
.end
.begin para
The exam finished up with Mr. Woodham presenting an overview
of his proposed thesis topic which is an investigation into the
kinds of visual processing needed to detect flaws in castings.
.end

BIN
arc/ar2:c/MMR 1 Normal file
View File

Binary file not shown.

BIN
arc/ar2:c/MMR2 1 Normal file
View File

Binary file not shown.

298
arc/ar2:c/PART6 1 Normal file
View File

@@ -0,0 +1,298 @@
SCHEDULING THE INSTALLATION OF EQUIPMENT
It is the scheduler's job to coordinate the deliveries of
machines. Scheduling is a complex business: each order for a machine
involves a separate planning operation that starts when the order is
placed, and becomes progressively more detailed as the day of
installation approaches. Much of the subtlety of the scheduling
process lies in the careful accumulation by the scheduler of
information about each machine to be installed.
The scheduler must take care not only of installations, but
also of upgrades and cancellations. In this section we describe only
the procedures associated with the installation of equipment, we did
not have the time to study and describe the procedures relating to
cancellations.
S_c_h_e_d_u_l_i_n_g_ _i_n_v_o_l_v_e_s_ _t_h_e_ _f_o_l_l_o_w_i_n_g_ _s_i_x_ _s_t_e_p_s_:_
BATCHING. Machines are installed about one month after the
date of order. As soon as the order has been placed, and has been
through the Equipment Order Entry (EOE) process, the Order Package
containing the relevant documents is sent to the scheduler. A Strip
Board, summarizing the details of each machine installation, is
maintained for quick reference, and the first operation is to prepare
a fresh strip for the new order. Details of the supplies
to accompany the machine installation are sent to the
Regional Distribution Center (RDC), so that they can be delivered well
before the machine arrives. Then the Order Package is filed in the
Open Order file.
ALLOCATION. Every week the scheduler receives from the Region
Headquarters a Weekly Allocation Sheet. This sheet is received two
weeks in advance of the period to which it refers, and shows how many
machines of each type will be available to the Branch for installation
during the week in question. The scheduler maintains an E_q_u_i_p_m_e_n_t_
C_o_n_t_r_o_l_ L_o_g_ (ECL), arranged by machine type, showing each installation
and its projected date. The weekly Allocation sheet is used to add
new entries to this log.
ROUGH SCHEDULING. Every day the scheduler plans the
deliveries of machines for the corresponding day two weeks hence. She
works through the Strip Board and the ECL, compiling a list of the
machines that can be installed that day. The list of deliveries for
each day is entered on a form called the Pick-and-Pull (P&P). This
form eventually generates the instructions to the rigger, the person
who actually delivers the machine. A fresh Strip Board is prepared
containing all the strips for the day's deliveries.
DETAILED SCHEDULING. After making up the list of deliveries,
the scheduler goes through the Open Order file, pulling out the
relevant Order Packages, checking them and transfering them to a
separate Open Order file.
REPORTING. After all the day's scheduling is done, various
people must be notified. Copies are made of the daily Strip Board, of
the Pick-and-Pull, and of the Work Orders that show details of each
order. These are sent to the rigger and to certain managers., and are
also posted in several places in the Branch Office. The Pick-and-Pull
is sent to the E_q_u_i_p_m_e_n_t_ _L_o_g_i_s_t_i_c_s_ _C_e_n_t_e_r_ (ELC), the warehouse from
which deliveries are made.
AUDITING. The scheduler receives a daily report from the
rigger, indicating the machines he has installed the previous day.
She checks this against the Pick-and-Pull, and then transfers the
appropriate strips to a new Strip Board showing those machines that
are Shipped/Not Installed (SNI). Likewise, the Order Packages for
these installations are moved to a special Shipped/Not Installed Open
Order file.
B_A_T_C_H_I_N_G_
The Batching operation is the
only phase during scheduling that requires the service of a typist;
the actual typing is done by the Branch receptionist.
1. Order Packages are received one by one after they have
been through the EOE (Equipment Order Entry) process. These packages,
each in a manila folder, include the COED (Customer Order Entry
Document), the service agreement and the purchase order made out by
the customer. A batch of Order Packages is made up and given to the
receptionist.
2. The receptionist types a strip for each order and places
the strip in the folder.
3. The batch of Order Packages returns to the scheduler.
4. The strip is removed and is inserted on the Strip Board
for the appropriate machine type (SB/MT).
5. The Order Package is stacked on one side for later filing.
6. The COED includes an Initial Supply Order (ISO), a list of
supplies to be provided when the machine is installed. The
appropriate part of the COED is copies, and the copy is placed in a
batch of ISO's. The COED number, a unique number stamped on each
blank COED form, is written on the batch cover sheet.
7. The Order Packages are filed in the Open Order drawer, a
single file drawer. The front part of this drawer is devoted to
unscheduled orders such as this one, and is subdivided by machine
type. Behind are the Daily (OO/D) and Shipped/Not Installed (OO/SNI)
sections of the Open Order drawer.
8. At the end of the day, the ISO Batch is completed: the
batch size is entered on the cover sheet, and a copy of the cover
sheet is made and filed.
9. The ISO Batch is mailed to the Regional Distribution
Center.
A_L_L_O_C_A_T_I_O_N_
Allocation is performed with the aid
of a Weekly Allocation Sheet received two weeks in advance from Region
Headquarters. A typical such sheet shows
the weekly allocations for several other branches. The scheduler uses
a felt pen to outline the column for the easier reference.
The main purpose of Allocation is to open up fresh entries in
the E_q_u_i_p_m_e_n_t_ _C_o_n_t_r_o_l_ _L_o_g_ _(_E_C_L_)_. Each page of the ECL is devoted to a
single type of machine; each machine installation is given one line,
which will eventually show the serial number, COED number and customer
name. At the time the weekly allocations are first
made, however, the serial numbers of the machines are not known, and
at this stage no attempt is made to assign names or COED numbers
either.
Later on, after the machines have been scheduled in detail, a
Monthly Allocation Report is received from the Region Headquarters:
this repeats the information given in the weekly allocations, and also
includes serial numbers. It is used for checking purposes.
10. After studying the Weekly Allocation Sheet, the scheduler
selects each machine type in turn, and consults her Equipment Control
Log.
11. According to the number in the allocation, the
appropriate number of lines are opened up in the log, for filling in
later when daily scheduling is done.
12. The Weekly Allocation Sheet is filed.
13. Every month the scheduler receives the Monthly Allocation
Report. The entries are compared, by serial number, with the
entries in the ECL.
14. The Monthly Allocation Report is filed.
R_O_U_G_H_ _S_C_H_E_D_U_L_I_N_G_ _F_O_R_ _I_N_S_T_A_L_L_A_T_I_O_N_ _2_ _W_E_E_K_S_ _H_E_N_C_E_
It is during the first phase of daily scheduling
that orders are selected for installation on a day exactly
two weeks hence. This operation involves a good deal of knowledge
about the installation operation - which Technical Representative can
install which type of machine, which machines are particularly
difficult and time-consuming to install, and so forth.
15. A Pick-and Pull is prepared for the day's deliveries.
The scheduler fills in the control number (allocated sequentially),
the Branch number, the name of the rigger and the installation date.
16. Taking the Strip Board for the machine type in question,
the scheduler selects the top most strip on the board and attempts to
schedule it. Installations are never made until at least three weeks
have elapsed from placing the order; therefore strips representing
orders less than a week old are not selected.
17. The scheduler consults the ECL to determine whether the
machine can be installed.
18. If the order can be scheduled, the customer name and COED
number are entered in the ECL.
19. The serial number and allocation week are copied from the
ECL to start a fresh entry on the Pick-and-Pull.
20. The COED number and customer name are entered from the
strip onto the Pick-and-Pull. The first three digits of the serial
number are also entered, since these are invariant for any one machine
type.
21. The strip is transfered to a fresh Strip Board for the
day in question.
D_E_T_A_I_L_E_D_ _S_C_H_E_D_U_L_I_N_G_ _F_O_R_ _I_N_S_T_A_L_L_A_T_I_O_N_S_ _2_ _W_E_E_K_S_ _H_E_N_C_E_
22. For each entry on the Strip Board, starting at the
bottom, the corresponding Order Package is retrieved from the Open
Order drawer: the machine type identifies the folder in which to
look, and generally the package will be near the back of that section.
23. The Order Package is checked, and a copy is made of the
Work Order which consists of the top one-third of each side of the
COED; the COED is designed so that it can be folded to present both
sections simultaneously to the copier.
24. The Order Package is placed on one side.
25. The Work Order copies are also placed on one side.
26. When the day's installations have been handled, the
packages are placed in a special section of the Open Order drawer,
devoted to that day' installations.
R_E_P_O_R_T_I_N_G_ _I_N_S_T_A_L_L_A_T_I_O_N_S_ _S_C_H_E_D_U_L_E_D_
The Pick-and-Pull is not used during the Detailed Scheduling
phase, but after the daily scheduling is complete it must be sent to
the Equipment Logistics Center. The rigger also needs it, together
with copies of the Work Orders to tell him exactly where to install
each copier. In addition, the scheduler posts copies of the Daily
Strip Boards for the benefit of Technical Representatives, and keeps
various members of the Branch management informed about installation
scheduling.
27. Twelve copies are made of the daily Strip Board; eight
of these are for inclusion in sets of documents sent to Branch
managers; the remaining four are posted around the Branch Office.
28. The day's Work Orders are copied and made into batches
for distribution.
29. The Pick-and-Pull is telecopied to the ELC.
30. A copy is made for the rigger of the Pick-and-Pull, which
is then filed in a folder.
31. The copied documents are made up into batches, and
distributed.
A_U_D_I_T_I_N_G_
Auditing takes place on the day
following installation, when a report is received from the rigger
listing the machines he installed the previous day. This report
provides, for the first time, the serial numbers of the machines
installed. In this final stage of scheduling, the rigger's report is
checked against the Pick-and-Pull for the day, serial numbers are
copied into the ECL, any errors detected are resolved, and the orders
are tansfered from Daily to Shipped/Not Installed (SNI) status. The
Rigger Report, includes other details besides impending deliveries,
but these do not relate to our study.
32. The Rigger Report, received via Telecopier, is checked
against the Pick-and-Pull folder. Entries are identified by COED
number. Generally all the entries on the Rigger Report are to be
found on a single day's P&P, but rigger delays and coordination
problems may cause discrepancies, and the scheduler may have to go
back to the folder for ohther P&P's.
33. The COED number is also used to find the machine's entry
in the ECL. The serial number is copied from the Rigger Report to the
ECL.
34. The customer name is copied from the P&P to the Rigger
Report entry.
35. Using the customer name as key, the scheduler finds the
corresponding strip on the Daily Strip Board and transfers it to the
SNI Strip Board.
36. Order Packages are Likewise located and transfered to the
SNI section of the Open Order drawer.
37. The scheduler goes to the terminal and enters the
`Equipment Received' data from the Rigger Report.
38. The Rigger Report is filed in a folder.
C_O_N_C_L_U_S_I_O_N_
Installation Scheduling is carried out almost entirely by one
person. Schedulding involves both routine paper work and complex
decision-making, and exhibits an interesting interplay of logs, files
and strip boards.
G_L_O_S_S_A_R_Y_ _O_F_ _A_C_R_O_N_Y_M_S_
COED Customer Order Entry Document
ECL Equipment Control Log
ELC Equipment Logistics Center
EOE Equipment Order Entry
ISO Initial Supply Order
MT Machine Type
OO Open Order file
OO/D Open Order, Daily file
OO/MT Open Order, filed by Machine Type
OO/SNI Open Order file, Shipped/Not Installed
P&P Pick-and-Pull
RDC Regional Distribution Center
SB Strip Board
SB/D Strip Board, Daily
SB/MT Strip Board, arranged by Machine Type
SB/SNI Strip Board, Shipped/Not Installed
SNI Shipped/Not Installed

BIN
arc/ar2:c/SCHED 1 Normal file
View File

Binary file not shown.

281
arc/ar2:clib/AC C Normal file
View File

@@ -0,0 +1,281 @@
#
/*
AC - Array of Characters Cluster
operations:
ac_new () => ac create empty array
ac_alloc (size) => ac create empty array, preferred size
ac_create (string) => ac create with initial value
ac_xh (ac, c) => c extend array with character
ac_trim (ac) => ac trim excess storage
ac_fetch (ac, i) => c fetch character from array
ac_link (ac) => ac make new link to array
ac_unlink (ac) remove link to array
ac_puts (ac, f) print array
ac_cat (ac, ac) => ac concatenate arrays
ac_copy (ac) => ac copy array
ac_string (ac) => *char return string version
ac_size (ac) => size return current size of array
ac_flush (ac) make array empty
ac_n () => int return # of active arrays
*/
struct rep {
int count; /* reference count */
char *s; /* pointer to actual array */
int csize; /* logical size of array */
int msize; /* physical size of array (at least csize+1) */
};
# define ac struct rep* /* watch usage! */
# define ASIZE 4 /* number of words in rep */
# define initial_size 8 /* default initial allocation */
char *calloc ();
int *salloc ();
ac ac_new();
ac ac_alloc();
ac ac_create();
ac ac_link();
ac ac_cat();
ac ac_copy();
static int count;
/**********************************************************************
AC_NEW - Create empty array.
AC_ALLOC - Create empty array, preferred size given.
**********************************************************************/
ac ac_new ()
{return (ac_alloc (initial_size));}
ac ac_alloc (sz)
{ac a;
if (sz<0) sz=0;
a = salloc (ASIZE);
a->count = 1;
a->csize = 0;
a->msize = sz+1;
a->s = calloc (a->msize);
++count;
return (a);
}
/**********************************************************************
AC_CREATE - Create array with initial value.
**********************************************************************/
ac ac_create (s) char s[];
{register char *p;
register int sz;
register ac a;
sz = slen (s);
a = ac_alloc (sz);
a->csize = sz;
p = a->s;
while (--sz >= 0) *p++ = *s++;
return (a);
}
/**********************************************************************
AC_XH - Extend Array with Character.
**********************************************************************/
char ac_xh (a, c) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) >= a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize =* 2);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
a->s[a->csize++] = c;
return (c);
}
/**********************************************************************
AC_TRIM - Discard excess storage.
**********************************************************************/
ac ac_trim (a) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) < a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize = a->csize + 1);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
return (a);
}
/**********************************************************************
AC_FETCH - Fetch Character from Array.
**********************************************************************/
char ac_fetch (a, n) ac a;
{extern int cerr;
if (n<0 || n>=a->csize)
{cprint (cerr, "Character array bounds error.");
return (0);
}
return (a->s[n]);
}
/**********************************************************************
AC_LINK - Create link to array.
**********************************************************************/
ac ac_link (a) ac a;
{++a->count;
return (a);
}
/**********************************************************************
AC_UNLINK - Remove link to array.
**********************************************************************/
ac_unlink (a) ac a;
{if (--a->count == 0)
{if (a->s) cfree (a->s);
--count;
sfree (a);
}
}
/**********************************************************************
AC_PUTS - Print array.
**********************************************************************/
ac_puts (a, f, wid) ac a; /* 3 args for cprint usage */
{register char *p;
register int i;
p = a->s;
i = a->csize;
while (--i >= 0) cputc (*p++, f);
}
/**********************************************************************
AC_CAT - Concatenate arrays.
**********************************************************************/
ac ac_cat (a1, a2) ac a1; ac a2;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize + a2->csize);
a->csize = i;
p = a->s;
q = a1->s;
i = a1->csize;
while (--i>=0) *p++ = *q++;
q = a2->s;
i = a2->csize;
while (--i>=0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_COPY - Copy array.
**********************************************************************/
ac ac_copy (a1) ac a1;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize);
a->csize = i;
p = a->s;
q = a1->s;
while (--i >= 0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_STRING - Return string version of array. The returned
string is valid only while the array remains linked
to and unchanged.
**********************************************************************/
char *ac_string (a) ac a;
{a->s[a->csize]=0;
return (a->s);
}
/**********************************************************************
AC_SIZE - Return current size of array.
**********************************************************************/
int ac_size (a) ac a;
{return (a->csize);}
/**********************************************************************
AC_FLUSH - Make array empty
**********************************************************************/
ac_flush (a) ac a;
{a->csize = 0;}
/**********************************************************************
AC_N - Return number of active arrays.
**********************************************************************/
int ac_n () {return (count);}


225
arc/ar2:clib/ALLOC CMID Normal file
View File

@@ -0,0 +1,225 @@
;
; ALLOC - C FREE STORAGE ROUTINES
;
; This file is PDP-10 dependent, system independent.
;
; CALLOC (SIZE) => *CHAR ; ALLOCATE ZEROED CHARACTERS
; SALLOC (SIZE) => *INT ; ALLOCATE ZEROED WORDS
; CFREE (*CHAR) ; RETURN CHARACTERS
; SFREE (*INT) ; RETURN WORDS
;
; AFREE (SIZE) => (ADDR) ; ALLOCATE GARBAGE WORDS
; AFRET (ADDR, SIZE) ; DEALLOCATE WORDS
; AFREZ (SIZE) => (ADDR) ; ALLOCATE AND ZERO WORDS
;
; ALOCSTAT (&NWALLOC, &NBFREE) => NWFREE ; COMPUTE STATS
;
TITLE ALLOC
.INSRT NC
.INSRT NM
; THESE ARE STORAGE-ALLOCATION ROUTINES WITH SOME PROTECTION
CENTRY CALLOC,[NWORDS] ; ALLOCATE CHARACTERS
XENTRY SALLOC,CALLOC ; ALLOCATE WORDS
SKIPL A,NWORDS ; DON'T ADD TO BAD SIZE
ADDI A,2 ; FOR HEADER WORDS
CALL AFREZ,[A]
ADDI A,2 ; POINTER TO USER AREA OF BLOCK
MOVE B,NWORDS
MOVEM B,-1(A) ; STORE SIZE IN HEADER
MOVE B,A
ADD B,[147506732514]
MOVEM B,-2(A) ; MAGIC WORD IN HEADER
RETURN
CENTRY CFREE,[PTR] ; RETURN CHARACTERS
XENTRY SFREE,CFREE ; RETURN WORDS
MOVE A,PTR
MOVE B,-2(A)
SUB B,A
CAME B,[147506732514]
GO CF$BAD
MOVEI A,-2(A)
MOVE B,1(A)
ADDI B,2
CALL AFRET,[A,B]
SETZ A,
CF$RET: RETURN
CF$BAD: CROAK BAD CALL TO CFREE/SFREE
SETO A,
GO CF$RET
.IDATA
MDATA FNWORDS ; NUMBER OF WORDS ALLOCATED
0
MDATA FLIST
FLIST+1 ; LIST OF FREE BLOCKS
0
.CODE
;
; AFREE - ALLOCATE STORAGE
;
CENTRY AFREE,[BSIZE]
XENTRY GETVEC,AFREE
MOVE A,BSIZE
JUMPLE A,AE$BAD ; SIZE MUST BE POSITIVE
CAIL A,400000 ; SIZE MUST BE REASONABLE
GO AE$BAD
HRLZI D,(A) ; SIZE IN LEFT HALF FOR COMPARISON
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A1: CAMG D,(C) ; IS CURRENT BLOCK BIG ENOUGH?
GO A3 ; YES
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A1 ; BLOCK EXISTS => LOOP
HLRZ B,D ; DESIRED SIZE IN B
PPUSH B ; SAVE SIZE NEEDED
CALL GETCORE,[B] ; ALLOCATE NEW BLOCK (SIZE,,ADDR)
HLRZ B,A ; SIZE OBTAINED
HRRZ A,A ; ADDRESS OF BLOCK
PPOP D ; SIZE NEEDED
SUBI B,(D) ; HOW MUCH EXTRA OBTAINED?
JUMPE B,AE$RET ; NO EXCESS => DONE
PPUSH A ; ADDRESS OF BLOCK
ADDM B,(P) ; ADDRESS OF DESIRED PART OF BLOCK
CALL AFRET,[A,B] ; RETURN THE EXCESS
PPOP A ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN A SUFFICIENTLY LARGE BLOCK FOUND IN LIST
A3: HLRZ D,D ; DESIRED SIZE IN D
HLRZ A,(C) ; SIZE OF BLOCK IN LIST
SUBI A,(D) ; EXCESS
JUMPE A,A4 ; NO EXCESS => DELETE BLOCK FROM LIST
HRLM A,(C) ; NEW BLOCK SIZE
ADDI A,(C) ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN ENTIRE BLOCK IS TO BE REMOVED FROM THE LIST
A4: HRRZ A,(C) ; NEXT BLOCK IN LIST
HRRM A,(B) ; CHAIN TO PREVIOUS BLOCK
MOVEI A,(C) ; RETURN THIS BLOCK
GO AE$RET ; DONE
AE$BAD: CROAK AFREE CALLED WITH BAD SIZE ARGUMENT
SETZ A,
AE$RET: RETURN ; DONE
;
; AFRET - DEALLOCATE STORAGE
;
CENTRY AFRET,[PTR,BSIZE]
MOVE A,PTR
MOVE B,BSIZE
JUMPLE B,CODE [ ; SIZE MUST BE POSITIVE
CROAK AFRET CALLED WITH BAD SIZE ARGUMENT
GO ARRET
]
MOVEI C,FLIST ; ADDRESS OF PREVIOUS BLOCK IN C
HRRZ D,(C) ; ADDRESS OF CURRENT BLOCK IN D
A5: CAIG A,(D) ; FIND PLACE IN LIST
GO A8 ; NEW BLOCK GOES HERE
MOVEI C,(D) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ D,(D) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN D,A5 ; BLOCK EXISTS => LOOP
; HERE TO INSERT NEW BLOCK AFTER A GIVEN BLOCK IN LIST
A6: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(C) ; END OF OLD BLOCK
CAIGE A,(D) ; OVERLAP WITH PREVIOUS BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIN A,(D) ; CONTIGUOUS WITH PREVIOUS BLOCK ?
GO A7 ; YES, GO MERGE THEM
HRRZ D,(C) ; ADDRESS OF NEXT BLOCK (IF ANY)
HRLI D,(B) ; SIZE OF BLOCK BEING FREED (IN LEFT HALF)
MOVEM D,(A) ; MAKE DOPE WORD OF BLOCK BEING FREED
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
GO ARRET ; DONE
; HERE TO MERGE BLOCK WITH PREVIOUS BLOCK (ADDR IN C)
A7: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(B) ; ADD SIZE OF BLOCK BEING FREED
HRLM D,(C) ; STORE NEW SIZE IN OLD BLOCK
GO ARRET ; DONE
; HERE IN INSERT NEW BLOCK IN MIDDLE OF LIST
A8: MOVEI 0,(A) ; ADDRESS OF NEW BLOCK
ADDI 0,(B) ; END OF NEW BLOCK
CAILE 0,(D) ; OVERLAP WITH NEXT BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIE 0,(D) ; CONTIGUOUS WITH NEXT BLOCK ?
GO A6 ; NO, APPEND TO PREVIOUS BLOCK
MOVS 0,(D) ; SWAPPED DOPE WORD OF NEXT BLOCK
ADDI 0,(B) ; SIZE OF COMBINED BLOCK
MOVSM 0,(A) ; MAKE DOPE WORD OF COMBINED BLOCK
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI D,(C) ; END OF PREVIOUS BLOCK
CAIE D,(A) ; CONTIGUOUS WITH PREVIOUS BLOCK ALSO ?
GO ARRET ; NO, DONE
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI 0,(D) ; SIZE OF COMBINED BLOCK
MOVSM 0,(C) ; MERGE AGAIN
ARRET: RETURN ; DONE
;
; AFREZ - ALLOCATE ZEROED BLOCK
;
CENTRY AFREZ,[BSIZE]
CALL AFREE,[BSIZE] ; ALLOCATE A BLOCK
SETZM (A) ; ZERO FIRST WORD
MOVE B,BSIZE ; THE SIZE
SOJE B,AZRET ; NUMBER OF WORDS REMAINING TO BE ZEROED
ADDI B,(A) ; LAST WORD OF BLOCK
HRLZI C,(A) ; FIRST WORD OF BLOCK (LEFT HALF)
HRRI C,1(A) ; SECOND WORD OF BLOCK (RIGHT HALF)
BLT C,(B) ; TRANSFER ZEROES
AZRET: RETURN ; DONE
;
; ALOCSTAT - COMPUTE ALLOCATION STATISTICS
;
CENTRY ALOCSTAT,[PNALOC,PNBFREE]
MOVE A,FNWORDS ; NUMBER ALLOCATED
MOVEM A,@PNALOC
SETZ A, ; ZERO SUM OF FREE BLOCK SIZES
SETZM @PNBFREE ; ZERO COUNT OF FREE BLOCKS
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A9: HLRZ D,(C) ; GET SIZE OF BLOCK
ADD A,D ; ADD TO SUM
AOS @PNBFREE
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A9 ; BLOCK EXISTS => LOOP
RETURN
END


26
arc/ar2:clib/APFNAM C Normal file
View File

@@ -0,0 +1,26 @@
/**********************************************************************
APFNAME - Append suffix to file name
**********************************************************************/
char *apfname (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, 0, 0, 0, suffix, "", "");
return (dest);
}
/**********************************************************************
FNMKOUT - Make output file name
**********************************************************************/
char *fnmkout (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, "", 0, 0, suffix, "", "");
return (dest);
}


17
arc/ar2:clib/ATOI C Normal file
View File

@@ -0,0 +1,17 @@
/**********************************************************************
ATOI - Convert string to Integer
**********************************************************************/
int atoi (s) char s[];
{int i, f, c;
if (!s) return (0);
i = f = 0;
if (*s == '-') {++s; ++f;}
while ((c = *s++)>='0' && c<='9') i = i*10 + c-'0';
return (f?-i:i);
}


21
arc/ar2:clib/BLT CMID Normal file
View File

@@ -0,0 +1,21 @@
;
; BLT
;
; This file is PDP-10 dependent, system-independent.
;
TITLE BLT
.INSRT NC
.INSRT NM
CENTRY BLT,[FROM,TO,NUM]
HRRZ A,TO
HRRZI B,-1(A)
ADD B,NUM
HRL A,FROM
BLT A,(B)
RETURN
END


58
arc/ar2:clib/C DEFS Normal file
View File

@@ -0,0 +1,58 @@
/*
C Standard Definitions
*/
# define ITS ITS
# define AI AI
/* data types */
struct _filespec {int dev, fn1, fn2, dir;};
# define filespec struct _filespec
# define channel int
struct _cal {int year, month, day, hour, minute, second;};
# define cal struct _cal
struct _tag {int *pc, *fp, *ap, *sp;};
# define tag struct _tag
/* common values */
# define TRUE 1
# define FALSE 0
# define OPENLOSS -1 /* returned by COPEN if lose */
/* C interrupts */
# define INT_DEFAULT 0
# define INT_IGNORE 1
# define mpv_interrupt 1
# define ioc_interrupt 2
# define ilopr_interrupt 3
# define mar_interrupt 4
# define utrap_interrupt 5
# define pure_interrupt 6
# define wiro_interrupt 7
# define sys_down_interrupt 8
# define clock_interrupt 9
# define timer_interrupt 10
# define pdlov_interrupt 11
# define ttyi_interrupt 12
# define cli_interrupt 13
# define overflow 14
# define float_overflow 15
# define channel0_interrupt 16
# define inferior0_interrupt 32
# define ctrls_interrupt 41
# define ctrlg_interrupt 42


139
arc/ar2:clib/C INFO Normal file
View File

@@ -0,0 +1,139 @@
C Info (30 July 1979)
--- C ---
C is an implementation language, similar to BCPL except with data
types. It is the primary language used in the Unix operating system.
This implementation runs on the ITS and TOPS-20 operating systems.
(The ITS implementation exists only on DM.) This implementation is
moderately compatible with the Unix C implementation. The Unix
system calls are NOT implemented. Some implemented library routines
are described below.
Further information is available from Eliot Moss (EBM@XX).
--- Compiling ---
CC is the C compiler command. Usage is
:cc file1.c file2.c ...
where the arguments are the path names of C source files which are to
be compiled. Each file will be compiled in turn, and if the compilation
is successful, the resulting relocatable file will be placed in the file
"file*.stk". [The ITS compiler currently produces "file*.rel". This will
soon be changed.] Arguments beginning with the '-' character are taken
to be compiler options. Available options include:
-c compile only, do not assemble
-g do not delete MIDAS file
-x syntax check only
-s produce a symbol table listing
-b compile big function (FUNCTION TOO LARGE)
For example, the command
:cc foo.c
would compile the C program in the file "foo.c" ("FOO C" on ITS) in the
current directory, and place the resulting relocatable program in the file
"foo.stk" ("FOO STK" on ITS).
--- Loading ---
Relocatable programs produced by the C compiler are loaded together
with the C support routines using the STINKR loader. To load program
files "foo", "bar", and "bletch" and produce a runnable file "foo",
type the following to STINKR:
(TOPS-20: (ITS:
x <c>clib x c/clib
l foo l foo
l bar l bar
l bletch l bletch
o foo.exe o ts.foo
^Z ^@
The ^@ (ASCII NUL) or ^Z terminates the terminal input file.
The ^Z must be followed by a CR. These commands (minus the ^@)
could also be written in a file, say "foo.stinkr" ("FOO STINKR"
on ITS), in which case one could invoke STINKR with "foo" as a
JCL argument and STINKR would read the commands from the
command file.
--- Library ---
The above STINKR commands will load in a set of library routines
for performing I/O, etc. These routines are similar to the
Unix "Portable I/O Library". A brief description of the most useful
routines follows:
char c; /* an ASCII character */
int i, n, cc; /* an integer */
int *p; /* an integer pointer */
int b; /* a boolean */
char *s, *s1, *s2; /* strings */
char *fn; /* an ITS file name or a path name */
int fd; /* a "file descriptor" */
fd = copen (fn, mode, options); /* open file */
char mode; /* 'r', 'w', or 'a' (append) */
char *options; /* 0 (char I/O), "s" (string file), "b" (binary) */
/* for string file, pass string as fn */
/* returns -1 if open fails */
extern int cin; /* standard input - pre-existing */
extern int cout; /* standard output - pre-existing */
extern int cerr; /* standard error ouput - pre-existing */
c = cgetc (fd); /* get character; returns 0 if eof */
c = cputc (c, fd); /* put character */
b = ceof (fd); /* test for end of file */
cclose (fd); /* close file */
c = getchar (); /* equivalent to cgetc(cin) */
putchar (c); /* equivalent to cputc(c,cout) */
gets (s1); /* read string (line) from cin */
puts (s1); /* put string and newline to cout */
cprint (fd, format, arg...); /* formatted print routine */
/* the format is a string which may contain format items
of the form %nf, where n is an optional decimal integer
(the minimum field width) and f is one of the following
characters:
d - print next arg (an integer) in decimal
o - print next arg (an integer) in octal
s - print next arg (a string)
c - print next arg (a character)
The file descriptor FD can be omitted, in which case
COUT is used.
*/
i = cgeti (fd); /* get integer (binary input) */
i = cputi (i, fd); /* put integer (binary output) */
b = istty (fd); /* test if file is a TTY */
c = utyi (); /* read char from TTY (unbuffered, no echo) */
utyo (c); /* output char to TTY (unbuffered) */
tyo_flush (); /* flush TTY output buffer */
cexit (cc); /* terminate job, closing all files */
/* returning from "main" is equivalent */
/* STRING Routines */
i = slen (s); /* find string length */
stcpy (s1, s2); /* copy string from S1 to S2 */
b = stcmp (s1, s2); /* compare strings */
/* storage allocation */
p = salloc (n); /* allocate n words, return pointer to it */
sfree (p); /* free storage allocated by salloc */
s = calloc (n); /* allocate n characters, return ptr to it */
cfree (s); /* free storage allocated by calloc */

56
arc/ar2:clib/C10BOO CMID Normal file
View File

@@ -0,0 +1,56 @@
;
; C10BOO - Bootstrapper Routine
;
; This file is ITS dependent.
;
TITLE BOOTSTRAP
.INSRT NC
.INSRT NM
LSTART==6 ; WHERE BOOTSTRAP LOADER WILL BE MOVED TO
LCHN==15 ; LOAD FILE CHANNEL
TCHN==16 ; TTY CHANNEL
CENTRY BOOTSTRAP,[FS]
MOVE C,FS
SYSCAL OPEN,[MOVSI 6?MOVEI LCHN?(C)?1(C)?2(C)?3(C)],LOSE
.SUSET [.ROPTI,,A] ; READ OPTION WORD
TLZ A,OPTOPC+OPTINT ; TURN OFF OLD PC ON MPV, IOC AND
; USE NEW INTERRUPT STACKING SCHEME
.SUSET [.SOPTI,,A] ; SET OPTION WORD
SETZM 42 ; DISABLE INTERRUPT HANDLING
SETZ A,
.SUSET [.SMASK,,A]
SETZM 41
.OPEN TCHN,[SIXBIT/ TTY/]
GO NOTTY
.CALL [SETZ ; TURN OFF ECHOING
'TTYSET
1000,,TCHN
[232222222222]
SETZ [230222220222]
]
JFCL
NOTTY: MOVE 0,[LOADER,,LSTART]
BLT 0,LSTART+LODLEN ; MOVE LOADER
JRST LSTART ; EXECUTE LOADER
LOSE: SETO A,
RETURN
;
; THE LOADING PROGRAM
;
LOADER:
.CALL [SETZ ? SIXBIT/LOAD/ ? MOVEI -1 ? SETZI LCHN]
.VALUE
.IOT LCHN,LSTART+5 ; READ STARTING ADDRESS
.CLOSE LCHN,
JRST @0 ; START PROGRAM
-1,,0 ; IOT POINTER
LODLEN==.-LOADER
END

54
arc/ar2:clib/C10COR CMID Normal file
View File

@@ -0,0 +1,54 @@
;
; C10COR - Basic Storage Allocation
;
; This file is ITS dependent.
;
TITLE CCORE
.INSRT NC
.INSRT NM
.GLOBAL FNWORD
;
; GETCORE - BASIC CORE ALLOCATOR
;
; GETCORE (SIZE) => SIZE,,ADDR
;
CENTRY GETCORE,[BSIZE],[NPAGES,PTR]
MOVE B,BSIZE
ADDI B,1777
LSH B,-10. ; NUMBER OF PAGES NEEDED
MOVEM B,NPAGES
CALL PGJGET,[NPAGES] ; GET PAGES
MOVN B,NPAGES ; MINUS NUMBER OF PAGES
JUMPLE A,CODE [
CROAK STORAGE EXHAUSTED
GO DOT
]
MOVEM A,PTR
HRL A,B ; AOBJN POINTER TO NEW PAGES
TRYAGN: .CALL [SETZ
'CORBLK
1000,,300000 ; WANT READ AND WRITE ACCESS
1000,,-1 ; PUT PAGE IN MY MAP
A ; WHERE TO PUT THEM
401000,,400001 ; GET FRESH PAGES
]
GO CODE [
CROAK UNABLE TO GET CORE
MOVEI 0,30.
.SLEEP 0,
GO TRYAGN
]
MOVE A,PTR
LSH A,10. ; POINTER TO FIRST PAGE
MOVE B,NPAGES
LSH B,10. ; NUMBER OF WORDS GOTTEN
ADDM B,FNWORDS ; SAVE FOR STATS
HRL A,B ; SIZE,,ADDR
RETURN
END

119
arc/ar2:clib/C10EXC C Normal file
View File

@@ -0,0 +1,119 @@
# include "clib/c.defs"
int exctime 0;
int exccode 0;
/**********************************************************************
EXECS - Execute a program with a given command string
Returns:
-5 Job valretted something and was not continued.
-4 Internal fatal error.
-3 Unable to load program file.
-2 Unable to create job.
-1 Unable to open program file.
0 Job terminated normally.
other Job terminated abnormally with said PIRQ
Sets:
exctime - job's CPU time in 1/60 sec. units
exccode - contents of job's loc 1 at termination
**********************************************************************/
int execs (pname, args) char *pname, *args;
{int i, j, ich;
char *s, buf[40];
filespec f;
j = j_fload (pname);
if (j<0) return (j);
j_sjcl (j, args);
j_give_tty (j);
j_start (j);
while (TRUE)
{i = j_wait (j);
j_take_tty (j);
switch (i) {
case -1: return (-4);
case -2: i = 0;
break;
case -3: s = j_valret (j);
if (s)
{cprint ("Job valrets: ");
puts (s);
}
else
{puts ("Job .VALUE 0");
}
cprint ("continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
i = -5;
break;
case -5: wsuset (014, 02); /* simulate ^Z typed */
sleep (15);
j_give_tty (j);
j_start (j);
continue;
default: cprint ("Unhandled interrupt, continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
break;
}
break;
}
exctime = ruset (j_ch(j), 024) / (16666000./4069.);
exccode = 0;
if (!j_name (j, &f) && (ich=open(&f,4))>=0)
{uiiot (ich);
exccode = uiiot (ich);
close (ich);
}
j_kill (j);
return (i);
}
/**********************************************************************
EXECV - Execute file given a vector of arguments
**********************************************************************/
int execv (prog, argc, argv)
char *prog, *argv[];
{char **ap, **ep, buff[300], *p, *s;
int c;
p = buff;
ap = argv;
ep = argv + argc - 1;
while (ap <= ep)
{s = *ap++;
*p++ = '"';
while (c = *s++) *p++ = c;
*p++ = '"';
*p++ = ' ';
}
*p++ = 0;
return (execs (prog, buff));
}

51
arc/ar2:clib/C10EXP C Normal file
View File

@@ -0,0 +1,51 @@
# include "c/c.defs"
/**********************************************************************
EXPAND ARGUMENT VECTOR CONTAINING FILE NAME PATTERNS
**********************************************************************/
static char **next;
static char *bufp;
int exparg (argc, argv, outv, buffer)
char *argv[], *outv[], buffer[];
{int i, expfs();
char *s;
bufp = buffer;
next = outv;
i = 0;
while (i<argc)
{s = argv[i++];
if (expmagic (s)) mapdir (s, expfs);
else *next++ = s;
}
return (next-outv);
}
int expmagic (s) /* does it contain magic pattern chars? */
char *s;
{int c, flag;
flag = FALSE;
while (c = *s++) switch (c) {
case '?':
case '*': flag = TRUE; continue;
case '/': flag = FALSE; continue;
case '\\': if (*s) ++s; continue;
}
return (flag);
}
expfs (fs)
filespec *fs;
{char *prfile (), *p;
p = bufp;
bufp = (prfile (fs, bufp)) + 1;
*next++ = p;
}


231
arc/ar2:clib/C10FD C Normal file
View File

@@ -0,0 +1,231 @@
# include "c.defs"
# include "its.bits"
/**********************************************************************
FD-ITS
File Directory Routines
ITS Version
**********************************************************************/
/**********************************************************************
FDMAP (P, F)
Call F(S) for all filenames S that match the pattern P.
**********************************************************************/
static int (*fff)();
fdmap (p, f)
char *p;
int (*f)();
{extern int fdzzzz();
fff = f;
mapdirec (p, fdzzzz);
}
/**********************************************************************
The following routines are internal and probably should
not be used by other programs.
**********************************************************************/
fdzzzz (fp)
filespec *fp;
{char fn[100];
prfile (fp, fn);
(*fff)(fn);
}
# define DIRSIZ 02000
# define ENTSIZ 5
/* some useful SIXBIT numbers */
# define _FILE_ 0164651544516 /* .FILE. */
# define _PDIRP_ 0104451621100 /* (DIR) */
# define _DSK_ 0446353000000
/**********************************************************************
MAPDIREC - Perform a function for each file in a
directory whose name matches a given pattern
(locked files not included)
**********************************************************************/
mapdirec (pattern, f)
char *pattern; /* the file name pattern */
int (*f)(); /* the function */
{filespec ff;
fparse (pattern, &ff);
return (mapdfs (&ff, f));
}
mapdfs (fp, f)
filespec *fp; /* the parsed pattern */
int (*f)(); /* the function */
{int n, v[2*DIRSIZ/ENTSIZ], *p, *q;
char pat1[10], pat2[10], buf[10];
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = fp->fn1;
fs.fn2 = fp->fn2;
n = rddir (fp, v, 04);
if (fp->fn1) c6tos (fp->fn1, pat1);
if (fp->fn2) c6tos (fp->fn2, pat2);
q = v + 2*n;
for (p=v; p<q; p=+2)
{if (fp->fn1)
{c6tos (p[0], buf);
if (!smatch (pat1, buf)) continue;
}
if (fp->fn2)
{c6tos(p[1], buf);
if (!smatch (pat2, buf)) continue;
}
fs.fn1 = p[0];
fs.fn2 = p[1];
(*f)(&fs);
}
}
/**********************************************************************
RDIREC - Read A Directory
S is a string specifying a directory.
V will be filled with pairs of SIXBIT names, one for each file.
The number of files is returned.
**********************************************************************/
int rdirec (s, v, fs)
char *s;
int v[];
filespec *fs;
{fparse (s, fs);
if (!fs->dir) fs->dir = fs->fn1;
return (rddir (fs, v, 0));
}
/**********************************************************************
RDDIR - Read Directory
Return in V a list of names in the directory specified by FS.
OPT is used to filter out some files:
if (opt & 01) no-links
if (opt & 02) no-backed-up-files
if (opt & 04) no-locked-files
**********************************************************************/
int rddir (fp, v, opt)
filespec *fp;
int v[], opt;
{int buf[DIRSIZ], f, n, i, *p, d, n1, n2;
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = _FILE_;
fs.fn2 = _PDIRP_;
if (!fs.dev) fs.dev = _DSK_;
if (!fs.dir) fs.dir = rsname();
f = open (&fs, BII);
if (f<0) return (0);
sysread (f, buf, DIRSIZ);
close (f);
n = (DIRSIZ - buf[1]) / ENTSIZ;
p = buf+buf[1];
i = 0;
while (--n >= 0)
{n1 = *p++;
n2 = *p++;
d = *p++ >> 18; /* random info */
p =+ 2;
if (d & 060) continue; /* should ignore these */
if (opt & d) continue; /* optionally ignore */
*v++ = n1;
*v++ = n2;
++i;
}
return (i);
}
/**********************************************************************
RMFD - Read the Master File Directory
V will be filled with SIXBIT names, one for each directory,
sorted.
The number of directories is returned.
**********************************************************************/
int rdmfd (v)
int v[];
{int ch, n, *e, *p, *q, i, j, x;
ch = fopen ("m.f.d. (file)", BII);
if (ch<0) return (ch);
n = sysread (ch, v, DIRSIZ);
close (ch);
e = v+n;
p = v+v[1];
q = v;
while (p<e) if (x = *p++) *q++ = x;
n = q-v-1; /* -1 for convenience in sort */
for (i=0; i<n; ++i)
for (j=i; j<=n; ++j)
if (v[j] < v[i]) {x=v[i];v[i]=v[j];v[j]=x;}
++n;
v[n] = 0;
return (n);
}
/**********************************************************************
a test routine
**********************************************************************/
# ifdef test
main ()
{char buf[50];
while (TRUE)
{cprint ("Pattern: ");
gets (buf);
mapdir (buf, prf);
}
}
prf (f)
filespec *f;
{char buf[100];
prfile (f, buf);
cprint ("%s\n", buf);
}
# endif


24
arc/ar2:clib/C10FIL C Normal file
View File

@@ -0,0 +1,24 @@
#include "c.defs"
/**********************************************************************
RENAME (file1, file2)
Should work even if a file2 already exists.
Return 0 if no error.
*ITS VERSION*
**********************************************************************/
rename (s1, s2) char *s1, *s2;
{filespec fs1, fs2;
fparse (s1, &fs1);
fparse (s2, &fs2);
if (fs1.dev==0) fs1.dev = csto6 ("DSK");
sysdelete (&fs2);
sysrname (&fs1, &fs2);
return (0);
}


118
arc/ar2:clib/C10FNM C Normal file
View File

@@ -0,0 +1,118 @@
# include "c/c.defs"
/*
ITS filename cluster
components:
DEV:DIR;NAME TYP
All components manipulated without punctuation.
routines:
s = fngdv (old, buf) return DEV (in buf)
s = fngdr (old, buf) return DIR (in buf)
s = fngnm (old, buf) return NAME (in buf)
s = fngtp (old, buf) return TYP (in buf)
s = fnggn (old, buf) return null GEN (in buf)
s = fngat (old, buf) return null ATTR (in buf)
s = fnsdf (buf, old, dv, dir, nm, typ, gen, attr)
set null components of OLD
new value in BUF
(ignore 0 args)
s = fnsfd (buf, old, dv, dir, nm, typ, gen, attr)
set components of OLD
new value in BUF
(ignore 0 args)
fnparse (old, dv, dir, nm, typ, gen, attr)
parse OLD into components
*/
fnparse (old, dv, dir, nm, typ, gen, attr)
char *old, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dev, dv);
c6tos (temp.dir, dir);
c6tos (temp.fn1, nm);
c6tos (temp.fn2, typ);
gen[0] = 0;
attr[0] = 0;
}
char *fngdv (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dev, buf);
return (buf);
}
char *fngdr (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.dir, buf);
return (buf);
}
char *fngnm (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.fn1, buf);
return (buf);
}
char *fngtp (old, buf)
char *old, *buf;
{filespec temp;
fparse (old, &temp);
c6tos (temp.fn2, buf);
return (buf);
}
char *fnggn (old, buf)
char *old, *buf;
{buf[0] = 0;
return (buf);
}
char *fngat (old, buf)
char *old, *buf;
{buf[0] = 0;
return (buf);
}
char *fnsdf (buf, old, dv, dir, nm, typ, gen, attr)
char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
if (dv && temp.dev==0) temp.dev = csto6 (dv);
if (dir && temp.dir==0) temp.dir = csto6 (dir);
if (nm && temp.fn1==0) temp.fn1 = csto6 (nm);
if (typ && temp.fn2==0) temp.fn2 = csto6 (typ);
prfile (&temp, buf);
return (buf);
}
char *fnsfd (buf, old, dv, dir, nm, typ, gen, attr)
char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr;
{filespec temp;
fparse (old, &temp);
if (dv) temp.dev = csto6 (dv);
if (dir) temp.dir = csto6 (dir);
if (nm) temp.fn1 = csto6 (nm);
if (typ) temp.fn2 = csto6 (typ);
prfile (&temp, buf);
return (buf);
}

96
arc/ar2:clib/C10FO CMID Normal file
View File

@@ -0,0 +1,96 @@
;
; FCOUT - FAST CHARACTER OUTPUT ROUTINES
;
; This file is ITS dependent.
;
TITLE FCOUT
.INSRT NC
.INSRT NM
BLKSIZ==200
BLKCNT==5*BLKSIZ
NL==12
CR==15
; SIOT STUFF
.UDATA
SBUF: BLOCK BLKSIZ
SPTR: BLOCK 1
SCHN: BLOCK 1
SCNT: BLOCK 1
.IDATA
SBPT: 440700,,SBUF
.CODE
CENTRY OOPN,[NAME]
CALL FOPEN,[NAME,[[1]]]
JUMPL A,OP$RET ; NEGATIVE FAILURE CODE
MOVEM A,SCHN ; ITS CHANNEL (RETURNED)
MOVEI B,BLKCNT
MOVEM B,SCNT
MOVE B,SBPT
MOVEM B,SPTR
OP$RET: RETURN
CENTRY OFLS ; FLUSH BUFFER
MOVEI C,BLKCNT
SUB C,SCNT
JUMPLE C,FL$RET
MOVE D,SBPT
SYSCAL SIOT,[SCHN ? D ? C]
FL$RET: MOVE D,SBPT
MOVEM D,SPTR
MOVEI D,BLKCNT
MOVEM D,SCNT
RETURN
CENTRY OUTI,[CC] ; OUTPUT IMAGE CHARACTER
MOVE A,CC
IDPB A,SPTR
SOSG SCNT
CALL OFLS
RETURN
CENTRY OUTC,[CC] ; OUTPUT ASCII CHARACTER
MOVE A,CC
CAIN A,NL
GO OC$NL
OC$1: IDPB A,SPTR
SOSG SCNT
CALL OFLS
RETURN
OC$NL: MOVEI A,CR
IDPB A,SPTR
SOSG SCNT
CALL OFLS
MOVEI A,NL
GO OC$1
CENTRY OUTS,[STR] ; OUTPUT ASCII STRING
MOVE B,STR
OS$2: SKIPN A,(B)
GO OS$RET
ADDI B,1
CAIN A,NL
GO OS$NL
OS$1: IDPB A,SPTR
SOSG SCNT
CALL OFLS
GO OS$2
OS$NL: MOVEI A,CR
IDPB A,SPTR
SOSG SCNT
CALL OFLS
MOVEI A,NL
GO OS$1
OS$RET: RETURN
CENTRY OCLS ; CLOSE FILE
CALL OFLS
SYSCAL CLOSE,[SCHN]
RETURN
END


407
arc/ar2:clib/C10INT CMID Normal file
View File

@@ -0,0 +1,407 @@
;
; INTRUP - C INTERRUPT SYSTEM
;
; This file is ITS dependent.
;
TITLE INTRUP
.INSRT NC
.INSRT NM
.GLOBAL UUOH,USAVEA,USAVEB,USAVEC,USAVED
.GLOBAL PDLTOP
; SOME C INTERRUPT NUMBERS
CH0I==16. ; CHANNEL 0 INTERRUPT
IN0I==32. ; INFERIOR 0 INTERRUPT
MPV==1. ; MPV INTERRUPT
CTRSI==41. ; CONTROL-S INTERRUPT
CTRGI==42. ; CONTROL-G INTERRUPT
NINT==42. ; NUMBER OF INTERRUPTS
; TAB1 - CONVERTS FIRST WORD INTERRUPTS TO C INTERRUPT NUMBER
.PDATA
MDATA TAB1
0 ? 0 ? 10. ? 0 ? 0 ? 0
0 ? 0 ? 0 ? 15. ? 7. ? 6.
5. ? 0 ? 0 ? 0 ? 0 ? 0
13. ? 0 ? 0 ? 4. ? 1. ? 9.
0 ? 0 ? 0 ? 2. ? 0 ? 8.
3. ? 0 ? 14. ? 0 ? 0 ? 12.
; TAB2 - CONTAINS HANDLERS FOR AND INFORMATION ABOUT C INTERRUPTS
; BITS 0-17 HANDLER (0 => DEFAULT, 1 => IGNORE, OTHER => ROUTINE ADDR)
; BITS 18-23 BIT NUMBER IN ITS MASK WORD
; BIT 24 ITS MASK WORD NUMBER
.IDATA
MDATA TAB2
0 ; NOT USED
15,,0 ; MPV
10,,0 ; IOC
5,,0 ; ILOPR
16,,0 ; MAR
27,,0 ; UTRAP
30,,0 ; PURE
31,,0 ; WIRO
6,,0 ; SYSDOWN
14,,0 ; CLOCK
41,,0 ; TIMER
0 ; PDLOV (NOT USED)
0,,0 ; TTYI
21,,0 ; CLI
3,,0 ; OVERFLOW
32,,0 ; FLOATING OVERFLOW
100,,0 ; CHANNEL 0
101,,0 ; CHANNEL 1
102,,0 ; CHANNEL 2
103,,0 ; CHANNEL 3
104,,0 ; CHANNEL 4
105,,0 ; CHANNEL 5
106,,0 ; CHANNEL 6
107,,0 ; CHANNEL 7
110,,0 ; CHANNEL 10
111,,0 ; CHANNEL 11
112,,0 ; CHANNEL 12
113,,0 ; CHANNEL 13
114,,0 ; CHANNEL 14
115,,0 ; CHANNEL 15
116,,0 ; CHANNEL 16
117,,0 ; CHANNEL 17
122,,0 ; INFERIOR 0
123,,0 ; INFERIOR 1
124,,0 ; INFERIOR 2
125,,0 ; INFERIOR 3
126,,0 ; INFERIOR 4
127,,0 ; INFERIOR 5
130,,0 ; INFERIOR 6
131,,0 ; INFERIOR 7
0 ; NOT USED
0 ; CONTROL-S INTERRUPT
0 ; CONTROL-G INTERRUPT
;
; ON - SPECIFY AN ACTION FOR A C INTERRUPT
;
.CODE
CENTRY ON,[INTNO,NEWH]
MOVE B,INTNO ; INTERRUPT #
JUMPLE B,ON2 ; BAD #
CAILE B,NINT ; NINT = HIGHEST VALID #
GO ON2 ; BAD #
HRRZ A,NEWH ; NEW HANDLER
CAIL B,CTRSI
GO ON1 ; SOFTWARE INTERRUPT
LDB D,[220600,,TAB2(B)] ; BIT #
MOVEI C,1
LSH C,(D) ; MASK
LDB D,[300100,,TAB2(B)] ; WORD #
CAIN B,CTRGI
JUMPE A,TURNON
JUMPE A,TURNOF
CAIE A,1
GO TURNON
CAIGE B,8.
GO TURNON
TURNOF: .SUSET [.SAMASK,,C ? .SAMSK2,,C](D)
GO ON1
TURNON: .SUSET [.SIMASK,,C ? .SIMSK2,,C](D)
ON1: HRRZ C,TAB2(B) ; OLD HANDLER
HRRM A,TAB2(B) ; NEW HANDLER
MOVE A,C ; RETURN OLD HANDLER
ONRET: RETURN
ON2: CROAK ON: INVALID INTERRUPT NUMBER
MOVEI A,1
GO ONRET
;
; SIGNAL - SIGNAL A C INTERRUPT
;
CENTRY SIGNAL,[SIGNO]
MOVE A,SIGNO ; INTERRUPT #
JUMPLE A,S3 ; BAD #
CAILE A,NINT ; NINT = HIGHEST VALID #
GO S3 ; BAD #
HRRZ B,TAB2(A) ; HANDLER
CAIN B,1
GO SIGRET ; 1 => IGNORE
JUMPN B,S1 ; SPECIFIED HANDLER
CAIN A,CTRGI
GO S4 ; HANDLE ^G INTERRUPT
GO SIGRET ; OTHERWISE IGNORE
S1: CAIGE A,CH0I
GO S2 ; NO ARG
CAILE A,IN0I+7
GO S2 ; NO ARG
CAIGE A,IN0I
SUBI A,CH0I ; ARG IS CHANNEL #
CAIL A,IN0I
SUBI A,IN0I ; ARG IS INFERIOR #
VCALL (B),[A]
GO SIGRET
S2: CAIN A,CTRSI
CL CTRSIH ; SPECIAL ^S ACTION
CAIN A,CTRGI
CL CTRGIH ; SPECIAL ^G ACTION
VCALL (B)
GO SIGRET
S3: CROAK INVALID INTERRUPT SIGNALLED
GO SIGRET
S4: CL CTRGIH
CALL STKDMP
CROAK -- ^G --
SIGRET: RETURN
; SPECIAL HANDLER FOR CONTROL-S INTERRUPT
IENTRY CTRSIH
PPUSH A
PPUSH B
CTRS1: SETO B,
SYSCAL IOT,[5000,,%TIACT+%TIINT+%TINWT ? TYICHN" ? 2000,,B]
JUMPLE B,CTRS2
CAIE B,^S
GO CTRS1
CTRS2: PPOP B
PPOP A
RTN
; SPECIAL HANDLER FOR CONTROL-G INTERRUPT
IENTRY CTRGIH
PPUSH A
PPUSH B
CTRG1: SETO B,
SYSCAL IOT,[5000,,%TIACT+%TIINT+%TINWT ? TYICHN ? 2000,,B]
JUMPLE B,CTRG2
CAIE A,^G
GO CTRG1
CTRG2: PPOP B
PPOP A
RTN
;
; DISMISS - DISMISS INTERRUPT AND RETURN TO CALLER
;
MENTRY DISMISS
SYSCAL DISMIS,[5000,,T%CTL ? INTPTR ? 1000,,.+2]
RETURN
;
; GETPC - GET INTERRUPTED PC
;
CENTRY GETPC
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
HRRZ A,T%OPC(D)
RETURN
;
; SETPC - SET INTERRUPTED PC
;
CENTRY SETPC,[PC]
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,PC
HRRM A,T%OPC(D)
RETURN
;
; INTERRUPT HANDLING SPECIFICATONS
;
T%NRG==4 ; NUMBER OF REGISTERS PUSHED
T%IW1==0 ; OFFSET OF 1ST INTERRUPT WORD
T%IW2==1 ; OFFSET OF 2ND INTERRUPT WORD
T%DF1==2 ; OFFSET OF 1ST OLD DEFER WORD
T%DF2==3 ; OFFSET OF 2ND OLD DEFER WORD
T%OPC==4 ; OFFSET OF OLD PC
T%REG==5 ; OFFSET OF FIRST SAVED REGISTER
T%SIZ==T%REG+T%NRG ; SIZE OF INTERRUPT FRAME
T%CTL==A*100+T%NRG ; CONTROL ARG FOR PUSHING REGS
MDATA TSINT
T%CTL,,INTPTR ; PUSH REGISTERS ON INTERRUPT STACK
%PIPDL ? 0 ; HANDLE PDL-OVERFLOW
-1 ? -1 ; DEFER ALL INTERRUPTS
PDLOVH ; PDL-OVERFLOW HANDLER
%PIMPV ? 0 ; HANDLE MPV
#%PIPDL ? -1 ; DEFER ALL BUT PDL-OVERFLOW
MPVH ; MPV HANDLER
#<%PIMPV+%PIPDL> ? 0 ; HANDLE ALL OTHER FIRST WORDERS
#<%PIMPV+%PIPDL> ? -1 ; DEFER ALL BUT MPV AND PDLOV
TSINT1 ; INTERRUPT HANDLER
0 ? -1 ; HANDLE ALL SECOND WORDERS
#<%PIMPV+%PIPDL> ? -1 ; DEFER ALL BUT MPV AND PDLOV
TSINT2 ; INTERRUPT HANDLER
TSINTL"==21. ; .-TSINT DOESN'T WORK DUE TO MIDAS BUG
;
; INTERRUPT STACK
;
INTPSZ==2*TSINTL ; SIZE OF INTERRUPT STACK
.IDATA
MDATA INTPTR
-INTPSZ,,INTPDL
MDATA INTPDL
BLOCK INTPSZ-1
-1 ; THIS PAGE MUST NOT BE DELETED!
.CODE
;
; MPV HANDLER
;
IENTRY MPVH
.SUSET [.RMPVA,,B] ; GET LOSING ADDRESS
; NOTE THAT ON KA-10 THIS ADDRESS
; IS ROUNDED DOWN TO FIRST WORD
; OF PAGE
TRZ B,1777 ; ROUND DOWN ANYWAY (FOR KL-10)
CAMGE B,SEG0LO" ; MAYBE IN SEGMENT 0?
GO MPV$0 ; NO
CAMG B,SEG0HI" ; IN SEGMENT 0?
GO MPV$1 ; YES
MPV$0: CAMGE B,SEG1LO" ; MAYBE IN SEGMENT 1?
GO TSINT1 ; NO
CAMLE B,SEG1HI" ; IN SEGMENT 1?
GO TSINT1 ; NO
; HERE IF ADDRESS IS IN SEGMENT 1
MOVE C,PDLTOP ; TOP END OF STACK
SUBI C,2000
TRZ C,1777 ; LAST FULL PAGE OF STACK
CAME B,C ; REFERENCE TO LAST PAGE OF STACK?
GO MPV$1 ; NO
CROAK IMMINENT STACK OVERFLOW
MPV$1: LSH B,-10. ; PAGE NUMBER
SYSCAL CORTYP,[B ? SETZM C] ; GET PAGE INFO
JUMPN C,TSINT1 ; PAGE EXISTS => MPV ON ANOTHER JOB
MPV$2: SYSCAL CORBLK,[1000,,%CBNDW ? 1000,,-1 ? B ? 1000,,%JSNEW],MPVLOS
GO INTDIS
MPVLOS: CROAK UNABLE TO GET ZERO PAGE
GO MPV$2
;
; HANDLER FOR FIRST WORD INTERRUPTS
;
IENTRY TSINT1
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,T%IW1(D) ; GET INTERRUPT WORD
JFFO A,.+2 ; GET FIRST BIT
GO INTDIS ; NONE (?)
MOVE A,TAB1(B) ; C INTERRUPT NUMBER
JUMPE A,IGNORE ; NOT HANDLED
HRRZ B,TAB2(A) ; HANDLER
CAIN B,1
GO IGNORE ; 1 MEANS IGNORE
JUMPN B,TS1 ; HANDLER SPECIFIED
CAIN A,MPV
GO FATMPV
CAIN A,CTRGI
GO TS1 ; DEFAULT IS NOT TO IGNORE
IGNORE: AOS T%OPC(D) ; OTHERWISE - THE DEFAULT
GO INTDIS ; IS TO CONTINUE WITH THE
; NEXT INSTRUCTION
; HERE IF FATAL MPV OCCURS
FATMPV: MOVEI A,%PIMPV
IORM A,T%DF1(D) ; MAKE MPV DEFFERED
GO INTDIS ; NOW DISMISS - WILL MAKE FATAL
;
; SECOND WORD INTERRUPT HANDLER
;
IENTRY TSINT2
MOVE D,INTPTR ; TOP OF INTERRUPT STACK
MOVEI D,-T%SIZ+1(D) ; BOTTOM OF FRAME
MOVE A,T%IW2(D) ; GET INTERRUPT WORD
JFFO A,.+2
GO INTDIS
CAILE B,17.
GO CHANI
CAIGE B,10.
GO INTDIS
MOVN A,B
ADDI A,17.+IN0I
GO TS1
CHANI: CAIGE B,19.
GO INTDIS
MOVN A,B
ADDI A,35.+CH0I
GO TS1
;
; HERE TO SIGNAL SOMETHING WITH ARG IN A
;
DEFINE PUSHL LIST
IRP X,,[LIST]
PPUSH X
TERMIN!TERMIN
DEFINE POPL LIST
IRP X,,[LIST]
PPOP X
TERMIN!TERMIN
TS1: ADDI P,20 ; IN CASE EPILOG INTERRUPTED
PUSHL [0,5,6,7,10,11,12,13,14,15,16]
PUSHL [40,USAVEA,USAVEB,USAVEC,USAVED,UUOH]
CALL SIGNAL,[A]
POPL [UUOH,USAVED,USAVEC,USAVEB,USAVEA,40]
POPL [16,15,14,13,12,11,10,7,6,5,0]
SUBI P,20
PDLOVH:
INTDIS: SYSCAL DISMIS,[5000,,T%CTL ? INTPTR]
IENTRY ETSINT
END


849
arc/ar2:clib/C10IO C Normal file
View File

@@ -0,0 +1,849 @@
# include "c/c.defs"
# include "c/its.bits"
/*
*
* CIO - C I/O Routines (written in C)
*
* Routines:
*
* fd = copen (fname, mode, opt)
* c = getchar ()
* gets (s)
* putchar (c)
* puts (s)
* ch = mopen (f, mode)
* rc = mclose (ch)
* rc = fparse (s, f)
* s = prfile (f, s)
* ch = fopen (fname, mode)
* ch = open (&filespec, mode)
* argc = fxarg (argc, argv)
* n = prsarg (in, out, argv, job)
* valret (s)
* c6 = ccto6 (c)
* c = c6toc (c6)
* w = csto6 (s)
* s = c6tos (w, s)
*
* Internal routines:
*
* c0init () [called by startup routine]
* fd = c0open (fname, mode)
* w = cons (lh, rh)
* s = filscan (b, s)
* s = c6q2s (w, s)
*
* Variables:
*
* cin - standard input channel
* cout - standard output channel
* cerr - standard error output channel
*
* cinfn - standard input file name (if redirected)
* coutfn - standard output file name (if redirected)
* cerrfn - standard errout file name (if redirected)
*
*
*/
# rename c0fcbs "C0FCBS"
# rename gettab "GETTAB"
# rename puttab "PUTTAB"
# rename clotab "CLOTAB"
# rename gc_bad "GC$BAD"
# rename pc_bad "PC$BAD"
# rename cl_bad "CL$BAD"
# rename prsarg "PRSARG"
# rename fcbtab "FCBTBL"
# rename tty_input_channel "TYICHN"
# rename tty_output_channel "TYOCHN"
# rename setappend "SETAPP"
# define _magic 37621 /* a magic number for validation */
# define buf_siz 0200
# define fcb_siz 7
# define NCHANNEL 10 /* number of CHANNELs */
# define phyeof_flag 001
# define open_flag 002
# define write_flag 004
# define tty_flag 010
# define unset_flag 020
# define QUOTE 021 /* control-Q, for file names */
# define _DSK 0446353000000 /* sixbit for DSK */
# define _GREATER 0360000000000 /* sixbit for > */
# define _TTY 0646471000000 /* sixbit for TTY */
# define _FILE 0164651544516 /* sixbit for .FILE. */
# define _DIR 0104451621100 /* sixbit for (DIR) */
channel cin, /* standard input unit */
cout, /* standard output unit */
cerr; /* standard error output unit */
char *cinfn, /* standard input file name, if redirected */
*coutfn, /* standard output file name, if redirected */
*cerrfn; /* standard errout file name, if redirected */
int cerrno; /* system OPEN error codes returned here */
extern int c0fcbs[], fcbtab[], puttab[], gettab[], clotab[],
gc_bad[], pc_bad[], cl_bad[];
/**********************************************************************
COPEN - CIO Open File
Open a file, given a file name, an optional mode, and an
optional options string. The possible modes are
'r' - read
'w' - write
'a' - append
The default mode is read. Normally, I/O is character oriented
and produces text files. In particular, the lines of a text
file are assumed (by the user) to be separated by newline
characters with any conversion to the system format performed
by the I/O routines.
If an options string is given and contains the character "b",
then I/O is integer (word) - oriented and produces image files.
I/O to and from character strings in core is accomplished by
including "s" in the options string and supplying a character
pointer to the string to be read or written into as the first
argument to COPEN. Closing a string open for write will
append a NULL character to the string and return a character
pointer to that character.
COPEN returns a CHANNEL, which is a pointer to a control block.
The external variables CIN, COUT, and CERR contain already-open
channels for standard input, standard output, and standard
error output, respectively.
COPEN returns OPENLOSS in case of error. The system error code is
stored in CERRNO.
**********************************************************************/
channel copen (fname, mode, opt)
char *fname;
{int *fcbp, i, fmode, bmode, its_mode, flags;
int chan, buffp, state, bcnt, device, c, sflag, *ip;
char *p, buf[5], *ep;
filespec f;
cerrno = 0;
if (mode<'A' || mode>'z') mode = 'r';
p = opt;
if (opt<0100 || opt>=01000000) p = "";
else if (p[0]<'A' || p[0]>'z') p = "";
flags = open_flag;
fmode = 0;
switch (lower (mode)) {
case 'r': fmode = 0; break;
case 'w': fmode = 1; break;
case 'a': fmode = 2; break;
default: cerrno = 012; /* mode not available */
return (OPENLOSS);
}
bmode = 0;
sflag = FALSE;
while (c = *p++) switch (lower (c)) {
case 'b': bmode = 4; break;
case 's': sflag = TRUE; break;
}
if (c0fcbs[0] != _magic) c0init(); /* initialize */
for (i=0; i<NCHANNEL; ++i)
{fcbp = fcbtab[i];
if (!(fcbp[0] & open_flag)) break;
}
if (i>=NCHANNEL)
{cerrno = 06; /* device full */
return (OPENLOSS);
}
chan = -1;
buffp = fcbp[0] >> 18;
if (sflag) /* string I/O */
{state = 3;
if (fmode==2) /* append */
while (*fname) ++fname;
}
else /* file I/O */
{state = 1;
fparse (fname, &f); /* parse file name */
if (f.dev == _TTY /* TTY special case */
&& (f.fn1 != _FILE || f.fn2 != _DIR))
{state = 0;
bmode = 0;
device = 0;
chan = -1;
flags =| tty_flag;
}
else /* normal case */
{if (f.dev == 0) f.dev = _DSK;
if (f.dir == 0) f.dir = rsname();
if (f.fn2 == 0) f.fn2 = _GREATER;
its_mode = (fmode==2 ? 0100001 : fmode);
its_mode =| 2; /* block mode */
its_mode =| bmode; /* image mode */
if (fmode==2 && !bmode) /* char append */
{chan = setappend (&f, its_mode, buf, &ep);
if (chan == -04) /* not found */
{chan = mopen (&f, its_mode & 077);
fmode = 1;
}
}
else chan = mopen (&f, its_mode);
if (chan<0) {cerrno = -chan; return (OPENLOSS);}
device = status (chan) & 077; /* device code */
if (bmode && device<=2) /* TTY in IMAGE mode ?? */
{close (chan);
bmode = 0;
its_mode =& ~4;
chan = mopen (&f, its_mode);
if (chan<0) {cerrno = -chan; return (OPENLOSS);}
device = status (chan) & 077;
}
if (state==1)
if (buffp==0)
{buffp = salloc (buf_siz);
if (buffp == -1)
{cerrno = 037; /* no core available */
return (OPENLOSS);
}
}
else
{i = buf_siz;
ip = buffp;
while (--i >= 0) *ip++ = 0;
}
}
}
bcnt = -1; /* special initialization hack */
if (fmode)
{bcnt = 5*buf_siz; /* char count */
if (bmode) bcnt = buf_siz; /* word count */
flags =| write_flag;
}
if (bmode && !sflag) state = 2;
if (chan < 0) {flags =| unset_flag; chan = 0;}
fcbp[0] = (buffp<<18) | ((chan&017)<<14) | ((device&077)<<8) | flags;
fcbp[2] = bcnt;
if (sflag) fcbp[1] = fname;
else fcbp[1] = cons (bmode ? 0 : 0440700, buffp);
if (fcbp[3]==0) fcbp[3] = salloc(20);
else fcbp[3] =& 0777777;
if (fmode) state =+ 4;
fcbp[4] = cons (clotab[state], fcbp[5]=gettab[state]);
fcbp[6] = puttab[state];
if (fmode==2 && !sflag) /* file append */
{i = fillen (chan);
if (bmode) access (chan, i); /* access to end of file */
else if (i>0)
{access (chan, i-1); /* write over last word */
p = buf;
while (p < ep) cputc (*p++ | 0400, fcbp);
}
}
return (fcbp);
}
/**********************************************************************
SETAPPEND - Set up for character append
**********************************************************************/
int setappend (fp, mode, buf, epp) filespec *fp; char buf[], **epp;
{int count, n, chan, wordlen, chanlen, c;
char *p;
count = 5; /* try 5 times */
while (--count>=0)
{p = buf;
chan = mopen (fp, UII);
if (chan < 0) return (chan);
wordlen = fillen (chan);
close (chan);
chan = mopen (fp, UAI);
if (chan < 0) return (chan);
chanlen = fillen (chan);
if (chanlen > 0)
{if (chanlen == wordlen) --chanlen;
else chanlen = ((chanlen-1)/5)*5;
access (chan, chanlen);
n = 5;
while (--n>=0 && (c = uiiot (chan)) >= 0 && c != 3)
*p++ = c;
}
close (chan);
*epp = p;
chan = mopen (fp, mode);
if (chan<0) return (chan);
if (wordlen == fillen(chan)) return (chan);
close (chan);
}
return (-012);
}
/**********************************************************************
GETCHAR - Read a character from the standard input unit
**********************************************************************/
getchar () {return (cgetc (cin));}
/**********************************************************************
GETS - Read a string from the standard input unit
**********************************************************************/
gets (p)
char *p;
{int c;
while ((c = cgetc (cin)) != '\n' && c>0) *p++ = c;
*p = 0;
}
/**********************************************************************
PUTCHAR - Output a character to the standard output unit
**********************************************************************/
putchar (c)
int c;
{return (cputc (c, cout));}
/**********************************************************************
PUTS - Output a string to the standard output unit
**********************************************************************/
puts (s)
char *s;
{int c;
while (c = *s++) cputc (c, cout);
cputc ('\n', cout);
}
/**********************************************************************
MOPEN - OPEN FILE
Open file given filespec and mode.
Return ITS channel number or -FC if unsuccessful.
Same as OPEN, except handles TTY specially
and waits if file is locked.
**********************************************************************/
channel mopen (f, mode) filespec *f; int mode;
{int ch, n;
if (f->dev == _TTY && !(f->fn1 == _FILE && f->fn2 == _DIR))
return (mode & 1 ? tyoopn() : tyiopn());
ch = open (f, mode);
n = 8;
while (ch == -023 && --n>=0) /* file locked */
{sleep (30);
ch = open (f, mode);
}
return (ch);
}
/**********************************************************************
MCLOSE - Close ITS channel, unless its the TTY.
**********************************************************************/
mclose (ch) channel ch;
{extern int tty_input_channel, tty_output_channel;
if (ch == tty_input_channel) return (0);
if (ch == tty_output_channel)
{tyo_flush ();
return (0);
}
return (close (ch));
}
/**********************************************************************
FPARSE - Convert an ASCIZ string representation of an ITS
file name or a path name to a FILESPEC.
Return 0 if OK, -1 if bad path name format.
**********************************************************************/
fparse (s, f) char s[]; filespec *f;
{int i, c, fnc, n_slash, no_its_chars, n_dot;
char buf[7], *p, *filscan();
f->dev = f->dir = f->fn1 = f->fn2 = 0;
/* check for path name */
p = s;
no_its_chars = TRUE;
n_slash = n_dot = 0;
while (c = *p++) switch (c) {
case QUOTE: if (*p) ++p; break;
case '.': ++n_dot; break;
case '/': ++n_slash; break;
case ' ':
case ':':
case ';': no_its_chars = FALSE; break;
}
if (no_its_chars && (n_dot>0 || n_slash>0))
/* here if path name */
{p = s;
if (*p=='/')
{--n_slash;
p = filscan (buf, ++p, &n_dot, &n_slash);
f->dev = csto6(buf);
c = *p++;
if (c!='/') return (-1);
}
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
if (c=='/')
{f->dir = csto6(buf);
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
}
if (c=='.')
{f->fn1 = csto6(buf);
p = filscan (buf, p, &n_dot, &n_slash);
c = *p++;
}
if (f->fn1) f->fn2 = csto6(buf);
else f->fn1 = csto6(buf);
return (0);
}
/* here if ITS file name */
p = s;
fnc = i = 0;
buf[0] = 0;
do {c = *p++;
switch (c) {
case ':': f->dev = csto6(buf);
i = 0;
break;
case ';': f->dir = csto6(buf);
i = 0;
break;
case ' ':
case 0: if (buf[0]) switch (fnc++) {
case 0: f->fn1 = csto6(buf); break;
case 1: f->fn2 = csto6(buf); break;
}
i = 0;
break;
default: if (c==QUOTE && *p) c = *p++;
if (i<6) buf[i++] = c;
}
buf[i] = 0;
}
while (c);
return (0);
}
/**********************************************************************
FILSCAN - scan for part of file name
**********************************************************************/
char *filscan (b, q, andot, anslash)
char *b, *q;
int *andot, *anslash;
{int c;
char *p;
p = q++;
while (c = *p++)
{if (c=='/') {--*anslash; break;}
else if (c=='.')
{if (--*andot == 0 && *anslash==0 && *p &&
p!=q) break;}
else if (c==QUOTE && *p) c = *p++;
*b++ = c;
}
*b = 0;
return (--p);
}
/**********************************************************************
PRFILE - convert FILESPEC to ITS file name
**********************************************************************/
char *prfile(f,p) filespec *f; char *p;
{char *c6q2s();
if (f->dev) {p = c6q2s (f->dev, p); *p++ = ':';}
if (f->dir) {p = c6q2s (f->dir, p); *p++ = ';';}
if (f->fn1) {p = c6q2s (f->fn1, p); *p++ = ' ';}
if (f->fn2) {p = c6q2s (f->fn2, p);}
*p = 0;
return (p);
}
/**********************************************************************
FOPEN - Open file given file name
**********************************************************************/
channel fopen (fname, mode) char *fname; int mode;
{filespec f;
fparse (fname, &f);
if (f.dev == 0) f.dev = _DSK;
if (f.dir == 0) f.dir = rsname();
return (open (&f, mode));
}
/**********************************************************************
OPEN - Open file given filespec
**********************************************************************/
channel open (f, mode) filespec *f; int mode;
{channel c;
int rc;
c = chnloc();
if (c<0) return (-014); /* bad channel number */
rc = sysopen (c, f, mode);
if (rc) return (rc);
return (c);
}
/**********************************************************************
FXARG - Process Command Arguments to Set Up
Redirection of Standard Input and Output
This routine is called by the C start-up routine.
**********************************************************************/
int fxarg (argc, argv) int argc; char *argv[];
{char **p, **q, *s;
int i, append, errappend, f;
i = argc; /* number of arguments given */
argc = 0; /* number of arguments returned */
p = argv; /* source pointer */
q = argv; /* destination pointer */
while (--i >= 0) /* for each argument given */
{s = *p++; /* the argument */
switch (s[0]) {
case '<': if (s[1]) cinfn = s+1; break;
case '>': if (s[1] == '>')
{if (s[2]) {coutfn = s+2; append = TRUE;}}
else {if (s[1]) {coutfn = s+1; append = FALSE;}}
break;
case '%': if (s[1] == '%')
{if (s[2]) {cerrfn = s+2; errappend=TRUE;}}
else {if (s[1]) {cerrfn = s+1; errappend = FALSE;}}
break;
default: /* normal argument */
++argc; *q++ = s;
}
}
/* now hack the standard file descriptors */
if (cinfn) /* input is redirected */
{f = c0open (cinfn, 'r');
if (f != OPENLOSS) {cclose (cin); cin = f;}
}
if (coutfn) /* output is redirected */
{f = c0open (coutfn, append ? 'a' : 'w');
if (f != OPENLOSS) {cout = f;}
}
if (cerrfn) /* errout is redirected */
{f = c0open (cerrfn, errappend ? 'a' : 'w');
if (f != OPENLOSS)
{if (cerr!=cout) cclose (cerr); cerr = f;}
}
return (argc);
}
/**********************************************************************
C0OPEN - Open with error message
**********************************************************************/
channel c0open (name, mode)
{channel f;
f = copen (name, mode, 0);
if (f == OPENLOSS) cprint (cerr, "Unable to open '%s'\n", name);
return (f);
}
/**********************************************************************
C0INIT - Initialization for C I/O Routines.
This routine is normally called first by the C start-up routine.
**********************************************************************/
c0init ()
{int *p, i;
c0fcbs[0] = _magic;
p = &c0fcbs[1];
i = NCHANNEL*fcb_siz;
while (--i >= 0) *p++ = 0;
i = NCHANNEL;
while (--i >= 0)
{p = &c0fcbs[fcb_siz*i+5];
p[0] = cons (cl_bad, gc_bad);
p[1] = gc_bad;
p[2] = pc_bad;
}
cin = copen ("/tty", 'r', 0); /* standard input */
cout = cerr = copen ("/tty", 'w', 0); /* standard output */
/* These calls do not actually open the TTY, the TTY is
automatically opened when I/O is done to it. This is helpful
for allowing C programs to run without the TTY. */
}
/**********************************************************************
VALRET - Valret a String
**********************************************************************/
valret (s) char *s;
{int len, bp1, bp2, buf, c, flag;
flag = FALSE;
len = slen (s);
buf = salloc (len/5 + 1);
if (buf<=0)
{buf=s; /* gross hack */
flag = TRUE;
}
bp1 = bp2 = 0440700000000 | buf;
while (TRUE)
{c = *s++;
if (c=='\n') c='\r';
idpb (c, &bp1);
if (!c) break;
}
val7ret (bp2);
if (flag) cquit(1); else sfree (buf);
}
/**********************************************************************
PRSARG - Parse JCL Arguments (PDP-10 ITS)
given: in - an advance byte pointer to the JCL
out - a pointer to a character buffer where the
arguments should be placed
argv - a pointer to a character pointer array
where pointers to the args should be placed
job - the sixbit XJNAME
narg - the maximum number of arguments
returns: number of arguments
**********************************************************************/
int prsarg (in, out, argv, job, narg)
char *out, *argv[];
{int c, argc;
char *c6tos();
argc = 1;
argv[0] = out;
out = c6tos (job, out);
*out++ = 0;
argv[1] = out;
while (c = ildb (&in))
{switch (c) {
case '\r': break;
case QUOTE: *out++ = ildb (&in); continue;
case ' ': continue;
case '"': while (c = ildb (&in))
{switch (c) {
case '\r': break;
case QUOTE: *out++ = ildb (&in); continue;
case '"': break;
default: *out++ = c; continue;
}
break;
}
*out++ = 0;
if (++argc < narg) argv[argc] = out;
if (c=='"') continue;
break;
default: *out++ = c;
while (c = ildb (&in))
{switch (c) {
case '\r': break;
case ' ': break;
case QUOTE: *out++ = ildb (&in); continue;
default: *out++ = c; continue;
}
break;
}
*out++ = 0;
if (++argc < narg) argv[argc] = out;
if (c==' ') continue;
break;
}
break;
}
return (argc>narg ? narg : argc);
}
/**********************************************************************
CONS - construct word from left and right halves
**********************************************************************/
int cons (lh, rh) {return (((lh & 0777777) << 18) | (rh & 0777777));}
/**********************************************************************
CCTO6 - convert ascii character to sixbit character
**********************************************************************/
char ccto6 (c) char c;
{return (((c>=040 && c<0140) ? c+040 : c) & 077);}
/**********************************************************************
C6TOC - convert sixbit character to ascii character
**********************************************************************/
char c6toc (c) char c;
{return (c+040);}
/**********************************************************************
CSTO6 - convert ascii string to left-justified sixbit
**********************************************************************/
int csto6 (s) char *s;
{int c,i,j;
i=0;
j=30;
while (c = *s++) if (j>=0)
{i =| (ccto6(c)<<j);
j =- 6;
}
return (i);
}
/**********************************************************************
C6TOS - convert left-justified sixbit word to ascii string
**********************************************************************/
char *c6tos (i, p) int i; char *p;
{int c,j;
j = 30;
while (j>=0 && (c = (i>>j)&077))
{*p++ = c6toc(c); j =- 6;}
*p = 0;
return (p);
}
/**********************************************************************
C6Q2S - convert left-justified sixbit word to ascii string,
inserting QUOTE characters, where necessary
**********************************************************************/
char *c6q2s (i, p) int i; char *p;
{int c, j;
j = 30;
while (j>=0)
{c = c6toc ((i>>j) & 077);
if (c==' ' || c==':' || c==';') *p++ = QUOTE;
*p++ = c;
if (! (i & ((1<<j) - 1))) break;
j =- 6;
}
*p = 0;
return (p);
}


720
arc/ar2:clib/C10JOB C Normal file
View File

@@ -0,0 +1,720 @@
# include "clib/c.defs"
# include "clib/its.bits"
/**********************************************************************
JOBs - Inferior Process Management
ITS Version
**********************************************************************/
/*
The representation of a job is an integer with a value from
0 to 7, indicating the inferior number.
Routines:
j_create (jname) => # or error code
j_load (filespec) => # or error code
j_fload (file_name) => # or error code
j_cload (channel, jname) => # or error code
j_own (uname, jname) => # or error code
error code:
-1 unable to open program file
-2 unable to create job
-3 unable to load job
-4 fatal error
-5 (OWN) no such job
-6 (OWN) job not yours
j_start (#) => rc (return code: non-zero => error)
j_stop (#) => rc
j_disown (#) => rc
j_forget (#) => rc
j_kill (#) => rc
j_snarf (#, inferior_name) => rc
(disown named inferior from stopped job)
j_give_tty (#) => rc
j_take_tty (#) => rc
j_grab_tty () (grab tty if given to some inferior
and stop job)
j_retn_tty () (return tty to inferior and restart)
j_wait (#) => status (waits for non-zero status)
j_sts (#) => status
j_onchange (f) (set handler for status changes)
j_sjcl (#, s) => rc (set jcl for job)
j_jcl (#) => s (get jcl)
j_ch (#) => ch (return block image output channel to job)
j_name (#, filespec) (set filespec to job name)
j_val (#) => s (return string valretted by job)
j_fval (#) (flush valret string; or call cfree)
Job Status:
-5 => stopped, ^Z typed
-4 => stopped (by superior)
-3 => stopped, valret
-2 => stopped, requested suicide
-1 => no job
0 => running
>0 => stopped, value is job's first interrupt word
*/
# define MAXJOBS 8
# define VALBUFSIZ 200
/* job status values */
# define js_attn -5
# define js_stopped -4
# define js_valret -3
# define js_suicide -2
# define js_nojob -1
# define js_running 0
/* useful SIXBIT numbers */
/* Fixed by BGS 9/14/79 because of MOVNI bug
# define _USR 0656362000000
# define _TS 0646300000000
# define _DSK 0446353000000
# define _FOO 0465757000000
# define _GR 0360000000000 */ /* > */
#define _USR csto6("USR")
#define _TS csto6("TS")
#define _DSK csto6("DSK")
#define _FOO csto6("FOO")
#define _GR csto6(">")
/* internal tables */
# rename job_channels "JOBCHN"
# rename job_status "JOBSTS"
# rename job_jcl "JOBJCL"
# rename job_valret "JOBVAL"
# rename job_name "JOBNAM"
# rename job_xname "JOBXNM"
# rename job_wait "JOBWAT"
int job_status[MAXJOBS] {js_nojob, js_nojob, js_nojob, js_nojob,
js_nojob, js_nojob, js_nojob, js_nojob};
int job_channels[MAXJOBS] {-1, -1, -1, -1, -1, -1, -1, -1};
char *job_jcl[MAXJOBS];
char *job_valret[MAXJOBS];
int job_name[MAXJOBS];
int job_xname[MAXJOBS];
int job_wait -1;
static int jobtty {-1}, jobotty, jobosts, (*jchandler)();
/* the routines */
int j_fload (file_name) char *file_name;
{filespec f;
fparse (file_name, &f);
return (j_load (&f));
}
int j_load (f) filespec *f;
{int pch, xjname;
if (f->dev == 0) f->dev = _DSK;
if (f->dir == 0) f->dir = rsname ();
pch = mopen (f, BII);
if (pch<0) return (-1);
xjname = (f->fn1 == _TS ? f->fn2 : f->fn1);
return (j_cload (pch, xjname));
}
int j_cload (pch, xjname)
channel pch;
{int j, jch, start;
j = j_create (xjname);
if (j<0)
{close (pch);
return (j);
}
jch = job_channels[j];
/* load program */
if (sysload (jch, pch))
{uclose (jch);
close (pch);
return (-3);
}
/* get starting address of program */
sysread (pch, &start, 1);
close (pch);
/* set starting address of job */
wuset (jch, UPC, start & 0777777);
return (j);
}
int j_create (xjname)
{int jch, i, inc, count, flag;
filespec jf;
/* set up job name */
jf.dev = _USR;
jf.dir = 0;
jf.fn1 = 0;
jf.fn2 = xjname;
/* make job name unique */
flag = FALSE;
while ((jch = open (&jf, OLD + BII)) >= 0)
{close (jch);
if (!flag)
{flag = TRUE;
i = jf.fn2;
count = 0;
while ((i&077)==0) {i =>> 6; ++count;}
if (count>0)
{count = 6*(count-1);
jf.fn2 =| ccto6('0') << count;
inc = 1 << count;
}
else
{jf.fn2 = (jf.fn2 & ~077) | ccto6('0');
inc = 1;
}
}
else jf.fn2 =+ inc;
}
/* create job */
jch = open (&jf, BIO);
if (jch<0) return (-2);
reset (jch);
/* set job's NAMEs */
wuset (jch, USNAME, rsname());
wuset (jch, UXJNAME, xjname);
return (j_xxx (jch, xjname));
}
/**********************************************************************
J_OWN - attach job as inferior
**********************************************************************/
int j_own (uname, jname)
{filespec fs;
int jch, j, w, sts;
fs.dev = _USR;
fs.dir = 0;
fs.fn1 = uname;
fs.fn2 = jname;
if ((jch = open (&fs, OLD + BII)) < 0) return (-5);
close (jch);
if ((jch = open (&fs, BIO)) < 0) return (-5);
if (status (jch) != 061)
{close (jch); return (-6);}
j = j_xxx (jch, jname);
if (ruset (jch, USTOP) & BUSRC)
{w = ruset (jch, UPIRQ);
if (w & PICZ) sts = js_attn;
else if (w & PIVAL) sts = js_valret;
else if (w) sts = w;
else sts = js_stopped;
wuset (jch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
}
else sts = js_running;
job_status[j] = sts;
return (j);
}
/**********************************************************************
J_XXX - common processing for new inferior
**********************************************************************/
int j_xxx (jch, xjname)
{int i, inf_no, option, j_handler();
/* get inferior number */
i = ruset (jch, UINF) >> 18;
inf_no = 0;
if (i) while (!(i&1)) {i=>>1; ++inf_no;}
/* set up interrupt handler */
on (inferior0_interrupt+inf_no, j_handler);
option = ruset (jch, UOPTION);
wuset (jch, UOPTION, option | OPTBRK);
/* clean up */
job_channels[inf_no] = jch;
if (job_status[inf_no] == js_nojob)
{job_status[inf_no] = js_stopped;
job_jcl[inf_no] = 0;
job_valret[inf_no] = 0;
}
job_name[inf_no] = ruset (jch, UJNAME);
job_xname[inf_no] = xjname;
return (inf_no);
}
int j_start (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, 0);
job_status[j] = js_running;
return (0);
}
int j_stop (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, -1);
job_status[j] = js_stopped;
return (0);
}
int j_disown (j)
{int ch, ec;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
ec = sysdisown (ch);
if (ec) return (ec);
j_flush (j);
return (0);
}
int j_forget (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
close (ch);
j_flush (j);
return (0);
}
int j_kill (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
uclose (ch);
j_flush (j);
return (0);
}
static int code[] {
0042000000013, /* .IOPUSH 0, ;(26) DON'T CLOBBER HIM */
0041000000034, /* .OPEN 0,34 ;(27) OPEN <JOB> */
0043100000000, /* .LOSE ;(30) FAIL, CAUSE ERR MSG */
0042000000027, /* .DISOWN 0, ;(31) DISOWN <JOB> */
0042000000014, /* .IOPOP 0, ;(32) UNCLOBBER HIM */
0043200000000, /* .VALUE ;(33) RETURN SUCCESS */
0000001656362, /* 1,,'USR ;(34) FILENAME BLOCK */
0, /* ;(35) WILL GET UNAME */
0 /* ;(36) WILL GET JNAME */
};
int j_snarf (j, jname)
{int ch, piclr, pirqc, pc, osts, sts;
if (j<0 || j>=MAXJOBS) return (-1);
osts = job_status[j];
if (osts == js_running) return (-1); /* must be stopped */
ch = job_channels[j];
if (ch<0) return (-1);
code[7] = rsuset (UUNAME);
code[8] = jname;
access (ch, 026);
syswrite (ch, code, 9);
piclr = ruset (ch, UPICLR);
wuset (ch, UPICLR, 0);
pirqc = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, pirqc);
pc = ruset (ch, UPC);
wuset (ch, UPC, 026);
j_start (j);
sts = j_wait (j);
job_status[j] = osts;
if (sts == js_valret) sts = 0;
else {wuset (ch, UAPIRQ, sts); sts = -1;}
wuset (ch, UPC, pc);
wuset (ch, UIPIRQ, pirqc);
wuset (ch, UPICLR, piclr);
return (sts);
}
int j_flush (j)
{char *p;
job_channels[j] = -1;
job_status[j] = js_nojob;
job_name[j] = 0;
if (p = job_jcl[j])
{sfree (p);
job_jcl[j] = 0;
}
if (p = job_valret[j])
{sfree (p);
job_valret[j] = 0;
}
on (inferior0_interrupt+j, 0);
}
int j_give_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = atty (ch);
if (rc == 0) jobtty = j;
return (rc);
}
int j_take_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = dtty (ch);
if (rc == 0) jobtty = -1;
return (rc);
}
int j_grab_tty ()
{if (jobtty >= 0)
{int rc;
jobotty = jobtty;
jobosts = job_status[jobtty];
j_stop (jobtty);
rc = j_take_tty (jobtty);
if (rc && jobosts==0) j_start (jobtty);
return (rc);
}
jobotty = -1;
return (0);
}
int j_retn_tty ()
{if (jobtty < 0 && jobotty >= 0)
{j_give_tty (jobotty);
if (jobosts == 0) j_start (jobotty);
jobotty = -1;
}
}
int j_wait (j)
{int sts;
if (j<0 || j>=MAXJOBS) return (-1);
job_wait = j;
sts = wfnz (&job_status[j]);
job_wait = -1;
return (sts);
}
int j_onchange (f) int (*f)();
{jchandler = f;
}
int j_sts (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_status[j]);
}
int j_sjcl (j, s) char *s;
{char *buf, *p;
int ch, i;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
if (*s==0)
{if (buf = job_jcl[j]) /* flush previous */
{i = ruset (ch, UOPTION) & ~OPTCMD;
wuset (ch, UOPTION, i);
sfree (buf);
job_jcl[j] = 0;
}
return (0);
}
i = salloc (slen (s) + 2);
if (i <= 0) return (-1);
buf = i;
stcpy (s, buf);
p = buf;
while (*p) ++p;
if (p==buf || p[-1]!='\r')
{p[0] = '\r';
p[1] = 0;
}
job_jcl[j] = buf;
wuset (ch, UOPTION, OPTCMD);
}
char *j_jcl (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_jcl[j]);
}
int j_ch (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_channels[j]);
}
int j_name (j, f) filespec *f;
{f->dev = _USR;
f->dir = 0;
f->fn1 = runame();
if (j>=0 && j<MAXJOBS)
{f->fn2 = job_name[j];
return (f->fn2 == 0);
}
f->fn2 = 0;
return (-1);
}
char *j_val (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_valret[j]);
}
j_fval (j)
{if (j<0 || j>=MAXJOBS) return;
if (job_valret[j] == 0) return;
cfree (job_valret[j]);
job_valret[j] = 0;
}
j_handler (j)
{int ch, w, opt, old_status;
if (j<0 || j>=MAXJOBS) return;
ch = job_channels[j];
if (ch<0) return;
old_status = job_status[j];
w = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
opt = ruset (ch, UOPTION);
if ((opt & OPTOPC)==0 && (w & IBACKUP))
wuset (ch, UPC, ruset (ch, UPC) - 1);
job_status[j] = w;
if (w & PICZ) /* ^Z typed */
{job_status[j] = js_attn;
return;
}
if (w & PIVAL) /* .VALUE */
jdovalue (j);
else if (w & PIBRK) /* .BREAK */
jdobrk (j);
if (j != job_wait && job_status[j] != old_status && jchandler)
(*jchandler)(j,job_status[j]);
}
jdovalue (j) /* handle .VALUE */
{int ch, ich, cmda, n;
char *p, buf[VALBUFSIZ];
filespec f;
ch = job_channels[j];
job_valret[j] = 0;
job_status[j] = js_valret;
cmda = ruset (ch, USV40) & 0777777;
if (cmda == 0) return;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
access (ich, cmda);
n = VALBUFSIZ;
p = buf;
while (TRUE)
{int w, i, c;
w = uiiot (ich);
for (i=0;i<5;++i)
{c = (w>>29) & 0177;
w =<< 7;
if (c!='\n') {*p++ = c; --n;}
if (c=='\r') {*p++ = '\n'; --n;}
if (!c) break;
if (n<=2)
{*p++ = c = 0;
break;
}
}
if (!c) break;
}
close (ich);
if (stcmp (buf, ":KILL\r") || stcmp (buf, ":KILL\r\n"))
{/* if (job_wait != j) j_kill (j);
else */ job_status[j] = js_suicide;
return;
}
p = calloc (slen (buf) + 1);
stcpy (buf, p);
job_valret[j] = p;
return;
}
jdobrk (j) /* handle .BREAK */
/* unless there is a 'fatal error', the job status
must be changed to something reasonable */
{int ch, i;
ch = job_channels[j];
wuset (ch, UAPIRQ, PIBRK); /* reset PIRQ bit */
i = ruset (ch, USV40); /* the instruction */
if ((i & ~000740000000) == 042000000033)
i = 045700160000; /* .LOGOUT n, */
switch (i>>18) { /* opcode */
case 045700: /* .BREAK 16 */
/* if ((i & 020000) && (job_wait != j)) j_kill (j);
else */ job_status[j] = js_suicide;
return;
case 045500: /* .BREAK 12 */
jdob12 (j, i);
return;
}
j_start (j);
}
jdob12 (j, i) /* handle .BREAK 12 */
{int cmda, ich, och;
filespec f;
cmda = i & 0777777;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
if ((och = open (&f, UIO)) < 0)
{close (ich);
return;
}
access (ich, cmda);
i = uiiot (ich);
if (i & 0200000000000) /* multiple commands */
{int n, a;
n = (i>>18) | 0777777000000;
a = i & 0777777;
while (n<0)
{access (och, cmda);
++n;
++a;
uoiot (och, (n<<18) | a);
access (ich, a-1);
do_brk (j, ich, och, uiiot (ich));
}
}
else do_brk (j, ich, och, i);
close (ich);
close (och);
j_start (j);
}
do_brk (j, ich, och, w) /* do .BREAK 12 command W */
{int cmd, a, f, i;
cmd = (w>>18) & 0177777;
a = w & 0777777;
access (och, a);
if (cmd==6) /* send :PRINT defaults */
{uoiot (och, _DSK);
uoiot (och, rsname ());
uoiot (och, _FOO);
uoiot (och, _GR);
return;
}
if (cmd==5 && job_jcl[j])
{f = copen (job_jcl[j], 'r', "s");
access (ich, a+2);
while (TRUE)
{w = 0;
for (i=0;i<5;++i) w = (w<<7) | (cgetc (f) & 0177);
w =<< 1;
uoiot (och, w);
if ((w & 0377) == 0) break;
if (uiiot (ich))
{uoiot (och, 0);
break;
}
}
cclose (f);
return;
}
if (cmd==10) /* send XJNAME */
{uoiot (och, job_xname[j]);
return;
}
}


713
arc/ar2:clib/C10JOB OLD Normal file
View File

@@ -0,0 +1,713 @@
# include "clib/c.defs"
# include "clib/its.bits"
/**********************************************************************
JOBs - Inferior Process Management
ITS Version
**********************************************************************/
/*
The representation of a job is an integer with a value from
0 to 7, indicating the inferior number.
Routines:
j_create (jname) => # or error code
j_load (filespec) => # or error code
j_fload (file_name) => # or error code
j_cload (channel, jname) => # or error code
j_own (uname, jname) => # or error code
error code:
-1 unable to open program file
-2 unable to create job
-3 unable to load job
-4 fatal error
-5 (OWN) no such job
-6 (OWN) job not yours
j_start (#) => rc (return code: non-zero => error)
j_stop (#) => rc
j_disown (#) => rc
j_forget (#) => rc
j_kill (#) => rc
j_snarf (#, inferior_name) => rc
(disown named inferior from stopped job)
j_give_tty (#) => rc
j_take_tty (#) => rc
j_grab_tty () (grab tty if given to some inferior
and stop job)
j_retn_tty () (return tty to inferior and restart)
j_wait (#) => status (waits for non-zero status)
j_sts (#) => status
j_onchange (f) (set handler for status changes)
j_sjcl (#, s) => rc (set jcl for job)
j_jcl (#) => s (get jcl)
j_ch (#) => ch (return block image output channel to job)
j_name (#, filespec) (set filespec to job name)
j_val (#) => s (return string valretted by job)
j_fval (#) (flush valret string; or call cfree)
Job Status:
-5 => stopped, ^Z typed
-4 => stopped (by superior)
-3 => stopped, valret
-2 => stopped, requested suicide
-1 => no job
0 => running
>0 => stopped, value is job's first interrupt word
*/
# define MAXJOBS 8
# define VALBUFSIZ 200
/* job status values */
# define js_attn -5
# define js_stopped -4
# define js_valret -3
# define js_suicide -2
# define js_nojob -1
# define js_running 0
/* useful SIXBIT numbers */
# define _USR 0656362000000
# define _TS 0646300000000
# define _DSK 0446353000000
# define _FOO 0465757000000
# define _GR 0360000000000 /* > */
/* internal tables */
# rename job_channels "JOBCHN"
# rename job_status "JOBSTS"
# rename job_jcl "JOBJCL"
# rename job_valret "JOBVAL"
# rename job_name "JOBNAM"
# rename job_xname "JOBXNM"
# rename job_wait "JOBWAT"
int job_status[MAXJOBS] {js_nojob, js_nojob, js_nojob, js_nojob,
js_nojob, js_nojob, js_nojob, js_nojob};
int job_channels[MAXJOBS] {-1, -1, -1, -1, -1, -1, -1, -1};
char *job_jcl[MAXJOBS];
char *job_valret[MAXJOBS];
int job_name[MAXJOBS];
int job_xname[MAXJOBS];
int job_wait -1;
static int jobtty {-1}, jobotty, jobosts, (*jchandler)();
/* the routines */
int j_fload (file_name) char *file_name;
{filespec f;
fparse (file_name, &f);
return (j_load (&f));
}
int j_load (f) filespec *f;
{int pch, xjname;
if (f->dev == 0) f->dev = _DSK;
if (f->dir == 0) f->dir = rsname ();
pch = mopen (f, BII);
if (pch<0) return (-1);
xjname = (f->fn1 == _TS ? f->fn2 : f->fn1);
return (j_cload (pch, xjname));
}
int j_cload (pch, xjname)
channel pch;
{int j, jch, start;
j = j_create (xjname);
if (j<0)
{close (pch);
return (j);
}
jch = job_channels[j];
/* load program */
if (sysload (jch, pch))
{uclose (jch);
close (pch);
return (-3);
}
/* get starting address of program */
sysread (pch, &start, 1);
close (pch);
/* set starting address of job */
wuset (jch, UPC, start & 0777777);
return (j);
}
int j_create (xjname)
{int jch, i, inc, count, flag;
filespec jf;
/* set up job name */
jf.dev = _USR;
jf.dir = 0;
jf.fn1 = 0;
jf.fn2 = xjname;
/* make job name unique */
flag = FALSE;
while ((jch = open (&jf, OLD + BII)) >= 0)
{close (jch);
if (!flag)
{flag = TRUE;
i = jf.fn2;
count = 0;
while ((i&077)==0) {i =>> 6; ++count;}
if (count>0)
{count = 6*(count-1);
jf.fn2 =| ccto6('0') << count;
inc = 1 << count;
}
else
{jf.fn2 = (jf.fn2 & ~077) | ccto6('0');
inc = 1;
}
}
else jf.fn2 =+ inc;
}
/* create job */
jch = open (&jf, BIO);
if (jch<0) return (-2);
reset (jch);
/* set job's NAMEs */
wuset (jch, USNAME, rsname());
wuset (jch, UXJNAME, xjname);
return (j_xxx (jch, xjname));
}
/**********************************************************************
J_OWN - attach job as inferior
**********************************************************************/
int j_own (uname, jname)
{filespec fs;
int jch, j, w, sts;
fs.dev = _USR;
fs.dir = 0;
fs.fn1 = uname;
fs.fn2 = jname;
if ((jch = open (&fs, OLD + BII)) < 0) return (-5);
close (jch);
if ((jch = open (&fs, BIO)) < 0) return (-5);
if (status (jch) != 061)
{close (jch); return (-6);}
j = j_xxx (jch, jname);
if (ruset (jch, USTOP) & BUSRC)
{w = ruset (jch, UPIRQ);
if (w & PICZ) sts = js_attn;
else if (w & PIVAL) sts = js_valret;
else if (w) sts = w;
else sts = js_stopped;
wuset (jch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
}
else sts = js_running;
job_status[j] = sts;
return (j);
}
/**********************************************************************
J_XXX - common processing for new inferior
**********************************************************************/
int j_xxx (jch, xjname)
{int i, inf_no, option, j_handler();
/* get inferior number */
i = ruset (jch, UINF) >> 18;
inf_no = 0;
if (i) while (!(i&1)) {i=>>1; ++inf_no;}
/* set up interrupt handler */
on (inferior0_interrupt+inf_no, j_handler);
option = ruset (jch, UOPTION);
wuset (jch, UOPTION, option | OPTBRK);
/* clean up */
job_channels[inf_no] = jch;
if (job_status[inf_no] == js_nojob)
{job_status[inf_no] = js_stopped;
job_jcl[inf_no] = 0;
job_valret[inf_no] = 0;
}
job_name[inf_no] = ruset (jch, UJNAME);
job_xname[inf_no] = xjname;
return (inf_no);
}
int j_start (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, 0);
job_status[j] = js_running;
return (0);
}
int j_stop (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
wuset (ch, USTOP, -1);
job_status[j] = js_stopped;
return (0);
}
int j_disown (j)
{int ch, ec;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
ec = sysdisown (ch);
if (ec) return (ec);
j_flush (j);
return (0);
}
int j_forget (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch < 0) return (-1);
close (ch);
j_flush (j);
return (0);
}
int j_kill (j)
{int ch;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
uclose (ch);
j_flush (j);
return (0);
}
static int code[] {
0042000000013, /* .IOPUSH 0, ;(26) DON'T CLOBBER HIM */
0041000000034, /* .OPEN 0,34 ;(27) OPEN <JOB> */
0043100000000, /* .LOSE ;(30) FAIL, CAUSE ERR MSG */
0042000000027, /* .DISOWN 0, ;(31) DISOWN <JOB> */
0042000000014, /* .IOPOP 0, ;(32) UNCLOBBER HIM */
0043200000000, /* .VALUE ;(33) RETURN SUCCESS */
0000001656362, /* 1,,'USR ;(34) FILENAME BLOCK */
0, /* ;(35) WILL GET UNAME */
0 /* ;(36) WILL GET JNAME */
};
int j_snarf (j, jname)
{int ch, piclr, pirqc, pc, osts, sts;
if (j<0 || j>=MAXJOBS) return (-1);
osts = job_status[j];
if (osts == js_running) return (-1); /* must be stopped */
ch = job_channels[j];
if (ch<0) return (-1);
code[7] = rsuset (UUNAME);
code[8] = jname;
access (ch, 026);
syswrite (ch, code, 9);
piclr = ruset (ch, UPICLR);
wuset (ch, UPICLR, 0);
pirqc = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, pirqc);
pc = ruset (ch, UPC);
wuset (ch, UPC, 026);
j_start (j);
sts = j_wait (j);
job_status[j] = osts;
if (sts == js_valret) sts = 0;
else {wuset (ch, UAPIRQ, sts); sts = -1;}
wuset (ch, UPC, pc);
wuset (ch, UIPIRQ, pirqc);
wuset (ch, UPICLR, piclr);
return (sts);
}
int j_flush (j)
{char *p;
job_channels[j] = -1;
job_status[j] = js_nojob;
job_name[j] = 0;
if (p = job_jcl[j])
{sfree (p);
job_jcl[j] = 0;
}
if (p = job_valret[j])
{sfree (p);
job_valret[j] = 0;
}
on (inferior0_interrupt+j, 0);
}
int j_give_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = atty (ch);
if (rc == 0) jobtty = j;
return (rc);
}
int j_take_tty (j)
{int ch, rc;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
rc = dtty (ch);
if (rc == 0) jobtty = -1;
return (rc);
}
int j_grab_tty ()
{if (jobtty >= 0)
{int rc;
jobotty = jobtty;
jobosts = job_status[jobtty];
j_stop (jobtty);
rc = j_take_tty (jobtty);
if (rc && jobosts==0) j_start (jobtty);
return (rc);
}
jobotty = -1;
return (0);
}
int j_retn_tty ()
{if (jobtty < 0 && jobotty >= 0)
{j_give_tty (jobotty);
if (jobosts == 0) j_start (jobotty);
jobotty = -1;
}
}
int j_wait (j)
{int sts;
if (j<0 || j>=MAXJOBS) return (-1);
job_wait = j;
sts = wfnz (&job_status[j]);
job_wait = -1;
return (sts);
}
int j_onchange (f) int (*f)();
{jchandler = f;
}
int j_sts (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_status[j]);
}
int j_sjcl (j, s) char *s;
{char *buf, *p;
int ch, i;
if (j<0 || j>=MAXJOBS) return (-1);
ch = job_channels[j];
if (ch<0) return (-1);
if (*s==0)
{if (buf = job_jcl[j]) /* flush previous */
{i = ruset (ch, UOPTION) & ~OPTCMD;
wuset (ch, UOPTION, i);
sfree (buf);
job_jcl[j] = 0;
}
return (0);
}
i = salloc (slen (s) + 2);
if (i <= 0) return (-1);
buf = i;
stcpy (s, buf);
p = buf;
while (*p) ++p;
if (p==buf || p[-1]!='\r')
{p[0] = '\r';
p[1] = 0;
}
job_jcl[j] = buf;
wuset (ch, UOPTION, OPTCMD);
}
char *j_jcl (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_jcl[j]);
}
int j_ch (j)
{if (j<0 || j>=MAXJOBS) return (-1);
return (job_channels[j]);
}
int j_name (j, f) filespec *f;
{f->dev = _USR;
f->dir = 0;
f->fn1 = runame();
if (j>=0 && j<MAXJOBS)
{f->fn2 = job_name[j];
return (f->fn2 == 0);
}
f->fn2 = 0;
return (-1);
}
char *j_val (j)
{if (j<0 || j>=MAXJOBS) return (0);
return (job_valret[j]);
}
j_fval (j)
{if (j<0 || j>=MAXJOBS) return;
if (job_valret[j] == 0) return;
cfree (job_valret[j]);
job_valret[j] = 0;
}
j_handler (j)
{int ch, w, opt, old_status;
if (j<0 || j>=MAXJOBS) return;
ch = job_channels[j];
if (ch<0) return;
old_status = job_status[j];
w = ruset (ch, UPIRQ);
wuset (ch, UAPIRQ, PJTTY+PIIOC+PIARO+PICZ+PIVAL);
opt = ruset (ch, UOPTION);
if ((opt & OPTOPC)==0 && (w & IBACKUP))
wuset (ch, UPC, ruset (ch, UPC) - 1);
job_status[j] = w;
if (w & PICZ) /* ^Z typed */
{job_status[j] = js_attn;
return;
}
if (w & PIVAL) /* .VALUE */
jdovalue (j);
else if (w & PIBRK) /* .BREAK */
jdobrk (j);
if (j != job_wait && job_status[j] != old_status && jchandler)
(*jchandler)(j,job_status[j]);
}
jdovalue (j) /* handle .VALUE */
{int ch, ich, cmda, n;
char *p, buf[VALBUFSIZ];
filespec f;
ch = job_channels[j];
job_valret[j] = 0;
job_status[j] = js_valret;
cmda = ruset (ch, USV40) & 0777777;
if (cmda == 0) return;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
access (ich, cmda);
n = VALBUFSIZ;
p = buf;
while (TRUE)
{int w, i, c;
w = uiiot (ich);
for (i=0;i<5;++i)
{c = (w>>29) & 0177;
w =<< 7;
if (c!='\n') {*p++ = c; --n;}
if (c=='\r') {*p++ = '\n'; --n;}
if (!c) break;
if (n<=2)
{*p++ = c = 0;
break;
}
}
if (!c) break;
}
close (ich);
if (stcmp (buf, ":KILL\r") || stcmp (buf, ":KILL\r\n"))
{/* if (job_wait != j) j_kill (j);
else */ job_status[j] = js_suicide;
return;
}
p = calloc (slen (buf) + 1);
stcpy (buf, p);
job_valret[j] = p;
return;
}
jdobrk (j) /* handle .BREAK */
/* unless there is a 'fatal error', the job status
must be changed to something reasonable */
{int ch, i;
ch = job_channels[j];
wuset (ch, UAPIRQ, PIBRK); /* reset PIRQ bit */
i = ruset (ch, USV40); /* the instruction */
if ((i & ~000740000000) == 042000000033)
i = 045700160000; /* .LOGOUT n, */
switch (i>>18) { /* opcode */
case 045700: /* .BREAK 16 */
/* if ((i & 020000) && (job_wait != j)) j_kill (j);
else */ job_status[j] = js_suicide;
return;
case 045500: /* .BREAK 12 */
jdob12 (j, i);
return;
}
j_start (j);
}
jdob12 (j, i) /* handle .BREAK 12 */
{int cmda, ich, och;
filespec f;
cmda = i & 0777777;
if (j_name (j, &f)) return;
if ((ich = open (&f, UII)) < 0) return;
if ((och = open (&f, UIO)) < 0)
{close (ich);
return;
}
access (ich, cmda);
i = uiiot (ich);
if (i & 0200000000000) /* multiple commands */
{int n, a;
n = (i>>18) | 0777777000000;
a = i & 0777777;
while (n<0)
{access (och, cmda);
++n;
++a;
uoiot (och, (n<<18) | a);
access (ich, a-1);
do_brk (j, ich, och, uiiot (ich));
}
}
else do_brk (j, ich, och, i);
close (ich);
close (och);
j_start (j);
}
do_brk (j, ich, och, w) /* do .BREAK 12 command W */
{int cmd, a, f, i;
cmd = (w>>18) & 0177777;
a = w & 0777777;
access (och, a);
if (cmd==6) /* send :PRINT defaults */
{uoiot (och, _DSK);
uoiot (och, rsname ());
uoiot (och, _FOO);
uoiot (och, _GR);
return;
}
if (cmd==5 && job_jcl[j])
{f = copen (job_jcl[j], 'r', "s");
access (ich, a+2);
while (TRUE)
{w = 0;
for (i=0;i<5;++i) w = (w<<7) | (cgetc (f) & 0177);
w =<< 1;
uoiot (och, w);
if ((w & 0377) == 0) break;
if (uiiot (ich))
{uoiot (och, 0);
break;
}
}
cclose (f);
return;
}
if (cmd==10) /* send XJNAME */
{uoiot (och, job_xname[j]);
return;
}
}


58
arc/ar2:clib/C10MAP C Normal file
View File

@@ -0,0 +1,58 @@
/*
FILMAP - file mapping routines
filmap (c, o, s) map in part of a file
filunmap (p, s) unmap part of a file
*/
# include "c.defs"
/**********************************************************************
FILMAP - map in a part of a disk file
return a pointer to it
**********************************************************************/
int *filmap (ch, offset, size)
{int block_no, page_no, word_no, no_pages, i;
int *p;
block_no = offset>>10;
word_no = offset & 01777;
no_pages = ((word_no + size - 1) >> 10) + 1;
page_no = pg_get (no_pages);
if (page_no < 0)
{puts ("FILMAP: Unable to Allocate Pages.\n");
return (0);
}
for (i=0;i<no_pages;++i)
if (corblk (0600000, -1, page_no+i, ch, block_no+i))
{cprint ("FILMAP: Error In Mapping Page %d.\n", block_no+i);
break;
}
p = (page_no<<10)+word_no;
return (p);
}
/**********************************************************************
FILUNMAP - Unmap pages mapped by FILMAP
**********************************************************************/
filunmap (p, size) int *p;
{int page_no, word_no, no_pages, p_rep;
p_rep = p;
word_no = p_rep & 01777;
page_no = p_rep >> 10;
no_pages = ((word_no + size - 1) >> 10) + 1;
pg_ret (page_no, no_pages);
}


490
arc/ar2:clib/C10MIO CMID Normal file
View File

@@ -0,0 +1,490 @@
;
; C10MIO - C I/O ROUTINES WRITTEN IN MIDAS
;
; This file is ITS dependent.
;
TITLE MIO
.INSRT NC
.INSRT NM
; INCLUDES:
;
; CGETC - CIO GET CHARACTER
; CPUTC - CIO PUT CHARACTER
; CGETI - CIO GET INTEGER (IMAGE)
; CPUTI - CIO PUT INTEGER (IMAGE)
; CEOF - CIO TEST FOR END-OF-FILE
; CFLUSH - CIO FLUSH BUFFER
; REW - REWIND INPUT FILE
; CLOSALL - CIO CLOSE ALL FILES
; CCLOSE - CIO CLOSE FILE
; ISTTY - IS FILE A TTY?
; CISFD - IS PTR AN ACTUAL FILE DESCRIPTOR?
; ITSCHAN - RETURN ACTUAL ITS CHANNEL
;
; REGISTERS
FP==3 ; FILE CONTROL BLOCK POINTER
T1==4 ; TEMPORARY
; VALUES
NL==12
CR==15
; FILE CONTROL BLOCK ENTRIES
FBUFFP==0 ; (LEFT HALF) POINTER TO BUFFER (OR ZERO IF NOT BUFFERED)
FCHAN: 160400,,(FP) ; ITS CHANNEL NUMBER
FDEVIC: 100600,,(FP) ; DEVICE CODE
FFLAG==0 ; (RIGHTMOST 8 BITS) FLAGS
PHYEOF==1 ; PHYSICAL EOF REACHED (BUFFERED INPUT)
%OPEN==2 ; FILE IS OPEN
%WRITE==4 ; FILE IS OPEN FOR WRITE
%TTY==10 ; FILE IS TTY
%UNSET==20 ; DEVICE AND CHANNEL NOT SET YET
FBPTR==1 ; POINTER TO NEXT CHAR/WORD OR CHAR/WORD POSITION
FBCNT==2 ; NUMBER OF CHARS/WORDS OR AVAILABLE POSITIONS IN BUFFER
FUCNT==3 ; (LEFT HALF) NUMBER OF CHARS IN UNGETC BUFFER
FUPTR==3 ; (RIGHT HALF) POINTER TO UNGETC BUFFER
FCLSR==4 ; (LEFT HALF) ADDRESS OF CLOSE ROUTINE
FNGETR==4 ; (RIGHT HALF) ADDRESS OF NORMAL GETC ROUTINE
FGETCR==5 ; ADDRESS OF CGETC ROUTINE
FPUTCR==6 ; ADDRESS OF CPUTC ROUTINE
FCBSIZ==7 ; SIZE OF FILE CONTROL BLOCK
; CONSTANTS
IBFSIZ==200
NCHAN==10.
UBFFSZ==20.
CENTRY CGETC,[FD]
XENTRY GETC,CGETC
XENTRY CGETI,CGETC
XENTRY GETI,CGETC
HRRZ FP,FD ; FILE DESCRIPTOR
GO @FGETCR(FP) ; JUMP TO APPROPRIATE ROUTINE
GETBUF: SOSGE FBCNT(FP) ; HERE FOR BUFFERED CHAR INPUT
JSP B,GTBUF1 ; BUFFER EMPTY, GO FILL IT
ILDB A,FBPTR(FP) ; GET NEXT CHAR FROM BUFFER
CAIN A,CR ; IGNORE INCOMING CR
GO GETBUF
RETURN
GETBIN: SOSGE FBCNT(FP) ; HERE FOR BINARY INPUT
GO GTBIN1 ; BUFFER EMPTY, REFILL IT
MOVE A,@FBPTR(FP) ; GET NEXT WORD FROM BUFFER
AOS FBPTR(FP) ; INCR POINTER
RETURN
GETSTR: MOVE A,@FBPTR(FP) ; HERE FOR STRING INPUT
AOS FBPTR(FP) ; INCR POINTER
JUMPE A,NEWEOF
RETURN
GETTTY: CALL TYI ; HERE FOR TTY INPUT
HRRZ FP,FD ; RESTORE FP
JUMPE A,NEWEOF
RETURN
IENTRY GC$BAD
CROAK BAD CALL TO CGETC/CGETI
SETO A,
RETURN
GETUN: HLRZ B,FUCNT(FP) ; HERE WHEN CHAR IN UNGETC BUFFER
JUMPLE B,CODE [ ; IS UNGETC BUFFER EMPTY?
HRRZ A,FNGETR(FP) ; YES
MOVEM A,FGETCR(FP) ; RESTORE CGETC ROUTINE
GO (A) ; GET NEXT CHAR
]
HRRZ A,FUPTR(FP)
ADD A,B
HRRZ A,(A) ; GET CHAR
SUBI B,1 ; DECR COUNT
HRLM B,FUCNT(FP)
RETURN
NEWEOF: MOVEI A,EOF ; HERE ON NEWLY DISCOVERED EOF
MOVEM A,FGETCR(FP)
HRRM A,FNGETR(FP) ; SET CGETC ROUTINE TO EOF
EOF: SETZ A,
RETURN
; BUFFERED CHARACTER INPUT - BUFFER READ ROUTINE
;
; CONTAINS HACKERY WHICH ALLOWS DETECTION OF LAST WORD
; OF FILE. TRAILING CONTROL-C'S ARE REMOVED FROM THIS
; WORD. CALLED VIA JSP B,
;
GTBUF1: HRRZ T1,FFLAG(FP) ; HERE TO FILL OR REFILL BUFFER
TRNE T1,PHYEOF ; HAS END OF FILE BEEN REACHED?
GO NEWEOF ; YES, ANNOUNCE IT
MOVN A,FBCNT(FP) ; OLD CHARACTER COUNT (CHECKED LATER)
MOVEI T1,5*<IBFSIZ-1> ; RESET CHARACTER COUNT
MOVEM T1,FBCNT(FP) ; (LAST WORD SAVED FOR NEXT BUFFER)
HLRZ T1,FBUFFP(FP) ; RESET CHARACTER POINTER
HRLI T1,440700 ; TO BEGINNING OF BUFFER
MOVEM T1,FBPTR(FP)
CAIE A,2 ; CHECK OLD COUNT FOR SPECIAL VALUE
GO GTBUF2 ; NORMAL (NOT INIT) CASE
HLRZ T1,FBUFFP(FP) ; FIRST TIME - FILL ENTIRE BUFFER
HRLI T1,-IBFSIZ
GO GTBUF3
GTBUF2: HLRZ T1,FBUFFP(FP) ; NORMAL CASE - ONE WORD SAVED FROM LAST READ
MOVE A,IBFSIZ-1(T1) ; GET LAST WORD OF BUFFER (UNREAD)
MOVEM A,(T1) ; MAKE FIRST WORD OF BUFFER
ADDI T1,1 ; ADJUST CPTR TO FILL REST OF BUFFER
HRLI T1,-IBFSIZ+1
GTBUF3: LDB A,FCHAN ; ITS CHANNEL NUMBER
LSH A,23.
IOR A,[.IOT T1]
XCT A ; EXECUTE .IOT
JUMPGE T1,-2(B) ; BUFFER WAS FILLED, NO MORE TO DO
HLRES T1
ADDI T1,IBFSIZ ; NUMBER OF WORDS READ
HLRZ A,FBUFFP(FP)
ADDI A,-1(T1) ; POINTER TO WORD LAST READ
IMULI T1,5 ; NUMBER OF CHARS READ
PPUSH B
MOVEI B,5 ; CHECK FOR AT MOST 5 TRAILING ^C'S
HRLI A,010700 ; BYTE POINTER TO LAST CHAR
GTBUF4: LDB 0,A ; GRAB CHARACTER
ADD A,[070000,,0] ; DECREMENT BYTE POINTER
CAIE 0,3 ; IS IT A ^C
GO GTBUF5 ; NO
SUBI T1,1 ; DECREMENT CHARACTER COUNT
SOJG B,GTBUF4 ; KEEP LOOKING
GTBUF5: PPOP B
MOVEM T1,FBCNT(FP) ; SET CHARACTER COUNT
MOVEI T1,PHYEOF
IORM T1,FFLAG(FP) ; SET PHYSICAL EOF FLAG
GO -2(B) ; THAT'S IT!
;
; GTBIN1 - INTERNAL CODE FOR BINARY BUFFER GET
;
GTBIN1: HRRZ T1,FFLAG(FP) ; HERE TO REFILL BUFFER IN BINARY MODE
TRNE T1,PHYEOF ; HAS END OF FILE BEEN REACHED?
GO NEWEOF ; YES, ANNOUNCE IT
MOVEI T1,IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP) ; BUFFER POINTER
MOVEM T1,FBPTR(FP) ; RESET POINTER
HRLI T1,-IBFSIZ ; COUNTING POINTER FOR IOT
LDB A,FCHAN
LSH A,23.
IOR A,[.IOT T1] ; SET UP .IOT INSTRUCTION
XCT A ; EXECUTE .IOT INSTRUCTION
JUMPGE T1,GETBIN ; BUFFER WAS FILLED, RESUME
HLRES T1
ADDI T1,IBFSIZ ; NUMBER OF WORDS ACTUALLY READ
MOVEM T1,FBCNT(FP) ; SET COUNTER
MOVEI T1,PHYEOF
IORM T1,FFLAG(FP) ; SET PHYSICAL EOF FLAG
GO GETBIN ; RESUME
CENTRY CPUTC,[CC,FD]
XENTRY PUTC,CPUTC
XENTRY CPUTI,CPUTC
XENTRY PUTI,CPUTC
HRRZ FP,FD ; FILE DESCRIPTOR
MOVE A,CC ; CHARACTER (OR INTEGER) TO BE WRITTEN
GO @FPUTCR(FP) ; JUMP TO APPROPRIATE ROUTINE
PUTBUF: CAIN A,NL ; HERE FOR BUFFERED CHAR OUTPUT
GO CODE [
CALL CPUTC,[[[CR]],FP]
HRRZ FP,FD
MOVEI A,NL
GO PF$1
]
JUMPE A,PC$RET ; DONT WRITE NULLS
PF$1: IDPB A,FBPTR(FP) ; STORE CHAR
SOSG FBCNT(FP) ; BUFFER FULL?
GO CODE [ ; YES
MCALL FLUSHB,[FP,[[IBFSIZ]]] ; FLUSH ENTIRE BUFFER
GO PC$RET
]
PC$RET: RETURN ; NO, RETURN
PUTBIN: MOVEM A,@FBPTR(FP) ; HERE ON BINARY OUTPUT
AOS FBPTR(FP)
SOSLE FBCNT(FP)
GO PC$RET
HLRZ T1,FBUFFP(FP)
HRLI T1,-IBFSIZ ; SET UP COUNTING POINTER FOR .IOT
LDB A,FCHAN ; GET ITS CHANNEL NUMBER
LSH A,23.
IOR A,[.IOT T1] ; PREPARE .IOT INSTRUCTION
XCT A ; EXECUTE .IOT INSTRUCTION
MOVEI T1,IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP)
MOVEM T1,FBPTR(FP) ; RESET POINTER
GO PC$RET
PUTSTR: MOVEM A,@FBPTR(FP) ; HERE ON STRING OUTPUT
AOS FBPTR(FP)
GO PC$RET
PUTTTY: CAIN A,NL ; HERE ON TTY OUTPUT
MOVEI A,CR ; OUTPUT NEWLINES AS CR'S
CALL TYO,[A]
GO PC$RET
IENTRY PC$BAD
CROAK BAD CALL TO CPUTC/CPUTI
SETO A,
GO PC$RET
CENTRY CEOF,[FD]
HRRZ FP,FD
SETZ A,
HRRZ B,FGETCR(FP)
CAIN B,EOF
MOVEI A,1
CAIN B,GC$BAD
SETO A,
RETURN
CENTRY UNGETC,[CC,FD]
HRRZ FP,FD ; FILE DESCRIPTOR
MOVE A,CC ; CHARACTER
HLRZ T1,FUCNT(FP) ; NUMBER OF CHARS IN BUFFER
ADDI T1,1
CAIL T1,UBFFSZ ; TOO MANY?
GO CODE [
SETO A,
GO UN$RET
]
HRLM T1,FUCNT(FP)
HRRZ B,FUPTR(FP)
ADD T1,B
MOVEM A,(T1) ; STORE CHAR
MOVEI B,GETUN
MOVEM B,FGETCR(FP) ; SET UP GETC ROUTINE
UN$RET: RETURN
CENTRY CFLUSH,[FD]
MCALL FLUSHP,[FD,[[0]]]
RETURN
MENTRY FLUSHP,[FD,PADC]
HRRZ FP,FD
HRRZ A,FPUTCR(FP) ; OUTPUT ROUTINE
CAIE A,PUTBUF
GO FL$RET
HRRZ T1,PADC ; PAD CHARACTER
MOVEI A,5*IBFSIZ ; NUMBER OF CHAR POSITIONS
SUB A,FBCNT(FP) ; NUMBER OF ACTUAL CHARS IN BUFFER
JUMPLE A,FL$RET ; BUFFER IS EMPTY
IDIVI A,5
JUMPE B,FL$1 ; NO PARTIALLY FILLED WORDS
MOVN B,B
ADDI B,5
IDPB T1,FBPTR(FP) ; FILL OUT WITH ^C'S
SOJG B,.-1
ADDI A,1
FL$1: MCALL FLUSHB,[FP,A]
FL$RET: RETURN
MENTRY FLUSHB,[FD,SIZE]
MOVE FP,FD ; FILE POINTER
MOVN T1,SIZE ; SIZE OF FILLED PART OF BUFFER
HRLZ T1,T1 ; CONSTRUCT
HLR T1,FBUFFP(FP) ; .IOT POINTER
LDB B,FCHAN
LSH B,23.
IOR B,[.IOT T1] ; PREPARE .IOT INSTRUCTION
XCT B ; EXECUTE .IOT INSTRUCTION
MOVEI T1,5*IBFSIZ
MOVEM T1,FBCNT(FP) ; RESET COUNTER
HLRZ T1,FBUFFP(FP)
HRLI T1,440700
MOVEM T1,FBPTR(FP) ; RESET ABPTR
RETURN
CENTRY REW,[FD]
HRRZ FP,FD
SETOM FBCNT(FP)
HRRZ A,FFLAG(FP)
TRZ A,PHYEOF
HRRM A,FFLAG(FP)
MOVE A,GETTAB+1
MOVEM A,FGETCR(FP)
LDB A,FCHAN
.CALL [SETZ ? 'ACCESS ? A ? 401000,,0]
CROAK REW: ACCESS FAILED
RETURN
CENTRY CLOSALL,,[COUNTER] ; CLOSE ALL C FILES
MOVEI A,NCHAN-1
MOVEM A,COUNTER
MOVE A,COUNTER
CA$1: CALL CCLOSE,[FCBTBL(A)]
SOSL A,COUNTER
GO CA$1
RETURN
CENTRY CCLOSE,[FD]
HRRZ FP,FD
HLRZ A,FCLSR(FP)
GO (A) ; JUMP TO APPROPRIATE ROUTINE
CLOBUF: MCALL FLUSHP,[FP,[[3]]]
GO CLIBUF
CLOBIN: MOVE A,FBCNT(FP) ; HERE ON BINARY OUTPUT
SUBI A,IBFSIZ
JUMPGE A,CLIBUF
HRLZ A,A
HLR A,FBUFFP(FP)
LDB B,FCHAN
LSH B,23.
IOR B,[.IOT A]
XCT B ; FLUSH BUFFER
CLIBUF: LDB A,FCHAN ; HERE ON BUFFERED AND BINARY INPUT
; ALSO FALL THROUGH FROM BUFFERED AND BINARY OUTPUT
CALL MCLOSE,[A]
MOVE FP,FD
CLTTY: SETZ A, ; HERE ON TTY AND FALL THROUGH
CLOSE2: MOVEI T1,%OPEN ; HERE TO CLEAR %OPEN BIT
ANDCAM T1,FFLAG(FP)
MOVEI T1,GC$BAD ; SET ROUTINES TO BAD
MOVEM T1,FGETCR(FP)
MOVEI T1,PC$BAD
MOVEM T1,FPUTCR(FP)
MOVE T1,[CL$BAD,,GC$BAD]
MOVEM T1,FCLSR(FP)
CL$RET: RETURN
CLOSTR: MOVE A,FBPTR(FP) ; HERE ON STRING OUTPUT
SETZM (A) ; APPEND NULL ONTO STRING
GO CLOSE2 ; RETURN POINTER TO NULL CHAR
IENTRY CL$BAD
SETO A,
GO CL$RET
CENTRY ISTTY,[FD]
HRRZ FP,FD
HRRZ A,FFLAG(FP)
TRNE A,%UNSET ; IS DEVICE CODE VALID?
GO IS$RET ; NO -- MUST BE A TTY
LDB A,FDEVICE ; GET IT
CAILE A,2 ; TEST FOR TTY DEVICES
SETZ A,
IS$RET: RETURN
; INTERNAL ROUTINE TO SET DEVICE AND CHANNEL
; MUST BE THE TTY INPUT OR OUTPUT CHANNEL
; RETURN DEVICE CODE
MENTRY SETDEV,[FD]
HRRZ FP,FD
MOVE A,FFLAG(FP)
TRNE A,%WRITE
MOVEI B,ZTYOOPN"
TRNN A,%WRITE
MOVEI B,ZTYIOPN"
VCALL (B)
JUMPL A,SD$RET ; VALID CHANNEL RETURNED?
HRRZ FP,FD
DPB A,FCHAN ; YES - STORE IT
LSH A,23.
IOR A,[.STATUS A]
XCT A
ANDI A,77 ; GET DEVICE FROM CHANNEL STATUS
DPB A,FDEVIC ; STORE DEVICE
MOVEI T1,%UNSET ; CLEAR %UNSET BIT
ANDCAM T1,FFLAG(FP)
SD$RET: RETURN
CENTRY CISFD,[FD]
MOVE A,FD
CAIGE A,C0FCBS+1
GO ISF$NO
CAIL A,C0FCBS+1+NCHAN*FCBSIZ
GO ISF$NO
MOVEI A,1
RETURN
ISF$NO: SETZ A,
RETURN
CENTRY ITSCHAN,[FD]
HRRZ FP,FD
HRRZ A,FFLAG(FP)
TRNN A,%UNSET ; IS CHANNEL CODE VALID?
GO IC$1 ; YES - GET IT
MCALL SETDEV,[FD] ; NO -- SET IT AND RETURN IT
RETURN
IC$1: LDB A,FCHAN ; GET CHANNEL
RETURN
.PDATA
MDATA GETTAB
GETTTY
GETBUF
GETBIN
GETSTR
GC$BAD
GC$BAD
GC$BAD
GC$BAD
MDATA PUTTAB
PC$BAD
PC$BAD
PC$BAD
PC$BAD
PUTTTY
PUTBUF
PUTBIN
PUTSTR
MDATA CLOTAB
CLTTY
CLIBUF
CLIBUF
CLTTY
CLTTY
CLOBUF
CLOBIN
CLOSTR
; STATIC DATA AREAS
.UDATA
MDATA C0FCBS
BLOCK NCHAN*FCBSIZ+1
MDATA FCBTBL
REPEAT NCHAN C0FCBS+1+.RPCNT*FCBSIZ
END


111
arc/ar2:clib/C10PAG C Normal file
View File

@@ -0,0 +1,111 @@
/*
* C PAGE Handling Package
*
* routines:
*
* pg = pg_get (n)
* rc = pg_ret (pg, n)
* b = pg_exist (pg)
* i = pg_nshare (pg)
* i = pp_nshare (p)
*
*/
# include "c.defs"
# rename page_table "PAGTAB"
# rename first_free_page "FFPAGE"
int first_free_page;
extern int page_table [256];
extern int cerr;
/**********************************************************************
PG_GET - Page Get
Allocate "n" contiguous unused pages in the address space.
Return the number of the lowest page allocated, or -1
if unable to allocate pages.
**********************************************************************/
int pg_get (n)
{int page, i, top, tp, n_free;
if (n<1 || n>254) return (-1);
page = first_free_page; /* first page we examine */
top = 256-n; /* highest possible low page */
n_free = 0; /* number of free pages we see */
while (page <= top)
{for (i=0;i<n;++i)
{tp = page+i;
if (page_table[tp]!=0 || pg_exist(tp)) break;
else ++n_free;
}
if (i>=n) break; /* success */
page =+ i+1;
}
if (page > top) return (-1);
for (i=0;i<n;++i) page_table[page+i] = -1;
if (n_free==n) first_free_page = page+n;
return (page);
}
/**********************************************************************
PG_RET - Page Return
deallocate "n" pages in the address space and unmap them
return non-zero on error
**********************************************************************/
int pg_ret (page, n)
{if (n<1 || page<=0 || page+n>256)
{cprint (cerr, "PG_RET: invalid page number %d.\n", page);
return (-1);
}
if (page < first_free_page) first_free_page = page;
while (--n >= 0)
{page_table[page] = 0;
corblk (0, -1, page, -1, page);
++page;
}
return (0);
}
/**********************************************************************
PG_EXIST - Does page exist in address space?
**********************************************************************/
pg_exist (page_no)
{int blk[4];
cortyp (page_no, blk);
return (page_table[page_no] = (blk[0] != 0));
}
/**********************************************************************
PG_NSHARE - Return number of times page is shared
**********************************************************************/
pp_nshare (p) {return (pg_nshare (p>>10));}
pg_nshare (page_no)
{int blk[4];
cortyp (page_no, blk);
return (blk[3] & 0777777);
}


431
arc/ar2:clib/C10RUN CMID Normal file
View File

@@ -0,0 +1,431 @@
;
; C10RUN - BASIC C RUN-TIME SUPPORT
;
; This file is ITS dependent.
;
TITLE CRUN
.INSRT NC
.INSRT NM
.GLOBAL A,B,C,D,P,GO,.CCALL,.VCALL,.ACALL,.XCALL
PDLSIZ==20000 ; DESIRED PDL SIZE
MAXARG==40. ; MAXIMUM NUMBER OF ARGUMENTS
BUFSZ==250. ; COMMAND BUFFER SIZE IN CHARACTERS
TP==16
;
; START-UP ROUTINE
;
IENTRY START
; ENABLE INTERRUPTS
.SUSET [.ROPTI,,A] ; READ OPTION WORD
TLO A,OPTOPC+OPTINT ; SET OLD PC ON MPV, IOC AND
; USE NEW INTERRUPT STACKING SCHEME
.SUSET [.SOPTI,,A] ; SET OPTION WORD
MOVE A,[-TSINTL",,TSINT"] ; SET UP INTERRUPT HANDLING
MOVEM A,42
MOVEI A,%PIMPV+%PIPDL ; ENABLE MPV AND PDL OVERFLOW
.SUSET [.SMASK,,A]
;SET UP UUO HANDLER
MOVE A,[JSR UUOH"]
MOVEM A,41
MOVE P,PDLBOT ; STACK
MOVE TP,TPINIT ; TIME STACK (IF IN TIMING MODE)
MCALL $SETUP
IENTRY RESTART
MOVE P,PDLBOT
VCALL @CALLER,[ARGC,[[ARGV]]]
CALL CEXIT,[[[0]]]
IENTRY .EXIT
SETZM TIMING
SKIPE EXITER
VCALL @EXITER ; CLEAN-UP TIMING
.LOGOUT ; IN CASE WE ARE AT TOP LEVEL
.BREAK 16,160000 ; COMMIT SUICIDE
; SETUP ROUTINE
; TURN OFF TTY ECHOING, READ AND PARSE JCL COMMAND,
; GET JOB NAME, INITIALIZE I/O, OPEN TTY
MENTRY $SETUP
; TURN OFF TTY ECHOING
.SUSET [.RTTY,,A] ; READ TTY WORD
TLNE A,400000 ; TEST %TBNOT BIT
GO SET$0 ; DONT HAVE TTY
.OPEN 17,[SIXBIT/ TTY/]
GO SET$0 ; WHO CARES IF IT FAILS
.CALL [SETZ ; TURN OFF ECHOING
'TTYSET
1000,,17
[020202020202]
SETZ [030202020202]
]
JFCL
.CLOSE 17,
SET$0: .CLOSE 1, ; HACK FOR TOP-LEVEL BOOTSTRAP
.CLOSE 2,
.CLOSE 3,
; READ JCL
.SUSET [.ROPTI,,A] ; READ OPTION WORD
TLNN A,OPTCMD ; IS THERE SOME JCL
GO SET$2 ; NOPE
SETZM JCLBUF ; FIRST WORD -- MAKE SURE ITS THERE
SETOM JCLBUF+<BUFSZ/5>-1 ; LAST WORD OF JCLBUF
.BREAK 12,[..RJCL,,JCLBUF] ; READ JCL
; READ JOB NAME
SET$2: .SUSET [.RXJNAME,,XJNAME]
; PARSE JCL
MCALL PRSARG,[[[440700,,JCLBUF]],[[ARGBUF]],[[ARGV]],XJNAME,[[MAXARG]]]
MOVEM A,ARGC
CALL C0INIT ; INITIALIZE C I/O ROUTINES
CALL FXARG,[ARGC,[[ARGV]]] ; DO REDIRECTION OF STANDARD I/O
MOVEM A,ARGC
.SUSET [.RTTY,,A] ; READ TTY WORD
TLNE A,400000 ; TEST %TBNOT BIT
GO SET$R ; RETURN IF DONT HAVE TTY
CALL TYIOPN ; ENABLE INTERRUPT CHARS
SET$R: RETURN
IENTRY STKDMP
PUSH P,0 ; SAVE REGISTERS
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,[0] ; PLACE TO SAVE 'REAL' RETURN ADDRESS
PUSH P,[0] ; ZERO ARG TO STKDMP
.VALUE [ASCIZ\..XECP/0/1Q
P\]
MOVEM 0,-1(P) ; SAVE AWAY 'REAL' RETURN ADDRESS
PUSHJ P,ZSTKDMP"
POP P,(P)
POP P,D
POP P,C
POP P,B
POP P,A
POP P,0
POPJ P,
;
; EXIT ROUTINES
;
CENTRY CEXIT,[CC]
CALL CLOSALL
MOVE A,CC
GO .EXIT
CENTRY CQUIT,[CC]
CROAK CQUIT CALLED
CALL CEXIT,[CC]
; CODE TO PERFORM LOAD-TIME INITIALIZATION
; FLUSHES ZERO PAGES IN IMPURE AREAS
.IDATA
; NO LITERALS IN THIS CODE!
IENTRY LBINIT ; INIT FOR MAKING LIBRARY
SETZM IFLUSH ; DON'T FLUSH ZERO-PAGES BECAUSE
; MAKLIB EXPECTS THEM TO BE THERE
MOVE A,LBD1 ; RESET FLUSH-FLAG WHEN DONE
MOVEM A,IDONE
GO LINIT
LBD1: SETOM IFLUSH
IENTRY LINIT
MOVEI P,ARGV ; TEMPORARY PDL
IENTRY ISTART
JFCL
; SETUP SEGMENT BOUNDARIES
HLRZ A,20
MOVEM A,SEG0LO
HRRZ A,20
MOVEM A,SEG0HI
SETZM 20
HLRZ A,21
MOVEM A,SEG1LO
HRRZ A,21
MOVEM A,SEG1HI
SETZM 21
HLRZ A,22
MOVEM A,SEG2LO
HRRZ A,22
MOVEM A,SEG2HI
SETZM 22
HLRZ A,23
MOVEM A,SEG3LO
HRRZ A,23
MOVEM A,SEG3HI
SETZM 23
; INITIALIZE PAGE-TABLE
MOVEI A,256.
I$LOOP: SOJL A,I$SMSH ; A IS PAGE NUMBER
.CALL I$CORT ; GET PAGE INFO
.VALUE I$MES1 ; SYSTEM CALL LOST
MOVEM B,PAGTAB(A)
GO I$LOOP
; NOW LOOK FOR .CCALLS TO SMASH
I$SMSH: SKIPE TIMING ; DON'T SMASH IF TIMING
GO I$FLSH
SKIPA A,SEG2LO ; POINTER TO BEGINNING OF CODE AREA
I$S1: ADDI A,1 ; NEXT WORD
CAML A,SEG2HI ; AT END OF CODE AREA?
GO I$PURE ; DONE
HLRZ B,(A) ; INSTRUCTION
TRZ B,000777 ; ISOLATE OPCODE
CAIE B,(.CCALL) ; IS IT A .CCALL?
GO I$S1 ; NO, GO ON
HLRZ B,(A) ; THE INSTRUCTION AGAIN
TRNN B,000037 ; IS INDEXING OR INDIRECTION USED
GO I$S6 ; NO, IT'S A CONSTANT CALL
TRZ B,777000 ; SMASH OPCODE
IORI B,(.VCALL) ; MAKE IT A .VCALL
HRLM B,(A) ; SMASH THE .CCALL
GO I$S1 ; GO ON TO NEXT WORD
I$S6: HRRZ C,(A) ; THE CALLED PROCEDURE
JUMPE C,I$S1 ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO I$S1 ; NO, NOT A PROCEDURE
LDB B,[270400,,(A)] ; THE NUMBER OF ACTUAL ARGS
CAIE 0,(B) ; DO THE NUMBERS MATCH?
GO I$S2 ; NO
MOVEI B,(PUSHJ P,)
HRLM B,(A) ; SMASH .CCALL TO PUSHJ
GO I$S1
; HERE IF NUMBER OF ACTUALS AND FORMALS ARE DIFFERENT
I$S2: SUBI 0,(B) ; NUMBER OF EXTRA ACTUALS NEEDED
JUMPL 0,I$S5 ; TOO MANY ACTUALS GIVEN
MOVE B,0
ADDI B,2
CL I$ALLC ; ALLOCATE SPACE FOR PROG
HRRZ B,D ; ADDRESS OF BLOCK
HRLI B,(JSP D,) ; CONSTRUCT CALL TO IT
MOVEM B,(A) ; SMASH ORIGINAL CALL
SUBI D,1
I$S3: SOJL 0,I$S4 ; FOR EACH MISSING ARG
PUSH D,PZERO ; COMPILE A PUSH OF ZERO
GO I$S3
I$S4: PUSH D,PUSHD ; COMPILE A PUSH OF D (RETURN ADDRESS)
HRLI C,(GO) ; MAKE JUMP TO CALLED PROC
PUSH D,C ; COMPILE CALL
GO I$S1 ; FINISHED WITH THIS CALL
; HERE IF NUMBER OF ACTUALS EXCEEDS NUMBER OF FORMALS
I$S5: MOVEI B,3 ; GET TWO WORDS
CL I$ALLC
HRRZ B,D ; ADDRESS OF BLOCK
HRLI B,(JSP D,) ; MAKE CALL TO IT
MOVEM B,(A) ; SMASH ORIGINAL CALL
MOVN B,0 ; NUMBER OF EXTRA ARGS
HRLI B,(SUBI P,) ; CONSTRUCT INSTRUCTION
MOVEM B,(D) ; STORE IN BLOCK
MOVE B,PUSHD
MOVEM B,1(D)
HRLI C,(GO) ; MAKE JUMP TO CALLED PROC
MOVEM C,2(D) ; STORE IN BLOCK
GO I$S1 ; FINISHED WITH THIS CALL
; NOW PURIFY HIGH SEGMENTS
I$PURE: MOVE A,SEG2LO
TRZ A,1777
MOVE B,SEG2HI
SUBI B,(A)
LSH A,-10.
ADDI B,1777
LSH B,-10.
MOVN B,B
HRL A,B
.CALL I$PBLK
.VALUE I$MES4
MOVE A,SEG3LO
TRZ A,1777
MOVE B,SEG3HI
SUBI B,(A)
LSH A,-10.
ADDI B,1777
LSH B,-10.
MOVN B,B
HRL A,B
.CALL I$PBLK
.VALUE I$MES4
; NOW LOOK FOR ZERO-PAGES TO FLUSH
I$FLSH: SKIPN IFLUSH
GO I$DONE
MOVEI A,0 ; FIRST PAGE IS 1 (CAN'T FLUSH 0!)
NXTPAG: ADDI A,1 ; CURRENT PAGE NUMBER
MOVE B,A
LSH B,10. ; POINTER TO FIRST WORD IN PAGE
CAMLE B,SEG1HI ; STILL IN IMPURE AREA?
GO I$DONE ; NO, DONE
SKIPN PAGTAB(A) ; DOES PAGE EXIST?
GO NXTPAG ; NO, TRY NEXT ONE
NXTWRD: SKIPE (B) ; IS THE WORD ZERO
GO NXTPAG ; NO, CAN'T FLUSH THIS PAGE
ADDI B,1 ; NEXT WORD
TRNE B,1777 ; IN NEXT PAGE?
GO NXTWRD ; NO, KEEP GOING
.CALL I$CORB ; YES, DELETE PAGE
.VALUE I$MES2 ; SYSTEM CALL LOST
GO NXTPAG ; GO ON TO NEXT PAGE
I$DONE:
IENTRY IDONE
JFCL
SETZ A, ; CLEAN UP
SETZ B, ; LIKE A GOOD BOY SHOULD
SETZ C,
SETZ D,
.BREAK 16,0 ; RETURN TO LOADER
; STORAGE ALLOCATOR FOR .CCALL COMPILER
; CALL WITH SIZE IN B
; RETURNS ADDRESS IN D
I$ALLC: MOVE D,SEG3HI ; TOP OF PATCH SPACE
ADDI D,1 ; POINT TO NEW BLOCK
ADDB B,SEG3HI ; NEW TOP OF PATCH SPACE
LSH B,-10. ; PAGE OF TOP OF PATCH SPACE
SKIPE PAGTAB(B) ; DOES PAGE EXIST?
RTN ; YES
.CALL I$GETB ; GET PAGE
.VALUE I$MES3 ; SYSTEM CALL LOST
SETOM PAGTAB(B) ; UPDATE PAGE TABLE
RTN ; RETURN
MDATA TIMING
0
IFLUSH: -1 ; FLUSH ZERO PAGES
I$CORT: SETZ ? 'CORTYP ? A ? 402000,,B
I$CORB: SETZ ? 'CORBLK ? 1000,,0 ? 1000,,%JSELF ? SETZ A
I$PBLK: SETZ ? 'CORBLK ? 1000,,%CBNDR ? 1000,,%JSELF ? 400000,,A
I$GETB: SETZ ? 'CORBLK ? 1000,,%CBNDR+%CBNDW ? 1000,,%JSELF ?
B ? 401000,,%JSNEW
I$MES1: ASCIZ/CORTYP FAILED/
I$MES2: ASCIZ/PAGE-DELETE FAILED/
I$MES3: ASCIZ/PAGE-GET FAILED/
I$MES4: ASCIZ/PURIFY FAILED/
.CODE
IENTRY FIXIFY
JUMPL A,FIXL
FADR A,[.499999]
UFA A,[233000000000']
TLZ B,777000'
JRST @0
FIXL: MOVN A,A
FADR A,[.499999]
UFA A,[233000000000']
TLZ B,777000'
MOVN B,B
JRST @0
; IMPURE AREA
.IDATA
-1 ; THIS STUFF MUST NOT BE FLUSHED!
MDATA PAGTAB ; PAGE TABLE
BLOCK 256.
MDATA ARGV
BLOCK MAXARG ; POINTERS TO ARGS PLACED HERE
MDATA XJNAME
BLOCK 1 ; JOB NAME
MDATA SEG0LO
0
MDATA SEG0HI
0
MDATA SEG1LO
0
MDATA SEG1HI
0
MDATA SEG2LO
0
MDATA SEG2HI
0
MDATA SEG3LO
0
MDATA SEG3HI
0
; END OF WIRED-DOWN STUFF (PROTECTED
; ON THIS END BY CALLER)
MDATA CALLER
ZMAIN" ; C ROUTINE CALLED AS PROGRAM
MDATA PURBOT
0
MDATA PURTOP
0
.UDATA
MDATA EXITER
BLOCK 1 ; EXIT ROUTINE (FOR TIMING)
ARGC: BLOCK 1 ; NUMBER OF ARGUMENTS TO MAIN
JCLBUF: BLOCK BUFSZ/5 ; JCL BUFFER
ARGBUF: BLOCK BUFSZ ; MAIN ARGS BUFFER
PDL: BLOCK PDLSIZ ; THE STACK
.IDATA
MDATA PDLBOT
PDL
MDATA PDLTOP
PDL+PDLSIZ-1
.PDATA
MDATA PZERO
PUSH P,ZERO
MDATA ZERO
0
MDATA PUSHD
PUSH P,D
MDATA TPINIT ; SET BY TINIT
0
CONSTANTS
MDATA PATCH
END START


44
arc/ar2:clib/C10SAV CMID Normal file
View File

@@ -0,0 +1,44 @@
;
; CSAVE - Routine to prepare for saving a program file
;
; This file is ITS dependent.
; This file contains the size of the shared library file.
;
TITLE CSAVE
.INSRT NC
.INSRT NM
.GLOBAL TYICHN,TYOCHN,PDLBOT,PDLTOP
CENTRY CSAVE
SETOM TYICHN
SETOM TYOCHN
MOVE A,[-10.,,246.]
.CALL [SETZ ? 'CORBLK ? MOVEI 0 ? MOVEI %JSELF ? SETZ A]
; DELETE SHARED LIBRARY PAGES
CROAK CORBLK FAILED
; DELETE STACK PAGES
MOVE A,PDLBOT
ADDI A,1777
TRZ A,1777 ; MOVE TO NEXT PAGE BOUNDARY
MOVE B,PDLTOP ; LAST WORD OF STACK
ADDI B,1
TRZ B,1777 ; MOVE TO PREVIOUS PAGE BOUNDARY
LSH A,-10.
LSH B,-10. ; GET PAGE NUMBERS
SUB B,A ; NUMBER OF PAGES
MOVN B,B ; NEGATIVE NUMBER OF PAGES
HRL A,B ; MAKE COUNTING POINTER
.CALL [SETZ ? 'CORBLK ? MOVEI 0 ? MOVEI %JSELF ? SETZ A]
CROAK CORBLK FAILED
.VALUE [ASCIZ/:PDUMP /]
RETURN
END


25
arc/ar2:clib/C10SFD C Normal file
View File

@@ -0,0 +1,25 @@
/**********************************************************************
SETFDIR - Set File Directory (and defaults)
(obsolete)
**********************************************************************/
char *setfdir (buf, name, dir)
char *buf, *name, *dir;
{filespec fs1, fs2;
char *p;
fparse (name, &fs1);
fparse (dir, &fs2);
if (fs2.dir==0) fs2.dir=fs2.fn1;
if (fs2.dev) fs1.dev = fs2.dev;
else if (fs1.dev==0) fs1.dev=csto6("dsk");
if (fs2.dir) fs1.dir = fs2.dir;
else if (fs1.dir==0) fs1.dir=rsname();
p = prfile (&fs1, buf);
*p = 0;
return (buf);
}


64
arc/ar2:clib/C10SRY CMID Normal file
View File

@@ -0,0 +1,64 @@
;
; C10SRY - CHANGE .VCALL'S TO PUSHJ'S
;
; This file is ITS dependent.
; This routine assumes a superior DDT.
;
TITLE SORRY
.INSRT NC
.INSRT NM
.GLOBAL SEG2LO,SEG2HI,SEG3LO,SEG3HI
IENTRY SORRY
.VALUE [ASCIZ/:UNPURE
P/]
; MOVE A,SEG2LO
; TRZ A,1777
; MOVE B,SEG2HI
; SUBI B,(A)
; LSH A,-10.
; ADDI B,1777
; LSH B,-10.
; MOVN B,B
; HRL A,B
; .CALL I$IMPR
; .VALUE
SKIPA A,SEG2LO ; POINTER TO BEGINNING OF CODE AREA
S1: ADDI A,1 ; NEXT WORD
CAML A,SEG2HI ; AT END OF CODE AREA?
GO DONE
HLRZ B,(A) ; INSTRUCTION
TRZ B,000777 ; ISOLATE OPCODE
CAIE B,(.VCALL) ; IS IT A .CCALL?
GO S1 ; NO, GO ON
HLRZ B,(A) ; THE INSTRUCTION AGAIN
TRZ B,777740 ; FLUSH OPCODE AND ACCUMULATOR
IORI B,(PUSHJ P,) ; MAKE IT A PUSHJ
HRLM B,(A) ; STORE IT
GO S1
DONE: MOVE A,SEG2LO
TRZ A,1777
MOVE B,SEG3HI
SUBI B,(A)
LSH A,-10.
ADDI B,1777
LSH B,-10.
MOVN B,B
HRL A,B
.CALL I$PURE
.VALUE
.VALUE [ASCIZ/:PDUMP /]
.BREAK 16,0
.PDATA
I$PURE: SETZ ? 'CORBLK ? 1000,,%CBNDR ? 1000,,%JSELF ? 400000,,A
;I$IMPR: SETZ ? 'CORBLK ? 1000,,%CBRED+%CBWRT ? 1000,,%JSELF ? 400000,,A
END


136
arc/ar2:clib/C10STD C Normal file
View File

@@ -0,0 +1,136 @@
# include "c.defs"
# include "stdio.h"
/**********************************************************************
STDIO.C - 'Standard I/O' Simulator for ITS
Must call STDIO to initialize.
**********************************************************************/
int *stdin, *stdout, *stderr;
extern int cin, cout, cerr;
stdio ()
{stdin = cin; stdout = cout; stderr = cerr;
on (ctrlg_interrupt, INT_IGNORE);
}
flopen (name, mode)
char *name, *mode;
{int f;
f = copen (name, mode[0]);
if (f == OPENLOSS) return (0);
return (f);
}
int fgetc (f)
{int c;
c = cgetc (f);
if (c < 0) return (EOF);
if (c == 0 && ceof (f)) return (EOF);
return (c);
}
int fgeth ()
{return (fgetc (cin));}
int peekc (f)
{int c;
c = cgetc (f);
if (c < 0) return (EOF);
if (c == 0 && ceof (f)) return (EOF);
ungetc (c, f);
return (c);
}
int pkchar ()
{return (peekc (cin));}
printf (a, b, c, d, e, f, g)
{cprint (cout, a, b, c, d, e, f, g);}
fprintf (a, b, c, d, e, f, g)
{cprint (a, b, c, d, e, f, g);}
fclose (f) {cclose (f);}
fread (f, buf, size, number) char buf[];
{int n;
n = size * number;
while (--n >= 0) *buf++ = cgetc (f);
}
freopen (name, mode, f) char *name, *mode;
{int i;
cclose (f);
i = copen (name, *mode);
return (i);
}
/**********************************************************************
STRING ROUTINES
**********************************************************************/
strcmp (s1, s2)
char *s1, *s2;
{int c1, c2;
while (TRUE)
{c1 = *s1++;
c2 = *s2++;
if (c1 < c2) return (-1);
if (c1 > c2) return (1);
if (c1 == 0) return (0);
}
}
strcpy (dest, source)
char *dest, *source;
{stcpy (source, dest);}
strcat (dest, source)
char *dest, *source;
{while (*dest) ++dest;
stcpy (source, dest);
}
getuid () {return (rsuset (074));}
getpw (w, buf) char *buf;
{c6tos (w, buf);}
nowtime (tv) int tv[];
{cal foo;
now (&foo);
tv[0] = tv[1] = cal2f (&foo);
}
char *ctime (tv) int tv[];
{static char buf[100];
cal foo;
int f;
f2cal (tv[0], &foo);
f = copen (buf, 'w', "s");
prcal (&foo, f);
cputc ('\n', f);
cclose (f);
return (buf);
}
unlink (s) {delete (s);}
exit (cc) {cexit (cc);}


728
arc/ar2:clib/C10SYS CMID Normal file
View File

@@ -0,0 +1,728 @@
;
; C10SYS - C LIBRARY ROUTINES (INTERFACES TO SYSTEM CALLS)
;
; This file is ITS dependent.
;
TITLE C10SYS
.INSRT NC
.INSRT NM
; CONTAINS:
; SYSOPEN ; OPEN CHANNEL
; CLOSE ; CLOSE CHANNEL
; CHNLOC ; FIND AVAILABLE CHANNEL
; UIIOT ; PERFORM UNIT INPUT IOT
; UOIOT ; PERFORM UNIT OUTPUT IOT
; SYSREAD ; PERFORM BLOCK INPUT IOT
; SYSWRITE ; PERFORM BLOCK OUTPUT IOT
; SIOT ; STRING IOT
; SYSFINISH ; FORCE OUTPUT AND WAIT FOR COMPLETION
; SYSFORCE ; FORCE OUTPUT TO DEVICE
; RESET ; RESET CHANNEL
; STATUS ; GET CHANNEL STATUS
; RFPNTR ; READ FILE ACCESS POINTER
; ACCESS ; PERFORM RANDOM ACCESS ON CHANNEL
; FILLEN ; GET FILE LENGTH
; FILNAM ; GET FILE NAME FROM CHANNEL
; RAUTH ; READ FILE AUTHOR
; SAUTH ; SET FILE AUTHOR
; RDMPBT ; READ DUMP BIT
; SDMPBT ; SET DUMP BIT
; SREAPB ; SET DO-NOT-REAP BIT
; RFDATE ; READ FILE CREATION DATE
; SFDATE ; SET FILE CREATION DATE
; SRDATE ; SET FILE REFERENCE DATE
; DSKUPD ; UPDATE FILE INFO
; RESRDT ; RESTORE FILE INFO
; TTYGET ; GET TTY STATUS
; TTYSET ; SET TTY STATUS
; CNSGET ; GET CONSOLE PARAMETERS
; CNSSET ; SET CONSOLE PARAMETERS
; ITYIC ; READ TTY INTERRUPT CHARACTER
; WHYINT ; WHY WAS I INTERRUPTED?
; SYSLISTEN ; LISTEN FOR TTY INPUT
; RCPOS ; READ CURSOR POSITION
; SCML ; SET # OF COMMAND LINES
; GETCPU ; RETURN CPU TIME IN 4.069 USEC
; CPUTM ; RETURN CPU TIME IN 1/60 SECONDS
; SLEEP ; GO TO SLEEP
; ETIME ; RETURN A TIME FOR ELAPSED TIME MEASUREMENT
; NOW ; GET CURRENT DATE AND TIME
; CORBLK ; PERFORM PAGE HACKING
; CORTYP ; GET INFORMATION ABOUT PAGE
; PAGEID ; GET NAMED PUBLIC PAGE
; PGWRIT ; CAUSE PAGE TO BE WRITTEN ON DISK
; RSNAME ; READ SNAME
; SSNAME ; SET SNAME
; RUNAME ; READ USER NAME
; RSUSET ; WHAT = RSUSET (WHERE)
; WSUSET ; WHAT = WSUSET (WHERE, WHAT)
; RUSET ; WHAT = RUSET (WHO, WHERE)
; WUSET ; WHAT = WUSET (WHO, WHERE, WHAT)
; WUSRVAR ; RC = WUSRVAR (JOB, SPEC, VALUE)
; DELETE ; DELETE A FILE
; SYSDEL ; DELETE FILE
; RENMWO ; RENAME FILE OPEN FOR OUTPUT
; SYSRNM ; EC = SYSRNM (FS1, FS2)
; SYSLNK ; EC = MAKE LINK (FS1, FS2)
; DIRSIZ ; READ DIRECTORY SIZE, QUOTA INFO
; TRANAD ; RC = TRANAD (JOB, FROM, TO, FLAGS)
; TRANCL ; RC = TRANCL (JOB, FLAGS)
; TRANDL ; RC = TRANDL (JOB, FILESPEC, FLAGS)
; SYSLOAD ; LOAD A PROGRAM
; PDUMP ; PDUMP A PROGRAM
; UCLOSE ; DESTROY INFERIOR JOB
; SYSDISOWN ; EC = SYSDISOWN (JOBCH)
; REOWN ; EC = REOWN (JOBCH)
; SYSDTACH ; EC = SYSDTACH (JOBCH)
; SYSATACH ; EC = SYSATACH (JOBCH, TTY)
; ATTY ; GIVE TTY TO INFERIOR
; DTTY ; TAKE TTY FROM INFERIOR
; WFNZ ; WAIT FOR WORD TO BECOME NON-ZERO
; WFZ ; WAIT FOR WORD TO BECOME ZERO
; VAL7RET ; VALRET AN ASCIZ STRING
; DEMSIG ; SIGNAL A DEMON PROCESS
; SSTATUS ; OBTAIN SYSTEM STATUS
; MAKTAG ; CREATE A TAG (GLOBAL LABEL)
; GOTAG ; GOTO A TAG, DISMISSING INTERRUPTS
CENTRY SYSOPEN,[CHAN, FILSPC, MODE] ; OPEN CHANNEL
HRLZ B,MODE
HRR B,CHAN
HRRZ C,FILSPC
SYSCAL OPEN,[B ? (C) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY CLOSE,[CHAN] ; CLOSE CHANNEL
SYSCAL CLOSE,[CHAN]
RETURN
CENTRY CHNLOC ; FIND AVAILABLE CHANNEL
FIRSTC==1 ; CHANGE TO 0 IF SYSTEM FIXED SO THAT
; CHANNEL 0 IS NOT ARBITRARILY SMASHED
; BY .CALL MLINK, ETC.
MOVEI B,FIRSTC
CL$1: SYSCAL RFNAME,[B ? 2000,,C]
JUMPE C,CL$2 ; CHANNEL NOT OPEN
ADDI B,1
CAIGE B,20
GO CL$1
SETO A,
GO CL$RET
CL$2: MOVE A,B
CL$RET: RETURN
CENTRY UIIOT,[CHAN] ; PERFORM UNIT INPUT IOT
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.IOT A]
XCT A
RETURN
CENTRY UOIOT,[CHAN,DATA] ; PERFORM UNIT OUTPUT IOT
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.IOT DATA]
XCT A
MOVE A,DATA
RETURN
CENTRY SYSREAD,[CHAN,BUFFP,NWORDS] ; PERFORM BLOCK INPUT IOT
XENTRY SYSWRITE,SYSREAD ; PERFORM BLOCK OUTPUT IOT
MOVN A,NWORDS ; MINUS NUMBER OF WORDS
HRLZ 0,A
HRR 0,BUFFP ; SET UP CPTR
MOVE C,CHAN
ANDI C,17
LSH C,23.
IOR C,[.IOT 0]
XCT C
HLRE C,0 ; NEW COUNTER
SUB C,A ; NUMBER OF WORDS WRITTEN/READ
MOVE A,C
RETURN
CENTRY SIOT,[CHAN,BYTP,NBYTES] ; STRING IOT
SYSCAL SIOT,[CHAN ? BYTP ? NBYTES],SI$LOS
MOVE A,NBYTES
SI$RET: RETURN
SI$LOS: CROAK SIOT LOST
GO SI$RET
CENTRY SYSFINISH,[CHAN]
SYSCAL FINISH,[CHAN]
RETURN
CENTRY SYSFORCE,[CHAN]
SYSCAL FORCE,[CHAN]
RETURN
CENTRY RESET,[CHAN] ; RESET CHANNEL
MOVE A,CHAN
ANDI A,17
LSH A,23.
IOR A,[.RESET]
XCT A
SETZ A,
RETURN
CENTRY STATUS,[CHAN] ; GET CHANNEL STATUS
MOVE A,CHAN
LSH A,23.
IOR A,[.STATUS A]
XCT A
RETURN
CENTRY RFPNTR,[CHAN] ; READ FILE ACCESS POINTER
SYSCAL RFPNTR,[CHAN ? MOVEM B],RP$LOS
MOVE A,B
RP$RET: RETURN
RP$LOS: MOVN A,A
GO RP$RET
CENTRY ACCESS,[CHAN,POS] ; PERFORM RANDOM ACCESS ON CHANNEL
SYSCAL ACCESS,[CHAN ? POS]
RETURN
CENTRY FILLEN,[CHAN] ; GET FILE LENGTH
SYSCAL FILLEN,[CHAN ? 2000,,B],FL$LOS
MOVE A,B
FL$RET: RETURN
FL$LOS: MOVN A,A
GO FL$RET
CENTRY FILNAM,[CHAN,FILSPC] ; GET FILE NAME FROM CHANNEL
HRLZ B,CHAN ; CHANNEL
HRR B,FILSPC ; FILESPEC FOR RESULTS
MOVE C,4(B) ; SAVE 5TH WORD
.RCHST B, ; READ CHANNEL STATUS
HRLZS (B) ; LEFT ADJUST DEV
MOVEM C,4(B) ; RESTORE 5TH WORD
RETURN ; DONE
CENTRY RAUTH,[CHAN]
SYSCAL RAUTH,[CHAN ? MOVEM B],RA$LOS
MOVE A,B
RA$RET: RETURN
RA$LOS: MOVN A,A
GO RA$RET
CENTRY SAUTH,[CHAN,AUTHOR]
SYSCAL SAUTH,[CHAN ? AUTHOR]
RETURN
CENTRY RDMPBT,[CHAN]
SYSCAL RDMPBT,[CHAN ? MOVEM B],RD$LOS
MOVE A,B
RD$RET: RETURN
RD$LOS: MOVN A,A
GO RD$RET
CENTRY SDMPBT,[CHAN,BIT]
SYSCAL SDMPBT,[CHAN ? BIT]
RETURN
CENTRY SREAPB,[CHAN,BIT]
SYSCAL SREAPB,[CHAN ? BIT]
RETURN
CENTRY RFDATE,[CHAN] ; READ FILE CREATION DATE
SYSCAL RFDATE,[CHAN ? 2000,,B],RF$LOS
MOVE A,B
RF$RET: RETURN
RF$LOS: MOVN A,A
GO RF$RET
CENTRY SFDATE,[CHAN,FDATE] ; SET FILE CREATION DATE
SYSCAL SFDATE,[CHAN ? FDATE]
RETURN
CENTRY SRDATE,[CHAN,FDATE] ; SET FILE REFERENCE DATE
SYSCAL SRDATE,[CHAN ? FDATE]
RETURN
CENTRY DSKUPD,[CHAN]
SYSCAL DSKUPD,[CHAN]
RETURN
CENTRY RESRDT,[CHAN]
SYSCAL RESRDT,[CHAN]
RETURN
CENTRY TTYGET,[CHAN,BLOCK] ; GET TTY STATUS - WRITES 3 VALUES
HRRZ B,BLOCK
SYSCAL TTYGET,[CHAN ? MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)]
RETURN
CENTRY TTYSET,[CHAN,BLOCK] ; SET TTY STATUS - READS 3 VALUES
HRRZ B,BLOCK
SYSCAL TTYSET,[CHAN ? (B) ? 1(B) ? 2(B)]
RETURN
CENTRY CNSGET,[CHAN,BLOCK] ; GET CONSOLE STATUS - WRITES 5 VALUES
HRRZ B,BLOCK
SYSCAL CNSGET,[CHAN ? MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)
MOVEM 3(B) ? MOVEM 4(B)]
RETURN
CENTRY CNSSET,[CHAN,BLOCK] ; SET CONSOLE STATUS - READS 5 VALUES
HRRZ B,BLOCK
SYSCAL CNSSET,[CHAN ? (B) ? 1(B) ? 2(B) ? 3(B) ? 4(B)]
RETURN
CENTRY WHYINT,[CHAN,BLOCK]
HRRZ B,BLOCK
SYSCAL WHYINT,[CHAN ? (B) ? 1(B) ? 2(B) ? 3(B) ? 4(B)]
RETURN
CENTRY ITYIC,[CHAN] ; READ TTY INTERRUPT CHARACTER
MOVE A,CHAN ; CHANNEL
.ITYIC A,
SETO A,
RETURN
CENTRY SYSLISTEN,[CHAN] ; NCHARS = SYSLISTEN(CHAN)
SYSCAL LISTEN,[CHAN ? MOVEM B],LI$LOS
MOVE A,B
LI$RET: RETURN
LI$LOS: MOVN A,A
GO LI$RET
CENTRY RCPOS,[CHAN] ; READ TTY CURSOR POSITION (V,,H)
SYSCAL RCPOS,[CHAN ? 2000,,B],RC$LOS
MOVE A,B
RC$RET: RETURN
RC$LOS: MOVN A,A
GO RC$RET
CENTRY SCML,[CHAN,NUMBER]
SYSCAL SCML,[CHAN ? NUMBER]
RETURN
CENTRY GETCPU ; RETURN CPU TIME IN 4.069 USEC
.SUSET [24,,A]
RETURN
CENTRY CPUTM ; RETURN CPU TIME IN 1/60 SECONDS
.SUSET [24,,A]
LSH A,-12.
RETURN
CENTRY SLEEP,[TIME] ; GO TO SLEEP
MOVE A,TIME
.SLEEP A,
RETURN
CENTRY ETIME ; RETURN A TIME FOR ELAPSED TIME MEASUREMENT
.RDTIME A,
LSH A,1
RETURN
CENTRY NOW,[PCAL] ; GET CURRENT DATE AND TIME
HRRZ D,PCAL ; CAL POINTER
.RDATE C,
LDB A,[360600,,C] ; HIGH-ORDER YEAR SIXBIT
SUBI A,20
IMULI A,10.
LDB B,[300600,,C] ; LOW-ORDER YEAR SIXBIT
SUBI B,20
ADDI A,1900.(B) ; YEAR
MOVEM A,(D)
LDB A,[220600,,C] ; HIGH-ORDER MONTH
SUBI A,20
IMULI A,10.
LDB B,[140600,,C] ; LOW-ORDER MONTH
SUBI B,20
ADDI A,(B)
MOVEM A,1(D) ; MONTH
LDB A,[060600,,C] ; HIGH-ORDER DAY
SUBI A,20
IMULI A,10.
LDB B,[000600,,C] ; LOW-ORDER DAY
SUBI B,20
ADDI A,(B)
MOVEM A,2(D) ; DAY
.RTIME C,
LDB A,[360600,,C] ; HIGH-ORDER HOUR
SUBI A,20
IMULI A,10.
LDB B,[300600,,C] ; LOW-ORDER HOUR
SUBI B,20
ADDI A,(B)
MOVEM A,3(D) ; HOUR
LDB A,[220600,,C] ; HIGH-ORDER MINUTE
SUBI A,20
IMULI A,10.
LDB B,[140600,,C] ; LOW-ORDER MINUTE
SUBI B,20
ADDI A,(B)
MOVEM A,4(D) ; MINUTE
LDB A,[060600,,C] ; HIGH-ORDER SECOND
SUBI A,20
IMULI A,10.
LDB B,[000600,,C] ; LOW-ORDER SECOND
SUBI B,20
ADDI A,(B)
MOVEM A,5(D) ; SECOND
MOVEI A,(D)
RETURN
CENTRY CORBLK,[A1,A2,A3,A4,A5] ; PERFORM PAGE HACKING
SYSCAL CORBLK,[A1 ? A2 ? A3 ? A4 ? A5]
RETURN
CENTRY CORTYP,[PAGNO,OUTPUT] ; GET INFORMATION ABOUT PAGE
MOVE B,OUTPUT
SYSCAL CORTYP,[PAGNO ? 2000,,(B) ? 2000,,1(B) ? 2000,,2(B)
2000,,3(B)]
RETURN
CENTRY PAGEID,[VPN,IDN] ; GET NAMED PUBLIC PAGE
SYSCAL PAGEID,[VPN ? IDN ? 2000,,B],PI$LOS
MOVE A,B
PI$RET: RETURN
PI$LOS: MOVN A,A
GO PI$RET
CENTRY PGWRIT,[JOB,VPN]
SYSCAL PGWRIT,[JOB ? VPN]
RETURN
CENTRY RSNAME ; READ SNAME
.SUSET [.RSNAM,,A]
RETURN
CENTRY SSNAME,[NAME] ; SET SNAME
MOVE A,NAME
.SUSET [.SSNAM,,A]
RETURN
CENTRY RUNAME ; READ USER NAME
.SUSET [.RUNAM,,A]
RETURN
CENTRY RSUSET,[WHERE]
HRLZ A,WHERE
TLZ A,600000 ; CLEAR DIRECTION AND BLOCK BITS
ADDI A,A ; RESULT TO A
.SUSET A ; DO IT
RETURN
CENTRY WSUSET,[WHERE,WHAT]
HRLZ B,WHERE
TLO B,400000 ; SET DIRECTION BIT
TLZ B,200000 ; CLEAR BLOCK BIT
ADDI B,A ; TAKE WORD FROM A
MOVE A,WHAT
.SUSET B ; DO IT
RETURN
CENTRY RUSET,[WHO,WHERE]
HRLZ B,WHERE
TLZ B,600000 ; CLEAR DIRECTION AND BLOCK BITS
ADDI B,A ; RESULT TO A
HRRZ A,WHO
ANDI A,17 ; CHANNEL NUMBER
LSH A,23.
IOR A,[.USET B]
XCT A ; DO IT
RETURN
CENTRY WUSET,[WHO,WHERE,WHAT]
HRLZ B,WHERE
TLO B,400000 ; SET DIRECTION BIT
TLZ B,200000 ; CLEAR DIRECTION BIT
ADDI B,A ; TAKE WORD FROM A
HRRZ C,WHO
ANDI C,17 ; CHANNEL NUMBER
LSH C,23.
IOR C,[.USET B]
MOVE A,WHAT
XCT C ; DO IT
RETURN
CENTRY WUSRVAR,[JOB,SPEC,VALUE]
SETZ A,
SYSCAL USRVAR,[JOB ? SPEC ? VALUE]
RETURN
CENTRY DELETE,[FILNAM],[FDEV,FDIR,FFN1,FFN2] ; DELETE A FILE
MOVEI A,FDEV ; POINTER TO FILESPEC
CALL FPARSE,[FILNAM,A] ; CONSTRUCT FILESPEC
MOVEI A,FDEV
CALL SYSDELETE,[A] ; DELETE THAT FILE
RETURN
CENTRY SYSDELETE,[FILSPC] ; DELETE FILE
MOVE B,FILSPC ; ADDRESS OF FILESPEC BLOCK
HRLZI C,(SIXBIT/DSK/)
SKIPN (B)
MOVEM C,(B)
.SUSET [.RSNAM,,C]
SKIPN 3(B)
MOVEM C,3(B)
SYSCAL DELETE,[(B) ? 1(B) ? 2(B) ? 3(B)]
RETURN
CENTRY RENMWO,[CHAN,FILSPC] ; RENAME FILE OPEN FOR OUTPUT
HRRZ B,FILSPC
SYSCAL RENMWO,[CHAN ? 1(B) ? 2(B)]
RETURN
CENTRY SYSRNM,[FILSP1,FILSP2]
HRRZ B,FILSP1
HRRZ C,FILSP2
SYSCAL RENAME,[(B) ? 1(B) ? 2(B) ? 3(B) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY SYSLNK,[FILSP1,FILSP2]
HRRZ B,FILSP1
HRRZ C,FILSP2
SYSCAL MLINK,[(B) ? 1(B) ? 2(B) ? 3(B) ? 1(C) ? 2(C) ? 3(C)]
RETURN
CENTRY DIRSIZ,[CHAN,BLOCK] ; WRITES 2 VALUES
HRRZ B,BLOCK
SYSCAL DIRSIZ,[CHAN ? (B) ? 1(B)]
RETURN
CENTRY TRANAD,[JOB,FROM,TO,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
HRRZ C,FROM ; FROM FILESPEC
HRLI C,-4 ; MAKE IT A CPTR
HRRZ D,TO ; TO FILESPEC
HRLI D,-4 ; MAKE IT A CPTR
SYSCAL TRANAD,[B ? C ? D]
RETURN
CENTRY TRANCL,[JOB,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
SKIPN FLAGS
HRLI B,300003 ; DEFAULT FLAGS
SYSCAL TRANCL,[B]
RETURN
CENTRY TRANDL,[JOB,FILSPC,FLAGS]
HRRZ B,JOB
HRL B,FLAGS
HRRZ C,FILSPC
HRLI C,-4 ; MAKE IT A CPTR
SYSCAL TRANDL,[B ? C]
RETURN
CENTRY SYSLOAD,[JOB,CHAN],[RCODE,OLDIOC] ; LOAD A PROGRAM
SETZM RCODE
CALL ON,[[[2]],[[1]]]
MOVEM A,OLDIOC
SYSCAL LOAD,[JOB ? CHAN],LD$LOS
LD$1: CALL ON,[[[2]],OLDIOC]
MOVE A,RCODE
RETURN
LD$LOS: SETOM RCODE
GO LD$1
CENTRY PDUMP,[JOBCH,DSKCH]
SETZ B,
SYSCAL PDUMP,[JOBCH ? DSKCH ? B]
RETURN
CENTRY UCLOSE,[JCHAN] ; DESTROY INFERIOR JOB
MOVE A,JCHAN
ANDI A,17
LSH A,23.
IOR A,[.UCLOSE]
XCT A
RETURN
CENTRY SYSDISOWN,[JCHAN]
SYSCAL DISOWN,[JCHAN]
RETURN
CENTRY REOWN,[JCHAN]
SYSCAL REOWN,[JCHAN]
RETURN
CENTRY SYSDTACH,[JCHAN]
SYSCAL DETACH,[JCHAN]
RETURN
CENTRY SYSATACH,[JCHAN,TTY] ; TTY<0 => DEFAULT
SKIPGE TTY
GO AT$1
SYSCAL ATTACH,[JCHAN ? TTY]
AT$RET: RETURN
AT$1: SYSCAL ATTACH,[JCHAN]
GO AT$RET
CENTRY ATTY,[JOB] ; GIVE TTY TO INFERIOR
MOVE B,JOB
ANDI B,17
LSH B,23.
IOR B,[.ATTY]
SETZ A,
XCT B
SETO A,
RETURN
CENTRY DTTY,[JOB] ; TAKE TTY FROM INFERIOR
MOVE B,JOB
ANDI B,17
LSH B,23.
IOR B,[.DTTY]
SETZ A,
XCT B
SETO A,
RETURN
CENTRY WFNZ,[PTR] ; WAIT FOR WORD TO BECOME NON-ZERO
MOVE A,PTR
SKIPN (A)
.HANG
MOVE A,(A)
RETURN
CENTRY WFZ,[PTR] ; WAIT FOR WORD TO BECOME ZERO
MOVE A,PTR
SKIPE (A)
.HANG
MOVE A,(A)
RETURN
CENTRY VAL7RET,[STR] ; VALRET AN ASCIZ STRING
HRRZ A,STR
HRLI A,(.VALUE)
XCT A
RETURN
CENTRY DEMSIG,[DEMON] ; SIGNAL A DEMON PROCESS
SYSCAL DEMSIG,[DEMON]
RETURN
CENTRY SSTATUS,[VALBLK] ; RETURNS 7 VALUES
HRRZ B,VALBLK
SYSCAL SSTATUS,[MOVEM (B) ? MOVEM 1(B) ? MOVEM 2(B)
MOVEM 3(B) ? MOVEM 4(B) ? MOVEM 5(B) ? MOVEM 6(B)]
RETURN
CENTRY MAKTAG,[TAGP]
HRRZ A,TAGP ; TAG POINTER
MOVE B,(P) ; RETURN PC
MOVEM B,(A) ; SAVE RETURN PC
MOVEI B,-2(P) ; STACK POINTER BEFORE CALL
MOVEM B,1(A) ; SAVE STACK POINTER
RETURN
CENTRY GOTAG,[TAGP]
MCALL DISMISS
MOVE A,TAGP
MOVE P,1(A)
HRRZ D,(A)
GO (D)
END


197
arc/ar2:clib/C10TAP CMID Normal file
View File

@@ -0,0 +1,197 @@
;
; C10TAP - MAG TAPE INTERFACE
;
; This file is ITS dependent.
;
TITLE C10TAPE
.INSRT NC
.INSRT NM
TAPIN==17 ; TAPE CHANNEL
TPIBSZ==200 ; SIZE OF TAPE INPUT BUFFER
TPBFSZ==2000 ; SIZE OF TAPE OUTPUT BUFFER
CENTRY RWND8 ; REWIND TAPE, LEAVE OPEN FOR READ
.CLOSE TAPIN,
.OPEN TAPIN,[033726,,(SIXBIT/MT0/)]
CROAK UNABLE TO OPEN TAPE FOR READING
MOVE 0,[TAPIN,,[1]]
.MTAPE 0,
JFCL
SETZM CURBLOCK
RETURN
CENTRY OPEN8 ; OPEN TAPE FOR 8-BIT READ
MOVE A,TAPECH
CAILE A,0
GO OP$RTN
CALL RWND8
SETZM TPICNT
SETZM TPIEOF
SETOM CURBLOCK
MOVEI 0,1
MOVEM 0,TAPECH
OP$RTN: RETURN
CENTRY OPNW8 ; OPEN TAPE FOR 8-BIT WRITE
CALL RWND8
.OPEN TAPIN,[033707,,(SIXBIT/MT0/)]
CROAK UNABLE TO OPEN TAPE FOR WRITING
MOVEI A,2*TPBFSZ
MOVEM A,TPICNT
MOVE A,[442000,,TPIBUF]
MOVEM A,TPIBFP
SETOM TAPECH
RETURN
CENTRY GET16 ; READ 16-BITS
SOSGE TPICNT
CL TPREAD
ILDB A,TPIBFP
ILDB B,TPIBFP
LSH B,10
IOR A,B
MOVE B,A
ADD B,CHECKSUM
ANDI B,0177777
MOVEM B,CHECKSUM
RETURN
CENTRY PUT16,[W] ; WRITE 16 BITS
MOVE C,W
SOSGE TPICNT ; ANY ROOM ?
CL WRTAPE ; NO, FLUSH BUFFER
MOVE B,C
ADD B,CHECKSUM
ANDI B,0177777
MOVEM B,CHECKSUM
MOVE B,C
LSH B,-10
ANDI B,0377
LSH C,10
ANDI C,177400
IOR B,C
MOVE C,B
IDPB C,TPIBFP
RETURN
CENTRY SEEK8,[ACC] ; RANDOM ACCESS
SETZM CHARINBUF ; CLEAR GET8 BUFFER
MOVE A,ACC
MOVE B,A
SUB A,CURBLOCK
CAIE A,0
GO L1
; HERE IF DESIRED BLOCK IS IN BUFFER
MOVEI A,2*TPIBSZ
MOVEM A,TPICNT
MOVE A,[441000,,TPIBUF]
MOVEM A,TPIBFP
SE$RET: RETURN
L1: SUBI A,1 ; NUMBER OF BLOCKS TO SKIP
SETZM TPICNT
CAIN A,0
GO SE$RET ; WANT NEXT BLOCK, NOTHING TO SKIP
; HERE IF NECESSARY TO SKIP SOME BLOCKS
HRLZ C,A
HRLZI A,TAPIN
HRRI A,C
HRRI C,6
.MTAPE A,
JFCL
SUBI B,1
MOVEM B,CURBLOCK
RETURN
CENTRY CLOS8 ; CLOSE TAPE
SKIPGE TAPECH
CL FLUSH8 ; FLUSH BUFFER
CALL RWND8
.CLOSE TAPIN,
SETZM TAPECH
RETURN
CENTRY EOF8 ; TEST FOR END-OF-FILE
MOVE A,TPIEOF
RETURN
; *** BUFFERED I/O ROUTINES ***
; TPICNT - NUMBER OF 16-BIT INTEGERS IN BUFFER
; TPIBFP - ABPTR TO NEXT 16-BIT INTEGER IN BUFFER
; TPIBUF - THE BUFFER
; TPIEOF - -1 IF END-OF-FILE
TPR1: SOSL TPICNT
RTN
TPREAD: MOVEI A,2*TPIBSZ
MOVEM A,TPICNT
MOVE A,[441000,,TPIBUF]
MOVEM A,TPIBFP
MOVEI A,TPIBUF
HRLI A,-TPIBSZ
AOS CURBLOCK
.IOT TAPIN,A
JUMPGE A,TPR1
HLRES A
ADDI A,TPIBSZ
JUMPE A,TPR2 ; END OF FILE
LSH A,1
MOVEM A,TPICNT
GO TPR1
TPR2: SETOM TPIEOF
SETZM TPIBUF
RTN
FLUSH8: MOVEI A,2*TPBFSZ ; FLUSH (MAYBE UNFILLED) BUFFER
SUB A,TPICNT
ADDI A,1
LSH A,-1
MOVN A,A
HRLZ A,A
SKIPA
WRTAPE: HRLZI A,-TPBFSZ ; THIS IS SKIPPED FROM FLUSH8
HRRI A,TPIBUF
.IOT TAPIN,A ; WRITE BUFFER
MOVEI A,2*TPBFSZ-1
MOVEM A,TPICNT
MOVE A,[442000,,TPIBUF]
MOVEM A,TPIBFP
RTN
; *** BUFFERED I/O VARIABLES ***
.UDATA
TAPECH: BLOCK 1 ; 0 - CLOSED
; 1 - OPEN FOR READ
; -1 - OPEN FOR WRITE
TPICNT: BLOCK 1 ; TAPE I/O VARIABLES
TPIBFP: BLOCK 1
TPIEOF: BLOCK 1
TPIBUF: BLOCK TPBFSZ
MDATA CURBLOCK
BLOCK 1
MDATA CHECKSUM
BLOCK 1
MDATA CHARINBUF
BLOCK 1
END


111
arc/ar2:clib/C10TMM CMID Normal file
View File

@@ -0,0 +1,111 @@
;
; C10TMM - Program to determine the timing constants for
; the C timing package (C10TMR). The computed
; times are left in TIME1, TIME2, TIME3. Times
; are in nanoseconds.
;
; This file is ITS dependent.
; This is a stand-alone program.
;
A==1
B==2
C==3
D==4
P==17
CL==PUSHJ P,
RTN==POPJ P,
GO==JRST
.CCALL==1_27.
TP"=16 ; TIME STACK POINTER
%TPROC==0 ; THE PROCEDURE POINTER
%TNAME==1 ; THE PROCEDURE NAME (SNARFED FROM PROCEDURE)
%TNCAL==2 ; THE NUMBER OF CALLS
%TTIME==3 ; THE TOTAL AMOUNT OF ACCUMULATED TIME
%TSIZE==4 ; SIZE OF TIME TABLE ENTRY
%FTABL==0 ; POINTER TO TIME TABLE ENTRY
%FTIME==1 ; ACCUMULATED OR START TIME
%FRTNA==2 ; ACTUAL RETURN ADDRESS
%FSIZE==3 ; SIZE OF STACK FRAME
TIME1: 0
TIME2: 0
TIME3: 0
TIME4: 0
START: MOVE P,[-2000,,PDL]
MOVE A,[JSR UUOH]
MOVEM A,41
.SUSET [24,,TIME1]
CL TSUSET
.SUSET [24,,TIME2]
CL TUUO
.SUSET [24,,TIME3]
CL TEPILOG
.SUSET [24,,TIME4]
MOVE A,TIME2
SUB A,TIME1
IMULI A,4069.
IDIVI A,1000.
MOVEM A,TIME1
MOVE A,TIME3
SUB A,TIME2
IMULI A,4069.
IDIVI A,1000.
MOVEM A,TIME2
MOVE A,TIME4
SUB A,TIME3
IMULI A,4069.
IDIVI A,500.
MOVEM A,TIME3
SETZM TIME4
.VALUE
TSUSET: REPEAT 1000.,[.SUSET [24,,C]
]
RTN
TUUO: REPEAT 1000.,[
.CCALL 2,0
]
RTN
UUOH: 0
GO UUO$HANDLER
UUO$HANDLER:
MOVEM D,USAVED
LDB D,[330500,,ZERO]
GO @UUOH(D)
USAVED: 0
ZERO: 0
BAR: -1
BAR2: 0
0
0
BAR3: 0
0
0
0
TEPILOG:
MOVEI TP,BAR2
MOVEI B,BAR3
MOVEI A,0
REPEAT 500.,[
MOVE 0,C
SUBI C,37
SUB C,%FTIME(TP)
MOVE C,%FTABL(TP)
ADDM C,%TTIME(B)
SUBI TP,%FSIZE
ADDI 0,37
SUBM 0,%FTIME(TP)
GO @[.+1](A) ; TO NEXT LOCATION
]
RTN
PDL: BLOCK 2000
END START

150
arc/ar2:clib/C10TMR CMID Normal file
View File

@@ -0,0 +1,150 @@
;
; TIMER - Version of runtime to time procedure calls
;
; This file is ITS dependent.
; (Dependency is system-call to get runtime.)
;
TITLE TIMER
.INSRT NC
.INSRT NM
TIMSIZ==1000.
IF1,[
KLFLAG==0
PRINTX \KL10 (YES/NO)? \
.TTYMAC TIMEQ
IFSE TIMEQ,YES,KLFLAG==1
TERMIN
]
TP"=16 ; TIME STACK POINTER
; TIME TABLE ENTRY WORDS
%TPROC==0 ; THE PROCEDURE POINTER
%TNAME==1 ; THE PROCEDURE NAME (SNARFED FROM PROCEDURE)
%TNCAL==2 ; THE NUMBER OF CALLS
%TTIME==3 ; THE TOTAL AMOUNT OF ACCUMULATED TIME
%TSIZE==4 ; SIZE OF TIME TABLE ENTRY
; TIME STACK FRAME WORDS
%FTABL==0 ; POINTER TO TIME TABLE ENTRY
%FTIME==1 ; ACCUMULATED OR START TIME
%FRTNA==2 ; ACTUAL RETURN ADDRESS
%FSIZE==3 ; SIZE OF STACK FRAME
; TIMING CONSTANTS (IN NANOSECONDS)
; COMPUTED BY PROGRAM 'TTIMM'
IFE KLFLAG,[
SUSTIM==387909. ;TIME FOR .SUSET
UUOTIM==27929. ;TIME FOR UUO DISPATCH
EPITIM==30891. ;TIME FOR EPILOG
]
IFN KLFLAG,[
SUSTIM==71630.
UUOTIM==3373.
EPITIM==4663.
]
;
; .CCALL HANDLER (TIMING VERSION)
;
IENTRY UTCALL
.SUSET [24,,C] ; JOB ACCUMULATED TIME TO C
SKIPN TIMING" ; IS TIMING ON ?
GO UT$1 ; NO, RESUME NORMAL OPERATION
SUBI C,<UUOTIM+SUSTIM>/4069.
; FUDGE FOR SUSET AND TIME IT TOOK
; TO GET HERE
SUBM C,%FTIME(TP) ; DETERMINE CALLER'S ACCUMULATED TIME
ADDI TP,%FSIZE ; ALLOCATE NEW TIME FRAME
HRRZ B,40 ; CALLED ROUTINE
HRRZ D,-1(B) ; TIMTAB POINTER OR PROC NAME
CAIGE D,TIMTAB ; IS IT A TIMTAB POINTER?
GO UT$3 ; NO
CAMGE D,TIMEP ; IS IT A TIMTAB POINTER?
GO UT$2 ; YES
UT$3: MOVE A,D ; PROC NAME
MOVE D,TIMEP ; FIRST TIMED CALL OF ROUTINE
CAML D,ETIMEP ; IS TIME TABLE FULL?
GO UT$1 ; YES, IGNORE THIS CALL
MOVEM B,%TPROC(D) ; NO - INITIALIZE NEW TIMTAB ENTRY
MOVEM A,%TNAME(D)
SETZM %TTIME(D)
SETZM %TNCAL(D)
HRRM D,-1(B) ; PUT PTR TO TIMTAB ENTRY IN NAME WORD
MOVEI C,%TSIZE
ADDM C,TIMEP ; ADVANCE POINTER TO NEXT FREE ENTRY
UT$2: ; HERE WITH PTR TO TIMTAB ENTRY IN D
MOVEM D,%FTABL(TP) ; STORE POINTER IN TIME STACK
AOS %TNCAL(D) ; INCREMENT USE COUNT
UT$1: ; CONTINUE WITH CALL PROCESSING
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UCBAD" ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UCBAD ; NO, NOT A PROCEDURE
LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
SUB 0,B ; NUMBER OF ARGS NOT GIVEN
JUMPL 0,CODE [ ; TOO MANY ARGS GIVEN
ADD P,0 ; POP OFF EXTRA ARGS
GO UTDOIT ; MAKE THE CALL
]
UTLOOP: SOJL 0,UTDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UTLOOP ; LOOP
UTDOIT: SKIPN TIMING
GO UT$4
MOVE B,UUOH ; RETURN ADDRESS
MOVEM B,%FRTNA(TP) ; SAVE IT
MOVEI B,%FTIME(TP) ; CONSTRUCT .SUSET
HRLI B,24 ; GET START TIME FOR CALLED PROC
.SUSET B ; AND STORE IN TIME STACK FRAME
PUSHJ P,(C) ; CALL PROCEDURE
.SUSET [24,,C] ; JOB ACCUMULATED TIME
MOVE 0,C
SUBI C,SUSTIM/4069. ; FUDGE FOR .SUSET TIME
SUB C,%FTIME(TP) ; SUBTRACT START TIME
MOVE B,%FTABL(TP) ; TIMTAB ENTRY POINTER
ADDM C,%TTIME(B) ; ADD TO ACCUMULATED TIME FOR CALLEE
SUBI TP,%FSIZE ; POP TIME STACK FRAME
ADDI 0,<EPITIM>/4069. ; FUDGE
SUBM 0,%FTIME(TP) ; ADJUST START TIME OF CALLER
GO @%FRTNA+%FSIZE(TP) ; RETURN TO CALLER
UT$4: PUSH P,UUOH"
GO (C)
IENTRY TINIT
SETOM TIMING"
MOVEI A,UTCALL
MOVEM A,UUOTAB"+1
MOVEI TP,TIMSTK
MOVEM TP,TPINIT"
MOVEI A,TPRT"
MOVEM A,EXITER"
GO LINIT"
.IDATA
MDATA TIMEP
TIMTAB
MDATA ETIMEP
TIMTAB+<TIMSIZ*%TSIZE>
.UDATA
MDATA TIMTAB
BLOCK TIMSIZ*%TSIZE
MDATA TIMSTK
BLOCK TIMSIZ
END


152
arc/ar2:clib/C10TPR C Normal file
View File

@@ -0,0 +1,152 @@
# include "clib/c.defs"
# include "clib/its.bits"
/**********************************************************************
C10TPR - Printing Routine for C Timer Package
*ITS*
**********************************************************************/
# rename null "$NULL$"
# rename timing "TIMING"
# rename timtab "TIMTAB"
# rename timep "TIMEP"
# rename tprt "TPRT"
struct _tentry {int *proc, pname, count, time;};
# define tentry struct _tentry
extern int timing;
extern tentry timtab[], *timep;
extern int cout;
/* All times are kept in machine-dependent Units
and converted upon output to the appropriate
units.
*/
tprt ()
{int fout, /* output file */
total_time, /* total CPU time used */
smallest, /* smallest average time */
time, /* time used by current routine */
average, /* average time of current routine */
percent, /* percentage CPU time, current routine */
cpercent, /* cumulative percentage CPU time */
ctime, /* cumulative CPU time */
count, /* number of calls, current routine */
ncalls, /* total number of calls */
namep, /* pointer to current routine name */
nulltime, /* time to call null routine */
t,
c;
tentry *ip, *ip1;
t = rsuset (URUNT);
c = 50;
timing = -1;
while (--c >= 0)
{null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
null ();
}
timing = 0;
fout = copen ("timer.output", 'a');
if (fout<0) fout = copen ("timout", 'w');
if (fout<0) fout = cout;
cprint (fout, "\n\n\n *** TIMING INFORMATION ***\n\n");
cprint (fout, "TIME(usec) PERCENT CUM. %% NO. CALLS AVG. TIME ROUTINE NAME\n\n");
/* null entry should be last */
--timep;
nulltime = timep->time / timep->count;
/* sort entries in order of decreasing CPU time used */
for (ip=timtab;ip<timep;++ip)
for (ip1 = ip+1;ip1<timep;++ip1)
if (ip1->time > ip->time)
bswap (ip, ip1, 4);
total_time = 0;
for (ip=timtab;ip<timep;++ip)
total_time =+ ip->time;
ncalls = 0;
smallest = 10000; /* big number */
ctime = 0;
for (ip=timtab;ip<timep;++ip)
{time = ip->time;
ctime =+ time;
percent = (time * 1000) / total_time;
cpercent = (ctime * 1000) / total_time;
count = ip->count;
ncalls =+ count;
namep = (ip->pname) | 0440700000000;
average = time/count;
if (average<smallest && average>0) smallest=average;
cprint (fout, "%10d%8d.%1d%8d.%1d",
u2mic (time), percent/10, percent%10,
cpercent/10, cpercent%10);
cprint (fout, "%11d%12d ", count, u2mic (average));
while (c = ildb (&namep)) cputc (c, fout);
cputc ('\n', fout);
}
if (smallest<nulltime) nulltime=smallest;
time = ncalls * nulltime;
percent = (time * 1000) / total_time; /* percent * 10 */
cprint (fout, "\nTOTAL TIME = %d MSEC.\n", u2mil (total_time));
cprint (fout, "PROC. CALL TIME = %d USEC.\n", u2mic (nulltime));
cprint (fout, "NO. CALLS = %d\n", ncalls);
cprint (fout, "EST. CALL OVERHEAD = %d.%d %%\n",
percent/10, percent%10);
cclose (fout);
}
u2mil (t) /* convert Units to Milliseconds */
{return ((t * 407) / 100000);}
u2mic (t) /* convert Units to Microseconds */
{return ((t * 407) / 100);}
bswap (p, q, n) int *p, *q;
{int t;
while (--n >= 0)
{t = *p;
*p++ = *q;
*q++ = t;
}
}
null () {;}


376
arc/ar2:clib/C10TTY C Normal file
View File

@@ -0,0 +1,376 @@
/*
* C TTY Package
*
* routines:
*
* tyiopn - open TTY input channel
* tyi - read char from TTY (buffered)
* utyi - read char from TTY (unbuffered)
* get_buf - read string from TTY
* setprompt - set default TYI prompt string
* tyoopn - open TTY output channel
* tyo - output char to TTY (buffered)
* utyo - output char to TTY (unbuffered)
* spctty - output display code (unbuffered)
* tyos - output string to TTY (buffered)
* tyo_flush - flush TTY output buffer
*
* global variables:
*
* ttynp - ^L handler
*
* internal routines:
*
* ttyih - TTY interrupt handler
* ctrlch - return display width of char
*
*/
# include "c.defs"
# define tty_input_buffer_size 120
# define tty_output_buffer_size 60
# rename tty_input_channel "TYICHN"
# rename tty_output_channel "TYOCHN"
# rename tty_device_code "TTYDEV"
# rename tty_input_buffer "TYIBUF"
# rename tty_input_ptr "TYIPTR"
# rename tty_input_count "TYICNT"
# rename tty_output_buffer "TYOBUF"
# rename tty_output_ptr "TYOPTR"
# rename tty_output_count "TYOCNT"
# rename tty_output_bptr "TYOBPT"
# rename tty_default_prompt "TTYDPR"
int tty_input_channel -1;
int tty_output_channel -1;
int tty_device_code -1;
char tty_input_buffer[tty_input_buffer_size];
char *tty_input_ptr;
int tty_input_count;
char tty_output_buffer[tty_output_buffer_size];
char *tty_output_ptr {tty_output_buffer};
int tty_output_count;
int tty_output_bptr;
char *tty_default_prompt;
int ttxnp(); /* default TTY ^L handler */
int (*ttynp)() {ttxnp}; /* called on ^L */
/**********************************************************************
TYI - Read Character From TTY (buffered)
**********************************************************************/
tyi ()
{while (tty_input_count <= 0)
{if (tty_input_channel < 0) tyiopn ();
tty_input_count = get_buf (tty_input_buffer,
tty_input_buffer_size, '\r', "");
tty_input_ptr = tty_input_buffer;
if (tty_input_count == 0) return (0);
}
--tty_input_count;
return (*tty_input_ptr++);
}
/**********************************************************************
UTYO - output character to TTY (unbuffered)
**********************************************************************/
utyo (c)
{if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (tty_output_count > 0) tyo_flush ();
c =& 0177;
if (c != 16) uoiot (tty_output_channel, c);
else
{uoiot (tty_output_channel, '^');
uoiot (tty_output_channel, 'P');
}
}
}
/**********************************************************************
TYO - output character to TTY
**********************************************************************/
tyo (c)
{c =& 0177;
if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (c != 16) {*tty_output_ptr++ = c; ++tty_output_count;}
else
{*tty_output_ptr++ = '^';
*tty_output_ptr++ = 'P';
tty_output_count =+ 2;
}
if (c=='\r' || tty_output_count >= tty_output_buffer_size-2)
tyo_flush ();
}
}
/**********************************************************************
TYO_FLUSH - flush TTY output buffer
**********************************************************************/
tyo_flush ()
{if (tty_output_channel >= 0 && tty_output_count > 0)
{siot (tty_output_channel, tty_output_bptr,
tty_output_count);
tty_output_ptr = tty_output_buffer;
tty_output_count = 0;
}
}
/**********************************************************************
TYOS - Output String to TTY
**********************************************************************/
tyos (s) char s[];
{int c;
while (c = *s++) tyo (c=='\n' ? '\r' : c);
}
/**********************************************************************
SPCTTY - Send "special" display control character to TTY.
**********************************************************************/
spctty (c)
{if (tty_output_channel >= 0 || tyoopn() >= 0)
{if (tty_output_count > 0) tyo_flush ();
uoiot (tty_output_channel, 16);
uoiot (tty_output_channel, c);
}
}
/**********************************************************************
UTYI - read character from TTY (unbuffered and unechoed)
**********************************************************************/
int utyi ()
{if (tty_input_channel<0) tyiopn ();
if (tty_output_count > 0) tyo_flush ();
return (uiiot (tty_input_channel));
}
/**********************************************************************
GET_BUF - Read characters from TTY until end-of-file
simulated or given break character seen.
Read characters into given buffer, including
the terminating break character (if any).
Return a count of the number of characters
placed in the buffer. The given prompt string
will be printed first; it will be reprinted
when ^L is typed.
**********************************************************************/
int get_buf (buf, buf_size, break_ch, prompt) char buf[], prompt[];
{char *p, *q, pbuf[tty_output_buffer_size];
int i, c, j;
if (tty_input_channel<0) tyiopn ();
if (!prompt[0]) /* no explicit prompt */
{if (tty_output_count > 0) /* use partial output line */
{tty_output_buffer[tty_output_count] = 0;
stcpy (tty_output_buffer, pbuf);
prompt = pbuf;
}
else if (tty_default_prompt) /* use default */
prompt = tty_default_prompt;
}
if (prompt != pbuf) tyos (prompt);
if (tty_output_count > 0) tyo_flush ();
p = buf;
i = 0; /* number of chars in buffer */
while (TRUE)
{c = uiiot (tty_input_channel);
if (c != break_ch) switch (c) {
case 0177: /* rubout - delete prev char */
if (i>0)
{c = *--p;
--i;
if (tty_device_code==2) /* display */
{if (c=='\r')
{spctty ('U');
q = p;
while ((c = *--q) != '\r' &&
q>=buf)
{j = ctrlch(c);
while (--j>=0) spctty ('F');
}
if (q<buf)
{q = prompt;
while (*q) ++q;
while ((c = *--q) != '\n' &&
q>=prompt)
{j = ctrlch(c);
while (--j>=0) spctty ('F');
}
}
}
else
{j = ctrlch(c);
while (--j>=0) spctty ('X');
}
}
else utyo (c);
}
continue;
case '\p': /* redisplay buffer */
*p = 0;
(*ttynp) (tty_device_code==2, prompt, buf);
continue;
case 0: /* simulate end-of-file */
q = buf;
while (q < p) {if (*q == '\r') *q = '\n'; ++q;}
return (i);
case '\n': /* ignore - dont want to echo it */
continue;
default: if (i <= buf_size - 2)
{++i;
utyo (*p++ = c);
}
else utyo (07); /* beep */
continue;
}
break;
}
utyo ('\r');
*p++ = c;
q = buf;
while (q < p) {if (*q == '\r') *q = '\n'; ++q;}
return (i+1);
}
/**********************************************************************
TTXNP - Default TTY ^L handler
**********************************************************************/
ttxnp (display, prompt, buf)
int display;
char *prompt, *buf;
{if (display) spctty ('C'); else tyo ('\r');
tyos (prompt);
tyos (buf);
tyo_flush ();
}
/**********************************************************************
TTYIH - TTY Input Interrupt Handler
**********************************************************************/
ttyih ()
{int c;
c = ityic (tty_input_channel);
if (c == 023) signal (ctrls_interrupt);
else if (c == 007) signal (ctrlg_interrupt);
}
/**********************************************************************
TYIOPN - Open TTY for INPUT.
**********************************************************************/
channel tyiopn()
{int block[3];
if (tty_input_channel < 0)
tty_input_channel = fopen ("/tty", 0);
on (ttyi_interrupt, ttyih);
ttyget (tty_input_channel, block);
block[0] = 020202020202;
block[1] = 030202020202;
ttyset (tty_input_channel, block);
tty_device_code = status (tty_input_channel) & 077;
return (tty_input_channel);
}
/**********************************************************************
TYOOPN - Open TTY for OUTPUT.
**********************************************************************/
channel tyoopn()
{int i;
if (tty_output_channel < 0)
{tty_output_channel = fopen ("/tty", 021);
i = tty_output_buffer;
i =| 0444400000000;
tty_output_bptr = i;
}
return (tty_output_channel);
}
/**********************************************************************
CTRLCH - Return the number of characters a character
prints as.
**********************************************************************/
int ctrlch (c)
{if (c==0177) return (2);
if (c>=' ' || c==033 || c=='\t') return (1);
if (c=='\b' || c==07) return (0);
return (2);
}
/**********************************************************************
SETPROMPT - Set Default Input Prompt String
**********************************************************************/
setprompt (s)
char *s;
{tty_default_prompt = s;}


217
arc/ar2:clib/CFLOAT CMID Normal file
View File

@@ -0,0 +1,217 @@
;
; CFLOAT - FLOATING POINT STUFF
;
; This file is PDP-10 dependent, system-independent.
;
TITLE CFLOAT
.INSRT NC
.INSRT NM
; CONTAINS: LOG, EXP, COS, SIN, ATAN, SQRT, DTRUNCATE, DROUND, DABS
CENTRY LOG,[V]
MOVE B,V
JUMPLE B,OUTRNG
LDB D,[331100,,B] ;GRAB EXPONENT
SUBI D,201 ;REMOVE BIAS
TLZ B,777000 ;SET EXPONENT
TLO B,201000 ; TO 1
MOVE A,B
FSBR A,SQRT2
FADR B,SQRT2
FDVB A,B
FMPR B,B
MOVE C,[0.434259751]
FMPR C,B
FADR C,[0.576584342]
FMPR C,B
FADR C,[0.961800762]
FMPR C,B
FADR C,[2.88539007]
FMPR C,A
FADR C,[0.5]
MOVE B,D
FSC B,233
FADR B,C
FMPR B,[0.693147180] ;LOG E OF 2
MOVE A,B
RETURN
CENTRY EXP,[V]
MOVE B,V
PUSH P,B
MOVM A,B
SETZM B
FMPR A,[0.434294481] ;LOG BASE 10 OF E
MOVE D,[1.0]
CAMG A,D
GO RATEX
MULI A,400
ASHC B,-243(A)
CAILE B,43
GO OUTRNG
CAILE B,7
GO EXPR2
EXPR1: FMPR D,FLOAP1(B)
LDB A,[103300,,C]
SKIPE A
TLO A,177000
FADR A,A
RATEX: MOVEI B,7
SETZM C
RATEY: FADR C,COEF2-1(B)
FMPR C,A
SOJN B,RATEY
FADR C,[1.0]
FMPR C,C
FMPR D,C
MOVE B,[1.0]
SKIPL (P) ;SKIP IF INPUT NEGATIVE
SKIPN B,D
FDVR B,D
MOVE A,B
SUB P,[1,,1]
RETURN
EXPR2: LDB D,[030300,,B]
ANDI B,7
MOVE D,FLOAP1(D)
FMPR D,D ;TO THE 8TH POWER
FMPR D,D
FMPR D,D
GO EXPR1
COEF2: 1.15129278
0.662730884
0.254393575
0.0729517367
0.0174211199
2.55491796^-3
9.3264267^-4
FLOAP1: 1.0
10.0
100.0
1000.0
10000.0
100000.0
1000000.0
10000000.0
OUTRNG: CROAK [ARGUMENT OUT OF RANGE]
GO RTN1
CENTRY COS,[V]
MOVE B,V
FADR B,[1.570796326] ;COS(X)=SIN (X+PI/2)
CALL SIN,[B]
RTN1: RETURN
CENTRY SIN,[V]
MOVE B,V
CL .SIN
RETURN
.SIN: MOVM A,B
CAMG A,[.0001]
RTN ;GOSPER'S RECURSIVE SIN.
FDVR B,[-3.0] ;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3)
CL .SIN
FSC A,1
FMPR A,A
FADR A,[-3.0]
FMPRB A,B
RTN
CENTRY SQRT,[V]
MOVE B,V
MOVE A,B
ASH B,-1
FSC B,100
SQ2: MOVE C,B ;NEWTON'S METHOD, SPECINER'S HACK.
FDVRM A,B
FADRM C,B
FSC B,-1
CAME C,B
GO SQ2
MOVE A,B
RETURN
CENTRY ATAN,[V],[TEMP]
MOVE B,V
MOVEM B,TEMP
MOVM D,B
CAMG D,[0.4^-8] ;SMALL ENOUGH SO ATAN(X)=X?
GO ATAN3 ;YES
CAML D,[7.0^7] ;LARGE ENOUGH SO THAT ATAN(X)=PI/2?
GO ATAN1 ;YES
MOVN C,[1.0]
CAMLE D,[1.0] ;IS ABS(X)<1.0?
FDVM C,D ;NO,SCALE IT DOWN
MOVE B,D
FMPR B,B
MOVE C,[1.44863154]
FADR C,B
MOVE A,[-0.264768620]
FDVM A,C
FADR C,B
FADR C,[3.31633543]
MOVE A,[-7.10676005]
FDVM A,C
FADR C,B
FADR C,[6.76213924]
MOVE B,[3.70925626]
FDVR B,C
FADR B,[0.174655439]
FMPR B,D
JUMPG D,ATAN2 ;WAS ARG SCALED?
FADR B,PI2 ;YES, ATAN(X)=PI/2-ATAN(1/X)
GO ATAN2
ATAN1: MOVE B,PI2
ATAN2: SKIPGE TEMP ;WAS INPUT NEGATIVE?
MOVNS B ;YES,COMPLEMENT
ATAN3: MOVE A,B
RETURN
SQRT2: 1.41421356
PI2: 3.1415926535/2
CENTRY DROUND,[V]
MOVE A,V
FADR A,[.499999]
JUMPL A,ROUND1
UFA A,[233000000000]
TLZ B,777000
GO ROUND2
ROUND1: UFA A,[233000000000]
TLO B,777000
ROUND2: MOVE A,B
RETURN
CENTRY DTRUNCATE,[V]
MOVE A,V
UFA A,[233000000000]
TLZ B,777000
MOVE A,B
RETURN
CENTRY DABS,[V]
MOVE A,V
JUMPGE A,RET
MOVN A,A
JUMPGE A,RET
TLZ A,400000
RET: RETURN
END


15
arc/ar2:clib/CLIB H Normal file
View File

@@ -0,0 +1,15 @@
/* Handy definitions */
#define OPENLOSS (-1) /* Returned by COPEN if open fails */
typedef int SIXBIT; /* Six characters packed in one word */
typedef struct { /* ITS filespec in sixbit */
SIXBIT dev, /* Device */
fn1, /* First filename */
fn2, /* Second filename */
dir; /* Directory */
} FILESPEC;
#define TRUE 1
#define FALSE 0

208
arc/ar2:clib/CLIB LIST Normal file
View File

@@ -0,0 +1,208 @@
/*
CLIB LIST - List of some C routines contained in the
shared library.
*** TYPE DEFINITIONS ***
1. SIXBIT A word containing left-justified SIXBIT
characters.
2. FILESPEC A block of four SIXBIT words, representing
an ITS file specification.
*/
# define sixbit int
struct _filespec {sixbit dev, fn1, fn2, dir;};
# define filespec struct _filespec
/**********************************************************************
PARAMETER AND RETURNED VALUE TYPE DEFINITIONS
*/
char c; /* an ASCII character */
int i; /* an integer */
int *p; /* an integer pointer */
int b; /* a boolean */
char *s, *s1, *s2; /* strings */
int rc; /* a return code,
zero if OK, non-zero otherwise */
char *fn; /* a string representing an ITS file
name or a path name */
int fd; /* a "file descriptor," used by the
portable I/O stuff */
char c6; /* a SIXBIT character */
sixbit w; /* a SIXBIT word */
filespec *f; /* a pointer to a FILESPEC block */
int ch; /* an ITS channel or (returned) negative
ITS failure code */
int fdate; /* date as stored in ITS file dir */
int pg; /* a page number */
int *pbp; /* pointer to a PDP-10 byte pointer */
/**********************************************************************
A LISTING OF THE ROUTINES
*/
/* "Portable" I/O Routines */
fd = copen (fn, mode, options); /* open file */
/* mode is either
'r' - read
'w' - write
'a' - append
options is usually omitted
but "s" means I/O to string (pass string as fn)
and "b" means binary I/O
returns -1 if open fails
*/
extern int cin; /* standard input - pre-existing */
extern int cout; /* standard output - pre-existing */
extern int cerr; /* standard error ouput - pre-existing */
c = cgetc (fd); /* get character; returns 0 if eof */
c = cputc (c, fd); /* put character */
b = ceof (fd); /* test for end of file */
cclose (fd); /* close file */
c = getchar (); /* equivalent to cgetc(cin) */
putchar (c); /* equivalent to cputc(c,cout) */
gets (s1); /* read string (line) from cin */
puts (s1); /* put string and newline to cout */
cprint (fd, format, arg...); /* formatted print routine */
/* the format is a string which may contain format items
of the form %nf, where n is an optional decimal integer
(the minimum field width) and f is one of the following
characters:
d - print next arg (an integer) in decimal
o - print next arg (an integer) in octal
s - print next arg (a string)
c - print next arg (a character)
The file descriptor FD can be omitted, in which case
COUT is used.
*/
i = cgeti (fd); /* get integer (binary input) */
i = cputi (i, fd); /* put integer (binary output) */
cexit (cc); /* terminate job, closing all files */
/* returning from "main" is equivalent */
b = istty (fd); /* test if file is a TTY */
ch = itschan (fd); /* return actual ITS channel */
/* STRING Routines */
i = slen (s); /* find string length */
stcpy (s1, s2); /* copy string from S1 to S2 */
b = stcmp (s1, s2); /* compare strings */
/* SIXBIT Routines */
c6 = ccto6 (c); /* convert ASCII char to SIXBIT char */
c = c6toc (c6); /* convert SIXBIT char to ASCII char */
w = csto6 (s1); /* convert ASCIZ string to SIXBIT word */
c6tos (w, s1); /* convert SIXBIT word to ASCII string */
/* ITS Filename Routines */
fparse (s1,f); /* convert file name or path name to FILESPEC */
prfile (f,s1); /* convert FILESPEC to file name (ASCII string) */
/* ITS I/O Routines */
ch = mopen (f, mode); /* open file, handle TTY specially */
rc = mclose (ch); /* close channel, unless TTY */
spctty (c); /* output ^P code to TTY */
ch = fopen (s1, mode); /* open channel given filename or pathname,
if error return negative ITS failure code */
ch = open (f, mode); /* open channel given filespec
if error return negative ITS failure code */
delete (fname); /* delete the file named FNAME */
/* Byte Pointer Hacking */
ildb (pbp);
idpb (i, pbp);
/* Interfaces to ITS System Calls */
rc = sysopen (ch, f, mode); /* open specific channel, if error return
negative ITS failure code */
sysdel (f); /* delete the file specified by F */
ch = chnloc (); /* find an available channel */
rc = close (ch); /* close a channel */
uclose (ch); /* close a job */
i = status (ch); /* return channel status */
n = fillen (ch); /* return ITS file length */
access (ch, i); /* set file access pointer */
reset (ch); /* reset channel */
i = uiiot (ch); /* unit input IOT */
uoiot (ch, i); /* unit output IOT */
n_read = sysread (ch, p, n_words); /* block input IOT */
n_written = syswrite (ch, p, n_words); /* block output IOT */
fdate = rfdate (ch); /* read file creation date */
fdate = sfdate (ch, fdate); /* set file creation date */
w = rsname (); /* return SNAME */
w = runame (); /* return UNAME */
ssname (w); /* set SNAME */
sleep (n); /* sleep for n 30th seconds */
rc = sysload (job_ch, prog_ch); /* load program into job */
rc = atty (ch); /* give TTY to inferior */
rc = dtty (ch); /* take TTY from inferior */
valret (s); /* .VALUE a string (or 0) */
t = etime(); /* return system elapsed time in 1/60 sec units*/
t = cputm(); /* return job CPU time in 1/60 sec units */
t = getcpu(); /* return job CPU time in 4.096 usec units */
rc = corblk (mode, dest, destpg, src, srcpg);
cortyp (pg, &resultblock);
rc = pageid (idn, pg);
/* USET hacking */
what = rsuset (where);
what = wsuset (where, what);
what = ruset (who, where);
what = wuset (who, where, what);
/* TRANSL hacking */
rc = tranad (job, from_file_spec, to_file_spec, flags);
rc = trancl (job, flags);
rc = trandl (job, file_spec, flags);
/* storage allocation */
p = salloc (n); /* allocate n words, return pointer to it */
sfree (p); /* free storage allocated by salloc */
s = calloc (n); /* allocate n characters, return ptr to it */
cfree (s); /* free storage allocated by calloc */
/* interrupt hacking */
previous_handler = on (interrupt_number, new_handler);
signal (interrupt_number);
/* miscellaneous routines */
i = wfnz (p); /* wait for word pointed to by P to become
non-zero; then return that value */


47
arc/ar2:clib/CLIB PRGLST Normal file
View File

@@ -0,0 +1,47 @@
; CLIB PRGLST
; *ITS*
; This file is a Stinkr XFILE that lists the program files that make up the
; shared C library. It is used in the construction of a new library. It
; is also used to construct test versions of programs not using the shared
; library and to construct timing versions of programs (which cannot use
; the shared library).
; The following are ITS- dependent files from C10LIB:
l clib;c10cor
l clib;c10exp
l clib;c10fd
l clib;c10fil
l clib;c10fnm
l clib;c10fo
l clib;c10int
l clib;c10io
l clib;c10map
l clib;c10mio
l clib;c10pag
l clib;c10sys
l clib;c10tty
; The following are ITS-independent files from CLIB:
l clib;ac
l clib;alloc
l clib;apfnam
l clib;atoi
l clib;blt
l clib;cfloat
l clib;cprint
l clib;date
l clib;fprint
l clib;match
l clib;pr60th
l clib;random
l clib;stkdmp
l clib;string
l clib;uuoh
; This must be last:
l clib;c10run


8
arc/ar2:clib/CLIB STINKR Normal file
View File

@@ -0,0 +1,8 @@
; xfile for loading basic C library
; this file must be loaded first
; segment 0 must start at 100
s 100,n,p,n
i sinit
l clib;[crel] >


16
arc/ar2:clib/CLIB TESTER Normal file
View File

@@ -0,0 +1,16 @@
; CLIB TESTER
; *ITS*
; This file is a Stinkr XFILE to be used to construct test versions of
; programs that do not use the shared C library. Construction of such
; programs is useful to test changes to library routines prior to the
; construction of a new version of the library.
; This file must be XFILEd first.
; Segment 0 must start at 100.
s 100,n,p,n
i linit
x c;clib prglst


18
arc/ar2:clib/CLIB TIMER Normal file
View File

@@ -0,0 +1,18 @@
; CLIB TIMER
; *ITS*
; This file is a Stinkr XFILE to be used to construct timing versions of
; programs. The only difference from normal programs is that a different
; handler is used for the procedure call UUOs.
; This file must be XFILEd first.
; Segment 0 must start at 100.
s 100,100000,400000,600000
i tinit
l clib;c10tmr
l clib;c10tpr
x clib;clib prglst


35
arc/ar2:clib/CODE INSERT Normal file
View File

@@ -0,0 +1,35 @@
; MACROS FOR SEPARATE CODE LITERAL AREA
; THIS DOES NOT HANDLE RECURSIVE CALLS
CD%N==0
IF1,[CD%LOC==0]
DEFINE CD%AS *PREFIX*,#SEGNO,*SUFFIX*
PREFIX!SEGNO!SUFFIX
TERMIN
DEFINE CODE BODY
IF2,[ CD%AS/CD%LOC+CD%/,CD%N+1]
CD%N==CD%N+1
DOT==.-1
CD%OLC==.
IF1,[
BODY
CD%AS /CD%/,CD%N,/==CD%LOC/
CD%LOC==CD%LOC+<.-CD%OLC>
]
IF2,[
CD%AS /LOC CD%LOC+CD%/,CD%N
BODY
]
LOC CD%OLC
TERMIN
DEFINE INSCODE
IF1,[
CD%SIZ==CD%LOC
CD%LOC==.
BLOCK CD%SIZ
]
TERMIN

177
arc/ar2:clib/CPRINT C Normal file
View File

@@ -0,0 +1,177 @@
/*
CPRINT - C Formatted Print Routine
Extendable Format Version:
Print Routines should expect the following
arguments (n specified when defined):
1 to n: n data arguments
n+1: file descriptor
n+2: field width (0 if none given)
*/
# define WORDMASK 077777777777
# define SMALLEST "-34359738368"
extern int cin, cout, cerr;
int prc(), prd(), pro(), prs();
static int (*format_table[26]) () {
/* a */ 0, 0, prc, prd, 0, 0, 0, 0,
/* i */ 0, 0, 0, 0, 0, 0, pro, 0,
/* q */ 0, 0, prs, 0, 0, 0, 0, 0,
/* y */ 0, 0};
static int format_nargs [26] {
/* a */ 0, 0, 1, 1, 0, 0, 0, 0,
/* i */ 0, 0, 0, 0, 0, 0, 1, 0,
/* q */ 0, 0, 1, 0, 0, 0, 0, 0,
/* y */ 0, 0};
deffmt (c, p, n) int (*p)();
{if (c >= 'A' && c <= 'Z') c =+ ('a' - 'A');
if (c >= 'a' && c <= 'z')
{if (n >= 0 && n <= 3)
{format_table [c - 'a'] = p;
format_nargs [c - 'a'] = n;
}
else cprint (cerr, "bad nargs to DEFFMT: %d\n", n);
}
else cprint (cerr, "bad character to DEFFMT: %c\n", c);
}
cprint (a1,a2,a3,a4,a5,a6,a7,a8)
{int *adx, c, width;
char *fmt;
int fn, (*p)(), n;
if (cisfd(a1)) /* file descriptor */
{fn = a1;
fmt = a2;
adx = &a3;
}
else
{fn = cout;
fmt = a1;
adx = &a2;
}
while (c= *fmt++)
{if (c!='%') cputc (c,fn);
else
{width = 0;
while ((c = *fmt)>='0' && c<='9')
width = (width*10) + (*fmt++ - '0');
c = *fmt++;
if (c >= 'A' && c <= 'Z') c =+ ('a' - 'A');
if (c >= 'a' && c <= 'z')
{p = format_table [c - 'a'];
n = format_nargs [c - 'a'];
if (p)
{switch (n) {
case 0: (*p) (fn, width); break;
case 1: (*p) (adx[0], fn, width); break;
case 2: (*p) (adx[0], adx[1], fn, width); break;
case 3: (*p) (adx[0], adx[1], adx[2], fn, width); break;
}
adx =+ n;
continue;
}
cputc (c, fn);
}
else cputc (c, fn);
}
}
}
/**********************************************************************
PRO - Print Octal Integer
**********************************************************************/
pro (i, f, w)
{int b[30], *p, a;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
p = b;
while (a = ((i>>3) & WORDMASK))
{*p++ = (i&07) + '0';
i = a;
}
*p++ = i+'0';
if (i) *p++ = '0';
i = w - (p-b);
while (--i>=0) cputc (' ', f);
while (p > b) cputc (*--p, f);
}
/**********************************************************************
PRD - Print Decimal Integer
**********************************************************************/
prd (i, f, w)
{int b[30], *p, a, flag;
flag = 0;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
p = b;
if (i < 0) {i = -i; flag = 1;}
if (i < 0) {stcpy (SMALLEST, b); p = b+slen(b); flag = 0;}
else
{while (a = i/10)
{*p++ = i%10 + '0';
i = a;
}
*p++ = i+'0';
}
if (flag) *p++ = '-';
i = w - (p-b);
while (--i>=0) cputc (' ', f);
while (p > b) cputc (*--p, f);
}
/**********************************************************************
PRS - Print String
**********************************************************************/
prs (s, f, w) char *s;
{int i;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
i = (w > 0 ? w - slen (s) : 0);
while (--i >= 0) cputc (' ', f);
while (i = *s++) cputc (i, f);
}
/**********************************************************************
PRC - Print Character
**********************************************************************/
prc (c, f, w)
{int i;
if (!cisfd(f)) f = cout;
if (w<0 || w>200) w = 0;
i = w - 1;
while (--i >= 0) cputc (' ', f);
cputc (c, f);
}


39
arc/ar2:clib/CRATE 10 Normal file
View File

@@ -0,0 +1,39 @@
TITLE CRATE C LIBRARY DESECRATOR FOR VERSION 10
A==1
GO==JRST
.GLOBAL INIT,PAGENO,NPAGES,VERNAM
INIT: .VALUE [ASCIZ/: INITIALIZE IF NOT FOR VERSION 10 
 /]
.CALL [SETZ
SIXBIT/OPEN/
1000,,1 ; CHANNEL 1
[SIXBIT/DSK/]
[SIXBIT/[CLIB]/]
VERNAM
SETZ [SIXBIT/C/]
]
.VALUE [ASCIZ/: UNABLE TO GET LIBRARY FILE 
/]
MOVN A,NPAGES
HRLZ A,A
HRR A,PAGENO
.CALL [SETZ
'CORBLK
1000,,600000 ; READ-WRITE ACCESS
1000,,-1 ; PUT IN MY MAP
A ; AOBJN POINTER
401000,,1 ; FROM FILE
]
.VALUE [ASCIZ/: UNABLE TO MAP IN LIBRARY FILE 
/]
.CLOSE 1,
.VALUE [ASCIZ/: ALL SET 
:SL /]
GO .-1
PAGENO: 246. ; FIRST PAGE TO SMASH
NPAGES: 10. ; NUMBER OF PAGES TO SMASH
VERNAM: SIXBIT/10/ ; VERSION NUMBER IN SIXBIT
END INIT

40
arc/ar2:clib/CRATE 9 Normal file
View File

@@ -0,0 +1,40 @@
TITLE CRATE C LIBRARY DESECRATOR FOR VERSION 9
A==1
GO==JRST
.GLOBAL INIT,PAGENO,NPAGES,VERNAM
INIT: .VALUE [ASCIZ/: INITIALIZE IF NOT FOR VERSION 9 
 /]
.CALL [SETZ
SIXBIT/OPEN/
1000,,1 ; CHANNEL 1
[SIXBIT/DSK/]
[SIXBIT/[CLIB]/]
VERNAM
SETZ [SIXBIT/C/]
]
.VALUE [ASCIZ/: UNABLE TO GET LIBRARY FILE 
/]
MOVN A,NPAGES
HRLZ A,A
HRR A,PAGENO
.CALL [SETZ
'CORBLK
1000,,600000 ; READ-WRITE ACCESS
1000,,-1 ; PUT IN MY MAP
A ; AOBJN POINTER
401000,,1 ; FROM FILE
]
.VALUE [ASCIZ/: UNABLE TO MAP IN LIBRARY FILE 
/]
.CLOSE 1,
.VALUE [ASCIZ/: ALL SET 
:SL /]
GO .-1
PAGENO: 371 ; FIRST PAGE TO SMASH
NPAGES: 7 ; NUMBER OF PAGES TO SMASH
VERNAM: SIXBIT/9/ ; VERSION NUMBER IN SIXBIT
END INIT


17
arc/ar2:clib/CTYPE C Normal file
View File

@@ -0,0 +1,17 @@
# include "ctype.h"
# define S _S
# define N _N
# define L _L
# define U _U
char _ctype[] {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
S, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
N, N, N, N, N, N, N, N, N, N, 0, 0, 0, 0, 0, 0,
0, U, U, U, U, U, U, U, U, U, U, U, U, U, U, U,
U, U, U, U, U, U, U, U, U, U, U, 0, 0, 0, 0, 0,
0, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L,
L, L, L, L, L, L, L, L, L, L, L, 0, 0, 0, 0, 0};


16
arc/ar2:clib/CTYPE H Normal file
View File

@@ -0,0 +1,16 @@
#define _U 01
#define _L 02
#define _A 03
#define _N 04
#define _S 010
extern char _ctype[];
#define isalpha(c) (_ctype[c]&_A)
#define isupper(c) (_ctype[c]&_U)
#define islower(c) (_ctype[c]&_L)
#define isdigit(c) (_ctype[c]&_N)
#define isspace(c) (_ctype[c]&_S)
#define toupper(c) ((c)-'a'+'A')
#define tolower(c) ((c)-'A'+'a')


155
arc/ar2:clib/DATE C Normal file
View File

@@ -0,0 +1,155 @@
/*
DATE - Date Hacking Routines
These routines recognize three representations for dates:
(1) CAL - calender date, a system-independent representation
consisting of a record containing six integers
for the year, month, day, hour, minute, and second
(2) FDATE - the ITS date representation used in file directories
(3) UDATE - the UNIX date representation, seconds since
Jan 1, 1970, GMT.
(4) TDATE - the TOPS-20 date representation
The routines:
u2cal (udate, cd) - convert udate to cal
udate = cal2u (cd) - convert cal to udate
f2cal (fdate, cd) - convert fdate to cal
fdate = cal2f (cd) - convert cal to fdate
t2cal (tdate, cd)
tdate = cal2t (cd)
prcal (cd, fd) - print cal (CIO)
*/
# define ZONE 5 /* offset of local zone from GMT */
struct _cal {int year, month, day, hour, minute, second;};
# define cal struct _cal
static int month_tab1[] {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
static int month_tab2[] {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335};
static int year_tab[] {0, 365, 2*365, 3*365+1};
# define four_years (4*365+1)
static char *month_name[] {
"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
# rename srctab "SRCTAB"
u2cal (udate, cd) cal *cd;
{udate =- (ZONE*60*60);
cd->second = udate%60; udate =/ 60;
cd->minute = udate%60; udate =/ 60;
cd->hour = udate%24; udate =/ 24;
cd->year = 1970 + 4*(udate/four_years);
udate =% four_years;
cd->year =+ srctab (year_tab, 4, &udate);
cd->month = srctab (cd->year%4==0 ? month_tab2 : month_tab1,
12, &udate) + 1;
cd->day = udate + 1;
}
int cal2u (cd) cal *cd;
{int udate, year;
year = cd->year;
udate = cd->second + 60*(cd->minute + 60*(cd->hour + 24*(cd->day-1)));
udate =+ (year%4==0 ? month_tab2 : month_tab1) [cd->month-1] * 60*60*24;
year =- 1970;
if (year<0) year=0;
udate =+ 60*60*24*(four_years*(year/4) + year_tab[year%4]);
udate =+ (ZONE*60*60);
return (udate);
}
f2cal (fdate, cd) cal *cd;
{cd->year = 1900 + ((fdate>>27) & 0177);
if ((cd->month = (fdate>>23) & 017) > 12) cd->month = 0;
cd->day = (fdate>>18) & 037;
fdate = (fdate & 0777777) >> 1;
cd->second = fdate % 60;
fdate =/ 60;
cd->minute = fdate % 60;
cd->hour = fdate / 60;
}
int cal2f (cd) cal *cd;
{int fdate;
fdate = 2*(cd->second + 60*(cd->minute + 60*cd->hour));
fdate =| cd->day << 18;
fdate =| cd->month << 23;
fdate =| (cd->year - 1900) << 27;
return (fdate);
}
t2cal (tdate, cd) cal *cd;
{int vec[3], udate;
SYSODCNV (tdate, 0, vec);
cd->year = vec[0] >> 18;
cd->month = (vec[0] & 0777777) + 1;
cd->day = (vec[1] >> 18) + 1;
udate = vec[2] & 0777777;
cd->second = udate%60; udate =/ 60;
cd->minute = udate%60; udate =/ 60;
cd->hour = udate%24;
}
int cal2t (cd) cal *cd;
{char buf[100];
int f;
f = copen (buf, 'w', "s");
cprint (f, "%d/%d/%d %d:%d:%d", cd->month, cd->day, cd->year,
cd->hour, cd->minute, cd->second);
cclose (f);
return (SYSIDTIM (mkbptr (buf), 0));
}
prcal (cd, f) cal *cd;
{char *s;
int m;
m = cd->month-1;
if (m>=0 && m<=11) s = month_name[m];
else s = "?";
cprint (f, "%s%3d%5d ", s, cd->day, cd->year);
cputc (cd->hour/10+'0', f);
cputc (cd->hour%10+'0', f);
cputc (':', f);
cputc (cd->minute/10+'0', f);
cputc (cd->minute%10+'0', f);
cputc (':', f);
cputc (cd->second/10+'0', f);
cputc (cd->second%10+'0', f);
}
int srctab (tab, sz, n) int *tab, sz, *n;
{int *p, i;
p = tab+sz;
i = *n;
while (--p>=tab)
{if (*p <= i)
{*n = i - *p;
return (p-tab);
}
}
return (0);
}


90
arc/ar2:clib/FPRINT C Normal file
View File

@@ -0,0 +1,90 @@
#
/*
*
* FPRINT - Floating-Point Print Routine
*
* requires:
*
* i = dtruncate (d)
* i = dround (d)
* d = dabs (d)
* cputc (c, fd)
*
* internal routines and tables:
*
* fp3, fp4, fp5, fp6, ft0, ft1, ft10
*
*/
static double ft0[] {1e1, 1e2, 1e4, 1e8, 1e16, 1e32};
static double ft1[] {1e-1, 1e-2, 1e-4, 1e-8, 1e-16, 1e-32};
static double ft10[] {1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7};
double dabs ();
fprint (d, fd)
double d;
{if (d<0) {cputc ('-', fd); d = dabs (d);}
if (d>0)
{if (d < 1.0) {fp4 (d, 0, fd); return;}
else if (d >= 1e8) {fp4 (d, 1, fd); return;}
}
fp3 (d, fd);
}
fp3 (d, fd) /* print positive double */
double d;
{int i, n;
double fraction;
i = dtruncate (d);
fraction = d - i;
n = fp5 (i, fd); /* return # of digits printed */
cputc ('.', fd);
n = 8 - n;
fraction =* ft10[n];
i = dround (fraction);
fp6 (i, n, fd); /* prints n digits */
}
fp4 (d, flag, fd)
double d;
{int c, e;
c = 6;
e = 0;
while (--c >= 0)
{e =<< 1;
if (flag ? d >= ft0[c] : d <= ft1[c])
{++e;
d =* (flag ? ft1[c] : ft0[c]);
}
}
if (d < 1.0) {++e; d =* 10.0;}
fp3 (d, fd);
cputc ('e', fd);
cputc (flag ? '+' : '-', fd);
fp5 (e, fd);
}
int fp5 (i, fd) /* print decimal integer, return # of digits printed */
{int a;
if (a = i/10) a = fp5 (a, fd);
else a = 0;
cputc (i%10 + '0', fd);
return (a+1);
}
int fp6 (i, n, fd) /* print decimal integer given # of digits */
{if (n>0)
{if (n>1) fp6 (i/10, n-1, fd);
cputc (i%10 + '0', fd);
}
}


79
arc/ar2:clib/GETSRV C Normal file
View File

@@ -0,0 +1,79 @@
# include "c.defs"
/**********************************************************************
GETSRV - Lookup name in table of Arpanet Servers
Currently runs only on ITS machines (needs a particular file).
Requires upper case string.
**********************************************************************/
# define TABLESIZE 10000
int getsrv (s) char *s; /* return -1 if bad */
{static int *p;
int n, *nmtab;
/* first check for decimal host number */
n = atoi (s);
if (n > 0) return (n);
/* if not a number, must search the table of host names */
if (!p) /* host file not read in yet */
{int f, *q, *e;
char *ss;
p = calloc (TABLESIZE);
ss = "sysbin;hosts1 >";
f = copen (ss, 'r', "b");
if (f == OPENLOSS)
{cprint ("Unable to find host table: %s\n", ss);
return (-1);
}
e = p + TABLESIZE;
q = p;
while (!ceof (f) && q<e) *q++ = cgeti (f);
cclose (f);
}
nmtab = p+p[6]; /* name table */
n = *nmtab++;
while (--n >= 0)
{int nte, nm, bp;
nte = *nmtab++;
nm = nte & 0777777; /* index of name in table */
nm = p + nm; /* pointer to name in table */
bp = 0440700000000 | nm; /* byte pointer to name */
if (_gmatch (bp, s)) /* found entry */
{int num;
num = nte >> 18; /* index of numtab entry in table */
if (p[num+2]<0) /* it's a server */
return (p[num]);
return (-1);
}
}
return (-1);
}
_gmatch (bp, s) char *s;
{int c;
while (c = ildb (&bp))
if (c != *s++) return (FALSE);
return (*s == 0);
}
#ifdef testing
main ()
{char buf[100];
int n;
while (TRUE)
{cprint ("Enter name:");
gets (buf);
n = getsrv (buf);
cprint ("Name=%s,Number=%d\n", buf, n);
}
}
#endif


77
arc/ar2:clib/ITS BITS Normal file
View File

@@ -0,0 +1,77 @@
/* open modes */
# define UAI 0 /* unit ascii input */
# define UAO 1 /* unit ascii output */
# define BAI 2 /* block ascii input */
# define BAO 3 /* block ascii output */
# define UII 4 /* unit image input */
# define UIO 5 /* unit image output */
# define BII 6 /* block image input */
# define BIO 7 /* block image output */
# define OLD 010 /* open old job only */
/* user variables */
# define UPC 0
# define UTTY 02
# define UUNAME 04
# define UJNAME 05
# define USTOP 07
# define UPIRQ 010
# define UINF 011
# define USV40 013
# define UIPIRQ 014
# define UAPIRQ 015
# define USNAME 016
# define UPICLR 017
# define URUNT 024
# define UHSNAME 043
# define UOPTION 054
# define USUPPR 065
# define UXUNAME 074
# define UXJNAME 075
/* USTOP magic bit */
# define BUSRC 0100000000000
/* .OPTION bits */
# define OPTBRK 020000000000 /* can handle .BREAKs */
# define OPTCMD 040000000000 /* got command arg to give */
# define OPTOPC 000200000000 /* always reset PC on interrupt */
/* first word interrupt bits */
# define PJRLT 0200000000000 /* Real-time timer went off [3] (A) */
# define PJRUN 0100000000000 /* Run-time timer went off [3] (A) */
# define PJTTY 02000000000 /* Don't have TTY [2] (S) */
# define PJPAR 01000000000 /* Memory parity error [1] (A) */
# define PJFOV 0400000000 /* ARFOV (Floating overflow) [3] (S) */
# define PJWRO 0200000000 /* WIRO (Write in read-only page) [2] (S) */
# define PJFET 0100000000 /* Fetched insn from impure page [2] (S) */
# define PJTRP 040000000 /* SYSUUO (System uuo in trap mode) [2] (S) */
# define PJDBG 02000000 /* System being debugged state change [3] (A) */
# define PILOS 01000000 /* .LOSE */
# define PICLI 0400000 /* CLI interrupt [3] (A) */
# define PIPDL 0200000 /* PDL overflow [3] (S) */
# define PILTP 0100000 /* 340 or E&S light pen hit [3] (A) */
# define PIMAR 040000 /* MAR hit. [2] (S) */
# define PIMPV 020000 /* MPV (memory protect violation) [2] (S) */
# define PICLK 010000 /* Slow (1/2 sec) clock [3] (A) */
# define PI1PR 04000 /* Single-instruction proceed [1] (S) */
# define PIBRK 02000 /* .BREAK instruction executed. [1] (S) */
# define PIOOB 01000 /* Address out of bounds [2] (S) */
# define PIIOC 0400 /* IOCERR (I/O channel error) [2] (S) */
# define PIVAL 0200 /* .VALUE instruction executed [1] (S) */
# define PIDWN 0100 /* System-going-down status change [3] (A) */
# define PIILO 040 /* ILOPR, ILUUO (illegal operation) [2] (S) */
# define PIDIS 020 /* Display memory protect [2] (A) */
# define PIARO 010 /* Arithmetic overflow [3] (S) */
# define PIB42 04 /* BADPI (Bad location 42) [1] (S) */
# define PICZ 02 /* ^Z or CALL typed on terminal [1] (A) */
# define PITYI 01 /* TTY input (obsolete) [3] (A) */
# define IBACKUP (PJTTY|PJWRO|PJFET|PJTRP|PIMPV|PIOOB|PIIOC|PIILO)
/* interrupts where PC may need SOSing */


283
arc/ar2:clib/MAKLIB C Normal file
View File

@@ -0,0 +1,283 @@
# include "c.defs"
# include "its.bits"
/*
MAKLIB
*ITS*
Shared C Library Construction Program
Loads library stuff from TS CLIB into an inferior. Writes
pure part as a sharable file. Constructs a MIDAS program
to load the impure part and define all symbols.
*** Instructions for constructing a new version of the
shared C library:
1. Edit the file MKCLIB STINKR to contain all of the
files you want to be in the library. See that file
for further instructions.
2. Create a TS CLIB in the C directory by running Stinkr on
MKCLIB STINKR.
3. Create a TS MAKLIB using MAKLIB STINKR.
4. Run TS MAKLIB.
The STINKR files are kept in C10LIB.
*/
# define MAXSYMS 4000 /* maximum number of symbols */
# define NAMMASK 0037777777777 /* name mask away flags */
# define SYMMASK 0037777777777 /* symtab mask for name */
struct _syment {int sym, val;};
typedef struct _syment syment;
syment symtab[MAXSYMS];
syment *csymp, *esymp;
main (argc, argv) char *argv[];
{int flib, fmak, version, nam, val, npage, pgno, zeroc;
int j, jch, pch, ilo, ihi, plo, phi, count;
char svers[20], buf[50], vbuf[100];
filespec ff;
syment *p;
/* open library program file */
pch = fopen ("TS CLIB", UII);
if (pch < 0)
{puts ("Unable to find TS CLIB");
return;
}
/* create an inferior job */
j = j_create (020);
if (j < 0)
{puts ("Unable to create inferior job");
return;
}
j_name (j, &ff);
jch = open (&ff, UII);
if (jch < 0)
{puts ("Unable to open inferior job");
return;
}
/* load CLIB program into inferior */
if (sysload (jch, pch))
{puts ("Unable to load TS CLIB");
return;
}
rsymtab (pch);
flib = copen ("c/[clib].>", 'w', "b");
if (flib < 0)
{puts ("Unable to create library file");
return;
}
filnam (itschan (flib), &ff);
version = ff.fn2;
c6tos (version, svers);
apfname (buf, "c/[cmak].foo", svers);
fmak = copen (buf, 'w');
if (fmak < 0)
{puts ("Unable to create maker file");
cclose (flib);
delete ("c/clib.>");
return;
}
cprint ("Creating C library version %s\n", svers);
cprint (fmak, ";\tSHARED C LIBRARY MAKER -- VERSION %s\n\n", svers);
cprint (fmak, ".INSRT C;NC INSERT\n");
cprint (fmak, "TITLE CLIB C LIBRARY VERSION %s\n\n", svers);
p = symtab;
while (p < csymp)
{nam = p->sym;
val = p->val;
++p;
prname (nam, fmak, 0);
cprint (fmak, "\"=%o\n", val);
}
cputc ('\n', fmak);
/* now define impure area */
ilo = jread (lookup (rdname ("SEG0LO")), jch);
ihi = jread (lookup (rdname ("SEG1HI")), jch);
count = ihi - ilo + 1;
cprint (fmak, "\t.IDATA\n\n");
zeroc = 0;
access (jch, ilo);
while (--count >= 0)
{val = uiiot (jch);
if (val)
{if (zeroc>0) cprint (fmak, "\tBLOCK\t%o\n", zeroc);
zeroc = 0;
cprint (fmak, "\t%o\n", val);
}
else ++zeroc;
}
if (zeroc>0) cprint (fmak, "\tBLOCK\t%o\n", zeroc);
cputc ('\n', fmak);
plo = jread (lookup (rdname ("SEG2LO")), jch);
phi = jread (lookup (rdname ("SEG3HI")), jch);
phi =+ 0100;
plo =& ~01777;
npage = (phi - plo + 02000) >> 10;
pgno = plo >> 10;
cprint (fmak, "IPATCH\": BLOCK 40\n\
.CODE\n\
INIT\": MOVEI P,ARGV\n\
PUSHJ P,MAPIN\"\n\
MOVEI A,ZMAIN\"\n\
HRRM A,CALLER\"\n\
GO START\"\n\n\
MAPIN: .CALL [SETZ\n\
SIXBIT/OPEN/\n\
1000,,1 ; CHANNEL 1\n\
[SIXBIT/DSK/]\n\
[SIXBIT/[CLIB]/]\n\
[SIXBIT/%s/]\n\
SETZ [SIXBIT/C/]\n\
]\n\
.VALUE [ASCIZ/: UNABLE TO GET LIBRARY FILE /]\n\
MOVE A,[-%d.,,%o]\n\
.CALL [SETZ\n\
'CORBLK\n\
1000,,200000 ; READ-ONLY\n\
1000,,-1 ; PUT IN MY MAP\n\
A ; AOBJN POINTER\n\
401000,,1 ; FROM FILE\n\
]\n\
.VALUE [ASCIZ/: UNABLE TO MAP IN LIBRARY FILE /]\n\
.CLOSE 1,\n\
POPJ P,\n\n\
MAPOUT\":MOVE A,[-%d.,,%o]\n\
.CALL [SETZ\n\
'CORBLK\n\
1000,,0 ; DELETE\n\
1000,,-1 ; FROM ME\n\
400000,,A ; AOBJN POINTER\n\
]\n\
.VALUE [ASCIZ/: CAN'T MAP OUT LIBRARY PAGES /]\n\
POPJ P,\n\n\
SINIT\": MOVE A,[PUSHJ P,MAPIN]\n\
MOVEM A,ISTART\"\n\
MOVE A,[PUSHJ P,MAPOUT]\n\
MOVEM A,IDONE\"\n\
GO LINIT\"\n\n", svers, npage, pgno, npage, pgno);
cprint (fmak, ".PDATA\NEND INIT\n");
cclose (fmak);
count = phi - plo + 1;
count = (count + 01777) & ~01777;
access (jch, plo);
while (--count >= 0)
{val = uiiot (jch);
cputi (val, flib);
}
cclose (flib);
fmak = copen (vbuf, 'w', "s");
cprint (fmak, ":KILL\r:MIDAS C;[CREL] %s _ C;[CMAK] %s\r", svers, svers);
cclose (fmak);
valret (vbuf);
}
int jread (loc, jch)
{access (jch, loc);
return (uiiot (jch));
}
/**********************************************************************
SYMBOL TABLE
**********************************************************************/
rsymtab (ch)
{int count;
csymp = symtab;
esymp = symtab + MAXSYMS;
uiiot (ch);
count = -((uiiot (ch) >> 18) | 0777777000000) / 2;
uiiot (ch);
uiiot (ch);
--count;
while (--count >= 0)
{int n, val;
n = uiiot (ch) & SYMMASK;
val = uiiot (ch);
csymp->sym = n;
csymp->val = val;
++csymp;
}
}
int lookup (sym)
{syment *p;
for (p = symtab; p < csymp; ++p)
if (p->sym == sym) return (p->val);
puts ("symbol missing");
return (01000000);
}
char tab40[] {' ', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K',
'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
'W', 'X', 'Y', 'Z', '.', '$', '%'};
rdname (p) char *p;
{int w, factor, c;
char *s;
s = p;
w = 0;
factor = (40*40*40*40*40);
while (c = *s++)
{int i;
if (c==' ') continue;
if (factor == 0) continue;
if (c>='a' && c<='z') c =+ ('A'-'a');
for (i=0;i<40;++i)
if (c == tab40[i])
{w =+ (i * factor);
factor =/ 40;
break;
}
if (i>=40) break;
}
return (w);
}
prname (n, fn, w)
{n =& NAMMASK;
if (n) p40 (n, fn);
}
p40 (i, fn)
{int a;
if (a = i/40) p40 (a, fn);
i =% 40;
if (i) cputc (tab40[i], fn);
}


7
arc/ar2:clib/MAKLIB STINKR Normal file
View File

@@ -0,0 +1,7 @@
x clib
l maklib
l apfnam
l c10job
l c10fnm
o ts maklib


94
arc/ar2:clib/MATCH C Normal file
View File

@@ -0,0 +1,94 @@
# include "c.defs"
/**********************************************************************
SMATCH - pattern matching procedure
The pattern P is a character string which is to be matched
with the data string S. Certain characters in P are treated
special:
'*' match any substring
'?' match any character
'\\' quote following character
**********************************************************************/
int smatch (p, s)
char *p;
char *s;
{int c1, c2, i;
while (TRUE)
{c1 = *p++;
c2 = *s++;
switch (c1) {
case 0: return (!c2);
case '?': if (!c2) return (FALSE);
continue;
case '*': while (*p=='*') ++p;
if (*p==0) return (TRUE);
i = -1;
do if (smatch (p, s+i)) return (TRUE);
while (s[i++]);
return (FALSE);
case '\\': if (!(c1 = *p++)) return (FALSE);
/* fall through */
default: if (c1 != c2) return (FALSE);
continue;
}
}
}
/**********************************************************************
SINDEX (P, DS)
Return the index of the first occurrence of the string P
in the string DS. Return -1 if P does not occur in DS.
**********************************************************************/
int sindex (p, ds)
char *p;
char *ds;
{int c1, c2, start;
char *s, *t1, *t2, *tail;
s = ds;
start = p[0];
tail = p+1;
if (start) while (TRUE)
{while ((c2 = *s++) != start)
if (c2==0) return (-1);
t1 = tail;
t2 = s;
while ((c1 = *t1++) == (c2 = *t2++))
if (c1==0) break;
if (c1==0) break;
}
return (s-ds-1);
}
# ifdef test
int main ()
{char buf1[100], buf2[100];
while (TRUE)
{cprint ("Pattern: ");
gets (buf1);
cprint ("Data: ");
gets (buf2);
if (smatch (buf1, buf2))
cprint ("Matched.\n");
else cprint ("No match.\n");
}
}
# endif


29
arc/ar2:clib/MKCLIB STINKR Normal file
View File

@@ -0,0 +1,29 @@
; Stinkr xfile for loading basic C library in preparation for construction
; of the shared library.
; note -- it is proper for ZMAIN to be undefined
; note -- it is proper for DATE to have 3 TOPS-20-related names undefined
; The last two addresses in the 's' command must be set so that nothing
; overlaps and there is no wraparound. You also have to leave some room
; at the end for consing done during loading.
; The best procedure is to first use 'p' for the last two numbers, which
; tells Stinkr to allocate from the next page boundary. Then run Stinkr
; to find out how big the segments are. Then you can change the starting
; addresses to push the last to segments as close to the end as possible.
; You should leave about 400 octal words for cons space; if you have not
; left enough, stinker will die saying LBINIT failed.
; If the library has gotten bigger (more pages), the program C10SAV must
; be changed accordingly.
; C10SRY should not be here; you want to run it before the library is mapped
; in.
; C10SAV should not be here; it maps out the library as it runs.
s 100,n,755400,774000
i lbinit
o ts clib
x c;clib prglst

BIN
arc/ar2:clib/NC INSERT Normal file
View File

Binary file not shown.

164
arc/ar2:clib/NM INSERT Normal file
View File

@@ -0,0 +1,164 @@
.INSRT C;CODE INSERT
.OFNM2=SIXBIT/STK/
CL=PUSHJ P,
RTN=POPJ P,
.VCALL=2_33
.ACALL=3_33
.XCALL=4_33
DEFINE SYSCAL NAME,ARGS,DUMMY,LABEL
SETZ A,
.CALL [SETZ
.1STWD SIXBIT /NAME/
ARGS
403000,,A
]
IFSN [LABEL][]GO LABEL
IFSE [LABEL][]MOVN A,A
TERMIN
DEFINE INFORM A,B
IF1,[PRINTX \ A = B
\]
TERMIN
; SUPPORT ROUTINES
DEFINE %LEN [LIST]
%COUNT==0
IRP ELEM,,LIST
%COUNT==%COUNT+1
TERMIN
TERMIN
DEFINE DEFVAR NAME,#OFFSET
DEFINE NAME
<OFFSET-%P>&262143.(P)TERMIN
TERMIN
; DEFINE C-CALLABLE PROCEDURE (C NAME)
DEFINE CENTRY NAME,[ARGS],[VARS]
PROLOG Z!NAME,NAME,ARGS,VARS
TERMIN
; DEFINE C-CALLABLE PROCEDURE (MIDAS NAME)
DEFINE MENTRY NAME,[ARGS],[VARS]
PROLOG NAME,NAME,ARGS,VARS
TERMIN
; DEFINE MIDAS ENTRY POINT (NOT PROCEDURE)
DEFINE IENTRY NAME
NAME": TERMIN
; PROLOG MACRO
DEFINE PROLOG MNAME,PNAME,[ARGS],[VARS]
%LEN ARGS
%A==%COUNT
%LEN VARS
%V==%COUNT
%OFF== -<%A+%V>
IRP ARGNAM,,ARGS
DEFVAR ARGNAM,%OFF
%OFF==%OFF+1
TERMIN
%OFF==%OFF+1
IRP VARNAM,,VARS
DEFVAR VARNAM,%OFF
%OFF==%OFF+1
TERMIN
%A,,[ASCIZ/PNAME/]
MNAME": IFN %V,[ADDI P,%V]
TERMIN
; DEFINE SYNONYM FOR C-CALLABLE ENTRY POINT
DEFINE XENTRY NEWNAME,OLDNAME
Z!NEWNAME"=Z!OLDNAME"
TERMIN
; DEFINE MIDAS-ACCESSIBLE DATA
DEFINE MDATA NAME
NAME":TERMIN
; FATAL ERROR
DEFINE CROAK STRING/
.VALUE [ASCIZ \
: STRING 
\]
TERMIN
; RETURN STATEMENT
DEFINE RETURN
IFE %A,[
IFN %V,[SUBI P,%V]
POPJ P,
]
IFN %A,[
SUBI P,%V+%A+1
JRST @<%A+1>(P)
]
TERMIN
; CALL STATEMENT
DEFINE CALL NAME,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
ICALL NN,NAME
TERMIN
; MIDAS-CALL STATEMENT
DEFINE MCALL NAME,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
CCALL NN,NAME"
TERMIN
; VARIABLE-CALL STATEMENT
DEFINE VCALL F,[ARGS]
NN==0
IRP ARG,,ARGS
PPUSH ARG
NN==NN+1
TERMIN
CCALL NN,F
TERMIN
; INTERNAL CALL
DEFINE ICALL N,NAME
CCALL N,Z!NAME"
TERMIN
; HACK FOR CONSTANTS
EQUALS NM%EN END
EXPUNGE END
DEFINE END ENDLOC
.CODE
INSCODE
.PDATA
CONSTANTS
NM%EN ENDLOC
TERMIN
.CODE


56
arc/ar2:clib/PR60TH C Normal file
View File

@@ -0,0 +1,56 @@
# include "c.defs"
/**********************************************************************
PR60TH - Print time in 1/60 sec.
Print time HH:MM:SS.XX on file FILE.
TIME is in units of 1/60 sec.
**********************************************************************/
pr60th (time, file)
{int ss, sc, mn, hour, zs;
if (time < 0) time = -time;
zs = TRUE;
ss = time%60;
time = time/60;
sc = time%60;
time = time/60;
mn = time%60;
hour = time/60;
if (hour)
{cprint (file, "%3d:", hour);
zs = FALSE;
}
else cprint (file, " ");
xput2 (mn, file, zs);
if (zs && mn==0) cputc (' ', file);
else
{cputc (':', file);
zs = FALSE;
}
if (zs && !sc)
{cputc (' ', file);
cputc ('0', file);
}
else
{xput2 (sc, file, zs);
zs = FALSE;
}
cputc ('.', file);
xput2 (ss, file, FALSE);
}
xput2 (val, file, zs)
{int num;
num = val/10;
if (num>0 || !zs) {cputc ('0'+num, file); zs=FALSE;}
else cputc (' ', file);
num = val%10;
if (num>0 || !zs) cputc ('0'+num, file);
else cputc (' ', file);
}

31
arc/ar2:clib/RANDOM CMID Normal file
View File

@@ -0,0 +1,31 @@
;
; RANDOM - RANDOM NUMBER GENERATOR (STOLEN FROM MUDDLE)
;
; This file is PDP-10 dependent, system-independent.
;
TITLE RANDOM
.INSRT NC
.INSRT NM
CENTRY SRAND,[SEED]
MOVE A,SEED
ROT A,-1
MOVEM A,RLOW
RETURN
CENTRY RAND
MOVE A,RHI
MOVE B,RLOW
MOVEM A,RLOW ;Update Low seed
LSHC A,-1 ;Shift both right one bit
XORB B,RHI ;Generate output and update High seed
MOVE A,B
RETURN
.IDATA
RHI: 267762113337
RLOW: 155256071112
.PDATA
END

17
arc/ar2:clib/STDIO H Normal file
View File

@@ -0,0 +1,17 @@
# define BUFSIZ 512
# define FILE int
# define NULL 0
# define EOF (-1)
# define peekchar pkchar /* avoid name conflict */
# define fopen flopen /* " */
# define getc fgetc /* " */
# define getchar fgeth /* " */
# define feof ceof /* direct translation */
# define putc cputc /* " */
extern FILE *stdin, *stdout, *stderr;
# define ITS ITS


249
arc/ar2:clib/STKDMP C Normal file
View File

@@ -0,0 +1,249 @@
# include "c.defs"
/**********************************************************************
STKDMP - C Stack Dumping Routine
This file is PDP-10 dependent, but essentially system
independent.
**********************************************************************/
# rename findproc "FINDPR"
# rename findframe "FINDFR"
# rename print_name "PRNAME"
# rename callok "CALLOK"
# rename hack "STKDMP"
# rename seg2lo "SEG2LO"
# rename seg2hi "SEG2HI"
# rename seg3lo "SEG3LO"
# rename seg3hi "SEG3HI"
# rename pdlbot "PDLBOT"
# rename pdltop "PDLTOP"
# rename purbot "PURBOT"
# rename purtop "PURTOP"
# rename intptr "INTPTR"
# rename mpvh "MPVH"
# rename etsint "ETSINT"
# rename uuoh "UUOH"
# rename uuohan "UUO$HA"
# rename euuoh "EUUOH"
# rename caller "CALLER"
# define ADDI_P 0271740
# define SUBI_P 0275740
# define GO_P 0254037
# define JSP_D 0265200
# define GO 0254000
# define left(x) (((x) >> 18) & 0777777)
# define right(x) ((x) & 0777777)
extern int *seg2lo, *seg2hi, *seg3lo, *seg3hi,
*pdlbot, *pdltop, *purbot, *purtop, *caller,
mpvh[], etsint[], intptr, uuoh[], uuohan[], euuoh[],
cout, *findframe(), *findproc(), hack[];
/**********************************************************************
STKDMP - Dump stack.
**********************************************************************/
static int tuuoh;
stkdmp (fd)
{int *pc; /* procedure pointer */
int *opc; /* previously printed-out pc */
int *sp; /* stack pointer */
if (!cisfd(fd)) fd = cout;
cputc ('\n', fd);
tuuoh = uuoh[0];
sp = &fd; /* arg is on the stack */
pc = right(sp[1]); /* my caller's pc is on the stack */
opc = -1;
--sp; /* top of stack when he was running */
if (pc >= hack && pc <= hack+12) /* PUSHJ P,STKDMP$X */
{pc = right(sp[0]); /* 'real' caller */
sp =- 7; /* 'real' stack top */
}
while (TRUE)
{int *proc, nargs, *npc, *namep, *ap;
proc = findproc (pc);
if (proc == 0) break;
nargs = left(proc[-1]);
namep = right(proc[-1]);
sp = findframe (sp, proc, pc);
if (sp == 0)
{if (opc != caller)
{cprint (fd, " ");
print_name (namep, fd);
cprint (fd, "\n");
}
break;
}
npc = right(sp[0]);
sp =- nargs;
ap = sp;
--sp;
cprint (fd, "%7o ", sp);
print_name (namep, fd);
cprint (fd, " (");
if (nargs>10) nargs = 10;
while (--nargs >= 0)
{cprint (fd, "%o", *ap++);
if (nargs) cprint (fd, ", ");
}
cprint (fd, ")\n");
opc = proc;
pc = npc;
}
}
/**********************************************************************
FINDPROC - Find beginning of active procedure, given a PC.
**********************************************************************/
int *findproc (pc) int *pc;
{int *low, *high, n;
n = 3;
while (--n>=0)
{if (pc >= mpvh && pc < etsint)
{int *p;
p = right(intptr);
pc = right(p[-4]);
continue;
}
if (pc == uuoh+1 || (pc >= uuohan && pc < euuoh))
{pc = right(tuuoh);
if ((pc[0]>>29)==0) ++pc; /* hack */
continue;
}
}
if (pc > seg2lo && pc <= seg2hi)
{low = seg2lo;
high = seg2hi;
}
else if (pc > purbot && pc <= purtop)
{low = purbot;
high = purtop;
}
else return (0);
++pc;
while (--pc > low)
{int data, c, nargs, *namep;
if ((*pc >> 27) == 0) continue;
data = pc[-1];
nargs = left(data);
namep = right(data);
if (nargs >= 16) continue;
if (namep < seg3lo || namep > seg3hi) continue;
c = (*namep >> 29); /* left byte */
if (c < ' ' || c > 'z') continue;
return (pc);
}
return (0);
}
/**********************************************************************
FINDFRAME - Find stack frame, given stack top and procedure
pointer, and PC within procedure. Returns pointer
to return address on stack.
**********************************************************************/
int *findframe (sp, proc, pc) int *sp, *proc, *pc;
{int instr, signal();
instr = proc[0];
if (left(instr) == ADDI_P) /* procedure allocates a frame */
{int bump;
bump = right(instr); /* local frame size */
if (pc == proc); /* hasn't allocated it yet */
else if (left(pc[0]) == GO_P); /* has popped it */
else sp =- bump;
}
if (pc >= mpvh && pc < etsint) /* was in interrupt handler */
sp =- 17; /* ignore stuff pushed by handler */
/* !!! the above is wrong !!! */
++sp;
while (--sp >= pdlbot)
{int data, *opc;
data = *sp;
/* look for return address word on stack */
/* check for reasonable status bits */
if (!(data & 0010000000000)) continue;
/* must be in user mode */
if (data & 0027637000000) continue; /* bad for status bits */
/* check for reasonable old PC (within code segment) */
opc = right(data) - 1;
if (opc < seg2lo) continue;
if (opc > seg2hi) continue;
/* check to see if old PC was call to current proc */
if (callok (opc, proc))
{if (proc == signal && opc>=mpvh && opc<etsint)
tuuoh = sp[-1];
return (sp);
}
}
return (0);
}
/**********************************************************************
CALLOK
**********************************************************************/
int callok (opc, proc)
int *opc, *proc;
{int call, *tpc, op;
call = *opc;
if (call & 037000000) /* index or indirect */
return (TRUE); /* can't test it, assume it's the right one */
op = left(call); /* op code */
tpc = right(call); /* address */
if (op == JSP_D) /* call with nargs mismatch */
{int n, i; /* look for jump */
n = 20; /* up to 20 instructions before jump */
for (i=0;i<n;++i)
{call = tpc[i];
op = left(call);
if (op == GO)
{tpc = right(call);
break;
}
}
}
return (tpc == proc);
}
/**********************************************************************
PRINTNAME
**********************************************************************/
print_name (namep, fd)
{int c;
namep = right(namep) | 0440700000000;
while (c = ildb (&namep))
cputc (c>='A' && c<='Z' ? c+('a'-'A') : c, fd);
}


132
arc/ar2:clib/STRING CMID Normal file
View File

@@ -0,0 +1,132 @@
;
; STRING - C STRING, BYTE, AND BIT ROUTINES
;
; This file is PDP-10 dependent, system-independent.
;
TITLE STRING
.INSRT NC
.INSRT NM
; CONTAINS:
; SLEN ; STRING LENGTH
; STCPY ; STRING COPY
; STCMP ; STRING COMPARE
; LOWER ; CVT CHAR TO LOWER CASE
; UPPER ; CVT CHAR TO UPPER CASE
; BGET ; BIT ARRAY BIT GET
; BSET ; BIT ARRAY BIT SET
; ILDB ; INCREMENT AND LOAD BYTE
; IDPB ; INCREMENT AND DEPOSIT BYTE
CENTRY SLEN,[STR] ; STRING LENGTH
MOVE B,STR ; POINTER TO STRING
SETZ A, ; COUNTER
SL$1: MOVE C,(B) ; GET NEXT CHARACTER
SKIPN C
GO SL$RET ; RETURN ON NULL CHAR
ADDI A,1 ; INCR COUNTER
ADDI B,1 ; INCR POINTER
GO SL$1
SL$RET: RETURN
CENTRY STCPY,[SRC,DEST] ; STRING COPY
; COPY STRING FROM SRC TO DEST
; RETURN POINTER TO NULL TERMINATING NEW COPY
MOVE B,SRC ; SOURCE POINTER
MOVE A,DEST ; DESTINATION POINTER
SC$1: MOVE C,(B) ; GET NEXT CHAR
MOVEM C,(A) ; STORE
SKIPN C
GO SC$RET ; RETURN AFTER WRITING NULL CHAR
ADDI B,1 ; INCR SOURCE PTR
ADDI A,1 ; INCR DESTINATION PTR
GO SC$1
SC$RET: RETURN
CENTRY STCMP,[S1,S2] ; STRING COMPARE
MOVE B,S1
MOVE C,S2
SM$1: MOVE A,(B) ; GET NEXT CHAR
CAME A,(C)
GO SM$2 ; DIFFERENCE FOUND
ADDI B,1 ; INCR PTR1
ADDI C,1 ; INCR PTR2
JUMPN A,SM$1
SETO A,
GO SM$RET
SM$2: SETZ A,
SM$RET: RETURN
CENTRY LOWER,[CH] ; CVT CHAR TO LOWER CASE
MOVE A,CH
CAIGE A,"A
GO LW$RET
CAILE A,"Z
GO LW$RET
ADDI A,"a-"A
LW$RET: RETURN
CENTRY UPPER,[CH] ; CVT CHAR TO UPPER CASE
MOVE A,CH
CAIGE A,"a
GO UP$RET
CAILE A,"z
GO UP$RET
SUBI A,"a-"A
UP$RET: RETURN
CENTRY BGET,[BARRAY,BINDEX] ; BIT ARRAY BIT GET
HRRZ C,BINDEX
HRRZ A,BARRAY
MOVEI B,(C) ; SUBSCRIPT
LSH C,-5 ; GET WORD OFFSET
ADDI A,(C) ; GET WORD ADDRESS
MOVE A,(A) ; GET THE WORD
ANDI B,37 ; BIT OFFSET
ROT A,1(B) ; PUT BIT IN RIGHT-MOST POSITION
ANDI A,1 ; GET THE BIT
RETURN
CENTRY BSET,[BARRAY,BINDEX] ; BIT ARRAY BIT SET
HRRZ C,BINDEX
HRRZ A,BARRAY
MOVEI B,(C) ; SUBSCRIPT
LSH C,-5 ; GET WORD OFFSET
ADDI A,(C) ; GET WORD ADDRESS
ANDI B,37 ; BIT OFFSET
MOVN B,B ; NEGATIVE BIT OFFSET
MOVEI C,1 ; A BIT
ROT C,-1(B) ; PUT IN RIGHT POSITION
IORM C,(A) ; SMASH ARRAY WORD
MOVEI A,1
RETURN
CENTRY ILDB,[ABPTR] ; INCREMENT AND LOAD BYTE
HRRZ A,ABPTR ; ADDRESS OF BYTE POINTER
ILDB A,(A)
RETURN
CENTRY IDPB,[CH,ABPTR] ; INCREMENT AND DEPOSIT BYTE
MOVE B,CH ; THE CHARACTER
HRRZ A,ABPTR ; ADDRESS OF BYTE POINTER
IDPB B,(A)
RETURN
END


19
arc/ar2:clib/TESTFD C Normal file
View File

@@ -0,0 +1,19 @@
/**********************************************************************
TSTFD
Test routine for FD
**********************************************************************/
main ()
{char buf[200];
extern int puts ();
for (;;)
{cprint ("Enter pattern: ");
gets (buf);
fdmap (buf, puts);
puts ("");
}
}


123
arc/ar2:clib/TTIME C Normal file
View File

@@ -0,0 +1,123 @@
/**********************************************************************
TTIME - Test program for Timing
**********************************************************************/
# rename timing "TIMING"
extern int timing;
main ()
{int i;
i = 10000;
if (timing) i = 1000;
while (--i >= 0) foo ();
}
foo () /* calls null 100 times */
{
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
null();
}
null () {;}

157
arc/ar2:clib/UUOH CMID Normal file
View File

@@ -0,0 +1,157 @@
;
; UUOH - C UUO Handler
;
; This file is PDP-10 dependent, system-independent.
;
TITLE UUOH
.INSRT NC
.INSRT NM
;
; UUO DISPATCH TABLE
;
.PDATA
IENTRY UUOTAB
ILLUUO
UCCALL ;.CCALL - FIRST TIME CALL
UVCALL ;.VCALL - CALL OF VARIABLE PROC
UACALL ;.ACALL - CALL NEEDING ADDITIONAL ARGS
UXCALL ;.XCALL - CALL WITH EXTRA ARGS
REPEAT UUOTAB+40-.,[ILLUUO?]
;
; BASIC UUO DISPATCHER
;
.IDATA
MDATA UUOH
0
GO UUO$HANDLER
MDATA SMASH
-1
.UDATA
MDATA USAVEA
BLOCK 1
MDATA USAVEB
BLOCK 2
MDATA USAVEC
BLOCK 3
MDATA USAVED
BLOCK 4
.CODE
IENTRY UUO$HANDLER
MOVEM D,USAVED
LDB D,[330500,,40] ; GET UUO CODE
GO @UUOTAB(D) ; DISPATCH BASED ON THE UUO
URETA: MOVE A,USAVEA
URETB: MOVE B,USAVEB
URETC: MOVE C,USAVEC
URETD: MOVE D,USAVED
GO @UUOH
;
; ILLEGAL UUO HANDLER
;
IENTRY ILLUUO
CROAK ILLEGAL UUO
GO URETD
;
; .CCALL HANDLER
;
IENTRY UCCALL
MOVEM B,USAVEB ; MUST NOT CHANGE ANY REGS
MOVEM C,USAVEC ; AS CALL MIGHT BE THRU A REG
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UCBAD ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UCBAD ; NO, NOT A PROCEDURE
SKIPN SMASH ; SHOULD I SMASH THE CALL
GO UC$GO ; NO, LEAVE IT
SOS D,UUOH ; ADDRESS OF THE CALL
MOVE B,(D) ; THE .CCALL INSTRUCTION
TLZ B,777740 ; ZERO OUT ALL BUT ADDRESS PART
CAIE B,(C) ; IS IT A CONSTANT CALL?
GO UCV ; NO, CHANGE IT INTO A .VCALL
LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
SUB B,0 ; THE NUMBER OF EXTRA ACTUALS
JUMPL B,UCA ; TOO FEW ACTUALS
JUMPG B,UCX ; TOO MANY ACTUALS
MOVEI B,(PUSHJ P,)
HRLM B,(D) ; SMASH .CCALL TO PUSHJ
GO URETB ; RE-EXECUTE CALL
UCA: MOVN B,B ; THE NUMBER OF EXTRA ARGS NEEDED
LSH B,5 ; SHIFT INTO ACCUMULATOR POSITION
IORI B,(.ACALL)
HRLM B,(D) ; SMASH .CCALL TO .ACALL
GO URETB ; RE-EXECUTE CALL
UCX: LSH B,5 ; SHIFT INTO ACCUMULATOR POSITION
IORI B,(.XCALL)
HRLM B,(D) ; SMASH .CCALL TO .ACALL
GO URETB ; RE-EXECUTE CALL
UCV: MOVE B,(D) ; THE ORIGINAL CALL
TLZ B,777000 ; MASK OUT OPCODE
TLO B,(.VCALL) ; MAKE IT A .VCALL
MOVEM B,(D) ; SMASH CALL
GO URETB ; RE-EXECUTE CALL
IENTRY UCBAD
LDB B,[270400,,0] ; THE NUMBER OF ACTUAL ARGS
UVBAD: MOVEM B,USAVEA ; SAVE NUMBER OF ACTUAL ARGS
SETZ A, ; SET DEFAULT RETURN VALUE
MOVE D,UUOH
SUBI D,1 ; LET USER LOOK AT CALL
CROAK CALL OF UNDEFINED PROCEDURE
SUB P,USAVEA ; POP OFF ARGS
GO URETB ; RETURN TO CALLER
IENTRY UVCALL
HRRZ C,40 ; THE CALLED PROCEDURE
JUMPE C,UVBAD ; NO SUCH PROCEDURE
HLRZ 0,-1(C) ; THE NUMBER OF FORMAL ARGS
CAIL 0,20 ; REASONABLE NUMBER?
GO UVBAD ; NO, NOT A PROCEDURE
UC$GO: LDB B,[270400,,40] ; THE NUMBER OF ACTUAL ARGS
SUB 0,B ; NUMBER OF ARGS NOT GIVEN
JUMPL 0,UVHACK ; TOO MANY ARGS GIVEN
UVLOOP: SOJL 0,UVDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UVLOOP ; LOOP
UVHACK: ; TOO MANY ARGS GIVEN
ADD P,0 ; POP OFF EXTRA ARGS
UVDOIT: PUSH P,UUOH ; PUSH RETURN ADDRESS
GO (C) ; EXECUTE PROCEDURE
IENTRY UACALL
LDB B,[270400,,40] ; THE NUMBER OF EXTRA ARGS NEEDED
HRRZ C,40 ; THE CALLED PROCEDURE
UALOOP: SOJL B,UVDOIT ; FOR EACH ARG NEEDED
PUSH P,[0] ; PUSH ZERO ARG
GO UALOOP ; LOOP
IENTRY UXCALL
LDB B,[270400,,40] ; THE NUMBER OF EXTRA ARGS
HRRZ C,40 ; THE CALLED PROCEDURE
SUBI P,(B) ; POP OFF EXTRA ARGS
PUSH P,UUOH ; PUSH RETURN ADDRESS
GO (C) ; EXECUTE PROCEDURE
IENTRY EUUOH
END


281
arc/ar5:c/AC C Normal file
View File

@@ -0,0 +1,281 @@
#
/*
AC - Array of Characters Cluster
operations:
ac_new () => ac create empty array
ac_alloc (size) => ac create empty array, preferred size
ac_create (string) => ac create with initial value
ac_xh (ac, c) => c extend array with character
ac_trim (ac) => ac trim excess storage
ac_fetch (ac, i) => c fetch character from array
ac_link (ac) => ac make new link to array
ac_unlink (ac) remove link to array
ac_puts (ac, f) print array
ac_cat (ac, ac) => ac concatenate arrays
ac_copy (ac) => ac copy array
ac_string (ac) => *char return string version
ac_size (ac) => size return current size of array
ac_flush (ac) make array empty
ac_n () => int return # of active arrays
*/
struct rep {
int count; /* reference count */
char *s; /* pointer to actual array */
int csize; /* logical size of array */
int msize; /* physical size of array (at least csize+1) */
};
# define ac struct rep* /* watch usage! */
# define ASIZE 4 /* number of words in rep */
# define initial_size 8 /* default initial allocation */
char *calloc ();
int *salloc ();
ac ac_new();
ac ac_alloc();
ac ac_create();
ac ac_link();
ac ac_cat();
ac ac_copy();
static int count;
/**********************************************************************
AC_NEW - Create empty array.
AC_ALLOC - Create empty array, preferred size given.
**********************************************************************/
ac ac_new ()
{return (ac_alloc (initial_size));}
ac ac_alloc (sz)
{ac a;
if (sz<0) sz=0;
a = salloc (ASIZE);
a->count = 1;
a->csize = 0;
a->msize = sz+1;
a->s = calloc (a->msize);
++count;
return (a);
}
/**********************************************************************
AC_CREATE - Create array with initial value.
**********************************************************************/
ac ac_create (s) char s[];
{register char *p;
register int sz;
register ac a;
sz = slen (s);
a = ac_alloc (sz);
a->csize = sz;
p = a->s;
while (--sz >= 0) *p++ = *s++;
return (a);
}
/**********************************************************************
AC_XH - Extend Array with Character.
**********************************************************************/
char ac_xh (a, c) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) >= a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize =* 2);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
a->s[a->csize++] = c;
return (c);
}
/**********************************************************************
AC_TRIM - Discard excess storage.
**********************************************************************/
ac ac_trim (a) register ac a;
{register char *p, *q;
char *old;
int i;
if ((i = a->csize) < a->msize-1)
{old = p = a->s;
a->s = q = calloc (a->msize = a->csize + 1);
while (--i >= 0) *q++ = *p++;
if (old) cfree (old);
}
return (a);
}
/**********************************************************************
AC_FETCH - Fetch Character from Array.
**********************************************************************/
char ac_fetch (a, n) ac a;
{extern int cerr;
if (n<0 || n>=a->csize)
{cprint (cerr, "Character array bounds error.");
return (0);
}
return (a->s[n]);
}
/**********************************************************************
AC_LINK - Create link to array.
**********************************************************************/
ac ac_link (a) ac a;
{++a->count;
return (a);
}
/**********************************************************************
AC_UNLINK - Remove link to array.
**********************************************************************/
ac_unlink (a) ac a;
{if (--a->count == 0)
{if (a->s) cfree (a->s);
--count;
sfree (a);
}
}
/**********************************************************************
AC_PUTS - Print array.
**********************************************************************/
ac_puts (a, f, wid) ac a; /* 3 args for cprint usage */
{register char *p;
register int i;
p = a->s;
i = a->csize;
while (--i >= 0) cputc (*p++, f);
}
/**********************************************************************
AC_CAT - Concatenate arrays.
**********************************************************************/
ac ac_cat (a1, a2) ac a1; ac a2;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize + a2->csize);
a->csize = i;
p = a->s;
q = a1->s;
i = a1->csize;
while (--i>=0) *p++ = *q++;
q = a2->s;
i = a2->csize;
while (--i>=0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_COPY - Copy array.
**********************************************************************/
ac ac_copy (a1) ac a1;
{register ac a;
register char *p, *q;
int i;
a = ac_alloc (i = a1->csize);
a->csize = i;
p = a->s;
q = a1->s;
while (--i >= 0) *p++ = *q++;
return (a);
}
/**********************************************************************
AC_STRING - Return string version of array. The returned
string is valid only while the array remains linked
to and unchanged.
**********************************************************************/
char *ac_string (a) ac a;
{a->s[a->csize]=0;
return (a->s);
}
/**********************************************************************
AC_SIZE - Return current size of array.
**********************************************************************/
int ac_size (a) ac a;
{return (a->csize);}
/**********************************************************************
AC_FLUSH - Make array empty
**********************************************************************/
ac_flush (a) ac a;
{a->csize = 0;}
/**********************************************************************
AC_N - Return number of active arrays.
**********************************************************************/
int ac_n () {return (count);}


225
arc/ar5:c/ALLOC CMID Normal file
View File

@@ -0,0 +1,225 @@
;
; ALLOC - C FREE STORAGE ROUTINES
;
; This file is PDP-10 dependent, system independent.
;
; CALLOC (SIZE) => *CHAR ; ALLOCATE ZEROED CHARACTERS
; SALLOC (SIZE) => *INT ; ALLOCATE ZEROED WORDS
; CFREE (*CHAR) ; RETURN CHARACTERS
; SFREE (*INT) ; RETURN WORDS
;
; AFREE (SIZE) => (ADDR) ; ALLOCATE GARBAGE WORDS
; AFRET (ADDR, SIZE) ; DEALLOCATE WORDS
; AFREZ (SIZE) => (ADDR) ; ALLOCATE AND ZERO WORDS
;
; ALOCSTAT (&NWALLOC, &NBFREE) => NWFREE ; COMPUTE STATS
;
TITLE ALLOC
.INSRT NC
.INSRT NM
; THESE ARE STORAGE-ALLOCATION ROUTINES WITH SOME PROTECTION
CENTRY CALLOC,[NWORDS] ; ALLOCATE CHARACTERS
XENTRY SALLOC,CALLOC ; ALLOCATE WORDS
SKIPL A,NWORDS ; DON'T ADD TO BAD SIZE
ADDI A,2 ; FOR HEADER WORDS
CALL AFREZ,[A]
ADDI A,2 ; POINTER TO USER AREA OF BLOCK
MOVE B,NWORDS
MOVEM B,-1(A) ; STORE SIZE IN HEADER
MOVE B,A
ADD B,[147506732514]
MOVEM B,-2(A) ; MAGIC WORD IN HEADER
RETURN
CENTRY CFREE,[PTR] ; RETURN CHARACTERS
XENTRY SFREE,CFREE ; RETURN WORDS
MOVE A,PTR
MOVE B,-2(A)
SUB B,A
CAME B,[147506732514]
GO CF$BAD
MOVEI A,-2(A)
MOVE B,1(A)
ADDI B,2
CALL AFRET,[A,B]
SETZ A,
CF$RET: RETURN
CF$BAD: CROAK BAD CALL TO CFREE/SFREE
SETO A,
GO CF$RET
.IDATA
MDATA FNWORDS ; NUMBER OF WORDS ALLOCATED
0
MDATA FLIST
FLIST+1 ; LIST OF FREE BLOCKS
0
.CODE
;
; AFREE - ALLOCATE STORAGE
;
CENTRY AFREE,[BSIZE]
XENTRY GETVEC,AFREE
MOVE A,BSIZE
JUMPLE A,AE$BAD ; SIZE MUST BE POSITIVE
CAIL A,400000 ; SIZE MUST BE REASONABLE
GO AE$BAD
HRLZI D,(A) ; SIZE IN LEFT HALF FOR COMPARISON
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A1: CAMG D,(C) ; IS CURRENT BLOCK BIG ENOUGH?
GO A3 ; YES
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A1 ; BLOCK EXISTS => LOOP
HLRZ B,D ; DESIRED SIZE IN B
PPUSH B ; SAVE SIZE NEEDED
CALL GETCORE,[B] ; ALLOCATE NEW BLOCK (SIZE,,ADDR)
HLRZ B,A ; SIZE OBTAINED
HRRZ A,A ; ADDRESS OF BLOCK
PPOP D ; SIZE NEEDED
SUBI B,(D) ; HOW MUCH EXTRA OBTAINED?
JUMPE B,AE$RET ; NO EXCESS => DONE
PPUSH A ; ADDRESS OF BLOCK
ADDM B,(P) ; ADDRESS OF DESIRED PART OF BLOCK
CALL AFRET,[A,B] ; RETURN THE EXCESS
PPOP A ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN A SUFFICIENTLY LARGE BLOCK FOUND IN LIST
A3: HLRZ D,D ; DESIRED SIZE IN D
HLRZ A,(C) ; SIZE OF BLOCK IN LIST
SUBI A,(D) ; EXCESS
JUMPE A,A4 ; NO EXCESS => DELETE BLOCK FROM LIST
HRLM A,(C) ; NEW BLOCK SIZE
ADDI A,(C) ; ADDRESS OF DESIRED PART OF BLOCK
GO AE$RET ; DONE
; HERE WHEN ENTIRE BLOCK IS TO BE REMOVED FROM THE LIST
A4: HRRZ A,(C) ; NEXT BLOCK IN LIST
HRRM A,(B) ; CHAIN TO PREVIOUS BLOCK
MOVEI A,(C) ; RETURN THIS BLOCK
GO AE$RET ; DONE
AE$BAD: CROAK AFREE CALLED WITH BAD SIZE ARGUMENT
SETZ A,
AE$RET: RETURN ; DONE
;
; AFRET - DEALLOCATE STORAGE
;
CENTRY AFRET,[PTR,BSIZE]
MOVE A,PTR
MOVE B,BSIZE
JUMPLE B,CODE [ ; SIZE MUST BE POSITIVE
CROAK AFRET CALLED WITH BAD SIZE ARGUMENT
GO ARRET
]
MOVEI C,FLIST ; ADDRESS OF PREVIOUS BLOCK IN C
HRRZ D,(C) ; ADDRESS OF CURRENT BLOCK IN D
A5: CAIG A,(D) ; FIND PLACE IN LIST
GO A8 ; NEW BLOCK GOES HERE
MOVEI C,(D) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ D,(D) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN D,A5 ; BLOCK EXISTS => LOOP
; HERE TO INSERT NEW BLOCK AFTER A GIVEN BLOCK IN LIST
A6: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(C) ; END OF OLD BLOCK
CAIGE A,(D) ; OVERLAP WITH PREVIOUS BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIN A,(D) ; CONTIGUOUS WITH PREVIOUS BLOCK ?
GO A7 ; YES, GO MERGE THEM
HRRZ D,(C) ; ADDRESS OF NEXT BLOCK (IF ANY)
HRLI D,(B) ; SIZE OF BLOCK BEING FREED (IN LEFT HALF)
MOVEM D,(A) ; MAKE DOPE WORD OF BLOCK BEING FREED
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
GO ARRET ; DONE
; HERE TO MERGE BLOCK WITH PREVIOUS BLOCK (ADDR IN C)
A7: HLRZ D,(C) ; SIZE OF OLD BLOCK
ADDI D,(B) ; ADD SIZE OF BLOCK BEING FREED
HRLM D,(C) ; STORE NEW SIZE IN OLD BLOCK
GO ARRET ; DONE
; HERE IN INSERT NEW BLOCK IN MIDDLE OF LIST
A8: MOVEI 0,(A) ; ADDRESS OF NEW BLOCK
ADDI 0,(B) ; END OF NEW BLOCK
CAILE 0,(D) ; OVERLAP WITH NEXT BLOCK ?
GO CODE [ ; YES, ERROR
CROAK AFRET CALLED WITH BAD ADDRESS
GO ARRET
]
CAIE 0,(D) ; CONTIGUOUS WITH NEXT BLOCK ?
GO A6 ; NO, APPEND TO PREVIOUS BLOCK
MOVS 0,(D) ; SWAPPED DOPE WORD OF NEXT BLOCK
ADDI 0,(B) ; SIZE OF COMBINED BLOCK
MOVSM 0,(A) ; MAKE DOPE WORD OF COMBINED BLOCK
HRRM A,(C) ; CHAIN IT TO PREVIOUS BLOCK
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI D,(C) ; END OF PREVIOUS BLOCK
CAIE D,(A) ; CONTIGUOUS WITH PREVIOUS BLOCK ALSO ?
GO ARRET ; NO, DONE
HLRZ D,(C) ; SIZE OF PREVIOUS BLOCK
ADDI 0,(D) ; SIZE OF COMBINED BLOCK
MOVSM 0,(C) ; MERGE AGAIN
ARRET: RETURN ; DONE
;
; AFREZ - ALLOCATE ZEROED BLOCK
;
CENTRY AFREZ,[BSIZE]
CALL AFREE,[BSIZE] ; ALLOCATE A BLOCK
SETZM (A) ; ZERO FIRST WORD
MOVE B,BSIZE ; THE SIZE
SOJE B,AZRET ; NUMBER OF WORDS REMAINING TO BE ZEROED
ADDI B,(A) ; LAST WORD OF BLOCK
HRLZI C,(A) ; FIRST WORD OF BLOCK (LEFT HALF)
HRRI C,1(A) ; SECOND WORD OF BLOCK (RIGHT HALF)
BLT C,(B) ; TRANSFER ZEROES
AZRET: RETURN ; DONE
;
; ALOCSTAT - COMPUTE ALLOCATION STATISTICS
;
CENTRY ALOCSTAT,[PNALOC,PNBFREE]
MOVE A,FNWORDS ; NUMBER ALLOCATED
MOVEM A,@PNALOC
SETZ A, ; ZERO SUM OF FREE BLOCK SIZES
SETZM @PNBFREE ; ZERO COUNT OF FREE BLOCKS
MOVEI B,FLIST ; PREVIOUS BLOCK ADDR IN B
HRRZ C,(B) ; CURRENT BLOCK ADDR IN C
A9: HLRZ D,(C) ; GET SIZE OF BLOCK
ADD A,D ; ADD TO SUM
AOS @PNBFREE
MOVEI B,(C) ; CURRENT BLOCK -> PREVIOUS BLOCK
HRRZ C,(C) ; NEXT BLOCK -> CURRENT BLOCK
JUMPN C,A9 ; BLOCK EXISTS => LOOP
RETURN
END


26
arc/ar5:c/APFNAM C Normal file
View File

@@ -0,0 +1,26 @@
/**********************************************************************
APFNAME - Append suffix to file name
**********************************************************************/
char *apfname (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, 0, 0, 0, suffix, "", "");
return (dest);
}
/**********************************************************************
FNMKOUT - Make output file name
**********************************************************************/
char *fnmkout (dest, source, suffix)
char *dest, *source, *suffix;
{fnsfd (dest, source, "", 0, 0, suffix, "", "");
return (dest);
}


17
arc/ar5:c/ATOI C Normal file
View File

@@ -0,0 +1,17 @@
/**********************************************************************
ATOI - Convert string to Integer
**********************************************************************/
int atoi (s) char s[];
{int i, f, c;
if (!s) return (0);
i = f = 0;
if (*s == '-') {++s; ++f;}
while ((c = *s++)>='0' && c<='9') i = i*10 + c-'0';
return (f?-i:i);
}


21
arc/ar5:c/BLT CMID Normal file
View File

@@ -0,0 +1,21 @@
;
; BLT
;
; This file is PDP-10 dependent, system-independent.
;
TITLE BLT
.INSRT NC
.INSRT NM
CENTRY BLT,[FROM,TO,NUM]
HRRZ A,TO
HRRZI B,-1(A)
ADD B,NUM
HRL A,FROM
BLT A,(B)
RETURN
END


57
arc/ar5:c/C DEFS Normal file
View File

@@ -0,0 +1,57 @@
/*
C Standard Definitions
*/
# define ITS ITS
/* data types */
struct _filespec {int dev, fn1, fn2, dir;};
# define filespec struct _filespec
# define channel int
struct _cal {int year, month, day, hour, minute, second;};
# define cal struct _cal
struct _tag {int *pc, *fp, *ap, *sp;};
# define tag struct _tag
/* common values */
# define TRUE 1
# define FALSE 0
# define OPENLOSS -1 /* returned by COPEN if lose */
/* C interrupts */
# define INT_DEFAULT 0
# define INT_IGNORE 1
# define mpv_interrupt 1
# define ioc_interrupt 2
# define ilopr_interrupt 3
# define mar_interrupt 4
# define utrap_interrupt 5
# define pure_interrupt 6
# define wiro_interrupt 7
# define sys_down_interrupt 8
# define clock_interrupt 9
# define timer_interrupt 10
# define pdlov_interrupt 11
# define ttyi_interrupt 12
# define cli_interrupt 13
# define overflow 14
# define float_overflow 15
# define channel0_interrupt 16
# define inferior0_interrupt 32
# define ctrls_interrupt 41
# define ctrlg_interrupt 42


56
arc/ar5:c/C10BOO CMID Normal file
View File

@@ -0,0 +1,56 @@
;
; C10BOO - Bootstrapper Routine
;
; This file is ITS dependent.
;
TITLE BOOTSTRAP
.INSRT NC
.INSRT NM
LSTART==6 ; WHERE BOOTSTRAP LOADER WILL BE MOVED TO
LCHN==15 ; LOAD FILE CHANNEL
TCHN==16 ; TTY CHANNEL
CENTRY BOOTSTRAP,[FS]
MOVE C,FS
SYSCAL OPEN,[MOVSI 6?MOVEI LCHN?(C)?1(C)?2(C)?3(C)],LOSE
.SUSET [.ROPTI,,A] ; READ OPTION WORD
TLZ A,OPTOPC+OPTINT ; TURN OFF OLD PC ON MPV, IOC AND
; USE NEW INTERRUPT STACKING SCHEME
.SUSET [.SOPTI,,A] ; SET OPTION WORD
SETZM 42 ; DISABLE INTERRUPT HANDLING
SETZ A,
.SUSET [.SMASK,,A]
SETZM 41
.OPEN TCHN,[SIXBIT/ TTY/]
GO NOTTY
.CALL [SETZ ; TURN OFF ECHOING
'TTYSET
1000,,TCHN
[232222222222]
SETZ [230222220222]
]
JFCL
NOTTY: MOVE 0,[LOADER,,LSTART]
BLT 0,LSTART+LODLEN ; MOVE LOADER
JRST LSTART ; EXECUTE LOADER
LOSE: SETO A,
RETURN
;
; THE LOADING PROGRAM
;
LOADER:
.CALL [SETZ ? SIXBIT/LOAD/ ? MOVEI -1 ? SETZI LCHN]
.VALUE
.IOT LCHN,LSTART+5 ; READ STARTING ADDRESS
.CLOSE LCHN,
JRST @0 ; START PROGRAM
-1,,0 ; IOT POINTER
LODLEN==.-LOADER
END

54
arc/ar5:c/C10COR CMID Normal file
View File

@@ -0,0 +1,54 @@
;
; C10COR - Basic Storage Allocation
;
; This file is ITS dependent.
;
TITLE CCORE
.INSRT NC
.INSRT NM
.GLOBAL FNWORD
;
; GETCORE - BASIC CORE ALLOCATOR
;
; GETCORE (SIZE) => SIZE,,ADDR
;
CENTRY GETCORE,[BSIZE],[NPAGES,PTR]
MOVE B,BSIZE
ADDI B,1777
LSH B,-10. ; NUMBER OF PAGES NEEDED
MOVEM B,NPAGES
CALL PGJGET,[NPAGES] ; GET PAGES
MOVN B,NPAGES ; MINUS NUMBER OF PAGES
JUMPLE A,CODE [
CROAK STORAGE EXHAUSTED
GO DOT
]
MOVEM A,PTR
HRL A,B ; AOBJN POINTER TO NEW PAGES
TRYAGN: .CALL [SETZ
'CORBLK
1000,,300000 ; WANT READ AND WRITE ACCESS
1000,,-1 ; PUT PAGE IN MY MAP
A ; WHERE TO PUT THEM
401000,,400001 ; GET FRESH PAGES
]
GO CODE [
CROAK UNABLE TO GET CORE
MOVEI 0,30.
.SLEEP 0,
GO TRYAGN
]
MOVE A,PTR
LSH A,10. ; POINTER TO FIRST PAGE
MOVE B,NPAGES
LSH B,10. ; NUMBER OF WORDS GOTTEN
ADDM B,FNWORDS ; SAVE FOR STATS
HRL A,B ; SIZE,,ADDR
RETURN
END

120
arc/ar5:c/C10EXC C Normal file
View File

@@ -0,0 +1,120 @@
# include "c/c.defs"
int exctime 0;
int exccode 0;
/**********************************************************************
EXECS - Execute a program with a given command string
Returns:
-5 Job valretted something and was not continued.
-4 Internal fatal error.
-3 Unable to load program file.
-2 Unable to create job.
-1 Unable to open program file.
0 Job terminated normally.
other Job terminated abnormally with said PIRQ
Sets:
exctime - job's CPU time in 1/60 sec. units
exccode - contents of job's loc 1 at termination
**********************************************************************/
int execs (pname, args) char *pname, *args;
{int i, j, ich;
char *s, buf[40];
filespec f;
j = j_fload (pname);
if (j<0) return (j);
j_sjcl (j, args);
j_give_tty (j);
j_start (j);
while (TRUE)
{i = j_wait (j);
j_take_tty (j);
switch (i) {
case -1: return (-4);
case -2: i = 0;
break;
case -3: s = j_valret (j);
if (s)
{cprint ("Job valrets: ");
puts (s);
}
else
{puts ("Job .VALUE 0");
}
cprint ("continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
i = -5;
break;
case -5: wsuset (014, 02); /* simulate ^Z typed */
sleep (15);
j_give_tty (j);
j_start (j);
continue;
default: cprint ("Unhandled interrupt, continue? ");
gets (buf);
if (buf[0]=='y' || buf[0]=='Y')
{j_give_tty (j);
j_start (j);
continue;
}
break;
}
break;
}
exctime = ruset (j_ch(j), 024) / (16666000./4069.);
exccode = 0;
if (!j_name (j, &f) && (ich=open(&f,4))>=0)
{uiiot (ich);
exccode = uiiot (ich);
close (ich);
}
j_kill (j);
return (i);
}
/**********************************************************************
EXECV - Execute file given a vector of arguments
**********************************************************************/
int execv (prog, argc, argv)
char *prog, *argv[];
{char **ap, **ep, buff[300], *p, *s;
int c;
p = buff;
ap = argv;
ep = argv + argc - 1;
while (ap <= ep)
{s = *ap++;
*p++ = '"';
while (c = *s++) *p++ = c;
*p++ = '"';
*p++ = ' ';
}
*p++ = 0;
return (execs (prog, buff));
}


51
arc/ar5:c/C10EXP C Normal file
View File

@@ -0,0 +1,51 @@
# include "c/c.defs"
/**********************************************************************
EXPAND ARGUMENT VECTOR CONTAINING FILE NAME PATTERNS
**********************************************************************/
static char **next;
static char *bufp;
int exparg (argc, argv, outv, buffer)
char *argv[], *outv[], buffer[];
{int i, expfs();
char *s;
bufp = buffer;
next = outv;
i = 0;
while (i<argc)
{s = argv[i++];
if (expmagic (s)) mapdir (s, expfs);
else *next++ = s;
}
return (next-outv);
}
int expmagic (s) /* does it contain magic pattern chars? */
char *s;
{int c, flag;
flag = FALSE;
while (c = *s++) switch (c) {
case '?':
case '*': flag = TRUE; continue;
case '/': flag = FALSE; continue;
case '\\': if (*s) ++s; continue;
}
return (flag);
}
expfs (fs)
filespec *fs;
{char *prfile (), *p;
p = bufp;
bufp = (prfile (fs, bufp)) + 1;
*next++ = p;
}


231
arc/ar5:c/C10FD C Normal file
View File

@@ -0,0 +1,231 @@
# include "c.defs"
# include "its.bits"
/**********************************************************************
FD-ITS
File Directory Routines
ITS Version
**********************************************************************/
/**********************************************************************
FDMAP (P, F)
Call F(S) for all filenames S that match the pattern P.
**********************************************************************/
static int (*fff)();
fdmap (p, f)
char *p;
int (*f)();
{extern int fdzzzz();
fff = f;
mapdirec (p, fdzzzz);
}
/**********************************************************************
The following routines are internal and probably should
not be used by other programs.
**********************************************************************/
fdzzzz (fp)
filespec *fp;
{char fn[100];
prfile (fp, fn);
(*fff)(fn);
}
# define DIRSIZ 02000
# define ENTSIZ 5
/* some useful SIXBIT numbers */
# define _FILE_ 0164651544516 /* .FILE. */
# define _PDIRP_ 0104451621100 /* (DIR) */
# define _DSK_ 0446353000000
/**********************************************************************
MAPDIREC - Perform a function for each file in a
directory whose name matches a given pattern
(locked files not included)
**********************************************************************/
mapdirec (pattern, f)
char *pattern; /* the file name pattern */
int (*f)(); /* the function */
{filespec ff;
fparse (pattern, &ff);
return (mapdfs (&ff, f));
}
mapdfs (fp, f)
filespec *fp; /* the parsed pattern */
int (*f)(); /* the function */
{int n, v[2*DIRSIZ/ENTSIZ], *p, *q;
char pat1[10], pat2[10], buf[10];
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = fp->fn1;
fs.fn2 = fp->fn2;
n = rddir (fp, v, 04);
if (fp->fn1) c6tos (fp->fn1, pat1);
if (fp->fn2) c6tos (fp->fn2, pat2);
q = v + 2*n;
for (p=v; p<q; p=+2)
{if (fp->fn1)
{c6tos (p[0], buf);
if (!smatch (pat1, buf)) continue;
}
if (fp->fn2)
{c6tos(p[1], buf);
if (!smatch (pat2, buf)) continue;
}
fs.fn1 = p[0];
fs.fn2 = p[1];
(*f)(&fs);
}
}
/**********************************************************************
RDIREC - Read A Directory
S is a string specifying a directory.
V will be filled with pairs of SIXBIT names, one for each file.
The number of files is returned.
**********************************************************************/
int rdirec (s, v, fs)
char *s;
int v[];
filespec *fs;
{fparse (s, fs);
if (!fs->dir) fs->dir = fs->fn1;
return (rddir (fs, v, 0));
}
/**********************************************************************
RDDIR - Read Directory
Return in V a list of names in the directory specified by FS.
OPT is used to filter out some files:
if (opt & 01) no-links
if (opt & 02) no-backed-up-files
if (opt & 04) no-locked-files
**********************************************************************/
int rddir (fp, v, opt)
filespec *fp;
int v[], opt;
{int buf[DIRSIZ], f, n, i, *p, d, n1, n2;
filespec fs;
fs.dev = fp->dev;
fs.dir = fp->dir;
fs.fn1 = _FILE_;
fs.fn2 = _PDIRP_;
if (!fs.dev) fs.dev = _DSK_;
if (!fs.dir) fs.dir = rsname();
f = open (&fs, BII);
if (f<0) return (0);
sysread (f, buf, DIRSIZ);
close (f);
n = (DIRSIZ - buf[1]) / ENTSIZ;
p = buf+buf[1];
i = 0;
while (--n >= 0)
{n1 = *p++;
n2 = *p++;
d = *p++ >> 18; /* random info */
p =+ 2;
if (d & 060) continue; /* should ignore these */
if (opt & d) continue; /* optionally ignore */
*v++ = n1;
*v++ = n2;
++i;
}
return (i);
}
/**********************************************************************
RMFD - Read the Master File Directory
V will be filled with SIXBIT names, one for each directory,
sorted.
The number of directories is returned.
**********************************************************************/
int rdmfd (v)
int v[];
{int ch, n, *e, *p, *q, i, j, x;
ch = fopen ("m.f.d. (file)", BII);
if (ch<0) return (ch);
n = sysread (ch, v, DIRSIZ);
close (ch);
e = v+n;
p = v+v[1];
q = v;
while (p<e) if (x = *p++) *q++ = x;
n = q-v-1; /* -1 for convenience in sort */
for (i=0; i<n; ++i)
for (j=i; j<=n; ++j)
if (v[j] < v[i]) {x=v[i];v[i]=v[j];v[j]=x;}
++n;
v[n] = 0;
return (n);
}
/**********************************************************************
a test routine
**********************************************************************/
# ifdef test
main ()
{char buf[50];
while (TRUE)
{cprint ("Pattern: ");
gets (buf);
mapdir (buf, prf);
}
}
prf (f)
filespec *f;
{char buf[100];
prfile (f, buf);
cprint ("%s\n", buf);
}
# endif


Some files were not shown because too many files have changed in this diff Show More