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