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) ;MACRO TO DEFINE CONSECUTIVE BIT MASKS FOR FLAGS IN ANY AC DEFINE BIT (FLAG,AC) IFE AC'..,>> IFNDEF AC'.., IFNB ,>> 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) IFNDEF GROUP'$LEN, IFNB ,>> SYM LNK,ID ;**ID BLOCK** LINKAGE WORD SYM NN1,ID ;NICK-NAME OF USER (ASCII) REPEAT NAMSIZ-1,;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,> IFLE NAMSIZ,> IFL INQSIZ-5,> IFL WRKSIZ-ID$LEN,> IFL WRKSIZ-MB$LEN-<^D80/5>, > IFL WRKSIZ-MB$LEN-INQSIZ-<2*NAMSIZ>-6, > IFLE OMLMAX,> IFL OVRIDE-3,> IF2, >> IFN FDCDEV-'DSK',> IFN F.XIT-1B0,> IFN MS.NOR-1B0,> IFN MB$TXT-MB$LEN+1,> IFE MS..&777777B17,> IF2, >> ;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: ; ; MOVE P1, ; 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,
; 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, ; 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/_*/] PJRST ACTOUT ;TYPE OUT LINE AND RETURN ILLCHR: PUSH P,C ;SAVE ILLEGAL CHARACTER 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/_*/] 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 PAGE DEFINE ITEM (A,B,C) COMNAM: COMMAC ;GENERATE TABLE OF COMMAND NAMES COMLEN==.-COMNAM ;CALCULATE LENGTH OF COMMAND TABLE PAGE DEFINE ITEM (A,B,C) COMDSP: COMMAC ;GENERATE COMMAND DISPATCH TABLE PAGE DEFINE ITEM (A,B,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/_/] 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/_/] 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/_/] ;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//];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/_/] 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//] TELERR: QRSET Q,INPUTQ ;WIPE OUT THE INPUT QUEUE QPERR ;CHECK FOR QPACK PROBLEMS CAIA ;SKIP NO MESSAGE ERROR TELER1: MOVEI M,[ASCIZ//] 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//] 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//] 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/_/] 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/_/] 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/_/] 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/_/] 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//] 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/__/] 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/_/] 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/_/] 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/_/] PJRST ACTOUT ;TYPE HANDY MESSAGE AND RETURN ;HERE TO PROVIDE MY NAME AS AUTHOR OF FORUM AUTCOM: MOVEI M,[ASCIZ//] PJRST LINOUT ;AND WHERE I'M FROM ;HERE TO EXPLAIN WHAT PROGRAM THIS IS WHTCOM: MOVEI M,[ASCIZ//] PJRST LINOUT ;TYPE LINE WITH CRLF AND RETURN ;HERE TO EXPLAIN HOW TO USE THIS PROGRAM HOWCOM: MOVEI M,[ASCIZ/ -- /] 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//] ;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//] ;LOAD FRIENDLY MESSAGE PJRST LINOUT ;TYPE LINE AND RETURN ;HERE TO LIST ALL THE COMMANDS IN THE COMMAND TABLE LSTCOM: MOVEI M,[ASCIZ/_/] 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/_/] 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/_/] 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/_/] 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//] 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/_/] 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//] 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//] 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, ;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, ; NEVER RUN OUT OF BEEPS MOVEI M,[ASCIZ/ ;FINISH UP THE ABOVE LINE PUSHJ P,FINLIN ;TACK ON ANG BRKT AND CRLF IFG BEPMAX, ;REPAIR COUNT IF REFUSED IFLE BEPMAX, 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//] 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//] 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//] 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//] 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//];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//] 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//] 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//] JUMPE X,LINOUT ;JUST TYPE LINE AND RETURN MOVEI M,[ASCIZ//] 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/ ; MOVEI A, ; 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//] TXNE F,F.ALL ;IF WE WERE LOOKING FOR ALL, PJRST LINOUT ; TYPE MESSAGE AND RETURN MOVEI M,[ASCIZ/" ;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//] 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, ;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