?COMPILE 0XBASIC/UTILITY WITH XALGOL ?XALGOL STACK = 5000 ?DATA CARD $ CARD LIST SINGLE XREF BEGIN COMMENT::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ::::: XBASIC -- A CONVERSATIONAL BASIC INTERPRETER ::::: ::::: ::::: ::::: MK XV 1.04: 1 DECEMBER 1975 ::::: ::::: ::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: XBASIC IS A BASIC INTERPRETER DEVELOPED FOR THE BURROUGHS RANGE OF COMPUTERS BY STAFF AT PAISLEY COLLEGE OF TECHNOLOGY. ITS PURPOSE IS TO PROVIDE FAST RESPONSE TO SIMPLE BASIC PROGRAMS UNDER TIME- SHARING. ACTUAL RUNNING OF PROGRAMS IS MUCH SLOWER FOR XBASIC, BUT EXPERIENCE SHOWS THAT MOST CLASS TIME IS SPENT ON INPUT AND COMPILE. XBASIC IS AN IMPLEMENTATION OF STANDARD BASIC, AND DIFFERS FROM BURROUGHS BASIC IN CERTAIN MATTERS OF DETAIL. THE COMMANDS ALLOWED IN XBASIC FORM A SUBSET OF THE COMMANDS AVAILABLE UNDER CANDE. FILES ARE EDITABLE UNDER CANDE. TRACE AND UNTRACE STATEMENTS CAN BE MADE AVAILABLE - SEE LINES 83300-83400 AND 107300-108700. XBASIC OUTPUT MAY BE DIVERTED FROM REMOTE TO PRINTER ("SEND"). VIDEO TERMINALS ARE SUPPORTED FOR EASY CORRECTION OF SOURCE PROGRAM. PROGRAMS ARE MONITORED FOR EXCESS LOOPING. TO USE XBASIC FROM THE BATCH TERMINAL, THE FOLLOWING CARDS SHOULD BE SUPPLIED: ? EXECUTE 0XBASIC/UTILITY ? COMMON=2 ? DATA CRD (INSERT DECK HERE: USE TERMINAL FORMAT) ? END :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; COMMENT THE BLOCK STRUCTURE FOR THE PROGRAM IS AS FOLLOWS: ------------- /------| 1 SOURCEIN: 1 / DOES | START-->--1 & EXECUTE 1--RUN->----< OBJECT >--YES--->---| 1 1 COMMANDS 1 | EXIST? / 1 A ------------- |------| V 1 1 1 1 1 1 (YES) V (NO) 1 1 /------| 1 1 1 / ANY | ------------- 1 1 < SYNTAX >------<----1 COMPILE: 1 1 1 | ERRORS?/ 1 1 1 1 |------/ ------------- 1 1 1 1 1 V (NO) 1 1 1 1 1 ------------- 1 |---<---1 EXECUTE: 1------------------<--------------/ ------------- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; INTEGER IU; % (COMMON) INPUT UNIT=0 VDU,1 TTY,2 CRD INTEGER ARRAY PROG[0:200,2:11], % SOURCE STRINGS SSEQ[0:200], % SEQUENCE NUMBERS STYP, % STATEMENT TYPES SPOB[1:200], % POINTERS TO OBJECTPROGRAM SUB[1:26], % INFO ON USER FUNCTIONS ARR[1:26,0:2], % ARRAYS STRAR[1:26,0:1], % STRING ARRAYS IOB[1:240],IOF[1:10], % I/O PSEUDOBUFFERS IOBE[1:14], % " " KEY[1:38], % COMPILE KEYWORDS FNM[1:3,1:2]; % FILENAMES FOR EXECUTE REAL ARRAY OBJ[0:999], % PSEUDO-OBJECTPROGRAM FORX[1:10,1:4], % INFO ON FOR STATEMENTS CONST[1:1000], % SOURCE PROGRAM CONSTANTS ANSA[0:9], % FOR DISK SEARCH IO[0:3]; % FILENAMES INTEGER MS, % NUMBER OF LINES OF PROGRAM ACS, % FIRST EXECUTABLE STATEMENT CS, % CURRENT STATEMENT NUMBER CHA, % CURRENT SOURCE CHARACTER CP, % POSITION OF CHA IN SOURCE LP, % SEE LOOK CO, % POSITION IN OBJ OU, % OUTPUT UNIT (0 REMOTE, 1 PRINTER) MSTO, % CURRENT TOP OF ARRAYS MSTR, % CURRENT TOP OF STRING ARRAYS NCON, % NUMBER OF CONSTANTS DELIM, % SEE NCH TIM, % MAX EXECUTION TIME (2 MIN USUALLY) LL, % CURRENT LINE NUMBER IN INPUT PAGE AREASIZE, % FOR EXECUTE OUTPUT FILE IF ANY BEG, % LIST COMMAND INITIAL LINE EN, % FINAL LINE NDEP, % ARITH STACK COUNTER ADDR, % CURRENT VARIABLE ADDRESS FORE,FORC, % HELP COMPILE FOR NESTS NF, % NUMBER OF EXECUTE FILES A,B,C,D,K; % HASH REAL R,S,T; % HASH BOOLEAN OBJECT, % "THERE IS AN ORJECTPROGRAM" STRIN, % "EXPRESSION IS A STRING" HDDR, % "PRINTER HEADER PRINTED" INFILTOG, % "PROGRAM NEEDS INPUT FILE" OUTFILTOG, % "PROGRAM NEEDS OUTPUT FILE" FIRSTOFF, % "HELLO" DANGER, % "NEW MATERIAL IN WORKFILE" VAR, % "EXPRESSION IS A VARIABLE" SY, % "PROGRAM CONTAINS SYNTAX ERRORS" EQOK, % "EXPRESSION MAY CONTAIN =" AA; % "SUCCESSIVE EXPNS TO PRINT" POINTER PINB, % START OF LINE IN IOB[*] PIOB, % CURRENT CHARACTER " PIBE, % LAST CHARACTER IN IOBE[1] POB, % FIRST CHARCTER IN OBJ[*] APR,BPR,CPR; % HASH FORMAT WHT ("ERR- ",A6," IS NOT A COMMAND IN XBASIC"), STP (/"END ",A6), SPC (/), WRN ("MORE THAN 100 GOTOS. IS YOUR PROGRAM ALL RIGHT?"), REP (A3), SYER ("SYNTAX ERRORS: CLEAR SCREEN AND TRANSMIT A SPACE"), SYR ("SYNTAX ERRORS:"), WT ("WAIT-"), MESS ("EXECUTING"), INTR ("ILLEGAL NUMBER"), LNGPRG("PROGRAM TOO LONG AT LINE ",I6), INVIT ("VDU ASSUMED - ELSE SAY TTY"), DVO ("OUTPUT IS BEING DIVERTED TO PRINTER"), BK ("EXECUTION STOPPED - EXCESS TIME."/ "FOR LONG PROGRAMS USE MAIN SYSTEM"), SNUM (X72,I8), F1 ("USE RENAME XXXXXX OR SAVE XXXXXX COMMAND"), F2 ("ERR? THIS WILL DELETE THE WORKFILE"), F3 ("OK- ",I3," RECORDS",A6,"D, LAST RECORD =",I7), F4 ("FILE ",A6," - ",A6,A1," BY XBASIC"), F5 ("YOUR WORKFILE IS AS AT LAST RUN COMMAND"), F6 (I6,X3,"DIM OR FILES STATEMENT OUT OF SEQUENCE"/ "ERR RUN"), F7 ("WORKFILE NOW EMPTY"), HD1 ("FURTHER OUTPUT WILL BE PRINTED WHEN YOU SIGN OFF"), HD3 (X40,"XBASIC MK XV",X8,"RUN ",A6,"DAY ", A2,"/",A2,"/",A2,/X54,"USER NO. ",A3,A4,/X52,20("*")//), F9 ("XBASIC IS RUNNING-"), F10 ("UNNAMED WORKFILE HAS",I4," RECORDS, LAST RECORD =",I6), F11 (A6," (WORKFILE) HAS",I4," RECORDS, LAST RECORD =",I6), F12 ("ERR- ILLEGAL PARAMETER"), F13 ("ARE PRESENT CONTENTS OF FILE ",A6," TO BE DESTROYED?"); SWITCH FORMAT NUM:=(U10),(U6),(X20,U10); SWITCH FORMAT MNP:=("NOT ENOUGH INPUT AT LINE",I6,X5,"TRY AGAIN"), ("BLANK INPUT AT LINE",I6,X5,"IGNORED"); FILE TTY 19(2,10);FILE IN CRD 2(2,10); FILE IN VDU 19(1,240); FILE OUT LIN 1(2,14);SWITCH FILE FN:=TTY,CRD;SWITCH FILE FL:=TTY,LIN; MONITOR INTOVR,EXPOVR,INDEX,FLAG,ZERO; LABEL SOURCEIN,COMPILE,EXECUTE,STOP,FINSH,ERR,INCST,PER,INER, TOOLONG; LABEL EXS,EQL,LET,CAR,ONX,RON,IFF,FEQ,GOT,GOS,RET,FOX,NEX, DEF,REA,RREA,INP,RAN,RES,PRI,RPRI,XPRI,DIM,ENX,REM,RFIL, INTVR,QUOTE,RDUM,DAT,RDAT,RDIM,PAG,MAT,IOMT,FLAGR,FIL,CGO; SWITCH OPN:=LET,GOT,GOS,RET,INP,REA,PRI,FOX,NEX,MAT, DEF,DAT,RAN,PAG,RES,REM,ENX,ENX,IFF,ONX; DEFINE ON(ON1)=IF CHA=ON1 THEN #; COMMENT::::::::::::::::GLOBAL PROCEDURES::::::::::::::::::::::::::: --- CHCONV CONVERTS CHA TO LETTER CODE 1-26 ; INTEGER PROCEDURE CHCONV(A);VALUE A; INTEGER A; BEGIN CHCONV:=0;IF A GTR 16 AND A LSS 26 THEN CHCONV:=A-16 ELSE IF A GTR 32 AND A LSS 42 THEN CHCONV:=A-23 ELSE IF A GTR 49 AND A LSS 58 THEN CHCONV:=A-31 END; COMMENT --- NCH PICKS NEXT CHARACTER FROM SOURCE STRING AND STORE IT IN CHA. BLANKS ARE SKIPPED. IF LAST CHAR- RETURN "%" AT DELIM. CP IS UPDATED. IOBE[*] IS USED AS HASH.; INTEGER PROCEDURE NCH; BEGIN INTEGER A;LABEL RPT; POINTER CPR; IOBE[1]:=0;A:=CP; RPT: IF A GEQ DELIM THEN CHA:=NCH:="%" ELSE BEGIN CPR:=POINTER(PROG[CS,2])+A; REPLACE PIBE BY CPR:CPR FOR 1;A:=A+1; IF IOBE[1]=48 THEN GO TO RPT;CHA:=NCH:=IOBE[1];CP:=A END END; COMMENT --- NMBR PICKS UP STATEMENT NUMBER ; INTEGER PROCEDURE NMBR(N);VALUE N;INTEGER N; BEGIN LABEL DONE,RNB,BLK,NST,SKB; DEFINE RD(RD1)=REPLACE BPR BY APR:APR FOR 1; IF DELTA(PINB,APR) GEQ RD1 THEN GO BLK;IF IOBE[1]#; CHA:=NMBR:=IOBE[1]:=0; NST: RD(N)=48 THEN GO NST;IF (CHA:=IOBE[1]) GEQ 10 THEN GO DONE; RNB: RD(72) LSS 10 THEN BEGIN CHA:=CHA|10+IOBE[1];GO RNB END; NMBR:=CHA;CHA:=IOBE[1];IF CHA NEQ 48 THEN GO DONE; SKB: RD(72)=48 THEN GO SKB;CHA:=IOBE[1];GO DONE; BLK: CHA:="%"; DONE: END; COMMENT --- FILECONTROL DEALS WITH SOURCE FILE OPERATIONS A=0 "MAKE"/"RENAME", 1 "SAVE", 2 "LOAD"/"COPY", 3 "REMOVE", 4 SAVE WORKFILE(AT "RUN") 5 LOAD WORKFILE(AT XBASIC ENTRY), 6 EXPLICIT REMOVE (AT "BYE",ETC) 7 EXPLICIT SAVE, 8 EXPLICIT LOAD; PROCEDURE FILECONTROL(A,C,D,L);VALUE A,C,D;INTEGER A;REAL C,D;LABEL L; % C AND D CARRY LABEL EQUATE FOR EXPLICIT OPERATIONS BEGIN INTEGER B,X,Y; PROCEDURE FILERR(E);VALUE E;INTEGER E; BEGIN SWITCH FORMAT ERR:=("ERR- ",A3,A4,"/",A3,A4,"- NOT ON DISK"), ("ERR- ",A3,A4,"/",A3,A4," - INVALID USER"), ("ERR- ",A3,A4,"/",A3,A4," - NON-STANDARD"), ("ERR- ",A3,A4,"/",A3,A4," - ILLEGAL NAME"), ("ERR- ",A3,A4,"/",A3,A4," - DUPLICATE NAME"), ("ERR- NO FILENAME"), ("ERR- WORKFILE"), ("ERR- WORKFILE IS EMPTY"); IF E>4 THEN WRITE(TTY,ERR[E]) ELSE WRITE(TTY,ERR[E], FOR X:=B,2 DO [IO[X].[41:18],IO[X].[23:24]]); IF B=0 THEN IO[0]:=0;IF A=1 AND E=3 THEN WRITE(TTY,F1); GO SOURCEIN END; LABEL SKIP,MK,SV,LD,RM,EF,SW,LW,EW; SWITCH OP:=MK,SV,LD,RM,SW,LW,RM,SV,LD; FILE DSK DISK "XBWKFL "(2,10,300,SAVE 7);% NB LABEL EQN ABOVE SKIP IF DANGER AND (C="CREATE" OR A=2 OR A=6) THEN BEGIN DANGER:=FALSE; WRITE(TTY,F2);GO SOURCEIN END; B:=IF A=0 THEN 0 ELSE 1;IF A>3 THEN BEGIN FILL DSK WITH C,D;IO[1]:=C;IO[2]:=D;GO SKIP END; IO[B]:=" "; % FILENAME SCAN APR:APR FOR 5 UNTIL NEQ " ";IF DELTA(PINB,APR)<12 THEN REPLACE POINTER(IO[B])+1 BY APR:APR FOR IF A<2 THEN 6 ELSE 7 WHILE IN ALPHA; IF IO[B]=" " THEN BEGIN % ON SAVE SAVE WKFILE IF NO NAME IF A=1 AND IO[0] NEQ 0 THEN IO[1]:=IO[0] ELSE FILERR(5) END; IO[2]:=0;IF A GTR 1 THEN BEGIN % PROCESS "/USERCODE" IF PRESENT SCAN CPR:CPR:=APR FOR 10 WHILE NEQ "/";IF DELTA(PINB,CPR) LSS 15 THEN BEGIN IO[2]:=" "; REPLACE POINTER(IO[2])+1 BY APR:CPR+1 FOR 7 WHILE IN ALPHA END END; IF IO[2]=0 THEN IO[2]:=TIME(-1); IF IO[B]="XBWKFL " OR IO[B].[41:36] LSS "A00000" THEN FILERR(3); FILL DSK WITH IO[B],IO[2];DSK.SAVE:=7; SKIP: IF NOT FIRSTOFF THEN BEGIN X:=CHA;Y:=NMBR(72); IF Y NEQ 0 OR CHA NEQ "%" THEN GO PER;CHA:=X END; SEARCH(DSK,ANSA[*]);IF (A=5 OR A=6) AND ANSA[0]=-1 THEN GO L; IF A=0 AND ANSA[0] NEQ -1 THEN FILERR(4); IF A=1 AND IO[1] NEQ IO[0] AND ANSA[0] NEQ -1 THEN FILERR(4); IF A>1 AND A NEQ 4 THEN BEGIN IF ANSA[0] LEQ 0 THEN FILERR(ANSA[0]+1); IF ANSA[3] NEQ 10 OR ANSA[4] NEQ 300 THEN FILERR(2) END; IF CHA="MAKE00" THEN BEGIN MS:=0;OBJECT:=FALSE END; GO OP[A+1]; SV: IF IO[0]=0 THEN IO[0]:=IO[B]; % NAME WORKFILE IF MS=0 THEN FILERR(7);IF ANSA[0] NEQ -1 AND ANSA[0] NEQ 7 THEN FILERR(1);DSK.AREAS:=20;DSK.AREASIZE:=10; FOR CS:=1 STEP 1 UNTIL MS DO BEGIN % SAVE IT IN CANDE FORMAT REPLACE POINTER(IOBE[10]) BY SSEQ[CS] FOR 8 DIGITS; REPLACE POINTER(IOBE[*]) BY POINTER(PROG[CS,2]) FOR 9 WORDS; WRITE(DSK,10,IOBE[*]) END;LOCK(DSK);DANGER:=FALSE;GO MK; LD: FOR MS:=1 STEP 1 UNTIL 200 DO BEGIN % LOAD FROM READ(DSK,10,IOBE[*])[EF];READ(IOBE[*],SNUM,SSEQ[MS]); % CANDE FORMAT WRITE(PROG[MS,*],9,IOBE[*]);PROG[MS,11]:=SSEQ[MS] END; EF: MS:=MS-1;OBJECT:=FALSE;LOCK(DSK); WRITE(TTY,F3,MS,C,SSEQ[MS]); ON("LOAD00") IO[0]:=IF IO[2]=TIME(-1) THEN IO[1] ELSE 0;GO MK; RM: IF IO[B]=IO[0] AND A=3 THEN BEGIN IF MS=0 THEN IO[0]:=0 ELSE FILERR(6) END;IF ANSA[0] NEQ 7 THEN FILERR(1); WRITE(DSK,*,0);CLOSE(DSK,PURGE);GO MK; SW: DSK.AREAS:=20;DSK.AREASIZE:=11; IF MS=0 THEN FILERR(7); WRITE(DSK,*,IO[0]);FOR CS:=1 STEP 1 UNTIL MS DO WRITE(DSK,10,PROG[CS,*]);LOCK(DSK);DANGER:=FALSE;GO MK; LW: READ(DSK,*,IO[0]);FOR MS:=1 STEP 1 UNTIL 200 DO BEGIN READ(DSK,10,PROG[MS,*])[EW];SSEQ[MS]:=PROG[MS,11] END; EW: LOCK(DSK);MS:=MS-1;OBJECT:=FALSE;GO MK; MK: IF A<4 AND CHA NEQ "COPY00" THEN WRITE(TTY,F4,IO[B].[41:36],C,D); IF A=5 THEN WRITE(TTY,F5); IF CHA="COPY00" THEN WRITE(TTY,STP,"COPY "); GO L END; COMMENT --- SYNT DEALS WITH SYNTAX ERRORS ; PROCEDURE SYNT(A);VALUE A;REAL A; BEGIN IF SY THEN BEGIN IF IU=0 THEN BEGIN WRITE(TTY,SYER); READ(TTY[STOP]) END ELSE WRITE(TTY,SYR);SY:=FALSE END; REPLACE APR:=POINTER(IOBE[*]) BY " " FOR 72; WRITE(IOBE[*],NUM[0],SSEQ[CS]);SCAN APR:APR WHILE NEQ 48; IF IU=0 THEN BEGIN REPLACE APR:APR BY POINTER(PROG[CS,*]) FOR 72; APR:=POINTER(IOBE[*])+72; REPLACE APR:APR BY "!" FOR 1 END ELSE APR:=APR+3; REPLACE POB BY A FOR 8;REPLACE APR BY POB+1 FOR 7; OBJ[1]:=0;REPLACE POB+7 BY POINTER(IOBE[*])+79 FOR 1; IF IU GTR 0 THEN WRITE(TTY,9,IOBE[*]) ELSE IF OBJ[1]=48 THEN WRITE(TTY,10,IOBE[*]) ELSE WRITE(TTY[NO],10,IOBE[*]);GO TO ERR END; COMMENT --- NWC MODIFIES NCH FOR COMPILE ; INTEGER PROCEDURE NWC; BEGIN ON("%") SYNT("MISG OP");NWC:=NCH END; COMMENT --- PUT STORES CHARACTER IN OBJ ; PROCEDURE PUT(A);VALUE A;INTEGER A; BEGIN IF A>63 THEN SYNT("STR >63"); IOBE[1]:=A;REPLACE POB+CO BY PIBE FOR 1;CO:=CO+1; IF CO GEQ 8000 THEN GO TO TOOLONG;IF CO MOD 8=0 THEN CO:=CO+1 END; COMMENT --- RED MOVES BACK ONE SPACE IN OBJ; DEFINE RED=CO:=IF CO.[2:3]=1 THEN CO-2 ELSE CO-1#; COMMENT --- LOOK LOOKS AT A STRING IN SOURCE PROG ; INTEGER PROCEDURE LOOK(A);VALUE A;INTEGER A; BEGIN INTEGER B,C,D,E;E:=C:=CHA;B:=CP; FOR D:=1 STEP 1 UNTIL A-1 DO IF CHA NEQ "%" THEN C:=C|64+NWC; LOOK:=C;LP:=CP;CP:=B;CHA:=E END; COMMENT --- NUMB PICKS UP DIM AND MAT SIZES ; INTEGER PROCEDURE NUMB; BEGIN LABEL RP;INTEGER A; A:=0; RP: IF NWC LSS 10 THEN BEGIN A:=A|10+CHA;GO TO RP END; IF A=0 THEN SYNT("IL STMT"); NUMB:=A END; COMMENT --- ARITH(1) CONVERTS EXPNS TO REVERSE POLISH ; PROCEDURE ARITH(TT);VALUE TT;INTEGER TT; BEGIN INTEGER I,A,B,C,J,K,OP,STCK;BOOLEAN INMOK,VOK,STROK; LABEL S,SS,RPT,EXPON,DONE,FINEV,FORM1,FORM2,FORM3,FIN,RP; INTEGER ARRAY OPK[1:20]; COMMENT AN EXPRESSION CONSISTS OF A NUMBER OF PRIMARIES SEPARATED BY OPERATORS, POSSIBLY PRECEDED BY INITIAL - . PRIMARIES: OPERATORS: NUMBER + VARIABLE - ARRAY WITH SUBSCRIPT(S) * FUNCTION WITH PARAMETER(S) / STRING ** STRING VARIABLE = STRING ARRAY WITH SUBSCRIPT EXPRESSION IN BRACKETS EXPRESSION HAS TYPE REAL UNLESS STRING PRIMARY OCCURS: IF SO IT HAS TYPE STRING. A VARIABLE PRIMARY IS A PRIMARY OTHER THAN NUMBER, FUNCTION, OR STRING. IN OBJ AN EXPRESSION HAS FORM A OPS A OPS ... A OPS 0 WHERE A IS A CHARACTER BETWEEN 1 AND 16 GIVING THE PRIMARY OR OPERATOR TYPE. OPS IS 0-2 CHARACTERS GIVING MORE INFORMATION DEPENDING ON A. ; STRIN:=FALSE;NDEP:=NDEP+1;IF NDEP=10 THEN SYNT("SIMPLFY"); STCK:=OP:=0;INMOK:=VOK:=TRUE;STROK:=TT=0; COMMENT PRIMARIES: ; SS: CHA:=NWC; COMMENT BRACKETED EXPRESSION; S: ON(29) BEGIN ARITH(1);IF CHA NEQ 45 THEN SYNT("NO ) ,A"); RED;GO TO FORM1 END; COMMENT 1 NUMBER ; IF CHA LSS 10 OR CHA = 26 THEN BEGIN R:=I:=0; RPT: ON(26) BEGIN I:=1;CHA:=NWC END; IF CHA GEQ 10 THEN GO TO EXPON;IF I>0 THEN BEGIN R:=R+CHA|10*(-I); I:=I+1 END ELSE R:=R|10+CHA;CHA:=NWC; GO TO RPT; EXPON: IF CHA NEQ 21 THEN GO TO DONE;I:=1;CHA:=NWC;J:=0; ON(44) BEGIN I:=-1;CHA:=NWC END ELSE ON(16) CHA:=NWC;J:=CHA; IF CHA GEQ 10 THEN SYNT("NO EXPN");CHA:=NWC; IF CHA LSS 10 THEN BEGIN J:=J|10+CHA;CHA:=NWC END;R:=R|10*(I|J); DONE: PUT(1);NCON:=NCON+1;CONST[NCON]:=R; PUT(NCON.[11:6]);PUT(NCON.[5:6]);GO FORM2 END; COMMENT 8 INITIAL - ; ON(44) BEGIN IF NOT INMOK THEN SYNT ("MISPL -");PUT(8); GO TO FORM2 END; COMMENT 16 STRING ; ON(63) BEGIN IF NOT STROK THEN SYNT("ILL STR");PUT(16); SCAN CPR:APR:=POINTER(PROG[CS,2])+CP WHILE NEQ 63;A:=DELTA(APR,CPR); STRIN:=TRUE;IF A>14 THEN SYNT("LONGSTR");PUT(A);PUT(CP); CP:=CP+A+1;CHA:=NWC;VAR:=FALSE;GO TO FORM3 END; IF CHCONV(CHA)=0 THEN SYNT("ILL NUM"); B:=CHA;A:=LOOK(2) MOD 64;IF CHCONV(A) NEQ 0 THEN BEGIN A:=LOOK(3) MOD 4096;CHA:=B; IF A NEQ "ST" AND A NEQ "TH" AND A NEQ"TO" AND A NEQ "GO" THEN BEGIN LABEL EQL,FNQ,RDUM; COMMENT 5 STANDARD FNS; INTEGER B,AS,AP; B:=LOOK(3);CP:=LP; FOR A:=21 STEP 1 UNTIL 32 DO IF B=KEY[A] THEN GO TO EQL; GO TO FNQ; EQL: IF NWC NEQ 29 THEN SYNT("NO PARM");ARITH(1);RED; PUT(5);PUT(A-2); IF CHA NEQ 45 THEN SYNT("NO ) A");GO TO FORM1; COMMENT 4 USER FNS ; FNQ: K:=B DIV 64; IF K NEQ "FN" THEN SYNT("UNRC FN"); B:=CHCONV(B MOD 64);IF SUB[B]=0 THEN SYNT("UNDC FN"); IF NWC NEQ 29 THEN SYNT("NO PARM");A:=0; RDUM: A:=A+1;ARITH(1);RED;ON(58) GO TO RDUM; IF CHA NEQ 45 OR A NEQ SUB[B] THEN SYNT("PARAMTR"); CHA:=NWC;PUT(4);PUT(B);GO TO FORM2 END END; B:=CHCONV(B);IF B=0 THEN SYNT("INV VAR");CHA:=NWC; COMMENT 3 ARRAY ; ON(29) BEGIN IF ARR[B,1]=0 THEN SYNT("UNDC AR"); ARITH(1);RED;ON(58) BEGIN IF ARR[B,2]=0 THEN SYNT("SUBSCPT"); ARITH(1);RED END;IF CHA NEQ 45 THEN SYNT("SUBSCPT");STROK:=FALSE; PUT(3);PUT(B);CHA:=NWC END ELSE ON("$") BEGIN IF NOT STROK THEN SYNT("ILL STR"); COMMENT 15 STRING ARRAY; CHA:=NWC;ON(29)BEGIN IF STRAR[B,1]=0 THEN SYNT("UNDSTAR");ARITH(1); RED; IF CHA NEQ 45 THEN SYNT("NO ) ,5");PUT(15);CHA:=NWC END ELSE PUT(14);PUT(B);STRIN:=TRUE;VAR:=VOK;GO TO FORM3 END ELSE BEGIN PUT(2);PUT(B);IF CHA LSS 10 THEN BEGIN PUT(C:=CHA+1); COMMENT 14 STRING VBLE 2 VARIABLE ; CHA:=NCH END ELSE PUT(C:=0);IF STCK=0 THEN ADDR:=11|(B-1)+C; STROK:=FALSE END;VAR:=VOK;GO TO FORM3; FORM1: CHA:=NWC; FORM2: STROK:=VAR:=FALSE;IF STRIN THEN SYNT("ILL STR"); COMMENT 7-13 OPERATORS: DANGER: REVERSE POLISH SECTION ; FORM3: BEGIN LABEL RPT,TEST,BOP,XOP; STCK:=STCK+1;INMOK:=FALSE; RPT: I:=0;ON(16) I:=3 ELSE ON(44) I:=4 ELSE ON(43) BEGIN IF NWC=43 THEN I:=7 ELSE BEGIN CP:=CP-1;I:=5 END; END ELSE ON(49) I:=6 ELSE IF CHA=61 AND EQOK THEN BEGIN INMOK:=TRUE; IF NOT VAR THEN SYNT("ILL ASN");I:=1 END;VOK:=I LEQ 1; IF NOT VOK THEN BEGIN STROK:=FALSE;IF STRIN THEN SYNT("ILL STR") END; TEST: IF OP=0 THEN GO TO BOP; IF OP LSS 0 THEN SYNT(" ARITH"); J:=OPK[OP];IF I|J NEQ 1 AND (I+1) DIV 2 LEQ (J+1) DIV 2 THEN BEGIN OP:=OP-1;GO TO XOP END; BOP: IF I=0 THEN GO TO FIN;OP:=OP+1;OPK[OP]:=1;GO TO SS; XOP: VAR:=FALSE;STCK:=STCK-1; PUT(J+6);IF STCK LEQ 0 THEN SYNT(" ARITH"); GO TO TEST END; COMMENT 6 END EXPN ; FIN: NDEP:=NDEP-1;IF STCK NEQ 1 THEN SYNT(" ARITH"); PUT(0) END; COMMENT --- SKIP SKIPS GIVEN STRING IF FOUND ; PROCEDURE SKIP(A,B);VALUE A,B;INTEGER A,B; BEGIN INTEGER C,D,E;E:=CP;C:=NWC; FOR D:=1 STEP 1 UNTIL A-1 DO IF CHA NEQ "%" THEN C:=C|64+NWC; IF C NEQ B THEN BEGIN CP:=E;CHA:=0 END END; COMMENT --- CHMAT CHECK USED IN MAT STATEMENT ; INTEGER PROCEDURE CHMAT(A);VALUE A;INTEGER A; BEGIN A:=CHCONV(A);IF A=0 THEN SYNT("ILL ARR"); IF ARR[A,1]=0 THEN SYNT("UNDC AR");IF ARR[A,2]=0 THEN SYNT(" TYPE");CHMAT:=A END; COMMENT ---- CFN FOR FILE INPUT ANO OUTPUT; PROCEDURE CFN; BEGIN LABEL L,M; CHA:=NWC;IF LOOK(4)="FILE" THEN BEGIN CP:=LP;D:=IF A=15 THEN 5 ELSE A; FOR C:=1 STEP 1 UNTIL NF DO BEGIN CHA:=NWC;B:=LOOK(FNM[2,C]); IF B=FNM[1,C] THEN BEGIN IF FNM[3,C]=0 THEN FNM[3,C]:=D ELSE IF D NEQ FNM[3,C] THEN SYNT("IN+OUT?");CP:=LP;PUT(A);IF D=5 THEN INFILTOG:=TRUE;IF A=7 THEN OUTFILTOG:=TRUE; IF NWC=":" THEN BEGIN A:=NUMB;FOR B:=ACS STEP 1 UNTIL MS DO IF A=SSEQ[B] THEN BEGIN PUT(B.[11:6]);PUT(B.[5:6]);GO ON(58) L ELSE M END;SYNT("UNDF GO") END;PUT(0);PUT(0);ON(58) GO L; GO TO M END ELSE BEGIN CP:=CP-1;CHA:=0 END END;SYNT("UNDC FL") END; PUT(0);ON("%") GO TO M;CP:=CP-1;CHA:=0;GO TO L; M: IF A=5 THEN SYNT("NOINPUT");PUT(0);GO TO INCST; L: END; COMMENT------------------------------------------------------- ----------- XBASIC STARTS HERE ----------------- -------------------------------------------------------------; FIRSTOFF:=IU NEQ 2;IF IU=2 THEN TTY.TYPE:=1; PIBE:=POINTER(IOBE[1])+7; PINB:=POINTER(IOB[1]); DELIM:=72;TIM:=10800;LL:=-1; OBJECT:=HDDR:=FALSE;OU:=0; FILL KEY[*] WITH "LET","GOT","GOS","RET","INP", "REA","PRI","FOR","NFX","MAT","DEF","DAT", "RAN","PAG","RES","REM","STO","END","IF ","ON ","SIN","COS", "TAN","ATN","EXP","LOG","ABS","INT","SQR","FIX","SGN","RND", "EQ","LT","LE","GT","GE","NE"; COMMENT------------------------------------------------------ ------------SOURCEIN: FOR INPUT OF SOURCE PROGRAM ------- ------------ AND EXECUTION OF COMMANDS ------- -----------------------------------------------------------------; COMMENT: COMMANDS ALLOWED IN XBASIC HELLO SAME AS BYE BYE TERMINATES XBASIC. PRINTER OUTPUT IS SCHEDULED RUN EXECUTES PROGRAM IF FREE OF SYNTAX ERRORS SCR DELETES WORKFILE DELETE SAME AS SCR LIST LISTS ENTIRE WORKFILE LIST E WHERE E IS A NUMBER OF ELEMENTS OF FORM N OR M-N (M,N STATEMENT NUMBERS) SEPARATED BY COMMAS. LISTS PART OF PROGRAM MAKE NNNNNN INITIALISES AND NAMES WORKFILE SAVE SAVES WORKFILE IF NAMED SAVE NNNNNN SAVES WORKFILE IN NNNNNN. NAMES WORKFILE IF NOT ALREADY NAMED LOAD NNNNNN LOADS WORKFILE AND NAMES IT LOAD NNNNNN/UUUUUUU COPIES WORKFILE FROM NNNNNN/UUUUUUU WORKFILE BECOMES UNNAMED COPY NNNNNN COPIES NNNNNN INTO WORKFILE COPY NNNNNN/UUUUUUU SAME FOR NNNNNN/UUUUUUU REMOVE NNNNNN REMOVES FILE NNNNNN/USER NO. RENAME NNNNNN RENAMES WORKFILE PLOP RESETS WORKFILE TO LAST RUN STATUS WHATS OBTAINS WORKFILE STATUS TTY INPUT UNIT IS TTY VDU INPUT UNIT IS VDU SEND DIVERTS OUTPUT TO PRINTER NOSEND TERMINATES DIVERSION OF OUTPUT TIME N RESETS MAX EXECUTION TIME TO N MINUTES -------------------------------------------------------------; SOURCEIN: BEGIN LABEL SOURCEIN,EF,COPY,NEWL,SOURCE,RMOB, FST; INTOVR:=INER; IF FIRSTOFF THEN BEGIN FILECONTROL(5,"XBWKFL ",TIME(-1),FST); FST: IF IU=0 THEN WRITE(TTY,INVIT);FIRSTOFF:=FALSE END; IF LL=-1 THEN GO TO SOURCE; SOURCEIN: IF IU GTR 0 THEN GO TO SOURCE;PINB:=PINB+80; LL:=LL+1;IF LL LSS 24 THEN GO TO NEWL; SOURCE: LL:=0;IF IU GTR 0 THEN READ(FN[IU-1][STOP],10,IOB[*]) ELSE READ(VDU[STOP],240,IOB[*]); IF IU=2 THEN WRITE(TTY,10,IOB[*]); PINB:=POINTER(IOB[*]);IOBE[1]:=0; NEWL: C:=IF MS>0 THEN SSEQ[MS] ELSE 0;APR:=PINB;BPR:=PIBE; A:=NMBR(6);IF A=0 THEN BEGIN IF CHA="%" THEN GO TO SOURCEIN; COMMENT NONVOID INPUT WITH ZERO STATEMENT NO. MUST BE COMMAND; IOBE[1]:=0;REPLACE BPR-5 BY APR:CPR:=APR-1 FOR 1; REPLACE BPR-4 BY APR:APR FOR 5 WHILE IN ALPHA;CHA:=IOBE[1]; ON("RUN000") BEGIN IF OBJECT THEN BEGIN IF NMBR(72) NEQ 0 OR CHA NEQ "%" THEN GO PER;GO EXECUTE END ELSE IF IU=2 THEN GO COMPILE ELSE BEGIN WRITE(TTY,WT); FILECONTROL(4,"XBWKFL ",TIME(-1),COMPILE) END END; ON("DELETE" OR CHA="SCR000") BEGIN C:=NMBR(72); IF C NEQ 0 OR CHA NEQ "%" THEN GO PER;WRITE(TTY,F7); CS:=MS:=IO[0]:=0;DANGER:=OBJECT:=FALSE;GO SOURCEIN END; ON("LIST00") BEGIN COMMENT PROCESS LIST COMMAND; LABEL NEX,LEX; IF OU=1 THEN WRITE(TTY,DVO); WRITE(FL[OU],SPC); NEX: BEG:=NMBR(72);IF CHCONV(CHA) NEQ 0 THEN GO PER; EN:=ON("%" AND BEG=0) 1000000 ELSE ON(44) NMBR(72) ELSE BEG; IF CHCONV(CHA) NEQ 0 THEN GO PER; FOR A:=1 STEP 1 UNTIL MS DO IF SSEQ[A] LEQ EN AND SSEQ[A] GEQ BEG THEN BEGIN REPLACE POINTER(IOBE[1]) BY " " FOR 112; WRITE(IOBE[*],NUM[2|OU],SSEQ[A]); SCAN CPR:POINTER(IOBE[1])+20|OU FOR 20 WHILE NEQ 48; REPLACE CPR BY POINTER(PROG[A,2]) FOR 72;WRITE(FL[OU],14,IOBE[*]) END;ON(58) GO TO NEX;WRITE(TTY,STP,"LIST ");GO TO SOURCEIN END; ON("RENAME") FILECONTROL(0," NAMED"," ",SOURCEIN); ON("MAKE00") FILECONTROL(0,"CREATE","D",SOURCEIN); ON("SAVE00") FILECONTROL(1," SAVED"," ",SOURCEIN); ON("LOAD00") FILECONTROL(2," LOADE","D",SOURCEIN); ON("REMOVE") FILECONTROL(3,"REMOVE","D",SOURCEIN); ON("COPY00") FILECONTROL(2," COPIE",0,SOURCEIN); ON("BYE000" OR CHA="HELL00") BEGIN IF IU=2 THEN GO FINSH; FILECONTROL(6,"XBWKFL ",TIME(-1),FINSH) END; ON("SEND00") BEGIN OU:=1;IF NOT HDDR THEN BEGIN WRITE(LIN,HD3,TIME(6),TIME(5).[23:12],TIME(5).[35:12],TIME(5).[11:12], TIME(-1).[41:18],TIME(-1).[23:24]); HDDR:=TRUE END;WRITE(TTY,HD1);GO SOURCEIN END; ON("NOSEND") BEGIN OU:=0;WRITE(TTY,STP,"NOSEND");GO TO SOURCEIN END; ON("TTY000") BEGIN IU:=1;WRITE(TTY,STP,"SETTTY");GO TO SOURCE END; ON("VDU000") BEGIN IU:=0;WRITE(TTY,STP,"SETVDU");GO TO SOURCEIN END; ON("TIME00") BEGIN TIM:=3600|NMBR(10);WRITE(TTY,STP,"SETTIM"); GO TO SOURCEIN END; ON("PLOP00") FILECONTROL(5,0,0,SOURCEIN); ON("WHATSO") BEGIN WRITE(TTY,F9);IF IO[0]=0 THEN WRITE(TTY,F10,MS,SSEQ[MS]) ELSE WRITE(TTY,F11,IO[0].[41:36],MS,SSEQ[MS]); GO SOURCEIN END; % ILLEGAL COMMAND WRITE(TTY,WHT," "&CHA[35:35:6|DELTA(CPR,APR)]);GO SOURCEIN END; COMMENT PROCESS SOURCE STATEMENT; OBJECT:=FALSE;DANGER:=TRUE; COMMENT DELETE STATEMENT; ON("%") BEGIN CHA:=A;FOR A:=1 STEP 1 UNTIL MS DO ON(SSEQ[A]) BEGIN MS:=MS-1;FOR B:=A STEP 1 UNTIL MS DO BEGIN SSEQ[B]:=SSEQ[B+1];WRITE(PROG[B,*],10,PROG[B+1,*]) END END; GO TO SOURCEIN END; CHA:=A;APR:=APR-1; COMMENT ADD NEW LAST STATEMENT; IF CHA GTR C THEN BEGIN CS:=MS;MS:=A:=MS+1; IF MS GTR 200 THEN GO TOOLONG; GO TO COPY END; COMMENT REPLACE EARLIER STATEMENT; FOR A:=1 STEP 1 UNTIL MS DO ON(SSEQ[A]) GO TO COPY ELSE IF CHA LSS SSEQ[A] THEN BEGIN MS:=MS+1; COMMENT INSERT STATEMENT; IF MS GTR 200 THEN GO TO TOOLONG; FOR B:=MS STEP -1 UNTIL A+1 DO BEGIN SSEQ[B]:=SSEQ[B-1];WRITE(PROG[B,*],10,PROG[B-1,*]) END; GO TO COPY END; COPY: PROG[A,11]:=SSEQ[A]:=CHA; REPLACE BPR:CPR:=POINTER(PROG[A,2]) BY " " FOR 1; B:=DELTA(APR,PINB+80);IF B>71 THEN B:=71; REPLACE BPR:BPR BY APR FOR B WHILE NEQ "!"; REPLACE BPR BY " " FOR 72-DELTA(CPR,BPR);GO SOURCEIN END SOURCEIN; INER: WRITE(TTY,INTR);GO TO SOURCEIN; TOOLONG: WRITE(TTY,LNGPRG,SSEQ[CS]);GO TO SOURCEIN; PER: WRITE(TTY,F12);GO SOURCEIN; COMMENT---------------------------------------------------------- -------------------- END SOURCEIN --------------------------- ------------------------------------------------------------------ ----------- COMPILE: SEARCH FOR SYNTAX ERRORS --------- ----------- AND MAKE PSEUDO-OBJECT CODE --------- --------------------------------------------------------------------; COMMENT SYNTAX ERROR MESSAGES: OUTPUT AFTER "RUN" WITH NEW FAULTY PROGRAM ARITH MISSING OPERATOR OR OPERAND IN ARITHMETIC EXPRESSION (SHOULD NOT OCCUR) FILES PROGRAM CAN HAVE ONLY ONE INPUT AND ONE OUTPUT FILE IL GOSB THIS STATEMENT HAS BEEN ILLEGALLY REFERENCED BY A GOSUB STATEMENT (IT IS IN A FOR LOOP) IL RELN AN ILLEGAL RELATION OF FORM X?? HAS BEEN FOUND IN AN IF STATEMENT ILL ARR ARRAY NAME EXPECTED BUT CHARACTER IS NOT A LETTER ILL ASN AN ASSIGNMENT IS ATTEMPTED BUT LEFT HAND SIDE IS NOT A VARIABLE ILL FN THE NAME OF A DEFINED FUNCTION MUST BE OF FORM FN LETTER. PARAMETER(S) MUST BE SUPPLIED. ILL FOR A FOR STATENENT IS ALREADY IN OPERATION FOR THIS VARIABLE ILL NEX NEXT MUST REFER TO AN UNSUBSCRIPTED REAL VBLE ILL NUM A PRIMARY IS MISSING OR ILLEGAL ILL STR A STRING PRIMARY HAS BEEN ENCOUNTERED IN A REAL EXPRESSION IL STMT ILLEGAL STATEMENT INV IF STRINGS CAN ONLY BE COMPARED FOR EQUALITY OR INEQUALITY INV PAR A FORMAL PARAMETER IN A DEF STATEMENT MUST BE A VARIABLE INV VAR A PRIMARY IS MISSING OR ILLEGAL. IN A READ STATEMENT EVERY EXPRESSION MUST CONSIST OF A SINGLE VARIABLE PRIMARY. IN+OUT? A FILE IS BEING USED FOR INPUT AND OUTPUT LONGSTR A STRING CONTAINS MORE THAN 14 CHARACTERS IN A STATEMENT OTHER THAN PRINT. MISG OP AN OPERAND ESSENTIAL TO THIS STATEMENT HAS BEEN OMITTED (END OF STATEMENT ERROR). MISP = MISPLACED OR MISSING = IN DEF STATEMENT MISPL - A - SIGN HAS BEEN PLACED ILLEGALLY IN AN EXPRESSION (E.G. A*-B). NAME PROBABLY CAUSED BY ILLEGAL FILENAME NESTING INCORRECTLY NESTED FOR AND NEXT STATEMENTS NO ) X MISSING PARENTHESES: X=A IN ARITH EXPRESSION NO ( X P IN FUNCTION PARAMETER S IN SUBSCRIPT F IN FILE DECLARATION NO EXPN E HAS BEEN FOUND IN A NUMBER BUT NO EXPONENT FOLLOWS NO FOR A NEXT STATEMENT HAS NO CORRESPONDING FOR NOINPUT INPUT STATEMENT MUST HAVE LIST OF VARIABLES NO NEXT A FOR STATEMENT EARLIER IN PROGRAM HAS NO NEXT NO PARM EVERY FUNCTION MUST HAVE PARAMETER(S) IN BRACKETS NO PROG THERE IS NO PROGRAM TO RUN NO RELN NO RELATION HAS BEEN FOUND IN AN IF STATEMENT NO SEPR CONSECUTIVE ARITH EXPRESSIONS IN PRINT STATEMENT MUST BE SEPARATED BY , OR SEMICOLON NO TO A FOR STATEMENT MUST HAVE A FINAL VALUE (FOR X=1 TO 10 ETC.) NOT END THE LAST STATEMENT MUST BE AN END STATEMENT NOTLAST THE END STATEMENT MUST BE THE LAST STATEMENT OVERFLW A NUMBER IS TOO LARGE QUOTES MISMATCHED STRING QUOTES REDC AR ARRAY TWICE DIMENSIONED REDC FN A FUNCTION HAS BEEN DEFINED MORE THAN ONCE SAMEFIL A FILE HAS BEEN DECLARED MORE THAN ONCE PARAMTR WRONG NUMBER OF PARAMETERS IN A FUNCTION CALL SIMPLFY AN EXPRESSION IS NESTED TO A DEPTH OF 10 OR MORE AND SHOULD RE BROKEN UP SIZE AN ARRAY DIMENSION IS GREATER THAN 64 OR (IN MAT STATEMENT) IS GREATER THAN THE DECLARED DIMENSION OF THE ARRAY STORAGE ARRAY STORAGE HAS BEEN EXCEEDED (700 WORDS OF TYPE REAL, 70 OF TYPE ALPHA) STR >63 ILLEGAL OBJECT CHARACTER (E.G. PRINT STRING HAS >63 CHARS OR STARTS LATER THAN COL 63) STR=STR A STRING CAN ONLY BE COMPARED WITH ANOTHER SUBSCPT AN ARRAY REFERENCE HAS THE WRONG NUMBER OF SUBSCRIPTS TOO MCH PROCESSING OF THE SOURCE STATEMENT HAS NOT USED UP ALL THE INFORMATION IN IT. (CAN BE CAUSED BY OMISSION OF AN OPERATOR IN AN EXPRESSION) TYPE AN ATTEMPT HAS BEEN MADE TO USE A MAT STATEMENT FOR A 1-DIMENSIONAL ARRAY UNDC AR AN ARRAY HAS BEEN REFERENCED BUT NOT DECLARED UNDC FL A FILE HAS BEEN REFERENCED BUT NOT DECLARED UNDC FN A FUNCTION OF TYPE FN* HAS BEEN REFERENCED BUT NOT DECLARED UNDF GO THERE IS NO STATEMENT IN THE PROGRAM WITH THE SEQUENCE NUMBER REFERENCED BY THIS STATEMENT UNDSTAR A STRING ARRAY HAS BEEN REFERENCED BUT NOT DECLARED UNRC FN A FUNCTION NAME OR KEYWORD HAS BEEN MISSPELLED OR MISPLACED 3 FILES NOT MORE THAN TWO FILES MAY BE DECLARED 11 FORS FOR STATEMENTS NESTED TOO DEEP :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; COMPILE: COMMENT IN THE FOLLOWING COMMENTS, IS ANY EXPRESSION (POSSIBLY WITH =) IS ANY LETTER IS ANY VARIABLE PRIMARY IS ANY UNSIGNED INTEGER IS A STATEMENT NUMBER IS A FILENAME ALLOWED VARIANTS ARE LISTED BELOW. THREE LETTER ABBREVIATIONS OF INITIAL KEYWORDS ARE ALLOWED WHERE UNAMBIGUOUS. SPACES ARE IGNORED EXCEPT INSIDE STRING QUOTES; INTOVR:=INTVR;INDEX:=QUOTE;FLAG:=FLAGR; MSTO:=287;MSTR:=27;INFILTOG:=OUTFILTOG:=FALSE; FOR A:=1 STEP 1 UNTIL 26 DO STRAR[A,1]:=ARR[A,1]:=ARR[A,2]:=SUB[A]:=0; IO[1]:=IO[2]:=FNM[2,1]:=FNM[2,2]:=FNM[3,1]:=FNM[3,2]:=AREASIZE:=0; NDEP:=CO:=1;POB:=POINTER(OBJ[*]); CS:=0;SY:=EQOK:=TRUE; IF MS =0 THEN SYNT("NO PROG"); FORE:=FORC:=NCON:=0;FOR A:=1 STEP 1 UNTIL 200 DO STYP[A]:=0; COMMENT FILES FILES ,.. WHERE IS (EXISTING FILE) OR () (FILE TO BE CREATED: N=MAX NO OF RECS) WHERE IS A CANDE FILENAME THERE CAN ONLY BE ONE FILES STATEMENT. IT MUST BE THE FIRST STATEMENT. THERE CAN BE AT MOST ONE INPUT FILE AND ONE OUTPUT FILE; FIL: ACS:=CS:=CS+1;CP:=CHA:=0;CHA:=NWC;B:=LOOK(3); IF B="REM" THEN GO FIL;IF B="FIL" THEN BEGIN CP:=LP;SKIP(2,"ES");A:=0; RFIL: A:=A+1;IF A>3 THEN SYNT("3 FILES"); CHA:=NWC;IO[A]:=" ";BPR:=POINTER(PROG[CS,2])+CP-1; SCAN APR:BPR FOR 6 WHILE IN ALPHA;FNM[2,A]:=B:=DELTA(BPR,APR); REPLACE POINTER(IO[A])+1 BY BPR FOR B;FNM[1,A]:=LOOK(B);CP:=LP; NF:=A;CHA:=NWC;ON("(") BEGIN AREASIZE:=NUMB/20+1;FNM[3,A]:=7; IF CHA NEQ ")" THEN SYNT("NO ) ,F");CHA:=NWC END;ON(",") GO TO RFIL; IF A=2 AND IO[1]=IO[2] THEN SYNT("SAMEFIL");IF CHA NEQ "%" THEN SYNT("TOO MCH") END ELSE CS:=0; IF ACS>MS THEN SYNT("NO PROG"); COMMENT DIM DIM (),... DIMENSION (),... WHERE IS OR $ IS OR , DIM STATEMENTS MUST PRECEDE ALL EXECUTABLE STATEMENTS STRING ARRAY MUST BE ONE-DIMENSIONAL. ALL DIMENSIONS MUST BE <64. 713 WORDS REAL AND 73 STRINGS ARE AVAILABLE FOR ARRAYS ; DIM: ACS:=CS:=CS+1;CP:=CHA:=0;CHA:=NWC; B:=LOOK(3);IF B="REM" THEN GO DIM; IF B="DIM" THEN BEGIN CP:=LP;SKIP(6,"ENSION"); RDIM: K:=CHCONV(NWC);IF K=0 THEN SYNT("ILL ARR"); IF NWC="$" THEN BEGIN STRAR[K,0]:=MSTR;IF NWC NEQ "(" THEN SYNT("NO ( ,S");A:=STRAR[K,1]:=NUMB;MSTR:=MSTR+A; IF CHA NEQ ")" THEN SYNT("NO ) ,S");IF NWC="," THEN GO TO RDIM; GO TO DIM END; ARR[K,0]:=MSTO;IF CHA NEQ "(" THEN SYNT("NO ( ,S"); IF ARR[K,1] NEQ 0 THEN SYNT("REDC AR"); B:=ARR[K,1]:=NUMB;IF B>64 THEN SYNT(" SIZE "); ON(",") BEGIN A:=ARR[K,2]:=NUMB;B:=B|A END; MSTO:=MSTO+B;IF MSTO GTR 1000 THEN SYNT("STORAGE"); IF CHA NEQ ")" THEN SYNT("NO ) ,S");IF NWC="," THEN GO TO RDIM; GO TO DIM END;IF ACS>MS THEN SYNT("NO PROG"); COMMENT PROGRAM COMPILATION BEGINS HERE ; FOR CS:=ACS STEP 1 UNTIL MS DO BEGIN COMMENT IF GOSUB ENTRY THEN FIX FOR LEVEL ; EXS: IF STYP[CS] NEQ 0 THEN BEGIN IF FORC NEQ FORE THEN SYNT("IL GOSB");FORE:=FORC:=STYP[CS] END; COMMENT IDENTITY STATEMENT TYPE ; NDEP:=CP:=CHA:=0;CHA:=NWC;B:=LOOK(3);EQOK:=TRUE; FOR A:=1 STEP 1 UNTIL 18 DO IF B=KEY[A] THEN GO TO EQL; IF B="DIM" OR B="FIL" THEN BEGIN WRITE(TTY,F6,SSEQ[CS]); GO SOURCEIN END; %IF B="TRA" THEN BEGIN STYP[CS]:=20;GO REM END; %IF B="UNT" THEN BEGIN STYP[CS]:=21;GO REM END; B:=B DIV 64; IF B="IF" THEN BEGIN LP:=LP-1;A:=19;GO TO EQL END; IF B="ON" THEN BEGIN LP:=LP-1;A:=20;GO TO EQL END; LP:=0;A:=1; EQL: CP:=LP;STYP[CS]:=A;SPOB[CS]:=CO; IF CS=MS AND A NEQ 18 THEN SYNT("NOT END");GO TO OPN[A]; COMMENT 1 LET LET WHERE E MAY BE A STRING ASSIGNMENT ; LET: ARITH(0);GO TO INCST; CAR: ARITH(1); GO TO INCST; COMMENT 20 ON ON GO TO ,... ; ONX: ARITH(1);SKIP(3,"OTO"); RON: A:=NUMB;FOR B:=ACS STEP 1 UNTIL MS DO IF A=SSEQ[B] THEN BEGIN PUT(B.[11:6]);PUT(B.[5:6]); IF STYP[CS]=3 AND STYP[B] IF THEN IF GO TO IS AN EXPRESSION WITHOUT = IS ONE OF THE FOLLOWING |EQ |GT |LT |GE |LE |NE = > < >= <= <> STRINGS CAN BE COMPARED ONLY FOR EQUALITY OR INEQUALITY; IFF: EQOK:=FALSE;ARITH(0);EQOK:=TRUE; C:=IF STRIN THEN 0 ELSE 1; B:=0;IF CHA=30 THEN BEGIN B:=B+2;CHA:=NWC END; IF CHA=14 THEN BEGIN B:=B+4;CHA:=NWC END;IF CHA=61 THEN B:=B+1 ELSE CP:=CP-1;IF B=0 THEN CHA:=NWC ELSE GO TO FEQ; IF CHA NEQ "|" THEN SYNT("NO RELN");CHA:=NWC; A:=CHA|64+NWC;FOR B:=1 STEP 1 UNTIL 6 DO IF A=KEY[B+32] THEN GO TO FEQ;SYNT("IL RELN"); FEQ: PUT(B);ARITH(C);IF C=0 AND NOT STRIN THEN SYNT("STR=STR"); IF STRIN AND B NEQ 1 AND B NEQ 6 THEN SYNT("INV IF "); SKIP(3,"OTO");SKIP(3,"HEN");GO TO RON; COMMENT 2 GO TO GO TO ; GOT: SKIP(1,"0");GO TO RON; COMMENT 3 GOSUB GOSUB ; GOS: SKIP(2,"UB");GO TO RON; COMMENT 4 RETURN RETURN ; RET: SKIP(3,"URN");CHA:=NWC;GO TO INCST; COMMENT 8 FOR FOR TO STEP FOR TO ; COMMENT DURING COMPILE, FOR INFO IS STORED IN FORX AS FOLLOWS: 2 3 4 OBJPOINTER TO STORE NEXTLINE FORLINE ADDR EACH FOR IS ASSIGNED A LEVEL (=FORC), WHICH 1S USED TO CHECK NESTING AND DURING EXECUTION. IN SUBROUTINES FORC IS INITIALISED TO MAX FORC OF CALLING (GOSUB) STATEMENT: THIS LEVEL 1S STORED TEMPORARILY IN STYP. OBJECT FORM OF FOR STATEMENT IS AS FOLLOWS: LEVEL ASSIGN FINAL INCREMENT NEXTLINE ; FOX: FORC:=FORC+1;PUT(FORC);IF FORC>10 THEN SYNT("11 FORS"); ARITH(1);FORX[FORC,4]:=ADDR+1;IF CHA NEQ "T" THEN SYNT(" NO TO"); SKIP(1,"0");FOR A:=1 STEP 1 UNTIL FORC-1 DO IF FORX[A,4]=ADDR THEN SYNT("ILL FOR");ARITH(1);IF CHA="S" THEN BEGIN SKIP(3,"TEP");ARITH(1) END ELSE PUT(0);FORX[FORC,2]:=CO;PUT(0);PUT(0);FORX[FORC,3]:=CS; GO INCST; COMMENT 9 NEXT NEXT WHERE IS A VARIABLE NAME ; NEX: SKIP(1,"T");B:=CHCONV(NWC)-1;IF B=-1 THEN SYNT("ILL NEX"); IF NWC LSS 10 THEN BEGIN B:=11|B+CHA+1;CHA:=NWC END ELSE B:=11|B; IF FORC=FORE THEN SYNT("NO FOR "); IF B+1 NEQ FORX[FORC,4] THEN SYNT("NESTING"); A:=CO;CO:=FORX[FORC,2];PUT(CS.[11:6]);PUT(CS.[5:6]); CO:=A;SPOB[CS]:=FORC+16|FORX[FORC,3];FORX[FORC,4]:=0;FORC:=FORC-1; GO INCST; COMMENT 11 DEF DEF FN(....)= FORMAL PARAMETERS MUST BE SINGLE LETTERS ; DEF: SKIP(3,"INE");SKIP(2,"FN");K:=CHCONV(NWC); IF K=0 OR NWC NEQ 29 THEN SYNT(" ILL FN");A:=0;PUT(K); IF SUB[K] NEQ 0 THEN SYNT("REDC FN"); RDUM: A:=A+1;B:=11|CHCONV(NWC)-11;IF B=-11 THEN SYNT("INV PAR"); CONST[NCON+A]:=B;IF NWC=58 THEN GO RDUM;IF CHA NEQ 45 THEN SYNT (" NO ) P");SUB[K]:=A;FOR B:=A STEP -1 UNTIL 1 DO BEGIN PUT((C:=CONST[NCON+B]).[11:6]);PUT(C.[5:6]) END; IF NWC NEQ "=" THEN SYNT("MISP = ");ARITH(1);SUB[K]:=A;GO TO INCST; COMMENT 6 READ READ ,... ; REA: SKIP(1,"D"); RREA: ARITH(0);IF NOT VAR THEN SYNT("INV VAR"); ON(58) GO TO RREA;PUT(0);GO TO INCST; COMMENT 5 INPUT INPUT ,... INPUT FILE ,,... WHERE IS THE FILENAME; INP: SKIP(2,"UT");CFN;GO TO RREA; COMMENT 13 RANDOMISE RANDOMISE RANDOMIZE ; RAN: SKIP(6,"DOMISE");SKIP(6,"DOMIZE");CHA:=NWC;GO TO INCST; COMMENT 15 RESTORE RESTORE RESTORE FILE WHERE IS THE INPUT FILE ; RES: SKIP(4,"TORE");CFN; GO TO INCST; COMMENT 7 PRINT PRINT

