Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-1-exec/execnc.mac
There are 2 other files named execnc.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.71,  3-May-89 01:19:19, Edit by MKL
; add .NDIR startup
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.69,  4-Sep-87 14:32:23, Edit by MKL
; at NICINT, up logout idle time to 30 minutes
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.68,  3-Sep-87 15:39:16, Edit by MKL
; undo IPCINI stuff
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.58, 10-Feb-87 00:38:43, Edit by MKL
; add memory to calculate command
;SRC:<6-1-EXEC>EXECNC.MAC.56,  6-Feb-87 12:03:51, Edit by KNIGHT
; Add DIALOG command
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.54, 22-Dec-86 16:21:46, Edit by MKL
; add BIBLIO command
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.50, 14-Nov-86 11:30:01, Edit by IAN
; [NIC275] Add PERFORMANCE command to run SYS:PERFORMANCE.EXE
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.48,  2-Oct-86 15:57:35, Edit by MKL
; Enable REGISTER command
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.32,  7-Apr-86 23:06:12, Edit by MKL
; Fix up USRMSG routine to handle new IPCF sends stuff
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.29,  4-Mar-86 11:43:15, Edit by HSS
; Flushed safety command
;SRC:<6-1-EXEC>EXECNC.MAC.28,  5-Dec-85 13:26:09, Edit by KNIGHT
; Add KERSRV command
;[SRI-NIC]SRC:<6-1-EXEC>EXECNC.MAC.20,  2-Dec-85 16:41:53, Edit by MKL
;EM34 add IPCF stuff
;SRC:<6-1-EXEC>EXECNC.MAC.19,  6-Nov-85 11:15:30, Edit by KNIGHT
; One last fix to .DOHSN - make true index into linked list
;SRC:<6-1-EXEC>EXECNC.MAC.18,  5-Nov-85 15:46:15, Edit by KNIGHT
; Fix .DOHSN
;SRC:<6-1-EXEC>EXECNC.MAC.17,  5-Nov-85 14:31:35, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECNC.MAC.16,  5-Nov-85 14:12:30, Edit by KNIGHT
;SRC:<6-1-EXEC>EXECNC.MAC.15,  5-Nov-85 13:14:44, Edit by KNIGHT
; Rewrite history stuff here for compatibility with command editor.
;SRC:<6-1-EXEC>EXECNC.MAC.14,  1-Nov-85 10:29:55, Edit by KNIGHT
; Enclose ^L clear screen junk in IFE NICSW
;[SRI-NIC]SRC:<6-EXEC>EXECNC.MAC.13, 23-Sep-85 15:54:24, Edit by MKL
; [NIC1066] only allow NLI programs to be run from nvt's [NC]
;[SRI-NIC]SRC:<6-EXEC>EXECNC.MAC.8, 25-Jul-85 21:18:18, Edit by HSS
; [NIC1062] Change user name for TACNEWS and NICGUEST
;[SRI-NIC]SRC:<6-EXEC>EXECNC.MAC.5,  3-Jul-85 22:47:48, Edit by HSS
; [NIC1053] Add SAFETY command
;[SRI-NIC]SRC:<6-EXEC>EXECNC.MAC.4,  9-May-85 23:48:18, Edit by HSS
; [NIC1034] Add NYU calculate command
;[SRI-NIC]PS:<HSS.EXEC>EXECNC.MAC.3, 17-Apr-85 12:22:01, Edit by HSS
; [NIC1017] Add NYU history mechanism code
;[SRI-NIC]PS:<HSS.EXEC>EXECNC.MAC.2,  4-Apr-85 15:39:02, Edit by HSS
; [NIC1001] Added ^e initialize code

	SEARCH	EXECDE
	TTITLE	EXECNC
.HOST::	LINEX <Host name or number>	;GET INPUT LINE
	 CMERRX				;NO GOOD
	CONFIRM				;GET EOL
	SETZM RSPTR			;FORCE CRSCAN TO USE THIS
	HRROI B,[GETSAVE (SYS:HOST.)]	;RUN THIS PROGRAM
	JRST PERUN			;RUN IT
;[NIC1001] ^EINITIALIZE {GATEWAYS,HOSTS}

.INITI::KEYWD	$INITI			;[NIC1001] TABLE TO READ FROM
	0				;[NIC1001] NO DEFAULT
	 JRST CERR			;[NIC1001] ERROR
	CONFIRM				;[NIC1001] GET CRLF
	MOVE A,P3			;[NIC1001] GET CODE TO DO
	IPOPR%				;[NIC1001] DO IT!
	 ERCAL CJERRE			;[NIC1001] LET HIM KNOW ABOUT PROBLEM
	RET				;[NIC1001] RETURN

$INITI:	TABLE
	T Gateways,,.IPGWY		;[NIC1001] INITIALIZE GATEWAYS
	T Hosts,,.IPINI			;[NIC1001] INITIALIZE HOSTS
	TEND
.TACNE::HRROI A,[ASCIZ /ANONYMOUS.TACNEWS/] ;SETUP USERNAME
	HRROI B,[ASCIZ /QUERY/]		;SETUP ACCOUNT
	HRROI C,[ASCIZ /THUMBTACKS/] 	;AND PASSWORD
	HRROI D,[ASCIZ /SYS:TACNEWS.EXE/] ;PROGRAM TO RUN
	JRST NIC0			;JOIN COMMON CODE

.QUERY::				;SYNONYM FOR NIC
.NIC::	HRROI A,[ASCIZ /ANONYMOUS.NICGUEST/] ;POINT TO USERNAME
	HRROI B,[ASCIZ /QUERY/]	;GET ACCOUNT STRING
	HRROI C,[ASCIZ /RACHMANINOFF/] ;GET PASSWORD
	HRROI D,[ASCIZ /SYS:NIC.EXE/] ;PROGRAM TO RUN
NIC0:	TRVAR <ALOGF,LOGNO,FORK,PJFN,USER,ACCT,PASS,PROG> ;LOGGED IN FLAG, FORK, TEMP. JFN, USERNAME ACCNT AND PASSWORD PTR,PROGRAM PTR
	MOVEM A,USER		;SAVE USERNAME
	MOVEM B,ACCT		;AND ACCOUNT
	MOVEM C,PASS		;AND PASSWORD
	MOVEM D,PROG		;AND PROGRAM
	SETZM ALOGF		;DEFAULT TO LOGGED IN
	SKIPE CUSRNO		;CHECK EXEC'S OPINION
	 JRST NIC00		;YES, SKIP AROUND LOG IN STUFF
