Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C
C
C
C            COPYRIGHT (c) 1977 BY
C    DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS.
C   
C  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
C  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
C  INCLUSION OF THE  ABOVE COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY OTHER
C  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE  MADE AVAILABLE TO ANY
C  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
C  TRANSFERRED.
C 
C  THE INFORMATION IN THIS  SOFTWARE IS SUBJECT TO CHANGE  WITHOUT NOTICE
C  AND  SHOULD  NOT  BE  CONSTRUED AS A COMMITMENT BY  DIGITAL  EQUIPMENT
C  CORPORATION.
C 
C  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
C  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
C 
C 
C 
C
C
C
C
C
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-01             +
C   +                                                +
C   +  PETER BAUM  1-SEP-77                          +
C   +  DIGITAL EQUIPMENT CORPORATION                 +
C   +  146 MAIN STREET                               +
C   +  MAYNARD, MASSACHUSETTS  01754                 +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C
C *******************************************************
C *                                                     *
C *       SUBROUTINE   BASCNG                           *
C *                                                     *
C *******************************************************
C
C
C SUBROUTINE BASCNG IS CALLED WHEN THE *B CALC COMMAND IS
C ENCOUNTERED. THIS COMMAND INDICATES THAT THE DEFAULT BASE
C FOR CONSTANTS IS TO BE CHANGED. THE ROUTINE READS IN ONE
C OR TWO DIGITS AND CHANGES THE DEFAULT BASE SPECIFICATION
C AS IS APPROPRIATE.
C
C
C
C MODIFICATION CLASS M2
C
C
C
C
C   BASCNG CALLS
C
C  ERRMSG  (PRINTS ERROR MESSAGES)
C  GETNNB  (GETS THE NEXT NON-BLANK IN INPUT LINE LINE(80))
C
C
C
C
C  BASCNG IS CALLED BY ROUTINE CMND WHICH IDENTIFIES THE COMMAND THAT
C  THE USER WANTS TO EXECUTE.
C
C
C
C
C
C    VARIABLE       USE
C
C    BASED       HOLDS THE DEFAULT BASE.
C    IPT         POINTS TO THE NEXT NON-BLANK IN LINE(80).
C    I1          BINARY VALUE OF FIRST DIGIT, VALUE OF NEW BASE.
C    I2          BINARY VALUE OF SECOND DIGIT.
C    NONBLK      POINTS TO THE LAST NON-BLANK IN LINE(80)
C    RETCD       RETURN CODE: 1=O.K.  2=ERROR.
C    RETCD2      HOLDS RETURN CODE FROM CALL TO GETNNB
C
C
C
C
	SUBROUTINE BASCNG(RETCD)
C
C
C UPON ENTRANCE, NONBLK POINTS TO THE 'B' IN '*B' IN LINE
C
	INTEGER*2 IPT,I1,I2
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 RETCD,RETCD2,VIEWSW,BASED
C
	LOGICAL*1 DIGITS(16,3),LINE(80)
C
	COMMON /DIGV/ DIGITS
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
C
C
C
C
C IF NO ARGUMENT, RETURN WITH NORMAL RETURN CODE. THIS ALLOWS THE
C USER TO SEE WHAT THE PRESENT DEFAULT BASE IS.
	RETCD=1
	CALL GETNNB(IPT,RETCD2)
	IF(RETCD2.GT.1)GO TO 1000
C
C
C CHECK OUT FIRST DIGIT
	DO 300 I1=1,10
	IF(DIGITS(I1,1).EQ.LINE(IPT)) GO TO 400
300	CONTINUE
	GO TO 999
C
C
C SEE IF THERE IS A SECOND DIGIT
400	NONBLK=IPT
	IF(I1.EQ.10)I1=0
	CALL GETNNB(IPT,RETCD2)
	IF(RETCD2.EQ.1)GO TO 500
C
C
C IF NOT, CONVERT TO A TWO DIGIT NUMBER WITH A LEADING ZERO.
	I2=I1
	I1=0
	GO TO 700
C
C
C
C A SECOND CHARACTER WAS FOUND; FIGURE OUT WHAT THE BINARY
C VALUE IS (IF IT IS A DIGIT AT ALL).
500	DO 600 I2=1,10
	IF(DIGITS(I2,1).EQ.LINE(IPT))GO TO 700
600	CONTINUE
	GO TO 999
C
C
C
C CONVERT DIGITS TO A NUMBER IF IT IS LEGAL
700	IF(I2.EQ.10)I2=0
	I1=I1*10+I2
	IF(I1.NE.8.AND.I1.NE.10.AND.I1.NE.16) GO TO 999
	BASED=I1
	GO TO 1000
C
C
C ILLEGAL BASE SPECIFICATION
999	RETCD=2
	CALL ERRMSG(19)
C
C RETURN
1000	RETURN
	END