Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/zimula.man
There is 1 other file named zimula.man in the archive. Click here to see a list.
Swedish National Defense Research Institute FOA Report
Dep of Planning and Operations Research C10055-M3(E5)
S-104 50 STOCKHOLM 80 Sept 1976
A Working SIMULA definition of SIMSET and SIMULATION
Using the HIDDEN PROTECTED concepts
By Mats Ohlin
Abstract:
The system classes SIMSET and SIMULATION have been defined in
basic SIMULA using the HIDDEN PROTECTED concepts. The
possibility to include simple tracing facilities in these
classes is demonstrated and its value for educational and
debugging purposes is discussed.
Key words and Phrases:
SIMULA, HIDDEN PROTECTED, SIMSET, SIMULATION, Report
generator, Tracing, Debugging, Teaching Simulation Language,
Quasi-parallell processes.
Acknowledgements:
I want to thank Lars Enderin, Jacob Palme and Mats Wallin, all
at FOA, for helpfull comments during the preparation of this
report.
The information in this report is subject to change without
notice. The institute assumes no responsibility for any
errors that may be present in this document. The software
code is intended for use on a SIMULA system. (SIMULA is a
registrated trademark of the Norwegian Computing Center, Oslo,
Norway.) Copyright 1976 by the Swedish National Defense
Research Institute. Copying is allowed with reference to this
report.
NOTE
This document was compiled using the DEC-10 RUNOFF
Text Formatting Program at QZ - Stockholm Universities
Computing Center, Stockholm, Sweden.
A Working SIMULA definition of SIMSET and SIMULATION Page 2
1. Introduction
1. Introduction
The SIMULA Language definition includes the built-in system
classes SIMSET and SIMULATION.
These classes are defined in the Common Base (1) in almost
"pure" SIMULA. The only discrepancy consists in the use of
certain class identifiers not accessible by the user.
Using the HIDDEN PROTECTED concepts, as suggested by Palme (2)
and defined by the SIMULA Development Group in 1976 (3), a
more strict definition in SIMULA is possible.
2. Use of SIMULA defined versions of SIMSET/SIMULATION
Now and then, imaginative users of SIMULA express the wish for
alternatives to the scheduling mechanism present in the
built-in system classes. Sometimes, users want to change the
way SIMSET handles circular list, for example to introduce
priority queues.
The presented SIMULA version may be used as a base for such
extensions. It would - for example - be easy to introduce
concepts for new scheduling clauses.
Consider the programmer who wants to schedule a process (X)
BEFORE another process (Y) in such manner that X ALWAYS is
ACTIVATED before Y.
Clearly, the statements
AVTIVATE Y AT 100;
ACTIVATE X BEFORE Y;
REACTIVATE Y AT 50;
will have the effect that X is scheduled to the event time
100. However, we are interested in a scheduling mechanism
where X is linked to the activation of Y (whenever that
happens!) in a "dynamic" sense - i.e. even if Y is
REACTIVATED later, X will still be activated before Y.
Consider the new dynamic scheduling:
ACTIVATE Y AT 100;
ACTIVATE X ERE Y;
REACTIVATE Y AT 50;
Now, X will be activated at time 50 (ere[1] Y). In order to
----------------------------------------------------------
[1] Ere is an english synonym to Before.
A Working SIMULA definition of SIMSET and SIMULATION Page 3
2. Use of SIMULA defined versions of SIMSET/SIMULATION
accomplish this, we only need to introduce the following small
changes:
1. Introduce a new attribute to Process - PREDECESSOR.
2. Introduce a new scheduling code "ERE" in procedure
ACTIVATE, which - if either REAC or X was IDLE -
A) Removes X from SQS (if there)
B) Makes Y.PREDECESSOR:- X
3. Changing procedure CURRENT to -
REF (PROCESS) PROCEDURE CURRENT;
INSPECT FIRSTEV.PROC DO
CURRENT:- IF PREDECESSOR == NONE THEN THIS PROCESS ELSE
PREDECESSOR;
4. Modify procedure NEXTEV to:
REF (PROCESS) PROCEDURE NEXTEV;
NEXTEV:-
IF IDLE THEN NONE ELSE IF EVENT.EVSUC == NONE THEN NONE
ELSE
IF EVENT.EVSUC.PROC.PREDECESSOR =/= NONE THEN
EVENT.EVSUC.PROC.PREDECESSOR ELSE
EVENT.EVSUC.PROC;
3. Use in Education
The SIMSET and SIMULATION classes as defined in appendices A
and B, may be used when teaching SIMULA SIMSET/SIMULATION.
Explanation tool
Quite often SIMULATION is taught as something like a "black
box" residing within the SIMULA system. In order to achieve a
higher order of understanding it might be necessary to go into
more detail when describing SIMULATION. Actually, the design
of SIMULATION, ingeniously exploiting Detach and Resume, is a
very nice piece of SIMULA code. I have not - so far - seen
anything like it! One could wonder why. Still the module
consists of less than 200 lines, or less than 3500 characters
of compressed code.
A Working SIMULA definition of SIMSET and SIMULATION Page 4
3. Use in Education
Tracing
The design of SIMSET/SIMULATION is oriented towards the
principle - "Everything is legal, even if it may be
meaningless". Thus, there are several instances where a
warning message could indicate a possible unintentional misuse
of a SIMSET/SIMULATION procedure. Also, an automatic report
generator (tracing) may help to reveal user errors.
4. Debug messages
In order to keep the number of run-time errors low, several
meaningless or suspect calls to system class procedures are
defined as legal in standard SIMULA. Sometimes such calls are
user errors.
A SIMULA version of SIMSET and SIMULATION can easily be
modified to give warning messages in these cases.
The following suspect cases have been identified:
1. X.FOLLOW/PRECEDE(Y);
where Y == NONE.
2. X.FOLLOW/PRECEDE(Y);
where Y does not belong to any Set.
3. X.INTO(Q);
where Q == NONE.
Note that cases 1-3 still have the side effect X.OUT.
4. CANCEL(X);
where X is IDLE.
5. CANCEL(X);
where X == NONE.
6. HOLD(EPS);
where TIME+EPS = TIME due to underflow.
7. [RE]ACTIVATE X DELAY EPS;
C.f. HOLD.
8. [RE]ACTIVATE X AT T;
where T < TIME.
9. ACTIVATE X;
where X was already scheduled.
A Working SIMULA definition of SIMSET and SIMULATION Page 5
4. Debug messages
10. [RE]ACTIVATE X BEFORE/AFTER Y;
where Y
A) Was NONE
B) Was not scheduled (I.e. IDLE)
Note that the side effect PASSIVATE X still will be
performed.
11. [RE]ACTIVATE X AFTER/BEFORE Y;
where X == Y.
Note that the effect here will always be NIL!
12. [RE]ACTIVATE X;
where X == NONE.
(This would have constituted an error if ACTIVATE had been
made an attribute of Process. Same thing for CANCEL.
Could have been nice though:
X.ACTIVATE; Y.CANCEL;
I am not sure why this was not done from the start.)
13. Scheduled Processes at end of simulation.
Though not always an error, a message of the number of
processes still in SQS might be displayed. Actually this
message is only issued if there are more than one process
in SQS (the one usually beeing Main Program). This
warning may help to reveal the user error of forgetting to
Hold Main Program (Hold(SIMPERIOD)).
Note that in all the cases listed above, no warning messages
will be issued using the standard system classes.
Several tracing systems have been proposed (4,5,6). The
presented method makes things very easy for the user.
He just adds:
BEGIN EXTERNAL CLASS ZIMSET, ZIMULATION;
and replaces SIMULATION BEGIN with ZIMULATION BEGIN.
For clarity, the names SIMSET and SIMULATION have been changed
to ZIMSET and ZIMULATION in the SIMULA defined versions.
Alas, he must also change his/her [RE]ACTIVATE statements.
Since the SIMULA syntax has deviated from ALGOL in this
special case, we cannot do better than introduce some new
procedures as substitutes for [RE]ACTIVATE.
Of course, we could force the programmer to use the Common
A Working SIMULA definition of SIMSET and SIMULATION Page 6
4. Debug messages
Base version of ACTIVATE (with another name though), but that
procedure is a bit cumbersome to use.
Thus two procedures:
[RE]ACTIVAT(PROCES,CODE,T,X);
are included in ZIMULATION replacing Common Base ACTIVATE.
- The first parameter is the process to be scheduled.
- Second comes the text CODE which is either
DIRECT, DELAY, AT, AFTER or BEFORE.
- The third parameter is only used when CODE is "DELAY" or "AT".
The final parameter is a process used when CODE is "AFTER" or
"BEFORE".
What about PRIOR?
Since priority scheduling is rather rare, this facility is
implemented using a ZIMULATION Boolean attribute PRIOR_ (PRIOR
is a reserved word in SIMULA). By assigning the value TRUE to
PRIOR_, before calling [RE]ACTIVAT, priority scheduling will
occur. PRIOR_ will be automatically reset to FALSE after the
procedure call.
5. Report procedures
5.1 PROCEDURE REPORT
ZIMSET contains a procedure REPORT with the following
parameters:
1. WARN - CHARACTER by VALUE.
This character is output at the start of each report line.
2. OBJTITLE - TEXT by REF.
The title of the object concerned.
3. T - TEXT by NAME.
Descriptive text.
The output line is formatted like this:
<WARN> <NOW> <OBJTITLE> <T>
A Working SIMULA definition of SIMSET and SIMULATION Page 7
5. Report procedures
where NOW is a VIRTUAL TEXT PROCEDURE returning NOTEXT on the
ZIMSET level.
Using ZIMULATION, NOW is redefined returning TIME in the
format
[xxxD] 00:00[.SS[.secdec]]
The output format is controlled by procedure
SETPARMS(TIMEUNIT,SECDEC);
The TIME is interpreted as being in units of
Days if 1st parm is 'D'
Hours - " - 'H'
Minutes - " - 'M'
Seconds - " - 'S'
SECDEC controls the "Seconds" part of the format. If SECDEC >
0 then SECDEC decimal places will be used. If zero then no
fraction part will appear, else (if < 0) then the Seconds part
will be suppressed all together. The code for the time
editing procedure PUTTIME is included in appendix C.
If TIMEUNIT is none of the characters listed above, PUTFLOAT
format will be used. Putfloat edits a number removing
trailing zeros (and rounding up trailing 9's). The code is
included in appendix D. Using PUTFLOAT, printing 1/16 will
actually result in "0.0625" and nothing else.
The <TIME> field is output only if it differs from that of the
previous output line.
Another debug facility is the two following procedures.
PROCEDURE SETLIST
The ZIMSET procedure SETLIST displays the contents of a set.
Here also non-title objects will be displayed (with the name
"Link Object").
PROCEDURE SQSLIST
The ZIMULATION procedure SQSLIST will display all the
processes in SQS. The output will include the title of object
(or generation number) as well as its event time.
Existing Report generators for SIMULATION naturally gives a
more readable printout (often including queue statistics
A Working SIMULA definition of SIMSET and SIMULATION Page 8
5. Report procedures
etc.). The advantage with the presented trace facilities is
that they demand a minimum of change to existing "pure SIMULA"
SIMULATION programs. Thus, HOLD, PASSIVATE, CANCEL etc need
not be changed - only scheduling statements have to be
slightly edited.
The Sequencing Set (SQS) is implemented according to Common
Base, i.e. using ordinary SIMSET (ZIMSET) circular lists.
The use of a binary tree would of course be much more
efficient (this is how it is actually implemented in standard
SIMULATION). However, if the ZIMULATION class is to be used
in education, the more expensive SIMSET linear list might be
tolerated, and much easier to teach and explain. Defining a
binary tree SQS should be an excellent student exercise.
6. Controlling Debug Output
In order to start tracing the user calls
TRACEON(FILENAME,TRACECODES);
where FILENAME is the name of the generated file. If there
already exists such a file, the new results will be appended
to the end of the file. Default filename (NOTEXT) is Sysout.
The Trace will be started with an identification line giving
Date and Time of day.
TRACECODES governs which mechanisms to trace. It consists of
a string of characters, each uniquely defining one facility.
O Out
F Follow
I Into, Precede
Q Clear, Cardinal
H Hold
P Passivate
C Cancel
D Direct !
A At, Delay ! ACTIVATION
B Before/After ! Messages
R React. message !
An asterisk ("*") will be equivalent to "OFIQHPCDABR".
Tracing is switched off by calling
TRACEOFF;
A Working SIMULA definition of SIMSET and SIMULATION Page 9
6. Controlling Debug Output
Not all objects will be automatically traced.
- Processes will always be traced (after TRACEON i.e.).
However, the identity of the process will just be an anonymous
process generation count number. The user may introduce
his/her own object titles by declaring
TEXT PROCEDURE title;
returning an object specific name.
- Objects IN Linkage, not in Process, will not be traced unless
the user declares a PROCEDURE TITLE not returning NOTEXT.
The following trace messages will be issued. The TRACEON
character code is indicated within ( ).
1. OUT (O)
<NOW> <TITLE> Leaving Set <HEADTITLE>
2. FOLLOW (F)
<NOW> <TITLE> Into (First in) Set <HEADTITLE> or
<NOW> <TITLE> Follows <XTITLE>
3. PRECEDE and INTO (I)
<NOW> <TITLE> Into (Last in) Set <HEADTITLE> or
<NOW> <TITLE> Precedes <XTITLE>
4. CLEAR and CARDINAL (Q)
<NOW> <TITLE> Cleared or
<NOW> <TITLE> Cardinal nnn
5. HOLD (H)
<TIME> <TITLE> Held <EPS> TO <TNEW>
6. PASSIVATE (P)
<TIME> <TITLE> Passivated
This message will also occur when the process terminates.
7. CANCEL (C)
<TIME> <TITLE> Cancelled - Evtime <OLDEVTIME>
8. ACTIVATE (D)
<TIME> <TITLE> ACTIVATED
9. ACTIVATE DELAY/AT (A)
<TIME> <TITLE> will be ACT. Delay 0 [PRIOR]
<TIME> <TITLE> will be ACT. AT <EVTIME> [PRIOR]
<TIME> <TITLE> will be Delayed to <EVTIME> [PRIOR]
A Working SIMULA definition of SIMSET and SIMULATION Page 10
6. Controlling Debug Output
10. ACTIVATE AFTER/BEFORE (B)
<TIME> <TITLE> ACT. AFTER <YTITLE> Sch at <YEVTIME>
<TIME> <TITLE> ACT. BEFORE <YTITLE> Sch at <YEVTIME>
11. REACTIVATE (R)
<TIME> <TITLE> Was REACT. from <OLDEVTIME>
This message is an explanation following messages 4-6
above if REACTIVAT rather than ACTIVAT was used.
The initial time field is output only if it is different from
that of the previous output line.
7. Demonstration Example
In (4) is demonstrated a simple simulation program describing
trucks moving cargo from a harbour to a factory.
The complete program looks as follows.
BEGIN
EXTERNAL PROCEDURE abort,write; [1]
EXTERNAL TEXT PROCEDURE conc,upcase,puttime,putfloat,
inline,today,daytime;
EXTERNAL CLASS zimset,zimulation;
zimulation BEGIN
REF (platform) harbour, store, factory;
INTEGER i, u;
process CLASS truck(truckname); VALUE truckname;
TEXT truckname;
BEGIN
TEXT PROCEDURE title; title:- truckname;
WHILE TRUE DO
BEGIN
hold(harbour.traveltime);
activat(harbour,"Delay",0,NONE);
wait(harbour.queue);
IF Draw(0.5,u) THEN
BEGIN
hold(store.traveltime);
------------------------------------------------------------
[1] The external procedures used in this report are all part of
the Utility Program Library on the DEC-10 SIMULA System. See
SIMULA Language Handbook, Part 3, FOA Report C10045-M3(E5), 1976.
A Working SIMULA definition of SIMSET and SIMULATION Page 11
7. Demonstration Example
activat(store,"Delay",0,NONE);
wait(store.queue);
END ELSE
BEGIN
hold(factory.traveltime);
activat(factory,"Delay",0,NONE);
END
END of loop
END of truck;
head CLASS platformhead(headtitle); TEXT headtitle;
BEGIN TEXT PROCEDURE title; title:- headtitle;
END platformhead;
process CLASS platform(pfname,platformtime,
traveltime);
VALUE pfname; TEXT pfname;
REAL platformtime, traveltime;
BEGIN REF (platformhead) queue;
TEXT PROCEDURE title; title:- pfname;
queue:- NEW platformhead(conc(pfname,"queue"));
WHILE TRUE DO
BEGIN
INSPECT queue.first WHEN truck DO
BEGIN
out; hold(platformtime);
activat(THIS truck,"Direct",0,NONE);
END OTHERWISE passivate;
END loop
END of platform;
setparms('!',0); ! PUTFLOAT format;
traceon("Sysout","*");
harbour:- NEW platform("Harbour",10,20);
activat(harbour,"Direct",0,NONE);
store:- NEW platform("Store",15,20);
activat(store,"Direct",0,NONE);
factory:- NEW platform("Factory",17,20);
activat(factory,"Direct",0,NONE);
FOR i:= 1 STEP 1 UNTIL 5 DO
activat(NEW truck(conc("Truck ",putfloat(Blanks(1),i))),
"Direct",0,NONE);
hold(20); setlist(harbour.queue);
hold(55); setlist(store.queue); sqslist;
hold(125);
END zimulation
END of program
A Working SIMULA definition of SIMSET and SIMULATION Page 12
7. Demonstration Example
An excerpt of the output:
*** Trace generated 1976-09-02 at 9:50:12 ***
0 Harbour ACTIVATED
: 20 Harbourqueue Set Member List ----
: Truck 1
: Truck 2
: Truck 3
: Truck 4
: Truck 5
: ----------- End of List ----
Main Program Held 55 to 75
Truck 1 Leaving Set Harbourqueue
Harbour Held 10 to 30
30 Truck 1 ACTIVATED
......................................................
70 Truck 1 Into (Last in) Set Harbourqueue
Truck 3 Into (Last in) Set Storequeue
Truck 5 ACTIVATED
Truck 5 Held 20 to 90
Truck 1 Leaving Set Harbourqueue
Harbour Held 10 to 80
: 75 Storequeue Set Member List ----
: Truck 3
: ----------- End of List ----
: ---- Scheduled Processes ----
: Evtime Title
: 75 Main Program
: 75 Store
: 80 Truck 4
: 80 Harbour
: 90 Truck 5
: ---- End of SQS List --------
Main Program Held 125 to 200
Truck 2 ACTIVATED
Truck 2 Held 20 to 95
Truck 3 Leaving Set Storequeue
Store Held 15 to 90
80 Truck 4 Into (Last in) Set Storequeue
......................................................
195 Truck 4 Into (Last in) Set Harbourqueue
! 200 5 Remaining Processes in SQS
A Working SIMULA definition of SIMSET and SIMULATION Page 13
8. Using HIDDEN PROTECTED
8. Using HIDDEN PROTECTED
The HIDDEN PROTECTED concepts, as proposed by Palme (2) and
now formally defined by the SIMULA Development Group (3) have
made it possible to hide those quantities that should not be
accessible to the user.
A short summary of these concepts.
- An attribute may be specified PROTECTED on the level where it
is introduced. This will have the effect that this attribute
will not be accessible through remote access.
- An attribute may be specified HIDDEN if it is PROTECTED,
having the effect that it will not be accessible in the prefix
chain (subclasses or prefixed blocks). Thus an attribute may
also be specified HIDDEN at an inner level to the one where it
was PROTECTED.
How are these mechanisms used in ZIMSET and ZIMULATION?
In ZIMSET, CLASS Linkage has been defined according to:
CLASS Linkage;
PROTECTED isuc,ipred;
BEGIN REF (Linkage) isuc,ipred;
REF (Link) PROCEDURE suc;
IF isuc IN Link THEN suc:- isuc;
REF (Link) PROCEDURE pred;
IF ipred IN Link THEN pred:- ipred;
REF (Linkage) PROCEDURE prev;
prev:- ipred;
END of Linkage;
CLASS Link is defined:
Linkage CLASS Link;
HIDDEN ipred,isuc;
BEGIN
....Procedures INTO, PRECEDE, FOLLOW as in Common Base
END of Link;
Likewise, IPRED and ISUC are hidden in CLASS HEAD, thus making
these attributes completely inaccessible. Note that an HIDDEN
attribute is accessible at the level of the HIDDEN
specification!
A Working SIMULA definition of SIMSET and SIMULATION Page 14
8. Using HIDDEN PROTECTED
The Linkage attributes ISUC and IPRED are still visible inside
inner levels to Linkage - not IN Head or Link. The user must
therefore himself hide ISUC and IPRED in his subclasses to
Linkage (if any!).
Alternatively we could have introduced a LINKAGETEMP,
identical to LINKAGE adding a new LINKAGE level where ISUC and
IPRED are HIDDEN. HEAD and LINK then would be prefixed by
LINKAGETEMP of course. Finally LINKAGETEMP would have been
made HIDDEN PROTECTED in ZIMSET itself.
In ZIMULATION, the following changes have been made.
At the system CLASS level, the following quantities are
specified HIDDEN PROTECTED -
EVENTNOTICE, SQS, FIRSTEV, IMAIN, MAINPROGRAM, PROCESSTEMP
Since the attributes of EVENTNOTICE, EVTIME and PROC are
inaccessible due to the inaccessibility of EVENTNOTICE
qualification, there is no need to hide the individual
attributes. This could not have been done anyway - the
attributes are accessed remotely within ZIMULATION.
There remains one trouble spot, though. In ACTIVATE, the
first parameter is the Process concerned. The procedure makes
access (remotely) of the secret attributes ITERMINATED and
EVENT. Since we cannot PROTECT them at an inner level we must
invent some trick.
The trick is to define an intermediate CLASS PROCESSTEMP -
Link CLASS processtemp;
PROTECTED iterminated;
BEGIN
REF (eventnotice) event; BOOLEAN iterminated;
BOOLEAN PROCEDURE terminated;
terminated:= iterminated;
... etc. according to Common Base
END of process temporarily defined;
We now define our Process level -
processtemp CLASS Process;
HIDDEN iterminated;
BEGIN
event:
END of Process;
A Working SIMULA definition of SIMSET and SIMULATION Page 15
8. Using HIDDEN PROTECTED
By redeclaring EVENT to a (harmless?) LABEL, the original
meaning of EVENT will be inaccessible to the user. Note that
we cannot hide and protect the new (label) EVENT, since that
would have made the old one visible. Alternatively we could
not PROTECT the original EVENT since it is used remotely in
ACTIVATE..subtitle 9. Conclusions
9. Conclusions
As stated above, the presented SIMULA definition of SIMSET and
SIMULATION could be used as a base for further extensions of
queue handling and discrete event facilities.
On the other hand, the described trace and debugging
facilities may easily be included as a part of the built-in
system classes. The SIMULA Development Group is currently
discussing this issue. It is the authors hope that this
report will highlight some of the diagnostic possiblities that
may be considered.
A Working SIMULA definition of SIMSET and SIMULATION Page 16
8. Using HIDDEN PROTECTED
References:
1. COMMON BASE Language by O.Dahl, B.Myrhaug, K.Nygaard.
Norwegian Computing Center, Publication No. S-22, October
1970, Oslo.
2. Protected Program Modules in SIMULA67 by J.Palme, Swedish
National Defense Research Institute, FOA P Report
C8372-M3(E5), July 1973, Stockholm.
3. SIMULA Development Group Recommendation No. 1 Accepted in
September 1976, Nordwijkerhout, Holland.
4. Putting Statistics into a SIMULA Program by J.Palme,
Swedish National Defense Research Institute, FOA 1 Report
C10030-M3(E5), August 1975, Stockholm.
5. Report Generator for SIMULA by Bjarne Bredrup, 3rd SIMULA
User's Conference, September 1975, Brighton.
6. SIMON 75 Reference Manual by Robin Hills and Graham
Birtwistle, Robin Hills (Consultant) Ltd., Surrey,
England, November 1975.
A Working SIMULA definition of SIMSET and SIMULATION Page 17
Appendix A - Source Code of ZIMSET
Appendix A - Source Code of ZIMSET
Lines containing !; may be removed in order to get a
non-report version. ! is an alternative hardware
representation of COMMENT on the DEC-10 SIMULA System.
EXTERNAL TEXT PROCEDURE upcase,conc,today,daytime;
CLASS zimset;
!;PROTECTED traceon_zimset,traceoff_zimset;
!;HIDDEN PROTECTED trace;
!;VIRTUAL: TEXT PROCEDURE now;
BEGIN
CLASS linkage;
PROTECTED i_suc,i_pred;
VIRTUAL: TEXT PROCEDURE title;
BEGIN
REF (linkage) i_suc,i_pred;
TEXT PROCEDURE title;;
REF (link) PROCEDURE suc;
IF i_suc IN link THEN suc:- i_suc;
REF (link) PROCEDURE pred;
IF i_pred IN link THEN pred:- i_pred;
REF (linkage) PROCEDURE prev;
prev:- i_pred;
END of linkage;
linkage CLASS link;
HIDDEN i_suc,i_pred;
BEGIN
REF (head) PROCEDURE sethead;
! Test if last;
INSPECT i_suc WHEN head DO
sethead:- THIS head
OTHERWISE ! Move forward;
BEGIN REF (linkage) x;
x:- THIS link.i_pred;
WHILE x IN link DO x:- x.i_pred;
INSPECT x WHEN head DO
sethead:- THIS head;
END of sethead;
PROCEDURE out;
IF i_suc =/= NONE THEN
BEGIN
A Working SIMULA definition of SIMSET and SIMULATION Page 18
Appendix A - Source Code of ZIMSET
!; TEXT t;
!; t:- title;
!; IF (IF trace[1] THEN t =/= NOTEXT ELSE FALSE) THEN
!; report(' ',t,conc(" Leaving Set ",sethead.title));
!;
i_suc.i_pred:- i_pred;
i_pred.i_suc:- i_suc;
i_suc:- i_pred:- NONE
END of out;
PROCEDURE follow(x); REF (linkage) x;
BEGIN out;
IF x =/= NONE THEN
BEGIN
IF x.i_suc =/= NONE THEN
BEGIN
i_pred:- x;
i_suc:- x.i_suc;
i_suc.i_pred:- x.i_suc:- THIS linkage;
!; IF (IF trace[2] THEN title =/= NOTEXT ELSE
!; FALSE) THEN
!; report(' ',title,
!; IF x IN head THEN
!; conc(" Into (First in) Set ",x.title) ELSE
!; conc(" Follows ",x.title," of Set ",
!; x QUA link.sethead.title));
END
x C ELSE !;
!; report('?',title,
!; conc(" Could not Follow Non-Set member ",
!; x.title));
END
ELSE report('?',title," Could not Follow NONE"); !;
END of follow;
PROCEDURE precede(x); REF (linkage) x;
BEGIN out;
IF x =/= NONE THEN
BEGIN
IF x.i_suc =/= NONE THEN
BEGIN
!; TEXT t;
i_suc:- x;
i_pred:- x.i_pred;
i_pred.i_suc:- x.i_pred:- THIS linkage;
!; t:- title;
!; IF (IF trace[3] THEN t =/= NOTEXT ELSE FALSE)
!; THEN
!; report(' ',t,
!; IF x IN head THEN
!; conc(" Into (Last in) Set ",x.title) ELSE
A Working SIMULA definition of SIMSET and SIMULATION Page 19
Appendix A - Source Code of ZIMSET
!; conc(" Precedes ",x.title," of Set ",
!; x QUA link.sethead.title));
END
ELSE !;
!; report('?',title,
!; conc(" Could not Precede Non-Set member ",
!; x.title));
END
ELSE report('?',title," Could not Precede NONE"); !;
END of precede;
PROCEDURE into(s); REF (head) s;
!; IF s == NONE THEN
!; BEGIN out;
!; report('?',title," Could not move Into NONE")
!; END ELSE
precede(s);
END of link;
linkage CLASS head;
HIDDEN i_suc,i_pred;
BEGIN
REF (link) PROCEDURE first; first:- suc;
REF (link) PROCEDURE last; last:- pred;
BOOLEAN PROCEDURE empty;
empty:= i_suc == THIS linkage;
INTEGER PROCEDURE cardinal;
BEGIN INTEGER i; REF (linkage) x;
x:- THIS linkage;
FOR x:- x.suc WHILE x =/= NONE DO i:= i + 1;
cardinal:= i;
!; IF (IF trace[4] THEN title =/= NOTEXT ELSE FALSE)
!; THEN
!; BEGIN TEXT t; t:- Blanks(5); t.Putint(i);
!; report(' ',title,conc(" Cardinal ",t));
!; END trace;
END of cardinal;
PROCEDURE clear;
BEGIN REF (link) x;
FOR x:- first WHILE x =/= NONE DO x.out;
!; IF (IF trace[4] THEN title =/= NOTEXT ELSE FALSE)
!; THEN
!; report(' ',title," Cleared");
END of clear;
i_suc:- i_pred:- THIS linkage
A Working SIMULA definition of SIMSET and SIMULATION Page 20
Appendix A - Source Code of ZIMSET
END of head;
!; PROCEDURE setlist(s); REF (head) s;
!; IF tracefile =/= NONE THEN
!; BEGIN
!; tracefile.Outimage;
!; IF s == NONE THEN
!; report('?',NOTEXT," SETLIST Called for NONE") ELSE
!; BEGIN REF (link) x; INTEGER p; TEXT t;
!; report(':',s.title," Set Member List ----");
!; x:- s.first;
!; WHILE x =/= NONE DO
!; BEGIN t:- x.title;
!; report(':',IF t == NOTEXT THEN Copy("Link Object")
!; ELSE t,NOTEXT);
!; x:- x.suc
!; END loop;
!; report(':',
!; Copy("-----------")," End of List ----");
!; END s not none;
!; tracefile.Outimage;
!; END of setlist;
!;
!; PROCEDURE traceon(filespec,dotrace);
!; VALUE filespec,dotrace; TEXT filespec,dotrace;
!; BEGIN CHARACTER c;
!; INSPECT tracefile DO
!; BEGIN Outimage; Close END;
!; IF filespec == NOTEXT THEN tracefile:- Sysout ELSE
!; IF upcase(filespec) = "SYSOUT" THEN
!; tracefile:- Sysout ELSE
!; BEGIN
!; tracefile:- NEW
!; Outfile(conc(filespec,"/ACCESS:APPEND"));
!; tracefile.Open(Blanks(80));
!; END not Sysout;
!; IF dotrace = "*" THEN
!; BEGIN dotrace.Setpos(0);
!; ! Inhibit WHILE loop on dotrace;
!; trace[1]:= trace[2]:= trace[3]:= trace[4]:= TRUE
!; END set all ELSE upcase(dotrace);
!; WHILE dotrace.More DO
!; BEGIN c:= dotrace.Getchar;
!; IF c = 'O' THEN trace[1]:= TRUE ELSE
!; IF c = 'F' THEN trace[2]:= TRUE ELSE
!; IF c = 'I' THEN trace[3]:= TRUE ELSE
!; IF c = 'Q' THEN trace[4]:= TRUE;
!; END loop;
!;
!; INSPECT tracefile DO
!; BEGIN Outimage;
A Working SIMULA definition of SIMSET and SIMULATION Page 21
Appendix A - Source Code of ZIMSET
!; Outtext("*** Trace generated ");
!; Outtext(today); Outtext(" at ");
!; Outtext(daytime); Outtext(" ***");
!; Outtext(" Trace Codes: ");
!; Outtext(IF dotrace = "*" THEN Copy("All") ELSE
!; dotrace);
!; Outimage; Outimage
!; END inspect tracefile;
!; END trace on;
!;
!; PROCEDURE traceon_zimset(t1,t2); TEXT t1,t2;
!; traceon(t1,t2);
!;
!; PROCEDURE traceoff;
!; BEGIN INTEGER i;
!; IF tracefile =/= Sysout THEN
!; INSPECT tracefile DO Close;
!; tracefile:- NONE;
!; FOR i:= 1 STEP 1 UNTIL 4 DO
!; trace[i]:= FALSE;
!; END of trace off;
!;
!; PROCEDURE traceoff_zimset;
!; traceoff;
!;
!; BOOLEAN ARRAY trace[1:4];
!;
!; PROCEDURE report(warn,objtitle,t); NAME t;
!; TEXT t,objtitle;
!; CHARACTER warn;
!; INSPECT tracefile DO
!; BEGIN INTEGER p;
!; Outchar(warn); Outtext(now);
!; p:= Pos; Outtext(objtitle);
!; Setpos(p+12);
!; Outtext(t); Outimage;
!; END of report;
!;
!; TEXT PROCEDURE now; ;
!;
!; REF (Outfile) tracefile;
END of zimset;
A Working SIMULA definition of SIMSET and SIMULATION Page 22
Appendix B - Source Code of ZIMULATION
Appendix B - Source Code of ZIMULATION
Lines containing !; may be removed in order to get a
non-report version.
EXTERNAL PROCEDURE abort;
EXTERNAL TEXT PROCEDURE
upcase,conc,puttime,putfloat,today,daytime;
EXTERNAL CLASS zimset;
zimset CLASS zimulation;
!;HIDDEN traceon_zimset,traceoff_zimset;
HIDDEN PROTECTED event_notice,sqs,first_ev,main_,
main_program,process_temp
!;,mp_title,timefield1,timefield2,timefield3
!;,oldtime,activate_,trace,process_count
;
BEGIN
link CLASS event_notice(ev_time,proc_);
REAL ev_time; REF (process) proc_;
BEGIN
REF (event_notice) PROCEDURE ev_suc;
IF suc IS event_notice THEN ev_suc:- suc;
PROCEDURE Rank(before_); BOOLEAN before_;
BEGIN REF (event_notice) p;
p:- sqs.last;
WHILE p.ev_time > ev_time DO p:- p.prev;
IF before_ THEN
BEGIN
WHILE p.ev_time = ev_time DO p:- p.prev;
END;
follow(p);
END of rank;
END of event notice;
link CLASS process_temp;
PROTECTED i_terminated;
BEGIN
REF (event_notice) event_; BOOLEAN i_terminated;
!; TEXT process_title;
!; TEXT PROCEDURE title; title:- process_title;
!;
BOOLEAN PROCEDURE terminated;
terminated:= i_terminated;
BOOLEAN PROCEDURE idle;
A Working SIMULA definition of SIMSET and SIMULATION Page 23
Appendix B - Source Code of ZIMULATION
idle:= event_ == NONE;
REAL PROCEDURE evtime;
IF idle THEN abort("Evtime of Idle Process") ELSE
evtime:= event_.ev_time;
REF (process) PROCEDURE nextev;
nextev:-
IF idle THEN NONE ELSE
IF event_.ev_suc == NONE THEN NONE ELSE
event_.ev_suc.proc_;
!; process_title:- Copy("(***)").Sub(2,3);
!; process_count:= process_count + 1;
!; process_title.Putint(process_count);
!; process_title:- process_title.Main;
Detach;
INNER;
i_terminated:= TRUE;
passivate;
abort("Activation of Terminated Process");
END of process temporarily defined;
process_temp CLASS process;
HIDDEN i_terminated;
BEGIN
event_: ;
END of process;
REF (event_notice) PROCEDURE first_ev;
first_ev:- sqs.first;
REF (process) PROCEDURE current;
current:- first_ev.proc_;
REAL PROCEDURE time;
time:= first_ev.ev_time;
PROCEDURE hold(t); REAL t;
INSPECT first_ev DO
BEGIN
IF t > 0 THEN
!; BEGIN REAL oldt; oldt:= ev_time;
!; IF trace[1] THEN
!; report(' ',proc_.title,conc(" Held",
!; puttime(timefield1,t,timeunit,secdec)," to",
!; puttime(timefield3,ev_time+t,timeunit,secdec)));
ev_time:= ev_time + t;
!; IF oldt = ev_time THEN
!; report('!',proc_.title," Hold arg. UNDERFLOW");
A Working SIMULA definition of SIMSET and SIMULATION Page 24
Appendix B - Source Code of ZIMULATION
!; END;
IF ev_suc =/= NONE THEN
BEGIN
IF ev_suc.ev_time <= ev_time THEN
BEGIN out; Rank(FALSE);
Resume(current);
END
END
END of hold;
PROCEDURE passivate;
BEGIN
INSPECT current WHEN process_temp DO
BEGIN
!; IF trace[2] THEN
!; report(' ',title," Passivated");
event_.out; event_:- NONE
END;
IF sqs.empty THEN
abort("Passivating last Process in SQS")ELSE
Resume(current);
END of passivate;
PROCEDURE wait(s); REF (head) s;
BEGIN
current.into(s); passivate
END of wait;
PROCEDURE cancel(x); REF (process) x;
IF x == current THEN passivate ELSE
INSPECT x WHEN process_temp DO
IF event_ =/= NONE THEN
BEGIN
!; IF trace[3] THEN
!; report(' ',title,conc(" Cancelled - Evtime ",
!; puttime(timefield1,event_.ev_time,timeunit,secdec)));
event_.out; event_:- NONE
END of cancel
ELSE !;
!; report('?',title," Cancelled (was not scheduled)")
!; OTHERWISE
!; report('?',Copy("NONE")," could not be Cancelled")
;
PROCEDURE activate_(reac,x,code,t,y,prior_);
VALUE code; TEXT code;
REF (process_temp) x,y; BOOLEAN reac,prior_; REAL t;
INSPECT x DO
IF NOT terminated THEN
BEGIN REF (process_temp) z; REF (event_notice) ev;
IF reac THEN ev:- event_ ELSE
IF event_ =/= NONE THEN
A Working SIMULA definition of SIMSET and SIMULATION Page 25
Appendix B - Source Code of ZIMULATION
!; BEGIN
!; report('?',title,
!; conc(" unsucc. ACT. - already sched. at",
!; puttime(timefield1,event_.ev_time,timeunit,secdec)));
!;
GO TO exit;
!; END;
z:- current;
IF upcase(code) = "DIRECT" THEN
direct: BEGIN
!; IF trace[4] THEN
!; report(' ',title," ACTIVATED");
event_:- NEW event_notice(time,x);
event_.precede(first_ev)
END direct ELSE
IF code = "DELAY" THEN
BEGIN
!; REAL oldt; oldt:= t;
t:= t + time;
!; IF time = t AND oldt > 0 THEN
!; report('!',title," DELAY arg. UNDERFLOW");
GO TO at_
END delay ELSE
IF code = "AT" THEN
at_: BEGIN
IF t < time THEN
!; BEGIN
!; report('?',title,conc(" Time > AT-arg: ",
!; puttime(timefield1,t,timeunit,secdec)));
t:= time;
!; END;
IF t = time AND prior_ THEN GO TO direct;
!; IF trace[5] THEN
!; BEGIN
!; IF t = time THEN
!; report(' ',title,conc(
!; IF code = "AT" THEN
!; Copy(" will be ACT. AT Time (Now) ") ELSE
!; Copy(" will be ACT. Delay 0 "),
!; IF prior_ THEN Copy(" PRIOR") ELSE NOTEXT))
!; ELSE
!; report(' ',title,conc(
!; IF code = "AT" THEN Copy(" will be ACT. AT ")
!; ELSE
!; Copy(" will be Delayed to"),
!; puttime(timefield1,t,timeunit,secdec),
!; IF prior_ THEN Copy(" PRIOR") ELSE NOTEXT));
!; END trace[5] on;
event_:- NEW event_notice(t,x);
event_.Rank(prior_);
END at ELSE
A Working SIMULA definition of SIMSET and SIMULATION Page 26
Appendix B - Source Code of ZIMULATION
IF (IF y == NONE THEN TRUE ELSE y.event_ == NONE) THEN
!; BEGIN
!; report('?',title,conc(" Passivated due to ACT. ",
!; code,
!; IF y == NONE THEN Copy(" NONE") ELSE
!; conc(" Idle obj. ",y.title)));
event_:- NONE
!; END
ELSE
IF (IF code = "AFTER" THEN TRUE ELSE code = "BEFORE")
THEN
BEGIN
IF x == y THEN
!; BEGIN
!; report('?',title,conc(" unsucc. ACT. ",code,
!; " itself"));
GO TO exit;
!; END;
! Reactivate x before/after y;
!; IF trace[6] THEN
!; report(' ',title,conc(" ACT. ",code," ",y.title,
!; " sched. at",
!; puttime(timefield1,y.event_.ev_time,timeunit,
!; secdec)));
event_:- NEW event_notice(y.event_.ev_time,x);
IF code = "BEFORE" THEN event_.precede(y.event_) ELSE
event_.follow(y.event_);
END before or after ELSE
abort(conc("Illegal parm. to ACTIVATE - Code: ",code));
IF ev =/= NONE THEN
BEGIN
!; IF trace[7] THEN
!; report(' ',title,conc(" was REACT. from ",
!; puttime(timefield1,ev.ev_time,timeunit,secdec)));
ev.out;
IF sqs.empty THEN abort("SQS Empty")
END;
IF z =/= current THEN Resume(current);
exit:
END of activate
ELSE !;
!; report('?',Copy(" (TERM.OBJ) "),
!; " Attempt to ACT. terminated object")
!; OTHERWISE
!; report('?',Copy("NONE"),conc(" could not be ",
!; IF reac THEN Copy("RE") ELSE NOTEXT,"ACTIVATED"))
;
PROCEDURE reactivat(x,code,t,y);
NAME code; REF (process_temp) x,y; TEXT code;
A Working SIMULA definition of SIMSET and SIMULATION Page 27
Appendix B - Source Code of ZIMULATION
REAL t;
BEGIN
activate_(TRUE,x,code,t,y,prior_); prior_:= FALSE;
END of reactivat;
PROCEDURE activat(x,code,t,y);
NAME code; REF (process_temp) x,y; TEXT code;
REAL t;
BEGIN
activate_(FALSE,x,code,t,y,prior_); prior_:= FALSE;
END of activat;
BOOLEAN prior_;
PROCEDURE accum(a,b,c,d); NAME a,b,c; REAL a,b,c,d;
BEGIN a:= a + c*(time-b);
b:= time; c:= c + d
END of accum;
process CLASS main_program;
BEGIN
!; TEXT PROCEDURE title; title:- mp_title;
l: Detach; GO TO l
END of main program;
REF (process) PROCEDURE Main; Main:- main_;
REF (main_program) main_;
REF (head) sqs;
!; PROCEDURE sqslist;
!; INSPECT tracefile DO
!; BEGIN REF (event_notice) en;
!; Outimage;
Outtext(":---- Scheduled Processes ----"); Outimage;
!;
!; Outchar(':'); Setpos(timefield1.Length-4);
!; Outtext("Evtime Title"); Outimage;
!; FOR en:- sqs.first QUA event_notice,
!; en.suc WHILE en =/= NONE DO
!; BEGIN Outchar(':');
!; Outtext(puttime(timefield1,en.ev_time,timeunit,
!; secdec));
!; Setpos(Pos+4); Outtext(en.proc_.title); Outimage;
!;
!; END loop;
!; Outtext(":---- End of SQS List --------"); Outimage;
!;
!; Outimage;
!; END of sqslist;
!;
A Working SIMULA definition of SIMSET and SIMULATION Page 28
Appendix B - Source Code of ZIMULATION
!; TEXT PROCEDURE now;
!; ! NOW returns leading part of messages.
!; ! Should end with blank;
!; BEGIN
!; IF time > oldtime THEN
!; BEGIN oldtime:= time;
!; puttime(timefield2,oldtime,timeunit,secdec);
!; END ELSE timefield2:= NOTEXT;
!; now:- timefield2.Main
!; END of now;
!; PROCEDURE traceon(filespec,dotrace);
!; VALUE filespec,dotrace; TEXT filespec,dotrace;
!; BEGIN CHARACTER c;
!; IF dotrace = "*" THEN
!; BEGIN INTEGER i;
!; FOR i:= 1 STEP 1 UNTIL 7 DO trace[i]:= TRUE;
!; dotrace.Setpos(0); ! Inhibit WHILE loop on dotrace;
!;
!; END ELSE upcase(dotrace);
!; WHILE dotrace.More DO
!; BEGIN c:= dotrace.Getchar;
!; IF c = 'H' THEN trace[1]:= TRUE ELSE
!; IF c = 'P' THEN trace[2]:= TRUE ELSE
!; IF c = 'C' THEN trace[3]:= TRUE ELSE
!; IF c = 'D' THEN trace[4]:= TRUE ELSE
!; IF c = 'A' THEN trace[5]:= TRUE ELSE
!; IF c = 'B' THEN trace[6]:= TRUE ELSE
!; IF c = 'R' THEN trace[7]:= TRUE;
!; END loop;
!; traceon_zimset(filespec,dotrace);
!; END of traceon;
!;
!; PROCEDURE traceoff;
!; BEGIN INTEGER i;
!; FOR i:= 1 STEP 1 UNTIL 7 DO
!; trace[i]:= FALSE;
!; traceoff_zimset;
!; END of traceoff;
!;
!; PROCEDURE setparms(unit,dec); CHARACTER unit;
!; INTEGER dec;
!; BEGIN
!; IF unit = 'd' THEN unit:= 'D' ELSE
!; IF unit = 'h' THEN unit:= 'H' ELSE
!; IF unit = 'm' THEN unit:= 'M' ELSE
!; IF unit = 's' THEN unit:= 'S';
!; timeunit:= unit;
!; secdec:= dec;
!; timefield2:-
!; Blanks(IF secdec < 0 THEN 13 ELSE
A Working SIMULA definition of SIMSET and SIMULATION Page 29
Appendix B - Source Code of ZIMULATION
!; IF secdec = 0 THEN 16 ELSE secdec + 17);
!; timefield1:- Blanks(timefield2.Length-1);
!; timefield3:- Blanks(timefield1.Length);
!; ! Note - one extra blank at end of timefields.;
!; timefield2:- timefield2.Sub(1,timefield2.Length-1);
!; END of setparms;
!;
!; TEXT timefield1,timefield2,timefield3,mp_title;
!; CHARACTER timeunit; INTEGER secdec,process_count;
!; BOOLEAN ARRAY trace[1:7];
!; REAL oldtime;
!; setparms('M',-1); oldtime:= -1;
!;
!; mp_title:- Copy("Main Program");
sqs:- NEW head;
main_:- NEW main_program;
INSPECT main_ WHEN process_temp DO
BEGIN
event_:- NEW event_notice(0,main_);
event_.into(sqs);
END;
INNER;
!; IF sqs.first =/= sqs.last THEN
!; BEGIN TEXT t;
!; t:- Blanks(5);
!; t.Putint(sqs.cardinal);
!; report('!',t," Remaining Processes in SQS");
!; END sqs not empty;
!; traceoff;
END of zimulation;
A Working SIMULA definition of SIMSET and SIMULATION Page 30
Appendix C - Source Code of PUTTIME
Appendix C - Source Code of PUTTIME
TEXT PROCEDURE puttime(field,time,unit,secdec);
TEXT field; REAL time; CHARACTER unit; INTEGER secdec;
! Puttime edits a REAL variable representing a TIME value
! left justified into the text fIELD in
! seconds if UNIT = 'S'
! minutes if UNIT = 'M'
! hours if UNIT = 'H'
! days if UNIT = 'D'
! Else PUTFLOAT editing will be used.
!
! The FIELD must have a minimum length of
! 12 if secdec < 0
! 15 if secdec = 0
! 16+secdec if secdec > 0
!
! Format:
!
! [-]dddD hh:mm[.ss[.xxx...]]
!
! where
! ddd is number of days (Blanked if day < 1)
! hh is number of hours
! mm is number of minutes
! ss is number of seconds (only if SECDEC >= 0)
! xxx is fraction of second with SECDEC digits
!
! PUTTIME also returns a reference to parameter FIELD.
! Thus it can be used as parameter to Outtext -
! i.e. Outtext(puttime(field,Time,'H',-1);
! or editing Image directly -
! puttime(Image.Sub(Pos,17),Time,'H',-1);
!
! Restriction - TIME must not exceed MAXINT (the greatest
! representable integer).
!;
IF field.Length >=
(IF secdec < 0 THEN 12 ELSE IF secdec = 0 THEN 15 ELSE
secdec+16)
THEN
BEGIN INTEGER days,hours,m,powersec; REAL seconds;
PROCEDURE fixedit(x,w); REAL x; INTEGER w;
BEGIN
field.Sub(field.Pos,w).Putfix(x,secdec);
field.Setpos(field.Pos+w);
END of fixedit;
PROCEDURE intedit(i,w); INTEGER i,w;
BEGIN
A Working SIMULA definition of SIMSET and SIMULATION Page 31
Appendix C - Source Code of PUTTIME
field.Sub(field.Pos,w).Putint(i);
IF field.Getchar = ' ' THEN
BEGIN field.Setpos(field.Pos-1);
field.Putchar('0');
END;
field.Setpos(field.Pos-1+w);
END of intedit;
BOOLEAN PROCEDURE adjusted;
BEGIN
IF m = 60 THEN
BEGIN adjusted:= TRUE;
hours:= hours + 1; m:= 0;
IF hours = 24 THEN
BEGIN days:= days + 1; hours:= 0 END
END;
field.Sub(2,6):= " D ";
field.Setpos(5);
IF days < 1 THEN
field.Putchar(' ') ELSE
IF days < 10 THEN
BEGIN
field.Setpos(4);
field.Putchar(Char(days+Rank('0')));
END ELSE
IF days < 100 THEN
BEGIN field.Setpos(3); intedit(days,2) END ELSE
IF days < 1000 THEN
BEGIN field.Setpos(2); intedit(days,3) END ELSE
IF days <= 9999 AND days >= -999 THEN
BEGIN field.Setpos(1); intedit(days,4) END ELSE
field.Sub(1,4):= "****";
field.Setpos(8);
intedit(hours,2); field.Putchar(':');
END of adjust;
powersec:= 1;
FOR m:= 1 STEP 1 UNTIL secdec DO powersec:= powersec*10;
IF unit = 'D' THEN time:= 1440*time ELSE
IF unit = 'H' THEN time:= 60*time ELSE
IF unit = 'M' THEN ELSE
IF unit = 'S' THEN time:= time/60 ELSE
BEGIN putfloat(field,time);
GO TO stop
END;
field.Setpos(1);
field.Putchar(IF time < 0 THEN '-' ELSE ' ');
time:= Abs(time);
IF time > MAXINT THEN GO TO error;
m:= Entier(time);
A Working SIMULA definition of SIMSET and SIMULATION Page 32
Appendix C - Source Code of PUTTIME
seconds:= 60*(time - m);
hours:= m//60;
m:= Mod(m,60);
days:= hours//24;
hours:= Mod(hours,24);
IF secdec >= 0 THEN
BEGIN
IF Entier(seconds*powersec+0.5) = 60*powersec THEN
BEGIN m:= m + 1; seconds:= 0 END;
adjusted;
intedit(m,2); field.Putchar('.');
IF seconds < 9.5 THEN
BEGIN field.Putchar('0');
fixedit(seconds,IF secdec = 0 THEN 1 ELSE secdec+2)
END ELSE
fixedit(seconds,IF secdec = 0 THEN 2 ELSE secdec+3);
END ELSE
BEGIN time:= m + seconds/60;
m:= time;
IF adjusted THEN time:= 0;
IF time < 9.5 THEN field.Putchar('0');
secdec:= 0;
fixedit(time,IF time < 9.5 THEN 1 ELSE 2)
END;
stop:
field.Setpos(1); puttime:- field
END of puttime OK ELSE
error:
BEGIN field.Setpos(1);
puttime:- putfloat(field,time);
END of puttime error;
A Working SIMULA definition of SIMSET and SIMULATION Page 33
Appendix D - Source Code of PUTFLOAT
Appendix D - Source Code of PUTFLOAT
! PROCEDURE PUTFLOAT edits a number X into the text T
! (right justified).
!
! Insignificant trailing zeros in fractions are removed.
!
! Representation errors (of type 98.9999999) are corrected.
! If fixed point format cannot be used (displaying significant
! digits), floating point format is used instead.
! The output will depend on the length of the text T.
! A value in the range [8,16] is recommended.
!
! PUTFLOAT also returns a reference to the text parameter.
;
TEXT PROCEDURE putfloat(t,x); TEXT t; REAL x;
BEGIN INTEGER w;
w:= t.Length; t:= NOTEXT;
IF w = 0 THEN ! NOTEXT !; ELSE
IF x = 0 THEN t.Sub(w,1).Putchar('0') ELSE
BEGIN REAL saved; BOOLEAN negative;
INTEGER d,i,pow,j;
negative:= x < 0; d:= 8; ! No. of signif. digits;
saved:= x; x:= Abs(x);
IF x >= &8 OR x < &-7 THEN
realedit:
BEGIN pow:= 0;
WHILE x >= 10 DO
BEGIN x:= x*0.1; pow:= pow + 1 END;
WHILE x < 1 DO
BEGIN x:= x*10; pow:= pow - 1 END;
! Calculate length for exp part;
j:= IF pow >= 10 THEN 3 ELSE IF pow >= 0 THEN 2 ELSE
IF pow >= -9 THEN 3 ELSE 4;
i:= w - j;
IF i > (IF negative THEN 1 ELSE 0) THEN
BEGIN
putfloat(t.Sub(1,i),x*Sign(saved));
t.Setpos(1);
IF t.Getchar = '*' THEN GO TO realcase;
t.Setpos(1);
WHILE t.Pos <= i DO
IF t.Getchar = 'E' THEN GO TO realcase;
t.Putchar('E');
t.Sub(i+2,j-1).Putint(pow);
END ELSE
A Working SIMULA definition of SIMSET and SIMULATION Page 34
Appendix D - Source Code of PUTFLOAT
realcase:
BEGIN i:= w - (IF negative THEN 6 ELSE 5);
IF i < 0 THEN i:= 0;
IF d > i THEN d:= i;
t.Putreal(saved,d)
END putreal case
END realedit block ELSE
BEGIN INTEGER pow_d,pow_di,n1,m,di,ix;
pow:= 1;
pow_di:= pow_d:= 100 000 000; ! = 10**d;
! Scale x to [0.1,1-eps] ;
WHILE x >= 1.0 DO
BEGIN x:= x*0.1;
IF pow_di = 1 THEN GO TO realedit;
pow_di:= pow_di//10;
i:= i - 1
END;
WHILE x < 0.1 DO
BEGIN x:= x*10; pow:= pow*10; i:= i + 1 END;
di:= d + i;
IF di < 0 THEN
BEGIN d:= -i; di:= 0 END;
ix:= x*pow_d; ! IX now integer with full prec;
! Fix 9999.... problem;
j:= Mod(ix,100);
IF j >= 90 THEN ix:= ix + 100 - j ELSE
IF j <= 10 THEN ix:= ix - j;
n1:= ix//pow_di//pow; ! = Integer Part;
! Calculate j = no. of chars before dec. point;
m:= n1; j:= IF negative THEN 2 ELSE 1;
WHILE m >= 10 DO
BEGIN m:= m//10; j:= j + 1 END m loop;
ix:= ix -(n1*pow_di)*pow;
! ix = fraction ;
IF ix NE 0 THEN
! Remove trailing zeros in IX;
WHILE Mod(ix,10) = 0 DO
BEGIN ix:= ix//10; di:= di-1 END mod loop;
IF j + (di+1)*Sign(ix) > w THEN GO TO realedit;
IF negative THEN n1:= -n1;
A Working SIMULA definition of SIMSET and SIMULATION Page 35
Appendix D - Source Code of PUTFLOAT
IF ix = 0 THEN t.Putint(n1) ELSE
BEGIN
j:= w-di;
IF negative AND n1 = 0 THEN
t.Sub(j-2,2):= "-0" ELSE
t.Sub(1,j-1).Putint(n1);
t.Setpos(j); t.Putchar('.');
t.Sub(t.Pos,di).Putint(ix);
! Fill in zeros;
WHILE ix > 0 DO
BEGIN ix:= ix//10; di:= di - 1 END ix loop;
t.Setpos(j+1);
FOR j:= 1 STEP 1 UNTIL di DO t.Putchar('0');
END fraction present
END w > 0
END x not = 0;
putfloat:- t
END of putfloat;
A Working SIMULA definition of SIMSET and SIMULATION Page 36
INDEX
*** INDEX ***
ACTIVAT procedure . . . . . . 6
ACTIVATE statement . . . . . . 5
ALGOL . . . . . . . . . . . . 5
Appendix A - Source ZIMSET . . 17
Appendix B - Source ZIMULATION 22
Appendix C - Source PUTTIME . 30
Appendix D - Source PUTFLOAT . 33
Binary tree for SQS . . . . . 8
Birtwistle, Graham . . . . . . 16
Bredrup, Bjarne . . . . . . . 16
Common base . . . . . . . . . 2
Controlling Debug Output . . . 8
Dahl, Ole-Johan . . . . . . . 16
Debug messages . . . . . . . . 4
Demonstration example . . . . 10
Discrete event simulation . . 2
Education . . . . . . . . . . 3
ERE . . . . . . . . . . . . . 2
HIDDEN . . . . . . . . . . . . 2
Hills, Robin . . . . . . . . . 16
Myhrhaug, Bj`rn . . . . . . . 16
NOW - virtual procedure . . . 7
Nygaard, Kristen . . . . . . . 16
Palme, Jacob . . . . . . . . . 2, 16
PRIOR . . . . . . . . . . . . 6
PROTECTED . . . . . . . . . . 2
PUTFLOAT format . . . . . . . 7
Queue handling . . . . . . . . 2
REACTIVAT procedure . . . . . 6
References . . . . . . . . . . 16
Report generators . . . . . . 4
Report procedures . . . . . . 6
Scheduling mechanisms . . . . 2
SETPARMS procedure . . . . . . 7
SIMULA Developent Group (SDG) 2
SIMULA syntax . . . . . . . . 5
Teaching SIMULA . . . . . . . 3
TITLE virtual TEXT procedure . 9
TRACEOFF procedure . . . . . . 8
TRACEON procedure . . . . . . 8
Tracing . . . . . . . . . . . 4
Using HIDDEN PROTECTED . . . . 13
Wallin, Mats . . . . . . . . . 1