Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-sources/opleas.mac
There are 3 other files named opleas.mac in the archive. Click here to see a list.
;<3A.UTILITIES>OPLEAS.MAC.5, 27-Jul-78 18:33:55, EDIT BY MILLER
;CHANGE VERSION NUMBER
;<OSMAN>OPLEAS.MAC.1, 26-Apr-78 11:31:42, EDIT BY OSMAN
;PROPERLY HANDLE OPLEAS.CMD BEING UPDATED WHILE OPLEAS RUNNING
;(PROBLEM WAS AC'S BEING CLOBBERED IN TEMPTY ROUTINE)
;<4.UTILITIES>OPLEAS.MAC.3, 5-Dec-77 21:03:49, Edit by MCLEAN
;ADD RM03
;<4.UTILITIES>OPLEAS.MAC.2, 1-Oct-77 01:34:52, EDIT BY DBELL
;BEFORE ALLOCATING A DEVICE TO A JOB, MAKE SURE THAT THE USER
;HAS NOT GONE AWAY MEANWHILE. TCO 1869.
;<4.UTILITIES>OPLEAS.MAC.1, 26-Sep-77 13:53:36, EDIT BY HELLIWELL
;<3-UTILITIES>OPLEAS.MAC.7, 23-Sep-77 19:52:18, EDIT BY HELLIWELL
;GENERALIZE TMOUNT (ADD DECTAPES)
;<3-UTILITIES>OPLEAS.MAC.6, 19-Aug-77 14:38:25, EDIT BY HURLEY
;<3-UTILITIES>OPLEAS.MAC.5, 18-Aug-77 14:29:42, EDIT BY KIRSCHEN
;FIX LUUO DEFINITIONS TO ASSEMBLE WITH NEW MACRO
;<3-UTILITIES>OPLEAS.MAC.4, 11-Aug-77 09:17:56, EDIT BY HURLEY
;MAKE OPLEAS LOOK ON SYSTEM: FOR OPLEAS.CMD
;<3-UTILITIES>OPLEAS.MAC.3, 11-May-77 11:27:01, EDIT BY OSMAN
;DON'T SET ABTFLG UNLESS CURRENT USER IS THE ^C'ER.
;<3-UTILITIES>OPLEAS.MAC.2, 11-May-77 11:04:22, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.183, 27-Dec-76 17:06:51, EDIT BY HURLEY
;<2-UTILITIES>OPLEAS.MAC.182, 18-Dec-76 17:07:54, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.181, 18-Dec-76 17:00:22, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.180, 18-Dec-76 16:56:49, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.179, 18-Dec-76 16:43:26, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.178, 18-Dec-76 16:35:23, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.176, 18-Dec-76 15:21:56, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.168, 9-Dec-76 14:32:17, EDIT BY OSMAN
;TCO 1637 - MAKE OPLEAS READ PS:[SYSTEM]OPLEAS.CMD
;<2-UTILITIES>OPLEAS.MAC.61, 12-Oct-76 11:05:22, EDIT BY OSMAN
; TCO 1588 - IMPLEMENT IGTBL CONTAINING UNMOUNTABLE STRUCTURES
;<2-UTILITIES>OPLEAS.MAC.50, 29-Sep-76 16:40:30, EDIT BY OSMAN
; TCO 1509 - IMPLEMENT SMOUNT AND SDISMOUNT FOR FILE STRUCTURE CONTROL
;<1B-UTILITIES>OPLEAS.MAC.16, 10-JUN-76 14:02:14, Edit by HESS
; ALLOW OPLEASE TO RUN WITHOUT BEING ENABLED FIRST
;<1B-UTILITIES>OPLEAS.MAC.15, 7-JUN-76 13:28:57, Edit by HESS
; TCO 1347 - ALLOW COLON AFTER DEVICE NAME (TMOUNT)
;<1B-UTILITIES>OPLEAS.MAC.14, 2-JUN-76 16:24:55, Edit by HESS
; TCO 1337 (DEVICE OPEN BY JOB -2 BUG)
;<1B-UTILITIES>OPLEAS.MAC.13, 21-MAY-76 12:12:22, Edit by HESS
;<1B-UTILITIES>OPLEAS.MAC.12, 4-MAY-76 13:33:23, Edit by HESS
; MACRO 50 ANOMALLY IN POINTR MACRO CALLS
;<EXEC>OPLEAS.MAC.11, 8-APR-76 11:56:33, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES
;<EXEC>OPLEAS.MAC.10, 30-MAR-76 11:35:35, Edit by HESS
;<EXEC>OPLEAS.MAC.9, 26-MAR-76 02:40:55, Edit by HESS
;<EXEC>OPLEAS.MAC.8, 26-MAR-76 00:59:48, Edit by HESS
;<EXEC>OPLEAS.MAC.7, 25-MAR-76 22:36:54, Edit by HESS
; ADD FEATURE FOR TMOUNT FACILITY
TITLE OPLEAS
;COPYRIGHT (C) 1976, 1977, DIGITAL EQUIPMENT CORP., MAYNARD MASS. 01754 ***
;THIS PROGRAM IS THE OPERATOR HALF OF THE PLEASE/OPLEAS PAIR OF PROGRAMS.
;EACH OPERATOR WHO WANTS TO BE AVAILABLE TO USERS RUNS A COPY OF OPLEAS,
;SPECIFYING THE OPERATOR'S ID. USERS RUN PLEASE, SPECIFYING THE OPERATOR,
;AND THE TWO PROGRAMS TALK VIA IPCF MESSAGES.
;THE PDB'S FOR THE MESSAGES ARE SET UP IN THE USUAL WAY; I.E.,
;.IPCFL: FLAG WORD
;.IPCFS: SENDER'S PID
;.IPCFR: RECEIVER'S PID
;.IPCFP: 1000,,PAGE NUMBER
;ALL MESSAGES ARE SENT IN PAGE MODE
;THE FIRST WORD OF EACH MESSAGE CONTAINS A CODE IN THE RIGHT HALF INDICATING
;THE MESSAGE TYPE. IN A 'TEXT' MESSAGE THE LEFT HALF CONTAINS THE NUMBER OF TEXT
;MESSAGES SENT. IN A 'BYE' MESSAGE THE LEFT HALF CONTAINS THE NUMBER THAT WAS
;IN THE FIRST WORD OF THE LAST TEXT MESSAGE RECEIVED. ALL OTHER MESSAGES
;HAVE ZERO IN THE LEFT HALF OF THE FIRST WORD
;THE CONTENTS OF THE REMAINING WORDS OF A MESSAGE VARY WITH THE MESSAGE TYPE.
SUBTTL DATA DEFINITION
SEARCH MONSYM,MACSYM ;HAS JSYS DEFINITIONS, BITS, ETC.
SEARCH COMSYM ;COMMUNICATION SYMBOLS
.REQUIRE SYS:MACREL.REL ;HAS JSERR
SALL
IFNDEF .PSECT,<
.DIRECT .XTABM>
;MACRO TO RESET, HALT, RESTART IF USER CONTINUES.
;RESET PREVENTS INTERRUPT ON MESSAGES SENT TO OLD PID BEFORE
;RESET AT START IS EXECUTED
DEFINE QUIT1
<JRST [ RESET
HALTF
JRST START2]>
;REGISTER USAGE
;PRIMARY USAGE - CARRIED OVER SUBROUTINE CALLS
;P1/ ADDRESS OF RECEIVE PDB
;P2/ ADDRESS OF SEND PDB
;P3/ ADDRESS OF SEND MESSAGE
;P4/ SIZE OF SEND MESSAGE
;Q1/ FLAG WORD RECEIVED
;Q2/ SENDER'S PID
;Q3/TRANSFER ADDRESS
; TEMPORARY USAGE
;P5/ ASSORTED TEMPORARY VALUES
;P6/DITTO
;REGISTERS FROM ABOVE USED AS LOCAL TEMPORARY VALUES
;T1-T4 USED FOR TEMPORARY VALUES
;AC DEFINITIONS
F=0
A=1
B=2
C=3
D=4 ;A,B,C,D OR T1,T2,T3,T4 ARE AC'S 1-4
T1=1
T2=2
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
P=17
;DEBUG SWITCH - 1 IF WANT EXTRA PRINTING. ALL DEBUG PRINTING PRECEDED BY 'D:'
DEBUG: 0
;MASKS FOR FLAG WORD RECEIVED (FIRST WORD IN PDB)
MSKSTR(ERROR,,IP%CFE) ;ERROR FIELD IN FLAG WORD
MSKSTR(SYSTEM,,IP%CFC) ;SYSTEM SEND FIELD IN FLAG WORD
;STACK
STKINI: MOVE P,[IOWD STKSIZ,STK];STACK INITIALIZATION INSTRUCTION
STKSIZ==500
STK: BLOCK STKSIZ
;REGISTER SAVE AREA. REGISTERS ARE STORED IN ORDER IN INTERRUPT ROUTINES
REGSAV: BLOCK 17
UUOACS: BLOCK 17 ;SAVED AC'S DURING UUOS
;UUO DEFINITIONS
DEFINE UUODEF(NAME,VALUE)
<
OPDEF NAME [<VALUE>B8]
>
UUODEF UTYPE,1 ;TYPE STRING
UUODEF UERROR,2 ;FATAL ERROR
UUODEF UWARN,3 ;WARNING ERROR
DEFINE TYPE(TEXT)
<
UTYPE [ASCIZ \TEXT\]
>
DEFINE WARN(TEXT)
<
UWARN [ASCIZ \TEXT\]
>
DEFINE ERROR(TEXT)
<
UERROR [ASCIZ \TEXT\]
>
;(SEE "UUOH" FOR UUO HANDLER)
FREESP: BLOCK 100 ;SOME FREE SPACE FOR STRING CREATION, ETC.
;ENTRY VECTOR
PRGVER==3 ;VERSION NUMBER
PRGEDT==12 ;EDIT NUMBER
PRGMIN==1 ;MINOR VERSION
PRGCST==0 ;CUSTOMER ID
ENTVEC: JRST START ;START ADDRESS
JRST START2 ;REENTER ADDRESS
PRGCST_^D33+PRGVER_^D24+PRGMIN_^D18+PRGEDT
;TRANSFER VECTOR BASED ON CODE RECEIVED
DEFINE TX(ADDRES,CODE)
<
IFG CODE-%%MAX,<%%MAX==CODE>
RELOC GOTAB+CODE
ADDRES
RELOC GOTAB+%%MAX+1
>
%%MAX==0 ;FINAL VALUE IS ONE LESS THAN LENGTH OF TABLE
GOTAB: TX ONEWAY,PLONE ;PLONE HAS BEEN RECEIVED
TX QUEST,PLQUES ;PLQUES HAS BEEN RECEIVED
TX HELLO,PLHEL ;PLHEL HAS BEEN RECEIVED
TX BYE,PLBYE ;PLBYE HAS BEEN RECEIVED
TX ABORT,PLABRT ;USER WANTS TO ABORT COMMAND (TYPED ^C)
TX TEXT,PLTXT ;PLTXT HAS BEEN RECEIVED
TMNT,<
TX XHELLO,THELLO ;EXEC WANTS MOUNT SERVICE
TX XMOUNT,TMOUN ;MOUNT INFO MESSAGE
>;TMNT
SMNT,<
TX SREMOV,SRINFO ;EXEC WANTS A STRUCTURE TO BE REMOVED
TX SMELLO,SHELLO ;EXEC WANTS SMOUNT SERVICE
TX SMOUNT,SMINFO ;EXEC IS SENDING SMOUNT INFO
TX MDONE,SMDONE ;EXEC SUCCEEDED IN INCREMENTING MOUNT COUNT
>;SMNT
TX LSTADD,SIGNOR ;EXEC WANTS TO CAUSE A STRUCTURE TO BE IGNORED
TX LSTDEL,SACKN ;EXEC WANTS TO MAKE STRUCTURE MOUNTABLE AGAIN
TABSIZ=.-GOTAB
;BUFFER THAT HOLDS TEXT SENT BY USER
TXTBUF: BLOCK 1000
BUFEND:
BUFNXT: XWD -1,TXTBUF ;NEXT LOCATION TO WRITE INTO
IPAGE: 0 ;GETS IPCF PAGE NUMBER FOR MESSAGES
IPAGEX: 0 ;GETS IPCF ADDRESS FOR MESSAGES
MESSAG: BLOCK 1777 ;IPCF MESSAGE STARTS SOMEWHERE IN HERE
;MESSAGE AREA FOR RECEIVE
;PDB
RMSGSZ= 1000
RPDB: IP%CFB!IP%TTL!IP%CFV ;DON'T BLOCK; TRUNCATE; PAGE MODE
block 1 ;sender's pid
BLOCK 1 ;receiver's pid
XWD RMSGSZ,RMSG ;message length,,page
BLOCK 3 ;DIRECTORIES AND PRIVILEGES
RPDBSZ=.-RPDB
IPDB: BLOCK RPDBSZ ;REAL PDB USED FOR SENDS AND RECEIVES
;MESSAGE
RMSG: BLOCK RMSGSZ ;MESSAGE AREA
;MESSAGE AREA FOR SEND at interrupt level
SMSGSZ=1000
SPDB: IP%CFV ;PAGE MODE
block 1 ;SENDER'S PID
BLOCK 1 ;RECEIVER'S PID
XWD SMSGSZ,SMSG ;MESSAGE LENGTH,,page
SPDBSZ=.-SPDB
;MESSAGE
SMSG: BLOCK SMSGSZ ;MESSAGE AREA
;PDB
;message area for send at NON-INTerrupt level
;PDB
OMSGSZ=1000
OPDB: IP%CFV ;PAGE MODE
block 1 ;SENDER'S PID
block 1 ;RECEIVER'S PID
XWD OMSGSZ,OMSG ;MESSAGE LENGTH,,page NUMBER
OPDBSZ=.-OPDB
;MESSAGE
OMSG: BLOCK OMSGSZ ;MESSAGE AREA
;THIS AREA CONTAINS THE NAME SENT TO INFO. INITIALLY IT CONTAINS
;<OPERATOR>OPLEAS. THE OPERATOR ID IS READ AND CONCATENATED TO THIS
;INITIAL STRING AND SENT TO <SYSTEM>INFO AS AN IDENTIFIER FOR THIS COPY
;OF OPLEAS.
LINESZ=775 ;WORDS AVAILABLE AFTER NAME BEFORE ID ADDED
namlen=21 ;LENGTH OF NAME BEFORE ID ADDED
NAMSIZ: block 1 ;SIZE OF NAME SENT TO INFO
;INCLUDES ID TYPED BY USER
;KEEP THIS BLOCK TOGETHER
MYNAME: ASCIZ /<OPERATOR>OPLEAS/
BLOCK LINESZ-1 ;SPACE FOR REST OF NAME
;THE FOLLOWING VALUE IS FIXED
INISIZ=<LINESZ*5>-2 ;BYTES AVAILABLE AFTER NAME BEFORE ID ADDED
;THE FOLLOWING IS UPDATED AFTER THE ID IS READ.
inibeg: block 1 ;pointer to FIRST BYTE AFTER NAME
;VARIABLES USED WHILE READING FIRST LINE
JOBNAM: ASCIZ/OPLEAS/ ;OUR PROGRAM NAME
IDFLG: 0 ;SET WHEN OPERATOR ID FOUND
CHCNT: 0 ;NUMBER OF NON-PUNCTUATION CHARS PROCESSED
BYTCNT: 0 ;NUMBER OF BYTES PROCESSED
;PIDS
MYPID: 0 ;OPLEAS'S PID
CURPID: 0 ;PID CURRENTLY TALKING TO
TMNT,<
;TMOUNT STORAGE
TMF: 0 ;-1 IF TMOUNT REQUEST IN PROGRESS
TMIND: 0 ;DEVICE INDEX
DEVNAM: 0 ;TABLE PNTR FOR DEVICE NAMES
DEVCHR: 0 ;TABLE PNTR FOR DEVICE CHARS.
DEVUNT: 0 ;TABLE PNTR FOR UNIT NUMBERS
DEFINE TYPES<
MNTMAC .DVMTA,magtape,MTA
MNTMAC .DVDTA,dectape,DTA
>
;DEVICE TYPE TABLE
DEFINE MNTMAC(A,B,C)
< A
>
TMTYP: TYPES
TMLEN==.-TMTYP
;DEVICE DESCRIPTION NAME
DEFINE MNTMAC(A,B,C)
< [ASCIZ \B\]
>
TMNAM: TYPES
;DEVICE MNEMONIC
DEFINE MNTMAC(A,B,C)
< ASCII \C\
>
TMMN: TYPES
>;TMNT
SMNT,<
;SMOUNT STORAGE
UNITS==10 ;LARGEST NUMBER OF UNITS WE CAN HANDLE
CHNS==10 ;LARGEST NUMBER OF CHANNELS WE UNDERSTAND
.BADCD==123456 ;A DEVICE CODE WE DON'T EVER EXPECT
DEVTYP: ;TABLE OF STRUCTURE TYPES WE UNDERSTAND
[ASCIZ /RP04/],,.MSRP4
[ASCIZ /RP05/],,.MSRP5
[ASCIZ /RP06/],,.MSRP6
[ASCIZ /RM03/],,.MSRM3
BADDEV: [ASCIZ /?UNKNOWN DEVICE/],,.BADCD
DEVS==.-DEVTYP ;NUMBER OF KINDS OF STRUCTURES WE UNDERSTAND
MAXPKS==DEVS*UNITS*CHNS ;LARGEST NUMBER OF DISK PACKS WE CAN HANDLE
NOOPGU==^D10 ;NUMBER OF MINUTES TO WAIT BEFORE GIVING
;UP DURING AN SMOUNT REQUEST WHEN NO
;OPERATOR IS IN ATTENDANCE
SCANT==^D3 ;SECONDS BETWEEN SCANS OF DRIVES TO CHECK
;FOR STRUCTURE COMING ON LINE
ANNOYT==^D5 ;MINUTES TO WAIT BEFORE REMINDING THE
;OPERATOR THAT AN SMOUNT REQUEST IS PENDING
DEFINE TABLE(NAME)
<
NAME:
%%MAX==0
DEFINE Y(ITEM,MONNAM)
<
ITEM=NAME+MONNAM
IFGE MONNAM-%%MAX,
<
%%MAX==MONNAM+1
>
>
DEFINE TABEND(LENGTH)
<
RELOC NAME+%%MAX
LENGTH==.-NAME
>
>
TABLE RNUBLK ;BLOCK FOR READING STATUS OF DISK DRIVE
Y RNUCHN,.MSRCH ;CHANNEL NUMBER
Y RNUUNT,.MSRUN ;UNIT NUMBER
Y RNUCON,.MSRCT ;CONTROLLER NUMBER
Y RNUSTA,.MSRST ;STATUS
Y RNUALS,.MSRSA ;STRUCTURE ALIAS
Y RNUNAM,.MSRSN ;STRUCTURE NAME
Y RNUNUM,.MSRNS ;UNIT OF STRUCTURE,, TOTAL UNITS IN STRUCTURE
TABEND RNULEN
;STRNLN*5-1 IS MAXIMUM NUMBER OF CHARACTERS ALLOWED IN A STRUCTURE NAME STRING(DEFINED IN COMSYM)
SMABLK: BLOCK STRNLN ;SMOUNT ALIAS REQUEST
SMSBLK: BLOCK STRNLN ;SMOUNT PHYSICAL REQUEST
ALSBLK: BLOCK STRNLN ;HOLDS ALIAS NAME STRING FOR JSYS'S
NAMBLK: BLOCK STRNLN ;PHYSICAL NAME STRING FOR JSYS'S
TABLE MNTBLK ;BLOCK FOR THE MOUNT JSYS (MSTR)
Y MNTNAM,.MSTNM ;NAME OF STRUCTURE
Y MNTALS,.MSTAL ;ALIAS
Y MNTNUM,.MSTNU ;NUMBER OF UNITS IN STRUCTURE
Y MNTTBL,.MSTUI ;TABLE OF INFO FOR EACH PACK IN STRUCTURE
UNTLEN==.MSTNO ;NUMBER OF WORDS PER PACK OF INFO IN THIS SUBTABLE
MTLEN==UNTLEN*MAXPKS ;ALLOW ROOM FOR ONE HUMUNGOUS STRUCTURE
Y MTBEND,.MSTUI+MTLEN-1 ;LEAVE ROOM FOR ENTIRE SUBTABLE
TABEND MNTLEN
TABLE GSSBLK ;BLOCK FOR GETTING STRUCTURE STATUS
Y GSSALS,.MSGSN ;ALIAS
Y GSSSID,.MSGSI ;STRUCTURE ID
Y GSSSTA,.MSGST ;STRUCTURE STATUS
Y GSSMC,.MSGMC ;MOUNT COUNT
Y GSSOFC,.MSGFC ;OPEN FILE COUNT
TABEND GSSLEN
TABLE GSUBLK ;BLOCK FOR GETTING STRUCTURE USERS
Y GSUALS,.MSUAL ;ALIAS
Y GSUFLG,.MSUFL ;FLAGS,,NUMBER OF ITEMS RETURNED
Y GSULST,.MSUJ1 ;BEGINNING OF JOB LIST
GSUJLN==200 ;NUMBER OF JOBS THAT CAN FIT IN LIST
Y GSUEND,.MSUJ1+GSUJLN-1 ;LEAVE ROOM FOR JOB LIST
TABEND GSULEN
TABLE SSSBLK ;BLOCK FOR SETTING STRUCTURE STATUS
Y SSSALS,.MSSSN ;ALIAS
Y SSSMSK,.MSSMW ;MASK OF BITS TO CHANGE
Y SSSSTA,.MSSST ;NEW VALUES FOR BITS
TABEND SSSLEN
DISALS: 0 ;ALIAS OF STRUCTURE BEING DISMOUNTED
DTABLN==MAXPKS ;DRIVE TABLE LENGTH, ONE WORD PER DRIVE
DRV%NA==MS%MNT ;BIT IN DRIVE TABLE MEANING DRIVE UNAVAILABLE
DRVTAB: BLOCK DTABLN ;DRIVE TABLE
ODRVTB: BLOCK DTABLN ;OLD DRIVE TABLE, SO PRINTOUT ONLY SHOWS CHANGES
SALIAS: 0 ;ALIAS OF STRUCTURE BEING MOUNTED(POINTER THERETO)
STRNAM: 0 ;PHYSICAL NAME OF STRUCTURE BEING MOUNTED
;DATA RECEIVED FROM EXEC
RNAMES==RMSG+.NAMES ;LOCATION WHERE NAMES BEGIN
RFLAGS==RMSG+.FLAGS ;LOCATION WHERE CONTROL FLAGS ARE PASSED
NOFLG: 0 ;-1 IF WAITING FOR OPERATOR'S REJECTION REASON
SMF: 0 ;-1 IF WAITING FOR REQUESTED STRUCTURE TO APPEAR
SMEDSP: 0 ;IF NON-0, IS SMOUNT ERROR DISPATCH ADDRESS
SMDIR: 0 ;CONNECTED DIR OF SMOUNTER
RMF: 0 ;-1 IF WAITING FOR A STRUCTURE TO BE REMOVED
SMFLGS: 0 ;SMOUNT FLAGS SENT BY EXEC
TYPNAM: 0 ;POINTER TO ASCII NAME OF DEVICE TYPE (LIKE "RP05")
LSTOPR: 0 ;SHOWS WHEN THE OPERATOR WAS LAST PRESENT
LASTL: 0 ;SHOWS WHEN AVAILABLE DRIVE LIST WAS LAST PRINTED
>;SMNT
;MAXIMUM MESSAGE SIZE FOR THIS INSTALLATION
MAXMSG: BLOCK 1 ;DETERMINED DURING INITIALIZATION WITH MUTIL
;ASSOCIATED VARIABLE FOR NEXT MESSAGE IN IPCF QUEUE
NXTMSG: BLOCK 1 ;0 IF THERE WAS NO MESSAGE WAITING
; AFTER THE LAST RECEIVE
;**** COMMAND INPUT STORAGE AREA
COMNAM: ASCIZ /SYSTEM:OPLEAS.CMD/ ;NAME OF COMMANDS FILE
COMTBL: COMLEN,,COMLEN ;LIST OF LEGAL COMMANDS
[ASCIZ /DOMESTIC/],,DOMSTR ;ALLOW STRUCTURE TO BE MOUNTED DOMESTIC
COMLEN==.-COMTBL-1 ;NUMBER OF COMMANDS IN TABLE(NOT CHANGED DYNAMICALLY)
COMJFN: 0 ;HOLDS HANDLE (JFN) ON COMMANDS FILE
STAMP: 0 ;LAST KNOWN WRITE-TIME OF COMMANDS FILE
ATMLEN==100 ;LENGTH OF ATOM BUFFER
SAVEDP: 0 ;USED TO SAVE STACK POINTER FOR REPARSES
ATMBUF: BLOCK ATMLEN ;ATOM BUFFER (LAST FIELD READ BY COMND JSYS
CINLEN==100 ;LENGTH OF INPUT BUFFER FOR COMND
CINBUF: BLOCK CINLEN
CMFNP==FBLOCK+.CMFNP
CMDAT==FBLOCK+.CMDAT
CMHLP==FBLOCK+.CMHLP
CMDEF==FBLOCK+.CMDEF
CMFLG==SBLOCK+.CMFLG
CMIOJ==SBLOCK+.CMIOJ
CMRTY==SBLOCK+.CMRTY
CMBFP==SBLOCK+.CMBFP
CMPTR==SBLOCK+.CMPTR
CMCNT==SBLOCK+.CMCNT
CMINC==SBLOCK+.CMINC
CMABP==SBLOCK+.CMABP
CMABC==SBLOCK+.CMABC
CMGJB==SBLOCK+.CMGJB
CMKEY==<.CMKEY>B8
CMNOI==<.CMNOI>B8
CMCFM==<.CMCFM>B8
CMFLD==<.CMFLD>B8
FBLOCK: BLOCK 4 ;FUNCTION BLOCK FOR COMND JSYS
SBLOCK: BLOCK 12 ;STATE BLOCK
;ARGUMENT BLOCK FOR MUTIL
MUTILD: BLOCK 10
;FLAGS TO INDICATE STATE
PIFLG: 0 ;-1 IFF INTERRUPTS ARE ON
INTFLG: 0 ;SET WHEN INTERRUPT PROCESSED
WTFLG: 0 ;SET WHEN WAITING FOR AN INTERRUPT
WRKFLG: 0 ;-1 IF SMOUNT OR SREMOVE MUST REALLY WAIT FOR SOMETHING
SILNTF: 0 ;-1 TO PREVENT TYPEOUT OF LOGOFF MESSAGE
ansflg: 0 ;set when waiting for answer to 'ok'
;FLAGS SET BASED ON MESSAGES RECEIVED
ABTFLG: 0 ;-1 IF SOMEONE ABORTS COMMAND
BYEFLG: 0 ;SOMEONE WANTS TO SAY GOODBYE
; BIT 0 SET IF USER SAYS GOODBYE
;BIT 1 SET IF OPERATOR SAYS GOODBYE
TXTFLG: 0 ;TEXT FROM USER WAITING IN BUFFER
;FLAG SET WHEN TERMINATE READ BEFORE OPERATOR TYPES TERMINATOR
RDFLG: 0 ;SET WHEN RDTTY RETURNS RD%BTM NOT SET
;COUNT OF TEXT MESSAGES SENT AND RECEIVED
SNDCNT: 0 ;NUMBER OF MESSAGES SENT BY OPLEAS
RCVCNT: 0 ;NUMBER OF LAST MESSAGE RECEIVED BY OPLEAS
TXTCNT: 0 ;NUMBER OF LAST MESSAGE RECEIVED BY PLEASE
;INTERRUPT SYSTEM
; [LEVEL,,INTERRUPT ADDRESS]
;MACRO FOR FILLING CHANNEL TABLE:
DEFINE INT(CHANNEL,LEVEL,ROUTINE)<
RELOC CHNTAB+CHANNEL
LEVEL,,ROUTINE
>
CHNTAB: INT 0,2,IPCINT ;IPCF ON CHANNEL 0
INT 1,2,TINT ;^T ON CHANNEL 1
INT 2,2,CINT ;^C ON CHANNEL 2
INT 3,2,TYPINT ;INPUT BUFFER NON-EMPTY ON 3
INT .ICPOV,1,ILL ;PUSHDOWN OVERFLOW SAME AS ILLEGAL INSTRUCTION
INT .ICILI,1,ILL ;ILLEGAL INSTRUCTION, LEVEL 1, ROUTINE AT "ILL"
RELOC CHNTAB+6*6 ;LEAVE ROOM FOR 36 CHANNELS
; [LOCATION WHERE PC STORED BY LEVEL]
LEVTAB: PCSAV1 ;LEVEL 1 PC STORAGE
PCSAV2 ;LEVEL 2 PC STORAGE
PCSAV3 ;LEVEL 3 PC STORAGE
;PC'S SAVED HERE
;****** THESE PC WORDS MUST REMAIN IN ORDER CONTIGUOUSLY
PCSAV1: BLOCK 1 ;LEVEL 1 PC STORAGE
PCSAV2: BLOCK 1 ;LEVEL 2 PC STORAGE
PCSAV3: BLOCK 1 ;LEVEL 3 PC STORAGE
;******
;INTERNAL QUEUE FOR WAITING USERS
QUESIZ=40 ;MAXIMUM NUMBER WAITING (INCLUDES ONE-WAY)
QUEBEG: BLOCK QUESIZ-1 ;QUEUE AREA - CONTAINS PID OR PAGE OF
QUEFIN: BLOCK 1 ; ONEWAY
NXTADD: QUEBEG ;NEXT LOCATION TO ADD TO
NXTREM: QUEBEG ;NEXT LOCATION TO REMOVE FROM
QUECNT: 0 ;CURRENT NUMBER OF ENTRIES IN QUEUE
;ENABLED CAPABILITIES BEFORE ENABLING EVERYTHING
CAPAB: BLOCK 1
;LOCATIONS FOR TIMING OUT USER AFTER 'OK' IS SENT
dtime: 0 ;TIME TO GIVE UP
DELAY: ^D60000 ;ONE MINUTE IN MILLISECONDS
;BUFFER FOR USER ID INFO - LINE NUMBER, DIRECTORY
USRSIZ=12
USER: BLOCK USRSIZ
;CHARACTERS USED IN ANSWERING QUESTION ON CTRL/C INTERRUPT
UPPY=131 ;UPPER CASE Y
LOWY=171 ;LOWER CASE Y
UPPN=116 ;UPPER CASE N
LOWN=156 ;LOWER CASE N
;UNDETECTABLE STRUCTURE TABLE
;STRUCTURE NAMES IN THIS TABLE ARE UNDETECTABLE BY OPLEAS AS BEING
;ON-LINE, EVEN THOUGH THEY MAY BE SITTING ON SOME DRIVES
IGTLEN==50 ;MAXIMUM LENGTH OF TABLE
IGTBL: BLOCK IGTLEN+1 ;LEAVE ROOM FOR HEADER WORD
;TABLE OF STRUCTURES WHICH ARE ALLOWED TO BE MOUNTED DOMESTICALLY
DOMLEN==1000 ;ALLOW THIS MANY OR SO
DOMINI: DOMLEN ;LENGTH,,MAX (INITIAL SETTING)
DOMTBL: BLOCK DOMLEN+1 ;LEAVE ROOM FOR STRUCTURES
;STORAGE SPACE FOR STRINGS, PLEASE SEE "GETMEM" ROUTINE
STRSIZ==3000 ;TOTAL NUMBER OF WORDS OF STORAGE AVAILABLE
STRBUF: BLOCK STRSIZ ;THE STRING STORAGE ITSELF
DICT: 0 ;WORD NEEDED BY FREE STRING SPACE MANAGER
;free space for oneway messages
NPAGES==50 ;NUMBER OF PAGES FOR ONEWAY MESSAGES
nxtpag: 0 ;first available page (first location)
ONEBUF: BLOCK 1000+NPAGES*1000 ;LEAVE ROOM FOR ONEWAY PAGES
lstpag: 0 ;indicates end of free space
SUBTTL INITIALIZATION
; HERE IF RESTARTING AFTER ERROR. INPUT WILL COME FROM ANSWERS TO QUESTIONS
;AND NOT FROM THE EXEC VIA RSCAN.
START2: TYPE <%_[Restarting]%_>
movei t1,.priin ;t1/primary input
cfibf ;clear input buffer (discard erroNEOus text)
HRROI T1,T2 ;POINT TO INTERNAL AREA
SETZ T2, ;CLEAR IT
RSCAN ;PUT NULL IN RESCAN BUFFER SO
; RSCAN WILL RETURN NO CHARACTERS
JSERR ;CATCH ERROR
;HERE ON NORMAL START
START: RESET ;GET RID OF PIDS, CLEAR INTERRUPTS, ETC.
MOVE A,[CALL UUOH] ;UUO HANDLER INVOKER
MOVEM A,41
XCT STKINI ;SET UP STACK
CALL ENBCAP ;ENABLE CAPABILITES
MOVEI T1,777+MESSAG ;GET AN ADDRESS WITHIN MESSAGE AREA
ANDI T1,777000 ;MESSAGE MUST START ON PAGE BOUNDARY
MOVEM T1,IPAGEX ;MESSAGE ADDRESS
LSH T1,-9 ;MAKE PAGE NUMBER
MOVEM T1,IPAGE ;REMEMBER FOR IPCF
MOVEI A,RMSG
HRRM A,RPDB+.IPCFP ;SET UP MESSAGE ADDRESSES
MOVEI A,OMSG ;BECAUSE PROGRAM MAY HAVE BEEN HALTED
HRRM A,OPDB+.IPCFP ;BEFORE "SNDMSG" FIXED THEM
MOVEI A,SMSG
HRRM A,SPDB+.IPCFP
;CLEAR VARIOUS LOCATIONS (SEE DATA DEFINITION FOR EXPLANATIONS)
SMNT,<
SETZM SMF
SETZM RMF
>;SMNT
TMNT,<
SETZM TMF
>;TMNT
SETZM MYPID
SETZM CURPID
SETZM WTFLG
SETZM INTFLG
SETZM TXTFLG
SETZM ABTFLG ;CLEAR THE "ABORT" FLAG
SETZM BYEFLG
SETZM ANSFLG
SETZM STAMP ;MAKE SURE COMMANDS FILE GETS READ THE FIRST TIME
SETZM NXTMSG
SETZM PCSAV1
SETZM IDFLG
SETZM CHCNT
SETZM BYTCNT
SETZM PIFLG ;INTERRUPTS INITIALLY OFF
SETZM SNDCNT
SETZM RCVCNT
SETZM TXTCNT
SETZM DTIME
SETZM QUECNT
SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVEI A,STRSIZ ;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
MOVEI B,STRBUF ;STARTS AT ADDRESS IN B
CALL RETMEM ;FREE IT UP IN STANDARD WAY
MOVEI A,DOMLEN ;INITIALIZE DOMESTIC STRUCTURES TABLE
MOVEM A,DOMTBL
MOVEI A,IGTLEN ;GET MAXIMUM LENGTH OF UNDETECTABLE STRUCTURE TABLE
MOVEM A,IGTBL ;INITIALIZE UNDETECTABLE STRUCTURE TABLE TO 0 ENTRIES
TMNT,<
MOVE T1,[SIXBIT "DEVNAM"]
SYSGT ;INIT TABLE PNTR
MOVEM T2,DEVNAM
MOVE T1,[SIXBIT "DEVCHR"]
SYSGT ;INIT TABLE PNTR
MOVEM T2,DEVCHR
MOVE T1,[SIXBIT "DEVUNT"]
SYSGT ;INIT TABLE PNTR
MOVEM T2,DEVUNT
>;TMNT
call clrtxt ;clear buffer area for received text
;SET UP BUFFER FOR OPERATOR ID. INITIALIZE TO ASSUME BLANK ID.
MOVE T1,[ASCII /SE/] ;RESTORE NULLS TO BYTES AFTER 'OPLEAS'
MOVEM T1,MYNAME+3
MOVE T1,[MYNAME+4,,MYNAME+5] ;CLEAR REMAINING WORDS
SETZM MYNAME+4
BLT T1,MYNAME+LINESZ+2
MOVE T1,[POINT 7,MYNAME+3,13] ;POINT TO LAST BYTE OF
MOVEM T1,INIBEG ;NAME SENT TO INFO
MOVEI T1,namlen ;SIZE OF NAMES SENT TO INFO
MOVEM T1,NAMSIZ ;INITIALIZE TO ASSUME NULL ID
;SET UP QUEUE AREA
MOVEI T1,QUEBEG
MOVEM T1,NXTADD
MOVEM T1,NXTREM
MOVEI T1,ONEBUF+777 ;GET ADDRESS WITHIN FIRST PAGE OF ONEWAY BUFFER
ANDI T1,777000 ;GET ADDRESS OF BEGINNING OF THAT PAGE
MOVEM T1,NXTPAG ;REMEMBER BEGINNING OF BUFFER
ADDI T1,<NPAGES-1>*1000 ;GET ADDRESS OF BEGINNING OF LAST PAGE IN BUFFER
MOVEM T1,LSTPAG ;REMEMBER
;FIND OUT MAXIMUM MESSAGE SIZE - USED WHEN RECEIVING IN NON-PAGE MODE
MOVEI T1,26 ;CODE:FIND MAX MESSAGE
MOVEM T1,MUTILD ;TO MUTIL AREA
MOVEI T1,2 ;T1/SIZE OF MUTIL AREA
MOVEI T2,MUTILD ;T2/LOCATION OF MUTIL AREA
MUTIL ;GET SIZE LIMIT
JSERR ;ERROR
MOVE T1,MUTILD+1 ;GET MAXIMUM MESSAGE SIZE
MOVEM T1,MAXMSG ;SAVE
;set up free page area for one-way messages. EACH PAGE POINTS TO NEXT FREE PAGE
move t1,nxtpag ;t1/first available location
init1: move t2,t1 ;first location in this page
addi t2,1000 ;first location in next page
movem t2,(t1) ;store next available address in this page
move t1,t2 ;next page
CAMGE T1,LSTPAG ;LAST ONE?
jrst init1 ;no.
setom (t1) ;yes. set last to -1 to indicate end of list
;..
SUBTTL FIRST - READS FIRST INPUT LINE
;THIS CODE READS THE LINE TYPED TO THE EXEC. THIS MAY BE OF THE FORM
;@OPLEAS ID
;@OPLEAS $
;@OPLEAS
;@R OPLEAS
;@START
;ETC. IT SEARCHES FOR THE ID AND STORES IT IN THE MYNAME AREA. IT SETS
;IDFLG ON FINDING AN ID
;READ THE LINE TYPED TO THE EXEC
;..
SETZ T1,
RSCAN ;PUT THE LINE IN INPUT BUFFER
JRST [ JSERR
JRST START2]
MOVEM T1,P6 ;SAVE BYTE COUNT
JUMPE P6,GTINFO ;IF NO CHARACTERS, STARTED WITH DDT.
; OR RESTARTED FROM WITHIN
;THERE IS AT LEAST ONE CHARACTER. SEE IF IT STARTED WITH JOB NAME.
;IF SO, MAY CONTAIN ID. IF NOT, GO ASK FOR IT.
MOVE P5,[440700,,JOBNAM] ;POINT TO JOB NAME
FIRST1: ILDB T2,P5 ;GET NEXT CHARACTER IN NAME
JUMPE T2,FIRST2 ;IF ZERO, MATCHED WHOLE NAME
PBIN ;YES. GET A CHARACTER
SOS P6 ;DECREMENT COUNT OF REMAINING CHARS
JUMPE P6,GTINFO ;LAST CHARACTER? MUST BE BREAK
CAMN T1,T2 ;DO THEY MATCH?
JRST FIRST1 ;YES. GO LOOK AT NEXT PAIR
JRST FIRST6 ;NO. DIDN'T START WITH JOBNAME
;STARTED WITH JOB NAME. LOOK FOR FIRST SPACE OR TAB
;JOB NAME MAY BE FOLLOWED BY RECOGNIZED FILE NAME, ETC.
FIRST2: PBIN ;READ NEXT CHARACTER
SOS P6 ;DECREMENT REMAINING COUNT
JUMPE P6,GTINFO ;LAST CHARACTER? MUST BE BREAK
CAIN T1,40 ;IS IT A BLANK?
JRST FIRST3 ;YES. ON TO ID AND TEXT
CAIE T1,.CHTAB ;NO. IS IT TAB?
JRST FIRST2 ;NO. GO TO NEXT CHARACTER
;FOUND SPACE OR TAB AFTER JOBNAME. LOOK FOR FIRST NON-SPACE,
;NON-TAB TO BEGIN ID OR TEXT.
FIRST3: PBIN ;YES. READ ONE
SOS P6 ;DECREMENT COUNT OF REMAINING CHARS
SKIPN P6 ;LAST CHARACTER?
JRST [ CAIN T1,.CHESC ;YES. ESCAPE?
SETOM IDFLG ;YES. MEANS BLANK ID
JRST GTINFO] ;IGNORE LAST CHARACTER. MUST BE BREAK
CAIN T1,40 ;SPACE?
JRST FIRST3 ;YES. KEEP LOOKING
CAIN T1,.CHTAB ;NO.TAB?
JRST FIRST3 ;YES. KEEP LOOKING
CAIE T1,.CHCRT ;NO. CARRIAGE RETURN?
JRST FIRST7 ;NO.
;yes. line feed follows
;QUIT BEFORE READING ENTIRE BUFFER. READ AND DISCARD
FIRST6: JUMPE P6,GTINFO ;IF ZERO, HAVE READ ALL
PBIN ;READ A CHARACTER
SOS P6 ;DECREMENT COUNT
JRST FIRST6
;HAVE FOUND 'JOBNAME...CHARACTER'. THE CHARACTER IS NON-BLANK.
;READ IT AND REMAINING CHARACTERS INTO MYNAME AREA
;STARTING AT BYTE POINTED TO BY INIBEG
FIRST7: MOVEI T1,.PRIIN ;BACK UP POINTER SO READ WILL INCLUDE
BKJFN ; CHARACTER ALREADY READ
JRST [ JSERR ;FAILED
JRST START2] ;START OVER
AOS P6 ;ADD TO COUNT FOR RE-READ CHARACTER
MOVE T1,INIBEG ;DEST:BYTE AFTER 'OPLEAS' IN
; MYNAME
MOVX T2,RD%BRK!RD%BEL ;STANDARD BREAK PLUS EOL
HRRI T2,INISIZ ;T2/BYTES AVAILABLE IN BUFFER
HRR T4,T2 ;SAVE LIMIT ON READ
SETZ T3, ;NO CTRL/R BUFFER
RDTTY ;READ INPUT LINE
jrst [ jserr ;read failed.
jrst start2] ;start over
txnn t2,rd%btm ;DID we read A BREAK CHARACTER?
jrst [ TYPE <
?INPUT TOO LONG. IT HAS BEEN REJECTED.
> ;no. RAN OUT OF BUFFER SPACE
jrst start2] ;start over
MOVE T3,T4 ;SPACE ORIGINALLY AVAILABLE
MOVEM T1,T4 ;SAVE POINTER TO LAST BYTE READ
SUBI T3,(T2) ;COMPUTE BYTES READ FROM BYTES REMAINING
SUB P6,T3 ;NUMBER BYTES STILL IN RESCAN BUFFER
FIRST9: SKIPE P6 ;ANY MORE CHARACTERS TO READ?
JRST [ PBIN ;YES. READ ONE AND DISCARD
SOS P6 ;DECREMENT THE COUNT
JRST FIRST9] ;REPEAT UNTIL ALL READ
MOVE P6,T4 ;P6/POINTER TO LAST BYTE
LDB P5,P6 ;SAVE LAST BYTE
SETZM CHCNT ;CLEAR COUNT OF NON-BLANK CHARACTERS
SETZM BYTCNT ;CLEAR COUNT OF BYTES
MOVE T1,INIBEG ;POINT TO BEGINNING
;LOOK THROUGH CHARACTERS LOOKING FOR ID
FIRST4: ILDB P5,T1 ;LOOK AT NEXT BYTE
AOS BYTCNT ;INCREMENT BYTE COUNT
cain p5,.chesc ;escape?
jrst [ setom idflg ;yes. operator id is null
jrst gtinfo]
CAMN T1,P6 ;IS IT THE LAST?
JRST FIRST8 ;YES. IGNORE TERMINATOR
CAIN P5,.CHCRT ;CARRIAGE RETURN?
JRST FIRST8 ;YES. NO CHARACTERS FOLLOW
CAIN P5,40 ;BLANK?
JRST FIRST8 ;YES. WE HAVE ENOUGH
CAIN P5,.CHTAB ;NO.TAB?
JRST FIRST8 ;YES. WE HAVE ENOUGH
CAIN P5,72 ;NO. COLON?
JRST FIRST8 ;YES. WE HAVE ENOUGH
;NOT PUNCTUATION, CR OR LAST CHARACTER. MUST BE PART OF ID.
AOS CHCNT ;INCREMENT CHARACTER COUNT
JRST FIRST4
;PUNCTUATION, CARRIAGE RETURN, OR LAST. IF ANY CHARACTERS READ, THEY
;MUST BE THE ID.
FIRST8: SKIPN CHCNT ;READ ANY CHARACTERS?
JRST GTINFO ;NO. ID NOT ENTERED
SETOM IDFLG ;YES. WE HAVE AN ID
MOVE T2,NAMSIZ ;ADD LENGTH OF ID TO NAME SIZE
ADD T2,BYTCNT
SOS T2 ;DON'T COUNT CURRENT CHARACTER
MOVEM T2,NAMSIZ
;..
SUBTTL GTINFO - GETS INFO NOT ENTERED IN CALL
;HERE AFTER PROCESSING THE LINE TYPED TO THE EXEC. IDFLG IS SET IF AN
;OPERATOR ID WAS FOUND. IF IT IS MISSING, THIS CODE PROMPTS FOR IT AND STORES
;THE ANSWER IN THE MYNAME AREA.
;REACHED VIA JRST
;..
GTINFO: SKIPE IDFLG ;DO WE HAVE AN OPERATOR ID?
JRST GTINF5 ;YES. DON'T ASK FOR IT
TYPE <%_What is your operator ID?>
MOVE T1,INIBEG ;READ ID INTO END OF NAME
MOVX T2,RD%BRK!RD%BEL ;STANDARD BREAK PLUS BEL
SETZ T3, ;NO CONTROL/R BUFFER
HRRI T2,INISIZ ;SPACE AVAILABLE AFTER NAME
RDTTY ;READ THE OPERATOR ID
jrst [ jserr ;ERROR IN READING
jrst start2] ;start over
txnn t2,rd%btm ;did we read all that was typed?
jrst [ TYPE <%_?INPUT TOO LONG. IT HAS BEEN REJECTED.%_> ;no. print message
jrst start2] ;start over
MOVEI T3,INISIZ ;ORIGINAL BYTES AVAILABLE
MOVEI T2,(T2) ;REMAINING BYTES AVAILABLE
SUB T3,T2 ;COMPUTE NUMBER READ
MOVEM T3,P6 ;P6/ NUMBER OF BYTES READ
LDB P5,A ;GET LAST CHARACTER
CAIN P5,33 ;ESCAPE?
CAIE P6,1 ;EXACTLY ONE CHARACTER?
JRST GTINF1 ;NOT LONE ALTMODE
MOVEI P5,0
DPB P5,A ;CHANGE ALTMODE TO NULL
TYPE <%_> ;JUST TYPE A CRLF IN RESPONSE TO ALTMODE
JRST GTINF5 ;LEAVE ORIGINAL NAME UNMODIFIED
;USER TYPED ID OR CR. BACK UP TO LAST CHARACTER NOT A BREAK
GTINF1: LDB P5,T1 ;LOOK AT LAST BYTE
CAIN P5,.CHLFD ;IS IT A LINE FEED?
JRST GTINF2 ;YES.
CAIN P5,72 ;COLON?
JRST GTINF2 ;YES.
CAIN P5,.CHCUN ;END OF LINE?
JRST GTINF2 ;YES.
CAIE P5,.CHCRT ;CARRIAGE RETURN?
JRST GTINF3 ;NO.
;LINE FEED, COLON, EOL OR CARRIAGE RETURN. KEEP BACKING UP
GTINF2: SOS P6
JUMPE P6,GTINF5 ;ANY MORE CHARACTERS?
BKJFN ;YES. BACK UP
JSERR
JRST GTINF1
;NOT A BREAK CHARACTER
GTINF3: MOVEM T1,INIBEG ;LAST CHAR IN ID. SAVE POINTER TO
; TO BEGINNING OF TEXT
MOVE T2,NAMSIZ ;INCREASE NAME SIZE BY LENGTH
ADD T2,P6 ; OF ID
MOVEM T2,NAMSIZ
GTINF5: JFCL
;..
SUBTTL GET A PID
;THIS CODE GETS A PID FOR THIS OPERATOR USING MUTIL. IT SAVES THE PID
;IN MYPID AND IN THE APPROPRIATE WORD OF THE 3 PDB'S.
;..
GETPID: SETOM F ;F/0 IF OVER PID QUOTA, -1 IF NOT
GETPI4: MOVEI T1,.MUCRE ;CREATE A PID
MOVEM T1,MUTILD ;FUNCTION CODE
MOVE T1,[0,,.FHSLF] ;MY FORK
MOVEM T1,MUTILD+1
MOVEI T1,3 ;T1/LENGTH
MOVEI T2,MUTILD ;T2/LOCATION
MUTIL
JRST GETPI1 ;FAILED
JRST GETPI3 ;SUCCEEDED
;UNABLE TO GET PID. IF EXCEEDED PID QUOTA, INCREASE QUOTA AND TRY
;AGAIN
GETPI1: CAIE T1,IPCF13 ;PID QUOTA EXCEEDED?
JRST GETPI2 ;NO. FATAL ERROR
JUMPE F,GETPI2 ;YES. HAVE WE HAD THIS BEFORE?
AOS F ;NO. SET FLAG TO SHOW IT HAPPENED
MOVEI T1,.MUFPQ ;FIND OUT PRESENT QUOTA
MOVEM T1,MUTILD ;FUNCTION: FIND PID QUOTA
SETOM MUTILD+1 ;JOB NUMBER (-1 FOR ME)
MOVEI T1,3 ;T1/LENGTH OF ARGUMENT BLOCK
MOVEI T2,MUTILD ;T2/LOCATION OF ARGUMENT BLOCK
MUTIL ;GET QUOTA
JRST GETPI2 ;CAN'T GET QUOTA
SETOM T4 ;-1 IF THIS SUCCEEDS, 0 IF FAILS
MOVEI T1,.MUSPQ ;FUNCTION:SET PID QUOTA
MOVEM T1,MUTILD
SETOM MUTILD+1 ;JOB NUMBER (-1 FOR ME)
AOS MUTILD+2 ;INCREASE QUOTA BY ONE
MOVEI T1,3 ;T1/LENGTH OF ARGUMENT BLOCK
MOVEI T2,MUTILD ;T2/LOCATION OF ARGUMENT BLOCK
MUTIL ;SET THE QUOTA
SETZM T4 ;CAN'T SET QUOTA
JUMPN T4, GETPI4 ;IF SUCCEEDED IN INCREASING QUOTA, TRY AGAIN
;..
;FATAL ERROR - NOT QUOTA PROBLEM OR QUOTA PROBLEM REPEATED
;OR COULDN'T INCREASE QUOTA
;..
GETPI2: JRST [ JSERR
QUIT1]
;GOT A PID. SAVE IN PDB'S
GETPI3: MOVE T1,MUTILD+2 ;SAVE THE PID
MOVEM T1,MYPID
MOVEI T2,RPDB ;SAVE MY PID IN RECEIVER FIELD FOR
MOVEM T1,.IPCFR(T2) ; RECEIVES
MOVEI T2,SPDB ;SAVE IN SENDER FIELD FOR INTERRUPT
MOVEM T1,.IPCFS(T2) ; LEVEL SENDS
MOVEI T2,OPDB ;SAVE IN SENDER FIELD FOR OPERATOR
MOVEM T1,.IPCFS(T2) ; SENDS
MOVE T2,MYPID ;T2/OPERATOR'S PID
SKIPE DEBUG ;DEBUGGING?
TYPE<%_D:Operator's PID is %2O%_> ;YES. PRINT OPERATOR'S PID
;INCREASE QUOTA
SETOM F ;F/-1 IF CONTINUE, 0 IF RESTART
MOVEI T1,.MUSSQ ;SET SEND AND RECEIVE QUOTA
MOVEM T1,MUTILD ;WORD 1/FUNCTION
MOVE T1,MYPID
MOVEM T1,MUTILD+1 ;WORD 2/PID
MOVEI T1,777B26+777B35 ;SEND AND RECEIVE 777 MESSAGES
MOVEM T1,MUTILD+2
MOVEI T1,3 ;T1/SIZE OF ARGUMENT BLOCK
MOVEI T2,MUTILD ;T2/LOCATION OF ARGUMENT BLOCK
MUTIL ;SET SEND AND RECEIVE QUOTAS
JRST [ SETZM F ;FAILED. CHECK FOR INSUFFICIENT PRIVILEGE
CAIN T1,IPCF10 ;NEED WHEEL PRIVILEGE?
SETOM F ;YES. SET FLAG
CAIN T1,IPCF11 ;NEED WHEEL OR IPCF PRIVILEGE?
SETOM F ;YES. SET FLAG
JSERR ;REPORT ERROR
SKIPN F ;NEED MORE PRIVILEGE?
JRST .+1 ;NO. START OVER
TYPE <%_%%Insufficient privilege. Unable to increase quota%_> ;YES. MAY BE ABLE TO CONTINUE
JRST .+1]
JUMPE F,START2 ;RESTART IF NOT A PRIVILEGE ERROR
;..
SUBTTL SET UP INTERRUPTS
;THIS CODE SETS UP FOR INTERRUPTS ON THE FOLLOWING CHANNELS:
;0-IPCF MESSAGE RECEIVED
;1-CTRL/T
;2-CTRL/C
;3-INPUT BUFFER GOES FROM EMPTY TO NON-EMPTY
;IT ACTIVATES CHANNEL 0 BUT DOESN'T ENABLE ANY CHANNELS. THUS AN
;IPCF INTERRUPT IS DELAYED UNTIL THE INTERRUPTS ARE ENABLED.
;REACHED VIA JRST
;..
CIS ;CLEAR THE INTERRUPT SYSTEM
MOVEI T1,.MUPIC ;ASSOCIATE PID WITH CHANNEL
MOVEM T1,MUTILD ;FUNCTION CODE
MOVE T1,MYPID ;PID FOR OPLEASE
MOVEM T1,MUTILD+1 ;PID TO ASSOCIATE WITH CHANNEL
SETZM MUTILD+2 ;CHANNEL 0
MOVEI T1,3 ;T1/LENGTH OF ARGUMENT BLOCK
MOVEI T2,MUTILD ;T2/LOCATION OF ARGUMENT BLOCK
MUTIL ;ASSOCIATE CHANNEL WITH PID
JRST [ JSERR ;CAN'T SET UP CHANNEL. QUIT
SKIPN DEBUG ;DEBUGGING?
QUIT1 ;NO. GIVE UP
MOVE T2,MYPID ;T2/PID USED IN MUTIL
TYPE <%_D:Trying to associate PID %2O with channel 0%_> ;YES. PRINT PID
QUIT1] ;GIVE UP
MOVE T1,[.TICCT,,1] ;CTRL/T ON CHANNEL 1
ATI ;ASSIGN CTRL/T TO CHANNEL 1
MOVX T1,.FHSLF ;T1/MY FORK
RPCAP ;GET PRESENT CAPABILITIES
txnn t2,sc%ctc ;can we enable ctrl/c?
jrst chan ;no. don't try
TXO T3,SC%CTC ;ALLOW CTRL/C INTERRUPTS
EPCAP ;ENABLE THIS PLUS EXISTING
MOVE T1,[.TICCC,,2] ;CTRL/C ON CHANNEL 2
ATI ;ASSIGN CTRL/C TO CHANNEL 2
CHAN: MOVE T1,[.TICTI,,3] ;INPUT BUFFER NON-EMPTY
ATI ;ASSIGN BUFFER NON-EMPTY TO 3
MOVX T1,.FHSLF ;MY FORK
MOVE T2,[LEVTAB,,CHNTAB] ;
SIR ;SET UP INTERRUPT TABLES
movei t1,.fhslf ;t1/my fork
MOVX T2,1B0+1B<.ICILI>+1B<.ICPOV> ;ACTIVATE CHANNELS
aic ;activate channelS
;..
;SEND NAME TO INFO.
;..
MOVEI P2,OPDB ;P2/ADDRESS OF SEND PDB
MOVEI P4,OPDBSZ ;P4/SIZE OF SEND PDB
MOVEI P3,OMSG ;P3/ADDRESS OF SEND MESSAGE
CALL SNDNAM
JRST START2 ;FAILED. RESTART
;TRY TO ASSIGN PID TO BE MDA PID
TMNT,<
LDB T1,[POINT 7,MYNAME+3,20]
CAIE T1,.CHESC ;CHECK FOR ESCAPE
CAIN T1,.CHLFD ; OR LINE-FEED
MOVEI T1,.CHCRT ;FAKE UP CR
CAIE T1,.CHCRT ;CHECK FOR NULL ID
JRST NOMDA ;NO - DONT BECOME MDA
MOVEI T3,.MURSP ;FCN TO READ MDA PID
MOVEM T3,MUTILD
MOVEI T3,.SPMDA ;INDEX INTO SYSTEM PID TABLE
MOVEM T3,MUTILD+1
MOVEI T1,3 ;LEN OF ARGS
MOVEI T2,MUTILD ;ADDRS OF ARGS
MUTIL ;READ TABLE
JRST [CAIE T1,IPCF27 ;NO SUCH PID ERROR
JSERR ;NO - LOSAGE
MOVEI T1,3 ;RESTORE T1
MOVE T3,MYPID ;SETUP PID TO USE
JRST SETMDA] ;...
MOVE T3,MYPID ;CHECK IF PID ALREADY THERE
CAMN T3,MUTILD+2 ;...
JRST NOMDA ;NO NEED TO SET ONE
SETMDA: MOVEM T3,MUTILD+2 ;SET PID IN ARG BLOCK
MOVEI T3,.MUSSP ;FCN CODE TO SET PID
MOVEM T3,MUTILD ;STORE IN BLOCK
MUTIL ;SET SYSTEM PID FOR MDA
JSERR ;LOSAGE
NOMDA:
> ;TMNT
;ACTIVATE CTRL/C,CTRL/T, AND INPUT BUFFER CHANNELS.
;ENABLE INTERRUPT SYSTEM
MOVX T1,.FHSLF ;T1/MY FORK
MOVX T2,1B1!1B2!1B3 ;T2/CHANNELS TO ACTIVATE
aic ;activate ctrl/c,ctrl/t,input buffer
CALL PION ;TURN ON INTERRUPTS
;CAUSE AN INTERRUPT ON THE IPCF CHANNEL IN CASE THERE WAS A MESSAGE
;IN THE QUEUE WHEN THE CHANNEL WAS ACTIVATED. INTERRUPT ROUTINE
;WILL IGNORE THE INTERRUPT IF THE MRECV FAILS.
MOVEI T1,.FHSLF ;T1/MY FORK
MOVX T2,1B0 ;T2/CHANNEL 0 (IPCF INTERRUPT)
IIC ;CAUSE INTERRUPT ON CHANNEL IN CASE
; MESSAGE ALREADY THERE
;..
SUBTTL WAKEUP
;THIS IS THE MAIN NON-INTERRUPT LEVEL ROUTINE. IT IS STARTED FOR THE
;FIRST TIME AFTER THE FORCED IPCF INTERRUPT. IT CLEARS INTFLG WHEN IT
;STARTS. WHEN IT HAS NOTHING TO DO, IT CHECKS INTFLG. IF IT IS SET, AN
;INTERRUPT HAS OCCURRED SINCE WAKEUP BEGAN, SO IT STARTS OVER. OTHERWISE, IT
;SETS WTFLG AND SLEEPS.
;EACH INTERRUPT ROUTINE DECIDES WHERE TO RETURN BASED ON WTFLG. IF IT IS
;SET, THE ROUTINE RETURNS TO WAKEUP. OTHERWISE, IT RETURNS TO THE
;NEXT LOCATION TO BE EXECUTED WHEN THE INTTERRUPT OCCURRED.
;REACHED VIA DEBRK.
;..
WAKEUP:
SETZM INTFLG ;CLEAR INTERRUPT FLAG
SETZM WTFLG ;CLEAR WAIT FLAG
;IF TEXT HAS COME IN FROM PLEASE, IT IS STORED IN TXTBUF. PRINT IT.
;THE MESSAGES ARE CONCATENATED. A NULL FOLLOWS THE LAST MESSAGE.
MOVX T1,.FHSLF ;T1/MY FORK
DIR ;NO INTERRUPTS WHILE READING BUFFER
MOVX T1,.FHSLF ;T1/MY FORK
EIR ;ENABLE INTERRUPTS
;SEE IF THE OPERATOR HAS TYPED ON THE TERMINAL.
MOVEI T1,.PRIIN ;T1/PRIMARY INPUT DEVICE
SIBE ;HAS OPERATOR TYPED ANYTHING?
JRST WAKE1 ;YES. READ IT.
JRST WAKE3 ;NO.
;OPERATOR HAS TYPED. READ IT
WAKE1: HRROI T1,OMSG+1 ;POINT TO BEGINNING OF BUFFER
MOVX T2,RD%BRK!RD%BEL ;STANDARD BREAK PLUS EOL
HRRI T2,<OMSGSZ*5>-10 ;NUMBER OF BYTES (leave room to
; add crlf and null if not read)
SETZ T3, ;NO CTRL/R BUFFER
SETZM RDFLG ;INITIALIZE TO SAY ALL CHARACTERS READ
RDTTY
JSERR
SKIPN CURPID ;IS THERE A CURRENT PID?
JRST [ TYPE<%_%%No current user. Input ignored.%_>
JRST WAKE3]
SMNT,<
SKIPE SMF ;WAITING FOR STRUCTURE TO BE MOUNTED?
JRST SMOPR ;YES, PERHAPS OPERATOR IS REFUSING
>;SMNT
TMNT,<
SKIPE TMF ;TMOUNT REQUEST?
JRST TMOPR ;YES - HANDLE RESPONSE
>;TMNT
TXNE T2,RD%BTM ;DID WE GET EVERYTHING TYPED?
JRST [ LDB P5,T1 ;YES. SAVE LAST CHARACTER TYPED
JRST WAKE12] ;GO SEND THE MESSAGE
;..
;read ended on buffer full. operator wants to send more. send this
;much and go read the rest.
;..
MOVEM T1,P6 ;SAVE POINTER TO LAST CHARACTER READ
TYPE <%_%%Text exceeds maximum for one message. Message being sent.%_>
SETOM RDFLG ;SET FLAG TO READ REST OF INPUT
MOVE T1,P6 ;RESTORE POINTER TO T1
MOVEI T4,.CHCRT ;APPEND A CR SINCE operator DIDN'T GET IT IN
IDPB T4,T1 ;ADD IT FOR LOOKS AT user'S END
MOVEI T4,.CHLFD ;SIMILARLY LINE FEED
IDPB T4,T1
SETZ T4, ;END WITH NULL FOR SOUT IN upleASE
IDPB T4,T1
;send as much as we HAVE READ
WAKE12:
CALL SNDTXT ;SEND WHAT OPERATOR HAS TYPED TO USER
JRST WAKEUP ;COULDN'T
skipe rdflg ;is there more to read?
jrst wake1 ;yes. go read it
;entire message read. check terminator for goodbye
caie P5,.CHCNZ ;NO. ENDED WITH CTRL/Z?
CAIN P5,.CHESC ;NO. ESCAPE?
WAKE13: JRST [ MOVX T2,1B1 ;SET BYEFLG TO INDICATE OPR QUIT
IORM T2,BYEFLG
JRST wake3]
jrst wakeup ;see if operator has typed more
;ROUTINE FOR SENDING TEXT TO USER. SKIPS IFF SUCCEEDS
SNDTXT: MOVEI A,PLTXT ;CODE IS "TEXT"
CALL BLURB ;SEND THE TEXT
RET ;FAILURE RETURN
RETSKP ;SUCCESS RETURN
;ROUTINE TO SEND TEXT WITH ARBITRARY CODE (CODE DETERMINES TYPE
;OF TEXT, FOR INSTANCE IS IT AN ERROR MESSAGE OR A BIRTHDAY
;GREETING ??)
;ACCEPTS:
; A/ CODE TO SEND
;RETURNS:
; +1 FAILURE
; +2 WIN
BLURB: MOVEM A,OMSG ;STORE DESIRED CODE
MOVEI P2,OPDB ;P2/LOCATION OF SEND PDB
MOVE T1,CURPID
MOVEM T1,.IPCFR(P2) ;SEND TO CURRENT PID
AOS T1,SNDCNT ;INCREMENT COUNT OF TEXT MESSAGES SENT
HRLM T1,OMSG ;SEND WITH MESSAGE
MOVEI P4,OPDBSZ
CALL SNDMSG ;SEND TEXT JUST READ
JRST [ CALL ERR1 ;FAILED. RETRY IF OVER RECEIVE QUOTA
RET ;RETRY FAILED OR COULDN'T RETRY
JRST .+1] ;RETRY SUCCEEDED
RETSKP ;SUCCESS
;SEE IF ANYONE HAS SAID GOODBYE
WAKE3: SKIPN P6,BYEFLG ;HAS ANYONE SAID GOODBYE? LOAD P6
JRST WAKE6 ;NO.
;SOMEONE HAS SAID GOODBYE. IF TEXT HAS BEEN RECEIVED AND NOT
;PRINTED, DUMP THE BUFFER
MOVE P5,RCVCNT ;SAVE NUMBER OF LAST MESSAGE RECEIVED
;SEE WHO SAID GOODBYE
TXNE P6,1B0 ;WAS IT THE USER?
JRST WAKE10 ;YES.
TXNN P6,1B1 ;NO. WAS IT OPERATOR?
JRST WAKE6 ;NO.
;OPERATOR HAS SAID GOODBYE AND USER HAS NOT. SEND 'GOODBYE'
MOVEI P2,OPDB ;p2/address of send pdb
MOVE T1,CURPID ;SEND TO CURRENT PID
MOVEM T1,.IPCFR(P2)
MOVEI T1,PLBYE ;CODE IS GOODBYE
MOVEM T1,OMSG ;SAVE IN FIRST WORD OF MESSAGE
HRLM P5,OMSG ;SEND NUMBER OF LAST MESSAGE RECEIVED
MOVEI P4,OPDBSZ ;P4/LENGTH OF PDB
CALL SNDMSG ;SEND 'GOODBYE' TO CURRENT USER
JRST [ CAIE T1,IPCFX7 ;RECEIVER'S QUOTA EXCEEDED?
JRST .+1 ;NO. ASSUME IT WENT AWAY
MOVEI T1,^D1000 ;TIME TO WAIT
DISMS ;WAIT A WHILE
CALL SNDMSG ;TRY AGAIN
JFCL ;FAILED AGAIN. GIVE UP
JRST .+1] ;SUCCEEDED SECOND TIME
JRST WAKE4 ;GO PRINT MESSAGE
;USER SAID GOODBYE. SEE IF ALL THE MESSAGES WE SENT GOT THERE
WAKE10: MOVE T1,TXTCNT ;T1/NUMBER OF LAST RECEIVED BY PLEASE
CAML T1,SNDCNT ;SAME AS NUMBER SENT?
JRST WAKE4 ;YES. GOOD
TYPE <%_%%Part of your message was not transmitted.%_> ;NO. WARN OPERATOR
SKIPN DEBUG ;DEBUGGING?
JRST WAKE4 ;NO. DON'T PRINT MESSAGE
MOVE T2,SNDCNT ;T2/NUMBER SENT
TYPE <%_D:Number of messages sent: %2D>
MOVE T2,TXTCNT ;T2/NUMBER OF MESSAGES RECEIVED BY UPLEASE
TYPE <%_D:Number of messages received: %2D>
;PRINT MESSAGE INDICATING FINISHED WITH THIS USER
WAKE4: MOVX T3,1B0!1B17 ;T3/TIME ONLY, NO COLUMNATION
AOSN SILNTF ;ALLOWED TO PRINT?
JRST NOPNT ;NO, SKIP THIS THEN
SKIPE ABTFLG ;DIFFERENT MESSAGE IF USER ABORTS
TYPE <[User aborted transaction at %3C]%_>
SKIPN ABTFLG
TYPE <[Transaction finished at %3C]%_>
NOPNT:
;..
;RESET FLAGS, CLEAR BUFFERS
;DON'T ALLOW INTERRUPTS WHILE STRAIGHTENING OUT ALL THE FLAGS
;..
MOVEI T1,.FHSLF ;T1/MY FORK
DIR ;DISABLE INTERRUPTS
TMNT,< SETZM TMF> ;CLEAR TMOUNT FLAG
SMNT,< SETZM SMF
SETZM RMF> ;CLEAR SMOUNT FLAG
SETZM CURPID ;NO CURRENT PID
SETZM BYEFLG ;NO 'BYE'
SETZM ABTFLG ;CLEAR "ABORT" FLAG
SETZM ANSFLG ;NOT WAITING FOR ANSWER
SETZM SNDCNT ;RESET COUNT OF MESSAGES SENT
SETZM RCVCNT ;RESET LAST MESSAGE RECEIVED
SETZM TXTCNT ;RESET LAST MESSAGE RECEIVED BY UPLEASE
MOVEI T1,.PRIIN ;CLEAR INPUT BUFFER IN CASE OPERATOR
CFIBF ; TYPED AFTER GOODBYE DETECTED
MOVEI T1,.FHSLF ;T1/MY FORK
EIR ;ENABLE INTERRUPTS
;SEE IF ANYONE IS WAITING IN THE QUEUE.
WAKE9: SKIPN QUECNT ;ANYONE WAITING?
JRST WAKE6 ;NO.
;SOMEONE IS WAITING IN THE QUEUE. TAKE FIRST USER.
;IF ENTRY IS PID, USER IS WAITING FOR 2-WAY CONVERSATION. IF IT IS
;AN ADDRESS, USER SENT ONE-WAY.
MOVEI T1,.FHSLF
DIR ;NO INTERRUPTS WHILE ADJUSTING QUEUE
SOS QUECNT ;YES. DECREMENT QUEUE COUNT
AOS T1,NXTREM ;INCREMENT POINTER TO OLDEST ETNRY
; AND LOAD INTO T1
MOVE P6,-1(T1) ;TAKE PID FROM OLDEST ENTRY
CAILE T1,QUEFIN ;AT END OF QUEUE AREA?
JRST [ MOVEI T1,QUEBEG ;YES. POINT TO TOP OF AREA
MOVEM T1,NXTREM ;SAVE AS NEXT ENTRY TO REMOVE
jrst .+1]
txnn p6,777777b17 ;is this an address (lh zero)?
;QUEUE entry is location OF ONE-WAY MESSAGE. print message
jrst [ move p5,p6 ;yes. p5/address of message
call prtone ;print the message
call retpag ;return page to free space
movei t1,.priin ;clear input buffer in case operator
cfibf ; tried to answer one-way
movei t1,.fhslf ;t1/my fork
eir ;enable interrupts
jrst wake9] ;go get next person in queue
;..
;entry is a pid. send ok and start two-way communication
;..
TMNT,<
TLZE P6,(1B0) ;CHECK FOR TMOUNT REQUEST
SETOM TMF ; SET FLAG
>;TMNT
SMNT,<
TLZE P6,(1B1) ;CHECK FOR SMOUNT REQUEST
SETOM SMF ; SET FLAG
SKIPE SMF ;DON'T IDENTIFY USER HERE FOR SMOUNT
JRST WAKESM
>;SMNT
CALL USERID ;IDENTIFY THE USER
JRST [ MOVEI T1,.FHSLF ;FAILED. T1/MY FORK
EIR ;ENABLE INTERRUPTS
JRST WAKE9] ;USER NOT THERE. GET NEXT ONE
SMNT,<
WAKESM:
>;SMNT
SETOM ANSFLG ;WAITING FOR ANSWER TO 'OK'
MOVEM P6,CURPID ;MAKE THIS THE CURRENT PID
MOVEI T1,.FHSLF ;T1/MY FORK
EIR
MOVEI P2,OPDB ;P2/ADDRESS OF SEND PDB
MOVEI P4,OPDBSZ ;P4/SIZE OF SEND PDB
MOVEM P6,.IPCFR(P2) ;RECEIVER - CURRENT PID
MOVEI T1,PLOK ;MESSAGE IS 'OK'
MOVEM T1,OMSG
CALL SNDMSG ;SEND MESSAGE
JRST [ CALL ERR1 ;FAILED. IF RECEIVE QUOTA FULL, RETRY
JRST WAKEUP ;RETRY FAILED OR COULDN'T RETRY
JRST .+1] ;RETRY SUCCEEDED.
;BEGIN WAITING FOR ANSWER
TIME ;GET CURRENT TIME
ADD T1,DELAY ;ADD TIME TO WAIT FOR ANSWER
MOVEM T1,DTIME ;SAVE TIME TO GIVE UP
SETOM WTFLG ;INTERRUPT WILL GO TO WAKEUP
SKIPE INTFLG ;HAS THERE BEEN AN INTERRUPT
JRST WAKEUP ;YES. WAKEUP
move t1,delay ;no. set wait time
DISMS ;WAIT
JRST WAKE7 ;CAME OUT OF DISMISS WITHOUT
; GETTING TEXT.
;IF WAITING FOR ANSWER TO 'OK', WAIT LIMITED TIME HERE.
;OTHERWISE, GO TO STANDARD WAIT
WAKE6: SKIPN ansflg ;WAITING FOR RESPONSE TO 'OK'?
jrst WAKE8 ;NO.
SKIPE TXTFLG ;YES. HAS ANY TEXT COME IN?
JRST WAKEUP ;YES. GO LOOK AT IT
time ;NO.what time is it now?
caml t1,dtime ;did we time out?
jrst WAKE7 ;yes.
setom wtflg
skipe intflg ;HAVE THERE BEEN ANY INTERRUPTS?
jrst wakeup ;YES. GO SEE WHAT
move t2,dtime ;compute new dismiss time
subb t2,t1 ;save in t1
disms ;wait
;PLEASE DIDN'T RESPOND TO 'OK' IN TIME. TELL OPERATOR
WAKE7: TYPE <%_%%User not responding. (Type ESCAPE to proceed to next user)%_>
;IF INTERRUPTS HAVE COME IN, REPEAT WAKEUP CODE. IF NOT, WAIT
;FOR ANOTHER INTERRUPT.
WAKE8:
SMNT,<
SKIPE SMF ;WAITING FOR A STRUCTURE?
JRST SFIND ;YES, SEE IF IT'S ON-LINE YET
>;SMNT
SETOM WTFLG ;SET FLAG INDICATING WAITING
SKIPE INTFLG ;HAS AN INTERRUPT BEEN PROCESSED?
JRST WAKEUP ;YES. SEE WHAT NEEDS TO BE DONE
WAIT ;NO. WAIT FOR SOMETHING TO HAPPEN
;SHOULDN'T GET HERE. PRINT MESSAGE IF DEBUGGING. IGNORE OTHERWISE
SKIPN DEBUG ;DEBUGGING?
JRST WAKEUP ;NO. IGNORE ERROR
TYPE <%_D:At halt after WAIT%_> ;YES. PRINT ERROR AND QUIT
JRST WAKEUP
SUBTTL SNDMSG
;SEND A MESSAGE WHOSE PDB AND MESSAGE AREA HAVE BEEN SET UP.
;THIS ROUTINE ASSUMES A REAL 18-BIT ADDRESS IN WORD .IPCFP
;OF THE PDB. THE ROUTINE MOVES THE MESSAGE TO A PAGE BOUNDARY
;IN FREE SPACE AND MODIFIES .IPCFP ACCORDINGLY.
ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;P4/SIZE OF SEND PDB
;REACHED VIA CALL SNDMSG FROM ROUTINE AT EITHER INTERRUPT OR NON-
;INTERRUPT LEVEL
;RETURNS: +1 SEND FAILED
; +2: SEND SUCCEEDED
SNDMSG: MOVEI T1,400000
DIR ;NO INTERRUPTS DURING MESSING AROUND
HRLZ T1,.IPCFP(P2) ;GET ADDRESS OF DATA TO SEND
HRR T1,IPAGEX ;ADDRESS FROM WHICH MSEND REALLY WILL READ DATA
MOVE T2,IPAGEX
BLT T1,SMSGSZ-1(T2) ;MOVE DATA TO REAL PAGE FOR IPCF
HRL T1,P2 ;GET ADDRESS OF PDB
HRRI T1,IPDB ;MOVE TO THE REAL PDB
MOVS T3,T1 ;SAVE BLT POINTER FOR RETURNING THE PDB
BLT T1,IPDB-1(P4) ;COPY THE PDB
MOVE T1,IPAGE ;GET IPCF PAGE NUMBER
HRRM T1,.IPCFP+IPDB ;DUMB SYSTEM REQUIRES REAL PAGE FOR IPCF
MOVE T1,P4 ;T1/ SIZE OF SEND PDB
MOVEI B,IPDB ;USE OUR OWN PDB
MSEND ;SEND THE MESSAGE
JRST SNDMS1
HRR T2,.IPCFP(P2) ;SAVE THE MESSAGE ADDRESS
ADDI T1,-1(P2) ;COMPUTE END ADDRESS OF CALLER'S PDB
BLT T3,(T1) ;COPY FINAL REAL PDB INTO USER'S PDB
HRRM T2,.IPCFP(P2) ;PRESERVE CALLER'S ADDSS OF MESSAGE
MOVEI T1,400000
EIR ;TURN INTERRUPTS BACK ON
RETSKP ;SUCCEEDED
;FAILED. PRINT INFO IF DEBUGGING.
SNDMS1: call pion ;turn interrupts back on
SKIPN DEBUG ;DEBUGGING?
RET ;NO. NO MESSAGES.
MOVE T2,.IPCFR(P2) ;T2/RECEIVER
TYPE <%_D:Failed on send to PID %2O>
MOVE T2,SMSG ;T2/FIRST WORD OF MESSAGE
TYPE <%_D:First word of message: %2O%_>
RET
;THE FOLLOWING ROUTINE SENDS AN IPCF CODE AT INTERRUPT LEVEL.
;
;ACCEPTS:
; A/ CODE TO BE SENT
; B/ PID TO SEND IT TO
;RETURNS: +1 ALWAYS
SNDCOD: MOVEM B,.IPCFR+SPDB ;SET UP PID TO SEND MESS TO
MOVEM A,SMSG ;SET UP CODE BEING SENT
PUSH P,P4 ;DON'T CLOBBER P4
PUSH P,P2 ;OR P2
MOVEI P4,SPDBSZ ;SET UP SIZE OF PDB
MOVEI P2,SPDB ;SET UP PDB ADDRESS
CALL SNDMSG ;SEND THE MESSAGE
JFCL ;DON'T WORRY ABOUT ERROR HERE
POP P,P2
POP P,P4
RET
;ROUTINE TO SEND MESSAGE TO OURSELF
;ACCEPTS:
; A/ CODE TO BE SENT
;RETURNS: +1 ALWAYS
BABBLE: MOVE B,MYPID ;SEND MESSAGE TO OURSELF
CALLRET SNDCOD ;SEND THE CODE
SUBTTL USERID
;IDENTIFY THE NEXT USER TO BE PROCESSED
;ACCEPTS:
;P6/USER'S PID
;RETURNS: +1 IF USER NOT THERE (INVALID PID, JOB NUMBER)
; +2 IF SUCCEED
USERID:
SETZM USER ;CLEAR AREA TO CONTAIN USER
MOVE T1,[USER,,USER+1] ; INFO: LINE NUMBER AND
BLT T1,USER+USRSIZ-1 ; DIRECTORY
movei t1,.mufoj ;CODE: get job number
movem t1,mutild ;TO MUTIL AREA
move t1,p6 ;USER'S PID
movem t1,mutild+1
movei t1,3 ;t1/length
movei t2,mutild ;t2/location
mutil ;GET THE USER'S JOB NUMBER
JRST [ CALL USERI1 ;FAILED. PRINT ERROR
RET] ;ERROR RETURN
MOVEI T1,.FHSLF ;T1/MY FORK
RPCAP ;READ MY CAPABILITIES
TXO T3,SC%GTB ;ADD GETAB CAPABILITY
EPCAP ;ENABLE WITH GETAB ADDED
MOVE T1,MUTILD+2 ;T1/JOB NUMBER
MOVE T2,[-2,,USER] ;T2/2 WORDS, WRITE TO USER
MOVEI T3,.JITNO ;T3/START WITH TERMINAL NO.
GETJI ;FIND OUT ABOUT USER'S JOB
JRST [ CALL USERI1 ;FAILED. PRINT ERROR
RET]
HRROI T1,USER+2 ;T1/POINTER TO USER AREA
MOVE T2,USER+1 ;T2/USER'S DIRECTORY NUMBER
DIRST ;CONVERT TO DIRECTORY NAME
JSERR ;FAILED. PRINT ERROR AND CONTINUE
TYPE <%_[>
SKIPE TMF
JRST NOTPLS ;IF TMOUNT, THEN NOT PLEASE
SKIPN SMF
SKIPE RMF
CAIA ;IF SMOUNT OR SREMOVE, THEN NOT PLEAS
TYPE <PLEASE:>
NOTPLS:
TMNT,<
SKIPE TMF ;CORRECT HEADING
TYPE <TMOUNT:>
>;TMNT
SMNT,<
SKIPN RMF ;DON'T SAY "SMOUNT" FOR "SREMOVE"!!
SKIPN SMF ;CORRECT HEADING
CAIA
TYPE <SMOUNT:>
SKIPE RMF ;CORRECT HEADING
TYPE <SREMOVE:>
>;SMNT
HRROI T1,USER+2 ;T1/POINTER TO DIRECTORY NAME
MOVE T2,MUTILD+2 ;T2/JOB NUMBER
MOVE T3,USER ;T2/TERMINAL NUMBER
MOVX T4,1B17 ;NO COLUMNATION FOR DATE AND TIME
TYPE < User %1A Job %2D Line %3O Received at %4C]%_>
TMNT,<
SKIPE TMF
MOVEM T2,TMF ;SAVE JOB # IN FLAG
>;TMNT
RETSKP ;SUCCESSFUL RETURN
;UNABLE TO GET INFORMATION ON USER.
USERI1: CAIN T1,IPCF27 ;'NOT A DEFINED PID' FROM MUTIL?
JRST USERI2 ;YES. TELL OPERATOR
CAIE T1,GTJIX3 ;ILLEGAL JOB NUMBER FROM GETJI?
JRST USERI3 ;NO. UNKNOWN ERROR
USERI2: SKIPE DEBUG ;DEBUGGING?
USERI3: JSERR
RET
SUBTTL PRTONE - PRINT ONEWAY MESSAGE
;ONEWAY MESSAGE IS TO BE PRINTED. CAN BE IN MESSAGE AREA IF JUST RECEIVED.
;IF NOT, IS IN FREE PAGE AREA.
;ACCEPTS:
;P5/ADDRESS OF MESSAGE
;REACHED VIA CALL PRTONE FROM INTERRUPT OR NON-INTERRUPT LEVEL ROUTINE
;RETURNS +1: ALWAYS
PRTONE:
MOVE T2,1(P5) ;T2/TIME SENT
TYPE<%_[PLEASE: One-way sent at %2T]>
HRROI T1,USER+2 ;T1/POINT TO STORAGE AREA
MOVE T2,2(P5) ;T2/USER'S LOGGED IN DIRECTORY
DIRST ;CONVERT DIRECTORY TO STRING
JSERR ;FAILED
HRROI T1,USER+2 ;T1/POINTER TO DIRECTORY NAME
MOVE T2,3(P5) ;T2/GET USER'S LINE NUMBER
MOVX T3,1B0!1B17 ;T3/TIME ONLY, NO COLUMNATION
HRROI D,4(P5) ;D/POINTER TO TEXT
TYPE <%_[User %1A Line %2O Received at %3C]%_%4A>
RET
SUBTTL MOVTXT
;MOVE TEXT FROM ONEWAY OR TEXT MESSAGE TO BUFFER TO BE PRINTED
;ACCEPTS:
;T2/BYTE POINTER TO TEXT IN MESSAGE AREA
;RETURNS +1: ALWAYS
MOVTXT:
MOVE T1,BUFNXT ;POINT TO NEXT AVAILABLE LOCATION
; IN BUFFER
MOVEI T3,BUFEND ;end of buffer area
hrrz t4,bufnxt ;next available location
SUB T3,T4 ;words available
SOS T3 ;round down to full word
JUMPLE T3,MOVTX1 ;ERROR IF NO SPACE
IMULI T3,5 ;bytes available
SETZ T4, ;STOP ON NULL BYTE
SOUT ;TRANSFER TEXT TO OUTPUT AREA
BKJFN ;BACKUP THE POINTER TO OVERWRITE THE
JFCL ; NULL NEXT TIME (T1 CONTAINS POINTER)
MOVEM T1,BUFNXT ;UPDATED POINTER
SETOM TXTFLG ;SET FLAG TO INDICATE BUFFER NON-EMPTY
JUMPE T3,MOVTX1 ;END OF BUFFER?
RET
;BUFFER OVERFLOW
MOVTX1: TMSG<
%%Text deleted from incoming message.
>
RET
SUBTTL PRNTXT
;PRINT TEXT THAT HAS COME IN AND IS WAITING IN THE BUFFER
;RETURNS +1 ALWAYS
PRNTXT: CALL PIOFF ;TURN OFF INTERRUPTS WHILE WE DO THIS
SETZM TXTFLG ;CLEAR TEXT FLAG
HRROI T1,TXTBUF ;POINT TO BEGINNING OF BUFFER
PSOUT ;PRINT TEXT
setzm ansflg ;no longer waiting for answer to 'ok'
call clrtxt ;clear buffer area and reset bufnxt
CALL PION
RET
subttl clrtxt
;clears txtbuf area - contains text that has been received but not
;typed out. called at initialiZation and after all characters have
;been typed. clears the area and resets bufnxt to point to start
;INTERRUPTS HAVE BEEN DISABLED BY CALLING ROUTINE
;REACHED VIA CALL PRNTXT BY NON-INTERRUPT LEVEL ROUTINE
;RETURNS +1 ALWAYS
clrtxt: setZM txtbuf
move t1,[txtbuf,,txtbuf+1]
blt t1,bufend-1
hrroi t1,txtbuf
movem t1,bufnxt
RET
SUBTTL REMPID
;REMOVE A PID FROM INTERNAL QUEUE.
;ACCEPTS:
;Q2/ PID TO BE REMOVED
;REACHED VIA CALL REMPID FROM INTERRUPT OR NON-INTERRUPT LEVEL ROUTINE
;RETURNS: +1 PID NOT FOUND
; +2 PID REMOVED
REMPID: SKIPN QUECNT ;ANYTHING IN QUEUE?
RET ;NO. ERROR
TMNT,<
MOVE T3,Q2 ;COPY OF PID
TLO T3,(1B0) ;WITH BIT 0 ON
>;TMNT
SMNT,<
MOVE T2,Q2 ;COPY OF PID
TLO T2,(1B1) ;WITH BIT 1 ON
>;SMNT
MOVE T4,NXTREM ;POINT TO FIRST ENTRY
CHECK: TMNT,<
CAME T3,(T4)> ;MATCH?
CAMN Q2,(T4) ;IS THIS THE PID?
JRST FIND ;YES. GO TAKE IT OUT
SMNT,<
CAMN T2,(T4) ;MAYBE ENTRY HAS BIT 1 ON
JRST FIND ;THESE THREE COMPARES COULD HAVE PROBABLY
;BEEN BEEN MADE ONE WITHOUT TOO MUCH
;EFFORT, BUT THERE WERE ALREADY TWO WHEN
;I ADDED THE THIRD AND DID SO TO MINIMIZE
;MY CHANCES OF DOING SOMETHING WRONG,
;CONSIDERING I DIDN'T STUDY THIS ROUTINE
;TOO CAREFULLY. /EO
>;SMNT
AOS T4 ;NO. POINT TO NEXT LOCATION
CAILE T4,QUEFIN ;END OF QUEUE AREA?
MOVEI T4,QUEBEG ;YES. GO TO BEGINNING
CAME T4,NXTADD ;BEYOND END OF LIST?
JRST CHECK ;NO. GO SEE IF THIS IS IT.
RET
;SENDER IN QUEUE. REMOVE AND SQUEEZE LIST
FIND: SOS QUECNT ;DECREMENT QUEUE COUNT
SOS T1,NXTADD ;DECREMENT NEXT AVAILABLE LOC
CAIGE T1,QUEBEG ;BACK TO BEGINNING OF AREA?
JRST [ MOVEI T1,QUEFIN ;YES. RESET TO END
MOVEM T1,NXTADD
JRST .+1]
;MOVE EACH SUCCEEDING ENTRY TO NEXT LOWER-NUMBERED LOCATION
REMPI1: CAMN T4,NXTADD ;BEYOND END OF LIST?
RETSKP ;YES. DONE
MOVEI T3,1(T4) ;T3/NEXT LOCATION,T4/CURRENT LOC
CAILE T3,QUEFIN ;DOWN TO END OF AREA?
MOVEI T3,QUEBEG ;YES. RESET TO TOP
MOVE T2,(T3) ;CONTENTS OF NEXT LOCATION
MOVEM T2,(T4) ;MOVE TO CURRENT LOCATION
MOVE T4,T3 ;POINT TO NEXT LOCATION
JRST REMPI1
SUBTTL IPCF INTERRUPT PROCESSING
;THIS IS THE MAIN ROUTINE FOR PROCESSING IPCF INTERRUPTS. IT IS INVOKED
;WHENEVER THE NUMBER OF MESSAGES WAITING TO BE RECIEVED GOES FROM ZERO
;TO NON-ZERO.
;IT RECIEVES A MESSAGE AND JUMPS TO THE CODE TO PROCESS THE MESSAGE. WHEN
;THERE ARE NO MORE MESSAGES WAITING, IT RETURNS.
;REACHED VIA INTERRUPT ON CHANNEL 0.
IPCINT: SETOM INTFLG ;SET INTERRUPT FLAG
MOVEM 16,REGSAV+16 ;SAVE REGISTER 16
MOVEI 16,REGSAV ;SET UP FOR BLT OF 0 TO REGSAV
BLT 16,REGSAV+16 ;MOVE 0-16 TO REGSAV
;SET UP FOR RECEIVE
IPCIN1: MOVEI T4,RPDB
MOVX T1,IP%CFB!IP%TTL!IP%CFV ;DON'T BLOCK;TRUNCATE;PAGE MODE
MOVEM T1,.IPCFL(T4) ;FLAG WORD
MOVSI T1,RMSGSZ ;MESSAGE SIZE
HRR T1,IPAGE ;MESSAGE PAGE
MOVEM T1,.IPCFP(T4) ;STORE IN PDB (size already set)
MOVEI T1,RPDBSZ ;T1/LENGTH OF PDB
MOVEI T2,RPDB ;T2/LOCATION OF PDB
MRECV ;RECEIVE NEXT MESSAGE
JRST IPCIN2 ;FAILED
HRL T1,IPAGEX ;MOVE DATA FROM IPCF PAGE
HRRI T1,RMSG ;INTO PROGRAM DATA AREA
BLT T1,RMSG+RMSGSZ-1
JRST IPCIN5 ;SUCCEEDED
;RECEIVE FAILED. IF PROBLEM IS THAT MESSAGE IS NOT IN PAGE MODE
;TRY RECEIVING WITHOUT PAGE MODE BIT SET. RECEIVE INTO THE SAME PAGE
;AS IN PAGE MODE
IPCIN2: CAIE T1,IPCF16 ;DATA MODE PROBLEM?
JRST IPCIN3 ;NO.
MOVX T2,IP%CFB!IP%TTL ;DON'T BLOCK,TRUNCATE,NO PAGE
MOVEM T2,.IPCFL(T4) ;TO PDB
MOVSI T1,MAXMSG ;MESSAGE SIZE
HRR T1,IPAGEX ;PAGE INTO WHICH TO READ MESSAGE
MOVEM T1,.IPCFP(T4) ;TO PDB (size already set)
MOVEI T1,RPDBSZ ;T1/SIZE OF PDB
MOVEI T2,RPDB ;T2/LOCATION OF PDB
MRECV ;READ MESSAGE AND DISCARD
JRST IPCIN3 ;STILL FAILS
HRL A,IPAGEX ;MOVE DATA FROM IPCF PAGE MESSAGE
HRRI A,RMSG ;INTO PROGRAM'S MESSAGE AREA
BLT A,RMSG+RMSGSZ-1
JRST IPCIN5 ;GO PROCESS IT
;NOT A PAGE PROBLEM. IF THERE WAS NO MESSAGE, IGNORE THE INTERRUPT.
;OTHERWISE, PRINT THE ERROR AND RETRY.
IPCIN3: CAIE T1,IPCFX2 ;NO MESSAGE?
JRST IPCIN4 ;NO.
SETZM NXTMSG ;YES. CLEAR ASSOCIATED VARIABLE
JRST ENDINT ;IGNORE THE INTERRUPT
IPCIN4: JSERR ;UNKNOWN ERROR
JRST IPCIN1 ;TRY AGAIN
;RECEIVE SUCCEEDED. CHECK FOR UNDELIVERED MAIL AND ERRORS. IGNORE
;ALL OTHER MESSAGES EXCEPT THOSE FROM PLEASE
IPCIN5: SETOM NXTMSG ;REMEMBER TO TRY ONE MORE MRECV BEFORE DEBRK
MOVEI P1,RPDB ;P1/LOCATION OF RECEIVE PDB
MOVE Q2,.IPCFS(P1) ;Q2/SENDER'S PID
MOVE Q1,.IPCFL(P1) ;Q1/FLAG WORD RECEIVED
JXN Q1,IP%CFM,UNDEL ;UNDELIVERED MAIL?
JXN Q1,IP%CFE,RCVERR ;NO. ERROR?
JXN Q1,IP%CFC,IPCMDA ;FROM SYSTEM? CHECK MDA
;MESSAGE IS NOT FROM SYSTEM, UNDELIVERED, OR ERROR. TRANSFER
;ACCORDING TO CODE SENT
HRRZ P6,RMSG ;P6/CODE SENT IN MESSAGE
MOVEI P2,SPDB ;P2/LOCATION OF SEND PDB
SKIPE GOTAB(P6) ;MAKE SURE REASONABLE CODE RECEIVED
CAIL P6,TABSIZ ;CHECK MAX LEGAL
CAIA
JRST @GOTAB(P6) ;OK - DISPATCH
; RECEIVED BAD CODE WITHOUT ERROR
SKIPN DEBUG ;DEBUGGING?
JRST BADMS1 ;NO.
MOVE T2,P6 ;T2/CODE SENT IN MESSAGE
MOVE T3,Q2 ;T2/SENDING PID
TYPE <%_D:Received code %2O from PID %3O%_> ;YES.
BADMS1: MOVEM Q2,.IPCFR(P2) ;SEND TO SENDER
MOVEI T2,PLCON ;CODE IS 'CONFUSED'
MOVEM T2,SMSG ;STORE CODE IN MESSAGE
MOVEI P2,SPDB ;P2/ADDRESSOF SEND PDB
MOVEI P4,SPDBSZ ;P4/SIZE OF SEND PDB
CALL SNDMSG ;SEND THE MESSAGE
JFCL ;FAILED. IGNORE
;..
;MESSAGE HAS BEEN PROCESSED. IF THERE WAS ANOTHER MESSAGE WAITING
;WHEN THIS ONE WAS RECEIVED, NXTMSG IS NON-ZERO, GO RECEIVE THE NEXT
;ONE. IF NXTMSG IS ZERO. ANY MESSAGE THAT HAS COME IN SINCE THE LAST
;RECEIVE WILL CAUSE A NEW INTERRUPT.
;..
NOTMNT,<IPCMDA:>
ENDINT: SKIPE NXTMSG ;ANY MORE MESSAGES IN QUEUE?
JRST IPCIN1 ;GO RECEIVE THE NEXT MESSAGE
;NO MORE TO RECEIVE. IF CAME FROM WAIT, WAKE UP. IF NOT,
;RETURN TO WHERE WE WERE BEFORE THE INTERRUPT.
HRLZI 16,REGSAV ;RESTORE REGISTERS
BLT 16,16
SKIPN WTFLG ;CAME FROM A WAIT?
DEBRK ;NO. RETURN TO WHERE WE WERE
CALL ILEVEL ;WHAT INTERRUPT LEVEL ARE WE AT?
MOVEI B,WAKEUP ;YES. START WAKE-UP PROCEDURE
MOVEM B,PCSAV1-1(A) ;CHANGE APPROPRIATE PC WORD
MOVE B,REGSAV+B ;RESTORE AC'S USED HERE
MOVE C,REGSAV+C
DEBRK
;SOMETHING FAILED. START OVER
RESTRT: QUIT1 ;START OVER
;MESSAGE FROM SYSTEM, MAY BE RETURN REQUEST OF DEVICE(S)
TMNT,<
IPCMDA: LDB Q1,[POINTR (Q1,IP%CFC)]
CAIE Q1,.IPCCC ;FROM <SYSTEM>IPCF?
JRST ENDINT ;NO - IGNORE
MOVE Q1,RMSG ;GET MESSAGE ADDRS
CAIE Q1,.IPCSA ;MESSAGE CODE OF MDA
JRST ENDINT ;NO - IGNORE
HLRZ Q1,.IPCFP(P1) ;LENGTH OF MESSAGE
MOVNI Q1,-1(Q1) ;-LEN-1
HRLZS Q1 ;-LEN,,0
IPCMD1: TYPE <%_[TMOUNT: Device >
MOVE T2,RMSG+1(Q1) ;DEVICE DESIGNATOR
MOVEI T1,.PRIOU
DEVST ;PRINT DEVICE NAME
JSERR
TYPE <: returned]_>
MOVEI T1,.ALCAL ;RETURN DEVICE TO COMMON POOL
MOVE T2,RMSG+1(Q1) ;...
MOVNI T3,1 ;...
ALLOC
JSERR
AOBJN Q1,IPCMD1 ;LOOP OVER ALL DEVICES
JRST ENDINT ;DISMISS INTERUPT
>;TMNT
SUBTTL HELLO
;'HELLO' RECEIVED. IF OPERATOR IS FREE, SEND 'OK'. OTHERWISE PUT PID IN
;INTERNAL QUEUE AND SEND 'WAIT'.
;ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;Q2/ PID OF SENDER
;REACHED VIA JRST FROM IPCINT
;JRSTS TO ENDINT ALWAYS.
SMNT,<
SMELLO: TLO Q2,(1B1) ;MARK PID AS SMOUNT
JRST HELLO ;JOIN COMMON CODE
>;SMNT
TMNT,<
XHELLO: TLO Q2,(1B0) ;MARK PID AS TMOUNT
>;TMNT
HELLO: SKIPN CURPID ;IS THERE A CURRENT PID?
SKIPE QUECNT ;NO. ANYONE IN THE QUEUE?
JRST HELLO3 ;YES.
;NO ONE CURRENT OR WAITING. MAKE THIS THE CURRENT PID
TMNT,<
TLZE Q2,(1B0) ;CHECK FOR TMOUNT PID
SETOM TMF ;YES - SET FLAG
>;TMNT
SMNT,<
TLZE Q2,(1B1) ;CHECK FOR SMOUNT PID
SETOM SMF ;YES - SET FLAG
>;SMNT
MOVE P6,Q2 ;NO. P6/NEXT PID
SMNT,<
SKIPE SMF ;DON'T IDENTIFY SMOUNT USER HERE
JRST NOID1 ;SMOUNT ROUTINE DOES IT
>
CALL USERID ;IDENTIFY THE USER
JRST ENDINT ;USER NOT THERE. FORGET THE HELLO
SMNT,<
NOID1:
>
MOVEI P5,PLOK ;MESSAGE IS 'OK'
MOVEM Q2,CURPID ;MAKE THIS THE CURRENT PID
JRST HELLO1
;THERE IS A CURRENT PID OR SOMEONE IN THE QUEUE. PUT USER IN QUEUE.
HELLO3: AOS T1,QUECNT ;YES. INCREMENT QUEUE COUNT
; AND LOAD INTO T1
CAILE T1,QUESIZ ;QUEUE FULL?
JRST HELLO2 ;YES. ERROR
MOVE T2,NXTADD ;STORE PID IN NEXT FREE LOCATION
MOVEM Q2,(T2)
TMNT,< TLZ Q2,(1B0)> ;CLEAR FLAG
SMNT,< TLZ Q2,(1B1)> ;CLEAR FLAG
AOS T2,NXTADD ;INCREMENT NEXT FREE LOCATION
; AND LOAD INTO T2
CAILE T2,QUEFIN ;END OF QUEUE AREA?
JRST [ MOVEI T2,QUEBEG ;YES. BACK TO TOP
MOVEM T2,NXTADD
JRST .+1]
MOVEI P5,PLWAIT ;MESSAGE IS 'WAIT'
;SEND APPROPRIATE MESSAGE (P5 CONTAINS CODE)
HELLO1: MOVEM Q2,.IPCFR(P2) ;SEND TO THE SENDER OF 'HELLO'
MOVEM P5,SMSG ;CODE TO FIRST WORD OF MESSAGE
MOVEI P4,SPDBSZ ;P4/SIZE OF SEND PDB
CALL SNDMSG ;SEND MESSAGE
JRST [ CALL ERR1 ;FAILED. RETRY IF OVER RECEIVE QUOTA
JRST ENDINT ;RETRY FAILED
JRST .+1] ;RETRY SUCCEEDED
CAIN P5,PLOK ;SENT 'OK' MESSAGE?
JRST [ SETOM ANSFLG ;YES. INDICATE WAITING FOR ANSWER
TIME ;GET CURRENT TIME
ADD T1,DELAY ;ADD TIME TO WAIT FOR ANSWER
MOVEM T1,DTIME ;SAVE TIME TO GIVE UP
JRST .+1]
JRST ENDINT ;SUCCESS
HELLO2: TYPE<%_%% User queue OVERFLOW.%_>
sos quecnt ;decrement count incremented above
; limit - never added this user
jrst endint
SUBTTL TMOUNT
TMNT,<
;'TMOUNT' RECIEVED - GEN MSG FOR OPR
XMOUNT: CAME Q2,CURPID ;CURRENT?
JRST TEXT2 ;NO - COMMON ERROR
;****** THIS IS TEMPORARY TO WORK WITH OLD EXEC
SKIPE T1,RMSG+1 ;GET AND TEST FOR 0
CAMN T1,[-1] ;AND -1
HRRI T1,.DVMTA ;AND ASSUME MTA
MOVEM T1,RMSG+1
;****** END TEMPORARY HACK
HRRZ T1,RMSG+1 ;GET DEVICE TYPE
MOVSI T2,-TMLEN ;GET TABLE LENGTH
XMNT1: CAME T1,TMTYP(T2) ;IS THIS IT?
AOBJN T2,XMNT1 ;NO, KEEP LOOKING
JUMPGE T2,TEXT2 ;GIVE RANDOM ERROR FOR UNKNOWN DEVICE
HRRZM T2,TMIND ;REMEMBER INDEX
HRRO T1,TMNAM(T2) ;GET DESCRIPTION
HRROI T2,RMSG+2 ;POINT TO STRING SENT
TYPE <Mount %1A: ID=%2A>
SKIPN RMSG+2 ;DID USER GIVE VOLID?
TYPE <(SCRATCH)> ;NO
TYPE </WRITE->
SKIPGE RMSG+1
TYPE <LOCKED>
SKIPL RMSG+1 ;ACCORDING TO USER
TYPE <ENABLED>
TYPE <%_>
CALL DEVFRE ;PRINT FREE DRIVES
TYPE <Respond with drive name: >
JRST ENDINT ;DISMISS INTERUPT
;HERE WITH OPR RESPONSE IN OMSG+1 THRU OMSG+OMSGSZ
TMOPR: LDB T1,[POINT 7,OMSG+1,6] ;GET FIRST CHAR OF MESSAGE
CAIE T1,.CHESC ;ESC MEANS HE WONT TALK
CAIN T1,.CHCNZ ;IF ^Z THEN ABORT
JRST TMABT ; REQUEST
CAIG T1,"7" ;IF OCTAL #
CAIGE T1,"0"
SKIPA
JRST TMOCT ;THEN SEARCH FOR DRIVE
TRNE T1,100 ;LETTER?
TRZ T1,40 ;YES, MAKE SURE UC
MOVE Q1,TMIND ;GET DEVICE INDEX
LDB Q1,[POINT 7,TMMN(Q1),6] ;GET FIRST LETTER OF MNEMONIC
CAMN T1,Q1 ;IS IT?
JRST TMGET ;YES, GET A DRIVE
CAIN T1,"?" ;WANT HELP?
JRST TMHLP ;YES - TELL HIM
CALL CKEOL
JRST TMFRE ;TYPE FREE LIST AGAIN
TMERR: TYPE <%_?Invalid response
Drive name: >
JRST WAKEUP ;LOOP BACK
;HERE FOR LIST OF FREE DRIVES
TMFRE: CALL DEVFRE
TYPE <Drive name: >
JRST WAKEUP
;HERE FOR HELP
TMHLP: MOVE T1,TMIND ;GET DEVICE INDEX
HRRO T2,TMNAM(T1) ;GET POINTER TO DESCRIPTION
HRROI T1,TMMN(T1) ;GET POINTER TO MNEMONIC
TYPE <
Mount requested %2A.
Respond with one of the following:
Octal number - For drive %1A#
%1A# - For that drive
<CR> - For list of free drives
<CTRL>Z to abort request
Drive name: >
JRST WAKEUP
;HERE TO ABORT TMOUNT REQUEST
TMABT: MOVX T2,1B1 ;SET FLAG
IORM T2,BYEFLG
JRST WAKE3 ;PROCESS
;HERE IF OCTAL NUMBER TYPED - GEN DEVICE NAME
TMOCT: MOVE Q1,[POINT 7,OMSG+1] ;POINT TO STRING
MOVEI Q2,0 ;INIT NUMBER
TMOCT1: ILDB T1,Q1 ;GET CHAR
CAIG T1,"7" ;VALID OCTAL?
CAIGE T1,"0" ;??
JRST [CAIN T1,":" ;COLON TERM OK (IGNORE)
ILDB T1,Q1 ;GET NEXT CHAR
CALL CKEOL ;MUST NOW BE EOL
JRST TMOCT2 ; EOL - PROCEED
JRST TMERR]
IMULI Q2,10 ;SHIFT ANSWER
TRNE Q2,777000 ;ERROR IF MORE THAN 3 CHARS
JRST TMERR
ADDI Q2,-60(T1) ;ADD IT IN
JRST TMOCT1 ;LOOP TILL DONE
TMOCT2: MOVE T1,TMIND ;GET DEVICE INDE
HRL Q2,TMTYP(T1) ;GET DEVICE TYPE
TLO Q2,600000 ;MAKE IT DESIGNATOR
CALL CKDEV ;TO TO ALLOC ETC...
JRST TMNOT ;SAY NOT AVAILABLE
TMEXIT: MOVEI P2,OPDB ;ADDRS OF SEND PDB
MOVE T1,CURPID ;SEND TO CURRENT PID
MOVEM T1,OPDB+.IPCFR
MOVEI T1,XTMNT ;MOUNT SUCCESS CODE
MOVEM T1,OMSG
MOVEM Q2,OMSG+1 ;STORE DEVICE DESIGNATOR
MOVEI P4,OPDBSZ ;SIZE OF SEND PDB
CALL SNDMSG ;SEND AWAY
JFCL ;TOUGH
JRST WAKE4 ;ALL DONE
TMGET: MOVE T1,OMSG+1 ;GET RESPONSE
AND T1,[BYTE(7)137,137,137] ;LOOK AT 1ST 3 CHARS, UC ONLY
MOVE Q1,TMIND ;GET DEVICE INDEX
CAME T1,TMMN(Q1) ;MATCH MNEMONIC?
JRST TMERR ;NO - ERROR
MOVE Q1,[POINT 7,OMSG+1,20]
MOVEI Q2,0 ;SET UP FOR OCTAL NUMBER STUFF
JRST TMOCT1 ;JOIN COMMON CODE
;ROUTINE TO CHECK LINE TERMINATOR
CKEOL: CAIE T1,.CHCRT ;CARRIAGE RETURN
CAIN T1,.CHLFD ; OR LINE-FEED
RET ;GIVE NON-SKIP
RETSKP ;ELSE SKIP
;HERE TO DEVICE(S) NOT AVAILABLE
TMNOT: TYPE <
?Device not available - <CTRL>Z to abort
Drive name: >
JRST WAKEUP
;ROUTINE TO LOOP OVER ALL DEVICES TO FIND ONE AVAILABLE
DEVFRE: HRRZ T1,DEVNAM ;TABLE NUMBER OF NAMES
HRLI T1,-1 ;GET # OF ENTRIES
GETAB
JSERR
HRLZ Q1,T1 ;MAKE AOBJN PNTR
HRRZ T2,TMIND ;GET DEVICE INDEX, CLEAR 1ST TIME FLAG
DEVFR1: HRLZ T1,Q1 ;INDEX TO T1
HRR T1,DEVUNT
GETAB ;GET UNIT #
JSERR
MOVE Q2,T1 ;SAVE IN Q2
HRLZ T1,Q1 ;BUILD CALL
HRR T1,DEVCHR ;FOR CHARACTERISTC TABLE
GETAB ;...
JSERR
LDB T1,[POINTR (T1,DV%TYP)]
CAME T1,TMTYP(T2) ;CORRECT DEVICE TYPE?
JRST DEVFR2 ;NO
HRLZ T1,T1
TLO T1,600000
HRR T1,Q2 ;MAKE DEVICE DESIGNATOR
PUSH P,T2
PUSH P,T3
DVCHR ;GET CHARACTERISTICS
ERJMP [POP P,T3
POP P,T2
JRST DEVFR2]
MOVE T1,T3 ;COPY JOB #
POP P,T3
POP P,T2
JUMPL T1,DEVFR3 ;JUMP IF FREE
DEVFR2: AOBJN Q1,DEVFR1 ;NO - TRY NEXT
HRRO T1,TMNAM(T2) ;GET DESCRIPTION
TLNN T2,-1 ;FIND ANY?
TYPE <No free %1A drives.>
TYPE <%_>
RET ;...
DEVFR3: HRRO T1,TMNAM(T2)
TLNN T2,-1
TYPE <Free %1A drives: >
TLNE T2,-1 ;ANY PRINTED?
TYPE <, > ;YES, SEPERATE
MOVEI T1,.PRIOU ;OUT TO TTY
HRLZ T2,TMTYP(T2) ;TYPE
TLO T2,600000 ;DESIGNATOR
HRR T2,Q2 ;UNIT
DEVST ;PRINT NAME
JSERR ;FOO!
TYPE <:>
HRRO T2,TMIND ;GET INDEX BACK, INDICATE NOT 1ST TIME
JRST DEVFR2
;ROUTINE TO CHECK ON DEVICE DESIGNATOR AND TRY TO ALLOC
CKDEV: MOVEI T1,.MUFOJ ;GET CODE TO GET JOB NUMBER
MOVEM T1,MUTILD ;SAVE IT
MOVE T1,CURPID ;GET USER'S PID
MOVEM T1,MUTILD+1 ;SAVE IT TOO
MOVEI T1,3 ;WANT THREE ARGUMENTS
MOVEI T2,MUTILD ;AT THIS LOCATION
MUTIL ;SEE IF PID STILL EXISTS
JRST CKDEVG ;FAILURE, GO CHECK IT
MOVEI T1,.ALCAL ;FCN ALLOCATE TO JOB
MOVE T2,Q2 ;DEVICE
MOVE T3,TMF ;JOB #
ALLOC ;TRY TO ALLOCATE
JRST [CAIE T1,ALCX5 ;NOT AVAIL?
CAIN T1,ALCX6
RET ;GIVE NON-SKIP
CAIN T1,ALCX4 ;JOB VALID?
JRST CKDEVJ ;NO - INFORM OPR
JSERR] ;ELSE ERROR
TYPE <%_[>
MOVEI T1,.PRIOU ;INFORM OPR OF WHAT HAPPENED
DEVST ;DEVICE NAME
JSERR
MOVE T2,TMF ;JOB # AGAIN
TYPE <: assigned to job %2D]%_>
RETSKP ;SKIP RETURN
CKDEVG: CAIN T1,IPCF27 ;PID GONE BECAUSE JOB WENT AWAY?
JRST CKDEVJ ;YES, GO COMPLAIN
JSERR ;NO, GIVE WORSE ERROR
SKIPA ;AND ABORT
CKDEVJ: TYPE <?Job dissappeared - aborting....%_>
POP P,0(P) ;CLEAN UP PDL
JRST TMABT ;AND ABORT
>;TMNT
SUBTTL STRLST
;SOMEONE HAS SENT DIRECTIVES ABOUT MANAGING STRUCTURE LISTS.
;"SACKN" SENT TO MAKE STRUCTURE MOUNTABLE AGAIN.
LSTDEL: CALL WHLOPR ;MAKE SURE HE'S WHEEL OR OPERATOR
MOVEI A,IGTBL ;POINT TO TABLE OF IGNORED STRUCTURES
HRROI B,RMSG+.TEXT ;GET POINTER TO STRUCTURE NAME
TBLUK ;SEE IF IT'S IN THE TABLE
TXNN B,TL%EXM ;MUST BE EXACT MATCH
JRST NOTTHR ;IT'S NOT THERE!
HLRZ D,@B ;GET ADDRESS OF STRING BEING REMOVED
MOVE B,A ;MOVE ADDRESS OF DELETION CANDIDATE INTO B
MOVEI A,IGTBL ;GET ADDRESS OF TABLE (AGAIN)
TBDEL ;REMOVE THE ENTRY
MOVE A,D ;GET ADDRESS OF STRING TO BE FREED
CALL STREM ;REMOVE STRING FROM STRING STORAGE SPACE
JRST LST1 ;RETURN TO CALLER
;"SIGNOR" SENT TO MAKE STRUCTURE UNDETECTABLE AS A MOUNTABLE STRUCTURE...
LSTADD: CALL WHLOPR ;MAKE SURE SENDER IS WHEEL OR OPERATOR
MOVEI A,IGTBL
HRROI B,RMSG+.TEXT ;POINT AT NAME BEING ENTERED INTO TABLE
TBLUK ;SEE IF IT'S ALREADY IN TABLE
TXNE B,TL%EXM ;SKIP IF NOT ALREADY IN TABLE
JRST DUP ;ALREADY THERE!
HRROI A,RMSG+.TEXT ;GET POINTER TO THE NAME SENT
CALL READNM ;READ IN THE NAME AND SKIP IF ROOM FOR IT
JRST NOROOM ;NO ROOM FOR THE ENTIRE NAME
HRLZ B,A ;PUT ADDRESS OF STORED NAME IN LEFT HALF
MOVEI A,IGTBL ;POINT TO TABLE OF STRUCTURES BEING IGNORED
TBADD ;PUT STRUCTURE IN THE LIST
ERJMP NOROOM ;ASSUME NO ROOM (ALREADY CHECKED FOR DUPLICATION)
LST1: MOVEI A,PLOK ;STRUCTURE ADDED, SEND "OK" TO SENDER
MOVE B,Q2 ;SEND TO SENDER
CALL SNDCOD ;SEND THE "OK"
JRST ENDINT ;DISMISS THE INTERRUPT
NOTTHR: HRROI A,[ASCIZ /%Structure wasn't being ignored/]
JRST EXCUSE ;TELL EXEC WHY WE'RE REFUSING
NOROOM: HRROI A,[ASCIZ /?No room for another structure on list/]
JRST excuse ;send the excuse to the sender
;get here when tbadd fails...
adderr: CALL GETERR ;GET ERROR CODE
CAIE A,TADDX2 ;ENTRY ALREADY IN TABLE?
jrst noroom ;no, assume no room
DUP: hrroi a,[asciz /%Structure already set to be ignored/]
JRST EXCUSE ;SEND THE EXCUSE
;GET TO HERE WITH BYTE POINTER IN A POINTING TO EXCUSE FOR NOT PUTTING
;THE REQUESTED STRUCTURE ON THE LIST OF IGNORED STRUCTURES.
EXCUSE: MOVE B,A ;COPY FROM THE STRING
HRROI A,SMSG+.TEXT ;TO THE IPCF MESSAGE PAGE
MOVEI C,0 ;END ON NULL
SOUT ;COPY IT
MOVEI A,PLTXT ;CODE IS "TEXT"
MOVE B,Q2 ;SEND TO WHOEVER SENT US THE REQUEST
CALL SNDCOD ;SEND THE MESSAGE
JRST ENDINT ;DISMISS THE INTERRUPT
;ROUTINE TO SKIP IFF SENDER IS WHEEL, OPR, OR MAINTENANCE
PRVCHK: SAVEAC <A> ;DON'T CLOBBER ANYTHING
MOVE A,RPDB+.IPCFC ;GET PRIVS OF SENDER
TXNE A,SC%WHL+SC%OPR+SC%MNT ;DOES HE HAVE REQUIRED PRIVS?
RETSKP ;YES
RET ;NO
;ROUTINE TO MAKE SURE SENDER IS AN ENABLED WHEEL OR OPERATOR
;RETURNS IFF WHEEL OR OPR
WHLOPR: CALL PRVCHK ;DOES HE HAVE PRIVS?
CAIA ;NO
RET ;YES
HRROI A,[ASCIZ /?WHEEL, OPERATOR, or MAINTENANCE capability required/]
POP P,(P) ;THROW AWAY RETURN FROM THIS ROUTINE
JRST EXCUSE ;TELL SENDER WHY WE'RE REFUSING
SUBTTL SMOUNT
SMNT,<
;'SMOUNT' RECEIVED FROM SOME USER'S EXEC (OR FROM SOMEONE SCREWING AROUND!)
SREMOV: CAME Q2,CURPID ;FROM CURRENT USER?
JRST TEXT2 ;NO, HANG LOOSE...
SETOM RMF ;SOMEONE WANTS TO REMOVE A STRUCTURE
SMOUNT: CAME Q2,CURPID ;FROM CURRENT USER?
JRST TEXT2 ;NO, HANG LOOSE...
SETZM ANSFLG ;WE HAVE RECEIVED RESPONSE FROM "OK"!
SETZM SMEDSP ;NO ERROR DISPATCH ADDRESS YET
MOVE A,RPDB+.IPCSD ;GET CONNECTED DIRECTORY OF SMOUNTER
MOVEM A,SMDIR ;COPY (BECAUSE GETS CLOBBERED WITH NEXT MRECV JSYS)
SETZM WRKFLG ;FIRST ASSUME THERE'S NO WORK TO DO
HRROI A,SMABLK ;POINT TO BLOCK TO HOLD DESIRED ALIAS
HRROI B,RNAMES ;POINT TO NAMES SENT BY EXEC
MOVEI C,0 ;END ON NULL
MOVEM A,SALIAS ;REMEMBER POINTER TO ALIAS
SOUT ;COPY THE ALIAS
HRROI A,SMSBLK ;POINTER TO DESIRED PHYSICAL STRUCTURE NAME
MOVEM A,STRNAM ;REMEMBER POINTER TO REAL STRUCTURE NAME DESIRED
SOUT ;COPY THE NAME
MOVE A,RFLAGS ;GET RECEIVED FLAGS
MOVEM A,SMFLGS ;SAVE'EM
call mntini ;do initialization chores
SETOM SMF ;REMEMBER WE'RE WAITING FOR STRUCTURE TO APPEAR
SKIPE RMF ;SKIP THE FOLLOWING CHECK IF NOT A REMOVAL REQUEST
CALL STRMNT ;IS STRUCTURE MOUNTED?
JRST RFIND1 ;NO
;...
;STRUCTURE IS MOUNTED, SO MAKE SURE USER ISN'T CONNECTED TO IT, AND
;THAT USER HAS NO OPEN FILES ON IT.
MOVE B,SMDIR ;GET USER'S CONNECTED DIRECTORY
HRROI A,FREESP ;POINT TO SOME FREE SPACE
DIRST ;GET NAME OF CONNECTED STRUCTURE
JSERR
HRROI A,FREESP ;POINT TO NAME
STDEV ;GET DESIGNATOR OF CONNECTED STRUCTURE
JSERR
MOVE C,B ;REMEMBER DESIGNATOR IN C
MOVE A,SALIAS ;GET POINTER TO ALIAS NAME
STDEV ;GET ITS DESIGNATOR
JSERR ;COULDN'T
MOVEI A,UCON ;WHERE TO GO IF USER STILL CONNECTED TO STRUCTURE BEING REMOVED
CAMN B,C ;MAKE SURE USER ISN'T CONNECTED TO STRUCTURE BEING REMOVED
MOVEM A,SMEDSP ;REMEMBER TO GO TO "UCON" INSTEAD OF DOING ANY WORK
;*********
;* CODE GOES HERE WHICH MAKES SURE USER
;* HAS NO OPEN FILES ON STRUCTURE BEING
;* REMOVED, BUT ALAS; MR. MONITOR DOESN'T
;* KNOW HOW TO TELL US WHICH FILES USER
;* HAS OPEN. TUNE IN NEXT WEEK...
;********
RFIND1: movn a,rmf ;0 for smount, 1 for sremove
call @[exp strmnt,nostr](a)
SETOM WRKFLG ;STRUCTURE NOT IN REQUESTED STATE, REMEMBER THAT THERE'S WORK TO DO
JRST ENDINT ;START WAKEUP TO LOOK FOR STRUCTURE
;HERE TO SEE IF STRUCTURE HAS BEEN PUT ON-LINE BY SOMEONE YET...
SFIND: SKIPE SMEDSP ;IS THERE AN ERROR CONDITION?
JRST @SMEDSP ;YES, GO HANDLE IT
SKIPE RMF ;WAITING FOR STRUCTURE TO BE REMOVED?
JRST RFIND ;YES, GO SEE THE STATE OF THE WORLD
CALL FNDSTR ;TRY TO FIND THE STRUCTURE SITTING ON SOME DRIVES
JRST STRNF ;STRUCTURE NOT FOUND
CALL MSMNT ;STRUCTURE FOUND, MOUNT IT
JRST WHOOPS ;COULDN'T MOUNT, GO GIVE EXCUSE
CALL BBB ;GO PRINT MESSAGE, IF BAT BLOCKS ARE BAD
SFIND2: CALL COMNDS ;UPDATE COMMANDS TO CHECK FOR DOMESTIC OR FOREIGN
MOVX B,MS%DOM ;GET DOMESTIC BIT
MOVE A,SALIAS ;GET POINTER TO STRUCTURE NAME
MOVEM A,SSSALS ;SET UP ALIAS FOR STRUCTURE BEING MODIFIED
MOVEM B,SSSMSK ;SET UP MASK TO "DOMESTIC" BIT
IORM B,SSSSTA ;TURN ON DOMESTIC BIT
MOVE A,STRNAM ;GET POINTER TO REAL NAME OF STRUCTURE
CALL DOMQ ;SKIP IF SUPPOSED TO BE MOUNTED DOMESTIC
SETCMM SSSSTA ;NOT, SO TURN OFF BIT SO IT WILL BE FOREIGN
CALL MSSSS ;SET STRUCTURE STATUS, FOREIGN OR DOMESTIC
SETZM SMF ;WE'RE NO LONGER LOOKING FOR STRUCTURE
MOVEI A,PLOK ;TELL USER'S EXEC IT'S OK TO INCREMENT MOUNT COUNT NOW
MOVE B,CURPID ;SEND MESSAGE TO CORRECT USER!
CALL SNDCOD ;SEND THE "OK"
JRST WAKEUP ;WAIT FOR EXEC TO INCREMENT MOUNT COUNT
;GET TO HERE FOR REMOVAL REQUEST...
RFIND: CALL NOSTR ;HAS STRUCTURE BEEN REMOVED?
JRST STRNF ;NO, KEEP WAITING
SETZM RMF ;YES, CLEAR FLAG SO WE KNOW WE'RE DONE
MOVEI A,PLOK ;TELL EXEC IT WON
MOVE B,CURPID ;SEND MESSAGE TO CORRECT USER!
CALL SNDCOD ;SEND THE "OK"
MOVE A,STRNAM ;GET NAME OF STRUCTURE THAT WAS REMOVED
SKIPE WRKFLG ;DON'T SAY ANYTHING IF NO WORK GOT DONE
TYPE <[Structure %1A: removed from drives]%_>
SKIPN WRKFLG
SETOM SILNTF ;DON'T SAY "TRANSACTION ENDED..." IF NEVER SAID STARTED!
JRST WAKE4 ;PROCEED TO NEXT USER
;ROUTINE WHICH SKIPS IFF SPECIFIED STRUCTURE (A LA STRNAM,SALIAS) HAS
;BEEN REMOVED FROM DRIVES
NOSTR: CALL FNDSTR ;IS STRUCTURE DISMOUNTED BUT SPINNING?
CAIA ;REMOVED, OR STILL MOUNTED
RET ;SPINNING, SO NOT REMOVED YET
CALL STRMNT ;SKIP IF REQUESTED STRUCTURE MOUNTED
RETSKP ;CAN'T GET STATUS, SO MUST BE REMOVED
RET ;GOT STATUS, SO NOT REMOVED YET
;ROUTINE WHICH SKIPS IFF STRUCTURE WHOSE ALIAS IS POINTED TO BY
;SALIAS IS CURRENTLY MOUNTED
STRMNT: MOVE A,SALIAS
MOVEM A,GSSALS
CALL MSGSS ;SEE IF STRUCTURE ALREADY REMOVED
RET
RETSKP
;ARRIVE HERE WHEN EXEC HAS SAID IT SUCCEEDED IN INCREMENTING THE
;MOUNT COUNT
MDONE: CAME Q2,CURPID ;FROM CURRENT USER?
JRST TEXT2 ;NO, HANG LOOSE...
MOVE A,TYPNAM ;GET POINTER TO DEVICE TYPE NAME
HRRZ C,MNTNUM ;PICK UP NUMBER OF UNITS IN STRUCTURE
SKIPE WRKFLG ;DON'T TYPE ANYTHING IF DIDN'T DO ANY WORK!
TYPE <[%S mounted as a %3D-unit %1A structure]%_>
SKIPN WRKFLG
SETOM SILNTF ;DON'T PRINT "TRANSACTIN ENDED..." UNLESS SOME WORK GOT DONE
jrst bye ;done with request, proceed to next user in queue
;GET TO HERE WHEN THE STRUCTURE ISN'T FOUND THAT WAS ASKED TO BE MOUNTED
STRNF: SKIPE RMF
JRST STRNF9 ;REMOVAL REQUEST, DON'T CHECK FOR MOUNTED
CALL STRMNT ;SKIP IF REQUESTED STRUCTURE IS MOUNTED
CAIA ;NOT YET
JRST SFIND2 ;MOUNTED, SO FINISH UP
;(THIS SOLVES THE PROBLEM OF US GETTING
;CALLED TO MOUNT AN ALREADY MOUNTED STRUCTURE)
STRNF9: MOVE A,SMFLGS ;GET FLAGS
TXNE A,NO%WT ;DID USER REQUEST NOT TO WAIT FOR STRUCTURE?
JRST NOWAIT ;YES, SO ABORT NOW
SETOM WRKFLG ;IF WE EVER GET HERE, WE WEREN'T SATISFIED, SO REMEMBER THERE WAS WORK TO TO
TIME ;GET CURRENT TIME
SUB A,LASTL ;CALCULATE TIME SINCE LAST LIST OF AVAILABLE DRIVES
CAMLE A,[ANNOYT*^D60000] ;HAS A LONG TIME PASSED SINCE LISTING AVAILABLE DRIVES?
CALL DLISTX ;YES, REMIND THE OPERATOR
MOVEI A,SCANT*^D1000 ;GET TIME FOR SLEEPING BETWEEN SCANS
DISMS ;SLEEP FOR AWHILE
TIME ;GET CURRENT TIME
CALL SKPNOP ;SKIP IF THERE'S NO OPERATOR
MOVEM A,LSTOPR ;THERE IS, REMEMBER.
CALL DLIST ;LIST AVAILABLE DRIVES (IF IT'S CHANGED)
CALL SKPNOP ;SKIP IF NO OPERATOR IN ATTENDANCE
JRST PRESNT ;THE OPERATOR IS IN.
TIME ;GET CURRENT TIME
SUB A,LSTOPR ;CALCULATE WAITING TIME WITH NO OPERATOR
CAML A,[NOOPGU*^D60000] ;HAVE WE WAITED REAL LONG WITH NO OP?
JRST GIVEUP ;YES, SO CANCEL THE SMOUNT REQUEST
PRESNT: JRST WAKEUP ;WAIT FOR STRUCTURE TO APPEAR...
;ROUTINE TO UPDATE DISK DRIVE TABLE, AND LIST IT IF IT'S CHANGED SINCE
;THE LAST LISTING
DLIST: MOVE A,[DRVTAB,,ODRVTB] ;COPY THE AVAILABILITY TABLE
BLT A,ODRVTB+DTABLN-1 ;SO WE'LL KNOW IF IT'S CHANGED
CALL DRINFO ;GET INFO ABOUT WHICH DRIVES ARE AVAILABLE
CALLRET PDINFO ;PRINT OUT THE DRIVE INFO (IF IT HAS CHANGED)
;THIS ROUTINE IDENTIFIES WHO'S REQUESTING AN SMOUNT, AND LISTS THE
;AVAILABLE DISK DRIVES
DLISTX: MOVX A,DRV%NA ;GET "DRIVE NOT AVAILABLE BIT"
XORM A,DRVTAB ;CHANGE ITS STATE IN TABLE TO GUARANTEE PRINTOUT
CALL WHOMNT ;SAY WHO'S DOING THE SMOUNT
CALLRET DLIST ;FALL INTO CODE THAT PRINTS AVAILABLE DRIVES
;ROUTINE TO DECLARE WHAT TO MOUNT. PRINTS OUT REQUEST ON THE
;OPERATOR'S CONSOLE.
WHOMNT: MOVE P6,CURPID ;USE PID OF WHOMEVER'S CURRENT USER
CALL USERID ;TELL OPERATOR WHO IS DOING THE SMOUNT
JFCL ;IGNORE FAILURE (USER PROBABLY TYPED ^C)
HRROI D,[ASCIZ /mount/]
SKIPN RMF ;REMOVAL REQUEST?
JRST NORM ;NO, DIFFERENT MESSAGE
TYPE <Please remove %S from the drives when it appears on
the list of free drives, or type NO.%_>
JRST BURST ;SKIP SMOUNT REQUEST MESSAGE
NORM: TYPE <Please mount %S, or type NO.%_>
BURST: ret
;THE FOLLOWING ROUTINE LOOKS FOR A SPECIFIED STRUCTURE ON THE
;DISK DRIVES. ONLY DRIVES NOT CONTAINING PART OF AN ALREADY MOUNTED
;STRUCTURE, AND DRIVES CONTAINING A PACK WHICH ISN'T BEING USED FOR
;AN ON-LINE DIAGNOSTIC, ARE CONSIDERED. THE ROUTINE MAKES SURE THERE
;AREN'T TWO COMPLETE UNMOUNTED STRUCTURES WITH THE SPECIFIED NAME. IF
;THE ROUTINE FINDS EXACTLY ONE COMPLETE STRUCTURE OF THE SPECIFIED
;NAME, IT TAKES A SKIP RETURN WITH "MNTBLK" SET UP CORRECTLY FOR
;MOUNTING THE STRUCTURE. OTHERWISE, THE ROUTINE TAKES A NON-SKIP
;RETURN
FNDSTR: CALL DRVINI ;INITIALIZE POINTERS SO WE CAN SCAN ALL DRIVES
;FIRST, WE LOOK FOR SOME PACK IN THE STRUCTURE, TO FIND OUT HOW MANY
;PACKS ARE IN THE STRUCTURE ALTOGETHER:
FND1: CALL MSRNU ;READ STATUS OF NEXT DISK DRIVE
RET ;WE NEVER FOUND A SINGLE PACK, SO THE STRUCTURE ISN'T ON LINE YET
call drvmch ;is this pack off line and the right name?
jrst fnd1 ;NO, keep looking
HRRZ A,RNUNUM ;GET NUMBER OF UNITS IN THIS STRUCTURE
CAILE A,MAXPKS ;MAKE SURE THERE AREN'T TOO MANY UNITS
ERROR <Too many units in structure for this assembly of the mounting program>
MOVEM A,MNTNUM ;CLEAR FLAGS AND STORE NUMBER OF UNITS IN STRUCTURE
;NOW WE KNOW HOW MANY UNITS WE'RE LOOKING FOR. THE NEXT STEP IS TO
;RESCAN ALL THE DRIVES, LOOKING FOR ALL THE UNITS, MAKING SURE WE FIND
;EXACTLY ONE OF EACH UNIT OF THE STRUCTURE.
;INITIALIZE THE STRUCTURE TABLE:
SETOM MNTTBL ;-1 MEANS WE HAVEN'T FOUND ANY UNITS YET
MOVE A,[MNTTBL,,MNTTBL+1] ;PREPARE TO PUT -1 IN ALL ENTRIES
BLT A,MNTTBL+MNTLEN-1 ;FILL REST WITH -1'S
MOVEI C,0 ;C HOLDS NUMBER OF UNITS OF THE STRUCTURE WE'VE FOUND SO FAR
CALL DRVINI ;RESTART THE DRIVE SCAN
FND2: CALL MSRNU ;READ NEXT DISK UNIT
JRST FND3 ;GO TO FND3 IF ALL HAVE BEEN SCANNED
CALL DRVMCH ;SKIP IFF PACK IS AVAILABLE AND RIGHT NAME
JRST FND2 ;IT'S NOT, LOOK AT THE NEXT ONE
HLRZ A,RNUNUM ;GET UNIT NUMBER WE'VE JUST FOUND
IMULI A,UNTLEN ;MULTIPLY BY NUMBER OF WORDS USED FOR EACH UNIT
ADDI A,MNTTBL ;OFFSET INTO THE TABLE
AOSE (A) ;MAKE SURE THIS IS THE FIRST MATCH ON THIS UNIT
RET ;SUBSEQUENT, SO AMBIGUITY
HRLI A,RNUCHN ;PREPARE TO MOVE UNIT INFO
MOVEI B,UNTLEN-1(A) ;B HOLDS FINAL ADDRESS INTO WHICH TO MOVE DATA
BLT A,(B) ;MOVE THE INFO FOR THIS UNIT INTO THE MOUNT TABLE
AOJA C,FND2 ;REMEMBER WE'VE FOUND ANOTHER UNIT AND KEEP LOOKING
;NOW THAT WE'VE SCANNED ALL THE DRIVES, MAKE SURE WE'VE FOUND ALL
;THE UNITS
FND3: CAME C,MNTNUM ;CORRECT NUMBER OF UNITS FOUND?
RET ;WRONG NUMBER, SO TAKE NON-SKIP
;WE'VE FOUND THEM ALL, SO FINISH SETTING UP "MNTBLK" SO THE MOUNT
;JSYS WILL WORK
MOVE A,SALIAS ;CORRECT NUMBER, GET DESIRED ALIAS
MOVEM A,MNTALS ;STORE IT IN MOUNT BLOCK
MOVE A,STRNAM ;GET STRUCTURE NAME
MOVEM A,MNTNAM ;STORE AS STRUCTURE NAME BEING MOUNTED
MOVE A,[MNTTBL,,RNUBLK] ;PREPARE TO MOVE INFO FOR ONE PACK OF STRUCTURE
BLT A,RNUBLK+UNTLEN ;SET UP INFO FOR ONE PACK
CALL MSRUS ;READ STATUS OF THIS PACK
LDB A,[221100,,RNUSTA] ;GET DEVICE TYPE CODE
CALL DEVIDX ;GET INDEX INTO DEVICE TYPE NAME TABLE
HLRO A,DEVTYP(A) ;MAKE POINTER TO ASCII NAME
MOVEM A,TYPNAM ;REMEMBER POINTER TO DEVICE TYPE NAME
RETSKP ;FOUND THE STRUCTURE, SO TAKE SKIP RETURN
;THE FOLLOWING ROUTINE TAKES A DEVICE TYPE NUMBER AS RETURNED
;BY THE MONITOR AND NORMALIZES IT TO 0 THROUGH N-1 WHERE N IS THE
;NUMBER OF DEVICE TYPES WE UNDERSTAND.
;ACCEPTS:
; A/ DEVICE TYPE AS RETURNED BY "READ UNIT STATUS"
;RETURNS: +1 ALWAYS
DEVIDX: PUSH P,B
PUSH P,C ;DON'T CLOBBER ANYTHING
MOVEI B,DEVS ;LENGTH OF TABLE TO SEARCH
DEVID1: SOJL B,DEVNF ;IF B RUNS OUT, THE DEVICE CODE WAS BAD
HRRZ C,DEVTYP(B) ;PICK UP DEVICE CODE FROM TABLE
CAME A,C ;IS THIS THE ONE WE'RE LOOKING FOR?
JRST DEVID1 ;NO, KEEP LOOKING
MOVE A,B ;YES, RETURN IT
DEVRET: POP P,C
POP P,B
RET ;RETURN
DEVNF: MOVEI A,BADDEV-DEVTYP ;ON BAD CODE, RETURN A STANDARD BAD ONE
JRST DEVRET
;HERE'S THE ROUTINE THAT ACTUALLY MOUNTS A STRUCTURE. IT ASSUMES
;"MNTBLK" IS SET UP FOR THE STRUCTURE TO BE MOUNTED.
;THIS ROUTINE TAKES A SKIP RETURN IFF THE MOUNT SUCCEEDS
MSMNT: MOVE A,[MNTLEN,,.MSMNT] ;GET LENGTH AND CODE FOR MOUNTING
MOVEI B,MNTBLK ;POINT AT DATA BLOCK FOR STRUCTURE BEING MOUNTED
MSTR ;MOUNT THE STRUCTURE
ERJMP R ;IF FAILS, JUST GIVE SINGLE RETURN
RETSKP ;TAKE SKIP RETURN ON SUCCESSFUL MOUNT
;ROUTINE TO CHECK MOUNTED STRUCTURE AND PRINT WARNING MESSAGE
;IF BAT BLOCKS ARE BAD (MS%BBB IS ON IN READ-UNIT-STATUS)
BBB: MOVE D,MNTNUM ;GET NUMBER OF UNITS IN STRUCTURE
BBBLUP: SOJL D,BBBDON ;IF SCANNED ALL PACKS, WE'RE DONE
MOVE A,D ;POINT TO A PACK IN THIS STRUCTURE
IMULI A,UNTLEN ;MULTIPLY BY SIZE OF PACK INFO BLOCK
ADDI A,MNTTBL ;CALCULATE ADDRESS OF PACK INFO BLOCK
HRL A,A ;PUT IN LEFT HALF FOR BLT POINTER
HRRI A,RNUBLK ;PREPARE TO MOVE BLOCK
BLT A,RNUBLK+UNTLEN ;MOVE IT
CALL MSRUS ;GET INFO ON THIS PACK
MOVE A,RNUSTA ;PICK UP THE STATUS BITS
TXNN A,MS%BBB ;SKIP IF BAT BLOCKS BAD
JRST BBBLUP ;NOT BAD, LOOK AT REST OF PACKS
TYPE <%%%S has bad BAT blocks%_>
BBBDON: RET ;RETURN AFTER CHECKED ALL, OR FOUND ONE BAD
;THIS ROUTINE SETS BIT "DRV%NA" FOR EVERY
;WORD OF DRVTAB, DEPENDING ON WHETHER THAT DRIVE IS AVAILABLE FOR
;MOUNTING ANOTHER STRUCTURE. IF THE BIT IS ON, THE DRIVE IS
;UNAVAILABLE.
DRINFO: MOVX A,DRV%NA ;BIT BEING MODIFIED
MOVEI B,DTABLN ;INDEX INTO DRIVE TABLE
DRIVE1: SOJL B,DRIVE2 ;JUMP IF WE'VE REFERENCED THE WHOLE TABLE YET
IORM A,DRVTAB(B) ;FIRST ASSUME DRIVE IS UNAVAILABLE
JRST DRIVE1 ;DO ALL DRIVES
DRIVE2: CALL DRVINI ;INITIALIZE DRIVE SCAN
DRIVE3: CALL MSRNU ;READ STATUS OF NEXT DISK UNIT
RET ;WE'RE DONE IF WE'VE SCANNED ALL DRIVES
DRIVE6: call drvav ;is drive unused right now?
JRST DRIVE3 ;NOT AVAILABLE, LOOK AT NEXT ONE
;...
;GET TO HERE TO TURN OFF "DRIVE UNAVAILABLE" BIT IN TABLE. DEVICE
;TYPE, CHANNEL, AND UNIT, ARE ENCODED TOGETHER AS AN INDEX INTO THE
;TABLE
LDB A,[221100,,RNUSTA] ;PICK UP DEVICE TYPE
CALL DEVIDX ;GET INDEX FROM DEVICE TYPE TABLE
IMULI A,CHNS ;MULTIPLY BY NUMBER OF CHANNELS ALLOWED PER TYPE
MOVE D,RNUUNT ;GET UNIT NUMBER OF THIS DRIVE
JUMPL D,FNYDEV ;DON'T ALLOW A NEGATIVE UNIT NUMBER!
CAIL D,UNITS ;MAKE SURE WE EXPECT SO LARGE A UNIT NUMBER
JRST FNYDEV ;WE DON'T, THIS IS A FUNNY DEVICE
MOVE C,RNUCHN ;GET CHANNEL NUMBER
JUMPL C,FNYDEV ;MAKE SURE IT'S NON-NEGATIVE
CAIL C,CHNS ;MAKE SURE IT'S NOT TOO LARGE
JRST FNYDEV ;TOO LARGE
ADD A,C ;COMPLETE INDEX INTO DRIVE TABLE
IMULI A,UNITS ;LEAVE ROOM FOR UNIT DESIGNATOR
ADD A,D
MOVE C,RNUSTA ;GET BITS ABOUT THIS DRIVE
MOVEM C,DRVTAB(A) ;SAVE ALL BITS
MOVX B,DRV%NA ;GET BIT WE'RE CLEARING
ANDCAM B,DRVTAB(A) ;CLEAR IT
JRST DRIVE3 ;PROCEED WITH NEXT DRIVE
;IF WE ENCOUNTER A CHANNEL,UNIT, OR DEVICE TYPE THAT IS OUT OF
;RANGE OR UNRECOGNIZED...
FNYDEV: WARN <Channel, unit, or device type out of range>
JRST DRIVE3 ;PROCEED WITH NEXT DRIVE
;THIS ROUTINE SETS STRUCTURE STATUS
MSSSS: MOVE A,[SSSLEN,,.MSSSS] ;LENGTH,,FUNCTION
MOVEI B,SSSBLK ;POINTER TO DATA BLOCK
MSTR ;DO IT
RET
;GET STRUCTURE USERS. SKIPS IFF SUCCESSFUL
MSGSU: MOVE A,[GSULEN,,.MSGSU]
MOVEI B,GSUBLK
MSTR
ERJMP R ;NON-SKIP RETURN ON ERROR
RETSKP
;THIS ONE GETS STRUCTURE STATUS
;SKIPS IFF SUCCESSFUL
MSGSS: HRROI A,NAMBLK ;ALWAYS WRITE PHYSICAL STRUCTURE-ID INTO "NAMBLK"
MOVEM A,GSSSID
MOVE A,[GSSLEN,,.MSGSS]
MOVEI B,GSSBLK
MSTR
ERJMP R ;NON-SKIP IF ERROR
RETSKP ;SKIP IF SUCCESSFUL
;DISMOUNT A STRUCTURE...
MSDIS: MOVE A,[1,,.MSDIS]
MOVEI B,DISALS ;POINT AT ALIAS OF STRUCTURE BEING DISMOUNTED
MSTR ;DISMOUNT IT
RET
;READ STATUS OF DISK UNIT
MSRUS: push p,a ;don't clobber ac's
push p,b
HRROI A,ALSBLK ;GET POINTER TO ALIAS BLOCK
MOVEM A,RNUALS ;STORE FOR READING STATUS OF DRIVE
HRROI A,NAMBLK ;NEEDS POINTER FOR PHYSICAL NAME TOO
MOVEM A,RNUNAM
MOVE A,[RNULEN,,.MSRUS]
MOVEI B,RNUBLK ;SAME DATA AREA AS FOR "READ NEXT UNIT"
MSTR
pop p,b
pop p,a
RET
;ROUTINE TO READ STATUS OF NEXT DISK UNIT
;this routine takes a non-skip return if there are no more drives
;to read the status of, and skips if it successfully reads the status
;of the next drive
MSRNU: HRROI A,ALSBLK ;GET POINTER TO ALIAS BLOCK
MOVEM A,RNUALS ;STORE FOR READING STATUS OF DRIVE
HRROI A,NAMBLK ;NEEDS POINTER FOR PHYSICAL NAME TOO
MOVEM A,RNUNAM
MOVE A,[RNULEN,,.MSRNU] ;LENGTH,,FUNCTION
MOVEI B,RNUBLK ;ADDRESS OF DATA BLOCK
MSTR ;DO IT
ERJMP MSRNUE ;GO ANALYZE THE ERROR
RETSKP ;SKIP RETURN IF WE HAVE STATUS OF NEXT DISK
MSRNUE: CALL GETERR ;GET ERROR CODE
CAIE A,MSTX18 ;IS IT "NO MORE DRIVES"?
JSERR ;UNEXPECTED ERROR
ret ;non-skip return if no more drives
;this routine takes a skip return iff a drive contains an unmounted
;pack that's not being used for a diagnostic, and the drive's pack
;is the right name. the "right name" is that in "strnam". the
;actual drive data used for checking is that in "rnublk", as set up
;by the "msrnu" routine.
drvmch: SAVEAC<A,B,C,D> ;SAVE TEMPORARIES
call drvav ;skip if drive is available
ret ;not available
MOVX A,MS%OFL+MS%HBB ;NOT GOOD (NON-SKIP) IF OFFLINE OR BAD HOME BLOCKS
TDNE A,RNUSTA ;IS THIS DRIVE OFF-LINE?
RET ;NOT POSSIBLY THE RIGHT NAME IF OFF-LINE!
HRROI A,NAMBLK ;POINTER TO NAME OF STRUCTURE WHOSE PACK IS ON THIS DRIVE
MOVE B,STRNAM ;POINTER TO NAME OF STRUCTURE BEING REQUESTED
STCMP ;COMPARE NAMES
CAIE A,0 ;THE SAME?
RET ;NO
retskp ;a good pack
;this routine skips iff a drive is available. data in "rnublk" is used
;for making the decision
drvav: MOVE A,RNUSTA ;GET STATUS BITS FOR THIS DRIVE
TXNE A,MS%OFL+MS%HBB ;OFF-LINE OR BAD BLOCKS?
RETSKP ;YES, DEFINITELY AVAILABLE
TXNE A,MS%DIA ;BEING DIAGNOSED?
ret ;yes, non-skip
HRROI A,NAMBLK ;GET NAME OF STRUCTURE
CALL NOTIGN ;NOT BEING IGNORED?
RET ;IS BEING IGNORED SO NOT AVAILABLE
MOVE A,RNUSTA
TXNN A,MS%MNT ;MOUNTED?
RETSKP ;NOT MOUNTED, SO AVAILABLE
;...
;STRUCTURE IS MOUNTED, BUT MAYBE AVAILABLE ANYWAY, SINCE THERE MAY
;BE NO USERS OF IT. LET'S CHECK. WE MUST BE CAREFUL, HOWEVER, THAT
;A USER DOESN'T START USING IT AFTER WE'VE DECIDED NOONE'S USING IT,
;BUT BEFORE WE GET AROUND TO DISMOUNTING IT!!...
HRROI A,ALSBLK ;GET POINTER TO ALIAS NAME
MOVEM A,GSSALS ;STORE IT FOR STRUCTURE STATUS JSYS
CALL MSGSS ;GET STRUCTURE STATUS
JSERR ;UNEXPECTED FAILURE
MOVE A,GSSSTA ;GET STATUS BITS
TXNE A,MS%INI+MS%PPS ;BEING INITIALIZED OR PUBLIC
RET ;YES, SO UNAVAILABLE
CALL STRFRE ;SKIP IF THIS STRUCTURE NOT IN USE
RET ;IN USE, NOT AVAILABLE
MOVE A,GSSSTA ;GET STATUS BITS
TXNE A,MS%INI ;BEING INITIALIZED?
RET ;YES, SO NOT AVAILABLE
HRROI A,ALSBLK ;GET POINTER TO ALIAS NAME
MOVEM A,SSSALS ;SET UP FOR SETTING STRUCTURE STATUS
MOVX A,MS%DIS ;BIT TO SAY "STRUCTURE BEING DISMOUNTED"
MOVEM A,SSSSTA ;STORE BIT VALUE
MOVEM A,SSSMSK ;AND WHICH BIT POSITION WE'RE CHANGING
CALL MSSSS ;DO THE "SET STRUCTURE STATUS"
CALL STRFRE ;SKIP IF STRUCTURE STILL FREE
CAIA ;NOT FREE (SOMEONE USING IT)
JRST DRIVE5 ;IT'S STILL FREE, SO WE CAN DISMOUNT IT
SETZM SSSSTA ;TURN OFF "IS BEING DISMOUNTED" BIT
HRROI A,ALSBLK ;POINT AT STRUCTURE
MOVEM A,SSSALS ;FOR SETTING STRUCTURE STATUS
CALL MSSSS ;DO IT
RET ;UNAVAILABLE BECAUSE SOMEONE SNUCK IN
DRIVE5: HRROI A,ALSBLK ;POINT TO NAME OF STRUCTURE BEING DISMOUNTED
MOVEM A,DISALS ;STORE IT IN DISMOUNT DATA BLOCK
CALL MSDIS ;DISMOUNT THE STRUCTURE
CALL MSRUS ;REREAD STATUS OF THIS DISK UNIT
JRST DRVAV ;RECONSIDER IT, SHOULD BE AVAILABLE NOW
;THE FOLLOWING ROUTINE SKIPS IFF THE SPECIFIED MOUNTED STRUCTURE IS
;NOT IN USE, I.E. OPEN FILE COUNT, MOUNT COUNT, CONNECTED COUNT ARE 0.
;STRUCTURE REFERENCED IS ASSUMED TO BE IN "ALSBLK".
STRFRE: HRROI A,ALSBLK ;POINT AT NAME AGAIN (*SIGH*)
MOVEM A,GSSALS
MOVEM A,GSUALS ;STORE FOR USER LIST JSYS
MOVX A,MS%GTC ;PREPARE TO GET CONNECTORS
MOVEM A,GSUFLG
CALL MSGSU ;GET LIST OF CONNECTORS
JSERR ;UNEXPECTED FAILURE
HRRZ A,GSUFLG ;GET NUMBER OF JOBS CONNECTED TO THIS STRUCTURE
JUMPN A,R ;IF NON-0, STRUCTURE IS IN USE
CALL MSGSS ;GET STRUCTURE STATUS
JSERR ;UNEXPECTED FAILURE
MOVE A,GSSMC ;GET THE MOUNT COUNT
ADD A,GSSOFC ;ADD IN THE OPEN FILE COUNT
JUMPE A,RSKP ;NO OPEN FILES, NO MOUNTERS, AVAILABLE
RET ;SOME USERS, NOT AVAILABLE
;ROUTINE TO SKIP IFF A STRUCTURE ISN'T SET TO BE IGNORED AS A
;MOUNTABLE STRUCTURE. GIVE IT POINTER TO STRUCTURE NAME IN A.
NOTIGN: SAVEAC <A,B,C,D> ;DON'T CLOBBER AC'S
MOVE B,A ;PUT POINTER TO NAME IN B.
MOVEI A,IGTBL ;LOOK AT TABLE OF IGNORED STRUCTURES
CALL INTOFF ;DON'T LET TABLE CHANGE WHILE WE'RE LOOKING AT IT!
TBLUK ;LOOK UP THE STRUCTURE
CALL INTON ;TURN INTERRUPTS BACK ON
TXNE B,TL%EXM ;EXACT MATCH?
RET ;YES, SO BEING IGNORED, SO TAKE NON-SKIP
RETSKP ;NO, SO AVAILABLE, SO SKIP
;initialization chores of mounter
mntini: TIME
MOVEM A,LSTOPR ;ASSUME OPERATOR JUST LEFT
CALL ANYWAY ;GUARANTEE REQUEST PRINTOUT THE FIRST TIME
SETZM NOFLG ;OPERATOR HASN'T REFUSED THE MOUNT YET
MOVE A,STRNAM ;GET POINTER TO PHYSICAL NAME
BIN ;GET FIRST CHARACTER (ILDB DOESN'T WORK ON -1,,FOO)
JUMPN B,NAMCHK ;IF NON-0, USER SPECIFYED A PHYSICAL NAME
SKIPE RMF ;REMOVAL REQUEST?
JRST MNTRMF ;YES, GO HANDLE STRUCTURE ID DEFAULTING
MOVE A,SALIAS ;GET POINTER TO ALIAS
MOVEM A,STRNAM ;ON SMOUNT, DEFAULT STR ID TO ALIAS
ret
;GET TO HERE WHEN USER HAS SPECIFIIED SPECIFIC PHYSICAL STRUCTURE NAME.
;WE MUST MAKE SURE THAT IF THE ALIAS HE SPECIFYED IS ALREADY MOUNTED,
;THAT IT'S PHYSICAL NAME IS THAT WHICH THE USER GAVE US. ALSO, IF
;THE STRUCTURE IS NOT MOUNTED, ONLY ENABLED WHEELS, OPRS, AND MAINTENANCE
;PEOPLE ARE ALLOWED TO SPECIFY A DIFFERENT PHYSICAL NAME THAN THE ALIAS.
;THIS IS SO THAT MALICIOUS USERS CAN'T DO THINGS LIKE MOUNTING A AS
;B AND B AS A, ETC.
NAMCHK: CALL STRMNT ;IS STRUCTURE MOUNTED?
JRST NAM1 ;NO, SO WE MAY NOT CARE ABOUT PHYSICAL NAME
HRROI A,NAMBLK ;MOUNTED, GET MOUNTED ONE'S PHYSICAL NAME
MOVE B,STRNAM ;GET USER'S SPECIFYED PHYSICAL NAME
STCMP ;COMPARE THEM
JUMPN A,NAMBAD ;ERROR IF THEY DISAGREE AND STRUCTURE IS MOUNTED
;SPECIFYED ALIAS IS NOT MOUNTED...
NAM1: SKIPE RMF ;REMOVAL REQUEST??
RET ;YES, SO ALL PHYSICAL NAMES OF UNMOUNTED STRUCTURES ARE LEGAL
MOVE A,SALIAS
MOVE B,STRNAM ;COMPARE ALIAS AND PHYSICAL NAME USER GAVE US
STCMP ;A=0 IFF THEY ARE THE SAME
JUMPE A,R ;IF THEY'RE THE SAME, IT'S ALWAYS LEGAL
CALL PRVCHK ;NOT THE SAME, MAKE SURE USER IS PRIVILEGED
JRST NAMBD1 ;HE'S NOT, SO THAT'S AN ERROR
RET ;PRIVILEGED, SO ALLOW IT
;NOW WE KNOW IT'S A REMOVAL REQUEST. IF USER DIDN'T SPECIFY PHYSICAL
;STRUCTURE NAME, WE HAVE TO FIGURE IT OUT...
MNTRMF: MOVE A,SALIAS ;GET ALIAS
MOVEM A,STRNAM ;FIRST ASSUME WE'RE USING ALIAS AS PHYSICAL NAME
CALL STRMNT ;SKIP IF STRUCTURE BEING REMOVED IS MOUNTED
RET ;NOT MOUNTED, USE GIVEN NAME AS PHYSICAL NAME
CALL DRVINI ;MOUNTED, SO FIGURE OUT WHAT IT'S REAL NAME IS
INI2: CALL MSRNU ;GET INFO ON A PACK
RET ;CAN'T FIND IT, ASSUME NOT REALLY MOUNTED (MAYBE SOME CLOWN DID "REMOVE DSK:")
MOVE A,RNUSTA ;GET STATUS BITS FOR THIS PACK
TXNN A,MS%MNT ;MAKE SURE IT'S MOUNTED
JRST INI2 ;NOT MOUNTED, SO LOOK AT NEXT PACK
HRROI A,ALSBLK ;LOOK AT THIS STRUCTURE'S ALIAS
MOVE B,SALIAS ;GET ALIAS OF STRUCTURE BEING REMOVED
STCMP ;COMPARE NAMES
JUMPN A,INI2 ;IF DIFFERENT, WE HAVEN'T FOUND A GOOD PACK YET
HRROI A,SMSBLK ;POINT TO PLACE TO STORE PHYSICAL NAME
MOVEM A,STRNAM ;REMEMBER POINTER TO PHYSICAL NAME
HRROI B,NAMBLK ;POINT TO THIS STRUCTURE'S PHYSICAL NAME
MOVEI C,0 ;END ON NULL
SOUT ;COPY NAME TO PHYSICAL STRUCTURE NAME CELL
RET ;DONE
;the following routine prints out the list of available drives, if it
;has changed. "odrvtb" contains the old list, and "drvtab" contains
;the new list.
pdinfo: movei d,0 ;pointer to drive table
movei c,0 ;number of available drives seen
MOVEI B,0 ;NUMBER OF DISK DRIVES THAT HAVE CHANGED STATE
pd3: cail d,dtabln ;have we looked at entire table?
JRST PD4 ;LEAVE LOOP
move a,drvtab(d) ;get word for disk drive
txnn a,drV%na ;skip if it's not available
aoj c, ;available, count it
XOR A,ODRVTB(D) ;GET OLD AVAILABILITY
TXNE A,DRV%NA ;DID IT CHANGE STATE?
AOJ B, ;YES, COUNT IT
aoja d,pd3
PD4: JUMPE B,R ;JUST RETURN IF NOTHING HAS CHANGED
HLRZ A,IGTBL ;GET NUMBER OF STRUCTURES BEING IGNORED
JUMPE A,PD9 ;JUMP TO PD9 IF NONE
CAIN A,1
TYPE <Structure being ignored: >
CAIE A,1
TYPE <structures being ignored: >
CAIA ;NO COMMA BEFORE FIRST ONE
PD7: TYPE <, >
HLRZ B,IGTBL(A) ;GET ADDRESS HOLDING NAME OF STRUCTURE
UTYPE @B ;PRINT THE NAME
SOJG A,PD7 ;PRINT ALL OF THEM
TYPE <%_>
PD9: TIME
MOVEM A,LASTL ;REMEMBER WHAT TIME WE PRINTED THIS LIST
SKIPN RMF ;WAITING FOR SOMETHING TO BE REMOVED?
JRST PDGONE ;NO, SKIP THIS INFO PRINTING
MOVE A,SALIAS ;GET NAME OF STRUCTURE AWAITING REMOVAL
MOVEM A,GSUALS ;PREPARE TO GET CONNECTORS TO STRUCTURE
MOVEM A,GSSALS
CALL MSGSS
JRST PDGONE ;IF CAN'T GET STATUS, ASSUME IT'S DISMOUNTED
MOVX A,MS%GTC ;PREPARE TO GET CONNECTORS
MOVEM A,GSUFLG
CALL MSGSU ;GET CONNECTORS
JSERR ;SHOULDN'T FAIL
HRRZ D,GSUFLG ;GET NUMBER OF CONNECTORS
CAIE D,0 ;PRINT MESSAGE IF USERS CONNECTED TO STRUCTURE
TYPE <%S can't be removed while users are CONNECTed to it%_>
MOVE A,STRNAM ;GET PHYSICAL NAME OF STRUCTURE BEING REMOVED
CALL NOTIGN ;MAKE SURE IT'S NOT BEING IGNORED
TYPE <%S unremovable until someone does "^ESET STR %2A: ACKNOWLEDGED" command%_>
call notign
aoj d, ;remember that there was a reason it's unremovable
MOVE B,GSSSTA ;GET STATUS BITS
TXNE B,MS%INI
TYPE <%S can't be removed WHILE It's being initialized%_>
SKIPN GSSOFC
SKIPE GSSMC ;IF NON-0 MOUNT OR OPEN FILE COUNT, CAN'T REMOVE IT
CAIA ;THERE ARE USERS
JRST PDY ;NO USERS ON IT
AOJ D, ;REMEMBER THERE WERE USERS
TYPE <%S can't be removed until users close files on it and SDISMOUNT it%_>
PDY: CAIN D,0 ;RETURN HERE IF ANY CONNECTORS
TXNE B,MS%INI ;STRUCTURE UNAVAILABLE FOR REMOVAL?
RET ;YES, SO DON'T BOTHER LISTING AVAILABLE DRIVES
PDGONE: jumpe c,pdna ;if none availale, go say so
HRROI A,[ASCIZ /available drives/]
SKIPE RMF
HRROI A,[ASCIZ /Packs available for removal and free drives/]
type <%1A:
Type Unit Channel Str name Pack #
---- ---- ------- -------- ------
>
movei A,0 ;pointer to drive table
movx b,dRv%na ;get "not available" bit
pd1: cail A,dtabln ;have we looked at the whole table?
ret ;yes
tDnn b,drvtab(A) ;skip if drive not available
call pdtell ;available, list it
aoja A,pd1 ;loop for rest of drives
;ROUTINE TO PRINT OUT AN AVAILABLE DRIVE, DECODES CONTENTS OF A INTO
;DEVICE TYPE, CHANNEL NUMBER, AND UNIT NUMBER.
PDTELL: PUSH P,A ;SAVE DRIVE NUMBER
PUSH P,B ;DON'T CLOBBER BIT BEING TESTED
IDIVI A,CHNS*UNITS ;LEAVE DEVICE INDEX IN A
IDIVI B,UNITS ;LEAVE CHANNEL IN B, UNIT IN C
movem b,rnuchn ;set up for reading drive status
movem c,rnuunt
call msrus ;read drive status
HLRo A,DEVTYP(A) ;get pointer to name of drive type
type <%1a %3o %2o > ;like "rp04 (unit) 0 (channel) 1"
MOVE A,RNUSTA ;GET STATUS BITS
TXNE A,MS%OFL ;OFF-LINE?
jrst pdol ;this drive is off line
TXNE A,MS%HBB ;HOMEBLOCKS BAD?
JRST PDBB ;YES
hlrz b,rnunum ;get unit within structure
aoj b, ;add one for "pack 1 of 3" etc.
hrrz c,rnunum ;get total units in structure
HRROI A,NAMBLK ;POINT AT STRUCTURE NAME
type <%1A: %2d of %3d%_> ;"ps2: (pack) 1 of 3" for instance
PDEX: POP P,B ;RESTORE B AND A
POP P,A ;FOR PDINFO ROUTINE
RET
pdol: type <No detectable pack on this drive%_>
JRST PDEX
PDBB: TYPE <Bad HOME blocks%_>
JRST PDEX
;WHEN NO DRIVES ARE AVAILABLE...
PDNA: SKIPN RMF ;DON'T TYPE THIS IF WAITING FOR STRUCTURE TO BE REMOVED
TYPE <No drives currently available for mounting new structures...%_>
RET
;GET TO HERE IF THE OPERATOR TYPES SOMETHING WHILE WE'RE WAITING FOR A
;REQUESTED STRUCTURE TO APPEAR
SMOPR: MOVEI D,SMERR ;CODE IS "SMOUNT ERROR"
SKIPE NOFLG ;HAS OPERATOR ALREADY TYPED "NO"?
JRST REASON ;YES, WE'RE NOW READING THE REASON
MOVE A,[440700,,OMSG+1] ;NO, THIS IS IT THEN. SET UP POINTER TO WHAT OPERATOR TYPED.
CALL GETWRD ;GET THE FIRST WORD
CAME B,[SIXBIT /NO/] ;DID OPERATOR TYPE "NO"?
JRST BADNO ;NO, SO COMPLAIN
SETOM NOFLG ;YES, REMEMBER.
TYPE <Please type the reason - end with <ret>:%_>
JRST WAKEUP ;WAIT FOR OPERATOR TO TYPE THE REASON
BADNO: CALL ANYWAY ;MAKE OPLEAS PRINT OUT THE REQUEST AGAIN
JRST WAKEUP ;IGNORE THE NON-NO AND WAIT FOR "NO" OR STRUCTURE
;ROUTINE TO MAKE OPLEAS THINK IT'S BEEN A REALLY LONG TIME SINCE THE
;OPERATOR HAS BEEN REMINDED OF THE REQUEST. THIS IS USED IN PLACES LIKE
;THE FIRST TIME, AND WHEN THE OPERATOR TYPES GARBAGE, IN ORDER TO REMIND
;THE OPERATOR WHAT HE/SHE IS SUPPOSED TO DO.
ANYWAY: time ;get current time
sub a,[^d60000*annoyt+1]
movem a,lastl ;fool opleas into printing the
;verbose request again (in response
;to bad typin just received from
;operator)
RET
;USER HAS ASKED FOR MOUNTING REMOVAL OF AN ALREADY MOUNTED STRUCTURE,
;AND USER SPECIFYED A PHYSICAL ID, WHICH DOESN'T MATCH THE REAL ONE.
NAMBAD: MOVEI A,UBLEW ;ERROR DISPATCH
UBLEW2: MOVEM A,SMEDSP
RET ;RETURN AND PROCESS ERROR LATER
;OH, IT'S NOW LATER!...
UBLEW: HRROI B,[ASCIZ /Structure already mounted and wrong STRUCTURE-ID specified/]
JRST UCON1 ;GO PROCESS ERROR
;USER TRIED TO MOUNT A NEW STRUCTURE WITH A DIFFERENT ALIAS THAN THE
;STRUCTURE'S PHYSICAL NAME.
NAMBD1: MOVEI A,UBLEW1 ;ERROR DISPATCH ADDRESS
JRST UBLEW2 ;JOIN COMMON CODE
UBLEW1: HRROI B,[ASCIZ /OPERATOR, WHEEL, or MAINTENANCE capability required to
specify STRUCTURE-ID different than alias/]
JRST UCON1
;ARRIVE HERE WHEN USER HAS REQUESTED REMOVAL OF HIS CONNECTED
;STRUCTURE. DISALLOW THE REMOVAL, BECAUSE SYSTEM PHILOSOPHY BELIEVES
;EVERYONE HAS A CONNECTED DIRECTORY. ENFORCE IT.
UCON: HRROI B,[ASCIZ /Illegal to remove connected structure/]
UCON1: SETOM SILNTF ;WE DON'T WANT "FINISHED AT..." PRINTED
JRST GIVERR ;GO GIVE ERROR TO CALLER
;GET TO HERE WHEN GIVING UP AN SMOUNT REQUEST BECAUSE WE WAITED TOO
;LONG FOR THE REQUESTED STRUCTURE TO BE MOUNTED.
GIVEUP: HRROI B,[ASCIZ /Noone put the structure on line/]
SKIPE RMF
HRROI B,[ASCIZ /Noone removed the structure/]
GIVERR: MOVEI D,SMERR ;CODE IS "SMOUNT ERROR"
GIVE1: HRROI A,OMSG+1 ;PLACE TO PUT REASON
MOVEI C,0 ;END MESSAGE WITH NULL
SOUT ;STORE REASON FOR FAILURE
JRST REASON ;FALL INTO CODE THAT SENDS FAILURE REASON
;OPERATOR HAS REJECTED THE MOUNT REQUEST AND TYPED IN THE REASON...
REASON: MOVE A,D ;GET CODE OF IPCF MESSAGE
CALL BLURB ;SEND TEXT WITH CODE
JRST WAKE13 ;COULDN'T TELL USER, SO SAY BYE
SKIPE RDFLG ;IS THE OPERATOR'S REASON REAL LONG?
JRST WAKE1 ;YES, READ THE REST OF IT
JRST WAKE4 ;WE'VE SENT REASON, PROCEED TO NEXT USER
;HERE IF MOUNT JSYS FAILS: GET ERROR STRING AND SEND TO USER
;AS REASON FOR SMOUNT FAILURE
WHOOPS: HRROI A,OMSG+1 ;PUT MESSAGE WHERE EXEC CAN READ IT FROM
MOVE B,[.FHSLF,,-1] ;SPECIFY LAST ERROR (GERNERATED BY FAILING MOUNT)
MOVEI C,0 ;NO LIMIT TO MESSAGE LENGTH
TYPE <?Couldn't mount %S, monitor's reason is:%_ %2E%_>
ERSTR ;GET REASON THAT MOUNT FAILED
JSERR
JSERR ;ERSTR FAILED
MOVEI D,SMERR ;THIS IS AN SMOUNT ERROR
JRST REASON ;GO TELL USER WHY IT FAILED
;GET TO HERE IF STRUCTURE NOT ON-LINE YET, AND USER REQUESTED NOT
;TO WAIT FOR IT
NOWAIT: SETOM SILNTF ;IF NEVER ANNOUNCED REQUEST, DON'T ANNOUNCE ABORT EITHER
HRROI B,[ASCIZ /%Structure not on-line/]
SKIPE RMF ;DIFFERENT FAILURE MESSAGE FOR REMOVAL REQUEST
HRROI B,[ASCIZ /%Structure still on-line/]
MOVEI D,PLTXT ;JUST SEND TEXT, BUT NOT AS AN ERROR MESSAGE
JRST GIVE1 ;USE COMMON CODE FOR SENDING FAILURE NOTIFICATION
;ROUTINE TO INITIALIZE UNIT, CHANNEL, AND CONTROLLER NUMBER, SO THAT
;ENTIRE DRIVE LIST WILL BE SCANNED.
DRVINI: SETOM RNUCHN
SETOM RNUCON
SETOM RNUUNT
RET
;THE FOLLOWING ROUTINE TAKES A POINTER IN A TO A STRUCTURE NAME
;(NOT ALIAS). THE ROUTINE SKIPS IFF THE STRUCTURE IS FOUND ON THE
;LIST OF STRUCTURES ALLOWED TO BE MOUNTED DOMESTICALLY.
DOMQ: SAVEAC <A,B,C>
MOVE B,A ;PUT POINTER TO NAME IN B
MOVEI A,DOMTBL ;POINTER TO TABLE IN A
TBLUK ;SEE IF STRUCTURE IS IN TABLE
TXNE B,TL%EXM ;EXACT MATCH WITH SOMETHING?
RETSKP ;YES, TAKE SKIP RETURN
RET ;NO, SINGLE RETURN, DOMESTIC MOUNTING NOT ALLOWED
;GET TO HERE WHEN "DOMESTIC" COMMAND SEEN IN COMMAND FILE
DOMSTR: HRROI A,[ASCIZ /STRUCTURE/] ;GUIDE WORD STRING
MOVEM A,CMDAT ;SPECIFY GUIDE STRING
MOVX A,CMNOI ;GET "NOISE" FUNCTION
CALL CREAD ;READ GUIDE WORDS
MOVX A,CMFLD ;SPECIFY ARBITRARY FIELD
CALL CREAD ;READ NAME OF STRUCTURE BEING ALLOWED TO BE DOMESTIC
HRROI A,ATMBUF ;GET POINTER TO STRUCTURE NAME
CALL READNM ;COPY THE NAME
JRST NOSRUM ;NO ROOM
MOVE D,A ;REMEMBER ADDRESS OF STRUCTURE NAME STRING
MOVX A,CMCFM ;GET COMMAND CONFIRMATION
CALL CREAD ;ASSURE GOOD CONFIRMATION
HRLZ B,D ;MAKE A TABLE ENTRY
MOVEI A,DOMTBL ;POINT AT DOMESTIC STRUCTURES TABLE
TBADD ;ADD THIS STRUCTURE TO TABLE
ERJMP DOMFAL ;COULDN'T, GO SEE WHY
JRST ICOMND ;GO READ NEXT COMMAND
;NO ROOM FOR ANOTHER STRING...
NOSRUM: TYPE <%%No more room, >
HRROI A,ATMBUF ;GET POINTER TO NAME AGAIN
TYPE <Structure %1A: not put on domestic structures list%_>
JRST ICOMND ;GO GET NEXT COMMAND
;TBADD FAILED WHEN TRYING TO ADD STRUCTURE TO DOMESTIC LIST
DOMFAL: CALL GETERR ;GET ERROR CODE
CAIN A,TADDX1 ;TABLE FULL?
JRST TABFUL ;YES
CAIN A,TADDX2 ;ENTRY ALREADY THERE?
JRST TABDUP ;YES
TYPE <%%%1E, >
NOS2: HRRO A,D ;MAKE POINTER TO STRUCTURE NAME
TYPE <Structure %1A: not put on domestic structures list%_>
NOS1: CALL STREM ;RELEASE STORAGE TAKEN UP BY STRING
JRST ICOMND ;GO GET NEXT COMMAND
TABFUL: TYPE <Domestic structures table full, >
JRST NOS2 ;GO SAY WHICH STRUCTURE DIDN'T GET PUT ON LIST
TABDUP: TYPE <%%Duplicate domestic structure name %1A:%_>
JRST NOS1 ;GO GET NEXT COMMAND
SUBTTL COMMANDS
;THIS SECTION HANDLES OPLEAS COMMANDS, WHICH ARE READ FROM A SPECIAL
;FILE
;HERE'S THE "COMNDS" ROUTINE. ANY PLACE WITHIN OPLEAS THAT A DECISION
;MUST BE MADE WHICH DEPENDS ON COMMANDS THAT MIGHT BE IN THE
;COMMAND FILE, MUST CALL THIS ROUTINE BEFORE MAKING THE DECISION.
;(REMEMBER, SOMEONE MIGHT UPDATE THE COMMANDS FILE WHILE OPLEAS
;IS RUNNING)
COMNDS: MOVEM P,SAVEDP ;REPARSE MAY HAPPEN FROM DEEPER SUBROUTINES
MOVX A,GJ%OLD+GJ%SHT ;OLD FILE + SHORT FORM GTJFN
HRROI B,COMNAM ;GET POINTER TO COMMANDS FILE NAME
GTJFN ;GET HANDLE ON COMMANDS FILE
JRST NOCOMS ;GO HANDLE ERROR GETTING HANDLE
MOVE B,[70000,,OF%RD] ;BITS FOR OPENING FILE FOR READ
OPENF ;OPEN COMMANDS FILE FOR READING
JRST NOOPEN ;GOT JFN, BUT COULDN'T OPEN FILE
MOVEM A,COMJFN ;REMEMBER NEW HANDLE ON COMMANDS FILE
GTAD ;GET CURRENT TIME AND DATE
MOVE D,A ;D CONTAINS A NUMBER GUARANTEED DIFFERENT FROM FILE WRITE DATE
MOVE A,COMJFN ;GET HANDLE ON COMMANDS FILE
MOVEI B,D ;WE'LL READ TIME INTO D
MOVEI C,1 ;ONLY ONE DATUM REQUESTED
RFTAD ;GET LAST WRITE-TIME FOR COMMANDS FILE
CAMN D,STAMP ;DIFFERENT THAN LAST TIME WE CHECKED?
RET ;NO, SO COMMANDS ARE UP TO DATE
;...
;THERE'S A NEW COMMANDS FILE, SO CLEAR OLD COMMANDS STATUS AND READ
;NEW COMMANDS IN.
MOVEM D,STAMP ;REMEMBER NEW UPDATE STAMP
CALL PIOFF ;NO INTERRUPTS DURING COMMAND UPDATE
MOVEI A,DOMTBL ;PREPARE TO EMPTY THE DOMESTIC STRUCTURES TABLE
CALL TEMPTY ;EMPTY THE TABLE
MOVE A,DOMINI ;GET INITIAL STATE OF DOMESTIC TABLE
MOVEM A,DOMTBL ;CLEAR DOMESTIC STRUCTURES TABLE
ICOMND: CALL READI ;INITIALIZE FOR COMND JSYS
REPARS: MOVE P,SAVEDP ;FIX STACK ON REPARSE
MOVEI A,COMTBL ;GET POINTER TO COMMANDS
MOVEM A,CMDAT
MOVX A,CMKEY ;SPECIFY "KEYWORD"
CALL CREAD ;DO COMND JSYS
MOVE B,(B) ;GET ADDRESS OF COMMAND'S SUPPORT ROUTINE
JRST (B) ;DO WHAT THE COMMAND WANTS
;ROUTINE TO DO COMND JSYS. IT RETURNS IFF A SUCCESFUL PARSE HAPPENS.
;CALL IT WITH THE VALUE FOR THE FIRST WORD OF THE FUNCTION BLOCK IN A.
CREAD: MOVEM A,FBLOCK
MOVEI A,SBLOCK
MOVEI B,FBLOCK ;COMMAND STATE BLOCK AND FUNCTION BLOCK
COMND ;READ COMMAND NAME
ERJMP COMEOF ;ERROR, HOPEFULLY END OF FILE
TXNE A,CM%NOP ;DID IT PARSE CORRECTLY?
JRST NOPARS ;NO, GIVE WARNING AND CONTINUE
RET ;SUCCESFUL COMND JSYS, RETURN
;GET TO HERE ON BAD COMMAND
NOPARS: HRROI A,ATMBUF ;GET POINTER TO ATOM BUFFER
TYPE <%%Command line containing "%1A" being ignored%_>
JRST ICOMND ;GO INPUT NEXT COMMAND
;GET TO HERE ON COMND JSYS ERROR, HOPEFULLY END OF FILE CONDITION
COMEOF: CALL GETERR ;GET ERROR CODE
CAIN A,IOX4 ;END OF FILE?
JRST COMEO1 ;YES
COMEO2: TYPE <%%Command file execution failed, reason:%_%2E.
>
;HERE ON END OF COMMAND FILE...
NOCOMS: ;COULDN'T GET JFN ON COMMAND FILE
COMEO1: CALL PION ;TURN PI'S BACK ON
MOVE P,SAVEDP ;GET CORRECT STACK LOCALE
MOVE A,COMJFN ;GET JFN ON COMMANDS FILE
CLOSF ;CLOSE IT
JFCL ;IGNORE FAILURE
RET ;RETURN TO CALLER
;ROUTINE TO INITIALIZE POINTERS ETC. FOR COMND JSYS
READI: SETZM CMFNP
SETZM CMDAT
SETZM CMHLP
SETZM CMDEF ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVEI A,REPARS
MOVEM A,CMFLG ;SET UP REPARSE ADDRESS
HRL A,COMJFN ;INPUT FROM COMMAND FILE JFN
HRRI A,377777 ;NO EDITING OUTPUT
MOVEM A,CMIOJ
HRROI A,CINBUF ;POINTER TO USER'S (FILE'S) INPUT
MOVEM A,CMRTY ;CONTROL-R BUFFER IS REGULAR INPUT BUFFER
MOVEM A,CMBFP
MOVEM A,CMPTR ;POINTER TO NEXT FIELD TO BE PARSED
MOVEI A,CINLEN*5 ;GET LENGTH OF INPUT BUFFER
MOVEM A,CMCNT
SETZM CMINC ;NO UNPARSED CHARACTERS YET
HRROI A,ATMBUF ;POINTER TO ATOM BUFFER
MOVEM A,CMABP
MOVEI A,ATMLEN*5 ;LENGTH OF ATOM BUFFER
MOVEM A,CMABC
SETZM CMGJB ;NO GTJFN BLOCK
RET
SUBTTL TEXT
;ERROR OPENING COMMAND FILE, RELEASE JFN, GIVE WARNING AND RETURN
;TO CALLER
NOOPEN: PUSH P,B ;SAVE ERROR CODE
MOVE A,COMJFN ;GET JFN OF COMMAND FILE
CLOSF ;CLOSE IT
JFCL ;IGNORE ERROR
POP P,B ;RETRIEVE REASON THAT OPENF FAILED
JRST COMEO2 ;TYPE REASON AND GIVE UP TRYING TO READ COMMANDS
;'TEXT' RECEIVED. IF FROM CURRENT PID, MOVE TO BUFFER FOR LATER TYPING.
; IF NOT, SEND 'CONFUSED' TO SENDER
;ACCEPTS:
;Q2/ PID OF SENDER
;P2/ ADDRESS OF SEND PDB
;REACHED VIA JRST FROM IPCINT
;JRSTS TO ENDINT ALWAYS
TEXT: CAME Q2,CURPID ;IS TEXT FROM CURRENT PID?
JRST TEXT2 ;NO. GO SEND 'CONFUSED' MESSAGE
;TEXT IS FROM CURRENT PID
HLRZ T1,RMSG ;SAVE NUMBER OF THIS MESSAGE
MOVEM T1,RCVCNT ; TO SEND BACK WITH 'BYE'
UTYPE RMSG+1 ;TYPE MESSAGE
JRST ENDINT
;TEXT NOT FROM CURRENT USER. ERROR
TEXT2: MOVE T2,Q2 ;T2/PID SENDING TEXT
SKIPE DEBUG ;DEBUGGING?
TYPE <%_D:Received text from PID %2O%_>
MOVEI T2,PLCON ;SEND 'CONFUSED' TO SENDER
MOVEM T2,SMSG ;CODE FIELD IN MESSAGE
MOVEM Q2,.IPCFR(P2) ;SEND MESSAGE TO SENDER OF TEXT
MOVEI P4,SPDBSZ ;P4/SIZE OF SEND PDB
CALL SNDMSG ;SEND 'CONFUSED' TO SENDER
JFCL ;FAILURE. IGNORE.
JRST ENDINT
SUBTTL BYE
;'BYE' RECEIVED. IF FROM CURRENT USER, SET BIT 0 IN BYEFLG. IF
;NOT, REMOVE FROM INTERNAL QUEUE.
;ACCEPTS:
;Q2/ SENDER'S PID
;REACHED VIA JRST FROM IPCINT
;JRSTS TO ENDINT ALWAYS
ABORT: CAMN Q2,CURPID ;DON'T SET FLAG IF QUEUED-UP USER ^C'S
SETOM ABTFLG ;ABORT IS LIKE BYE BUT DIFFERENT SIGN-OFF MESSAGE
BYE: CAMN Q2,CURPID ;SENT FROM CURRENT PID?
JRST [ MOVX T1,1B0 ;YES. SET BYEFLG TO SAY USER QUIT
IORM T1,BYEFLG
HLRZ T1,RMSG ;LAST MESSAGE RECEIVED BY UPLEASE
MOVEM T1,TXTCNT ;SAVE TO CHECK AGAINST OUR COUNT
JRST ENDINT]
;NOT FROM CURRENT USER. REMOVE FROM QUEUE.
CALL REMPID ;REMOVE PID AND SQUEEZE QUEUE
;IGNORE GOODBYE IF FROM PID NOT IN QUEUE. PROBABLY RECEIVED FROM
;CURRENT PID AFTER OPERATOR TERMINATED.
JFCL ;PID NOT IN QUEUE
JRST ENDINT
SUBTTL ONEWAY
;RECEIVED ONEWAY MESSAGE. IF OPERATOR IS FREE, PRINT THE MESSAGE.
;IF NOT, ENTER USER IN QUEUE. IF USER IS ALREADY IN QUEUE, CHANGE
;THE ENTRY TO POINT TO THE MESSAGE. STORE THE MESSAGE IN A FREE PAGE
;ACCEPTS:
;Q2/SENDER'S PID
;REACHED VIA JRST FROM IPCINT
;JRSTS TO ENDINT ALWAYS
ONEWAY:
CAIN Q2,CURPID ;FROM CURRENT USER?
JRST ONEWA4 ;YES
SKIPN CURPID ;IS THERE A CURRENT PID?
SKIPE QUECNT ;NO. IS ANYONE IN THE QUEUE?
JRST ONEWA1 ;YES. ADD THIS USER TO QUEUE
;OPERATOR IS FREE. PRINT THIS MESSAGE.
JRST [ MOVEI P5,RMSG ;P5/ADDRESS OF MESSAGE
CALL PRTONE ;PRINT THE ONEWAY MESSAGE
JRST ENDINT]
;SOMEONE IS AHEAD OF THIS USER. PUT IN QUEUE
ONEWA1:
CALL GETPAG ;STORE MESSAGE IN NEXT FREE PAGE.
; P5/LOCATION OF MESSAGE AFTER STORED
jrst [ TYPE <%_%%NUMBER OF ONE-WAY MESSAGES EXCEEDS MAXIMUM%_> ;failed to get page
jrst endint]
MOVE T4,NXTREM ;POINT TO FIRST ENTRY IN QUEUE
ONEWA2: CAMN Q2,(T4) ;IS THIS THE USER?
JRST [ MOVEM P5,(T4) ;YES. STORE THE PAGE WHERE THE
JRST ENDINT] ; MESSAGE IS IN THE QUEUE
AOS T4 ;NO. POINT TO NEXT LOCATION
CAILE T4,QUEFIN ;AT END OF QUEUE AREA?
MOVEI T4,QUEBEG ;YES. POINT TO BEGINNING
CAME T4,NXTADD ;BEYOND END OF LIST?
JRST ONEWA2 ;NO. GO LOOK AT NEXT ENTRY
;USER NOT IN QUEUE. ADD TO END OF LIST
AOS T1,QUECNT ;INCREMENT QUEUE COUNT
CAILE T1,QUESIZ ;QUEUE OVERFLOWED?
JRST ONEWA3 ;YES. PRINT ERROR
MOVEM P5,(T4) ;SAVE PAGE WHERE MESSAGE STORED
AOS T4,NXTADD ;INCREMENT NEXT AVAILABLE LOCATION
CAILE T4,QUEFIN ;BEYOND END OF LIST?
JRST [ MOVEI T4,QUEBEG ;YES. RESET TO TOP OF LIST
MOVEM T4,NXTADD
JRST .+1]
JRST ENDINT
;QUEUE OVERFLOWED
ONEWA3: TYPE<%_%%User queue overflow.%_>
SOS QUECNT ;DECREMENT COUNT INCREMENTED BEFORE
; OVERFLOW
CALL RETPAG ;RETURN PAGE TAKEN BEFORE OVERFLOW (P5 CONTAINS ADDRESS)
JRST ENDINT
;ONEWAY IS FROM CURRENT USER - PROBABLY DIDN'T GET THE OK IN TIME
;USER HAS NOT RECEIVED ANY MESSAGES, SO TXTCNT WILL BE ZERO
ONEWA4:
UTYPE RMSG+4 ;TYPE MESSAGE
MOVX T1,1B0 ;SET BYEFLG TO SAY USER QUIT
IORM T1,BYEFLG
JRST ENDINT
SUBTTL FREE SPACE ALLOCATION
;ROUTINE TAKING A STRING POINTER IN A. IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A. IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
READNM: CALL BCOUNT ;HOW MANY WORDS IN THIS STRING?
PUSH P,A ;SAVE BYTE POINTER TO STRING BEING STORED
MOVE A,B ;PUT NUMBER OF WORDS NEEDED INTO A.
CALL GETMEM ;GET THAT MANY
JRST NOREAD ;COULDN'T, SO TAKE NON-SKIP RETURN
HRRO A,B ;MAKE BYTE POINTER TO SPACE OBTAINED
EXCH B,(P) ;GET ORIGINAL POINTER, SAVE ADDRESS WHERE STRING WILL BE COPIED TO
MOVEI C,0 ;STORE NULL AT END OF STRING
SOUT ;COPY THE STRING
POP P,A ;GET ADDRESS WHERE STRING GOT PUT
HRRO A,A ;MAKE BYTE POINTER
RETSKP ;SUCCESFUL RETURN
NOREAD: POP P,(P) ;BAD RETURN, FIX STACK
RET ;NO ROOM FOR STRING
;STREM ROUTINE TAKES ADDRESS OF STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE
STREM: PUSH P,A ;PRESERVE ADDRESS
HRRO A,A ;MAKE BYTE POINTER
CALL BCOUNT ;COUNT NUMBER OF WORDS IN THE STRING
EXCH A,B ;PUT LENGTH IN A, ADDRESS IN B
HRRZ B,B ;GET RID OF BYTE POINTER P AND S
CALL RETMEM ;RETURN THE SPACE TO THE FREE POOL
POP P,A ;RESTORE ADDRESS OF STRING (WHICH ISN'T NO MORE!)
RET
; /GETMEM/ - ROUTINE TO ASSIGN MEMORY AS REQUESTED
; INPUTS: A - CONTAINS NUMBER OF WORDS WANTED
; OUTPUTS: A - NUMBER OF WORDS OBTAINED
; B - CONTAINS ADDRESS OF WORDS GOTTEN
; RETURNS: SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM
GETMEM: MOVEI B,DICT ;START WITH HEADER OF ODD LIST
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,0(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,0(B) ;GET SIZE OF CURRENT BLOCK
CAMGE D,A ;IS IT SUFFICIENT FOR REQUEST?
JRST GETM2 ;NO, SO TRY NEXT BLOCK
GETM3: HRL B,0(B) ;GET LINK OF CURRENT BLOCK
HLRM B,0(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS B ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN D,A ;IS THIS AN EXACT MATCH ON SIZE?
RETSKP ;SUCCESS, SKIP RETURN
PUSH P,A ;SAVE NUMBER OF WORDS
PUSH P,B ;SAVE ADDRESS
ADD B,A ;GET FIRST WORD TO RETURN
SUBM D,A ;NUMBER OF WORDS TO RETURN
CALL RETMEM ;RETURN THE EXTRA WORDS
POP P,B ;RESTORE ADDRESS OF BLOCK
POP P,A ;RESTORE NUMBER OF WORDS
RETSKP ;SUCCESS, SKIP RETURN
; /RETMEM/ - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
; INPUT: A - CONTAINS SIZE OF BLOCK TO RETURN
; B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; OUTPUT: NONE
; RETURNS: ALWAYS CPOPJ
;
RETMEM: MOVEI C,DICT ;GET PREV SET UP
RETM3: HRRZ D,0(C) ;GET PREV'S LINK
SKIPE D ;IF CURRENT IS 0 OR
CAIL D,0(B) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RETM4 ; THEN RETURN BLOCK HERE
MOVE C,D ;MAKE PREV=CURRENT
JRST RETM3 ;CONTINUE
RETM4: HRRM D,0(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,0(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,0(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,0(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,0(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,0(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,0(B) ;GET OUR SIZE
HLRZ D,0(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,0(B) ;STORE INTO RETURNED BLOCK
HRRZ D,0(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,0(C) ;GET PREV BLOCKS SIZE
ADDI A,0(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,0(B) ;DOES HE BUTT RIGHT UP AGAINST US?
RET ;NO, RETURN WITH NO COMBINATION
HRRM D,0(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,0(C) ;GET HIS SIZE
HLRZ B,0(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,0(C) ;STORE COMBINED SIZE
RET ;RETURN
;BCOUNT ROUTINE TAKES POINTER TO ASCII STRING IN A. IT ASSUMES THE
;STRING ENDS WITH NULL AND RETURNS THE NUMBER OF WORDS ENCOMPASSED
;BY THE STRING IN B. EVERYTHING (EXCEPT B DUMMY!) IS PRESERVED.
BCOUNT: PUSH P,A ;DON'T CLOBBER AC'S
PUSH P,C
PUSH P,D
MOVEI B,0 ;DESTINATION POINTER (NONE BECAUSE WE'RE ONLY COUNTING)
MOVSI C,377777 ;A LARGE POSITIVE NUMBER LONGER THAN STRING BEING COUNTED
MOVEI D,0 ;STOP READING WHEN NULL ENCOUNTERED
SIN ;COUNT LENGTH OF STRING
SUB C,[<377777,,0>+4] ;COMPUTE NUMBER OF BYTES READ
IDIVI C,5 ;CHANGE TO WORD COUNT
MOVN B,C ;RETURN IN B
POP P,D
POP P,C
POP P,A
RET
;GETPAG COPIES A ONE-WAY MESSAGE INTO THE NEXT AVAILABLE FREE PAGE AND
;UPDATES NXTPAG.
;REACHED VIA CALL RETPAG FROM ONEWAY
;RETURNS +1: THERE ARE NO FREE PAGES
; +2: SUCCESS
; P5/ADDRESS OF PAGE WHERE MESSAGE STORED
GETPAG:
SKIPGE P5,NXTPAG ;ANY AVAILABLE?
RET ;NO.
MOVE T2,(P5) ;GET NEXT LOCATION AFTER FIRST
MOVEM T2,NXTPAG ;SAVE AS NEW FIRST AVAILABLE
MOVSI T3,RMSG ;COPY MESSAGE FROM MESSAGE RECEIVE
HRR T3,P5 ; AREA TO FREE PAGE
BLT T3,1000(P5) ;TRANSFER ONE PAGE
RETSKP
;RETPAG RETURNS A PAGE TO THE TOP OF THE FREE PAGE LIST
;ACCEPTS:
;P5/ADDRESS OF PAGE TO RETURN TO FREE SPACE
;RETURNS +1: ALWAYS
RETPAG:
MOVE T2,NXTPAG ;NEXT FREE PAGE
MOVEM P5,NXTPAG ;MAKE THIS THE FIRST PAGE
MOVEM T2,(P5) ;MAKE THIS POINT TO PREVIOUS FIRST PAGE
RET
;ROUTINE TO EMPTY A TABLE. PASS ADDRESS OF TABLE IN A. THIS
;ROUTINE MERELY RETURNS ALL THE STRINGS POINTED TO BY THE TABLE TO
;FREE SPACE
TEMPTY: SAVEAC <A,B,C,D>
STKVAR <NEMS,TPTR>
HLRZ D,(A) ;GET NUMBER OF ENTRIES FOR CLEARING
MOVEM D,NEMS ;COUNTER FOR HOW MANY ENTRIES TO REMOVE
MOVEM A,TPTR ;SAVE POINTER TO TABLE ENTRY
TEM1: SOSGE NEMS ;DONE REMOVING EVERYTHING?
RET ;YES
AOS B,TPTR ;PRECEDE TO NEXT TABLE ENTRY
HLRZ A,(B) ;GET ADDRESS OF STRING
CALL STREM ;RETURN IT TO FREE SPACE
JRST TEM1 ;LOOP FOR REST OF STRINGS
SUBTTL QUEST
;'QUESTION' RECEIVED. FIND USER'S POSITION IN QUEUE AND SEND MESSAGE
;returns 0 if user not there, -1 IF CURRENT PID
;MESSAGE CONTAINS (NUMBER ENTRIES IN QUEUE,,USER'S POSITION)
;ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;Q2/ PID OF SENDER
;REACHED VIA JRST FROM IPCINT
;JRSTS TO ENDINT ALWAYS
QUEST:
SETZM P5 ;CLEAR USER'S POSITION IN QUEUE
CAMN Q2,CURPID ;CURRENT PID?
JRST [ SETOM P5 ;YES. RETURN -1
JRST QUEST1]
SKIPN QUECNT ;ANYONE IN QUEUE?
JRST QUEST1 ;NO. CAN'T B