         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$INCLUDE INCLIOQ                                               << 1560>>00202000
$EDIT VOID=00280000                                            << 9478>>00275000
                                                               << 2218>>00721000
<< CONSOLE MESSAGE ELIMINATION EQUATES AND DEFINES >>          << 2218>>00721010
                                                               << 2218>>00721015
pointer sysg'ext'ptr = %377;                                   << 2218>>00721020
                                                               << 2218>>00721025
EQUATE                                                         << 2218>>00721030
                                                               << 2218>>00721035
   MAESTRO'OFFSET=  %153,                                      << 2218>>00721040
   << definition of the maestro'word in sysg'ext'ptr + %153>>  << 2218>>00721045
   << (15:1) = maestro enabled, suppress console messages  >>  << 2218>>00721050
   << (14:1) = someone is in PROGEN CTRL A loop            >>  << 2218>>00721055
   << (13:1) = message pending (not used here but in the   >>  << 2218>>00721060
   <<          background FILTER process                   >>  << 2218>>00721065
   << (12:1) = reply pending                               >>  << 2218>>00721070
   << (11:1) = queue entry pending in XDS                  >>  << 2218>>00721071
   << (0:1 ) = start bit set and reset in initiat filter   >>  << 2218>>00721072
   maestro'dst'offset = %154,                                  << 2218>>00721075
   qbase = 4, << overhead size in the DS used for maestro >>   << 2218>>00721081
   progen'pin = 1,                                             << 2218>>00721085
   logonly'dest = -32000;                                      << 2218>>00721090
   << used to call FORMSG only to log the message as a     >>  << 2218>>00721095
   << console message.                                     >>  << 2218>>00721100
                                                               << 2218>>00721105
DEFINE                                                         << 2218>>00721110
                                                               << 2218>>00721115
   get'flag = sysg'ext'ptr(maestro'offset).(14:2)#,            << 2218>>00721120
   cswitchmsg = (msgno = 3145)#, << console has been switched>><< 2218>>00721125
   cigset = (setno = 7)#,        << CI general mesage set    >><< 2218>>00721130
   set'reply'flag = sysg'ext'ptr(maestro'offset).(12:1) := 1#, << 2218>>00721145
   mbufsizew = 162#,                                           << 2218>>00721165
     << CI'commandbuff + overhead = 280 byte + 44 byte>>       << 2218>>00721170
   mbufsizewm1 = mbufsizew - 1#,                               << 2218>>00721175
   mbufsize = mbufsizew * 2#,                                  << 2218>>00721180
   disable'maestro = sysg'ext'ptr(maestro'offset).(14:2) := 0#,<< 2218>>00721185
   curdst = sysg'ext'ptr(maestro'dst'offset)#;                 << 2218>>00721186
                                                               << 2218>>00721187
COMMENT                                                        << 9478>>00730953
$EDIT VOID=731000                                              << 1560>>00730968
************************************************************** << 9478>>00731015
                                                               << 9478>>00731031
IO MESSAGE DST HEADER ENTRY FORMAT:                            << 9478>>00731046
                                                               << 9478>>00731062
            |----------------------------------------|         << 9478>>00731078
ENTRY 0+ 0  |      NUMBER OF CONFIGURED ENTRIES      |         << 9478>>00731093
            |----------------------------------------|         << 9478>>00731109
       + 1  |         ENTRY LENGTH IN WORDS          |         << 9478>>00731125
            |----------------------------------------|         << 9478>>00731140
       + 2  |      NUMBER OF UNASSIGNED ENTRIES      |         << 9478>>00731156
            |----------------------------------------|         << 9478>>00731171
       + 3  | TABLE RELATIVE INDEX TO 1ST UNASSIGNED |         << 9478>>00731187
            |----------------------------------------|         << 9478>>00731203
       + 4  | TABLE RELATIVE INDEX TO LAST FREE ENTRY|         << 9478>>00731218
            |----------------------------------------|         << 9478>>00731234
                                                               << 9478>>00731250
;                                                              << 9478>>00731265
EQUATE                                                         << 9478>>00731281
  NUM'ENTRIES =0,  !# OF CONFIGURED ENTRIES                    << 9478>>00731296
  ENTRY'LENGTH=1,  !ENTRY LENGTH IN WORDS                      << 9478>>00731312
  NUM'FREE    =2,  !# OF UNASSIGNED ENTRIES                    << 9478>>00731328
  FIRST'FREE  =3,  !TABLE RELATIVE INDEX TO 1ST UNASSIGNED     << 9478>>00731343
  LAST'FREE   =4,  !TABLE RELATIVE INDEX TO LAST FREE ENTRY    << 9478>>00731359
  HEADER'SIZE =LAST'FREE+1,  !SIZE OF MESSAGE TABLE HEADER     << 9478>>00731375
                                                               << 9478>>00731390
  NUM'MSG'BUFS=63; !NUMBER OF MESSAGE BUFFERS IN MSG DST       << 1560>>00731406
                                                               << 9478>>00731421
DEFINE MESSENGER'PROC = ABSOLUTE (%1142)#;                     << 1560>>00931000
                                                               << 1288>>01390100
PROCEDURE DICTFIND(NAME,DATA,RESULT);                          << 1288>>01390110
INTEGER ARRAY      NAME,DATA;                                  << 1288>>01390120
INTEGER                      RESULT;                           << 1288>>01390130
OPTION EXTERNAL;                                               << 1288>>01390140
                                                               << 1288>>01390150
                                                               << 1560>>01531000
procedure ABORTIOX'NOWAIT(IOQX);                               << 1560>>01531020
   value IOQX;                                                 << 1560>>01531040
   integer IOQX;                                               << 1560>>01531060
   option external;                                            << 1560>>01531080
                                                               << 1560>>01531100
procedure ABORTTIMEREQ(TRLX);                                  << 1560>>01531120
   value TRLX;                                                 << 1560>>01531140
   integer TRLX;                                               << 1560>>01531160
   option external;                                            << 1560>>01531180
                                                               << 1560>>01531200
double procedure IOSTATUS(IOQX);                               << 1560>>01531220
   value IOQX;                                                 << 1560>>01531240
   integer IOQX;                                               << 1560>>01531260
   option external;                                            << 1560>>01531280
                                                               << 1560>>01531300
logical procedure PORTSTATUS(PORTNUMBER);                      << 1560>>01531320
   value PORTNUMBER;                                           << 1560>>01531340
   integer PORTNUMBER;                                         << 1560>>01531360
   option external;                                            << 1560>>01531380
                                                               << 1560>>01531400
procedure RECEIVEMSG(PORTNUM,MSGLEN,FLAGS);                    << 1560>>01531420
   value PORTNUM,MSGLEN,FLAGS;                                 << 1560>>01531440
   integer PORTNUM,MSGLEN;                                     << 1560>>01531460
   logical FLAGS;                                              << 1560>>01531480
   option external;                                            << 1560>>01531500
                                                               << 1560>>01531520
procedure RESETDB(OLDDB);                                      << 1560>>01531540
   value OLDDB;                                                << 1560>>01531560
   integer OLDDB;                                              << 1560>>01531580
   option external;                                            << 1560>>01531600
                                                               << 1560>>01531620
integer procedure SETSYSDB;                                    << 1560>>01531640
   option external;                                            << 1560>>01531660
                                                               << 1560>>01531680
double procedure TIMER;                                        << 1560>>01531700
   option external;                                            << 1560>>01531720
                                                               << 1560>>01531740
integer procedure TIMEREQ(CODE,REQ,TIME);                      << 1560>>01531760
value CODE, REQ, TIME;                                         << 1560>>01531780
double TIME;                                                   << 1560>>01531800
integer CODE, REQ;                                             << 1560>>01531820
option external;                                               << 1560>>01531840
                                                               << 1560>>01531860
procedure UNIMPEDE(PCBPT);                                     << 1560>>01531880
   value PCBPT;                                                << 1560>>01531900
   integer PCBPT;                                              << 1560>>01531920
   option external;                                            << 1560>>01531940
                                                               << 1560>>01531960
integer procedure maestroprefix (reply, buff,clen, cbuff,      << 2218>>01570010
                                 console);                     << 2218>>01570050
   value reply, console, clen;                                 << 2218>>01570100
   integer clen;                                               << 2218>>01570150
   logical reply, console;                                     << 2218>>01570200
   array buff;                                                 << 2218>>01570250
   array cbuff;                                                << 2218>>01570300
   option forward;                                             << 2218>>01570350
                                                               << 2218>>01570400
procedure save'message (len, buff);                            << 2218>>01570450
   value len;                                                  << 2218>>01570500
   integer len;                                                << 2218>>01570550
   array buff;                                                 << 2218>>01570600
   option forward;                                             << 2218>>01570650
                                                               << 2218>>01570700
   OPTION INTERNAL,UNCALLABLE;                                 << 9227>>01820000
$EDIT VOID=01990000                                            <<*1284>>01990000
  IF DST <> 0 THEN                                             <<*1284>>01991000
   BEGIN                                                       <<*1284>>01992000
       BUFF'(1) := DST;                                        <<*1284>>01993000
       BUFF'(RIT'DBREL) := 0;  <<FLAG A DST RELATIVE ADDRESS>> <<*1284>>01994000
   END                                                         <<*1284>>01994100
$EDIT VOID=02045000                                            <<*1284>>02005000
  << THE FOLLOWING CODE IS INTENDED TO ADDRESS THE PROBLEM >>  <<*1284>>02007000
  << OF STACK GROWTH THAT PREVENTS SOME ROUTINES FROM      >>  <<*1284>>02008000
  << USING A DST RELATIVE ADDRESS TO ACCESS REPLY STRINGS. >>  <<*1284>>02009000
  << IF WE ARE PASSED A DB RELATIVE ADDRESS, WE WANT TO    >>  <<*1284>>02009010
  << KEEP THIS ADDRESS DB RELATIVE AND STORE IT IN THE RIT AS>><<*1284>>02009020
  << SUCH. THIS REPLACES THE METHOD OF ALWAYS MAKING THE   >>  <<*1284>>02009030
  << ADDRESS SEGMENT RELATIVE.                             >>  <<*1284>>02009040
  PCBPT := CURPRC;                                             <<*1284>>02010000
  BUFF'(1) := SPCBSTKDST;  << GET STAK DST # FROM PCB >>       <<*1284>>02015000
  BUFF'(RIT'DBREL) := 1;   << FLAG A DB RELATIVE ADDRESS >>    <<*1284>>02020000
$PAGE                                                          << 1560>>02295500
$TITLE "MESSENGER"                                             << 1560>>02295510
<<--------------------------------------------->>              << 1560>>02295520
       procedure   MESSENGER;                                  << 1560>>02295530
<<--------------------------------------------->>              << 1560>>02295540
OPTION PRIVILEGED,UNCALLABLE;                                  << 1560>>02295550
BEGIN                                                          << 1560>>02295560
                                                               << 1560>>02295570
<<This procedure is PROCREATEd in to a process to cleanup >>   << 1560>>02295580
<<message buffers.  When a process calls GENMSG, the      >>   << 1560>>02295590
<<message is moved to the buffer, and a no-wait IO is done>>   << 1560>>02295600
<<to route the msg. MESSENGER'PROC is then awaked to check>>   << 1560>>02295610
<<on the IO and release the buffer when the IO is done.   >>   << 1560>>02295620
                                                               << 1560>>02295630
