mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-01-19 01:06:45 +00:00
Commit initial piece B5500 APL source transcription (starting from the end) by Hans Pufal of Angouleme, France as of 2013-09-09. This transcription is from a photocopy of a listing donated by Ed Vandergriff of Chaska, Minnesota, US. Although this version of APL was written by Gary Kildall, et al, at the University of Washington in Seattle, Washington, US, according to Ed, this listing probably originated from the Georgia Institute of Technology (Georgia Tech) in Atlanta, Georgia, US.
This commit is contained in:
Paul Kimpel
parent
1df979558d
commit
7810b03f4d
893
source/APL/IMAGE.alg_m
Normal file
893
source/APL/IMAGE.alg_m
Normal file
@ -0,0 +1,893 @@
|
||||
M:=0; END; 08015888 P78
|
||||
END;
|
||||
END;
|
||||
MOVETWO(T,DIR,K,WR,L,DISK);
|
||||
END;
|
||||
EOB:=1;
|
||||
IF M GTR 0 THEN N:=WR(DISK,N,B);
|
||||
IF K GTR 0 THEN L:=WR(DISK,L,DIR);
|
||||
LOCK(DISK);
|
||||
END;
|
||||
BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B;
|
||||
BEGIN REAL T;
|
||||
A:=B:=GT1:=0;
|
||||
%
|
||||
%
|
||||
IF SCAN AND IDENT THEN
|
||||
BEGIN T?ACCUM[0]; T.[6:6]?"/";
|
||||
IF SCAN AND LOCKIT THEN GT1?1 ELSE IF IDENT THEN LIBNAMES?TRUE;
|
||||
A?T; B? JOBNUM;
|
||||
END
|
||||
ELSE LIBNAMES? TRUE;
|
||||
END;
|
||||
PROCEDURE MASSAGEHANDLER;
|
||||
BEGIN
|
||||
LABEL ERR1;
|
||||
%
|
||||
IF SCAN THEN IF IDENT THEN
|
||||
BEGIN INTEGER I; REAL R,S;
|
||||
PROCEDURE NOFILEPRESENT;
|
||||
BEGIN
|
||||
FILL BUFFER[*] WITH "FILE NOT", " ON DISK";
|
||||
FORMROW(3,0,BUFFER,0,16);
|
||||
END OF NOFILEPRESENT;
|
||||
PROCEDURE PRINTF(VARS); VALUE VARS; BOOLEAN VARS;
|
||||
BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG;
|
||||
INTEGER NUM;
|
||||
J:=VARSIZE-1; M:=VARIABLES;
|
||||
FOR I=0 STEP 1 UNTIL N DO
|
||||
BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1)
|
||||
=FUNCTION;
|
||||
IF NUM:=3?REAL(TOG AND VARS)+8+NUM GTR LINESIZE
|
||||
THEN BEGIN TERPRINT; NUM:=8?READL(TOG AND VARS)+8 END;
|
||||
IF VARS THEN
|
||||
BEGIN FORMROW(0,1,T,0,7); L:=L+1;
|
||||
IF TOG THEN FORMWRD(0,"3(F) "));
|
||||
END ELSE
|
||||
IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END;
|
||||
END;
|
||||
IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT
|
||||
END;
|
||||
R:=ACCUM[0];
|
||||
FOR I:=0 STEP 1 UNTIL MAXMESS DO
|
||||
IF R=MESSTAB[I] THEN
|
||||
BEGIN R:=I; I:=MAXMESS+1
|
||||
END;
|
||||
IF I=MAXMESS+2 THEN
|
||||
CASE R OF
|
||||
BEGIN
|
||||
% ------- SAVE -------
|
||||
IF NOT LIBNAMES(R,S) THEN
|
||||
IF NOT LIBRARIAN(R,S) THEN BEGIN
|
||||
SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES
|
||||
GTA[0]?GTA[1].>~.0;TRANSFER(R,1,GTA,1,7);
|
||||
IF(GT1?SEARCHORD(LIBRARY,GTA, I, 7)) NEQ 0 THEN
|
||||
BEGIN GTA[0]?GTA[1]?0;TRANSFER(R,1,GTA,1,7);
|
||||
STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1));
|
||||
END; LIBSIZE?LIBSIZE+1;
|
||||
END
|
||||
ELSE
|
||||
BEGIN
|
||||
FILL BUFFER[*] WITH "FILE ALR","EADY ON ",
|
||||
"DISK ";
|
||||
FORMROW(3,0,BUFFER,0,20);
|
||||
END
|
||||
ELSE GO ERR1;
|
||||
% ------- LOAD -------
|
||||
IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN
|
||||
IF LIBRARIAN(R,S) THEN
|
||||
BEGIN ARRAYA[0:1];
|
||||
LOADWORKSPACE(R,S,A);
|
||||
END
|
||||
ELSE NOFILEPRESENT
|
||||
ELSE GO ERR1; 0801626? P79
|
||||
% ------- DROP -------
|
||||
IF CURRENTMODE=CALCMODE THEN
|
||||
IF NOT LIBNAME(R,S) THEN
|
||||
IF LIBRARIAN(R,S) THEN
|
||||
BEGIN FILE ELIF DISK (1,1);
|
||||
FILL ELIF WITH R,S; WRITE(ELIF[0]);
|
||||
CLOSE(ELIF,PURGE)
|
||||
;GTA[0]?GTA[1]?0;TRANSFER(R,1,GTA,1,7);
|
||||
IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I);
|
||||
LIBSIZE?LIBSIZE-1;
|
||||
END
|
||||
ELSE NOFILEPRESENT
|
||||
ELSE
|
||||
IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE)
|
||||
ELSE GO ERR1 ELSE GO ERR1;
|
||||
% ------- COPY -------
|
||||
IF LIBNAMES(R,S) THEN
|
||||
IF LIBRARIAN(R,S) THEN
|
||||
LOADWORKSPCE(R,S,ACCUM)
|
||||
ELSE NOFILEPRESENT
|
||||
ELSE GO ERR1;
|
||||
|
||||
% -------- VARS -------
|
||||
PRINTID(TRUE);
|
||||
%------- FNS -------
|
||||
PRINTID(FALSE);
|
||||
%-------- LOGGED ----------------
|
||||
;
|
||||
%-------- MSG --------
|
||||
ERRORMESS(SYNTAXERROR,LADDRESS,0);
|
||||
%-----WIDTH (INTEGER) ---------------------------
|
||||
IF NOT SCAN THEN BEGIN NUMBERCON(LINSIZE, ACCUM);
|
||||
FORMROW(3,0,ACCUM,2,ACOUNT); END
|
||||
ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72
|
||||
THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR;
|
||||
END
|
||||
%IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO
|
||||
%AND WE"LL GET AN ERROR ANYWAY
|
||||
ELSE GO TO ERR1;
|
||||
%-------- OPR --------
|
||||
;
|
||||
%------DIGITS (INTEGER) ------------------------
|
||||
IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM);
|
||||
FORMROW(3,0,ACCUM,2,ACOUNT); END
|
||||
ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12
|
||||
AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END
|
||||
ELSE GO TO ERR1;
|
||||
%-------- OFF --------
|
||||
BEGIN
|
||||
IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN
|
||||
ELTMWORKSPACE(WORKSPACE) ELSE
|
||||
GO TO ERR1;
|
||||
FILL ACCUM[*] WITH "END OF R","UN ";
|
||||
FORMROW(3,MARGINSIZE,ACCUM,0,10);
|
||||
CURRENTMODE=CALCMODE;
|
||||
GT1:=CSTATION;
|
||||
CSTATION:=GT1&0[CAPLOGGED]
|
||||
;GO TO FINIS;
|
||||
END;
|
||||
%--------ORIGIN----------------------------------
|
||||
IF NO SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM);
|
||||
FORMROW(3,0,ACCUM,2,ACOUNT) END
|
||||
ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:=
|
||||
I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1;
|
||||
%--------SEED---------------------------------
|
||||
IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM);
|
||||
FORMROW(3,0,ACCUM,2,ACOUNT) END
|
||||
ELSE IF NUMERIC AND ERR=0 THEN BEGIN
|
||||
SEED:=ABS(I:=ACCUM[0]);
|
||||
STOREPSR END ELSE GO TO ERR1;
|
||||
%--------FUZZ------------------------------------
|
||||
IF NOT SCAN THEN BEGIN
|
||||
NUMBERCRON(FUZZ,ACCUM);
|
||||
FORMROW(3,0,ACCUM,2,ACOUNT) END
|
||||
ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]);
|
||||
SIDREPSR END ELSE GO TO ERR1;
|
||||
%------- SYN, NOSYN-------------------------------------
|
||||
NOSYNTAX:=0; NOSYNTAX:=1;
|
||||
%-----------------STORE-------------------------
|
||||
IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK);
|
||||
08017970 P80
|
||||
%-----------------ABORT-------------------------
|
||||
BEGIN IF BOOLEAN(SUSPENSION) THEN
|
||||
SP[0,0]:=0; NROWS:=-1;
|
||||
%%%
|
||||
SUSPENSION:=0;
|
||||
STOREPSR;
|
||||
END;
|
||||
%-----------------SI------------------------------
|
||||
IF BOOLEAN(SUSPENSION) THEN
|
||||
BEGIN GT1:=0;
|
||||
PROCESS(LOOKATSTACK);
|
||||
END ELSE FORMWD(3,"6 NULL.");
|
||||
%------------------SIV------------------------------
|
||||
IF BOOLEAN(SUSPENSION) THEN
|
||||
BEGIN GIT1:=1;
|
||||
PROCESS(LOOKATSTACK);
|
||||
END ELSE FORMWD(3,"6 NULL.");
|
||||
%------------------ERASE------------------------------
|
||||
IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1;
|
||||
ELSE WHILE SCAN AND IDENT DO
|
||||
BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM
|
||||
TRANSFER(ACCUM,2,GTA,0,7);
|
||||
IF (IF VARIABLES=0 THEN FALSE ELSE
|
||||
SEARCHWORD(VARIABLES,GTA,GT1,7)=0) THEN
|
||||
BEGIN % FOUND SYMBOL TABLE ENTRY MATCHING NAME
|
||||
DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOL TABLE
|
||||
IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;
|
||||
COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED;
|
||||
|
||||
% CHECK IF THERE ARE MORE TO DELETE
|
||||
IF GT1:=GETFILED(GTA,7,1)=FUNCTION THEN
|
||||
BEGIN
|
||||
RELEASEUNIT(GETFIELD(GTA,FPTF,FFL));
|
||||
RELEASEUNIT(GETFILED(GTA,FSQF,FFL));
|
||||
END
|
||||
ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY
|
||||
RELEASEARRAY(GTA[1]);
|
||||
END ELSE % THERE IS NO SUCH VARIABLE
|
||||
ERRORMESS(LABELERROR,LADDRESS,0);
|
||||
END; % OF TAKING CARE OF ERASE
|
||||
%------------ ASSIGN --------------------------------
|
||||
;
|
||||
%------------ DELETE ---------------------------------
|
||||
;
|
||||
%------------- LIST ------------------------------------
|
||||
;
|
||||
% -------------DEGUG --------------------------------
|
||||
IF SCAN AND IDENT THEN
|
||||
IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1);
|
||||
|
||||
%----------------------------- FILES ----------------------
|
||||
IF LIBSIZE>1 THEN
|
||||
BEGIN FOR I?1 STEP 1 UNTIL LINSIZE-1 DO
|
||||
BEGIN R?CONTENTS(LIBRARY,I ,ACCUM);
|
||||
FORMROW(0,1,ACCUM,2,6);
|
||||
END; TERPRINT;
|
||||
END ELSE FORMWD(3,"6 NULL.");
|
||||
%------------------------ END OF CASES -----------------------
|
||||
END ELSE GO TO ERR1;
|
||||
IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE);
|
||||
END ELSE
|
||||
IF QUOTE THEN EDITLINE ELSE
|
||||
ERR1: ERRORMESS(SYNTAXERROR,0,0);
|
||||
INDENT(0);
|
||||
TERPRINT;
|
||||
END;
|
||||
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;
|
||||
BEGIN
|
||||
REAL STREAM PROCEDURE CON(R); VALUE R;
|
||||
BEGIN SI:=LOC R; DI:=LOC CON; DS:=DEC
|
||||
END;
|
||||
LINENUMBER:=CON(ENTIER(R+.00005)?10000))
|
||||
END;
|
||||
DEFINE DELIM="""#, ENDCHR="$"#;
|
||||
BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);
|
||||
VALUE COMAMND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD;
|
||||
ARRAY OLD, NEWEDIT; BEGIN
|
||||
BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD);
|
||||
VALUE COMMAND,CHAR.WORD;
|
||||
BEGIN
|
||||
LOCAL OLDLINE,NEWLINE,F,BCHR;
|
||||
LOCAL N,M,T;
|
||||
LOCAL X,Y,Z; 080301? P81
|
||||
LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH,
|
||||
OVER;
|
||||
DI:=NEW; WORD(DS:=BLIT" ");
|
||||
SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR;
|
||||
SI:=COMMAND;
|
||||
TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY;
|
||||
TALLY:=0;
|
||||
IF SC?"?" THEN
|
||||
BEGIN RCHR:=SI; SI:=OLD; OLDLINE:=SI;
|
||||
DI:=NEW; NEWLINE:=DI; SI:=RCHR;
|
||||
63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY
|
||||
:=TALLY+1); N:=TALLY;
|
||||
IF TOGGLE THEN
|
||||
BEGIN
|
||||
SI:=SI+1; TALLY:=0;
|
||||
63(IF SC=DELIM THEN TALLY:=0 ELSE
|
||||
IF SC="?" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1);
|
||||
IF TOGGLE THEN M:=TALLY;;
|
||||
DI:=OLDLINE; SI:=RCHR;
|
||||
2( X( Y( Z( CI:=CI+F;
|
||||
GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH;
|
||||
LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING*************
|
||||
IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ;
|
||||
DI:=NEWLINE; GO BETWEEN END ELSE
|
||||
IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI;
|
||||
DI:=NELINE; SI:=BCHR; TALLY:=1; F:=TALLY;
|
||||
GO FOUND END ELSE
|
||||
BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWJLINE:=DI;
|
||||
OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE;
|
||||
END; GO OVER;
|
||||
FOUND: %**************FOUND THE FIRST UNIQUE STRING *****************
|
||||
IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2;
|
||||
F:=TALLY; GO BETWEEN END ELSE
|
||||
DS:=CHR; GO OVER;
|
||||
BETWEEN: % ********** BETWEEN THEN // ********************************
|
||||
IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE;
|
||||
TALLY:=3; F:=TALLY; GO TAIL END ELSE
|
||||
IF SC="?" THEN BEGIN TALLY:=4; F:=TALLY;
|
||||
SI:=OLDLINE; GO FINWISH END ELSE
|
||||
DS:=CHR; GO OVER;
|
||||
TAIL: % ******* THE TAIL END OF THE COMMAND **************************
|
||||
IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4;
|
||||
F:=TALLY; GO FINISH END ELSE
|
||||
BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END;
|
||||
GO OVER;
|
||||
FINISH: % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW************
|
||||
DS:=CHR; OVER:)));
|
||||
TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY;
|
||||
Z:=TALLY);
|
||||
SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1;
|
||||
WITHINLINE:=TALLY;
|
||||
END
|
||||
END
|
||||
END OF WITHINALINE;
|
||||
WITHINALINE := WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);
|
||||
END OF PHONY WITHINALINE;
|
||||
PROCEDURE EDITLINE;
|
||||
BEGIN ARRAY T[0:MAXBUFFSIZE];
|
||||
INITBUFF(T,BUFFSIZE);
|
||||
TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE));
|
||||
IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE?8,BUFFSIZE) THEN
|
||||
BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER);
|
||||
|
||||
IF SCAN AND RGTPAREN THEN
|
||||
ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1;
|
||||
END;
|
||||
|
||||
FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE));
|
||||
END;
|
||||
PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC;
|
||||
BEGIN
|
||||
INTEGER I,J;
|
||||
I:=L?10000 MOD 10000;
|
||||
FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO
|
||||
I:=I/10;
|
||||
INC:=10*J;
|
||||
SEQ:=L;
|
||||
END;
|
||||
PROCEDURE FUNCTIONHANDLER;
|
||||
BEGIN
|
||||
LABEL ENDHANDLER;
|
||||
OWN BOOLEAN EDITMODE; 09003000 P82
|
||||
DEFINE FPT=FUNCPOINTER@,
|
||||
FSQ=FUNCSEQ#,
|
||||
SEQ=CURLINE#,
|
||||
INC=INCREMENT#,
|
||||
MODE=SPECMODE#,
|
||||
ENDDEFINES=#;
|
||||
INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR;
|
||||
BEGIN LABEL L,FINIS;
|
||||
LOCAL Q;
|
||||
DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET;
|
||||
% LEFT-ARROW / QUESTION MARK
|
||||
SI:=ADDR;
|
||||
L: DI:=LOCQ;
|
||||
IF SC=DELCHR THEN
|
||||
BEGIN ADDR:=SI; SI:=LOC; DS:=ADDR; DS:=LIT" ";
|
||||
TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS;
|
||||
END;
|
||||
IF SC=DC THEN GO TO FINIS; SI:=SI-1;
|
||||
IF SC=DC THEN GO TO FINIS;
|
||||
GO TO SL;
|
||||
FINIS:
|
||||
END;
|
||||
INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S;
|
||||
INTEGER PT, REAL S;
|
||||
IF PT NEQ 0 THEN
|
||||
BEGIN INTEGER K; ARRAY L[0:1];
|
||||
ADDRESS:=ABSOLUTEADDRESS;
|
||||
WHILE LABELSCAN(L,0) AND ERR EQL 0 DO
|
||||
IF SEARCHORD(PT,L,K,8)=0 THEN
|
||||
IF L[1] NEQ S THEN ERR:=24;
|
||||
OLLABELCONFLICT:=ERR
|
||||
END;
|
||||
INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT,
|
||||
SQ,L; FORWARD;
|
||||
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;
|
||||
INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD;
|
||||
PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,
|
||||
ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];
|
||||
FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T
|
||||
DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER);
|
||||
PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K;
|
||||
INTEGER PT,SQ,I,K;
|
||||
BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE];
|
||||
STREAM PROCEDURE BL(A);
|
||||
BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END;
|
||||
DEFINE MOVE=MOVEWDS#;
|
||||
REAL T,SEQ; INTEGER A,B,L,H;
|
||||
T:=ADDRESS;
|
||||
FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO
|
||||
BEGIN B:=CONTENTS(PT,A,C); BL(OLD);
|
||||
SEQ:=C[0];
|
||||
B:=CONTENTS(SQ,C[1],OLD);
|
||||
IF EDITMODE:=WITHINALINE(T,OLD,NEW,BUFFSIZE?8,BUFFSIZE)
|
||||
THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW);
|
||||
MOVE(OLD,MAXBUFFSIZE,BUFFER);
|
||||
IF EDITMODE:=ERR:=OLDLABELCONFICT(PT,C[0])=0 THEN
|
||||
BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]);
|
||||
DELTOG:=DELPRESENT(ADDRESS);
|
||||
DELETE1(SQ,C[1]); DELET1(PT,A+B); C[1]:=
|
||||
STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE));
|
||||
STOREORD(PT,C,A+B);
|
||||
RESCANLINE; L:=0; M:=1; LAB[1]L=C[0];
|
||||
WHILE LABELSCAN(C,0) DO
|
||||
BEGIN MOVEWDS(C,1,LAB);
|
||||
IF (IF FUNCSSIZE=0 THEN TRUE ELSE L:=
|
||||
SEARCHWROD(PT,C,M,B)NEQ 0) THEN
|
||||
BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1;
|
||||
STOREORD(PT,ALAR,L+M-1);
|
||||
END END;
|
||||
A:=A+B; K:=K+B;
|
||||
COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT
|
||||
IF NOSYTNATX=0 THE PROCESS(XEQUTE);
|
||||
END END;
|
||||
MOVE(NEW,MAXBUFFSIZE+1,BUFFER)
|
||||
END END;
|
||||
PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I;
|
||||
BEGIN
|
||||
GT1:=CONTENTS(PT,I,GTA);
|
||||
INDENT(GTA[0]);
|
||||
GT1:=CONTENTS(SQ,GTA[1],BUFFER);
|
||||
CHRCOUNT:=CHRCOUNT-1;
|
||||
FORMROW(1,0,BUFFER,0,GT1);
|
||||
END; 090528?? P83
|
||||
INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ;
|
||||
INTEGER PT,SQ; REAL A,B;
|
||||
IF A LEQ B AND FUNCSIZE NEQ 0 THEN
|
||||
BEGIN
|
||||
ARRAY C[0:1];
|
||||
INTEGER I,J,K;
|
||||
DEFINE CLEANBUFFER=BUFFERCLEAN#;
|
||||
A:=LINENUMBER(A); B:=LINENUMBER(B);
|
||||
C[0]:=A;
|
||||
I:=SEARCHORD(PT,C,K,8);
|
||||
I:=( IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE
|
||||
K ELSE K);
|
||||
IF A NEQ B THEN
|
||||
BEGIN
|
||||
C[0]:=B; B:=SEARCHORD(PT,C,K,8);
|
||||
END;
|
||||
IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT
|
||||
IF I=K THEN
|
||||
IF A NEQ 0 THEN %NOT EDITING THE HEADER
|
||||
EDITDRIVER(PT,SQ,I,K);
|
||||
ELSE %EDITING THE FUNCTION HEADER, FIX LATER.
|
||||
ERR:=3;
|
||||
ELSE %EDITING MORE THAN ONE LINE
|
||||
BEGIN MODE:=EDITING;
|
||||
IF A=0 THEN I:=I+1;
|
||||
CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS);
|
||||
MOVE(BUFFER,BUFFSIZE,OLDBUFFER);
|
||||
LOWER:=I; UPPER:=K
|
||||
END
|
||||
ELSE %NOT EDITING, MUST BE A LIST
|
||||
BEGIN
|
||||
FORMWD(3,"1 ");
|
||||
IF K=I THEN % LISTING A SINGLE LINE
|
||||
BEGIN LISTLINE(PT,SQ,I);
|
||||
FORMWD(3,"1 ");
|
||||
END ELSE % LISTING A SET OF LINES
|
||||
BEGIN MODE:=DISPLAYING;
|
||||
LOWER:=I; UPPER:=K;
|
||||
END;
|
||||
END;
|
||||
EOB:=1;
|
||||
END ELSE DISPLAY:=20;
|
||||
INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B;
|
||||
INTEGER PT,SQ; REAL A,B;
|
||||
IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ Q THEN
|
||||
BEGIN
|
||||
INTEGER I,J,K,L;
|
||||
ARRAY C[0:1];
|
||||
A:=LINENUMBER(B);
|
||||
B:=LINENUMBER(B);
|
||||
C[0]:=A;
|
||||
IF SEARCHOR(PT,C,I,8)=1 THEN I:=I-1;
|
||||
IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE
|
||||
BEGIN
|
||||
FOR J:=K STEP 1 UNTIL I DO
|
||||
BEGIN A:=CONTENTS(PT,J,C);
|
||||
L:=ELIMOLDLINE(PT,SQ,C[1]);
|
||||
FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L;
|
||||
DELETE1(SQ,C[1])
|
||||
END;
|
||||
FUNCSIZE:=FUNCSIZE-(I-K+1)
|
||||
; EOF:=1;
|
||||
DELETEN(PT,K,I);
|
||||
IF FUNCSIZE=0 THEN
|
||||
BEGIN
|
||||
PT:=0; RESEASEUNIT(SQ); SQ:=0;
|
||||
STOREPSR;
|
||||
END;
|
||||
END;
|
||||
END ELSE DELETE:=22;
|
||||
INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L;
|
||||
INTEGER PT,SQ,L;
|
||||
BEGIN INTEGER K,J;
|
||||
REAL AD;
|
||||
ARRAY T[0:MAXBUFFERSIZE],LAB[0:1];
|
||||
AD:=ADDRESS;
|
||||
MOVEWDS(BUFFER,MAXBUFFSIZE+1,T);
|
||||
INITBUFF(BUFFER,BUFFSIZE);
|
||||
K:=CONTENTS(SQ,L,BUFFER);
|
||||
RESCANLINE;
|
||||
WHILE LABELSCAN(LAB,0) DO 091240?? P84
|
||||
IF SEARCHORD(PT,LAB,K,8)=0 THEN
|
||||
BEGIN DELETE1(PT,K); J:=J-1 END;
|
||||
ADDRESS:=AD;
|
||||
MOVEWDS(T,MAXBUFFSIZE+1,BUFFER);
|
||||
ELIMOLDLINE:=J
|
||||
END;
|
||||
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;
|
||||
INTEGER PT,SQ; REAL SEQ; ARRAY B[0]
|
||||
BEGIN DEFINE BUFFER=B#;
|
||||
ARRAY C,LAB[0:1];
|
||||
INTEGER I,J,K,L;
|
||||
BOOLEAN TOG;
|
||||
SEQ:=LINENUMBER(SEQ);
|
||||
C[0]:=SEQ;
|
||||
IF TOG:=(PT=0 OR FUNCSIZE=0) THEN
|
||||
BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0
|
||||
END ELSE
|
||||
IF J:=SEARCHORD(PT,C,I,8)=0 THEN
|
||||
BEGIN
|
||||
K:=ELIMOLDLINE(PT,SQ,C[1]);
|
||||
I:=J+K; FUNCSIZE:=FUNCSIZE+K;
|
||||
DELETE1(PT,T);
|
||||
FUNCSIZE:=FUNCSIZE-1;
|
||||
DELETE1(SQ,C[1]);
|
||||
END ELSE
|
||||
I:=I+J-1;
|
||||
RESCANLINE;
|
||||
DELTOG:=DELPRESENT(ADDRESS);
|
||||
K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE));
|
||||
LAB[1]:=SEQ; L:=0; J:=1;
|
||||
IF TOG THEN PT:=NEXTUNIT;
|
||||
WHILE LABELSCAN(C,0) DO
|
||||
BEGIN
|
||||
MOVEWDS(C,1,LAB);
|
||||
IF (IF FUNCSIZE=0 THEN TRUE ELSE L:=
|
||||
SEARCHORD(PT,C,J,8)NEQ 0 ) THEN
|
||||
BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1;
|
||||
STOREORD(PT,LAB,L+J-1);
|
||||
END;
|
||||
END;
|
||||
C[1]:=K;
|
||||
C[0]:=SEQ;
|
||||
FUNCSIZE:=FUNCSIZE+1;
|
||||
STQOREORD(PT,C,I);
|
||||
IF TOG THEN STOREPSR;
|
||||
EOD:=1;
|
||||
END;
|
||||
BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT;
|
||||
IF NOT(BOUND:=NUMERIC) THEN
|
||||
IF INDENT AND FUNCSIZE GTR 0 THEN
|
||||
BEGIN ARRAY L[0:1]; INTEGER K;
|
||||
REAL T,U;
|
||||
REAL STREAM PROCEDURE CON(A);
|
||||
VALUE A;
|
||||
BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT
|
||||
END;
|
||||
TRANSFER(ACCUM,2,L,1,7);
|
||||
IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN
|
||||
BEGIN T:=ADDRESS;
|
||||
U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG
|
||||
IF SCAN AND PLUS OR MINUS THEN
|
||||
BEGIN K:=(IF PLUS THEN 1 ELSE -1);
|
||||
IF SCAN AND NUMERIC THEN
|
||||
ACCUM[0]:=MAX(U+K?ACCUM[0],0) ELSE
|
||||
BEGIN ACCUM[0]:=U;
|
||||
ADDRESS:=T;
|
||||
END;
|
||||
END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T;
|
||||
END;
|
||||
EOB:=0;
|
||||
END;
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE FINISHUP;
|
||||
BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE;
|
||||
IF FUNCPOINTER=0 THEN % HE DELETED EVERYTHING
|
||||
BEGIN TRANSFER(PSR,FSTART?8,GTA,0,8);
|
||||
IF SEARCHORD(VARIABSLES,GTA,GT1,7)=0 THEN
|
||||
BEGIN DELETE1(VARIABLES,GT1);
|
||||
IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;
|
||||
END ELSE SPOUT(9198260);
|
||||
END; 09198270 P85
|
||||
DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0;
|
||||
STOREPSR;
|
||||
END;
|
||||
|
||||
LABEL SHORTCUT;
|
||||
REAL L,U,TADD;
|
||||
STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);
|
||||
VALUE BUFFSIZE,ADDR;
|
||||
BEGIN LABEL L; LOCAL T,U,TSI,TDI;
|
||||
SI:=ADDR; SI:=SI-1; L:
|
||||
IF SC NEQ "]" THEN
|
||||
BEGIN SI:=SI-1; GO TO L END;
|
||||
SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET;
|
||||
DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI;
|
||||
BUFFSIZE(8(IF TOGGKLE THEN DS:=LIT" " ELSE
|
||||
IF SC=DC THEN
|
||||
BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" "
|
||||
END ELSE
|
||||
BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR;
|
||||
DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T;
|
||||
SI:=TSI;
|
||||
END))
|
||||
END;
|
||||
PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,
|
||||
ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];
|
||||
CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);
|
||||
COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE;
|
||||
ERR:=0;
|
||||
IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER;
|
||||
BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////
|
||||
IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER.
|
||||
BEGIN ARRAY A[0:MAXHEADERSARGS];
|
||||
LABEL HEADERSTORE,FORGETITFELLA;
|
||||
IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK
|
||||
IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION
|
||||
BEGIN COMMENT GET THE FUNCTION NAME;
|
||||
TRANSFER(A,1,GTA,0,7);
|
||||
IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN
|
||||
COMMENT RE-DEFINING A FUNCTION. MAKE SURE NULL ;
|
||||
IF GETFIELD(GTA,7,1)==FUNCTIUON AND
|
||||
(A[1]+A[2]+A[3])=0 THEN %NULL HEADER--OK
|
||||
%--------------------SET UP FOR CONTINUATION OF DEFINITION------
|
||||
BEGIN
|
||||
FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL);
|
||||
FUNCSEQ:=GETFIELD(GTA,FSQF,FFL);
|
||||
GT3:=CURLINE:=TOPLINE(FPT);
|
||||
CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT
|
||||
COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE
|
||||
FUNCTION;
|
||||
FUNCSIZE:=SIZE(FPT);
|
||||
CURLINE:=CURLINE+INC;
|
||||
DELTOG:=DELPRESENT(ADDRESS);
|
||||
END ELSE
|
||||
%------------------REDEFINING THE HEADER OF A DEFINED FUNCTION----
|
||||
GO TO FORGETITFELLA
|
||||
ELSE
|
||||
%--------------------NAME NOT FOUND IN DIRECTWORY, SET UP
|
||||
HEADERSTORE:
|
||||
BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0;
|
||||
ARRAY OLDBUFFER[0:MAXBUFFSIZE];
|
||||
INTEGER L,U,F,K,J;
|
||||
INTEGER A1,A2;
|
||||
COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE
|
||||
FOLLOWING VALUES:
|
||||
A[0] = FUNCTION NAME , I.E., 0AAAAAAA
|
||||
A[1] = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE
|
||||
FUNCTION.
|
||||
A[2] = NUMBER OF ARGUMENTS TO THE FUNCTION.
|
||||
A[3] = NUMBER OF LOCALS + RESULT +ARGUMENTS.
|
||||
A[4]....A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS.
|
||||
THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN
|
||||
THE FIRST ARGUMENT, FOLL7OWED BY THE LOCALS. ALL
|
||||
ARE OF THE FORM 0XXXXXXX;
|
||||
U:=(A1:=A[1])+(A2:=A[2])+3;
|
||||
FOR L:=4 STEP 1 UNTIL 0 DO %LOOK FOR DUPLICATES AMONG
|
||||
FOR K:=L+1 STEP 1 UNTIL 0 DO %THE RESULT/ARGUMENT SET
|
||||
IF A[L]=A[K] THEN GO TO FORGETITFELLA;
|
||||
SEQUENTIAL(FUNCSEQ:=NEXTUNIT);
|
||||
SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER,
|
||||
HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER)));
|
||||
SETFILED(GTA,0,8,0);
|
||||
STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0);
|
||||
SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); 09229004 P86
|
||||
FOR L:=4 STEP 1 UNTIL U DO
|
||||
BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN
|
||||
BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1
|
||||
STOREORD(F,GTA,0);
|
||||
END ELSE %LOOKING AT THE ARGUMENTS
|
||||
BEGIN K:=SEARCHORD(F,GTA,J,8);
|
||||
GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L];
|
||||
STOREORD(F,GTA,J+K-1);
|
||||
END END;
|
||||
FUNCSIZE:=U:=U-2; U:=A[3]-U+L;
|
||||
FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE
|
||||
BEGIN GTA[0]:=A[L];
|
||||
IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE.
|
||||
BEGIN GTA[0]:=A[L]; GTA[1]:=0;
|
||||
STOREORD(F,GTA,J+K-1);
|
||||
FUNCSIZE:=FUNCSIZE+1
|
||||
END;
|
||||
END;
|
||||
GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS];
|
||||
CURLINE:=INCREMENT:=1;
|
||||
DELTOG:=0;
|
||||
COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE
|
||||
IS A PLACE FOR IT. THE TYPE IS EITHER 1 (FUNCTION CALL), OR
|
||||
0 (SUBROUTINE CALL);
|
||||
END;
|
||||
%--------------------------------------------------------
|
||||
END ELSE % VARIABLES=0, MAKE UP A DIRECTORY
|
||||
BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE
|
||||
END
|
||||
ELSE % HEADER SYNTAX IS BAD
|
||||
GO TO ENDHANDLER;
|
||||
COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE;
|
||||
IF GT2 NEQ 0 THEN %NME NOT FOUND IN DIRECTORY;
|
||||
BEGIN
|
||||
TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME
|
||||
SETFIELD(GTA,7,1,FUNCTION);
|
||||
SETFIELD(GTA,FPTF,FFL,FUNCPOINTER);
|
||||
SETFIELD(GTA,FSQF,FFL,FUNCSEQ);
|
||||
IF VARIABLES=0 THEN
|
||||
VARIABLE:=NEXTUNIT;
|
||||
STOREORD(VARIABLES,GTA,GT3+GT2-1);
|
||||
VARSIZE:=VARSIZE+1;
|
||||
END;
|
||||
CURRENTMODE:=FUNCMODE;
|
||||
TRANSFER(GTA,0,PSR,FSTART?8,8);
|
||||
STOREPSR;
|
||||
IF SCAN THEN GO TO SHORTCUT;
|
||||
IF FALSE THEN
|
||||
FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0);
|
||||
END ELSE % WE ARE IN FUNCTION DEFINITION MODE
|
||||
IF GT1:=MODE NEQ 0 THEN % A SPECIAL FUNCTION SUCH AS DISPLAY OR EDIT
|
||||
BEGIN L:=LOWER;
|
||||
IF GT1=DISPLAYING THEN
|
||||
LISTLINE(FPT,FSQ,L) ELSE
|
||||
IF GT1=EDITING THEN
|
||||
BEGIN INITBUFF(BUFFER,BUFFSIZE);
|
||||
MOVE(OLDBUFFER,BUFFSIZE,BUFFER);
|
||||
EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS;
|
||||
EDITDRIVER(FP1,FSQ,L,L)
|
||||
;IF NOT EDITMODE THEN
|
||||
BEGIN MODE:=0; ERR:=30
|
||||
END;
|
||||
END ELSE
|
||||
IF GT1=RESEQUENCING THEN
|
||||
IF GT1:=L LEQ UPPER THEN
|
||||
BEGIN GT2:=CONTENTS(FPT,L,GTA);
|
||||
GT3:=GTA[0]:=LINENUMBER(CURLINE);
|
||||
DELETE1(FPT,L);
|
||||
STOREORD(FPT,GTA,L);
|
||||
CURLINE:=CURLINE+INCREMENT;
|
||||
GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE;
|
||||
WHILE (IF ERR NEQ 0 THEN FALSE ELSE
|
||||
LABELSCAN(GTA,0)) FO
|
||||
IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN
|
||||
BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2);
|
||||
STOREORD(FPT,GTA,GT2)
|
||||
END ELSE ERR:=16
|
||||
END
|
||||
ELSE MODE:=0;
|
||||
LOWER:=L+1;
|
||||
IF LOWER GTR UPPER THEN
|
||||
BEGIN IF MODE=DISPLAYING THEN
|
||||
FORMWD(3,"1 "); 092314?? P87
|
||||
MODE:=0;
|
||||
END;
|
||||
O TO ENDHANDLER
|
||||
END;
|
||||
END ; % OF BLOCK STARTED EON LINE 9225115 //////////////////
|
||||
|
||||
|
||||
IF ERR=0 AND EOB=0 THEN
|
||||
|
||||
SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %//////////////////////////
|
||||
IF DEDLV THEN FINISHUP ELSE
|
||||
IF LFTBRACKET THEN
|
||||
BEGIN
|
||||
IF SCAN THEN
|
||||
IF DOUND(FPT) THEN
|
||||
BEGIN L:=ACCUM[0];
|
||||
IF SCAN THEN
|
||||
IF QUDV OR EDITMWODE:=(QUOTEQUAD) THEN
|
||||
IF SCAN THEN
|
||||
IF BOUND(FPT) THEN
|
||||
BEGIN U:=ACCUM[0];
|
||||
RGTBRACK:
|
||||
IF SCAN AND RGTBRACKET THEN
|
||||
IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN
|
||||
IF DELV THEN
|
||||
BEGIN ERR:=DISPLAY(L,U,FPT,FSQ);
|
||||
DELTOG:=1;
|
||||
END
|
||||
ELSEERR:=1;
|
||||
ELSE ERR:=DISPLAY(L,U,FPT,FSQ)
|
||||
ELSE ERR:=2
|
||||
END
|
||||
ELSE
|
||||
IF RGTBRACKT THEN
|
||||
IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN
|
||||
IF DELV THEN
|
||||
BEGIN ERR:=DISPLAY(L,L,FPT,FSQ);
|
||||
DELTOG:=1;
|
||||
END
|
||||
ELSE ERR:=3
|
||||
ELSE ERR:=DISPLAY(L,L,FPT,FSQ)
|
||||
ELSE ERR:=4
|
||||
ELSE ERR:=5
|
||||
ELSE
|
||||
IF RGTBRACKET THEN
|
||||
BEGIN TADD:=ADDRESS;
|
||||
IF SCAN THEN
|
||||
IF IDENT AND ACCUM[0]="ADELETE" THEN
|
||||
IF SCAN THEN
|
||||
IF LFTBRACKET THEN
|
||||
DELOPTION:
|
||||
IF SCAN AND BOUND(FPT) THEN
|
||||
BEGIN U:=ACCUM[0];
|
||||
IF SCAN AND RGTBRACKET THEN
|
||||
IF SCAN THEN
|
||||
IF DELV THEN
|
||||
BEGIN ERR:=DELETE(L,U,FPT,FSQ);
|
||||
FINISHUP
|
||||
END
|
||||
ELSE ERR:=6
|
||||
ELSE ERR:=DELETE(L,U.FPT,FSQ)
|
||||
ELSE ERR:=7
|
||||
END
|
||||
ELSE ERR:=8
|
||||
ELSE
|
||||
IF DELV THEN
|
||||
BEGIN ERR:=DELETE(L,L,FPT,FSQ);
|
||||
FINSIHUP
|
||||
END
|
||||
ELSE ERR:=9
|
||||
ELSE ERR:=DELETE(L,L,FPT,FSQ)
|
||||
ELSE
|
||||
IF LFTBRACKET TEHN GO TO DESLOPTION ELSE
|
||||
BEGIN CHECKSEQ(SEQ,L,INC);
|
||||
CLEANBUFFER(BUFFER,BUFFSIZE,TADD);
|
||||
ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0;
|
||||
IF SCAN THEN GO TO SHORTCUT
|
||||
END
|
||||
ELSE ERR:=DELETE(L,L,FPT,FSQ)
|
||||
END
|
||||
ELSE ERR:=10
|
||||
ELSE ERR:=11 09310000 P88
|
||||
END ELSE
|
||||
IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN
|
||||
BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK
|
||||
END ELSE
|
||||
IF IOTA THEN
|
||||
IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN
|
||||
BEGIN IF SCAN THEN
|
||||
IF DELV THEN DELTOG:=1; ELSE ERR:=15;
|
||||
IF ERR == 0 THEN
|
||||
BEGIN MODE:=RFSEQUENCING; CURLINE:=INCREMENT:=1;
|
||||
SETFIELD(GTA,0,8,0);
|
||||
GT1:=SEARCHORD(FPT,GTA,GT2,8);
|
||||
LOWER:=GTT2+1; UPPER:=FUNCSIZE-1;
|
||||
END
|
||||
END
|
||||
ELSE ERR:=14;
|
||||
ELSE ERR:=12
|
||||
ELSE ERR:=13
|
||||
END
|
||||
ELSE
|
||||
IF CURLINE=0 THEN %CHANGING HEADER
|
||||
ERR:=26 ELSE
|
||||
IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN
|
||||
BEGIN
|
||||
IF NOSYNTAX=0 THEN PROCESS(XEQUTE);
|
||||
IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC;
|
||||
END;
|
||||
IF ERR NEQ 0 TEHN
|
||||
BEGIN FORMWD(2,"5ERROR ");
|
||||
EOD:=1;
|
||||
FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]);
|
||||
END;
|
||||
END; %OF BLOCK STARTED ON LINE 9238000 //////////////////////
|
||||
ENDHANDLER:
|
||||
IF BOOLEAN(SUSPENSION) THEN BEGIN
|
||||
FILL ACCUM[*] WITH "ABORT SU", "SP. FNS.";
|
||||
FORMROW(3,0,ACCUM,0,16); INDENT(0); TERPRINT;
|
||||
END ELSE
|
||||
IF MODE=0 THEN
|
||||
BEGIN
|
||||
IF BOOLEAN(DELTOG) THEN FINISHUP;
|
||||
INDENT(-CURLINE); TERPRINT;
|
||||
END;
|
||||
|
||||
END;
|
||||
EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL;
|
||||
FLAG:=FAULTL; ZERO:=FAULTL;
|
||||
INITIALIZETABLE;
|
||||
TRYAGAIN:
|
||||
IF FALSE THEN %ENTERS WITH A FAULT.
|
||||
FAULTL:
|
||||
BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO
|
||||
|
||||
BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0
|
||||
END
|
||||
END;
|
||||
APLMONITOR;
|
||||
ENDOFJOB:
|
||||
|
||||
FINIS:
|
||||
WRAPUP;
|
||||
|
||||
END.
|
||||
END;END. LAST CARD ON OCRDING TAPE
|
||||
|
||||
|
||||
|
||||
TOTAL LOGIICAL RECORDS= 7273
|
||||
END OF JOB.
|
||||
Loading…
x
Reference in New Issue
Block a user