$ CARD LIST SINGLE XREF 00000100 BEGIN 00000200 COMMENT::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 00000300 ::::: XBASIC -- A CONVERSATIONAL BASIC INTERPRETER ::::: 00000400 ::::: ::::: 00000500 ::::: MK XV 1.04: 1 DECEMBER 1975 ::::: 00000600 ::::: ::::: 00000700 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 00000800 00000900 XBASIC IS A BASIC INTERPRETER DEVELOPED FOR THE BURROUGHS RANGE 00001000 OF COMPUTERS BY STAFF AT PAISLEY COLLEGE OF TECHNOLOGY. ITS PURPOSE 00001100 IS TO PROVIDE FAST RESPONSE TO SIMPLE BASIC PROGRAMS UNDER TIME- 00001200 SHARING. ACTUAL RUNNING OF PROGRAMS IS MUCH SLOWER FOR XBASIC, BUT 00001300 EXPERIENCE SHOWS THAT MOST CLASS TIME IS SPENT ON INPUT AND COMPILE. 00001400 00001500 XBASIC IS AN IMPLEMENTATION OF STANDARD BASIC, AND DIFFERS 00001600 FROM BURROUGHS BASIC IN CERTAIN MATTERS OF DETAIL. THE COMMANDS 00001700 ALLOWED IN XBASIC FORM A SUBSET OF THE COMMANDS AVAILABLE UNDER CANDE. 00001800 FILES ARE EDITABLE UNDER CANDE. TRACE AND UNTRACE STATEMENTS 00001900 CAN BE MADE AVAILABLE - SEE LINES 83300-83400 AND 107300-108700. 00002000 XBASIC OUTPUT MAY BE DIVERTED FROM REMOTE TO PRINTER ("SEND"). 00002100 VIDEO TERMINALS ARE SUPPORTED FOR EASY CORRECTION OF SOURCE PROGRAM. 00002200 PROGRAMS ARE MONITORED FOR EXCESS LOOPING. 00002300 00002400 TO USE XBASIC FROM THE BATCH TERMINAL, THE FOLLOWING 00002500 CARDS SHOULD BE SUPPLIED: 00002600 ? EXECUTE 0XBASIC/UTILITY 00002700 ? COMMON=2 00002800 ? DATA CRD 00002900 (INSERT DECK HERE: USE TERMINAL FORMAT) 00003000 ? END 00003100 00003200 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; 00003300 COMMENT 00003400 THE BLOCK STRUCTURE FOR THE PROGRAM IS AS FOLLOWS: 00003500 00003600 ------------- /------| 00003700 1 SOURCEIN: 1 / DOES | 00003800 START-->--1 & EXECUTE 1--RUN->----< OBJECT >--YES--->---| 00003900 1 1 COMMANDS 1 | EXIST? / 1 00004000 A ------------- |------| V 00004100 1 1 1 1 00004200 1 1 (YES) V (NO) 1 00004300 1 /------| 1 1 00004400 1 / ANY | ------------- 1 00004500 1 < SYNTAX >------<----1 COMPILE: 1 1 00004600 1 | ERRORS?/ 1 1 1 00004700 1 |------/ ------------- 1 00004800 1 1 1 00004900 1 V (NO) 1 00005000 1 1 1 00005100 1 ------------- 1 00005200 |---<---1 EXECUTE: 1------------------<--------------/ 00005300 ------------- 00005400 00005500 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; 00005600 00005700 INTEGER IU; % (COMMON) INPUT UNIT=0 VDU,1 TTY,2 CRD 00005800 00005900 INTEGER ARRAY PROG[0:200,2:11], % SOURCE STRINGS 00006000 SSEQ[0:200], % SEQUENCE NUMBERS 00006100 STYP, % STATEMENT TYPES 00006200 SPOB[1:200], % POINTERS TO OBJECTPROGRAM 00006300 SUB[1:26], % INFO ON USER FUNCTIONS 00006400 ARR[1:26,0:2], % ARRAYS 00006500 STRAR[1:26,0:1], % STRING ARRAYS 00006600 IOB[1:240],IOF[1:10], % I/O PSEUDOBUFFERS 00006700 IOBE[1:14], % " " 00006800 KEY[1:38], % COMPILE KEYWORDS 00006900 FNM[1:3,1:2]; % FILENAMES FOR EXECUTE 00007000 00007100 REAL ARRAY OBJ[0:999], % PSEUDO-OBJECTPROGRAM 00007200 FORX[1:10,1:4], % INFO ON FOR STATEMENTS 00007300 CONST[1:1000], % SOURCE PROGRAM CONSTANTS 00007400 ANSA[0:9], % FOR DISK SEARCH 00007500 IO[0:3]; % FILENAMES 00007600 00007700 INTEGER MS, % NUMBER OF LINES OF PROGRAM 00007800 ACS, % FIRST EXECUTABLE STATEMENT 00007900 CS, % CURRENT STATEMENT NUMBER 00008000 CHA, % CURRENT SOURCE CHARACTER 00008100 CP, % POSITION OF CHA IN SOURCE 00008200 LP, % SEE LOOK 00008300 CO, % POSITION IN OBJ 00008400 OU, % OUTPUT UNIT (0 REMOTE, 1 PRINTER) 00008500 MSTO, % CURRENT TOP OF ARRAYS 00008600 MSTR, % CURRENT TOP OF STRING ARRAYS 00008700 NCON, % NUMBER OF CONSTANTS 00008800 DELIM, % SEE NCH 00008900 TIM, % MAX EXECUTION TIME (2 MIN USUALLY) 00009000 LL, % CURRENT LINE NUMBER IN INPUT PAGE 00009100 AREASIZE, % FOR EXECUTE OUTPUT FILE IF ANY 00009200 BEG, % LIST COMMAND INITIAL LINE 00009300 EN, % FINAL LINE 00009400 NDEP, % ARITH STACK COUNTER 00009500 ADDR, % CURRENT VARIABLE ADDRESS 00009600 FORE,FORC, % HELP COMPILE FOR NESTS 00009700 NF, % NUMBER OF EXECUTE FILES 00009800 A,B,C,D,K; % HASH 00009900 00010000 REAL R,S,T; % HASH 00010100 00010200 BOOLEAN OBJECT, % "THERE IS AN ORJECTPROGRAM" 00010300 STRIN, % "EXPRESSION IS A STRING" 00010400 HDDR, % "PRINTER HEADER PRINTED" 00010500 INFILTOG, % "PROGRAM NEEDS INPUT FILE" 00010600 OUTFILTOG, % "PROGRAM NEEDS OUTPUT FILE" 00010700 FIRSTOFF, % "HELLO" 00010800 DANGER, % "NEW MATERIAL IN WORKFILE" 00010900 VAR, % "EXPRESSION IS A VARIABLE" 00011000 SY, % "PROGRAM CONTAINS SYNTAX ERRORS" 00011100 EQOK, % "EXPRESSION MAY CONTAIN =" 00011200 AA; % "SUCCESSIVE EXPNS TO PRINT" 00011300 00011400 POINTER PINB, % START OF LINE IN IOB[*] 00011500 PIOB, % CURRENT CHARACTER " 00011600 PIBE, % LAST CHARACTER IN IOBE[1] 00011700 POB, % FIRST CHARCTER IN OBJ[*] 00011800 APR,BPR,CPR; % HASH 00011900 00012000 FORMAT WHT ("ERR- ",A6," IS NOT A COMMAND IN XBASIC"), 00012100 STP (/"END ",A6), 00012200 SPC (/), 00012300 WRN ("MORE THAN 100 GOTOS. IS YOUR PROGRAM ALL RIGHT?"), 00012400 REP (A3), 00012500 SYER ("SYNTAX ERRORS: CLEAR SCREEN AND TRANSMIT A SPACE"), 00012600 SYR ("SYNTAX ERRORS:"), 00012700 WT ("WAIT-"), 00012800 MESS ("EXECUTING"), 00012900 INTR ("ILLEGAL NUMBER"), 00013000 LNGPRG("PROGRAM TOO LONG AT LINE ",I6), 00013100 INVIT ("VDU ASSUMED - ELSE SAY TTY"), 00013200 DVO ("OUTPUT IS BEING DIVERTED TO PRINTER"), 00013300 BK ("EXECUTION STOPPED - EXCESS TIME."/ 00013400 "FOR LONG PROGRAMS USE MAIN SYSTEM"), 00013500 SNUM (X72,I8), 00013600 F1 ("USE RENAME XXXXXX OR SAVE XXXXXX COMMAND"), 00013700 F2 ("ERR? THIS WILL DELETE THE WORKFILE"), 00013800 F3 ("OK- ",I3," RECORDS",A6,"D, LAST RECORD =",I7), 00013900 F4 ("FILE ",A6," - ",A6,A1," BY XBASIC"), 00014000 F5 ("YOUR WORKFILE IS AS AT LAST RUN COMMAND"), 00014100 F6 (I6,X3,"DIM OR FILES STATEMENT OUT OF SEQUENCE"/ 00014200 "ERR RUN"), 00014300 F7 ("WORKFILE NOW EMPTY"), 00014400 HD1 ("FURTHER OUTPUT WILL BE PRINTED WHEN YOU SIGN OFF"), 00014500 HD3 (X40,"XBASIC MK XV",X8,"RUN ",A6,"DAY ", 00014600 A2,"/",A2,"/",A2,/X54,"USER NO. ",A3,A4,/X52,20("*")//), 00014700 00014800 F9 ("XBASIC IS RUNNING-"), 00014900 F10 ("UNNAMED WORKFILE HAS",I4," RECORDS, LAST RECORD =",I6), 00015000 F11 (A6," (WORKFILE) HAS",I4," RECORDS, LAST RECORD =",I6), 00015100 F12 ("ERR- ILLEGAL PARAMETER"), 00015200 F13 ("ARE PRESENT CONTENTS OF FILE ",A6," TO BE DESTROYED?"); 00015300 00015400 SWITCH FORMAT NUM:=(U10),(U6),(X20,U10); 00015500 SWITCH FORMAT MNP:=("NOT ENOUGH INPUT AT LINE",I6,X5,"TRY AGAIN"), 00015600 ("BLANK INPUT AT LINE",I6,X5,"IGNORED"); 00015700 00015800 FILE TTY 19(2,10);FILE IN CRD 2(2,10); FILE IN VDU 19(1,240); 00015900 FILE OUT LIN 1(2,14);SWITCH FILE FN:=TTY,CRD;SWITCH FILE FL:=TTY,LIN; 00016000 00016100 MONITOR INTOVR,EXPOVR,INDEX,FLAG,ZERO; 00016200 00016300 LABEL SOURCEIN,COMPILE,EXECUTE,STOP,FINSH,ERR,INCST,PER,INER, 00016400 TOOLONG; 00016500 00016600 LABEL EXS,EQL,LET,CAR,ONX,RON,IFF,FEQ,GOT,GOS,RET,FOX,NEX, 00016700 DEF,REA,RREA,INP,RAN,RES,PRI,RPRI,XPRI,DIM,ENX,REM,RFIL, 00016800 INTVR,QUOTE,RDUM,DAT,RDAT,RDIM,PAG,MAT,IOMT,FLAGR,FIL,CGO; 00016900 00017000 SWITCH OPN:=LET,GOT,GOS,RET,INP,REA,PRI,FOX,NEX,MAT, 00017100 DEF,DAT,RAN,PAG,RES,REM,ENX,ENX,IFF,ONX; 00017200 00017300 00017400 DEFINE ON(ON1)=IF CHA=ON1 THEN #; 00017500 00017600 COMMENT::::::::::::::::GLOBAL PROCEDURES::::::::::::::::::::::::::: 00017700 00017800 --- CHCONV CONVERTS CHA TO LETTER CODE 1-26 ; 00017900 00018000 INTEGER PROCEDURE CHCONV(A);VALUE A; INTEGER A; 00018100 BEGIN CHCONV:=0;IF A GTR 16 AND A LSS 26 THEN CHCONV:=A-16 ELSE 00018200 IF A GTR 32 AND A LSS 42 THEN CHCONV:=A-23 ELSE 00018300 IF A GTR 49 AND A LSS 58 THEN CHCONV:=A-31 END; 00018400 COMMENT 00018500 --- NCH PICKS NEXT CHARACTER FROM SOURCE STRING 00018600 AND STORE IT IN CHA. BLANKS ARE SKIPPED. 00018700 IF LAST CHAR- RETURN "%" AT DELIM. 00018800 CP IS UPDATED. IOBE[*] IS USED AS HASH.; 00018900 00019000 INTEGER PROCEDURE NCH; 00019100 BEGIN INTEGER A;LABEL RPT; POINTER CPR; 00019200 IOBE[1]:=0;A:=CP; 00019300 RPT: IF A GEQ DELIM THEN CHA:=NCH:="%" ELSE BEGIN 00019400 CPR:=POINTER(PROG[CS,2])+A; 00019500 REPLACE PIBE BY CPR:CPR FOR 1;A:=A+1; 00019600 IF IOBE[1]=48 THEN GO TO RPT;CHA:=NCH:=IOBE[1];CP:=A 00019700 END END; 00019800 COMMENT 00019900 --- NMBR PICKS UP STATEMENT NUMBER ; 00020000 INTEGER PROCEDURE NMBR(N);VALUE N;INTEGER N; 00020100 BEGIN LABEL DONE,RNB,BLK,NST,SKB; 00020200 DEFINE RD(RD1)=REPLACE BPR BY APR:APR FOR 1; 00020300 IF DELTA(PINB,APR) GEQ RD1 THEN GO BLK;IF IOBE[1]#; 00020400 CHA:=NMBR:=IOBE[1]:=0; 00020500 NST: RD(N)=48 THEN GO NST;IF (CHA:=IOBE[1]) GEQ 10 THEN GO DONE; 00020600 RNB: RD(72) LSS 10 THEN BEGIN CHA:=CHA|10+IOBE[1];GO RNB END; 00020700 NMBR:=CHA;CHA:=IOBE[1];IF CHA NEQ 48 THEN GO DONE; 00020800 SKB: RD(72)=48 THEN GO SKB;CHA:=IOBE[1];GO DONE; 00020900 00021000 00021100 BLK: CHA:="%"; 00021200 DONE: END; 00021300 COMMENT 00021400 --- FILECONTROL DEALS WITH SOURCE FILE OPERATIONS 00021500 A=0 "MAKE"/"RENAME", 00021600 1 "SAVE", 2 "LOAD"/"COPY", 00021700 3 "REMOVE", 4 SAVE WORKFILE(AT "RUN") 00021800 5 LOAD WORKFILE(AT XBASIC ENTRY), 00021900 6 EXPLICIT REMOVE (AT "BYE",ETC) 00022000 7 EXPLICIT SAVE, 8 EXPLICIT LOAD; 00022100 00022200 PROCEDURE FILECONTROL(A,C,D,L);VALUE A,C,D;INTEGER A;REAL C,D;LABEL L; 00022300 % C AND D CARRY LABEL EQUATE FOR EXPLICIT OPERATIONS 00022400 BEGIN INTEGER B,X,Y; 00022500 PROCEDURE FILERR(E);VALUE E;INTEGER E; 00022600 BEGIN SWITCH FORMAT ERR:=("ERR- ",A3,A4,"/",A3,A4,"- NOT ON DISK"), 00022700 ("ERR- ",A3,A4,"/",A3,A4," - INVALID USER"), 00022800 ("ERR- ",A3,A4,"/",A3,A4," - NON-STANDARD"), 00022900 ("ERR- ",A3,A4,"/",A3,A4," - ILLEGAL NAME"), 00023000 ("ERR- ",A3,A4,"/",A3,A4," - DUPLICATE NAME"), 00023100 ("ERR- NO FILENAME"), 00023200 ("ERR- WORKFILE"), 00023300 ("ERR- WORKFILE IS EMPTY"); 00023400 00023500 IF E>4 THEN WRITE(TTY,ERR[E]) ELSE WRITE(TTY,ERR[E], 00023600 FOR X:=B,2 DO [IO[X].[41:18],IO[X].[23:24]]); 00023700 IF B=0 THEN IO[0]:=0;IF A=1 AND E=3 THEN WRITE(TTY,F1); 00023800 GO SOURCEIN END; 00023900 LABEL SKIP,MK,SV,LD,RM,EF,SW,LW,EW; 00024000 SWITCH OP:=MK,SV,LD,RM,SW,LW,RM,SV,LD; 00024100 FILE DSK DISK "XBWKFL "(2,10,300,SAVE 7);% NB LABEL EQN ABOVE SKIP 00024200 IF DANGER AND (C="CREATE" OR A=2 OR A=6) THEN BEGIN DANGER:=FALSE; 00024300 WRITE(TTY,F2);GO SOURCEIN END; 00024400 B:=IF A=0 THEN 0 ELSE 1;IF A>3 THEN BEGIN 00024500 FILL DSK WITH C,D;IO[1]:=C;IO[2]:=D;GO SKIP END; 00024600 IO[B]:=" "; % FILENAME 00024700 SCAN APR:APR FOR 5 UNTIL NEQ " ";IF DELTA(PINB,APR)<12 THEN 00024800 REPLACE POINTER(IO[B])+1 BY APR:APR FOR IF A<2 THEN 6 ELSE 7 00024900 WHILE IN ALPHA; 00025000 IF IO[B]=" " THEN BEGIN % ON SAVE SAVE WKFILE IF NO NAME 00025100 IF A=1 AND IO[0] NEQ 0 THEN IO[1]:=IO[0] ELSE FILERR(5) END; 00025200 IO[2]:=0;IF A GTR 1 THEN BEGIN % PROCESS "/USERCODE" IF PRESENT 00025300 SCAN CPR:CPR:=APR FOR 10 WHILE NEQ "/";IF DELTA(PINB,CPR) LSS 15 THEN 00025400 BEGIN IO[2]:=" "; 00025500 REPLACE POINTER(IO[2])+1 BY APR:CPR+1 FOR 7 WHILE IN ALPHA END END; 00025600 IF IO[2]=0 THEN IO[2]:=TIME(-1); 00025700 IF IO[B]="XBWKFL " OR IO[B].[41:36] LSS "A00000" THEN FILERR(3); 00025800 FILL DSK WITH IO[B],IO[2];DSK.SAVE:=7; 00025900 SKIP: IF NOT FIRSTOFF THEN BEGIN X:=CHA;Y:=NMBR(72); 00026000 IF Y NEQ 0 OR CHA NEQ "%" THEN GO PER;CHA:=X END; 00026100 SEARCH(DSK,ANSA[*]);IF (A=5 OR A=6) AND ANSA[0]=-1 THEN GO L; 00026200 IF A=0 AND ANSA[0] NEQ -1 THEN FILERR(4); 00026300 IF A=1 AND IO[1] NEQ IO[0] AND ANSA[0] NEQ -1 THEN FILERR(4); 00026400 IF A>1 AND A NEQ 4 THEN BEGIN IF ANSA[0] LEQ 0 THEN FILERR(ANSA[0]+1); 00026500 IF ANSA[3] NEQ 10 OR ANSA[4] NEQ 300 THEN FILERR(2) END; 00026600 IF CHA="MAKE00" THEN BEGIN MS:=0;OBJECT:=FALSE END; 00026700 GO OP[A+1]; 00026800 SV: IF IO[0]=0 THEN IO[0]:=IO[B]; % NAME WORKFILE 00026900 IF MS=0 THEN FILERR(7);IF ANSA[0] NEQ -1 AND ANSA[0] NEQ 7 THEN 00027000 FILERR(1);DSK.AREAS:=20;DSK.AREASIZE:=10; 00027100 FOR CS:=1 STEP 1 UNTIL MS DO BEGIN % SAVE IT IN CANDE FORMAT 00027200 REPLACE POINTER(IOBE[10]) BY SSEQ[CS] FOR 8 DIGITS; 00027300 REPLACE POINTER(IOBE[*]) BY POINTER(PROG[CS,2]) FOR 9 WORDS; 00027400 WRITE(DSK,10,IOBE[*]) END;LOCK(DSK);DANGER:=FALSE;GO MK; 00027500 LD: FOR MS:=1 STEP 1 UNTIL 200 DO BEGIN % LOAD FROM 00027600 READ(DSK,10,IOBE[*])[EF];READ(IOBE[*],SNUM,SSEQ[MS]); % CANDE FORMAT 00027700 WRITE(PROG[MS,*],9,IOBE[*]);PROG[MS,11]:=SSEQ[MS] END; 00027800 EF: MS:=MS-1;OBJECT:=FALSE;LOCK(DSK); 00027900 WRITE(TTY,F3,MS,C,SSEQ[MS]); 00028000 ON("LOAD00") IO[0]:=IF IO[2]=TIME(-1) THEN IO[1] ELSE 0;GO MK; 00028100 RM: IF IO[B]=IO[0] AND A=3 THEN BEGIN IF MS=0 THEN 00028200 IO[0]:=0 ELSE FILERR(6) END;IF ANSA[0] NEQ 7 THEN FILERR(1); 00028300 WRITE(DSK,*,0);CLOSE(DSK,PURGE);GO MK; 00028400 SW: DSK.AREAS:=20;DSK.AREASIZE:=11; 00028500 IF MS=0 THEN FILERR(7); 00028600 WRITE(DSK,*,IO[0]);FOR CS:=1 STEP 1 UNTIL MS DO 00028700 WRITE(DSK,10,PROG[CS,*]);LOCK(DSK);DANGER:=FALSE;GO MK; 00028800 LW: READ(DSK,*,IO[0]);FOR MS:=1 STEP 1 UNTIL 200 DO 00028900 BEGIN READ(DSK,10,PROG[MS,*])[EW];SSEQ[MS]:=PROG[MS,11] END; 00029000 EW: LOCK(DSK);MS:=MS-1;OBJECT:=FALSE;GO MK; 00029100 MK: IF A<4 AND CHA NEQ "COPY00" THEN 00029200 WRITE(TTY,F4,IO[B].[41:36],C,D); 00029300 IF A=5 THEN WRITE(TTY,F5); 00029400 IF CHA="COPY00" THEN WRITE(TTY,STP,"COPY "); 00029500 GO L END; 00029600 COMMENT 00029700 --- SYNT DEALS WITH SYNTAX ERRORS ; 00029800 00029900 PROCEDURE SYNT(A);VALUE A;REAL A; 00030000 BEGIN IF SY THEN BEGIN IF IU=0 THEN BEGIN WRITE(TTY,SYER); 00030100 READ(TTY[STOP]) END ELSE WRITE(TTY,SYR);SY:=FALSE END; 00030200 REPLACE APR:=POINTER(IOBE[*]) BY " " FOR 72; 00030300 WRITE(IOBE[*],NUM[0],SSEQ[CS]);SCAN APR:APR WHILE NEQ 48; 00030400 IF IU=0 THEN BEGIN REPLACE APR:APR BY POINTER(PROG[CS,*]) FOR 72; 00030500 APR:=POINTER(IOBE[*])+72; 00030600 REPLACE APR:APR BY "!" FOR 1 END ELSE APR:=APR+3; 00030700 REPLACE POB BY A FOR 8;REPLACE APR BY POB+1 FOR 7; 00030800 OBJ[1]:=0;REPLACE POB+7 BY POINTER(IOBE[*])+79 FOR 1; 00030900 IF IU GTR 0 THEN WRITE(TTY,9,IOBE[*]) ELSE IF OBJ[1]=48 THEN 00031000 WRITE(TTY,10,IOBE[*]) ELSE WRITE(TTY[NO],10,IOBE[*]);GO TO ERR END; 00031100 COMMENT 00031200 --- NWC MODIFIES NCH FOR COMPILE ; 00031300 00031400 INTEGER PROCEDURE NWC; 00031500 BEGIN ON("%") SYNT("MISG OP");NWC:=NCH END; 00031600 00031700 COMMENT 00031800 --- PUT STORES CHARACTER IN OBJ ; 00031900 00032000 PROCEDURE PUT(A);VALUE A;INTEGER A; 00032100 BEGIN IF A>63 THEN SYNT("STR >63"); 00032200 IOBE[1]:=A;REPLACE POB+CO BY PIBE FOR 1;CO:=CO+1; 00032300 IF CO GEQ 8000 THEN GO TO TOOLONG;IF CO MOD 8=0 THEN CO:=CO+1 END; 00032400 COMMENT 00032500 --- RED MOVES BACK ONE SPACE IN OBJ; 00032600 00032700 DEFINE RED=CO:=IF CO.[2:3]=1 THEN CO-2 ELSE CO-1#; 00032800 00032900 COMMENT 00033000 --- LOOK LOOKS AT A STRING IN SOURCE PROG ; 00033100 00033200 INTEGER PROCEDURE LOOK(A);VALUE A;INTEGER A; 00033300 BEGIN INTEGER B,C,D,E;E:=C:=CHA;B:=CP; 00033400 FOR D:=1 STEP 1 UNTIL A-1 DO IF CHA NEQ "%" THEN C:=C|64+NWC; 00033500 LOOK:=C;LP:=CP;CP:=B;CHA:=E END; 00033600 COMMENT 00033700 --- NUMB PICKS UP DIM AND MAT SIZES ; 00033800 00033900 INTEGER PROCEDURE NUMB; 00034000 BEGIN LABEL RP;INTEGER A; 00034100 A:=0; 00034200 RP: IF NWC LSS 10 THEN BEGIN A:=A|10+CHA;GO TO RP END; 00034300 IF A=0 THEN SYNT("IL STMT"); 00034400 NUMB:=A END; 00034500 COMMENT 00034600 --- ARITH(1) CONVERTS EXPNS TO REVERSE POLISH ; 00034700 00034800 PROCEDURE ARITH(TT);VALUE TT;INTEGER TT; 00034900 BEGIN INTEGER I,A,B,C,J,K,OP,STCK;BOOLEAN INMOK,VOK,STROK; 00035000 LABEL S,SS,RPT,EXPON,DONE,FINEV,FORM1,FORM2,FORM3,FIN,RP; 00035100 INTEGER ARRAY OPK[1:20]; 00035200 00035300 COMMENT AN EXPRESSION CONSISTS OF A NUMBER OF PRIMARIES 00035400 SEPARATED BY OPERATORS, POSSIBLY PRECEDED BY INITIAL - . 00035500 PRIMARIES: OPERATORS: 00035600 NUMBER + 00035700 VARIABLE - 00035800 ARRAY WITH SUBSCRIPT(S) * 00035900 FUNCTION WITH PARAMETER(S) / 00036000 STRING ** 00036100 STRING VARIABLE = 00036200 STRING ARRAY WITH SUBSCRIPT 00036300 EXPRESSION IN BRACKETS 00036400 00036500 EXPRESSION HAS TYPE REAL UNLESS STRING PRIMARY 00036600 OCCURS: IF SO IT HAS TYPE STRING. A VARIABLE PRIMARY IS 00036700 A PRIMARY OTHER THAN NUMBER, FUNCTION, OR STRING. 00036800 IN OBJ AN EXPRESSION HAS FORM 00036900 A OPS A OPS ... A OPS 0 00037000 WHERE A IS A CHARACTER BETWEEN 1 AND 16 GIVING THE PRIMARY 00037100 OR OPERATOR TYPE. OPS IS 0-2 CHARACTERS GIVING MORE INFORMATION00037200 DEPENDING ON A. ; 00037300 00037400 STRIN:=FALSE;NDEP:=NDEP+1;IF NDEP=10 THEN SYNT("SIMPLFY"); 00037500 STCK:=OP:=0;INMOK:=VOK:=TRUE;STROK:=TT=0; 00037600 00037700 COMMENT PRIMARIES: ; 00037800 00037900 SS: CHA:=NWC; 00038000 COMMENT BRACKETED EXPRESSION; 00038100 S: ON(29) BEGIN ARITH(1);IF CHA NEQ 45 THEN SYNT("NO ) ,A"); 00038200 RED;GO TO FORM1 END; 00038300 COMMENT 1 NUMBER ; 00038400 IF CHA LSS 10 OR CHA = 26 THEN BEGIN R:=I:=0; 00038500 RPT: ON(26) BEGIN I:=1;CHA:=NWC END; 00038600 IF CHA GEQ 10 THEN GO TO EXPON;IF I>0 THEN BEGIN R:=R+CHA|10*(-I); 00038700 I:=I+1 END ELSE R:=R|10+CHA;CHA:=NWC; GO TO RPT; 00038800 EXPON: IF CHA NEQ 21 THEN GO TO DONE;I:=1;CHA:=NWC;J:=0; 00038900 ON(44) BEGIN I:=-1;CHA:=NWC END ELSE ON(16) CHA:=NWC;J:=CHA; 00039000 IF CHA GEQ 10 THEN SYNT("NO EXPN");CHA:=NWC; 00039100 IF CHA LSS 10 THEN BEGIN J:=J|10+CHA;CHA:=NWC END;R:=R|10*(I|J); 00039200 DONE: PUT(1);NCON:=NCON+1;CONST[NCON]:=R; 00039300 PUT(NCON.[11:6]);PUT(NCON.[5:6]);GO FORM2 END; 00039400 COMMENT 8 INITIAL - ; 00039500 ON(44) BEGIN IF NOT INMOK THEN SYNT ("MISPL -");PUT(8); 00039600 GO TO FORM2 END; 00039700 COMMENT 16 STRING ; 00039800 ON(63) BEGIN IF NOT STROK THEN SYNT("ILL STR");PUT(16); 00039900 SCAN CPR:APR:=POINTER(PROG[CS,2])+CP WHILE NEQ 63;A:=DELTA(APR,CPR); 00040000 STRIN:=TRUE;IF A>14 THEN SYNT("LONGSTR");PUT(A);PUT(CP); 00040100 CP:=CP+A+1;CHA:=NWC;VAR:=FALSE;GO TO FORM3 END; 00040200 IF CHCONV(CHA)=0 THEN SYNT("ILL NUM"); 00040300 B:=CHA;A:=LOOK(2) MOD 64;IF CHCONV(A) NEQ 0 THEN BEGIN 00040400 A:=LOOK(3) MOD 4096;CHA:=B; 00040500 IF A NEQ "ST" AND A NEQ "TH" AND A NEQ"TO" AND A NEQ "GO" THEN 00040600 BEGIN LABEL EQL,FNQ,RDUM; 00040700 COMMENT 5 STANDARD FNS; 00040800 INTEGER B,AS,AP; 00040900 B:=LOOK(3);CP:=LP; 00041000 FOR A:=21 STEP 1 UNTIL 32 DO IF B=KEY[A] THEN GO TO EQL; 00041100 GO TO FNQ; 00041200 EQL: IF NWC NEQ 29 THEN SYNT("NO PARM");ARITH(1);RED; 00041300 PUT(5);PUT(A-2); 00041400 IF CHA NEQ 45 THEN SYNT("NO ) A");GO TO FORM1; 00041500 COMMENT 4 USER FNS ; 00041600 FNQ: K:=B DIV 64; IF K NEQ "FN" THEN SYNT("UNRC FN"); 00041700 B:=CHCONV(B MOD 64);IF SUB[B]=0 THEN SYNT("UNDC FN"); 00041800 IF NWC NEQ 29 THEN SYNT("NO PARM");A:=0; 00041900 RDUM: A:=A+1;ARITH(1);RED;ON(58) GO TO RDUM; 00042000 IF CHA NEQ 45 OR A NEQ SUB[B] THEN SYNT("PARAMTR"); 00042100 CHA:=NWC;PUT(4);PUT(B);GO TO FORM2 END END; 00042200 B:=CHCONV(B);IF B=0 THEN SYNT("INV VAR");CHA:=NWC; 00042300 COMMENT 3 ARRAY ; 00042400 ON(29) BEGIN IF ARR[B,1]=0 THEN SYNT("UNDC AR"); 00042500 ARITH(1);RED;ON(58) BEGIN IF ARR[B,2]=0 THEN SYNT("SUBSCPT"); 00042600 ARITH(1);RED END;IF CHA NEQ 45 THEN SYNT("SUBSCPT");STROK:=FALSE; 00042700 PUT(3);PUT(B);CHA:=NWC END 00042800 ELSE ON("$") BEGIN IF NOT STROK THEN SYNT("ILL STR"); 00042900 COMMENT 15 STRING ARRAY; 00043000 CHA:=NWC;ON(29)BEGIN IF STRAR[B,1]=0 THEN SYNT("UNDSTAR");ARITH(1); 00043100 RED; 00043200 IF CHA NEQ 45 THEN SYNT("NO ) ,5");PUT(15);CHA:=NWC END ELSE 00043300 PUT(14);PUT(B);STRIN:=TRUE;VAR:=VOK;GO TO FORM3 END 00043400 ELSE BEGIN PUT(2);PUT(B);IF CHA LSS 10 THEN BEGIN PUT(C:=CHA+1); 00043500 COMMENT 14 STRING VBLE 00043600 2 VARIABLE ; 00043700 CHA:=NCH END ELSE PUT(C:=0);IF STCK=0 THEN ADDR:=11|(B-1)+C; 00043800 STROK:=FALSE END;VAR:=VOK;GO TO FORM3; 00043900 FORM1: CHA:=NWC; 00044000 FORM2: STROK:=VAR:=FALSE;IF STRIN THEN SYNT("ILL STR"); 00044100 COMMENT 7-13 OPERATORS: 00044200 DANGER: REVERSE POLISH SECTION ; 00044300 FORM3: BEGIN LABEL RPT,TEST,BOP,XOP; 00044400 STCK:=STCK+1;INMOK:=FALSE; 00044500 RPT: I:=0;ON(16) I:=3 ELSE ON(44) I:=4 ELSE 00044600 ON(43) BEGIN IF NWC=43 THEN I:=7 ELSE BEGIN CP:=CP-1;I:=5 END; 00044700 END ELSE ON(49) I:=6 ELSE IF CHA=61 AND EQOK THEN BEGIN INMOK:=TRUE; 00044800 IF NOT VAR THEN SYNT("ILL ASN");I:=1 END;VOK:=I LEQ 1; 00044900 IF NOT VOK THEN BEGIN STROK:=FALSE;IF STRIN THEN SYNT("ILL STR") END; 00045000 TEST: IF OP=0 THEN GO TO BOP; IF OP LSS 0 00045100 THEN SYNT(" ARITH"); 00045200 J:=OPK[OP];IF I|J NEQ 1 AND (I+1) DIV 2 LEQ (J+1) DIV 2 THEN BEGIN 00045300 OP:=OP-1;GO TO XOP END; 00045400 BOP: IF I=0 THEN GO TO FIN;OP:=OP+1;OPK[OP]:=1;GO TO SS; 00045500 XOP: VAR:=FALSE;STCK:=STCK-1; 00045600 PUT(J+6);IF STCK LEQ 0 THEN SYNT(" ARITH"); 00045700 GO TO TEST END; 00045800 COMMENT 6 END EXPN ; 00045900 FIN: NDEP:=NDEP-1;IF STCK NEQ 1 THEN SYNT(" ARITH"); 00046000 PUT(0) END; 00046100 COMMENT 00046200 --- SKIP SKIPS GIVEN STRING IF FOUND ; 00046300 00046400 PROCEDURE SKIP(A,B);VALUE A,B;INTEGER A,B; 00046500 BEGIN INTEGER C,D,E;E:=CP;C:=NWC; 00046600 FOR D:=1 STEP 1 UNTIL A-1 DO IF CHA NEQ "%" THEN C:=C|64+NWC; 00046700 IF C NEQ B THEN BEGIN CP:=E;CHA:=0 END END; 00046800 COMMENT 00046900 --- CHMAT CHECK USED IN MAT STATEMENT ; 00047000 00047100 INTEGER PROCEDURE CHMAT(A);VALUE A;INTEGER A; 00047200 BEGIN A:=CHCONV(A);IF A=0 THEN SYNT("ILL ARR"); 00047300 IF ARR[A,1]=0 THEN SYNT("UNDC AR");IF ARR[A,2]=0 THEN 00047400 SYNT(" TYPE");CHMAT:=A END; 00047500 00047600 00047700 COMMENT ---- CFN FOR FILE INPUT ANO OUTPUT; 00047800 00047900 PROCEDURE CFN; 00048000 BEGIN LABEL L,M; 00048100 CHA:=NWC;IF LOOK(4)="FILE" THEN BEGIN CP:=LP;D:=IF A=15 THEN 5 ELSE A; 00048200 FOR C:=1 STEP 1 UNTIL NF DO BEGIN CHA:=NWC;B:=LOOK(FNM[2,C]); 00048300 IF B=FNM[1,C] THEN BEGIN IF FNM[3,C]=0 THEN FNM[3,C]:=D ELSE IF D NEQ 00048400 FNM[3,C] THEN SYNT("IN+OUT?");CP:=LP;PUT(A);IF D=5 THEN 00048500 INFILTOG:=TRUE;IF A=7 THEN OUTFILTOG:=TRUE; 00048600 IF NWC=":" THEN BEGIN A:=NUMB;FOR B:=ACS STEP 1 UNTIL MS DO 00048700 IF A=SSEQ[B] THEN BEGIN PUT(B.[11:6]);PUT(B.[5:6]);GO ON(58) L ELSE M 00048800 END;SYNT("UNDF GO") END;PUT(0);PUT(0);ON(58) GO L; 00048900 GO TO M END ELSE BEGIN CP:=CP-1;CHA:=0 END END;SYNT("UNDC FL") END; 00049000 PUT(0);ON("%") GO TO M;CP:=CP-1;CHA:=0;GO TO L; 00049100 M: IF A=5 THEN SYNT("NOINPUT");PUT(0);GO TO INCST; 00049200 L: END; 00049300 00049400 COMMENT------------------------------------------------------- 00049500 ----------- XBASIC STARTS HERE ----------------- 00049600 -------------------------------------------------------------; 00049700 00049800 FIRSTOFF:=IU NEQ 2;IF IU=2 THEN TTY.TYPE:=1; 00049900 PIBE:=POINTER(IOBE[1])+7; PINB:=POINTER(IOB[1]); 00050000 DELIM:=72;TIM:=10800;LL:=-1; 00050100 OBJECT:=HDDR:=FALSE;OU:=0; 00050200 00050300 FILL KEY[*] WITH "LET","GOT","GOS","RET","INP", 00050400 "REA","PRI","FOR","NFX","MAT","DEF","DAT", 00050500 "RAN","PAG","RES","REM","STO","END","IF ","ON ","SIN","COS", 00050600 "TAN","ATN","EXP","LOG","ABS","INT","SQR","FIX","SGN","RND", 00050700 "EQ","LT","LE","GT","GE","NE"; 00050800 00050900 COMMENT------------------------------------------------------ 00051000 ------------SOURCEIN: FOR INPUT OF SOURCE PROGRAM ------- 00051100 ------------ AND EXECUTION OF COMMANDS ------- 00051200 -----------------------------------------------------------------; 00051300 00051400 COMMENT: COMMANDS ALLOWED IN XBASIC 00051500 00051600 HELLO SAME AS BYE 00051700 BYE TERMINATES XBASIC. PRINTER OUTPUT IS SCHEDULED 00051800 RUN EXECUTES PROGRAM IF FREE OF SYNTAX ERRORS 00051900 SCR DELETES WORKFILE 00052000 DELETE SAME AS SCR 00052100 LIST LISTS ENTIRE WORKFILE 00052200 LIST E WHERE E IS A NUMBER OF ELEMENTS OF FORM 00052300 N OR M-N (M,N STATEMENT NUMBERS) 00052400 SEPARATED BY COMMAS. LISTS PART OF PROGRAM 00052500 MAKE NNNNNN INITIALISES AND NAMES WORKFILE 00052600 SAVE SAVES WORKFILE IF NAMED 00052700 SAVE NNNNNN SAVES WORKFILE IN NNNNNN. NAMES WORKFILE 00052800 IF NOT ALREADY NAMED 00052900 LOAD NNNNNN LOADS WORKFILE AND NAMES IT 00053000 LOAD NNNNNN/UUUUUUU COPIES WORKFILE FROM NNNNNN/UUUUUUU 00053100 WORKFILE BECOMES UNNAMED 00053200 COPY NNNNNN COPIES NNNNNN INTO WORKFILE 00053300 COPY NNNNNN/UUUUUUU SAME FOR NNNNNN/UUUUUUU 00053400 REMOVE NNNNNN REMOVES FILE NNNNNN/USER NO. 00053500 RENAME NNNNNN RENAMES WORKFILE 00053600 PLOP RESETS WORKFILE TO LAST RUN STATUS 00053700 WHATS OBTAINS WORKFILE STATUS 00053800 TTY INPUT UNIT IS TTY 00053900 VDU INPUT UNIT IS VDU 00054000 SEND DIVERTS OUTPUT TO PRINTER 00054100 NOSEND TERMINATES DIVERSION OF OUTPUT 00054200 TIME N RESETS MAX EXECUTION TIME TO N MINUTES 00054300 -------------------------------------------------------------; 00054400 00054500 SOURCEIN: BEGIN LABEL SOURCEIN,EF,COPY,NEWL,SOURCE,RMOB, 00054600 FST; 00054700 00054800 INTOVR:=INER; 00054900 IF FIRSTOFF THEN BEGIN FILECONTROL(5,"XBWKFL ",TIME(-1),FST); 00055000 FST: IF IU=0 THEN WRITE(TTY,INVIT);FIRSTOFF:=FALSE END; 00055100 IF LL=-1 THEN GO TO SOURCE; 00055200 SOURCEIN: IF IU GTR 0 THEN GO TO SOURCE;PINB:=PINB+80; 00055300 LL:=LL+1;IF LL LSS 24 THEN GO TO NEWL; 00055400 SOURCE: LL:=0;IF IU GTR 0 THEN READ(FN[IU-1][STOP],10,IOB[*]) 00055500 ELSE READ(VDU[STOP],240,IOB[*]); 00055600 IF IU=2 THEN WRITE(TTY,10,IOB[*]); 00055700 PINB:=POINTER(IOB[*]);IOBE[1]:=0; 00055800 NEWL: C:=IF MS>0 THEN SSEQ[MS] ELSE 0;APR:=PINB;BPR:=PIBE; 00055900 A:=NMBR(6);IF A=0 THEN BEGIN IF CHA="%" THEN GO TO SOURCEIN; 00056000 COMMENT NONVOID INPUT WITH ZERO STATEMENT NO. MUST BE COMMAND; 00056100 IOBE[1]:=0;REPLACE BPR-5 BY APR:CPR:=APR-1 FOR 1; 00056200 REPLACE BPR-4 BY APR:APR FOR 5 WHILE IN ALPHA;CHA:=IOBE[1]; 00056300 ON("RUN000") BEGIN IF OBJECT THEN BEGIN IF NMBR(72) NEQ 0 OR 00056400 CHA NEQ "%" THEN GO PER;GO EXECUTE END 00056500 ELSE IF IU=2 THEN GO COMPILE 00056600 ELSE BEGIN WRITE(TTY,WT); 00056700 FILECONTROL(4,"XBWKFL ",TIME(-1),COMPILE) END END; 00056800 ON("DELETE" OR CHA="SCR000") BEGIN C:=NMBR(72); 00056900 IF C NEQ 0 OR CHA NEQ "%" THEN GO PER;WRITE(TTY,F7); 00057000 CS:=MS:=IO[0]:=0;DANGER:=OBJECT:=FALSE;GO SOURCEIN END; 00057100 ON("LIST00") BEGIN 00057200 00057300 COMMENT PROCESS LIST COMMAND; 00057400 00057500 LABEL NEX,LEX; 00057600 IF OU=1 THEN WRITE(TTY,DVO); 00057700 WRITE(FL[OU],SPC); 00057800 NEX: BEG:=NMBR(72);IF CHCONV(CHA) NEQ 0 THEN GO PER; 00057900 EN:=ON("%" AND BEG=0) 1000000 ELSE ON(44) NMBR(72) ELSE BEG; 00058000 IF CHCONV(CHA) NEQ 0 THEN GO PER; 00058100 FOR A:=1 STEP 1 UNTIL MS DO IF SSEQ[A] LEQ EN 00058200 AND SSEQ[A] GEQ BEG THEN BEGIN 00058300 REPLACE POINTER(IOBE[1]) BY " " FOR 112; 00058400 WRITE(IOBE[*],NUM[2|OU],SSEQ[A]); 00058500 SCAN CPR:POINTER(IOBE[1])+20|OU FOR 20 WHILE NEQ 48; 00058600 REPLACE CPR BY POINTER(PROG[A,2]) FOR 72;WRITE(FL[OU],14,IOBE[*]) 00058700 END;ON(58) GO TO NEX;WRITE(TTY,STP,"LIST ");GO TO SOURCEIN END; 00058800 ON("RENAME") FILECONTROL(0," NAMED"," ",SOURCEIN); 00058900 ON("MAKE00") FILECONTROL(0,"CREATE","D",SOURCEIN); 00059000 ON("SAVE00") FILECONTROL(1," SAVED"," ",SOURCEIN); 00059100 00059200 ON("LOAD00") FILECONTROL(2," LOADE","D",SOURCEIN); 00059300 ON("REMOVE") FILECONTROL(3,"REMOVE","D",SOURCEIN); 00059400 ON("COPY00") FILECONTROL(2," COPIE",0,SOURCEIN); 00059500 ON("BYE000" OR CHA="HELL00") BEGIN IF IU=2 THEN GO FINSH; 00059600 FILECONTROL(6,"XBWKFL ",TIME(-1),FINSH) END; 00059700 ON("SEND00") BEGIN OU:=1;IF NOT HDDR THEN BEGIN 00059800 WRITE(LIN,HD3,TIME(6),TIME(5).[23:12],TIME(5).[35:12],TIME(5).[11:12], 00059900 TIME(-1).[41:18],TIME(-1).[23:24]); 00060000 HDDR:=TRUE END;WRITE(TTY,HD1);GO SOURCEIN END; 00060100 ON("NOSEND") BEGIN OU:=0;WRITE(TTY,STP,"NOSEND");GO TO SOURCEIN END; 00060200 ON("TTY000") BEGIN IU:=1;WRITE(TTY,STP,"SETTTY");GO TO SOURCE END; 00060300 ON("VDU000") BEGIN IU:=0;WRITE(TTY,STP,"SETVDU");GO TO SOURCEIN END; 00060400 ON("TIME00") BEGIN TIM:=3600|NMBR(10);WRITE(TTY,STP,"SETTIM"); 00060500 GO TO SOURCEIN END; 00060600 ON("PLOP00") FILECONTROL(5,0,0,SOURCEIN); 00060700 ON("WHATSO") BEGIN WRITE(TTY,F9);IF IO[0]=0 THEN 00060800 WRITE(TTY,F10,MS,SSEQ[MS]) ELSE 00060900 WRITE(TTY,F11,IO[0].[41:36],MS,SSEQ[MS]); 00061000 GO SOURCEIN END; 00061100 % ILLEGAL COMMAND 00061200 WRITE(TTY,WHT," "&CHA[35:35:6|DELTA(CPR,APR)]);GO SOURCEIN END; 00061300 00061400 COMMENT PROCESS SOURCE STATEMENT; 00061500 00061600 OBJECT:=FALSE;DANGER:=TRUE; 00061700 00061800 COMMENT DELETE STATEMENT; 00061900 00062000 ON("%") BEGIN CHA:=A;FOR A:=1 STEP 1 UNTIL MS DO 00062100 ON(SSEQ[A]) BEGIN MS:=MS-1;FOR B:=A STEP 1 UNTIL MS DO 00062200 BEGIN SSEQ[B]:=SSEQ[B+1];WRITE(PROG[B,*],10,PROG[B+1,*]) END END; 00062300 GO TO SOURCEIN END; 00062400 CHA:=A;APR:=APR-1; 00062500 00062600 COMMENT ADD NEW LAST STATEMENT; 00062700 00062800 IF CHA GTR C THEN BEGIN CS:=MS;MS:=A:=MS+1; 00062900 IF MS GTR 200 THEN GO TOOLONG; 00063000 GO TO COPY END; 00063100 00063200 COMMENT REPLACE EARLIER STATEMENT; 00063300 FOR A:=1 STEP 1 UNTIL MS DO ON(SSEQ[A]) GO TO COPY 00063400 ELSE IF CHA LSS SSEQ[A] THEN BEGIN MS:=MS+1; 00063500 00063600 COMMENT INSERT STATEMENT; 00063700 00063800 IF MS GTR 200 THEN GO TO TOOLONG; 00063900 FOR B:=MS STEP -1 UNTIL A+1 DO 00064000 BEGIN SSEQ[B]:=SSEQ[B-1];WRITE(PROG[B,*],10,PROG[B-1,*]) END; 00064100 GO TO COPY END; 00064200 COPY: PROG[A,11]:=SSEQ[A]:=CHA; 00064300 REPLACE BPR:CPR:=POINTER(PROG[A,2]) BY " " FOR 1; 00064400 B:=DELTA(APR,PINB+80);IF B>71 THEN B:=71; 00064500 REPLACE BPR:BPR BY APR FOR B WHILE NEQ "!"; 00064600 REPLACE BPR BY " " FOR 72-DELTA(CPR,BPR);GO SOURCEIN END SOURCEIN; 00064700 INER: WRITE(TTY,INTR);GO TO SOURCEIN; 00064800 TOOLONG: WRITE(TTY,LNGPRG,SSEQ[CS]);GO TO SOURCEIN; 00064900 PER: WRITE(TTY,F12);GO SOURCEIN; 00065000 COMMENT---------------------------------------------------------- 00065100 -------------------- END SOURCEIN --------------------------- 00065200 ------------------------------------------------------------------ 00065300 ----------- COMPILE: SEARCH FOR SYNTAX ERRORS --------- 00065400 ----------- AND MAKE PSEUDO-OBJECT CODE --------- 00065500 --------------------------------------------------------------------; 00065600 COMMENT 00065700 SYNTAX ERROR MESSAGES: OUTPUT AFTER "RUN" 00065800 WITH NEW FAULTY PROGRAM 00065900 00066000 ARITH MISSING OPERATOR OR OPERAND IN ARITHMETIC 00066100 EXPRESSION (SHOULD NOT OCCUR) 00066200 FILES PROGRAM CAN HAVE ONLY ONE INPUT AND ONE OUTPUT 00066300 FILE 00066400 IL GOSB THIS STATEMENT HAS BEEN ILLEGALLY REFERENCED 00066500 BY A GOSUB STATEMENT (IT IS IN A FOR LOOP) 00066600 IL RELN AN ILLEGAL RELATION OF FORM X?? HAS BEEN 00066700 FOUND IN AN IF STATEMENT 00066800 ILL ARR ARRAY NAME EXPECTED BUT CHARACTER IS NOT 00066900 A LETTER 00067000 ILL ASN AN ASSIGNMENT IS ATTEMPTED BUT LEFT HAND SIDE 00067100 IS NOT A VARIABLE 00067200 ILL FN THE NAME OF A DEFINED FUNCTION MUST BE OF FORM 00067300 FN LETTER. PARAMETER(S) MUST BE SUPPLIED. 00067400 ILL FOR A FOR STATENENT IS ALREADY IN OPERATION 00067500 FOR THIS VARIABLE 00067600 ILL NEX NEXT MUST REFER TO AN UNSUBSCRIPTED REAL VBLE 00067700 ILL NUM A PRIMARY IS MISSING OR ILLEGAL 00067800 ILL STR A STRING PRIMARY HAS BEEN ENCOUNTERED IN 00067900 A REAL EXPRESSION 00068000 IL STMT ILLEGAL STATEMENT 00068100 INV IF STRINGS CAN ONLY BE COMPARED FOR EQUALITY 00068200 OR INEQUALITY 00068300 INV PAR A FORMAL PARAMETER IN A DEF STATEMENT 00068400 MUST BE A VARIABLE 00068500 INV VAR A PRIMARY IS MISSING OR ILLEGAL. IN A READ 00068600 STATEMENT EVERY EXPRESSION MUST CONSIST OF 00068700 A SINGLE VARIABLE PRIMARY. 00068800 IN+OUT? A FILE IS BEING USED FOR INPUT AND OUTPUT 00068900 LONGSTR A STRING CONTAINS MORE THAN 14 CHARACTERS 00069000 IN A STATEMENT OTHER THAN PRINT. 00069100 MISG OP AN OPERAND ESSENTIAL TO THIS STATEMENT HAS 00069200 BEEN OMITTED (END OF STATEMENT ERROR). 00069300 MISP = MISPLACED OR MISSING = IN DEF STATEMENT 00069400 MISPL - A - SIGN HAS BEEN PLACED ILLEGALLY IN AN 00069500 EXPRESSION (E.G. A*-B). 00069600 NAME PROBABLY CAUSED BY ILLEGAL FILENAME 00069700 NESTING INCORRECTLY NESTED FOR AND NEXT STATEMENTS 00069800 NO ) X MISSING PARENTHESES: X=A IN ARITH EXPRESSION 00069900 NO ( X P IN FUNCTION PARAMETER 00070000 S IN SUBSCRIPT 00070100 F IN FILE DECLARATION 00070200 NO EXPN E HAS BEEN FOUND IN A NUMBER BUT NO EXPONENT 00070300 FOLLOWS 00070400 NO FOR A NEXT STATEMENT HAS NO CORRESPONDING FOR 00070500 NOINPUT INPUT STATEMENT MUST HAVE LIST OF VARIABLES 00070600 NO NEXT A FOR STATEMENT EARLIER IN PROGRAM HAS NO NEXT 00070700 NO PARM EVERY FUNCTION MUST HAVE PARAMETER(S) IN 00070800 BRACKETS 00070900 NO PROG THERE IS NO PROGRAM TO RUN 00071000 NO RELN NO RELATION HAS BEEN FOUND IN AN IF STATEMENT 00071100 NO SEPR CONSECUTIVE ARITH EXPRESSIONS IN PRINT 00071200 STATEMENT MUST BE SEPARATED BY , OR SEMICOLON 00071300 NO TO A FOR STATEMENT MUST HAVE A FINAL VALUE 00071400 (FOR X=1 TO 10 ETC.) 00071500 NOT END THE LAST STATEMENT MUST BE AN END STATEMENT 00071600 NOTLAST THE END STATEMENT MUST BE THE LAST STATEMENT 00071700 OVERFLW A NUMBER IS TOO LARGE 00071800 QUOTES MISMATCHED STRING QUOTES 00071900 REDC AR ARRAY TWICE DIMENSIONED 00072000 REDC FN A FUNCTION HAS BEEN DEFINED MORE THAN ONCE 00072100 SAMEFIL A FILE HAS BEEN DECLARED MORE THAN ONCE 00072200 PARAMTR WRONG NUMBER OF PARAMETERS IN A FUNCTION CALL 00072300 SIMPLFY AN EXPRESSION IS NESTED TO A DEPTH OF 10 OR 00072400 MORE AND SHOULD RE BROKEN UP 00072500 SIZE AN ARRAY DIMENSION IS GREATER THAN 64 OR 00072600 (IN MAT STATEMENT) IS GREATER THAN THE DECLARED 00072700 DIMENSION OF THE ARRAY 00072800 STORAGE ARRAY STORAGE HAS BEEN EXCEEDED (700 WORDS OF 00072900 TYPE REAL, 70 OF TYPE ALPHA) 00073000 STR >63 ILLEGAL OBJECT CHARACTER (E.G. PRINT STRING 00073100 HAS >63 CHARS OR STARTS LATER THAN COL 63) 00073200 STR=STR A STRING CAN ONLY BE COMPARED WITH ANOTHER 00073300 SUBSCPT AN ARRAY REFERENCE HAS THE WRONG NUMBER OF 00073400 SUBSCRIPTS 00073500 TOO MCH PROCESSING OF THE SOURCE STATEMENT HAS NOT 00073600 USED UP ALL THE INFORMATION IN IT. (CAN BE 00073700 CAUSED BY OMISSION OF AN OPERATOR IN AN 00073800 EXPRESSION) 00073900 TYPE AN ATTEMPT HAS BEEN MADE TO USE A MAT STATEMENT 00074000 FOR A 1-DIMENSIONAL ARRAY 00074100 UNDC AR AN ARRAY HAS BEEN REFERENCED BUT NOT DECLARED 00074200 UNDC FL A FILE HAS BEEN REFERENCED BUT NOT DECLARED 00074300 UNDC FN A FUNCTION OF TYPE FN* HAS BEEN REFERENCED BUT 00074400 NOT DECLARED 00074500 UNDF GO THERE IS NO STATEMENT IN THE PROGRAM WITH THE 00074600 SEQUENCE NUMBER REFERENCED BY THIS STATEMENT 00074700 UNDSTAR A STRING ARRAY HAS BEEN REFERENCED BUT NOT 00074800 DECLARED 00074900 UNRC FN A FUNCTION NAME OR KEYWORD HAS BEEN MISSPELLED 00075000 OR MISPLACED 00075100 3 FILES NOT MORE THAN TWO FILES MAY BE DECLARED 00075200 11 FORS FOR STATEMENTS NESTED TOO DEEP 00075300 :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::; 00075400 00075500 COMPILE: 00075600 00075700 COMMENT IN THE FOLLOWING COMMENTS, 00075800 IS ANY EXPRESSION (POSSIBLY WITH =) 00075900 IS ANY LETTER 00076000 IS ANY VARIABLE PRIMARY 00076100 IS ANY UNSIGNED INTEGER 00076200 IS A STATEMENT NUMBER 00076300 IS A FILENAME 00076350 00076400 ALLOWED VARIANTS ARE LISTED BELOW. THREE LETTER 00076500 ABBREVIATIONS OF INITIAL KEYWORDS ARE ALLOWED WHERE UNAMBIGUOUS.00076600 SPACES ARE IGNORED EXCEPT INSIDE STRING QUOTES; 00076700 00076800 INTOVR:=INTVR;INDEX:=QUOTE;FLAG:=FLAGR; 00076900 MSTO:=287;MSTR:=27;INFILTOG:=OUTFILTOG:=FALSE; 00077000 FOR A:=1 STEP 1 UNTIL 26 DO STRAR[A,1]:=ARR[A,1]:=ARR[A,2]:=SUB[A]:=0; 00077100 IO[1]:=IO[2]:=FNM[2,1]:=FNM[2,2]:=FNM[3,1]:=FNM[3,2]:=AREASIZE:=0; 00077200 NDEP:=CO:=1;POB:=POINTER(OBJ[*]); 00077300 CS:=0;SY:=EQOK:=TRUE; 00077400 IF MS =0 THEN SYNT("NO PROG"); 00077500 FORE:=FORC:=NCON:=0;FOR A:=1 STEP 1 UNTIL 200 DO STYP[A]:=0; 00077600 00077700 COMMENT FILES 00077800 FILES ,.. 00077900 WHERE IS (EXISTING FILE) 00078000 OR () (FILE TO BE CREATED: N=MAX NO OF RECS) 00078100 WHERE IS A CANDE FILENAME 00078200 THERE CAN ONLY BE ONE FILES STATEMENT. IT MUST BE THE FIRST STATEMENT. 00078300 THERE CAN BE AT MOST ONE INPUT FILE AND ONE OUTPUT FILE; 00078400 00078500 FIL: ACS:=CS:=CS+1;CP:=CHA:=0;CHA:=NWC;B:=LOOK(3); 00078600 IF B="REM" THEN GO FIL;IF B="FIL" THEN BEGIN CP:=LP;SKIP(2,"ES");A:=0; 00078700 RFIL: A:=A+1;IF A>3 THEN SYNT("3 FILES"); 00078800 CHA:=NWC;IO[A]:=" ";BPR:=POINTER(PROG[CS,2])+CP-1; 00078900 SCAN APR:BPR FOR 6 WHILE IN ALPHA;FNM[2,A]:=B:=DELTA(BPR,APR); 00079000 REPLACE POINTER(IO[A])+1 BY BPR FOR B;FNM[1,A]:=LOOK(B);CP:=LP; 00079100 NF:=A;CHA:=NWC;ON("(") BEGIN AREASIZE:=NUMB/20+1;FNM[3,A]:=7; 00079200 IF CHA NEQ ")" THEN SYNT("NO ) ,F");CHA:=NWC END;ON(",") GO TO RFIL; 00079300 IF A=2 AND IO[1]=IO[2] THEN SYNT("SAMEFIL");IF CHA NEQ "%" THEN 00079400 SYNT("TOO MCH") END ELSE CS:=0; 00079500 IF ACS>MS THEN SYNT("NO PROG"); 00079600 COMMENT DIM 00079700 DIM (),... 00079800 DIMENSION (),... 00079900 WHERE IS OR $ 00080000 IS OR , 00080100 DIM STATEMENTS MUST PRECEDE ALL EXECUTABLE STATEMENTS 00080200 STRING ARRAY MUST BE ONE-DIMENSIONAL. 00080300 ALL DIMENSIONS MUST BE <64. 00080400 713 WORDS REAL AND 73 STRINGS ARE AVAILABLE FOR ARRAYS ; 00080500 00080600 DIM: ACS:=CS:=CS+1;CP:=CHA:=0;CHA:=NWC; 00080700 B:=LOOK(3);IF B="REM" THEN GO DIM; 00080800 IF B="DIM" THEN BEGIN CP:=LP;SKIP(6,"ENSION"); 00080900 RDIM: K:=CHCONV(NWC);IF K=0 THEN SYNT("ILL ARR"); 00081000 IF NWC="$" THEN BEGIN STRAR[K,0]:=MSTR;IF NWC NEQ "(" THEN 00081100 SYNT("NO ( ,S");A:=STRAR[K,1]:=NUMB;MSTR:=MSTR+A; 00081200 IF CHA NEQ ")" THEN SYNT("NO ) ,S");IF NWC="," THEN GO TO RDIM; 00081300 GO TO DIM END; ARR[K,0]:=MSTO;IF CHA NEQ "(" THEN SYNT("NO ( ,S"); 00081400 IF ARR[K,1] NEQ 0 THEN SYNT("REDC AR"); 00081500 B:=ARR[K,1]:=NUMB;IF B>64 THEN SYNT(" SIZE "); 00081600 ON(",") BEGIN A:=ARR[K,2]:=NUMB;B:=B|A END; 00081700 MSTO:=MSTO+B;IF MSTO GTR 1000 THEN SYNT("STORAGE"); 00081800 IF CHA NEQ ")" THEN SYNT("NO ) ,S");IF NWC="," THEN GO TO RDIM; 00081900 GO TO DIM END;IF ACS>MS THEN SYNT("NO PROG"); 00082000 00082100 COMMENT PROGRAM COMPILATION BEGINS HERE ; 00082200 00082300 FOR CS:=ACS STEP 1 UNTIL MS DO BEGIN 00082400 COMMENT IF GOSUB ENTRY THEN FIX FOR LEVEL ; 00082500 EXS: IF STYP[CS] NEQ 0 THEN BEGIN IF FORC NEQ FORE THEN 00082600 SYNT("IL GOSB");FORE:=FORC:=STYP[CS] END; 00082700 COMMENT IDENTITY STATEMENT TYPE ; 00082800 NDEP:=CP:=CHA:=0;CHA:=NWC;B:=LOOK(3);EQOK:=TRUE; 00082900 FOR A:=1 STEP 1 UNTIL 18 DO IF B=KEY[A] THEN GO TO EQL; 00083000 IF B="DIM" OR B="FIL" THEN BEGIN WRITE(TTY,F6,SSEQ[CS]); 00083100 GO SOURCEIN END; 00083200 %IF B="TRA" THEN BEGIN STYP[CS]:=20;GO REM END; 00083300 %IF B="UNT" THEN BEGIN STYP[CS]:=21;GO REM END; 00083400 B:=B DIV 64; 00083500 IF B="IF" THEN BEGIN LP:=LP-1;A:=19;GO TO EQL END; 00083600 IF B="ON" THEN BEGIN LP:=LP-1;A:=20;GO TO EQL END; 00083700 LP:=0;A:=1; 00083800 EQL: CP:=LP;STYP[CS]:=A;SPOB[CS]:=CO; 00083900 IF CS=MS AND A NEQ 18 THEN SYNT("NOT END");GO TO OPN[A]; 00084000 COMMENT 1 LET 00084100 LET 00084200 00084300 WHERE E MAY BE A STRING ASSIGNMENT ; 00084400 00084500 LET: ARITH(0);GO TO INCST; 00084600 CAR: ARITH(1); GO TO INCST; 00084700 COMMENT 20 ON 00084800 ON GO TO ,... ; 00084900 00085000 ONX: ARITH(1);SKIP(3,"OTO"); 00085100 RON: A:=NUMB;FOR B:=ACS STEP 1 UNTIL MS DO IF A=SSEQ[B] 00085200 THEN BEGIN PUT(B.[11:6]);PUT(B.[5:6]); 00085300 IF STYP[CS]=3 AND STYP[B] IF THEN 00085900 IF GO TO 00086000 IS AN EXPRESSION WITHOUT = 00086100 IS ONE OF THE FOLLOWING 00086200 |EQ |GT |LT |GE |LE |NE 00086300 = > < >= <= <> 00086400 STRINGS CAN BE COMPARED ONLY FOR EQUALITY OR INEQUALITY; 00086500 00086600 IFF: EQOK:=FALSE;ARITH(0);EQOK:=TRUE; 00086700 C:=IF STRIN THEN 0 ELSE 1; 00086800 B:=0;IF CHA=30 THEN BEGIN B:=B+2;CHA:=NWC END; 00086900 IF CHA=14 THEN BEGIN B:=B+4;CHA:=NWC END;IF CHA=61 THEN B:=B+1 00087000 ELSE CP:=CP-1;IF B=0 THEN CHA:=NWC ELSE GO TO FEQ; 00087100 IF CHA NEQ "|" THEN SYNT("NO RELN");CHA:=NWC; 00087200 A:=CHA|64+NWC;FOR B:=1 STEP 1 UNTIL 6 DO IF A=KEY[B+32] 00087300 THEN GO TO FEQ;SYNT("IL RELN"); 00087400 FEQ: PUT(B);ARITH(C);IF C=0 AND NOT STRIN THEN SYNT("STR=STR"); 00087500 IF STRIN AND B NEQ 1 AND B NEQ 6 THEN SYNT("INV IF "); 00087600 SKIP(3,"OTO");SKIP(3,"HEN");GO TO RON; 00087700 COMMENT 2 GO TO 00087800 GO TO ; 00087900 00088000 GOT: SKIP(1,"0");GO TO RON; 00088100 COMMENT 3 GOSUB 00088200 GOSUB ; 00088300 00088400 GOS: SKIP(2,"UB");GO TO RON; 00088500 COMMENT 4 RETURN 00088600 RETURN ; 00088700 00088800 RET: SKIP(3,"URN");CHA:=NWC;GO TO INCST; 00088900 COMMENT 8 FOR 00089000 FOR TO STEP 00089100 FOR TO ; 00089200 00089300 COMMENT DURING COMPILE, FOR INFO IS STORED IN FORX AS FOLLOWS: 00089400 2 3 4 00089500 OBJPOINTER TO STORE NEXTLINE FORLINE ADDR 00089600 00089700 EACH FOR IS ASSIGNED A LEVEL (=FORC), WHICH 1S USED TO CHECK 00089800 NESTING AND DURING EXECUTION. IN SUBROUTINES FORC IS INITIALISED 00089900 TO MAX FORC OF CALLING (GOSUB) STATEMENT: THIS LEVEL 1S STORED 00090000 TEMPORARILY IN STYP. OBJECT FORM OF FOR STATEMENT IS AS FOLLOWS: 00090100 LEVEL ASSIGN FINAL INCREMENT NEXTLINE ; 00090200 00090300 FOX: FORC:=FORC+1;PUT(FORC);IF FORC>10 THEN SYNT("11 FORS"); 00090400 ARITH(1);FORX[FORC,4]:=ADDR+1;IF CHA NEQ "T" THEN SYNT(" NO TO"); 00090500 SKIP(1,"0");FOR A:=1 STEP 1 UNTIL FORC-1 DO IF FORX[A,4]=ADDR THEN 00090600 SYNT("ILL FOR");ARITH(1);IF CHA="S" THEN BEGIN SKIP(3,"TEP");ARITH(1) 00090700 END ELSE PUT(0);FORX[FORC,2]:=CO;PUT(0);PUT(0);FORX[FORC,3]:=CS; 00090800 GO INCST; 00090900 COMMENT 9 NEXT 00091000 NEXT 00091100 WHERE IS A VARIABLE NAME ; 00091200 00091300 NEX: SKIP(1,"T");B:=CHCONV(NWC)-1;IF B=-1 THEN SYNT("ILL NEX"); 00091400 IF NWC LSS 10 THEN BEGIN B:=11|B+CHA+1;CHA:=NWC END ELSE B:=11|B; 00091500 IF FORC=FORE THEN SYNT("NO FOR "); 00091600 IF B+1 NEQ FORX[FORC,4] THEN SYNT("NESTING"); 00091700 A:=CO;CO:=FORX[FORC,2];PUT(CS.[11:6]);PUT(CS.[5:6]); 00091800 CO:=A;SPOB[CS]:=FORC+16|FORX[FORC,3];FORX[FORC,4]:=0;FORC:=FORC-1; 00091900 GO INCST; 00092000 COMMENT 11 DEF 00092100 DEF FN(....)= 00092200 FORMAL PARAMETERS MUST BE SINGLE LETTERS ; 00092300 00092400 DEF: SKIP(3,"INE");SKIP(2,"FN");K:=CHCONV(NWC); 00092500 IF K=0 OR NWC NEQ 29 THEN SYNT(" ILL FN");A:=0;PUT(K); 00092600 IF SUB[K] NEQ 0 THEN SYNT("REDC FN"); 00092700 RDUM: A:=A+1;B:=11|CHCONV(NWC)-11;IF B=-11 THEN SYNT("INV PAR"); 00092800 CONST[NCON+A]:=B;IF NWC=58 THEN GO RDUM;IF CHA NEQ 45 THEN SYNT 00092900 (" NO ) P");SUB[K]:=A;FOR B:=A STEP -1 UNTIL 1 DO BEGIN 00093000 PUT((C:=CONST[NCON+B]).[11:6]);PUT(C.[5:6]) END; 00093100 IF NWC NEQ "=" THEN SYNT("MISP = ");ARITH(1);SUB[K]:=A;GO TO INCST; 00093200 COMMENT 6 READ 00093300 READ ,... ; 00093400 00093500 REA: SKIP(1,"D"); 00093600 RREA: ARITH(0);IF NOT VAR THEN SYNT("INV VAR"); 00093700 ON(58) GO TO RREA;PUT(0);GO TO INCST; 00093800 COMMENT 5 INPUT 00093900 INPUT ,... 00094000 INPUT FILE ,,... 00094100 WHERE IS THE FILENAME; 00094200 INP: SKIP(2,"UT");CFN;GO TO RREA; 00094300 COMMENT 13 RANDOMISE 00094400 RANDOMISE 00094500 RANDOMIZE ; 00094600 RAN: SKIP(6,"DOMISE");SKIP(6,"DOMIZE");CHA:=NWC;GO TO INCST; 00094700 COMMENT 15 RESTORE 00094800 RESTORE 00094900 RESTORE FILE 00094930 WHERE IS THE INPUT FILE ; 00094960 RES: SKIP(4,"TORE");CFN; GO TO INCST; 00095000 COMMENT 7 PRINT 00095100 PRINT