array IOQ'ARRAY(0:NUM'MSG'BUFS-1), <<pending I/O IOQs>>        << 1560>>02295640
      DST'ARRAY(0:NUM'MSG'BUFS-1), <<DST buffer offset>>       << 1560>>02295650
      BUF'HDR(0:21);       <<Work area for MSG DST hdr>>       << 1560>>02295660
byte array B'BUF'HDR(*)=BUF'HDR;                               << 1560>>02295670
                                                               << 1560>>02295680
integer CURRENT'INDEX, <<Index into I/O arrays>>               << 1560>>02295690
        MOVE'LENGTH,   <<Length to move in MDS instructions>>  << 1560>>02295700
        SAVESIR,       <<Save GETSIR information>>             << 1560>>02295710
        CONSOLE'IOQX,   <<ioq indx of the preempt write >>     << 1560>>02295720
        TRLX,          <<Index of watchdog timer>>             << 1560>>02295730
        LAST'ENTRY;    <<Index of last entry in arrays>>       << 1560>>02295740
                                                               << 1560>>02295750
<<Timer declarations>>                                         << 1560>>02295760
double NEW'TIME,           <<delta time from LAST'TIME>>       << 1560>>02295770
       LAST'TIME;          <<prior cycle TIME obtained>>       << 1560>>02295780
                                                               << 1560>>02295790
define PAUSE'TIME = 30000D#;  <<30 second watchdog timer>>     << 1560>>02295800
                                                               << 1560>>02295810
<<Table relative index into IOQ table>>                        << 1560>>02295820
integer   Q'ENTRY'INDEX,                                       << 1560>>02295830
          IOQ'ENTRY'INDEX = Q'ENTRY'INDEX,                     << 1560>>02295840
          DRQ'ENTRY'INDEX = Q'ENTRY'INDEX;                     << 1560>>02295850
                                                               << 1560>>02295860
<<S-relative arguments for RECEIVEMSG>>                        << 1560>>02295870
integer   SM0 = S-0,                                           << 1560>>02295880
          SM1 = S-1,                                           << 1560>>02295890
          SM2 = S-2,                                           << 1560>>02295900
          SM3 = S-3;                                           << 1560>>02295910
                                                               << 1560>>02295920
INTEGER SAVE'INDEX;                                            << 1560>>02295930
ARRAY SAVE'IOQX (0:NUM'MSG'BUFS);                              << 1560>>02295940
LOGICAL ABORT'FINISHED;                                        << 1560>>02295950
INTEGER LPDT'INDEX;                                            << 1560>>02295960
<<Declarations to fire-off PROGEN if SHUTDOWN requested>>      << 1560>>02295970
integer PROGEN = DB + %141;         <<Sysglob location>>       << 1560>>02295980
define SHUTDOWN = absolute(%1300)#, <<Shutdown flag>>          << 1560>>02295990
       THISPIN  = (CURPRC)/PCBSIZE#;                           << 1560>>02296000
                                                               << 1560>>02296020
equate MSGSIR  = %24;  <<MSG SIR number>>                      << 1560>>02296030
DEFINE DIT'CONSOLE'MODE = 8).(11:1#; << If on, CNTL-A posted >><< 1560>>02296041
$PAGE                                                          << 1560>>02296050
<<-------------------------------------------->>               << 1560>>02296060
     subroutine  GIVE'BACK'BUFFER;                             << 1560>>02296070
<<-------------------------------------------->>               << 1560>>02296080
<<Return MSG buffer to available list>>                        << 1560>>02296090
BEGIN                                                          << 1560>>02296100
                                                               << 1560>>02296110
IF IOMSGDST = 0 THEN                                           << 1560>>02296120
  RETURN;    <<No DST for buffers yet>>                        << 1560>>02296130
                                                               << 1560>>02296140
<<Move in buffer DST header info>>                             << 1560>>02296150
TOS := @BUF'HDR;                                               << 1560>>02296160
TOS := IOMSGDST;                                               << 1560>>02296170
TOS := 0;                                                      << 1560>>02296180
TOS := HEADER'SIZE;                                            << 1560>>02296190
ASSEMBLE ( MFDS 4 );                                           << 1560>>02296200
                                                               << 1560>>02296210
<<Get tail pointer>>                                           << 1560>>02296220
IF BUF'HDR(LAST'FREE) = 0 THEN                                 << 1560>>02296230
  BEGIN    <<This will be first on avail list>>                << 1560>>02296240
   BUF'HDR(FIRST'FREE) := BUF'HDR(LAST'FREE) :=                << 1560>>02296250
   DST'ARRAY(CURRENT'INDEX);                                   << 1560>>02296260
  END                                                          << 1560>>02296270
ELSE                                                           << 1560>>02296280
  BEGIN  <<Must chain this buffer onto prior buffer>>          << 1560>>02296290
   <<Move this one's pointer to current last guy's>>           << 1560>>02296300
   TOS := IOMSGDST;                                            << 1560>>02296310
   TOS := BUF'HDR(LAST'FREE);                                  << 1560>>02296320
   TOS := @DST'ARRAY(CURRENT'INDEX);                           << 1560>>02296330
   TOS := 1;                                                   << 1560>>02296340
   ASSEMBLE ( MTDS 4 );                                        << 1560>>02296350
                                                               << 1560>>02296360
   <<Fix tail pointer only>>                                   << 1560>>02296370
   BUF'HDR(LAST'FREE) := DST'ARRAY(CURRENT'INDEX);             << 1560>>02296380
  END;                                                         << 1560>>02296390
                                                               << 1560>>02296400
<<Bump number of available entries by 1>>                      << 1560>>02296410
BUF'HDR(NUM'FREE) := BUF'HDR(NUM'FREE) + 1;                    << 1560>>02296420
                                                               << 1560>>02296430
<<Now, write back new header info>>                            << 1560>>02296440
TOS := IOMSGDST;                                               << 1560>>02296450
TOS := 0;                                                      << 1560>>02296460
TOS := @BUF'HDR;                                               << 1560>>02296470
TOS := HEADER'SIZE;                                            << 1560>>02296480
ASSEMBLE ( MTDS 4 );                                           << 1560>>02296490
BUF'HDR := 0;                                                  << 1560>>02296500
                                                               << 1560>>02296510
TOS := IOMSGDST;                                               << 1560>>02296520
TOS := BUF'HDR(LAST'FREE);                                     << 1560>>02296530
TOS := @BUF'HDR;                                               << 1560>>02296540
TOS := 1;                                                      << 1560>>02296550
ASSEMBLE ( MTDS 4 );                                           << 1560>>02296560
                                                               << 1560>>02296570
END;    <<of subroutine GIVE'BACK'BUFFER>>                     << 1560>>02296580
$PAGE                                                          << 1560>>02296590
<<---------------------------------------->>                   << 1560>>02296600
     subroutine   UNIMPEDE'PROCESS;                            << 1560>>02296610
<<---------------------------------------->>                   << 1560>>02296620
BEGIN                                                          << 1560>>02296630
                                                               << 1560>>02296640
PDISABLE;    <<Protect integrity of IMP chain>>                << 1560>>02296650
IF IOMSGQUEUE = 0 THEN                                         << 1560>>02296660
  BEGIN    <<There are no PINs waiting>>                       << 1560>>02296670
   PENABLE;                                                    << 1560>>02296680
   RETURN;                                                     << 1560>>02296690
  END;                                                         << 1560>>02296700
                                                               << 1560>>02296710
<<Fix up linking>>                                             << 1560>>02296720
TOS := IOMSGQUEUE;   <<Save PIN to UNIMPEDE on TOS>>           << 1560>>02296730
IOMSGQUEUE := LPCB(IOMSGQUEUE * PCBSIZE + NIMPPINWORDNUM) /    << 1560>>02296740
                   PCBSIZE;                                    << 1560>>02296750
X := S0 * PCBSIZE + NIMPPINWORDNUM;                            << 1560>>02296760
LPCB(X) := 0;                                                  << 1560>>02296770
UNIMPEDE(TOS*PCBSIZE);  <<Unimpede pin 1st on list>>           << 1560>>02296780
PENABLE;                                                       << 1560>>02296790
                                                               << 1560>>02296800
<<If process was impeded & watchdog timer, clear timer>>       << 1560>>02296810
If TRLX <> 0 THEN                                              << 1560>>02296820
  BEGIN   <<Abort/cancel this timer request>>                  << 1560>>02296830
   SETSYSDB;                                                   << 1560>>02296840
   ABORTTIMEREQ(TRLX);                                         << 1560>>02296850
   RESETDB(-1);                                                << 1560>>02296860
   TRLX := 0;                                                  << 1560>>02296870
   LAST'TIME := 0D;                                            << 1560>>02296880
  END;                                                         << 1560>>02296890
                                                               << 1560>>02296900
END;   <<of subroutine UNIMPEDE'PROCESS>>                      << 1560>>02296910
$PAGE                                                          << 1560>>02296920
<<---------------------------------------->>                   << 1560>>02296930
LOGICAL SUBROUTINE   PREEMPT'CONSOLE'IO;                       << 1560>>02296940
<<---------------------------------------->>                   << 1560>>02296950
BEGIN                                                          << 1560>>02296960
                                                               << 1560>>02296970
IF IOMSGQUEUE = 0   << no waiting, don't preempt >>            << 1560>>02296980
   OR CONSOLE'IOQX <> 0 THEN << already done a preempt >>      << 1560>>02296990
   RETURN;                                                     << 1560>>02297000
IOQ'ENTRY'INDEX := IOQ'ARRAY; << 1st ioqx in array >>          << 1560>>02297010
IF IOQ'LDEV = SYS'CONSOLE'LDEV THEN                            << 1560>>02297020
   BEGIN  << must issue a preempt IO to clear console >>       << 1560>>02297030
   LPDT'INDEX := SYS'CONSOLE'LDEV *                            << 1560>>02297031
                       INTEGER(LPDT'ENTRY'SIZE);               << 1560>>02297032
   IF ABSOLUTE(LPDT'DIT'PTR                                    << 1560>>02297033
               + SYSDB + DIT'CONSOLE'MODE) = 1 THEN RETURN;    << 1560>>02297034
           << console on control-a command, can't preempt >>   << 1560>>02297035
   B'BUF'HDR := %15; << just write a CR out to console >>      << 1560>>02297040
   TOS :=            << unblocked, wake and no impede >>       << 1560>>02297050
   ATTACHIO (SYS'CONSOLE'LDEV,0,0,@BUF'HDR,1,-1,0,0,%406);     << 1560>>02297060
   DEL;                                                        << 1560>>02297070
   CONSOLE'IOQX := TOS;                                        << 1560>>02297080
   IF CONSOLE'IOQX <> 0 THEN                                   << 1560>>02297090
       BEGIN   << successful  >>                               << 1560>>02297100
       SETSYSDB;                                               << 1560>>02297110
       ABORTTIMEREQ(TRLX);    << clear timer >>                << 1560>>02297120
       RESETDB(-1);                                            << 1560>>02297130
       TRLX := 0;                                              << 1560>>02297140
       LAST'TIME := 0D;                                        << 1560>>02297150
       PREEMPT'CONSOLE'IO := TRUE;   << return success  >>     << 1560>>02297160
       END;                                                    << 1560>>02297170
   END;                                                        << 1560>>02297180
                                                               << 1560>>02297190
END; << of PREEMPT'CONSOLE'IO subroutine >>                    << 1560>>02297200
$PAGE                                                          << 1560>>02297210
<<--------------------------------------------->>              << 1560>>02297220
     subroutine   MAKE'BUFFER'AVAIL;                           << 1560>>02297230
<<--------------------------------------------->>              << 1560>>02297240
BEGIN    <<IO is done, so clean-up>>                           << 1560>>02297250
                                                               << 1560>>02297260
SAVESIR := GETSIR(MSGSIR);  <<Save integrity of msg bufs>>     << 1560>>02297270
                                                               << 1560>>02297280
<<Give buffer back to available pool>>                         << 1560>>02297290
GIVE'BACK'BUFFER;                                              << 1560>>02297300
                                                               << 1560>>02297310
<<If any process waiting on buffers, unimpede>>                << 1560>>02297320
UNIMPEDE'PROCESS;                                              << 1560>>02297330
                                                               << 1560>>02297340
RELSIR(MSGSIR,SAVESIR);  <<Make SIR available again>>          << 1560>>02297350
                                                               << 1560>>02297360
<<Now, compress the table>>                                    << 1560>>02297370
MOVE IOQ'ARRAY(CURRENT'INDEX) :=                               << 1560>>02297380
   IOQ'ARRAY(CURRENT'INDEX+1),(LAST'ENTRY-CURRENT'INDEX);      << 1560>>02297390
