mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-01-13 23:25:24 +00:00
Commit additional transcription for B5500 APL source by Fausto Saporito, as of 2013-10-11.
This commit is contained in:
Paul Kimpel
parent
e75b74d632
commit
e6bd06eba0
@ -1,4 +1,4 @@
|
||||
BEGIN 00000490
|
||||
BEGIN 00000490
|
||||
% THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP
|
||||
% AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR
|
||||
% HELLMUT GOLDE. THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE
|
||||
@ -399,6 +399,7 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH);
|
||||
OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF;
|
||||
REAL GT1;
|
||||
LABEL MOREPAGES;
|
||||
COMMENT
|
||||
IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M); 00005620
|
||||
IF MODE=8 THEN NPAGES:=NPAGES+N;
|
||||
MOREPAGES:
|
||||
@ -688,7 +689,7 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH);
|
||||
END;
|
||||
COMMENT -- ASSIGN A FREE PAGE (SUBS T);
|
||||
T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1;
|
||||
|
||||
|
||||
PG:=INDX[T,P];
|
||||
FOR K:=T+1 STEP 1 UNTIL CURPAGE DO
|
||||
MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]);
|
||||
@ -896,7 +897,7 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH);
|
||||
END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0;
|
||||
IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER); 00010240
|
||||
END OF FILE UPDATE;
|
||||
%------- MODE=10 ------EEMERGENCY FILE MAINTENANCE -------
|
||||
%------- MODE=10 ------ EMERGENCY FILE MAINTENANCE -------
|
||||
DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1
|
||||
%------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ----------
|
||||
;COMMENT TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL;
|
||||
@ -1316,7 +1317,7 @@ DEFINE
|
||||
CAPHEADING=11:47:1#,
|
||||
APLCODE = STATIONPARAMS#,
|
||||
|
||||
|
||||
|
||||
SPECMODE = BOUNDARY.[1:3]#,
|
||||
DISPLAYIMG=1#,
|
||||
EDITING=2#,
|
||||
@ -1332,7 +1333,7 @@ DEFINE
|
||||
BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT
|
||||
INTEGER BUFFSIZE,ITEMCOUNT,RESULT,
|
||||
LOGINSIZE,
|
||||
%%%
|
||||
%%%
|
||||
ERR,
|
||||
NROWS,
|
||||
%%%
|
||||
@ -1510,7 +1511,7 @@ PROCEDURE INITIALIZETABLE;
|
||||
FILL IDTABLE[*] WITH
|
||||
"1+481-49", "1&501%07", "1.171@19", "1#411(08",
|
||||
"1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177,
|
||||
%CAST IN ABOVE LINE IS REALLY 3["]141"
|
||||
%LAST IN ABOVE LINE IS REALLY 3["]141"
|
||||
"202:=042", "[]101[11", "1]123AND", "212OR223",
|
||||
"NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05",
|
||||
"2GO051=2", "63MAX304", "CEIL303F", "LR313MIN",
|
||||
@ -1526,12 +1527,12 @@ PROCEDURE INITIALIZETABLE;
|
||||
IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST
|
||||
BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE
|
||||
END TO MARK THE END. TABSIZE IS THE DEFINE (LINE 30000) GIVING
|
||||
THE SIZE OF TDTABLE;
|
||||
THE SIZE OF IDTABLE;
|
||||
IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE
|
||||
IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022;
|
||||
BUFFSIZE:=MAXBUFFSIZE;
|
||||
LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT
|
||||
|
||||
|
||||
INITBUFF(OUTBUFF, 10);
|
||||
INITBUFF(BUFFER,BUFFSIZE);
|
||||
NROWS:=-1;
|
||||
@ -1565,7 +1566,7 @@ PROCEDURE INITIALIZETABLE;
|
||||
"4LIST ",
|
||||
"5DEBUG ",
|
||||
"5FILES ";
|
||||
|
||||
|
||||
IF LIBSIZE=-1 THEN
|
||||
BEGIN LIBSIZE~1;GTA[0]~" ";STOREORD(LIBRARY,GTA,0);WRAPUP;
|
||||
END ELSE BEGIN LIBSIZE~SIZE(LIBRARY);
|
||||
@ -1732,16 +1733,16 @@ PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC;
|
||||
IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2;
|
||||
IF CC GTR 1 AND CHRCOUNT GTR OTHEN TERPRINT;
|
||||
IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN
|
||||
|
||||
|
||||
BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT,
|
||||
0,WD,2,K:=L-CHRCOUNT);
|
||||
CHRCOUNT:=L; TERPRINT;
|
||||
|
||||
|
||||
I:=I-K;
|
||||
|
||||
|
||||
END;
|
||||
APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I);
|
||||
|
||||
|
||||
CHRCOUNT:=CHRCOUNT+I;
|
||||
IF BOOLEAN(CC) THEN
|
||||
IF CC=-1 THEN BEGIN LINETOG:=FALSE;
|
||||
@ -1750,13 +1751,13 @@ PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC;
|
||||
END;
|
||||
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);
|
||||
ARRAY SPECS[0]; REAL HADDR; FORWARD;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;
|
||||
COMMENT STARTS ON 8030000;
|
||||
FORWARD;
|
||||
|
||||
|
||||
PROCEDURE INDENT(R); VALUE R; REAL R;
|
||||
BEGIN
|
||||
INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I;
|
||||
@ -1791,7 +1792,7 @@ PROCEDURE INDENT(R); VALUE R; REAL R;
|
||||
END;
|
||||
IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0
|
||||
CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1
|
||||
|
||||
|
||||
END;
|
||||
INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2;
|
||||
INTEGER ADDR1, ADDR2; ARRAY BUF[0];
|
||||
@ -1839,9 +1840,9 @@ INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2;
|
||||
END OF PHONY HEADER;
|
||||
PROCEDURE STARTSCAN;
|
||||
BEGIN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
LADDRESS:=
|
||||
ADDRESS:=ABSOLUTEADDRESS;
|
||||
BEGIN TERPRINT;
|
||||
@ -1870,7 +1871,7 @@ PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL,
|
||||
BL:=0;
|
||||
END;
|
||||
APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N);
|
||||
|
||||
|
||||
CHRCOUNT:=CHRCOUNT+N+BL;
|
||||
IF BOOLEAN(CC) THEN
|
||||
IF CC=-1 THEN BEGIN LINETOG:=FALSE;
|
||||
@ -1880,7 +1881,7 @@ PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL,
|
||||
PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0];
|
||||
BEGIN FORMAT F(F24.*), G(E24.*);
|
||||
REAL S; DEFINE MAXIM = 10@9#;
|
||||
|
||||
|
||||
STREAM PROCEDURE ADJUST(A,B);
|
||||
BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI;
|
||||
DI:=LOC T; DI:=DI+1; T1:=DI;
|
||||
@ -1902,7 +1903,7 @@ PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0];
|
||||
TALLY:=TALLY+1; DS:=CHR
|
||||
END);
|
||||
SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY;
|
||||
|
||||
|
||||
TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0"
|
||||
THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY;
|
||||
SI:=T1; IF SC="1" THEN BEGIN
|
||||
@ -1911,19 +1912,317 @@ PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0];
|
||||
TALLY:=TALLY+4; MANT:=TALLY; END;
|
||||
SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR;
|
||||
END;
|
||||
IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN
|
||||
IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN
|
||||
WRITE(SCR[*],G,DIGITS,R) ELSE
|
||||
WRITE(SCR[*],F,DIGITS,R);
|
||||
ADJUST(A,SCR)
|
||||
END;
|
||||
...
|
||||
IF SCAN THEN 00501600 P25
|
||||
...
|
||||
INTEGER K; 03002210 P26
|
||||
...
|
||||
REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440 P27
|
||||
...
|
||||
BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550 P28
|
||||
WRITE(SCR[*],F,DIGITS,R);
|
||||
ADJUST(A,SCR)
|
||||
END;
|
||||
PROCEDURE STOREPSR;
|
||||
BEGIN INTEGER I;
|
||||
DELETE1(WORKSPACE,0);
|
||||
I:=STORESEQ(WORKSPACE,PSR,PSRSIZE|8);
|
||||
COMMENT USED TO CALL WRAPUP;
|
||||
END;
|
||||
PROCEDURE RESCANLINE;
|
||||
BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END;
|
||||
PROCEDURE PROCESS(MODE);VALUE MODE; INTEGER MODE; FORWARD;
|
||||
PROCEDURE MESSAGEHANDLER; FORWARD;
|
||||
PROCEDURE FUNCTIONHANDLER; FORWARD;
|
||||
PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R;
|
||||
INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000;
|
||||
STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R;
|
||||
BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1);
|
||||
DS:=L CHR;
|
||||
END;
|
||||
COMMENT: VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH
|
||||
CHARACTER OF A, RIGHT-ADJUSTED. L MUST BE LEQ 8 AND
|
||||
J MUST BE LESS THAT 64;
|
||||
REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L;
|
||||
BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1);
|
||||
DS:=L CHR;
|
||||
END;
|
||||
REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD;
|
||||
BEGIN
|
||||
INTEGER STREAM PROCEDURE CON(A); VALUE A;
|
||||
BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END;
|
||||
ARRAY A[0:1]; INTEGER I;
|
||||
I:=CONTENTS(ORD,SIZE(ORD)-1,A);
|
||||
TOPLINE:=CON(A[0])/10000
|
||||
END;
|
||||
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);
|
||||
ARRAY SPECS[0]; REAL HADDR;
|
||||
BEGIN
|
||||
LABEL A,B,C;
|
||||
INTEGER P;
|
||||
DEFINE NOTE=HADDR.[24:24]:=ADDRESS#,P8=8|P+1#;
|
||||
ERR:=0;
|
||||
SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0;
|
||||
NOTE; HADDR.[1:23]:=GT1:=ADDRESS;
|
||||
IF SCAN AND IDENT THEN
|
||||
BEGIN
|
||||
TRANSFER(ACCUM,2,SPECS,1,7);
|
||||
NOTE;
|
||||
IF SCAN THEN
|
||||
IF LFTARROW THEN
|
||||
BEGIN
|
||||
SPECS[1]:=1;
|
||||
SPECS[3]:=1;
|
||||
TRANSFER(SPECS,1,SPECS,33,7);
|
||||
GT2:=ADDRESS;
|
||||
IF SCAN AND IDENT THEN
|
||||
BEGIN
|
||||
TRANSFER(ACCUM,2,SPECS,1,7);
|
||||
NOTE;
|
||||
IF SCAN THEN 00501600
|
||||
C: IF IDENT THEN
|
||||
BEGIN
|
||||
P:=(SPECS[3]:=SPECS[3]+1)+3;
|
||||
TRANSFER(ACCUM,2,SPECS,P8,7);
|
||||
SPECS[2]:=1;
|
||||
NOTE;
|
||||
IF SCAN THEN IF IDENT THEN
|
||||
BEGIN SPECS[2]:=2;
|
||||
P:=(SPECS[3]:=SPECS[3]+1)+2;
|
||||
TRANSFER(SPECS,1,SPECS,P8+8,7);
|
||||
TRANSFER(SPECS,P8,SPECS,1,7);
|
||||
TRANSFER(ACCUM,2,SPECS,P8,7);
|
||||
|
||||
B: NOTE; IF SCAN THEN
|
||||
A: IF SEMICOLON THEN IF SCAN THEN
|
||||
IF IDENT THEN
|
||||
BEGIN
|
||||
P:=(SPECS[3]:=SPECS[3]+1)+3;
|
||||
TRANSFER(ACCUM,2,SPECS,P8,7);
|
||||
GO TO B;
|
||||
END ELSE GO TO A
|
||||
ELSE ELSE ELSE
|
||||
END ELSE GO TO A
|
||||
ELSE END
|
||||
ELSE GO TO A ELSE
|
||||
END ELSE ERRORMESS(ERR:=1,GT2,0)
|
||||
END ELSE GO TO C
|
||||
ELSE
|
||||
END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0);
|
||||
FUNCTIONHEADER:=ERR=0;
|
||||
ADDRESS:=HADDR.[24:24];
|
||||
END FUNCTIONHEADER;
|
||||
|
||||
INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD;
|
||||
COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH
|
||||
AT LEAST 3 WDS;
|
||||
PROCEDURE EDITLINE; FORWARD;
|
||||
INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0];
|
||||
FORWARD; COMMENT LINE 8007900;
|
||||
BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K;
|
||||
ARRAY L[0]; FORWARD; COMMENT LINE 8013910;
|
||||
|
||||
|
||||
PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD;
|
||||
COMMENT ON LINE 8040000;
|
||||
PROCEDURE RELEASEARRAY(D);VALUE D; REAL D;
|
||||
BEGIN COMMENT RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D;
|
||||
INTEGER K,J,PT;
|
||||
ARRAY BLOCK[0:32]; %SEE MAXWORDSTORE, LINE 17260
|
||||
ARRAY TEMP[0:1];
|
||||
IF D.RF NEQ 0 THEN
|
||||
BEGIN DELETE1(WS,D.DIMPTR);
|
||||
K:=CONTENTS(WS,D.INPTR,BLOCK)-1;
|
||||
DELETE1(WS,D,INPTR);
|
||||
FOR J:=0 STEP 2 UNTIL K DO
|
||||
BEGIN TRANSFER(BLOCK,J,TEMP,6,2);
|
||||
PT:=TEMP[0]; DELETE1(WS,PT); END;
|
||||
END;
|
||||
END;
|
||||
PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L;
|
||||
INTEGER DIR,N,M,L;
|
||||
ARRAY SP[0,0],B[0];
|
||||
BEGIN COMMENT
|
||||
DIR= INTO: TRANSFER N WORDS FROM B[L] INTO SP[M]
|
||||
(ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG)
|
||||
DIR= OUTOF (OPPOSITE);
|
||||
STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR,
|
||||
L,M,N;
|
||||
BEGIN LOCAL T;
|
||||
SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;
|
||||
SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI;
|
||||
SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR;
|
||||
SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI;
|
||||
SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR;
|
||||
SI:=LOC DIR; SI:=SI+7;
|
||||
IF SC="0" THEN
|
||||
BEGIN SI:=M; DI:=L
|
||||
END ELSE
|
||||
BEGIN SI:=L ; DI:=M
|
||||
END;
|
||||
T(2(DS:=32WDS)); DS:=N WDS;
|
||||
END;
|
||||
INTEGER K; 03002210
|
||||
WHILE N:=N-K GTR 0 DO
|
||||
MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*],
|
||||
M:=M+K,B,K:=L MOD SPRSIZE,
|
||||
K:=MIN(SPRSIZE-K,N))
|
||||
END;
|
||||
|
||||
PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0];
|
||||
BEGIN INTEGER L;
|
||||
LABEL SKIPREST;
|
||||
INTEGER I,N,M,U; REAL T;
|
||||
L:=PD.SPF;
|
||||
I:=SP[LOC]+L;
|
||||
FOR L:=L+2 STEP 1 UNTIL I DO
|
||||
IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN
|
||||
BEGIN % OUTPUT MESSAGE AND NAME
|
||||
FORMWD(2,"5FUNC: ");
|
||||
N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR
|
||||
N:=N-1; % BACK UP ONE TO GET NAME
|
||||
GTA[0]:=SP[NOC];
|
||||
FORMROW(1,1,GTA,1,7);
|
||||
END
|
||||
ELSE % MIGHT BE AN OPERATOR
|
||||
IF T.TYPEFIELD=OPERATOR THEN
|
||||
BEGIN COMMENT OUTPUT MESSAGE AND OP CODE;
|
||||
FORMWD(2,"5ATOR: ");
|
||||
NUMBERCON(T.OPTYPE,ACCUM);
|
||||
FORMROW(0,1,ACCUM,2,ACOUNT);
|
||||
NUMBERCON(T.LOCFIELD,ACCUM);
|
||||
FORMROW(1,1,ACCUM,2,ACOUNT);
|
||||
END ELSE %MAY BE A CONSTANT
|
||||
IF T.TYPEFIELD=CONSTANT THEN
|
||||
BEGIN COMMENT GET DATA DESCRIPTOR;
|
||||
N:=T.LOCFIELD;
|
||||
FORMWD(2,"5CONS: ");
|
||||
T:=SP[NOC]; %T HAS THE DATA DESCRIPTOR
|
||||
IF T.SPF=0 THEN BEGIN % A NULL VECTOR
|
||||
FORMWD(1,"4NULL ");
|
||||
GO TO SKIPREST; END;
|
||||
N:=T.SPF; %N HAS THE SCALAR OR TOP OF VECTOR LOC.
|
||||
IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE
|
||||
BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS
|
||||
END;
|
||||
IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT
|
||||
BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS;
|
||||
TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:=
|
||||
SP[NOC])-1)DIV 8+1));
|
||||
FORMROW(1,1,BUFFER,0,T);
|
||||
END ELSE % SHOULD TEST FOR NULL...DO IT LATER.
|
||||
FOR N:=M STEP 1 UNTIL U DO
|
||||
BEGIN NUMBERCON(SP[NOC],ACCUM);
|
||||
FORMROW(0,1,ACCUM,2,ACOUNT);
|
||||
END;
|
||||
TERPRINT;
|
||||
SKIPREST:
|
||||
END ELSE COMMENT MUST BE AN OPERAND;
|
||||
IF T.TYPEFIELD=LOCALVAR THEN
|
||||
BEGIN FORMWD(2,"5LOCL: ");
|
||||
N:=T.SPF; % N HAS LOCATION OF NAME;
|
||||
GTA[0]:=SP[NOC]; % PUT NAME IN GTA
|
||||
FORMROW(1,1,GTA,1,7);
|
||||
END ELSE
|
||||
BEGIN COMMENT TREAT IT AS VARIABLE;
|
||||
N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR;
|
||||
N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR;
|
||||
GTA[0]:=SP[NOC];
|
||||
FORMWD(2,"5AND : ");
|
||||
FORMROW(1,1,GTA,1,7);
|
||||
END;
|
||||
END;
|
||||
|
||||
PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE;
|
||||
BEGIN
|
||||
OWN INTEGER J;
|
||||
OWN REAL RESULTD;
|
||||
LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL;
|
||||
MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO;
|
||||
LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY.
|
||||
INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT);
|
||||
INTEGER LASTCONSTANT; FORWARD;
|
||||
INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH;
|
||||
INTEGER LENGTH; FORWARD;
|
||||
PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD;
|
||||
REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440
|
||||
INTEGER LASTCONSTANT; FORWARD;
|
||||
INTEGER PROCEDURE BUILDNULL(LASTCONSTANT);
|
||||
INTEGER LASTCONSTANT; FORWARD;
|
||||
PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD;
|
||||
COMMENT LINE 3121400;
|
||||
PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD;
|
||||
COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP
|
||||
IS ADDRESSED INCORRECTLY OTHERWISE;
|
||||
REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP;
|
||||
BEGIN COMMENT
|
||||
BC= BUILDCONSTANT,
|
||||
GS= GET SPACE PROCEDURE ;
|
||||
ARRAY INFIX[0:MAXPOLISH];
|
||||
|
||||
INTEGER LASTCONSTANT;
|
||||
DEFINE GS=GETSPACE#;
|
||||
BOOLEAN STREAM PROCEDURE EQUAL(A,B);
|
||||
BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2;
|
||||
IF 7SC=DC THEN TALLY:=1;
|
||||
EQUAL:=TALLY;
|
||||
END;
|
||||
PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2);
|
||||
VALUE N,CHR1,CHR2;
|
||||
INTEGER N,CHR1,CHR2,L,OTOP;
|
||||
ARRAY DEST[0,0],ORIG[0];
|
||||
BEGIN
|
||||
REAL T,U;
|
||||
WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO
|
||||
IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE
|
||||
U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK
|
||||
BEGIN
|
||||
IF N GTR 1 THEN
|
||||
IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE
|
||||
OTOP:=OTOP-1;
|
||||
N:=N-1;
|
||||
END ELSE
|
||||
COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION;
|
||||
|
||||
|
||||
BEGIN
|
||||
IF J NEQ 0 THEN
|
||||
BEGIN L:=L+1;
|
||||
DEST[LOC]:=ORIG[OTOP]
|
||||
END;
|
||||
OTOP:OTOP-1
|
||||
END;
|
||||
IF N GTR 1 THEN ERR:=SYNTAXERROR;
|
||||
END;
|
||||
INTEGER ITOP,K,L,I;
|
||||
INTEGER M,N,FLOC; REAL T;
|
||||
LABEL SKIPSCAN,FILLER;
|
||||
LABEL SPFULLAB;
|
||||
|
||||
|
||||
PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH;
|
||||
INTEGER L,LENGTH; ARRAY SP[0,0];
|
||||
BEGIN IF LENGTH GTR 0 THEN
|
||||
BEGIN SP[LOC]:=SP[0,0];
|
||||
SP[LOC].LEN:=LENGTH; SP[0,0]:=L
|
||||
END;
|
||||
END;
|
||||
|
||||
IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE
|
||||
|
||||
BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L;
|
||||
FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF
|
||||
|
||||
END;
|
||||
|
||||
T:=ADDRESS;
|
||||
ITOP:=0;
|
||||
DO
|
||||
SKIPSCAN:
|
||||
IF ITOP LSS MAXPOLISH THEN
|
||||
BEGIN
|
||||
INFIX[ITOP:=ITOP+1].ADDRFIELD:=T;
|
||||
IF SPECIAL THEN
|
||||
IF QUOTEV THEN % CONSTANT VECTOR
|
||||
BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT;
|
||||
IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN
|
||||
INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR
|
||||
END ELSE % ORDINARY OPERATOR
|
||||
BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550
|
||||
...
|
||||
UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR 03104040 P29
|
||||
...
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user