BLOCK DATA INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRW = 32 C PARAMETER RCL = 32 C PARAMETER RCP = 1024 C PARAMETER RCPM27 = 997 C RCP = RRW*RCL C RCPM27=RCP-27 C RRW=MAX REAL ROWS C RCL=MAX REAL COLS C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS C VBLS AND TYPE DIMENSIONED RRW,RCL C ++++++++++++++++++++++++++++++++++++++++++++++++++ C + + C + CALC VERSION X01-06 + 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 MODIFIED 18-MAY-1981 P.B. SET % TO VERSION 6 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 AVBLS(100,27) HOLDS THE VALUES OF THE 27 LEGAL VARIABLES.(ACCUMULATORS) C VBLS(8,RRW,RCL) HOLDS VALUES OF ALL 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 C BLOCK DATA INTEGER*2 LEVEL,NONBLK,LEND INTEGER*2 LASTOP INTEGER*2 ST1TYP(40),ST2TYP(40) INTEGER*2 TYPE(RRW,RCL) 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 AVBLS(100,27) LOGICAL*1 VBLS(8,RRW,RCL) LOGICAL*1 DTBL1(9,9,8) LOGICAL*1 DIGITS(16,3) C C OARRY WILL BE USED TO HOLD OUTPUT VARIABLE IF OSWIT IS NONZERO INTEGER*2 OSWIT C OCNTR MAY HOLD BYTES VALID IN OARRY (UP TO 100, NO MORE...) INTEGER*2 OCNTR LOGICAL*1 OARRY(100) C C ILINE IS PROGRAMMABLE LINE INPUT (I.E., NOT FROM CONSOLE) LOGICAL*1 ILINE(106) INTEGER*2 ILNFG INTEGER*2 ILNCT COMMON /ILN/ILNFG,ILNCT,ILINE C ILINE IS PRESENT IF ILNFG <> 0 AND ILNCT HAS # BYTES IN IT. COMMON /OAR/OSWIT,OCNTR,OARRY 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,AVBLS,VBLS,VLEN COMMON /DECIDE/ DTBL1 COMMON /DIGV/ DIGITS COMMON /ERROR/ LASTOP COMMON/ITERA/ ITCNTV LOGICAL*1 DVFMT(12) COMMON/DEFVBX/DVFMT C INITIAL DEFAULT FORMAT FOR NUMERICS DATA DVFMT/'(','F','9','.','2',6*32,')'/ C DATA VIEWSW/2/ DATA LEVEL/1/ DATA LASTOP/0/ DATA ITCNTV/6*0/ DATA OSWIT/0/,OCNTR/0/,ILNFG/0/,ILNCT/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,RCPM27*2/ C C C GIVE VERSION # BY VALUE IN % C DATA AVBLS(1,27)/6/ DATA AVBLS(2,27)/0/,AVBLS(3,27)/0/,AVBLS(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