PROCEDURE ,010003 ;+ ; Copyright (C) 1976 ; Digital Equipment Corporation, Maynard, Mass. ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the inclu- ; sion of the above copyright notice. This software, or any ; other copies thereof, may not be provided or otherwise made ; available to any other person except for use on such system ; and to one who agrees to these license terms. Title to and ; ownership of the software shall at all times remain in DEC. ; ; The information in this software is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation. ; ; DEC assumes no responsibility for the use or reliability of its ; software on equipment which is not supplied by DEC. ; ; Written: 08-Feb-80, -1.0.0-, ; ; Modified: 30-Sep-80, -1.0.1-, John D. Leonard ; Fixed to allow spacing characters in expressions ; ; Modified: 02-Sep-80, -1.0.2-, John D. Leonard ; Modified to allow line spacings to be expressed in fractional 1/8 ; line increments. ; ; Modified: 01-Jan-81, -1.0.3-, John D. Leonard ; To save R4, which can be destroyed by CCIN if footnote processing ; active. Then subsequent argument calls may be corrupted and cause ; fatal aborting. ;- DATA RNEXPD ; ; temporary data buffer for symbol table parsing. ; BUFFER: .ASCII " " ; temporary storage for symbol name ; CODE RNEXP ;+ ; rcnr--relative decimal conversion routine ; ; inputs: ; ; r3=base value to be augmented. ; ; outputs: ; ; nonskip return if no number is present. ; ; skip return with r3 updated to new value. ;- RCNR:: MOV R4,-(SP) ; and R4, just in case MOV R3,-(SP) ; save work registers 10$: CALL CCIN ; get next character BITB #CHASP,CHATBL(R1) ; is it a spacing character? BNE 10$ ; yes - ignore it. CLR -(SP) ; reserve room for sign flag BITB #CHASI,CHATBL(R1) ; is this a sign character? BEQ 20$ ; no - skip. INC (SP) ; yes - flag as signed number. 20$: CALL RCNX ; convert decimal number JMP 40$ ; nonskip return if null TST (SP) ; is this a signed quantity? BEQ 30$ ; no ADD 2(SP),R3 ; augment base value 30$: ADD #4,6(SP) ; set skip return MOV R3,2(SP) ; Set returned R3 40$: TST (SP)+ ; Pop sign flag MOV (SP)+,R3 ; Get returned value MOV (SP)+,R4 ; Restore R4 RETURN ; return to caller .SBTTL READ SIGNED DECIMAL NUMBER ; ; read signed decimal number for command decoder ; non-skip return if none found ; RCNO:: 5$: CALL CCIN ; read character from command line BITB #CHASP,CHATBL(R1) ; is it a spacing character (blank or tab)? BNE 5$ ; yes -- loop. RCNX: CLR R3 ; clear result BITNEB #CHAEC,CHATBL(R1),RCN1 ; end of command? CMPEQ R1,#CMA,RCN2 ; leading ,? CALL PLUS ; compute value of expression. CMPNE R1,#CMA,10$ ; skip if the character is not a , CALL CCIN ; if stopped on a ',', get a char ; the idea of this is that in case ; we get called again, we don't ; want to find the same comma again ; and report no argument!!! 10$: ADD #4,(SP) ; set skip return. RCN1: MOVB R1,GCSCH ; store break character. RCN2: RETURN ; and return. ; ; internal subroutine to read in a term of values composed ; of + and - operations. ; PLUS: CLR -(SP) ; clear the result register. MOV #'+,-(SP) ; save the current operation type. 10$: CALL MULT ; parse a term. CMP (SP),#'- ; is it to add in the argument? BNE 20$ ; yes -- add it in. NEG R3 ; subtract the new quantity. 20$: ADD R3,2(SP) ; add the new quantity. 30$: MOV R1,(SP) ; save the operation (if any) CMPEQ R1,#'+,40$ ; loop on + operation. CMPNE R1,#'-,90$ ; or on - operation. 40$: CALL CCIN ; consume operator .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),40$ ; Loop if spacing character .ENDC BR 10$ ; and loop 90$: MOV (SP)+,R3 ; discard the unneeded flag word. MOV (SP)+,R3 ; recover the current value. RETURN ; and return to the caller. ; ; internal subroutine to parse a term of items multiplied or ; divided together. ; MULT: MOV #1,-(SP) ; clear the result register. .IF DF A$$RAP TSTEQ $MFAC,5$ ; Line spacing factor ? MOV #DIVPL,(SP) ; Use # of divisions per line 5$: .ENDC MOV #'*,-(SP) ; save the current operation type. 10$: CALL FACT ; get a single factor CMP (SP),#'* ; is it to multiply the argument? BNE 20$ ; no - divide the argument. .IF NDF R$$EIS ; if not on an eis machine ... MOV R0,-(SP) ; save registers 0 and 1 MOV R1,-(SP) ; ... MOV 6(SP),R0 ; get the multiplier. MOV R3,R1 ; and the multiplicand. CALL $MUL ; do the multiplication. MOV R1,R3 ; put result back in r3 MOV (SP)+,R1 ; recover r1 MOV (SP)+,R0 ; and r0 .IFF ; otherwise, on an eis machine ... MUL 2(SP),R3 ; do the multiply directly. .IF DF A$$RAP TSTEQ $MFAC,15$ ; No line spacing factor ? ASH #DIV8,R3 ; divide by factor 15$: .ENDC .ENDC ;r$$eis ; end of eis conditional code BR 30$ ; skip divide code 20$: .IF NDF R$$EIS ; if not on an eis machine ... MOV R0,-(SP) ; save registers 0 and 1 MOV R1,-(SP) ; ... MOV 6(SP),R0 ; get dividend. MOV R3,R1 ; get divisor. CALL $DIV ; do the divide the hard way. MOV R0,R3 ; put the result back in r3 MOV (SP)+,R1 ; recover r1 MOV (SP)+,R0 ; and r0 .IFF ; otherwise, on an eis machine ... MOV R2,-(SP) ; save r2 MOV R1,-(SP) ; save r1 MOV R3,R1 ; save the divisor MOV 6(SP),R3 ; recover dividend. .IF DF A$$RAP TSTEQ $MFAC,25$ ; No line spacing factor ? ASH #MUL8,R3 ; Multiply dividend by factor 25$: .ENDC CLR R2 ; clear out the high order. DIV R1,R2 ; divide out the number. MOV R2,R3 ; put result back in r3 MOV (SP)+,R1 ; recover r1 MOV (SP)+,R2 ; and r2 .ENDC ;r$$eis ; end of conditional eis code 30$: MOV R3,2(SP) ; save result. MOV R1,(SP) ; save operator CMPEQ R1,#'*,40$ ; loop on * operation CMPNE R1,#'/,90$ ; loop on / operation 40$: CALL CCIN ; consume operator .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),40$ ; Loop if spacing character .ENDC BR 10$ ; and loop 90$: MOV (SP)+,R3 ; discard the unneeded flag word MOV (SP)+,R3 ; recover current value RETURN ; and return to the caller. ; ; Internal subroutine to read in an element conposed of ; numerics or a symbol. If the element begins with a digit, it ; is taken as a number; if it begins with an alphabetic it is ; taken as a symbol. In addition, it reads the characters at ; the beginning of the factor and if there are an odd number ; of - signs, will negate the result. This allows expressions ; of the form x+--1 for example (if anyone really wants them!) ; FACT: CLR -(SP) ; Set the +/- indicator to + 1$: CMPEQ R1,#'+,2$ ; Ignore leading plus CMPNE R1,#'-,5$ ; Skip if not minus COM (SP) ; Indicate leading minus 2$: CALL CCIN ; Consume a character. .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),2$ ; Loop if spacing character .ENDC BR 1$ ; And process any more lying around. 5$: CLR R3 ; Clear result in case of errors. CMPNE R1,#'(,9$ ; Skip if not a ( - start of factor 6$: CALL CCIN ; Get the next character. .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),6$ ; Loop if spacing character .ENDC CALL PLUS ; Parse the factor. CMPNE R1,#'),7$ ; Skip if not legally terminated. 61$: CALL CCIN ; Yes -- skip past it. .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),61$ ; Loop if spacing character .ENDC 7$: BR 90$ ; And return whatever we got. 9$: BITB #CHANU,CHATBL(R1) ; Is it a digit? BEQ 20$ ; No. 10$: BITB #CHANU,CHATBL(R1) ; Is it still numeric? BEQ 90$ ; No -- end of number. ASL R3 ; Multiply by 10. MOV R3,-(SP) ; ... ASL R3 ; ... ASL R3 ; ... ADD (SP)+,R3 ; ... SUB #'0,R1 ; Convert R1 to a binary digit. ADD R1,R3 ; Add it into the value. 15$: CALL CCIN ; Get the next character. .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),15$ ; Loop if spacing character .ENDC BR 10$ ; And loop. 20$: CLR R3 ; Assume GETSYM will fail. CALL GETSYM ; Get a symbol - return CS if ; not a legal symbol. BCS 90$ ; Just return if not a legal symbol. MOV R1,-(SP) ; Save the character. MOV R0,-(SP) ; Save R0 MOV #BUFFER,R1 ; Point to the buffer. CALL RETINT ; Retrieve an integer value. MOV R0,R3 ; Move it into result register. MOV (SP)+,R0 ; Recover R0 MOV (SP)+,R1 ; Retrieve the character. 90$: .IF DF A$$RAP TSTEQ $MFAC,92$ ; No line spacing factor ? ASH #MUL8,R3 ; Multiply by factor 92$: .ENDC TST (SP)+ ; Is there a - on the stack? BGE 95$ ; No - just return. NEG R3 ; Negate the returned value. 95$: RETURN ; And return. ; ; Internal subroutine to retrieve a symbol name. If the ; first character is not a valid character for a symbol to ; begin with, it returns with CC-C set. It stops scanning ; when it finds a character which is not valid for a symbol, ; and if it is not the first character returns with CC-C ; cleared. ; GETSYM: BITB #CHAUC!CHALC,CHATBL(R1) ; Is it alphabetic? BEQ 90$ ; No -- just leave. BITB #CHALC,CHATBL(R1) ; Is it lower case? BEQ 30$ ; No -- continue normally. BIC #40,R1 ; Make it upper case. 30$: MOV #BUFFER,R3 ; Point to temporary buffer. MOV #6.,-(SP) ; Save maximum size. 40$: DEC (SP) ; Decrement count of buffer size. BLT 41$ ; Skip if no more room in buffer. MOVB R1,(R3)+ ; Output the character. 41$: CALL CCIN ; Get the next character. .IF DF A$$RAP BITNEB #CHASP,CHATBL(R1),41$ ; Loop if spacing character .ENDC BITB #CHALC!CHAUC!CHANU,CHATBL(R1) ; Is it alphanumeric? BEQ 50$ ; No -- just leave. BITB #CHALC,CHATBL(R1) ; Is it lower case? BEQ 45$ ; No -- next character. BIC #40,R1 ; Map lower case to upper case. 45$: BR 40$ ; And loop until terminator found. 50$: CLRB (R3)+ ; Make an extra byte of padding. TST (SP)+ ; Clear junk RETURN ; And return with CC-C clear. 90$: SEC ; Show error. RETURN ; And return to the user. .SBTTL DECPRT -- DECIMAL PRINT ROUTINE DECPRT:: .IF NDF R$$EIS ; if no eis, use $div MOV #12,R1 ; standard decimal print routine CALL $DIV ; divide .IFF ; otherwise, use div MOV R0,R1 ; get number into low order CLR R0 ; clear high order. DIV #12,R0 ; divide by 10. .ENDC ; r$$eis MOV R1,-(SP) TSTEQ R0,10$ ; no more digits to convert? CALL DECPRT ; no 10$: MOV (SP)+,R1 ; get a digit ADD #'0,R1 ; make ascii digit JMP FOUT ; output to file. .SBTTL DECPR -- TOC OUTPUT ROUTINE DECPR:: .IF NDF R$$EIS ; if no eis, use $div MOV #12,R1 ; standard decimal print routine CALL $DIV ; divide .IFF ; otherwise, use div MOV R0,R1 ; move into low order of pair CLR R0 ; clear high order DIV #12,R0 ; divide by 10. .ENDC ; r$$eis MOV R1,-(SP) ; TSTEQ R0,1$ ; any left to divide ? CALL DECPR ; no 1$: MOV (SP)+,R1 ; get the digit ADD #60,R1 ; make ascii digit JMP TFOUT ; output to file .END