;check -- must be on network tty then
	GJINF%			;RETURNS TTY# IN T4
	MOVX A,TCP%NT
	SETZ B,
	STAT%			;GET NVT RANGES
	 ERJMP NIC9
	HLRE A,B
	TLZ B,-1		;FIRST NVT IN B
	MOVN A,A
	SUBI A,1
	ADD A,B			;LAST NVT IN A
	CAML D,B
	 CAMLE D,A
	  JRST [SETO A,
		HRROI B,[ASCIZ \That is only allowed from network terminals.\]
		JRST NIC9]
	CALL PIOFF		;NO INTERRUPTS FOR A WHILE
	MOVX A,RC%EMO		;EXACT MATCH, ONLY
	MOVE B,USER		;CHECK USERNAME
	SETZ C,			;NO STEPPING
	RCUSR%			;GET USER NUMBER FROM NAME
	TXNE A,RC%NOM!RC%AMB	;WAS THERE A MATCH
	 JRST [SETO A,		;NO ERROR NEEDED
	       HRROI B,[ASCIZ \That account doesn't exist; contact NIC@NIC\]
	       JRST NIC9]	;QUIT ON ERRORS
	MOVEM C,LOGNO		;SAVE IT
	MOVE A,C		;MOVE DIR NUMBER
	MOVE B,PASS		;PASSWORD
	MOVE C,ACCT		;ACCOUNT
	SETZ D,			;PARANOIA
	LOGIN%
	 JRST [HRROI B,[ASCIZ \LOGIN Failure -- \] ;ERROR CODE IN A
	       JRST NIC9]	;FAILURE FOR SOME REASON
	MOVE B,LOGNO		;GET USER NUMBER
	MOVEM B,CUSRNO		;STORE IT FOR EXEC
	MOVX A,.TICBK		;GET BREAK INTERRUPT
	DTI%			;DISABLE IT
	MOVX A,.TICCC		;GET ^C INTERRUPT
	DTI%			;DISABLE IT
	MOVX A,.TICCT		;GET ^T INTERRUPT
	DTI%
	MOVX A,.FHSLF		;GET MY PROCESS ID
	MOVX B,1B3+1B1		;DISABLE INTERRUPT CHANNELS, ^T, ^C
	DIC%
	SETOM ALOGF		;LOGGED IN AS NICGUEST
	CALL PION		;ENABLE ALL INTERRUPTS
	MOVE A,[.FHSLF,,.TIMBF]	;REMOVE PENDING TIMER INTERRUPTS
	MOVE B,[377777,,-1]	;WAY OUT TIME
	SETZ C,
	TIMER%			;CANCEL THEM
	 JFCL			;NO BIG DEAL IF THERE WEREN'T ANY
	MOVE A,[.FHSLF,,.TIMEL]	;NOW SET UP INTERVAL FOR IDLE CHECKING
	MOVX B,5*^D60000	;EVERY 5 MINUTES
	MOVX C,NICCHN		;ON THIS CHANNEL
	TIMER%
	 JRST [HRROI B,[ASCIZ /Couldn't set TIMER -- /]	;ERROR IN B
	       JRST NIC9]

;refuse sends!
	MOVEI A,.CTTRM
	MOVEI B,.MOSTF
	MOVX C,MO%NUM
	MTOPR%
	 ERJMP .+1

;HERE TO RUN THE NIC-QUERY PROGRAM
NIC00:	MOVE B,PROG		;PROGRAM TO RUN
	CALL TRYGTJ		;ATTEMPT A JFN
	 JRST [SETZ A,		;GET LAST ERROR
	       HRROI B,[ASCIZ \Couldn't get program -- \]
	       JRST NIC9]
	MOVEM A,PJFN		;SAVE JFN HERE
	MOVEI Q1,ETTYMD		;SET TTY MODES
	CALL LTTYMD
	MOVX A,CR%CAP		;GIVE HIM SOME ABILITIES
	CFORK%			;MAKE A FORK
	 JRST [HRROI B,[ASCIZ \Couldn't create a fork -- \]
	       JRST NIC9]
	MOVEM A,FORK		;SAVE IT
	HRLZ A,FORK		;GET HANDLE IN LH
	HRR A,PJFN		;GET THE JFN IN RH
	GET%
	 ERJMP [SETZ A,		;GET ALST ERROR
		HRROI B,[ASCIZ\GET% failure -- \]
		JRST NIC9]
	MOVX A,.PRIIN		;CLEAR INPUT BUFFERS
	CFIBF%
	MOVE A,FORK		;GET HANDLE BACK
	SETZ B,			;NOTHING SPECIAL
	SFRKV%			;START IT UP
	 ERJMP [SETZ A,		;GET LAST ERROR
		HRROI B,[ASCIZ \Couldn't start fork -- \]
		JRST NIC9]
	WFORK%
	KFORK%
	JRST NIC10		;GO FINISH UP

NIC9:	ETYPE <%_ %2M>		;OUTPUT CRLF AND MESSAGE
	JUMPL A,NIC10		;NO ERROR FOLLOWS
	SKIPE A			;WAS ERROR PASSED?
	 ETYPE <%1?>		;YES, USE IT
	SKIPN A			;OTHERWISE USE LAST ERROR ENCOUNTERED
	 ETYPE <%?>
	ETYPE <%_>		;FINAL CRLF

NIC10:	SKIPN ALOGF		;NICGUEST LOGIN?
	 RET			;NO, SO JUST RETURN
	CIS%			;CLEAR THINGS UP FIRST
	CALL .KK0		;SHOULD JUST LOGOUT AND NEVER RETURN
	DTACH%			;JUST IN CASE
	HALTF%			;ALWAYS WORKS!

;HERE ON INTERRUPT EVERY 5 MINUTES
;WE WILL CHECK TO SEE IF NICGUEST WAS IDLE FOR 15 MINUTES
;AT WHICH TIME WE WILL LOG OUT.
NICINT::PUSH P,[[DEBRK%]]	;CONJURE UP A RETURN
	ATSAVE			;SAVE A-D
	GJINF%			;GET NECESSARY INFO
	JUMPL D,NIC10		;JUST QUIT IF DETACHED
	MOVX A,ID%TTY		;BIT THAT RETURNS # MSEC SINCE LAST TYPE IN
	HRR A,C			;GET JOB NO. IN A
	IDLE%			;MEASURE IDLE TIME
	CAMLE A,[^D30*^D60000]	;EXCEEDED 30 MINUTES?
	 JRST [ETYPE <%_ Autologout%_>
	       JRST NIC10]	;YES, ZAP HIM
	MOVE A,[.FHSLF,,.TIMEL]	;NOW SET UP INTERVAL FOR IDLE CHECKING
	MOVX B,5*^D60000	;EVERY 5 MINUTES
	MOVX C,NICCHN		;ON THIS CHANNEL
	TIMER%
	 JRST [HRROI B,[ASCIZ /Couldn't set TIMER -- /]	;ERROR IN A
	       JRST NIC9]
	RET			;RETURN
;Start [NIC275]
.PERFO::HRROI A,[ASCIZ /ANONYMOUS.PERFORMANCE/] ;POINT TO USERNAME
	HRROI B,[ASCIZ /PERFORMANCE/]		;GET ACCOUNT STRING
	HRROI C,[ASCIZ /ANDJUSTLYSO/]		;GET PASSWORD
	HRROI D,[ASCIZ /SYS:PERFORMANCE.EXE/]	;PROGRAM TO RUN
	JRST NIC0
;End [NIC275]

.REGIS::CONFIRM				;GET CRLF
;	ETYPE <Register is not available yet.  Please send mail to REGISTRAR@SRI-NIC.ARPA%_with any additions or changes to the NIC network user database.%_>
;	RET				;
	HRROI A,[ASCIZ /ANONYMOUS.REGISTER/] ;POINT TO USERNAME
	HRROI B,[ASCIZ /REGISTER/]	;GET ACCOUNT STRING
	HRROI C,[ASCIZ /TENYEARSGONE/] ;GET PASSWORD
	HRROI D,[ASCIZ /SYS:REGISTER.EXE/] ;PROGRAM TO RUN
	JRST NIC0

.BIBLI::CONFIRM
;	ETYPE <The Biblio service is not available yet.%_>
;	RET

	HRROI A,[ASCIZ /ANONYMOUS.BIBLIO/] ;POINT TO USERNAME
	HRROI B,[ASCIZ /BIBLIO/]	;GET ACCOUNT STRING
	HRROI C,[ASCIZ /WAZABBABA/] ;GET PASSWORD
	HRROI D,[ASCIZ /SYS:BIBLIO.EXE/] ;PROGRAM TO RUN
	JRST NIC0
.KERSR::HRROI A,[ASCIZ /ANONYMOUS.KERMIT/] ;POINT TO USERNAME
	HRROI B,[ASCIZ /QUERY/]	;GET ACCOUNT STRING
	HRROI C,[ASCIZ /NOBORDERSHERE/] ;GET PASSWORD
	HRROI D,[ASCIZ /SYS:KERSRV.EXE/] ;PROGRAM TO RUN
	JRST NIC0
.DIALO::TRVAR <ALOGF,LOGNO,FORK,PJFN> ;LOGGED IN FLAG, FORK, TEMP. JFN
	MOVEM D,PROG		;AND PROGRAM
	SETZM ALOGF		;DEFAULT TO LOGGED IN
	SKIPE CUSRNO		;CHECK EXEC'S OPINION
	IFSKP.
	  CALL PIOFF		;NO INTERRUPTS FOR A WHILE
	  MOVX A,RC%EMO		;EXACT MATCH, ONLY
	  HRROI B,[ASCIZ/ANONYMOUS.DIALOG/]
	  SETZ C,		;NO STEPPING
	  RCUSR%		;GET USER NUMBER FROM NAME
	  IFXN. A,RC%NOM!RC%AMB	;WAS THERE A MATCH
	    SETO A,		;NO ERROR NEEDED
	    HRROI B,[ASCIZ \That account doesn't exist; contact NIC@NIC\]
	    JRST DIA9
	  ENDIF.
	  MOVEM C,LOGNO		;SAVE IT
	  MOVE A,C		;MOVE DIR NUMBER
	  HRROI B,[ASCIZ/SPECKLESSSKY/]
	  HRROI C,[ASCIZ/QUERY/]
	  SETZ D,		;PARANOIA
	  LOGIN%
	  IFJER.
	    HRROI B,[ASCIZ \LOGIN Failure -- \] ;ERROR CODE IN A
	    JRST DIA9
	  ENDIF.
  	  MOVE B,LOGNO		;GET USER NUMBER
	  MOVEM B,CUSRNO	;STORE IT FOR EXEC
	  MOVX A,.TICBK		;GET BREAK INTERRUPT
	  DTI%			;DISABLE IT
	  MOVX A,.TICCC		;GET ^C INTERRUPT
	  DTI%			;DISABLE IT
	  MOVX A,.TICCT		;GET ^T INTERRUPT
	  DTI%
	  MOVX A,.FHSLF		;GET MY PROCESS ID
	  MOVX B,1B3+1B1	;DISABLE INTERRUPT CHANNELS, ^T, ^C
	  DIC%
	  SETOM ALOGF		;LOGGED IN AS NICGUEST
	  CALL PION		;ENABLE ALL INTERRUPTS
	  MOVE A,[.FHSLF,,.TIMBF]	;REMOVE PENDING TIMER INTERRUPTS
	  MOVE B,[377777,,-1]	;WAY OUT TIME
	  SETZ C,
	  TIMER%		;CANCEL THEM
	   TRN			;NO BIG DEAL IF THERE WEREN'T ANY
	  MOVE A,[.FHSLF,,.TIMEL]	;NOW SET UP INTERVAL FOR IDLE CHECKING
	  MOVX B,5*^D60000	;EVERY 5 MINUTES
	  MOVX C,NICCHN		;ON THIS CHANNEL
	  TIMER%
	  IFJER.
	    HRROI B,[ASCIZ /Couldn't set TIMER -- /]	;ERROR IN B
	    JRST DIA9
	  ENDIF.
	ENDIF.
	HRROI B,[ASCIZ/SYS:DIALOG.EXE/]
	CALL TRYGTJ		;ATTEMPT A JFN
	IFNSK.
	  SETZ A,		;GET LAST ERROR
	  HRROI B,[ASCIZ \Couldn't get program -- \]
	  JRST DIA9
	ENDIF.
	MOVEM A,PJFN		;SAVE JFN HERE
	MOVEI Q1,ETTYMD		;SET TTY MODES
	CALL LTTYMD
	MOVX A,CR%CAP		;GIVE HIM SOME ABILITIES
	CFORK%			;MAKE A FORK
	IFJER.
	  HRROI B,[ASCIZ \Couldn't create a fork -- \]
	  JRST DIA9
	ENDIF.
	MOVEM A,FORK		;SAVE IT
	HRLZ A,FORK		;GET HANDLE IN LH
	HRR A,PJFN		;GET THE JFN IN RH
	GET%
	IFJER.
	  SETZ A,
	  HRROI B,[ASCIZ\GET% failure -- \]
	  JRST DIA9
	ENDIF.
	MOVX A,.PRIIN		;CLEAR INPUT BUFFERS
	CFIBF%
	MOVE A,FORK		;GET HANDLE BACK
	SETZ B,			;NOTHING SPECIAL
	SFRKV%			;START IT UP
	IFJER.
	  SETZ A,	
	  HRROI B,[ASCIZ \Couldn't start fork -- \]
	  JRST DIA9
	ENDIF.
	WFORK%
	KFORK%
	JRST DIA10

DIA9:	ETYPE <%_ %2M>		;OUTPUT CRLF AND MESSAGE
	IFGE. A
	  SKIPE A		;WAS ERROR PASSED?
	   ETYPE <%1?>		;YES, USE IT
	  SKIPN A			;OTHERWISE USE LAST ERROR ENCOUNTERED
	   ETYPE <%?>
	  ETYPE <%_>		;FINAL CRLF
	ENDIF.
DIA10:	SKIPN ALOGF		;NICGUEST LOGIN?
	 RET			;NO, SO JUST RETURN
	CIS%			;CLEAR THINGS UP FIRST
	CALL .KK0		;SHOULD JUST LOGOUT AND NEVER RETURN
	DTACH%			;JUST IN CASE
	HALTF%			;ALWAYS WORKS!
	JRST .DIALO
.NDIR::
	HRROI B,[GETSAVE <SYS:NDIR.>] ;get program
	CALL TRYGTJ	
	 ERROR <Utility not installed at this site>
	NOISE <OF FILES>	
	MOVE B,CMPTR		;751 set up the command line for rscan
	MOVE C,CMINC		;751
	ADJBP C,B		;751
	SETZ B,			;751
	SKIPGE CMFLG		;751
	 IDPB B,C		;751
	CALLRET STEPH		;751
.WHOIS::MOVX A,CM%XIF			;ALLOW @ FOR HOST NAME
	IORM A,CMFLG			;INSTEAD OF FILE REDIRECTION
	LINEX <Ident for WHOIS>		;TELL HIM WHAT WE WANT
	 CMERRX				;BOMB ON ERROR
	CONFIRM				;GET CRLF
	SETZM RSPTR			;FORCE CRSCAN TO USE COMMAND
	HRROI B,[GETSAVE (SYS:WHOIS.)]	;PROGRAM TO RUN
	JRST PERUN			;GO TO IT
;[NIC1017] HERE TO PARSE AND PERFORM THE HISTORY COMMANDS
.DOHST::PUSH P,[CMDIN4]		;[NIC1017] FAKE RETURN ADDRESS
	SKIPN HISTSW
	 ERROR <No history>	;[NIC1017]
	MOVE A,P		;[NIC1017] SAVE STACK PTR
	TRVAR <COMADR,SAVEP>
	MOVEM A,SAVEP		;[NIC1017] SO WE KNOW WHERE RETURN ADDR IS
	MOVEI B,[FLDDB. .CMTOK,,<-1,,[ASCIZ "/"]>,,,[
		  FLDDB. .CMNUM,CM%SDH,5+5,<Decimal command number>,,[
		   FLDDB. .CMQST,CM%SDH,,<Quoted imbedded string>,,[
		    FLDBK. .CMFLD,,,<Command string>,,FLDMSK,]]]]
	CALL FLDSKP		;[NIC1017] TRY TO PARSE THAT
	 CMERRX			;[NIC1017] ERROR OR SOMETHING
	LDB D,[331100,,(C)]	;[NIC1017] GET FUNCTION CODE
	CAIN D,.CMNUM		;[NIC1017] GO HANDLE COMMAND NUMBER
	 JRST .DOHSN		;[NIC1017] IF NUMBER ENTERED
	CAIN D,.CMTOK		;[NIC1017] WAS / ENTERED AGAIN
	 JRST .DOHSS		;[NIC1017] USE LAST COMMAND
	CAIN D,.CMFLD		;[NIC1017] WAS IT A FIELD
	 JRST .DOHSF		;[NIC1017] GO EAT IT UP THEN
	JRST .DOHSQ		;[NIC1017] GO HANDLE QUOTED STRING

;HERE TO HANDLE ANOTHER /
.DOHSS:	SKIPA A,CMDNUM		;[NIC1017] GET CURRENT COMMAND NUMBER
;HERE TO HANDLE COMMAND NUMBER
.DOHSN:	 MOVE A,B		;[NIC1017] SAVE COMMAND NUMBER
	IFL. A
	  AOJ A,		;[NIC1017] IF NEGATIVE, RELATIVE NUMBER
	  ADD A,CMDNUM		;[NIC1017] MAKE IT ABSOLUTE
	ENDIF.
	MOVE B,CMDNUM		;[NIC1017] GET CURRENT COMMAND NUMBER
	SUB B,HISTSW		;[NIC1017] GET SMALLEST COMMAND WE HAVE
	SKIPGE B		;[NIC1017] IF NEGATIVE, MAKE ONE
	 SETZ B,		;[NIC1017] STILL HAVE THIS ONE THEN
	AOJ B,			;[NIC1017] BASE 1
	CAMG A,CMDNUM		;[NIC1017] SMALLER THAN LARGEST WE HAVE
	 CAMGE A,B		;[NIC1017] AND LARGER THAN SMALLEST WE HAVE
	   ERROR <Command not found> ;[NIC1017] TELL HIM WHY
	SUB A,B			;GET INDEX TO LIST ENTRY WE DESIRE
	HLRZ B,HSTLST		;[NIC1017] GET BASE ADDRESS
	IFN. A			;IF THERE'S MORE THAN ONE COMMAND TO SKIP...
	  DO.			;TRAVERSE THE LINKED LIST TO FIND RIGHT COMMAND
	    HLRZ B,(B)		;GET POINTER TO NEXT ITEM IN LIST
	    SKIPE B		; (IF THERE'S ONE)
	     SOJG A,TOP.	;AND COUNT NOT EXHAUSTED, CONTINUE TRAVERSE
	  ENDDO.
	ENDIF.
	ADDI B,2		;POINT TO ASCIZ STRING FOR COMMAND
	JRST .DOHS2		;[NIC1017] GO PARSE FOR ARGS.

;HERE TO HANDLE STRING FIELD
.DOHSF:	CALL DOHFCM		;[NIC1017] LOOK UP COMMAND
	 ERROR <Command not found in list> ;[NIC1017] COULDN'T FIND IT
	JRST .DOHS2	 

;HERE TO HANDLE A QUOTED STRING
.DOHSQ:	CALL DOHFIS		;[NIC1017] LOOK UP IMBEDDED STRING IN COMMANDS
	 ERROR <Command not found in list> ;[NIC1017] COULDN'T FIND IT

;HERE TO FINISH UP PARSE
.DOHS2:	CONFIRM			;[NIC1017] GET CRLF
	HRROI A,CBUF		;[NIC1017] COPY IT TO COMMAND BUFFER
	HRLI B,440700		; MAKE B A BYTE POINTER
	SETZ C,			;[NIC1017] TILL NULL FOUND
	SOUT%
	MOVEI B,.CHLFD		;[NIC1017] ADD LINE FEED
	IDPB B,A		;[NIC1017]
	SETZ B,			;[NIC1017] NOW ADD NULL
	IDPB B,A		;[NIC1017] TIE IT OFF
	HRROI A,CBUF		;[NIC1017] GET COMMAND PTR
	ETYPE < %1M>		;[NIC1017] OUTPUT IT ALWAYS
	MOVEM A,CMPTR		;[NIC1017] SAVE FOR INPUT LATER
	CALL BCOUNT		;[NIC1017] COUNT CHARACTERS
	ADDM B,CMINC		;[NIC1017] KEEP COUNT IN HERE
	MOVE A,SAVEP		;[NIC1017] GET PTR TO RETURN LOC ON STACK
	MOVEI B,CIN0		;[NIC1017] WHERE TO RETURN TO
	MOVEM B,(A)		;[NIC1017] STUFF IT SO WE RETURN THERE
	RET			;[NIC1017] GO DO IT

;DOHFCM -- DO HISTORY FIND COMMAND
DOHFCM:	HRRZ D,HSTLST		;[NIC1017] POINTER TO NEWEST ENTRY IN LIST
	DO.			;TRAVERSE LIST LOOKING FOR STRING MATCH
	  IFN. D		;NOTHING THERE?
	    HRROI A,ATMBUF	;NO, THEN GET PTR TO INPUT STRING
	    HRROI B,2(D)	;POINT TO COMMAND STRING IN LINKED LIST
	    STCMP%		;[NIC1017] COMPARE
	    SKIPE A		;[NIC1017] TOTAL MATCH?
	     TXNE A,SC%SUB	;[NIC1017] SUBSET MATCH?
	      RETSKP		;[NIC1017] 
	    HRRZ D,(D)		;POINT TO NEXT OLDEST ENTRY.
	    LOOP.		;CONTINUE SEARCH
	  ENDIF.
	ENDDO.
	MOVEI B,2(D)		;POINT TO THE COMMAND STRING.
	RET			;LIST EXHAUSTED OR NOTHING THERE, FAIL

;DOHFIS -- DO HISTORY FIND IMBEDDED STRING
DOHFIS:	HRRZ D,HSTLST		;[NIC1017] POINTER TO NEWEST ENTRY IN LIST
	DO.			;TRAVERSE LIST LOOKING FOR STRING MATCH
	  IFN. D		;NOTHING THERE?
	    MOVEI A,2(D)	;[NIC1017] GET PTR TO COMMAND STRING
	    HRLI A,440700
	    MOVE B,[POINT 7,ATMBUF]	;[NIC1017] GET PTR TO INPUT PATTERN
	    CALL DOHFND		;[NIC1017] DO PATTERN MATCH
	    IFSKP.
	      MOVEI B,2(D)	;FOUND IT, ADDRESS OF COMMAND STRING IN B
	      RETSKP
	    ENDIF.
	    HRRZ D,(D)		;POINT TO NEXT OLDEST ENTRY.
	    LOOP.		;CONTINUE SEARCH
	  ENDIF.
	ENDDO.
	RET			;LIST EXHAUSTED OR NOTHING THERE, FAIL

;DOHFND -- DO HISTORY FIND
;A/ PTR STRING TO SEARCH IN
;B/ PTR PATTERN TO FIND IN STRING
;RETURNS +1 NOT FOUND
;	 +2 A/ PTR TO START OF PATTERN IN STRING
DOHFND:	SAVEAC <C,D,Q1,Q2>	; SAVE ACS THAT ARE USED HERE
	DO.
	  MOVE C,A		;[NIC1017] SAVE PTR INTO STRING
	  MOVE D,B		;[NIC1017] GET NEW PTR TO PATTERN
	  DO.
	    ILDB Q1,A		;[NIC1017] GET A CHARACTER FORM STRING
	    ILDB Q2,D		;[NIC1017] GET A CHARACTER FROM PATTERN
	    IFE. Q2
	      MOVE A,C		;[NIC1017] RESTORE SAVED STRING POSITION
	      RETSKP		;MATCH FOUND
	    ENDIF.
	    JUMPE Q1,R		;[NIC1017] END OF STRING?
	    CAMN Q1,Q2		;[NIC1017] CHARACTERS MATCH?
	     LOOP.		;YES, CONTINUE SUBSTRING SEARCH
	  ENDDO.
	  LOOP.			;CONTINUE SEARCH FOR SUBSTRING IF NO MATCH
	ENDDO.
	RET

FLDMSK:	BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,</-!;.@\_$,*>
;[NIC1034] THE CALCULATE COMMAND
.CALCU::TRVAR <BASEI,BASEO,EXPPTR,PSTPTR,PARENS,NUMSEN,STKPTR,OVRFLW> ;[NIC1034]
	SETZM BASEI		;[NIC1034] INITIALIZE INPUT BASE
	SETZM BASEO		;[NIC1034] AND OUTPUT BASE
	SETZM OVRFLW		;[NIC1034] INIT. OVER FLOW INDICATOR
	MOVEI B,[FLDDB. .CMSWI,,$BASEB,,,[
		  FLDDB. .CMTXT,,,<Input expression as a>]] ;[NIC1034]
	CALL FLDSKP		;[NIC1034] GO PARSE IT
	 CMERRX
	LDB D,[331100,,(C)]	;[NIC1034] SEE WHAT WE GOT
	CAIN D,.CMTXT		;[NIC1034] WAS IT THE EXPRESSION?
	 JRST .CALC0		;[NIC1034] YES, THEN CONFIRM
	CALL GETKEY		;[NIC1034] GET THE ADDRESS
	JRST 0(P3)		;[NIC1034] THEN DISPATCH TO CORRECT PLACE

;HERE ON INPUT BASE
IBASE:	DECX <Input base as a decimal number> ;[NIC1034] GET THE BASE
	 CMERRX			;[NIC1034] ERROR HERE
	CAIL B,2		;[NIC1034] IS BASE LESS THEN MIN?
	 CAILE B,^D10		;[NIC1034] AND NOT GREATER THEN MAX
	  ERROR <Input base must be between 2 and 10>
	MOVEM B,BASEI		;[NIC1034] SAVE IT
	SKIPE BASEO		;[NIC1034] HAVE WE GOTTEN OUTPUT BASE YET?
	 JRST IBASE1		;[NIC1034] YES, SO JUST GET EXPRESSION
	MOVEI B,[FLDDB. .CMSWI,,IBASEI,,,[
		  FLDDB. .CMTXT,,,<Input expression as a>]] ;[NIC1034]
	CALL FLDSKP		;[NIC1034] GO PARSE IT
	 CMERRX
	LDB D,[331100,,(C)]	;[NIC1034] SEE WHAT WE GOT
	CAIN D,.CMTXT		;[NIC1034] WAS IT THE EXPRESSION?
	 JRST .CALC0		;[NIC1034] YES, THEN CONFIRM
	CALL GETKEY		;[NIC1034] GET ADDRESS
	JRST 0(P3)		;[NIC1034] THEN DISPATCH TO CORRECT PLACE
IBASE1:	LINEX <Input expression> ;[NIC1034] GET EXPRESSION FROM USER
	 CMERRX			;[NIC1034] ERROR
	JRST .CALC0		;[NIC1034] FINISH UP

;HERE ON OUTPUT BASE
OBASE:	DECX <Output base as a decimal number> ;[NIC1034] GET THE BASE
	 CMERRX			;[NIC1034] ERROR HERE
	CAIL B,2		;[NIC1034] IS OUTPUT BASE LESS THEN MIN?
	 CAILE B,^D36		;[NIC1034] AND LESS THEN MAX?
	  ERROR <Output base must be between 2 and 36>
	MOVEM B,BASEO		;[NIC1034] SAVE IT
	SKIPE BASEI		;[NIC1034] HAVE WE GOTTEN INPUT BASE YET?
	 JRST OBASE1		;[NIC1034] YES, SO JUST GET EXPRESSION
	MOVEI B,[FLDDB. .CMSWI,,OBASEO,,,[
		  FLDDB. .CMTXT,,,<Input expression as a>]] ;[NIC1034]
	CALL FLDSKP		;[NIC1034] GO PARSE IT
	 CMERRX
	LDB D,[331100,,(C)]	;[NIC1034] SEE WHAT WE GOT
	CAIN D,.CMTXT		;[NIC1034] WAS IT THE EXPRESSION?
	 JRST .CALC0		;[NIC1034] YES, THEN CONFIRM
	CALL GETKEY		;[NIC1034] GET ADDRESS
	JRST 0(P3)		;[NIC1034] THEN DISPATCH TO CORRECT PLACE
OBASE1:	LINEX <Input expression> ;[NIC1034] GET EXPRESSION FROM USER
	 CMERRX			;[NIC1034] ERROR
	JRST .CALC0		;[NIC1034] FINISH UP

.CALC0:	CALL BUFFF		;[NIC1034] COPY EXPRESSION
	MOVEM A,EXPPTR		;[NIC1034] SAVE PTR TO IT
	CONFIRM			;[NIC1034] GET CRLF
	MOVEI A,.FHSLF		;[NIC1034] SET SPECIAL INTERRUPTS
	MOVX B,1B<.ICAOV>!1B<.ICFOV> ;[NIC1034] THESE CHANNELS
	AIC%			;[NIC1034] TURN THEM ON
	MOVE A,EXPPTR		;[NIC1034] GET PTR TO EXPRESSIONS BACK
	CALL BCOUNT		;[NIC1034] COUNT CHARACTERS AND WORDS
	JUMPE B,[HRROI A,[ASCIZ/?Null expression illegal./]
		 JRST .CALER]	;[NIC1034] ERROR IF NOTHING INPUT
	ADDI B,1		;[NIC1034] MAKE A SLOT FOR TERMINATOR
	IMULI B,2		;[NIC1034] TWICE AS LARGE, JUST IN CASE
	PUSH P,B		;[NIC1034] SAVE CHARACTER COUNT
	MOVE A,B		;[NIC1034] GET READY FOR MORE SPACE
	CALL GETBUF		;[NIC1034] GET MORE TEMP. SPACE
	SUBI A,1		;[NIC1034] 1 FROM ADDRESS
	MOVN B,0(P)		;[NIC1034] GET -CHARACTER (WORD) COUNT
	HRL A,B			;[NIC1034] PUT COUNT IN LH
	MOVEM A,PSTPTR		;[NIC1034] POSTFIX OPERATOR ADDR
	MOVE A,0(P)		;[NIC1034] GET CHAR. COUNT BACK
	CALL GETBUF		;[NIC1034] NOW GET A STACK
	SUBI A,1		;[NIC1034] ADDRESS - 1
	POP P,B			;[NIC1034] GET COUNT BACK
	MOVN B,B		;[NIC1034] NEGATE LENGTH
	HRL A,B			;[NIC1034] SAVE -LEN IN LH
	MOVEM A,STKPTR		;[NIC1034] AND SAVE ITS ADDR
.CALRS:	SETZ A,			;[NIC1034] MAKE STACK BOTTOM
	MOVE P1,PSTPTR		;[NIC1034] INITIALIZE OPERATOR STACK
	PUSH P1,A		;[NIC1034] AND BOTTOM OF OPERATOR STACK 
	MOVE P2,STKPTR		;[NIC1034] INITIALIZE NUMBER STACK
	MOVEI A,^D10		;[NIC1034] GET DEFAULT BASE
	SKIPN BASEI		;[NIC1034] WAS INPUT BASE SET
	 MOVEM A,BASEI		;[NIC1034] NO, SET DEFAULT
	SKIPN BASEO		;[NIC1034] WAS OUTPUT BASE SET
	 MOVEM A,BASEO		;[NIC1034] NO, SET DEFAULT
	SETZM PARENS		;[NIC1034] ZERO PARENTHESIS COUNT
	MOVEI A,1		;[NIC1034] SAY NUMBER OR UNARY IS OK
	MOVEM A,NUMSEN		;[NIC1034] FOR PARSING
	MOVE Q1,EXPPTR		;[NIC1034] GET EXPRESSION PTR

;LOOP HERE READING EXPRESSION CONVERTING IT TO POSTFIX
.CALC1:	IBP Q1			;[NIC1034] SKIP A CHARACTER
.CALC2:	LDB A,Q1		;[NIC1034] GET A CHARACTER
	JUMPE A,.CALC3		;[NIC1034] FINISHED ON A NULL, POP STACK
	CAIN A,.CHSPC		;[NIC1034] IS IT A SPACE?
	 JRST .CALC1		;[NIC1034] THEN IGNORE IT
	caie a,"m"
	 cain a,"M"
	  jrst .calmm		;wants value from memory 
	CAIL A,"0"		;[NIC1034] IF LESS THEN 0
	 CAILE A,"9"		;[NIC1034] OR GREATER THEN 9
	  SKIPA			;[NIC1034] THEN IT'S NOT A NUMBER
	   JRST .CALGN		;[NIC1034] THEN GET A NUMBER
	CAIN A,"."		;[NIC1034] WAS IT A DECIMAL POINT?
	 JRST .CALGN		;[NIC1034] THEN GET A NUMBER
	CAIN A,")"		;[NIC1034] IS IT A CLOSE PARENTHESIS
	 JRST .CALCP		;[NIC1034] THEN DO CLOSE PAREN. HANDLING
	CAIN A,"("		;[NIC1034] IS IT AN OPEN PAREN?
	 JRST .CALPO		;[NIC1034] YES, DO OPEN PAREN. STUFF
	MOVE B,LEGOPS		;[NIC1034] GET PTR TO LEGAL OPERATORS
	ILDB C,B		;[NIC1034] GET FIRST LEGAL ONE
	JUMPE C,[HRROI A,[ASCIZ/?Illegal character in expression./] ;[NIC1034]
		 JRST .CALER]	;[NIC1034] CLEAN UP AND ERROR
	CAME C,A		;[NIC1034] IS IT THE ONE WE HAVE
	 JRST .-3		;[NIC1034] GET ANOTHER OPERATOR
	JRST .CALOP		;[NIC1034] IT'S LEGAL, WORK IT

;HERE TO OUTPUT NUMBER AND CLEAN UP
.CALC3:	SKIPE PARENS		;[NIC1034] IS PAREN. COUNT ZERO?
	 JRST .CALP3		;[NIC1034] UNBALANCED PARENS.
.CALC4:	SKIPN 0(P1)		;[NIC1034] IS OPERATOR STACK EMPTY
	 JRST .CALC5		;[NIC1034] THEN GO PRINT RESULT
	CALL .CALEV		;[NIC1034] GO EVALUATE OPERATOR
	 JRST .CALER		;[NIC1034] COMPUTATIONAL ERROR
	JRST .CALC4		;[NIC1034] LOOP UNTIL STACK MT
.CALC5:	MOVE A,CIJFN		;[NIC1034] OUTPUT TO HERE
	POP P2,B		;[NIC1034] NUMBER TO OUTPUT
	movem b,nummem		;save num
	move c,baseo
	movem c,nummba		;save base
	SKIPG C,BASEO		;[NIC1034] GET THE OUTPUT BASE
	 JRST .CALC6		;[NIC1034] OUTPUT HAS TO BE FLOAT
	NOUT%
	 JRST .CALE0		;[NIC1034] SOME SORT OF ERROR
	JRST .CALC7		;[NIC1034] JOIN COMMON TO FINISH
.CALC6:	MOVSI C,(FL%ONE!FL%PNT)	;[NIC1034] FOLLOW THESE OPTIONS
	FLOUT%
	 JRST .CALE0
.CALC7:	ETYPE <%_>		;[NIC1034] CRLF
	JRST .CALCL		;[NIC1034] AND GO CLOSE UP

;here if memory requested
.calmm:	skipn numsen
	 jrst .calo0
	move b,nummem		;get memory
	skipg basei		;seen float yet?
	 jrst .camm1		;yes
	skipg nummba		;was mem a float?
	 jrst .camm2
.camm3:	push p2,b		;dump on stack
	setzm numsen
	jrst .calc1
.camm1:	skiple nummba		;was mem float too?
	 fltr b,b		;no, so float it
	jrst .camm3
.camm2:	setom basei
	setom baseo
	jrst .calrs

;HERE TO EAT A NUMBER
.CALGN: SKIPN NUMSEN		;[NIC1034] DID AN OPERATOR PRECEED US?
	 JRST .CALO0		;[NIC1034] NO, JOIN ERROR CODE IN OPERATORS
	MOVE B,A		;[NIC1034] SAVE CHARACTER THAT BROUGHT US HERE
	SETO A,			;[NIC1034] BACKUP OVER CHARACTER JUST SEEN
	ADJBP A,Q1		;[NIC1034] SOW THEY WILL SEE IT
	SKIPG C,BASEI		;[NIC1034] HAVE WE SEEN A FLOAT YET?
	 JRST .CALGF		;[NIC1034] YES, GO INPUT A FLOAT
	CAIN B,"."		;[NIC1034] IF DECIMAL POINT SEEN
	 JRST .CALG1		;[NIC1034] THEN GOBBLE FLOATING
	NIN%			;[NIC1034] TRY TO INPUT INTEGER
	 JRST .CALE0		;[NIC1034] JSYS ERROR OF SOME SORT
	LDB C,A			;[NIC1034] GET NEXT CHARACTER
	CAIN C,"."		;[NIC1034] IF A DECIMAL POINT
	 JRST .CALG1		;[NIC1034] IT IS, RESTART
.CALG2:	MOVE Q1,A		;[NIC1034] SAVE UPDATED PTR
	PUSH P2,B		;[NIC1034] SAVE NUMBER ON NUMBER STACK
	SETZM NUMSEN		;[NIC1034] MARK WE JUST DID A NUMBER
	JRST .CALC2		;[NIC1034] AND LOOP
.CALG1:	SETOM BASEI		;[NIC1034] REMEMBER WE SAW FLOAT
	SETOM BASEO		;[NIC1034]
	JRST .CALRS		;[NIC1034] AND RESTART
.CALGF:	FLIN%			;[NIC1034] GET FLOATING POINT NUMBER
	 JRST .CALE0		;[NIC1034] JSYS ERROR OF SOME SORT
	JRST .CALG2		;[NIC1034] JOIN INTEGER CODE

;HERE WHEN A CLOSE PARENTHESIS IS FOUND
.CALCP:	SKIPE NUMSEN		;[NIC1034] WAS A NUMBER PREVIOUS
	 JRST .CALO0		;[NIC1034] NO, SO ERROR
	SKIPG PARENS		;[NIC1034] HAVE WE SEEN THE OPEN?
	 JRST .CALP3		;[NIC1034] SAY THERE IS A PAREN. MISMATCH
	SOS PARENS		;[NIC1034] SUBTRACT THIS ONE
.CALP1:	MOVE B,0(P1)		;[NIC1034] GET TOP OF STACK OPERATOR
	CAIN B,"("		;[NIC1034] SCAN FOR THE OPEN
	 JRST .CALP2		;[NIC1034] FOUND IT, CLEAN UP SOME
	CALL .CALEV		;[NIC1034] GO DO SOME EVALUATION
	 JRST .CALER		;[NIC1034] COMPUTATIONAL ERROR
	JRST .CALP1		;[NIC1034] CHECK NEXT OPERATOR
.CALP2:	POP P1,B		;[NIC1034] GET OFF THE OPEN.
	SETZM NUMSEN		;[NIC1034] SAY WE WANT AN OPERATOR NEXT
	JRST .CALC1		;[NIC1034] GO FOR ANOTHER CHARACTER
.CALP3:	HRROI A,[ASCIZ/?Unbalanced parenthesis./]
	JRST .CALER		;[NIC1034] GO DO ERROR

;HERE WHEN AN OPEN PARENTHESIS IS FOUND
.CALPO:	SKIPN NUMSEN		;[NIC1034] WAS AN OPERATOR OR OPEN PREVIOUS
	 JRST .CALO0		;[NIC1034] NO, THEN ERROR
	PUSH P1,A		;[NIC1034] SAVE ON OPERATOR STACK
	AOS PARENS		;[NIC1034] INCREMENT PAREN. COUNT
	MOVEI A,1		;[NIC1034] SAY WE SAW A PAREN.
	MOVEM A,NUMSEN		;[NIC1034] FOR LATER PARSING
	JRST .CALC1		;[NIC1034] AND GET NEXT CHARACTER

;HERE WHEN AN OPERATOR IS FOUND
.CALOP:	SKIPG NUMSEN		;[NIC1034] WAS AN NUMBER PREVIOUS
	 JRST .CALO1		;[NIC1034] YES, SO NO PROBLEM
	CAIE A,"+"		;[NIC1034] IS IT UNARY PLUS?
	 CAIN A,"-"		;[NIC1034] IS IT A UNARY MINUS?
	  CAIA			;[NIC1034]
	   JRST .CALO0		;[NIC1034] NO, SO IMMEDIATE ERROR
	MOVE B,NUMSEN		;[NIC1034] GET FLAG FOR TYPE OF OPERATOR SEEN
	CAILE B,1		;[NIC1034] HOW MANY HAVE WE SEEN
	 JRST .CALO0		;[NIC1034] TOO MANY, ERROR
	CAIN A,"-"		;[NIC1034] IS IT UNARY MINUS
	 MOVEI A,"~"		;[NIC1034] CHANGE FOR OUR UNARY MINUS
	CAIN A,"+"		;[NIC1034] WAS IT UNARY PLUS
	 MOVEI A,"#"		;[NIC1034] MAKE IT OUR UNARY PLUS
	JRST .CALO1		;[NIC1034] JOIN REST OF OPERATOR CODE
.CALO0:	HRROI A,[ASCIZ/?Illegal format for expression/]	;[NIC1034]
	JRST .CALER		;[NIC1034] GO ERROR
.CALO1:	MOVSI B,-OPTABL		;[NIC1034] INDEX INTO OPTAB WITH AN AOBJN PTR
	CAME A,OPTAB(B)		;[NIC1034] IS IT IN THE OPERATOR TABLE
	 AOBJN B,.-1		;[NIC1034] LOOP UNTIL CHARACTER FOUND OR EXHAUST
.CALO2:	MOVE C,0(P1)		;[NIC1034] GET LAST OPERATOR ON STACK
	MOVSI D,-OPTABL		;[NIC1034] GET AOBJN PTR
	CAME C,OPTAB(D)		;[NIC1034] DID WE FIND TOP OF STACK OPERATOR?
	 AOBJN D,.-1		;[NIC1034] LOOP UNTIL FOUND
	MOVE C,ISP(D)		;[NIC1034] GET IN-STACK PRECEDENCE
	CAMGE C,ICP(B)		;[NIC1034] WHILE IN-STACK GE IN-COMING
	 JRST .CALO3		;[NIC1034] FINISHED POPPING, CLEAN UP
	CALL .CALEV		;[NIC1034] GO EVALUATE SOME
	 JRST .CALER		;[NIC1034] COMPUTATION ERROR
	JRST .CALO2		;[NIC1034] UNTIL CONDITION FALSE
.CALO3:	PUSH P1,A		;[NIC1034] A BETTER STILL HAVE OPERATOR
	AOS NUMSEN		;[NIC1034] SAY WE SAW AN OPERATOR
	CAIN A,"!"		;[NIC1034] FACTORIAL IS SPECIAL CASE
	 SETZM NUMSEN		;[NIC1034] MAKE IT TRANSPARENT
	JRST .CALC1		;[NIC1034] LOOK AT NEXT CHARACTER

;HERE ON ANY ERRORS
.CALE0:	ETYPE <?%?>		;[NIC1034] ENTRY FOR JSYS ERRORS
	JRST .CALR1		;[NIC1034] CLOSE UP AND QUIT
.CALER:	SKIPE OVRFLW		;[NIC1034] WAS IT OVERFLOW?
	 HRROI A,[ASCIZ/?Arithmetic overflow/] ;[NIC1034] YES
	UTYPE (A)		;[NIC1034] OUTPUT THE PASSED ERROR MESSAGE
.CALR1:	CALL .CALCL		;[NIC1034] CLOSE THINGS UP
	RET			;[NIC1034] AND RETURN

;HERE WHEN WE HAVE FINISHED
.CALCL:	HRRZ B,PSTPTR		;[NIC1034] RETURN MEMORY FROM OPERATOR STACK
	HLRE A,PSTPTR		;[NIC1034] LENGTH IN A, ADDR IN B
	MOVN A,A		;[NIC1034] MAKE POSITIVE
	SKIPN PSTPTR		;[NIC1034] DID WE GET IT YET?
	CALL RETBUF		;[NIC1034] THEN AND RETURN IT
	HRRZ B,STKPTR		;[NIC1034] RETURN MEMORY FROM NUMBER STACK
	HLRE A,STKPTR		;[NIC1034] ADDR IN B, COUNT IN A
	MOVN A,A		;[NIC1034] MAKE POSITIVE
	SKIPN STKPTR		;[NIC1034] DID WE GET IT YET
	CALL RETBUF		;[NIC1034] RETURN IT
	MOVE A,EXPPTR		;[NIC1034] GET PTR TO ORIGINAL EXPRESSION
	SKIPN A			;[NIC1034] IF THERE IS ANYTHING TO RETURN
	CALL STREM		;[NIC1034] RETURN IT TOO
	MOVEI A,.FHSLF		;[NIC1034] RESET SPECIAL INTERRUPTS
	MOVX B,1B<.ICAOV>!1B<.ICFOV> ;[NIC1034] THESE CHANNELS
	DIC%			;[NIC1034] TURN THEM OFF
	RET			;[NIC1034]

;HERE TO EVALUATE SOME EXPRESSIONS
.CALEV:	PUSH P,A		;[NIC1034] SAVE A
	PUSH P,B		;[NIC1034] AND B FOR CALLING ROUTINES
	POP P1,A		;[NIC1034] POP OPERATOR
	CAIN A,"!"		;[NIC1034] WAS IT FACTORIAL?
	 JRST .CALFC		;[NIC1034] THEN GO DO IT
	CAIN A,"^"		;[NIC1034] WAS IT EXPONENTIATION
	 JRST .CALXP		;[NIC1034] THEN GO DO IT
	CAIN A,"~"		;[NIC1034] WAS IT UNARY MINUS
	 JRST .CALUM		;[NIC1034] THEN GO DO IT
	CAIN A,"#"		;[NIC1034] WAS IT UANRY PLUS?
	 JRST .CALUP		;[NIC1034] THEN GO DO IT
	CAIN A,"*"		;[NIC1034] WAS IT MULTIPLY
	 JRST .CALMP		;[NIC1034] THEN GO DO IT
	CAIN A,"/"		;[NIC1034] WAS IT DIVIDE
	 JRST .CALDV		;[NIC1034] THEN GO DO IT
	CAIN A,"\"		;[NIC1034] WAS IT MODULO?
	 JRST .CALYO		;[NIC1034] THEN GO DO IT
	CAIN A,"+"		;[NIC1034] WAS IT BINARY ADDITION
	 JRST .CALAD		;[NIC1034] THEN GO DO IT
	CAIN A,"-"		;[NIC1034] WAS IT BINARY SUBTRACTION
	 JRST .CALSB		;[NIC1034] THEN GO DO IT
	TYPE <?Should never get here.> ;[NIC1034]
.CALE1:	SKIPN OVRFLW		;[NIC1034] NON-ZERO IF OVERFLOW OCCURED
	AOS -2(P)		;[NIC1034] CAUSE A SKIP RETURN
.CALE2:	POP P,B			;[NIC1034] GET AC'S BACK
	POP P,A			;[NIC1034]
	RET			;[NIC1034] AND RETURN

;HERE TO DO FACTORIAL
.CALFC:	SKIPG BASEI		;[NIC1034] DO WE HAVE TO DEAL WITH REALS?
	 JRST .CALF3		;[NIC1034] SEE IF WE CAN STILL DO THIS
.CALF1:	POP P2,D		;[NIC1034] GET NUMBER TO FACTORIAL
	MOVEI C,2		;[NIC1034] GET LOWEST FACTORIAL
	SKIPG BASEI		;[NIC1034] SHOULD IT BE FLOAT?
	 FLTR C,C		;[NIC1034] MAKE FLOAT IF NECESSARY
	PUSH P2,C		;[NIC1034] SAVE RESULT SO FAR
.CALF2:	CAML C,D		;[NIC1034] COMPARE TO NUMBER
	 JRST .CALE1		;[NIC1034] RETURN WITH FINISHED VALUE
	MOVEI B,1		;[NIC1034] ADD ONE TO CURRENT VALUE
	SKIPG BASEI		;[NIC1034] NEED FLOAT
	 FLTR B,B		;[NIC1034] THEN CONVERT IT
	CALL .CALA0		;[NIC1034] RETURN SUM OF B AND C ON NUMBER STK
	POP P2,A		;[NIC1034] GET RESULT INTO A FOR SAFTY
	MOVE B,A		;[NIC1034] AND MOVE TO B FOR MULT.
	POP P2,C		;[NIC1034] GET ANSWER FROM LAST TIME
	CALL .CALM0		;[NIC1034] MULTIPLY B AND C; RESULT NUMBER STK
	MOVE C,A		;[NIC1034] GET COUNT BACK TO C
	JRST .CALF2		;[NIC1034] SEE IF WE ARE DONE
.CALF3:	FIXR A,0(P2)		;[NIC1034] TRY FIXING FACTORIAL TO INTEGER
	FLTR A,A		;[NIC1034] THEN CONVERT IT BACK TO FLOAT
	CAMN A,0(P2)		;[NIC1034] IF DIFFERENT (MANTISSA PRESENT)
	 JRST .CALF1		;[NIC1034] NOT DIFFERENT. CAN DO
	HRROI A,[ASCIZ/?Non-integral factorial illegal./] ;[NIC1034]
	EXCH A,-1(P)		;[NIC1034] PUT IT WHERE IT WILL BE POPPED
	JRST .CALE2		;[NIC1034] ERROR RETURN

;HERE FOR EXPONENTIATION
.CALXP:	SKIPG BASEI		;[NIC1034] FLOAT NEEDED?
	 JRST .CALX2		;[NIC1034] YES, CHECK EXPONENT
.CALX0:	POP P2,B		;[NIC1034] GET THE EXPONENT
	POP P2,D		;[NIC1034] GET NUMBER TO MULTIPLY
	SKIPN B			;[NIC1034] ZERO EXPONENT?
	 JRST [ MOVEI B,1	;[NIC1034] ANSWER IS ALWAYS ONE
		PUSH P2,B	;[NIC1034] SAVE ANSWER ON STACK
		JRST .CALE1]	;[NIC1034] NORMAL RETURN
	PUSH P2,D		;[NIC1034] ANSWER IF EXPONENT IS ONE
.CALX1:	MOVEI C,1		;[NIC1034] SUBTRACT 1 FROM EXPONENT
	SKIPG BASEI		;[NIC1034] DO WE NEED FLOAT
	 FLTR C,C		;[NIC1034] THEN CONVERT IT
	CALL .CALS0		;[NIC1034] SUBTRACT C FROM B
	POP P2,A		;[NIC1034] GET RESULT INTO A
	SKIPN A			;[NIC1034] IF ZERO, WE ARE DONE
	 JRST .CALE1		;[NIC1034] SO RETURN NORMALLY
	MOVE B,D		;[NIC1034] GET NUMBER TO MULTIPLY
	POP P2,C		;[NIC1034] GET CURRENT MULTIPLIERS
	CALL .CALM0		;[NIC1034] AND NULTIPLY THEM. ANSWER ON STACK
	MOVE B,A		;[NIC1034] GET COUNT BACK IN B
	JRST .CALX1		;[NIC1034] AND LOOP
.CALX2:	FIXR A,0(P2)		;[NIC1034] TRY FIXING EXPONENT TO INTEGER
	FLTR A,A		;[NIC1034] THEN CONVERT IT BACK TO FLOAT
	CAMN A,0(P2)		;[NIC1034] IF DIFFERENT (THERE WAS A MANTISSA)
	 JRST .CALX0		;[NIC1034] NO, NO DIFFERENT, WHO FLOAT
	HRROI A,[ASCIZ/?Non-integral real exponent illegal./] ;[NIC1034] ERROR
	EXCH A,-1(P)		;[NIC1034] PUT IT WHERE IT WILL BE POPPED
	JRST .CALE2		;[NIC1034] ERROR RETURN

;HERE TO DO UNARY OPERATIONS, PLUS AND MINUS
.CALUP:	MOVEI A,1		;[NIC1034] MULTIPLIER FOR PLUS
	SKIPA			;[NIC1034]
.CALUM:	SETO A,			;[NIC1034] MULTIPLIER FOR MINUS
	SKIPG BASEI		;[NIC1034] DO WE HAVE A BASE
	 JRST .CALU1		;[NIC1034] THEN GO HANDLE FLOAT
	IMULM A,0(P2)		;[NIC1034] MULTIPLY CURRENT ANSWER
	JRST .CALE1		;[NIC1034] AND RETURN NORMALLY
.CALU1:	FLTR A,A		;[NIC1034] NO, CONVERT TO FLOAT
	FMPRM A,0(P2)		;[NIC1034] FLOATING MULTIPLY
	JRST .CALE1		;[NIC1034] AND RETURN

;HERE TO MULTIPLY TWO NUMBERS
.CALMP:	POP P2,C		;[NIC1034] GET FIRST NUMBER
	POP P2,B		;[NIC1034] AND SECOND
	TLO Z,F1		;[NIC1034] SAY WE JRSTED HERE
.CALM0:	PUSH P,B		;[NIC1034] SAVE ORIGINAL
	PUSH P,C		;[NIC1034] THIS ONE TOO
	SKIPG BASEI		;[NIC1034] NEED FLOAT
	 JRST .CALM1		;[NIC1034] YES, DO FMPR
	IMUL B,C		;[NIC1034] DO THE INTEGER MULTIPLY
	SKIPA			;[NIC1034]
.CALM1:	FMPR B,C		;[NIC1034] FLOAT MULTIPLY
	PUSH P2,B		;[NIC1034] SAVE RESULT
	POP P,C			;[NIC1034] GET BACK C
	POP P,B			;[NIC1034] RESTORE ORIGINAL
	TLZE Z,F1		;[NIC1034] DID WE JRST HERE?
	 JRST .CALE1		;[NIC1034] NORMAL RETURN
	RET			;[NIC1034] NO.

;HERE TO DIVIDE TWO NUMBERS
.CALDV:	POP P2,C		;[NIC1034] GET FIRST NUMBER
	POP P2,B		;[NIC1034] AND SECOND
.CALD0:	PUSH P,B		;[NIC1034] SAVE ORIGINAL
	PUSH P,C		;[NIC1034] THIS ONE TOO
	SKIPG BASEI		;[NIC1034] NEED FLOAT
	 JRST .CALD1		;[NIC1034] YES, DO FDVR
	IDIV B,C		;[NIC1034] DO THE INTEGER DIVIDE
	SKIPA			;[NIC1034]
.CALD1:	FDVR B,C		;[NIC1034] FLOAT DIVIDE
	PUSH P2,B		;[NIC1034] SAVE RESULT
	POP P,C			;[NIC1034] GET BACK C
	POP P,B			;[NIC1034] RESTORE ORIGINAL
	JRST .CALE1		;[NIC1034] RETURN NORMALLY

;HERE TO GET MODULO OF TWO NUMBERS
.CALYO:	POP P2,C		;[NIC1034] GET FIRST NUMBER
	POP P2,B		;[NIC1034] AND SECOND
.CALY0:	SKIPG BASEI		;[NIC1034] NEED FLOAT
	 JRST .CALY1		;[NIC1034] YES, ERROR
	PUSH P,B		;[NIC1034] SAVE ORIGINAL
	PUSH P,C		;[NIC1034] THIS ONE TOO
	IDIV B,C		;[NIC1034] DO THE INTEGER DIVIDE W/ REMAINDER
	PUSH P2,C		;[NIC1034] SAVE REMAINDER
	POP P,C			;[NIC1034] GET BACK C
	POP P,B			;[NIC1034] RESTORE ORIGINAL
	JRST .CALE1		;[NIC1034] OK RETURN
.CALY1:	HRROI A,[ASCIZ/?Modulo not permited on floating values./]
	EXCH A,-1(P)		;[NIC1034] PUT ERROR WHERE IT WIL BE POPPED OFF
	JRST .CALE2		;[NIC1034] AND TAKE ERROR RETURN

;HERE TO ADD TWO NUMBERS
.CALAD:	POP P2,C		;[NIC1034] GET ONE NUMBER
	POP P2,B		;[NIC1034] GET THE OTHER
	TLO Z,F1		;[NIC1034] SAY WE JRSTED HERE
.CALA0:	PUSH P,B		;[NIC1034] SAVE B
	SKIPG BASEI		;[NIC1034] FLOAT?
	 JRST .CALA1		;[NIC1034] YES, DO FADR
	ADD B,C			;[NIC1034] GET SUM
	SKIPA			;[NIC1034]
.CALA1:	FADR B,C		;[NIC1034] FLOAT ADD
	PUSH P2,B		;[NIC1034] SUM ON STACK
	POP P,B			;[NIC1034] RESTORE ORIGINAL
	TLZE Z,F1		;[NIC1034] DID WE JRST HERE?
	 JRST .CALE1		;[NIC1034] YES.
	RET			;[NIC1034] NO.

;HERE TO SUBTRACT TWO NUMBERS
.CALSB:	POP P2,C		;[NIC1034] GET ONE NUMBER
	POP P2,B		;[NIC1034] GET THE OTHER
	TLO Z,F1		;[NIC1034] SAY WE JRSTED HERE
.CALS0:	PUSH P,B		;[NIC1034] SAVE B
	SKIPG BASEI		;[NIC1034] FLOAT?
	 JRST .CALS1		;[NIC1034] YES, DO FSBR
	SUB B,C			;[NIC1034] GET DIFFERENCE
	SKIPA			;[NIC1034]
.CALS1:	FSBR B,C		;[NIC1034] FLOAT SUB
	PUSH P2,B		;[NIC1034] SUM ON STACK
	POP P,B			;[NIC1034] RESTORE ORIGINAL
	TLZE Z,F1		;[NIC1034] DID WE JRST HERE?
	 JRST .CALE1		;[NIC1034] YES.
	RET			;[NIC1034] NO.

;HERE ON ARITHMETIC OVERFLOW
.CALOV::SETOM OVRFLW		;[NIC1034] REMEMBER OVERFLOW
	DEBRK%			;[NIC1034] AND CONTINUE. WILL CATCH IT LATER

;HERE FOR HELP ON CALC.
.CALHP:	CONFIRM			;[NIC1034] JUST DO HELP ALONE
	MOVE A,COJFN		;[NIC1034] OUTPUT TO HERE
	HRROI B,.CALTX		;[NIC1034] GET CALCULATOR HELP TEXT
	SETZ C,			;[NIC1034] TILL A NULL.
	SOUT			;[NIC1034]
	RET			;[NIC1034]

.CALTX:	ASCIZ ~
 The CALCULATOR command will work as a general calculator and number
converter. Input and output bases can be set for conversion. The permitted
input base ranges from 2 to 10 and output base ranges from 2 to 36.

Factorial (!), exponentiation (^), multiplication (*), division (/),
modulo (\), addition (+), and subtraction (-) are supported. Unary
minus and plus are allowed. Parenthesis can be used to change the
precedence of the operators. Normal FORTRAN precedence is the default.
~

LEGOPS:	POINT 7,[ASCIZ "!^*/\+-"] ;[NIC1034] ALL LEGAL OPERATORS
OPTAB:	.CHNUL			;[NIC1034] STACK TERMINATOR
	"!"			;[NIC1034] FACTORIAL
	"^"			;[NIC1034] EXPONENTIATION
	"~"			;[NIC1034] UNARY MINUS
	"#"			;[NIC1034] UNARY PLUS
	"*"			;[NIC1034] MULTIPLICATION
	"/"			;[NIC1034] DIVISION
	"\"			;[NIC1034] MODULO
	"+"			;[NIC1034] BINARY PLUS
	"-"			;[NIC1034] BINARY MINUS
	"("			;[NIC1034] OPEN PARENTHESIS
OPTABL==.-OPTAB			;[NIC1034] CALCULATE LENGTH

ISP:	-1			;[NIC1034] IN-STACK PRIORITY OF TERMINATOR
	3			;[NIC1034]  "   "      "     OF FACTORIAL
	3			;[NIC1034]  "   "      "     OF EXPONENTIATION
	3			;[NIC1034]  "   "      "     OF UNARY MINUS
	3			;[NIC1034]  "   "      "     OF UNARY PLUS
	2			;[NIC1034]  "   "      "     OF MULTIPLICATION
	2			;[NIC1034]  "   "      "     OF DIVISION
	2			;[NIC1034]  "   "      "     OF MODULO
	1			;[NIC1034]  "   "      "     OF ADDITION
	1			;[NIC1034]  "   "      "     OF SUBTRACTION
	0			;[NIC1034]  "   "      "     OF OPEN PAREN.

ICP:	0			;[NIC1034] INCOMING PRIORITY OF TERMINATOR
	4			;[NIC1034]     "       "     OF FACTORIAL
	4			;[NIC1034]     "       "     OF EXPONENTIATION
	4			;[NIC1034]     "       "     OF UNARY MINUS
	4			;[NIC1034]     "       "     OF UNARY PLUS
	2			;[NIC1034]     "       "     OF MULTIPLICATION
	2			;[NIC1034]     "       "     OF DIVISION
	2			;[NIC1034]     "       "     OF MODULO
	1			;[NIC1034]     "       "     OF ADDITION
	1			;[NIC1034]     "       "     OF SUBTRACTION
	4			;[NIC1034]     "	      "     OF OPEN PAREN.

$BASEB:	TABLE
	T Help,,.CALHP		;[NIC1034] HELP FOR CALC.
	TV Input-Base,,IBASE	;[NIC1034] INPUT BASE ROUTINE
	TV Output-Base,,OBASE	;[NIC1034] OUTPUT BASE ROUTINE
	TEND

IBASEI:	TABLE
	TV Output-Base,,OBASE	;[NIC1034] JUST DO OUTPUT BASE
	TEND

OBASEO:	TABLE
	TV Input-Base,,IBASE	;[NIC1034] JUST DO INPUT BASE
	TEND

IFE NICSW,<
IFN CTLLSW,<
;CLEAR SCREEN ON CTRL-L INTERRUPT
ICLRSC::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	CALL BLANK1
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	DEBRK%
>
>;IFE NICSW
;EM34
;Define a PID for this user. Called whenever the exec starts or we login.

IPCINI:: ret
	SKIPE RCVFLG		;Receiving messages?
	 RET			;No, Don't do anything, then
	SKIPN MYPID		;Got a PID yet?
	 CALL GETPID		;Create me a PID
	CALL XGIPID		;Get INFO's PID now
	 RET			;Non-existant - just punt
	SKIPE A,HAVPID		;Was it ever named?
	 JRST  [CAIE A,1	;Yes, was it a NLI name?
	         RET		;No, so we are done
		SKIPN CUSRNO	;Logged in then?
		 RET		;Nope, so end
		CALL IPCKIL	;Kill off the old pid
		CALL GETPID	;Get a new one
		JRST .+1]	;And now name it

	SKIPN CUSRNO
	 JRST NOSNDF
	HRROI A,SNDFNM		;Where the message file name is
	MOVE B,LIDNO		;First put on home directory name
	DIRST%
	 ERJMP NOSNDF
	HRROI B,[ASCIZ/MSGS.TXT;T/]	;Initial part
	SETZB C,D
	SOUT%			;Do the string copy
NOSNDF:	SETZM IPCFP+.IPCI1	;No message copy
	HRROI A,IPCFP+.IPCI2	;Argument is the PID name
	SKIPN B,CUSRNO		;Current user #
	 JRST [HRROI B,[ASCIZ /N-L-I/]
	       SETZ C,
	       SOUT%
	       JRST NLINAM]
	DIRST%			;Translate us
	 ERJMP NONPID		;Oh well...
NLINAM:	MOVEI B,"."		;Special separator
	IDPB B,A		;Add it on
	MOVE B,JOBNO		;Current job number
	MOVEI C,^D10		;In decimal
	NOUT%			;Add it to the PID name
	 TRN
	MOVE A,[1,,.IPCIJ]	;Code,,FCN
	MOVEI B,0		;Sending to INFO
	CALL SNDMSG		;Send a message...
	  CALL CJERR		;We don't want this to happen...
INII.2:	MOVE A,INFPID		;Get INFO pid back
	CALL IPCRCV		;Receive message from INFO
	MOVE C,IPCFP		;Get request ID returned by INFO
	CAME C,[1,,.IPCIJ]	;Is it mine?
	 JRST INII.2		;Try again, then
	LOAD A,IP%CFE,A		;Load the error/flag bits
	JUMPE A,IPCIOK		;If 0, then we are in good shape
	CAIN A,.IPCDN		;Duplicate name?
	 RET			;Just return, then
	ETYPE <%%During PID name def: INFO returned error code %1O
>
	RET			;Return
IPCIOK:	SETO A,			;A logged in PID name
	SKIPN CUSRNO
	 MOVEI A,1		;A NLI pid name
	MOVEM A,HAVPID		;We now have a named PID
NONPID:	RET			;And are now done...

;Kill off our PID. Called whenever the exec halts to insure that no one 
;tries to send any messages to us.

IPCKIL::TRVAR <<ARGBLK,4>>	;MUTIL% argument BLOCK
	MOVEI A,.MUDES		;Delete PID function
	MOVE B,MYPID		;Argument is this PID
	DMOVEM A,ARGBLK		;Define the argument block
	MOVEI A,4		;Length is 4
	MOVEI B,ARGBLK		;Located here
	MUTIL%			;Kill my PID
	 ERJMP .+1		;Maybe, but we don't really care
	SETZM MYPID		;No longer have a PID
	SETZM HAVPID		;Ditto
	RET			;Done

;Come here when we get a message from a user. Called with A=address of msg,
;B=PID of sender, C=user # of sender

USRMSG::TRVAR <<MYPDB,4>,<UBLK,4>,<USRNAM,10>,USRLOC>
	MOVE D,A		;Save pointer to received message
	SKIPE RCVFLG		;Are we receiving messages?
	 RET			;Ignore it, then
	MOVEI A,.MUFOJ		;Function to return job #
	DMOVEM A,UBLK		;Define the MUTIL% block
	MOVEI A,3		;Length of argblock
	MOVEI B,UBLK		;Location of argblock
	MUTIL%			;Get job number of PID
	 ERJMP [MOVE B,.MSGJB(D);Guess we have to trust him...
		JRST .+2]
	MOVE B,2+UBLK		;Job number is here
	MOVEM B,USRLOC		;save location (job number so far)
	MOVE A,.MSGFL(D)	;get flags
	TXNE A,MSG%LF		;local or foreign send?
	 JRST USR4N		;foreign
	HRROI A,USRNAM
	MOVE B,C
	DIRST%
	 JFCL
	HRROI A,2(D)		;point to message text
	JRST USRMRC		;display and record message

;send if from a foreign user
USR4N:	CAME C,[.MSGMM]		;did mmailr send this?
	 RET			;nope, ignore it then
	HRROI A,USRNAM
	HRROI B,2(D)		;get pointer to messages strings
	SETZ 3,
	SOUT%			;copy user name
	MOVEM B,USRLOC		;save pointer to host name
	ILDB A,B
	JUMPN A,.-1		;find end of host name
	MOVE A,B
;	JRST USRMRC		;display and record message

;USRMRC is called to display and record a user message.
;Called with pointer to message in A, username string stored
;at USRNAM and USRLOC containing a job number (for local sends)
;or a string pointer to a host name (foreign sends)

USRMRC::PUSH P,A		;save A
	HRROI A,SNDFRM		;output buffer
	HRROI B,USRNAM
	SETZ C,
	SOUT%			;username
	MOVE D,USRLOC
	TLNE D,-1		;job number or host pointer?
	IFSKP.			;if job number
	 HRROI B,[ASCIZ/, job /];More header
	 SOUT%			;Output it
	 HRRZ B,D		;job number
	 MOVEI C,^D10		;Always in decimal
	 NOUT%			;Add it on
	  TRN			;ignoring errors...
	ELSE.			;else must be host pointer
	 HRROI B,[ASCIZ / at /]
	 SOUT%
	 MOVE B,D		;host pointer
	 SOUT%
	ENDIF.
	HRROI B,[ASCIZ /, /]
	SETZ C,
	SOUT%
	SETO B,			;-1 means now
	MOVX C,OT%NSC!OT%12H!OT%SCL
	ODTIM%			;Add it to the message
	 ERJMP .+1		;Again, no errors
	HRROI B,[ASCIZ/
/]
	SETZ C,
	SOUT%			;Last bit of header

	ETYPE <%_>
	HRROI A,SNDFRM
	PSOUT%
	MOVE A,(P)		;get back message pointer
	PSOUT%			;display message
	ETYPE <%_>	

	HRROI B,SNDFNM		;Name of file
	CALL TRYGTO		;Get an output jfn
	 JRST USRMRQ		;Punt...
	MOVE C,A
USRMR1:	MOVX B,<OF%APP!OF%RTD!FLD(7,OF%BSZ)>
	OPENF%			;Try to open it
	 JRST [CAIE 1,OPNX9	;invalid simultaneousness?
	        JRST USRMRQ	;Nope...
	       MOVEI 1,^d100
	       DISMS%
	       MOVE A,C
	       JRST USRMR1]
	HRROI B,SNDFRM		;message header
	SETZ C,
	SOUT%			;to file
	POP P,B			;Get back message pointer
	SETZB C,D		;Clear these words
	SOUT%			;Write the message itself
	HRROI B,[BYTE(7)15,12,37,0] ;What the end of it looks like
	MOVNI C,3
	SOUT%			;That's it!!
	CLOSF%			;Close the JFN
	 TRN
	RET			;And return
USRMRQ:	ADJSP P,-1		;Flush 1 words of stack
	RET			;And return

	END