Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50242/poomas.bli
There are no other files named poomas.bli in the archive.
00100 ! - - - - - - - POOMAS POOR MANS SIMULA - - - -
00200 !
00300 !
00400 MODULE MAINPROG(INSPECT,STACK=GLOBAL(MYSTACK,300),DREGS=5,
00500 RSAVE,LOWSEG) =
00600 BEGIN
00700
00800 MACRO ! MAKE GLOBAL NAMES UNREADABLE BUT UNIQUE.
00900 RELEASESPACE = RELSPACE$,
01000 RELEASELIST = RELIST$,
01100 RELEASEMEMBERS = RELMBR$,
01200 INSERTBEFORE = INSBEF$,
01300 INSERTAFTER = INSAFT$,
01400 FIRSTATTIME = FSTATT$,
01500 FIRSTAFTERTIME = FSTAFT$;
01600
01700 STRUCTURE
01800 OBJECT[X] = (@.OBJECT+.X)<0,36>;
01900
02000 EXTERNAL ! DECLARED BY USER IN INNER BLOCK.
02100 INITIO;
02200
02300 EXTERNAL ! BLIPP VARIABLES.
02400 MAXMEM, ! MAXIMAL FREELIST SIZE.
02500 ERRCOUNT; ! COUNT OF ERRORS ACCEPTED.
02600
02700 EXTERNAL ! QPEP VARIABLES.
02800 DEBUGGING,
02900 TIME,
03000 OBJECT
03100 SQS:
03200 CURRENT:
03300 MAINPROG;
03400
03500 EXTERNAL ! QPEP ROUTINES.
03600 TRACEBREAK,
03700 INITQPEP,
03800 MAKEEVNOT,
03900 FIRSTATTIME,
04000 FIRSTAFTERTIME,
04100 SCHEDULE,
04200 WAIT,
04300 KILL,
04400 TERMINATE,
04500 ISPROCESS,
04600 CANCEL;
04700
04800 EXTERNAL
04900 OUTMSG,
05000 OCTOUT,
05100 DECOUT,
05200 FLOUT;
05300
05400 EXTERNAL ! BLIPP ROUTINES
05500 ISROFUN,
05600 TYPLIS,
05700 DDTBREAK,
05800 INITBLIPP,
05900 INITMEM,
06000 MAKEOBJ,
06100 MAKELIST,
06200 MAKEREP,
06300 CLEARLIST,
06400 RELEASEMEMBERS,
06500 RELEASELIST,
06600 REMOVE,
06700 INSERTBEFORE,
06800 INSERTAFTER,
06900 INCLUDE,
07000 REPLACE,
07100 FIRST,
07200 LAST,
07300 RELEASESPACE,
07400 FIND,
07500 MAPLIST,
07600 EMPTY,
07700 CARDINAL,
07800 BLIPPERROR;
07900
08000 EXTERNAL ! DATA COLLECTION ROUTINES:
08100 INITHISTO,
08200 HISTO,
08300 HPRINT,
08400 ACCUM;
08500
08600 EXTERNAL ! RANDOM NUMBER ROUTINES:
08700 RANDINT,
08800 UNIFORM,
08900 NORMAL,
09000 FASTNORMAL,
09100 NEGEXP,
09200 POISSON,
09300 ERLANG,
09400 DISCRETE,
09500 LINEAR;
09600
09700
09800 MACRO ! INTERFACING OLD I/O TO BLISS I/O.
09900 TYPECRLF = TYPELINE()$,
10000 TYPDEC(N,LF) = (DECOUT(0,0,N);
10100 IF LF THEN TYPECRLF)$,
10200 TYPE(MSG,LF) = (OUTMSG(0,PLIT MSG);
10300 IF LF THEN TYPECRLF)$,
10400 TYPFLT(N,LF) = (FLOUT(0,N,0,3);
10500 IF LF THEN TYPECRLF)$;
10600
10700 EXTERNAL TYPELINE; ! FUDGE, FIX LATER.
10800 EXTERNAL TYPOCT; ! DECLARED IN BLIPP
10900
11000 MACRO
11100 REMOTELCL(P,I) =
11200 (IF .(P)[-1]<RAFL> EQL 0 THEN (BLIPPERROR(31); .BREG)
11300 ELSE .(P)[-1]<RAFL>+P<BASE>+I)$,
11400 REMOTEFML(P,I) =
11500 (IF .(P)[-1]<RALF> EQL 0 THEN (BLIPPERROR(31); .BREG)
11600 ELSE .(P)[-1]<RALF>+P<BASE>+I)$,
11700 CLOSEPROC(P) =
11800 (RARA(P) _ 0)$;
11900
12000 MACRO ! CLASS INDICATORS.
12100 FREECLASS = 0$, ! FREELIST MEMBER
12200 HEADCLASS = #777777$, ! LIST HEAD
12300 REPCLASS = #777776$, ! REPRESENTATIVE
12400 EVNOTCLASS = #777775$; ! EVENTNOTICE CLASS.
12500
12600 MACRO ! REGISTERS ETC.
12700 RIGHTHALF = 0,18$,
12800 BASE = 0,18$,
12900 RALF = 18,9$,
13000 RAFL = 27,9$,
13100 LEFTHALF = 18,18$,
13200 STATEAREA = 8$; ! SIZE OF STATE AREA.
13300
13400 MACRO ! CONSTANTS.
13500 NONE = #707070707070$,
13600 HWNONE = #707070$;
13700
13800 MACRO ! FIELDS IN OBJECTS.
13900 PRED(E) = (E[-3]<18,18>)$, ! PREDECESSOR
14000 SUC(E) = (E[-3]<0,18>)$, ! SUCCESSOR
14100 CLASS(E) = (E[-2]<18,18>)$, ! CLASS FIELD
14200 SIZE(E) = (E[-2]<0,18>)$, ! SIZE FIELD
14300 POINTERS(E) = (E[-3])$, ! SUC AND PRED COMPINED
14400 REACTPT(E) = (E[0])$, ! REACTIVATION POINT
14500 EVNOT(P) = (P[-1]<0,18>)$, ! EVENTNOTICE POINTER.
14600 RARA(P) = (P[-1]<18,18>)$, ! RAFL RALF FIELD.
14700 PROCPTR(E) = (E[-1])$, ! PROCESS POINTER.
14800 TIMEFLD(E) = (E[0])$; ! TIME FIELD IN EVNOT.
14900
15000
15100 %_
15200 PROCESS CREATION. PROCESS CREATION - - - -
15300
15400 NEW(P,S)
15500 THE 2 PARAMETERS TO THIS MACRO SPECIFY A ROUTINE WITH
15600 ITS PARAMETERS AND THE STACK-SIZE (EXCLUDING STATE AREA) FOR
15700 THE PROCESS TO BE CREATED. P SHOULD SYNTACTICALLY TAKE THE
15800 FORM OF A PROCEDURE CALL, S SHOULD EVALUATE TO A NUMBER.
15900 A COROUTINE INSTANCE OF P IS CREATED. IF THIS PROCESS
16000 EXECUTES A RETURN OUT OF THE OUTMOST PROCEDURE IT WILL BE
16100 TERMINATED.
16200 VALUE: PROCESS DESCRIPTOR, IF ERRORS THE HALFWORD NONE.
16300 _%
16400
16500 OWN SMACRO,TMACRO; ! LOCAL INSIDE BLOCK BELOW WHEN BLISS
16600 MAP OBJECT SMACRO; ! CAN HANDLE BLOCKS AS ACTUALS.
16700
16800 MACRO NEW(P,S) =
16900 BEGIN
17000 TMACRO _ MAKEOBJ(SMACRO _ S+STATEAREA,.CURRENT);
17100 IF .TMACRO EQL 0 THEN EXITCOMPOUND HWNONE;
17200 TMACRO _ CREATE P AT .TMACRO
17300 LENGTH .SMACRO THEN TERMINATE(.CURRENT);
17400 SMACRO _ .TMACRO<RIGHTHALF>;
17500 CLASS(SMACRO) _ .REACTPT(SMACRO);
17600 EVNOT(SMACRO) _ NONE;
17700 RARA(SMACRO) _ .TMACRO<LEFTHALF>;
17800 .TMACRO
17900 END$; ! END NEW.
18000
18100
18200 ! SCHEDULING MACROS
18300
18400
18500 MACRO
18600 FIRSTAT = 0$,
18700 LASTAT = 1$,
18800 BEFORE = 2$,
18900 AFTER = 3$,
19000 ACTIVATE(P,N,T) = SCHEDULE(4+N,P,T)$,
19100 REACTIVATE(P,N,T) = SCHEDULE(N,P,T)$,
19200 HOLDSHORT(T) = SCHEDULE(0,.CURRENT,.TIME FADR T)$,
19300 HOLDLONG(T) = SCHEDULE(1,.CURRENT,.TIME FADR T)$,
19400 HOLD(T) = SCHEDULE(1,.CURRENT,.TIME FADR T)$;
19500
19600
19700 ! SET UP STACK FOR MAIN PROGRAM TO BE AN OBJECT.
19800
19900 SREG _ .SREG + #3000003;
20000 FREG _ .FREG + 3;
20100 (.FREG+1)<0,36> _ .FREG;
20200 BREG _ .BREG + 3;
20300
20400 ! INITIALIZE FIELDS OF MAIN PROGRAM AS FOR ANY OLD OBJECT.
20500
20600 MYSTACK _ NONE;
20700 (MYSTACK+1) _ (INITQPEP<0,0>+1)^18 ! ANY ROUTINE NAME OK AS CLASS.
20800 ! ADDING 1 TO GET CORRECT SUBTRACTION OF .SREG<LEFTHALF>.
20900 + .SREG<RIGHTHALF>-MYSTACK<0,0>-.SREG<LEFTHALF>;
21000 ! THIS WAS THE SIZE = USED + UNUSED PART OF STACK.
21100
21200 ! INITIALIZE I/O, BLIPP AND QPEP.
21300
21400 MAXMEM _ 15360; ! * * * MAXIMAL FREELISTSIZE * * * * *
21500
21600 INITIO();
21700 INITBLIPP();
21800 INITQPEP();
21900 ERRCOUNT _ 10; ! **** NO. OF ERROR MESSAGES PERMITTED. ***
22000