MOVE DST'ARRAY(CURRENT'INDEX) :=                               << 1560>>02297400
   DST'ARRAY(CURRENT'INDEX+1),(LAST'ENTRY-CURRENT'INDEX);      << 1560>>02297410
LAST'ENTRY := LAST'ENTRY - 1;                                  << 1560>>02297420
CURRENT'INDEX := CURRENT'INDEX - 1;                            << 1560>>02297430
                                                               << 1560>>02297440
END;    <<of subroutine MAKE'BUFFER'AVAIL>>                    << 1560>>02297450
                                                               << 1560>>02297460
$PAGE                                                          << 1560>>02297470
<<---------------------------------------------------->>       << 1560>>02297480
<<      MESSENGER     PROCEDURE OUTER BLOCK           >>       << 1560>>02297490
<<---------------------------------------------------->>       << 1560>>02297500
LAST'ENTRY := -1;   <<Initialize last index pointer used>>     << 1560>>02297510
TRLX := 0;          <<No current watchdog timer>>              << 1560>>02297520
SAVE'INDEX := 0;                                               << 1560>>02297530
CONSOLE'IOQX := 0;                                             << 1560>>02297540
                                                               << 1560>>02297550
START:                                                         << 1560>>02297560
                                                               << 1560>>02297570
IF SHUTDOWN.(3:1) THEN                                         << 1560>>02297580
  BEGIN      <<Process stop>>                                  << 1560>>02297590
   SETSYSDB;                                                   << 1560>>02297600
   AWAKE(PROGEN,2<<son>>,0);                                   << 1560>>02297610
   WAIT(0,0);    <<Go to sleep forever>>                       << 1560>>02297620
  END;                                                         << 1560>>02297630
                                                               << 1560>>02297640
<<Check and see if any IPC messages are waiting>>              << 1560>>02297650
While PORTSTATUS(0) do                                         << 1560>>02297660
  BEGIN   <<There are messages to get & process>>              << 1560>>02297670
   ASSEMBLE ( ADDS 4 );   <<Return cells>>                     << 1560>>02297680
   RECEIVEMSG(0,4,0);<<Read 4 words from port 0 destructively>><< 1560>>02297690
   IF = and SM3 = 2 THEN <<Got IOQ msg OK>>                    << 1560>>02297700
     BEGIN                                                     << 1560>>02297710
      <<Store IOQ & DST associated in tail of array>>          << 1560>>02297720
      LAST'ENTRY := LAST'ENTRY + 1; <<Increment last entry>>   << 1560>>02297730
      IOQ'ARRAY(LAST'ENTRY) := SM2; <<Store IOQ>>              << 1560>>02297740
      DST'ARRAY(LAST'ENTRY) := SM1; <<Store DST>>              << 1560>>02297750
                                                               << 1560>>02297760
      <<Now, mark the IOQ with this PCB, IW bit>>              << 1560>>02297770
      IOQ'ENTRY'INDEX := SM2; <<Load IOQ>>                     << 1560>>02297780
      DISABLE;                                                 << 1560>>02297790
      IF NOT IOQ'DONE THEN <<If not completed>>                << 1560>>02297800
        BEGIN                                                  << 1560>>02297810
         IOQ'IOWAKE := 1;  <<Turn on WAKE bit>>                << 1560>>02297820
         IOQ'PCB := THISPIN; <<Set this PCB>>                  << 1560>>02297830
        END;                                                   << 1560>>02297840
      ENABLE;                                                  << 1560>>02297850
                                                               << 1560>>02297860
      ASSEMBLE (SUBS 4);  <<Pop 4 words off TOS>>              << 1560>>02297870
     END;  <<of successful RCPT of IPC msg>>                   << 1560>>02297880
                                                               << 1560>>02297890
  END;    <<of check for any IPC message>>                     << 1560>>02297900
                                                               << 1560>>02297910
<<Now, see if any IOQ's have completed so we can>>             << 1560>>02297920
<<release their DST>>                                          << 1560>>02297930
CURRENT'INDEX := -1;                                           << 1560>>02297940
WHILE (CURRENT'INDEX:=CURRENT'INDEX+1) <= LAST'ENTRY DO        << 1560>>02297950
  BEGIN    <<Check the IOQ's>>                                 << 1560>>02297960
   IOSTATUS(IOQ'ARRAY(CURRENT'INDEX));                         << 1560>>02297970
   IF = THEN                                                   << 1560>>02297980
     MAKE'BUFFER'AVAIL;  <<I/O has completed>>                 << 1560>>02297990
  END;                                                         << 1560>>02298000
                                                               << 1560>>02298010
<<Perform watchdog timer housekeeping>>                        << 1560>>02298020
IF TRLX <> 0 THEN                                              << 1560>>02298030
  BEGIN   <<Watchdog timer is set, see if expired>>            << 1560>>02298040
   NEW'TIME := TIMER - LAST'TIME;  <<Delta time in ms>>        << 1560>>02298050
   IF < THEN   <<System clock wrap-around>>                    << 1560>>02298060
     NEW'TIME := %17777777777D - NEW'TIME + 1D;                << 1560>>02298070
   IF NEW'TIME >= PAUSE'TIME THEN                              << 1560>>02298080
     IF LAST'ENTRY >= 0 AND NOT PREEMPT'CONSOLE'IO THEN        << 1560>>02298090
       BEGIN    <<Kill the oldest outstanding msg>>            << 1560>>02298100
        ABORT'FINISHED := TRUE;                                << 1560>>02298110
        CURRENT'INDEX := 0;                                    << 1560>>02298120
        TOS := IOQ'ARRAY(CURRENT'INDEX); <<Oldest IOQ on TOS>> << 1560>>02298130
        SETSYSDB;                                              << 1560>>02298140
        ABORTIOX'NOWAIT(*);                                    << 1560>>02298150
        IF <> THEN ABORT'FINISHED := FALSE;                    << 1560>>02298160
        RESETDB(-1);                                           << 1560>>02298170
        IF NOT ABORT'FINISHED THEN                             << 1560>>02298180
           BEGIN                                               << 1560>>02298190
           SAVE'IOQX (SAVE'INDEX) := IOQ'ARRAY; << save it >>  << 1560>>02298200
           SAVE'INDEX := SAVE'INDEX + 1;                       << 1560>>02298210
           IF SAVE'INDEX > NUM'MSG'BUFS THEN <<should never>>  << 1560>>02298220
              SAVE'INDEX := NUM'MSG'BUFS; << decr. to max >>   << 1560>>02298230
               << last ioqx not released till next restart >>  << 1560>>02298231
           END;                                                << 1560>>02298240
        MAKE'BUFFER'AVAIL;                                     << 1560>>02298250
       END;                                                    << 1560>>02298260
  END;   <<of processing "popped" watchdog timer>>             << 1560>>02298270
                                                               << 1560>>02298280
<<If no watchdog timer & have impeded processes, get one>>     << 1560>>02298290
PDISABLE;                                                      << 1560>>02298300
IF IOMSGQUEUE <> 0 THEN  <<There are impeded processes>>       << 1560>>02298310
  IF TRLX = 0 THEN   <<There is no current watchdog timer>>    << 1560>>02298320
    BEGIN                                                      << 1560>>02298330
                                                               << 1560>>02298340
     LAST'TIME := TIMER;   <<Save time of call>>               << 1560>>02298350
     <<Stack ops for call to TIMEREQ>>                         << 1560>>02298360
     TOS := 0;     <<TRLX returned>>                           << 1560>>02298370
     TOS := %12;   <<CODE %12 is watchdog timer>>              << 1560>>02298380
     TOS := CURPRC;  <<My PCB offset from PCB base>>           << 1560>>02298390
     TOS := PAUSE'TIME; <<Delay time in ms (double)>>          << 1560>>02298400
                                                               << 1560>>02298410
     SETSYSDB;                                                 << 1560>>02298420
     ASSEMBLE (PCAL TIMEREQ);                                  << 1560>>02298430
     <<or TOS := TIMEREQ(%12,MESSENGER'PROC,PAUSE'TIME);>>     << 1560>>02298440
     RESETDB(-1);                                              << 1560>>02298450
                                                               << 1560>>02298460
     <<Save TRLX index>>                                       << 1560>>02298470
     TRLX := TOS;                                              << 1560>>02298480
    END;                                                       << 1560>>02298490
                                                               << 1560>>02298500
PENABLE;                                                       << 1560>>02298510
                                                               << 1560>>02298520
CURRENT'INDEX := -1;                                           << 1560>>02298530
WHILE (CURRENT'INDEX:=CURRENT'INDEX+1) < SAVE'INDEX DO         << 1560>>02298540
  BEGIN    <<Check the saved IOQ's>>                           << 1560>>02298550
   IOSTATUS(SAVE'IOQX(CURRENT'INDEX));                         << 1560>>02298560
   IF = THEN                                                   << 1560>>02298570
     BEGIN    <<I/O has completed, compress the array>>        << 1560>>02298580
     MOVE SAVE'IOQX(CURRENT'INDEX) :=                          << 1560>>02298590
      SAVE'IOQX(CURRENT'INDEX+1), (SAVE'INDEX-CURRENT'INDEX);  << 1560>>02298600
     SAVE'INDEX := SAVE'INDEX - 1;                             << 1560>>02298610
     CURRENT'INDEX := CURRENT'INDEX - 1;                       << 1560>>02298620
     END;                                                      << 1560>>02298630
  END;                                                         << 1560>>02298640
