diff --git a/source/APL/IMAGE.alg_m b/source/APL/IMAGE.alg_m index c2a14e1..5ddbec1 100644 --- a/source/APL/IMAGE.alg_m +++ b/source/APL/IMAGE.alg_m @@ -1,11 +1,11 @@ -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 % IN ITS ORIGINAL OR ANY MODIFIED FORM. ANY PUBLICATION RELATING TO % THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT % THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE -% PRINCIPAL IMPLEMENTORS, GARY KINDALL, LEROY SMITH, SALLY SWEDINE, +% PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE, % AND MARY ZOSEL. COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE % PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER % CENTER. @@ -180,7 +180,7 @@ STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL); COMMENT -- MOVE TO POSITION FOR WRITE; SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); - T1:=SI; COMMENT -- RECORDS WILL BE WRITTER HERE; + T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE; DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR; SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED; TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8)); @@ -385,6 +385,7 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE + STRING IN -A- (EITHER AS INPUT OR OUTPUT) ; PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D; ARRAY T[0]; @@ -576,7 +577,7 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH M; IF M GTR (PAGESIZE-SKIP-1)|8-2 THEN MESSAGE(5) COMMENT - THIS CHARACTER STRING IS TOOL LONG ; ELSE + THIS CHARACTER STRING IS TOO LONG ; ELSE BEGIN ARRAY C[0:PAGESIZE]; STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS; BEGIN LOCAL T; @@ -687,7 +688,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]); @@ -895,7 +896,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 ------ EMERGENCY FILE MAINTENANCE ------- + %------- MODE=10 ------EEMERGENCY 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; @@ -1095,7 +1096,7 @@ DEFINE DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS) DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD - PDC=10#, % PROG DESC CALC MODE + PDC=10#, % DROG DESC CALC MODE INTO=0#, DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE) DDPUSC=27#, % DATA DESC PRESENT UNNAMED SCALAR CHR @@ -1103,7 +1104,7 @@ DEFINE DDPNVC=29#, %DATA DESC PRES PERMANENT VECTOR CHAR MODE DDPNVW=28#, %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT) OUTOF=1#, - NAMEDNULLV=0&7[1:45:3]#, %KLUDGE...NAMED VERSION OF NULLV + NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV BACKP=[6:18]#, SCALARDATA=0#, ARRAYDATA=2#, @@ -1315,7 +1316,7 @@ DEFINE CAPHEADING=11:47:1#, APLCODE = STATIONPARAMS#, - + SPECMODE = BOUNDARY.[1:3]#, DISPLAYIMG=1#, EDITING=2#, @@ -1331,7 +1332,7 @@ DEFINE BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT INTEGER BUFFSIZE,ITEMCOUNT,RESULT, LOGINSIZE, - %%% + %%% ERR, NROWS, %%% @@ -1509,7 +1510,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, - %LAST IN ABOVE LINE IS REALLY 3["]141" + %CAST 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", @@ -1525,12 +1526,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 IDTABLE; + THE SIZE OF TDTABLE; 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; @@ -1564,7 +1565,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); @@ -1611,7 +1612,7 @@ REAL PROCEDURE NUMBER; BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#; COMMENT: VALUE OF INTCON IS THE CONVERSION OF AN INTEGER CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING - AT THE CHARACTERS ADDRESS. ADDRESS IS SE TO POINT + AT THE CHARACTER ADDRESS. ADDRESS IS SET TO POINT TO THE NEXT CHARACTER DURING INTCON; DPTOG:=COUNT GTR 8; THI:=T:=CONV(ADDR,N:=COUNT MOD 8); @@ -1731,16 +1732,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; @@ -1749,13 +1750,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; @@ -1790,7 +1791,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]; @@ -1838,9 +1839,9 @@ INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2; END OF PHONY HEADER; PROCEDURE STARTSCAN; BEGIN - - - + + + LADDRESS:= ADDRESS:=ABSOLUTEADDRESS; BEGIN TERPRINT; @@ -1869,7 +1870,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; @@ -1879,7 +1880,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; @@ -1888,7 +1889,7 @@ PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0]; BEGIN TSI:=SI; SI:=LOC T; IF SC="1" THEN; SI:=TSI; IF TOGGLE THEN - IF SC NEQ "0" THEN 00342000 + IF SC NEQ "0" THEN 00342000 P24 IF SC="@" THEN BEGIN TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT; END ELSE FRAC:=TALLY @@ -1901,7 +1902,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 @@ -1915,7 +1916,1231 @@ PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0]; WRITE(SCR[*],F,DIGITS,R); ADJUST(A,SCR) END; - M:=0; END; 08015888 P78 +... + IF SCAN THEN 00501600 P25 +... + INTEGER K; 03002210 P26 +... + REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440 P27 +... + BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550 P28 +... + UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR 03104040 P29 +... + IF INFIX[I].OPTPE NEQ DYADIC THEN SINFIX[I].OPTYPE:=MONADIC; 03104840 P30 +... + IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR; 03105087 P31 +... + BEGIN 03105383 P32 +... + T.OPTYPE:=MONADIC; 03106260 P33 +... + GTR MAXPROGS THEN %OFF THE END OF SP 03110920 P34 +... + BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR 03114800 P35 +... + BEGIN 03121255 P36 +... + SETFIELD(NEWDESC,7,1, IF BIOOLEAN(T.SCALAR) 03124650 P37 +... + END; 03140080 P38 + INTEGER C; +... + T:=SP[NOC]; SP[NOC.NAMED:=1; N:=T; 03140600 P39 +... + BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END; 03150085 P40 +... + L:=GETSPACE(N:=(NUMELEMENTS(D)+D,RF)); 03150650 P41 +... + WHILE TRUE DO % RECURSIVE EVALUATION LOOP 03151310 P42 +... + M := M + NJ; CC := 2; END; 03152646 P43 +... + AND N.QUADIN=4) THEN POPPROGRAM:=TRUE; 03155000 P44 +... + %ESE WE HAVE AN ERROR (MISSING " ETC) 03210520 P45 +... + OUTER:=(START:=L+RANK+J|MAT) + COL - 1; 03221020 P46 +... + OP APL OPERATOR OP APL OPERATOR 03230015 P47 +... + ANS := IF RIGHT | LEFT = 1 THEN 0 ELSE 1; %NAND 03233400 P48 +... + DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1); 03235100 P49 +... + IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP 03239380 P50 +... + LABEL QUIT, DONE; 03240800 P51 +... + GO TO QUIT END 03243705 P52 +... + OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN; 03254510 P53 +... + THEN GO TO DOMAIN; 03268280 P54 +... + BEGIN 03269860 P55 +... + 03271000 P56 +... + MM := M + RRANK - 1; 03272500 P57 +... + LABEL QUIT, FORGET, RANKERR; 03273620 P58 +... + HOP := (DIM-1) | JUMP; 03274600 P59 +... + SUB[I]:=TEMP-1; I:=I+1 END; 03277000 P60 +... + FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE 03500140 P61 +... + FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL 03507100 P62 +... +%------------------ CASE 2.....MODE=ALLOC------------------------ 03702300 P63 +... + CASE T.TYPEFIELD OF 03752700 P64 + BEGIN %-------TF=0 (REPLACEMENT)-------------- + BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE + DEFINE STARTSEGMENT=#; %///////////////////// + PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP; + N:=T.LOCFIELD; + IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE + BEGIN M:=FUNCLOC;%FIND LAST MKS + M:=SP[MOC].SPF+M; + N:=SP[MOC].LOCFIELD+N; END; + U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U; + IF U.DATADES=0 THEN ERR:=NONCEERROR; + COMMENT PROBABLY MIXUP WITH FUNCTION NAMES + AND NAMES OF LOCAL SUSPENDED VARIABLES; + END; + %-------------FUNCTION CALL----------------- +%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +BEGIN COMMENT SET UP STACK FOR A FUNCTION CALLL; +EAL U,V,NARGS,D; +INTEGER I,FLOC; +LABEL TERMINATE; +COMMENT + MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%:::::::::::::::::::: + FLOC:=N:=T.LOCFIELD; + IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR; + FO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION + IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N); + D:=SP[NOC]; L:=LASTMKS; %D IS TEH DESC, L IS THE PROG MKS + SP[LUOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION + L:=STACKBASE+1; L:=SP[LOC].SPF+1; + M:=SP[LOC].SPF; + IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL + IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN + BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END; + + + SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA + NARGS:=D.NUMBERARGS; + FOR I:=1 STEP 1 UNTIL NARGS DO + IF BOOLEAN((T:=AREG).DATADESC) THEN + BEGIN + IF BOOLEAN(T.NAMED) THEN %MAKE A COPY + COMMENT YOU COULD MAKE A CALL BY NAME HERE; + BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+1,RF)); + SPCOPY(T,SPF,U,V); T.NAMED:=0; T.SPF:=U; + T.BACKP:=0; + END ELSE %NO NEED TO MAKE A COPY + AREG.PRESENCE:=0; + POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE + END ELSE ERR:=SYSTEMERROR; + IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR; + IF ERR NEQ 0 THEN GO TO TERMINATE; + SP[LOC].SPF:=N; + PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID]; + OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION + %NOW SET UP THE FUNCTION MARK STACK. + + M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF]; + M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE + AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]& + (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS + CURLINE:=U; + + U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS + M:=M+5; % M IS ON TEH FIRST DESC IOF THE FIRST LAB, LOC,... + FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK + BEGIN IF SP[MOC] NNEQ 0 THEN %MAKE UP THE DESC + BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC]; + T:=L&DDPUSW[CDID]&0[CCIF] + END ELSE + T:=NULLV; + PUSH; M:=M+2; + AREG:=T; %A SINGLE LOCAL + END; + %COPY OVER THE ARGUMENTS + FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER + BEGIN M:=D.SPF; %M IS THE LOACTION OF THE LABEL TABLE. + M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE + M:=SP[MOC]; + N:=LASTMKS+MM; + SP[NOC]:=GTA[I-1]; + END; + %PUT IN A PHONEY PROG DESC TO START THINGS OFF + PUSH; IF ERR NEQ 0 THEN GO TO TERMINATE; 03753400 P65 + ARFG:=0&4094[CCIF]&(LASKMKS-STACKBASE)[BACKU[]; + LASTMKS:=ST; POLTOP:=POLLOC:=0; + TERMINATE: + END; +%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + %-------END OF LOAD FUNCTION FOR CALL----- + %-------------TF=2 (CONSTANT)--------------------- + BEGIN PUSH; IF ERR=0 THEN BEGIN + N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END; + END; + %-------------TF=3 (OPERATOR)----------------- + COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR + ASSIGNMENT NUMBER; + BEGIN IF T.OPTYPE=MONADIC THEN + BEGIN PUSH;IF ERR=0 THEN AREG:=0; END; + CASE T.LOCFIELD OF +BEGIN %--------------- OPERATE ON STACK --------------------- + COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE + DESCRIPTOR OF THE RESULT OF THE OPERATION. + AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND + ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK. + IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.; +; +; +; +; + %---------------------REPLACEMENT OPERATOR--------------- + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// + IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE + AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN. + + IF BOOLAN(T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN + OLDDATA:=CHAIN(T,OLDATA); + M:=T.LOCFIELD; + + IF(RESUT:=BREG).SPF = 0 THEN U:=T:=0 ELSE + U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF); + SPCOPY(RESULT,SPF,U,T); + RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCJLS + GT1:=IF BOOLEAN(U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0; + SP[MOC]:=RESULT>1[CLOCF]; + IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL + BEGIN M:=M-1;IFSP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1; + + END; + RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA + END + %-------TRANSFER OPERATOR--------------------------------- + BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////////// + SCRATCHAIN(OLDDATA);ODDATA:=0; + IF BOOLEAN(D.DPTYPE) THEN ST:=ST-1; %GET RID OF PH7ONEY TOP + L:=FUNCLOC; + IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE + ERR:=SYNTAXERROR; + GO TO SKIPPOP; + END; + BEGIN %--------------COMPRESSION------------------------------------ + DEFINE STARTSEGMENT=#; %///////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG) + ELSE COMPRESS(AREG,S[]LOC],BREG); COMMENT A/B HAS BEEN + STACKAED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A; + END; + ARITH(3); %OPERATION IS DIVIDE + ; +; +%-------------QUAD INPUT-------------------------------- + EVALQ: BEGIN LABEL EVALQUAD; + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; + CURRENTMODE:=INPUTMODE; + FORMWD(3,"3[]: "); INDENT(0); + + IMS(2); % SETUP MARKSTACK FOR QUAD EXIT + IF ERR NEQ 0 THEN GOTO SKIPPOP; + GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE +EVALQUAD: %LO7OK AT BUFFER TO SEE WHAT CAME IN + BEGIN + IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END; + IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT + GO TO SKIPPOP; + END; + END; + BEGIN % -----EVALUATE SUBSCRIPTS--------------- + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03811002 P66 + T:=AREG; L:=BREG.SPPF; + IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR; GO TO SKIPPOP;END; + U:=SP[LOC]; % GET # OF SUBSCRIPTS + IF U GTR 32 THEN ERR:=INDEXERROR ELSE + BEGIN + IF U GTR 0 THEN BEGIN + IF T.PRESENCE NQ 1 THEN % GET ARRAY INTO SP + BEGIN N:=T.LOCFIELD; + IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN + BEGIN T:=GETARRAY(T); SP[NOC]:=T END; + T.LOCFIELD:= N; + END; + IF ERR=0 THEN % NOW EVAVLUATE + + RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF + ELSE INTO),T,U); + IF L=INTO THEN BEGIN + + CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP + END ELSE % NO SUBSCRIPTS + BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP; + END; % DON{T LET TEH DESC. IN T BE POPPED. + U:=U+2; % # OF THINGS TO POP + FOR N:=1 STEP 1 UNTIKL U DO POP; + IF L=OUTOF THEN PUSH; AREG:=RESULT; + + GO TO SKIPPOP; + END; + END; +; +; +%-------------QQUAD INPUT------------------------------- + EVALQQ: BEGIN LABEL EVALQQUAD; + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; + CURRENTMODE:=INPUTMODE; + IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT + IF ERR NEQ 0 THEN GO TO SKIPPOP; + GO TO EXECEXIT; +EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING + IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT + N:=ENTIER((3L+7) DIV 8); % FIND NUMBER OF WORDS + M:=GETSPACE(N+1); % GET SPACE FOR EACH VECTOR IN SP + TRANSFERSP(INTO,SP,M+1,BUFFER,0,N); + SP[MOC]:=L; % STORE LENGTH OF VECTOR + RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR + END ELSE RESULT:=NULLV;% NOTHING WAS INPUT + PUSH; IF ERR=0 THEN AREG:=RESULT; + GO TO SKIPPOP; + END; + RESULTD := SEMICOL; %CONVERSIEON CONCATENATION + COMMAP; %CATENATE + BEGIN%----------INNER PRODUCR (PERIOD)--------------------- + M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC]; + PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD); + END; + ARITH(4); %* +; +; + ARITH(17); %AND + ARITH(18); %OR + ARITH(9); %NOT + ARITH(11); %LESS:THAN + ARITH(16); %LEQ + ARITH(13); %= + ARITH(14); %GREATER-THAN + ARITH(15); %NEQ + ARITH(8); %MAX/CEIL + ARITH(7); %MIN/FLOOR + ARITH(6); %RESD/AAAABS + IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP + RHOP; %RHO + IOTAP; %IOTA +; + REDUCESORTSCAN(0,BREG,AREG,4); %REVERSAL; + BEGIN %-----------EXPANSION------------------------- + DEFINE STARTSEGMENT=#; %/////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG) + ELSE EXPAND(REG,SP[LOC],BREG); COMMENTS A EXPN B HAS BEEN + STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A; + END; + RESULTD:=BASEVALUE; %BASE VALUE + ARITH(10); %COMB/FACT 03840000 P67 +; + IF T.EOPTYPE=MONADIC THEN ARITH(5) ELSE + DYADICRNDM; %RNDM + IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT + RESULTID := REPRESENT; %REPRESENTATION + ARITH(45); %CIRCLE--TRIGONOMETRIC FUNCTIONS +; +; + ARITH(0); %ADD + ARITH(2); %SUBTRACT + ARITH(1); %MULTIPLY + %-------------------DISPLAY--------------------------------------- + + BEFIN DEFINE STRATSEGMENT=#; %///////////////////////////////// + IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL + IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC + IF BOOLEAN(RESULT,PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN + IF BOOLEAN(RESULT.SCALAR) THEN + BEGIN NUMBERCON(SP[MOC],ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT) + END + ELSE %A VECTOR + IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT + IF BOOLEAN(RESULT.CHRMEODE) THEN DISPLAYCHARV(RESULT) + ELSE + BEGIN RESULT:=M:=GETSPACE(L+1); + SP[MOC]:=L; RESULT.DF:=1; RESULT.DIS:=DDPUVW; + AREG:=RESULT; + FOR T:=1 STEP 1 UNTIL 1L DO + BEGIN M:=M+1; SP[MEOC]:=1 + END; + DISPLAY(AREG,BREG); + RESULT:=BREG; + END ELSE TERPRQINT + ENS TERPRINT + ELSE ; %PROBABLY AN FUNCTION....DONT DO ANYTHING + IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT + GO TO BREAKKEY; + POP; GO TO SKIPPOP; + END; + BEGIN % ---------------REDUCTION--------------------------------------- + M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH + IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1); + END; + BEGIN %--------ROTATION---------------------------- + DEFINE STARTSEGMENT=#; %//////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN + REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE + REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS + STACKED AS R,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A; + END; + ARITH(21); %LOG + REDUCESORTSCAN(0,BREG,AREG,2); % SORTUP + REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN + BEGIN%--------------SCAN-------LIKE REDUCTION---------------- + DEFINE STARTSEGMENT=#; %////////////////////////////////////// + M:=(CINDEX:=CINDEX+1) + POLLOC; %FIND OPERATOR IN POLISH + IF (T:=SP[MOC]).TYPEFIELD NEW 3 THEN ERR:=SYSTEMERROR + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3); + END; + ARITH(19); %NAND + RITH(20) %NOR + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) + ELSE ERR:=RANKERROR; % OPERATION IS TAKE + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) + ELSE ERR:=RANKERROR; % OPERATION IS DROP + %------------------------XEQ--------------------------------- +XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %//////////////// + IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY + EFLSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR + NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING + ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR + ELSE BEGIN + M:=GT1; % # OF CHARCATERS SET BY NUMELEMENTS + INITBUFF(BUFFER.MAXBUFFSIZE);RESCANLINE; + TRANSFERSP(QUTOF,SP,T,SPF+1,BUFFER,0,U); + IF(U:=U|8-M) GTR 0 THEN SETFIELD(BUFFER,M,U," "); + IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL + ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END + END; END; + END; %--------------EN OF OPERATION ON STACK--------------------- + POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT; 03869970 P68 +SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; + %-------TF=4 (LOCAL VARIABLE)------------ + BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP; + DEFINE STARTSEGMENT=#; %///////////////// + N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M; + + N:=SP[MOC].LOCFIELD+N; + T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY + PUSH; AREG:=T; + END; + %-------TF=5 (OPERAND)----------------------- + BEGIN PUSH; IF ERR=0 THEN BEGIN + N:=POLWORD.LOCFIELD; U:=SP[NOC]; + IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE + IF U.PRESENCE NEQ 1 THEN BEGIN + U:=GETARRAY(U); SP[NOC]:=U END; + U.LOCFIELD:=0; + AREG:=U; END; + END; + END; % OF CASE STATEMENT TESTING TYPEFILED + END % OF TEST FOR CINDEX LEQ POLTOP + ELSE % WE ARE AT THE END OF THE POLISH + BEGIN COMMENT LASKMKS CONTAINS THE LOCATION + OF THE LAST WARK STACK. GET MARK STACK AND CONTINUE; + + SCRATCHCHAIN(OLDDDATA); OLDDATE:=0; + L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC]; + IF T.DIF=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE + IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NIO RESULT + ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY + IF BOOLEAN(RESULT.SCALAR) THEN + BEGIN M:=GETSPACE(2);L:=RESULT.SPF; + RESULT.SPF:=M+1;SP[MOC]:=RESULT; + M:=M+1;SP[MOC]:=SP[LOC]; + END ELSE % MAKE COPY OF A VECTOR + BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS( + RESULT))); + L:=RESULT.SPF;RESULT.SPF:=M+1; + SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END; + + + FORGETPROGRAM(U); + + DO POP UNTIL ST LSS 2LASTMKS;%CUT BACK STACK TO IMS + OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE; + AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS + CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF; + POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC]; + END ELSE + BEGIN L:=FUNCLOC;M:=SP[LOC.SPF+L; + IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN + BEGIN + IF O=(LOOP:=LOOP+1) MOD 5) THEN + WRITE(TWXOUT,1,JIGG1LE[*])[BREAKKEY:BREAKKEY]; + %THAT WAS TO CHECK FOR A BREAK TO INTERRUT A PROG + STEPLINE(FALSE); + END; + ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE; + WHILE POPROGRAM(OLDDATA,LASTMKS) DO; + END; + END; + END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL) + IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE + BEGIN + DEFINE STARTSEGMENT=#; %///////////////////////////// + COMMENT + MONITOR PRINT(ST,L,M,SP,GTA,T);%:::::::::::::::::::::: + XIT:=TRUE;CURRENTMODE:=ERRORMODE; + + L:=POLLOC+1; + TRANSFERSP(OUTOF,SP,(L:=SP[LOC],SPF)+1,BUFFER, + 0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8))); + L:=FUNCLWOC;M:=SP[LOC].SPF+1; + GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS + WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF + POPPROGRAM(OLDDATA.LASTMKS)THEN 1 ELSE 0; + IF M NEQ L AND NOT BOOLEAN(SP[MOC]).SUSPENDED)THEN%GET LINE# + BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT + L:=SP[NOC].SPF-1;%LOCATION WOF FUNCTION NAME + SETFIELD(GTA,0,1,0); + GTA(0):=SP(LOC); + FORMROW(3,0,GTA,1,7); + L:=SP[MOC].SPF; %BASE OF LABEL TABLE 03918475 P69 + L:=L+CURLINE; + T:=SP[LOC]; + + %ALSO PUT THE FUNCTION INTO SUSPENSION + IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1; + PUSHINTOSYMTAB(SP[MOC]); + END ELSE T:=0; + ERRORMESS(ERR,POLWORD,SPF,T); + END; + END UNTIL XIT; +BREAKKEY: BEGIN BREAKFLAG:=FALSE; + XIT:=TRUE;CURRENTMODE:=CASLCMODE; + L:=FUNCJLOC;M:=SP[LOC].SPF+L; + IF M NEW L AND NOT BOOLEAN(SP[MOC].SUSPENDED) THEN + BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1; + PUSHINTOSYMTAB(SP[MOC]);SP[KLOC].RG:=SP[LOC].RF+1; + M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK + WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS) + THEN; LASTMKS:=M;IMS(4); + END + IF FALSE THEN + END; +EXECEXIT: + IF STACKBASE NEQ 0 THEN BEGIN + L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK + + END; + END OF EXECUTION LOOP; +PROCESSEXIT: + IF BOOLEAN(POLBUG) THEN % DUMP SP + IF MODE=EQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP; + IF FALSE THEN + BEGIN CASE O OF BEGIN + EXPOVRL: SPOUT(3951200); + INTOVRL: SPOUT(3591300); + INDEXL: SPOUT(3951500); + ZEROL: SPOUT(3951600); + END; + REALLYERROR:=1; + DEBUGSP: + WRITE(PRINT,MIN(15,PSRSIZE),PSR); + BEGIN + STREAM PROCEDURE FORM(A,B,N); VALUE N; + BEGIN + DI:=B; 15(DS:=BLIT(" "); + SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3; + SI:=A; 10(DS:=8CHR; DI:=DI+1); + END; + M:=MIN(NROWS+1|SPRSIZE-1,MAXMEMACCESSES); + FOR N:=0 STEP 10 UNTIL M DO + BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M*N,10)); + FORM(ACCUM,BUFFER,N); + WRITE(PRINT,15,BUFFER[*]); + END; + END; + IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN + BEGIN + ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0); + SUSPENSION:=0; + CURRENTMODE:=CALCMODE; + REALLYERROR:=ERR:=0; + END; + END; + END OF PROCESS PROCEDURE; +PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; + INTEGER N; REAL ADDR; + BEGIN + INTEGER STREAM PROCEDURE FORM(A,B); VALUE A; + BEGIN LOCAL T,U; + LABEL L,M; + SI:=A; + L: IF SC=" " THEN + BEGIN SI:=SI+1; GO TO L; + END; + DI:=LOC I; DS:=2RESET; DS:=2SET; + DI:=8; MESSIZEU:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M; + SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M: + FORM:=TALLY; + END; + ARRAY ERMES[0:13],B[0:MESSIZE/8]; + FILL ERMES[*] WITH + "1 ", 05001510 P70 + "5DEPTH ", + "6DOMAIN ", + "7EDITING", + "5INDEX ", + "5LABEL ", + "6LENGTH ", + "5NONCE ", + "4RANK ", + "6SYNTAX ", + "6SYSTEM ", + "5VALUE ", + "7SP FULL", + "7FLYKITE"; + IF R NEQ 0 THEN + BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1; + END; + FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N|8+1, + ERMES[N].[1:5]); + FORMWORD(0,"6 ERROR"); + IF ADDR.[33:15] GEQ 512 THEN + BEGIN + FORMD(D,"4 AT "); + FORMROW(1,1,B,0,FORM(ADDR,B)) + END; + FORMWD(3,"1 "); + END; +PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME; + REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD; +PROCEDURE LOGINAPLUSER; + BEGIN + COMMENT LOG:IN THE CURRENT USER; + COMMENT INPUT LINE IS THE BUFFER; + LABEL EXEC, GUESS; + DEFINE T=GT1#, J=GT2#,I=GT3#; + PROCEDURE INITIALIZEPSR; + BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO + PSRM[I] := 0; + SEED:=STREAMBASE; ORIGIN:=1; + FUZZ:-1@-11; + LINESIZE:=72; DIGITS:=9; + END; + LADDRESS := ADDRESS := ABSOLUTEADDRESS; + WORKSPACE:=WORKSPACEUNIT; + ITEMCOUNT := EOB := 0; + IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE + BEGIN + WORKSPACE:=NEXTUNIT; + SEQUENTIAL(WORKSPACE); + INITIALIZEPSR; + I=STORESEQ(WORKSPACE,PSR,PSRSIZE|8); + INITBUFF(OLDBUFFER,BUFFSIZE); + + END ELSE % WORKSPACE ASSIGNED + I:=CONTENTS(WORKSPACE,0,PSR); + FILL ACCUM[*] WITH "LOGGED 1", "N "; + FORMROW(0,1,ACCUM,0,RI); + SYMBASE:=STAKCBASE:=0; + CSTATION.APLOGGED:=1; + CASE CURRENTMODE OF + BEGIN %--------CALCMODE-------------- + ;COMMENT NOTHING TO DO ANYMORE; + %--------------XEQUTEMODE---------------------- +EXEC: + BEGIN F9ILL ACCUM[*] WITH "LAST RUN"," STOPPED"; + FORMROW(3,0,ACCUM,0,16); + CURRENTMODE:=CALCMODE; + END; + %-------------FUNCMODE----------------- + BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT", + "ION OF "; + FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR, + FSTART|8,7); + CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER); + CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT + CURLINE:=CURLINE+INCRMENT; INDENT(-CURLINE); + FUNCSIZE:=SIZE(GT1); + END; + %------------INPUTMODE-------------ERRORMODE---- + GOTOEXEC; GO TO EXEC; + END; + GUESS: %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT 07044001 P71 + STOREPSR; + IF CURRENTMODE NEQ FUNCMODE THEN + INDENT(0); TERPRINT; + VARSIE:=IF VARPIABLES=0 THEN 0 ELSE SIZE(VARIABLES); + END; +PROCEDURE APLMONITOR; + BEGIN + REAL T; + INTEGER I; + BOOLEAN WORK; + LABEL AROUND, NEWUSER; + LABEL CALULATE,EXECITEIT,FUNCTIONSTART,BACKAGAIN; + LABEL CALCULATEDIT; + I := CUSER := 1; + T := STATION; + BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM" + ,"PUTER SC","IENCE #",VERSIONDATE; + WORK:=TRUE; + FORMROW(3,MARGINSIZE,ACCUM,0,40); + INDENT(0); TERPRINT; CSTATION.APLHEADING:=1 + ; LOGINAPLUSER; + END; + AROUND: + BEGIN + IF MAINTENANCE THEN; + CASE CURRENTMODE OF + BEGIN %-------CALCMODE-------------------------------- + COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF; + + GO CALCULATE; + %--------XEQUTE MODE-------------------------------- + GO TO EXECUTEIT; + %----------FUNCMODE----------------------------------- + GO TO FUNCTIONSTART; + %-----------INPUTMODE--------------------------------- + COMMENT REQUIRES INPUT; + + BEGIN COMMENT GET HT ELINE AND GO BACK; + STARTSCAN; + CURRENTMODE:=XEQM+ODE; + GO TO EXECUTEIT; + END; + %----------ERRORMODE--------------------------------- + GO TO BACKAGAIN; + + END; %OF CASES + END; + COMMENT GET HERE IF NOTHING TO DO; + + GO TO AROUND; + CALCULATE: + STARTSCAN; +CALCULATEDIT: + ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE + IF SCAN THEN + IF RGTPAREN THEN MESSAGEHANDLER EALSE + IF DELV THEN FUNCTIONHANDLER ELSE + BEGIN COMMENT PROCESS CAJLCULATOR MODE REQUEST; + MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); + IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER +%%% +%%% + SYMBASE:=STACKBASE:=0; + END; + PROCESS(XEQUTE); + IF CURRENTMODE=CALCMODE THEN +BACKAGAIN: BEGIN INDENT(0); TERPRINT; + IF NOT BOOLEAN(SUSPENSION) THEN + BEGIN IF CURRENTMODE NEQ ERRORMODE THEN + PROCESS(WRITEBACK); + SP[0,0]:=0;NROWS:=-1; +%%% + END; + CURRENTMODE:=CALCMODE; + END; + IF EDITOG=1 THEN + BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); + RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT; + END; + I:=0; + GO AROUND; 07127000 P72 + EXECUTEIT: + POECESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE + IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN; + I:=0; + GO AROUND; + FUNCTIONSTART: + IF SPECMODE = 0 THEN + BEGIN %SEE IF A SPECIAL FUNCTION. + STARTSCAN; + IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE + FUNCTIONHANDLER + END ELSE + FUNCTIONHANDLER; + I:=0; + GO AROUND + END; +INTEGER PROCEDURE LENGTH(A,M);VLUE M; BOOLEAN M; ARRAY A[0]; + BEGIN +INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L; + BEGIN LOCAL T; + LOCAL C,CC,TST; LABEL LAB; + LOCAL AR; LABEL LAB2; + SI:=LOC M; SI:=SI+7; + IF SC'"1" THEN + BEGIN COMMENT LOOK FOR LEFT ARROW.; + DI:=LOC AR; DS:=RESET; DS:=5SET; + SI:=LOCL; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=A; + T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB; + TALLY:=TALLY+1; + C:=TALLY; TSI:=SI; SI:=L9OC C; + SI:=SI+7; IF SI="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; + TALLY:=0; + END; SI:=TSI))); + L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB; + TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0; + END; SI:=TSI); + LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7; + DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR; + END ELSE + BEGIN + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=A; T(2(SI:=SI+32)); SI:=SI+L; + T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2; + TALLY:=TALLY+1; C:=TALLY; SI:=SI; SI:=LOC C; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 + END; SI:=TSI))); + LAB2: GO TO LAB + END + END; +INTEGER I; +I:=LENGT(A,M,BUFFSIZE|8); +LENGTH:=IF M THEN I ELSE BUFFSIZE|8-I + END +BOOLEAN PRUOCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0]; + BEGIN REAL T; + T:=ADDRSS; + IF SCAN AND IDENT THEN + BEGIN SETFIELD(ACCUM,1,1,0); TRANSFER(ACCUM,1,L,K|8,8); + IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN + BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN; + END; + END + END; +STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N; + BEGIN SI:=A; DT:=8; DS:=N WDS END; +INTEGER PROCEURE DAYTIME(B); ARRAY B[0]; + BEGIN + + INTEGER D,H,M,MIN,Q,P,Y,TIME1; + LABEL OWT; + STREAM PROCEDURE FORM(A,DAY,MD,DA,YR,HR,MIN,AP); + VALUE DAY,MD,DA,YR,HR,MIN,AP; + BEGIN DI:=A; 08014064 P73 + SI:=LOC DAY; SI:=SI+7; + IF SC="0" THEN DS:=3LIT"SUN" ELSE + IF SC="1" THEN DS:=3LIT"MON" ELSE + IF SC="2" THEN DS:=4LIT"TUES" ELSE + IF SC="3" THEN DS:=6LIT"WEDNES" ELSE + IF SC="4" THEN DS:=5LIT"THURS" ELSE + IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR"; + DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC; + DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-"; + SI:=LOC YR; DS:=2DEC; DS:=2LIT" "; + SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN; + SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" "; + DS:=CHR; DS:=LIT"M" + END; + TIME1:=TIME(1); + Y:=TIME(0); + D:=Y.[30:1]|100+Y.[36:6]|10+Y.[42:6]; + Y:=Y.[18:6]|10+Y.[24:6]; + FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30, + 31,30,31,31,30,31,30 DO + IF D LEQ H THEN GO OWT ELSE + BEGIN D:=D-H; M:=M+1; + END; + OWT: + H:=TIME1 DIV 216000; + MIN:=(TIME1 DIV 3600) MOD 60; + IF M LSS 2 THEN + BEGIN Q:=M+11; P:=Y-1; + END ELSE + BEGIN Q:=M-1; P:=Y + END; + M:=M+1; + FORM(B,TIME1:=((Q|26-2)DIV 10+D+P+P.[36:10]+1)MOD 7, + M,D,Y,Q:= H MOD 12, Q:=MIN MOD 10+(MIN DIV 10)|64, + IF H GEQ 12 THEN "P" ELSE 17); + DAYTIME:=(IF TIME1=6 THEN 5 ELSE + IF TIME1=5 THEN 3 ELSE + IF TIME2=2 THEN 4 ELSE 3)+22; + + + END; +PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; + REAL NAME1,NAME2; ARRAY IDENT[0]; + BEGIN + FILE DISK DISK(2,WDSPERREC,WDSPERBLK); + INTEGER PROCEDURE RD(D,N,A); + VALUE N; INTEGER N; FILE D; ARRAY A[0]; + BEGIN READ(D[N],WDSPERREC,A[*]); + RD:=N+1; + END; + PROCEDURE LOADITEM(RD,D,ITEM); + INTEGER PR+OCEDURE RD; FILE D; + ARRAY ITEM[0]; + BEGIN + DEFINE T=ITEM#; + PROCEDURE GETALINE(C,S,L,R,RD,D,LEN); + VALUE LEN; INTEGER C,S,L,LEN; + ARRAY A[0]; INTEGER PROCEDURE RD; FILE D; + BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT + INTEGER P; + IF C GTR LEN-2 THEN + IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS + BEGIN + S:=RD(D,S,R); + C:=2; + TRANSFER(B,0,L,6,2); + END + ELSE % 1 CHR LEFT ON LINE + BEGIN + TRANSFER(B,C,L,6,1); + S:=RD(D,S,B); + TRANSFER(B,0,L,7,1); + C:=1; + END + ELSE % AT LEAST 2 CHARS REMAINING ON LINE + BEGIN + TRANSFER(B,C,L,6,2); + C:=C+2; + END; + P:=0; + +IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION + BEGIN + WHILE P LSS L DO 08014459 P74 + IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE + % EXTENDS INTO NEXT RECORD + BEGIN + TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD + S:=RD(D,S,R); + P:=P+(LEN-C); % AMOUNT READ SO FAR + C:=0; + END + ELSE % ALL ON ONE RECORD + BEGIN + TRANSFER(B,C,BUFFER,P,L-P); + C:=C_L-P; + P:=L; % FINISHED + END; + END; + END OF GETALINE; + INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE; + INTEGER HOLD; + LABEL SCALARL; + ARRAY U[0:1],B[0:WDSPERREC-1]; + BOOLEAN TOG; + TRANSFER(T,0,U,0,7); + G:=GETFIELD(T,7,1); + IF VARSRSIZE GTR 0 THEN + IF K+;SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN + IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE + ELSE % NOT A FUNCTION IN THE SYMBOL TABLE + IF G=FUNCTION THEN + BEGIN + DELETE1(VARIABLES,HOLD); + IF K=ARRAYDATA THEN RELEASEARRAY(U[1]); + END; + ELSE TOG:=TRUE % DON-T CHANGE + ELSE % NOT IN VARIABLES + BEGIN + VARSIZE:=VARSIZE+1; + HOLD:=HOLD+K-1; + END; + ELSE VARSIZE:=1; + LEN:=(WDSPERREC-1)|8; + IF NOT TOG THEN % OK TO PUT INTO VARIABLES + IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES + BEGIN + TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME, + %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE + S:=T[1].LIBF1; % RECORD NUMBER + M:=T[1].LIBF2; % WORD WITHIN RECORD + SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE + PR:=NEXTUNIT; + S:=RD(D,S,B); + FOR I:=0 STEP 1 UNTIL SIZE-1 DO + BEGIN + TRANSFER(M,M|8,T,0,16); + M:=M+2; + IF M GEQ WDSPERREC-1 THEN + BEGIN + S:=RD(D,S,R); + IF M GEQ WDSPERREC THEN + BEGIN + TRANSFER(B,0,T,8,8); + M:=1; + END + ELSE M:=0; + END; + STOREORD(PT,T,I); + END; % HAV FINISHED FILLIN G POINTERS TABLE + IF VARIABLES=0 THEN BEGIN + VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN + STOREORD(VARIABLES,U,HOLD); END; + SEQUENTIAL (SQ:=MEXTUNIT); + SETFIELD(U,FPTF,FFL,PT); + SETFIELD(U,FSQF,FFL,SQ); + STOREORD(VARIABLES,U,HOLD); + IF TOC THEN DELETE1(VARIABLES,HOSLD+1);%REMOVE 1 EXTRA + COMMENT NOW FILL IN SEQ STORAGE; + IF M NEQ 0 THEN BEGIN + M:=C:=0; + S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD + END; + L:=1; + + WHILE L NEQ 0 DO + BEGIN 08014747 P75 + GETALINE(C,S,L,B,RD,D,LEN); + GT1:=STORESEQ(SQ,BUFFER,L); + END + END + ELSE + IF G=ARRAYDATA THEN + IF T[1].INTPTR=0 THEN % NULL VECTOR + GOTO SCALARL + ELSE + BEGIN + ARRAY DIMVECT[0,MAXBUFFSIZE]; + S:=T[1].INPTR; % RECORD NUMBER + M:=T[1].DIMPTR; % LOC WITHIN RECORD + C:=M|8; + SIZE:=RD(D,S,B); + GETALINE(C,S,L,B,RD,D,LEN); + T[1].DIMPTR:=STORESEQ(WS,BUFFER,L); + % PUTS DIMVECT INTO WORKSPACE + GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS + SIZE:=L-1; + FOR K:=0 STEP 2 UNTIL SIZE DO + BEGIN + GETALINE(C,S,L,B,RD,D,LEN); + SETFIELD(DIMVECT,K,S,STORESEQ(WS,BUFFER,L)); + END; COMMENT THIS STORES THE VALUES OF THE + ARRAY INTO THE W+ORKSPACE, AND ALSO RECORDS + THE LOCATION WITHIN WS IN DIMVECT,TO BE STORED; + T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1); + IF VARIABLES=0 THEN VARIABLES:=NECTUNIT; + STOREORD(VARIABLES,T,HOLD); + END + ELSE % MUST BE A SCALER + SCALARL: + BEGIN + IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT; + STOREORD(VARIABLES,T,HOLD); + END + ELSE % WILL NOT REPLACE IN SYMBOL TABLE + BEGIN + FILL BUFFER[*] WITH " ","NOT REPL","ACED "; + TRANSFER(T,0,BUFFER,0,7); + FORMROW(3,0,BUFFER,0,20); + END; + END LOADITEM; + BOOLEAN STREAM PROCEDURE EQUAL(A,B); + BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1; + EQUAL:=TALLY + END; + INTEGER I,J,L,NDIR,N; + LABEL MOVEVAR,SKIP; + ARRAY T,U[0:1],D[0:WDSPERREC-1]; + FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D); + IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED + FOR I:=2 STEP 1 UNTQIL 9 DO IF GETFIELD(D[I],1,7) NEQ C THEN GO SKIP; + IF NDIR:=D[0] NEQ 0 THEN + BEGIN N:=LIBSPACES+ENTIER(NDIR|2/(J:=WDSPERREC-1)); + IF(NDIR|2) MOD J NEQ 0 THEN N:=N+1; + FOR I:=1 STEP 1 UNTIL NDIR DO + BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB; + IF WDSPERREC-J LSS 3 THEN + IF WDSPERREC-J=1 THEN + BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR + END ELSE + BEGIN TRANSFER(D,J|8,T,08); L:=RD(DISK,L,D); + TRANSFER(D,0,T,8,8); J:=1 + END ELSE MOVEVAR: + BEGIN TRANSFER(D,J|8,T,0,16); J:=J+2 + END; + IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN + BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1; + LOADITEM(RD,DISK,T); + END + END; + STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES + END; + IF FALS THEN SKIP; FORMWD(1,"6BADFIL"); + EOB:=1; + END OF LIBRARY LOAD; +PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS; + IF WORKSPACE NEQ 0 THEN + BEGIN + INTEGER I,J,K,V,L,G; 08015020 P76 + ARRAY T[0,1]; + J:=SIZE(V:=VARIABLES)-1; + FOR I:=0 STEP 1 UNTIL J DO + BEGIN K:=CONTENTS(V,I,T); + IF GETFIELD(T,7,1)=FUNCTION THEN + FOR L:=FPTF,FSQF DO % GET RID OF STORAGE + IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G); + END; + RELEASEUNIT(V); + VARIABLES:=0; VARSIZE:=0; + CURRENTMODE:=0; J:=SIZE(WS)-1; + FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I); + STORESPR; + END; +PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS; + BEGIN LABEL QQQ; QQQ: + IF WORKSPACE NEQ 0 THEN + BEGIN + PURGEWORKSPACE(WS); RELEASEUNIT(WS); +% + END ELSE SPOUT(8015222); + END; +PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); + VALUE NAME1,NAME2,LOCKFILE; + REAL NAME1,NAME2,LOCKFILE; + BEGIN + SAVE FILE DISK [NAREAS:SIZEAREAS] + (2,WDSPERREC,WDSPERBLK,SAVE 100); + INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N; + F+ILE D; ARRAY A[0]; + BEGIN REAL STREAM PROCEDURE CON(A); VALUE A; + BEGIN SI:=LOCA; DI:=LOC C9ON; DS:=8DEC END; + STREAM PROCEDURE CLEANER(A); + BEGIN DI:=A; WDSPERREC(DS:=BLIT".") END; + A[WDSPERREC-1]:=CON(N); + WRITE(D[N],WDSPERREC,A[*]); + WR:=N+1; CLEANER(A); + END; + PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J; + INTEGER L,C,J,N,M; + ARRAY B[0]; INTEGER PROCEDURE WR; FILE D; + BEGIN INTEGER P,K; + IF C+2 GTR L THEN + BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1; + TRANSFER(J,7,B,0,1); + END ELSE + BEGIN TRANSFER(J,6,B,C,2); C:=C+2; + END; + WHILE J NEW 0 DO + IF J GTR K:=(L-C) THEN + BEGIN TRANSFER(BUFFER,P,B,C,K); + N:=WR(D.N.B); J:=J-K; C:=0; P:=P+K + END ELSE + BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0 + END; + IF C=L THEN + BEGIN N:=WR(D,N,B); C:=0 + END; + END; + + PROCEDURE MOVETWO(U,B,M,WR,L,D); + ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D; + BEGIN + COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF A FULLRECORD; + TRANSFER(U,0,B,M|8,16); % CONTENTS OF U INTO B + M:=M+2; + IF M GEQ WDSPERREC-1 THEN % FULL RECORD + BEGIN + L:=WR(D,L,B); + IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD + + BEGIN + TRANSFER(U,8,B,0,8); + M:=1; + END + ELSE M:=D; + END; + END OF MOVETWO; + INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W; + REAL LSD,STP; + LABEL SKIP; + ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC]; + N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))|2/(WDSPERREC-1)); 08015575 P77 + IF (S|) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST + LEN:=(WDSPERREC-1)|8; + FILLS DISK WITH NAME1,NAME2; + DIR[0]:=S; % SIZE OF SYMBOL TABLE + IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM; + S:=S-1; + L:=WR(DISK,L,DIR); % FIRST LINE CPONTAINS # OF ENTRIES IN + COMMENT SYMBOL TABLE AND LOCK INFORMATION; + FOR I:=0 STEP 1 UNTIL 5 DO + BEGIN + J:=CONTENTS(VARIABLES,T,T); % RETURNS VALUE OF I-TH LOC + % IN VARIABLES INTO T + IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN + BEGIN + PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD + SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD + %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER AND POINTE + %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT + MAX:=SIZE(PT); + T[1].LIBF1:=N; % RECORD # + T[1].LIBF2:=M; % LOC WITHIN RECORD + T[1].LIBF3:=MAX; % SIZE OF POINTERS TABLE; + % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE + H:=ENTIER(GT1:=(M+MAX|2)/(WDSPERREC-1)); + H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N; + U[0]:=0; + J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS + IF J=2 THEN GO SKIP; + FOR W:=0 STEP 1 UNTIL LINE-1 DO + %MOVE LOCALS AND LABELS INTO THE SAVE FILE + BEGIN + J:=CONTENTS(PT,W,U); + MOVETWO(U,B,M,WR,N,DISK); + END; + FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO + BEGIN + + J:=CONTENTS(PT,LINE,U); + GT1:=U[1]; + U[1]:=LINE-W; + MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE + J:=CONTENTS(SQ,GT1,BUFFER); + PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT + END; + PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN); + SKIP: + Q:=C DIV 8; + IF C MOD 8 NEQ 0 THEN Q:=Q+1; + IF Q=WDSPERREC-1 THEN + BEGIN + H:=WR(DISK,H,SEX); + Q:=0; + END; + IF M GTR 0 THEN N:=WR(DISK,N,B); + M:=Q; N:=H; + TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B + C:=0; + END + ELSE + BEGIN + T[1].INPTR:=N; T[1].DIMPTR:=M; + C:=M|8; + J:=CONTENTS(WS,LSD,DIMPTR,BUFFER); % DIM VECT + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT + J:=CONTENTS(WS,LSD,INPTR,DIMVECT); + TRANSFER(DIMVECT,0,BUFFER,0,J); + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); + J:=J-1; + FOR LINE:=0 STEP 2 UNTIL J DO + BEGIN + PT:=GETFIELD(DIMVECT,LINE,2); + STP:=CONTENTS(WS,PT,BUFFER); + PUTAWAY(C,STP,WR,DISK,N,M,B,LEN); + END; + M:=C DIV A; IF C MOD A NEQ 0 THEN M:=M+1; C:=0; + IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,8); + M:=0; END; 08015888 P78 END; END; MOVETWO(T,DIR,K,WR,L,DISK); @@ -1931,13 +3156,13 @@ BEGIN REAL T; % % 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; + 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; + ELSE LIBNAMES~ TRUE; END; -PROCEDURE MASSAGEHANDLER; +PROCEDURE MESSAGEHANDLER; BEGIN LABEL ERR1; % @@ -1952,14 +3177,14 @@ PROCEDURE MASSAGEHANDLER; 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 + 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 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) ")); + IF TOG THEN FORMWRD(0,"3(F) "); END ELSE IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END; END; @@ -1977,11 +3202,11 @@ PROCEDURE MASSAGEHANDLER; 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); + 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; LIBSIZE~LIBSIZE+1; END ELSE BEGIN @@ -1989,15 +3214,15 @@ PROCEDURE MASSAGEHANDLER; "DISK "; FORMROW(3,0,BUFFER,0,20); END - ELSE GO ERR1; + 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 + ELSE NOFILEPRESENT + ELSE GO ERR1; 0801626? P79 % ------- DROP ------- IF CURRENTMODE=CALCMODE THEN IF NOT LIBNAME(R,S) THEN @@ -2005,9 +3230,9 @@ PROCEDURE MASSAGEHANDLER; 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); + ;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; + LIBSIZE~LIBSIZE-1; END ELSE NOFILEPRESENT ELSE @@ -2078,7 +3303,7 @@ PROCEDURE MASSAGEHANDLER; NOSYNTAX:=0; NOSYNTAX:=1; %-----------------STORE------------------------- IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK); - 08017970 P80 + 08017970 P80 %-----------------ABORT------------------------- BEGIN IF BOOLEAN(SUSPENSION) THEN SP[0,0]:=0; NROWS:=-1; @@ -2109,10 +3334,10 @@ PROCEDURE MASSAGEHANDLER; 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 + IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN BEGIN RELEASEUNIT(GETFIELD(GTA,FPTF,FFL)); - RELEASEUNIT(GETFILED(GTA,FSQF,FFL)); + RELEASEUNIT(GETFIELD(GTA,FSQF,FFL)); END ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY RELEASEARRAY(GTA[1]); @@ -2131,8 +3356,8 @@ PROCEDURE MASSAGEHANDLER; %----------------------------- FILES ---------------------- IF LIBSIZE>1 THEN - BEGIN FOR I?1 STEP 1 UNTIL LINSIZE-1 DO - BEGIN R?CONTENTS(LIBRARY,I ,ACCUM); + 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."); @@ -2150,18 +3375,18 @@ REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; REAL STREAM PROCEDURE CON(R); VALUE R; BEGIN SI:=LOC R; DI:=LOC CON; DS:=DEC END; - LINENUMBER:=CON(ENTIER(R+.00005)?10000)) + 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; + VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD; ARRAY OLD, NEWEDIT; BEGIN -BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); +BOOLEAN STREAM PROCEDURE WITHINALINE(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 + LOCAL X,Y,Z; 080301?? P81 LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH, OVER; DI:=NEW; WORD(DS:=BLIT" "); @@ -2169,7 +3394,7 @@ BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); SI:=COMMAND; TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY; TALLY:=0; - IF SC?"?" THEN + 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 @@ -2178,7 +3403,7 @@ BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); 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 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; @@ -2199,7 +3424,7 @@ FOUND: %**************FOUND THE FIRST UNIQUE STRING ***************** 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; + 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 ************************** @@ -2222,7 +3447,7 @@ 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 + IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE|8,BUFFSIZE) THEN BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER); IF SCAN AND RGTPAREN THEN @@ -2234,7 +3459,7 @@ PROCEDURE EDITLINE; PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; BEGIN INTEGER I,J; - I:=L?10000 MOD 10000; + 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; @@ -2243,7 +3468,7 @@ PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; PROCEDURE FUNCTIONHANDLER; BEGIN LABEL ENDHANDLER; - OWN BOOLEAN EDITMODE; 09003000 P82 + OWN BOOLEAN EDITMODE; 09003000 P82 DEFINE FPT=FUNCPOINTER@, FSQ=FUNCSEQ#, SEQ=CURLINE#, @@ -2274,7 +3499,7 @@ INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S; 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 + OLDLABELCONFLICT:=ERR END; INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT, SQ,L; FORWARD; @@ -2296,7 +3521,7 @@ PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; 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) + 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 @@ -2315,7 +3540,7 @@ PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; 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); + IF NOSYNTAX=0 THEN PROCESS(XEQUTE); END END; MOVE(NEW,MAXBUFFSIZE+1,BUFFER) END END; @@ -2326,7 +3551,7 @@ PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; GT1:=CONTENTS(SQ,GTA[1],BUFFER); CHRCOUNT:=CHRCOUNT-1; FORMROW(1,0,BUFFER,0,GT1); - END; 090528?? P83 + 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 @@ -2407,7 +3632,7 @@ INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B; INITBUFF(BUFFER,BUFFSIZE); K:=CONTENTS(SQ,L,BUFFER); RESCANLINE; - WHILE LABELSCAN(LAB,0) DO 091240?? P84 + 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; @@ -2471,7 +3696,7 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 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 + ACCUM[0]:=MAX(U+K|ACCUM[0],0) ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T; END; @@ -2485,12 +3710,12 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 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 TRANSFER(PSR,FSTART|8,GTA,0,8); + IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN BEGIN DELETE1(VARIABLES,GT1); IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; END ELSE SPOUT(9198260); - END; 09198270 P85 + END; 09198270 P85 DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0; STOREPSR; END; @@ -2505,7 +3730,7 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 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 + BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE IF SC=DC THEN BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" " END ELSE @@ -2530,7 +3755,7 @@ COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; 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 + 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 @@ -2571,9 +3796,9 @@ HEADERSTORE: SEQUENTIAL(FUNCSEQ:=NEXTUNIT); SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER, HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER))); - SETFILED(GTA,0,8,0); + SETFIELD(GTA,0,8,0); STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0); - SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); 09229004 P86 + 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 @@ -2618,7 +3843,7 @@ HEADERSTORE: VARSIZE:=VARSIZE+1; END; CURRENTMODE:=FUNCMODE; - TRANSFER(GTA,0,PSR,FSTART?8,8); + TRANSFER(GTA,0,PSR,FSTART|8,8); STOREPSR; IF SCAN THEN GO TO SHORTCUT; IF FALSE THEN @@ -2656,10 +3881,10 @@ HEADERSTORE: LOWER:=L+1; IF LOWER GTR UPPER THEN BEGIN IF MODE=DISPLAYING THEN - FORMWD(3,"1 "); 092314?? P87 + FORMWD(3,"1 "); 092314?? P87 MODE:=0; END; - O TO ENDHANDLER + GO TO ENDHANDLER END; END ; % OF BLOCK STARTED EON LINE 9225115 ////////////////// @@ -2724,7 +3949,7 @@ DELOPTION: ELSE IF DELV THEN BEGIN ERR:=DELETE(L,L,FPT,FSQ); - FINSIHUP + FINISHUP END ELSE ERR:=9 ELSE ERR:=DELETE(L,L,FPT,FSQ) @@ -2738,7 +3963,7 @@ DELOPTION: ELSE ERR:=DELETE(L,L,FPT,FSQ) END ELSE ERR:=10 - ELSE ERR:=11 09310000 P88 + ELSE ERR:=11 09310000 P88 END ELSE IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK @@ -2806,5 +4031,5 @@ END. - TOTAL LOGIICAL RECORDS= 7273 + TOTAL LOGICAL RECORDS= 7273 END OF JOB.