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 [email protected]%_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