Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50501/forum.mac
There are no other files named forum.mac in the archive.
TITLE FORUM A PROGRAM FOR INTER-TERMINAL COMMUNICATION
SUBTTL ERNIE PETRIDES, WESLEYAN UNIVERSITY, JANUARY, 1979
SEARCH QPACK,MACTEN,UUOSYM
TWOSEG
SALL
COMMENT \
THIS PROGRAM REQUIRES A STARTUP DIALOGUE WITH THE USER THE FIRST
TIME IT IS RUN. THE NECESSARY INFORMATION IS THEN WRITTEN INTO "TMPCOR"
SO THAT FUTURE RUNS WILL NOT REQUIRE THIS DIALOGUE. A CCL START TO THIS
PROGRAM IS THE SIGNAL TO ATTEMPT TO OBTAIN THE INFORMATION FROM TMPCOR.
ALSO, DON'T FORGET THAT OUTLIB MUST BE COMPILED WITH THE AC DEFINITIONS
FOR T1, T2, T3, C, M, N, AND P. THESE ASSIGNMENTS ALONG WITH .FTMOD==2,
.FTIOE=-1, .FTLMD==0, .FTFUC==0, .FTFLC==0, AND .FTFNC==0 MUST ALL BE
GIVEN IN THE UNIVERSAL FILE "AC". PLEASE NOTE THAT THE SCANNING OF THE
FORUM LINKED LIST FROM TOP TO BOTTOM (AS OPPOSED TO A CIRCULAR LIST, AS
USED TO BE DONE) IS NECESSARY TO AVOID INFINITE LOOPS ON REMOVALS.
\
EXTERN FC$SHR,FC$DEL,LL$APR,LL$REM
EXTERN ACTOUT,LINOUT,STROUT,CLFOUT,DLFOUT,SPCOUT,DSPOUT,TABOUT
EXTERN CHROUT,BRKOUT,PPNOUT,DECOUT,OCTOUT,SIXOUT,SXSOUT,FTLOUT
EXTERN OUTLST,ERR,DEV,FIL,EXT,PPN,SIX,CPOPJ1,CPOPJ0
SUBTTL ACCUMULATOR AND I/O CHANNEL DEFINITIONS
F==0 ;FLAG REGISTER
T1==1 ;FOUR CONSECUTIVE TEMPS ("AC")
T2==2 ; ("AC")
T3==3 ; ("AC")
T4==4 ;
P1==5 ;PRESERVED AC'S FOR SCRATCH WORK
P2==6 ; (DITTO)
ID==7 ;ID BLOCK POINTER
C==10 ;CHARACTER AC ("AC")
M==11 ;MESSAGE POINTER ("AC")
N==12 ;NUMBER REGISTER ("AC")
E==13 ;ERROR CODE OR BRANCH
X==14 ;GENERAL INDEX OR POINTER
Q==15 ;INPUT QUEUE POINTER
A==16 ;ARGUMENT PASSER
P==17 ;PUSH DOWN STACK POINTER ("AC")
PRF==1 ;PROFILE I/O CHANNEL
LOG==2 ;I/O CHANNEL FOR LOG
PTY==3 ;PTY FOR SENDS AND SYS U'S
HLP==4 ;CHANNEL FOR READING HELP FILE
FDC==5 ;FREE DISK CHANNEL FOR TEMP WORK
LKP==6 ;GENERAL CHANNEL FOR LOOKUPS ONLY
SUBTTL PARAMETERS, MACROS, AND OPERATORS
ND WRKSIZ,^D50 ;WORK BUFFER SIZE (IN WORDS)
ND INQSIZ,^D120/5 ;TTY INPUT QUEUE SIZE (WORDS)
ND NAMSIZ,4 ;NICK-NAME SIZE (IN WORDS)
ND OMLMAX,^D10 ;MAX LENGTH OF OLD MESSAGE LIST
ND BEPMAX,^D20 ;MAX TIMES NON-PRIV'S MAY BEEP
ND HBRTIM,^D10*^D1000 ;MAXIMUM MILLISECS TO LET HIBER
ND GRCTIM,6*^D1000 ;GRACE TIME BEFORE TYPE INTERRUPT
ND SLPTIM,2 ;SECONDS TO SLEEP IF ANY HIBER FAILS
ND OVRIDE,^D8*^D60 ;MAX JIFFIES BEFORE INTERLOCK OVERRIDE
ND COMCUE,"/" ;CUE FOR COMMAND PROCESSING
ND CMTCUE,";" ;COMMENT CUE (IGNORE REST OF LINE)
ND PRVPRG,0 ;PRIVILEGED PROGRAMMER NUMBER
PDSIZE==200 ;SIZE OF PUSH DOWN STACK
PRGPFX=='FRM' ;STANDARD PROGRAM PREFIX CODE
TMPNAM==PRGPFX ;TMPCOR FILE NAME FOR DIALOGUE INFO
DPFEXT=='PRF' ;DEFAULT PROFILE FILE EXTENSION
DPFDEV=='DSK' ;DEFAULT PROFILE FILE DEVICE
LOGFST=='FORUM1' ;STARTING SEQUENTIAL LOG FILE NAME
LOGLST=='FORUM9' ;FINAL SEQUENTIAL LOG FILE NAME
LOGOVR=='FORUMX' ;SEQUENCE OVERRIDE LOG FILE NAME
LOGEXT=='LOG' ;LOG FILE EXTENSION
LOGDEV=='LOG' ;LOG FILE DEVICE
HLPNAM=='FORUM ' ;HELP FILE NAME
HLPEXT=='HLP' ;HELP FILE EXTENSION
HLPDEV=='HLP' ;HELP FILE DEVICE
FDCDEV=='DSK' ;FREE DISK CHANNEL DEVICE
;MACRO TO TERMINATE ASSEMBLY WITH ERROR MESSAGE
DEFINE ASMERR (TEXT)
<PRINTX
PRINTX ? TEXT -- REASSEMBLY NECESSARY
PRINTX
PASS2
LOC 137
EXIT
END 137>
;MACRO TO DEFINE CONSECUTIVE BIT MASKS FOR FLAGS IN ANY AC
DEFINE BIT (FLAG,AC)
<IF1, <IFDEF AC'..,<AC'..==AC'.._<-1>
IFE AC'..,<ASMERR <TOO MANY FLAGS DEFINED IN AC>>>
IFNDEF AC'..,<AC'..==1B0>
IFNB <FLAG>,<AC'.'FLAG==AC'..>>>
BIT XIT,F ;MUST BE LEFTMOST FLAG! -- PROGRAM EXIT REQUESTED
BIT CCL,F ;WE HAD CCL START
BIT PCC,F ;PROHIBIT CONTROL-C
BIT RCC,F ;REQUEST CONTROL-C
BIT MIP,F ;MODIFICATION IN PROGRESS
BIT LOG,F ;LOG FILE BEING RECORDED
BIT SRR,F ;SKIP RETURN REQUESTED FLAG
BIT NLR,F ;NEW LINE REQUESTED FLAG
BIT GTO,F ;GRACE TIME OVERFLOW FLAG
BIT ILS,F ;IGNORE LEADING SPACES (OR TABS)
BIT ALL,F ;DO COMMAND FOR EVERYONE IN FORUM
BIT FRC,F ;FORCE SENDING OF MESSAGES FLAG
;THE CHANNEL OPEN FLAGS ARE SET ONLY AFTER THE BUFFER RING IS SET UP
BIT LCO,F ;LOG FILE CHANNEL OPEN
BIT HCO,F ;HELP FILE CHANNEL OPEN
BIT PCO,F ;PTY CHANNEL OPEN
BIT FCO,F ;FREE DISK CHANNEL OPEN
BIT LKP,F ;LOOKUP CHANNEL OPEN -- NEVER
; DOES I/O SO SET WHENEVER "OPEN"
;MACRO TO CREATE RELATED SYMBOLS OF THE FORM XX$YYY
DEFINE SYM (CODE,GROUP)
<IF1, <IFDEF GROUP'$LEN,<GROUP'$LEN==GROUP'$LEN+1>
IFNDEF GROUP'$LEN,<GROUP'$LEN==1>
IFNB <CODE>,<GROUP'$'CODE==GROUP'$LEN-1>>>
SYM LNK,ID ;**ID BLOCK** LINKAGE WORD
SYM NN1,ID ;NICK-NAME OF USER (ASCII)
REPEAT NAMSIZ-1,<SYM ,ID>;LEAVE ENOUGH ROOM FOR WHOLE NAME
SYM JOB,ID ;JOB NUMBER (ZERO LEFT NEEDED AFTER NN)
SYM TTY,ID ;TTY NUMBER (ZERO ==> TTY0)
SYM PPN,ID ;USER'S PROJ-PROG NUMBER
SYM UN1,ID ;1ST WORD OF USER NAME (SIXBIT)
SYM UN2,ID ;2ND WORD OF USER NAME (SIXBIT)
SYM UPT,ID ;UPTIME IN JIFFIES AT ENTRY
SYM NDX,ID ;ENTRY INDEX NUMBER
SYM PFF,ID ;PROFILE FILE NAME, EXTENSION, PPN,
SYM PFE,ID ; AND DEVICE -- NOTE THAT THE ORDER
SYM PFP,ID ; OF THESE FOUR ITEMS MUST AGREE
SYM PFD,ID ; WITH THE PROFILE BLOCK SPEC BELOW
SYM MLP,ID ;POINTER TO MESSAGE POINTER LIST
SYM GRP,ID ;PRIVATE GROUP NAME (-1 FOR PRIV MODE)
SYM FIL,PF ;**PROFILE BLOCK** FILE (DEF IS NN)
SYM EXT,PF ;EXTENSION (DEFAULT IS ".PRF")
SYM PPN,PF ;PPN (DEFAULT IS LOGGED IN PPN)
SYM DEV,PF ;DEVICE (DEFAULT IS DISK)
SYM LNK,MP ;**MESSAGE BLOCK POINTER BLOCK** LINK
SYM MBA,MP ;LENGTH,,ADR OF MESSAGE BLOCK
SYM CNT,MB ;**MESSAGE BLOCK** RECEIVER COUNT
SYM SDR,MB ;MSG FLAGS,,SENDER'S ID BLOCK ADR
SYM UPT,MB ;UPTIME IN JIFFIES AT POSTMARK
SYM TXT,MB ;TEXT OF MESSAGE (ASCII)
;MESSAGE STATUS FLAGS (MAXIMUM OF 18, AND "NOR" MUST BE LEFTMOST BIT)
BIT NOR,MS ;DON'T ALLOW REPLAY FROM OLD MSG LIST
BIT FRC,MS ;FORCED MESSAGE SO ALWAYS READ IT
BIT NTY,MS ;THIS IS A FORUM ENTRY MESSAGE
BIT XIT,MS ;THIS IS A FORUM EXIT MESSAGE
BIT NAM,MS ;THIS IS A NAME CHANGE MESSAGE
BIT PRV,MS ;THIS IS A PRIVATE MESSAGE
;NOW CHECK OUT SOME PARAMETERS
IFL PDSIZE-50,<ASMERR <NOT ENOUGH STACK SPACE RESERVED>>
IFLE NAMSIZ,<ASMERR <UNREASONABLE NAME SIZE PARAMETER>>
IFL INQSIZ-5,<ASMERR <UNREASONABLE QUEUE SIZE PARAMETER>>
IFL WRKSIZ-ID$LEN,<ASMERR <WORK BUFFER NOT LARGE ENOUGH FOR ID BLOCK>>
IFL WRKSIZ-MB$LEN-<^D80/5>,
<ASMERR <WORK BUFFER NOT LARGE ENOUGH FOR MESSAGE BLOCK>>
IFL WRKSIZ-MB$LEN-INQSIZ-<2*NAMSIZ>-6,
<ASMERR <WORK BUFFER NOT LARGE ENOUGH FOR MESSAGE BLOCK>>
IFLE OMLMAX,<ASMERR <UNREASONABLE MAXIMUM LENGTH FOR OLD MESSAGE LIST>>
IFL OVRIDE-3,<ASMERR <UNWISE SELECTION OF OVERRIDE TIME PARAMETER>>
IF2, <IFLE ZLAST-ZFIRST-1,
<ASMERR <INVALID LENTGH OF STORAGE AREA TO BE INITIALIZED>>>
IFN FDCDEV-'DSK',<ASMERR <INVALID DEFINITION OF THE FREE DISK DEVICE>>
IFN F.XIT-1B0,<ASMERR <EXIT FLAG IN F MUST BE THE LEFTMOST BIT>>
IFN MS.NOR-1B0,<ASMERR <NO REPLAY MESSAGE FLAG MUST BE LEFTMOST BIT>>
IFN MB$TXT-MB$LEN+1,<ASMERR <TEXT MUST BE THE LAST ITEM IN MESSAGE BLOCK>>
IFE MS..&777777B17,<ASMERR <ONLY 18 MESSAGE STATUS FLAGS ALLOWED>>
IF2, <IFE CP..&777740B17,<ASMERR <ONLY 13 COMMAND PRIVILEGE FLAGS ALLOWED>>>
;AND DEFINE SOME SINGLE WORD OPERATORS
OPDEF QPERR [JUMPN Q,QPERRS] ;QPACK ERROR HANDLER
OPDEF FCERR [JUMPL A,FCERRS] ;FREE-CORE ERROR HANDLER
OPDEF PJRST [JRST] ;JUMP TO IMPLIED RETURN
OPDEF ONTTY [SETOM OUTLST] ;PUT TTY IN OUTPUT LIST
OPDEF OFFTTY [SETZM OUTLST] ;REMOVE TTY FROM OUTLST
OPDEF ONLOG [PUSHJ P,SETLON] ;PUT LOG IN OUTPUT LIST
OPDEF OFFLOG [PUSHJ P,SETLOF] ;REMOVE LOG FROM OUTLST
SUBTTL INITIALIZATION, MAIN PROGRAM LOOP, AND HISEG INTERLOCK
RELOC 400000 ;THIS IS ALL PURE CODE
START: TDZA F,F ;CLEAR FLAGS FOR NORMAL START
MOVX F,F.CCL ;OTHERWISE, SHOW HAD CCL START
RESET ;RESET I/O CHANNELS AND FF
MOVE P,[IOWD PDSIZE,STACK] ;SET UP OUR STACK POINTER
AOSE RUNDEV ;IF ALREADY SET UP RUN DEV,
SOSA .SGDEV,RUNDEV ; THEN REPAIR AND RELOAD AC
MOVEM .SGDEV,RUNDEV ; ELSE SAVE INFO FOR HELP
AOSE RUNPPN ;IF ALREADY SET UP RUN PPN,
SOSA .SGPPN,RUNPPN ; THEN REPAIR AND RELOAD AC
MOVEM .SGPPN,RUNPPN ; ELSE SAVE INFO FOR HELP
SETZB P1,P2 ;CLEAR ALTHOUGH NOT NEEDED
PUSHJ P,OWNINI ;DO OUR OWN INITIALIZATION
PUSHJ P,MODIFY ;WITH HISEG INTERLOCK EFFECTIVE,
PUSHJ P,FENTER ;ENTER FORUM W/ ID BLOCK IN WRKBUF
TXZ F,F.XIT ;NO EXIT FOR ^Z DURING DIALOGUE
PUSHJ P,GETNSC ;SEE IF ANYTHING LEFT IN QUEUE
JRST MAIN ;START IN MAIN LOOP IF EMPTY
CAIN C,COMCUE ;IF LOADED FROM SWITCH.INI,
PUSHJ P,DOCOM ; THEN GO PROCESS COMMAND
QRSET Q,INPUTQ ;EMPTY OUT THE INPUT QUEUE
QPERR ;PROTECT AGAINST QPACK ERROR
;MAIN PROGRAM LOOP
MAIN: SKIPE ID,SAVEID ;IF OUR ID BLOCK ADR IS GONE,
SKIPN (ID) ;OR OUR FORUM LINKAGE IS GONE,
JRST REMOVE ; THEN WE CANNOT CONTINUE
MOVEI T1,HBRTIM ;LOAD MAXIMUM TIME TO HIBERNATE
TXO T1,HB.RTL ;WITH WAKE ON LINE OF TTY INPUT
MOVEI T2,SLPTIM ;(AND JUST IN CASE HIBER FAILS)
HIBER T1, ;ZZZ UNTIL SOME ACTION
SLEEP T2, ;OR SLEEP IF HIBER FAILS
SKIPN (ID) ;THIS IS THE MOST LIKELY PLACE
JRST REMOVE ;TO CATCH A JOB WHICH BOMBED
PUSHJ P,WEED ;SCAN FORUM FOR DEAD JOBS
PUSHJ P,SEND ;SEND OUR MESSAGE IF THERE
PUSHJ P,READ ;AND READ THOSE RECEIVED
JUMPL F,DOEXIT ;DO EXIT ROUTINE IF REQUESTED
JRST MAIN ;OTHERWISE, LOOP BACK FOR WAIT
;HERE TO INTERLOCK HISEG MODIFICATION TO EXECUTE RETURN INSTRUCTION.
; *** NOTE *** THAT THE EXECUTED INSTRUCTION MUST NOT BE A TRANSFER
; INSTRUCTION UNLESS IT IS A SUBROUTINE CALL (SKIP RETURNS ARE OKAY).
;CALL WITH:
; PUSHJ P,MODIFY
; INTERLOCK INSTRUCTION
; RETURN HERE IF NORMAL INSTRUCTION
; RETURN HERE IF SUB CALL WITH SKIP RETURN
;
MODIFY: TXO F,F.PCC!F.MIP ;NO CONTROL-C AND MOD. IN PROG.
MOVEI T1,OVRIDE ;LOAD MAX TIMES TO RETRY
TDZA T2,T2 ;CLEAR FOR JIFFY SLEEP ON RETRIES
RETRY: SLEEP T2, ;FIRST HESITATE BEFORE RETRY
AOSE INTLCK ;SKIP IF WE GET INTERLOCK
SOJGE T1,RETRY ;ELSE TRY AGAIN UNTIL MAX
XCT @(P) ;EXECUTE RETURN INSTRUCTION
CAIA ;HERE WHEN DONE MODIFICATION
AOS (P) ;HERE IF SUB CALL W/ SKIP RETURN
AOS (P) ;RETURN AFTER XCT'ED INSTRUCTION
SETOM INTLCK ;GIVE UP HISEG INTERLOCK
TXZ F,F.MIP ;SHOW THAT WE GAVE IT UP
TXNE F,F.RCC ;IF CONTROL-C WAS TYPED,
JRST CCXIT ; DO THE CONTROL-C REPLY
TXZ F,F.PCC ;ELSE ALLOW CONTROL-C'S
POPJ P, ;AND RETURN TO CALLER
SUBTTL ROUTINE TO READ ALL THE MESSAGES
;IN THIS ROUTINE, X IS USED AS THE ADDRESS OF THE FIRST MESSAGE POINTER
READ: PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
HRRZ X,ID$MLP(ID) ;LOAD MESSAGE POINTER LINK
JUMPE X,CPOPJ0 ;RETURN WHEN NO MORE TO DO
HRRZ T1,MP$MBA(X) ;GET MESSAGE BLOCK ADDRESS
PUSH P,T1 ;SAVE FOR LATER DELETE CHECK
HLLZ T2,MB$SDR(T1) ;PICK UP MESSAGE STATUS BITS
HRRZ T3,MB$SDR(T1) ;PICK UP SENDER'S ID BLOCK ADR
TXNE T2,MS.XIT ;IF THIS ISN'T AN EXIT MSG,
CAME T3,IGNRID ;OR IT'S NOT FROM IGNORED ID,
CAIA ; THEN SKIP FOR IGNORE TEST
JRST READ1 ; ELSE CLEAR SPEC AND READ
TXNN T2,MS.FRC ;IF THIS IS A FORCED MESSAGE,
CAME T3,IGNRID ;OR WE'RE NOT IGNORING USER,
JRST READ2 ; THEN JUST DO NORMAL READ
JRST READ3 ; ELSE DELETE WITHOUT READ
READ1: SETZM IGNRID ;HERE TO TERMINATE IGNORING
READ2: SKPINC ;CLEAR CNTL-O IN CASE ON
JFCL ;(WE DON'T REALLY CARE)
TXZE F,F.NLR ;IF NOT AT BEGINNING OF LINE,
PUSHJ P,CLFOUT ; THEN GET ON A NEW LINE
TXNE F,F.LOG ;IF WE'RE RECORDING A LOG,
ONLOG ; ENTER MESSAGE IN LOG
MOVEI M,MB$TXT(T1) ;LOAD MESSAGE TEXT ADR
PUSHJ P,LINOUT ;TYPE OUT THE STUFF
TXNE F,F.LOG ;IF WE USED THE LOG FILE,
OFFLOG ; REMOVE LOG FROM OUTLST
PUSHJ P,BRKOUT ;FORCE OUT TTY BUFFER
READ3: MOVEI A,(X) ;LOAD ADR OF MESSAGE LINK
PUSHJ P,MODIFY ;WITH HISEG INTERLOCK IN
PUSHJ P,LL$REM ;REMOVE FROM OUR LIST
MOVEI A,(X) ;RELOAD INFO FOR FC$DEL OR EXPMSG
POP P,T1 ;RECOVER SAVED MSG BLOCK ADR
SOSG MB$CNT(T1) ;IF LAST TO RECEIVE MESSAGE,
JRST READ4 ; THEN GO EXPIRE MESSAGE
PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
PUSHJ P,FC$DEL ;DELETE MESSAGE PNTR FROM FC
FCERR ;AND CHECK FOR FC ERRORS
JRST READ ;LOOP TO READ MORE MESSAGES
READ4: PUSHJ P,MODIFY ;HERE TO EXPIRE OLD MESSAGE
PUSHJ P,EXPMSG ;WITH MSG PNTR ADDRESS IN A
JRST READ ;LOOP FOR MORE MESSAGES
SUBTTL ROUTINE TO SEND TYPED MESSAGES TO ALL IN FORUM
;IN THIS ROUTINE, X IS THE ID BLOCK SCANNER AND P1 IS THE MESSAGE POINTER
SEND: PUSHJ P,GETLNS ;CHECK TO SEE IF LINE AVAILABLE
CAIA ;SKIP IF NOT
JRST SEND1 ;ELSE GO PROCESS IT
TXNN F,F.GTO ;IF ALREADY OVERFLOWED GT,
SKPINC ;OR IF TTY BUFFER IS EMPTY,
POPJ P, ; THEN NO LINE TO PROCESS
MOVX A,HB.RTL!HB.RWJ ;SPECIFY DESIRED WAKE BITS
PUSHJ P,SETWAK ;LOCK OUT WAKES FROM OTHERS
MOVEI T1,GRCTIM ;WITH MAXIMUM GRACE TIME
TXO T1,HB.RTL!HB.RWJ ;OR LINE IS FINALLY READY
MOVEI T2,SLPTIM ;(WITH DEFAULT SLEEP TIME)
HIBER T1, ;WAIT FOR REST OF LINE
SLEEP T2, ;SLEEP IF HIBER FAILS
MOVX A,HB.RTL ;RELOAD NORMAL WAKE ENABLE
PUSHJ P,SETWAK ;RESET TO ALLOW OUTSIDE WAKES
TXO F,F.GTO!F.NLR ;ASSUME WE OVERFLOWED GRCTIM
PUSHJ P,GETLNS ;TRY NOW FOR LINE OF INPUT
POPJ P, ;RETURN IF STILL CAN'T GET IT
SEND1: TXZ F,F.GTO!F.NLR ;ELSE RESET FLAGS AND PROCEED
SETZ Q, ;USE A ZERO ARG FOR STATUS
QSTAT Q,INPUTQ ;TO FIND NUMBER OF BYTES USED
QPERR ;CHECK FOR ERRORS
JUMPE Q,CPOPJ0 ;JUST RETURN IF NOTHING IN QUEUE
SETZ Q, ;ELSE CLEAR THE QUEUE POINTER
QWHRE Q,INPUTQ ;TO LOCATE THE BOTTOM CHAR
QPERR ;WATCH FOR ERRORS
SEND2: QREAD Q,C ;LOAD A CHAR FROM QUEUE
QPERR ;HANDLE ERROR OR FALL THROUGH
JUMPE Q,SEND3 ;SEND SPACES IF DONE SCAN
CAIE C,40 ;IF THIS CHAR'S A SPACE,
CAIN C,.CHTAB ;OR THIS CHAR'S A TAB,
JRST SEND2 ; THEN LOOP BACK FOR NEXT
CAIE C,COMCUE ;IF IT'S NOT THE COMMAND CUE,
JRST SEND3 ;THEN GO SEND LINE TO FORUM
PUSHJ P,GETNSC ;OTHERWISE, EMPTY BEFORE CUE
POPJ P, ;(NEVER SHOULD DO THIS)
PJRST DOCOM ;AND GO PROCESS COMMAND(S)
;HERE WHEN HAVE LINE OF TEXT TO SEND TO EVERYONE IN FORUM
SEND3: PUSHJ P,MSGHDR ;SET UP MESSAGE BLOCK HEADER
PUSH P,P1 ;SAVE PRECIOUS ACCUMULATOR
MOVE P1,[POINT 7,WRKBUF+MB$TXT];LOAD INITIAL TEXT POINTER
PUSHJ P,PUTOAB ;PUT AN OPEN ANGLE BRACKET
MOVEI A,ID$NN1(ID) ;LOAD ADDRESS TO OUR NAME
PUSHJ P,PUTNAM ;PUT NICK-NAME INTO MESSAGE
PUSHJ P,PUTCAB ;PUT A CLOSE ANGLE BRACKET
PUSHJ P,PUTCLN ;DO A COLON TO SET OFF NAME
PUSHJ P,PUTSPC ;THEN A SPACE SO LOOKS NEAT
MOVSI Q,INPUTQ ;SET UP INPUT QUEUE POINTER
SEND4: QPULL Q,C ;LOAD A CHAR FROM QUEUE
JRST SEND5 ;OUT WHEN QUEUE EMPTY
PUSHJ P,PUTCHR ;DEPOSIT CHAR IN BUFFER
JRST SEND4 ;LOOP BACK FOR MORE
SEND5: QPERR ;MAKE SURE NO REAL ERROR
PUSHJ P,PUTNUL ;NOW APPEND A NULL TO STRING
SUBI P1,WRKBUF ;FIND WORDS USED AFTER FIRST
MOVSI A,1(P1) ;LOAD BUFFER LENGTH IN LEFT
HRRI A,WRKBUF ;LOAD BUFFER ADDRESS IN RIGHT
TXNN F,F.LOG ;UNLESS WE'RE MAKING A LOG,
JRST SEND6 ; GO START THE SEND PROCESS
OFFTTY ;OTHERWISE, SUPPRESS TTY OUTPUT
ONLOG ;AND START WRITING IN THE LOG
MOVEI M,WRKBUF+MB$TXT ;LOAD THE ADDRESS OF MESSAGE TEXT
PUSHJ P,LINOUT ;AND PUT THE STUFF IN THE LOG
OFFLOG ;REMOVE LOG FROM OUPUT LIST
ONTTY ;RESTORE OUTPUT TO TERMINAL
SEND6: PUSHJ P,MODIFY ;WITH HISEG INTERLOCK IN PROGRESS
PUSHJ P,FC$SHR ;LOAD DATA INTO FREE-CORE STORAGE
FCERR ;CHECK FOR FREE-CORE ERRORS
SETZM WRKBUF+MP$LNK ;CLEAR LINK WORD IN WORK BUFFER
MOVEM A,WRKBUF+MP$MBA ;LOAD STORAGE ADDRESS AND LENGTH
MOVE P1,A ;SAVE ADDRESS IN INDEX REGISTER
PUSHJ P,MODIFY ;WITH CONTINUOUS HISEG INTERLOCK
PUSHJ P,SENALL ;DO ROUTINE TO SEND MSG TO ALL
POP P,P1 ;RESTORE ACCUMULATOR UNDER OATH
POPJ P, ;RETURN TO MAIN PROGRAM
;SUBROUTINE TO A SEND MESSAGE TO EVERYONE IN THE FORUM. MESSAGE MUST
; ALREADY BE IN FREE-CORE STORAGE WITH THE CORRESPONDING MESSAGE
; POINTER IN THE FIRST TWO WORDS OF THE WORK BUFFER. THE MESSAGE
; BLOCK ADDRESS MUST ALSO BE IN P1. THIS ROUTINE MUST BE CALLED
; UNDER THE HISEG MODIFICATION INTERLOCK.
;CALL WITH:
; <COMPLETED MESSAGE BLOCK IN HISEG FREE-CORE>
; MOVE P1,<STORAGE ADDRESS>
; SETZM WRKBUF+MP$LNK
; MOVEM P1,WRKBUF+MP$MBA
; PUSHJ P,MODIFY
; PUSHJ P,SENALL
;
SENALL: MOVEI X,FORUM ;START WITH FIRST FORUM LINK
SENAL1: HRRZ X,(X) ;PERUSE THROUGH THE FORUM LIST
SKIPN X ;IF WE FIND END OF THE LIST,
JRST SENAL2 ; THEN WE'RE DONE WITH SEND
CAIN X,(ID) ;IF WE'VE REACHED OURSELF,
JRST SENAL1 ; THEN IGNORE AND GET NEXT
PUSHJ P,SENMSG ;DO BELOW ROUTINE TO SEND MSG
JFCL ;DON'T CARE IF MESSAGE REFUSED
JRST SENAL1 ;LOOP FOR NEXT GUY
SENAL2: SOSLE MB$CNT(P1) ;NOW REPAIR RECEIVER COUNT
POPJ P, ;AND RETURN TO CALLING ROUTINE
MOVE A,[XWD MP$LEN,WRKBUF] ;THEORETICALLY, THIS SHOULD ONLY
PUSHJ P,FC$SHR ; HAPPEN IF NO ONE ELSE IS IN THE
FCERR ; FORUM, BUT IT WORKS EITHER WAY
PJRST EXPMSG ;EXPIRE MESSAGE AND RETURN TO CALLER
;NOTE THAT INTERLOCK IS STILL IN PROGRESS (HOPEFULLY)
;SUBROUTINE TO SEND SINGLE MESSAGE CHECKING SUB-FORUM GROUPS AND PRIV'S
SENMSG: MOVE T1,ID$GRP(X) ;LOAD THEIR SIXBIT GROUP
MOVE T2,ID$GRP(ID) ;LOAD OUR SIXBIT GROUP
CAME T1,T2 ;IF THEIRS MATCHES OURS,
TXNE F,F.FRC ;OR MSG IS TO BE FORCED,
JRST SENMS1 ; THEN GO DO THE SEND
AOJE T1,SENMS1 ;SEND IF THEY'RE IN PRIV MODE
AOJE T2,SENMS1 ;SEND IF WE'RE IN PRIV MODE
POPJ P, ;OTHERWISE, GIVE ERROR RETURN
SENMS1: MOVE A,[XWD MP$LEN,WRKBUF] ;PUT TWO-WORD POINTER BLOCK
PUSHJ P,FC$SHR ;INTO FREE-CORE STORAGE
FCERR ;CHECK FOR FREE-CORE ERROR
AOS MB$CNT(P1) ;BUMP THE RECEIVER COUNT
MOVSI A,(A) ;GET STORAGE ADR INTO LEFT
HRRI A,ID$MLP(X) ;LOAD THEIR MESSAGE LIST PNTR
PUSHJ P,LL$APR ;APPEND TO RIGHT END OF LIST
MOVE T1,ID$JOB(X) ;LOAD THEIR JOB NUMBER
WAKE T1, ;AND GET THEM OUTA BED
JFCL ;(NICE TRY ANYWAY)
JRST CPOPJ1 ;DO SKIP RETURN
;SUBROUTINE TO EXPIRE A MESSAGE. THE MESSAGE IS ACTUALLY APPENDED TO THE
; OLD MESSAGE LIST, UNLESS THE SENDER ADR WORD HAS BIT 0 SET, IN
; WHICH CASE THE PRIVATE MESSAGE IS JUST DELETED. IF AN ADDITION
; TO THE OLD MESSAGE LIST CAUSES IT TO EXCEED ITS MAXIMUM ALLOWABLE
; LENGTH "OMLMAX", THE OLDEST ONE IN THE LIST IS REMOVED AND DELETED.
; THIS ROUTINE MUST BE CALLED UNDER THE HISEG MODIFICATION INTERLOCK!
;CALL WITH:
; MOVE A,<ADDRESS OF MESSAGE POINTER LINK>
; PUSHJ P,MODIFY
; PUSHJ P,EXPMSG
;
EXPMSG: HRRZ T1,MP$MBA(A) ;FIND ADDRESS OF MESSAGE BLOCK
SKIPGE MB$SDR(T1) ;IF THE NO REPLAY FLAG IS SET,
JRST EXPMS1 ; THEN DON'T PUT IN OLD MSG LIST
MOVSI A,(A) ;PUT MESSAGE PNTR ADR IN LEFT
HRRI A,OLDMLP ;LOAD ADR OF OLD MSG LIST PNTR
PUSHJ P,LL$APR ;APPEND THIS MESSAGE POINTER
SOSL OLDMLC ;DECREMENT THE FREE COUNT
POPJ P, ;RETURN TO CALLER IF OKAY
AOS OLDMLC ;CORRECT SPACE FREE COUNT
HRRZ A,OLDMLP ;LOAD 1ST PNTR ADR IF TOO MANY
PUSH P,MP$MBA(A) ;SAVE ADDRESS OF MESSAGE BLOCK
PUSH P,A ;SAVE ADDRESS OF MESSAGE POINTER
PUSHJ P,LL$REM ;REMOVE MESSAGE POINTER FROM OML
POP P,A ;RECOVER ADDRESS OF MSG PNTR
CAIA ;CONTINUE WITH REMOVE FROM FC
EXPMS1: PUSH P,MP$MBA(A) ;HERE ON PRIVATE MESSAGE DEL'S
PUSHJ P,FC$DEL ;DELETE IT FROM FREE-CORE
FCERR ;CHECK FOR ERRORS
POP P,A ;RECOVER ADR OF MESSAGE BLOCK
PUSHJ P,FC$DEL ;DELETE MESSAGE FROM FREE-CORE
FCERR ;AGAIN CHECK FOR ERRORS
POPJ P, ;RETURN TO CALLER
;SUBROUTINE TO PROPERLY ALTER THE HIBER WAKE CONDITIONS. THE PROBLEM
; ARISES WHEN ANOTHER JOB ISSUES A SUCCESSFUL WAKE BEFORE A NEW
; HIBER IS EXECUTED WHICH ATTEMPTS TO LOCK OUT WAKES FROM OTHER
; JOBS. THE CORRECT PROCEDURE IS TO ISSUE A DUMMY HIBER TO SET
; UP THE CONDITIONS FIRST.
;CALL WITH:
; MOVX A,<DESIRED WAKE ENABLE BITS>
; PUSHJ P,SETWAK
; RETURN IS ALWAYS HERE
;
SETWAK: HLLZ T1,A ;LOAD HIBER WAKE ENABLE BITS
SKIPE ID ;IF ALREADY HAVE ID BLOCK,
SKIPA T2,ID$JOB(ID) ; THEN LOAD OUR JOB NUMBER
PJOB T2, ; ELSE GET IT FROM MONITOR
WAKE T2, ;ISSUE A WAKE FOR OURSELVES
AOJ T1, ;USE 1 MSEC HIBER IF FAILED
HIBER T1, ;HIBER TO CHANGE CONDITIONS
JFCL ;DON'T WORRY IF WE COULDN'T
POPJ P, ;RETURN TO DO REAL HIBER
;SUBROUTINE TO SET UP THE MESSAGE BLOCK HEADER IN THE WORK BUFFER. NO
; ARGUMENTS ARE NEEDED AND NO SPECIAL CONDITIONS ARE NECESSARY.
;CALL WITH:
; PUSHJ P,MSGHDR
; RETURN IS ALWAYS HERE
;
MSGHDR: PUSHJ P,ZERWBF ;CLEAR OUT THE WORK BUFFER
AOS WRKBUF+MB$CNT ;START WITH INITIAL COUNT
MOVEI T1,(ID) ;LOAD OUR ID BLOCK ADDRESS
SKIPE T2,ID$GRP(ID) ;IF NOT IN SPECIAL GROUP,
CAMN T2,[EXP -1] ;OR WE'RE UNDER PRIV MODE,
CAIA ; THEN SKIP TO USE OML
TXO T1,MS.NOR ; ELSE SUPPRESS REPLAYS
TXNN F,F.FRC ;IF THE FORCE FLAG IS SET,
AOSN T2 ;OR WE'RE IN PRIV MODE,
TXO T1,MS.FRC ; THEN SET FORCED MARKER
MOVEM T1,WRKBUF+MB$SDR ;STORE THE STATUS/SENDER WORD
MOVE T1,[EXP %NSUPT] ;FROM CONFIGURATION GETTAB
GETTAB T1, ;GET UPTIME IN JIFFIES WORD
SETZ T1, ;NO SWEAT IF FAILED
MOVEM T1,WRKBUF+MB$UPT ;STORE IN MESSAGE BLOCK BUFFER
POPJ P, ;RETURN TO STORE TEXT AND SEND
;SUBROUTINE TO ZERO OUT THE WHOLE WORK BUFFER.
;CALL WITH:
; PUSHJ P,ZERWBF
; RETURN IS ALWAYS HERE
;
ZERWBF: SETZM WRKBUF ;CLEAR OUT FIRST WORD
MOVE T1,[XWD WRKBUF,WRKBUF+1];PROPAGATE ZERO WORDS
BLT T1,WRKBUF+WRKSIZ-1 ;TO ZERO WHOLE BUFFER
POPJ P, ;AND RETURN
SUBTTL ROUTINE TO WEED OUT ANY INVALID JOBS IN THE FORUM
;IN THIS ROUTINE, X IS THE ID BLOCK SCANNER AND P1 HOLDS OUR HISEG INDEX
WEED: HRLZ T1,ID$JOB(ID) ;LOAD OUR JOB NUMBER INDEX
HRRI T1,.GTSGN ;LOAD SEGMENT TABLE NUMBER
GETTAB T1, ;CHECK GETTAB FOR SEGMENT #
POPJ P, ;FORGET IT IF PROBLEMS
JUMPLE T1,CPOPJ0 ;SAME IF SPYING/NO TABLE
PUSH P,P1 ;OTHERWISE, SAVE PRES. AC
MOVEI P1,(T1) ;PUT OUR HISEG INDEX IN P1
PUSHJ P,MODIFY ;REQUEST MODIFICATION INTERLOCK
PUSHJ P,DOWEED ;DO BELOW ROUTINE TO FIND WEEDS
JRST REMOVE ;ERROR IF COULDN'T FIND SELF
POP P,P1 ;OTHERWISE, RESTORE ACCUM
POPJ P, ;AND RETURN TO MAIN PROG
;THIS SECTION IS UNDER THE HISEG INTERLOCK
DOWEED: TXZ F,F.SRR ;SET NON-SKIP FOR NO SELF
MOVEI X,FORUM ;LOAD STARTING PLACE IN LIST
DOWEE1: HRRZ X,(X) ;PROCEED THROUGH NEXT LINK
SKIPN X ;IF REACHED END OF FORUM,
JRST DOWEE4 ; THEN FIGURE OUT RETURN
CAIE X,(ID) ;IF THIS ISN'T OUR ID BLOCK,
JRST DOWEE2 ; THEN GO CHECK OUT JOB
TXO F,F.SRR ;OTHERWISE, SHOW WE FOUND US
JRST DOWEE1 ;AND CONTINUE THE FORUM SCAN
DOWEE2: MOVN T1,ID$JOB(X) ;LOAD NEGATIVE JOB NUMBER
JOBSTS T1, ;FIND OUT THIS JOB'S STATUS
JRST DOWEE3 ;DO KILL IF NO JOB NUMBER
TXNE T1,JB.UML ;IF IT'S AT MONITOR LEVEL,
JRST DOWEE3 ; THEN REMOVE IT FROM FORUM
HRLZ T1,ID$JOB(X) ;LOAD JOB NUMBER INTO LEFT
HRRI T1,.GTSGN ;LOAD SEGMENT TABLE NUMBER
GETTAB T1, ;LOOK UP THIS JOB'S INDEX
JRST DOWEE3 ;MUST BE ILLEGAL JOB SPEC
JUMPLE DOWEE3 ;TOO BAD IF SPYING OR DEAD
CAIN P1,(T1) ;IF INDEX IS SAME AS OURS,
JRST DOWEE1 ; THEN THIS GUY IS LEGIT
DOWEE3: MOVEI A,(X) ;ELSE LOAD ID BLOCK ADDRESS
PUSHJ P,LL$REM ;TO REMOVE IT FROM THE FORUM
JRST DOWEED ;RESTART SCAN FROM THE TOP
DOWEE4: TXZE F,F.SRR ;IF WE FOUND OURSELVES,
AOS (P) ; THEN DO SKIP RETURN
POPJ P, ;RETURN TO WEED ROUTINE
SUBTTL SPECAL COMMAND PROCESSOR AND DISPATCHER
DOCOM: PUSHJ P,GETLOD+1 ;GET FIRST LETTER OR DIGIT
JRST NOCOM ;ILLEGAL OR END OF LINE
PUSHJ P,GETSIX ;PROCESS THE SIXBIT COMMAND
JUMPE T1,NOCOM ;DO ERROR IF NO COMMAND GIVEN
SETOB T2,N ;INIT MASK AND AMBIG MARKER
MOVE T3,T1 ;MAKE A COPY OF COMMAND IN T3
DOCOM1: LSH T2,-6 ;SHIFT MASK OF UNSPECIFIED CHARS
LSH T3,6 ;SHIFT OUT LEFT CHAR IN COMMAND
JUMPN T3,DOCOM1 ;REPEAT UNTIL NO MORE SPECIFIED
MOVSI X,-COMLEN ;LOAD NEG. COMMAND TABLE LENGTH
TSTCOM: MOVE T3,COMNAM(X) ;LOAD A COMMAND NAME FROM TABLE
XOR T3,T1 ;FIND THE BITS THAT DON'T MATCH
JUMPE T3,GOTCOM ;WE'VE GOT IT IF PERFECT MATCH
TDZ T3,T2 ;OTHERWISE, MASK UNSPECIFIED CHARS
JUMPN T3,NXTCOM ;TRY NEXT IF NO PARTIAL MATCH
JUMPGE N,AMBCOM ;AMBIGUOUS IF ALREADY HAD ONE
MOVEI N,(X) ;ELSE SAVE INDEX AND TRY NEXT
NXTCOM: AOBJN X,TSTCOM ;TEST NEXT COMMAND IF STILL MORE
SKIPL X,N ;ELSE IF HAD A PARTIAL MATCH,
JRST GOTCOM ; THEN GO DO ABBREVIATION
SKIPA M,[[ASCIZ/<Unrecognizable command "/]]
AMBCOM: MOVEI M,[ASCIZ/<Ambiguous command "/]
PUSHJ P,STROUT ;SEND OUT THE MESSAGE TEXT
MOVEM T1,SIX ;LOAD IT INTO SIXBIT PRINTER
PUSHJ P,SXSOUT ;TYPE IT WITHOUT TRAILING SPACES
PJRST ILLCH1 ;FINISH ERROR SAME AS ILLCHR
NOCOM: CAIN C,COMCUE ;IF LAST CHAR WAS A SLASH,
JRST NOCOM1 ; THEN THE COMMAND IS BLANK
CAIE C,CMTCUE ;IF LAST CHAR WAS A SEMI-COLON,
JUMPN C,ILLCHR ;OR IF END-OF-LINE WAS REACHED,
NOCOM1: CLRBFI ;CLEAR THE TTY INPUT BUFFER
QRSET Q,INPUTQ ;WIPE OUT THE INPUT QUEUE
QPERR ;CHECK FOR QPACK ERRORS
MOVEI M,[ASCIZ/<Unspecified command>_*/]
PJRST ACTOUT ;TYPE OUT LINE AND RETURN
ILLCHR: PUSH P,C ;SAVE ILLEGAL CHARACTER
MOVEI M,[ASCIZ/<Illegal or unexpected character "/]
ILLCH0: PUSHJ P,STROUT ;TYPE OUT ERROR MESSAGE
POP P,C ;RESTORE CHAR FROM STACK
PUSHJ P,CHROUT ;TYPE OFFENDING CHARACTER
ILLCH1: CLRBFI ;CLEAR THE INPUT BUFFER
QRSET Q,INPUTQ ;CLEAR THE INPUT QUEUE
QPERR ;WATCH FOR ERRORS
MOVEI M,[ASCIZ/">_*/] ;LOAD DOUBLE QUOTE AND CLOSE
PJRST ACTOUT ;TYPE MESSAGE AND RETURN
;SPECIAL BITS ASSOCIATED WITH EACH COMMAND (USE ONLY LEFT 13 BITS!)
BIT IDR,CP ;ID REQUIRED PRIVILEGE BIT
BIT NAM,CP ;NAME ARGUMENT EXPECTED BIT
;HERE WHEN FOUND A UNIQUE COMMAND, WITH INDEX IN "X"
GOTCOM: MOVE T1,COMPRV(X) ;LOAD COMMAND PRIVILEGE BITS
JUMPN ID,GOTCO1 ;PASS ID TEST IF ALREADY IN
TXNE T1,CP.IDR ;ELSE IF COMMAND REQUIRES ID,
JRST NOGO ; THEN DON'T ALLOW COMMAND
JRST GOTCO2 ;NO NAME CAUSE OURS IS IN NAMBUF
GOTCO1: TXNE T1,CP.NAM ;IF COMMAND NEEDS A NAME ARG,
PUSHJ P,GETNAM ; GO PARSE THE NAME IN QUEUE
GOTCO2: MOVEM C,SAVCHR ;SAVE TRAILING CHARACTER
TXNE F,F.LOG ;IF WE'VE GOT THE LOG OPEN,
ONLOG ; ENTER SPEC IN OUTPUT LIST
PUSHJ P,@COMDSP(X) ;DISPATCH TO DO THE COMMAND
TXNE F,F.LOG ;IF WE TURNED ON THE LOG,
OFFLOG ; TURN IF BACK OFF
PUSHJ P,BRKOUT ;EMPTY OUT TTY OUTPUT BUFFER
MOVE C,SAVCHR ;RESTORE SAVED CHARACTER
CAIN C,COMCUE ;IF THE FINAL CHAR WAS CUE,
JRST DOCOM ; DO ANOTHER COMMAND
JUMPE C,CPOPJ0 ;RETURN IF END-OF-LINE REACHED
PUSH P,C ;SAVE THE OFFENDING CHARACTER
MOVEI M,[ASCIZ/<Unexpected and ignored character "/]
CAIE C,CMTCUE ;AS LONG AS NOT A SEMI-COLON,
PJRST ILLCH0 ; FINISH MESSAGE AND RETURN
POP P,(P) ;OTHERWISE, FORGET ABOUT IT
QRSET Q,INPUTQ ;BUT RESET THE INPUT QUEUE
QPERR ;CHECK FOR ERRORS
POPJ P, ;AND RETURN
;HERE ON UNIMPLEMENTED COMMANDS
NOTYET: TXNE F,F.LOG ;IF WE HAD THE LOG OPEN,
OFFLOG ; AVOID ERRORS TO FILE
POP P,(P) ;UNLOAD ONE CALLING LEVEL
MOVEI M,[ASCIZ/ command not yet implemented>_*/]
CAIA ;SKIP NOGO ENTRY AND CONTINUE
;HERE WHEN COMMAND NOT ALLOWED BECAUSE NO ID
NOGO: MOVEI M,[ASCIZ/ command not allowed until you're in the FORUM>_*/]
MOVEI C,"<" ;LOAD AN OPEN ANGLE BRACKET
PUSHJ P,CHROUT ;SEND OUT THE CHARACTER
MOVE T1,COMNAM(X) ;LOAD FULL NAME OF COMMAND
MOVEM T1,SIX ;INTO SIXBIT PRINTER BUFFER
PUSHJ P,SXSOUT ;TYPE WITHOUT TRAILING SPACES
CLRBFI ;WIPE OUT THE TTY INPUT BUFFER
QRSET Q,INPUTQ ;RESET THE TTY INPUT QUEUE
QPERR ;CHECK FOR POSSIBLE ERRORS
PJRST ACTOUT ;DO THE MESSAGE AND RETURN
DEFINE COMMAC
<ITEM H,HLPCOM,0
ITEM HELP,HLPCOM,0
ITEM EX,XITCOM,0
ITEM EXIT,XITCOM,0
ITEM WHO,WHOCOM,CP.NAM
ITEM REPLAY,REPCOM,CP.IDR
ITEM REMOVE,REMCOM,CP.IDR!CP.NAM
ITEM MYNAME,MYNCOM,CP.IDR!CP.NAM
ITEM TELL,TELCOM,CP.IDR!CP.NAM
ITEM SEND,SENCOM,0
ITEM SYSTAT,SYSCOM,0
ITEM MYFILE,MYFCOM,0
ITEM ACCESS,ACCCOM,0
ITEM NOACCE,NACCOM,0
ITEM PROFIL,PRFCOM,CP.IDR!CP.NAM
ITEM LOG,LOGCOM,0
ITEM NOLOG,NLOCOM,0
ITEM LC,LCTCOM,0
ITEM LOWERC,LCTCOM,0
ITEM UC,UCTCOM,0
ITEM UPPERC,UCTCOM,0
ITEM TIME,TIMCOM,0
ITEM ENTMAX,EMXCOM,0
ITEM AUTHOR,AUTCOM,0
ITEM WHAT,WHTCOM,0
ITEM HOW,HOWCOM,0
ITEM WHY,WHYCOM,0
ITEM HELLO,HELCOM,0
ITEM HI,HELCOM,0
ITEM LIST,LSTCOM,0
ITEM EXPOSE,EXPCOM,CP.IDR!CP.NAM
ITEM USER,USRCOM,CP.IDR!CP.NAM
ITEM WHEN,WHNCOM,CP.IDR!CP.NAM
ITEM WHERE,TTYCOM,CP.IDR!CP.NAM
ITEM LOCATE,TTYCOM,CP.IDR!CP.NAM
ITEM TTY,TTYCOM,CP.IDR!CP.NAM
ITEM PPN,PPNCOM,CP.IDR!CP.NAM
ITEM JOB,JOBCOM,CP.IDR!CP.NAM
ITEM ENTRY,NTYCOM,CP.IDR!CP.NAM
ITEM BEEP,BEPCOM,CP.IDR!CP.NAM
ITEM GROUP,GRPCOM,CP.IDR
ITEM NOGROU,NGRCOM,CP.IDR
ITEM FORCE,FORCOM,CP.IDR
ITEM NOFORC,NFRCOM,CP.IDR
ITEM IGNORE,IGNCOM,CP.IDR!CP.NAM>
PAGE
DEFINE ITEM (A,B,C) <SIXBIT/A/>
COMNAM: COMMAC ;GENERATE TABLE OF COMMAND NAMES
COMLEN==.-COMNAM ;CALCULATE LENGTH OF COMMAND TABLE
PAGE
DEFINE ITEM (A,B,C) <EXP B>
COMDSP: COMMAC ;GENERATE COMMAND DISPATCH TABLE
PAGE
DEFINE ITEM (A,B,C) <EXP C>
COMPRV: COMMAC ;PRIVILEGE TABLE USES LEFT 13 BITS
;THIS WAS PART OF THE DISPATCH TABLE, BUT MACRO GOOFED UP THE POLISH
; FIXUPS WHEN RELOCATABLE B WAS !'ED WITH C
SUBTTL SPECIAL COMMAND ROUTINES --- HELP
;HERE TO TYPE HELP TEXT FROM HLP:FORUM.HLP
HLPCOM: MOVE T1,[EXP HLPNAM] ;LOAD NAME OF HELP FILE
MOVEM T1,FIL ;INTO FILE SPEC PRINTER
MOVSI T1,HLPEXT ;LOAD FILE'S EXTENSION
MOVEM T1,EXT ;INTO FILE SPEC PRINTER
TXNE F,F.HCO ;IF HELP CHANNEL OPEN,
JRST DOHLP ; JUST GO LOOKUP INFO
SETZM PPN ;USE NULL PPN IN LOOKUP
SETZM SAVHFP ;CLEAR SAVED PPN OF FILE
MOVSI T1,HLPDEV ;LOAD DEVICE OF HELP FILE
MOVEM T1,DEV ;STORE FOR OPEN AND PRINT
PUSHJ P,OPNHLP ;OPEN HLP: AND LOOKUP FILE
CAIA ;SKIP IF UUO FAILURE
JRST DOHLP ;GO DO STUFF IF ALL SET
IFN HLPDEV-'HLP',<
MOVSI T1,'HLP' ;NORMAL PLACE FOR HELP FILES
MOVEM T1,DEV ;PUT DEVICE NAME INTO PRINTER
PUSHJ P,OPNHLP ;OPEN HLP: AND LOOKUP FILE
CAIA ;SKIP IF EITHER FAILED
JRST DOHLP ;OTHERWISE, GO DO STUFF
>;END OF IFN HLPDEV-'HLP' CONDITIONAL
IFN HLPDEV-'SYS',<
MOVSI T1,'SYS' ;SOMETIMES THEY'RE KEPT HERE
MOVEM T1,DEV ;LOAD DEVICE NAME INTO PLACE
PUSHJ P,OPNHLP ;OPEN SYS: AND LOOKUP FILE
CAIA ;SKIP IF UUO FAILURE
JRST DOHLP ;GO DO HELP IF ALL SET
>;END OF IFN HLPDEV-'SYS' CONDITIONAL
MOVE T1,RUNDEV ;ELSE, AS A LAST RESORT,
MOVEM T1,DEV ;TRY THE DEVICE AND PPN
MOVE T1,RUNPPN ;FROM WHICH THE FORUM
MOVEM T1,PPN ;PROGRAM WAS RUN
MOVEM T1,SAVHFP ;ALSO STORE FOR REPEATS
PUSHJ P,OPNHLP ;OPEN CHANNEL TO RUN DEVICE
CAIA ;SKIP IF UUO FAILURE
JRST DOHLP ;DO HELP IF FINALLY GOT IT
SETZM PPN ;OTHERWISE, CLEAR PPN SPEC
MOVSI T1,HLPDEV ;LOAD ORIGINAL HELP DEVICE
HLPERR: MOVEM T1,DEV ;PUT IT INTO DEVICE PRINTER
TXNE F,F.LOG ;IF RECORDING IN LOG FILE,
OFFLOG ; WIPE LOG FROM OUTLST
MOVEI M,[ASCIZ/<Unable to locate the help file ^>_/]
PJRST ACTOUT ;TYPE ERROR MESSAGE AND RETURN
;SUBROUTINES TO OPEN HELP CHANNEL AND LOOKUP HELP FILE
OPNHLP: MOVEI T1,.IOASC ;IN ASCII MODE,
MOVE T2,DEV ;TO GIVEN DEVICE,
MOVEI T3,HLPBRH ;WITH INPUT BUFFER,
OPEN HLP,T1 ;OPEN HELP FILE CHANNEL
POPJ P, ;ERROR RETURN IT CAN'T
LKPHLP: MOVE T1,FIL ;LOAD HELP FILE NAME
MOVE T2,EXT ;LOAD HELP FILE EXTENSION
SETZ T3, ;CLEAR DATE AND PROT
MOVE T4,PPN ;LOAD (OR ZERO) PPN SPEC
LOOKUP HLP,T1 ;DO THE LOOKUP ON FILE
CAIA ;SKIP IF CAN'T FIND FILE
JRST CPOPJ1 ;DO SKIP RETURN IF GOT IT
RELEAS HLP, ;OTHERWISE, FREE CHANNEL
POPJ P, ;AND DO NON-SKIP RETURN
;HERE AFTER THE VALIDATED HELP CHANNEL IS OPEN
DOHLP: TXON F,F.HCO ;SHOW HELP CHANNEL OPEN
JRST DOHLP1 ;JUMP AHEAD IF FIRST TIME
MOVE T1,SAVHFP ;LOAD SAVED PPN OF FILE
MOVEM T1,PPN ;PUT IN PLACE FOR LOOKUP
MOVEI T1,HLP ;LOAD HELP CHANNEL NUMBER
DEVNAM T1, ;FIND DEVICE NAME OF CHANNEL
SETZ T1, ;(ONLY NEEDED FOR OUTPUT)
PUSHJ P,LKPHLP ;DO ANOTHER LOOKUP OF FILE
PJRST HLPERR ;(UNLIKELY ERROR THIS TIME)
CAIA ;SKIP BUFFER RING SETUP
DOHLP1: INBUF HLP, ;SET UP RING FIRST TIME IN
MOVEI M,[ASCIZ/<Contents of ^>_/]
PUSHJ P,ACTOUT ;NOTIFY USER OF HELP FILE
DOHLP2: IN HLP, ;GET A BUFFER FULL OF HELP
CAIA ;SKIP IF CAN DO IT
JRST DOHLP4 ;OTHERWISE, MUST BE EOF
DOHLP3: SOSGE HLPBRH+2 ;DECREMENT BYTES LEFT
JRST DOHLP2 ;GET ANOTHER BUFFER
ILDB C,HLPBRH+1 ;OR LOAD A CHAR OF TEXT
JUMPE C,DOHLP3 ;DON'T LET NULLS BREAK OUTPUT
PUSHJ P,CHROUT ;SEND CHAR TO OUTPUT
JRST DOHLP3 ;KEEP LOOPING UNTIL EOB
DOHLP4: CLOSE HLP, ;CLOSE HELP FILE
SETZM DEV ;DON'T BOTHER TYPING DEVICE
SETZM PPN ;OR PPN SINCE USER KNOWS ALREADY
MOVEI M,[ASCIZ/<End of ^>_/] ;SHOW WE REACHED END OF FILE
PJRST ACTOUT ;FINISH MESSAGE AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- EXIT, WHO
;HERE TO DO AN EXIT FROM AN EXIT COMMAND
XITCOM: TXNE F,F.LOG ;IF THE LOG FILE IS ON,
OFFLOG ; SUPPRESS EXIT MESSAGES
JRST DOEXIT ;DO THE EXIT PROCEDURE
;HERE TO TYPE THE NAMES OF EVERYONE ELSE IN THE FORUM
WHOCOM: SKIPE NAMBUF ;IF NAME GIVEN AS ARGUMENT,
PJRST EXPCOM ; DO EXPOSE COMMAND INSTEAD
PUSHJ P,MODIFY ;WHILE UNDER CONSTANT INTERLOCK,
PUSHJ P,DOWHO ; TYPE OUT ALL THE NAMES
PJRST FINLIN ; FINISH LINE IF HAD SOME
MOVEI M,[ASCIZ/<No one else is in the FORUM>/];ELSE SPECIAL
PJRST LINOUT ;FINISH OFF THE LINE AND RETURN
;THIS SUBROUTINE IS UNDER THE HISEG INTERLOCK
DOWHO: TXO F,F.SRR ;REQUEST SKIP IN CASE NO ONE
MOVEI X,FORUM ;USE FORUM ADR FOR 1ST LINK
DOWHO1: HRRZ X,(X) ;LOAD NEXT LINK IN THE FORUM
SKIPN X ;IF FOUND END OF THE LIST,
JRST DOWHO2 ; THEN GO DO RETURN STUFF
CAIN X,(ID) ;IF WE'VE REACHED OURSELF,
JRST DOWHO1 ; THEN IGNORE AND GET NEXT
TXZN F,F.SRR ;IF NOT OUR FIRST NAME,
SKIPA M,[[ASCIZ/,/]] ; THEN LOAD A SEPARATOR
MOVEI M,[ASCIZ/<Others currently in the FORUM:/];ELSE BEGIN
PUSHJ P,STROUT ;DO THE APPROPRIATE MESSAGE
PUSHJ P,SPCOUT ;THEN TYPE A SPACE EITHER WAY
MOVEI M,ID$NN1(X) ;LOAD POINTER TO NICK-NAME
PUSHJ P,STROUT ;SEND STRING OUT FOR TYPING
MOVEI C,"*" ;LOAD SPECIAL GROUP INDICATOR
SKIPE ID$GRP(X) ;IF THIS ONE IS IN A GROUP,
PUSHJ P,CHROUT ; PUT MARKER AFTER NAME
JRST DOWHO1 ;LOOP FOR MORE FORUM MEMBERS
DOWHO2: TXZE F,F.SRR ;IF NO ONE WAS FOUND IN FORUM,
AOS (P) ; THEN DO SKIP RETURN TO ABOVE
POPJ P, ;RETURN TO WHOCOM ROUTINE
SUBTTL SPECIAL COMMAND ROUTINES --- REPLAY, REMOVE
;HERE TO TYPE OUT THE LAST SO MANY MESSAGES THAT WERE IN THE FORUM
REPCOM: PUSHJ P,MODIFY ;WITH CONTINUOUS HISEG INTERLOCK,
PUSHJ P,DOREP ;ENACT THE REPLAY COMMAND BELOW
POPJ P, ;RETURN FROM COMMAND
;THIS SUBROUTINE IS UNDER THE HISEG INTERLOCK
DOREP: MOVN N,OLDMLC ;PICK UP NEG. SPACES FREE IN OML
ADDI N,OMLMAX ;CALCULATE NUMBER IN OLD LSG LIST
MOVEI M,[ASCIZ/_<Replay of the last (\# )message$>_/]
PUSHJ P,ACTOUT ;THERE MUST BE AT LEAST ONE MSG
MOVEI X,OLDMLP ;LOAD OLD MESSAGE LIST POINTER
DOREP1: HRRZ X,(X) ;PICK UP NEXT LINK TO MB POINTERS
SKIPN X ;WHEN WE HIT END OF LINKED LIST,
PJRST CLFOUT ; LEAVE A BLANK LINE AND RETURN
HRRZ M,MP$MBA(X) ;LOAD POINTER TO MESSAGE BLOCK
MOVEI M,MB$TXT(M) ;LOAD ADDRESS OF TEXT OF MESSAGE
PUSHJ P,LINOUT ;TYPE OUT MESSAGE WITH A CRLF
JRST DOREP1 ;GO ON TO NEXT MESSAGE LINK
;HERE TO CARRY OUT THE SECRET REMOVE COMMAND
REMCOM: HRRZ T1,ID$PPN(ID) ;PICK UP USER'S PROG NUMBER
CAIE T1,PRVPRG ;UNLESS WE'RE THE PRIV ONE,
JRST XITCOM ; THEN HE/SHE GETS REMOVED
MOVEI A,DOREM ;LOAD REMOVE ROUTINE ADDRESS
PUSHJ P,MODIFY ;GRAB THE HISEG INTERLOCK
PUSHJ P,SEARCH ;FIND ID BLOCK ADR OF NAME
POPJ P, ;RETURN WHEN DONE REMOVING
;ELSE FALL THROUGH FOR SELF
DOREM: HRRZ T1,ID$JOB(X) ;GET JOB OF UNFORTUNATE USER
PUSH P,A ;SAVE ROUTINE ADR FOR SEARCH
MOVEI A,(X) ;LOAD HIS OR HER ID BLOCK ADR
PUSHJ P,LL$REM ;REMOVE BLOCK FROM FORUM LIST
HLRZ X,A ;FIX LINK TO CONTINUE SEARCH
POP P,A ;RESTORE ADR FOR SEARCH SUB
WAKE T1, ;NO HARM IN PROMPTING THEM
JFCL ;THEY WILL DIE SOON ENOUGH
POPJ P, ;AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- MYNAME
;HERE TO FIND OUT OR CHANGE OUR FORUM NICK-NAME
MYNCOM: SKIPN NAMBUF ;IF NO ARGUMENT WAS GIVEN,
JRST .+3 ; THEN JUST PROVIDE NAME
PUSHJ P,DOMYN ;OTHERWISE, SET UP NEW NAME
SKIPA M,[[ASCIZ/<Your name has been changed to /]]
MOVEI M,[ASCIZ/<Your name is /]
PUSHJ P,STROUT ;TYPE OUT APPROPRIATE TEXT
MOVEI M,ID$NN1(ID) ;LOAD ADDRESS OF NEW/OLD NAME
PUSHJ P,STROUT ;TYPE OUT THE INFO FOR USER
PJRST FINLIN ;FINISH LINE AND RETURN
;CODE TO CHANGE NAME AND INFORM THE FORUM
DOMYN: TXO F,F.FRC ;THIS MESSAGE SHOULD BE FORCED
PUSHJ P,MSGHDR ;SET UP MESSAGE HEADER IN WRKBUF
MOVE T1,WRKBUF+MB$SDR ;LOAD SENDER WORD FROM BUFFER
TXZ T1,MS.NOR ;ALWAYS PUT THIS IN OLD MSG'S
TXO T1,MS.NAM ;INDICATE CHANGE OF NAME TYPE
MOVEM T1,WRKBUF+MB$SDR ;RETURN WORD TO WORK BUFFER
PUSH P,P1 ;SAVE SPECIAL ACCUMULATOR
MOVE P1,[POINT 7,WRKBUF+MB$TXT];LOAD ASCII TEXT POINTER
PUSHJ P,PUTOAB ;PUT AN OPEN ANGLE BRACKET
MOVEI A,ID$NN1(ID) ;LOAD ADR OF CURRENT NAME
PUSHJ P,PUTNAM ;PUT THE CHARS IN MESSAGE
MOVEI M,[ASCIZ/ has changed his or her name to /]
PUSHJ P,PUTSTR ;LOAD STRING INTO MESSAGE
MOVEI A,NAMBUF ;LOAD ADDRESS OF NEW NAME
PUSHJ P,PUTNAM ;PUT THOSE CHARS IN MESSAGE
PUSHJ P,PUTCAB ;APPEND A CLOSE ANGLE BRACKET
PUSHJ P,PUTNUL ;AND THEN A FINAL NULL BYTE
SUBI P1,WRKBUF ;FIND WORDS USED AFTER FIRST
MOVSI A,1(P1) ;LOAD LENGTH OF MESSAGE BLOCK
HRRI A,WRKBUF ;LOAD ADDRESS OF WORK SPACE
PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
PUSHJ P,FC$SHR ;AND PUT INTO FREE-CORE
FCERR ;CHECK FOR POSSIBLE ERRORS
MOVSI P1,NAMBUF ;LOAD ADDRESS OF NEW NAME
HRRI P1,ID$NN1(ID) ;LOAD ADR OF DESTINATION
PUSHJ P,MODIFY ;WITH INTERLOCK IN PROGRESS
BLT P1,ID$NN1+NAMSIZ-1(ID) ;TRANSFER NAME INTO ID BLOCK
SETZM WRKBUF+MP$LNK ;CLEAR LINKAGE WORD OF PNTR
MOVEM A,WRKBUF+MP$MBA ;STORE MESSAGE BLOCK ADDRESS
MOVE P1,A ;SAVE INFO IN P1 FOR SENALL
PUSHJ P,MODIFY ;GRAB THE HISEG INTERLOCK
PUSHJ P,SENALL ;SEND CHANGE TO ALL IN FORUM
POP P,P1 ;PRESERVE ACCORDING TO CONVENTION
TXZ F,F.FRC ;CLEAR MESSAGE FORCE FLAG
POPJ P, ;AND RETURN TO ABOVE ROUTINE
SUBTTL SPECIAL COMMAND ROUTINES --- TELL
;HERE TO SEND A PRIVATE MESSAGE TO ANYONE IN THE FORUM
TELCOM: SETZM SAVCHR ;NEVER FOLLOW WITH COMMANDS
CAIN C,":" ;IF DELIMITER IS A COLON,
JRST DOTEL ; THEN WE'VE A LEGIT MSG
SKIPN NAMBUF ;AS LONG AS NO NAME GIVEN,
JUMPE C,TELER1 ; DO ERROR IF NO LINE
MOVEI M,[ASCIZ/<A colon must follow the name and precede the text>/]
TELERR: QRSET Q,INPUTQ ;WIPE OUT THE INPUT QUEUE
QPERR ;CHECK FOR QPACK PROBLEMS
CAIA ;SKIP NO MESSAGE ERROR
TELER1: MOVEI M,[ASCIZ/<No message specified>/]
CLRBFI ;CLEAR ANY USER TYPE AHEAD
TXNE F,F.LOG ;IF A LOG IS BEING RECORDED,
OFFLOG ; THEN DON'T SEND IT ERROR
PJRST LINOUT ;TYPE THE LINE AND RETURN
;HERE WHEN THE NECESSARY FORMAT IS ENCOUNTERED
DOTEL: PUSHJ P,GETNSC ;GET FIRST NON-SPACE CHAR
JRST TELER1 ;DO EMPTY ERROR IF CAN'T
SKIPE NAMBUF ;AS LONG AS NAME GIVEN,
JRST DOTEL1 ; THEN GO DO THE SEND
MOVEI M,[ASCIZ/<No previous name specified>/]
SKIPN SAVTEL ;IF NO PREVIOUS TELL OBJECT,
JRST TELERR ; THEN GO HANDLE ERROR MSG
MOVE T1,[XWD SAVTEL,NAMBUF] ;OTHERWISE, PREPARE TRANSFER
BLT T1,NAMBUF+NAMSIZ-1 ;OF OLD NAME TO THE BUFFER
JRST DOTEL2 ;GO SET UP THE MESSAGE BLK
DOTEL1: MOVE T1,[XWD NAMBUF,SAVTEL] ;HERE IF NAME GIVEN ON TELL
BLT T1,SAVTEL+NAMSIZ-1 ;SAVE FOR FUTURE REFERENCE
DOTEL2: TXO F,F.FRC ;FORCE PRIVATE MSG'S TO ALL
PUSHJ P,MSGHDR ;SET UP MSG HEADER IN WRKBUF
MOVX T1,MS.NOR!MS.PRV ;NEVER REPLAY AND PRIVATE MSG
IORM T1,WRKBUF+MB$SDR ;SET THE BITS ON IN MSG STATS
PUSH P,P1 ;SAVE SPECIAL ACCUMULATOR
PUSH P,C ;ALSO SAVE 1ST CHAR OF MSG
MOVE P1,[POINT 7,WRKBUF+MB$TXT];LOAD TEXT BYTE POINTER
MOVEI M,[ASCIZ/<Prv msg from /];LOAD ADDRESS OF FIRST PART
PUSHJ P,PUTSTR ;PUT BEGINNING STRING IN MSG
MOVEI A,ID$NN1(ID) ;LOAD ADDRESS OF OUR NAME
PUSHJ P,PUTNAM ;PUT NAME IN THE MESSAGE
MOVEI M,[ASCIZ/ to /] ;ALSO USE TWO PART INFO
PUSHJ P,PUTSTR ;PUT STRING INTO MESSAGE
MOVEI A,NAMBUF ;LOAD ADDRESS OF NAME ARG
PUSHJ P,PUTNAM ;NOTATE SPECIFIED SENDEE
PUSHJ P,PUTCAB ;STICK IN A CLOSE ANG BRKT
PUSHJ P,PUTCLN ;AND TACK ON A COLON CHAR
PUSHJ P,PUTSPC ;PUT A SPACE FOR SEPARATION
POP P,C ;UNLOAD FIRST MESSAGE CHAR
DOTEL3: PUSHJ P,PUTCHR ;AND PUT IT INTO MESSAGE
QPULL Q,C ;UNLOAD NEXT CHAR FROM Q
QPERR ;FALL THROUGH WHEN EMPTY
JUMPN Q,DOTEL3 ;LOOP BACK IF GOT A CHAR
PUSHJ P,PUTNUL ;APPEND FINAL NULL TO TEXT
SUBI P1,WRKBUF ;FIND WORDS USED AFTER FIRST
MOVSI A,1(P1) ;LOAD BUFFER LENGTH IN LEFT
HRRI A,WRKBUF ;LOAD ADDRESS OF BLOCK TOO
TXNN F,F.LOG ;AS LONG AS NOT DOING LOG,
JRST DOTEL4 ; THEN JUMP AHEAD FOR SEND
OFFTTY ;ELSE SEND SPECIAL TO LOG
MOVEI M,WRKBUF+MB$TXT ;LOG ALREADY SET IN OUTLST
PUSHJ P,LINOUT ;SO SEND IT THE MESSAGE TEXT
OFFLOG ;KEEP REST OUT OF THE LOG
ONTTY ;AND REPLACE TTY IN OUTLST
DOTEL4: PUSHJ P,MODIFY ;GET UNDER HISEG INTERLOCK
PUSHJ P,FC$SHR ;STORE PRIVATE MESSAGE BLOCK
FCERR ;CHECK FOR STORAGE ERRORS
SETZM WRKBUF+MP$LNK ;CLEAR MESSAGE POINTER LINK
MOVEM A,WRKBUF+MP$MBA ;STORE MESSAGE BLOCK ADDRESS
MOVE P1,A ;LEAVE ADR IN HANDY PLACE
MOVEI A,DOTEL6 ;LOAD SEND ROUTINE ADDRESS
PUSHJ P,MODIFY ;WITH CONTINUOUS INTERLOCK
PUSHJ P,SEARCH ;SEND MESSAGE TO THE FORUM
JRST DOTEL5 ;HERE IF DONE OR NO MATCH
TXZ F,F.FRC ;CLEAR THE FORCE FLAG
MOVEI M,[ASCIZ/<Tell it to yourself, silly>/]
PUSHJ P,LINOUT ;DO SPECIAL IF NAMED SELF
DOTEL5: TXZ F,F.FRC ;EXTINGUISH FORCE FLAG
EXCH P1,(P) ;RESTORE SPECIAL ACCUMULATOR
POP P,A ;RECOVER MESSAGE BLOCK ADR
SOSLE MB$CNT(A) ;REPAIR THE RECEIVER COUNT
POPJ P, ;AND RETURN IF IT'S NORMAL
PUSHJ P,MODIFY ;ELSE GRAB HISEG INTERLOCK
PUSHJ P,FC$DEL ;TO DELETE MSG FROM FREE-CORE
FCERR ;WHILE CHECKING FOR ERRORS
POPJ P, ;HAPPENS WHEN NO MATCH MADE
;THIS SUBROUTINE IS UNDER THE HISEG INTERLOCK
DOTEL6: PUSH P,A ;SAVE THIS ROUTINE'S ADDRESS
PUSHJ P,SENMSG ;FORCE SENDING TO ALL MATCHES
JRST DOTEL7 ;(SHOULD NEVER HAPPEN)
MOVEI M,[ASCIZ/<Private message sent to /]
PUSHJ P,STROUT ;INFORM USER OF SEND SUCCESS
MOVEI M,ID$NN1(X) ;LOAD ADDRESS OF SENDEE NAME
PUSHJ P,STROUT ;SPECIFY TO WHOM MESSAGE SENT
PUSHJ P,FINLIN ;FINISH WITH ANG BRKT AND CRLF
DOTEL7: POP P,A ;RESTORE ADR FOR SEARCH
POPJ P, ;AND CONTINUE FORUM SCAN
SUBTTL SPECIAL COMMAND ROUTINES --- (NOT YET IMPLEMENTED COMMANDS)
SENCOM:
SYSCOM:
MYFCOM:
ACCCOM:
NACCOM:
PRFCOM:
PJRST NOTYET
SUBTTL SPECIAL COMMAND ROUTINES --- LOG, NOLOG
;HERE TO OPEN A LOG FILE FOR RECORDING THE FORUM CONVERSATION
LOGCOM: TXNN F,F.LOG ;AS LONG AS A LOG ISN'T OPEN,
JRST DOLOG ; THEN GO START ONE UP
MOVE T1,SAVLFN ;OTHERWISE, PREPARE MESSAGE
MOVEM T1,FIL ;LOAD THE NAME OF CURRENT LOG
MOVSI T1,LOGEXT ;LOAD THE CONSTANT EXTENSION
MOVEM T1,EXT ;INTO PRINTER BUFFER
MOVEI T1,LOG ;LOAD THE LOG CHANNEL
DEVPPN T1, ;TO FIND THE LOG PPN
SETZ T1, ;USE ZERO IF NOT IMPLEMENTED
MOVEM T1,PPN ;PUT INFO IN PRINTER
MOVEI T1,LOG ;LOAD CHANNEL NUMBER AGAIN
DEVNAM T1, ;TO OBTAIN DEVICE NAME
SETZ T1, ;DON'T WORRY ABOUT IT
MOVEM T1,DEV ;STORE INFO IN PRINTER
OFFLOG ;DON'T WRITE THIS IN THE LOG
MOVEI M,[ASCIZ/<Already recording in the log file ^>_/]
PJRST ACTOUT ;EXPLAIN SITUATION AND RETURN
;HERE WHEN REQUEST FOR LOG IS LEGIT
DOLOG: TXNE F,F.LCO ;IF LOG CHANNEL ALREADY OPEN,
JRST DOLOG1 ; DON'T TRY TO RE-OPEN IT
MOVEI T1,.IOASC ;IN ASCII MODE,
MOVSI T2,LOGDEV ;TO DEVICE LOG,
MOVSI T3,LOGBRH ;WITH OUTPUT BUFFERING,
OPEN LOG,T1 ;OPEN AN I/O CHANNEL
CAIA ;SKIP IF UNAVAILABLE
JRST DOLOG1 ;OTHERWISE, PROCEED WITH ENTER
IFN LOGDEV-'DSK',<
MOVEI T1,.IOASC ;TRY ANOTHER TIME
MOVSI T2,'DSK' ;TO DEVICE DISK
MOVSI T3,LOGBRH ;WITH SAME BUFFER
OPEN LOG,T1 ;ISSUE CHANNEL REQUEST
CAIA ;SKIP IF FAILURE
JRST DOLOG1 ;ELSE GO ON FOR ENTER
>;END OF IFN LOGDEV-'DSK' CONDITIONAL
MOVSI T1,LOGDEV ;HERE IF FAILURE TO OPEN CHANNEL
MOVEM T1,DEV ;LOAD DEVICE NAME IN PRINTER
MOVEI M,[ASCIZ/<Unable to open channel to device :>_/]
PJRST ACTOUT ;TYPE FAILURE AND RETURN
DOLOG1: MOVSI T1,LOGEXT ;LOAD THE LOG FILE EXTENSION
MOVEM T1,EXT ;INTO THE EXTENSION PRINTER
MOVEI T1,LOG ;LOAD THE LOG CHANNEL NUMBER
DEVPPN T1, ;FIND THE PPN OF LOG CHANNEL
SETZ T1, ;USE NONE IF NOT IMPLEMENTED
MOVEM T1,PPN ;PUT INFO IN PPN PRINTER
MOVEI T1,LOG ;RELOAD LOG CHANNEL NUMBER
DEVNAM T1, ;FIND DEVICE NAME OF CHANNEL
SETZ T1, ;OH WELL
MOVEM T1,DEV ;STORE INFO IN PRINT BUFFER
SKIPN T2,DEV ;IF WE COULDN'T GET DEVICE NAME,
JRST DOLOG5 ; ALWAYS USE OVERRIDE FILE NAME
SETZB T1,T3 ;ELSE WITH NO STATUS OR BUFFERS
OPEN LKP,T1 ;OPEN THE LOOKUP CHANNEL
JRST DOLOG5 ;USE OVERRIDE IF CAN'T
TXO F,F.LKP ;SHOW THAT LKP CHN OPEN
TXNE F,F.LCO ;UNLESS THIS IS THE FIRST TIME,
JRST DOLOG2 ; CONTINUE FROM NAME SEQUENCE
MOVE T1,[EXP LOGFST] ;LOAD STARTING FILE NAME
MOVEM T1,SAVLFN ;SALT AWAY FOR FUTURE REFERENCE
JRST DOLOG4 ;ENTER SEQUENCE LOOP AFTER INC
DOLOG2: MOVE T1,SAVLFN ;LOAD LAST FILE NAME USED
CAMN T1,[EXP LOGOVR] ;IF IT'S THE OVERRIDE NAME,
JRST DOLOG6 ; THEN WE MUST SUPERSEDE IT
DOLOG3: AOS T1,SAVLFN ;OBTAIN NEXT NAME IN SEQUENCE
DOLOG4: CAMN T1,[EXP LOGOVR] ;IF WE HIT THE OVERRIDE NAME,
JRST DOLOG6 ; THEN DON'T CHECK FOR SUPERSEDES
CAMLE T1,[EXP LOGLST] ;IF WE'RE OUT OF NAMES TO USE,
JRST DOLOG5 ; TRY THE OVERRIDE FILE NAME
MOVSI T2,LOGEXT ;LOAD THE LOG FILE EXTENSION
SETZB T3,T4 ;USE DEFAULT TIMES AND PPN
ENTER LOG,T1 ;OPEN THE FILE FOR WRITING
JRST DOLOG3 ;TRY NEXT IN SEQUENCE IF CAN'T
MOVE T1,SAVLFN ;OTHERWISE, RELOAD FILE NAME
MOVSI T2,LOGEXT ;AND SAME WITH LOG EXTENSION
SETZB T3,T4 ;AND CLEAR OTHER GARBAGE
LOOKUP LKP,T1 ;SEE IF FILE ALEADY EXISTS
JRST DOLOG7 ;ALL CLEAR IF NOT THERE
CLOSE LOG,CL.RST ;OTHERWISE, DON'T SUPERSEDE
CLOSE LKP, ;AND TERMINATE THE LOOKUP
JRST DOLOG3 ;TRY NEXT NAME IN SEQUENCE
DOLOG5: MOVE T1,[EXP LOGOVR] ;USE OVERRIDE FILE NAME
MOVEM T1,SAVLFN ;SAVE FOR FUTURE REFERENCE
DOLOG6: MOVSI T2,LOGEXT ;LOAD STANDARD EXTENSION
SETZB T3,T4 ;AND NORMAL OTHER STUFF
ENTER LOG,T1 ;OPEN FILE FOR WRITING
CAIA ;SKIP TO HANDLE ERROR
JRST DOLOG7 ;ELSE WE'RE ALL SET
TXZE F,F.LKP ;IF WE OPENED LOOKUP CHANNEL,
RELEAS LKP, ; THEN GET RID OF IT
MOVE T1,SAVLFN ;RELOAD FILE NAME JUST IN CASE
MOVEM T1,FIL ;PUT FILE NAME INTO PRINTER
MOVEI M,[ASCIZ/<Unable to open the log file ^ for writing>_/]
PJRST ACTOUT ;TYPE MESSAGE AND RETURN
DOLOG7: TXZE F,F.LKP ;IF WE OPENED THE LOOKUP CHN,
RELEAS LKP, ; THEN TERMINATE CORRESPONDENCE
MOVE T1,SAVLFN ;RELOAD NAME JUST IN CASE
MOVEM T1,FIL ;PUT LOG FILE NAME IN PRINTER
TXON F,F.LCO ;IF THIS IS THE FIRST TIME,
OUTBUF LOG, ; SET UP THE BUFFER RING
MOVEI M,[ASCIZ/<Now recording in ^>_/]
PUSHJ P,ACTOUT ;TYPE OUT MESSAGE TO TERMINAL
TXO F,F.LOG ;SHOW THAT WE'RE DOING A LOG
OFFTTY ;TAKE TTY OUT OF OUTPUT LIST
ONLOG ;PUT THE LOG IN THE OUTLST
MOVEI M,[ASCIZ/***** Recording of the FORUM conversation at /]
PUSHJ P,STROUT ;PUT ABOVE STRING IN LOG FILE
MOVEI M,[ASCIZ/+ on &/]
PUSHJ P,ACTOUT ;DO THE FANCY ACTION STUFF
MOVEI M,[ASCIZ/ *****/]
PUSHJ P,LINOUT ;STARS WOULD CAUSE 20-BLOCK LOGS
PUSHJ P,DLFOUT ;SKIP DOWN TWO EXTRA LINES
ONTTY ;PUT TTY BACK IN OUTPUT LIST
POPJ P, ;AND FINALLY RETURN
;HERE TO CLOSE THE LOG FILE ON COMMAND OR UPON EXIT
NLOCOM: TXZE F,F.LOG ;AS LONG AS THERE IS A LOG,
JRST .+3 ; THEN IT'S OKAY TO CLOSE IT
MOVEI M,[ASCIZ/<No log file was being recorded>/]
PJRST LINOUT ;TYPE LINE AND RETURN
MOVE T1,SAVLFN ;HERE TO CLOSE UP THE LOG
MOVEM T1,FIL ;PUT FILE NAME IN PRINTER
MOVSI T1,LOGEXT ;LOAD UP FILE EXTENSION
MOVEM T1,EXT ;PUT IT IN SAME PLACE
SETZM PPN ;DON'T BOTHER WITH PPN
SETZM DEV ;OR THE LOG DEVICE NAME
OFFTTY ;DON'T SEND THIS TO TTY
ONLOG ;TURN ON LOG IN CASE EXIT
MOVEI M,[ASCIZ/_<End of FORUM log file ^ at +>_/]
PUSHJ P,ACTOUT ;PUT FINAL MESSAGE IN LOG
CLOSE LOG, ;OUTPUT BUFFER AND CLOSE IT
OFFLOG ;REMOVE LOG (FLAG CLEARED)
ONTTY ;PUT TTY BACK IN OUTLST
MOVEI M,[ASCIZ/<Log file ^ closed>_/]
PJRST ACTOUT ;TYPE INFO AND RETURN
;THIS ROUTINE IS USED TO PUT THE LOG IN THE OUTPUT LIST BY OPDEF "ONLOG"
SETLON: PUSH P,T1 ;SAVE A SCRATCH AC
MOVE T1,[XWD LOG,LOGBRH] ;LOAD CHANNEL AND BUFFER
MOVEM T1,OUTLST+1 ;INTO OUTPUT LIST SPEC
POP P,T1 ;RESTORE SCRATCH AC
POPJ P, ;AND RETURN
;THIS IS THE REMOVE ROUTINE USED BY "OFFLOG", NEEDED BECAUSE MACRO WAS
; GOOFING UP POLISH FIXUPS (SETZM OUTLST+1 WAS MADE INTO SETZM 0)
SETLOF: SETZM OUTLST+1 ;HOPEFULLY, MACRO CAN HANDLE THIS
POPJ P, ;RETURN FROM ONE-INSTRUCTION SUB
SUBTTL SPECIAL COMMAND ROUTINES --- LC,UC,TIME,ENTMAX,AUTHOR,WHAT,HOW
;HERE TO SET TTY TO LOWER CASE INPUT
LCTCOM: SETO T1, ;FOR OUR TERMINAL
GETLCH T1 ;GET LINE CHARACTERISTICS
TXO T1,GL.LCM ;SWITCH TO LOWER CASE MODE
SETLCH T1 ;DO THE SET TTY LC
POPJ P, ;AND RETURN
;HERE TO SET TTY TO UPPER CASE INPUT
UCTCOM: SETO T1, ;FOR OUR TERMINAL
GETLCH T1 ;WE WANT LINE CHARACTERISTICS
TXZ T1,GL.LCM ;SWITCH TO UPPER CASE MODE
SETLCH T1 ;DO THE SET TTY NO LC
POPJ P, ;AND RETURN
;HERE TO FIND THE CURRENT TIME OF DAY
TIMCOM: MOVEI M,[ASCIZ/<The current time is +>_/]
PJRST ACTOUT ;TYPE INFO AND RETURN
;HERE TO FIND NUMBER OF ENTRIES MADE INTO THE FORUM PROGRAM
EMXCOM: MOVE N,ENTERS ;LOAD ENTRY INFORMATION
MOVEI M,[ASCIZ/<There ha(s\ve) been # entr(y\ies) into the FORUM>_/]
PJRST ACTOUT ;TYPE HANDY MESSAGE AND RETURN
;HERE TO PROVIDE MY NAME AS AUTHOR OF FORUM
AUTCOM: MOVEI M,[ASCIZ/<The author of FORUM is Ernie Petrides/]
PUSHJ P,STROUT ;TELL THEM WHO I AM
MOVEI M,[ASCIZ/, Wesleyan University, Middletown, CT>/]
PJRST LINOUT ;AND WHERE I'M FROM
;HERE TO EXPLAIN WHAT PROGRAM THIS IS
WHTCOM: MOVEI M,[ASCIZ/<This is FORUM -- /]
PUSHJ P,STROUT ;PUT OUT FIRST HALF OF TEXT
MOVEI M,[ASCIZ/a program for inter-terminal communication>/]
PJRST LINOUT ;TYPE LINE WITH CRLF AND RETURN
;HERE TO EXPLAIN HOW TO USE THIS PROGRAM
HOWCOM: MOVEI M,[ASCIZ/<Just type a line of text followed by a <CR> -- /]
PUSHJ P,STROUT ;TYPE FIRST HALF OF MESSAGE
MOVEI M,[ASCIZ\type "/H" for help>\]
PJRST LINOUT ;DO REST WITH CRLF AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- WHY, HELLO, LIST
;HERE TO RETURN A SNIDE MESSAGE TO WHY
WHYCOM: MOVEI M,[ASCIZ/<Because>/] ;NEVER ASK THE COMPUTER WHY
PJRST LINOUT ;TYPE THE LINE AND RETURN
;HERE TO TYPE A FRIENDLY GREETING IF SOMEONE SAYS HELLO TO US
HELCOM: MOVEI M,[ASCIZ/<Hi, there>/] ;LOAD FRIENDLY MESSAGE
PJRST LINOUT ;TYPE LINE AND RETURN
;HERE TO LIST ALL THE COMMANDS IN THE COMMAND TABLE
LSTCOM: MOVEI M,[ASCIZ/<List of commands:/]
PUSHJ P,STROUT ;TYPE HEADER OF MESSAGE
MOVSI X,-COMLEN ;INIT AOBJ PNTR FOR COMMANDS
JRST DOLST1 ;JUMP INTO PRINT LOOP 1ST TIME
DOLST: MOVEI C,"," ;FIRST LOAD A COMMA CHAR
PUSHJ P,CHROUT ;TO SET OFF COMMAND NAMES
MOVEI T1,1(X) ;LOAD NUMBER OF 8-CHAR FIELDS
IDIVI T1,^D9 ;FIND IF WE NEED A NEW LINE
JUMPN T2,DOLST1 ;JUST TYPE A SPACE IF NOT
PUSHJ P,CLFOUT ;OTHERWISE, GET ON NEW LINE
PUSHJ P,TABOUT ;AND TAB OVER ONE COMMAND FIELD
CAIA ;SKIP THE SPACING CHOICE
DOLST1: PUSHJ P,SPCOUT ;JUST TYPE A PLAIN OLD SPACE
MOVE T1,COMNAM(X) ;LOAD THIS COMMAND'S NAME
MOVEM T1,SIX ;PUT INTO SIXBIT PRINTER
PUSHJ P,SXSOUT ;TYPE IT WITHOUT TRAILERS
AOBJN X,DOLST ;LOOP IF STILL MORE TO GO
PJRST FINLIN ;OTHERWISE, FINISH AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- EXPOSE (OR WHO W/ ARG)
;HERE TO EXPOSE VITAL STATISTICS OF ANYONE IN THE FORUM
EXPCOM: MOVEI A,DOEXP ;LOAD ROUTINE ADDRESS AS ARG
PUSHJ P,MODIFY ;REQUEST THE HISEG INTERLOCK
PUSHJ P,SEARCH ;DO SEARCH ROUTINE WITH BELOW
POPJ P, ;RETURN IF DONE OR ERROR
MOVEI M,[ASCIZ/yourself/] ;LOAD SPECIAL NAME FOR SELF
DOEXP: PUSH P,M ;SAVE APPROPRIATE NAME ADDRESS
MOVEI M,[ASCIZ/<Exposure of /];LOAD ADR OF BEGINNING TEXT
PUSHJ P,STROUT ;OUPUT STRING TO THE USER
POP P,M ;RECOVER ADDRESS OF THE NAME
PUSHJ P,STROUT ;TYPE OUT THE PROPER NAME
MOVEI C,"*" ;LOAD THE GROUP INDICATOR
SKIPE ID$GRP(X) ;IF THIS GUY IS IN SPECIAL,
PUSHJ P,CHROUT ; THEN SIGNAL IT W/ ASTERISK
MOVEI C,":" ;LOAD A SINGLE COLON CHAR
PUSHJ P,CHROUT ;SEPARATE INFO FROM NAME
PUSHJ P,DSPOUT ;NOW TYPE OUT TWO SPACES
MOVEI M,[ASCIZ/TTY/] ;LOAD STRING FOR TERMINAL
PUSHJ P,STROUT ;OUTPUT THE THREE LETTERS
MOVE N,ID$TTY(X) ;LOAD THE TTY NUMBER
PUSHJ P,OCTOUT ;TYPE OUT IN OCTAL
PUSHJ P,DSPOUT ;ANOTHER TWO SPACES
MOVEI M,[ASCIZ/JOB/] ;SHOW WE KNOW THE JOB
PUSHJ P,STROUT ;LOOKS LIKE CONTROL-Y
MOVE N,ID$JOB(X) ;LOAD THE JOB NUMBER
PUSHJ P,DECOUT ;OUTPUT IN DECIMAL
PUSHJ P,DSPOUT ;TWO MORE SPACES
MOVE N,ID$PPN(X) ;LOAD THEIR PPN
MOVEM N,PPN ;PUT IN PRINTER
PUSHJ P,PPNOUT ;DO SPECIAL SUB
PUSHJ P,DSPOUT ;TWO MORE SEPS
MOVE T1,ID$UN1(X) ;LOAD FIRST HALF OF USER NAME
MOVEM T1,SIX ;INTO SIXBIT PRINTER BUFFER
PUSHJ P,SIXOUT ;TYPE AT LEAST SIX CHARS
MOVE T1,ID$UN2(X) ;LOAD SECOND HALF OF NAME
MOVEM T1,SIX ;INTO SIXBIT PRINTER BUF
PUSHJ P,SXSOUT ;NO TRAILING SPACES NOW
PJRST FINLIN ;FINISH LINE AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- USER, WHEN
;HERE TO FIND OUT USER NAME OF ANYONE IN THE FORUM
USRCOM: MOVEI A,DOUSR ;LOAD ADR OF OUTPUT ROUTINE
PUSHJ P,MODIFY ;GET THE HISEG INTERLOCK
PUSHJ P,SEARCH ;DO INFO FOR GIVEN NAME
POPJ P, ;RETURN IF NOT SELF SPEC
MOVEI M,[ASCIZ/<You are logged in as /]
PJRST DOUSR1 ;ELSE DO ROUTINE FOR SELF
DOUSR: MOVEI C,"<" ;LOAD AN OPEN ANG BRACKET
PUSHJ P,CHROUT ;TYPE OUT BEGINNING CHAR
PUSHJ P,STROUT ;TYPE OUT NAME VIA ADR IN M
MOVEI M,[ASCIZ/ is logged in as /]
DOUSR1: PUSHJ P,STROUT ;TYPE OUT APPROPRIATE STRING
MOVE T1,ID$UN1(X) ;LOAD FIRST HALF OF NAME
MOVEM T1,SIX ;INTO SIXBIT PRINTER BUF
PUSHJ P,SIXOUT ;TYPE OUT ALL SIX CHARS
MOVE T1,ID$UN2(X) ;LOAD SECOND HALF OF NAME
MOVEM T1,SIX ;PUT THIS IN SIXBIT PRINTER
PUSHJ P,SXSOUT ;DO WITHOUT TRAILING SPACES
PJRST FINLIN ;FINISH LINE AND RETURN
;HERE TO FIND OUT HOW LONG SOMEONE HAS BEEN IN THE FORUM
WHNCOM: MOVEI A,DOWHN ;LOAD ADR OF BELOW ROUTINE
PUSHJ P,MODIFY ;GET THE HISEG INTERLOCK
PUSHJ P,SEARCH ;DO THE FORUM SCAN STUFF
POPJ P, ;RETURN IF TASK COMPLETE
MOVEI M,[ASCIZ/<You have been in the FORUM for # minute$>_/]
PJRST DOWHN1 ;ELSE DO SPECIAL FOR SELF
DOWHN: MOVEI C,"<" ;LOAD OPEN ANGLE BRACKET
PUSHJ P,CHROUT ;OUTPUT INITIAL CHARACTER
PUSHJ P,STROUT ;DO NAME POINTED TO BY M
MOVEI M,[ASCIZ/ has been in the FORUM for # minute$>_/]
DOWHN1: MOVE T1,[EXP %NSUPT] ;WE NEED SYSTEM UPTIME
GETTAB T1, ;FROM GETTAB TABLES
SETZ T1, ;USE ZERO IF PROBLEMS
SUB T1,ID$UPT(X) ;FIND ELAPSED JIFFIES
SKIPN N,JIFSEC ;IF JIFFIES/SEC NOT KNOWN,
PUSHJ P,SETJIF ; THEN FIND OUT AND SET N
IDIV T1,N ;CALCULATE SECONDS OF TIME
IDIVI T1,^D60 ;CONVERT TO MINUTES OF USE
CAIGE T2,^D30 ;IF FRACTION IS LESS THAN HALF,
SKIPA N,T1 ; THEN LOAD MINUTES STRAIGHT
MOVEI N,1(T1) ; ELSE ROUND UP TO NEXT VALUE
PJRST ACTOUT ;FINISH LINE AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- TTY (OR WHERE OR LOCATE), PPN
;HERE TO FIND OUT THE LOCATION OF SOMEONE IN THE FORUM
TTYCOM: MOVEI A,DOTTY ;LOAD ADR OF OUTPUT ROUTINE
PUSHJ P,MODIFY ;GRAB MODIFICATION INTERLOCK
PUSHJ P,SEARCH ;DO STUFF FOR ALL MATCHES
POPJ P, ;RETURN IF DONE OR NOTHING
MOVEI M,[ASCIZ/<You are located at TTY/]
PJRST DOTTY1 ;ELSE DO SPECIAL FOR SELF
DOTTY: MOVEI C,"<" ;LOAD OPEN ANGLE BRACKET
PUSHJ P,CHROUT ;START BEGINNING OF LINE
PUSHJ P,STROUT ;TYPE OUT MATCHED NAME
MOVEI M,[ASCIZ/ is located at TTY/]
DOTTY1: PUSHJ P,STROUT ;OUTPUT APPROPRIATE MSG
MOVE N,ID$TTY(X) ;PUT TTY NUMBER IN PLACE
PUSHJ P,OCTOUT ;TYPE IT IN OCTAL RADIX
PJRST FINLIN ;FINISH LINE AND RETURN
;HERE TO FIND OUT PROJECT-PROGRAMMER NUMBER OF ANYONE IN THE FORUM
PPNCOM: MOVEI A,DOPPN ;PROVIDE ROUTINE ADDRESS
PUSHJ P,MODIFY ;GO GET THE INTERLOCK
PUSHJ P,SEARCH ;SCAN THROUGH THE FORUM
POPJ P, ;RETURN IF ALL FINISHED
MOVEI M,[ASCIZ/<You are logged into [>_/]
PJRST DOPPN1 ;ELSE DO SPECIAL FOR SELF
DOPPN: MOVEI C,"<" ;LOAD UP AN OPEN ANG BRKT
PUSHJ P,CHROUT ;SEND IT TO OUTPUT STREAM
PUSHJ P,STROUT ;TYPE NAME OF SEARCHEE
MOVEI M,[ASCIZ/ is logged into [>_/]
DOPPN1: MOVE T1,ID$PPN(X) ;LOAD USER'S PPN SPEC
MOVEM T1,PPN ;PUT IN OUTPUT BUFFER
PJRST ACTOUT ;DO OUTPUT AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- JOB, ENTRY
;HERE TO FIND OUT THE JOB NUMBER OF ANYONE IN THE FORUM
JOBCOM: MOVEI A,DOJOB ;LOAD OUTPUT ROUTINE ADR
PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
PUSHJ P,SEARCH ;DO SCAN OF THE FORUM
POPJ P, ;RETURN IF ALL DONE
MOVEI M,[ASCIZ/<You are running under job #>_/]
PJRST DOJOB1 ;ELSE DO STRING FOR SELF
DOJOB: MOVEI C,"<" ;LOAD THE STANDARD STARTER
PUSHJ P,CHROUT ;TYPE OUT THE CHARACTER
PUSHJ P,STROUT ;OUTPUT NAME FROM ADR IN M
MOVEI M,[ASCIZ/ is running under job #>_/]
DOJOB1: MOVE N,ID$JOB(X) ;LOAD APPROPRIATE JOB NUMBER
PJRST ACTOUT ;DO ACTION OUTPUT AND RETURN
;HERE TO FIND OUT THE ENTRY INDEX OF ANYONE IN THE FORUM
NTYCOM: MOVEI A,DONTY ;SET UP ROUTINE ADDRESS
PUSHJ P,MODIFY ;WE NEED THE INTERLOCK
PUSHJ P,SEARCH ;TO SCAN FORUM LIST
POPJ P, ;RETURN IF ALL DONE
MOVEI M,[ASCIZ/<You were entry number #>_/]
PJRST DONTY1 ;OTHERWISE, DO SELF
DONTY: MOVEI C,"<" ;LOAD STARTER CHARACTER
PUSHJ P,CHROUT ;OUTPUT SPECIAL BRACKET
PUSHJ P,STROUT ;TYPE NAME OF THIS GUY
MOVEI M,[ASCIZ/ was entry number #>_/]
DONTY1: MOVE N,ID$NDX(X) ;LOAD ENTRY IN PLACE
PJRST ACTOUT ;DO OUTPUT AND RETURN
SUBTTL SPECIAL COMMAND ROUTINES --- BEEP
;HERE TO BEEP THE TERMINAL OF SOMEONE IN THE FORUM
IFLE BEPMAX,< ;USE NO LIMIT IF PARAMETER IS NOT POSITIVE
BEPCOM: MOVEI M,[ASCIZ/<There is no limit on beeps in this version>/]
SKIPN NAMBUF ;IF NO NAME WAS SPECIFIED,
PJRST LINOUT> ; THEN JUST TYPE THE MESSAGE
IFG BEPMAX,< ;CHECK LIMITS IF PARAMETER HAS LEGIT VALUE
BEPCOM: MOVEI M,[ASCIZ/<You have # beep$ left>_/]
SKIPGE N,BEPCNT ;LOAD NUMBER OF BEEPS LEFT
SETZB N,BEPCNT ;USE ZERO IF WENT NEGATIVE
SKIPN NAMBUF ;IF NO NAME WAS SPECIFIED,
PJRST ACTOUT ; THEN JUST TYPE THE INFO
MOVEI M,[ASCIZ/<Sorry, your beeper has run dry>/]
JUMPE N,LINOUT> ;TOO BAD IF WE'VE RUN OUT
PUSHJ P,MSGHDR ;SET UP MESSAGE HEADER
MOVX T1,MS.NOR ;LOAD NO REPLAY FLAG
IORM T1,WRKBUF+MB$SDR ;NEVER PUT BEEPS IN OML
PUSH P,P1 ;PRESERVE SPECIAL ACCUM
MOVE P1,[POINT 7,WRKBUF+MB$TXT];LOAD AN IDPB POINTER
MOVEI C,.CHBEL ;LOAD A BEEP CHARACTER
PUSHJ P,PUTCHR ;MAKE IT HEAD THE MSG
MOVEI M,[ASCIZ/<You have been *BEEPED* by /]
PUSHJ P,PUTSTR ;EXPLAIN WHAT JUST HAPPENED
MOVEI A,ID$NN1(ID) ;LOAD ADDRESS OF OUR NAME
PUSHJ P,PUTNAM ;PUT IT INTO THE MESSAGE
PUSHJ P,PUTCAB ;APPEND A CLOSE ANG BRKT
PUSHJ P,PUTNUL ;AND TACK ON TERMINATOR
SUBI P1,WRKBUF ;FIND BLOCK LENGTH - 1
MOVSI A,1(P1) ;GET LENGTH IN PLACE
HRRI A,WRKBUF ;WITH BUFFER ADDRESS
PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
PUSHJ P,FC$SHR ;STORE INTO FREE-CORE
FCERR ;CHECK FOR ERRORS
SETZM WRKBUF+MP$LNK ;CLEAR LINKAGE POINTER
MOVEM A,WRKBUF+MP$MBA ;SET MESSAGE BLOCK ADR
MOVE P1,A ;COPY FOR CONVENIENCE
MOVEI A,DOBEP ;LOAD ADDRESS OF BEEPER
PUSHJ P,MODIFY ;GET INTERLOCK AGAIN
PUSHJ P,SEARCH ;DO THE FORUM SCAN
JRST BEPCO1 ;AHEAD IF DONE OR NO MATCH
MOVEI C,.CHBEL ;LOAD A BEEP CHARACTER
PUSHJ P,CHROUT ;SEND IT TO OURSELVES
MOVEI M,[ASCIZ/<You have been *BEEPED* by yourself>/]
PUSHJ P,LINOUT ;EXPLAIN WHAT WE JUST DID
BEPCO1: EXCH P1,(P) ;RESTORE SPECIAL ACCUM
POP P,A ;RECOVER MSG BLOCK ADR
SOSLE MB$CNT(A) ;IF SUCCESSFULLY SENT,
POPJ P, ; THEN JUST RETURN
PUSHJ P,MODIFY ;OTHERWISE, GET INTERLOCK
PUSHJ P,FC$DEL ;TO DELETE IT FROM STORAGE
FCERR ;DON'T FORGET ERROR CHECK
POPJ P, ;AND NOW RETURN TO CALLER
;THIS ROUTINE IS UNDER THE HISEG INTERLOCK
DOBEP:
IFG BEPMAX,<SOSGE N,BEPCNT ;DECREMENT THE BEEP COUNT
POPJ P,> ;JUST RETURN IF OVERDRAWN
PUSH P,A ;SAVE ADR OF THIS ROUTINE
PUSHJ P,SENMSG ;TRY SEND TO ID SPEC IN X
JRST DOBEP1 ;RECOVER THE BEEP IF REFUSED
IFG BEPMAX,<HRRZ T1,ID$PPN(ID) ;LOAD OUR PROGRAMMER SPEC
CAIN T1,PRVPRG ;IF WE HAVE THE PRIVILEGES,
AOS N,BEPCNT> ; NEVER RUN OUT OF BEEPS
MOVEI M,[ASCIZ/<Beep sent to /];LOAD BEGINNING TEXT ADR
PUSHJ P,STROUT ;TYPE OUT THE ASCII STRING
MOVEI M,ID$NN1(X) ;LOAD ADR OF NAME WHO'LL BEEP
PUSHJ P,STROUT ;TYPE OUT HIS OR HER NAME
IFG BEPMAX,<MOVEI M,[ASCIZ/ -- # beep$ left/];LOAD ADR OF END MSG
PUSHJ P,ACTOUT> ;FINISH UP THE ABOVE LINE
PUSHJ P,FINLIN ;TACK ON ANG BRKT AND CRLF
IFG BEPMAX,<CAIA ;SKIP BEEP FAILURE FIXER
DOBEP1: AOS BEPCNT> ;REPAIR COUNT IF REFUSED
IFLE BEPMAX,<DOBEP1:>
POP P,A ;RESTORE ADR FOR SEARCH
POPJ P, ;AND CONTINUE FORUM SCAN
SUBTTL SPECIAL COMMAND ROUTINES --- GROUP, NOGROUP
;HERE TO ENTER A SPECIAL SUB-FORUM GROUP FOR PRIVATE CONVERSATIONS
GRPCOM: PUSHJ P,GETSIX ;GET SIXBIT ARG INTO T1
MOVEM C,SAVCHR ;UPDATE COMMAND SCANNER
JUMPN T1,DOGRP4 ;HANDLE CHANGE IF GIVEN
MOVEI M,[ASCIZ/<You are not in a sub-FORUM group>/]
SKIPN T1,ID$GRP(ID) ;IF NO SPEC FOR GROUP,
PJRST LINOUT ; DO ABOVE MESSAGE
MOVEM T1,SIX ;ELSE LOAD SIXBIT NAME
AOJE T1,LINOUT ;FORCE MODE IS NOT A GROUP
PUSHJ P,MODIFY ;WITH CONSTANT HISEG INTERLOCK
PUSHJ P,DOGRP ;TYPE NAME OF THOSE IN GROUP
PJRST FINLIN ;FINISH LINE IF HAD SOME
MOVEI M,[ASCIZ/<No one else is in the group /]
PUSHJ P,STROUT ;DO THIS IF NO OTHERS FOUND
PUSHJ P,SXSOUT ;TYPE NAME OF GROUP IN SIX
PJRST FINLIN ;FINISH LINE AND RETURN
;THIS SUBROUTINE IS UNDER THE HISEG INTERLOCK
DOGRP: TXO F,F.SRR ;REQUEST SKIP IF NONE FOUND
MOVEI X,FORUM ;LOAD STARTING PLACE OF LIST
DOGRP1: HRRZ X,(X) ;PICK UP AN ID BLOCK ADDRESS
SKIPN X ;IF REACHED END OF THE LIST,
JRST DOGRP3 ; GO FIGURE OUT THE RETURN
CAIN X,(ID) ;IF WE HIT OUR OWN ID BLOCK,
JRST DOGRP1 ; THEN JUST GO ON TO NEXT
MOVE T1,ID$GRP(X) ;LOAD THIS GUY'S GROUP SPEC
CAME T1,ID$GRP(ID) ;IF IT DOESN'T MATCH OURS,
JRST DOGRP1 ; THEN SKIP AND GET NEXT
TXZN F,F.SRR ;IF THIS ISN'T THE FIRST ONE,
JRST DOGRP2 ; THEN JUMP AHEAD FOR COMMA
MOVEI M,[ASCIZ/<Others in the group /]
PUSHJ P,STROUT ;HERE IF FIND FIRST MEMBER
PUSHJ P,SXSOUT ;OUTPUT NAME OF THE GROUP
SKIPA C,[EXP ":"] ;LOAD UP A COLON AND SKIP
DOGRP2: MOVEI C,"," ;HERE FOR SUCCESSIVE NAME
PUSHJ P,CHROUT ;SEND CHARACTER TO OUTPUT
PUSHJ P,SPCOUT ;STICK IN SEPARATING SPACE
MOVEI M,ID$NN1(X) ;LOAD ADDRESS OF NICK-NAME
PUSHJ P,STROUT ;AND TYPE OUT THE INFO
JRST DOGRP1 ;LOOP BACK UNTIL DONE
DOGRP3: TXZE F,F.SRR ;IF NO ONE FOUND IN GROUP,
AOS (P) ; THEN DO THE SKIP RETURN
POPJ P, ;RETURN TO GRPCOM ROUTINE
;HERE WHEN A CHANGE OF SUB-FORUM GROUP IS REQUESTED
DOGRP4: PUSH P,T1 ;SAVE THE NEW GROUP NAME
SKIPE ID$GRP(ID) ;IF ALREADY IN A GROUP,
PUSHJ P,NGRCOM ; THEN GO REMOVE US
POP P,T1 ;RECOVER SAVED GROUP
MOVEM T1,ID$GRP(ID) ;ENTER NEW SPEC IN ID
MOVEM T1,SIX ;PUT NAME IN SIXBIT BUF
MOVEI M,[ASCIZ/<You have entered the group /]
PUSHJ P,STROUT ;TYPE OUT HELPFUL MESSAGE
PUSHJ P,SXSOUT ;TYPE OUT THE GROUP NAME
PUSHJ P,FINLIN ;DO CLOSE BRKT AND CRLF
MOVEI M,[ASCIZ/ has joined the group>/]
PUSHJ P,MODIFY ;GET THE HISEG INTERLOCK
PUSHJ P,NOTIFY+1 ;GO INFORM THE APPROPRIATE
POPJ P, ;AND RETURN TO CALLER
;HERE TO LEAVE A SPECIAL SUB-FORUM GROUP
NGRCOM: MOVEI M,[ASCIZ/<You were not in a sub-FORUM group>/]
SKIPN T1,ID$GRP(ID) ;IF NOT IF A FORUM GROUP,
PJRST LINOUT ; TYPE MESSAGE AND RETURN
MOVEM T1,SIX ;PUT NAME IN SIXBIT BUFFER
AOJE T1,NGRCO1 ;NO MESSAGES IF HAD FORCE
MOVEI M,[ASCIZ/<You have left the group /]
PUSHJ P,STROUT ;TYPE OUT EXIT MESSAGE
PUSHJ P,SXSOUT ;TYPE NAME OF THE GROUP
PUSHJ P,FINLIN ;FINISH END OF THE LINE
MOVEI M,[ASCIZ/ has left the group>/]
PUSHJ P,MODIFY ;ELSE REQUEST THE INTERLOCK
PUSHJ P,NOTIFY+1 ;INFORM THOSE IN THE GROUP
NGRCO1: SETZM ID$GRP(ID) ;CLEAR OUT OUR GROUP NAME
POPJ P, ;AND RETURN TO CALLER
SUBTTL SPECIAL COMMAND ROUTINES --- FORCE, NOFORCE, IGNORE
;HERE TO ENTER PRIVILEGED FORCE MODE FOR SENDING AND RECEIVING MESSAGES
FORCOM: HRRZ T1,ID$PPN(ID) ;LOAD OUR PROGRAMMER NUMBER
MOVEI M,[ASCIZ/<Sorry, Luke>/];STRICTLY FOR STAR WARS FANS
CAIE T1,PRVPRG ;IF WE'RE NOT THE PRIV ONE,
PJRST LINOUT ; THEN WE LOSE WITH MESSAGE
SKIPE ID$GRP(ID) ;ELSE IF ALREADY IN A GROUP,
PUSHJ P,NGRCOM ; THEN REMOVE OURSELVES
SETOM ID$GRP(ID) ;BEAT OUT DARTH VADER
MOVEI M,[ASCIZ/<Use the Force, Luke>/]
PJRST LINOUT ;TYPE LINE AND RETURN
;HERE TO LEAVE THE PRIVILEGED FORCE MODE
NFRCOM: PJRST NGRCOM ;DO SAME ROUTINE AS NOGROUP
;HERE TO SET UP ID OF FORUM MEMBER FROM WHICH MESSAGES ARE IGNORED
IGNCOM: SKIPN NAMBUF ;IF NO ARGUMENT WAS GIVEN,
JRST IGNCO1 ; THEN REMOVE THE CONDITION
MOVEI A,DOIGN ;LOAD ADDRESS OF BELOW ROUTINE
PUSHJ P,MODIFY ;REQUEST MODIFICATION INTERLOCK
PUSHJ P,SEARCH ;DO A FORUM SCAN FOR NICK-NAME
POPJ P, ;RETURN IF DONE OR NO MATCH
TXNE F,F.LOG ;OTHERWISE, WANTED SELF
OFFLOG ;DON'T DO OUTPUT TO LOG
MOVEI M,[ASCIZ/<You just can't ignore yourself>/]
PJRST LINOUT ;TYPE MESSAGE AND RETURN
IGNCO1: SETZ X, ;WANT TO SET DATA TO ZERO
EXCH X,IGNRID ;LOAD OLD ADR AND CLEAR
MOVEI M,[ASCIZ/<No one is being ignored>/]
JUMPE X,LINOUT ;JUST TYPE LINE AND RETURN
MOVEI M,[ASCIZ/<Ignoring of /];LOAD ADR OF FRONT TEXT
PUSHJ P,STROUT ;SEND IT TO THE OUTPUT
MOVEI M,ID$NN1(X) ;LOAD ADR OF NICK-NAME
PUSHJ P,STROUT ;HOPEFULLY STILL THERE
MOVEI M,[ASCIZ/ is now terminated>/]
PJRST LINOUT ;FINISH LINE AND RETURN
DOIGN: HRRZM X,IGNRID ;SAVE ID BLOCK ADR OF MATCH
MOVE N,ID$JOB(X) ;LOAD JOB NUMBER OF THIS GUY
MOVEI M,[ASCIZ/<Now ignoring job # as /]
PUSHJ P,ACTOUT ;TYPE OUT TEXT AND JOB NUM
MOVEI M,ID$NN1(X) ;LOAD ADR OF THEIR NAME
PUSHJ P,STROUT ;SEND IT TO OUTPUT STREAM
PJRST FINLIN ;FINISH LINE AND RETURN
SUBTTL SUBROUTINES NEEDED BY SPECIAL COMMAND ROUTINES
;SUBROUTINE TO SEARCH THE FORUM FOR THE SPECIFIED NAME IN NAME BUFFER.
; THIS ROUTINE PUSHJ'S TO THE SUBROUTINE WHOSE ADDRESS IS IN "A"
; FOR EVERY SUCCESSFUL MATCH WHILE PROVIDING THE CORRESPONDING
; ID BLOCK ADDRESS IN "X" AND THE NICK-NAME ADDRESS IN "M". IF
; THE NAME "ALL" IS USED, A CALL IS GENERATED FOR EVERY FORUM
; MEMBER BESIDES SELF. IF NO CALL HAS BEEN DONE FOR A COMPLETE
; SCAN, AN APPROPRIATE MESSAGE IS TYPED. IN THE ABOVE CASES, THE
; NON-SKIP RETURN IS TAKEN. IF THE FIRST WORD OF NAMBUF IS ZERO,
; OR IF NO MATCH HAS BEEN FOUND FOR OUR NAME, "ME", OR "SELF",
; THEN THE SKIP RETURN IS TAKEN WITH THE USER'S ID BLOCK ADDRESS
; IN "X". THIS ROUTINE MUST BE CALLED UNDER THE HISEG INTERLOCK!
;CALL WITH:
; <PARSED NAME IN NAMBUF>
; MOVEI A,<OUTPUT ROUTINE ADDRESS>
; PUSHJ P,MODIFY
; PUSHJ P,SEARCH
; RETURN HERE IF NAME(S) MATCHED OR NOT
; RETURN HERE IF NO NAME OR SELF IMPLIED
;
SEARCH: MOVEI X,(ID) ;LOAD UP OUR FORUM LINK
SKIPN NAMBUF ;IF NO NAME IS SPECIFIED,
JRST CPOPJ1 ; DO SKIP RETURN FOR SELF
TXO F,F.SRR ;ASSUME WE'LL NOT FIND MATCH
MOVE T1,[ASCIZ/ALL/] ;LOAD NAME SPEC FOR EVERYONE
CAMN T1,NAMBUF ;IF USER HAS SPECIFIED ALL,
TXOA F,F.ALL ; THEN SET FLAG FOR MATCH
TXZ F,F.ALL ; ELSE CLEAR SAID FLAG
MOVEI X,FORUM ;START WITH FORUM ORIGIN ADR
SEARC1: HRRZ X,(X) ;ADVANCE THROUGH FORUM LIST
SKIPN X ;IF END OF THE LIST IS FOUND,
JRST SEARC2 ; THEN WE'RE DONE WITH SCAN
CAIN X,(ID) ;IF WE'VE COME AROUND TO SELF,
JRST SEARC1 ; JUST IGNORE AND CONTINUE
MOVEI T1,ID$NN1(X) ;LOAD ADDRESS OF THIS NAME
TXNN F,F.ALL ;IF WE'RE DOING ALL IN FORUM,
PUSHJ P,NMATCH ;OR THIS NAME MATCHES REQUEST,
TXZA F,F.SRR ; THEN CANCEL SKIP AND SKIP
JRST SEARC1 ; ELSE JUST CONTINUE SCAN
MOVEI M,ID$NN1(X) ;LOAD ADDRESS OF THIS NAME
PUSHJ P,(A) ;DO SPECIFIED OUTPUT ROUTINE
JRST SEARC1 ;AND CONTINUE FORUM SEARCH
SEARC2: TXNN F,F.SRR ;IF WE FOUND AT LEAST ONE,
POPJ P, ; THEN WE'RE ALL DONE
MOVEI X,(ID) ;ELSE LOAD ID BLOCK ADR
MOVEI T1,ID$NN1(X) ;LOAD ADDRESS OF OUR NAME
PUSHJ P,NMATCH ;SEE IF WE MATCH OURSELF
JRST CPOPJ1 ;DO SKIP RETURN IF WE DO
MOVE T1,NAMBUF ;LOAD FIRST WORD OF NAME
CAME T1,[ASCIZ/ME/] ;IF USER TYPED "ME",
CAMN T1,[ASCIZ/SELF/] ;OR HE/SHE TYPED "SELF",
JRST CPOPJ1 ; THEN DO SKIP RETURN
TXNE F,F.LOG ;OTHERWISE, NO MATCH IS MADE
OFFLOG ;SO TURN OFF LOG IF WAS ON
MOVEI M,[ASCIZ/<There is no one else in the FORUM>/]
TXNE F,F.ALL ;IF WE WERE LOOKING FOR ALL,
PJRST LINOUT ; TYPE MESSAGE AND RETURN
MOVEI M,[ASCIZ/<There is no one in the FORUM by the name of /]
PUSHJ P,STROUT ;TYPE OUT MESSAGE BODY
MOVEI M,NAMBUF ;LOAD ADDRESS OF NAME
PUSHJ P,STROUT ;TYPE OUT REQUESTED NAME
PJRST FINLIN ;FINISH LINE AND RETURN
;SUBROUTINE TO SEE IF THE NAME IN NAMBUF MATCHES THE NAME STARTING AT
; THE ADDRESS IN T1. THE NON-SKIP RETURN IS TAKEN IF A PERFECT
; MATCH IS FOUND, OTHERWISE THE SKIP RETURN IS TAKEN. NORMALLY
; USED UNDER THE HISEG INTERLOCK AND EXPECTED TO PRESERVE AC'S
; "A" AND "X".
;
NMATCH: SKIPA T2,[XWD -NAMSIZ,0] ;LOAD AOBJ POINTER TO NAMBUF
AOJ T1, ;INCREMENT PNTR UNLESS 1ST TIME
MOVE T3,(T1) ;LOAD NAME WORD FROM ID BLOCK
CAME T3,NAMBUF(T2) ;IF THIS WORD DOESN'T MATCH,
JRST CPOPJ1 ; THEN DO A SKIP RETURN
AOBJN T2,NMATCH+1 ;OTHERWISE, TRY NEXT WORD
POPJ P, ;OR WE'VE GOT IT IF NO MORE
;SUBROUTINE TO FIND NUMBER OF JIFFIES THERE ARE IN A SECOND AND PUT THE
; RESULT INTO JIFSEC AND N. THIS ROUTINE MUST BE CALLED AFTER THE
; HIGH SEGMENT HAS BEEN UN-WRITE-PROTECTED.
;CALL WITH:
; SKIPN N,JIFSEC
; PUSHJ P,SETJIF
; RETURN IS ALWAYS HERE WITH VALUE IN N
;
SETJIF: MOVE N,[EXP %CNTIC] ;GET NUMBER OF TICKS PER SEC
GETTAB N, ;FROM CONFIGURATION TABLE
SETZ N, ;PROTECT AGAINST IMPOSSIBLE
SKIPN N ;IF TABLE NOT DEFINED,
MOVEI N,^D60 ; USE THE DEFAULT VALUE
MOVEM N,JIFSEC ;STORE FOR OTHER JOBS
POPJ P, ;AND RETURN
;PROCEDURE TO HELP FINISH MESSAGES FROM THE FORUM PROGRAM.
;
FINLIN: MOVEI C,">" ;LOAD A CLOSE ANGLE BRACKET
PUSHJ P,CHROUT ;OUTPUT THE TAIL CHARACTER
PJRST CLFOUT ;FINISH LINE AND RETURN
SUBTTL SUBROUTINES FOR GETTING INPUT TEXT FROM TTY
;HERE TO SKIP AFTER GETTING LINE OF TEXT OR RETURN NORMAL
GETLNS: MOVSI Q,INPUTQ ;LOAD ADR OF QUEUE HEADER
GETLS: INCHSL C ;IF THERE'S NO LINE THERE,
POPJ P, ; JUST RETURN NON-SKIP
PUSHJ P,IFBRKC ;IF WE'VE GOT A BREAK CHAR,
JRST CPOPJ1 ; DO A SKIP RETURN BACK
PUSHJ P,PUTQUE ;OTHERWISE, PUT IT IN QUEUE
CAIA ; SKIP IF BUFFER OVERFLOW
JRST GETLS ;ELSE GET NEXT CHAR IN LINE
QRSET Q,INPUTQ ;HERE TO WIPE THE INPUT QUEUE
QPERR ;CHECK FOR ANY QPACK ERRORS
POPJ P, ;DO ERROR RETURN BACK
;HERE TO WAIT FOR LINE OF TEXT FROM TTY
GETLNW: QRSET Q,INPUTQ ;RESET THE INPUT QUEUE
QPERR ;OFF TO HANDLE ERROR
GETLW: INCHWL C ;WAIT FOR LINE READY
PUSHJ P,IFBRKC ;IF WE'VE GOT A BREAK CHAR,
POPJ P, ; THEN WE'RE ALL DONE
PUSHJ P,PUTQUE ;OTHERWISE, PUT IT IN QUEUE
JRST GETLNW ;DO RESET IF INPUT OVERFLOW
JRST GETLW ;ELSE GET NEXT CHAR IN LINE
;HERE TO PUT A CHARACTER IN THE INPUT QUEUE RETURNING SKIP IF NO ERROR
PUTQUE: CAIGE C,40 ;IF WE DON'T HAVE A CONTROL CHAR,
CAIN C,.CHTAB ;OR THE CONTROL CHAR IS A TAB,
CAIA ; THEN SKIP TO PUT CHAR IN QUEUE
JRST CPOPJ1 ; ELSE IGNORE IT AND GET NEXT
QPUSH Q,C ;HERE TO STORE CHAR IN QUEUE
CAIA ;(SKIP IF ERROR)
JRST CPOPJ1 ;SKIP RETURN FOR NEXT CHAR
QPERR ;DO QPACK ERROR IF NOT OVERFLOW
MOVEI T1,'IBO' ;ELSE INPUT BUFFER OVERFLOW
HRRM T1,ERR ;LOAD SIXBIT ERROR CODE
MOVEI N,INQSIZ*5 ;LOAD MAX CHARS IN INPUT QUEUE
MOVEI M,IBOMSG ;LOAD MESSAGE WITH ACTION CHARS
PUSHJ P,ACTOUT ;TYPE OUT INFORMATIVE WARNING
CLRBFI ;WIPE OUT THE INPUT BUFFER
TXZ F,F.GTO!F.NLR ;AND CLEAR RELEVANT FLAGS
POPJ P, ;DO THE ERROR RETURN
IBOMSG: ASCIZ/% Input overflow -- please retype line of under # character$_*/
;SUBROUTINE TO FIND THE FIRST/NEXT NON-SPACE CHARACTER IN THE INPUT QUEUE.
; THE SKIP RETURN WITH THE CHARACTER IN "C" IS ALWAYS TAKEN UNLESS
; THE QUEUE IS EMPTIED, IN WHICH CASE "C" IS SET TO ZERO.
;
GETNSC: PUSHJ P,GETCHR ;GET CHAR FROM QUEUE OR RETURN
CAIE C,40 ;IF WE'VE GOT A SPACE,
CAIN C,.CHTAB ;OR WE'VE GOT A TAB,
JRST GETNSC ; LOOP BACK FOR NEXT CHAR
JRST CPOPJ1 ;ELSE DO A SKIP RETURN
;SUBROUTINE TO LOOK FOR A LETTER OR DIGIT IN THE INPUT QUEUE, CONVERTING
; LOWER CASE TO UPPER CASE. FOR A NORMAL CALL, A SKIP RETURN IS
; GIVEN ONLY IF THE NEXT CHARACTER IS A LETTER OR DIGIT. FOR AN
; OFFSET CALL (+1), LEADING SPACES AND TABS ARE IGNORED. IN EITHER
; CASE, THE NEXT NON-SPACE CHARACTER IS RETURNED IN "C", UNLESS THE
; QUEUE IS EMPTY, IN WHICH CASE "C" IS CLEARED.
;
GETLOD: TXZA F,F.ILS ;WATCH LEADING SPACES FOR NORMAL CALL
TXO F,F.ILS ;IGNORE THEM FOR OFFSET CALL (+1)
TXO F,F.SRR ;REQUEST A SKIP RETURN
GETLO1: PUSHJ P,GETCHR ;GET CHAR FROM QUEUE OR RETURN
PUSHJ P,CONVLC ;CONVERT LC LETTERS TO UC
CAIL C,"A" ;IF IT'S UNDER AN A,
CAILE C,"Z" ;OR IT'S OVER A Z,
CAIA ; THEN SKIP TO TEST FOR DIGIT
JRST GETLO2 ; ELSE WE'VE GOT WHAT WE WANT
CAIL C,"0" ;IF CHAR'S UNDER A ZERO,
CAILE C,"9" ;OR CHAR'S OVER A NINE,
JRST GETLO3 ; THEN WE DON'T WANT IT
GETLO2: TXZE F,F.SRR ;IF A SKIP RETURN IS REQUESTED,
AOS (P) ; THEN INCREMENT RETURN ADR
POPJ P, ;RETURN EITHER WAY
GETLO3: CAIE C,40 ;IF WE'VE GOT A SPACE,
CAIN C,.CHTAB ;OR WE'VE GOT A TAB,
CAIA ; SKIP THE ERROR RETURN
POPJ P, ; ELSE RETURN WITH THIS CHAR
TXNN F,F.ILS ;UNLESS IGNORING LEADING SPACES,
TXZ F,F.SRR ; CANCEL REQUEST FOR SKIP RETURN
JRST GETLO1 ;LOOP FOR NEXT NON-SPACE CHARACTER
;SUBROUTINE TO LOOK FOR AN OCTAL DIGIT IN THE INPUT QUEUE. FOR A NORMAL
; CALL, A SKIP RETURN IS GIVEN ONLY IF THE NEXT CHARACTER PASSES.
; FOR AN OFFSET CALL (+1), LEADING SPACES AND TABS ARE IGNORED. IN
; EITHER CASE, THE NEXT NON-SPACE CHARACTER IS RETURNED IN "C",
; UNLESS THE QUEUE IS EMPTY, IN WHICH CASE "C" IS CLEARED.
;
GETOCT: TXZA F,F.ILS ;WATCH LEADING SPACES FOR NORMAL CALL
TXO F,F.ILS ;IGNORE THEM FOR OFFSET CALL (+1)
TXO F,F.SRR ;REQUEST A SKIP RETURN FOR EXIT
GETOC1: PUSHJ P,GETCHR ;GET CHAR FROM QUEUE OR RETURN
CAIL C,"0" ;IF IT'S UNDER A ZERO,
CAILE C,"7" ;OR IT'S OVER A SEVEN,
JRST GETOC2 ; THEN IT DOESN'T PASS
TXZE F,F.SRR ;IF A SKIP RETURN IS REQUESTED,
AOS (P) ; INCREMENT RETURN ADDRESS
POPJ P, ;RETURN EITHER WAY
GETOC2: CAIE C,40 ;IF WE'VE GOT A SPACE,
CAIN C,.CHTAB ;OR WE'VE GOT A TAB,
CAIA ; SKIP THE ERROR RETURN
POPJ P, ; ELSE RETURN WITH THIS CHAR
TXNN F,F.ILS ;UNLESS IGNORING LEADING SPACES,
TXZ F,F.SRR ; CANCEL REQUEST FOR SKIP RETURN
JRST GETOC1 ;LOOP FOR NEXT NON-SPACE CHARACTER
;SUBROUTINE TO UNLOAD ONE CHARACTER FROM INPUT QUEUE INTO "C" AND RETURN
; NON-SKIP. IF THE QUEUE IS EMPTY, THIS ROUTINE POPS THE RETURN OFF
; THE STACK, CLEARS "C", AND DOES A NON-SKIP RETURN TO THE CALLER OF
; THE ROUTINE THAT CALLED THIS ROUTINE. QPACK ERRORS ARE ROUTED TO
; THE QPACK ERROR HANDLER, DIRECTLY.
;
GETCHR: MOVSI Q,INPUTQ ;LOAD THE INPUT QUEUE HEADER ADR
QPULL Q,C ;UNLOAD ONE CHARACTER FROM BOTTOM
TDZA C,C ;CLEAR PREVIOUS CHAR IF CAN'T
POPJ P, ;DO STRAIGHT RETURN IF GOT IT
QPERR ;CHECK FOR TRUE QPACK ERRORS
POP P,(P) ;UNLOAD LAST LEVEL OF CALL
POPJ P, ;RETURN TO CALLER OF CALLER
;SUBROUTINE TO GET A NICK-NAME SPECIFICATION FROM THE INPUT QUEUE. IT
; SHOULD BE CALLED WITH THE FIRST CHARACTER (WHICH NEED NOT BE
; VALIDATED) IN "C". THE COMPLETE NAME IS PUT IN "NAMBUF" AND
; THE FIRST UNALLOWABLE CHARACTER FOR NICK-NAMES IS LEFT IN "C"
; (0 IF THE QUEUE IS EMPTIED). NAME CHARACTERS ARE UPPER CASE
; LETTERS, DIGITS, AND SPACES. LOWER CASE LETTERS ARE CONVERTED
; TO UPPER CASE AND TABS ARE CONVERTED TO SPACES. CONSECUTIVE
; SPACES ARE NOT STORED. THIS ROUTINE NEVER GIVES A SKIP RETURN.
; TESTING THE FIRST NAMBUF WORD FOR ZERO SOULD BE USED TO TELL IF
; A NAME WAS PROCESSED.
;
GETNAM: SETZM NAMBUF ;CLEAR THE NAME BUFFER
MOVE T1,[XWD NAMBUF,NAMBUF+1];PROPAGATE ZERO WORDS
BLT T1,NAMBUF+NAMSIZ ;TO CLEAR WHOLE THING
PUSHJ P,CONVLC ;CONVERT LC LETTERS TO UC
CAIL C,"A" ;IF CHAR IS UNDER AN A,
CAILE C,"Z" ;OR CHAR IS OVER A Z,
CAIA ; THEN TRY FOR A DIGIT
JRST GETNA1 ; ELSE PROCEED WITH NAME
CAIL C,"0" ;IF CHAR IS UNDER A ZERO,
CAILE C,"9" ;OR CHAR IS OVER A NINE,
CAIA ; THEN IT'S NO GOOD
JRST GETNA1 ;OTHERWISE, GO AHEAD
CAIE C,40 ;BUT IF WE'VE GOT A SPACE,
CAIN C,.CHTAB ;OR WE'VE GOT A TAB,
CAIA ; THEN IGNORE THE CHAR
POPJ P, ;OTHERWISE, DO ERROR RETURN
PUSHJ P,GETLOD+1 ;GET CHAR IGNORING LEADING SEPS
POPJ P, ;RETURN WITH PASSED ERROR CHAR
GETNA1: MOVE T1,[POINT 7,NAMBUF] ;LOAD BYTE POINTER TO DEST
MOVEI T2,NAMSIZ*5 ;LOAD MAX NUMBER OF CHARS
GETNA2: SOSL T2 ;AS LONG AS STILL ROOM,
IDPB C,T1 ; PUT CHAR IN NAME BUFFER
PUSHJ P,GETLOD ;GET ANOTHER LETTER OR DIGIT
CAIA ;SKIP IF NEXT CHAR ISN'T
JRST GETNA2 ;OTHERWISE, LOOP FOR STORE
CAIL C,"A" ;IF NEXT NON-SPACE CHAR
CAILE C,"Z" ;ISN'T BETWEEN A AND Z,
CAIA ; THEN SKIP TO TRY FOR DIGIT
JRST GETNA3 ; ELSE PUT IN NAME AFTER SPACE
CAIL C,"0" ;IF THE CHAR IS UNDER A ZERO,
CAILE C,"9" ;OR THE CHAR IS OVER A NINE,
POPJ P, ; THEN RETURN WITH IT IN C
GETNA3: MOVEI T3,40 ;ELSE LOAD SUPPRESSED SPACE
SOSL T2 ;AS LONG AS STILL ROOM,
IDPB T3,T1 ; PUT THE SPACE IN NAME
JRST GETNA2 ;LOOP TO CONTINUE WITH NAME
;SUBROUTINE TO GET A SIXBIT INPUT STRING FROM THE INPUT QUEUE. IT SHOULD
; BE CALLED WITH THE FIRST CHARACTER (WHICH NEED NOT BE VALIDATED) IN
; "C". THE FIRST SIX CONSECUTIVE LETTERS OR DIGITS ARE PUT IN SIXBIT
; FORMAT INTO "T1" AND THE FIRST UNALLOWABLE NON-SPACE NON-TAB CHAR-
; ACTER IS LEFT IN "C". THIS ROUTINE NEVER GIVES A SKIP RETURN. THE
; PARSING OF THE STRING CAN BE TESTED BY SEEING IF T1 CONTAINS ZERO.
;
GETSIX: SETZ T1, ;CLEAR OUT THE WORKING SPACE
PUSHJ P,CONVLC ;FORCE LETTERS TO UPPER CASE
CAIL C,"A" ;IF CHAR IS UNDER AN A,
CAILE C,"Z" ;OR CHAR IS OVER A Z,
CAIA ; THEN TRY FOR A DIGIT
JRST GETSI1 ; ELSE WE'VE GOT SOMETHING
CAIL C,"0" ;IF CHAR IS UNDER A ZERO,
CAILE C,"9" ;OR CHAR IS OVER A NINE,
POPJ P, ; THEN RETURN EMPTY T1
GETSI1: MOVE T2,[POINT 6,T1] ;LOAD SIXBIT BYTE POINTER
MOVEI T3,6 ;LOAD MAXIMUM CHAR COUNT
GETSI2: SOJL T3,GETSI3 ;AS LONG AS STILL ROOM,
SUBI C,40 ;CONVERT CHARACTER TO SIXBIT
IDPB C,T2 ;DEPOSIT IT INTO ACCUMULATOR
GETSI3: PUSHJ P,GETLOD ;GET NEXT LETTER OR DIGIT
POPJ P, ;ALL DONE IF NEXT ISN'T
JRST GETSI2 ;ELSE LOOP BACK FOR STORE
SUBTTL MISCELLANEOUS CHARACTER HANDLING ROUTINES
;SUBROUTINE TO CHECK FOR A BREAK CHARACTER IN "C" GIVING A NON-SKIP
; RETURN IF FOUND AND A SKIP RETURN IF NOT. IF THE CHAR IS A
; CONTROL-Z (OR CONTROL-C), THE EXIT FLAG IS SET.
;
IFBRKC: CAIL C,.CHLFD ;IF IT'S BETWEEN A LINE FEED,
CAILE C,.CHFFD ;AND A FORM FEED,
CAIN C,.CHESC ; OR IT'S AN ESCAPE,
POPJ P, ; THEN IT IS A BREAK CHAR
CAIN C,.CHBEL ;IF THE CHAR IS A CNTL-G,
POPJ P, ; THEN WE'VE GOT A BREAK
CAIE C,.CHCNZ ;IF IT'S A CNTL-Z (EOF),
CAIN C,.CHCNC ;OF CNTL-C (ONLY IF JACCT),
TXOA F,F.XIT ; MARK BREAK AND EXIT
AOS (P) ; ELSE DO A SKIP RETURN
POPJ P, ;DO THE APPROPRIATE RETURN
;SUBROUTINE TO CONVERT "C" TO UPPER CASE IF IT CONTAINS A LOWER CASE LETTER.
;
CONVLC: CAIL C,"A"+40 ;IF CHAR IS UNDER A LC A,
CAILE C,"Z"+40 ;OR CHAR IS OVER A LC Z,
POPJ P, ; THEN JUST RETURN
SUBI C,40 ;OTHERWISE, DO CONVERSION
POPJ P, ;AND THEN RETURN
;SUBROUTINES TO DEPOSIT CHARACTERS ACCORDING TO BYTE POINTER IN P1.
;
PUTNAM: HRLI A,(POINT 7,) ;MAKE POINTER TO OUR NAME
MOVEI T1,NAMSIZ*5 ;LOAD MAXIMUM NAME LENGTH
ILDB C,A ;LOAD A CHAR FROM NAME
JUMPE C,CPOPJ0 ;NO MORE IF IT'S A NULL
PUSHJ P,PUTCHR ;DEPOSIT CHAR IN STRING
SOJG T1,.-3 ;LOOP IF MORE TO GO
POPJ P, ;OR RETURN IF ALL DONE
PUTSTR: HRLI M,(POINT 7,) ;MAKE M AN ILDB POINTER
ILDB C,M ;LOAD A BYTE FROM THE STRING
JUMPE C,CPOPJ0 ;RETURN IF IT'S THE FINAL NULL
PUSHJ P,PUTCHR ;OTHERWISE, PUT CHAR IN PLACE
JRST .-3 ;AND CONTINUE WITH NEXT BYTE
PUTOAB: MOVEI C,"<" ;LOAD AN OPEN ANGLE BRACKET
PJRST PUTCHR ;DEPOSIT CHAR AND RETURN
PUTCAB: MOVEI C,">" ;LOAD A CLOSE ANGLE BRACKET
PJRST PUTCHR ;DEPOSIT CHAR AND RETURN
PUTCLN: MOVEI C,":" ;LOAD A COLON
PJRST PUTCHR ;DO THE STUFF
PUTNUL: TDZA C,C ;SET FOR NULL
PUTSPC: MOVEI C," " ;DO A SPACE
PUTCHR: IDPB C,P1 ;PUT CHAR IN STRING
POPJ P, ;RETURN TO CALLER
SUBTTL ENTRANCE, EXIT, AND CONTROL-C INTERRUPT ROUTINES
;THIS ROUTINE MUST BE CALLED UNDER HISEG INTERLOCK
FENTER: MOVE A,[XWD ID$LEN,WRKBUF] ;PUT ID BLOCK IN WORK BUFFER
PUSHJ P,FC$SHR ;INTO HISEG FREE-CORE STORAGE
FCERR ;CHECK FOR FREE-CORE ERRORS
PUSH P,A ;SAVE STORAGE ADR OF ID BLOCK
MOVSI A,(A) ;ALSO MOVE INTO LEFT HALF OF A
HRRI A,FORUM ;WITH FIXED FORUM POST IN RIGHT
PUSHJ P,LL$APR ;APPEND US TO THE FORUM LIST
POP P,ID ;RECOVER ID BLOCK ADDRESS
MOVEM ID,SAVEID ;SAVE ID BLOCK ADR IN STOORAGE
AOS X,ENTERS ;INCREMENT AND LOAD ENTER INDEX
MOVEM X,ID$NDX(ID) ;STORE OUR INDEX IN ID BLOCK
MOVEI M,[ASCIZ/ has entered the FORUM>/]
MOVX T1,MS.NTY ;LOAD TYPE OF MESSAGE WE ARE
PUSHJ P,NOTIFY ;NOTIFY THE FORUM ABOUT US
POPJ P, ;RETURN TO MAIN PROGRAM
;THIS ROUTINE MUST BE CALLED UNDER HISEG INTERLOCK
FEXIT: MOVEI M,[ASCIZ/ has left the FORUM>/]
MOVX T1,MS.XIT ;SHOW TYPE OF MESSAGE BIT
PUSHJ P,NOTIFY ;TELL EVERYONE WE'RE GONE
MOVEI A,(ID) ;LOAD OUR ADR IN ARG PASSER
PUSHJ P,LL$REM ;GET OUT OF THE FORUM LIST
SETZM SAVEID ;CLEAR ADR TO SHOW NOT IN
FEXIT1: HRRZ X,ID$MLP(ID) ;LOAD OUR MESSAGE LIST POINTER
JUMPE X,FEXIT3 ;DONE IF LIST IS ALL GONE
PUSH P,MP$MBA(X) ;SAVE ADDRESS OF MESSAGE BLOCK
MOVEI A,(X) ;LOAD ADR OF MESSAGE POINTER
PUSHJ P,LL$REM ;REMOVE POINTER FROM OUR LIST
MOVEI A,(X) ;RELOAD ADR OF MESSAGE PNTR
POP P,T1 ;RECOVER ADR OF MESSAGE BLOCK
SOSG MB$CNT(T1) ;DECREMENT RECEIVER COUNT
JRST FEXIT2 ;EXPIRE MESSAGE IF WE'RE LAST
PUSHJ P,FC$DEL ;OTHERWISE, JUST DELETE POINTER
FCERR ;CHECK FOR FREE-CORE ERRORS
JRST FEXIT1 ;LOOP TO CLEAN OUT ALL MESSAGES
FEXIT2: PUSHJ P,EXPMSG ;HERE TO EXPIRE MESSAGE REF BY A
JRST FEXIT1 ;LOOP UNTIL ALL MESSAGES DUMPED
FEXIT3: MOVEI A,(ID) ;RELOAD OUR ID BLOCK ADR
PUSHJ P,FC$DEL ;FREE THE SPACE IN FREE-CORE
FCERR ;STILL CHECKING FOR ERRORS
SETZB Q,ID ;SHOW NORMAL QKILL AND NO ID
QKILL Q,INPUTQ ;KILL OFF THE QUEUE
JFCL ;IGNORING FAILURE
POPJ P, ;RETURN
;HERE FROM MONITOR ON USER CONTROL-C
CCINT: PUSH P,INTBLK+2 ;FIRST STACK INTERRUPTED LOC
SETZM INTBLK+2 ;RE-ENABLE FOR NESTED CNTL-C
TXO F,F.RCC ;SHOW RESPONSE IS REQUESTED
TXOE F,F.PCC ;IF CONTROL-C IS PROHIBITED,
POPJ P, ; RETURN TO IMPORTANT WORK
CCXIT: JRST DOEXIT+1 ;ELSE JUMP INTO EXIT ROUTINE
;HERE IF WE HAVE FOUND THAT WE ARE NOT IN THE FORUM LINKED LIST
REMOVE: PUSHJ P,CLFOUT ;GET ON A NEW LINE
MOVEI M,[ASCIZ/<You have been removed from the FORUM>/]
PUSHJ P,LINOUT ;EXPLAIN UNFORTUNATE SITUATION
;FALL THROUGH FOR EXIT STUFF
;HERE TO DO NORMAL EXIT PROCEDURE ON CONTROL-C, CONTROL-Z, OR /EXIT
DOEXIT: TXO F,F.PCC!F.RCC ;PROHIBIT CNTL-C UNTIL CLEARED
SKIPN ID,SAVEID ;IF NOT CURRENTLY IN FORUM,
JRST .+3 ; DON'T TRY TO GET OUT
PUSHJ P,MODIFY ;REQUEST HISEG INTERLOCK
PUSHJ P,FEXIT ;TO DO EXIT PROCEDURE
TXNE F,F.LOG ;IF A LOG FILE IS OPEN,
PUSHJ P,NLOCOM ; GO TRY TO CLOSE IT
MOVEI M,[ASCIZ/_Bye-bye_*/] ;LOAD SILLY MESSAGE
PUSHJ P,ACTOUT ;AND SAY GOOD-RIDDENS
EXIT 1, ;AND TO MONITOR WE GO
TXZ F,F.PCC!F.RCC ;CLEAR FLAGS IF USER CONTINUES
MOVEI M,[ASCIZ/Hello, again_*/];SHOW WE KNOW WHAT'S GOING ON
PUSHJ P,ACTOUT ;BY TYPING ANOTHER MESSAGE
JRST START+1 ;AND RESTART THE PROGRAM
;ROUTINE TO KEEP FORUM POSTED ON AN ENTRANCE OR EXIT. A MESSAGE CONSISTING
; OF AN OPEN ANGLE BRACKET FOLLOWED BY OUR NAME AND THE ASCIZ STRING
; (WHICH SHOULD END WITH A CLOSE ANGLE BRACKET) WHOSE ADDRESS IS SET
; UP IN M IS SENT TO ALL THE MEMBERS OF THE FORUM. NOTE THAT THIS
; ROUTINE IS CALLED WHILE UNDER THE HISEG MODIFICATION INTERLOCK.
; AN OFFSET CALL (+1) TO THIS ROUTINE PREVENTS MESSAGES FROM BEING
; EXPIRED TO THE OLD MESSAGE LIST AND FROM BEING FORCED TO ALL THOSE
; IN THE FORUM. A NORMAL CALL LOADS THE BITS IN THE LEFT OF T1 INTO
; THE MESSAGE STATUS FLAGS.
;
NOTIFY: TXOA F,F.FRC ;FLAG FOR EVERYONE TO KNOW
TXZ F,F.FRC ;CLEAR THE FLAG FOR OFFSET
PUSH P,T1 ;SAVE SPECIAL FLAGS IN TEMP
PUSHJ P,MSGHDR ;SET UP MESSAGE BLOCK HEADER
POP P,T1 ;RESTORE FLAGS FROM STACK
TXNN F,F.FRC ;IF THIS NOTE IS SUPPRESSED,
MOVX T1,MS.NOR ; THEN PREVENT ADD. TO OML
HLLZS T1 ;ZERO ANY GARBAGE IN RIGHT
IOR T1,WRKBUF+MB$SDR ;JOIN STATUS BITS WITH SENDER
TXNE F,F.FRC ;IF THIS IS A FORCED MESSAGE,
TXZ T1,MS.NOR ; THEN ALWAYS PUT IN OML
MOVEM T1,WRKBUF+MB$SDR ;PUT BACK THE SENDER WORD
PUSH P,P1 ;SAVE A SPECIAL SCRATCH AC
MOVE P1,[POINT 7,WRKBUF+MB$TXT];LOAD BYTE POINTER TO TEXT
PUSHJ P,PUTOAB ;PUT AN OPEN ANGLE BRACKET
MOVEI A,ID$NN1(ID) ;LOAD ADDRESS OF NICK-NAME
PUSHJ P,PUTNAM ;PUT OUR NAME INTO MESSAGE
PUSHJ P,PUTSTR ;PUT ENTER/EXIT STRING IN TOO
PUSHJ P,PUTNUL ;DON'T FORGET FINAL NULL BYTE
SUBI P1,WRKBUF ;FIND WORDS USED AFTER FIRST
MOVSI A,1(P1) ;LOAD BUFFER LENGTH IN LEFT
HRRI A,WRKBUF ;LOAD ADR OF BUFFER IN RIGHT
PUSHJ P,FC$SHR ;PUT MESSAGE BLOCK INTO STORAGE
FCERR ;CHECK FOR FREE-CORE ERRORS
SETZM WRKBUF ;CLEAR FIRST WORD OF WORK BUFFER
MOVEM A,WRKBUF+1 ;ENTER STORAGE ADR AND LENGTH
MOVEI P1,(A) ;LOAD MSG BLOCK ADR FOR SENALL
PUSHJ P,SENALL ;SEND ENTRY OR EXIT TO ALL
TXZ F,F.FRC ;RESET FORCE MESSAGE FLAG
POP P,P1 ;PRESERVE SPECIAL ACCUMULATOR
POPJ P, ;AND RETURN TO FENTER OR FEXIT
SUBTTL SUBROUTINE FOR PERSONAL INITIALIZATION
;HERE TO SET THIS JOB ALL UP
OWNINI: ONTTY ;ENTER TTY INTO OUTPUT LIST
OFFLOG ;CAN LOG IN CASE CONT FROM CNTL-C
MOVSI T1,PRGPFX ;PUT THE SIXBIT PROGRAM PREFIX
MOVEM T1,ERR ;IN LEFT OF ERROR CODE LOCATION
SETZB ID,SAVEID ;SHOW NO ID BEFORE CNTL-C TRAPS
SETZM ZFIRST ;CLEAR FIRST LOC OF INIT STORAGE
MOVE T1,[XWD ZFIRST,ZFIRST+1];BY TRANSFERRING UP ZERO WORDS
BLT T1,ZLAST ;CLEAR OUT SPECIAL STORAGE LOCS
;HERE TO SET UP CONTROL-C INTERCEPT AND REENTER ADDRESS
OWN1: MOVSI T1,[XWD 4,CCINT ;PICK UP ADR OF INT BLK INIT
XWD 0,ER.ICC ;IT'S SET UP FOR CONTROL-C
EXP 0,0] ;WITH ALL THE STANDARD STUFF
HRRI T1,INTBLK ;LOAD ADDRESS OF DESTINATION
BLT T1,INTBLK+3 ;TRANSFER OVER THE INFO
MOVEI T1,INTBLK ;LOAD ADDRESS OF INTRPT BLOCK
MOVEM T1,.JBINT ;PUT IT IN JOBDAT FOR CNTL-C TRAP
MOVEI T1,RERUN ;LOAD PLACE TO REENTER
HRRM T1,.JBREN ;PUT ADR IN JOB DATA
;HERE TO INITIALIZE LOW SEGMENT TEXT QUEUE
OWN2: SETOB T1,INPUTQ ;GUARANTEE NO INTERLOCK FAILURE
TLZ T1,770000 ;CLEAR STATUS BIT POSITIONS IN MASK
ANDM T1,INPUTQ+1 ;WIPE OUT QUEUE STATUS IN CASE CONT
SETZM INPUTQ+3 ;AND FORCE QPACK TO GET NEW QUEUE
MOVEI Q,.QZASC!INQSIZ ;IN ASCII MODE WITH QUEUE SIZE,
QINIT Q,INPUTQ ;INITIALIZE THE INPUT QUEUE
QPERR ; (CHECK FOR QPACK ERROR)
;HERE TO ATTEMPT A TMPCOR READ FOR NAME (AND/OR COMMANDS) IF CCL START
OWN3: TXNN F,F.CCL ;IF WE DIDN'T HAVE A CCL START,
JRST OWN4 ; THEN DON'T TRY TO READ TMPCOR
PUSHJ P,ZERWBF ;OTHERWISE, ZERO THE WORK BUFFER
MOVEI T1,[XWD TMPNAM,0 ;WITH THE SPECIFIED TMPFIL NAME
IOWD WRKSIZ,WRKBUF] ;AND CORRESPONDING BUFFER INFO
HRLI T1,.TCRRF ;WE WANT TO READ THE TMPCOR FILE
TMPCOR T1, ;SO ISSUE OUR REQUEST
JRST OWN4 ;MUST GET INFO ELSEWHERE
MOVE T1,[POINT 7,WRKBUF] ;LOAD ASCII POINTER FOR TMP FILE
OWN3A: ILDB C,T1 ;LOAD A CHAR FROM WORK BUFFER
JUMPE C,OWN5 ;DONE IF WE GET TRAILING NULL
PUSHJ P,IFBRKC ;IF IT'S SOMEHOW A BREAK CHAR,
JRST OWN5 ; IGNORE REST OF THE FILE
CAIGE C,40 ;AS LONG AS NO CONTROL CHAR,
CAIN C,.CHTAB ;OR THE CONTROL CHAR IS TAB,
CAIA ; THEN SKIP TO LOAD BYTE
JRST OWN3A ; ELSE IGNORE AND GET NEXT
QPUSH Q,C ;PUT CHAR IN INPUT QUEUE
QPERR ;CHECK FOR QPACK ERRORS
JUMPN Q,OWN3A ;LOOP IF QUEUE NOT FULL
JRST OWN5 ;OR DO LINE IF FELL THROUGH
;HERE TO CHECK FOR A FORUM.INI FILE AS ALTERNATE TO TTY INPUT
OWN4: TXNE F,F.FCO ;IF ALREADY USED FREE CHANNEL,
JRST OWN4A ; THEN DON'T WASTE BUFFER SPACE
MOVEI T1,.IOASC ;IN ASCII MODE,
MOVSI T2,FDCDEV ;TO DEVICE DISK,
MOVEI T3,FDCBRH ;WITH INBUT BUFFERS,
OPEN FDC,T1 ;OPEN FREE DISK CHANNEL
JRST OWN5 ;MUST GET INPUT FROM TTY
OWN4A: MOVE T1,[SIXBIT/FORUM/] ;LOAD THIS PROGRAM'S NAME
MOVSI T2,'INI' ;LOAD COMMAND EXTENSION
SETZB T3,T4 ;DEFAULT PPN AND STUFF
LOOKUP FDC,T1 ;SEE IF WE CAN FIND ONE
JRST OWN5 ;MUST USE TTY IF CAN'T
TXON F,F.FCO ;SHOW WE SET UP CHANNEL
INBUF FDC, ;SET UP BUFFERS IF WE DID
OWN4B: IN FDC, ;GET A BUFFER OF INPUT
CAIA ;SKIP IF WE GOT ONE
JRST OWN4D ;OTHERWISE, WE'RE DONE
OWN4C: SOSGE FDCBRH+2 ;DECREMENT BUFFER BYTE COUNT
JRST OWN4B ;GET NEXT BUFFER IF EMPTY
ILDB C,FDCBRH+1 ;LOAD A BYTE FROM BUFFER
JUMPE C,OWN4C ;IGNORE NULL BYTES
PUSHJ P,IFBRKC ;IF IT'S A BREAK CHARACTER,
JRST OWN4D ; THEN DON'T DO ANYMORE
CAIGE C,40 ;IF NOT A CONTROL CHAR,
CAIN C,.CHTAB ;OR IT'S A TAB CHAR,
CAIA ; SKIP TO PUT IN QUEUE
JRST OWN4C ; ELSE IGNORE IT
QPUSH Q,C ;PUT THE CHAR IN QUEUE
QPERR ;CHECK FOR ERROR CONDITION
JUMPN Q,OWN4C ;LOOP FOR NEXT CHARACTER
OWN4D: CLOSE FDC, ;HERE WHEN DONE OR QUEUE FULL
;FALL THROUGH TO OWN5
;HERE TO GET INPUT TEXT FROM USER AT TTY IF COULDN'T GET IT ELSEWHERE
OWN5: SETZ Q, ;CLEAR SPEC FOR QUEUE STATUS
QSTAT Q,INPUTQ ;FIND NUMBER OF BYTES USED
QPERR ;CHECK FOR QUEUE ERRORS
JUMPG Q,OWN6 ;AWAY IF ALREADY HAVE A LINE
SKPINC ;OTHERWISE, CLEAR CONTROL-O
JFCL ;IN CASE IT WAS ON (IGNORE SKIP)
PUSHJ P,CLFOUT ;NOW GET ON A NEW LINE
MOVEI M,[ASCIZ/FORUM -- A program for inter-terminal communication/]
PUSHJ P,LINOUT ;EXPLAIN OURSELVES TO USER
PUSHJ P,CLFOUT ;SKIP ONTO NEXT LINE
MOVEI M,[ASCIZ/Please enter your name (up to /]
PUSHJ P,STROUT ;TYPE FIRST PART OF PROMPT
MOVEI N,NAMSIZ*5 ;LOAD MAX NUMBER OF CHARS
MOVEI M,[ASCIZ/# character$/] ;LOAD SPECIAL ACTION STRING
PUSHJ P,ACTOUT ;TYPE CORRECT NUMBER OF CHARS
MOVEI M,[ASCIZ/): /] ;LOAD LAST PART OF MESSAGE
OWN5A: PUSHJ P,STROUT ;ASK USER FOR NICK-NAME
PUSHJ P,BRKOUT ;FORCE OUT THE TTY BUFFER
PUSHJ P,GETLNW ;WAIT FOR LINE OF INPUT
PUSHJ P,ZERWBF ;ZERO OUT THE WORK BUFFER
SETZ Q, ;USE ZERO ARGUMENT TO QWHRE
QWHRE Q,INPUTQ ;TO LOCATE BOTTOM OF QUEUE
QPERR ;QPACK ERROR CHECK
SKIPA T2,[POINT 7,WRKBUF] ;LOAD TEXT POINTER
OWN5B: IDPB C,T2 ;PUT CHARACTER IN BUFFER
QREAD Q,C ;READ A BYTE IN QUEUE
QPERR ;CHECK FOR TRUE ERROR
JUMPN Q,OWN5B ;DO NEXT UNLESS ALL DONE
IBP T2 ;INCREMENT THE BYTE POINTER
SUBI T2,WRKBUF ;FIND WORDS USED AFTER 1ST
MOVSI T2,1(T2) ;PUT TOTAL LENGTH INTO LEFT
MOVNS T2 ;CONVERT TO NEGATIVE LENGTH
HRRI T2,WRKBUF-1 ;PUT BUFFER ADR - 1 IN RIGHT
MOVSI T1,TMPNAM ;LOAD NAME OF TMPCOR FILE
MOVE T3,[XWD .TCRWF,T1] ;LOAD INFO FOR TMPCOR UUO
TMPCOR T3, ;WRITE TMPCOR FILE FOR USER
JFCL ;TOO BAD IF NO ROOM
;FALL THROUGH TO OWN6
;HERE TO PROCESS THE LINE OF NAME AND/OR COMMANDS FROM ANYWHERE
OWN6: PUSHJ P,GETNSC ;GET FIRST NON-SPACE CHAR
JRST OWN6D ;NO GO IF QUEUE IS EMPTY
PUSHJ P,GETNAM ;GET A NICK-NAME FROM QUEUE
JUMPE C,OWN6C ;CHECK NAME IF QUEUE EMPTIED
CAIN C,CMTCUE ;IF CHAR STARTS COMMENT FIELD,
JRST OWN6B ; THEN WIPE REST OF QUEUE
CAIN C,COMCUE ;IF CHAR MARKS A COMMAND,
JRST OWN6A ; THEN GO PROCESS SPECIAL
CLRBFI ;OTHERWISE, CLEAR TYPE AHEAD
QRSET Q,INPUTQ ;WIPE OUT THE INPUT QUEUE
QPERR ;CHECK FOR QPACK ERRORS
MOVEI M,[ASCIZ/
Only letters and spaces are allowed in names -- please retype: /]
JRST OWN5A ;EXPLAIN AND GET NEW NAME
OWN6A: PUSHJ P,DOCOM ;HERE TO HANDLE SPECIAL COMMAND
JRST OWN6C ;GO CHECK FOR NAME WHEN DONE
OWN6B: QRSET Q,INPUTQ ;CLEAN OUT INPUT QUEUE
QPERR ;CHECK FOR QPACK ERRORS
OWN6C: SKIPE NAMBUF ;IF A NAME WAS GIVEN,
JRST OWN7 ; GO SET UP ID BLOCK
OWN6D: CLRBFI ;CLEAR OUT INPUT BUFFER
MOVEI M,[ASCIZ/
A name is required to enter the FORUM -- still waiting: /]
JRST OWN5A ;TRY FOR ANOTHER NAME
;HERE TO SET UP THE ID BLOCK IN WORK BUFFER
OWN7: MOVEI X,WRKBUF ;LOAD ADDRESS OF WORK BUFFER
SETZM ID$LNK(X) ;CLEAR LINKAGE WORD
MOVSI T1,NAMBUF ;TRANSFERRING FROM NAMBUF
HRRI T1,ID$NN1(X) ;TO THE WORK BUFFER
BLT T1,ID$NN1+NAMSIZ-1(X) ;MOVE OVER ENTIRE NICK-NAME
PJOB T1, ;STORE OUR JOB NUMBER
HRRZM T1,ID$JOB(X) ;(MUST HAVE ZERO LEFT)
SETO T1, ;NEGATIVE MEANS OUR TTY
GETLCH T1 ;GET OUR TTY INDEX
SUBI T1,.UXTRM ;OBTAIN LINE NUMBER
HRRZM T1,ID$TTY(X) ;STORE IN ID BUFFER
GETPPN T1, ;PICK UP OUR PPN
JFCL ;(SILLY SKIP IF JACCT)
MOVEM T1,ID$PPN(X) ;STORE THIS, TOO
HRLZ T1,ID$JOB(X) ;GET JOB NUMBER FOR INDEX
HRRI T1,.GTNM1 ;TO FIRST HALF OF USER NAME
GETTAB T1, ;LOOK IT UP IN MONITOR TABLE
SETZ T1, ;USE NULL IF FAILED
MOVEM T1,ID$UN1(X) ;STORE IN ID BLOCK BUFFER
HRLZ T1,ID$JOB(X) ;DO THE SAME THING AGAIN
HRRI T1,.GTNM2 ;FOR SECOND HALF OF NAME
GETTAB T1, ;GET INFO FROM MONITOR
SETZ T1, ;NONE IF FAILED
MOVEM T1,ID$UN2(X) ;STORE THIS, TOO
MOVE T1,[EXP %NSUPT] ;WE ALSO WANT UPTIME IN JIFFIES
GETTAB T1, ;FROM SAME HANDY TABLES
SETZ T1, ;(SHOULDN'T FAIL)
MOVEM T1,ID$UPT(X) ;STORE ENTRY TIME
SETZM ID$NDX(X) ;DON'T SPECIFY ENTRY INDEX YET
MOVSI T1,PRFBUF ;TRANSFERRING FROM PRFBUF
HRRI T1,ID$PFF(X) ;TO THE WORK BUFFER
BLT T1,ID$PFF+PF$LEN-1(X) ;INSTALL 4-WORD PROFILE SPEC
SETZM ID$MLP(X) ;INIT MESSAGE LIST POINTER
SETZM ID$GRP(X) ;INIT SUB-FORUM GROUP SPEC
;HERE TO UN-WRITE-PROTECT OUR HIGH SEGMENT AND ANNOUNCE ENTRY
OWN8: SETZ T1, ;CLEAR A TEMP
SETUWP T1, ;GIVE US PRIV
JRST UWPERR ;(SO LONG)
SKPINC ;CLEAR ANY CONTROL-O
JFCL ;(JUST IN CASE ON)
PUSHJ P,CLFOUT ;START A NEW LINE
PUSHJ P,DLFOUT ;AND DROP DOWN A COUPLE MORE
MOVEI M,[ASCIZ/********** Welcome to the FORUM **********/]
PUSHJ P,STROUT ;TELL USER WHAT HE/SHE IS RUNNING
MOVEI M,[ASCIZ/ & +__*/];THAT'S 6 SPACES, DATE, TIME,
PUSHJ P,ACTOUT ;AND A DOUBLE CRILIF TO TTY
;FALL THROUGH FOR SWITCH.INI
;HERE TO PUT COMMANDS FROM A SWITCH.INI FILE INTO INPUT QUEUE
OWN9: TXNE F,F.FCO ;IF ALREADY USED CHANNEL,
JRST OWN9A ; DON'T WASTE BUFFER SPACE
MOVEI T1,.IOASC ;IN ASCII MODE,
MOVSI T2,FDCDEV ;TO DEVICE DISK,
MOVEI T3,FDCBRH ;WITH INPUT BUFFERS,
OPEN FDC,T1 ;OPEN FOR SWITCH.INI FILE
JRST OWNRET ;FORGET IT IF FAILURE
OWN9A: MOVE T1,[SIXBIT/SWITCH/] ;LOAD THE FILE NAME
MOVSI T2,'INI' ;AND ITS EXTENSION
SETZB T3,T4 ;USE USER'S PPN
LOOKUP FDC,T1 ;SEE IF HE/SHE HAS ONE
JRST OWNRET ;MOST NORMAL PEOPLE DON'T
TXON F,F.FCO ;FLAG USE OF FREE CHANNEL
INBUF FDC, ;SET UP BUFFERS IF FIRST USE
MOVSI Q,INPUTQ ;LOAD ADR OF INPUT QUEUE
OWN9B: MOVSI T1,-5 ;LOAD -LENGTH OF PROG NAME
OWN9C: PUSHJ P,OWN9J ;GET A CHARACTER IN LINE
CAME C,OWN9K(T1) ;TEST AGAINST OUR CHAR
JRST OWN9E ;TRY NEXT LINE IF NOT FOR US
AOBJN T1,OWN9C ;KEEP TESTING IF IT MATCHES
OWN9D: PUSHJ P,OWN9J ;GET 6TH CHAR IF MADE IT
PUSHJ P,IFBRKC ;IF IT'S A BREAK CHAR,
JRST OWN9B ; GO TRY ANOTHER LINE
CAIN C,COMCUE ;IF ITS THE COMMAND CUE,
JRST OWN9F ; GO START LOADING TEXT
CAIE C,40 ;IF IT'S A SPACE,
CAIN C,.CHTAB ;OR IT'S A TAB,
JRST OWN9D ; TRY NEXT IN LINE
OWN9E: PUSHJ P,IFBRKC ;OTHERWISE, KILL LINE
JRST OWN9B ;ALL EMPTY IF BREAK CHAR
PUSHJ P,OWN9J ;ELSE GET NEXT CHAR IN LINE
JRST OWN9E ;TEST FOR BREAK CHAR AGAIN
OWN9F: QPUSH Q,C ;LOAD THE CHARACTER IN QUEUE
QPERR ;CHECK FOR QPACK ERROR
JUMPE Q,OWN9I ;ALL DONE IF QUEUE IS FULL
OWN9G: PUSHJ P,OWN9J ;ELSE GET NEXT CHARACTER
PUSHJ P,IFBRKC ;IF WE'VE GOT A BREAK CHAR,
JRST OWN9B ; TEST FOR ANOTHER LINE
CAIGE C,40 ;IF IT'S NOT A CONTROL CHAR,
CAIN C,.CHTAB ;OR THE CONTROL CHAR IS A TAB,
JRST OWN9F ; THEN GO LOAD CHAR IN QUEUE
JRST OWN9G ;OTHERWISE, IGNORE AND GET NEXT
OWN9H: IN FDC, ;LET MONITOR GET A BUFFER
JRST OWN9J ;GET A CHARACTER IF OKAY
POP P,(P) ;OTHERWISE, UNLOAD ONE LEVEL
OWN9I: CLOSE FDC, ;HERE WHEN FINISHED SWITCH.INI
JRST OWNRET ;FINISH INITIALIZATION STUFF
OWN9J: SOSGE FDCBRH+2 ;DECREMENT BYTE LEFT COUNT
JRST OWN9H ;NEED NEW BUFFER IF EMPTY
ILDB C,FDCBRH+1 ;LOAD A CHAR FROM BUFFER
JUMPE C,OWN9J ;IGNORE IMBEDDED NULLS
PUSHJ P,CONVLC ;CONVERT LOWER CASE TO UC
POPJ P, ;RETURN TO ABOVE ROUTINE
;TABLE OF CHARACTERS IN OUR PROGRAM NAME
OWN9K: EXP "F","O","R","U","M" ;MUST BE OF LENGTH @ OWN9C+3
;HERE TO RETURN FROM OWNINI SUBROUTINE
OWNRET: POPJ P, ;RETURN TO MAIN PROGRAM
SUBTTL FATAL ERROR HANDLING AND REENTER ROUTINE
;HERE ON QPACK ERRORS (QPERR::=JUMPN Q,QPERRS)
QPERRS: HLRM Q,ERR ;LOAD QPACK ERROR CODE
MOVEI Q,(Q) ;ISOLATE ERROR CODE NUMBER
MOVEI M,[ASCIZ/ QPACK error detected -- code number in AC 15/]
JRST FTLERR ;DO ERROR HANDLING BELOW
;HERE ON FREE-CORE ERRORS (FCERR::=JUMPL A,FCERRS)
FCERRS: HLLZS ERR ;CLEAR PREVIOUS ERROR CODE
MOVEI M,1(A) ;LOAD ADDRESS OF TEXT + 1
JRST FTLERR ;DO ERROR HANDLING BELOW
;HERE ON FAILURE TO UN-WRITE-PROTECT HIGH SEGMENT
UWPERR: MOVEI T1,'HPF' ;LOAD ERROR PREFIX
HRRM T1,ERR ;INTO ERROR BUFFER
MOVEI M,[ASCIZ/ Can't write in the high segment (meddling?)/]
;FALL THROUGH TO ERROR HANDLER
;HERE FOR GENERAL FATAL ERROR HANDLING
FTLERR: TXO F,F.PCC ;DON'T ALLOW CONTROL-C'S
TXZE F,F.MIP ;IF WE HAD INTERLOCK,
SETOM INTLCK ; GIVE IT UP NOW
SKIPN A,SAVEID ;IF WE'RE NOT IN THE FORUM,
JRST .+6 ; THEN JUST DO FATAL ERROR
MOVX T1,OVRIDE*2*^D1000 ;LOAD SPECIAL OVERRIDE COUNT
AOSE INTLCK ;GET THAT INTERLOCK IN A HURRY
SOJGE T1,.-1 ;KEEP TRYING WITHOUT SLEEP WAIT
PUSHJ P,LL$REM ;AT LEAST GET US OUT OF FORUM
SETOM INTLCK ;GIVE UP HISEG INTERLOCK NOW
SETZB ID,SAVEID ;ZERO ID MARKERS EITHER WAY
PUSHJ P,FTLOUT ;TYPE ERROR MESSAGE AND BOMB
MOVEI M,[ASCIZ/ Can't continue/]
JRST .-2 ;DON'T EVER ALLOW CONTINUE
RELOC ;PUT RUN UUO INTO THE LOW SEGMENT
;HERE ON A REENTER TO RE-RUN OURSELVES WITH A CCL START
RERUN: MOVE T1,RUNDEV ;LOAD DEV FROM WHICH RUN
MOVE T2,[SIXBIT/FORUM/] ;LOAD NAME OF OURSELVES
SETZB T3,T4 ;USE NO EXTENSION AND 0
MOVE T4+1,RUNPPN ;LOAD PPN FROM WHICH RUN
SETZ T4+2, ;USE NO CORE ASSIGNMENT
MOVE A,[XWD 1,T1] ;CCL START AND T1 RUN BLOCK
RUN A, ;ISSUE A RUN TO OURSELVES
HALT ;LET MONITOR HANDLE ERRORS
RELOC ;BACK UP TO HIGH SEGMENT
SUBTTL STORAGE AND END
RELOC
;LOW SEGMENT STORAGE FOR EACH JOB
ZFIRST==. ;***** FIRST LOC TO BE CLEARED ON STARTS OR RESTARTS
IGNRID: BLOCK 1 ;ID BLOCK ADR OF JOB TO IGNORE
PRFDEV: BLOCK 1 ;DEVICE TO WHICH PRF CHAN OPEN
LOGBRH: BLOCK 3 ;LOG FILE BUFFER RING HEADER
PTOBRH: BLOCK 3 ;PTY OUTPUT BUFFER RING HEADER
PTIBRH: BLOCK 3 ;PTY INPUT BUFFER RING HEADER
HLPBRH: BLOCK 3 ;HELP FILE BUFFER RING HEADER
FDCBRH: BLOCK 3 ;FREE DISK CHANNEL BFR RNG HDR
PRFBUF: BLOCK PF$LEN ;PROFILE SPECIFICATION BLOCK
ZLAST==. ;***** LOC AFTER LAST TO BE CLEARED ON START OR RESTARTS
WRKBUF: BLOCK WRKSIZ ;WORK BUFFER FOR ANYTHING
NAMBUF: BLOCK NAMSIZ+1 ;BUFFER FOR ASCII NICK-NAMES
INPUTQ: MAKEQ INQSIZ ;HEADER FOR TTY INPUT QUEUE
INTBLK: BLOCK 4 ;BLOCK FOR HANDLING CNTL-C'S
IFG BEPMAX,<BEPCNT: EXP BEPMAX> ;NUMBER OF BEEPS LEFT TO SEND
SAVCHR: BLOCK 1 ;PLACE TO SAVE A CHAR FROM "C"
SAVHFP: BLOCK 1 ;SAVED HELP FILE DIRECTORY
SAVLFN: BLOCK 1 ;LAST LOG FILE NAME USED
SAVEID: BLOCK 1 ;ADR OF ID BLOCK USED ON INTERRUPTS
SAVTEL: BLOCK NAMSIZ+1 ;PLACE TO SAVE NAME ON LAST TELL
SAVSEN: BLOCK 1 ;PLACE TO SAVE TTY ON LAST SEND
RUNDEV: EXP -1 ;DEVICE FROM WHICH FORUM WAS RUN
RUNPPN: EXP -1 ;PPN FROM WHICH FORUM WAS RUN
STACK: BLOCK PDSIZE ;THE PUSH DOWN STACK
RELOC
;HIGH SEGMENT STORAGE FOR SHARED DATA
FORUM: EXP 0 ;HOME LINK OF THE FORUM LIST
INTLCK: EXP -1 ;HISEG INTERLOCK (MUST BE -1 TO MOD.)
ENTERS: EXP 0 ;ENTRY INDEX (FIRST ENTER IS 1)
JIFSEC: EXP 0 ;PLACE TO SAVE JIFFIES PER SECOND
OLDMLP: EXP 0 ;POINTER TO OLD MESSAGE LIST
OLDMLC: EXP OMLMAX ;FREE SPACES LEFT IN OLD MSG LIST
;AND ALL LITERALS IMPLICITLY GO INTO HIGH SEGMENT
END START