%BEGIN ! ! DDDD EEEEEE BBBB BBBB II EEEEEE ! DD DD EE BB BB BB BB II EE ! DD DD EE BB BB BB BB II EE ! DD DD EEEEEE BBBB BBBB II EEEEEE ! DD DD EE BB BB BB BB II EE ! DD DD EE BB BB BB BB II EE ! DDDD EEEEEE BBBB BBBB II EEEEEE ! ! De EdinBurgh Basic IntErpreter ! _ _ _ _ _ _ !*************************************************************** !*************************************************************** !** ** !** WILLIAM ALAN PATERSON ** !** ** !** COMPUTER SCIENCE 4 1974/75 ** !** ** !*************************************************************** !*************************************************************** %EXTRINSICSTRING(15) IFILE,OFILE %EXTRINSICINTEGER STREAM %EXTERNALROUTINESPEC SETMARGINS(%INTEGER A,B,C) %EXTERNALROUTINESPEC MULT MATRIX(%LONGREALARRAYNAMEC A,B,C,%INTEGER N,P,M) %EXTERNALINTEGERFNSPEC TESTINT(%INTEGER C%STRING(15) S) %EXTERNALROUTINESPEC INVERT(%LONGREALARRAYNAME A,B %INTEGER N%C %LONGREALNAME DET) %EXTERNALLONGREALFNSPEC RANDOM(%INTEGERNAME I,%INTEGER K) %EXTERNALROUTINESPEC PROMPT(%STRING(17) S) %BYTEINTEGER NSYM,FLT,DUMPFL,RUNFLAG %INTEGER I,J,D1,D2,LLPT %INTEGER FAULTS; ! COUNT OF SYNTAX & COMPILE FAULTS %INTEGER ASL; ! AVAILABLE SPACE LIST %INTEGER NLINES; ! NO. OF LINES OF 'BASIC' PROGRAM %INTEGER TDIG; ! DIGIT COUNT %INTEGER LINEPT; ! POINTER INTO INPUT BUFFER 'LINE' %INTEGER LNUM; ! LINE NUMBER OF CURRENT LINE %INTEGER ANALRECPT; ! POINTER TO NEXT FREE SPACE IN 'ANALREC' %INTEGER LLNUM; ! LINE NUMBER OF HIGHEST LINE ENTERED %INTEGER DATPT2; ! POINTER TO THE TOP OF THE 'DATA' BLOCK %INTEGER ARRPT; ! POINTER TO FREE SPACE IN 'ARRSPACE' %INTEGER LINEL; ! LENGTH OF CURRENT OUTPUT LINE %BYTEINTEGERARRAY LINE(1:80); ! INPUT BUFFER %INTEGERARRAY ANALREC(0:2100); ! STORES INTERNAL FORM OF THE 'BASIC' PROGRAM %REALARRAY ARRSPACE(-1:2000); ! HOLDS THE VALUES OF THE 'BASIC' VARIABLES %REALARRAY DATARR(1:1280); ! THE 'DATA' BLOCK %SHORTINTEGERARRAY FNLIST('A':'Z'); ! POINTERS TO FN BODIES %SHORTINTEGERARRAY ONLIST(1:50); ! HOLDS LINE-CELL NOS. FOR 'ON' STATEMENTS %RECORDFORMAT RF1(%REAL STEP,FINAL,%INTEGER LABEL,VAR) %RECORDFORMAT RF2(%INTEGER PTR,DATA,LINK) %RECORDARRAY LC(0:255) (RF2); ! 'LINE CELLS' %RECORDNAME CELL (RF2) %RECORDFORMAT RF3(%INTEGER DESC,ADDR,D1,D2) %RECORDARRAY VT(0:285) (RF3); ! VARIABLE DESCRIPTORS %CONSTBYTEINTEGER CR=10; ! LINE TERMINATION SYMBOL %CONSTBYTEINTEGERARRAY OPR(1:5)='+','-','*','/','^'; ! ARITHMETIC OPERATORS %CONSTBYTEINTEGERARRAY PREC(0:9)=0,4(3),1,1,2,2,3,1; ! OPERATOR PRECEDENCES %CONSTSTRING(3)%ARRAY MATF(4:8)='INV','IDN','ZER','CON','TRN';! MATRIX FUNCTIONS %CONSTSTRING(3)%ARRAY FNN(1:11)='INT','RND','SIN','COS', 'TAN','ATN','EXP','LOG','ABS','SQR','SGN'; ! 'LIBRARY' FUNCTIONS %CONSTSTRING(7)%ARRAY INAME(1:19)='LET','READ','DATA','PRINT', 'GOTO','IF','MAT','FOR','NEXT','DIM','END','GOSUB','RETURN', 'INPUT','STOP','REM','ON','RESTORE','DEF FN'; ! INSTRUCTION NAMES %CONSTSTRING(2)%ARRAY REL(1:6)='<','<=','>','>=','=','#'; ! RELATIONAL OPERATORS %ROUTINESPEC PRINT SYNTAX %ROUTINESPEC PVARN(%INTEGER VAR) %ROUTINESPEC PRINT(%REAL X) %ROUTINESPEC RITE(%INTEGER I) %INTEGERFNSPEC LENTH(%INTEGER I) %ROUTINESPEC PHOLT(%INTEGER I) %ROUTINESPEC WRITE(%INTEGER I) %ROUTINESPEC RUNFOLT(%INTEGER I) %ROUTINESPEC GETSIM %FAULT 9->F9,1->F1,2,21,22,23,27->F2,24->F24 ! ! THE 'BASIC' PROGRAM IS HELD IN AN INTERNAL FORM IN ARRAY 'ANALREC'. ! THE LINES ARE TRANSLATED AND ENTERED INTO THIS ARRAY IN THE ORDER ! IN WHICH THEY ARE TYPED.THE SEQUENCING OF THESE LINES IS DONE BY ! HAVING A LIST OF POINTERS TO THE START OF THE LINES.THUS A ! 'LINE CELL' IS A POINTER INTO ARRAY LC ! LC_PTR IS THE POINTER TO THE START OF THE LINES DESCRIPTION ! IN 'ANALREC'.LC_LINK IS THE POINTER TO THE NEXT LINE CELL,AND LC_DATA ! INITIALLY HOLDS A 1 IF THE LINE IS SYNTACTICALLY INCORRECT. ! ! ! ! %ROUTINE GETSYM !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! AS GETSIM BUT SPACES ARE NOT SIGNIFICANT & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE GETSIM %UNTIL NSYM#' ' %END ! ! ! %ROUTINE GETSIM !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! SETS NSYM TO THE NEXT SIGNIFICANT CHARACTER,STOPPING & ! AT THE END OF THE CURRENT LINE & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %RETURNIF NSYM=CR; ! STOP ON A NEWLINE LINEPT=LINEPT+1 ; NSYM=LINE(LINEPT) %END ! ! ! %ROUTINE READLINE !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! READS THE NEXT LINE FROM THE CONSOLE INTO THE BUFFER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,J %UNTIL NSYM#CR %CYCLE; ! IGNORE BLANK LINES J=0 %UNTIL I=CR %CYCLE READSYMBOL(I) !******************************************** ! IF THERE ARE MORE THAN 80 CHARACTERS * ! IGNORE THE SURPLUS * !******************************************** J = J+1 ; %IF J<80 %THEN LINE(J) = I %REPEAT NSYM=0 ; LINEPT=0 ; GETSYM; ! PRIME NSYM %REPEAT %END ! ! ! %INTEGERFN ANALINST(%INTEGER TYPE) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! ATTEMPTS TO RECOGNIZE A VALID KEYWORD ON THE INPUT STREAM & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %OWNSHORTINTEGERARRAY CHAR(100:268)=%C 0,'A',106,'T','A',3,'I',110,'M',10, 'E','F','F','N',19,'O','R',8,'O','T', 123,'O',5,'S','U','B',12,'F',130,6, 'N','P','U','T',14,'E','T',1,'E','X', 'T',9,'N','D',11,'R',151,'I','N','T', 4,'V','A','L',0,'E',185,'A',161,'D', 2,'M',164,16,'T',170,'U','R','N',13, 'S','T','O','R','E',18,'T','O','P',15, 'N',17,'A','T',7,'V','A','L',0,'R', 'E','A','K',3,'I','S','T',2,'U',255, 'N',1,'O','N','T','I','N','U','E',4, 'U','M','P',4,'O','D','U','M','P',5, 'R','A','C','E',6,'H',230,'E','N',1, 'O',2,'T','E','P',3,'T',265,'O','P',8, 'N','B',249,'R','E','A','K',7,'T','R', 'A','C','E',9,'E','S','E','Q','U','E', 'N','C','E',10,'A','V','E',11 !********************************************** ! INSTRUCTIONS * !********************************************** %OWNBYTEINTEGERARRAY KEY1('A':'Z')=100(3),101,142,115,118, 100,127,100(2),135,182,138,180,145,100,155,176,100(7) !********************************************** ! COMMANDS * !********************************************** %OWNBYTEINTEGERARRAY KEY2('A':'Z')=100,189,100,210,100(7), 194,100,214,100(3),198,236,219,241,100(5) !********************************************** ! ASSORTED KEYWORDS * !********************************************** %OWNBYTEINTEGERARRAY KEY3('A':'Z')=100(2),202,100(15),232,225,100(6) %INTEGER I %RESULT=0 %UNLESS 'A'<=NSYM<='Z' !********************************************* ! INDEX INTO 'CHAR' ACCORDING TO * ! 'TYPE' * !********************************************* %IF TYPE=1 %START I = KEY1(NSYM) LLPT = LINEPT; ! SAVE START POINTER %FINISHELSESTART %IF TYPE=2 %THEN I = KEY2(NSYM) %ELSE I = KEY3(NSYM) %FINISH GETSYM %CYCLE %IF NSYM#CHAR(I) %START; ! SYMBOLS DO NOT MATCH !********************************************* ! AN ENTRY >100 MEANS THAT THERE IS * ! ALTERNATIVE, OTHERWISE FAIL * !********************************************* I = CHAR(I+1); ! LOOK FOR AN ALTERNATIVE %RESULT=-1 %IF I<100; ! NONE -> FAIL %FINISHELSESTART; ! SYMBOLS MATCH I=I+1 ; GETSYM; ! SKIP TO NEXT CHAR. I=I+1 %IF CHAR(I)>100; ! SKIP ALTERNATIVE PTR. %RESULT=CHAR(I) %IF CHAR(I)<'A'; ! FOUND A WORD %FINISH %REPEAT %END ! ! ! %INTEGERFN READ(%INTEGERNAME I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! READS AN INTEGER FROM THE CURRENT LINE & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER S %IF NSYM='-' %THEN S=-1 %AND GETSYM %ELSE S=1; ! S = SIGN %RESULT=1 %UNLESS '0'<=NSYM<='9'; ! SYMBOL IN DATA I=NSYM-'0' ; GETSYM ; TDIG = 1 %WHILE'0'<=NSYM<='9' %CYCLE; ! BUILD UP THE VALUE %IF TDIG=9 %START; ! CHECK DIGIT COUNT PRINTSTRING('INVALID CONSTANT') ; NEWLINE; ! TOO MANY DIGITS %RESULT=1 %FINISH TDIG = TDIG+1; ! INCREMENT DIGIT COUNT I=I*10+NSYM-'0' GETSYM %REPEAT I = -I %IF S<0; ! INTRODUCE SIGN %RESULT=0 %END ! ! ! %INTEGERFN READR(%REALNAME R) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! READS A FLOATING POINT NUMBER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER J,K,NDIG,S %IF NSYM='-' %THEN S = -1 %AND GETSYM %ELSE S = 1; ! S = SIGN R = 0.0 ; K = 0 ; NDIG=0 ->FRAC %IF NSYM='.'; ! NUMBER OF THE FORM '.NNN' %RESULT=1 %IF READ(J)>0; ! READ INTEGRAL PART NDIG = TDIG; ! LENGTH OF INTEGRAL PART R = J; ! CONVERT TO FLOATING POINT %IF NSYM='.' %START; ! READ FRACTIONAL PART FRAC: GETSYM; ! SKIP THE '.' %WHILE NSYM='0' %CYCLE K = K+1 ; GETSYM; ! COUNT LEADING ZEROS %REPEAT NDIG = NDIG+K %IF NDIG>9 %START; ! CHECK LENGTH INVALID: PRINTSTRING('INVALID CONSTANT ') ; NEWLINE ; %RESULT=1 %FINISH %IF READ(J)=0 %AND J#0 %START; ! NON-ZERO FRACTIONAL PART ->INVALID %IF NDIG+TDIG>9; ! CHECK LENGTH R = R+J/10**(LENTH(J)-1+K); ! ADD FRACTIONAL TO INTEGRAL PART %FINISH %FINISH %IF NSYM='E' %START; ! EXPONENTIAL FORM GETSYM; ! SKIP 'E' %RESULT=1%IF READ(J)>0; ! READ EXPONENT R=R*10**J; ! EXPONENTIATE %FINISH R = -R %IF S<0 %RESULT=0 %END ! ! ! %INTEGERFN ISINT(%REAL X) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! CHECKS A DECIMAL NUMBER TO SEE IF IT IS & ! SUFFICIENTLY CLOSE TO AN INTEGER TO BE TREATED & ! AS SUCH & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %RESULT=1 %IF!X-INT(X)!<0.000001 %RESULT=0 %END ! ! ! %ROUTINE PHOLT(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! SEMANTIC FAULTS & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %OWNSTRING(20)%ARRAY F(1:12)='BOTH LIST AND TABLE', 'TOO MUCH DATA','NO END INSTR','UNDEFINED LINE NO', 'VAR ALREADY USED','NO MATCH WITH FOR','FN DEFINED TWICE', '','NOT ENOUGH SPACE','PROGRAM TOO LONG', 'TOO MANY LABELS','FOR''S TOO DEEP' PRINTSTRING(' *** '.F(I).' LINE') WRITE(LNUM) ; NEWLINES(2) ; FAULTS=FAULTS+1 %END ! ! ! %ROUTINE RUNFOLT(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! RUNTIME FAULTS !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %OWNSTRING(20)%ARRAY F(-2:17)=%C '''FN''S TOO DEEP','FOR''S TOO DEEP', 'DIMENSION ERROR','SUBSCRIPT ERROR','FAULTY INPUT NO.', 'OUT OF DATA','VAR ALREADY IN USE','INVALID FOR','INVALID NEXT', 'GOSUBS TOO DEEP','RETURN BEFORE GOSUB','ARITHMETIC OVERFLOW', 'EXP TOO LARGE','DIVISION BY ZERO','SQR NEGATIVE', 'LOG NEGATIVE','LOG OF ZERO','ZERO TO NEG POWER', 'ABS VALUE TO POWER','CONSOLE INTERRUPT' PRINTSTRING(' *** '.F(I).' LINE') ; WRITE(LNUM) ; NEWLINES(3) FLT = 1 %UNLESS I>10 %RETURNIF DUMPFL = 0 PRINTSTRING('** DUMP ** ') %CYCLE I=0,1,285 %IF ARRSPACE(I)#0 %START; ! PRINT NON-ZERO VALUES PVARN(I) ; SPACE %IF I//11*11=I; ! PRINT VARIABLE NAME PRINTSTRING(' =') PRINT(ARRSPACE(I)) ; NEWLINE; ! PRINT ITS VALUE %FINISH %REPEAT PRINTSTRING('** END OF DUMP ** ') %END ! ! ! %INTEGERFN LENTH(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! NO OF CHARACTER POSITIONS OF I & ! (INCLUDING SIGN POSITION) & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER J,K I = -I %IF I<0 J = 2 ; K = 10 J = J+1 %AND K = K*10 %WHILE I>=K %RESULT=J %END ! ! ! %ROUTINE WRITE(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! ROUGHLY EQUIVALENT TO WRITE(I,0) & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SPACE ; RITE(I) LINEL = LINEL+1 %END ! ! ! %ROUTINE RITE(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! WRITES A POSITIVE INTEGER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER LZ,J,DIVISOR,F DIVISOR = 100000000 ; LZ=0; ! LEADING ZERO MARKER %CYCLE F=1,1,8 J=I//DIVISOR ; I=I-J*DIVISOR PRINTSYMBOL(J+'0') %AND LZ=1 %AND LINEL = LINEL+1 %UNLESS J!LZ=0 DIVISOR = DIVISOR//10 %REPEAT PRINTSYMBOL(I+'0') LINEL = LINEL+1 %END ! ! ! %ROUTINE PRINT(%REAL X) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS A FLOATING POINT NUMBER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %ROUTINESPEC PRYNT(%REAL X) %IF MOD(X)<0.000001 %START; ! ZERO !************************************************ ! TEST FOR ZERO INDEPENDENTLY SINCE * ! OTHERWISE IT IS POSSIBLE TO PRINT -0 * !************************************************ PRINTSTRING(' 0') ; LINEL = LINEL+2 %RETURN %FINISH %IF X<0 %THEN PRINTSYMBOL('-') %AND X = -X %ELSE SPACE; ! PRINT SIGN LINEL = LINEL+1 PRYNT(X); ! PRINT MODULUS ! ! ! %ROUTINE PRYNT(%REAL X) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS AN UNSIGNED REAL NUMBER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,J,NDP %IF X>=100000.0 %OR ISINT(X)>0 %START ! ** NUMBER TO PRINTED AS AN INTEGER ** %IF X>=1000000000.0 %START !****************************************** ! EXPONENTIAL FORM * !****************************************** I = 9 ; X = X/10**9 %WHILE X>=10.0 %CYCLE; ! NORMALISE DOWNWARDS I = I+1 ; X = X/10 %REPEAT PRYNT(X); ! PRINT MANTISSA PRINTSTRING(' E ') ; LINEL = LINEL+3 RITE(I); ! PRINT EXPONENT %FINISHELSE RITE(INT(X)); ! PRINT NEAREST INTEGER %FINISHELSESTART !************************************** ! PRINT AS A DECIMAL * !************************************** %IF X>=1.0 %START NDP = 7-LENTH(INTPT(X)); ! NO OF DECIMAL PLACES (MAX 5) RITE(INTPT(X)); ! PRINT INTEGRAL PART PRINTSYMBOL('.') ; LINEL = LINEL+1 !****************************************** ! EXTRACT FRACTIONAL PART AND * ! MAKE IT AN INTEGER * !****************************************** J = INT(FRACPT(X)*10**NDP) ->FRAC %FINISHELSESTART %IF X>=0.1 %OR ISINT(FRACPT(X)*1000000)>0 %START PRINTSTRING('0.') ; LINEL = LINEL+2 J = INT(X*1000000) ; NDP = 6; ! SIX DECIMAL PLACES FRAC: I = 10**(NDP-1) %WHILE J=1.0 %CYCLE; ! NORMALISE UPWARDS I = I+1 ; X = X*10 %REPEAT PRYNT(X); ! PRINT MANTISSA PRINTSTRING(' E -') ; LINEL = LINEL+4 RITE(I); ! PRINT EXPONENT %FINISH %FINISH %FINISH %END %END;! END OF PRINT ! ! ! %ROUTINE PVARN(%INTEGER VAR) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS OUT THE VARIABLE NAME 'VAR' !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I SPACE PRINTSYMBOL(VAR//11+'A') I=VAR-11*(VAR//11) %IF I#0 %THEN PRINTSYMBOL(I+'0'-1); ! EXTENDED NAME %END ! ! ! %ROUTINE PRSTRING(%INTEGER PT %INTEGERNAME LENTH) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS OUT AN INTERNAL CHARACTER STRING & ! RETURNING THE LENGTH IN LENTH & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %STRINGNAME S S == STRING(ADDR(ANALREC(PT))) PRINTSTRING(S) ; LENTH = LENGTH(S) %END ! ! ! %ROUTINE ANALYSE(%INTEGER INST) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! ROUTINE TO INSERT THE CODE FOR A 'BASIC' & ! INSTRUCTION INTO 'ANALREC' & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %ROUTINESPEC INC1 %ROUTINESPEC INC(%INTEGER I) %INTEGERFNSPEC COMPEXP %INTEGERFNSPEC PARAMS %ROUTINESPEC READVAR(%INTEGERNAME V) %STRINGNAME SN %INTEGERFNSPEC MATOP %INTEGERFNSPEC READSTRING %SWITCH INSTRUCTION(-1:19),MATS(0:8) %INTEGER I,J,K,VAR,VARPT,DIM,DATPT,COUNT CELL_PTR = ANALRECPT ; CELL_DATA=0 ANALREC(ANALRECPT) = LNUM; ! INSERT LINE NUMBER ANALREC(ANALRECPT+1) = INST ; INC(2); ! INSERT INSTRUCTION CODE ->INSTRUCTION(INST); ! OFF WE GO ! ! ! INSTRUCTION(0):SYNTAX:CELL_DATA = -1; ! FAULTY INSTRUCTION PRINT SYNTAX %RETURN ! ! ! INSTRUCTION(-1): ! *** IMPLIED LET *** LINEPT=LLPT ; NSYM=LINE(LLPT) ; ANALREC(ANALRECPT-1)=1; ! RESTORE NSYM, TRY 'LET' ! ! ! INSTRUCTION(1): ! *** LET *** READVAR(VAR) VARPT = ANALRECPT ; INC1; ! LEAVE SPACE FOR VARIABLE DIM = PARAMS; ! COMPILE PARAMETERS ->SYNTAX %IF VAR<0 %OR DIM<0 %OR NSYM#'=' GETSYM; ! SKIP '=' ANALREC(VARPT) = VAR!DIM<<13; ! INSERT VARIABLE ->SYNTAX %UNLESS COMPEXP=0 %AND NSYM=CR; ! COMPILE R.H.S. %RETURN ! ! ! INSTRUCTION(2):INSTRUCTION(14): ! *** READ *** INPUT *** VARPT=ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT COUNT=0 %UNTIL NSYM=CR %CYCLE DATPT=ANALRECPT ; INC1; ! LEAVE SPACE FOR VARIABLE READVAR(VAR) ; DIM=PARAMS; ! READ VAR NAME,COMPILE PARAMS ->SYNTAX %IF DIM<0 %OR VAR<0 ANALREC(DATPT)=VAR!DIM<<13; ! INSERT VARIABLE NAME COUNT=COUNT+1 GETSYM %IF NSYM=','; ! SKIP ',' %REPEAT ANALREC(VARPT)=COUNT; ! INSERT COUNT %RETURN ! ! ! INSTRUCTION(3): ! *** DATA *** DATPT=ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT %UNTIL NSYM=CR %CYCLE ->SYNTAX %IF READR(REAL(ADDR(ANALREC(ANALRECPT))))#0; ! READ & INSERT VALUE INC1 ; GETSYM %IF NSYM=','; ! SKIP ',' %REPEAT ANALREC(DATPT)=ANALRECPT-DATPT-1; ! INSERT COUNT %RETURN ! ! ! INSTRUCTION(4): ! *** PRINT *** VARPT=ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT COUNT = 0 %WHILE NSYM#CR %CYCLE DATPT = ANALRECPT ; INC1; ! LEAVE SPACE FOR TYPE %IF NSYM='''' %START; ! STRING K = 1 ; I = READSTRING; ! K = TYPE %FINISHELSESTART; ! EXPRESSION K = 0 ; I = COMPEXP %FINISH ->SYNTAX %IF I#0 %IF NSYM#CR %START %IF NSYM=',' %THEN J=1 %ELSESTART; ! J = SEPARATOR MARKER %IF NSYM=';' %THEN J=2 %ELSE ->SYNTAX %FINISH GETSYM %FINISHELSE J = 0 COUNT = COUNT+1 ANALREC(DATPT) = K!J<<1; ! INSERT TYPE/SEPARATOR MARKER %REPEAT ANALREC(VARPT)=COUNT; ! INSERT COUNT %RETURN ! ! ! INSTRUCTION(5):INSTRUCTION(12): ! *** GO TO *** GO SUB *** ->SYNTAX %IF READ(ANALREC(ANALRECPT))#0 ; INC1; ! READ LINE NUMBER %RETURN ! ! ! INSTRUCTION(6): ! *** IF *** ->SYNTAX %IF COMPEXP#0; ! COMPILE FIRST HALF !*********************************************** ! ATTEMPT TO RECOGNISE A VALID OPERATOR * ! FROM THE LIST - * ! <,<=,>,>=,=,#,<> * !*********************************************** %IF NSYM='=' %THEN I=5 %AND ->R2 %IF NSYM='#' %THEN I=6 %AND ->R2 %IF NSYM='>' %START I=3 ; GETSYM R1: %IF NSYM='=' %THEN I=I+1 %AND ->R2 ; ->R3 %FINISH ->SYNTAX %IF NSYM#'<' I=1 GETSYM ->R1 %IF NSYM#'>' I = 6 R2: GETSYM R3: ->SYNTAX %IF COMPEXP#0; ! COMPILE SECOND HALF ->SYNTAX %IF ANALINST(3)#1; ! READ 'THEN' ANALREC(ANALRECPT) = I ; INC1; ! INSERT RELATION ->INSTRUCTION(5) ! ! ! INSTRUCTION(7): ! *** MAT *** LLPT = LINEPT ; I = ANALINST(1); ! SAVE LINE POINTER : LOOK FOR INST NAME %IF I=2 %START J = 2; ! 'MAT' READ READVARS:ANALREC(ANALRECPT) = J ; INC1; ! INSERT CODE (READ,PRINT & INPUT) VARPT = ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT COUNT = 0 %UNTIL NSYM=CR %CYCLE READVAR(VAR) ; ->SYNTAX %IF VAR<0; ! READ NAME COUNT = COUNT+1 %IF NSYM=';' %AND J=3 %START; ! PACKED FORMAT VAR = VAR!512 ; GETSYM; ! MARK NAME, SKIP SEMI-COLON %FINISHELSESTART; ! STANDARD FORMAT GETSYM %IF NSYM=','; ! SKIP ',' %FINISH ANALREC(ANALRECPT) = VAR ; INC1; ! INSERT NAME %REPEAT ANALREC(VARPT) = COUNT; ! INSERT COUNT %RETURN %FINISH %IF I=4 %THEN J = 3 %AND ->READVARS; ! 'MAT' PRINT %IF I=14 %THEN J = 4 %AND ->READVARS; ! 'MAT' INPUT ANALREC(ANALRECPT) = 1 ; INC1; ! INSERT CODE (ASSIGNMENT) LINEPT = LLPT ; NSYM = LINE(LLPT); ! RESTORE NSYM READVAR(VAR) ; ->SYNTAX %IF VAR<0 %OR NSYM#'=' GETSYM; ! SKIP '=' ANALREC(ANALRECPT) = VAR ; INC1; ! INSERT 'MAT' NAME I = MATOP ; ->SYNTAX %IF I<0; ! FIND 'MAT' OPERATOR ANALREC(ANALRECPT) = I ; INC1; ! INSERT MAT OP ->MATS(I); ! JUMP TO RELEVANT OPERATOR ! ! ** SCALAR MULTIPLICATION MATS(0):GETSYM; ! SKIP'(' ->SYNTAX %IF COMPEXP#0 %OR NSYM#')'; ! COMPILE MULTIPLIER EXPR GETSYM ; ->SYNTAX %IF NSYM#'*'; ! SKIP ')' MATSL:GETSYM ; READVAR(VAR); ! READ OPERAND ->SYNTAX %IF VAR<0 ANALREC(ANALRECPT) = VAR ; INC1; ! INSERT OPERAND %RETURN ! ! ** + - * ** MATS(1):MATS(2):MATS(3):ANALREC(ANALRECPT)=VAR ; INC1 ; ->MATSL ! ! ** INV TRN ** MATS(4):MATS(8):->SYNTAX %UNLESS NSYM='(' GETSYM ; READVAR(VAR); ! SKIP '(' : READ PARAM NAME ->SYNTAX %IF VAR<0 %OR NSYM#')' ANALREC(ANALRECPT) = VAR ; INC1; ! INSERT PARAMETER GETSYM; ! SKIP ')' ! ! ** IDN ZER CON ** MATS(5):MATS(6):MATS(7):%RETURN ! ! ! INSTRUCTION(8): ! *** FOR *** READVAR(VAR) ; ->SYNTAX %IF VAR<0 %OR NSYM#'='; ! READ CONTROL VAR NAME ANALREC(ANALRECPT)=VAR ; INC1; ! INSERT CONTROL VARIABLE GETSYM; ! SKIP '=' ->SYNTAX %IF COMPEXP#0 %OR ANALINST(3)#2 %OR COMPEXP#0 %IF ANALINST(3)=3 %START; ! STEP EXISTS ANALREC(ANALRECPT)=1 ; INC1; ! 1 = STEP ->SYNTAX %IF COMPEXP#0; ! COMPILE STEP %FINISHELSE ANALREC(ANALRECPT)=0 %AND INC1; ! 0 = DEFAULT STEP %RETURN ! ! ! INSTRUCTION(9): ! *** NEXT *** READVAR(VAR) ; ->SYNTAX %IF VAR<0; ! READ VAR NAME ANALREC(ANALRECPT)=VAR ; INC1; ! INSERT VARIABLE %RETURN ! ! ! INSTRUCTION(10): ! *** DIM *** VARPT=ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT COUNT=0 %UNTIL NSYM=CR %CYCLE READVAR(VAR); ! READ VAR NAME %IF NSYM='(' %AND VAR>=0 %START GETSYM; ! SKIP '(' ->SYNTAX %IF READ(D1)#0 %OR D1<0 ; D2 = 0 %IF NSYM=',' %START; ! TWO PARAMETERS GETSYM; ! SKIP ',' ->SYNTAX %IF READ(D2)#0 %OR D2<0 %FINISH ->SYNTAX %UNLESS NSYM=')' ; GETSYM; ! SKIP ')' %FINISHELSE ->SYNTAX ANALREC(ANALRECPT) = VAR ; ANALREC(ANALRECPT+1)=D1 ANALREC(ANALRECPT+2) = D2 ; INC(3) ; COUNT = COUNT+1 GETSYM %IF NSYM=','; ! SKIP ',' %REPEAT ANALREC(VARPT)=COUNT; ! INSERT COUNT %RETURN ! ! ! INSTRUCTION(11):INSTRUCTION(13):INSTRUCTION(15):INSTRUCTION(18): ! *** END *** RETURN *** STOP *** RESTORE *** %RETURN ! ! ! INSTRUCTION(16): ! *** REM *** !************************************************ ! TAKE THE REST OF THE LINE AND PUT IT INTO * ! 'ANALREC' AS A STRING * !************************************************ SN == STRING(ADDR(ANALREC(ANALRECPT))) %IF LINE(LINEPT-1) =' ' %THEN SN = ' ' %ELSE SN='' %WHILE NSYM#CR %CYCLE SN = SN.TOSTRING(NSYM) ; GETSIM %REPEAT INC(LENGTH(SN)>>2+1) %RETURN ! ! ! INSTRUCTION(17): ! *** ON *** ->SYNTAX %UNLESS COMPEXP=0 %AND ANALINST(1)=5; ! COMPILE SWITCH EXPRESSION COUNT = 0 VARPT = ANALRECPT ; INC1; ! LEAVE SPACE FOR COUNT %UNTIL NSYM=CR %CYCLE ->SYNTAX %IF READ(ANALREC(ANALRECPT))#0 ; INC1; ! INSERT LABEL NUMBER COUNT = COUNT+1; ! INCREMENT LABEL COUNT GETSYM %IF NSYM=','; ! SKIP ',' %REPEAT ANALREC(VARPT)=COUNT; ! INSERT COUNT %RETURN ! ! ! INSTRUCTION(19): ! *** DEF *** ->SYNTAX %UNLESS 'A'<=NSYM<='Z' ANALREC(ANALRECPT)=NSYM ; INC1; ! INSERT FUNCTION NAME GETSYM ; ->SYNTAX %UNLESS NSYM='('; ! CHECK '(' GETSYM ; READVAR(VAR) ; ->SYNTAX %IF VAR<0 %OR NSYM#')'; ! READ PARAM NAME, CHECK ')' GETSYM ; ->SYNTAX %UNLESS NSYM='='; ! CHECK '=' GETSYM ; ANALREC(ANALRECPT) = VAR ; INC1; ! INSERT PARAMETER NAME ->SYNTAX %UNLESS COMPEXP=0; ! COMPILE FUNCTION BODY %RETURN ! ! ! %ROUTINE INC1 !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! IDENTICAL TO 'INC(1)' & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ANALRECPT = ANALRECPT+1 %END ! ! ! %ROUTINE INC(%INTEGER I) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! INCREMENTS ANALYSIS RECORD POINTER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ANALRECPT = ANALRECPT+I %END ! ! ! %ROUTINE READVAR(%INTEGERNAME V) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! RETURNS THE VALUE OF THE NEXT VARIABLE NAME ON THE INPUT & ! STREAM. -1 IF NONE SUCH EXISTS & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE V = -1 %ANDRETURNUNLESS'A'<=NSYM<='Z' V = (NSYM-'A')*11 ; GETSYM !******************************************** ! CHECK FOR EXTENDED NAME !******************************************** %IF'0'<=NSYM<='9' %THEN V = V+NSYM-'0'+1 %AND GETSYM %END ! ! ! %INTEGERFN MATOP !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! LOOKS FOR MATRIX OPERATORS & ! IF INV,IDN,ZER OR CON THEN RETURN 4->8. & ! IF +,-, OR * RETURN 1->3 AND PUT FIRST OPERAND & ! IN 'VAR'. & ! IF SCALAR MULTIPLICATION, RETURN 0 & ! ELSE RETURN -1 & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,SAVE %STRING(3) S %RESULT=0 %IF NSYM='('; ! SCALAR MULT SAVE = LINEPT S = '' %CYCLE I=1,1,3; ! FORM THREE CHAR STRING S=S.TOSTRING(NSYM) GETSYM %REPEAT %CYCLE I=4,1,8 %RESULT=I %IF S=MATF(I); ! MATRIX FUNCTION %REPEAT LINEPT = SAVE ; NSYM = LINE(SAVE); ! RESTORE NSYM READVAR(VAR) ; %RESULT=-1 %IF VAR<0; ! READ MATRIX NAME %RESULT=1 %IF NSYM='+'; ! ADDITION %RESULT=2 %IF NSYM='-'; ! SUBTRACTION %RESULT=3 %IF NSYM='*'; ! MULTIPLICATION %RESULT=-1; ! FAILURE %END ! ! ! %INTEGERFN READSTRING !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! READS A STRING AND INSERTS IT INTO ANALREC & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %STRINGNAME S S == STRING(ADDR(ANALREC(ANALRECPT))) ; S=''; ! CLEAR STRING GETSIM; ! SKIP INITIAL QUOTE %CYCLE %RESULT=1 %IF NSYM=CR %IF NSYM='''' %START GETSIM ; %EXITIF NSYM#''''; ! END OF STRING %FINISH S = S.TOSTRING(NSYM); ! INSERT CHARACTER GETSIM %REPEAT GETSYM %IF NSYM=' '; ! SET NSYM TO NEXT SIG. CHAR. INC(LENGTH(S)>>2+1); ! INCREMENT ANALRECPT %RESULT=0 %END ! ! ! %INTEGERFN COMPEXP !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! CONVERTS EXPRESSIONS INTO REVERSE POLISH !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE ! ! AN ARITHMETIC EXPRESSION IS COMPILED INTO THE FOLLOWING FORM:- ! THE FIRST ELEMENT IS A POINTER TO THE FIRST POSITION IN ! 'ANALREC' AFTER THE EXPRESSION.THEN FOLLOW 'ITEMS' WHICH ! DESCRIBE A REVERSE POLISH NOTATION. ! AN 'ITEM' IS IDENTIFIED BY A NUMBER 1->9 PRECEDING ITS ! MORE DETAILED DESCRIPTION. ! 1 - A VARIABLE NAME ! 2 - A CONSTANT ! 3 - A FUNCTION CALL ! 4 - + ,5 - - ,6 - * ,7 - / ,8 - ^ ! 9 - UNARY MINUS ! VARIABLES CAN AND FUNCTIONS DO HAVE PARAMETER(S) WHICH ARE ! THEMSELVES COMPLETELY GENERAL EXPRESSIONS AND ARE COMPILED ! BY CALLING THIS ROUTINE RECURSIVELY VIA ROUTINE 'PARAMS' ! %REAL SIGN,X %INTEGER ANALPT,LEVEL,OPT,VPT,I,VAR %INTEGERARRAY OPSTACK(1:50) ! ! %INTEGERFN FINDFN !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! TRYS TO FIND A FUNCTION NAME !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %STRING(3) S %INTEGER SAVE,I SAVE = LINEPT ; S='' %CYCLE I=1,1,3; ! READ THREE CHARACTERS ->OUT %UNLESS 'A'<=NSYM<='Z' S = S.TOSTRING(NSYM) ; GETSYM %REPEAT %IF 'FNA'<=S<='FNZ' %THENRESULT = CHARNO(S,3); ! USER DEFINED FUNCTION %CYCLE I=1,1,11 %RESULT=I %IF S=FNN(I); ! LIBRARY FN %REPEAT OUT:LINEPT = SAVE ; NSYM = LINE(LINEPT); ! NO FN NAME,RESTORE NSYM %RESULT=0 %END ! ! %ROUTINE UNSTACK !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! UNSTACK AN OPERATOR AND INSERT IT IN & ! THE ANALYSIS RECORD & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& OPT=OPT-1 ; ANALREC(ANALRECPT)=OPSTACK(OPT) ; INC1 %END ! ! ANALPT = ANALRECPT ; INC1; ! LEAVE SPACE FOR END POINTER OPSTACK(1)=0 ; LEVEL=1 ; OPT = 2 !******************************************** ! LOOK FOR AN OPERAND !******************************************** OPERAND:%IF NSYM='-' %START !******************************************** ! UNARY MINUS !******************************************** GETSYM; ! SKIP '.' %IF'0'<=NSYM<='9' %OR NSYM='.' %THEN SIGN = -1.0 %AND ->CONST;! A NEGATIVE CONSTANT !******************************************** ! IF A UNARY MINUS PRECEEDS A CONSTANT * ! THEN INCLUDE IT IN THE CONSTANT * !******************************************** OPSTACK(OPT)=9 ; OPT=OPT+1 ; ->OPERAND; ! STACK '9' (UNARY MINUS) %FINISH %IF NSYM='(' %START !******************************************** ! SUB-EXPRESSION * !******************************************** GETSYM ; OPSTACK(OPT) = 0 ; OPT = OPT+1 ; LEVEL = LEVEL+1;! STACK '0' (SUB-EXPR MARKER) ->OPERAND %FINISH %IF '0'<=NSYM<='9' %OR NSYM='.' %START !******************************************** ! CONSTANT * !******************************************** SIGN = 1.0 CONST: %RESULT=1 %UNLESS READR(X)=0; ! READ CONSTANT ANALREC(ANALRECPT) = 2; ! INSERT '2' REAL(ADDR(ANALREC(ANALRECPT+1))) = X*SIGN; ! INSERT CONSTANT VALUE INC(2) ->OPERATOR %FINISH I = FINDFN; ! LOOK FOR A FN NAME %IF I>0 %START !******************************************** ! FUNCTION CALL * !******************************************** ANALREC(ANALRECPT) = 3 ; ANALREC(ANALRECPT+1) = I; ! INSERT '3' & FN NAME INC(2) %RESULT=1 %UNLESS PARAMS=1; ! ONE PARAMETER ONLY ->OPERATOR %FINISH READVAR(VAR) ; %RESULT=1 %IF VAR<0 !******************************************** ! VARIABLE NAME * !******************************************** VPT=ANALRECPT ; INC(2) DIM=PARAMS ; %RESULT=1 %IF DIM<0; ! COMPILE PARAMETERS ANALREC(VPT) = 1 ; ANALREC(VPT+1) = VAR!DIM<<13; ! INSERT '1' & VAR NAME !***************************************************** ! LOOK FOR AN OPERATOR * !***************************************************** OPERATOR:%CYCLE I=1,1,5; ! LOOK FOR AN OPERATOR %IF OPR(I)=NSYM %START; ! FOUND ONE GETSYM; ! SKIP IT UNSTACK %WHILE PREC(I+3)<=PREC(OPSTACK(OPT-1)); ! UNSTACK OPS WITH >= PRECEDENCE OPSTACK(OPT) = I+3 ; OPT = OPT+1; ! STACK THIS OPERATOR ->OPERAND %FINISH %REPEAT %IF NSYM=')' %AND LEVEL>1 %START GETSYM !****************************************************** ! HAVE FOUND A ')' SO UNSTACK ALL OPERATORS MET * ! SINCE THE '(' * !****************************************************** UNSTACK %WHILE OPSTACK(OPT-1)#0; ! UNSTACK TO START OF SUB-EXPR OPT=OPT-1 ; LEVEL=LEVEL-1; ! UNSTACK '0' , DECREMENT LEVEL ->OPERATOR %FINISH !******************************************************* ! NO OPERATOR FOUND,HENCE THE END OF THE EXPRN * !******************************************************* %RESULT=1 %UNLESS LEVEL=1; ! MISSING ')' UNSTACK %WHILE OPT>2; ! UNSTACK ALL OPERATORS ANALREC(ANALPT)=ANALRECPT; ! FILL IN END POINTER %RESULT=0 %END ! ! ! %INTEGERFN PARAMS !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! COMPILES PARAMETERS (IF PRESENT) AND RETURNS THE ! NUMBER OF PARAMETERS !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER D %RESULT=0 %IF NSYM#'('; ! CHECK '(' GETSYM ; D=1; ! SKIP '(' %RESULT=-1 %UNLESS COMPEXP=0; ! COMPILE FIRST %IF NSYM=',' %START GETSYM ; D=2; ! SKIP ',' %RESULT=-1 %UNLESS COMPEXP=0; ! COMPILE SECOND %FINISH %RESULT=-1 %UNLESS NSYM=')' ; GETSYM; ! CHECK ')' , SKIP IT %RESULT=D %END %END;! END OF ANALYSE ! ! ! %ROUTINE PRINT FAULTS(%INTEGER FAULTS,%STRING(8) TYPE) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS THE NUMBER OF FAULTS AND THEIR TYPE & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& NEWLINES(2) ; PRINTSTRING('*** PROGRAM CONTAINS ') RITE(FAULTS) ; PRINTSTRING(' '.TYPE.' FAULT') PRINTSYMBOL('S') %IF FAULTS>1 NEWLINES(3) %END ! ! ! %ROUTINE OBEY(%INTEGER CMND) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! OBEYS A COMMAND & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %ROUTINESPEC LIST(%ROUTINENAME PSTRING) %ROUTINESPEC RESEQUENCE %ROUTINESPEC OUTSTRING(%INTEGER PT,%INTEGERNAME LENTH) %SWITCH COMMAND(-1:11) ->COMMAND(CMND) COMMAND(1):%IF FAULTS>0 %THEN PRINT FAULTS(FAULTS,'SYNTAX') %C %ELSE RUNFLAG = 1; ! RUN %RETURN COMMAND(2): LIST(PRSTRING) ; %RETURN; ! LIST COMMAND(3): %RETURN; ! BREAK COMMAND(4): DUMPFL = 1 ; %RETURN; ! DUMP COMMAND(5): DUMPFL = 0 ; %RETURN; ! NODUMP COMMAND(6): %RETURN; ! TRACE COMMAND(7): %RETURN; ! UNBREAK COMMAND(8): PRINTCH(7) ; %STOP; ! STOP COMMAND(9): %RETURN; ! UNTRACE COMMAND(10):RESEQUENCE ; %RETURN; ! RESEQUENCE COMMAND(11):%IF IFILE#'.TT' %START; ! SAVE SELECTOUTPUT(3) SETMARGINS(3,1,120) LIST(OUTSTRING) SELECTOUTPUT(2) CLOSESTREAM(3) SETMARGINS(2,1,120) %IF FROMSTRING(OFILE,1,3)='.LP' %FINISH %RETURN COMMAND(-1):COMMAND(0):PRINT SYNTAX; ! INVALID COMMAND ! ! %ROUTINE LIST(%ROUTINENAME PSTRING) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! ROUTINE TO RECONSTRUCT AND PRINT OUT THE & ! CURRENTLY STORED PROGRAM & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %ROUTINESPEC PRINTOUT(%INTEGER PT,BASE,%INTEGERARRAYNAME EXPR,%C %BYTEINTEGERARRAYNAME PTRS1,PTRS2) %ROUTINESPEC PSTRING(%INTEGER A,%INTEGERNAME B) %RECORDNAME LCL (RF2) %CONSTSTRING(6) %ARRAY MATIONAME(2:4)=' READ',' PRINT',' INPUT' %INTEGER MINL,I,J,K,L,M,TEMP,DIM,INDENT,MAXL,MAXS,LNUM %SWITCH LIST(1:19),MATL1(1:4),MATL2(0:8) ! ! ! %ROUTINE PRINTEXPR(%INTEGER PT) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS OUT THE EXPRESSION WHICH HAS ITS REVERSE POLISH ! REPRESENTATION STARTING AT ANALREC(PT) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGERARRAY EXPR(1:ANALREC(PT)-PT) %BYTEINTEGERARRAY PTRS1,PTRS2(1:ANALREC(PT)-PT),STACK(1:10) %INTEGER I,STACKPT,EXPRPT,DIM,J %SWITCH BLD(1:10) !*************************************************** ! COPY THE EXPRESSION INTO ARRAY EXPR * ! IN ORDER TO MATCH THE ELEMENTS OF * ! 'EXPR' WITH 'PTRS1' & 'PTRS2'. THIS * ! WOULD BE DIFFICULT IF USING 'ANALREC' * !*************************************************** I = 1 %CYCLE J = PT+1,1,ANALREC(PT)-1 EXPR(I) = ANALREC(J) I=I+1 %REPEAT EXPR(I) = 10; ! END MARKER STACKPT = 0 ; EXPRPT = 1 !******************************************************* ! TRANSFORM THE EXPRESSION INTO A BINARY TREE * !******************************************************* ! LOOP:STACKPT = STACKPT+1 ->BLD(EXPR(EXPRPT)) ! BLD(1):STACK(STACKPT) = EXPRPT; ! STACK POINTER (VARIABLE) DIM = EXPR(EXPRPT+1)>>13 EXPRPT = EXPRPT+2 %IF DIM>0 %START; ! SKIP PAST THE PARAMETERS %CYCLE I=1,1,DIM EXPRPT = EXPR(EXPRPT)-PT %REPEAT %FINISH ->LOOP ! BLD(2):STACK(STACKPT) = EXPRPT; ! STACK POINTER (CONSTANT) EXPRPT = EXPRPT+2 ->LOOP ! BLD(3):STACK(STACKPT) = EXPRPT; ! STACK POINTER (FUNCTION CALL) EXPRPT = EXPR(EXPRPT+2)-PT; ! SKIP PAST ACTUAL PARAMETER ->LOOP ! BLD(4):BLD(5):BLD(6):BLD(7):BLD(8):STACKPT = STACKPT-2 !**************************************************** ! BINARY OPERATORS - * ! UNSTACK THE TOP TWO,INSERT LINKS,& STACK * ! POINTER (OPERAND) * !**************************************************** PTRS1(EXPRPT) = STACK(STACKPT); ! FIRST LINK PTRS2(EXPRPT) = STACK(STACKPT+1); ! SECOND LINK STACK(STACKPT) = EXPRPT; ! STACK POINTER EXPRPT = EXPRPT+1 ->LOOP ! BLD(9):STACKPT = STACKPT-1 !*************************************************** ! UNARY MINUS - * ! UNSTACK ONE,INSERT LINK,& STACK POINTER * !*************************************************** PTRS1(EXPRPT) = STACK(STACKPT); ! LINK STACK(STACKPT) = EXPRPT; ! STACK POINTER EXPRPT = EXPRPT+1 ->LOOP ! BLD(10):PRINTOUT(STACK(1),PT,EXPR,PTRS1,PTRS2); ! PRINT THE TREE %END ! ! ! %ROUTINE PRINTOUT(%INTEGER PT,BASE,%INTEGERARRAYNAME EXPR,%C %BYTEINTEGERARRAYNAME PTRS1,PTRS2) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! PRINTS OUT A BINARY TREE AS PRODUCED BY 'PRINTEXPR' !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %SWITCH PRT(1:9) %INTEGER PAREN,DIM,PR,I PAREN = 0; ! NO PARENTHESES ->PRT(EXPR(PT)) ! PRT(1):PT=PT+1 ; PVARN(EXPR(PT)&511); ! PRINT VARIABLE NAME DIM = EXPR(PT)>>13 PT = PT+1 %RETURNIF DIM=0 PRINTSYMBOL('(') ; PRINTEXPR(PT+BASE); ! PRINT FIRST PARAMETER PRINTSYMBOL(',') %AND PRINTEXPR(EXPR(PT)) %IF DIM=2; ! PRINT SECOND PARAMETER PRINTSTRING(' )') %RETURN ! PRT(2):PRINT(REAL(ADDR(EXPR(PT+1)))); ! WRITE CONSTANT %RETURN ! PRT(3):I = EXPR(PT+1) %IF I>20 %START; ! USER FN NAME PRINTSTRING(' FN') ; PRINTSYMBOL(I) %FINISHELSE PRINTSTRING(' '.FNN(I)); ! LIBRARY FN NAME PRINTSYMBOL('(') PRINTEXPR(PT+2+BASE); ! RECURSE FOR PARAMETER PRINTSTRING(' )') %RETURN !************************************************ ! NON-ASSOCIATIVE OPERATORS * ! PARENTHESES IF THE SECOND OPERAND IS AN * ! OPERATOR OF SMALLER OR EQUAL PRECEDENCE * !************************************************ ! PRT(5):PRT(7):PRT(8): PAREN = 1 %UNLESS PREC(EXPR(PT))PREC(EXPR(PTRS1(PT))) %START PAREN = PAREN!2 ; PRINTSTRING(' (') %FINISH PRINTOUT(PTRS1(PT),BASE,EXPR,PTRS1,PTRS2); ! FIRST OPERAND PRINTSTRING(' )') %AND PAREN = PAREN&1 %IF PAREN>1 SPACE PRINTSYMBOL(OPR(EXPR(PT)-3)); ! OPERATOR !***************************************************** ! PARENTHESES IF SECOND OPERAND HAS SMALLER * ! PRECEDENCE * !***************************************************** PAREN = PAREN!2 %IF PR>PREC(EXPR(PTRS2(PT))) PRINTSTRING(' (') %IF PAREN>0 PRINTOUT(PTRS2(PT),BASE,EXPR,PTRS1,PTRS2); ! SECOND OPERAND PRINTSTRING(' )') %IF PAREN>0 %RETURN ! PRT(9): PRINTSTRING(' -') PAREN = 1 %AND PRINTSTRING(' (') %IF EXPR(PTRS1(PT))>3 PRINTOUT(PTRS1(PT),BASE,EXPR,PTRS1,PTRS2); ! OPERAND PRINTSTRING(' )') %IF PAREN>0 %END ! ! ! INDENT = 0 ; MAXS = LENTH(LLNUM) LCL == LC(0) !******************************************** ! LCL IS THE LINE CELL OF THE LINE * ! BEING PROCESSED * !******************************************** %IF NSYM=CR %THEN MINL = 0 %AND MAXL = 9999 %ELSESTART; ! DEFAULT PRINT SYNTAX %ANDRETURNUNLESS READ(MINL)=0 ; GETSYM; ! MINIMUM MAXL = MINL %UNLESS READ(MAXL)=0; ! MAXIMUM %FINISH %RETURNIF NLINES=0 %OR MINL>LLNUM %UNTIL LNUM>=MINL %CYCLE; ! SKIP UNTI MINL LCL == LC(LCL_LINK) ; LNUM = ANALREC(LCL_PTR) %REPEAT %WHILE ADDR(LCL)#ADDR(LC(0)) %AND LNUM<=MAXL %CYCLE SPACES(MAXS-LENTH(LNUM)) ; WRITE(LNUM); ! WRITE LINE NUMBER %IF LCL_DATA<0 %START; ! SYNTACTICALLY INVALID PRINTSTRING(' ** ERROR **') ; ->LISTLOOP %FINISH I = LCL_PTR J = ANALREC(I+1); ! INSTRUCTION CODE INDENT = INDENT-2 %IF J=9; ! 'NEXT' INSTRUCTION SPACES(INDENT); ! INDENT PRINTSTRING(' '.INAME(J)); ! PRINT INSTRUCTION NAME M = ANALREC(I+2) ->LIST(J) ! ! ! LIST(1):! --- LET TEMP = I+3 DIM = M>>13 %IF DIM>0 %START TEMP = ANALREC(TEMP) %IF DIM = 2 %THEN TEMP = ANALREC(TEMP) %FINISH !**************************************************** ! PUT L.H.S. INTO EXPRESSION FORMAT * !**************************************************** J = ANALREC(I) ; ANALREC(I) = TEMP; ! SAVE LINE NUMBER PRINTEXPR(I); ! PRINT L.H.S. ANALREC(I) = J; ! RESTORE LINE NUMBER PRINTSTRING(' =') PRINTEXPR(TEMP); ! PRINT R.H.S. ->LISTLOOP ! ! ! LIST(2):LIST(14):! --- READ --- INPUT I = I+1 %CYCLE L=1,1,M J = ANALREC(I) ; K = ANALREC(I+1); ! SAVE LINE NO. AND COUNT !************************************************* ! PUT VARIABLE INTO EXPRESSION FORMAT * !************************************************* TEMP = I+3 DIM = ANALREC(I+2)>>13 %IF DIM>0 %THEN TEMP = ANALREC(TEMP) %IF DIM=2 %THEN TEMP = ANALREC(TEMP) ANALREC(I) = TEMP ; ANALREC(I+1) = 1 PRINTEXPR(I) ; PRINTSTRING(' , ') %UNLESS L=M ANALREC(I) = J ; ANALREC(I+1) = K; ! RESTORE LINE NO. AND COUNT I = TEMP-2 %REPEAT ->LISTLOOP ! ! ! LIST(3):! --- DATA M = M+I+2 %CYCLE J=I+3,1,M PRINT(REAL(ADDR(ANALREC(J)))) PRINTSYMBOL(',') %UNLESS J=M %REPEAT ->LISTLOOP ! ! ! LIST(4):! --- PRINT I = I+3 %WHILE M>0 %CYCLE K = ANALREC(I) %IF K&1=0 %START PRINTEXPR(I+1) ; I = ANALREC(I+1); ! PRINT EXPR & MOVE POINTER %FINISHELSESTART PRINTSTRING(' ''') PSTRING(I+1,J); ! PRINT THE STRING PRINTSYMBOL('''') ; I = I+J>>2+2; ! MOVE POINTER %FINISH K = K>>1 %IF K>0 %START; ! PRINT SEPARATOR SPACE %IF K=2 %THEN PRINTSYMBOL(';') %ELSE PRINTSYMBOL(',') %FINISH M = M-1 %REPEAT ->LISTLOOP ! ! ! LIST(5):LIST(12):! --- GOTO --- GOSUB WRITE(M) ; ->LISTLOOP; ! WRITE LABEL NUMBER ! ! ! LIST(6):! --- IF PRINTEXPR(I+2); ! 1ST HALF PRINTSTRING(' '.REL(ANALREC(ANALREC(M)))); ! RELATION PRINTEXPR(M) ; PRINTSTRING(' THEN'); ! 2ND HALF WRITE(ANALREC(ANALREC(M)+1)); ! WRITE LABEL ->LISTLOOP ! ! ! LIST(7):! --- MAT ->MATL1(M) !************************** ! ASSIGNMENT !************************** MATL1(1):PVARN(ANALREC(I+3)) ; PRINTSTRING(' ='); ! PRINT ' =' M = ANALREC(I+4); ! ASSIGNMENT TYPE ->MATL2(M) ! MATL2(0):PRINTSTRING(' (') PRINTEXPR(I+5); ! PRINT SCALAR EXPRESSION PRINTSTRING(') *') PVARN(ANALREC(ANALREC(I+5))); ! PRINT MULTIPLICAND NAME ->LISTLOOP ! MATL2(1):MATL2(2):MATL2(3): PVARN(ANALREC(I+5)); ! PRINT FIRST OPERAND NAME SPACE ; PRINTSYMBOL(OPR(M)); ! PRINT OPERATOR PVARN(ANALREC(I+6)); ! PRINT SECOND OPERAND NAME ->LISTLOOP ! MATL2(4):MATL2(8):PRINTSTRING(' '.MATF(ANALREC(I+4)).'('); ! PRINT FUNCTION NAME PVARN(ANALREC(I+5)) ; PRINTSTRING(' )'); ! PRINT PARAMETER NAME ->LISTLOOP ! MATL2(5):MATL2(6):MATL2(7):PRINTSTRING(' '.MATF(ANALREC(I+4))); ! PRINT FUNCTION NAME ->LISTLOOP !************************** ! READ, PRINT, INPUT !************************** MATL1(2):MATL1(3):MATL1(4):PRINTSTRING(MATIONAME(M)) M = I+3+ANALREC(I+3) %CYCLE I=I+4,1,M PVARN(ANALREC(I)&511); ! PRINT MATRIX NAME SPACE %IF ANALREC(I)>>9#0 %THEN PRINTSYMBOL(';') %ELSESTART; ! PRINT SEPARATOR PRINTSYMBOL(',') %UNLESS I=M %FINISH %REPEAT ->LISTLOOP ! ! ! LIST(8):! --- FOR PVARN(M) ; I = I+3; ! CONTROL VARIABLE NAME PRINTSTRING(' =') ; PRINTEXPR(I); ! INITIAL VALUE I = ANALREC(I) ; PRINTSTRING(' TO') PRINTEXPR(I); ! FINAL VALUE I = ANALREC(I) %IF ANALREC(I)=1 %START PRINTSTRING(' STEP') ; PRINTEXPR(I+1); ! STEP VALUE %FINISH INDENT = INDENT+2; ! INCREASE INDENTATION ->LISTLOOP ! ! ! LIST(9):! --- NEXT PVARN(M); ! PRINT VARIABLE NAME ->LISTLOOP ! ! ! LIST(10):! --- DIM %CYCLE L=1,1,M I = I+3 ; PVARN(ANALREC(I)) PRINTSYMBOL('(') ; WRITE(ANALREC(I+1)); ! FIRST UPPER BOUND J = ANALREC(I+2) %IF J>0 %THEN PRINTSTRING(' ,') %AND WRITE(J); ! SECOND UPPER BOUND PRINTSTRING(' )') PRINTSTRING(' ,') %UNLESS L=M; ! SEPARATOR %REPEAT ->LISTLOOP ! ! ! LIST(11):LIST(13):LIST(15):LIST(18): ! --- END --- RETURN --- STOP --- RESTORE ->LISTLOOP ! ! ! LIST(16):! ---REM PRINTSTRING(STRING(ADDR(ANALREC(I+2)))) ->LISTLOOP ! ! ! LIST(17):! --- ON PRINTEXPR(I+2) ; PRINTSTRING(' GOTO'); ! PRINT EXPRESSION I = M ; M = ANALREC(I)+I %CYCLE L=I+1,1,M WRITE(ANALREC(L)); ! WRITE LABEL NUMBER PRINTSTRING(' ,') %UNLESS L=M %REPEAT ->LISTLOOP ! ! ! LIST(19):! --- DEF PRINTSYMBOL(M) ; PRINTSYMBOL('('); ! FUNCTION NAME PVARN(ANALREC(I+3)) ; PRINTSTRING(')='); ! PARAMETER NAME PRINTEXPR(I+4); ! FUNCTION BODY ->LISTLOOP ! ! ! LISTLOOP:NEWLINE LCL == LC(LCL_LINK) ; LNUM = ANALREC(LCL_PTR) %REPEAT NEWLINES(2) %END;! END OF LIST ! ! ! %ROUTINE OUTSTRING(%INTEGER PT %INTEGERNAME LENTH) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! USED IN PLACE OF 'PRSTRING WHEN 'SAVE'ING & ! A SOURCE FILE & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,J,ADDRESS ADDRESS = ADDR(ANALREC(PT)) %CYCLE I=1,1,BYTEINTEGER(ADDRESS) J = BYTEINTEGER(ADDRESS+I) PRINTSYMBOL(J) ; PRINTSYMBOL('''') %IF J=''''; ! DOUBLE UP IMBEDDED QUOTES %REPEAT LENTH = BYTEINTEGER(ADDRESS) %END ! ! ! %ROUTINE RESEQUENCE !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! RESEQUENCES ALL LINES IN 'ANALREC' AND CHANGES ALL & ! JUMP DESTINATIONS ACCORDINGLY & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %RECORDFORMAT RSEQF(%SHORTINTEGER OLD,NEW) %RECORDARRAY RSEQ(1:NLINES) (RSEQF) %INTEGER PTR,RSPT,LNUM,STEP,MAXL,K %SWITCH RS(1:19) %ROUTINE REPLACE(%INTEGERNAME LNUM) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! THIS ROUTINE SEARCHES THE LIST 'RSEQ' & ! FOR A MATCH FOR 'LNUM' IN THE 'OLD' & ! SUBFIELD AND REPLACES IT WITH THE & ! 'NEW' VALUE & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I %CYCLE I=1,1,NLINES LNUM = RSEQ(I)_NEW %ANDRETURN %IF RSEQ(I)_OLD=LNUM %REPEAT LNUM = 0 %END %RETURNIF NLINES=0; ! NOTHING TO RESEQUENCE MAXL = 9999//NLINES; ! MAXIMUM STEP SIZE %IF NSYM=CR %THEN STEP = 10 %ELSESTART; ! DEFAULT %IF READ(STEP)#0 %OR STEP<1 %THEN PRINT SYNTAX %ANDRETURN;! READ GIVEN STEP SIZE %FINISH PTR = LC(0)_LINK LNUM = STEP ; RSPT = 1 %WHILE PTR>0 %CYCLE !**************************************************** ! EXAMINE EACH INSTRUCTION, STORE ITS OLD AND * ! NEW LINE NUMBERS IN 'RSEQ', AND UPDATE ITS * ! OLD LINE NUMBER * !**************************************************** CELL == LC(PTR) RSEQ(RSPT)_OLD = ANALREC(CELL_PTR); ! INSERT OLD NO. RSEQ(RSPT)_NEW = LNUM; ! INSERT OLD ANALREC(CELL_PTR) = LNUM; ! REPLACE OLD WITH NEW LNUM = LNUM+STEP; ! UPDATE NEW PTR = CELL_LINK ; RSPT = RSPT+1; ! LINK TO NEXT %REPEAT CELL == LC(0) %WHILE CELL_LINK#0 %CYCLE !**************************************************** ! EXAMINE EACH INSTRUCTION, PICK OUT 'GOTO', * ! 'GOSUB', 'IF' & 'ON' AND UPDATE THEIR LABEL * ! NUMBERS * !**************************************************** CELL == LC(CELL_LINK) ->RS(ANALREC(CELL_PTR+1)) RS(5):RS(12):REPLACE(ANALREC(CELL_PTR+2)); ! 'GOTO', 'GOSUB' ->RSOUT RS(6): REPLACE(ANALREC(ANALREC(ANALREC(CELL_PTR+2))+1)); ! 'IF' ->RSOUT RS(17): K = ANALREC(CELL_PTR+2); ! 'ON' %CYCLE K=K+1,1,K+ANALREC(K) REPLACE(ANALREC(K)) %REPEAT RS(1):RS(2):RS(3):RS(4):RS(7): RS(8):RS(9):RS(10):RS(11):RS(13): RS(14):RS(15):RS(16):RS(18):RS(19): RSOUT: %REPEAT REPLACE(LLNUM); ! UPDATE LINE NUMBER OF HIGHEST LINE %END;! END OF RESEQUENCE %END;! END OF OBEY ! ! ! %ROUTINE COMPILE !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! COMPILE THE STORED PROGRAM & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %ROUTINESPEC DEC MAT %ROUTINESPEC DECLARE(%INTEGER DIM) %ROUTINESPEC DEC VAR %ROUTINESPEC DEC EXPR %INTEGERFNSPEC FINDLAB %INTEGER I,VAR,DIM %INTEGER FTOP; ! TOP OF THE 'FOR' STACK %INTEGER ONPT; ! POINTER INTO 'ONLIST' %INTEGER PT; ! POINTER INTO 'ANALREC' %RECORDNAME CELL (RF2); ! CURRENT LINE-CELL %RECORDNAME VART (RF3) %SWITCH COMPILE(0:19),MATC(0:8) %INTEGERARRAY FS(1:26); ! 'FOR' STACK %CYCLE I='A',1,'Z' FNLIST(I) = 0; ! CLEAR FNLIST !********************************************************************* ! FNLIST HAS THE FOLLOWING MEANINGS * ! -1 -- FN USED BUT NOT YET DEFINED * ! 0 -- FN NOT YET USED * ! >0 -- POINTER TO THE ANALYSIS RECORD POSITION OF * ! THE FN DEFINITION * !********************************************************************* %REPEAT %CYCLE I=0,1,285 VT(I)_DESC = 0; ! CLEAR VARIABLE DESCRIPTORS %REPEAT FTOP = 0 ; ONPT = 1 ; DATPT2 = 1 CELL == LC(0) ; ANALREC(ANALRECPT)=0 ; CELL_PTR=ANALRECPT-1 !********************************************************************* ! ARRAY,LABEL AND FUNCTION DECLARATION LOOP * ! _________________________________________ * ! THIS LOOP PERFORMS THE FOLLOWING FUNCTIONS:- * ! A) SETS VT_D1&VT_D2 (UPPER BOUNDS) FOR ARRAYS * ! B) CONVERTS LABEL NUMBERS INTO LINE CELL POINTERS * ! AND STORES THESE (FOR GOTO,GOSUB,IF & ON) * ! C) CHECKS THAT FOR'S AND NEXT'S BALANCE * ! D) CHECKS THAT ALL FN CALLS HAVE A CORRESPONDING * ! FUNCTION BODY * ! E) INSERTS THE CONSTANTS FROM 'DATA' STATEMENTS INTO * ! 'DATARR' * !********************************************************************* COMLOOP:COMPILE(13):COMPILE(15):COMPILE(16):COMPILE(18): CELL == LC(CELL_LINK); ! CELL = CURRENT LINE CELL PT=CELL_PTR+2 ; LNUM=ANALREC(CELL_PTR); ! PT POINTS TO LOCN. AFTER INST. CODE ->COMPILE(ANALREC(PT-1)); ! LNUM = LINE NUMBER ! ! ! COMPILE(0): !******************************************************************* ! HAVE REACHED THE END OF THE ANALYSIS RECORD WITHOUT * ! HITTING AN 'END' STATEMENT * !******************************************************************* LNUM = 9999; ! DUMMY LINE NUMBER PHOLT(3) ; ->COMPILE(11) ! ! ! COMPILE(1): ! *** LET *** DEC VAR; ! L.H.S. DEC EXPR; ! R.H.S. ->COMLOOP ! ! ! COMPILE(2):COMPILE(14): ! *** READ *** INPUT *** PT=PT+1 %CYCLE I=1,1,ANALREC(PT-1) DEC VAR %REPEAT ->COMLOOP ! ! ! COMPILE(3): ! *** DATA *** PT=PT+1 !************************************************** ! TAKE THE VALUES FROM 'ANALREC' AND PUT THEM * ! INTO 'DATARR' * !************************************************** %CYCLE I=1,1,ANALREC(PT-1) %IF DATPT2>1280 %THEN PHOLT(2) %ANDEXIT DATARR(DATPT2)=REAL(ADDR(ANALREC(PT))) ; PT=PT+1 DATPT2 = DATPT2+1 %REPEAT ->COMLOOP ! ! ! COMPILE(4): ! *** PRINT *** I = ANALREC(PT) ; PT = PT+1 %WHILE I>0 %CYCLE %IF ANALREC(PT)&1=0 %THEN PT=PT+1 %AND DEC EXPR %ELSEC PT=PT+2+ANALREC(PT+1)>>26 I = I-1 %REPEAT ->COMLOOP ! ! ! COMPILE(5):COMPILE(12): ! *** GOTO *** GOSUB *** CELL_DATA = FINDLAB; ! FIND CORRESPONDING LINE CELL PHOLT(4) %IF CELL_DATA=0; ! LABEL DOES NOT EXIST ->COMLOOP ! ! ! COMPILE(6): ! *** IF *** DEC EXPR ; DEC EXPR ; PT=PT+1 ; ->COMPILE(5) ! ! ! COMPILE(7): ! *** MAT *** %IF ANALREC(PT)>1 %START; ! READ, INPUT OR PRINT %CYCLE PT = PT+2,1,PT+1+ANALREC(PT+1) DECMAT %REPEAT ->COMLOOP %FINISH PT = PT+1 ; DECMAT; ! DECLARE L.H.S. MATRIX PT = PT+2 ->MATC(ANALREC(PT-1)) MATC(0):DEC EXPR MATC(4):MATC(8):DEC MAT MATC(5):MATC(6):MATC(7):->COMLOOP MATC(1):MATC(2):MATC(3):DEC MAT PT = PT+1 ; ->MATC(4) ! ! ! COMPILE(8): ! *** FOR *** VAR=ANALREC(PT) ; PT=PT+1 VART == VT(VAR) !******************************************** ! CHECK THAT THE VARIABLE IS NOT * ! ALREADY IN USE AS A CONTROL VARIABLE * !******************************************** %IF VART_DESC&4#0 %THEN PHOLT(5) %AND ->COMLOOP VART_DESC=VART_DESC!4; ! MARK DESCRIPTOR %IF FTOP=26 %THEN PHOLT(12) %ELSE FTOP = FTOP+1 %AND FS(FTOP)%C = VAR; ! STACK VARIABLE NAME DEC EXPR ; DEC EXPR; ! INITIAL AND FINAL VALUES %IF ANALREC(PT)=1 %THEN PT = PT+1 %AND DEC EXPR; ! STEP VALUE ->COMLOOP ! ! ! COMPILE(9): ! *** NEXT *** VAR=ANALREC(PT) !******************************************** ! CHECK THAT 'VAR' IS EQUAL TO THE * ! VARIABLE ON TOP OF THE STACK * !******************************************** %IF FTOP=0 %OR FS(FTOP)#VAR %THEN PHOLT(6) %ELSE FTOP = FTOP-1 VT(VAR)_DESC=VT(VAR)_DESC&3; ! CLEAR DESCRIPTOR ->COMLOOP ! ! ! COMPILE(10): ! *** DIM *** PT=PT+1 %CYCLE I=1,1,ANALREC(PT-1) %IF ANALREC(PT+2)=0 %THEN DIM=1 %ELSE DIM=2 DECLARE(DIM) VART == VT(ANALREC(PT)) VART_D1=ANALREC(PT+1)+1 ; VART_D2=ANALREC(PT+2)+1; ! SET UPPER BOUNDS PT=PT+3 %REPEAT ->COMLOOP ! ! ! COMPILE(17): ! *** ON *** DEC EXPR; ! SWITCH EXPRESSION !*************************************************** ! INSERT THE LINE CELL POINTERS CORRESPONDING * ! TO THE LINE NUMBERS IN 'ONLIST' AND INSERT * ! THE POINTER INTO 'ONLIST' (ONPT-1) INTO * ! 'CELL_DATA' * !*************************************************** CELL_DATA = ONPT-1 %CYCLE I=1,1,ANALREC(PT) PT = PT+1 ; J = FINDLAB; ! FIND LINE-CELL NUMBER %IF J=0 %THEN PHOLT(4); ! LINE DOES NOT EXIST ONLIST(ONPT)=J ; ONPT=ONPT+1; ! INSERT LINE-CELL NUMBER %IF ONPT=51 %THEN ONPT = 50 %AND PHOLT(11); ! MAXIMUM OF 50 IN PROGRAM %REPEAT ->COMLOOP ! ! ! COMPILE(19): ! *** DEF *** I = ANALREC(PT) %IF FNLIST(I)>0 %THEN PHOLT(7); ! FN DEFINED TWICE FNLIST(I) = PT+1 ; PT = PT+2 ; DEC EXPR ; ->COMLOOP ! ! ! COMPILE(11): ! *** END *** %WHILE FTOP>0 %CYCLE PRINTSTRING('*** ''NEXT'' MISSING '); ! 'NEXT' MISSING PVARN(FS(FTOP)) ; FTOP = FTOP-1 FAULTS = FAULTS+1 ; NEWLINE %REPEAT %CYCLE I='A',1,'Z' %IF FNLIST(I)<0 %START; ! FN BODY MISSING PRINTSTRING('*** FN NOT DEFINED ') ; PRINTSYMBOL(I) NEWLINE ; FAULTS = FAULTS+1 %FINISH %REPEAT ARRPT = 286; ! POINTER TO FREE STORE %CYCLE I=0,1,285; ! SET UP ARRAY START ADDRESSES VART == VT(I) ; VART_DESC = VART_DESC&3 %IF VART_DESC>0 %START; ! VAR USED AS AN ARRAY J = VART_D1*VART_D2; ! J = NO OF ELEMENTS IN ARRAY %IF ARRPT+J<2000 %START VART_ADDR = ARRPT ; ARRPT = ARRPT+J %FINISHELSE PHOLT(9) %ANDEXIT; ! TOO MANY ELEMENTS %FINISH %REPEAT %INTEGERFN FINDLAB !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! RETURNS THE LINE CELL POINTER OF THE LINE WITH LABEL & ! ANALREC(PT) & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,L,J I=LC(0)_LINK ; L=ANALREC(PT); ! I=LINE CELL POINTER %CYCLE J=ANALREC(LC(I)_PTR); ! GET LABEL NUMBER %RESULT=I %IF L=J; ! FOUND IT I = LC(I)_LINK; ! LINK TO NEXT %RESULT=0 %IF L>13 DECLARE(DIM) ; PT = PT+1; ! DECLARE VARIABLE %WHILE DIM>0 %CYCLE DEC EXPR ; DIM = DIM-1; ! DECLARE PARAMETERS %REPEAT %END ! ! ! %ROUTINE DEC EXPR !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! ANALYSES AN EXPRESSION DECLARING VARIABLES AND FUNCTIONS & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER FINISH,I ; %SWITCH SW(1:9) FINISH=ANALREC(PT) ; PT=PT+1 LOOP:SW(4):SW(5):SW(6):SW(7):SW(8):SW(9):%RETURNIF PT>=FINISH PT=PT+1 ; ->SW(ANALREC(PT-1)) !**************************** ! VARIABLE * !**************************** SW(1):DEC VAR ; ->LOOP; ! DECLARE THE VARIABLE !**************************** ! CONSTANT !**************************** SW(2):PT=PT+1 ; ->LOOP; ! SKIP CONSTANT !**************************** ! FUNCTION * !**************************** SW(3):I = ANALREC(PT); ! FUNCTION NAME %IF I>20 %START; ! USER DECLARED FUNCTION FNLIST(I) = -1 %IF FNLIST(I)=0; ! MARK USE OF THIS FUNCTION %FINISH PT=PT+1 ; DEC EXPR ; ->LOOP; ! DECLARE PARAMETER EXPRESSION %END ! ! ! %END;! END OF COMPILE ! ! ! %ROUTINE EXECUTE !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! EXECUTES THE STORED PROGRAM & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %INTEGERFNSPEC RREAD(%REALNAME R) %INTEGERFNSPEC ADDRESS %REALFNSPEC EVAL EXPR %INTEGER SUBPT; ! SUBROUTINE DEPTH %INTEGER DATPT1; ! POINTER TO BOTTOM OF 'DATA' BLOCK %INTEGER FTOP; ! POINTER TO 'FOR' STACK %INTEGER LPT; ! POINTER TO LINE-CELL OF NEXT INST. %INTEGER PT; ! POINTER INTO 'ANALREC' %INTEGER INST; ! CURRENT INSTRUCTION %INTEGER RAND; ! USED TO GENERATE RANDOM NUMBERS %INTEGER I,J,K,L,M,VAR %SWITCH EXECUTE(1:19),COND(2:19),MATIN(0:1) %SWITCH MATE1(1:4),MATE2(0:8) %RECORDNAME CELL (RF2); ! LINE BEING EXECUTED %RECORDNAME CURRENTFS (RF1); ! TOP OF 'FOR' STACK %RECORDNAME VART,VART1,VART2 (RF3) %REALNAME XN %REAL X,Y,Z,W %RECORDARRAY FS(1:26) (RF1) %SHORTINTEGERARRAY SUBSTACK(1:26); ! STACK FOR GOSUB RETURN POINTERS FTOP = 0 ; FLT=0 ; SUBPT=0 ; DATPT1 = 1 LINEL = 0; ! CURRENT OUTPUT LINE LENGTH %CYCLE I=0,1,ARRPT ARRSPACE(I) = 0; ! CLEAR STORE %REPEAT CELL == LC(0) ; LPT = CELL_LINK RAND = 1234567 NEWLINES(4) !********************************************************************* ! INTERPRETATION LOOP ! ______________ ____ !********************************************************************* ->INTLOOP NEXTEXEC:%RETURNIF FLT#0 INTLOOP:EXECUTE(3):EXECUTE(10):EXECUTE(16):EXECUTE(19): ! DATA, DIM, REM, DEF %IF TESTINT(0,'EXIT')#0 %THEN RUNFOLT(17) %ANDRETURN; ! CONSOLE INTERRUPT CELL == LC(LPT) PT=CELL_PTR+2 ; LNUM=ANALREC(CELL_PTR) ; LPT = CELL_LINK INST = ANALREC(CELL_PTR+1) ->EXECUTE(INST) ! ! ! EXECUTE(1): ! *** LET *** I = ADDRESS; ! EVALUATE ADDRESS OF L.H.S. ARRSPACE(I) = EVAL EXPR; ! ASSIGN R.H.S. TO L.H.S. ->NEXTEXEC ! ! ! EXECUTE(2):EXECUTE(14): ! *** READ *** INPUT *** PT = PT+1 ; J = INST//10 %CYCLE I=1,1,ANALREC(PT-1) XN == ARRSPACE(ADDRESS) %IF J=0 %START RUNFOLT(3) %ANDEXITIF DATPT1=DATPT2; ! OUT OF DATA XN = DATARR(DATPT1) ; DATPT1 = DATPT1+1 %FINISHELSESTART %EXITIF RREAD(XN)#0; ! SYMBOL IN DATA %FINISH %REPEAT ->NEXTEXEC ! ! ! EXECUTE(4): ! *** PRINT *** K = ANALREC(PT) ; J = 0 ; PT = PT+1 %WHILE K>0 %CYCLE J = ANALREC(PT) ; PT = PT+1 NEWLINE %AND LINEL=0 %IF LINEL>=70; ! AUTOMATIC LINE FEED %IF J&1=0 %START; ! EXPRESSION PRINT(EVAL EXPR) %FINISHELSESTART; ! STRING PRSTRING(PT,I) ; PT = PT+I>>2+1; ! ADD LENGTH TO PT LINEL = LINEL+I %FINISH J = J>>1 %IF J=2 %THEN M=8 %ELSE M=14 I = LINEL-LINEL//M*M SPACES(M-I) %AND LINEL = LINEL+M-I %IF I>0; ! TAB K = K-1 %REPEAT NEWLINE %AND LINEL = 0 %IF J=0 ->NEXTEXEC ! ! ! EXECUTE(5): ! *** GOTO *** LPT = CELL_DATA ; ->INTLOOP ! ! ! EXECUTE(6): ! *** IF *** X=EVAL EXPR ; X = X-EVAL EXPR; ! X = FIRST-SECOND %IF MOD(X)<0.000001 %THEN I=0 %ELSESTART; ! I = SIGN(X) %IF X<0 %THEN I=-1 %ELSE I=1 %FINISH ->COND(3*ANALREC(PT)+I) COND(2):COND(5):COND(6):COND(10):COND(12):COND(13):COND(15): COND(17):COND(19):LPT = CELL_DATA; ! CONDITION TRUE COND(3):COND(4):COND(7):COND(8):COND(9):COND(11):COND(14): COND(16):COND(18):->NEXTEXEC; ! CONDITION FALSE ! ! ! EXECUTE(7): ! *** MAT *** PT = PT+1 ; ->MATE1(ANALREC(PT-1)) !************************** ! ASSIGNMENT * !************************** MATE1(1):VART == VT(ANALREC(PT)) PT = PT+2 ->MATE2(ANALREC(PT-1)) ! ! ** SCALAR MULTIPLICATION ** MATE2(0):X = EVAL EXPR; ! X =SCALAR MULTIPLIER VART1 == VT(ANALREC(PT)) RUNFOLT(0) %UNLESS VART_D1=VART1_D1 %AND VART_D2=VART1_D2 J = ADDR(ARRSPACE(VART1_ADDR)) %CYCLE I = VART_ADDR,1,VART_ADDR+VART_D1*VART_D2-1 ARRSPACE(I) = X*REAL(J); ! MULTIPLY EACH ELEMENT BY X J = J+4 %REPEAT ->NEXTEXEC ! ! ** ADDITION ** SUBTRACTION ** MATE2(1):MATE2(2):L = ANALREC(PT-1)-1 VART1 == VT(ANALREC(PT)) ; VART2 == VT(ANALREC(PT+1)) RUNFOLT(0) %IF VART_D1#VART1_D1 %OR VART_D1#VART2_D1 %ORC VART_D2#VART1_D2 %OR VART_D2#VART2_D2 J = ADDR(ARRSPACE(VART1_ADDR)) ; K = ADDR(ARRSPACE(VART2_ADDR)) %IF L=0 %START %CYCLE I=VART_ADDR,1,VART_ADDR+VART_D1*VART_D2-1 ARRSPACE(I) = REAL(J)+REAL(K); ! ADD ELEMENTS J = J+4 ; K = K+4 %REPEAT %FINISHELSESTART %CYCLE I=VART_ADDR,1,VART_ADDR+VART_D1*VART_D2-1 ARRSPACE(I) = ARRSPACE(J)-ARRSPACE(K); ! SUBTRACT ELEMENTS J = J+1 ; K = K+1 %REPEAT %FINISH ->NEXTEXEC ! ! ** MULTIPLICATION ** MATE2(3):VART1 == VT(ANALREC(PT)) ; VART2 == VT(ANALREC(PT+1)) RUNFOLT(0) %IF VART_D1#VART1_D1 %OR VART_D2#VART2_D2 %ORC VART1_D2#VART2_D1 %BEGIN %REALARRAYFORMAT RF(1:VART_D1,1:VART_D2) %REALARRAYFORMAT RF1(1:VART1_D1,1:VART1_D2) %REALARRAYFORMAT RF2(1:VART2_D1,1:VART2_D2) %REALARRAYNAME A,A1,A2 %LONGREALARRAY AA(1:VART_D1,1:VART_D2) %LONGREALARRAY B(1:VART1_D1,1:VART1_D2) %LONGREALARRAY C(1:VART2_D1,1:VART2_D2) A == ARRAY(ADDR(ARRSPACE(VART_ADDR)),RF) A1 == ARRAY(ADDR(ARRSPACE(VART1_ADDR)),RF1) A2 == ARRAY(ADDR(ARRSPACE(VART2_ADDR)),RF2) %CYCLE I=1,1,VART1_D1 %CYCLE J=1,1,VART1_D2 B(I,J) = A1(I,J); ! COPY MULTIPLICAND INTO 'B' %REPEAT %REPEAT %CYCLE I=1,1,VART2_D1 %CYCLE J=1,1,VART2_D2 C(I,J) = A2(I,J); ! COPY MULTIPLIER INTO 'C' %REPEAT %REPEAT MULT MATRIX(AA,B,C,VART1_D1,VART1_D2,VART2_D2); ! CALCULATE 'AA = B * C' %CYCLE I=1,1,VART_D1 %CYCLE J=1,1,VART_D2 A(I,J) = AA(I,J); ! COPY 'AA' INTO DESTINATION %REPEAT %REPEAT %END ->NEXTEXEC ! ! ** INVERSE ** MATE2(4):VART1 == VT(ANALREC(PT)) RUNFOLT(0) %UNLESS VART1_D1=VART1_D2=VART_D1 %ANDC VART_D1=VART_D2; ! BOTH MATRICES MUST BE SQUARE %BEGIN %REALARRAYFORMAT AF(1:VART_D1,1:VART_D2) %REALARRAYNAME A %LONGREAL DET %LONGREALARRAY X,Y(1:VART_D1,1:VART_D2) A == ARRAY(ADDR(ARRSPACE(VART1_ADDR)),AF) %CYCLE I=1,1,VART_D1 %CYCLE J=1,1,VART_D2 X(I,J) = A(I,J); ! COPY OPERAND INTO X %REPEAT %REPEAT INVERT(Y,X,VART_D1,DET); ! INVERT X INTO Y A == ARRAY(ADDR(ARRSPACE(VART_ADDR)),AF) %CYCLE I=1,1,VART_D1 %CYCLE J=1,1,VART_D2 A(I,J) = Y(I,J); ! COPY Y INTO DESTINATION %REPEAT %REPEAT %END ->NEXTEXEC ! ! ** IDENTITY MATRIX ** ZERO MATRIX ** MATE2(5):RUNFOLT(0) %UNLESS VART_D1=VART_D2 ; ! MATRIX MUST BE SQUARE MATE2(6):L = 6-ANALREC(PT-1) ; X = 0 MATE2LL:%CYCLE I=VART_ADDR,1,VART_ADDR+VART_D1*VART_D2-1 ARRSPACE(I) = X; ! SET ENTIRE MATRIX TO 'X' %REPEAT ->NEXTEXEC %IF L=0 %CYCLE I=VART_ADDR,VART_D1+1,VART_ADDR+VART_D1*VART_D1-1 ARRSPACE(I) = 1; ! SET DIAGONAL TO '1' %REPEAT ->NEXTEXEC ! ! ** ALL ONES ** MATE2(7):L = 0 ; X = 1.0 ; ->MATE2LL ! ! ** TRANSPOSE ** MATE2(8):VART1 == VT(ANALREC(PT)) RUNFOLT(0) %UNLESS VART_D1=VART1_D2 %AND VART_D2=VART1_D1 %BEGIN %REALARRAYFORMAT A2(0:VART_D1-1,0:VART_D2-1) %REALARRAYNAME AN %REALARRAY A(0:VART1_D1-1,0:VART1_D2-1) AN == ARRAY(ADDR(ARRSPACE(VART1_ADDR)),A) %CYCLE I=0,1,VART1_D1-1 %CYCLE J=0,1,VART1_D2-1 A(I,J) = AN(I,J); ! COPY SOURCE INTO 'A' %REPEAT %REPEAT AN == ARRAY(ADDR(ARRSPACE(VART_ADDR)),A2) %CYCLE I=0,1,VART1_D1-1 %CYCLE J=0,1,VART1_D2-1 AN(J,I) = A(I,J); ! TRANSPOSE 'A' INTO DESTINATION %REPEAT %REPEAT %END ->NEXTEXEC !****************************** ! READ, INPUT !****************************** MATE1(2):MATE1(4):L = ANALREC(PT-1)>>2 %CYCLE I=1,1,ANALREC(PT) PT = PT+1 VART == VT(ANALREC(PT)) %CYCLE J=VART_ADDR,1,VART_D1-1+VART_ADDR %CYCLE K=0,1,VART_D2-1 XN == ARRSPACE(J+K*VART_D1) ->MATIN(L) MATIN(0): RUNFOLT(3) %ANDRETURNIF DATPT1=DATPT2; ! OUT OF DATA XN = DATARR(DATPT1) DATPT1 = DATPT1+1 ; ->MATINL MATIN(1): RUNFOLT(2) %ANDRETURNIF RREAD(XN)#0; ! SYMBOL IN DATA MATINL: %REPEAT %REPEAT %REPEAT ->NEXTEXEC !***************************** ! PRINT !***************************** MATE1(3):%CYCLE I=1,1,ANALREC(PT) PT = PT+1 %IF ANALREC(PT)>>9#0 %THEN M=8 %ELSE M=14 %IF LINEL>0 %THEN LINEL=0 %AND NEWLINE; ! TAKE A NEW LINE VART == VT(ANALREC(PT)&511) %CYCLE J=VART_ADDR,1,VART_D1-1+VART_ADDR %CYCLE K=0,1,VART_D2-1 LINEL = 0 %AND NEWLINE %IF LINEL>=70 PRINT(ARRSPACE(J+K*VART_D1)) L = LINEL-LINEL//M*M SPACES(M-L) %AND LINEL = LINEL+M-L %IF L>0; ! TAB %REPEAT NEWLINE ; LINEL = 0 %REPEAT NEWLINE %REPEAT ->NEXTEXEC ! ! ! EXECUTE(8): ! *** FOR *** %IF FTOP=26 %THEN RUNFOLT(-1) %ANDRETURN; ! 'FOR'S TOO DEEP VAR=ANALREC(PT) ; PT=PT+1 X = EVAL EXPR ; Z = EVAL EXPR; ! INITIAL VALUE, FINAL VALUE %IF ANALREC(PT)=1 %THEN PT = PT+1 %AND Y = EVAL EXPR %ELSE Y=1.0;! STEP VALUE RUNFOLT(5) %UNLESS Y#0; ! STEP MUST BE NON-ZERO %IF Y>=0 %THEN W = 1.0 %ELSE W = -1.0; ! W = DIRECTION OF INCREMENT %IF X*W>Z*W %START !******************************************************* ! BOUNDS INSIDE OUT.SO SKIP UNTIL AFTER THE 'NEXT' * ! INSTRUCTION * !******************************************************* %UNTIL ANALREC(PT-1)=9 %AND ANALREC(PT)=VAR %CYCLE CELL == LC(LPT) PT = CELL_PTR+2 ; LNUM = ANALREC(CELL_PTR) ; LPT = CELL_LINK %REPEAT %FINISHELSESTART; ! STACK A 'FOR' RECORD ARRSPACE(VAR) = X; ! ASSIGN INITIAL VALUE FTOP = FTOP+1 CURRENTFS == FS(FTOP) CURRENTFS_STEP = Y ; CURRENTFS_FINAL = Z CURRENTFS_LABEL = LPT ; CURRENTFS_VAR = VAR %FINISH ->NEXTEXEC ! ! ! EXECUTE(9): ! *** NEXT *** VAR = ANALREC(PT) ; XN == ARRSPACE(VAR) EXEC9:RUNFOLT(6) %ANDRETURNIF FTOP=0; ! NO MATCH WITH 'FOR' %IF VAR#CURRENTFS_VAR %START !************************************************** ! HAVE EITHER JUMPED INTO A 'FOR' LOOP OR * ! JUMPED OUT OF AN INNER ONE. SO UNSTACK * ! LOOKING FOR THE CORRECT 'NEXT'. * ! PROBLEM:- * ! 100 FOR I = ... <<<< * ! ... ^ * ! 150 GOTO 300 ^ * ! ... ^ * ! 200 NEXT I ^ * ! ... ^ * ! 250 FOR I = ... ^ * ! ... ^ * ! 300 ... ^ * ! ... ^ * ! 350 NEXT I >>>> * !************************************************** FTOP = FTOP-1 ; CURRENTFS == FS(FTOP) %IF FTOP>0 ->EXEC9 %FINISH %IF CURRENTFS_STEP>0 %THEN X = 1.0 %ELSE X = -1.0; ! X = DIRECTION OF INCREMENT XN = XN+CURRENTFS_STEP; ! ADD STEP TO CURRENT VALUE %IF XN*X<=CURRENTFS_FINAL*X %START; ! TEST AGAINST FINAL VALUE LPT = CURRENTFS_LABEL; ! BRANCH BACK %FINISHELSESTART FTOP = FTOP-1; ! UNSTACK RECORD %IF FTOP>0 %THEN CURRENTFS == FS(FTOP); ! SET 'CURRENTFS' TO POINT TO NEXT OUTER LOOP %FINISH ->INTLOOP ! ! ! EXECUTE(12): ! *** GOSUB *** SUBPT = SUBPT+1 ; RUNFOLT(7) %IF SUBPT=27; ! STACK OVERFLOW SUBSTACK(SUBPT)=LPT; ! STACK RETURN POINTER LPT = CELL_DATA ; ->NEXTEXEC ! ! ! EXECUTE(13): ! *** RETURN *** RUNFOLT(8) %IF SUBPT=0; ! STACK UNDERFLOW LPT=SUBSTACK(SUBPT) ; SUBPT=SUBPT-1; ! UNSTACK POINTER ->NEXTEXEC ! ! ! EXECUTE(17): ! *** ON *** I = INT(EVAL EXPR); ! EVALUATE SWITCH EXPRESSION LPT = ONLIST(CELL_DATA+I) %IF 1<=I<=ANALREC(PT); ! IF VALUE IS IN RANGE, JUMP ->NEXTEXEC ! ! ! EXECUTE(18): ! *** RESTORE *** DATPT1 = 1 ; ->INTLOOP; ! RESET 'DATA' BLOCK POINTER ! ! ! EXECUTE(11):EXECUTE(15):%RETURN ! ! ! %INTEGERFN RREAD(%REALNAME R) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! INPUT A NUMBER & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE PROMPT('?') GETSYM %IF NSYM=','; ! SKIP ',' READLINE %IF NSYM=CR; ! SKIP END-OF-LINE RUNFOLT(2) %ANDRESULT=1 %IF READR(R)#0; ! READ NUMBER %RESULT=0 %END ! ! ! %INTEGERFN ADDRESS !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! RETURNS THE ADDRESS (RELATIVE TO & ! 'ARRSPACE') OF THE VARIABLE POINTED TO & ! BY 'PT'. & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER VAR,DIM,D1,D2 %RECORDNAME VART (RF3) VAR=ANALREC(PT)&511 ; DIM=ANALREC(PT)>>13 ; PT=PT+1 VART == VT(VAR) %RESULT=VAR %IF DIM=0; ! SCALAR D1 = INT(EVAL EXPR); ! EVALUATE FIRST PARAMETER RUNFOLT(1) %ANDRESULT=-1 %UNLESS 0<=D1=FINISH PT=PT+1 ; ->SW(ANALREC(PT-1)) !***************************************** ! VARIABLE * !***************************************** SW(1):REAL(EVPT)=ARRSPACE(ADDRESS); ! STACK VARIABLE VALUE INC:EVPT=EVPT+4 ; ->LOOP !***************************************** ! CONSTANT * !***************************************** SW(2):REAL(EVPT)=REAL(ADDR(ANALREC(PT))) ; PT=PT+1; ! STACK CONSTANT VALUE ->INC !***************************************** ! FUNCTION CALL * !***************************************** SW(3):PT=PT+1 ; XN == REAL(EVPT) I = ANALREC(PT-1) %IF I>20 %START; ! USER FN XN = APPLY FN(I,EVAL EXPR) ; ->INC %FINISHELSE ->FN(I); ! LIBRARY FN FN(1):XN = INTPT(EVAL EXPR) ; ->INC; ! * INT * FN(2):XN = RANDOM(RAND,1) ; PT =ANALREC(PT) ; ->INC; ! * RND * FN(3):XN = SIN(EVAL EXPR) ; ->INC; ! * SIN * FN(4):XN = COS(EVAL EXPR) ; ->INC; ! * COS * FN(5):XN = TAN(EVAL EXPR) ; ->INC; ! * TAN * FN(6):XN = ARCTAN(1,EVAL EXPR) ; ->INC; ! * ATN * FN(7):XN = EXP(EVAL EXPR) ; ->INC; ! * EXP * FN(8):X = EVAL EXPR; ! * LOG * %IF X=0 %START RUNFOLT(14) ; INTEGER(EVPT) = X'FFFFFFFF'; ! -INFINITY ->INC %FINISH %IF X<0 %THEN RUNFOLT(13) %AND X = -X; ! TAKE LOG OF MODULUS XN = LOG(X) ; ->INC FN(9):XN = MOD(EVAL EXPR) ; ->INC; ! * ABS * FN(10):X = EVAL EXPR; ! * SQR * %IF X<0 %THEN RUNFOLT(12) %AND X=-X; ! TAKE SQRT OF MODULUS XN = SQRT(X) ; ->INC FN(11):XN = EVAL EXPR; ! * SGN * %IF XN>0 %THEN XN=1.0 %ELSESTART %IF XN<0 %THEN XN=-1.0 %FINISH ->INC !********************************* ! + * !********************************* SW(4):EVPT=EVPT-4 REAL(EVPT-4)=REAL(EVPT-4)+REAL(EVPT) ; ->LOOP; ! ADD !********************************* ! - * !********************************* SW(5):EVPT=EVPT-4 REAL(EVPT-4)=REAL(EVPT-4)-REAL(EVPT) ; ->LOOP; ! SUBTRACT !********************************* ! * * !********************************* SW(6):EVPT=EVPT-4 REAL(EVPT-4)=REAL(EVPT-4)*REAL(EVPT) ; ->LOOP; ! MULTIPLY !********************************* ! / * !********************************* SW(7):EVPT=EVPT-4 XN == REAL(EVPT) ; YN == REAL(EVPT-4) %IF XN=0 %THEN RUNFOLT(11) %AND INTEGER(EVPT-4) = X'7FFFFFFF' %C %ELSE YN = YN/XN; ! DIVIDE ->LOOP !********************************* ! ^ * !********************************* SW(8):EVPT=EVPT-4 XN == REAL(EVPT-4) ; YN == REAL(EVPT); ! YN==TOP OF STACK : XN ==SECOND TOP %IF XN=0 %START; ! MANTISSA ZERO %IF YN<0 %START RUNFOLT(15) ; INTEGER(EVPT-4) = X'7FFFFFFF' ; ->LOOP;! ZERO TO NEG. POWER, +INFINITY %FINISH %IF YN=0 %THEN XN = 1.0 %ELSE XN = 0; ! 0**0=1 : 0**X=0 %FINISHELSESTART %IF ISINT(YN)#0 %THEN XN = XN**INT(YN) %ELSESTART; ! INTEGRAL EXPONENT %IF XN<0 %THEN RUNFOLT(16) %AND XN = -XN; ! NEGATIVE FRACTIONAL EXPONENT XN = EXP(YN*LOG(XN)); ! EXPONENTIATE %FINISH %FINISH ->LOOP !********************************* ! UNARY - * !********************************* SW(9):REAL(EVPT-4) = -REAL(EVPT-4) ; ->LOOP; ! NEGATE %END;! END OF EVAL EXPR ! ! ! %END;! END OF EXECUTE ! ! ! %INTEGERFN GET LINE CELL !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! THIS ROUTINE GETS A NEW CELL, CHECKS TO SEE IF THE LINE & ! IS EMPTY, AND, IF NOT, INSERTS IT INTO THE LIST & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %OWNINTEGER LASTCPT %INTEGER PREVIOUS CELL,J,THIS CELL %RECORDNAME LCL (RF2) THIS CELL = ASL ; ASL = LC(ASL)_LINK; ! GET A NEW CELL CELL == LC(THIS CELL) %IF LNUM>LLNUM %START; ! LINE IS IN ORDER CELL_LINK=0; ! SO ADD IT TO THE END OF LC(LASTCPT)_LINK=THIS CELL; ! THE LIST PREVIOUS CELL = LASTCPT; ! POINTER TO PREVIOUS LINE-CELL LASTCPT = THIS CELL; ! UPDATE LAST CELL POINTER LLNUM=LNUM; ! UPDATE LAST LINE NUMBER %FINISHELSESTART; ! LINE OUT OF ORDER,SO CHAIN DOWN J = 0 ; LCL == LC(0); ! THE LIST TO FIND ITS POSITION %CYCLE PREVIOUS CELL = J ; J = LCL_LINK ; LCL == LC(J); ! CHAIN TO NEXT %IF ANALREC(LCL_PTR)=LNUM %START; ! LINE ALREADY EXISTS CELL_LINK = ASL ; ASL = THIS CELL; ! RETURN LINE CELL NLINES = NLINES-1; ! DECREMENT LINE COUNT FAULTS = FAULTS-1 %IF LCL_DATA<0; ! REMOVE FAULT FLAG CELL == LCL ; %EXIT; ! USE EXISTING CELL %FINISH %IF ANALREC(LCL_PTR)>LNUM %START; ! LINE TO INSERT CELL_LINK = J; ! UPDATE THIS LINK LC(PREVIOUS CELL)_LINK = THIS CELL; ! UPDATE PREVIOUS LINK %EXIT %FINISH %REPEAT %FINISH %RESULT=1 %IF NSYM#CR !***************************************** ! LINE IS EMPTY, DELETE IT * !***************************************** LC(PREVIOUS CELL)_LINK = CELL_LINK; ! BYPASS CELL %IF LLNUM=LNUM %START; ! LINE WAS HIGHEST SO FAR LLNUM = ANALREC(LC(PREVIOUS CELL)_PTR) ; LASTCPT = PREVIOUS CELL %FINISH CELL_LINK = ASL ; ASL = THIS CELL; ! RETURN THE CELL %RESULT=0 %END;! END OF GET LINE CELL ! ! ! %ROUTINE PRINT SYNTAX !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! MONITOR A SYNTAX FAULT & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %SHORTROUTINE %INTEGER I,J PRINTSTRING('** SYNTAX ') ; J = 1 %UNTIL I=CR %CYCLE I = LINE(J) ; PRINTSYMBOL(I) ; J = J+1; ! PRINT FAULTY LINE %REPEAT SPACES(11+LINEPT) ; PRINTSYMBOL('^') ; NEWLINE; ! MARK POSITION OF FAULT %END ! ! ! !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! NOW THE REAL ACTION STARTS! & !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SELECTINPUT(1) PRINTSTRING(' E.C.S.D. BASIC Interpreter Version 1E.') NEWLINES(4) LINE(80) = CR ; LINEL = 0 %CYCLE I=1,1,254 LC(I)_LINK = I+1; ! INITIALISE LINE-CELL LIST %REPEAT LC(255)_LINK = 0 ASL = 1 RUNFLAG = 0 ; DUMPFL = 0 ANALRECPT = 1 ; NLINES = 0 LC(0) = 0 ; ANALREC(0) = 0 FAULTS = 0 ; LLNUM = 0 INPUT LOOP:PROMPT(':') %UNTIL RUNFLAG#0 %CYCLE; ! LOOP UNTIL A 'RUN' COMMAND !************************************************************************************** ! MAIN INPUT LOOP * ! THIS HAS TWO FUNCTIONS:- * ! 1). ANALYSE AND STORE ALL 'BASIC' INSTRUCTIONS * ! 2). RECOGNISE AND OBEY ALL COMMANDS * !-------------------------------------------------------------------------------------* READLINE; ! FILL INPUT BUFFER %IF READ(LNUM)#0 %START; ! ** COMMAND ** %IF STREAM=0 %START; ! CHECK INPUT STREAM LINEPT = 0 ; GETSYM; ! RESTORE NSYM OBEY(ANALINST(2)); ! LOOK FOR AND OBEY COMMAND %FINISHELSE PRINT SYNTAX; ! INVALID IF NOT FROM CONSOLE %FINISHELSESTART; ! ** INSTRUCTION ** %IF 00 %START PRINT FAULTS(FAULTS,'SEMANTIC') FAULTS=0 ; ->INPUT LOOP %FINISH EXECUTE; ! EXECUTE THE PROGRAM STOP:PRINTSTRING(' STOPPED AT LINE') WRITE(LNUM) ; NEWLINES(8) ->INPUT LOOP F9: SELECTINPUT(0) ; CLOSESTREAM(1) ; STREAM = 0 ; ->INPUT LOOP F1: PRINTSTRING('INTERPRETER FAILURE 1') NEWLINE ; %STOP F24:RUNFOLT(10) ; ->STOP F2: RUNFOLT(9) ; ->STOP %ENDOFPROGRAM