PRINT FILE ,,... WHERE IS A FILENAME WHERE

IS A NUMBER OF ELEMENTS OF FORM "" 4 , 2 OR 6, 1 ; COMMENT 2 OR 6 , 1 (1,5 IF TRAILS) ; COMMENT 5 IF TRAILS TAB() 3 WHERE IS ANY STRING WHERE IS "" OR ; PRI: SKIP(2,"NT");CFN;CHA:=NWC;AA:=FALSE; RPRI: ON("%") BEGIN PUT(0);GO TO INCST END; ON(58) BEGIN PUT(1);AA:=FALSE; IF NWC="%" THEN BEGIN PUT(5); GO TO INCST END ELSE GO TO RPRI END; ON(";" OR CHA=":") BEGIN AA:=FALSE;IF NWC="%" THEN BEGIN PUT(5); GO INCST END;GO TO RPRI END; ON(63) BEGIN AA:=FALSE;PUT(4);PUT(CP);CPR:=POINTER(PROG[CS,2])+CP; SCAN APR:CPR UNTIL=63;B:=DELTA(CPR,APR);PUT(B); CP:=CP+B+1;CHA:=NWC;GO TO RPRI END; IF LOOK(4)="TAB(" THEN BEGIN AA:=FALSE;PUT(3);CP:=LP;ARITH(1); IF CHA NEQ 45 THEN SYNT("NO ) P");CHA:=NWC;GO TO RPRI END; CP:=CP-1;IF AA THEN SYNT("NO SEPR");AA:=TRUE; B:=CO;PUT(2);ARITH(0);IF STRIN THEN REPLACE POB+B BY "6" FOR 1;GO TO RPRI; COMMENT 14 PAGE PAGE ; PAG: SKIP(1,"E");CHA:=NWC;GO TO INCST; COMMENT 10 MAT MAT READ 1 MAT READ (,) 1 MAT PRINT 2 MAT PRINT (,) 2 MAT LET =()* 4 MAT =()* 4 MAT LET = 3 MAT = 3 WHERE IS AS DESCRIBED IN EXECUTE(PROCEDURE MATOP) ; MAT: CHA:=NWC;A:=LOOK(4);IF A="READ" THEN BEGIN PUT(1);CP:=LP; GO TO IOMT END;IF A="PRIN" THEN BEGIN PUT(2);CP:=LP;SKIP(1,"T"); GO TO IOMT END;CP:=CP-1;SKIP(3,"LET");A:=CP;B:=CHMAT(NWC);CHA:=NWC; IF NWC=29 THEN BEGIN PUT(4);PUT(B);ARITH(1);CHA:=NWC;PUT(CHMAT(NWC)); END ELSE BEGIN PUT(3);PUT(A) END;GO TO REM; IOMT: K:=CHMAT(NWC);PUT(K);IF NWC=29 THEN BEGIN FOR B:=1,2 DO BEGIN A:=NUMB;IF A LSS 0 OR A GTR ARR[K,B] THEN SYNT(" SIZE");PUT(A) END;CHA:=NWC; END ELSE BEGIN PUT(ARR[K,1]);PUT(ARR[K,2]) END; PUT(ON(";") 1 ELSE 0);ON(";") CHA:=NWC;GO TO INCST; COMMENT 12 DATA DATA ,... ; DAT: SKIP(1,"A"); RDAT: ARITH(0);ON(58) GO TO RDAT;PUT(0);GO INCST; COMMENT 17 STOP STOP 18 END END ; ENX: IF CS NEQ MS AND A=18 THEN SYNT("NOTLAST");CHA:=NWC; IF A=17 THEN CHA:=NWC; INCST: IF CHA NEQ "%" THEN SYNT("TOO MCH"); COMMENT 16 REM REM WHERE IS ANYTHING ; REM:ERR: END; % SORT OUT FILES IF 2 TO BE USED CS:=MS;IF NF=2 AND FNM[3,1]=FNM[3,2] THEN SYNT(" FILES "); IF FNM[3,1]=7 THEN BEGIN IO[3]:=IO[1];IO[1]:=IO[2]; IO[2]:=IO[3] END; IF NOT SY THEN BEGIN WRITE(TTY,STP,"ERRORS");GO TO SOURCEIN END; OBJECT:=TRUE;GO TO EXECUTE; INTVR: SYNT("OVERFLW"); QUOTE: SYNT(" QUOTES"); FLAGR: SYNT("NAME "); COMMENT---------------------------------------------------------------- -------------- END COMPILE ------------------------ ------------------------------------------------------------------------ -------------- EXECUTE: EXECUTION OF -------------------- -------------- USERS PROGRAM -------------------- -----------------------------------------------------------------------; EXECUTE: BEGIN FILE IN FIL1 DISK " "(2,10,300); FILE OUT FIL2 DISK[20:AREASIZE] " "(2,10,300,SAVE 7); INTEGER ARRAY SVE[1:10], % HOLDS GOSUB CALLS FUNC[1:26], % DEFINES STRGS[-1:100,0:2], % STRINGS IOB[1:14], % I/O PSEUDOBUFFER IOF[1:10], % " ADR[0:20]; % ADDRESS STCK FOR EVAL ARRAY STORE[0:1000], % HOLDS VARIABLE VALUES ETC STK[0:20]; % VALUE STACK FOR EVAL INTEGER XRND, % PSEUDO-RANDOM NUMBER INDEX CO, % CURRENT POSITION IN OBJ[*] RDAT, % DATA STATEMENT NGOT, % GO COUNTER SLVE, % GOSUB COUNTER RDTP, % POSITION IN DATA STATEMENT MSTO, % TOP OF STORE[*] MSTR, % TOP OF STRGS[*, ] IR, % INPUT FILE SEQUENCE NO NR, % OUTPUT FILE COUNTER RT, % RUN TERMINATION TIME MF, % FILE (0=TTY,OTHERWISE DISK) STCK, % STACK POINTER FOR EVAL A,B,C,D,I,J,K,L,U,V,W,X,Y,Z,AS; REAL R,S,T; % HASH POINTER PIOB, % CURRENT POSITION IN IOB[*] POUB, % INITIAL PBR,IPR; LABEL INCST; % TRACE PACKAGE %FORMAT T1(I6,X2,A3,X5,"VALUE ASSIGNED= "U),T2(I6,X2,A3,X5," TO STMT " % ,I6),T3(I6,X2,A3); BOOLEAN TRACEON,TLIN;%POINTER ITR; %PROCEDURE DSTR(A);VALUE A;INTEGER A; %BEGIN WRITE(IOF[*],T3,SSEQ[CS],IF TLIN THEN KEY[STYP[CS]] ELSE " "); %REPLACE ITR:POINTER(IOF[*])+14 BY "STRING ASSIGNED=";REPLACE ITR:ITR %BY """ FOR 1;REPLACE ITR:ITR BY POINTER(STRGS[A,1]) FOR STRGS[A,0]; %REPLACE ITR BY """ FOR 1;WRITE(FL[OU],9,IOF[*]);TLIN:=FALSE END; DEFINE TR0(TR01,TR02)=#,%IF TR01 THEN BEGIN WRITE(FL[OU],TR02,SSEQ[CS], % IF TLIN THEN KEY[STYP[CS]] ELSE " "#, TR1(TR11)=#, %=TR0(TRACEON,T1),TR11);TLIN:=FALSE END#, TR2(TR21)=#, %=TR0(TRACEON,T2),SSEQ[TR21]);TLIN:=FALSE END#, TR3 =#, %=TR0(TLIN,T3));TLIN:=FALSE END#, TR4(TR41)=#; %=IF TRACEON THEN DSTR(TR41)#; % PROCEDURES FOR EXECUTE: COMMENT --- GET GETS NEXT CHARACTER FROM OBJ ; DEFINE GET=0&OBJ[CO.[46:44]][5:47-CO.[2:3]|6:6];CO:=CO+1; IF CO.[2:3]=0 THEN CO:=CO+1#; COMMENT --- ERROR DEALS WITH EXECUTION TIME ERRORS; PROCEDURE ERROR(A);VALUE A;INTEGER A; BEGIN SWITCH FORMAT ERR:=("ERR0",I6), % SHOULD NOT OCCUR.. %0 ("SUBSCRIPT OUT OF BOUNDS AT LINE ",I6), %1 ("LOG OF NEGATIVE OR ZERO NUMBER AT LINE ",I6), %2 ("SQR OF NEGATIVE NUMBER AT LINE ",I6), %3 ("UNDEFINED FUNCTION AT LINE ",I6), %4 ("INPUT STATEMENT ATTEMPTED IN BATCH MODE AT LINE",I6), ("GO TO UNDEFINED STATEMENT NUMBER AT LINE ",I6), %6 ("RETURN WITHOUT GOSUB AT LINE ",I6), %7 ("ARGUMENT FOR SIN,COS,TAN OR EXP EXCEEDS 158 AT LINE",I6), %8 ("INCREMENT UNDEFINED OR ZERO AT LINE ",I6), %9 ("NEXT WITHOUT FOR AT LINE ",I6), %10 ("STORAGE EXCEEDED AT LINE ",I6), %11 ("INTEGER OVERFLOW AT LINE ",I6), %12 ("INVALID ADDRESS AT LINE ",I6), %13 ("DIVIDE BY ZERO AT LINE ",I6), %14 ("ILLEGAL EXPONENTIATION AT LINE ",I6), %15 ("FLOATING-POINT OVERFLOW AT LINE ",I6), %16 ("GOSUBS NESTED TOO DEEP (MORE THAN 10) AT LINE ",I6), %17 ("ILLEGAL EXPONENT ON INPUT AT LINE ",I6), %18 ("MISPLACED STRING IN INPUT AT LINE ",I6), %19 ("INPUT STRING TOO LONG AT LINE ",I6), %20 ("OUT OF DATA AT LINE ",I6),("ERR22",I6), % ERR22 SHOULDNT OCCUR 21,22 ("ILLEGAL MATRIX OPERATION AT LINE ",I6), %23 ("INVERSE OF ILL-CONDITIONED MATRIX AT LINE ",I6), %24 ("INSUFFICIENT SPARE STORAGE FOR MAT OP AT LINE ",I6), %25 ("ILLEGAL FILE OPERATION AT LINE ",I6), %26 ("INPUT FILE NOT ON DISK AT LINE",I6), %27 ("INPUT FILE - INVALID USER AT LINE",I6), %28 ("INPUT FILE IS NON-STANDARD AT LINE",I6), %29 ("OUTPUT FILE - DUPLICATE NAME AT LINE",I6); %30 COMMENT LAST MESSAGE HERE IS NO. 30 ; FORMAT DUR("THE FOLLOWING LINE WAS AWAITING OUTPUT:"), FILAT(A6," FILE SEQUENCE NO.",I8); WRITE(TTY,ERR[A],SSEQ[CS]); IF INFILTOG THEN WRITE(TTY,FILAT," INPUT",IR); IF OUTFILTOG THEN WRITE(TTY,FILAT,"OUTPUT",NR); IF DELTA(POUB,PIOB) GTR 0 THEN BEGIN WRITE(TTY,DUR); WRITE(TTY,9,IOB[*]) END; LOCK(FIL1);LOCK(FIL2);GO TO STOP END; COMMENT --- EVAL EVALUATES ARITHMETIC EXPRESSION (REVERSE POLISH DECODER) ; REAL PROCEDURE EVAL; BEGIN LABEL EQ,DONE,EXPON,RPT,SS,S,NUM,VR,AR,SF,UF,AD,SU,MU,DI,EX,FIN, INM,STRGA,STRGC,STRGV; SWITCH TYP:=FIN,NUM,VR,AR,UF,SF,FIN,EQ,INM,AD,SU,MU,DI,EX,STRGV, STRGA,STRGC; DEFINE TOP=STK[STCK];STCK:=STCK-1#; DEFINE STACK(STACK1)=STCK:=STCK+1;STK[STCK]:=STACK1;GO TO SS#; COMMENT ADDR RETURNS RESULT ADDRESS (IN STORE IF REAL, STRGS IF STRING). INTERMEDIATE RESULTS AND ADDRESSES ARE STACKED IN STK AND ADR RESECTIVELY. ; STRIN:=FALSE;STCK:=0; SS: ADR[STCK]:=ADDR;CHA:=GET;GO TO TYP[CHA+1]; NUM: A:=GET;A:=A|64+GET;STACK(CONST[A]); STRGV: ADDR:=GET;STRIN:=TRUE;STACK(0); STRGA: K:=GET;A:=TOP;IF A LEQ 0 OR A GTR STRAR[K,1] THEN ERROR(1);ADDR:=STRAR[K,0]+A;STRIN:=TRUE;STACK(0); STRGC: A:=GET;K:=GET;REPLACE POINTER(STRGS[0,1])BY POINTER (PROG[CS,2])+K FOR A;STRGS[0,0]:=A;STRIN:=TRUE;ADDR:=0;STACK(0); INM: STACK(0); VR: K:=GET;K:=K-1;ADDR:=11|K+GET;STACK(STORE[ADDR]); AR: K:=GET;A:=B:=TOP;IF ARR[K,2] NEQ 0 THEN BEGIN A:=TOP;IF B LEQ 0 OR B GTR ARR[K,2] THEN ERROR(1) END; IF A LEQ 0 OR A GTR ARR[K,1] THEN ERROR(1); ADDR:=ARR[K,0]+(A-1)|ARR[K,2]+B-1;STACK(STORE[ADDR]); SF: BEGIN LABEL SQR,SIF,COF,TAF,ATF,EXF,LOF,ABF,ENF,FNQ,DC, FIX,SGN,RND; SWITCH SFUN:=SIF,COF,TAF,ATF,EXF,LOF,ABF,ENF,SQR,FIX,SGN,RND; DEFINE TEST=IF ABS(R)>158 THEN ERROR(8)#; A:=GET;R:=TOP;GO TO SFUN[A-18]; SIF: TEST;R:=SIN(R);GO TO DC; COF: TEST;R:=COS(R); GO TO DC; TAF: TEST;R:=SIN(R)/COS(R); GO TO DC; ATF: R:=ARCTAN(R); GO TO DC; EXF: TEST;R:=EXP(R); GO TO DC; LOF: IF R LEQ 0 THEN ERROR(2);R:=LN(R); GO TO DC; ABF: R:=ABS(R); GO TO DC; SQR: IF R LSS 0 THEN ERROR(3);R:=R*.5; GO TO DC; ENF: R:=ENTIER(R);GO TO DC; FIX: R:=ENTIER(R);IF R LSS 0 THEN R:=R+1;GO TO DC; SGN: R:=IF R LSS 0 THEN -1 ELSE IF R GTR 0 THEN 1 ELSE 0; GO TO DC; RND: XRND:=XRND|2899;XRND:=XRND.[23:23]; R:=XRND|2*(-23);GO TO DC; DC: STACK(R) END; COMMENT USER FUNCTIONS SECTION ; UF: BEGIN INTEGER AS,SVSK,SVADDR; ARRAY DUM[1:20,1:4],SVSTK,SVADR[0:20]; K:=GET;AS:=CS;CS:=FUNC[K];IF CS=0 THEN BEGIN CS:=AS;ERROR(4) END; B:=CO;CO:=SPOB[CS];C:=GET;FOR A:=1 STEP 1 UNTIL SUB[K] DO BEGIN COMMENT SAVE VALUES OF FORMAL PARAMETERS AND STORE ACTUALS; R:=TOP;C:=GET;C:=64|C+GET;DUM[A,1]:=C;DUM[A,2]:=STORE[C];STORE[C]:=R END;SVADDR:=ADDR;SVSK:=STCK; FOR A:=0 STEP 1 UNTIL 20 DO BEGIN SVSTK[A]:=STK[A];SVADR[A]:=ADR[A] END; COMMENT NOW EVALUATE FUNCTION ANO RESTORE FORMAL PARAMETERS; R:=EVAL;FOR A:=1 STEP 1 UNTIL SUB[K] DO STORE[DUM[A,1]]:=DUM[A,2]; FOR A:=0 STEP 1 UNTIL 20 DO BEGIN STK[A]:=SVSTK[A];ADR[A]:=SVADR[A] END;ADDR:=SVADDR;STCK:=SVSK; CS:=AS;CO:=B;STACK(R) END; EQ: IF STRIN THEN BEGIN ADDR:=A:=ADR[STCK];STCK:=STCK-1; B:=ADR[STCK];REPLACE POINTER(STRGS[B,*]) BY POINTER(STRGS[A,*]) FOR 3 WORDS;TR4(B);GO TO SS END;R:=TOP;ADDR:=ADR[STCK]; STORE[ADDR]:=STK[STCK]:=R;TR1(R);GO TO SS; AD: R:=TOP;R:=R+TOP;STACK(R); SU: R:=TOP;R:=-R+TOP;STACK(R); MU: R:=TOP;R:=R|TOP;STACK(R); DI: R:=TOP;R:=1/R|TOP;STACK(R); EX: T:=TOP;R:=TOP;IF T NEQ ENTIER(T) AND R LSS 0 THEN ERROR(15);STACK(R*T); FIN: EVAL:=STK[1] END; COMMENT --- OUTP OUTPUTS CONTENTS OF PSEUDO-BUFFER ; PROCEDURE OUTP; BEGIN IF MF>0 THEN ERROR(26);TR3; WRITE(FL[OU],14,IOB[*]);REPLACE PIOB:=POUB:=POINTER(IOB[*]) BY " " FOR 112;IF OU=1 THEN PIOB:=POUB:=POUB+20 END; COMMENT --- MORE FALSE IF END OF STATEMENT ; BOOLEAN PROCEDURE MORE; BEGIN INTEGER A,B;A:=CO;B:=GET;MORE:=B NEQ 0;CO:=A END; COMMENT --- OUTNUM PLACES NUMBER IN PSEUDO-BUFFER ; PROCEDURE OUTNUM(A,F);VALUE A,F;REAL A;INTEGER F; BEGIN CHA:=0;CP:=CP-1;WRITE(IOBE[*],NUM[F],A); % CARE: SCAN APR:CPR FOR 16 UNTIL ="@"; IF DELTA(CPR,APR) NEQ 16 THEN REPLACE APR BY "E" FOR 1; IF DELTA(POUB,PIOB) GTR 60+F|4 THEN OUTP; REPLACE PIOB:PIOB BY POINTER(IOBE[1]) FOR 14 UNTIL=48; REPLACE PIOB:PIOB BY " " FOR 1 END; COMMENT --- QUO PLACES " IN OUTPUT BUFFER ; DEFINE QUO=IF MF>0 THEN REPLACE PIOB:PIOB BY """#; COMMENT --- MATOP PROCESSES MOST MAT STATEMENTS ; PROCEDURE MATOP; BEGIN INTEGER U,V,W,X,Y,Z,I,J; COMMENT MAT STATEMENTS CONCERNED HAVE FORMAT MAT LET = MAT = THE SECOND CHARACTER IN IS USED TO IDENTIFY ACTION TAKEN THIS CAN BE * + - E O D R N % (RECALL % IS END-STATEMENT CHARACTER) ; LABEL DONE,ADSU,EQM,CONS,EX,EY;REAL PIVOT,AI; INTEGER ARRAY IR[1:72];REAL ARRAY TEM[1:72]; DEFINE AA(AA1,AA2)=STORE[ARR[K,0]+(AA1-1)|U+AA2-1]#; CP:=GET;CHA:=0;K:=CHCONV(NCH);IF K=0 THEN ERROR(23); IF NCH NEQ 61 THEN ERROR(23);A:=CHCONV(NCH);CHA:=NCH; COMMENT SWITCH OCCURS HERE * MATRIX MULTIPLICATION IS * HASH STORAGE IS USED TO AVOID TROUBLE WITH A=A*B ETC ; ON("*") BEGIN B:=CHCONV(NCH); U:=ARR[K,1]-1;V:=ARR[K,2]-1;W:=ARR[A,1]-1;X:=ARR[A,2]-1; Y:=ARR[B,1]-1;Z:=ARR[B,2]-1;IF U NEQ W OR V NEQ Z OR X NEQ Y THEN ERROR(23);IF MSTO+(U+1)|(V+1) GTR 1000 THEN ERROR(25); FOR W:=0 STEP 1 UNTIL U DO FOR Z:=0 STEP 1 UNTIL V DO BEGIN R:=0; FOR Y:=0 STEP 1 UNTIL X DO R:=R+STORE[ARR[A,0]+X|W+W+Y]| STORE[ARR[B,0]+Y|V+Y+Z];STORE[MSTO+W|V+W+Z]:=R END; FOR W:=0 STEP 1 UNTIL U DO FOR Z:=0 STEP 1 UNTIL V DO STORE[ARR[K,0]+W|V+W+Z]:=STORE[MSTO+W|V+W+Z]; GO TO DONE END; COMMENT + MATRIX ADDITION IS + ; ON("+") BEGIN Z:=1;GO TO ADSU END; COMMENT - MATRIX SUBTRACTION IS - ; ON("-") BEGIN Z:=-1;GO TO ADSU END; COMMENT O ALL ONES IS CON ; ON("O") BEGIN Z:=Y:=1;GO TO CONS END; COMMENT D IDENTITY MATRIX IS IDN ; ON("D") BEGIN IF ARR[K,1] NEQ ARR[K,2] THEN ERROR(23);Z:=1;Y:=0; COMMENT E ZERO MATRIX IS ZER ; GO TO CONS END; ON("E") BEGIN Z:=Y:=0;GO TO CONS END; COMMENT R TRANSPOSITION IS TRN() HASH STORAGE USED TO AVOID TROUBLE WITH A=TRN(A) ; ON("R") BEGIN CHA:=NCH;CHA:=NCH;A:=CHCONV(NCH);IF A=0 THEN ERROR(23); U:=ARR[K,1]-1;V:=ARR[K,2]-1;W:=ARR[A,1]-1;X:=ARR[A,2]-1; IF U NEQ X OR V NEQ W THEN ERROR(23); IF MSTO+(U+1)|(V+1) GTR 1000 THEN ERROR(25); FOR U:=0 STEP 1 UNTIL X DO FOR V:=0 STEP 1 UNTIL W DO STORE[MSTO+U|W+U+V]:=STORE[ARR[A,0]+V|X+V+U]; FOR U:=0 STEP 1 UNTIL X DO FOR V:=0 STEP 1 UNTIL W DO STORE[ARR[K,0]+U|W+U+V]:=STORE[MSTO+U|W+U+V]; GO TO DONE END; COMMENT N INVERSION IS INV() ; ON("N") BEGIN CHA:=NCH;CHA:=NCH;A:=CHCONV(NCH); U:=ARR[K,1];IF U NEQ ARR[K,2] OR U NEQ ARR[A,1] OR U NEQ ARR[A,2] THEN ERROR(23);FOR I:=0 STEP 1 UNTIL U-1 DO FOR J:=0 STEP 1 UNTIL U-1 DO AA(I+1,J+1):=STORE[ARR[A,0]+I|U+J]; FOR V:=1 STEP 1 UNTIL U DO BEGIN PIVOT:=0; FOR I:=1 STEP 1 UNTIL U DO BEGIN IF V NEQ 1 THEN BEGIN FOR X:=1 STEP 1 UNTIL V-1 DO IF I=IR[X] THEN GO TO EX END; IF ABS(AA(I,V))GTR ABS(PIVOT) THEN BEGIN PIVOT:=AA(I,V);Y:=IR[V]:=I END; EX: END;IF ABS(PIVOT) LSS .0001 THEN ERROR(24); FOR J:=1 STEP 1 UNTIL U DO AA(Y,J):=AA(Y,J)/PIVOT;AA(Y,V):=1/PIVOT; FOR I:=1 STEP 1 UNTIL U DO IF I NEQ Y THEN BEGIN AI:=AA(I,V); AA(I,V):=-AI/PIVOT;FOR J:=1 STEP 1 UNTIL U DO IF J NEQ V THEN AA(I,J):=AA(I,J)-AI|AA(Y,J) END END; FOR I:=1 STEP 1 UNTIL U DO BEGIN FOR J:=1 STEP 1 UNTIL U DO TEM[J]:=AA(I,J); FOR J:=1 STEP 1 UNTIL U DO AA(I,IR[J]):=TEM[J] END; FOR J:=1 STEP 1 UNTIL U DO BEGIN FOR I:=1 STEP 1 UNTIL U DO TEM[I]:=AA(IR[I],J);FOR I:=1 STEP 1 UNTIL U DO AA(I,J):=TEM[I] END;GO TO DONE END; % EQUALITY COMMENT IS ; ON("%") BEGIN B:=A;Z:=0; GO TO EQM END; ERROR(23); ADSU: B:=CHCONV(NCH);IF B=0 THEN ERROR(23); IF ARR[A,1] NEQ ARR[B,1] OR ARR[A,2] NEQ ARR[A,2] THEN ERROR(23); EQM: U:=ARR[K,1];V:=ARR[K,2];IF U NEQ ARR[A,1] OR V NEQ ARR[A,2] THEN ERROR(23); FOR I:=0 STEP 1 UNTIL U-1 DO FOR J:=0 STEP 1 UNTIL V-1 DO AA(I+1,J+1):=STORE[ARR[A,0]+I|U+J]+Z|STORE[ARR[B,0]+I|U+J]; GO TO DONE; CONS: U:=ARR[K,I];FOR I:=1 STEP 1 UNTIL ARR[K,1] DO FOR J:=1 STEP 1 UNTIL ARR[K,2] DO AA(I,J):=IF I=J THEN Z ELSE Y; DONE: GO TO INCST END; LABEL RPT,REM,DAT,EXS,LET,RLET,ONX, INP,PRI,RPRI,XPRI,MAT,ENX,RREA,XREA,QDAT,FREA,RES,NDAT, STRV,FOL,INTVR,INDEXR,DZER,EXPVR, NM,TAB,COM,STR,EPRI,OUD,OUF, IFF,GOT,GOX,GOS,RET,FOX,NEX,FD,DEF,REA,EREA,RAN,PAG; SWITCH OPN:=LET,GOT,GOS,RET,INP,REA,EPRI,FOX,NEX,MAT, DEF,DAT,RAN,PAG,RES,REM,ENX,ENX,IFF,ONX; SWITCH TYP:=XPRI,COM,NM,TAB,STR,INCST,STRV; COMMENT---------------------------------------------------------------- ----------------- EXECUTE BEGINS HERE -------------------- -----------------------------------------------------------------------; INTOVR:=INTVR;EXPOVR:=EXPVR;ZERO:=DZER;INDEX:=INDEXR; WRITE(TTY,MESS);RT:=TIME(2)+TIM;IF OU=1 THEN WRITE(TTY,DVO); WRITE(FL[OU],SPC);NR:=IR:=RDAT:=RDTP:=NGOT:=0;TRACEON:=TLIN:=FALSE; FORC:=SLVE:=0;XRND:=101;CS:=ACS-1; POUB:=PIOB:=POINTER(IOB[*])+20|OU; REPLACE POINTER(IOB[*]) BY " " FOR 112; % GET FILES IF NEEDED: IF INFILTOG THEN BEGIN FILL FIL1 WITH IO[1],TIME(-1); SEARCH(FIL1,ANSA[*]);IF ANSA[0] LEQ 0 THEN ERROR(28+ANSA[0]); IF ANSA[3] NEQ 10 OR ANSA[4] NEQ 300 THEN ERROR(29) END; IF OUTFILTOG THEN BEGIN FILL FIL2 WITH IO[2],TIME(-1); SEARCH(FIL2,ANSA[*]);IF ANSA[0] NEQ -1 THEN BEGIN WRITE(TTY,F13,IO[2].[41:36]); IF IU=2 THEN U:=0 ELSE READ(TTY,REP,U);IF U NEQ "YES" THEN ERROR(30) END END; COMMENT RETURN TO HERE AFTER EACH STATEMENT; REM:DAT:INCST: TR3;CS:=CS+1; EXS: MF:=0; % FIRST SEE IF EXCESS TIME IF TIME(2) GTR RT THEN BEGIN WRITE(TTY,BK);GO TO ENX END; IF STYP[CS]>19 THEN BEGIN TRACEON:=STYP[CS]=20;GO INCST END; IF TRACEON THEN TLIN:=TRUE; U:=STYP[CS];CO:=SPOB[CS];GO TO OPN[U]; % NOW GO TO APPROPRIATE PLACE % LET STATEMENT LET: R:=EVAL;GO TO INCST; % ON STATEMENT ONX: U:=EVAL; FOR V:=1 STEP 1 UNTIL 2|U-2 DO BEGIN S:=GET END;GO GOT; %(STET) % IF STATEMENT IFF: R:=EVAL;IF STRIN THEN BEGIN COMMENT STRING IF ; U:=GET; REPLACE IPR:=POINTER(STRGS[-1,*]) BY POINTER(STRGS[ADDR,*]) FOR 24; R:=EVAL;GO IF IPR=POINTER(STRGS[ADDR,*]) FOR STRGS[-1,0]+8 EQV U=1 THEN GOT ELSE INCST END; COMMENT REAL IF ; U:=GET;R:=R-EVAL; IF R GTR 0 AND U.[2:1]=1 THEN GO TO GOT ELSE IF R LSS 0 AND U.[1:1]=1 THEN GO TO GOT ELSE IF R = 0 AND U.[0:1]=1 THEN GO TO GOT;GO TO INCST; % GOTO STATEMENT GOT: U:=GET;U:=64|U+GET;IF U=0 THEN ERROR(6); GOX: NGOT:=NGOT+1;TR2(U); COMMENT MONITOR FOR EXCESS LOOPING; IF NGOT=100 AND IU NEQ 2 THEN BEGIN WRITE(TTY,WRN);READ(TTY,REP,W); IF W NEQ "YES" THEN GO TO STOP END; CS:=U;GO EXS; % GOSUB STATEMENT GOS: SLVE:=SLVE+1;IF SLVE GTR 10 THEN ERROR(17); SVE[SLVE]:=CS;GO GOT; % RETURN STATEMENT RET: IF SLVE=0 THEN ERROR(7); CS:=SVE[SLVE];SLVE:=SLVE-1;GO TO INCST; % FOR STATEMENT FOX: FORC:=GET;R:=EVAL; COMMENT FORX CONTROL INFO IS STORED AS FOLLOWS: 1 2 3 4 ADDR STEP FINAL FORLINE A FOR LOOP IS EXECUTED ZERO TIMES IN THE RIGHT CIRCUMSTANCES; V:=FORX[FORC,1]:=ADDR;S:=FORX[FORC,3]:=EVAL; T:=FORX[FORC,2]:=IF MORE THEN EVAL ELSE 1; W:=FORX[FORC,4]:=CS;IF T=0 THEN ERROR(9); IF T|R LEQ T|S THEN GO INCST; % ELSE SKIP LOOP U:=GET;U:=GET;CS:=64|U+GET;GO TO INCST; % NEXT STATEMENT % SPOB STORES (NEXTS LEVEL IN FORX)+16|FORLINE NEX: U:=SPOB[CS].[3:4];V:=SPOB[CS].[41:38]; IF V NEQ FORX[U,4] THEN ERROR(10);L:=FORX[U,1]; T:=FORX[U,2];R:=STORE[L]+T; IF T|R LEQ T|FORX[U,3] THEN BEGIN STORE[L]:=R;TR1(R);T:=FORX[U,4]; TR2(T+1);CS:=T END ELSE FORX[U,4]:=0; GO TO INCST; % DEFINE STATEMENT DEF: U:=GET;FUNC[U]:=CS;GO TO INCST; % READ STATEMENT REA: U:=0; COMMENT THIS SECTION IS COMPLICATED BECAUSE OF SWITCHING OF ATTENTION FROM READ STATEMENT TO DATA STATEMENT AND BACK ETC; RREA: R:=EVAL;L:=ADDR;U:=CS;V:=CO; IF RDTP=0 THEN GO TO QDAT;CO:=RDTP;CS:=RDAT; XREA: IF STRIN THEN BEGIN R:=EVAL;CS:=U;IF NOT STRIN THEN ERROR(20);REPLACE POINTER(STRGS[L,*])BY POINTER(STRGS[ADDR,*]) FOR 3 WORDS;TR4(L) END ELSE BEGIN R:=EVAL;IF STRIN THEN ERROR(20); STORE[L]:=R;CS:=U;TR1(R) END;RDTP:=IF MORE THEN CO ELSE 0;CO:=V; IF MORE THEN GO TO RREA ELSE GO TO INCST; COMMENT FIND ANOTHER DATA STATEMENT; QDAT: FOR CS:=RDAT+1 STEP 1 UNTIL MS DO BEGIN IF STYP[CS]=12 THEN GO TO FREA END; CS:=U;ERROR(21); FREA: RDAT:=CS;CO:=SPOB[CS];GO TO XREA; % INPUT STATEMENT % "STOP" AT START OF INPUT STREAM STOPS A RUN INP: BEGIN LABEL RINP,EVINP,RPT,EXPON,DONE,FINP; MF:=GET;IF MF=0 THEN BEGIN IF IU=2 THEN ERROR(5); IF DELTA(POUB,PIOB) GTR 0 THEN BEGIN REPLACE POINTER(IOBE[*]) BY POUB FOR 72;WRITE(TTY[STOP],9,IOBE[*]); REPLACE PIOB:=POUB:=POINTER(IOB[*]) BY " " FOR 112;IF OU=1 THEN PIOB:=POUB:=PIOB+20 END;READ(TTY,9,IOBE[*]); READ(IOBE[*],REP,V);IF V="STO" THEN GO TO STOP END ELSE BEGIN Z:=GET;Z:=64|Z+GET;READ(FIL1,10,IOBE[*])[OUD]; READ(IOBE[*],SNUM,IR) END; REPLACE POINTER(PROG[0,2]) BY POINTER(IOBE[1]) FOR 72;X:=0; RINP: R:=EVAL;L:=ADDR;U:=CS;CS:=0;CP:=X;CHA:=0; IF NCH="%" THEN BEGIN IF MF=0 THEN BEGIN WRITE(TTY,MNP[IF X=0 THEN 1 ELSE 0],PROG[U,1]);CS:=U;GO TO EXS END ELSE BEGIN READ(FIL1,9,IOBE[*])[OUD]; REPLACE POINTER(PROG[0,2]) BY POINTER(IOBE[*]) FOR 72;CP:=1 END END; COMMENT INPUT STRING MAY OR MAY NOT HAVE "" ; EVINP: CP:=CP-1;CHA:=NCH;IF STRIN THEN BEGIN ON(63) SCAN APR:APR:=CPR:=POINTER(PROG[0,2])+CP FOR 15 WHILE NEQ 63 ELSE BEGIN CP:=CP-2;SCAN APR:APR:=CPR:=POINTER(PROG[0,2])+CP+1 FOR 15 WHILE IN ALPHA END; V:=DELTA(CPR,APR);IF V>14 THEN BEGIN CS:=U;ERROR(20) END; STRGS[L,0]:=V;REPLACE POINTER(STRGS[L,1]) BY CPR FOR V; CP:=CP+V+1;CHA:=NCH;CS:=U;TR4(L);GO FINP END; T:=R:=Y:=0; COMMENT INPUT NUMBER ; ON(44) BEGIN T:=1;CHA:=NCH END; RPT: ON(26) BEGIN Y:=1;CHA:=NCH END; IF CHA GEQ 10 THEN GO TO EXPON;IF Y GTR 0 THEN BEGIN R:=R+CHA|10*(-Y); Y:=Y+1 END ELSE R:=R|10 +CHA;CHA:=NCH; GO TO RPT; EXPON: IF CHA NEQ 21 THEN GO TO DONE;Y:=1;CHA:=NCH;Z:=0; ON(44)BEGIN Y:=-1;CHA:=NCH END ELSE ON(16) CHA:=NCH; IF CHA GEQ 10 THEN BEGIN CS:=U;ERROR(18) END;Z:=CHA;CHA:=NCH; IF CHA LSS 10 THEN BEGIN Z:=Z|10+CHA;CHA:=NCH END; R:=R|10*(Y|Z); DONE: IF T=1 THEN R:=-R;DELIM:=72;STORE[L]:=R;CS:=U;TR1(R); FINP: X:=CP;IF CHA NEQ 58 AND CHA NEQ "%" THEN ERROR(19); IF MORE THEN GO TO RINP ELSE GO TO INCST END; % RANDOMISE STATEMENT RAN: XRND:=(2|TIME(1)+1).[23:23];GO TO INCST; % RESTORE STATEMENT RES: MF:=GET;IF MF=0 THEN RDTP:=RDAT:=0 ELSE REWIND(FIL1); GO INCST; % PRINT STATEMENT EPRI: MF:=GET;IF MF>0 THEN BEGIN PBR:=PIOB; TR3;Z:=GET;Z:=64|Z+GET; POUB:=POINTER(IOF[*]);REPLACE PIOB:=POINTER(IOF[*]) BY " " FOR 72 END; PRI: CHA:=GET;IF MF>0 AND CHA=5 THEN ERROR(26); GO TO TYP[CHA+1]; Z:=GET;Z:=64|X+GET; COMMENT , IN PRINT MOVES TO NEXT 14-SPACE COLUMN. (SEMICOLON IN MIDDLE OF PRINT IS JUST DELIMITER); COM: IF MF>0 THEN REPLACE PIOB:PIOB BY "," ELSE BEGIN V:=DELTA(POUB,PIOB);IF V GTR 56 THEN BEGIN OUTP;V:=0 END ELSE V:=14-(V MOD 14); FOR U:=1 STEP 1 UNTIL V DO REPLACE PIOB:PIOB BY " " END; GO TO PRI; COMMENT PLACE STRING IN PSEUDO-BUFFER ; STR: CP:=GET; CPR:=POINTER(PROG[CS,2])+CP; V:=72-DELTA(POUB,PIOB);W:=GET; IF W GTR V THEN BEGIN REPLACE PIOB:PIOB BY CPR:CPR FOR V; OUTP;W:=W-V END; QUO;REPLACE PIOB:PIOB BY CPR:CPR FOR W;QUO; GO TO PRI; COMMENT TAB OVERWRITES ON TELETYPE AND LINE-PRINTER BUT REPLACES ON VIDEO UNIT. ; TAB: IF MF>0 THEN ERROR(26);U:=EVAL-1;U:=U MOD 72; IF IU+OU NEQ 0 THEN BEGIN TR3;WRITE(FL[OU][NO],9,IOB[*]); REPLACE POUB BY " " FOR 72 END;PIOB:=POUB+U; GO TO PRI; STRV: R:=EVAL;QUO;REPLACE PIOB:PIOB BY POINTER(STRGS[ADDR,1]) FOR STRGS[ADDR,0];QUO;GO TO PRI; NM: OUTNUM(EVAL,0);GO TO PRI; XPRI: IF MF>0 THEN BEGIN REPLACE PIOB BY ","; NR:=NR+10;REPLACE POINTER(IOF[10]) BY NR FOR 8 DIGITS; WRITE(FIL2,10,IOF[*])[OUF];PIOB:=PBR;POUB:=POINTER(IOB[*])+20|OU END ELSE OUTP;GO TO INCST; % PAGE STATEMENT PAG: IF OU=1 THEN WRITE(LIN[PAGE]);GO TO INCST; % MAT STATEMENT % MAT 1=READ, 2=PRINT, 3=MATOP, 4=SCALAR MULTIPLE MAT: BEGIN INTEGER E,F,G;LABEL QDAT,FREA,XREA,RREA; L:=GET;IF L=1 THEN BEGIN E:=CS;L:=GET;U:=GET;V:=GET; FOR W:=0 STEP 1 UNTIL U-1 DO FOR X:=0 STEP 1 UNTIL V-1 DO BEGIN IF RDTP = 0 THEN GO TO QDAT;CO:=RDTP;CS:=RDAT; XREA: STORE[ARR[L,0]+W|ARR[L,2]+X]:=EVAL; RDTP:=IF MORE THEN CO ELSE 0;GO TO RREA; QDAT: FOR CS:=RDAT + 1 STEP 1 UNTIL MS DO BEGIN IF STYP[CS] =12 THEN GO TO FREA END;CS:=E;ERROR(21); FREA: RDAT:=CS;CO:=SPOB[CS];GO TO XREA; RREA: END;CS:=E;GO TO INCST END; IF L=2 THEN BEGIN IF DELTA(POUB,PIOB) GTR 0 THEN OUTP; L:=GET;U:=GET;V:=GET;E:=GET;G:=14-E|7;FOR W:=0 STEP 1 UNTIL U-1 DO BEGIN FOR X:=0 STEP 1 UNTIL V-1 DO BEGIN OUTNUM(STORE[ARR[L,0]+ W|ARR[L,2]+X],E);PIOB:=POUB+G|((DELTA(POUB,PIOB)-1) DIV G +1) END;OUTP END;GO TO INCST END; IF L=3 THEN MATOP; L:=GET;R:=EVAL;W:=GET; IF ARR[L,1] NEQ ARR[W,1] OR ARR[L,2] NEQ ARR[W,2] THEN ERROR(23); FOR U:=0 STEP 1 UNTIL ARR[L,1]-1 DO FOR V:=0 STEP 1 UNTIL ARR[L,2]-1 DO STORE[ARR[L,0]+U|ARR[L,2]+V]:=R|STORE[ARR[W,0]+U|ARR[L,2]+V]; GO TO INCST END; % STOP OR END STATEMENT ENX: TR3;IF DELTA(POUB,PIOB)>0 THEN OUTP; LOCK(FIL1);LOCK(FIL2);GO TO STOP; OUD: IF Z=0 THEN ERROR(21);TR2(Z);CS:=Z;GO EXS; OUF: IF Z=0 THEN ERROR(26);TR2(Z);CS:=Z;GO EXS; INTVR: ERROR(12);INDEXR: ERROR(13); DZER: ERROR(14);EXPVR: ERROR(16) END; STOP: WRITE(TTY,STP,"RUN ");GO TO SOURCEIN; COMMENT PROGRAM WRITTEN BY MALCOLM CROWE LANGUAGE DETAILS DECIDED BY IAN MILLER AND JOHN FURLONG MATRIX INVERSION CORRECTED BY ARTHUR MACDIVITT ; FINSH: END. ?END