Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0001/block.for
There are 3 other files named block.for in the archive. Click here to see a list.
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 * BLOCK DATA MODULE *
C * *
C *******************************************************
C
C
C COMMON AREAS ARE INITIALIZED BY THIS MODULE.
C
C
C
C MODIFICATION CLASSES: M2,M3,M9,M10
C
C
C
C
C VARIABLE USE
C
C ALPHA(27) HOLDS LEGAL VARIABLE NAMES: ALPHABETIC CHARACTERS
C OR THE CHARACTER %.
C BASED HOLDS DEFAULT BASE.
C BLANK ' '
C COMMA ','
C DIGITS(16,3) HOLDS DECIMAL, OCTAL, AND HEXADECIMAL DIGITS. THE
C SECOND SUBSCRIPT IS
C 1 FOR DECIMAL
C 2 FOR OCTAL
C 3 FOR HEXADECIMAL
C DTBL1(9,9,8) CONTROLS THE DECISION PROCESS WHEN EVALUATING A
C BINARY OPERATION. SEE BELOW FOR DETAILS.
C EQ '='
C ITCNTV(6) INDEXED BY LEVEL. 0 INDICATES THAT NO ITERATION ON THE
C INDIRECT COMMAND FILE IS TO TAKE PLACE. IF POSITIVE, IT
C HOLDS THE INDEX INTO VBLS AND REPRESENTS THE VARIABLE
C USED TO CONTROL ITERATION.
C LINE(80) COMMAND INPUT LINE
C LPAR '('
C RPAR ')'
C ST1LIM HOLDS THE SIZE OF STACK 1 (ALWAYS CONSTANT)
C ST2LIM HOLDS THE SIZE OF STACK 2 (ALWAYS CONSTANT)
C ST1PT POINTS TO THE TOP OF STACK 1 (CHANGES AS STACK IS USED)
C ST2PT POINTS TO THE TOP OF STACK 2 (CHANGES AS STACK IS USED)
C ST1TYP(40) DATA TYPE FOR EACH ELEMENT IN STACK 1
C ST2TYP(40) DATA TYPE FOR EACH ELEMENT IN STACK 2
C STACK1(100,40) UTILITY STACKS USED WHEN EVALUATING EXPRESSIONS. THE FIRST
C STACK2(100,40) SUBSCRIPT CONTROLS INDEXING ACROSS THE BYTES OF A SINGLE
C VARIABLE. THE SECOND SUBSCRIPT CONTROLS STACK ELEMENTS.
C TYPE(27) HOLDS THE DATA TYPES FOR EACH OF THE 27 VARIABLES. SEE
C CODES.FTN FOR THE POSSIBLE VALUES.
C VIEWSW VIEW SWITCH
C 0 = OUTPUT ERROR MESSAGES
C 1 = OUTPUT ERROR MESSAGES AND FILE COMMAND LINES
C 2 = OUTPUT ERROR MESSAGES AND VALUE OF EXPRESSIONS
C EVALUATED.
C 3 = OUTPUT EVERYTHING
C VLEN(9) INDEXED BY DATA TYPE. GIVES THE NUMBER OF BYTES USED
C BY THAT DATA TYPE.
C VBLS(100,27) HOLDS THE VALUES OF THE 27 LEGAL VARIABLES.
C
C
C
C CONSTANTS ARE STORED IN VBLS ACCORDING TO THEIR TYPE:
C
C
C
C <----------- MULTIPLE PRECISION (M10, M8, M16) ------------------------->
C ! <------------- DECIMAL AND REAL --------------->
C ! ! <-- INTEGER HEX OCTAL -->
C ! ! ---> ASCII <---
C ! ! ! !
C
C ------------- -------------------------------------------------------
C ! ! ! ! ! ! ! ! ! ! ! ! !
C ! 100 ! 99 ! ... ! 9 ! 8 ! 7 ! 6 ! 5 ! 4 ! 3 ! 2 ! 1 !
C ! ! ! ! ! ! ! ! ! ! ! ! !
C ------------- -------------------------------------------------------
C
C
C NOTE: BYTE 100 HOLDS THE SIGN FOR MULTIPLE PRECISION NUMBERS.
C 0 = POSITIVE, 1 = NEGATIVE
C
C
C
C
C
BLOCK DATA
INTEGER*2 LEVEL,NONBLK,LEND
INTEGER*2 LASTOP
INTEGER*2 TYPE(27),ST1TYP(40),ST2TYP(40)
INTEGER*2 VIEWSW,BASED,VLEN(9)
INTEGER*2 ST1LIM,ST2LIM,ST1PT,ST2PT
INTEGER*2 ITCNTV(6)
C
LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ,LINE(80)
LOGICAL*1 STACK1(100,40),STACK2(100,40)
LOGICAL*1 VBLS(100,27)
LOGICAL*1 DTBL1(9,9,8)
LOGICAL*1 DIGITS(16,3)
C
COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
COMMON /STACK/ STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
; ST1LIM,ST2LIM
COMMON /V/ TYPE,VBLS,VLEN
COMMON /DECIDE/ DTBL1
COMMON /DIGV/ DIGITS
COMMON /ERROR/ LASTOP
COMMON/ITERA/ ITCNTV
C
DATA VIEWSW/3/
DATA LEVEL/1/
DATA LASTOP/0/
DATA ITCNTV/6*0/
DATA ALPHA/'A','B','C','D','E','F','G','H','I','J','K','L','M',
; 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','%'/
DATA DIGITS/'1','2','3','4','5','6','7','8','9',7*'0',
; '1','2','3','4','5','6','7',9*'0',
; '1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','0'/
DATA COMMA/','/, BLANK/' '/,RPAR/')'/,LPAR/'('/,EQ/'='/
C
C
C DEFAULT BASE IS 10
DATA BASED/10/
C
C
C STACKS ARE CURRENTLY SET AT 40 ELEMENTS DEEP
DATA ST1LIM/40/, ST2LIM/40/
C
C
C
C DEFAULT TYPES
C A,B,C,D,E,F,G,H = DECIMAL
C I,J,K,L,M,N = INTEGER (BASE10)
C O,P,Q,R,S,T,U,V,W,X,Y,Z = DECIMAL
C
C % AS INTEGER TO HOLD CALC VERSION NUMBER
C
DATA TYPE/8*-2,6*-4,12*-2,4/
C
C
C GIVE VERSION # BY VALUE IN %
C
DATA VBLS(1,27)/3/
DATA VBLS(2,27)/0/,VBLS(3,27)/0/,VBLS(4,27)/0/
C
C
C
C
C SPECIFY THE LENGTH USED BY EACH DATA TYPE
DATA VLEN/1,8,4,4,100,100,100,4,8/
C
C
C
C
C
C
C
C
C DECISION TABLE FOR PERFORMING BINARY OPERATIONS
C
C DTBL1(OPERAND2,OPERAND1,INDEX)
C
C WHERE: OPERATOR:
C INDEX=1 MODIFY CODE FOR OPERAND 1 */+-
C 2 MODIFY CODE FOR OPERAND 2 */+-
C 3 FUNCTION VALUE TYPE */+-
C 4 OPERATOR CLASS */+-
C
C 5 MODIFY CODE FOR OPERAND 1 **
C 6 MODIFY CODE FOR OPERAND 2 **
C 7 FUNCTION VALUE TYPE **
C 8 OPERATOR CLASS **
C
C
C WHERE TYPE CODES (MODIFY CODES) ARE:
C 0 NO CHANGE
C 1 CONVERT TO ASCII
C 2 CONVERT TO DECIMAL
C 3 CONVERT TO HEXADECIMAL
C 4 CONVERT TO INTEGER
C 5 CONVERT TO M10
C 6 CONVERT TO M8
C 7 CONVERT TO M16
C 8 CONVERT TO OCTAL
C 9 CONVERT TO REAL
C
C FOR */+- FUNCTION VALUE TYPES AND OPERATOR CLASS ARE PRESENTLY
C IDENTICAL
C
C FOR ** OPERATOR CLASSES FOLLOW:
C
C CODE OPERATOR CLASS
C 1 REAL**REAL
C 2 REAL**INTEGER
C 3 INTEGER**REAL
C 4 INTEGER**REAL
C 5 M8**INTEGER
C 6 M10**INTEGER
C 7 M16**INTEGER
C
C
C
C
C
C
DATA DTBL1 /4,2,3,4,5,6,7,8,9,
; 9*0,
; 0,2,0,0,3*7,0,9,
; 0,2,0,0,5,5,7,0,9,
; 0,2,7,0,0,0,7,0,9,
; 0,2,7,5,5,0,7,0,9,
; 0,2,6*0,9,
; 0,2,3,0,5,6,7,0,9,
; 0,2,7*0,
; 4,8*0,
; 2,0,6*2,0,
; 3,3*0,7,7,3*0,
; 4,4*0,5,3*0,
; 5,0,7,5,0,5,0,5,0,
; 6,0,7,5,3*0,6,0,
; 7,2,4*7,0,7,0,
; 8,8*0,
; 9,0,6*9,0,
; 4,2,3,4,5,6,7,8,9,
; 9*2,
; 3,2,3,3,3*7,3,9,
; 4,2,3,4,5,5,7,4,9,
; 5,2,7,3*5,7,5,9,
; 6,2,7,5,5,6,7,6,9,
; 7,2,6*7,9,
; 8,2,3,4,5,6,7,8,9,
; 9,2,7*9,
; 4,2,3,4,5,6,7,8,9,
; 9*2,
; 3,2,3,3,3*7,3,9,
; 4,2,3,4,5,5,7,4,9,
; 5,2,7,5,5,5,7,5,9,
; 6,2,7,5,5,6,7,6,9,
; 7,2,6*7,9,
; 8,2,3,4,5,6,7,8,9,
; 9,2,7*9,
; 4,2,3,6*4,
; 9*0,
; 9*0,
; 9*0,
; 0,9,6*0,9,
; 0,9,6*0,9,
; 0,9,6*0,9,
; 9*0,
; 9*0,
; 4,3*0,3*9,4,0,
; 4,3*0,3*9,0,0,
; 4,3*0,3*9,2*0,
; 4,3*0,3*9,2*0,
; 4,3*0,3*4,2*0,
; 4,3*0,3*4,2*0,
; 4,3*0,3*4,2*0,
; 4,3*0,3*9,2*0,
; 4,3*0,3*9,2*0,
; 4,2,3,6*4,
; 9*2,
; 9*3,
; 9*4,
; 5,9,6*5,9,
; 6,9,6,6,5,6,7,6,9,
; 7,9,6*7,9,
; 9*8,
; 9*9,
; 4,1,4,4,3,3,3,4,3,
; 2,1,2,2,3*1,2,1,
; 4,3,4,4,3*3,4,3,
; 4,3,4,4,3*3,4,3,
; 6,1,6*6,1,
; 5,1,6*5,1,
; 7,1,6*7,1,
; 4,3,4,4,3*3,4,3,
; 2,1,2,2,3*1,2,1/
END