Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-exec/execnc.mac
There are 2 other files named execnc.mac in the archive. Click here to see a list.
;[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
.SAFET::HRROI A,[ASCIZ /ANONYMOUS.SAFETY/] ;[NIC1053] SETUP USERNAME
	HRROI B,[ASCIZ /QUERY/]		;[NIC1053] AND ACCOUNT
	HRROI C,[ASCIZ /COKEISIT/]	;[NIC1053] AND PASSWORD
	HRROI D,[ASCIZ /SYS:SAFETY.EXE/];[NIC1053] AND PROGRAM TO RUN
	JRST NIC0			;[NIC1053] JOIN COMMON CODE

.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]

;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,[^D15*^D60000]	;EXCEEDED 15 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
.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				;
.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 HCNT		;[NIC1017] ANY COMMANDS?
	 ERROR <No history>	;[NIC1017]
	MOVE A,P		;[NIC1017] SAVE STACK PTR
	TRVAR <COMNUM,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 COMMAND NUMBER
.DOHSN:	MOVE A,B		;[NIC1017] SAVE COMMAND NUMBER
.DOHN1:	JUMPL A,[AOS A		;[NIC1017] IF NEGATIVE, RELATIVE NUMBER
		 ADD A,CNUM	;[NIC1017] MAKE IT ABSOLUTE
		 JRST .+1]	;[NIC1017] AND CONTINUE
	MOVE B,CNUM		;[NIC1017] GET CURRENT COMMAND NUMBER
	SUB B,HCNT		;[NIC1017] GET SMALLEST COMMAND WE HAVE
	SKIPGE B		;[NIC1017] IF NEGATIVE, MAKE ONE
	 SETZ B,		;[NIC1017] STILL HAVE THIS ONE THEN
	AOS B			;[NIC1017] BASE 1
	CAMG A,CNUM		;[NIC1017] SMALLER THAN LARGEST WE HAVE
	 CAMGE A,B		;[NIC1017] AND LARGER THAN SMALLEST WE HAVE
	   ERROR <Command not found> ;[NIC1017] TELL HIM WHY
	SOS A			;[NIC1017] BASE 0 THE COUNT
	IDIV A,HCNT		;[NIC1017] DIVIDE BY NUMBER OF COMMANDS
	HLRZ A,HPTR		;[NIC1017] GET BASE ADDRESS
	ADD A,B			;[NIC1017] GET PROPER OFFSET
	MOVEM A,COMNUM		;[NIC1017] SAVE COMMAND ADDRESS
	JRST .DOHS2		;[NIC1017] GO PARSE FOR ARGS.

;HERE TO HANDLE ANOTHER /
.DOHSS:	MOVE A,CNUM		;[NIC1017] GET CURRENT COMMAND NUMBER
	JRST .DOHN1		;[NIC1017] CALCULATE COMMAND ADDRESS

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

;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
	MOVEM D,COMNUM		;[NIC1017] SAVE NUMBER
	JRST .DOHS2		;[NIC1017] JOIN OTHERS

;HERE TO FINISH UP PARSE
.DOHS2:	CONFIRM			;[NIC1017] GET CRLF
	MOVE A,COMNUM		;[NIC1017] GET COMMAND NUMBER SPECIFIED
	SKIPN B,(A)		;[NIC1017] GET THE PTR ITSELF
	 ERROR <Command not found> ;[NIC1017] NOTHING THERE. SAY SO
	HRROI A,CBUF		;[NIC1017] COPY IT TO COMMAND BUFFER
	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:	HLRZ C,HPTR		;[NIC1017] GET BASE ADDRESS
	HRRZ D,HPTR		;[NIC1017] GET CURRENT PTR
	ADD C,HCNT		;[NIC1017] SPECIAL FIRST CASE CHECK
	CAML D,C		;[NIC1017] PTR WITHIN RANGE?
	 HLRZ D,HPTR		;[NIC1017] IF OVER RABLE, POINT TO FIRST
	MOVE Q1,D		;[NIC1017] SAVE CURRENT PTR
	HLRZ C,HPTR		;[NIC1017] GET BASE ADDR BACK