IF CONSOLE'IOQX <> 0 THEN   << release console ioqx >>         << 1560>>02298650
   BEGIN                                                       << 1560>>02298660
   IOSTATUS (CONSOLE'IOQX);                                    << 1560>>02298670
   IF = THEN << done  >>                                       << 1560>>02298680
      CONSOLE'IOQX := 0;                                       << 1560>>02298690
   END;                                                        << 1560>>02298700
<<Now, wait for a new event to wake me up>>                    << 1560>>02298710
WAIT(-(%114)<<IO,timer,msg>>,0);                               << 1560>>02298720
GO TO START;                                                   << 1560>>02298730
                                                               << 1560>>02298740
END;   <<of process/procedure MESSENGER>>                      << 1560>>02298750
   ASSEMBLE(DUP,NOP;LDI 1;LSUB);                                        02415000
$PAGE"                        Procedure INCS'MSG"              << 1288>>04105010
<<==========================================================>> << 1288>>04105020
<<                                                          >> << 1288>>04105030
<<   INCS'MSG                                               >> << 1288>>04105040
<<                                                          >> << 1288>>04105050
<<==========================================================>> << 1288>>04105060
                                                               << 1288>>04105070
COMMENT                                                        << 1288>>04105080
                                                               << 1288>>04105090
PURPOSE:                                                       << 1288>>04105100
                                                               << 1288>>04105110
   The procedure INCS'MSG is a hook into the MPE operating     << 1288>>04105120
   system used by INCS/3000.  INCS'MSG writes copies of        << 1288>>04105130
   console messages into an extra data segment (INCS XDS)      << 1288>>04105140
   created and managed by INCS/3000.  INCS/3000 reads the      << 1288>>04105150
   console messages from the extra data segment.  The extra    << 1288>>04105160
   data segment is managed as a circular queue.                << 1288>>04105170
                                                               << 1288>>04105180
DESCRIPTION OF INCS XDS:                                       << 1288>>04105190
                                                               << 1288>>04105200
   The first word (DB + %0) is used to store the tail pointer  << 1288>>04105210
   of the queue.  The second word (DB + %1) is used to         << 1288>>04105220
   store the head pointer of the queue.  The rest of INCS XDS  << 1288>>04105230
   contains the queue.  The queue is made up of N + 1 queue    << 1288>>04105240
   entries.                                                    << 1288>>04105250
                                                               << 1288>>04105260
   -----------------------------------       ---------------   << 1288>>04105270
   | TAIL    | HEAD    | QUEUE      |  . . .  | QUEUE      |   << 1288>>04105280
   | POINTER | POINTER | ENTRY 0    |         | ENTRY N    |   << 1288>>04105290
   -----------------------------------       ---------------   << 1288>>04105300
   DB+%0     DB+%1                                             << 1288>>04105310
                                                               << 1288>>04105320
   Each queue entry has the following format:                  << 1288>>04105330
                                                               << 1288>>04105340
   ------------------------------------------------            << 1288>>04105350
   | FLAG | DATA | LEN  | BUFFER                  |            << 1288>>04105360
   |      | LOST |      |                         |            << 1288>>04105370
   ------------------------------------------------            << 1288>>04105380
                                                               << 1288>>04105390
   The first word of a queue entry, FLAG, is used by INCS/3000.<< 1288>>04105400
   This field is always set to 1 by INCS'MSG.                  << 1288>>04105410
                                                               << 1288>>04105420
   The second word, DATA LOST, is used to count the number of  << 1288>>04105430
   console messages that were lost because the queue was full. << 1288>>04105440
   This field, in the queue entry pointed to by "TAILP - 1",   << 1288>>04105450
   is incremented by INCS'MSG each time it finds the queue     << 1288>>04105460
   full.                                                       << 1288>>04105470
                                                               << 1288>>04105480
   The first two words of a queue entry are reset to zero      << 1288>>04105490
   by the INCS/3000 process that reads from the queue.         << 1288>>04105500
                                                               << 1288>>04105510
   The third word, LEN, is set to the length in bytes of the   << 1288>>04105520
   console message stored in the BUFFER area of the queue      << 1288>>04105530
   entry.                                                      << 1288>>04105540
                                                               << 1288>>04105550
   The BUFFER area is the place where INCS'MSG actually puts th<< 1288>>04105560
   copy of the console message.                                << 1288>>04105570
                                                               << 1288>>04105580
INCS'MSG PARAMETERS:                                           << 1288>>04105590
                                                               << 1288>>04105600
   INCS'MSG is called with two parameters, OFFSET and CMLEN.   << 1288>>04105610
   The console message to be copied by INCS'MSG is stored in   << 1288>>04105620
   an extra data segment belonging to MPE.  OFFSET is the      << 1288>>04105630
   DB relative word address of the start of the console message<< 1288>>04105640
   in the XDS.  CMLEN is the length of the console message     << 1288>>04105650
   in bytes.                                                   << 1288>>04105660
                                                               << 1288>>04105670
OPERATION OF INCS'MSG:                                         << 1288>>04105680
                                                               << 1288>>04105690
   The system port dictionary is checked using the system port << 1288>>04105700
   procedure DICTFIND.  In an entry exits in the dictionary    << 1288>>04105710
   with name "INCS", DICTFIND returns 0 in RESULT and the      << 1288>>04105720
   data associated with "INCS" is returned in DICTDATA.  If    << 1288>>04105730
   no such entry exists DICTFIND returns 2 in RESULT.          << 1288>>04105740
                                                               << 1288>>04105750
   The value of RESULT is tested, if it is 0, processing by    << 1288>>04105760
   INCS'MSG continues, if if is 2, INCS'MSG returns to the call<< 1288>>04105770
   This allows INCS/3000 to turn INCS'MSG "on" by adding an    << 1288>>04105780
   "INCS" entry to the system port dictionary, and to turn     << 1288>>04105790
   it "off" by deleting the "INCS" entry from the port         << 1288>>04105800
   dictionary.                                                 << 1288>>04105810
                                                               << 1288>>04105820
   If an entry is found, DICTDATA(3) is checked to make        << 1288>>04105830
   sure that it is equal to CHECKVAL.  This is done as         << 1288>>04105840
   a security measure.  In case some other process             << 1288>>04105850
   happened to create a dictionary entry with name "INCS",     << 1288>>04105860
   it is very unlikely that DICTDATA(3) would be set to        << 1288>>04105870
   CHECKVAL.                                                   << 1288>>04105880
                                                               << 1288>>04105890
   If the CHECKVAL test is passed, the first three words of    << 1288>>04105900
   DICTDATA are examined to find out information about INCS XDS<< 1288>>04105910
   These three values must be set correctly by INCS/3000       << 1288>>04105920
   when the entry is added to the port dictionary.             << 1288>>04105930
   DICTDATA(0) contains the DST number of INCS XDS.            << 1288>>04105940
   DICTDATA(1) contains the size of the queue.  It             << 1288>>04105950
   corresponds exactly to N, mentioned in the description      << 1288>>04105960
   of INCS XDS.  DICTDATA(2) contains the length in bytes      << 1288>>04105970
   of the buffer area in a queue entry.  The length of         << 1288>>04105980
   the buffer area MUST BE AN EVEN NUMBER.                     << 1288>>04105990
                                                               << 1288>>04106000
   The size of a queue entry in words is calculated (QENTRYSIZE<< 1288>>04106010
   If the console message is longer than the buffer area       << 1288>>04106020
   in a queue entry, the length (CMLEN) is reset to the        << 1288>>04106030
   maximum length of the buffer area.                          << 1288>>04106040
                                                               << 1288>>04106050
   The DB resgiter is set to point to INCS XDS.                << 1288>>04106060
                                                               << 1288>>04106070
   To maintain the integrity of the queue pointers and         << 1288>>04106080
   queue in INCS XDS, a form of locking is needed to           << 1288>>04106090
   insure that INCS XDS is modified by only one process at     << 1288>>04106100
   a time.  This locking is implemented by executing           << 1288>>04106110
   a PSDB instruction to disable the dispatcher.               << 1288>>04106120
                                                               << 1288>>04106130
   The difference is taken between the tail (TAILP) and        << 1288>>04106140
   head (HEADP) pointers to determine the number of            << 1288>>04106150
   queue entries already in use.                               << 1288>>04106160
                                                               << 1288>>04106170
   If the queue is full, the tail pointer is decremented       << 1288>>04106180
   by one (PREVTAILP) and the address of the queue entry       << 1288>>04106190
   last filled is calculated.  The DATA FLAG field of          << 1288>>04106200
   that entry is incremented by one.  The dispatcher is        << 1288>>04106210
   reenabled, the DB register set back to the stack,           << 1288>>04106220
   and control returned to the caller.                         << 1288>>04106230
                                                               << 1288>>04106240
   If the queue has room, the word address (ADDR) of the queue << 1288>>04106250
   entry to be used is calculated from the value of the        << 1288>>04106260
   tailpointer and the length of a queue entry.                << 1288>>04106270
                                                               << 1288>>04106280
   The tail pointer is incremented.                            << 1288>>04106290
                                                               << 1288>>04106300
   The FLAG field of the queue entry is set to 0 (ZEROFLAG).   << 1288>>04106310
   The INCS/3000 process reading from INCS XDS will not        << 1288>>04106320
   read a queue entry unless the FLAG field contains a non-zero<< 1288>>04106330
   value.  The FLAG field must be set to zero here,            << 1288>>04106340
   since the console message has not yet been moved into       << 1288>>04106350
   the buffer, and the next step is to reenable the dispatcher,<< 1288>>04106360
   which could allow the reading process to access the queue en<< 1288>>04106370
                                                               << 1288>>04106380
   The dispatcher is reenabled (PSEB).                         << 1288>>04106390
                                                               << 1288>>04106400
   The console message is copied from the MPE XDS into         << 1288>>04106410
   the buffer area of the queue entry in INCS XDS using        << 1288>>04106420
   a MDS instruction.  The DST number of the MPE XDS           << 1288>>04106430
   containing the console message, is stored in Sysglobals     << 1288>>04106440
   at %113.  The DST number is put on the stack for the MDS    << 1288>>04106450
   instruction, by using a special SPL contruct                << 1288>>04106460
   (LOGICAL POINTER SYSGLOBS = 0, TOS := SYSGLOBS(%113)), that << 1288>>04106470
   allows the value to be copied directly from Sysglobals      << 1288>>04106480
   to the stack.                                               << 1288>>04106490
                                                               << 1288>>04106500
   The LEN field of the queue entry is set, to the length      << 1288>>04106510
   the the console message stored in the buffer area.          << 1288>>04106520
   The FLAG field is set to 1 (ONEFLAG), this marks the        << 1288>>04106530
   queue entry as ready to be read by the reading INCS/3000    << 1288>>04106540
   process.                                                    << 1288>>04106550
                                                               << 1288>>04106560
   The DB resgister is set back to the stack, and control      << 1288>>04106570
   is returned to the caller.;                                 << 1288>>04106580
                                                               << 1288>>04106590
PROCEDURE INCS'MSG(OFFSET, CMLEN);                             << 1288>>04106600
VALUE              OFFSET, CMLEN;                              << 1288>>04106610
INTEGER                    CMLEN;                              << 1288>>04106620
LOGICAL            OFFSET;                                     << 1288>>04106630
OPTION UNCALLABLE;                                             << 1288>>04106640
                                                               << 1288>>04106650
BEGIN                                                          << 1288>>04106660
  EQUATE          ZEROFLAG     = 0,                            << 1288>>04106670
                  ONEFLAG      = 1,                            << 1288>>04106680
                  CHECKVAL     = %52525;                       << 1288>>04106690
                                                               << 1288>>04106700
  LOGICAL         SAVEDST,                                     << 1288>>04106710
                  INCSDST;                                     << 1288>>04106720
                                                               << 1288>>04106730
  LOGICAL POINTER SYSGLOBS = 0;      <<USED TO ACCESS SYSGLOBAL<< 1288>>04106740
                                                               << 1288>>04106750
  INTEGER TAILP          = DB + %0;  <<USED TO ACCESS INCS XDS << 1288>>04106760
  INTEGER HEADP          = DB + %1;  <<USED TO ACCESS INCS XDS << 1288>>04106770
  INTEGER ARRAY QUEUE(*) = DB + %2;  <<USED TO ACCESS INCS XDS << 1288>>04106780
                                                               << 1288>>04106790
  INTEGER         SIZE,                                        << 1288>>04106800
                  BUFLEN,                                      << 1288>>04106810
                  NUMINQUEUE,                                  << 1288>>04106820
                  ADDR,                                        << 1288>>04106830
                  QENTRYSIZE,                                  << 1288>>04106840
                  NUMBERLOST,                                  << 1288>>04106850
                  PREVTAILP,                                   << 1288>>04106860
                  RESULT;                                      << 1288>>04106870
                                                               << 1288>>04106880
  INTEGER ARRAY   DICTDATA(0:6),                               << 1288>>04106890
                  WDICTNAME(0:7);                              << 1288>>04106900
                                                               << 1288>>04106910
  BYTE ARRAY      DICTNAME(*) = WDICTNAME;                     << 1288>>04106920
                                                               << 1288>>04106930
  MOVE DICTNAME := (4, 0, "INCS");                             << 1288>>04106940
  DICTFIND (WDICTNAME, DICTDATA, RESULT);                      << 1288>>04106950
                                                               << 1288>>04106960
  IF RESULT = 0 THEN                                           << 1288>>04106970
    IF DICTDATA(3) = CHECKVAL THEN                             << 1288>>04106980
    BEGIN                                                      << 1288>>04106990
      INCSDST    := DICTDATA(0);                               << 1288>>04107000
      SIZE       := DICTDATA(1);                               << 1288>>04107010
      BUFLEN     := DICTDATA(2);                               << 1288>>04107020
                                                               << 1288>>04107030
      QENTRYSIZE := BUFLEN/2 + 3;                              << 1288>>04107040
      IF CMLEN > BUFLEN THEN CMLEN := BUFLEN;                  << 1288>>04107050
                                                               << 1288>>04107060
      SAVEDST := EXCHANGEDB(INCSDST);                          << 1288>>04107070
                                                               << 1288>>04107080
      ASSEMBLE(PSDB);                                          << 1288>>04107090
                                                               << 1288>>04107100
      NUMINQUEUE := TAILP - HEADP;                             << 1288>>04107110
      IF NUMINQUEUE < 0 THEN NUMINQUEUE := NUMINQUEUE+SIZE +1; << 1288>>04107120
                                                               << 1288>>04107130
      IF NUMINQUEUE < SIZE THEN                                << 1288>>04107140
      BEGIN                                                    << 1288>>04107150
        ADDR  := QENTRYSIZE * TAILP;                           << 1288>>04107160
                                                               << 1288>>04107170
        TAILP := TAILP + 1;                                    << 1288>>04107180
        IF TAILP > SIZE THEN TAILP := 0;                       << 1288>>04107190
                                                               << 1288>>04107200
        QUEUE(ADDR)     := ZEROFLAG;                           << 1288>>04107210
                                                               << 1288>>04107220
        ASSEMBLE(PSEB);                                        << 1288>>04107230
                                                               << 1288>>04107240
        TOS := INCSDST;                                        << 1288>>04107250
        TOS := ADDR + 5;                                       << 1288>>04107260
        TOS := SYSGLOBS(%113);                                 << 1288>>04107270
        TOS := OFFSET;                                         << 1288>>04107280
        TOS := ((CMLEN-1)/2) + 1;                              << 1288>>04107290
        ASSEMBLE(MDS 5);                                       << 1288>>04107300
                                                               << 1288>>04107310
        QUEUE(ADDR + 2) := CMLEN;                              << 1288>>04107320
        QUEUE(ADDR)     := ONEFLAG                             << 1288>>04107330
      END                                                      << 1288>>04107340
      ELSE BEGIN                                               << 1288>>04107350
        PREVTAILP := TAILP - 1;                                << 1288>>04107360
        IF PREVTAILP < 0 THEN PREVTAILP := SIZE;               << 1288>>04107370
                                                               << 1288>>04107380
        ADDR := QENTRYSIZE * PREVTAILP + 1;                    << 1288>>04107390
        NUMBERLOST := QUEUE(ADDR);                             << 1288>>04107400
        NUMBERLOST := NUMBERLOST + 1;                          << 1288>>04107410
        IF NUMBERLOST > 32000 THEN NUMBERLOST := 0;            << 1288>>04107420
        QUEUE(ADDR) := NUMBERLOST;                             << 1288>>04107430
                                                               << 1288>>04107440
        ASSEMBLE(PSEB)                                         << 1288>>04107450
      END;                                                     << 1288>>04107460
                                                               << 1288>>04107470
      SAVEDST := EXCHANGEDB(0)                                 << 1288>>04107480
    END                                                        << 1288>>04107490
END;                                                           << 1288>>04107500
                                                               << 1288>>04107510
EQUATE MAXPRTCNT=2;  !MAX # OF LINES OF A MESSAGE TO PRINT     << 9478>>04720250
byte array space(0:0);                                         << 2218>>04905050
                                                               << 2218>>04905100
MOVEFROMDSEG(@MSG'DST'BUF,IOMSGDST,0,HEADER'SIZE);             << 9478>>05035000
IF MSG'DST'BUF(FIRST'FREE)=0 THEN                              << 9478>>05050000
$EDIT VOID=5057250                                             << 1560>>05055250
    << SINCE THIS IS 1ST IN LINE, WAKEN MESSENGER AS IF >>     << 1560>>05110000
    << A TIMER POPPED, SO IT CAN START FREEING UP BUFFER>>     << 1560>>05115000
    AWAKE(MESSENGER'PROC*PCBSIZE,%10<<TIMER>>,0);              << 1560>>05120000
  IF MSG'DST'BUF(FIRST'FREE) >                                 << 9478>>05260000
    (MSG'DST'BUF(NUM'ENTRIES)*MSG'DST'BUF(ENTRY'LENGTH))       << 9478>>05260250
    (MSG'DST'BUF(FIRST'FREE)-HEADER'SIZE) MOD                  << 9478>>05270000
      MSG'DST'BUF(ENTRY'LENGTH) <> 0 THEN                      << 9478>>05270250
  GETXDSBUF := MSG'DST'BUF(FIRST'FREE);                        << 9478>>05305000
  MOVEFROMDSEG(@MSG'DST'BUF(FIRST'FREE),IOMSGDST,              << 9478>>05320000
    MSG'DST'BUF(FIRST'FREE),1);                                << 9478>>05320250
  IF MSG'DST'BUF(FIRST'FREE) = 0 THEN                          << 9478>>05330000
    MSG'DST'BUF(LAST'FREE) := 0;                               << 9478>>05335000
  << DECREMENT NUMBER OF AVAILABLE ENTRIES BY 1>>              << 9478>>05335250
  MSG'DST'BUF(NUM'FREE):=MSG'DST'BUF(NUM'FREE)-1;              << 9478>>05335500
                                                               << 9478>>05335750
<< WRITE UPDATED MESSAGE HEADER BACK>>                         << 9478>>05336000
  MOVETODSEG(IOMSGDST,0,@MSG'DST'BUF,HEADER'SIZE);             << 9478>>05340000
$EDIT VOID=5372250                                             << 1560>>05370250
       IF dest = logonly'dest THEN                             << 2218>>05405050
         << message will be logged and disappears >>           << 2218>>05405100
         logit(sys'console'ldev)                               << 2218>>05405150
       ELSE       << logonly < dest < -1 >>                    << 2218>>05405200
        CCLRETN;                                               << 1560>>05575000
$EDIT VOID=5575500                                             << 1560>>05575250
   INCS'MSG(DSTX,OUTX);                                        << 1288>>05645100
<<SEND IOQ TO MESSENGER'PROC TO WAIT FOR COMPLETION>>          << 1560>>05765000
SENDMSG(MESSENGER'PROC,0<<port 0>>,4<<words of msg>>,%140000); << 1560>>05790000
PRTITEND:                                                      << 9478>>05820250
       IF outx >= outbuffsize THEN                             << 2218>>05890000
         IF dest = -1 THEN                                     << 2218>>05890001
         BEGIN                                                 << 2218>>05890002
            condcode := CCG;                                   << 2218>>05890003
            GOTO OUTL1;                                        << 2218>>05890004
         END                                                   << 2218>>05890005
         ELSE  PRINTIT;                                        << 2218>>05890006
         ASSEMBLE(XCH,LSUB;XCH);                               << 1319>>05970000
       IF (outx <> 0 or inlen = 0) and (dest <> - 1)           << 2218>>06715000
       THEN PRINTIT;                                           << 2218>>06720000
         IF inbuff(0) <> " "  and dest = -1 THEN               << 2218>>06770050
         BEGIN                                                 << 2218>>06770051
           space(0) := " ";                                    << 2218>>06770061
           tank (1, space);                                    << 2218>>06770100
         END;                                                  << 2218>>06771100
      go outl1 <<ALL FINISHED >>                               << 2218>>06790000
OUTL1:                                                         << 2218>>06810050
   IF dest = -1 THEN outlen := outx;                           << 2218>>06810100
LOGICAL SEG'OFFSET, DB'OFFSET;                                 << 1404>>07521000
logical maestro'flag;  << (14:2) of maestro'word >>            << 2218>>07525050
logical progen'ctrl'a := false; << true IF we are in ctrl'a >> << 2218>>07525100
logical maestro'msg := false;                                  << 2218>>07525150
array maestrobuff(0:mbufsizewm1);                              << 2218>>07525200
byte array b'maestrobuff (*) = maestrobuff;                    << 2218>>07525250
logical array parm(*) = parm1; <<parm buff: input >>           << 2218>>07525300
logical w'index ,   << index in maestrobuff >>                 << 2218>>07525350
        b'index,    << index in b'maestrobuff >>               << 2218>>07525400
        mask'index, << index of mask word in maestrobuff>>     << 2218>>07525401
        parm'len;   << length of parm i >>                     << 2218>>07525450
integer i;          << loop variable >>                        << 2218>>07525500
byte pointer b'parmx;  <<pointer to parmx if string >>         << 2218>>07525550
double pointer d'parmx; <<pointer to parmx if double >>        << 2218>>07525600
array ignor'rest(0:4) = PB := -1,                              << 2218>>07525601
                             %003333,                          << 2218>>07525611
                             %000333,                          << 2218>>07525612
                             %000033,                          << 2218>>07525622
                             %000003;                          << 2218>>07525632
                                                               << 2218>>07525650
                                                               << 2218>>07645005
subroutine format'buff;                                        << 2218>>07645010
COMMENT                                                        << 2218>>07645015
   This subroutine will format the maestrobuff contents. The   << 2218>>07645020
   buffers contents depends on setno, replyflag and mask.      << 2218>>07645025
   Set CCG if FORMSG returned CCG or it could not save all     << 2218>>07645030
   parameters.                                                 << 2218>>07645035
   Set CCL if FORMSG returned CCL                              << 2218>>07645040
;                                                              << 2218>>07645045
BEGIN                                                          << 2218>>07645050
  maestrobuff(0) := setno;                                     << 2218>>07645060
  IF pmask.preply THEN                                         << 2218>>07645065
    maestrobuff(1) := reply                                    << 2218>>07645070
  ELSE maestrobuff(1) := -1;                                   << 2218>>07645075
  maestrobuff(2) :=                                            << 2218>>07645080
     maestroprefix (pmask.preply, maestrobuff(3),len,          << 2218>>07645085
                    outbuff',console);                         << 2218>>07645090
  IF setno = -1 THEN                                           << 2218>>07645095
  BEGIN                                                        << 2218>>07645100
    << message is not in the catalog. Save the complete msg. >><< 2218>>07645105
    << as returned by FORMSG call. In this case we will use  >><< 2218>>07645110
    << mbufsize - 6.                                         >><< 2218>>07645115
    << buffer will contain:  -1, replytype/-1,               >><< 2218>>07645120
    << byte length of message, message text                  >><< 2218>>07645125
                                                               << 2218>>07645130
    FORMSG (inbuff,setno,msgno,mask,parm1,parm2,parm3,parm4,   << 2218>>07645135
            parm5,maestrobuff(3),mbufsize-6,                   << 2218>>07645140
            maestrobuff(2), -1, control);                      << 2218>>07645145
    IF < THEN condcode := CCL    << reply checks ccode >>      << 2218>>07645150
         ELSE IF > THEN condcode := CCG;                       << 2218>>07645155
    w'index  := (maestrobuff(2)+1)&LSR(1) + 3;                 << 2218>>07645160
  END                                                          << 2218>>07645165
  ELSE BEGIN                                                   << 2218>>07645170
    << setno > 0; save all relevant parms. in XDS instead >>   << 2218>>07645175
    << of the message.                                    >>   << 2218>>07645180
    << Buffer will contain:   setno, replytype/-1,        >>   << 2218>>07645185
    << prefixlength in byte, prefix, msgno                >>   << 2218>>07645190
    << mask, [parm1], ..., [parm5]                        >>   << 2218>>07645195
    << for mask describtion see FORMSG comment            >>   << 2218>>07645200
                                                               << 2218>>07645205
    w'index := (maestrobuff(2)+1)&LSR(1) + 3;                  << 2218>>07645210
    maestrobuff(w'index) := msgno;                             << 2218>>07645215
    w'index := w'index + 1;                                    << 2218>>07645220
    maestrobuff(w'index) := mask;                              << 2218>>07645225
    mask'index := w'index;                                     << 2218>>07645226
    w'index := w'index + 1;                                    << 2218>>07645230
    IF mask <> -1 THEN                                         << 2218>>07645235
    BEGIN                                                      << 2218>>07645240
      << save the parameters parm1,..,parm5 >>                 << 2218>>07645245
      << each value will start at a wordadress>>               << 2218>>07645250
      i := 0;                                                  << 2218>>07645251
      do BEGIN                                                 << 2218>>07645255
        CASE *integer (mask & CSL(4+ i*3) LAND 3) of           << 2218>>07645260
        BEGIN                                                  << 2218>>07645265
          BEGIN                                                << 2218>>07645270
            << 0 @string  terminated by 0 >>                   << 2218>>07645275
            b'index := w'index & LSL(1);                       << 2218>>07645280
            IF b'index >= mbufsize THEN                        << 2218>>07645285
            BEGIN                                              << 2218>>07645286
              << no space left in buffer, ignore rest of   >>  << 2218>>07645290
              << parameters including this one             >>  << 2218>>07645295
              maestrobuff(mask'index) :=                       << 2218>>07645300
                                 mask LOR ignor'rest(i);       << 2218>>07645301
              condcode := CCG;                                 << 2218>>07645305
              return;                                          << 2218>>07645310
            END;                                               << 2218>>07645315
            @b'parmx := parm(i);                               << 2218>>07645320
            scan b'parmx until 0, 1;                           << 2218>>07645325
            parm'len := (TOS - @b'parmx) + 1;                  << 2218>>07645330
            IF (b'index + parm'len) > mbufsize THEN            << 2218>>07645335
            BEGIN                                              << 2218>>07645340
            << not enough space left for the whole string    >><< 2218>>07645345
            << save as much as possible. Ignore following    >><< 2218>>07645350
            << parameters                                    >><< 2218>>07645355
              maestrobuff(mask'index) :=                       << 2218>>07645360
                               mask LOR ignor'rest(i+1);       << 2218>>07645361
              parm'len := mbufsize - b'index -1;               << 2218>>07645364
              move b'maestrobuff(b'index) :=                   << 2218>>07645365
                                   b'parmx, (parm'len);        << 2218>>07645366
              b'maestrobuff(mbufsize - 1) := 0;                << 2218>>07645370
              w'index := mbufsizew;                            << 2218>>07645375
              condcode := CCG;                                 << 2218>>07645380
              return;                                          << 2218>>07645385
            END;                                               << 2218>>07645390
            move b'maestrobuff (b'index) := b'parmx,(parm'len);<< 2218>>07645395
            w'index := (b'index + parm'len + 1)&LSR(1);        << 2218>>07645400
          END;                                                 << 2218>>07645405
          BEGIN                                                << 2218>>07645410
            << 1 integer >>                                    << 2218>>07645415
            << should start at a word boundary >>              << 2218>>07645420
            IF w'index >= mbufsizew THEN                       << 2218>>07645425
            BEGIN                                              << 2218>>07645430
              << buffer is full ignore the parameter and all >><< 2218>>07645435
              << subsequent parameters.                      >><< 2218>>07645440
              maestrobuff(mask'index) :=                       << 2218>>07645445
                             mask LOR ignor'rest(i);           << 2218>>07645446
              condcode := CCG;                                 << 2218>>07645450
              return;                                          << 2218>>07645455
            END;                                               << 2218>>07645460
            maestrobuff(w'index) := parm(i);                   << 2218>>07645465
            w'index := w'index + 1;                            << 2218>>07645470
          END;                                                 << 2218>>07645475
          BEGIN                                                << 2218>>07645480
            << 2 @double >>                                    << 2218>>07645485
            IF w'index >= (mbufsizew - 1) THEN                 << 2218>>07645490
            BEGIN                                              << 2218>>07645495
              << no more space in buffer ignor the following >><< 2218>>07645500
              << parameters including this one >>              << 2218>>07645505
              maestrobuff(mask'index) :=                       << 2218>>07645510
                                mask LOR ignor'rest(i);        << 2218>>07645511
              condcode := CCG;                                 << 2218>>07645515
              return;                                          << 2218>>07645520
            END;                                               << 2218>>07645525
            @d'parmx := parm(i);                               << 2218>>07645530
            TOS := d'parmx;                                    << 2218>>07645535
            maestrobuff(w'index + 1):= TOS;                    << 2218>>07645540
            maestrobuff(w'index) := TOS;                       << 2218>>07645545
            w'index := w'index + 2;                            << 2218>>07645550
          END;                                                 << 2218>>07645555
          ;  << 3 ignor parm >>                                << 2218>>07645560
        END; <<case>>                                          << 2218>>07645565
        i := i+1;                                              << 2218>>07645566
      END until i >= 5;                                        << 2218>>07645567
    END; <<THEN mask <> -1>>                                   << 2218>>07645570
  END; << ELSE  setno > 0 >>                                   << 2218>>07645575
END;  << subroutine format'buff >>                             << 2218>>07645580
                                                               << 2218>>07645585
      IF cigset and cswitchmsg                                 << 2218>>07860050
         THEN maestro'msg := true;                             << 2218>>07860100
      maestro'msg := true;                                     << 2218>>07880050
      maestro'msg := true;                                     << 2218>>07915050
   maestro'msg := true;                                        << 2218>>07945050
maestro'flag := get'flag; <<1/3 if maestro enabled >>          << 2218>>08300005
IF (maestro'flag = 3) and (MYPIN = progen'pin) THEN            << 2218>>08300010
   progen'ctrl'a := true;                                      << 2218>>08300015
IF maestro'msg and (maestro'flag.(15:1) = 1)                   << 2218>>08300020
   and not progen'ctrl'a THEN                                  << 2218>>08300025
BEGIN                                                          << 2218>>08300030
   <<Maestro is enabled and this message should not         >> << 2218>>08300035
   << come up on the console                                >> << 2218>>08300040
    format'buff;                                               << 2218>>08300080
    IF condcode <> CCL THEN                                    << 2218>>08300085
    BEGIN                                                      << 2218>>08300086
      save'message ( w'index, maestrobuff );                   << 2218>>08300090
      IF < THEN condcode := CCL;                               << 2218>>08300091
    END;                                                       << 2218>>08300092
    << for all messages comming this way don't forget to log>> << 2218>>08300100
    << them if console logging is on                        >> << 2218>>08300105
    IF condcode <> CCL THEN                                    << 2218>>08300110
    BEGIN                                                      << 2218>>08300111
      << maestrobuff(3) & outbuff are equal in the first >>    << 2218>>08300112
      << tmp characters.                                 >>    << 2218>>08300117
      GENMSG := FORMSG (inbuff,setno,msgno,mask,parm1,parm2,   << 2218>>08300127
                      parm3,parm4,parm5,maestrobuff(3),        << 2218>>08300128
                      outbuffsize,                             << 2218>>08300129
                      tmp,logonly'dest,control);               << 2218>>08300130
      IF pmask.preply THEN                                     << 2218>>08300131
      BEGIN                                                    << 2218>>08300132
        tmp := len;                                            << 2218>>08300133
        GENMSG := FORMSG (inbuff, setno, msgno, mask,          << 2218>>08300134
                  parm1, parm2, parm3, parm4, parm5,           << 2218>>08300135
                  outbuff', outbuffsize, tmp, -1, control);    << 2218>>08300136
        IF < THEN condcode := CCL                              << 2218>>08300137
          ELSE IF > THEN condcode := CCG;                      << 2218>>08300138
      END;                                                     << 2218>>08300140
    END;                                                       << 2218>>08300141
END                                                            << 2218>>08300160
ELSE BEGIN                                                     << 2218>>08300165
  << either Maestro not running or the message is           >> << 2218>>08300170
  << no console message.                                    >> << 2218>>08300175
                                                               << 2218>>08300180
END;  <<ELSE>>                                                 << 2218>>08355100
      THEN BEGIN                                               << 2218>>08460005
        set'reply'flag;  <<tell maestro user reply pENDing>>   << 2218>>08460010
        IF (maestro'flag.(15:1) = 0) or progen'ctrl'a          << 2218>>08460015
        ;                                                      << 2218>>08475050
      END                                                      << 2218>>08475100
      BEGIN                                                    << 1404>>08559800
      SEG'OFFSET := CONSBUFF'(2); << offset for reply >>       << 1404>>08559900
      IF DST = 0 THEN  << reply to stack, offset is db'rel >>  << 1404>>08566000
         BEGIN   << calculate segment relative offset >>       << 1404>>08566100
         TOS := @DB'OFFSET;                                    << 1404>>08566200
         TOS := CONSBUFF'(1); << DST number of stack >>        << 1404>>08566300
         TOS := 1;   << 1st word in PXGLOB: seg db >>          << 1404>>08566400
         TOS := 1;                                             << 1404>>08566500
         ASSEMBLE (MFDS 4);                                    << 1404>>08566600
         SEG'OFFSET := SEG'OFFSET + DB'OFFSET;                 << 1404>>08566700
         END;                                                  << 1404>>08566800
         MOVETODSEG(CONSBUFF'(1),SEG'OFFSET,@CHAR'ZERO,2);     << 1404>>08590000
         MOVETODSEG(CONSBUFF'(1),SEG'OFFSET,@ZERO,1);          << 1404>>08610000
      END;                                                     << 1404>>08621000
$TITLE "Maestroprefix"                                         << 2218>>09085005
Integer procedure maestroprefix (reply, buffer,clen, cbuff,    << 2218>>09085010
                                 console);                     << 2218>>09085015
        value reply, clen, console;                            << 2218>>09085020
        logical reply, console;                                << 2218>>09085025
        integer clen;    << length of console buffer >>        << 2218>>09085030
        array buffer;    << maestro buffer >>                  << 2218>>09085035
        array cbuff;     << console buffer >>                  << 2218>>09085040
        option internal;                                       << 2218>>09085045
                                                               << 2218>>09085050
COMMENT                                                        << 2218>>09085055
 This procedure will add "[?]<time>/[#J\Sxxx]/pin/             << 2218>>09085060
 [user.account]/" in the buffer.                               << 2218>>09085065
 It will use consprefix to do half of the work.                << 2218>>09085070
 It will also return the length of the prefix.                 << 2218>>09085075
;                                                              << 2218>>09085080
                                                               << 2218>>09085085
BEGIN                                                          << 2218>>09085090
integer                                                        << 2218>>09085095
    index = maestroprefix,                                     << 2218>>09085100
    w'index,                                                   << 2218>>09085105
    pcbglobloc;                                                << 2218>>09085110
array qarray(*) = q + 0;                                       << 2218>>09085115
logical pcbpt;                                                 << 2218>>09085120
byte array b'buff(*) = buffer;                                 << 2218>>09085125
byte array b'cbuff(*) = cbuff;                                 << 2218>>09085130
                                                               << 2218>>09085135
array uname(0:4),                                              << 2218>>09085140
      aname(0:4);                                              << 2218>>09085145
byte array b'uname(*) = uname,                                 << 2218>>09085150
           b'aname(*) = aname;                                 << 2218>>09085155
DEFINE                                                         << 2218>>09085160
      user'acct'name'len = 18#; <<2*8+2*1>>                    << 2218>>09085165
                                                               << 2218>>09085170
subroutine def'movefromdseg;                                   << 2218>>09085175
                                                               << 2218>>09085180
  << add <time>/[#J\Sxxx]/pin/ >>                              << 2218>>09085185
  IF reply or console THEN                                     << 2218>>09085190
  BEGIN                                                        << 2218>>09085195
    << console prefix already exists >>                        << 2218>>09085200
    index := clen;                                             << 2218>>09085205
    move b'buff := b'cbuff,(clen);                             << 2218>>09085210
  END                                                          << 2218>>09085215
  ELSE index := consprefix (reply, buffer);                    << 2218>>09085220
                                                               << 2218>>09085225
  pcbpt := curprc;                                             << 2218>>09085230
  IF procstate.systemprocflag = 0 THEN                         << 2218>>09085235
  BEGIN                                                        << 2218>>09085240
    << if userprocess add username.accountname/ >>             << 2218>>09085245
    uname(4) := 0;    << make sure move while AN will stop >>  << 2218>>09085250
    aname(4) := 0;                                             << 2218>>09085255
    pxglobal;                                                  << 2218>>09085260
    movefromdseg (@uname,pxg'jitdst,jit'uname'ptr,4);          << 2218>>09085265
    movefromdseg (@aname,pxg'jitdst,jit'aname'ptr,4);          << 2218>>09085270
    move b'buff (index) := b'uname while AN,1;                 << 2218>>09085275
    move * :=  ".",2;                                          << 2218>>09085280
    move * := b'aname while AN,1;                              << 2218>>09085285
    move * :=  "/",2;                                          << 2218>>09085290
    index := TOS - @b'buff;                                    << 2218>>09085295
  END;                                                         << 2218>>09085300
END; << maestroprefix >>                                       << 2218>>09085305
                                                               << 2218>>09085310
                                                               << 2218>>09085315
$TITLE "save'message"                                          << 2218>>09085320
procedure save'message(len,buff);                              << 2218>>09085325
  value len;                                                   << 2218>>09085330
  integer len;     << no. of words in buffer >>                << 2218>>09085335
  array buff;      << buffer containing the message >>         << 2218>>09085340
  option uncallable,privileged;                                << 2218>>09085345
                                                               << 2218>>09085350
COMMENT                                                        << 2218>>09085355
  This proc. will save the buffer contents and the length in   << 2218>>09085360
  an XDS opend by the background filter process of Maestro. The<< 2218>>09085365
  XDS is organised as a circular queue. At location 0-3 you'll << 2218>>09085370
  find tailptr, headptr, lostcount and max. queuesize          << 2218>>09085375
  Locations > 3 will contain the queue. Each queue element     << 2218>>09085380
  is of fixed size.                                            << 2218>>09085385
  The buffer will contain different info. The general layout   << 2218>>09085390
  is :                                                         << 2218>>09085395
  setno reply  len text [msgno mask [parm1] ...[parm5]]        << 2218>>09085400
  For more detail see the comments in format'buff.             << 2218>>09085405
                                                               << 2218>>09085410
  The headptr will allways point to the first element in the   << 2218>>09085415
  queue if the queue is not empty.                             << 2218>>09085420
  That will be indicated by bit 11 of the maestro'word in the  << 2218>>09085421
  SYSGLOB'EXT area.                                            << 2218>>09085422
  This procedure will manipulate the  headptr only if it       << 2218>>09085425
  adds a new queue element to an empty queue. The reader       << 2218>>09085430
  process will manipulate the head after reading the head      << 2218>>09085435
  element of the queue.                                        << 2218>>09085440
  The tail will always point to the last element in the queue. << 2218>>09085445
  At ther very beginning, tailptr will be -1 too, to indicate  << 2218>>09085450
  that. This is needed to start writing the DS a qelement 0.   << 2218>>09085455
  New queue elements will be added at the tail.                << 2218>>09085460
  The lostcount will be incremented by 1 and the message       << 2218>>09085465
  not be saved iff the queue is full.                          << 2218>>09085470
  NOTE: The filterprocess will create a XDS that contains      << 2218>>09085475
        queue elements  with entrysize 162 words. This is the  << 2218>>09085480
        current ci'commandbuffersize + 22 words.               << 2218>>09085485
  NOTE: This procedure will turn the console on again, if      << 2218>>09085490
        the XDS does not exist.                                << 2218>>09085495
  ;                                                            << 2218>>09085500
                                                               << 2218>>09085505
BEGIN                                                          << 2218>>09085510
  logical dstn,          << dstno. of XDS >>                   << 2218>>09085515
          flag;          << 0 = free , 1 = occupied >>         << 2218>>09085520
  integer addr,          << offset in XDS>>                    << 2218>>09085525
          numofentries;  << current no of elements >>          << 2218>>09085530
                                                               << 2218>>09085535
  integer array overhead (0:qbase - 1);                        << 2218>>09085540
                                                               << 2218>>09085545
  DEFINE                                                       << 2218>>09085550
    queue'is'not'empty =                                       << 2218>>09085551
       sysg'ext'ptr(maestro'offset).(11:1) := 1#,              << 2218>>09085552
    queue'empty =                                              << 2218>>09085553
       sysg'ext'ptr(maestro'offset).(11:1) = 0#,               << 2218>>09085554
    tailptr   = overhead(0)#, << offset in XDS >>              << 2218>>09085555
    headptr   = overhead(1)#, << offset in XDS >>              << 2218>>09085560
    lostcount = overhead(2)#, << no of lost messages >>        << 2218>>09085565
    qsize     = overhead(3)#; << max # of queue elements - 1 >><< 2218>>09085570
                                                               << 2218>>09085575
                                                               << 2218>>09085580
  subroutine def'movefromdseg;                                 << 2218>>09085585
  subroutine def'movetodseg;                                   << 2218>>09085590
                                                               << 2218>>09085595
      << Now disable dispatcher to make sure that no one else>><< 2218>>09085600
      << will work on our XDS                                >><< 2218>>09085605
      condcode := CCE;                                         << 2218>>09085610
      dstn := curdst;                                          << 2218>>09085615
      IF dstn <> 0 THEN                                        << 2218>>09085620
      BEGIN                                                    << 2218>>09085625
        << make DST present before pdisable >>                 << 2218>>09085630
        exchangedb(dstn);                                      << 2218>>09085635
        assemble (PSDB);                                       << 2218>>09085640
        exchangedb(0);                                         << 2218>>09085645
        movefromdseg (@overhead, dstn, %0, qbase);             << 2218>>09085650
        tailptr := tailptr + 1;                                << 2218>>09085655
        IF tailptr > qsize THEN tailptr := 0;                  << 2218>>09085660
        IF queue'empty THEN                                    << 2218>>09085665
        BEGIN                                                  << 2218>>09085670
          << queue is empty >>                                 << 2218>>09085675
          headptr := tailptr;                                  << 2218>>09085680
          addr := mbufsizew * tailptr + qbase;                 << 2218>>09085685
          movetodseg (dstn, %0, @tailptr,2);                   << 2218>>09085690
          movetodseg (dstn, addr, @buff(0), len);              << 2218>>09085695
          queue'is'not'empty;                                  << 2218>>09085696
        END                                                    << 2218>>09085700
        ELSE BEGIN                                             << 2218>>09085705
          IF tailptr = headptr THEN                            << 2218>>09085710
          BEGIN                                                << 2218>>09085715
            << queue is full >>                                << 2218>>09085720
            IF lostcount = 32767                               << 2218>>09085725
              THEN lostcount := 0                              << 2218>>09085730
              ELSE lostcount := lostcount +1;                  << 2218>>09085735
              movetodseg (dstn, %2, @lostcount, 1);            << 2218>>09085740
          END                                                  << 2218>>09085745
          ELSE BEGIN                                           << 2218>>09085750
            << space enough for at least one entry >>          << 2218>>09085751
            addr := mbufsizew* tailptr + qbase;                << 2218>>09085755
            movetodseg (dstn, %0, @tailptr,1);                 << 2218>>09085760
            movetodseg (dstn, addr, @buff(0), len);            << 2218>>09085765
            queue'is'not'empty;                                << 2218>>09085766
          END;                                                 << 2218>>09085770
        END; << ELSE queue not empty >>                        << 2218>>09085775
      assemble (PSEB);                                         << 2218>>09085780
    END                                                        << 2218>>09085785
    ELSE  BEGIN << dstn = 0 this should not happen if the >>   << 2218>>09085790
                << filter process is initialized correct  >>   << 2218>>09085795
      disable'maestro;                                         << 2218>>09085800
      condcode := CCL;                                         << 2218>>09085805
    END; <<ELSE >>                                             << 2218>>09085810
END;                                                           << 2218>>09085815
                                                               << 2218>>09086005
                                                               << 2218>>09086010
$PAGE                                                          << 2218>>09086015
$TITLE "initiat console elimination "                          << 2218>>09086020
integer procedure initiat'filter(qsize);                       << 2218>>09086025
integer qsize;                                                 << 2218>>09086030
option privileged;                                             << 2218>>09086035
                                                               << 2218>>09086040
  COMMENT                                                      << 2218>>09086045
    This procedure will initiat console elimination.           << 2218>>09086050
    (But only if there is for sure no other filter running!)   << 2218>>09086055
    It will - get an XDS,                                      << 2218>>09086060
            - write dstn in sysglobal extention area           << 2218>>09086065
            - enable Maestro                                   << 2218>>09086070
    REMARK: once an XDS is created it will stay in the system  << 2218>>09086075
            until the next warm/cool/coldstart !!!!!!          << 2218>>09086080
    RETURNS errornumber:                                       << 2218>>09086085
      errn = 0 o.k. create a DS of appropriate size            << 2218>>09086090
             1 created a DS but with different size            << 2218>>09086095
             2 DS already exists size might be different       << 2218>>09086100
                                                               << 2218>>09086105
             3 failed to get a DS                              << 2218>>09086110
             4 console is already eliminated                   << 2218>>09086115
             5 some one else is currently in this procedure    << 2218>>09086120
                                                               << 2218>>09086125
    ;                                                          << 2218>>09086130
  BEGIN                                                        << 2218>>09086135
  DEFINE                                                       << 2218>>09086140
   start'bit       = sysg'ext'ptr(maestro'offset).(0:1)#,      << 2218>>09086145
   set'start'bit   = sysg'ext'ptr(maestro'offset).(0:1):=1#,   << 2218>>09086150
   reset'start'bit = sysg'ext'ptr(maestro'offset).(0:1):=0#,   << 2218>>09086155
   consol'off      = sysg'ext'ptr(maestro'offset).(15:1)=1#,   << 2218>>09086160
   enable'maestro  = sysg'ext'ptr(maestro'offset).(14:2):=1#,  << 2218>>09086165
   dstlen          = (qsize * mbufsizew + qbase+3) / 4 * 4#,   << 2218>>09086170
   maxquelem       = qsize - 1#;                               << 2218>>09086175
                                                               << 2218>>09086180
  integer errn = initiat'filter;                               << 2218>>09086185
  integer dstn;                                                << 2218>>09086190
  integer len;                                                 << 2218>>09086195
  integer crit;                                                << 2218>>09086200
  integer array initial'val(0:qbase);                          << 2218>>09086205
  integer maxqsize;                                            << 2218>>09086210
                                                               << 2218>>09086215
  subroutine def'movetodseg;                                   << 2218>>09086220
                                                               << 2218>>09086225
  << first check if there is a filter already running. >>      << 2218>>09086230
  << if meastro is enabled there must be an other running.>>   << 2218>>09086235
  << => exit >>                                                << 2218>>09086240
                                                               << 2218>>09086245
  << make sure no one else will enter this code >>             << 2218>>09086250
  << at the same time >>                                       << 2218>>09086255
    errn := 0;                                                 << 2218>>09086260
    maxqsize := (32764 - qbase - 3) / mbufsizew;               << 2218>>09086265
    assemble (PSDB);                                           << 2218>>09086270
    IF start'bit = 1 THEN                                      << 2218>>09086275
    BEGIN                                                      << 2218>>09086280
      assemble (PSEB);                                         << 2218>>09086285
      << somebody else tries to do the same >>                 << 2218>>09086290
      errn := 5;                                               << 2218>>09086295
      return;                                                  << 2218>>09086300
    END                                                        << 2218>>09086305
    ELSE BEGIN                                                 << 2218>>09086310
      crit := setcritical;                                     << 2218>>09086315
      set'start'bit;                                           << 2218>>09086320
      assemble (PSEB);                                         << 2218>>09086325
    END;                                                       << 2218>>09086330
                                                               << 2218>>09086335
  IF consol'off THEN                                           << 2218>>09086340
  BEGIN                                                        << 2218>>09086345
    << a different filter is running >>                        << 2218>>09086350
    errn := 4;                                                 << 2218>>09086355
    goto outl;                                                 << 2218>>09086360
  END;                                                         << 2218>>09086365
                                                               << 2218>>09086370
  dstn := curdst;                                              << 2218>>09086375
  IF dstn <> 0 THEN                                            << 2218>>09086380
  BEGIN                                                        << 2218>>09086385
    << DS already exists >>                                    << 2218>>09086390
    errn := 2;                                                 << 2218>>09086395
    enable'maestro;                                            << 2218>>09086400
  END                                                          << 2218>>09086405
  ELSE BEGIN                                                   << 2218>>09086410
    << filter is started the first time after last startup>>   << 2218>>09086415
    << of the system >>                                        << 2218>>09086420
    IF qsize > maxqsize THEN                                   << 2218>>09086425
    BEGIN                                                      << 2218>>09086430
      qsize := maxqsize;                                       << 2218>>09086435
      errn := 1;                                               << 2218>>09086440
    END;                                                       << 2218>>09086445
    len := dstlen;                                             << 2218>>09086450
    dstn := getdataseg (len,len);                              << 2218>>09086455
    IF dstn <> 0 THEN                                          << 2218>>09086460
    BEGIN                                                      << 2218>>09086465
         << initial values: tailptr = -1       >>              << 2218>>09086470
         <<                 headptr = -1       >>              << 2218>>09086475
         <<                 lost    = 0        >>              << 2218>>09086480
         <<                 maxquelem qzise -1 >>              << 2218>>09086485
         <<                 the rest = 0       >>              << 2218>>09086490
      move initial'val :=(-1,-1,0,0,0);                        << 2218>>09086495
      initial'val(3) := maxquelem;                             << 2218>>09086500
      movetodseg (dstn, %0,@initial'val,qbase + 1);            << 2218>>09086505
      << initiat rest of XDS to 0 >>                           << 2218>>09086510
      TOS := dstn;                                             << 2218>>09086515
      TOS := qbase + 1;                                        << 2218>>09086520
      TOS := dstn;                                             << 2218>>09086525
      TOS := qbase;                                            << 2218>>09086530
      TOS := len - (qbase + 1);                                << 2218>>09086535
      assemble (mds 5);                                        << 2218>>09086540
      curdst := dstn;                                          << 2218>>09086545
      enable'maestro;                                          << 2218>>09086550
    END                                                        << 2218>>09086555
    ELSE errn := 3; << failed to get a DS >>                   << 2218>>09086560
  END;                                                         << 2218>>09086565
  << END of startup phase reset the start up bit >>            << 2218>>09086570
outl:                                                          << 2218>>09086575
  reset'start'bit;                                             << 2218>>09086580
  resetcritical(crit);                                         << 2218>>09086585
END; <<initiat'filter' >>                                      << 2218>>09086590
                                                               << 2218>>09086595
                                                               << 2218>>09086600
                                                               << 2218>>09086605
                                                               << 2218>>09086610
$page                                                          << 2218>>09086615
$TITLE "get'queue'element"                                     << 2218>>09086620
logical procedure get'queue'element(buff,lost);                << 2218>>09086625
   integer lost;                                               << 2218>>09086630
   array buff;                                                 << 2218>>09086635
option privileged;                                             << 2218>>09086640
COMMENT                                                        << 2218>>09086645
   This procedure will load the head of the queue from the     << 2218>>09086650
   XDS DSTN in the buffer buff.                                << 2218>>09086655
   The queue is empty if head = -1.                            << 2218>>09086660
   RETURNS  error number:                                      << 2218>>09086665
     0 :   if found an element in the queue                    << 2218>>09086670
     1 :   if the queue is empty                               << 2218>>09086675
     2 :   if there is no DS assigned.                         << 2218>>09086680
   ;                                                           << 2218>>09086685
  BEGIN                                                        << 2218>>09086690
  integer addr;                                                << 2218>>09086695
  integer array que'overhead (0:qbase-1);                      << 2218>>09086700
  integer dstn;                                                << 2218>>09086705
  integer errn = get'queue'element;                            << 2218>>09086710
                                                               << 2218>>09086715
  define tailptr    = que'overhead(0)#,                        << 2218>>09086720
         headptr    = que'overhead(1)#,                        << 2218>>09086725
         lostcount  = que'overhead(2)#,                        << 2218>>09086730
         maxquelem  = que'overhead(3)#,                        << 2218>>09086735
         queue'is'empty =                                      << 2218>>09086736
           sysg'ext'ptr(maestro'offset).(11:1) = 0#,           << 2218>>09086737
         queue'is'empty'now =                                  << 2218>>09086738
           sysg'ext'ptr(maestro'offset).(11:1) := 0#,          << 2218>>09086739
         queue'is'not'empty =                                  << 2218>>09086740
           sysg'ext'ptr(maestro'offset).(11:1) = 1#;           << 2218>>09086742
                                                               << 2218>>09086748
                                                               << 2218>>09086749
  subroutine def'movefromdseg;                                 << 2218>>09086750
  subroutine def'movetodseg;                                   << 2218>>09086755
                                                               << 2218>>09086760
  IF queue'is'empty THEN                                       << 2218>>09086761
  BEGIN                                                        << 2218>>09086762
    errn := 1;                                                 << 2218>>09086763
    return;                                                    << 2218>>09086764
  end;                                                         << 2218>>09086765
  dstn := curdst;                                              << 2218>>09086769
  IF dstn = 0 THEN                                             << 2218>>09086770
  BEGIN                                                        << 2218>>09086775
    errn := 2;                                                 << 2218>>09086780
    return;                                                    << 2218>>09086785
  END;                                                         << 2218>>09086790
  exchangedb(dstn);                                            << 2218>>09086795
             <<allocate the XDS so that we don't get a MAM>>   << 2218>>09086800
             <<interrupt while Pdisabled.                 >>   << 2218>>09086805
  assemble (PSDB);  <<turn off dispatcher >>                   << 2218>>09086810
  exchangedb(0);                                               << 2218>>09086815
             <<Now XDS and stack are in memory, back to stack>><< 2218>>09086820
             <<We will not get an absent trap while pdisabled>><< 2218>>09086825
  movefromdseg (@que'overhead, dstn, %0,qbase);                << 2218>>09086830
  IF queue'is'not'emtpy THEN                                   << 2218>>09086835
  BEGIN                                                        << 2218>>09086840
    << new is element >>                                       << 2218>>09086845
    addr := headptr * mbufsizew + qbase;                       << 2218>>09086850
    movefromdseg (@buff, dstn, addr,mbufsizew);                << 2218>>09086855
    lost := lost + lostcount;    <<queue might be full>>       << 2218>>09086860
    lostcount := 0;                                            << 2218>>09086865
    IF headptr = tailptr THEN                                  << 2218>>09086870
      queue'is'empty'now                                       << 2218>>09086881
    ELSE BEGIN                                                 << 2218>>09086885
      headptr := headptr + 1;                                  << 2218>>09086890
      IF headptr > maxquelem THEN headptr := 0;                << 2218>>09086895
    END;                                                       << 2218>>09086900
    movetodseg (dstn, %1, @headptr,2);                         << 2218>>09086905
                     <<save headptr, lostcount >>              << 2218>>09086910
    assemble (PSEB); << turn dispatcher on >>                  << 2218>>09086915
    errn := 0;                                                 << 2218>>09086920
  END                                                          << 2218>>09086925
  ELSE BEGIN                                                   << 2218>>09086930
    << queue is empty >>                                       << 2218>>09086935
    << this can only happen, iff more than one reader exist >> << 2218>>09086936
    assemble (PSEB);                                           << 2218>>09086940
    errn := 1;                                                 << 2218>>09086945
  END;                                                         << 2218>>09086950
END;                                                           << 2218>>09086955
                                                               << 2218>>09086960
DSTN1 := (SBUFSIZEW*NUM'MSG'BUFS)+HEADER'SIZE;                 << 9478>>09460000
<< SETUP MESSAGE TABLE HEADER>>                                << 9478>>09490000
DIRECTORY(ENTRY'LENGTH):=SBUFSIZEW;  !SIZE OF MESSAGE BUFFER   << 9478>>09500000
DIRECTORY(NUM'FREE):=NUM'MSG'BUFS;   !# OF FREE ENTRIES        << 9478>>09500250
DIRECTORY(FIRST'FREE):=HEADER'SIZE;  !POINTER TO FIRST AVAIL   << 9478>>09505000
DIRECTORY(LAST'FREE):=(SBUFSIZEW*(NUM'MSG'BUFS-1))+HEADER'SIZE;<< 9478>>09510000
MOVETODSEG(IOMSGDST,0,@DIRECTORY,HEADER'SIZE);                 << 9478>>09515000
ECODE := HEADER'SIZE;   !DISPLACEMENT TO START OF BUFFERS      << 9478>>09535000
