Trailing-Edge
-
PDP-10 Archives
-
BB-H138A-BM
-
3a-sources/accsub.mac
There are 3 other files named accsub.mac in the archive. Click here to see a list.
;<3-UTILITIES>ACCSUB.MAC.5, 8-Nov-77 10:42:57, EDIT BY KIRSCHEN
;<3-UTILITIES>ACCSUB.MAC.4, 8-Nov-77 10:37:20, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>ACCSUB.MAC.3, 8-Nov-77 10:36:57, EDIT BY KIRSCHEN
;<2-UTILITIES>ACCSUB.MAC.4, 27-Dec-76 17:04:58, EDIT BY HURLEY
;<2-UTILITIES>ACCSUB.MAC.3, 18-Oct-76 17:08:17, Edit by HESS
;<2-UTILITIES>ACCSUB.MAC.2, 18-Oct-76 16:36:48, Edit by HESS
;CONVERT TO RELEASE 2 JSYS'S
;<1A-UTILITIES>ACCSUB.MAC.7, 8-APR-76 11:04:49, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES
;<V-SOURCES>ACCSUB.MAC.6, 23-DEC-75 12:11:19, EDIT BY LEWINE
;<V-SOURCES>ACCSUB.MAC.3, 17-NOV-75 10:57:59, EDIT BY KIRSCHEN
TITLE ACCSUB
SEARCH MONSYM,MACSYM
SALL
SUBTTL JOHN MAKHOUL - DECEMBER 20, 1971
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
IFNDEF .PSECT,<
.DIRECT .XTABM>
;ION - TURNS INTERRUPT ON FOR ^E
; CALL ION(CNTLE)
;CNTLE IS ASSIGNED TO A STATEMENT NUMBER TO WHICH CONTROL IS
;TRANSFERRED UPON RECEIVING A ^E
;OPENF - OPENS BINARY INPUT FILE
; CALL OPENF(N)
;N=0,1 - FILE NAME READ FROM TTY
;OTHERWISE N IS POINTER TO FILE NAME
;N=1 - FILE NAME WRITTEN ON OUTFIL
;N=0 - FILE NAME WRITTEN IN MEMORY STARTING AT N
;OPENOF - CLOSES OLD OUTPUT ASCII FILE AND OPENS NEW ONE
; CALL OPENOF(FILNAM)
;OR CALL OPENOF , IF FILE NAME IS TO BE TYPED IN
;BINOF - OPENS BINARY OUTPUT FILE. NAME IS TYPED IN.
; CALL BINOF
;CLOSE - CLOSES ALL FILES, INITIALIZES JFN'S, RESETS FORTRAN IO
; CHANNELS, AND SETS INTERRUPT SYSTEM
; CALL CLOSE
;CLOSE INPUT BINARY FILE IF OPEN
; CALL CLOSI
;CLOSB - CLOSE BINARY OUTPUT FILE
; CALL CLOSB
;ASCIF - OPENS ASCII INPUT FILE
; CALL ASCIF(ASCI)
;ASCI=0 - FILE NAME READ FROM TTY:
;OTHERWISE ASCI IS POINTER TO FILE NAME
;CLOSA - CLOSE ASCII INPUT FILE
; CALL CLOSA
;RWORD - READS ONE BINARY WORD FROM OPENED FILE
; CALL RWORD(WORD,EOF)
;BINARY WORD IS STORED IN (WORD)
;EOF IS AN ASSIGNED STATEMENT NUMBER TO WHICH THE PROGRAM
;RETURNS UPON DETECTING AN END OF FILE.
;WWORD - WRITE ONE BINARY WORD ON BINARY OUTPUT FILE
; CALL WWORD(WORD)
;RCHAR - READS ONE CHARACTER FROM PRIMARY INPUT FILE INTO (CHAR)
; CALL RCHAR(CHAR)
;NOUT - OUTPUT INTEGER IN RADIX 10 WITH LEADING BLANKS
;NOUTZ - OUTPUT INTEGER IN RADIX 10 WITH LEADING ZEROES
; CALL NOUT(I,NCOL)
; CALL NOUTZ(I,NCOL)
;I=THE INTEGER TO BE OUTPUT
;NCOL=NUMBER OF COLUMNS. NCOL=0 MEANS PRINT AS MANY COLUMNS AS NECESSARY
;NCONV - CONVERTS ASCII NUMERIC STRING IN RADIX 10 INTO AN INTEGER
; CALL NCONV(I,ASCI)
;I=CONVERTED NUMBER
;ASCI=ARRAY CONTAINING NUMERIC STRING
;SINA - STRING INPUT FROM ASCII FILE
; CALL SINA(ASCI,EOF,NCHAR)
;ASCI=ARRAY TO CONTAIN ASCII STRING
;NCHAR=NO. OF CHARACTERS
; =0, ZERO BYTE TERMINATES
; <0, NEGATIVE BYTE COUNT
; >0, POSITIVE BYTE COUNT OR END-OF-LINE, WHICHEVER COMES FIRST
;EOF - ASSIGNED STATEMENT NO. FOR END OF FILE TRANSFER
;SOUT - OUTPUTS A STRING OF ASCII TO OUTPUT FILE
; CALL SOUT(POINT)
;POINT IS POINTER TO THE BEGINNING OF THE STRING
;PSOUT - SAME AS SOUT EXCEPT THAT OUTPUT IS TO TTY
;SOUTCR - LIKE SOUT EXCEPT THAT A CARRIAGE RETURN - LINE FEED IS
;ADDED TO OUTPUT STRING
;PSOUTR - SAME AS SOUTCR EXCEPT THAT OUTPUT IS TO CONTROL TTY
;ODTIM - OUTPUT DATE AND TIME ON OUTPUT FILE, GIVEN INTERNAL DATE
; CALL ODTIM(INTDATE)
;ODTIMT - SAME AS ODTIM EXCEPT OUTPUT IS TO PRIMARY OUTPUT
; CALL ODTIMT(INTDATE)
;DIRST - TRANSLATES DIRECTORY NUMBER TO STRING
; CALL DIRST(IDCODE,ASCI,NCHAR)
;IDCODE - DIRECTORY NUMBER
;ASCI - ARRAY TO CONTAIN STRING
;NCHAR - NUMBER OF CHARACTERS IN STRING
;STDIR - TRANSLATES TYPED IN STRING (WITH RECOGNITION) TO DIRECTORY
;NUMBER.
; CALL STDIR(USER,TYPE,DIRERR)
;USER WILL CONTAIN THE DIRECTORY NUMBER
;IF TYPE < 0 USER IS ALPHANUMERIC, OTHERWISE NUMERIC
;DIRERR IS ASSIGNED TO A STATEMENT NUMBER TO WHICH THE PROGRAM RETURNS
;IF USER NAME IS NOT IN THE DIRECTORY
;CATEG - FINDS OUT WHETHER USER IS NUMERIC OR ALPHANUMERIC
; CALL CATEG(USER)
;USER CONTAINS THE DIRECTORY NUMBER IN THE RIGHT HALF
;BIT0 OF USER IS TURNED ON IF ALPHANUMERIC, OTHERWISE NO CHANGE
;RALPH - READ ALPHANUMERIC STRING FROM TTY
; CALL RALPH(ASCI,NCHAR)
;ASCI IS ARRAY IN WHICH STRING IS STORED WITH A NULL TERMINATOR
;NCHAR IS THE NUMBER OF CHARACTERS IN THE STRING
;LSH - LOGICAL SHIFT - F4 FUNCTION CALL
; K=LSH(I,N)
;I IS INTEGER TO BE SHIFTED
;N IS NUMBER OF SHIFTS: + FOR LEFT AND - FOR RIGHT SHIFTS
;IFIXR - ROUNDS A FLOATING POINT NUMBER INTO AN INTEGER.
; RESULT IN AC0.
; I=IFIXR(X)
ENTRY OPENFZ,RWORD,RCHAR,OPENOF,SOUTZ,SOUTCR,PSOUTR,CLOSE
ENTRY DIRSTZ,STDIRZ,STDIR2,CATEG,RALPH
ENTRY ION,CLOSI,PSOUTZ,CLOSB,WWORD,BINOF
ENTRY GETPER,ODTIMZ,ODTIM2,ODTIMT
ENTRY ASCIF,CLOSA,NOUTZ,NCONV,SINA,SINA2
ENTRY GETTIM,TSTNUM,LSH,IFIXR
EXTERNAL RESET.
A=1
B=2
C=3
D=4
E=5
F=6
Q=16
P=17
ALT=33
USRLH==500000 ;SPECIAL SYSTEM HACK FOR USER DIR #
MLON
; OPDEF RESET. [15B8] ;RESET FORTRAN IO CHANNELS
;INTERRUPT ON FOR ^E
ION: MOVEI A,101
RFCOC
MOVEM B,CONT1# ;STORE TTY CONTROL STATUS
MOVEM C,CONT2#
MOVE A,@(Q)
MOVEM A,CNTLE#
MOVE A,[XWD 5,1]
ATI ;ASSIGN ^E TO CHANNEL 1
PUSHJ P,SETINT ;SET INTERRUPT SYSTEM
POPJ P,
;SET INTERRUPT SYSTEM - USE PSEUDO-INTERRUPT LEVEL 2
;LEVEL 1 IS RESERVED FOR THE COMPATIBILITY SYSTEM
SETINT: MOVEI A,400000
RIR ;GET [LEVTAB,CHNTAB] IN AC2
MOVE C,[XWD 2,CTRIH]
MOVEM C,1(B)
MOVE C,[XWD 2,EOFIH]
MOVEM C,^D10(B)
MOVE C,[XWD 2,ERRIH]
MOVEM C,^D15(B)
MOVS B,B
MOVEI C,RETSAV
MOVEM C,1(B)
MOVSI B,200000
AIC ;ACTIVATE CHANNEL 1
POPJ P,
RETSAV: 0
;^E INTERRUPT HANDLER
CTRIH: MOVEI A,100
CFIBF ;CLEAR TTY INPUT BUFFER
SETZ Q, ;RESET FORTRAN IO CHANNELS
HRRZM ,135 ;FOROTS KLUDGE
JSP Q,RESET.
0
MOVEI A,377777
MOVEM A,OUTFIL
MOVEI Q,[ -1,,0
740 ,, [ASCIZ/TTY:/] ]+1
PUSHJ P,OPENOF
PUSHJ P,SETINT ;SET INTERRUPT SYSTEM
MOVE A,CNTLE
MOVEM A,RETSAV
MOVEI A,101
MOVE B,CONT1
MOVE C,CONT2
SFCOC ;RESET TTY CONTROL STATUS
HRROI A,[XWD 572120,0]
PSOUT ;ECHO ^E
DEBRK
JRST @CNTLE ;EXECUTED ONLY IF NO INTERRUPT
;ERROR INTERRUPT HANDLER
ERRIH: HRROI A,[ASCIZ/
? /] ;GET INITIAL ERROR STRING
PSOUT ;OUTPUT INITIAL ERROR STRING
MOVEI A,101
MOVE B,[XWD 400000,-1] ;THIS FORK, LAST ERROR
SETZ C, ;AS LONG AS NEEDED
ERSTR
JFCL
JFCL
MOVEI A,100
CFIBF ;CLEAR TTY INPUT BUFFER
SETZ Q, ;RESET FORTRAN IO CHANNELS
HRRZM ,135 ;FOROTS KLUDGE
JSP Q,RESET.
0
MOVEI A,377777
MOVEM A,OUTFIL
MOVEI Q,[ -1,,0
740 ,, [ASCIZ/TTY:/] ]+1
PUSHJ P,OPENOF
PUSHJ P,SETINT ;SET INTERRUPT SYSTEM
MOVE A,CNTLE
MOVEM A,RETSAV
MOVEI A,101
MOVE B,CONT1
MOVE C,CONT2
SFCOC ;RESET TTY CONTROL STATUS
JRST @CNTLE ;RETURN
;END-OF-FILE INTERRUPT HANDLER
EOFIH: MOVE A,@1(Q)
MOVEM A,RETSAV
MOVE A,INFIL
GTSTS ;TEST FOR END OF BINARY FILE
TLNE B,1000
JRST EOF2
MOVE A,AIFIL ;ASSUME END OF ASCII INPUT FILE
EOF2: CLOSF
JRST ERRIH
POP P,A
DEBRK
;OPEN INPUT FILE
OPENFZ: MOVSI A,120003
MOVE D,@(Q)
MOVE E,D
JUMPE E,START ;N=0,1 READ FILE NAME
SOJE E,START ;FROM TTY
HRRO B,(Q) ;OTHERWISE, STRING POINTER
TLZA A,2
START: MOVE B,[XWD 100,101]
GTJFN ;GET INPUT FILE NAME
JRST ERRIH
MOVEM A,INFIL
MOVE B,[XWD 440000,201000]
OPENF
JRST ERRIH
JUMPN E,OP2
HRRO A,(Q)
JUMPE D,.+2
MOVE A,OUTFIL
MOVE B,INFIL
SETZ C,
JFNS ;OUTPUT FILE NAME
JUMPE D,OP2 ;N=0 NO CR-LF
HRROI B,[XWD 64240,0] ;CR-LF
SOUT
OP2: MOVEI A,400000
MOVSI B,200
AIC ;ACTIVATE CHANNEL 10
POPJ P,
INFIL: -1
;OPEN OUTPUT FILE
OPENOF:
BEG: MOVSI A,460003
HLRZ -1(Q)
JUMPE 0,.+2
JRST STRING
HLRZ (Q)
MOVE B,[XWD 100,101]
GET: GTJFN
JRST ERRIH
MOVE C,A
MOVE B,[XWD 70000,101000]
OPENF
JRST ERRIH
MOVE A,OUTFIL
JUMPL A,.+3
CLOSF ;CLOSE OLD OUTPUT FILE
JRST ERRIH
MOVE A,C
MOVEM A,OUTFIL
POPJ P,
OUTFIL: -1
STRING: TLZ A,2 ;STRING PROVIDED
HRRO B,(Q) ;STRING POINTER
JRST GET
;OPEN BINARY OUTPUT FILE
BINOF: MOVSI A,460003
MOVE B,[XWD 100,101]
GTJFN
JRST ERRIH
MOVEM A,BOFIL#
MOVE B,[XWD 440000,101000]
OPENF
JRST ERRIH
POPJ P,
;CLOSE ALL OPEN FILES AND INITIALIZE SYSTEM
CLOSE: MOVE C,(P) ;SAVE RETURN-ADRESS
JSP Q,RESET.
0
PUSH P,C
PUSHJ P,SETINT ;SET INTERRUPT SYSTEM WHICH WAS TURNED OFF
;BY COMPATIBILITY WHILE EXECUTING RESET.
SETOM INFIL ;INITIALIZE INPUT JFN
SETOM OUTFIL ;AND OUTPUT JFN
SETOM AIFIL ;AND ASCII INPUT JFN
SETO A,
CLOS2: CLOSF
JRST ERRIH
POPJ P,
;CLOSE INPUT BINARY FILE
CLOSI: MOVE A,INFIL
JUMPL A,.+3 ;JUMP IF NO INPUT FILE HAS BEEN OPENED
GTSTS ;CHECK FILE STATUS
JUMPL B,CLOS2 ;IF OPEN, CLOSE IT
POPJ P,
;CLOSE BINARY OUTPUT FILE
CLOSB: MOVE A,BOFIL
JRST CLOS2
;OPENS ASCII INPUT FILE
ASCIF: MOVSI A,120003
SKIPN @(Q)
JRST ASC2
HRRO B,(Q) ;STRING POINTER
TLZA A,2
ASC2: MOVE B,[XWD 100,101]
GTJFN
JRST ERRIH
MOVEM A,AIFIL
MOVE B,[XWD 70000,201000]
OPENF
JRST ERRIH
MOVEI A,400000
MOVSI B,200
AIC ;ACTIVATE CHANNEL 10
POPJ P,
AIFIL: -1
;CLOSES ASCII INPUT FILE
CLOSA: MOVE A,AIFIL
JUMPL A,.+3
GTSTS
JUMPL B,CLOS2
POPJ P,
;READ BINARY WORD
RWORD: MOVE A,INFIL
BIN
MOVEM B,@(Q)
POPJ P,
;WRITE WORD ON BINARY OUTPUT FILE
WWORD: MOVE A,BOFIL
MOVE B,@(Q)
BOUT
POPJ P,
;READ CHARACTER ROUTINE
RCHAR: MOVEI A,100
RFMOD
MOVEM B,BUF ;SAVE MODE WORD
IORI B,170000 ;BREAK ON ANY CHARACTER
SFMOD
PBIN
ROT A,-7 ;LEFT JUSTIFY
IOR A,[XWD 1004,20100] ;FILL IN SPACES
MOVEM A,@(Q)
MOVEI A,100
MOVE B,BUF
SFMOD ;RESET MODE FOR TTY
POPJ P,
;OUTPUT INTEGER WITH LEADING BLANKS
NOUT: SETZ E,
JRST NT1
;OUTPUT INTEGER WITH LEADING ZEROES
NOUTZ: MOVEI E,40000
NT1: MOVE A,OUTFIL
MOVE B,@(Q) ;GET INTEGER
MOVE C,[XWD 130000,12]
MOVE D,@1(Q) ;GET NUMBER OF COLUMNS
ANDI D,177
OR D,E ;LEADING BLANKS OR ZEROES
TSO C,D
NOUT
JRST ERRIH
POPJ P,
;CONVERTS ASCII NUMERIC STRING INTO A NUMBER
NCONV: HRRO A,1(Q)
MOVEI C,12
NIN
JRST ERRIH
MOVEM B,@(Q)
POPJ P,
; STRING INPUT FROM ASCII FILE, RETURN # OF CHARS READ
SINA2: CALL SINA ;GO READ FILE
MOVE A,@2(Q) ;GET ORIGINAL BYTE COUNT
SUB C,A ;GET -<# OF CHARACTERS READ>
MOVNM C,@2(Q) ;STORE # OF CHARACTERS READ
POPJ P, ;RETURN
;STRING INPUT FROM ASCII FILE
SINA: MOVE A,AIFIL
HRRO B,(Q) ;STRING POINTER
MOVE C,@2(Q) ;BYTE COUNT
MOVEI D,.CHLFD ;POSSIBLY TERMINATE ON END-OF-LINE
SIN
MOVE A,B ;GET UPDATED POINTER
JUMPE C,STDR2A ;IF TERMINATED DUE TO COUNT, DON'T BACK UP
BKJFN ;BAK UP TO CRLF
JRST ERRIH ;ERROR
ADDI C,2 ;CORRECT FOR LACK OF CRLF
STDR2A: MOVEI B,.CHNUL ;GET A NULL
DPB B,A ;TERMINATE STRING WITH A NULL
IBP A ;INCREMENT POINTER TO LINE FEED
DPB B,A ;CLOBBER LINE FEED
POPJ P,
;OUTPUT STRING ON OUTPUT FILE
SOUTZ: MOVE A,OUTFIL
SOUT2: HRRO B,(Q) ;STRING POINTER
SETZ C,
SOUT
POPJ P,
;OUTPUT STRING ON TTY
PSOUTZ: MOVEI A,101
JRST SOUT2
;OUTPUT STRING PLUS CR-LF ON OUTPUT FILE
SOUTCR: MOVE A,OUTFIL
PSOUT2: HRRO B,(Q)
SETZ C,
SOUT
HRROI B,[XWD 64240,0] ;POINTER TO CR-LF
SOUT
POPJ P,
;OUTPUT STRING PLUS CR-LF TO CONTROLLING TTY
PSOUTR: MOVEI A,101 ;CONTROL TTY
JRST PSOUT2
; FORM TEXT STRING OF FORM "DATE1 TO DATE2"
GETPER: HRROI A,@2(Q) ;GET POINTER TO ARRAY
MOVE B,@0(Q) ;GET FIRST DATE
MOVX C,1B9 ;OMIT TIME FROM OUTPUT
ODTIM ;OUTPUT DATE AND TIME TO ARRAY
HRROI B,[ASCIZ/ TO /] ;GET POINTER TO INPUT STRING
SETZM C ;TERMINATE ON NULL
SOUT ;OUTPUT TEXT
MOVE B,@1(Q) ;GET SECOND DATE
MOVX C,1B9 ;OMIT TIME FROM OUTPUT
ODTIM ;OUTPUT DATE AND TIME
POPJ P, ;RETURN
; OUTPUT DATE AND TIME AND TWO SPACES
ODTIM2: CALL ODTIMZ ;OUTPUT DATE AND TIME
HRROI B,[ASCIZ/ /] ;GET TWO SPACES
SETZM C ;TERMINATE ON NULL
SOUT ;OUTPUT TWO SPACES
POPJ P, ;RETURN
; INPUT TIME AND RETURN # OF SECONDS
GETTIM: HRROI A,@0(Q) ;FORM POINTER TO STRING
MOVSI B,400000 ;DO NOT INPUT DATE
IDTNC ;INPUT TIME
JRST ERRIH ;ERROR
HRRZM D,@1(Q) ;RETURN SECONDS
POPJ P, ;RETURN
;OUTPUT DATE AND TIME ON OUTFIL
ODTIMZ: MOVE A,OUTFIL
MOVE B,@(Q) ;GET INTERNAL DATE
MOVSI C,1 ;DO NOT ADD FILLER
ODTIM
POPJ P,
;OUTPUT DATE AND TIME TO CONTROLLING TTY
ODTIMT: MOVEI A,101
MOVE B,@(Q)
SETZ C,
ODTIM
POPJ P,
;TRANSLATE DIR NO. TO STRING
DIRSTZ: MOVE B,@(Q)
HRLI B,USRLH ;USER LEFT HALF
HRRZ C,1(Q)
SETZM @1(Q) ;ZERO FIRST WORD
HRRO A,C
SETZ D, ;NUMBER OF CHARACTERS
DIRST
JRST CHAR
;COMPUTE NUMBER OF CHARACTERS
NCHAR: MOVSI B,-5 ;5 CHARS/WORD
MOVE E,(C)
NULLT: TLNN E,774000 ;TEST FOR LEFT NULL
JRST CHAR
ADDI D,1
LSH E,7
AOBJN B,NULLT
AOJA C,NCHAR
CHAR: MOVEM D,@2(Q)
POPJ P,
; STDIR2 - TRANSLATE STRING IN CORE TO USER NUMBER
STDIR2: MOVX A,RC%EMO ;EXACT MATCH ONLY
HRROI B,@0(Q) ;GET POINTER TO STRING
RCUSR
ERJMP STDR2X
TXNE A,RC%AMB!RC%NOM ;CHECK FOR MATCH
JRST STDR2X
HRRZM C,@1(Q) ;RETURN USER NUMBER
POPJ P, ;RETURN
STDR2X: SETOM @1(Q) ;FLAG AS NON-EX
POPJ P, ;RETURN
;TRANSLATE STRING TO USER NO.
STDIRZ: MOVEI A,101
RFCOC
ANDI C,177777 ;IGNORE OUTPUT FOR ALT MODE
SFCOC
MOVE F,[POINT 7,BUF,-1]
STA: PBIN ;INPUT CHARACTER FROM TTY
CAIN A,.CHCRT
JRST .-2
CAIE A,ALT
CAIN A,.CHLFD
JRST .+3
IDPB A,F ;STORE IN STRING
JRST STA
MOVE D,A ;TERMINATOR
SETZ A,
MOVE E,F
IDPB A,E ;NULL AT END
MOVX A,RC%EMO ;NO RECOGNITION
CAIN D,ALT
MOVEI A,0 ;RECOGNIZE
MOVE B,[POINT 7,BUF,-1]
RCUSR
ERJMP STER ;ERROR
TXNE A,RC%NOM ;NO - MATCH
JRST STER
TXNE A,RC%AMB ;AMBIGUOUS
JRST [ MOVEI A,7
PBOUT
JRST STA]
;ECHO REST AFTER ALT MODE
HRRZ E,C ;STORE DIR INFO
CAIE D,ALT
JRST STB
MOVE A,F
PSOUT
PBIN
CAIN A,.CHCRT
JRST .-2
CAIE A,.CHLFD ;CHECK FOR CR-LF AFTER RECOGNITION
JRST STER
STB: HRRZM E,@(Q)
LSH E,1
MOVEM E,@1(Q)
POPJ P,
STER: MOVE E,@2(Q)
HRRM E,(P) ;TRANSFER CONTROL TO DIRERR
POPJ P,
;USER NUMERIC OR ALPHANUMERIC
CATEG: MOVE B,@(Q)
HRLI B,USRLH
HRROI A,BUF
DIRST
JRST CATOUT ;USER NOT IN DIRECTORY
MOVX A,RC%EMO
HRROI B,BUF
RCUSR
ERJMP CATOUT
TXNE A,RC%AMB!RC%NOM
JRST CATOUT
TXNN A,RC%ANA
JRST CATOUT ;USER NUMERIC
MOVE B,@(Q) ;USER ALPHANUMERIC
TLO B,400000
MOVEM B,@(Q)
CATOUT: POPJ P,
BUF: BLOCK 10
;READ ALPHANUMERIC STRING
RALPH: HRROI A,@0(Q) ;GET DESTINATION POINTER
MOVEI B,^D39 ;MAX 39 CHARACTERS
SETZM C ;NO ^R BUFFER
RDTTY ;READ FROM TTY
JRST ERRIH ;ERROR
MOVEI D,^D37 ;GET MAX # OF CHARACTERS - 2
HRRZ B,B ;KEEP JUST CHARACTER COUNT
SUB D,B ;COMPUTE # OF CHARACTERS READ
MOVEM D,@1(Q) ;RETURN # OF CHARACTERS READ
BKJFN ;BACK UP DESTINATION POINTER
JRST ERRIH ;ERROR
MOVEI B,.CHNUL ;GET A NULL CHARACTER
DPB B,A ;OVERWRITE THE CARRIAGE RETURN
IBP A ;INCREMENT POINTER TO LINE FEED
DPB B,A ;OVERWRITE LINE FEED
POPJ P, ;RETURN
; CONVERT ALL-DIGIT ALPHANUMERIC ACCOUNTS TO NUMBERS
TSTNUM: SETOM @1(Q) ;ASSUME NON-NUMERIC ACCOUNT
HRRO A,0(Q) ;GET POINTER TO STRING
MOVEI C,^D10 ;GET DECIMAL RADIX
NIN ;TRY CONVERTING STRING TO NUMBER
POPJ P, ;CANNOT CONVERT, MUST NOT BE A NUMBER
LDB C,A ;GET TERMINATOR
JUMPN C,TSTN10 ;IF NOT NULL, TERMINATED BY ALPHANUMERIC
MOVEM B,@1(Q) ;SAVE NUMERIC ACCOUNT NUMBER
TSTN10: POPJ P, ;RETURN TO WHENCE WE CAME ...
;LOGICAL SHIFT
LSH: MOVE 0,@(Q)
MOVE A,@1(Q)
LSH 0,(A) ;ANSWER IN AC0
POPJ P,
;ROUND FLOATING POINT TO INTEGER
IFIXR: MOVM 0,@(Q) ;GET MAGNITUDE OF ARGUMENT
MULI 0,400 ;SEPARATE FRACTION AND EXPONENT
EXCH 0,A ;PUT PARTIAL RESULT IN AC0
LSHC 0,-243(A) ;USE EXPONENT AS INDEX REGISTER
CAIGE A,0 ;SIGNIFICANT BIT?
AOJ 0, ;YES, ADD 1
SKIPGE @(Q) ;SET THE
MOVNS 0,0 ;CORRECT SIGN
POPJ P,
END