DOHFC1:	SOS D			;[NIC1017] BACKUP TO PREVIOUS COMMAND
	CAMLE C,D		;[NIC1017] IS PTR LESS THAN BASE?
	 JRST [ HLRZ D,HPTR	;[NIC1017] GET CURRENT BASE ADDRESS
		ADD D,HCNT	;[NIC1017] GET TO END OF BLOCK
		SOS D		;[NIC1017] BACK UP TO LAST ENTRY
		JRST .+1]	;[NIC1017] CONTINUE ON
	HRROI A,ATMBUF		;[NIC1017] GET PTR TO INPUT STRING
	SKIPN B,(D)		;[NIC1017] GET PTR TO COMMAND
	 JRST DOHFC2		;[NIC1017] NOTHING, LOOK AT NEXT ONE
	STCMP%			;[NIC1017] COMPARE
	SKIPE A			;[NIC1017] TOTAL MATCH?
	 TXNE A,SC%SUB		;[NIC1017] SUBSET MATCH?
	  RETSKP		;[NIC1017] 
DOHFC2:	CAMN D,Q1		;[NIC1017] HAVE WE LOOPED?
	 RET			;[NIC1017] FAILURE RETURN
	JRST DOHFC1		;[NIC1017] NO GOOD. LOOK AT NEXT

;DOHFIS -- DO HISTORY FIND IMBEDDED STRING
DOHFIS:	HLRZ C,HPTR		;[NIC1017] GET BASE ADDRESS
	HRRZ D,HPTR		;[NIC1017] GET CURRENT PTR
	ADD C,HCNT		;[NIC1017] SPECIAL FIRST CASE CHECK
	CAML D,C		;[NIC1017] PTR WITHIN RANGE?
	 HLRZ D,HPTR		;[NIC1017] IF PAST TABLE, MOVE TO FIRST ENTRY
	MOVE Q1,D		;[NIC1017] SAVE CURRENT PTR
	HLRZ C,HPTR		;[NIC1017] GET BASE ADDR BACK
DOHFI1:	SOS D			;[NIC1017] BACKUP TO PREVIOUS COMMAND
	CAMLE C,D		;[NIC1017] IS PTR LESS THAN BASE?
	 JRST [ HLRZ D,HPTR	;[NIC1017] GET CURRENT BASE ADDRESS
		ADD D,HCNT	;[NIC1017] GET TO END OF BLOCK
		SOS D		;[NIC1017] BACK UP TO LAST ENTRY
		JRST .+1]	;[NIC1017] CONTINUE ON
	MOVE B,[POINT 7,ATMBUF]	;[NIC1017] GET PTR TO INPUT PATTERN
	SKIPN A,(D)		;[NIC1017] GET PTR TO COMMAND STRING
	 JRST DOHFI2		;[NIC1017] NOTHING, LOOK AT NEXT ONE
	CALL DOHFND		;[NIC1017] DO PATTERN MATCH
	  SKIPA			;[NIC1017] NOT FOUND
	RETSKP			;[NIC1017] SAY FOUND IT. ADDR OF COMMAND IN D
DOHFI2:	CAMN D,Q1		;[NIC1017] HAVE WE LOOPED?
	 RET			;[NIC1017] FAILURE RETURN
	JRST DOHFI1		;[NIC1017] NO GOOD. LOOK AT NEXT

;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:	JUMPE A,R		;[NIC1017] RETURN IF STRING ZERO
	JUMPE B,R		;[NIC1017] RETURN IF PATTERN ZERO
	PUSH P,C		;[NIC1017] AC TO SAVE PLACE IN STRING
	PUSH P,D		;[NIC1017] AC WE USE TO POINT TO PATTERN
	PUSH P,Q1		;[NIC1017] SAVE PLACES FOR CHARACTERS
	PUSH P,Q2		;[NIC1017]
DOHFN1:	MOVE C,A		;[NIC1017] SAVE PTR INTO STRING
	MOVE D,B		;[NIC1017] GET NEW PTR TO PATTERN
DOHFN2:	ILDB Q1,A		;[NIC1017] GET A CHARACTER FORM STRING
	ILDB Q2,D		;[NIC1017] GET A CHARACTER FROM PATTERN
	JUMPE Q2,[MOVE A,C	;[NIC1017] RESTORE SAVED STRING POSITION
		  AOS -4(P)	;[NIC1017] GOOD RETURN. MATCH FOUND
		  JRST DOHFN4]	;[NIC1017] POP AND RETURN
	JUMPE Q1,DOHFN4		;[NIC1017] END OF STRING?
	CAMN Q1,Q2		;[NIC1017] CHARACTERS MATCH?
	 JRST DOHFN2		;[NIC1017] LOOP UNTIL MISMATCH
	JRST DOHFN1		;[NIC1017] TRY PATTERN ON UPDATED STRING
DOHFN4:	POP P,Q2		;[NIC1017] RESTORE ACS
	POP P,Q1
	POP P,D
	POP P,C
	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
	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
	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 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

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%
>

	END