mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-01-13 23:25:24 +00:00
2fb19ea809
Commit original transcription of Quick Basic 64 version of StarTrek prepared by James as of 2014-03-30.
1568 lines
73 KiB
Plaintext
1568 lines
73 KiB
Plaintext
?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,
|
|
<E> IS ANY EXPRESSION (POSSIBLY WITH =)
|
|
<L> IS ANY LETTER
|
|
<V> IS ANY VARIABLE PRIMARY
|
|
<N> IS ANY UNSIGNED INTEGER
|
|
<S> IS A STATEMENT NUMBER
|
|
<F> 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
|
|
<N> FILES <D>,..
|
|
WHERE <D> IS <F> (EXISTING FILE)
|
|
OR <F>(<N>) (FILE TO BE CREATED: N=MAX NO OF RECS)
|
|
WHERE <F> 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
|
|
<N> DIM <M>(<S>),...
|
|
<N> DIMENSION <M>(<T>),...
|
|
WHERE <M> IS <L> OR <L>$
|
|
<T> IS <N> OR <N>,<N>
|
|
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
|
|
<N> LET <E>
|
|
<N> <E>
|
|
WHERE E MAY BE A STRING ASSIGNMENT ;
|
|
|
|
LET: ARITH(0);GO TO INCST;
|
|
CAR: ARITH(1); GO TO INCST;
|
|
COMMENT 20 ON
|
|
<N> ON <E> GO TO <S>,... ;
|
|
|
|
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]<FORC THEN STYP[B]:=FORC ELSE
|
|
COMMENT SEE FOR STATEMENT FOR THIS TRICK;
|
|
IF STYP[CS]=20 THEN BEGIN ON(58) GO RON ELSE BEGIN PUT(0);PUT(0)
|
|
END END;GO INCST END;SYNT("UNDF GO");
|
|
COMMENT 19 IF
|
|
<N> IF <X><R><E> THEN <S>
|
|
<N> IF <X><R><E> GO TO <S>
|
|
<X> IS AN EXPRESSION WITHOUT =
|
|
<R> 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
|
|
<N> GO TO <S> ;
|
|
|
|
GOT: SKIP(1,"0");GO TO RON;
|
|
COMMENT 3 GOSUB
|
|
<N> GOSUB <S> ;
|
|
|
|
GOS: SKIP(2,"UB");GO TO RON;
|
|
COMMENT 4 RETURN
|
|
<N> RETURN ;
|
|
|
|
RET: SKIP(3,"URN");CHA:=NWC;GO TO INCST;
|
|
COMMENT 8 FOR
|
|
<N> FOR <E> TO <E> STEP <E>
|
|
<N> FOR <E> TO <E> ;
|
|
|
|
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
|
|
<N> NEXT <V>
|
|
WHERE <V> 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
|
|
<N> DEF FN<L>(<L>....)=<E>
|
|
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
|
|
<N> READ <V>,... ;
|
|
|
|
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
|
|
<N> INPUT <V>,...
|
|
<N> INPUT FILE <F>,<V>,...
|
|
WHERE <F> IS THE FILENAME;
|
|
INP: SKIP(2,"UT");CFN;GO TO RREA;
|
|
COMMENT 13 RANDOMISE
|
|
<N> RANDOMISE
|
|
<N> RANDOMIZE ;
|
|
RAN: SKIP(6,"DOMISE");SKIP(6,"DOMIZE");CHA:=NWC;GO TO INCST;
|
|
COMMENT 15 RESTORE
|
|
<N> RESTORE
|
|
<N> RESTORE FILE <F>
|
|
WHERE <F> IS THE INPUT FILE ;
|
|
RES: SKIP(4,"TORE");CFN; GO TO INCST;
|
|
COMMENT 7 PRINT
|
|
<N> PRINT <P>
|
|
<N> PRINT FILE <F>,<Q>,...
|
|
WHERE <F> IS A FILENAME
|
|
WHERE <P> IS A NUMBER OF ELEMENTS OF FORM
|
|
"<Z>" 4
|
|
<E>, 2 OR 6, 1
|
|
<E>; COMMENT 2 OR 6
|
|
, 1 (1,5 IF TRAILS)
|
|
; COMMENT 5 IF TRAILS
|
|
TAB(<E>) 3
|
|
WHERE <Z> IS ANY STRING
|
|
WHERE <Q> IS "<Z>" OR <E> ;
|
|
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
|
|
<N> PAGE ;
|
|
PAG: SKIP(1,"E");CHA:=NWC;GO TO INCST;
|
|
COMMENT 10 MAT
|
|
<N> MAT READ <L> 1
|
|
<N> MAT READ <L>(<N>,<N>) 1
|
|
<N> MAT PRINT <L> 2
|
|
<N> MAT PRINT <L>(<N>,<N>) 2
|
|
<N> MAT LET <L>=(<E>)*<L> 4
|
|
<N> MAT <L>=(<E>)*<L> 4
|
|
<N> MAT LET <L>=<M> 3
|
|
<N> MAT <L>=<M> 3
|
|
WHERE <M> 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
|
|
<N> DATA <E>,... ;
|
|
DAT: SKIP(1,"A");
|
|
RDAT: ARITH(0);ON(58) GO TO RDAT;PUT(0);GO INCST;
|
|
COMMENT 17 STOP
|
|
<N> STOP
|
|
18 END
|
|
<N> 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
|
|
<N> REM <Z>
|
|
WHERE <Z> 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
|
|
<N> MAT LET <L>=<M>
|
|
<N> MAT <L>=<M>
|
|
THE SECOND CHARACTER IN <M> 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
|
|
<M> IS <L>*<L>
|
|
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
|
|
<M> IS <L>+<L> ;
|
|
ON("+") BEGIN Z:=1;GO TO ADSU END;
|
|
COMMENT - MATRIX SUBTRACTION
|
|
<M> IS <L>-<L> ;
|
|
ON("-") BEGIN Z:=-1;GO TO ADSU END;
|
|
COMMENT O ALL ONES
|
|
<M> IS CON ;
|
|
ON("O") BEGIN Z:=Y:=1;GO TO CONS END;
|
|
COMMENT D IDENTITY MATRIX
|
|
<M> IS IDN ;
|
|
ON("D") BEGIN IF ARR[K,1] NEQ ARR[K,2] THEN ERROR(23);Z:=1;Y:=0;
|
|
COMMENT E ZERO MATRIX
|
|
<M> IS ZER ;
|
|
GO TO CONS END; ON("E") BEGIN Z:=Y:=0;GO TO CONS END;
|
|
COMMENT R TRANSPOSITION
|
|
<M> IS TRN(<L>)
|
|
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
|
|
<M> IS INV(<L>) ;
|
|
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 <M> IS <L> ;
|
|
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
|