00095200 PRINT FILE ,,... 00095300 WHERE IS A FILENAME 00095400 WHERE

IS A NUMBER OF ELEMENTS OF FORM 00095500 "" 4 00095600 , 2 OR 6, 1 00095700 ; COMMENT 2 OR 6 00095800 , 1 (1,5 IF TRAILS00095900 ; COMMENT 5 IF TRAILS 00096000 TAB() 3 00096100 WHERE IS ANY STRING 00096200 WHERE IS "" OR ; 00096300 00096400 PRI: SKIP(2,"NT");CFN;CHA:=NWC;AA:=FALSE; 00096500 RPRI: ON("%") BEGIN PUT(0);GO TO INCST END; 00096600 ON(58) BEGIN PUT(1);AA:=FALSE; 00096700 IF NWC="%" THEN BEGIN PUT(5); GO TO INCST END 00096800 ELSE GO TO RPRI END; 00096900 ON(";" OR CHA=":") BEGIN AA:=FALSE;IF NWC="%" THEN BEGIN PUT(5); 00097000 GO INCST END;GO TO RPRI END; 00097100 ON(63) BEGIN AA:=FALSE;PUT(4);PUT(CP);CPR:=POINTER(PROG[CS,2])+CP; 00097200 SCAN APR:CPR UNTIL=63;B:=DELTA(CPR,APR);PUT(B); 00097300 CP:=CP+B+1;CHA:=NWC;GO TO RPRI END; 00097400 IF LOOK(4)="TAB(" THEN BEGIN AA:=FALSE;PUT(3);CP:=LP;ARITH(1); 00097500 IF CHA NEQ 45 THEN SYNT("NO ) P");CHA:=NWC;GO TO RPRI END; 00097600 CP:=CP-1;IF AA THEN SYNT("NO SEPR");AA:=TRUE; 00097700 B:=CO;PUT(2);ARITH(0);IF STRIN THEN 00097800 REPLACE POB+B BY "6" FOR 1;GO TO RPRI; 00097900 COMMENT 14 PAGE 00098000 PAGE ; 00098100 PAG: SKIP(1,"E");CHA:=NWC;GO TO INCST; 00098200 COMMENT 10 MAT 00098300 MAT READ 1 00098400 MAT READ (,) 1 00098500 MAT PRINT 2 00098600 MAT PRINT (,) 2 00098700 MAT LET =()* 4 00098800 MAT =()* 4 00098900 MAT LET = 3 00099000 MAT = 3 00099100 WHERE IS AS DESCRIBED IN EXECUTE(PROCEDURE MATOP) ; 00099200 MAT: CHA:=NWC;A:=LOOK(4);IF A="READ" THEN BEGIN PUT(1);CP:=LP; 00099300 GO TO IOMT END;IF A="PRIN" THEN BEGIN PUT(2);CP:=LP;SKIP(1,"T"); 00099400 GO TO IOMT END;CP:=CP-1;SKIP(3,"LET");A:=CP;B:=CHMAT(NWC);CHA:=NWC; 00099500 IF NWC=29 THEN BEGIN PUT(4);PUT(B);ARITH(1);CHA:=NWC;PUT(CHMAT(NWC)); 00099600 END ELSE BEGIN PUT(3);PUT(A) END;GO TO REM; 00099700 IOMT: K:=CHMAT(NWC);PUT(K);IF NWC=29 THEN BEGIN 00099800 FOR B:=1,2 DO BEGIN A:=NUMB;IF A LSS 0 OR A GTR ARR[K,B] THEN 00099900 SYNT(" SIZE");PUT(A) END;CHA:=NWC; 00100000 END ELSE BEGIN PUT(ARR[K,1]);PUT(ARR[K,2]) END; 00100100 PUT(ON(";") 1 ELSE 0);ON(";") CHA:=NWC;GO TO INCST; 00100200 COMMENT 12 DATA 00100300 DATA ,... ; 00100400 DAT: SKIP(1,"A"); 00100500 RDAT: ARITH(0);ON(58) GO TO RDAT;PUT(0);GO INCST; 00100600 COMMENT 17 STOP 00100700 STOP 00100800 18 END 00100900 END ; 00101000 ENX: IF CS NEQ MS AND A=18 THEN SYNT("NOTLAST");CHA:=NWC; 00101100 IF A=17 THEN CHA:=NWC; 00101200 INCST: IF CHA NEQ "%" THEN SYNT("TOO MCH"); 00101300 COMMENT 16 REM 00101400 REM 00101500 WHERE IS ANYTHING ; 00101600 REM:ERR: END; 00101700 00101800 % SORT OUT FILES IF 2 TO BE USED 00101900 CS:=MS;IF NF=2 AND FNM[3,1]=FNM[3,2] THEN SYNT(" FILES "); 00102000 IF FNM[3,1]=7 THEN BEGIN IO[3]:=IO[1];IO[1]:=IO[2]; 00102100 IO[2]:=IO[3] END; 00102200 IF NOT SY THEN BEGIN WRITE(TTY,STP,"ERRORS");GO TO SOURCEIN END; 00102300 OBJECT:=TRUE;GO TO EXECUTE; 00102400 00102500 INTVR: SYNT("OVERFLW"); QUOTE: SYNT(" QUOTES"); 00102600 FLAGR: SYNT("NAME "); 00102700 00102800 00102900 COMMENT----------------------------------------------------------------00103000 -------------- END COMPILE ------------------------00103100 ------------------------------------------------------------------------00103200 -------------- EXECUTE: EXECUTION OF --------------------00103300 -------------- USERS PROGRAM --------------------00103400 -----------------------------------------------------------------------;00103500 EXECUTE: BEGIN 00103600 00103700 FILE IN FIL1 DISK " "(2,10,300); 00103800 FILE OUT FIL2 DISK[20:AREASIZE] " "(2,10,300,SAVE 7); 00103900 00104000 INTEGER ARRAY SVE[1:10], % HOLDS GOSUB CALLS 00104100 FUNC[1:26], % DEFINES 00104200 STRGS[-1:100,0:2], % STRINGS 00104300 IOB[1:14], % I/O PSEUDOBUFFER 00104400 IOF[1:10], % " 00104500 ADR[0:20]; % ADDRESS STCK FOR EVAL 00104600 00104700 ARRAY STORE[0:1000], % HOLDS VARIABLE VALUES ETC 00104800 STK[0:20]; % VALUE STACK FOR EVAL 00104900 00105000 INTEGER XRND, % PSEUDO-RANDOM NUMBER INDEX 00105100 CO, % CURRENT POSITION IN OBJ[*] 00105200 RDAT, % DATA STATEMENT 00105300 NGOT, % GO COUNTER 00105400 SLVE, % GOSUB COUNTER 00105500 RDTP, % POSITION IN DATA STATEMENT 00105600 MSTO, % TOP OF STORE[*] 00105700 MSTR, % TOP OF STRGS[*, ] 00105800 IR, % INPUT FILE SEQUENCE NO 00105850 NR, % OUTPUT FILE COUNTER 00105900 RT, % RUN TERMINATION TIME 00106000 MF, % FILE (0=TTY,OTHERWISE DISK) 00106100 STCK, % STACK POINTER FOR EVAL 00106200 A,B,C,D,I,J,K,L,U,V,W,X,Y,Z,AS; 00106300 00106400 REAL R,S,T; % HASH 00106500 00106600 POINTER PIOB, % CURRENT POSITION IN IOB[*] 00106700 POUB, % INITIAL 00106800 PBR,IPR; 00106900 00107000 LABEL INCST; 00107100 00107200 % TRACE PACKAGE 00107300 %FORMAT T1(I6,X2,A3,X5,"VALUE ASSIGNED= "U),T2(I6,X2,A3,X5," TO STMT " 00107400 % ,I6),T3(I6,X2,A3); 00107500 BOOLEAN TRACEON,TLIN;%POINTER ITR; 00107600 %PROCEDURE DSTR(A);VALUE A;INTEGER A; 00107700 %BEGIN WRITE(IOF[*],T3,SSEQ[CS],IF TLIN THEN KEY[STYP[CS]] ELSE " "); 00107800 %REPLACE ITR:POINTER(IOF[*])+14 BY "STRING ASSIGNED=";REPLACE ITR:ITR 00107900 %BY """ FOR 1;REPLACE ITR:ITR BY POINTER(STRGS[A,1]) FOR STRGS[A,0]; 00108000 %REPLACE ITR BY """ FOR 1;WRITE(FL[OU],9,IOF[*]);TLIN:=FALSE END; 00108100 DEFINE TR0(TR01,TR02)=#,%IF TR01 THEN BEGIN WRITE(FL[OU],TR02,SSEQ[CS],00108200 % IF TLIN THEN KEY[STYP[CS]] ELSE " "#, 00108300 TR1(TR11)=#, %=TR0(TRACEON,T1),TR11);TLIN:=FALSE END#, 00108400 TR2(TR21)=#, %=TR0(TRACEON,T2),SSEQ[TR21]);TLIN:=FALSE END#, 00108500 TR3 =#, %=TR0(TLIN,T3));TLIN:=FALSE END#, 00108600 TR4(TR41)=#; %=IF TRACEON THEN DSTR(TR41)#; 00108700 00108800 % PROCEDURES FOR EXECUTE: 00108900 00109000 COMMENT 00109100 --- GET GETS NEXT CHARACTER FROM OBJ ; 00109200 00109300 DEFINE GET=0&OBJ[CO.[46:44]][5:47-CO.[2:3]|6:6];CO:=CO+1; 00109400 IF CO.[2:3]=0 THEN CO:=CO+1#; 00109500 COMMENT 00109600 --- ERROR DEALS WITH EXECUTION TIME ERRORS; 00109700 00109800 PROCEDURE ERROR(A);VALUE A;INTEGER A; 00109900 BEGIN SWITCH FORMAT ERR:=("ERR0",I6), % SHOULD NOT OCCUR.. %0 00110000 ("SUBSCRIPT OUT OF BOUNDS AT LINE ",I6), %1 00110100 ("LOG OF NEGATIVE OR ZERO NUMBER AT LINE ",I6), %2 00110200 ("SQR OF NEGATIVE NUMBER AT LINE ",I6), %3 00110300 ("UNDEFINED FUNCTION AT LINE ",I6), %4 00110400 ("INPUT STATEMENT ATTEMPTED IN BATCH MODE AT LINE",I6), 00110500 ("GO TO UNDEFINED STATEMENT NUMBER AT LINE ",I6), %6 00110600 ("RETURN WITHOUT GOSUB AT LINE ",I6), %7 00110700 ("ARGUMENT FOR SIN,COS,TAN OR EXP EXCEEDS 158 AT LINE",I6), %8 00110800 ("INCREMENT UNDEFINED OR ZERO AT LINE ",I6), %9 00110900 ("NEXT WITHOUT FOR AT LINE ",I6), %10 00111000 ("STORAGE EXCEEDED AT LINE ",I6), %11 00111100 ("INTEGER OVERFLOW AT LINE ",I6), %12 00111200 ("INVALID ADDRESS AT LINE ",I6), %13 00111300 ("DIVIDE BY ZERO AT LINE ",I6), %14 00111400 ("ILLEGAL EXPONENTIATION AT LINE ",I6), %15 00111500 ("FLOATING-POINT OVERFLOW AT LINE ",I6), %16 00111600 ("GOSUBS NESTED TOO DEEP (MORE THAN 10) AT LINE ",I6), %17 00111700 ("ILLEGAL EXPONENT ON INPUT AT LINE ",I6), %18 00111800 ("MISPLACED STRING IN INPUT AT LINE ",I6), %19 00111900 ("INPUT STRING TOO LONG AT LINE ",I6), %20 00112000 ("OUT OF DATA AT LINE ",I6),("ERR22",I6), % ERR22 SHOULDNT OCCUR 21,22 00112100 ("ILLEGAL MATRIX OPERATION AT LINE ",I6), %23 00112200 ("INVERSE OF ILL-CONDITIONED MATRIX AT LINE ",I6), %24 00112300 ("INSUFFICIENT SPARE STORAGE FOR MAT OP AT LINE ",I6), %25 00112400 ("ILLEGAL FILE OPERATION AT LINE ",I6), %26 00112500 ("INPUT FILE NOT ON DISK AT LINE",I6), %27 00112600 ("INPUT FILE - INVALID USER AT LINE",I6), %28 00112700 ("INPUT FILE IS NON-STANDARD AT LINE",I6), %29 00112800 ("OUTPUT FILE - DUPLICATE NAME AT LINE",I6); %30 00112900 COMMENT LAST MESSAGE HERE IS NO. 30 ; 00113000 FORMAT DUR("THE FOLLOWING LINE WAS AWAITING OUTPUT:"), 00113100 FILAT(A6," FILE SEQUENCE NO.",I8); 00113130 WRITE(TTY,ERR[A],SSEQ[CS]); 00113150 IF INFILTOG THEN WRITE(TTY,FILAT," INPUT",IR); 00113170 IF OUTFILTOG THEN WRITE(TTY,FILAT,"OUTPUT",NR); 00113200 IF DELTA(POUB,PIOB) GTR 0 THEN BEGIN WRITE(TTY,DUR); 00113300 WRITE(TTY,9,IOB[*]) END; 00113400 LOCK(FIL1);LOCK(FIL2);GO TO STOP END; 00113500 00113600 COMMENT --- EVAL EVALUATES ARITHMETIC EXPRESSION 00113700 (REVERSE POLISH DECODER) ; 00113800 00113900 REAL PROCEDURE EVAL; 00114000 BEGIN 00114100 LABEL EQ,DONE,EXPON,RPT,SS,S,NUM,VR,AR,SF,UF,AD,SU,MU,DI,EX,FIN, 00114200 INM,STRGA,STRGC,STRGV; 00114300 SWITCH TYP:=FIN,NUM,VR,AR,UF,SF,FIN,EQ,INM,AD,SU,MU,DI,EX,STRGV, 00114400 STRGA,STRGC; 00114500 DEFINE TOP=STK[STCK];STCK:=STCK-1#; 00114600 DEFINE STACK(STACK1)=STCK:=STCK+1;STK[STCK]:=STACK1;GO TO SS#; 00114700 COMMENT ADDR RETURNS RESULT ADDRESS (IN STORE IF REAL, STRGS 00114800 IF STRING). INTERMEDIATE RESULTS AND ADDRESSES ARE STACKED 00114900 IN STK AND ADR RESECTIVELY. ; 00115000 STRIN:=FALSE;STCK:=0; 00115100 SS: ADR[STCK]:=ADDR;CHA:=GET;GO TO TYP[CHA+1]; 00115200 NUM: A:=GET;A:=A|64+GET;STACK(CONST[A]); 00115300 STRGV: ADDR:=GET;STRIN:=TRUE;STACK(0); 00115400 STRGA: K:=GET;A:=TOP;IF A LEQ 0 OR A GTR STRAR[K,1] 00115500 THEN ERROR(1);ADDR:=STRAR[K,0]+A;STRIN:=TRUE;STACK(0); 00115600 STRGC: A:=GET;K:=GET;REPLACE POINTER(STRGS[0,1])BY POINTER 00115700 (PROG[CS,2])+K FOR A;STRGS[0,0]:=A;STRIN:=TRUE;ADDR:=0;STACK(0); 00115800 INM: STACK(0); 00115900 VR: K:=GET;K:=K-1;ADDR:=11|K+GET;STACK(STORE[ADDR]); 00116000 AR: K:=GET;A:=B:=TOP;IF ARR[K,2] NEQ 0 THEN BEGIN 00116100 A:=TOP;IF B LEQ 0 OR B GTR ARR[K,2] THEN ERROR(1) END; 00116200 IF A LEQ 0 OR A GTR ARR[K,1] THEN ERROR(1); 00116300 ADDR:=ARR[K,0]+(A-1)|ARR[K,2]+B-1;STACK(STORE[ADDR]); 00116400 SF: 00116500 BEGIN LABEL SQR,SIF,COF,TAF,ATF,EXF,LOF,ABF,ENF,FNQ,DC, 00116600 FIX,SGN,RND; 00116700 SWITCH SFUN:=SIF,COF,TAF,ATF,EXF,LOF,ABF,ENF,SQR,FIX,SGN,RND; 00116800 DEFINE TEST=IF ABS(R)>158 THEN ERROR(8)#; 00116900 A:=GET;R:=TOP;GO TO SFUN[A-18]; 00117000 SIF: TEST;R:=SIN(R);GO TO DC; 00117100 COF: TEST;R:=COS(R); GO TO DC; 00117200 TAF: TEST;R:=SIN(R)/COS(R); GO TO DC; 00117300 ATF: R:=ARCTAN(R); GO TO DC; 00117400 EXF: TEST;R:=EXP(R); GO TO DC; 00117500 LOF: IF R LEQ 0 THEN ERROR(2);R:=LN(R); GO TO DC; 00117600 ABF: R:=ABS(R); GO TO DC; 00117700 SQR: IF R LSS 0 THEN ERROR(3);R:=R*.5; GO TO DC; 00117800 ENF: R:=ENTIER(R);GO TO DC; 00117900 FIX: R:=ENTIER(R);IF R LSS 0 THEN R:=R+1;GO TO DC; 00118000 SGN: R:=IF R LSS 0 THEN -1 ELSE IF R GTR 0 THEN 1 ELSE 0; 00118100 GO TO DC; 00118200 RND: XRND:=XRND|2899;XRND:=XRND.[23:23]; 00118300 R:=XRND|2*(-23);GO TO DC; 00118400 DC: STACK(R) END; 00118500 COMMENT USER FUNCTIONS SECTION ; 00118600 UF: BEGIN INTEGER AS,SVSK,SVADDR; 00118700 ARRAY DUM[1:20,1:4],SVSTK,SVADR[0:20]; 00118800 K:=GET;AS:=CS;CS:=FUNC[K];IF CS=0 THEN BEGIN CS:=AS;ERROR(4) END; 00118900 B:=CO;CO:=SPOB[CS];C:=GET;FOR A:=1 STEP 1 UNTIL SUB[K] DO BEGIN 00119000 COMMENT SAVE VALUES OF FORMAL PARAMETERS AND STORE ACTUALS; 00119100 R:=TOP;C:=GET;C:=64|C+GET;DUM[A,1]:=C;DUM[A,2]:=STORE[C];STORE[C]:=R 00119200 END;SVADDR:=ADDR;SVSK:=STCK; 00119300 FOR A:=0 STEP 1 UNTIL 20 DO BEGIN SVSTK[A]:=STK[A];SVADR[A]:=ADR[A] 00119400 END; 00119500 COMMENT NOW EVALUATE FUNCTION ANO RESTORE FORMAL PARAMETERS; 00119600 R:=EVAL;FOR A:=1 STEP 1 UNTIL SUB[K] DO STORE[DUM[A,1]]:=DUM[A,2]; 00119700 FOR A:=0 STEP 1 UNTIL 20 DO BEGIN STK[A]:=SVSTK[A];ADR[A]:=SVADR[A] 00119800 END;ADDR:=SVADDR;STCK:=SVSK; 00119900 CS:=AS;CO:=B;STACK(R) END; 00120000 EQ: IF STRIN THEN BEGIN ADDR:=A:=ADR[STCK];STCK:=STCK-1; 00120100 B:=ADR[STCK];REPLACE POINTER(STRGS[B,*]) BY POINTER(STRGS[A,*]) 00120200 FOR 3 WORDS;TR4(B);GO TO SS END;R:=TOP;ADDR:=ADR[STCK]; 00120300 STORE[ADDR]:=STK[STCK]:=R;TR1(R);GO TO SS; 00120400 AD: R:=TOP;R:=R+TOP;STACK(R); 00120500 SU: R:=TOP;R:=-R+TOP;STACK(R); 00120600 MU: R:=TOP;R:=R|TOP;STACK(R); 00120700 DI: R:=TOP;R:=1/R|TOP;STACK(R); 00120800 EX: T:=TOP;R:=TOP;IF T NEQ ENTIER(T) AND R LSS 0 00120900 THEN ERROR(15);STACK(R*T); 00121000 FIN: EVAL:=STK[1] END; 00121100 COMMENT 00121200 --- OUTP OUTPUTS CONTENTS OF PSEUDO-BUFFER ; 00121300 00121400 PROCEDURE OUTP; 00121500 BEGIN IF MF>0 THEN ERROR(26);TR3; 00121600 WRITE(FL[OU],14,IOB[*]);REPLACE PIOB:=POUB:=POINTER(IOB[*]) BY 00121700 " " FOR 112;IF OU=1 THEN PIOB:=POUB:=POUB+20 END; 00121800 COMMENT 00121900 --- MORE FALSE IF END OF STATEMENT ; 00122000 00122100 BOOLEAN PROCEDURE MORE; 00122200 BEGIN INTEGER A,B;A:=CO;B:=GET;MORE:=B NEQ 0;CO:=A END; 00122300 COMMENT 00122400 --- OUTNUM PLACES NUMBER IN PSEUDO-BUFFER ; 00122500 00122600 PROCEDURE OUTNUM(A,F);VALUE A,F;REAL A;INTEGER F; 00122700 BEGIN CHA:=0;CP:=CP-1;WRITE(IOBE[*],NUM[F],A); % CARE: 00122800 SCAN APR:CPR FOR 16 UNTIL ="@"; 00123200 IF DELTA(CPR,APR) NEQ 16 THEN REPLACE APR BY "E" FOR 1; 00123300 IF DELTA(POUB,PIOB) GTR 60+F|4 THEN OUTP; 00123400 REPLACE PIOB:PIOB BY POINTER(IOBE[1]) FOR 14 UNTIL=48; 00123500 REPLACE PIOB:PIOB BY " " FOR 1 END; 00123600 COMMENT 00123700 --- QUO PLACES " IN OUTPUT BUFFER ; 00123800 DEFINE QUO=IF MF>0 THEN REPLACE PIOB:PIOB BY """#; 00123900 COMMENT 00124000 --- MATOP PROCESSES MOST MAT STATEMENTS ; 00124100 00124200 PROCEDURE MATOP; 00124300 BEGIN INTEGER U,V,W,X,Y,Z,I,J; 00124400 COMMENT MAT STATEMENTS CONCERNED HAVE FORMAT 00124500 MAT LET = 00124600 MAT = 00124700 THE SECOND CHARACTER IN IS USED TO IDENTIFY ACTION TAKEN 00124800 THIS CAN BE * + - E O D R N % 00124900 (RECALL % IS END-STATEMENT CHARACTER) ; 00125000 LABEL DONE,ADSU,EQM,CONS,EX,EY;REAL PIVOT,AI; 00125100 INTEGER ARRAY IR[1:72];REAL ARRAY TEM[1:72]; 00125200 DEFINE AA(AA1,AA2)=STORE[ARR[K,0]+(AA1-1)|U+AA2-1]#; 00125300 CP:=GET;CHA:=0;K:=CHCONV(NCH);IF K=0 THEN ERROR(23); 00125400 IF NCH NEQ 61 THEN ERROR(23);A:=CHCONV(NCH);CHA:=NCH; 00125500 COMMENT SWITCH OCCURS HERE 00125600 * MATRIX MULTIPLICATION 00125700 IS * 00125800 HASH STORAGE IS USED TO AVOID TROUBLE WITH A=A*B ETC ; 00125900 ON("*") BEGIN B:=CHCONV(NCH); 00126000 U:=ARR[K,1]-1;V:=ARR[K,2]-1;W:=ARR[A,1]-1;X:=ARR[A,2]-1; 00126100 Y:=ARR[B,1]-1;Z:=ARR[B,2]-1;IF U NEQ W OR V NEQ Z OR X NEQ Y 00126200 THEN ERROR(23);IF MSTO+(U+1)|(V+1) GTR 1000 THEN ERROR(25); 00126300 FOR W:=0 STEP 1 UNTIL U DO FOR Z:=0 STEP 1 UNTIL V DO BEGIN R:=0; 00126400 FOR Y:=0 STEP 1 UNTIL X DO R:=R+STORE[ARR[A,0]+X|W+W+Y]| 00126500 STORE[ARR[B,0]+Y|V+Y+Z];STORE[MSTO+W|V+W+Z]:=R END; 00126600 FOR W:=0 STEP 1 UNTIL U DO FOR Z:=0 STEP 1 UNTIL V DO 00126700 STORE[ARR[K,0]+W|V+W+Z]:=STORE[MSTO+W|V+W+Z]; 00126800 GO TO DONE END; 00126900 COMMENT + MATRIX ADDITION 00127000 IS + ; 00127100 ON("+") BEGIN Z:=1;GO TO ADSU END; 00127200 COMMENT - MATRIX SUBTRACTION 00127300 IS - ; 00127400 ON("-") BEGIN Z:=-1;GO TO ADSU END; 00127500 COMMENT O ALL ONES 00127600 IS CON ; 00127700 ON("O") BEGIN Z:=Y:=1;GO TO CONS END; 00127800 COMMENT D IDENTITY MATRIX 00127900 IS IDN ; 00128000 ON("D") BEGIN IF ARR[K,1] NEQ ARR[K,2] THEN ERROR(23);Z:=1;Y:=0; 00128100 COMMENT E ZERO MATRIX 00128200 IS ZER ; 00128300 GO TO CONS END; ON("E") BEGIN Z:=Y:=0;GO TO CONS END; 00128400 COMMENT R TRANSPOSITION 00128500 IS TRN() 00128600 HASH STORAGE USED TO AVOID TROUBLE WITH A=TRN(A) ; 00128700 ON("R") BEGIN CHA:=NCH;CHA:=NCH;A:=CHCONV(NCH);IF A=0 THEN ERROR(23); 00128800 U:=ARR[K,1]-1;V:=ARR[K,2]-1;W:=ARR[A,1]-1;X:=ARR[A,2]-1; 00128900 IF U NEQ X OR V NEQ W THEN ERROR(23); 00129000 IF MSTO+(U+1)|(V+1) GTR 1000 THEN ERROR(25); 00129100 FOR U:=0 STEP 1 UNTIL X DO FOR V:=0 STEP 1 UNTIL W DO 00129200 STORE[MSTO+U|W+U+V]:=STORE[ARR[A,0]+V|X+V+U]; 00129300 FOR U:=0 STEP 1 UNTIL X DO FOR V:=0 STEP 1 UNTIL W DO 00129400 STORE[ARR[K,0]+U|W+U+V]:=STORE[MSTO+U|W+U+V]; 00129500 GO TO DONE END; 00129600 COMMENT N INVERSION 00129700 IS INV() ; 00129800 ON("N") BEGIN CHA:=NCH;CHA:=NCH;A:=CHCONV(NCH); 00129900 U:=ARR[K,1];IF U NEQ ARR[K,2] OR U NEQ ARR[A,1] OR U NEQ ARR[A,2] 00130000 THEN ERROR(23);FOR I:=0 STEP 1 UNTIL U-1 DO FOR J:=0 STEP 1 UNTIL U-1 00130100 DO AA(I+1,J+1):=STORE[ARR[A,0]+I|U+J]; 00130200 FOR V:=1 STEP 1 UNTIL U DO BEGIN PIVOT:=0; 00130300 FOR I:=1 STEP 1 UNTIL U DO BEGIN IF V NEQ 1 THEN BEGIN 00130400 FOR X:=1 STEP 1 UNTIL V-1 DO IF I=IR[X] THEN GO TO EX END; 00130500 IF ABS(AA(I,V))GTR ABS(PIVOT) THEN BEGIN PIVOT:=AA(I,V);Y:=IR[V]:=I 00130600 END; 00130700 EX: END;IF ABS(PIVOT) LSS .0001 THEN ERROR(24); 00130800 FOR J:=1 STEP 1 UNTIL U DO AA(Y,J):=AA(Y,J)/PIVOT;AA(Y,V):=1/PIVOT; 00130900 FOR I:=1 STEP 1 UNTIL U DO IF I NEQ Y THEN BEGIN AI:=AA(I,V); 00131000 AA(I,V):=-AI/PIVOT;FOR J:=1 STEP 1 UNTIL U DO IF J NEQ V THEN 00131100 AA(I,J):=AA(I,J)-AI|AA(Y,J) END END; 00131200 FOR I:=1 STEP 1 UNTIL U DO 00131300 BEGIN FOR J:=1 STEP 1 UNTIL U DO TEM[J]:=AA(I,J); 00131400 FOR J:=1 STEP 1 UNTIL U DO AA(I,IR[J]):=TEM[J] END; 00131500 FOR J:=1 STEP 1 UNTIL U DO BEGIN FOR I:=1 STEP 1 UNTIL U DO 00131600 TEM[I]:=AA(IR[I],J);FOR I:=1 STEP 1 UNTIL U DO AA(I,J):=TEM[I] 00131700 END;GO TO DONE END; 00131800 % EQUALITY 00131900 COMMENT IS ; 00132000 ON("%") BEGIN B:=A;Z:=0; GO TO EQM END; 00132100 ERROR(23); 00132200 ADSU: B:=CHCONV(NCH);IF B=0 THEN ERROR(23); 00132300 IF ARR[A,1] NEQ ARR[B,1] OR ARR[A,2] NEQ ARR[A,2] THEN ERROR(23); 00132400 EQM: U:=ARR[K,1];V:=ARR[K,2];IF U NEQ ARR[A,1] 00132500 OR V NEQ ARR[A,2] THEN ERROR(23); 00132600 FOR I:=0 STEP 1 UNTIL U-1 DO FOR J:=0 STEP 1 UNTIL V-1 DO 00132700 AA(I+1,J+1):=STORE[ARR[A,0]+I|U+J]+Z|STORE[ARR[B,0]+I|U+J]; 00132800 GO TO DONE; 00132900 CONS: U:=ARR[K,I];FOR I:=1 STEP 1 UNTIL ARR[K,1] DO 00133000 FOR J:=1 STEP 1 UNTIL ARR[K,2] DO AA(I,J):=IF I=J THEN Z ELSE Y; 00133100 DONE: GO TO INCST END; 00133200 LABEL RPT,REM,DAT,EXS,LET,RLET,ONX, 00133300 INP,PRI,RPRI,XPRI,MAT,ENX,RREA,XREA,QDAT,FREA,RES,NDAT, 00133400 STRV,FOL,INTVR,INDEXR,DZER,EXPVR, 00133500 NM,TAB,COM,STR,EPRI,OUD,OUF, 00133600 IFF,GOT,GOX,GOS,RET,FOX,NEX,FD,DEF,REA,EREA,RAN,PAG; 00133700 SWITCH OPN:=LET,GOT,GOS,RET,INP,REA,EPRI,FOX,NEX,MAT, 00133800 DEF,DAT,RAN,PAG,RES,REM,ENX,ENX,IFF,ONX; 00133900 00134000 SWITCH TYP:=XPRI,COM,NM,TAB,STR,INCST,STRV; 00134100 00134200 COMMENT----------------------------------------------------------------00134300 ----------------- EXECUTE BEGINS HERE --------------------00134400 -----------------------------------------------------------------------;00134500 00134600 INTOVR:=INTVR;EXPOVR:=EXPVR;ZERO:=DZER;INDEX:=INDEXR; 00134700 WRITE(TTY,MESS);RT:=TIME(2)+TIM;IF OU=1 THEN WRITE(TTY,DVO); 00134800 WRITE(FL[OU],SPC);NR:=IR:=RDAT:=RDTP:=NGOT:=0;TRACEON:=TLIN:=FALSE; 00134900 FORC:=SLVE:=0;XRND:=101;CS:=ACS-1; 00135000 POUB:=PIOB:=POINTER(IOB[*])+20|OU; 00135100 REPLACE POINTER(IOB[*]) BY " " FOR 112; 00135200 00135300 % GET FILES IF NEEDED: 00135400 IF INFILTOG THEN BEGIN FILL FIL1 WITH IO[1],TIME(-1); 00135500 SEARCH(FIL1,ANSA[*]);IF ANSA[0] LEQ 0 THEN ERROR(28+ANSA[0]); 00135600 IF ANSA[3] NEQ 10 OR ANSA[4] NEQ 300 THEN ERROR(29) END; 00135700 IF OUTFILTOG THEN BEGIN FILL FIL2 WITH IO[2],TIME(-1); 00135800 SEARCH(FIL2,ANSA[*]);IF ANSA[0] NEQ -1 THEN BEGIN 00135900 WRITE(TTY,F13,IO[2].[41:36]); 00136000 IF IU=2 THEN U:=0 ELSE 00136100 READ(TTY,REP,U);IF U NEQ "YES" THEN ERROR(30) END END; 00136200 00136300 COMMENT RETURN TO HERE AFTER EACH STATEMENT; 00136400 00136500 REM:DAT:INCST: TR3;CS:=CS+1; 00136600 EXS: MF:=0; % FIRST SEE IF EXCESS TIME 00136700 IF TIME(2) GTR RT THEN BEGIN WRITE(TTY,BK);GO TO ENX END; 00136800 IF STYP[CS]>19 THEN BEGIN TRACEON:=STYP[CS]=20;GO INCST END; 00136900 IF TRACEON THEN TLIN:=TRUE; 00137000 00137100 00137200 U:=STYP[CS];CO:=SPOB[CS];GO TO OPN[U]; % NOW GO TO APPROPRIATE PLACE 00137300 % LET STATEMENT 00137400 LET: R:=EVAL;GO TO INCST; 00137500 % ON STATEMENT 00137600 ONX: U:=EVAL; 00137700 FOR V:=1 STEP 1 UNTIL 2|U-2 DO BEGIN S:=GET END;GO GOT; %(STET) 00137800 % IF STATEMENT 00137900 IFF: R:=EVAL;IF STRIN THEN BEGIN 00138000 COMMENT STRING IF ; 00138100 U:=GET; 00138200 REPLACE IPR:=POINTER(STRGS[-1,*]) BY POINTER(STRGS[ADDR,*]) FOR 24; 00138300 R:=EVAL;GO IF IPR=POINTER(STRGS[ADDR,*]) 00138400 FOR STRGS[-1,0]+8 EQV U=1 THEN GOT ELSE INCST END; 00138500 COMMENT REAL IF ; 00138600 U:=GET;R:=R-EVAL; 00138700 IF R GTR 0 AND U.[2:1]=1 THEN GO TO GOT ELSE 00138800 IF R LSS 0 AND U.[1:1]=1 THEN GO TO GOT ELSE 00138900 IF R = 0 AND U.[0:1]=1 THEN GO TO GOT;GO TO INCST; 00139000 % GOTO STATEMENT 00139100 GOT: U:=GET;U:=64|U+GET;IF U=0 THEN ERROR(6); 00139200 GOX: NGOT:=NGOT+1;TR2(U); 00139300 COMMENT MONITOR FOR EXCESS LOOPING; 00139400 IF NGOT=100 AND IU NEQ 2 THEN BEGIN WRITE(TTY,WRN);READ(TTY,REP,W); 00139500 IF W NEQ "YES" THEN GO TO STOP END; 00139600 CS:=U;GO EXS; 00139700 % GOSUB STATEMENT 00139800 GOS: SLVE:=SLVE+1;IF SLVE GTR 10 THEN ERROR(17); 00139900 SVE[SLVE]:=CS;GO GOT; 00140000 % RETURN STATEMENT 00140100 RET: IF SLVE=0 THEN ERROR(7); 00140200 CS:=SVE[SLVE];SLVE:=SLVE-1;GO TO INCST; 00140300 % FOR STATEMENT 00140400 FOX: FORC:=GET;R:=EVAL; 00140500 00140600 COMMENT FORX CONTROL INFO IS STORED AS FOLLOWS: 00140700 1 2 3 4 00140800 ADDR STEP FINAL FORLINE 00140900 A FOR LOOP IS EXECUTED ZERO TIMES IN THE RIGHT CIRCUMSTANCES; 00141000 00141100 V:=FORX[FORC,1]:=ADDR;S:=FORX[FORC,3]:=EVAL; 00141200 T:=FORX[FORC,2]:=IF MORE THEN EVAL ELSE 1; 00141300 W:=FORX[FORC,4]:=CS;IF T=0 THEN ERROR(9); 00141400 IF T|R LEQ T|S THEN GO INCST; % ELSE SKIP LOOP 00141500 U:=GET;U:=GET;CS:=64|U+GET;GO TO INCST; 00141600 00141700 % NEXT STATEMENT 00141800 % SPOB STORES (NEXTS LEVEL IN FORX)+16|FORLINE 00141900 NEX: U:=SPOB[CS].[3:4];V:=SPOB[CS].[41:38]; 00142000 IF V NEQ FORX[U,4] THEN ERROR(10);L:=FORX[U,1]; 00142100 T:=FORX[U,2];R:=STORE[L]+T; 00142200 IF T|R LEQ T|FORX[U,3] THEN BEGIN STORE[L]:=R;TR1(R);T:=FORX[U,4]; 00142300 TR2(T+1);CS:=T END ELSE FORX[U,4]:=0; 00142400 GO TO INCST; 00142500 % DEFINE STATEMENT 00142600 DEF: U:=GET;FUNC[U]:=CS;GO TO INCST; 00142700 % READ STATEMENT 00142800 REA: U:=0; 00142900 COMMENT THIS SECTION IS COMPLICATED BECAUSE OF SWITCHING 00143000 OF ATTENTION FROM READ STATEMENT TO DATA STATEMENT AND BACK ETC; 00143100 RREA: R:=EVAL;L:=ADDR;U:=CS;V:=CO; 00143200 IF RDTP=0 THEN GO TO QDAT;CO:=RDTP;CS:=RDAT; 00143300 XREA: IF STRIN THEN BEGIN R:=EVAL;CS:=U;IF NOT STRIN THEN 00143400 ERROR(20);REPLACE POINTER(STRGS[L,*])BY POINTER(STRGS[ADDR,*]) 00143500 FOR 3 WORDS;TR4(L) END ELSE BEGIN R:=EVAL;IF STRIN THEN ERROR(20); 00143600 STORE[L]:=R;CS:=U;TR1(R) END;RDTP:=IF MORE THEN CO ELSE 0;CO:=V; 00143700 IF MORE THEN GO TO RREA ELSE GO TO INCST; 00143800 COMMENT FIND ANOTHER DATA STATEMENT; 00143900 QDAT: FOR CS:=RDAT+1 STEP 1 UNTIL MS DO BEGIN 00144000 IF STYP[CS]=12 THEN GO TO FREA END; 00144100 CS:=U;ERROR(21); 00144200 FREA: RDAT:=CS;CO:=SPOB[CS];GO TO XREA; 00144300 % INPUT STATEMENT 00144400 % "STOP" AT START OF INPUT STREAM STOPS A RUN 00144500 INP: BEGIN LABEL RINP,EVINP,RPT,EXPON,DONE,FINP; 00144600 MF:=GET;IF MF=0 THEN BEGIN IF IU=2 THEN ERROR(5); 00144700 IF DELTA(POUB,PIOB) GTR 0 THEN BEGIN 00144800 REPLACE POINTER(IOBE[*]) BY POUB FOR 72;WRITE(TTY[STOP],9,IOBE[*]); 00144900 REPLACE PIOB:=POUB:=POINTER(IOB[*]) BY " " FOR 112;IF OU=1 THEN 00145000 PIOB:=POUB:=PIOB+20 END;READ(TTY,9,IOBE[*]); 00145100 READ(IOBE[*],REP,V);IF V="STO" THEN GO TO STOP END 00145200 ELSE BEGIN Z:=GET;Z:=64|Z+GET;READ(FIL1,10,IOBE[*])[OUD]; 00145300 READ(IOBE[*],SNUM,IR) END; 00145350 REPLACE POINTER(PROG[0,2]) BY POINTER(IOBE[1]) FOR 72;X:=0; 00145400 RINP: R:=EVAL;L:=ADDR;U:=CS;CS:=0;CP:=X;CHA:=0; 00145500 IF NCH="%" THEN BEGIN IF MF=0 THEN BEGIN WRITE(TTY,MNP[IF X=0 THEN 1 00145600 ELSE 0],PROG[U,1]);CS:=U;GO TO EXS END ELSE BEGIN 00145700 READ(FIL1,9,IOBE[*])[OUD]; 00145800 REPLACE POINTER(PROG[0,2]) BY POINTER(IOBE[*]) FOR 72;CP:=1 END END; 00145900 COMMENT INPUT STRING MAY OR MAY NOT HAVE "" ; 00146000 EVINP: CP:=CP-1;CHA:=NCH;IF STRIN THEN BEGIN 00146100 ON(63) SCAN APR:APR:=CPR:=POINTER(PROG[0,2])+CP FOR 15 WHILE NEQ 63 00146200 ELSE BEGIN CP:=CP-2;SCAN APR:APR:=CPR:=POINTER(PROG[0,2])+CP+1 FOR 15 00146300 WHILE IN ALPHA END; 00146400 V:=DELTA(CPR,APR);IF V>14 THEN BEGIN CS:=U;ERROR(20) END; 00146500 STRGS[L,0]:=V;REPLACE POINTER(STRGS[L,1]) BY CPR FOR V; 00146600 CP:=CP+V+1;CHA:=NCH;CS:=U;TR4(L);GO FINP END; 00146700 T:=R:=Y:=0; 00146800 COMMENT INPUT NUMBER ; 00146900 ON(44) BEGIN T:=1;CHA:=NCH END; 00147000 RPT: ON(26) BEGIN Y:=1;CHA:=NCH END; 00147100 IF CHA GEQ 10 THEN GO TO EXPON;IF Y GTR 0 THEN 00147200 BEGIN R:=R+CHA|10*(-Y); 00147300 Y:=Y+1 END ELSE R:=R|10 +CHA;CHA:=NCH; GO TO RPT; 00147400 EXPON: IF CHA NEQ 21 THEN GO TO DONE;Y:=1;CHA:=NCH;Z:=0; 00147500 ON(44)BEGIN Y:=-1;CHA:=NCH END ELSE ON(16) CHA:=NCH; 00147600 IF CHA GEQ 10 THEN BEGIN CS:=U;ERROR(18) END;Z:=CHA;CHA:=NCH; 00147700 IF CHA LSS 10 THEN BEGIN Z:=Z|10+CHA;CHA:=NCH END; 00147800 R:=R|10*(Y|Z); 00147900 DONE: IF T=1 THEN R:=-R;DELIM:=72;STORE[L]:=R;CS:=U;TR1(R); 00148000 FINP: X:=CP;IF CHA NEQ 58 AND CHA NEQ "%" THEN ERROR(19); 00148100 IF MORE THEN GO TO RINP ELSE GO TO INCST END; 00148200 % RANDOMISE STATEMENT 00148300 RAN: XRND:=(2|TIME(1)+1).[23:23];GO TO INCST; 00148400 % RESTORE STATEMENT 00148500 RES: MF:=GET;IF MF=0 THEN RDTP:=RDAT:=0 ELSE REWIND(FIL1); 00148600 GO INCST; 00148700 % PRINT STATEMENT 00148800 EPRI: MF:=GET;IF MF>0 THEN BEGIN PBR:=PIOB; 00148900 TR3;Z:=GET;Z:=64|Z+GET; 00149000 POUB:=POINTER(IOF[*]);REPLACE PIOB:=POINTER(IOF[*]) BY " " FOR 72 END; 00149100 PRI: CHA:=GET;IF MF>0 AND CHA=5 THEN ERROR(26); 00149200 GO TO TYP[CHA+1]; 00149300 Z:=GET;Z:=64|X+GET; 00149400 COMMENT , IN PRINT MOVES TO NEXT 14-SPACE COLUMN. 00149500 00149600 (SEMICOLON IN MIDDLE OF PRINT IS JUST DELIMITER); 00149700 COM: IF MF>0 THEN REPLACE PIOB:PIOB BY "," ELSE BEGIN 00149800 V:=DELTA(POUB,PIOB);IF V GTR 56 THEN BEGIN 00149900 OUTP;V:=0 END ELSE V:=14-(V MOD 14); 00150000 FOR U:=1 STEP 1 UNTIL V DO REPLACE PIOB:PIOB BY " " END; 00150100 GO TO PRI; 00150200 COMMENT PLACE STRING IN PSEUDO-BUFFER ; 00150300 STR: CP:=GET; 00150400 CPR:=POINTER(PROG[CS,2])+CP; 00150500 V:=72-DELTA(POUB,PIOB);W:=GET; 00150600 IF W GTR V THEN BEGIN REPLACE PIOB:PIOB BY CPR:CPR FOR V; 00150700 OUTP;W:=W-V END; 00150800 QUO;REPLACE PIOB:PIOB BY CPR:CPR FOR W;QUO; 00150900 GO TO PRI; 00151000 00151100 COMMENT TAB OVERWRITES ON TELETYPE AND LINE-PRINTER 00151200 BUT REPLACES ON VIDEO UNIT. ; 00151300 00151400 TAB: IF MF>0 THEN ERROR(26);U:=EVAL-1;U:=U MOD 72; 00151500 IF IU+OU NEQ 0 THEN BEGIN TR3;WRITE(FL[OU][NO],9,IOB[*]); 00151600 REPLACE POUB BY " " FOR 72 END;PIOB:=POUB+U; GO TO PRI; 00151700 STRV: R:=EVAL;QUO;REPLACE PIOB:PIOB BY POINTER(STRGS[ADDR,1]) 00151800 FOR STRGS[ADDR,0];QUO;GO TO PRI; 00151900 NM: OUTNUM(EVAL,0);GO TO PRI; 00152000 XPRI: IF MF>0 THEN BEGIN REPLACE PIOB BY ","; 00152100 NR:=NR+10;REPLACE POINTER(IOF[10]) BY NR FOR 8 DIGITS; 00152200 WRITE(FIL2,10,IOF[*])[OUF];PIOB:=PBR;POUB:=POINTER(IOB[*])+20|OU END 00152300 ELSE OUTP;GO TO INCST; 00152400 % PAGE STATEMENT 00152500 PAG: IF OU=1 THEN WRITE(LIN[PAGE]);GO TO INCST; 00152600 % MAT STATEMENT 00152700 % MAT 1=READ, 2=PRINT, 3=MATOP, 4=SCALAR MULTIPLE 00152800 MAT: BEGIN INTEGER E,F,G;LABEL QDAT,FREA,XREA,RREA; 00152900 L:=GET;IF L=1 THEN BEGIN E:=CS;L:=GET;U:=GET;V:=GET; 00153000 FOR W:=0 STEP 1 UNTIL U-1 DO FOR X:=0 STEP 1 UNTIL V-1 DO BEGIN 00153100 IF RDTP = 0 THEN GO TO QDAT;CO:=RDTP;CS:=RDAT; 00153200 XREA: STORE[ARR[L,0]+W|ARR[L,2]+X]:=EVAL; 00153300 RDTP:=IF MORE THEN CO ELSE 0;GO TO RREA; 00153400 QDAT: FOR CS:=RDAT + 1 STEP 1 UNTIL MS DO BEGIN IF STYP[CS] 00153500 =12 THEN GO TO FREA END;CS:=E;ERROR(21); 00153600 FREA: RDAT:=CS;CO:=SPOB[CS];GO TO XREA; 00153700 RREA: END;CS:=E;GO TO INCST END; 00153800 IF L=2 THEN BEGIN 00153900 IF DELTA(POUB,PIOB) GTR 0 THEN OUTP; 00154000 L:=GET;U:=GET;V:=GET;E:=GET;G:=14-E|7;FOR W:=0 STEP 1 UNTIL U-1 DO 00154100 BEGIN FOR X:=0 STEP 1 UNTIL V-1 DO BEGIN OUTNUM(STORE[ARR[L,0]+ 00154200 W|ARR[L,2]+X],E);PIOB:=POUB+G|((DELTA(POUB,PIOB)-1) DIV G +1) 00154300 END;OUTP END;GO TO INCST END; 00154400 IF L=3 THEN MATOP; 00154500 L:=GET;R:=EVAL;W:=GET; 00154600 IF ARR[L,1] NEQ ARR[W,1] OR ARR[L,2] NEQ ARR[W,2] THEN ERROR(23); 00154700 FOR U:=0 STEP 1 UNTIL ARR[L,1]-1 DO FOR V:=0 STEP 1 UNTIL ARR[L,2]-1 00154800 DO STORE[ARR[L,0]+U|ARR[L,2]+V]:=R|STORE[ARR[W,0]+U|ARR[L,2]+V]; 00154900 GO TO INCST END; 00155000 % STOP OR END STATEMENT 00155100 ENX: TR3;IF DELTA(POUB,PIOB)>0 THEN OUTP; 00155200 LOCK(FIL1);LOCK(FIL2);GO TO STOP; 00155300 OUD: IF Z=0 THEN ERROR(21);TR2(Z);CS:=Z;GO EXS; 00155400 OUF: IF Z=0 THEN ERROR(26);TR2(Z);CS:=Z;GO EXS; 00155500 INTVR: ERROR(12);INDEXR: ERROR(13); 00155600 DZER: ERROR(14);EXPVR: ERROR(16) END; 00155700 STOP: WRITE(TTY,STP,"RUN ");GO TO SOURCEIN; 00155800 COMMENT 00155900 PROGRAM WRITTEN BY MALCOLM CROWE 00156000 LANGUAGE DETAILS DECIDED BY IAN MILLER AND JOHN FURLONG 00156100 MATRIX INVERSION CORRECTED BY ARTHUR MACDIVITT ; 00156200 00156300 FINSH: END. 00156400