% ADDS MODULAR ARITHMETIC FUNCTIONS 00000003 % ADDS ARBITRARY LENGTH ARITHMETIC 00000004 % CLEANS UP MACRO STRUCTURE 00000005 % IMPLEMENTS A TRACE BACK 00000006 % CHANGES DEFINITIONS OF PSEUDO REGISTERS. 00000007 % SOME IMPROVEMENTS TO GARBAGE COLLECTION 00000008 % ADDS ?HI 1 AS A JERK BACK TO COMMAND LEVEL 00000009 % CHANGES SPREAD, LINK TO $APPLY 00000010 00000099 %===================================================================== 00002800 % STANDARD LISP | 00002810 % | 00002820 % THE FOLLOWING "TWINKLE-BOX" LIGHTS HAVE MEANINGS: | 00002830 % 255 - SEARCHING THE STRING AREA FOR AN ENTRY. | 00002840 % 254 - SYMBOL TABLE SEARCH. | 00002850 % 253 - INITIALIZING THE SYMBOL TABLE. | 00002860 % 252 - INITIALIZING THE STRING SPACE. | 00002870 % 251 - INITIALIZING THE PAIR SPACE. | 00002880 % 249 - LAMBDA BINDING TAKING PLACE. | 00002890 % 248 - SEARCH STACK FOR LAMBDA VARIABLE. | 00002900 % 247 - SEARCH FOR A LABEL AND ITS BINDING. | 00002910 % 246 - CONS. | 00002920 % | 00002930 % IN ADDITION: | 00002940 % 0 - 80 P SPACE PAGE REFERENCE IN CAR, CDR ETC. | 00002950 % 96 - * T SPACE, STACK TOP. | 00002960 %===================================================================== 00002970 00003000 00003100 00003200 00003300 LABEL THU; 00003400 00003500 DEFINE 00003600 FZ = 20#, %FIELD SIZE 00003700 TZ = 19#, %TAG SIZE 00003800 CZ = 39#, %CELL SIZE (FZ+TZ=CZ) 00003900 DZ = 10#, %DECIMAL SIZE FOR BIG NUMBERS 00003910 FIELD = [FZ-1:FZ]#, %FIELD PART OF A CELL. 00004000 TAG = [CZ-1:TZ]#, %TAG PART OF CELL. 00004100 CELL = [CZ-1:CZ]#, %CELL 00004200 IDCELL = [FZ:FZ+1]#, %FIELD PLUS INTERNED BIT 00004300 SHIFTUP = [7:48]#, %SHIFTS LOW ORDER BYTE TO HIGH 00004400 BUCKF = [17:8]#, %BUCKET NUMBER FOR STRINGS 00004500 SLOCF = [9:10]#, %LOCATION OF STRING IN STRING DE00004600 LETERF = [9:8]#, %HIGH ORDER 8 BITS OF SLOCF 00004700 SPGARBF = [15:1]#, %GARBAGE COLLECT BIT FOR STRINGS00004800 FREEF = [14:1]#, %MARKS EMPTY SLOT FOR STRINGS 00004900 ISPPTRF = [13:14]#, %BACK PNTR FROM STRINGS TO ISP 00005000 QSPPTR = [47:13]#, %BACK PNTR TO QSPACE 00005100 00005200 % BITS IN TAG FIELD. 00005300 IDTAG = 1#, %IDENTIFIER 00005400 STRINGTAG = 2#, %STRING 00005500 VECTORTAG = 4#, %VECTOR 00005600 FUNCTTAG = 8#, %FUNCTION-POINTER 00005700 BIGTAG =16#, %TAG FOR BIG NUMBERS 00005710 MAXFIELDV = 2**FZ-1#, %SPECIAL USED AS MARKER IN GC 00005800 00005900 % GLOBAL MAXIMA 00006000 ISPMAX = 8192#, %I SPACE SIZE. 00006100 SSPBSZE = 1024#, %BUCKET SIZE (IN BYTES). 00006200 SSPHBUCKETS= 79#, %WHERE OVERFLOW BUCKETS START. 00006300 SSPBMAX = 160#, %TOTAL NO. OF BUCKETS. 00006400 PAGESIZE = 256#, %PAGE SIZE IN P SPACE 00006600 PPAGEMAX = 256#, %NO OF PAGES IN P SPACE. 00006700 PSPMAX = PAGESIZE*PPAGEMAX#, %P SPACE SIZE. 00006800 VSPMAX = 4096#, %V SPACE SIZE. 00006900 QSPMAX = 6144#, %Q SPACE SIZE. 00007000 BSPMAX = 2048#, %B SPACE SIZE. 00007100 FMAX = 9#, %MAXIMUM NUMBER OF FILES. 00007200 INSZE = 80#, %INPUT BUFFER SIZE. 00007300 GLOBLENGTH = 60#, %NUMBER OF GLOBALS FOR GC. 00007400 PRIMNUM = 120#, %NUMBER OF PRIMATIVES 00007500 00007600 % USEFUL MACROS 00007700 ZCALL(FN) = XCALL((FN).FIELD)#, 00007900 ZTRACT(X) = (X+ZERO)#, 00008000 ZEXTEND(X) = (X-ZERO)#, 00008010 ZEROLIT = (3*2**(CZ-3))#, 00008110 BASE = 10**DZ#, 00008120 BM1 = (10**DZ-1+ZEROLIT)#, 00008130 MINIMUM = 2**(CZ-2)#, 00008140 NUMB[N] = (N+ZEROLIT)#, 00008150 MNULL(X) = CT(X,84) = NIL#, 00008200 MGARBAGEP(X) = BOOLEAN(X).[CZ-1:1]#, 00008300 MINTEGERP(X) = (X).TAG >= BIGTAG#, 00008400 MNUMBERP(X) = CT(X,87).TAG >= BIGTAG#, 00008500 BIGP(X) = (X).TAG = BIGTAG#, 00008510 SMALLP(X) = BOOLEAN(X).[CZ-2:1]#, 00008520 OVERFLOWP(X) = (X).[44:47-CZ] NEQ 1#, %PPDMTL19 00008530 MVECTORP(X) = CT(X,59).TAG = VECTORTAG#, 00008600 MSTRINGP(X) = CT(X,89).TAG = STRINGTAG#, 00008700 MCODEP(X) = CT(X,85).TAG = FUNCTTAG#, 00008800 MIDP(X) = CT(X,86).TAG = IDTAG#, 00008900 MCONSTANTP(X) = CT(X,58).[CZ-2:TZ-2] NEQ 0#, 00009000 STRINGIZE(X) = (X) & STRINGTAG [47:48-FZ]#, 00009200 MPAIRP(X) = CT(X,88).TAG = 0#, 00009300 MATOM(X) = CT(X,79).TAG NEQ 0#, 00009400 MINTERNED(X) = BOOLEAN(X).[FZ:1]#, 00009500 MGLOBALP(X) = BOOLEAN(ISPPNAME[(X).FIELD]).[FZ+1:1]#, 00009600 MFLUIDP(X) = BOOLEAN(ISPPNAME[(X).FIELD]).[FZ+2:1]#, 00009700 MSIMPLE(X) = ((X).TAG NEQ 0 AND (X).TAG NEQ VECTORTAG AND 00009800 (X).TAG NEQ BIGTAG)#, 00009900 RPUSH(X) = BEGIN TSP[SP]:=X; SP:=SP+1 END#, 00010000 RPOP = TSP[SP:=SP-1]#, 00010100 IGNORE(X) = (REAL(BOOLEAN(X) AND BOOLEAN(IGNORABLES)) NEQ 0 00010110 OR X=NIL)#, 00010120 CHECKSTACK(S) = IF (S)+TSPPTR>=TSPMAX THEN EXPANDSTACK#, 00010200 ERRORID = (NIL+3)#, 00010300 BRANDNEW = ((4"FFFF").ISPPTRF)#, 00010400 TRUTH(X) = (REAL(X)+NIL)#; 00010500 00010600 % OTHER USEFUL MACROS 00010700 00010800 00010900 DEFINE 00011000 ZLITER(CHR) = (CHR IN LETTERS)#, 00011100 ZDIGIT(CHR) = (CHR>="0" AND CHR <="9")#, 00011200 XEQUAL = ARG1 := TRUTH(ZEQUAL(ARG1,ARG2))#, 00011300 VCODEP(R) = TRUTH(MCODEP(R))#, 00011400 VIDP(R) = TRUTH(MIDP(R))#, 00011500 VNUMBERP(R) = TRUTH(MNUMBERP(R))#, 00011600 VPAIRP(R) = TRUTH(MPAIRP(R))#, 00011700 VATOM(R) = TRUTH(MATOM(R))#, 00011800 MORDERP(A,B) = TRUTH(A>=B)#, 00011900 VCONSTANTP(R) = TRUTH(MCONSTANTP(R))#, 00012000 VVECTORP(R) = TRUTH(MVECTORP(R))#, 00012100 VNULL(R) = TRUTH(R=NIL)#, 00012200 VSTRINGP(R) = TRUTH(MSTRINGP(R))#, 00012300 MXGLOBALP = ARG1 := IF MIDP(ARG1) THEN 00012400 TRUTH(MGLOBALP(ARG1)) ELSE NIL#, 00012500 MXFLUIDP = ARG1 := IF MIDP(ARG1) THEN 00012600 TRUTH(MFLUIDP(ARG1)) ELSE NIL#, 00012700 ZADDTOCHRS(X) = ((X)*4) & STRINGTAG TAG#, 00012800 MUPLIM = ARG1 := IF MVECTORP(ARG1) THEN 00013100 VSP[ARG1.FIELD] ELSE NIL#, 00013200 MPUTPROP = ISPPROP[ARG1.FIELD] := ARG2#, 00013300 MGETPROP(X) = ISPPROP[(X).FIELD]#, 00013400 MPUTG = ISPVALUE[ARG1.FIELD] := ARG2#, 00013500 MGETG(X) = ISPVALUE[(X).FIELD]#, 00013600 VEQ(A,B) = CT(TRUTH(A=B),26)#, 00013700 VEQN(A,B) = TRUTH(ZEQN(A,B))#, 00013710 VEQUAL(A,B) = TRUTH(ZEQUAL(A,B))#, 00013800 ZEQ(A,B) = CT(A,26) = B#, 00013810 ZMEMQ(A,B) = MMEMQ(A,B) NEQ NIL#, 00013900 ZMEMBER(A,B) = MMEMBER(A,B) NEQ NIL#; 00014000 00014100 00014200 REAL NIL,T,ZERO,ONE,TWO,THREE,ITEMP,MTEMP,MTEMPLOC,ALWAYS,SOMETIMES; 00014300 REAL PRIME,PRIMEZ,PRIMEZZ,PRIMEX; % FOR MODULAR ARITHMETIC FUNCTIONS 00014310 BOOLEAN PRIMEBIG; 00014320 REAL WORKSET,INUSE,RHO,OLDTIME,APAGEMAX,ZA,ZB; %VARIABLES CONTROL GC 00014400 REAL IGNORABLES,QPTR; 00014410 ARRAY RCVLOC[0:0]; % RECEIVING VARIABLE FOR NEWP INTRINSICS 00014420 LONG ARRAY SEARCHPAGE[0:PAGESIZE-1]; % PLACE WHICH ALLOWS SEARCHING 00014430 00014500 00014600 % I SPACE. EACH ELEMENT IS AN IDENTIFIER CONSISTING OF 3 PARTS: 00014700 % (1) POINTER TO A PRINT NAME [I.SP.PNAME(...)] 00014800 % (2) POINTER TO PROPERTY LIST OF IDENTIFIER [ISPPROP(...)] 00014900 % (3) POINTER TO GLOBAL VALUE [ISPVALUE(...)] 00015000 LONG ARRAY ISPPNAME[0:511]; 00015100 ARRAY ISPPROP [0:ISPMAX-1]; 00015200 ARRAY ISPVALUE[0:ISPMAX-1]; 00015300 $ SET OMIT = NOT COUNT 00015400 ARRAY ISPCNT,ISPWEIGHT[0:ISPMAX-1]; 00015500 $ POP OMIT 00015600 REAL ISPFREE,ISPHIGH,AISPMAX; 00015700 00015800 % S SPACE. A BIG OLD CHARACTER STRING. THE FIRST CHARACTER IS 0 - 255 00015900 % AND IS THE STRING LENGTH OF WHAT FOLLOWS. 00016000 EBCDIC ARRAY SSP[0:SSPBMAX,0:63]; 00016100 REAL ZGET1,ZGET2; 00016200 00016300 % P SPACE. DOTTED PAIR SPACE IN TWO ARRAYS. 00016400 ARRAY MCAR,MCDR[0:PSPMAX-1]; 00016500 BOOLEAN ARRAY PPAGEUSEDA[0:(PPAGEMAX) DIV 48]; 00016600 DEFINE PPAGEUSED[X] = PPAGEUSEDA[(PJUNK:=X) DIV 48].[PJUNK MOD 48:1]#;00016700 REAL PJUNK; 00016800 REAL PSPFREE; 00016900 00017000 % V SPACE. JUST POINTERS (THE FIRST ENTRY IS ALWAYS THE UPLIM VALUE) 00017100 % WHICH ARE THE ELEMENTS OF ARRAYS. 00017200 ARRAY VSP[0:VSPMAX-1]; 00017300 REAL VSPFREE; 00017400 00017500 % T SPACE. THIS IS THE STACK WHICH HAS XSUBR NAMES ON IT AND 00017600 % ALL THE LAMBDA BINDINGS. 00017700 ARRAY TSP[0:PAGESIZE]; 00017800 REAL TSPMAX,TSPPTR; 00017900 00018000 % E.SP IS EVAL STACK 00018100 ARRAY ESP[0:PAGESIZE]; 00018200 REAL ES,ESPMAX; 00018300 00018400 % Q.SP IS SPACE WHICH CONTROLS LINKAGE TO GLOBALS, FLUIDS, LITERALS, 00018500 % AND CODE. 00018600 ARRAY QSP[0:QSPMAX-1]; 00018700 REAL CURQPROGPTR,CURSTACKBASE; %FOR BACK TRACKING. 00018800 00018906 % ARITHARRAY1 AND 2 ARE USED FOR ARITHMETIC ON LARGE NUMBERS 00018908 ARRAY ARITHARRAY1,ARITHARRAY2[0:20]; 00018910 00019000 % I/O STUFF HERE. 00019100 EBCDIC ARRAY TLINER,LINER[0:80]; 00019200 REAL SPOCOUNT; 00019300 EBCDIC ARRAY OUTER[0:131]; 00019400 REAL INPTR, OUTPTR, CURCHANIN, CURCHANOUT; 00019500 BOOLEAN FILEINUSEA; 00019600 DEFINE FILEINUSE[X] = FILEINUSEA.[X:1]#, 00019700 FILEINPUT[X] = FILEINUSEA.[X+23:1]#; 00019800 00019900 % GLOBALS ASSOCIATED WITH ERROR/ERRORSET. 00020000 ARRAY ERRS[0:30]; 00020100 00020200 % MISCELLANEOUS DECLARATIONS. 00020300 BOOLEAN STRINGSNEEDIT; %USED BY GARBAGE COLLECTION 00020400 REAL NEWSCNT1,NEWSCNT2; %CONTROLS GARB COLLECT OF STRINGS 00020500 BOOLEAN ATEND; %USED AFTER EOF ON ME. 00020600 BOOLEAN ASKING; %USER IS ASKING FOR STATUS 00020700 BOOLEAN BREAK; %USER HIT BREAK KEY 00020800 BOOLEAN HIGH; %THROWING UNDER A HI 00020810 BOOLEAN RECENTREAD; %LAST TTY I/O WAS A READ 00020900 REAL GGENSYM; %GENSYM COUNTER. 00021000 REAL BASKET; %THROW-BACK. 00021100 BOOLEAN BACKOUT; %TRUE=THROWING. 00021200 EVENT THROW; %CASUED WHEN THROWING 00021300 REAL CATCHCOUNTER; %CATCH RECURSION DEPTH 00021400 REAL THROWCOUNTER; %BUMPED AT EACH THROW 00021500 REAL CATCHER; %BUMPED FOR EACH CATCH 00021600 REAL MICROCOUNT,STARTTRACE; %MICRO INSTRUCTION COUNTER. 00021700 REAL UNBOUND; %UNBOUND VALUE. 00021800 REAL BEGINTIME; %TIME AT BEGINNING. 00021900 REAL GARBAGETIME; %TIME IN GARBAGE COLLECTION 00022000 00022100 TRUTHSET LETTERS("ABCDEFGHIJKLMNOPQRSTUVWXYZ" OR 00022200 "abcdefghijklmnopqrstuvwxyz"); 00022300 TRUTHSET LETTERSNDIGITS("0123456789" OR LETTERS); 00022400 TRUTHSET IDCHARACTERS(LETTERSNDIGITS OR "!"); 00022500 TRUTHSET LETTERSNBANG(LETTERS OR "!"); 00022600 TRUTHSET DIGITSNSIGN("0123456789" OR "+" OR "-"); 00022700 00022800 % GLOBALS ASSOCIATED WITH IDENTIFIERS REQUIRED. 00022900 ARRAY GLOBALVECT[0:GLOBLENGTH+10]; 00023000 DEFINE GLAMBDA = GLOBALVECT[0] #, 00023100 GEOL = GLOBALVECT[1] #, 00023200 GEOF = GLOBALVECT[2] #, 00023300 GATOM = GLOBALVECT[4] #, 00023500 GAPPLY = GLOBALVECT[7] #, 00023800 GEXPR = GLOBALVECT[8] #, 00023900 GFEXPR = GLOBALVECT[9] #, 00024000 GSUBR = GLOBALVECT[10] #, 00024100 GFSUBR = GLOBALVECT[11] #, 00024200 GMACRO = GLOBALVECT[12] #, 00024300 GEMSG = GLOBALVECT[13] #, 00024400 GECHO = GLOBALVECT[14] #, 00024500 GRAISE = GLOBALVECT[15] #, 00024600 GCATCH = GLOBALVECT[17] #, 00024800 GOUTPUT = GLOBALVECT[18] #, 00024900 GINPUT = GLOBALVECT[19] #, 00025000 GBPROG = GLOBALVECT[20] #, 00025100 GFLOATING = GLOBALVECT[22] #, 00025300 GCFLAG = GLOBALVECT[27] #, 00025700 GGETV = GLOBALVECT[28] #, 00025800 GPUTV = GLOBALVECT[29] #, 00025900 GARITHMETIC = GLOBALVECT[31] #, 00026100 GID = GLOBALVECT[32] #, 00026200 GLINELENGTH = GLOBALVECT[33] #, 00026300 GVECTOR = GLOBALVECT[34] #, 00026400 GINTEGER = GLOBALVECT[35] #, 00026500 GREMOB = GLOBALVECT[36] #, 00026600 GMKVECT = GLOBALVECT[37] #, 00026700 GPRINC = GLOBALVECT[38] #, 00026800 GEXPLODE = GLOBALVECT[40] #, 00027000 GSCNVAL = GLOBALVECT[41] #, 00027100 GUNBOUND = GLOBALVECT[42] #, 00027200 GPROMPT = GLOBALVECT[43] #, 00027300 GSETPCHAR = GLOBALVECT[44] #, 00027400 GGLOBAL = GLOBALVECT[46] #, 00027500 GFLUID = GLOBALVECT[47] #, 00027600 GUNFLUID = GLOBALVECT[48] #, 00027700 GIDORSTRING = GLOBALVECT[49] #, 00027800 GINTERN = GLOBALVECT[50] #, 00027900 GOPEN = GLOBALVECT[51] #, 00028000 GINITIALISE = GLOBALVECT[52] #, 00028100 GMOD = GLOBALVECT[53] #; 00028110 00028200 % HERE ARE THE PSEUDO REGISTERS 00028300 00028400 00028500 NUMBER NUM,SNUM,QNUM; 00028600 REAL ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,ARG9,ARG10,ARG11,ARG12, 00028700 ARG13,ARG14,ARG15,ARG16; 00028800 DEFINE 00028900 ARG'0 = ARG1#, ARG'1 = ARG2#, ARG'2 = ARG3#, ARG'3 = ARG4#, 00029000 ARG'4 = ARG5#, ARG'5 = ARG6#, ARG'6 = ARG7#, ARG'7 = ARG8#, 00029100 ARG'8 = ARG9#, ARG'9 = ARG10#, ARG'10 = ARG11#, ARG'11 = ARG12#, 00029200 ARG'12 = ARG13#, ARG'13 = ARG14#, ARG'14 = ARG15#, ARG'15 = ARG16#; 00029300 DEFINE ARGS[N] = CASE N OF (ARG'0,ARG'1,ARG'2,ARG'3,ARG'4,ARG'5, 00029400 ARG'6,ARG'7,ARG'8,ARG'9,ARG'10,ARG'11, 00029500 ARG'12,ARG'13,ARG'14,ARG'15)#; 00029600 00029800 % MACROS, PROCEDURES AND OTHER DECLARATIONS FOR I/O 00030900 00031000 00031100 % IOFILE IS AN ARRAY OF THE POSSIBLE FILES EXCEPT FOR DATA COMM I/O. 00031200 % THE POINTERS CUR.CHAN.IN, CUR.CHAN.OUT ARE THE ARRAY ELEMENT + 1. 00031300 % FILE 0 IS DATA COMM I/O AND IS TREATED SPECIALLY. 00031400 FILE ME(KIND=REMOTE,MYUSE=IO,MAXRECSIZE=80,UNITS=CHARACTERS); 00031500 FILE ME2(KIND=REMOTE,MYUSE=IO,MAXRECSIZE=80,UNITS=CHARACTERS); 00031600 FILE CARDS(KIND=DISK,FILETYPE=8); 00031700 FILE LINE (KIND=PRINTER,MAXRECSIZE=22); 00031800 FILE FILE1(KIND=DISK,FILETYPE=8); 00031900 FILE FILE2(KIND=DISK,FILETYPE=8); 00032000 FILE FILE3(KIND=DISK,FILETYPE=8); 00032100 FILE FILE4(KIND=DISK,FILETYPE=8); 00032200 FILE FILE5(KIND=DISK,FILETYPE=8); 00032300 FILE FILE6(KIND=DISK,FILETYPE=8); 00032400 FILE FILE7(KIND=DISK,FILETYPE=8); 00032500 SWITCH FILE IOFILE := ME,CARDS,LINE,FILE1,FILE2,FILE3,FILE4,FILE5, 00032600 FILE6,FILE7; 00032700 ARRAY FILEINFO,IOHERE,IOSTOP[0:FMAX]; 00032800 00032900 DEFINE 00033000 CAT = ,#, 00033100 CONVERT(W,N) = CONVERTPTR FOR CONVERTER(W,N)#, 00033200 STRINGLENGTH(A)= REAL(SSP[A.BUCKF,A.SLOCF],1)#, 00033300 ZGETSTRING(A) = SSP[ZGETSTRINGPROC(A),ZGET1] FOR ZGET2#, 00033400 DECIMAL(W,N) = W FOR N DIGITS#, 00033500 FOUR = 6#, 00033600 WRITELINE(S) = 00033700 BEGIN 00033800 REPLACE COLLECTOR BY S; 00033900 WRITELINEPROC(1); 00034000 END#, 00034100 WRITELINEDOUBLE(S) = 00034200 BEGIN 00034300 REPLACE COLLECTOR BY S; 00034400 WRITELINEPROC(2); 00034500 END#, 00034600 WRITETTY(S) = 00034700 BEGIN 00034800 REPLACE COLLECTOR BY S; 00034900 WRITETTYPROC; 00035000 END#, 00035100 WRITEIOFILE(N,S) = 00035200 BEGIN 00035300 REPLACE COLLECTOR BY S; 00035400 WRITEIOPROC(N); 00035500 END#, 00035600 ERRSTOP(S) = 00035700 BEGIN 00035800 REPLACE COLLECTOR[7] BY S; 00035900 ERRORSTOP; 00036000 END#, 00036100 ZDMPATOM(A,L) = 00036200 BEGIN 00036300 STOPCOUNT; 00036350 IF L+PTR>LL THEN XTERPRI; 00036400 STARTCOUNT; 00036450 REPLACE BFR[PTR] BY A; 00036500 PTR:=PTR+L; 00036600 MICROBUMP(7); 00036700 END#; 00036800 00036900 EBCDIC ARRAY COLLECTOR[0:131]; 00037000 POINTER CONVERTPTR; 00037100 ARRAY CONVERTARRAY[0:1]; 00037200 00037300 PROCEDURE WRITELINEPROC(N); VALUE N; REAL N; 00037400 BEGIN LABEL EXIT; 00037500 WRITE(LINE[SPACE N],22,COLLECTOR); 00037600 REPLACE COLLECTOR BY " " FOR 132; 00037700 END OF WRITELINEPROC; 00037800 00037900 PROCEDURE WRITETTYPROC; 00038000 BEGIN LABEL EXIT; 00038100 IF NOT BREAK THEN 00038200 BEGIN 00038300 BREAK := IF ATEND THEN 00038400 WRITE(ME2,80,COLLECTOR) 00038500 ELSE 00038600 WRITE(ME,80,COLLECTOR); 00038700 IF BREAK THEN IF RECENTREAD THEN 00038800 BREAK := IF ATEND THEN 00038900 WRITE(ME2,14,COLLECTOR) 00039000 ELSE 00039100 WRITE(ME,80,COLLECTOR); 00039200 END; 00039300 REPLACE COLLECTOR BY " " FOR 132; 00039400 RECENTREAD := FALSE; 00039500 END OF WRITETTYPROC; 00039600 00039700 PROCEDURE ERRORSTOP; 00039800 BEGIN LABEL EXIT; 00039900 REPLACE COLLECTOR BY "*" FOR 7; 00040000 WRITE(ME,80,COLLECTOR); 00040100 REPLACE COLLECTOR BY "FATAL ERROR " CAT " " FOR 60; 00040200 WRITE(ME,80,COLLECTOR); 00040300 READ(ME); 00040400 REPLACE COLLECTOR BY " " FOR 132; %PPDMTL10 00040500 END OF ERRORSTOP; 00040600 00040700 PROCEDURE EXPANDSTACK; 00040800 BEGIN LABEL EXIT; 00040900 IF TSPMAX>2**15 THEN 00041000 ERRSTOP("STACK OVERFLOW"); 00041100 RESIZE(TSP,TSPMAX:=TSPMAX+PAGESIZE,RETAIN); 00041200 END EXPANDSTACK; 00041300 00041400 00041500 REAL PROCEDURE CONVERTER(W,N); VALUE W,N; REAL W,N; 00041600 BEGIN LABEL EXIT; 00041700 CONVERTARRAY[0]:=W; 00041800 REPLACE CONVERTPTR BY POINTER(CONVERTARRAY[1],4)-N 00041900 FOR N WITH HEXTOEBCDIC; 00042000 CONVERTER:=N; 00042100 END CONVERTER; 00042200 00042300 PROCEDURE WRITEIOPROC(N); VALUE N; REAL N; 00042400 BEGIN LABEL EXIT; 00042500 IF N=0 THEN WRITETTYPROC ELSE 00042600 BEGIN 00042700 WRITE(IOFILE[N],IF N=1 THEN 22 ELSE 14,COLLECTOR); 00042800 REPLACE COLLECTOR BY " " FOR 132; 00042900 END; 00043000 END; 00043100 00043200 $ SET OMIT = COUNT 00043300 DEFINE COUNT(N) = #, MICROBUMP(I) = #, BEGINCOUNT = #, ENDCOUNT = #,00043400 STARTCOUNT = #, STOPCOUNT = #, DECLARECOUNT = #, 00043500 DECLAREANDWEIGH = #, 00043600 PRIMTRACE(N) = #, 00043700 PRIMCOUNTER(N) = #, 00043710 DECLARE(X,N,M) = 00043800 DEFINE X = BEGIN M END##, 00043900 JUMP(B) = B#, 00044000 CT(V,N) = V#; 00044100 $ POP OMIT SET OMIT = NOT COUNT 00044200 DEFINE COUNT(N) = OPCODE[N]:=*+1#, MICROBUMP(I) = MICROCOUNT:=*+I#, 00044300 BEGINCOUNT = C:=-MICROCOUNT; ISPCNT[QSP[QNUM].FIELD]:=*+1#, 00044400 ENDCOUNT = ISPWEIGHT[QSP[QNUM].FIELD] := *+C+MICROCOUNT#, 00044500 STARTCOUNT = C:=C-MICROCOUNT#, STOPCOUNT = C:=C+MICROCOUNT#, 00044600 DECLARECOUNT = REAL C#, 00044700 PRIMCOUNTER(N) = MICROCOUNT:=*+1; 00044710 OPCODE[N]:=*+1; 00044720 OPWEIGHT[N]:=*+C+MICROCOUNT#, 00044730 DECLAREANDWEIGH = REAL C; C:=-MICROCOUNT#; 00044740 ARRAY OPWEIGHT,OPCODE[0:PRIMNUM]; 00044900 ARRAY TRACETABLE[0:PRIMNUM*2]; 00045000 DEFINE 00045100 PRIMTRACE(N) = MICROBUMP(1); COUNT(N)#, 00045200 DECLARE(X,N,M) = 00045300 PROCEDURE X; 00045400 BEGIN M; PRIMTRACE(N) END#; 00045500 BOOLEAN PROCEDURE JUMP(B); VALUE B; BOOLEAN B; 00045600 BEGIN PRIMTRACE(99); JUMP:=B END; 00045700 REAL PROCEDURE CT(V,N); VALUE V,N; REAL V,N; 00045800 BEGIN LABEL EXIT; 00045900 PRIMTRACE(N); 00046000 CT := V; 00046100 END CT; 00046200 $ POP OMIT 00046300 00046400 00046500 % NEWP PRIMATIVES FOR GARBAGE COLLECTION 00047000 00047100 $ SET OMIT = NOT NEWP 00047200 00047300 LIBRARY LISP_SUPPORT(FUNCTIONNAME = "LISPSUPPORT.", %PPDMTL01 00047400 LIBACCESS = BYFUNCTION); %PPDMTL01 00047410 00047500 REAL PROCEDURE STACKOFFSET(V); 00047600 VALUE V; REAL V; LIBRARY LISP_SUPPORT; 00047700 PROCEDURE COPYFROMSTACK(N,P,I); 00047800 VALUE N,I,P; REAL I,N; POINTER P; LIBRARY LISP_SUPPORT; 00047900 REAL PROCEDURE MASKSTACKSEARCHER(V,M,R,I); 00048000 VALUE V,I,M; REAL V,I,M; ARRAY R[0]; LIBRARY LISP_SUPPORT; 00048100 00048200 $ POP OMIT 00048300 00048400 % FORWARD PROCEDURES. 00049100 REAL PROCEDURE ZCONS(A,B); VALUE A,B; REAL A,B; FORWARD; 00049200 PROCEDURE ZERROR(A, B); VALUE A,B; REAL A,B; FORWARD; 00049300 PROCEDURE MLIST(A,B); VALUE A,B; REAL A,B; FORWARD; 00049310 PROCEDURE MTMSMTCH(A,B,C); VALUE A,B,C; REAL A,B,C; FORWARD; 00049400 REAL PROCEDURE ZGETSTRINGPROC(A); VALUE A; REAL A; FORWARD; 00049500 PROCEDURE XCALL(N); VALUE N; REAL N; FORWARD; 00049600 PROCEDURE XTERPRI; FORWARD; 00049700 PROCEDURE YEVAL; FORWARD; 00049800 PROCEDURE YERROR; FORWARD; 00049810 PROCEDURE YINITIALISE; FORWARD; 00049820 PROCEDURE YSTANDARDQ11LISP; FORWARD; 00049830 PROCEDURE YQ01TQ19MSMTCH; FORWARD; 00049840 PROCEDURE ZPATOM(A,B,O); VALUE A,B; REAL A; BOOLEAN B; 00049900 EBCDIC ARRAY O[0]; FORWARD; 00049910 PROCEDURE FAULTPROCESSOR(FA,FN); VALUE FN; REAL FN; ARRAY FA[0]; 00050000 FORWARD; 00050100 00050200 $ PAGE 00050300 %SEGMENT(FASTLOAD); 00050400 PROCEDURE FASTLOAD; 00050500 BEGIN 00050600 % READ THE FILE CREATED BY SLISP/BOOTER. SEE THE DOCUMENTATION OF 00050700 % THIS PROGRAM FOR THE FORMATS OF EACH ENTRY. 00050800 ARRAY BBF[0:30]; 00050900 %FILE INIT (KIND=DISK,MAXRECSIZE=30,BLOCKSIZE=300); 00051000 REAL BPTR, CNT, BNO, I, J, QPROG, TMP; 00051200 POINTER P,Q; 00051300 REAL PROCEDURE FASTFETCH; 00051400 % RETURN THE NEXT ENTRY FROM THE BBF BUFFER. READ A NEW LINE WHEN 00051500 % NECESSARY. 00051600 BEGIN LABEL EOF; REAL J,T; 00051700 IF BPTR>=30 THEN BEGIN 00051800 READ(INIT,30,BBF)[EOF]; 00051900 IF FALSE THEN 00052000 EOF: ERRSTOP("PREMATURE END OF FILE"); 00052100 BPTR := 0; 00052200 END; 00052300 FASTFETCH:=BBF[BPTR]; 00052400 BPTR:=*+1; 00052500 END FASTFETCH; 00052600 00052700 00052800 PROCEDURE FETCHBLOCK(N,P); VALUE N,P; REAL N; POINTER P; 00052900 BEGIN REAL I,J; 00053000 IF I=N; 00054100 END FETCHBLOCK; 00054200 00054300 00054400 BPTR := 30; %FORCE THE FIRST READ. 00054600 IF NOT INIT.PRESENT THEN %QUIT IF NOT FILE AVAILABLE. 00054700 BEGIN 00054800 REPLACE OUTER BY " " FOR 132; 00054810 REPLACE OUTER BY INIT.TITLE; 00054820 ERRSTOP("MISSING INIT FILE: " CAT OUTER FOR 80); 00054830 END; 00054840 WHILE (TMP:=FASTFETCH)<9 DO 00054900 BEGIN %PICK UP THE IDENTIFIER CODE. 00055000 CASE TMP OF BEGIN 00055100 ; %0 IS A NOP. 00055200 BEGIN %1 -> READ IN THE IDENTIFIER SPACE ENTRIES. 00055300 CNT := FASTFETCH; %PICK UP THE NUMBER OF ENTRIES. 00055400 IF CNT>=ISPMAX THEN ERRSTOP("ID SPACE JAM"); 00055500 I := MIN((CNT+2*PAGESIZE) DIV PAGESIZE * PAGESIZE,ISPMAX); 00055600 IF I>AISPMAX THEN 00055700 RESIZE(ISPPNAME,AISPMAX:=I,RETAIN); 00055800 FETCHBLOCK(CNT,POINTER(ISPPNAME[0])); 00055900 FETCHBLOCK(CNT,POINTER(ISPVALUE[0])); 00056000 FOR I:=0 STEP 1 UNTIL CNT DO 00056100 BEGIN 00056200 MINTERNED(ISPPNAME[I]) := TRUE; 00056300 ISPPROP[I] := NIL; 00056400 END; 00056500 ISPPNAME[ISPFREE:=CNT] := NIL; 00056510 END IDSPACEBUILD; 00056600 00056700 BEGIN %2 -> READ ALL THE PAIRS. 00056800 PSPFREE := CNT := FASTFETCH; 00056900 IF PSPFREE>=PSPMAX THEN ERRSTOP("P SPACE JAM"); 00057000 FETCHBLOCK(CNT,POINTER(MCAR[0])); 00057100 FETCHBLOCK(CNT,POINTER(MCDR[0])); 00057200 END PAIRSPACEBUILD; 00057700 00057800 BEGIN %3 -> BUILD UP THE STRING SPACE. 00057900 BNO := FASTFETCH; %PICK UP THE BUCKET NUMBER. 00058000 CNT := FASTFETCH; %PICK UP THE BYTE COUNT. 00058100 I:=SIZE(SSP[BNO,*]); 00058200 IF I-30 THEN 00058900 REPLACE SSP[BNO,CNT] BY (I-CNT-2).[15:48] FOR 2; 00059000 END STRINGSPACEBUILD; 00059100 ; %4 -> NOT USED. 00059200 BEGIN %5 --> INITIALIZE ONE OF THE ERROR MESSAGES.00059300 CNT := FASTFETCH; %PICK UP GLOBAL ENTRY NUMBER. 00059400 ERRS[CNT] := FASTFETCH; 00059500 END ERRORMSGFETCH; 00059600 00059700 BEGIN %6 --> INITIALIZE GLOBAL IDENTIFIERS. 00059800 CNT := FASTFETCH; %GLOBAL TABLE NUMBER. 00059900 GLOBALVECT[CNT] := FASTFETCH; 00060000 END IDGLOBALBUILD; 00060100 00060200 BEGIN %7 -> NOT USED 00060300 END INITBSPACE; 00060800 00060900 BEGIN %8 -> INITIALIZE A Q SPACE BLOCK. 00061000 CNT := FASTFETCH; %COUNT OF WORDS TO MOVE. 00061100 FETCHBLOCK(CNT,POINTER(QSP[QPROG])); 00061200 QPROG:=*+CNT; 00061300 END INITQSPACE; 00061400 00061500 END CASE; 00061600 END READINIT; 00061700 IF TMP > 10 THEN ERRSTOP(CONVERT(TMP,FOUR) CAT 00061800 " IS AN INVALID FASTLOAD OPCODE"); 00061900 MINTERNED(ISPPNAME[ISPVALUE[GUNBOUND.FIELD].FIELD]) := FALSE; 00062000 UNBOUND := ISPVALUE[GUNBOUND.FIELD]; 00062100 QPTR := QPROG; 00062200 ISPHIGH:=ISPFREE-1; 00062300 END FASTLOAD; 00062400 $PAGE 00062500 00062600 PROCEDURE ANSWERHI; 00062700 BEGIN 00062800 EBCDIC ARRAY A[0:29]; 00062900 PICTURE PRETTYI(P EEEDEEEDEEEDEEE), PRETTYP(ZZZZI99), 00063000 PRETTYT(P EEDEEEI99); 00063100 REAL I,J,K; 00063200 LABEL EXIT; 00063300 IF ATEND THEN WRITETTY("END OF FILE - STANDARD INPUT DEVICE"); 00063400 J := TIME(12) - BEGINTIME; 00063500 REPLACE A BY INTEGER(J*2.4@-4) FOR 12 DIGITS, INTEGER(GARBAGETIME* 00063600 2.4@-4) FOR 12 DIGITS, INTEGER(10000*GARBAGETIME/J) FOR 6 DIGITS;00063700 WRITETTY("TOTAL TIME =" CAT A[5] WITH PRETTYT CAT ", GC TIME =" 00063800 CAT A[17] WITH PRETTYT CAT ", " CAT A[24] WITH PRETTYP CAT "%");00063900 IF CURCHANIN>0 THEN 00063910 WRITETTY("LINE NUMBER = " CAT IOHERE[CURCHANIN] FOR 8 NUMERIC);00063920 WRITETTY("I = " CAT AISPMAX FOR I:5 NUMERIC CAT 00064000 ", T = " CAT TSPMAX FOR I:5 NUMERIC CAT 00064100 ", E = " CAT ESPMAX FOR I:5 NUMERIC CAT 00064200 ", Q = " CAT QPTR FOR I:5 NUMERIC); 00064300 IF MICROCOUNT <= 1 THEN GO TO EXIT; 00064500 REPLACE A BY MICROCOUNT FOR 12 DIGITS; 00064600 WRITETTY(" MICRO-INSTRUCTIONS EXECUTED: " CAT 00064700 A WITH PRETTYI); 00064800 REPLACE A BY (MICROCOUNT DIV (J*2.4@-6)) FOR 12 DIGITS; 00064900 WRITETTY(" INSTRUCTIONS/SECOND: " CAT 00065000 A WITH PRETTYI); 00065100 WRITETTY(" MILLI SECONDS PER INSTRUCTION: " CAT 00065200 ((J*2.4@-3)/MICROCOUNT) FOR 6 NUMERIC); 00065300 $ SET OMIT = NOT COUNT 00065400 J:=K:=0; 00065500 FOR I:=0 STEP 1 UNTIL PRIMNUM DO 00065600 BEGIN J:=OPCODE[I]+J; K:=OPWEIGHT[I]+K END; 00065700 K:=K+J; 00065710 FOR I:=0 STEP 1 UNTIL PRIMNUM DO 00065800 IF OPCODE[I]>0 THEN 00065900 BEGIN 00066000 REPLACE A BY OPCODE[I] FOR 12 DIGITS, 00066100 OPCODE[I]*10000 DIV J FOR 6 DIGITS, 00066200 (OPWEIGHT[I]+OPCODE[I])*10000 DIV K FOR 6 DIGITS; 00066210 WRITETTY(A WITH PRETTYI CAT A[12] WITH PRETTYP CAT 00066300 A[18] WITH PRETTYP CAT " " CAT 00066310 POINTER(TRACETABLE[2*I]) FOR 12); 00066400 OPCODE[I]:=OPWEIGHT[I]:=0; 00066500 END; 00066600 REPLACE A BY J FOR 12 DIGITS; 00066700 WRITETTY(A WITH PRETTYI CAT " TOTAL"); 00066800 J:=K:=0; WRITETTY(" "); WRITETTY(" "); 00066900 FOR I:=0 STEP 1 UNTIL ISPHIGH DO 00067000 BEGIN J:=ISPCNT[I]+J; K:=ISPWEIGHT[I]+K END; 00067100 FOR I:=0 STEP 1 UNTIL ISPHIGH DO 00067200 IF ISPCNT[I]>0 THEN 00067300 BEGIN 00067400 REPLACE A BY ISPCNT[I] FOR 12 DIGITS, 00067500 ISPCNT[I]*10000 DIV J FOR 6 DIGITS, 00067600 ISPWEIGHT[I]*10000 DIV K FOR 6 DIGITS; 00067700 WRITETTY(A WITH PRETTYI CAT A[12] WITH PRETTYP CAT 00067800 A[18] WITH PRETTYP CAT " " CAT 00067900 ZGETSTRING(STRINGIZE(ISPPNAME[I]))); 00068000 ISPCNT[I]:=ISPWEIGHT[I]:=0; 00068100 END; 00068200 WRITETTY(" "); 00068300 REPLACE A BY J FOR 12 DIGITS; 00068400 WRITETTY(A WITH PRETTYI CAT " TOTAL"); 00068500 $ POP OMIT 00068600 EXIT: 00068700 ASKING:=FALSE; 00068800 END ANSWERHI; 00068900 00069000 00069100 PROCEDURE TDUMP(MSG, A, B, C); VALUE A,B,C,MSG; BOOLEAN A,B,C; 00069200 REAL MSG; 00069300 BEGIN REAL I,L,TMP,TNP; 00069400 BOOLEAN PRINTIT; 00069500 LABEL EXIT; 00069600 EBCDIC ARRAY LNE[0:131]; 00069700 WRITELINE ("********** " CAT MSG FOR 6 CAT " **********"); 00069800 WRITELINEDOUBLE (" -- BUFFERS/POINTERS --"); 00069900 WRITELINEDOUBLE ("LINER:" CAT LINER FOR 80); 00070000 WRITELINE ("OUTER:" CAT OUTER FOR 126); 00070100 WRITELINE ("INPTR:" CAT DECIMAL(INPTR, 3) CAT 00070200 " OUTPTR:" CAT DECIMAL(OUTPTR, 3) CAT 00070300 " CURCHANIN: " CAT DECIMAL(CURCHANIN, 2) CAT 00070400 " CURCHANOUT: " CAT DECIMAL(CURCHANOUT, 2)); 00070500 WRITELINE ("ISPFREE:" CAT CONVERT(ISPFREE,FOUR) CAT 00070600 " PSPFREE:" CAT CONVERT(PSPFREE,FOUR) CAT 00070700 " VSPFREE:" CAT CONVERT(VSPFREE,FOUR) CAT 00070800 " TSPPTR:" CAT CONVERT(TSPPTR,FOUR)); 00070900 WRITELINE("ARG1-4: " CAT CONVERT(ARG1,FOUR) CAT 00071000 " " CAT CONVERT(ARG2,FOUR) CAT " " CAT 00071100 CONVERT(ARG3,FOUR) CAT " " CAT 00071200 CONVERT(ARG4,FOUR)); 00071300 WRITELINEDOUBLE( 00071400 "MICROCOUNT: " CAT DECIMAL(MICROCOUNT, 8) CAT " BACKOUT: " CAT 00071500 (IF BACKOUT THEN "TRUE " ELSE "FALSE " ) FOR 6); 00071600 00071700 %SEGMENT(TDUMP2); 00071800 IF A THEN 00071900 BEGIN 00072000 WRITELINE (" -- SYMBOL TABLE --"); 00072100 FOR I:=0 STEP 1 UNTIL ISPHIGH DO 00072200 IF ISPPROP[I].FIELD NEQ MAXFIELDV THEN 00072300 WRITELINE(CONVERT(I,4) CAT " " CAT 00072400 CONVERT(ISPPNAME[I].FIELD,4) CAT " " CAT 00072500 CONVERT(ISPPROP[I].TAG,2) CAT " " CAT 00072600 CONVERT(ISPPROP[I].FIELD,4) CAT " " CAT 00072700 CONVERT(ISPVALUE[I].TAG,2) CAT " " CAT 00072800 CONVERT(ISPVALUE[I].FIELD,4) CAT 00072900 (IF MINTERNED(ISPPNAME[I]) THEN " * '" ELSE " '") CAT 00073000 ZGETSTRING(STRINGIZE(ISPPNAME[I])) CAT "' "); 00073100 END SYMBOLTABLEDUMP; 00073200 00073300 %SEGMENT(TDUMP3); 00073400 % DUMP THE PAIR SPACE. 00073500 IF B THEN BEGIN 00073600 I := 0; WRITELINEDOUBLE (" -- P SPACE --"); 00073700 WHILE I=123 THEN BEGIN 00076100 WRITELINE (LNE FOR L); 00076200 TNP := I; 00076300 REPLACE LNE BY CONVERT(TNP, FOUR) CAT " "; L:=8; 00076400 END; 00076500 REPLACE LNE[L] BY CONVERT(QSP[I], FOUR) CAT " "; 00076600 L:=*+7; I:=*+1; 00076700 END DUMPQSPACE; 00076800 WRITELINEDOUBLE (LNE FOR L); 00076900 END PSPACEDUMP; 00077000 00077100 % DUMP THE T SPACE (THE STACK). 00077200 %SEGMENT(TDUMP4); 00077300 IF C THEN BEGIN 00077400 I := TSPPTR - 1; 00077500 WRITELINEDOUBLE(" -- STACK --"); 00077600 WHILE I>0 DO 00077700 BEGIN 00077800 TNP := I; 00077900 WRITELINE ("*** " CAT CONVERT(TNP,FOUR) CAT " '" 00078000 CAT ZGETSTRING(STRINGIZE(ISPPNAME[TSP[I-1].FIELD])) CAT "'"); 00078100 TMP := TSP[I]; 00078200 I := I-2; 00078300 WHILE I>=TMP DO 00078400 BEGIN 00078500 WRITELINE (" " CAT CONVERT(TSP[I],FOUR)); 00078600 I:=I-1; 00078700 END DUMPAFRAME; 00078800 END DUMPSTACK; 00078900 END TSPACEDUMP; 00079000 00079100 EXIT: 00079200 END TDUMP; 00079300 00079400 PROCEDURE XDUMP; 00079500 BEGIN LABEL EXIT; 00079600 DECLAREANDWEIGH; 00079610 MICROBUMP(5); 00079620 PRIMCOUNTER(55); 00079700 TDUMP(" USER ",ARG1 NEQ NIL,ARG2 NEQ NIL,ARG3 NEQ NIL); 00079800 END; 00079900 00080000 PROCEDURE XCHKPOINT; 00080100 BEGIN LABEL EXIT; 00080200 DECLAREANDWEIGH; 00080210 MICROBUMP(5); 00080220 ANSWERHI; 00080300 ARG1:=NIL; 00080400 PRIMCOUNTER(57); 00080500 END; 00080600 00080700 00080800 00080900 % THIS IS THE ARITHMETIC SECTION 00081000 00081010 00081020 00081030 REAL PROCEDURE ZOVERFLOW; 00081040 BEGIN LABEL EXIT; 00081050 ZERROR(119, ERRS[19]); 00081060 END ZOVERFLOW; 00081070 00081080 00081100 00081110 00081120 DEFINE 00081130 VABS[X] = MABS(X)#, 00081140 VMINUS[X] = MMINUS(X)#, 00081150 LPLUS2(X,L) = (IF OVERFLOWP(ITEMP:=X+L) THEN 00081152 VPLUS2(ITEMP-L,NUMB[L]) 00081153 ELSE CT(ITEMP,104))#, 00081154 LDIFF(X,L) = (IF OVERFLOWP(ITEMP:=X-L) THEN 00081155 VDIFFERENCE(ITEMP+L,NUMB[L]) 00081156 ELSE CT(ITEMP,105))#, 00081157 ZEROERR = ZOVERFLOW#; 00081160 00081170 00081180 00081190 REAL PROCEDURE NORMALIZE(L,S,Z); VALUE L,S,Z; REAL L,S,Z; 00081200 BEGIN REAL I,N; 00081210 IF L=1 THEN 00081220 NORMALIZE := IF S<0 THEN 2*ZEROLIT-MCAR[Z] ELSE MCAR[Z] 00081230 ELSE 00081240 BEGIN 00081250 I := ZTRACT(L&S[46:46:1]); 00081260 NORMALIZE := IF L>2 THEN ZCONS(I,Z) & BIGTAG TAG 00081270 ELSE IF OVERFLOWP(N:=ZTRACT( 00081280 (ZEXTEND(MCAR[Z])*BASE+ZEXTEND(MCAR[MCDR[Z]])) &00081290 S [46:46:1])) THEN 00081300 ZCONS(I,Z) & BIGTAG TAG ELSE N; 00081310 END; 00081320 END NORMALIZE; 00081330 00081340 REAL PROCEDURE NUMCHECK(X); VALUE X; REAL X; 00081350 BEGIN LABEL EXIT; 00081360 IF NOT MNUMBERP(X) THEN 00081370 MTMSMTCH(X,GINTEGER,GARITHMETIC); 00081380 END NUMCHECK; 00081390 00081400 REAL PROCEDURE MULTIPLY(X,Y); VALUE X,Y; REAL X,Y; 00081410 BEGIN 00081420 DOUBLE R; 00081430 REAL I,J,Z,L1,L2,L,S,U; 00081440 DEFINE A=ARITHARRAY1#, B=ARITHARRAY2#; 00081450 IF NOT MINTEGERP(X) THEN NUMCHECK(X); 00081460 IF BIGP(X) THEN 00081470 BEGIN 00081480 X.TAG := 0; 00081490 S := ZEXTEND(MCAR[X]); 00081500 L1 := ABS(S)-1; 00081510 IF SIZE(A)<=L1 THEN RESIZE(A,3*L1 DIV 2); 00081520 FOR I:=L1 STEP -1 UNTIL 0 DO 00081530 BEGIN X:=MCDR[X]; A[I]:=ZEXTEND(MCAR[X]) END; 00081540 END 00081550 ELSE 00081560 BEGIN 00081570 S := ZEXTEND(X); 00081580 A[0] := ABS(S); 00081590 L1 := 0; 00081600 END; 00081610 IF NOT MINTEGERP(Y) THEN NUMCHECK(Y); 00081620 IF BIGP(Y) THEN 00081630 BEGIN 00081640 Y.TAG := 0; 00081650 L2 := ZEXTEND(MCAR[Y]); 00081660 S := L2*S; 00081670 L2 := ABS(L2)-1; 00081680 IF SIZE(B)<=L2 THEN RESIZE(B,3*L2 DIV 2); 00081690 FOR I:=L2 STEP -1 UNTIL 0 DO 00081700 BEGIN Y:=MCDR[Y]; B[I]:=ZEXTEND(MCAR[Y]) END; 00081710 END 00081720 ELSE 00081730 BEGIN 00081740 L2 := ZEXTEND(Y); 00081750 S := L2*S; 00081760 B[0] := ABS(L2); 00081770 L2 := 0; 00081780 END; 00081790 L := L1+L2; 00081800 Z := NIL; 00081810 U := -1; 00081820 FOR I:=0 STEP 1 UNTIL L DO 00081830 BEGIN 00081840 IF I<=L2 THEN U:=U+1; 00081850 J := IF I>L1 THEN I-L1 ELSE 0; 00081860 DO R := A[I-J] MUX B[J] + R UNTIL J:=J+1>U; 00081870 Z := ZCONS(ZTRACT(INTEGER(R MOD BASE)),Z); 00081880 R := R DIV BASE; 00081890 END; 00081900 IF R>0 THEN 00081910 BEGIN 00081920 IF R>=BASE THEN 00081930 BEGIN 00081940 Z := ZCONS(ZTRACT(INTEGER(R MOD BASE)),Z); 00081950 R := R DIV BASE; 00081960 L := L+1; 00081970 END; 00081980 Z := ZCONS(ZTRACT(INTEGER(R)),Z); 00081990 L := L+1; 00082000 END; 00082010 MULTIPLY := ZCONS(ZTRACT((L+1)&S[46:46:1]),Z)&BIGTAG TAG; 00082020 END MULTIPLY; 00082030 00082040 00082050 REAL PROCEDURE ADDSUB(X,Y,S); VALUE S,Y,X; REAL S,Y,X; 00082060 BEGIN LABEL EXIT; 00082070 REAL L1,L2,L,H,K,D,E,F,Z; 00082080 00082090 DEFINE ADDON(Z,E) = Z:=MCDR[Z]:=ZCONS(E,NIL)#; 00082100 DEFINE EXCHANGE(Q) = BEGIN 00082110 S:=X; X:=Y; Y:=S; 00082120 L1:=L2+L2-L1; Q; 00082130 END#; 00082140 DEFINE LAYDOWN = BEGIN 00082150 IF E>ZERO THEN ADDON(Z,E) ELSE 00082160 IF Z=ALWAYS THEN L:=L-1 ELSE ADDON(Z,E); 00082170 IF K>0 THEN 00082180 DO ADDON(Z,F) UNTIL (K:=K-1)=0; 00082190 END#; 00082200 00082210 IF NOT MNUMBERP(X) THEN NUMCHECK(X); 00082220 IF SMALLP(X) THEN 00082230 BEGIN 00082240 H := ZEXTEND(X); X := ABS(H); 00082250 IF X>=BASE THEN 00082260 BEGIN L1 := 2; 00082270 X:=ZCONS(ZTRACT(X DIV BASE),ZCONS(ZTRACT(X MOD BASE),00082280 NIL)); 00082290 END ELSE 00082300 BEGIN L1 := 1; 00082310 X := ZCONS(ZTRACT(X),NIL); 00082320 IF H=0 THEN H := 1; 00082330 END; 00082340 MCAR[SOMETIMES] := X; 00082350 END 00082360 ELSE 00082370 BEGIN 00082380 X.TAG := 0; 00082390 H := ZEXTEND(MCAR[X]); L1 := ABS(H); X := MCDR[X]; 00082400 END; 00082410 S := S*H; 00082420 IF NOT MNUMBERP(Y) THEN NUMCHECK(Y); 00082430 IF SMALLP(Y) THEN 00082440 BEGIN 00082450 E := ZEXTEND(Y); Y := ABS(E); 00082460 IF Y>=BASE THEN 00082470 BEGIN L2 := 2; 00082480 Y:=ZCONS(ZTRACT(Y DIV BASE),ZCONS(ZTRACT(Y MOD BASE),00082490 NIL)); 00082500 END ELSE 00082510 BEGIN L2 := 1; 00082520 Y := ZCONS(ZTRACT(Y),NIL); 00082530 END; 00082540 MCDR[SOMETIMES] := Y; 00082550 END 00082560 ELSE 00082570 BEGIN 00082580 Y.TAG := 0; 00082590 E := ZEXTEND(MCAR[Y]); L2 := ABS(E); Y := MCDR[Y]; 00082600 END; 00082610 S := S*E; 00082620 L := MAX(L1,L2); 00082630 E := ZERO; K := 0; Z := ALWAYS; MCDR[Z] := NIL; 00082640 IF S>=0 THEN 00082650 BEGIN 00082660 IF L1BM1 THEN 00082800 BEGIN 00082810 D := D-BASE; E := E+1; F := ZERO; 00082820 END 00082830 ELSE F := BM1; 00082840 LAYDOWN; 00082850 E := D; 00082860 END; 00082870 X := MCDR[X]; 00082880 END UNTIL X=NIL; 00082890 F := BM1; 00082900 END 00082910 ELSE 00082920 BEGIN 00082930 IF L1=L2 THEN 00082940 BEGIN 00082950 WHILE MCAR[X] = MCAR[Y] DO 00082960 BEGIN 00082970 X := MCDR[X]; Y := MCDR[Y]; 00082980 L := L-1; 00082990 IF L=0 THEN 00083000 BEGIN ADDSUB := ZERO; GO TO EXIT END; 00083010 END; 00083020 L1 := L2 := L; 00083030 IF MCAR[X] < MCAR[Y] THEN EXCHANGE(H:=-H); 00083040 END 00083050 ELSE IF L1ZERO THEN 00083450 Z:=MCDR[Z]:=ZCONS(Q,NIL) 00083460 ELSE IF Z=ALWAYS THEN 00083470 L := L-1 00083480 ELSE Z:=MCDR[Z]:=ZCONS(Q,NIL); 00083490 END#; 00083500 00083510 Z := ALWAYS; MCDR[Z] := NIL; 00083520 IF NOT MNUMBERP(X) THEN NUMCHECK(X); 00083530 IF SMALLP(X) THEN 00083540 BEGIN 00083550 R := ZEXTEND(X); X := ABS(R); 00083560 IF X>=BASE THEN 00083570 BEGIN L1 := 2; 00083580 X:=ZCONS(ZTRACT(X DIV BASE),ZCONS(ZTRACT(X MOD BASE),00083590 NIL)); 00083600 END ELSE 00083610 BEGIN L1 := 1; 00083620 X := ZCONS(ZTRACT(X),NIL); 00083630 IF R=0 THEN R := 1; 00083640 END; 00083650 MCAR[SOMETIMES] := X; 00083660 END 00083670 ELSE 00083680 BEGIN 00083690 X.TAG := 0; 00083700 R := ZEXTEND(MCAR[X]); L1 := ABS(R); X := MCDR[X]; 00083710 END; 00083720 IF NOT MNUMBERP(Y) THEN NUMCHECK(Y); 00083730 IF SMALLP(Y) THEN 00083740 BEGIN 00083750 Y := ZEXTEND(Y); S := Y*R; Y := ABS(Y); 00083760 L := L1; 00083770 DO BEGIN 00083780 D := ZEXTEND(MCAR[X]) + BASE MUX V; 00083790 V := INTEGER(D MOD Y); 00083800 IF P>0 THEN 00083810 BEGIN 00083820 Q := ZTRACT(INTEGER(D DIV Y)); 00083830 ADDON(Q,Z); 00083840 END; 00083850 X := MCDR[X]; 00083860 END UNTIL X=NIL; 00083870 V := ZTRACT(V&R[46:46:1]); 00083880 GO TO FINI; 00083890 END; 00083900 Y.TAG := 0; 00083910 L2 := ZEXTEND(MCAR[Y]); 00083920 S := L2*R;; 00083930 L2 := ABS(L2); 00083940 L := L1-L2+1; 00083950 IF SIZE(A)-2<=L1 THEN RESIZE(A,3*L1 DIV 2); 00083955 FOR I:=L1 STEP -1 UNTIL 1 DO 00083960 BEGIN A[I] := ZEXTEND(MCAR[X]); X := MCDR[X] END; 00083970 IF SIZE(B)-2<=L2 THEN RESIZE(B,3*L2 DIV 2); 00083975 FOR J:=L2 STEP -1 UNTIL 1 DO 00083980 BEGIN Y := MCDR[Y]; B[J] := ZEXTEND(MCAR[Y]) END; 00083990 A[L1+1] := A[0] := 0; 00084000 D := B[L2-1] + B[L2] MUX BASE; 00084010 FOR I:=L1 STEP -1 UNTIL L2 DO 00084020 BEGIN 00084030 Q := INTEGER((A[I-1]+(A[I+1] MUX BASE+A[I]) MUX BASE) DIV 00084040 D); 00084050 U := 0; K := I-L2; 00084060 FOR J:=1 STEP 1 UNTIL L2 DO 00084070 BEGIN 00084080 K := K+1; 00084090 E := B[J] MUX Q + U; U := E DIV BASE; 00084100 V := -INTEGER(E MOD BASE) + A[K]; 00084110 IF V<0 THEN 00084120 BEGIN U := U+1; V := V+BASE END; 00084130 A[K] := V; 00084140 END; 00084150 IF A[K+1]0 THEN 00084310 BEGIN Q := ZTRACT(Q); ADDON(Q,Z) END; 00084320 END; 00084330 IF P NEQ 1 THEN 00084340 BEGIN A[0] := 1; 00084350 WHILE A[L2]=0 DO L2:=L2-1; 00084360 IF L2>0 THEN 00084370 BEGIN 00084380 V := NIL; 00084390 FOR J:=1 STEP 1 UNTIL L2 DO 00084400 V := ZCONS(ZTRACT(A[J]),V); 00084410 V := NORMALIZE(L2,R,V); 00084420 END ELSE V := ZERO; 00084430 FINI: 00084440 IF P=0 THEN 00084450 BEGIN 00084460 DIVISION := V; 00084470 GO TO EXIT; 00084480 END; 00084490 END; 00084500 Z := IF Z=ALWAYS THEN ZERO ELSE NORMALIZE(L,S, 00084510 MCDR[ALWAYS]); 00084520 MCDR[ALWAYS] := NIL; 00084530 DIVISION := IF P=1 THEN Z ELSE ZCONS(Z,V); 00084540 EXIT: 00084550 END DIVISION; 00084560 00084570 00084580 REAL PROCEDURE VPLUS2(X,Y); VALUE X,Y; REAL X,Y; 00084590 BEGIN LABEL EXIT; 00084600 DECLAREANDWEIGH; 00084610 IF OVERFLOWP(VPLUS2:=X+Y-ZERO) THEN 00084620 VPLUS2 := ADDSUB(X,Y,1); 00084630 MICROBUMP(5); 00084640 PRIMCOUNTER(29); 00084650 END VPLUS2; 00084670 00084680 REAL PROCEDURE VDIFFERENCE(X,Y); VALUE X,Y; REAL X,Y; 00084690 BEGIN LABEL EXIT; 00084700 DECLAREANDWEIGH; 00084705 IF NOT SMALLP(X) THEN 00084710 VDIFFERENCE := ADDSUB(X,Y,-1) 00084720 ELSE IF OVERFLOWP(VDIFFERENCE:=X-Y+ZERO) THEN 00084730 VDIFFERENCE := ADDSUB(X,Y,-1); 00084740 MICROBUMP(6); 00084750 PRIMCOUNTER(31); 00084760 END VDIFFERENCE; 00084780 00084790 REAL PROCEDURE MMINUS(X); VALUE X; REAL X; 00084800 BEGIN LABEL EXIT; 00084810 IF OVERFLOWP(MMINUS:=2*ZEROLIT-X) THEN 00084820 MMINUS := IF BIGP(X) THEN 00084830 ZCONS(-MCAR[X.FIELD]+2*ZEROLIT,MCDR[X.FIELD])& 00084840 BIGTAG TAG 00084842 ELSE ADDSUB(ZERO,X,1); 00084850 MICROBUMP(5); 00084860 END MMINUS; 00084870 00084880 REAL PROCEDURE MABS(X); VALUE X; REAL X; 00084890 BEGIN LABEL EXIT; 00084900 MABS := IF X>=ZERO THEN X ELSE 00084910 IF X>MINIMUM THEN 2*ZEROLIT-X ELSE 00084920 IF X=MINIMUM THEN ADDSUB(ZERO,X,-1) ELSE 00084930 IF NOT BIGP(X) THEN NUMCHECK(X) ELSE 00084940 IF MCAR[X.FIELD]>ZERO THEN X ELSE 00084950 ZCONS(-MCAR[X.FIELD]+2*ZEROLIT,MCDR[X.FIELD])&BIGTAG TAG; 00084960 END MABS; 00084970 00084980 REAL PROCEDURE VTIMES2(X,Y); VALUE X,Y; REAL X,Y; 00084990 BEGIN LABEL EXIT; 00085000 DECLAREANDWEIGH; 00085010 IF OVERFLOWP(VTIMES2 := (X-ZERO)*(Y-ZERO) + ZERO) THEN 00085020 VTIMES2 := MULTIPLY(X,Y); 00085030 MICROBUMP(6); 00085040 PRIMCOUNTER(30); 00085050 END VTIMES2; 00085070 00085080 REAL PROCEDURE VQUOTIENT(X,Y); VALUE X,Y; REAL X,Y; 00085090 BEGIN LABEL EXIT; 00085100 DECLAREANDWEIGH; 00085110 IF Y=ZERO THEN ZEROERR; 00085120 IF SMALLP(REAL(BOOLEAN(X) AND BOOLEAN(Y))) AND X>MINIMUM THEN 00085130 VQUOTIENT := (X-ZERO) DIV (Y-ZERO) + ZERO ELSE 00085140 VQUOTIENT := DIVISION(X,Y,1); 00085150 MICROBUMP(10); 00085160 PRIMCOUNTER(31); 00085170 END VQUOTIENT; 00085190 00085200 REAL PROCEDURE VREMAINDER(X,Y); VALUE X,Y; REAL X,Y; 00085210 BEGIN LABEL EXIT; 00085220 DECLAREANDWEIGH; 00085230 IF Y=ZERO THEN ZEROERR; 00085240 VREMAINDER := IF SMALLP(REAL(BOOLEAN(X) AND BOOLEAN(Y))) THEN 00085250 (X-ZERO) MOD (Y-ZERO) + ZERO 00085260 ELSE DIVISION(X,Y,0); 00085270 MICROBUMP(9); 00085280 PRIMCOUNTER(36); 00085290 END VREMAINDER; 00085310 00085320 REAL PROCEDURE VEXPT(X,Y); VALUE X,Y; REAL X,Y; 00085330 BEGIN 00085340 DEFINE P=MCAR[SOMETIMES]#, Q=MCDR[SOMETIMES]#; 00085350 DECLAREANDWEIGH; 00085360 IF X=ONE THEN VEXPT := ONE ELSE 00085370 IF X=ZERO THEN VEXPT := ZERO ELSE 00085380 IF X+1=ZERO THEN 00085390 BEGIN 00085400 IF BIGP(Y) THEN 00085410 BEGIN Y.TAG := 0; 00085420 P := ABS(MCAR[Y]-ZERO); 00085430 WHILE P>0 DO 00085440 BEGIN Y := MCDR[Y]; P := P-1 END; 00085450 Y := MCAR[X]; 00085460 END; 00085470 VEXPT := IF BOOLEAN(Y) THEN X ELSE ONE; 00085480 END ELSE 00085490 IF BIGP(Y) THEN 00085500 BEGIN 00085510 IF MCAR[Y.FIELD]0 DO 00085590 BEGIN 00085600 MICROBUMP(6); 00085610 IF BOOLEAN(Y) THEN 00085620 P := IF P=ONE THEN Q ELSE VTIMES2(P,Q); 00085630 Y := Y.[38:38]; 00085640 IF Y>0 THEN Q := VTIMES2(Q,Q); 00085650 END; 00085660 VEXPT := P; 00085670 END; 00085680 P := Q := NIL; 00085690 MICROBUMP(10); 00085700 PRIMCOUNTER(61); 00085710 END VEXPT; 00085730 00085740 BOOLEAN PROCEDURE ZLESSP(A,B); VALUE A,B; REAL A,B; 00085750 BEGIN LABEL EXIT; 00085760 DECLAREANDWEIGH; 00085770 IF SMALLP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN 00085780 BEGIN 00085790 ZLESSP := AZERO ELSE 00085860 IF BIGP(A) THEN MCAR[A.FIELD]NUMCHECK(B); 00085880 MICROBUMP(5); 00085890 GO TO EXIT; 00085900 END; 00085910 IF NOT BIGP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN 00085920 BEGIN NUMCHECK(A); NUMCHECK(B) END; 00085930 MICROBUMP(5); 00085940 A.TAG := 0; B.TAG := 0; 00085950 DO BEGIN 00085960 IF MCAR[A] NEQ MCAR[B] THEN 00085970 BEGIN 00085980 MICROBUMP(3); 00085990 ZLESSP := MCAR[A]B; 00086170 MICROBUMP(3); 00086180 GO TO EXIT; 00086190 END; 00086200 IF SMALLP(REAL(BOOLEAN(A) OR BOOLEAN(B))) THEN 00086210 BEGIN 00086220 ZGREATERP := IF BIGP(B) THEN MCAR[B.FIELD]ZERO ELSE 00086240 NUMCHECK(A)MCAR[B]; 00086370 GO TO EXIT; 00086380 END; 00086390 MICROBUMP(4); 00086400 A := MCDR[A]; B := MCDR[B]; 00086410 END UNTIL B=NIL; 00086420 EXIT: 00086430 MICROBUMP(4); 00086440 PRIMCOUNTER(33); 00086450 END ZGREATERP; 00086470 00086480 BOOLEAN PROCEDURE ZEQN(A,B); VALUE A,B; REAL A,B; 00086490 BEGIN LABEL EXIT; 00086500 DECLAREANDWEIGH; 00086510 IF ZEQN:=A=B THEN GO TO EXIT; 00086520 IF BIGP(A) THEN IF BIGP(B) THEN 00086530 BEGIN A.TAG := 0; B.TAG := 0; 00086540 MICROBUMP(5); 00086550 WHILE MCAR[A] = MCAR[B] DO 00086560 BEGIN MICROBUMP(4); 00086570 A := MCDR[A]; 00086580 IF A=NIL THEN 00086590 BEGIN ZEQN := TRUE; GO TO EXIT END; 00086600 B := MCDR[B]; 00086610 END; 00086620 END; 00086630 EXIT: 00086640 MICROBUMP(4); 00086650 PRIMCOUNTER(27); 00086660 END ZEQN; 00086680 00086690 00086700 DEFINE XPLUS2 = ARG1:=VPLUS2(ARG1,ARG2)#, 00086800 XTIMES2 = ARG1:=VTIMES2(ARG1,ARG2)#, 00086900 XQUOTIENT = ARG1:=VQUOTIENT(ARG1,ARG2)#, 00087000 XREMAINDER = ARG1:=VREMAINDER(ARG1,ARG2)#, 00087100 XDIFFERENCE = ARG1:=VDIFFERENCE(ARG1,ARG2)#, 00087200 XGREATERP = ARG1:=TRUTH(ZGREATERP(ARG1,ARG2))#, 00087300 XLESSP = ARG1:=TRUTH(ZLESSP(ARG1,ARG2))#, 00087400 XEXPT = ARG1:=VEXPT(ARG1,ARG2)#, 00087500 XEQ = ARG1:=VEQ(ARG1,ARG2)#, 00087600 XEQN = ARG1:=TRUTH(ZEQN(ARG1,ARG2))#; 00087605 00087610 00087620 % THIS SECTIONS CONTAINS MODULAR ARITHMETIC FUNCTIONS 00087622 00087624 00087626 DECLARE(XCMOD,7,BEGIN 00087630 IF BIGP(ARG1) THEN 00087632 ARG1 := DIVISION(ARG1,PRIMEZ,0); 00087634 IF ARG1>=PRIMEZ THEN 00087636 ARG1 := (ARG1-ZERO) MOD PRIME+ZERO 00087640 ELSE IF ARG1=PRIMEZZ THEN 00087680 PRIMEZ ELSE ZERO)+ARG1+ARG2); 00087690 00087700 DECLARE(XCTIMES,9,ARG1 := ZTRACT(IF PRIMEBIG THEN 00087710 INTEGER(ZEXTEND(ARG1) MUX ZEXTEND(ARG2) MOD 00087720 PRIME) ELSE 00087730 ZEXTEND(ARG1)*ZEXTEND(ARG2) MOD PRIME)); 00087740 00087750 DECLARE(XCDIF,10,ARG1 := (IF ARG1ONE THEN 00087900 BEGIN 00087910 G := PRIMEZ := ARG1; 00087920 PRIMEZZ := G+ZERO; 00087930 PRIME := G-ZERO; 00087940 PRIMEX := ZERO MOD PRIME; 00087950 PRIMEBIG := OVERFLOWP(ZTRACT(PRIME**2)); 00087960 MICROBUMP(6); 00087965 END; 00087970 ARG1 := D; 00087980 ISPVALUE[GMOD.FIELD] := G; 00087990 MICROBUMP(6); 00087995 PRIMCOUNTER(4); 00088000 END XSETMOD; 00088020 00088030 PROCEDURE XCRECIP; 00088040 BEGIN REAL A,B,X,Y,R; 00088050 DECLAREANDWEIGH; 00088060 X := PRIME; Y := ZEXTEND(ARG1); A := 1; 00088070 WHILE Y>0 DO 00088080 BEGIN 00088090 R := -(X DIV Y)*A+B; 00088100 B := A; A := R; 00088110 R := X MOD Y; 00088120 X := Y; Y := R; 00088130 END; 00088140 B := (IF B>0 THEN 0 ELSE PRIME) + (B MOD PRIME); 00088150 ARG1 := ZTRACT(B); 00088160 MICROBUMP(10); 00088170 PRIMCOUNTER(6); 00088180 END XCRECIP; 00088200 00088210 00088220 PROCEDURE HI; 00091000 BEGIN REAL N; 00091010 ARRAY A[0:500]; 00091020 LABEL EXIT; 00091030 N := MYSELF.TASKVALUE; MYSELF.TASKVALUE := 0; 00091040 CASE N OF 00091050 BEGIN 00091060 0: ASKING := TRUE; 00091070 1: ON INVALIDINDEX[A:N], 00091080 BEGIN 00091090 HIGH := TRUE; 00091095 FAULTPROCESSOR(A,-4); 00091100 GO TO EXIT; 00091120 END; 00091130 N := MCAR[-1]; 00091140 ELSE:; 00091145 END; 00091150 EXIT: 00091340 END HI; 00091350 00091360 INTERRUPT ANSWER; HI; 00091370 00091380 PROCEDURE INITFREECHAIN; 00091600 BEGIN 00091610 REAL P,S; 00091620 S:=PSPFREE DIV PAGESIZE; 00091630 WHILE P<=S DO 00091640 BEGIN 00091650 PPAGEUSED[P]:=TRUE; 00091660 P:=P+1; 00091670 END INITPAGEUSED; 00091680 INUSE:=P*PAGESIZE; 00091690 WORKSET:=PSPFREE; 00091700 RHO:=100; 00091710 WHILE P=TSPMAX THEN 00109900 EXPANDSTACK; 00110000 RPUSH(-1); % TO RECOGNIZE FINISH. 00110100 DO BEGIN 00110200 IF SP+1>=TSPMAX THEN 00110300 EXPANDSTACK; 00110400 IF MPAIRP(GP) THEN 00110500 BEGIN 00110600 GB:=MCAR[GP]; 00110700 IF MGARBAGEP(GB) THEN 00110800 GP:=RPOP 00110900 ELSE 00111000 BEGIN 00111100 MGARBAGEP(MCAR[GP]):=TRUE; 00111200 IF IGNORE(GB) THEN 00111300 BEGIN 00111310 GB:=MCDR[GP]; 00111320 GP:=IF IGNORE(GB) THEN RPOP ELSE GB 00111330 END 00111340 ELSE 00111350 BEGIN 00111360 GP:=MCDR[GP]; 00111370 IF NOT IGNORE(GP) THEN 00111380 RPUSH(GP); 00111390 GP:=GB; 00111400 END; 00111410 END; 00111500 END ELSE 00111600 IF MIDP(GP) THEN 00111700 BEGIN 00111800 GB:=ISPVALUE[GP.FIELD]; 00111810 IF MGARBAGEP(GB) THEN 00111900 GP:=RPOP 00112000 ELSE 00112100 BEGIN 00112200 MGARBAGEP(ISPVALUE[GP.FIELD]):=TRUE; 00112400 IF STRINGSNEEDIT THEN 00112600 RPUSH(STRINGIZE(ISPPNAME[GP.FIELD])); 00112700 IF IGNORE(GB) THEN 00112710 BEGIN 00112720 GB:=ISPPROP[GP.FIELD]; 00112730 GP:=IF IGNORE(GB) THEN RPOP ELSE GB; 00112740 END 00112750 ELSE 00112760 BEGIN 00112770 GP:=ISPPROP[GP.FIELD]; 00112780 IF NOT IGNORE(GP) THEN 00112790 RPUSH(GP); 00112800 GP:=GB 00112810 END; 00112820 END; 00112900 END ELSE 00113000 IF MSTRINGP(GP) THEN 00113100 BEGIN 00113200 GB:=GP.BUCKF; GP:=GP.SLOCF; 00113500 IF GB>0 THEN 00113600 REPLACE SSP[GB,GP+1] BY (REAL(SSP[GB,GP+1],2)&1 SPGARBF)00113700 .[15:48] FOR 2; 00113800 GP:=RPOP; 00114000 END ELSE 00114100 IF MVECTORP(GP) THEN 00114200 BEGIN 00114300 IF NOT MGARBAGEP(VSP[GP.FIELD]) THEN 00114400 BEGIN 00114700 GB := ZEXTEND(VSP[GP:=GP.FIELD])+1; 00114800 MGARBAGEP(VSP[GP]):=TRUE; 00114900 WHILE GB+SP>=TSPMAX DO EXPANDSTACK; 00115000 I:=1; 00115010 DO BEGIN 00115030 GA:=VSP[GP+I]; 00115040 IF NOT IGNORE(GA) THEN 00115050 RPUSH(GA); 00115060 END UNTIL I:=I+1>GB; 00115070 END; 00115500 GP:=RPOP; 00115510 END ELSE 00115600 IF BIGP(GP) THEN 00115610 GP.TAG := 0 00115620 ELSE GP:=RPOP; 00115630 END UNTIL SP=BP; 00115900 END RMARKCELL; 00116000 00116100 00116200 PROCEDURE ZGARBAGE(Y); VALUE Y; REAL Y; 00116300 % THIS IS THE GARBAGE COLLECTOR. IT EXPECTS ONE ARGUMENT IN Y 00116400 % WHICH IS A STRING GIVING THE REASON FOR THE GARBAGECOLLECTION. 00116500 BEGIN LABEL FINDUSED,FINI; 00116600 REAL S,P,Q,R,PAVAILABLE,IAVAILABLE,GP; 00116700 REAL T1,T2,T3,NUWORK,NUINUSE; 00116800 ARRAY FA[0:500]; 00116900 00117000 DEFINE MARKCELL(X) = 00117100 BEGIN 00117200 GP:=X; 00117300 IF NOT IGNORE(GP) THEN 00117350 IF NOT MGARBAGEP(IF MIDP(GP) THEN ISPVALUE[GP.FIELD] ELSE 00117400 IF MPAIRP(GP) THEN MCAR[GP] ELSE 0) THEN 00117410 RMARKCELL(GP); 00117600 END MARKCELL#; 00117700 00117800 00117900 T1:=TIME(12); 00118000 DISABLE ANSWER; 00118010 IF ISPVALUE[GCFLAG.FIELD] NEQ NIL THEN 00118100 BEGIN 00118200 CASE Y OF 00118300 BEGIN 00118400 REPLACE CONVERTPTR BY "PAIR SPACE "; 00118500 REPLACE CONVERTPTR BY "ID SPACE "; 00118600 REPLACE CONVERTPTR BY "USER REQUEST"; 00118700 REPLACE CONVERTPTR BY "VECTOR SPACE"; 00118800 END; 00118900 WRITETTY("GARBAGE COLLECTION FOR " CAT CONVERTPTR FOR 12); 00119000 END; 00119100 IF ISPVALUE[GCFLAG.FIELD] = ONE THEN 00119200 BEGIN 00119300 P:=0; 00119400 ON ZERODIVIDE[FA:P]: 00119500 FAULTPROCESSOR(FA,1); 00119600 P:=P/P; 00119700 END; 00119800 % THAT PUTS OUT THE MESSAGE IF NECESSARY; 00119900 STRINGSNEEDIT := NEWSCNT1>NEWSCNT2; 00119990 IGNORABLES.TAG := 00120000 IF STRINGSNEEDIT THEN FUNCTTAG ELSE FUNCTTAG+STRINGTAG; 00120010 IGNORABLES:=IGNORABLES+MINIMUM; 00120020 MGARBAGEP(IGNORABLES):=TRUE; 00120030 NEWSCNT2 := NEWSCNT1; 00120100 FOR P:=1 STEP 1 UNTIL APAGEMAX DO 00120200 PPAGEUSED[P]:=FALSE; 00120300 PPAGEUSED[0]:=TRUE; % MARK FOR NIL. 00120400 S:=QPTR-1; % THE Q POINTER. 00120410 MGARBAGEP(ISPVALUE[NIL.FIELD]):=TRUE; 00120500 Q:=GLOBLENGTH; 00120510 GLOBALVECT[Q:=Q+1]:=ISPPROP[NIL.FIELD]; 00120600 GLOBALVECT[Q:=Q+1]:=STRINGIZE(ISPPNAME[NIL.FIELD]); 00120700 GLOBALVECT[Q:=Q+1]:=ZA; GLOBALVECT[Q:=Q+1]:=ZB; 00120900 ZA := ZB := NIL; 00121000 GLOBALVECT[Q:=Q+1]:=ALWAYS; GLOBALVECT[Q:=Q+1]:=SOMETIMES; 00121010 FOR P:=0 STEP 1 UNTIL Q DO 00121100 MARKCELL(GLOBALVECT[P]); % MARK THE GLOBALS. 00121200 FOR P:=0 STEP 1 UNTIL 15 DO 00121300 MARKCELL(ARGS[P]); 00121400 P:=0; 00121500 IF STRINGSNEEDIT THEN DO MARKCELL(ERRS[P]) UNTIL ERRS[P:=P+1] = 0; 00121600 FOR P:=0 STEP 1 UNTIL S DO 00121700 MARKCELL(QSP[P]); 00121800 % MARK THE STACK NOW; 00121900 FOR P:=1 STEP 1 UNTIL ES DO 00122000 MARKCELL(ESP[P]); 00122100 Q := TSPPTR - 1; % THE INITIAL STACKFRAME; 00122200 WHILE Q>0 DO 00122300 BEGIN 00122400 P:=TSP[Q] -1; % THE NEXT FRAME, -1 FOR OFFSET 00122500 Q:=Q-1; 00122600 R:=(IF TSP[Q]=GBPROG THEN 3 ELSE 0)+P; % IGNORE FUNNIES IN BPROG 00122700 DO BEGIN 00122800 MARKCELL(TSP[Q]); 00122900 Q:=Q-1; 00123000 END UNTIL Q<=R; % FINISHED FRAME; 00123100 Q:=P; 00123200 END SCANSTACK; 00123300 $ SET OMIT = SLOWSTACK OR COUNT 00123400 P:=STACKOFFSET(P); S:=MTEMPLOC; MTEMP:="LOCAL "; 00123500 WHILE P:=MASKSTACKSEARCHER("LOCAL ",4"FFFFFFFFFF00",RCVLOC,P-1) > S DO 00123600 BEGIN 00123700 R:=RCVLOC[0].[6:7]; 00123800 IF R>0 THEN 00123900 BEGIN 00124000 CHECKSTACK(R); 00124100 COPYFROMSTACK(R,POINTER(TSP[TSPPTR]),P+1); 00124200 Q:=TSPPTR; 00124300 TSPPTR:=Q+R; 00124400 DO BEGIN 00124500 MARKCELL(TSP[Q]); 00124600 Q:=Q+1; 00124700 END UNTIL Q=TSPPTR; 00124800 TSPPTR:=*-R; 00124900 END; 00125000 END; 00125100 $ POP OMIT 00125200 % END OF PHASE ONE. NOW HAVE TO DO SCAN OF OBLIST RECHAINING 00125300 % AND THEN THE LINEAR SCAN OF THE P AND I SPACES; 00125400 %SEGMENT(PHASE2); 00125500 P:=1; 00126200 DO BEGIN 00126300 IF MINTERNED(ISPPNAME[P]) THEN 00126400 IF NOT MGARBAGEP(ISPVALUE[P]) THEN 00126500 IF ISPVALUE[P] NEQ NIL THEN RMARKCELL(P&IDTAG TAG) ELSE 00126600 IF ISPPROP[P] NEQ NIL THEN RMARKCELL(P&IDTAG TAG) ELSE 00126700 IF MGLOBALP(P) THEN RMARKCELL(P&IDTAG TAG) ELSE 00126800 IF MFLUIDP(P) THEN RMARKCELL(P&IDTAG TAG); 00126900 P:=P+1 00127000 END UNTIL P>ISPHIGH; 00127100 T2:=TIME(12); 00127200 00127300 % THE USED STORE IS NOW MARKED. WE MUST DO A LINEAR SCAN 00127400 % OF THE I AND P SPACES TO CONSTRUCT A FREE CHAIN; 00127500 R:=APAGEMAX-1; % TOP PAGE; 00127600 PSPFREE:=-1; % JUST IN CASE IT WAS I SPACE. 00127700 PAVAILABLE:=0; 00127800 DO BEGIN 00127900 P:=(R+1)*PAGESIZE-1; % TOP OF THE PAGE; 00128000 Q := 0; MGARBAGEP(Q) := TRUE; 00128100 REPLACE SEARCHPAGE BY POINTER(MCAR[PAGESIZE*R]) FOR PAGESIZE WORDS; 00128150 IF MASKSEARCH(Q,Q,SEARCHPAGE[PAGESIZE-1])>=0 THEN 00128200 BEGIN 00128300 NUINUSE:=*+PAGESIZE; 00128400 PPAGEUSED[R] := TRUE; 00128500 S:=P-PAGESIZE; 00128600 DO BEGIN 00128700 Q:=MCAR[P]; 00128900 IF NOT MGARBAGEP(Q) THEN 00129000 BEGIN 00129100 PAVAILABLE:=*+1; 00129200 MCAR[P]:=MAXFIELDV; % PLACE ON FREE LIST; 00129300 MCDR[P]:=PSPFREE; 00129400 PSPFREE:=P; 00129500 END 00129600 ELSE % JUST UNMARK; 00129700 BEGIN NUWORK:=*+1; 00129800 MGARBAGEP(MCAR[P]):=FALSE; 00129900 END; 00130000 P:=P-1; 00130100 END UNTIL P=S; 00130200 END 00130300 ELSE 00130400 BEGIN 00130500 PPAGEUSED[R] := FALSE; 00130600 PAVAILABLE := *+PAGESIZE; 00130700 END; 00130800 R:=*-1; 00130900 END UNTIL R<0; 00131000 IF ISPFREE=ISPMAX+1 OR Y=1 THEN 00131100 IF AISPMAX 0 DO 00133700 BEGIN 00133800 IF BOOLEAN(Q).SPGARBF THEN 00133900 BEGIN 00134000 REPLACE SSP[R,P] BY (Q&0 SPGARBF).[23:48] FOR 3; 00134100 P:=P+S+3; 00134200 END 00134300 ELSE 00134400 BEGIN 00134500 Q:=P; 00134600 DO BEGIN 00134700 P:=P+S+3; 00134800 S:=REAL(SSP[R,P],1); 00134900 END UNTIL P-Q+S>255 OR S=0 OR 00135000 BOOLEAN(REAL(SSP[R,P],3).SPGARBF); 00135100 REPLACE SSP[R,Q] BY (0&1 FREEF & (P-Q-3)[23:8]).[23:48] 00135200 FOR 3; 00135300 END; 00135400 END; 00135500 R:=R+1; 00135600 END UNTIL P=0 AND R>SSPHBUCKETS; 00135700 P:=0; VSPFREE:=-1; R:=-1; 00135800 DO BEGIN 00135900 Q:=P; 00136000 WHILE P=VSPMAX THEN GO TO FINI; % FINISHED. 00137400 P:=P+VSP[P].FIELD+2; 00137500 END UNTIL FALSE; 00137600 FINI: 00137700 IF PAVAILABLE<4*PAGESIZE THEN 00137800 BEGIN 00137900 P:=APAGEMAX; 00138000 APAGEMAX:=MIN(APAGEMAX+4,PPAGEMAX); 00138100 PAVAILABLE:=*+(APAGEMAX-P)*PAGESIZE; 00138200 END; 00138300 T3:=TIME(12); 00138400 GARBAGETIME:=T3-T1+GARBAGETIME; 00138500 IF ISPVALUE[GCFLAG.FIELD] NEQ NIL THEN 00138600 IF NOT BREAK THEN 00138700 BEGIN 00138800 WRITETTY("GC END; PAIR AVAIL = " CAT DECIMAL(PAVAILABLE,6) 00138900 CAT ", SYMBOL AVAIL = " CAT DECIMAL(IAVAILABLE,4)); 00139000 BREAK:=WRITE(ME,<2A6," =",I6,",",F10.3>, 00139100 "PREV F","REE ",INUSE-WORKSET,(T1-OLDTIME)*2.4@-3/ 00139200 (INUSE-WORKSET), 00139300 "TOTAL ","PAIRS ",NUINUSE,(T3-T2)*2.4@-3/NUINUSE, 00139400 "IN USE"," PAIRS",NUWORK,(T2-T1)*2.4@-3/NUWORK); 00139500 BREAK:=WRITE(ME,<"TOTAL TIME = ",F7.2,", GC TIME =",F7.2, 00139600 ", THIS TIME =", F5.2,F7.2,"%">, 00139700 (T3-BEGINTIME)*2.4@-6,GARBAGETIME*2.4@-6,(T3-T1)*2.4@-6, 00139800 100*GARBAGETIME/(T3-BEGINTIME)); 00139900 END; 00140000 INUSE:=NUINUSE; WORKSET:=NUWORK; OLDTIME:=T3; 00140100 ENABLE ANSWER; 00140110 IF (PAVAILABLE=0) OR (IAVAILABLE=0) THEN 00140200 ZERROR(110, ERRS[10]); 00140300 END ZGARBAGE; 00140400 00140500 00140600 PROCEDURE XRECLAIM; 00140700 BEGIN LABEL EXIT; 00140800 DECLAREANDWEIGH; 00140810 ARG1:=NIL; ZGARBAGE(2); 00140900 MICROBUMP(5); 00140910 PRIMCOUNTER(28); 00141000 END XRECLAIM; 00141100 00141200 $PAGE 00141300 %SEGMENT(T.SPACE); 00141400 00141500 00144400 DEFINE ZPUSH(WHAT) = 00144500 BEGIN 00144600 TSP[TSPPTR] := WHAT; 00144700 TSPPTR:=TSPPTR+1; 00144800 END ZPUSH#; 00144900 00145000 00145600 DECLARE(XQUOTE,81,ARG1:=MCAR[ARG1]); 00145700 00145800 REAL PROCEDURE ZBIND(FRML,ACTUAL); 00145900 % PROCEDURE BINDS THE ACTUAL PARAMETERS TO THE FRML AND PLACES 00146000 % THEM ON THE STACK WITH LAMBDA AS THE FUNCTION NAME. 00146100 % IF NILLER IS TRUE THEN BIND THE VALUES TO NIL AND DON'T WORRY ABOUT 00146200 % ACTUAL (USED BY PROG FOR PROG VARIABLES). 00146300 VALUE FRML,ACTUAL; 00146400 REAL FRML,ACTUAL; 00146500 BEGIN REAL OLD,A1,A2; 00146600 BOOLEAN NILLER; 00146700 DECLAREANDWEIGH; 00146750 NILLER := ACTUAL=NIL; 00146800 OLD := TSPPTR; %BACK CHAIN POINTER HERE. 00147000 CHECKSTACK(18); 00147100 A2 := NIL; 00147200 WHILE MPAIRP(FRML) AND (MPAIRP(ACTUAL) OR NILLER) DO 00147300 BEGIN MICROBUMP(7); 00147400 A1 := MCAR[FRML]; 00147500 IF NOT NILLER THEN 00147600 BEGIN 00147700 A2 := MCAR[ACTUAL]; 00147800 ACTUAL := MCDR[ACTUAL]; 00147900 MICROBUMP(2); 00148000 END; 00148100 ZPUSH(ISPVALUE[A1.FIELD]); %VALUE HERE. 00148200 ZPUSH(A1); %VARIABLE NAME HERE. 00148300 ISPVALUE[A1.FIELD] := A2; 00148400 FRML := MCDR[FRML]; %NEXT FORMAL PARAMETER. 00148500 END; 00148600 ZPUSH(GLAMBDA); %ADD LAMBDA AS THE FUNCTION NAME.%PPDMTL05 00148610 ZPUSH(OLD); %ADD THE BACK CHAIN POINTER. %PPDMTL05 00148620 IF FRML NEQ ACTUAL THEN %ERROR IF BOTH LISTS ARE NOT EMPTY. 00148700 ZERROR(120, ERRS[11]); 00148800 %PPDMTL05 00148900 %PPDMTL05 00149000 ZBIND := NIL; 00149100 MICROBUMP(13); 00149200 PRIMCOUNTER(22); 00149210 END ZBIND; 00149300 00149400 00149500 DEFINE XLAMBIND = ARG1 := ZBIND(ARG1,ARG2)#; 00149600 00149700 00149800 PROCEDURE ZSPREAD; 00149900 % PROCEDURE SPREADS THE ACTUAL PARAMETERS IN ACTUAL LIST AMONG THE 00150000 % REGISTERS ARG1 -> ARG14. 00150100 BEGIN REAL I; 00150200 LABEL EXIT; 00150300 DECLAREANDWEIGH; 00150400 MICROBUMP(5); 00150500 ZA := ARG1; 00150600 I := ARG2; 00150610 IF MATOM(I) THEN 00150700 BEGIN ARG1 := NIL; GO TO EXIT END; 00150800 'FOR NUM:=0 STEP 1 UNTIL 13 DO 00150900 'BEGIN 00151000 MICROBUMP(3); 00151100 ARG'NUM := MCAR[I]; 00151200 I := MCDR[I]; 00151300 IF MATOM(I) THEN GO TO EXIT; 00151400 'END; 00151500 ZERROR(107,ERRS[7]); 00151600 EXIT: 00151700 PRIMCOUNTER(40); 00151800 END ZSPREAD; 00152000 00152100 DEFINE XAPPLY = 00152110 % USER INTERFACE TO ZCALL. PUT FN-POINTER IN $FN GLOBAL; 00152120 BEGIN 00152130 ZSPREAD; 00152140 STOPCOUNT; 00152150 ZCALL(ZA); 00152160 STARTCOUNT; 00152170 END XAPPLY#; 00152180 00152190 DEFINE XLINK = #, XSPREAD = XAPPLY#; 00152195 00152200 PROCEDURE ZUNSTACK; 00152300 BEGIN REAL I,J; 00152400 DECLAREANDWEIGH; 00152410 MICROBUMP(8); 00152420 J := TSPPTR-1; 00152500 TSPPTR := I := TSP[J]; 00152600 J := J-2; 00152700 WHILE I=0 THEN 00172700 QSP[I].[46:1]:=1; 00172800 MICROBUMP(6); 00172900 PRIMCOUNTER(76); 00173000 END XPUTD; 00173100 00173110 00173120 PROCEDURE XTIME; 00173130 BEGIN INTEGER I; 00173140 DECLAREANDWEIGH; 00173150 I := (TIME(12)-BEGINTIME)*2.4@-3; % MILLI-SECONDS 00173160 ARG1 := ZTRACT(I); 00173170 MICROBUMP(5); 00173180 PRIMCOUNTER(50); 00173190 END XTIME; 00173210 00173220 REAL PROCEDURE SEARCHFORNAME(A); ARRAY A[0]; 00173300 BEGIN REAL I,J,K; 00173310 POINTER P,Q; 00173320 ARRAY B[0:80]; 00173330 EBCDIC ARRAY S[0:35]; 00173335 LABEL EXIT; 00173340 IF NOT PROCS.PRESENT THEN 00173350 BEGIN SEARCHFORNAME := 8; GO TO EXIT END; 00173360 J := PROCS.LASTRECORD+1; 00173370 P := POINTER(B[12]); 00173380 DO BEGIN K:=(I+J) DIV 2; 00173390 READ(PROCS[K],80,B); 00173400 IF P>A FOR 8 THEN J:=K ELSE I:=K; 00173410 END UNTIL J-I<2; 00173420 READ(PROCS[I],80,B); 00173430 SCAN P:B UNTIL = "P"; 00173440 P := P+10; 00173450 SCAN P:P WHILE = " "; 00173460 IF P="Y" THEN 00173470 BEGIN P:=P+1; I:=72; 00173480 REPLACE Q:A+8 BY " "; 00173490 REPLACE S BY 00173495 "*$!" CAT """ CAT "#%'()=+-<>^\~|@.&?[]/,:;Q"; 00173500 DO BEGIN 00173510 I:=I-1; 00173515 IF P="Q" THEN 00173520 BEGIN 00173530 J:=INTEGER(P+1,2); P:=P+3; 00173540 REPLACE Q:Q BY S[J] FOR 1; 00173550 END 00173560 ELSE REPLACE Q:Q BY P:P FOR 1; 00173570 END UNTIL NOT P IN ALPHA; 00173580 END 00173590 ELSE 00173600 BEGIN 00173610 IF P="X" OR P="Z" OR P="V" THEN 00173620 P:=P+1; 00173630 REPLACE A+8 BY " ", P FOR I:72 WHILE IN ALPHA; 00173640 END; 00173650 SEARCHFORNAME := 82-I; 00173660 EXIT: 00173670 END SEARCHFORNAME; 00173680 00173690 PROCEDURE FAULTPROCESSOR(FA,FN); VALUE FN; REAL FN; ARRAY FA[0]; 00174200 BEGIN 00174300 REAL I,J; 00174400 POINTER P,Q; 00174500 ARRAY FB[0:22]; 00174600 IF FN=4 THEN 00174610 BEGIN 00174620 WRITETTY("INVALID INDEX"); 00174630 WRITETTY("ARG1-4 = " CAT 00174700 CONVERT(ARG1,10) CAT " " CAT 00174800 CONVERT(ARG2,10) CAT " " CAT 00174900 CONVERT(ARG3,10) CAT " " CAT 00175000 CONVERT(ARG4,10)); 00175100 END; 00175110 FA[SIZE(FA)-1] := "()."; 00175200 SCAN P:FA UNTIL = "("; 00175300 WHILE P NEQ "()." DO 00175400 BEGIN 00175500 P := P+1; 00175600 REPLACE FB BY P:P FOR 8; 00175700 I := SEARCHFORNAME(FB); 00175800 WRITETTY(FB FOR I); 00175900 SCAN P:P UNTIL = "("; 00176000 END; 00176100 IF ABS(FN)=4 THEN 00176400 BEGIN %INVALID INDEX 00176500 ISPVALUE[GEMSG.FIELD] := ERRS[IF FN=4 THEN 17 ELSE 14]; 00176600 ARG1:=ERRORID; 00176700 ARG2:=NIL; 00176800 XTHROW; 00176900 END; 00177000 END; 00177100 00177200 PROCEDURE ZCATCH; 00177300 % ARG1 IS REEVALUATED. IF A THROW OCCURS DURING THE EVALUATION, THE 00177400 % VALUE FROM THROW (IN BASKET) IS RETURNED, OTHERWISE A LIST OF THE 00177500 % VALUE OF ARG1 IS RETURNED. 00177600 BEGIN 00177700 ARRAY FA[0:500]; 00177800 REAL FN,K,S; 00177900 LABEL FL; 00178000 INTERRUPT THUD; 00178100 IF CATCHCOUNTER=K THEN 00178200 IF THROWCOUNTER>CATCHER THEN 00178300 BEGIN 00178400 CATCHER := *+1; 00178500 GO TO FL; 00178600 END; 00178700 DECLAREANDWEIGH; 00178710 MICROBUMP(100); 00178720 CHECKSTACK(2); 00178800 ZPUSH(GCATCH); %MARK THE STACK. 00179000 ZPUSH(TSPPTR-1); 00179100 ON INVALIDINDEX[FA:FN], 00179200 BEGIN 00179300 FAULTPROCESSOR(FA,4); 00179400 GO TO FL; 00179500 END; 00179600 ATTACH THUD TO THROW; 00179700 K:=CATCHCOUNTER:=*+1; 00179800 S:=ES; 00179900 STOPCOUNT; 00179910 YEVAL; %SO DO IT. 00180000 STARTCOUNT; 00180010 FL: 00180100 DETACH THUD; 00180200 CATCHCOUNTER:=*-1; 00180300 ES:=S; 00180400 IF BACKOUT THEN BEGIN %AHA! A THROW HAS OCCURRED. 00180500 BACKOUT := FALSE; %THROW IS COMPLETE. 00180600 ARG1 := BASKET; %VALUE TO RETURN. 00180700 END 00180800 ELSE BEGIN %RETURN (VALUE . NIL) 00180900 ARG2 := NIL; 00181000 XCONS; 00181100 END; 00181200 TSPPTR := TSP[TSPPTR-1]; 00181300 PRIMCOUNTER(1); 00181310 END ZCATCH; 00181400 00181500 00181600 DEFINE XCATCH = BEGIN STOPCOUNT; ZCATCH; STARTCOUNT END#; 00181700 00181800 00181900 PROCEDURE ZERROR(NUM, MSG); VALUE NUM,MSG; REAL NUM,MSG; 00182000 % ISOLATE XERROR FROM THE SYSTEM. 00182100 BEGIN LABEL EXIT; 00182200 ARG1 := ZTRACT(NUM); %ERROR NUMBER AS ARG1. 00182300 ARG2 := MSG; 00182400 IF NOT BACKOUT THEN YERROR; 00182500 END ZERROR; 00182600 00182605 PROCEDURE XQUIT; 00182610 BEGIN 00182620 DECLAREANDWEIGH; 00182630 PRIMCOUNTER(23); 00182635 RECENTREAD := ATEND := TRUE; BREAK := FALSE; 00182640 CLOSE(ME); 00182650 ANSWERHI; 00182660 GO TO THU; 00182670 END XQUIT; 00182680 00182700 PROCEDURE XSETPCHAR; 00182800 BEGIN REAL S; 00182900 DECLAREANDWEIGH; 00182950 IF MIDP(ARG1) THEN 00183000 S:=STRINGIZE(ISPPNAME[ARG1.FIELD]) 00183100 ELSE 00183200 IF MSTRINGP(ARG1) THEN 00183300 S:=ARG1 00183400 ELSE 00183500 MTMSMTCH(ARG1,GIDORSTRING,GSETPCHAR); 00183600 ARG1:=ISPVALUE[GPROMPT.FIELD]; 00183700 ISPVALUE[GPROMPT.FIELD] := S; 00183800 MICROBUMP(10); 00183900 PRIMCOUNTER(60); 00184000 END XSETPCHAR; 00184100 00184200 00184300 REAL PROCEDURE ZREADCH(PTR,BFR); 00184400 % PROCEDURE PICKS UP THE NEXT INPUT CHARACTER FROM THE SELECTED 00184500 % INPUT FILE (CUR.CHAN.IN) AT POSITION I. IF I < 0 THEN A NEW LINE 00184600 % IS REQUIRED. IF I > 80 THEN RETURN END-OF-LINE. @(4)00@ MEANS 00184700 % $EOF$ TO READCH, @(4)01@ MEANS $EOL$ TO READCH. 00184800 % IF !*RAISE IS T CHANGE LOWER CASES TO UPPER CASES. IF !*ECHO IS T, 00184900 % THEN DISPLAY THE LINE ON THE CURRENTLY SELECTED INPUT DEVICE. 00185000 REAL PTR; EBCDIC ARRAY BFR[0]; 00185100 BEGIN REAL I,J; 00185200 LABEL EXIT,EOFME,EOFYOU; 00185300 I:=PTR; 00185400 IF I < 0 THEN 00185500 BEGIN 00185600 IF ASKING THEN ANSWERHI; 00185610 IF CURCHANIN = 0 THEN 00185700 BEGIN 00185800 REPLACE COLLECTOR BY ZGETSTRING(ISPVALUE[GPROMPT. 00186000 FIELD]) CAT " "; 00186100 WHILE WRITE(ME[STOP],ZGET2+1,COLLECTOR) DO; 00186200 REPLACE COLLECTOR BY " " FOR 132; 00186300 ATEND := RECENTREAD := TRUE; BREAK := FALSE; 00186400 READ(ME,80,LINER)[EOFME]; 00186500 ATEND:=FALSE; 00186600 IF ASKING THEN 00186700 BEGIN 00186800 EOFME: 00186900 ANSWERHI; 00187000 IF ATEND THEN GO TO THU 00187100 END; 00187200 REPLACE BFR BY LINER FOR INSZE; %MOVE LINE TO INPUT BUFFER. 00187300 END 00187400 ELSE 00187500 BEGIN 00187600 READ(IOFILE[CURCHANIN],INSZE,BFR)[EOFYOU]; 00187700 IF FALSE THEN 00187800 BEGIN %BACK TO ME WHEN END OF FILE. 00187900 EOFYOU: 00188000 CURCHANIN := 0; 00188100 ZREADCH:=0; %RETURN $EOF$. 00188200 I:=-2; 00188300 GO TO EXIT; 00188400 END; 00188500 IF FILEINFO[CURCHANIN]IOSTOP[CURCHANIN] THEN GO TO EOFYOU; 00188850 END; 00188900 IF NOT MNULL(ISPVALUE[GECHO.FIELD]) THEN %ECHO? 00189000 WRITEIOFILE(CURCHANOUT,BFR FOR 00189100 IF CURCHANOUT=0 THEN INSZE ELSE ZEXTEND(ISPVALUE[ 00189200 GLINELENGTH.FIELD])); 00189300 MICROBUMP(30); 00189400 END GETANDECHO; 00189500 00189600 IF I>=INSZE THEN %SHOULD $EOL$ BE RETURNED? 00189700 BEGIN 00189800 I := -2; %FORCE READ NEXT TIME. 00189900 ZREADCH:=1; %1 %RETURN $EOL$. %PPDMTL12 00190000 GO TO EXIT; 00190100 END; 00190200 00190300 IF I<=0 THEN 00190400 BEGIN 00190500 IF NOT MNULL(ISPVALUE[GRAISE.FIELD]) THEN 00190600 FOR I:=0 STEP 6 UNTIL INSZE DO 00190700 REPLACE BFR[I] BY REAL(BOOLEAN(REAL(BFR[I],6)) OR 00190800 BOOLEAN(" ")) FOR 6; 00190900 I:=0; 00191000 END; 00191100 ZREADCH:=REAL(BFR[I],1); 00191200 EXIT: 00191300 PTR:=I+1; 00191400 MICROBUMP(8); 00191500 END ZREADCH; 00191600 00191700 00191800 REAL PROCEDURE ZADDTOSTRINGS(A,L); VALUE A,L; POINTER A; REAL L; 00191900 % PROCEDURE ADDS THE CHARACTER STRING A TO THE STRING AREA BY HASHING ON00192000 % ON THE FIRST TWO CHARACTERS IF LONGER THAN ONE CHARACTER AND THEN 00192100 % DOING A LINEAR SEARCH IN THE HASH BUCKET OR AN OVERFLOW AREA. SINGLE 00192200 % CHARACTER STRINGS STAND FOR THEMSELVES. 00192300 BEGIN LABEL EXIT; 00192400 REAL R,BUCKET,SPTR,LEN,W,WL,WB; 00192500 % SINGLE CHARACTER IDS STAND FOR THEMSELVES. 00192600 IF L = 1 THEN 00192700 BEGIN 00192800 SPTR:=REAL(A,1)*4; 00192900 GO TO EXIT; 00193000 END; 00193100 % COMPUTE THE BUCKET NUMBER ON THE FIRST SIX CHARACTERS OF A. 00193200 R:=REAL(A,MIN(L,6)); 00193300 R:=(R.[47:14]+R.[33:34]+L) MOD SSPHBUCKETS+1; 00193400 %SEARCH ALL BUCKETS UNTIL THE STRING IS FOUND OR THE END OF THE BUCKET00193500 %CHAIN IS REACHED. 00193600 WL:=SSPBSZE; 00193700 FOR BUCKET:=R, SSPHBUCKETS+1 STEP 1 UNTIL SSPBMAX-1 DO 00193800 BEGIN 00193900 MICROBUMP(7); 00194000 SPTR := 0; 00194100 WHILE LEN:=(R:=REAL(SSP[BUCKET,SPTR],3)).[23:8] > 0 DO 00194200 BEGIN 00194300 MICROBUMP(8); 00194400 IF BOOLEAN(R.FREEF) THEN 00194500 BEGIN 00194600 IF L+3LEN THEN 00194800 IF BUCKET<=SSPHBUCKETS OR WL=SSPBSZE THEN 00194900 BEGIN W:=SPTR; WL:=LEN; WB:=BUCKET END; 00195000 END 00195100 ELSE 00195200 IF LEN = L THEN 00195300 IF SSP[BUCKET,SPTR+3]=A FOR L THEN 00195400 GO TO EXIT; 00195500 SPTR:=*+LEN+3; 00195600 END; 00195700 %IF THERE IS ROOM IN THIS BUCKET, THEN THERE IS NO NEED TO SEARCH FURT00195800 %BECAUSE IT WON'T BE THERE. 00195900 MICROBUMP(10); 00196000 IF WL=SSPBSZE THEN 00196100 BEGIN 00196200 IF R-3= SSPBSZE THEN NEWSCNT1 := *+1; 00197000 END; 00197100 END; 00197200 IF L+3<=R THEN 00197300 BEGIN 00197400 REPLACE SSP[BUCKET,SPTR] BY L.SHIFTUP FOR 1, 00197500 BRANDNEW.[15:48] FOR 2, 00197600 A FOR L, (R-L-3).[23:48] FOR 3; 00197700 IF NEWSCNT1>0 THEN NEWSCNT1 := *+1; 00197800 GO TO EXIT; 00197900 END; 00198000 END 00198100 ELSE 00198200 BEGIN 00198300 REPLACE SSP[WB,W] BY L.SHIFTUP FOR 1, 00198400 BRANDNEW.[15:48] FOR 2, A FOR L; 00198500 IF WL>L THEN 00198600 REPLACE SSP[WB,W+3+L] BY (0&1 FREEF & (WL-L-3)[23:8]). 00198700 [23:48] FOR 3; 00198800 SPTR:=W; BUCKET:=WB; 00198900 GO TO EXIT; 00199000 END; 00199100 %TRY SEARCH ANOTHER BUCKET. 00199200 END; 00199300 ERRSTOP("STRING SPACE JAM"); 00199400 EXIT: 00199500 ZADDTOSTRINGS := SPTR & BUCKET BUCKF & STRINGTAG TAG; 00199600 MICROBUMP(9); 00199700 END ZADDTOSTRINGS; 00199800 00199900 00200000 REAL PROCEDURE ZGETSTRINGPROC(A); VALUE A; REAL A; 00200100 % RETURN THE STRING ASSOCIATED WITH A. STOP IF A NOT A STRING PTR. 00200200 BEGIN 00200300 REAL BNO,SPTR,L; 00200400 IF NOT MSTRINGP(A) THEN 00200500 ERRSTOP("NON-STRING --> " CAT CONVERT(A,FOUR)); 00200600 BNO:=A.BUCKF; 00200700 ZGETSTRINGPROC:=BNO; 00200800 SPTR:=A.SLOCF; 00200900 ZGET2:=REAL(SSP[BNO,SPTR],1); 00201000 ZGET1:=SPTR+3; 00201100 MICROBUMP(8); 00201200 END ZGETSTRINGPROC; 00201300 00201400 00201500 REAL PROCEDURE ZIDSPACE; 00201600 % PROCEDURE RETURNS THE NEXT FREE SLOT IN THE IDENTIFIER SPACE. 00201700 BEGIN LABEL EXIT; 00201800 IF ISPFREE=ISPMAX+1 THEN 00201900 ZGARBAGE(1); 00202000 IF ISPFREE>ISPHIGH THEN ISPHIGH:=ISPFREE; 00202100 ISPFREE:=ISPVALUE[ZIDSPACE:=ISPFREE].FIELD; 00202200 MICROBUMP(6); 00202300 END ZIDSPACE; 00202400 00202500 00202600 PROCEDURE XINTERN; 00202700 % SEARCHES THE OBLIST FOR AN OCCURRENCE OF AN IDENTIFIER WITH 00202800 % PRINT NAME OF ARG1 AND RETURNS THAT ID IF FOUND, OR CREATES 00202900 % A NEW ONE IF NOT. 00203000 BEGIN REAL TPTR,U,S,I,J; 00203100 LABEL FOUND,THERE,NOTTHERE; 00203200 DECLAREANDWEIGH; 00203250 IF MIDP(ARG1) THEN 00203300 U:=STRINGIZE(ISPPNAME[ARG1.FIELD]) 00203400 ELSE 00203500 IF MSTRINGP(ARG1) THEN 00203600 U:=ARG1 00203700 ELSE 00203800 MTMSMTCH(ARG1,GIDORSTRING,GINTERN); 00203900 MINTERNED(U) := TRUE; 00204000 S:=REAL(SSP[U.BUCKF,U.SLOCF+1],2); 00204100 IF S=BRANDNEW THEN GO TO NOTTHERE; 00204200 IF ISPPNAME[S].IDCELL=U.IDCELL THEN 00204300 GO THERE; 00204400 S := MAXFIELDV; 00204500 MINTERNED(S) := TRUE; 00204600 MICROBUMP(3); 00204700 FOR I:=0 STEP 128 UNTIL ISPHIGH DO 00204800 BEGIN MICROBUMP(30); 00204900 J:=ISPPNAME[I]; 00205000 IF I>0 THEN 00205100 ISPPNAME[I]:=U; 00205200 TPTR:=MASKSEARCH(U,S,ISPPNAME[MIN(I+128,ISPHIGH)]); 00205300 ISPPNAME[I]:=J; 00205400 IF TPTR>I OR TPTR=0 THEN 00205500 BEGIN 00205600 S:=TPTR; 00205700 GO TO FOUND; 00205800 END; 00205900 END; 00206000 NOTTHERE: 00206100 IF MSTRINGP(ARG1) THEN 00206200 ISPPNAME[S := ZIDSPACE] := ARG1 %SAVE THE PRINT NAME. 00206300 ELSE 00206400 S:=ARG1.FIELD; 00206500 ISPPNAME[S].TAG := 0; 00206600 MINTERNED(ISPPNAME[S]):=TRUE; 00206700 ISPPROP[S] := NIL; %EMTPY SO FAR. 00206800 ISPVALUE[S] := UNBOUND; 00206900 MICROBUMP(6); 00207000 FOUND: 00207100 REPLACE SSP[U.BUCKF,U.SLOCF+1] BY S.[15:48] FOR 2; 00207200 MICROBUMP(2); 00207300 THERE: 00207400 ARG1.TAG := IDTAG; %BUILD A NEW ENTRY TO RETURN AND PLACE 00207500 ARG1.FIELD := S; 00207600 MICROBUMP(11); 00207700 PRIMCOUNTER(20); 00207800 END XINTERN; 00207900 00208000 00208100 PROCEDURE CHRINTERN(CHR); VALUE CHR; REAL CHR; 00208200 BEGIN REAL R,S; 00208300 LABEL EXIT; 00208400 MICROBUMP(8); 00208500 S:=ZADDTOCHRS(CHR); 00208600 MINTERNED(S) := TRUE; 00208700 R := REAL(SSP[0,S.SLOCF+1],2); 00208800 IF R=SZE THEN 00219700 DO UNTIL CHR:=ZREADCH(R,BFR) NEQ 1 00219800 ELSE 00219900 BEGIN 00220000 CHR:=REAL(BFR[R],1); 00220100 IF CHR=" " THEN 00220200 BEGIN 00220300 MICROBUMP(10); 00220400 SCAN BFR[R] FOR S:SZE-R WHILE = " "; 00220500 R:=SZE-S; 00220600 IF R 24 THEN %PPDMTL02 00223550 WRITETTY ("Truncated to 24 characters"); %PPDMTL02 00223560 ARG1 := 0; 00223600 MICROBUMP(6); 00223700 END FORMID ELSE 00223800 00223900 % IF A NUMBER, COLLECT THE DIGITS, COMPRESS AND RETURN THE PROPER 00224000 % TAG WITH INTEGER VALUE TRUNCATED TO 16 BITS. 00224100 IF CHR IN DIGITSNSIGN THEN 00224200 BEGIN 00224300 S:=1; 00224400 IF CHR="-" OR CHR="+" THEN 00224500 BEGIN 00224600 IF ARG1 NEQ NIL THEN GO TO SINGLE; 00224700 IF CHR="-" THEN S:=-1; 00224800 CHR:=ZREADCH(R,BFR); 00224900 IF NOT ZDIGIT(CHR) THEN 00225000 BEGIN 00225100 R:=*-1; 00225200 CHR:=IF S=1 THEN "+" ELSE "-"; 00225300 GO TO SINGLE; 00225400 END; 00225500 END; 00225600 SCAN BFR[R] FOR I:SZE-R WHILE >= "0"; 00225700 R:=R-1; I:=-R-I+SZE; 00225800 IF I>DZ THEN 00225810 BEGIN REAL L,Z; Z:=NIL; 00225820 J:=R+I-DZ; 00225830 WHILE J>=R DO 00225840 BEGIN 00225850 Z:=ZCONS(ZTRACT(INTEGER(BFR[J],DZ)),Z); L:=L+1; J:=J-DZ; 00225860 END; 00225870 IF R-J="0" THEN 00225980 BEGIN R:=R+1; 00225990 SCAN BFR[R] FOR I:SZE-R WHILE >= "0"; 00226000 R:=SZE-I; 00226010 J:=GFLOATING; 00226020 ARG1:=1; 00226030 END; 00226040 MICROBUMP(20); 00226300 END FORMINTEGER ELSE 00226400 00226500 % IF A STRING, THEN GET ALL THE CHARACTERS. 00226600 IF CHR = """ THEN 00226700 BEGIN %GET THE FIRST 80 CHARACTERS OF THE STRING. 00226800 I:=0; 00226810 DO BEGIN 00226820 MICROBUMP(22); 00226830 REPLACE STRNGS[I] BY BFR[R] FOR S:SZE-R UNTIL = """; 00226900 I:=I+SZE-R-S; 00227000 R:=SZE-S+1; 00227010 IF S>0 THEN 00227020 IF BFR[R]=""" THEN 00227100 BEGIN 00227110 REPLACE STRNGS[I] BY """; 00227120 I:=I+1; 00227130 R:=R+1; 00227140 S:=-1; 00227145 MICROBUMP(10); 00227147 END 00227150 END UNTIL S>=0; 00227160 J:=ZADDTOSTRINGS(STRNGS,MIN(I,SZE)); 00227200 ARG1 := 1; 00227300 MICROBUMP(7); 00227400 END FORMSTRING ELSE 00227500 00227600 IF CHR = "#" THEN 00227700 BEGIN %BUILD A FUNCTION POINTER. 00227800 IF ARG1 NEQ NIL THEN GO TO SINGLE; 00227900 FOR I:=15 STEP -4 UNTIL 3 DO 00228000 J.[I:4] := IF CHR:=ZREADCH(R,BFR)<"0" THEN CHR+9 ELSE CHR; 00228100 J.TAG := FUNCTTAG; 00228200 ARG1 := 5; 00228300 MICROBUMP(30); 00228400 END FORMFNPTR ELSE 00228500 00228600 %ANYTHING ELSE RETURN AS 3, A SINGLE CHARACTER. 00228700 BEGIN 00228800 SINGLE: 00228900 MICROBUMP(6); 00229000 J := ZADDTOCHRS(CHR); 00229100 ARG1 := 3; 00229200 END; 00229300 00229400 PTR:=R; 00229500 ISPVALUE[GSCNVAL.FIELD] := J; 00229600 ARG1 := ZTRACT(ARG1); 00229700 MICROBUMP(8); 00229800 PRIMCOUNTER(35); 00229810 END ZRATOM; 00229900 00230000 00230100 DEFINE XSCAN = ZRATOM(INPTR,LINER,INSZE)#; 00230200 00230300 %SEGMENT(OUTPUT); 00230400 00230500 00230600 EBCDIC ARRAY ZPATOMARRAY[0:179]; 00230700 00230710 PROCEDURE ZPATOM(LL, ESC, OUTER); 00230800 % PROCEDURE DUMPS A SINGLE ATOM TO THE OUTPUT LINE BFR AT LOCATION 00230900 % PTR. LL IS THE MAXIMUM LENGTH OF THE LINE. 00231000 % IF ESC IS TRUE, PRINT ATOM WITH SPECIAL ESCAPE CHARACTERS. 00231100 VALUE LL,ESC; REAL LL; BOOLEAN ESC; 00231200 EBCDIC ARRAY OUTER[0]; 00231210 BEGIN REAL PP,PR,PL,CH; 00231300 POINTER P,Q; 00231400 DEFINE ATOM = ARG1#; 00231500 DEFINE BFR = OUTER#; 00231600 DEFINE PTR = OUTPTR#; 00231700 DEFINE TMP=ZPATOMARRAY#; 00231800 DECLAREANDWEIGH; 00231850 IF LL=0 THEN LL:=ZEXTEND(ISPVALUE[GLINELENGTH.FIELD]); 00231900 IF MSTRINGP(ATOM) THEN %DUMP A STRING. 00232000 BEGIN 00232100 PP := STRINGLENGTH(ATOM); 00232200 IF ESC THEN 00232210 BEGIN 00232220 REPLACE TMP[PP+1] BY ZGETSTRING(ATOM); 00232230 PR := PP+1; PL := PR+PP; PP := PR; 00232240 DO BEGIN 00232250 SCAN TMP[PR] FOR CH:PL-PR UNTIL = """; 00232260 MICROBUMP(PL-PR-CH+6); 00232270 IF CH>0 THEN 00232280 BEGIN 00232290 PP := PP-1; PR := PL-CH; 00232300 REPLACE TMP[PP] BY TMP[PP+1] FOR PR-PP CAT """; 00232310 PR := PR+1; 00232330 END; 00232340 MICROBUMP(8); 00232350 END UNTIL CH=0; 00232360 PP := PP-1; REPLACE TMP[PP] BY """; 00232370 REPLACE TMP[PL] BY """; 00232380 ZDMPATOM(TMP[PP] FOR PL+1-PP,PL+1-PP); 00232390 MICROBUMP(18); 00232400 END 00232410 00232420 ELSE 00232500 BEGIN 00232510 ZDMPATOM(ZGETSTRING(ATOM), PP); 00232600 MICROBUMP(4); 00232700 END; 00232710 END 00232800 ELSE IF MCODEP(ATOM) THEN %DUMP A FUNCTION POINTER. 00232900 ZDMPATOM("#" CAT CONVERT(ATOM.FIELD,4), 5) 00233000 ELSE IF SMALLP(ATOM) THEN %DUMP AN INTEGER. 00233100 BEGIN 00233200 CH := ZEXTEND(ATOM); 00233300 REPLACE TMP BY CH FOR 12 DIGITS; 00233400 SCAN TMP FOR PP:11 WHILE = "0"; 00233500 PP:=PP+1; PR:=12-PP; 00233600 IF CH<0 THEN 00233700 BEGIN 00233800 PP := PP+1; PR := PR-1; 00233900 REPLACE TMP[PR] BY "-"; 00234000 END; 00234100 ZDMPATOM(TMP[PR] FOR PP,PP); 00234200 MICROBUMP(15); 00234300 END 00234400 ELSE IF MIDP(ATOM) THEN %DUMP A PRINT NAME. 00234500 BEGIN 00234600 CH := STRINGIZE(ISPPNAME[ATOM.FIELD]); 00234700 IF NOT ESC THEN 00234800 BEGIN 00234900 MICROBUMP(9); 00235000 PP := STRINGLENGTH(CH); 00235100 ZDMPATOM(ZGETSTRING(CH),PP) 00235200 END 00235300 ELSE BEGIN 00235400 MICROBUMP(18); 00235500 REPLACE TMP BY ZGETSTRING(CH); 00235600 PL:=PP:=ZGET2; 00235700 P:=TMP[0]; Q:=TMP[PL]; 00235800 WHILE PP>0 DO 00235900 BEGIN 00236000 MICROBUMP(10); 00236100 REPLACE Q:Q BY P:P FOR PP:PP WHILE IN LETTERSNDIGITS; 00236200 IF PP>0 THEN 00236300 BEGIN 00236400 PR:=PR+1; 00236500 REPLACE Q:Q BY "!", P:P FOR 1; 00236600 PP:=PP-1; 00236700 END; 00236800 END; 00236900 PP:=PL+PR; 00237000 ZDMPATOM(TMP[PL] FOR PP,PP); 00237100 END 00237110 END 00237120 ELSE IF BIGP(ATOM) THEN %DUMP AN INTEGER. 00237130 BEGIN 00237140 CH := ZEXTEND(MCAR[MCDR[ATOM:=ATOM.FIELD]]); 00237150 REPLACE TMP BY CH FOR 12 DIGITS; 00237160 SCAN TMP FOR PP:11 WHILE = "0"; 00237170 PP:=PP+1; PR:=12-PP; 00237180 IF MCAR[ATOM]LL THEN 00237290 BEGIN 00237300 ZDMPATOM(TMP[PR] FOR LL,LL); 00237310 REPLACE TMP[0] BY TMP[PR+LL] FOR PP-LL; 00237320 PR:=0; PP:=PP-LL; 00237330 MICROBUMP(7); 00237340 END; 00237350 ATOM:=MCDR[ATOM]; 00237360 END UNTIL ATOM=NIL; 00237370 ZDMPATOM(TMP[PR] FOR PP,PP); 00237380 MICROBUMP(17); 00237390 END; 00237395 MICROBUMP(4); 00237500 PRIMCOUNTER(25-REAL(ESC)); 00237550 END ZPATOM; 00237600 00237700 00237800 DEFINE XPATOM = ZPATOM(0,TRUE,OUTER)#; 00237900 DEFINE XPATOM2 = ZPATOM(0,FALSE,OUTER)#; 00238000 00238100 00238200 PROCEDURE XGENSYM; 00238300 % ADDS A GENSYM TO THE SYMBOL TABLE AND THE STRING SPACE. 00238400 % GGENSYM IS THE NUMBER WHICH KEEPS GETTING ADDED. 00238500 BEGIN LABEL EXIT; 00238600 DECLAREANDWEIGH; 00238650 ARG1 := ZIDSPACE; 00238700 REPLACE CONVERTPTR BY "G" CAT DECIMAL(GGENSYM,5); 00238800 ISPPNAME[ARG1] := ZADDTOSTRINGS(CONVERTPTR,6)&0 TAG; 00238900 ISPPROP[ARG1] := ISPVALUE[ARG1] := NIL; 00239000 ARG1.TAG := IDTAG; 00239100 GGENSYM:=*+1; %MOVE TO NEXT GENSYM PLEASE. 00239200 MICROBUMP(13); 00239400 PRIMCOUNTER(3); 00239450 END XGENSYM; 00239500 00239600 00239700 PROCEDURE XREADCH; 00239800 % PROCEDURE PICKS UP NEXT CHARACTER FROM BUFFER. IF CHARACTER IS 00239900 % 0 THEN RETURN $EOF$, IF 1 THEN RETURN $EOL$. 00240000 BEGIN REAL CHR; 00240100 DECLAREANDWEIGH; 00240150 IF INPTR>0 AND INPTR FMAX OR TARG1 < 0 THEN %YEECH, BAD CHANNEL NUMBER. 00244800 BEGIN 00244900 MLIST(ARG1, ERRS[3]); 00245000 ZERROR(103, ARG1); 00245100 END 00245200 ELSE 00245300 IF TARG1>0 THEN 00245400 IF FILEINUSE[TARG1] THEN 00245500 BEGIN 00245600 IF FILEINPUT[TARG1] THEN 00245700 CLOSE(IOFILE[TARG1]) 00245800 ELSE 00245900 CLOSE (IOFILE[TARG1], CRUNCH); %PPDMTL06 00246000 FILEINUSE[TARG1]:=FALSE; 00246100 FILEINPUT[TARG1]:=FALSE; 00246200 END; 00246300 PRIMCOUNTER(38); 00246400 END XCLOSE; 00246500 00246600 00246700 PROCEDURE XEJECT; 00246800 % SKIP TO TOP OF PAGE ON SOME FILE. 00246900 BEGIN LABEL EXIT; 00247000 DECLAREANDWEIGH; 00247010 MICROBUMP(50); 00247020 IF CURCHANOUT = 0 THEN WRITETTY(4"0C") ELSE 00247100 IF CURCHANOUT = 2 THEN WRITE(LINE[SKIP 1]) ELSE 00247110 WRITE(IOFILE[CURCHANOUT]); % ??? PAGE (" "); 00247200 ARG1 := NIL; 00247210 PRIMCOUNTER(39); 00247300 END XEJECT; 00247400 00247500 00247600 PROCEDURE ZERR(A,S); VALUE A,S; REAL A,S; 00247700 % INTERNAL PROCEDURE FOR HANDLING ERROR 12. 00247800 BEGIN REAL TARG1; 00247900 TARG1 := ARG1; 00248000 ARG1:=A; 00248100 ARG2:=TARG1; 00248200 MLIST(ERRS[S], ARG1); 00248300 ARG1:=ZCONS(ARG2,ARG1); 00248400 ZERROR(105, ARG1); 00248500 END ZERR; 00248600 00248700 00248800 PROCEDURE XOPEN; 00248900 % ARG1 IS A LIST OF 1 -> 3 STRINGS WHICH FORM THE NAME OF THE FILE 00249000 % TO OPEN. ARG2 MUST BE EITHER INPUT OR OUTPUT. THE SELECTED CHANNEL 00249100 % NUMBER WHICH IS A POINTER TO IOFILE IS RETURNED. 00249200 BEGIN REAL TMP,TARG1,PTR,START,STOP,I,J,K,V; 00249300 EBCDIC ARRAY FID[0:119]; 00249400 POINTER P; 00249500 LABEL EXIT; 00249600 DECLAREANDWEIGH; 00249700 MICROBUMP(20000); 00249710 REPLACE FID BY 0 FOR 20 WORDS; 00249800 START := STOP := -1; 00249810 TARG1 := ARG1; 00249820 IF MPAIRP(TARG1) THEN 00249830 BEGIN 00249840 TMP := MCDR[ARG1]; TARG1 := MCAR[ARG1]; 00249850 WHILE START<0 DO 00249860 BEGIN 00249870 START := STOP; 00249880 IF MATOM(TMP) THEN 00249890 MTMSMTCH(TMP,GINTEGER,GOPEN); 00249900 STOP := MCAR[TMP]; 00249910 IF NOT SMALLP(STOP) THEN 00249920 MTMSMTCH(STOP,GINTEGER,GOPEN); 00249930 STOP := ZEXTEND(STOP); 00249935 TMP := MCDR[TMP]; 00249940 END; 00249950 END 00249960 ELSE 00249970 BEGIN 00249980 STOP := 100000000; 00249990 START := 0; 00250000 END; 00250010 IF MIDP(TARG1) THEN 00250020 IF TARG1 NEQ NIL THEN 00250100 TARG1 := STRINGIZE(ISPPNAME[TARG1.FIELD]); 00250200 IF MSTRINGP(TARG1) THEN 00250300 REPLACE FID BY ZGETSTRING(TARG1) CAT "." 00250400 ELSE 00250500 MTMSMTCH(TARG1,GIDORSTRING,GOPEN); 00250600 SCAN P:FID UNTIL = 0; 00250700 REPLACE P BY "."; 00250800 00250900 % ERROR IF NOT INPUT OR OUTPUT REQUESTED. 00251000 IF ARG2 NEQ GINPUT AND ARG2 NEQ GOUTPUT THEN 00251100 BEGIN 00251200 MLIST(ARG2, ERRS[6]); 00251300 ZERROR(106, ARG1); 00251400 END; 00251600 00251700 % SELECT CARDS AND PRINTER SPECIALLY. OTHERS, SEARCH THE FILE LIST. 00251800 PTR := IF FID = "CARDS." THEN 1 00252000 ELSE IF FID = "PRINTER." THEN 2 ELSE 3; 00252100 IF PTR = 3 THEN %FILES OTHER THAN CARDS/PRINTER. 00252200 BEGIN 00252300 WHILE FILEINUSE[PTR] DO 00252400 BEGIN 00252500 PTR:=PTR+1; 00252600 IF PTR > FMAX THEN %ERROR, NO UNUSED FILES. 00252700 BEGIN 00252800 MLIST(TARG1, ERRS[4]); 00252900 ZERROR(104, ARG1); 00253000 END; 00253200 END; 00253300 REPLACE IOFILE[PTR].TITLE BY FID; 00253400 END; 00253500 00253600 % IF AN INPUT FILE, OPEN IT (UNLESS AN ERROR), SET FLAGS AND POINTERS 00253700 % AND RETURN THE CHANNEL NUMBER. 00253800 IF ARG2 = GINPUT THEN 00253900 BEGIN 00254000 IF PTR = 2 THEN %PPDMTL08 00254010 BEGIN %PPDMTL08 00254020 MLIST (TARG1, ERRS[4]); %PPDMTL08 00254030 ZERROR (104, ARG1); %PPDMTL08 00254040 END %PPDMTL08 00254050 ELSE BEGIN %PPDMTL08 00254060 IOFILE[PTR](AREASIZE=0,AREAS=0,FILETYPE=8); 00254100 IF NOT IOFILE[PTR].PRESENT THEN 00254200 BEGIN 00254300 MLIST(TARG1, ERRS[3]); 00254400 ZERROR(103,ARG1); 00254500 END 00254600 ELSE 00254700 BEGIN 00254800 ARG1 := ZTRACT(PTR); 00254900 FILEINPUT[PTR]:=TRUE; 00255000 TMP := IOFILE[PTR].FILEKIND; 00255100 IF TMP >= 32 AND TMP <= 63 THEN %PPDMTL04 00255110 BEGIN %PPDMTL04 00255120 MLIST (TARG1, ERRS[4]); %PPDMTL04 00255130 ZERROR (104, ARG1); %PPDMTL04 00255140 END; %PPDMTL04 00255150 TMP := IF TMP=VALUE(ALGOLSYMBOL) OR TMP=VALUE(SEQDATA) THEN 72 ELSE 00255200 IF TMP=VALUE(DATA) OR TMP=VALUE(CDATA) THEN 80 ELSE 80; 00255300 FILEINFO[PTR] := TMP; 00255400 IOHERE[PTR] := START; IOSTOP[PTR] := STOP; 00255410 IF STOP < 100000000 THEN 00255420 BEGIN 00255430 IF TMP=80 THEN 00255440 BEGIN IOHERE[PTR]:=*-100; 00255442 J := (START+99) DIV 100 - 1 00255450 END 00255455 ELSE 00255460 BEGIN 00255470 P := FID[72]; 00255475 I := -1; J := IOFILE[PTR].LASTRECORD; 00255480 WHILE J-I>1 DO 00255490 BEGIN 00255500 K := (I+J).[38:38]; 00255510 READ(IOFILE[PTR][K],14,FID); 00255520 V := INTEGER(P,8); 00255530 IF V=START THEN I:=K; 00255540 IF V2 THEN %PPDMTL09 00255810 BEGIN %PPDMTL09 00255820 IF IOFILE[PTR].RESIDENT THEN %PPDMTL09 00255825 WRITETTY ("This file already exists. A CLOSE will override it."); 00255830 %PPDMTL09 00255831 IOFILE[PTR](MAXRECSIZE=15,BLOCKSIZE=300,AREASIZE=600, %PPDMTL09 00255900 AREAS=40,FILETYPE=0); %PPDMTL09 00256000 END; %PPDMTL09 00256010 ARG1 := ZTRACT(PTR); 00256100 FILEINPUT[PTR]:=FALSE; 00256200 END; 00256300 EXIT: 00256350 FILEINUSE[PTR] := TRUE; %MARK FILE AS IN USE. 00256400 PRIMCOUNTER(41); 00256600 END XOPEN; 00256700 00256800 00256900 DECLARE(XPOSN,42,ARG1:=ZTRACT(OUTPTR)); 00257000 00257100 00257200 PROCEDURE XRDS; 00257300 % SETS CUR.CHAN.IN TO NUMERIC ARGUMENT IF 0 OR 1. 0-ME, 1-CARDS. 00257400 BEGIN REAL TMP; 00257500 DECLAREANDWEIGH; 00257550 TMP := IF ARG1=NIL THEN 0 ELSE ZEXTEND(ARG1); 00257600 IF TMP > FMAX OR TMP < 0 THEN 00257700 ZERR(GINPUT,5); 00257800 IF TMP > 0 THEN %MAKE SURE FILE IS OPEN. 00257900 IF NOT FILEINUSE[TMP] OR NOT FILEINPUT[TMP] THEN 00258000 ZERR(GINPUT,5); 00258100 ARG1 := ZTRACT(CURCHANIN); %OLD CHANNEL. 00258200 CURCHANIN := TMP; 00258300 INPTR := -1; %FORCE A READ. 00258400 MICROBUMP(13); 00258500 PRIMCOUNTER(43); 00258600 END XRDS; 00258700 00258800 00258900 PROCEDURE XWRS; 00259000 % SAME AS XRDS BUT CUR.CHAN.OUT IS CHANGED. 00259100 BEGIN REAL TMP; 00259200 DECLAREANDWEIGH; 00259250 TMP := IF ARG1=NIL THEN 0 ELSE ZEXTEND(ARG1); 00259300 IF TMP>FMAX OR TMP<0 THEN %ERROR IF NUMBER TOO LARGE. 00259400 ZERR(GOUTPUT,5); 00259500 IF TMP>0 THEN %MAKE SURE FILE IS OPENED. 00259600 IF NOT FILEINUSE[TMP] OR FILEINPUT[TMP] THEN 00259700 ZERR(GOUTPUT,5); 00259800 ARG1 := ZTRACT(CURCHANOUT); 00259900 CURCHANOUT := TMP; 00260000 MICROBUMP(12); 00260100 PRIMCOUNTER(44); 00260200 END XWRS; 00260300 00260400 00260500 EBCDIC ARRAY EXPCOMARRAY[0:131]; 00260700 00260710 PROCEDURE XEXPLODE; 00260800 % PRINT THE ATOM IN ARG1 INTO A SPECIAL BUFFER AND THEN BUILD IT 00260900 % INTO A LIST OF CHARACTERS AND RETURN IT. 00261000 BEGIN REAL PTR,S; 00261100 DEFINE TMP=EXPCOMARRAY#; 00261200 DECLAREANDWEIGH; 00261250 IF MPAIRP(ARG1) OR MVECTORP(ARG1) THEN 00261300 MTMSMTCH(ARG1, GATOM, GEXPLODE); 00261400 PTR := OUTPTR; 00261600 OUTPTR := 0; 00261700 IF BIGP(ARG1) THEN 00261710 BEGIN 00261720 S:=ABS(ZEXTEND(MCAR[ARG1.FIELD]))*DZ+3; 00261730 IF SIZE(TMP)<=S THEN 00261740 BEGIN 00261742 RESIZE(TMP,2*S); 00261744 RESIZE(ZPATOMARRAY,2*S); 00261746 END; 00261748 END 00261750 ELSE 00261760 S:=132; 00261770 STOPCOUNT; 00261780 ZPATOM(S,TRUE,TMP); %GET THE CHARACTERS. 00261800 STARTCOUNT; 00261890 S := NIL; %A POINTER TO PREVIOUS ELEMENT. 00261900 DO BEGIN 00262000 CHRINTERN(REAL(TMP[OUTPTR:=OUTPTR-1],1)); 00262100 STOPCOUNT; 00262150 S := ZCONS(ARG1,S); %CHARACTER FIRST ADDED AS AN ID. 00262200 STARTCOUNT; 00262250 MICROBUMP(4); 00262300 END UNTIL OUTPTR=0; 00262400 ARG1 := S; 00262500 OUTPTR := PTR; 00262700 MICROBUMP(12); 00262800 PRIMCOUNTER(0); 00262900 END XEXPLODE; 00263000 00263100 00263200 PROCEDURE XCOMPRESS; 00263300 % BUILD THE CHARACTERS IN THE LIST IN ARG1 INTO AN ATOM AND RETURN. 00263400 % 101 ERROR IF ANYTHING BAD GOES WRONG. 00263500 BEGIN REAL PTR,TMP,L; 00263600 DEFINE HBUF=EXPCOMARRAY#; 00263700 LABEL EXIT,ERR; 00263800 DECLAREANDWEIGH; 00263850 00263900 % BUILD THE LIST OF CHARACTERS INTO STRING IN HBUF BUFFER. 00264000 TMP:=132; 00264100 WHILE MPAIRP(ARG1) DO 00264200 BEGIN 00264300 L:=MCAR[ARG1]; 00264400 IF MIDP(L) THEN 00264500 REPLACE HBUF[PTR] BY ZGETSTRING(STRINGIZE(ISPPNAME[L.FIELD])) 00264600 ELSE 00264700 IF SMALLP(L) THEN 00264800 BEGIN 00264900 L:=ZEXTEND(L)+"0"; 00265000 IF L>"9" THEN GO TO ERR; 00265100 REPLACE HBUF[PTR] BY L.SHIFTUP FOR 1; 00265200 END 00265300 ELSE GO TO ERR; 00265400 PTR:=*+1; 00265500 IF PTR>=TMP THEN 00265510 BEGIN 00265520 IF PTR>=SIZE(HBUF) THEN RESIZE(HBUF,2*PTR); 00265530 TMP:=SIZE(HBUF); 00265540 END; 00265550 ARG1 := MCDR[ARG1]; 00265600 MICROBUMP(11); 00265700 END BUILDCHARS; 00265800 00265900 % BUILD THE ATOM USING RATOM. 00266000 REPLACE HBUF[PTR] BY " "; 00266010 ARG1 := NIL; 00266100 TMP:=0; 00266120 STOPCOUNT; 00266150 ZRATOM(TMP, HBUF, PTR+1); 00266200 STARTCOUNT; 00266250 IF ARG1=ZERO THEN 00266300 BEGIN 00266400 MICROBUMP(3); 00266500 L:=ZIDSPACE; 00266600 ISPPNAME[L]:=ISPVALUE[GSCNVAL.FIELD]&0TAG; 00266700 ISPPROP[L]:=ISPVALUE[L]:=NIL; 00266800 ARG1:=L & IDTAG TAG; 00266900 END 00267000 ELSE 00267100 ARG1 := ISPVALUE[GSCNVAL.FIELD]; 00267200 IF TMP < PTR THEN %ERROR IF NOT ALL CHARACTERS USED. 00267300 ERR: 00267400 ZERROR(101, ERRS[1]); 00267500 EXIT: 00267600 MICROBUMP(17); 00267700 PRIMCOUNTER(5); 00267800 END XCOMPRESS; 00267900 00267910 00267920 PROCEDURE XLENGTHC; 00267930 BEGIN REAL I,J; 00267940 DEFINE A = EXPCOMARRAY#; 00267945 DECLAREANDWEIGH; 00267947 IF MSTRINGP(ARG1) THEN 00267950 ARG1 := STRINGLENGTH(ARG1) 00267960 ELSE 00267970 IF MIDP(ARG1) THEN 00267980 BEGIN 00267990 ARG1 := ISPPNAME[ARG1.FIELD]; 00267992 ARG1 := STRINGLENGTH(ARG1); 00267994 END 00267996 ELSE 00268000 IF MCODEP(ARG1) THEN 00268010 ARG1 := 5 00268020 ELSE 00268030 IF SMALLP(ARG1) THEN 00268040 BEGIN 00268050 MICROBUMP(15); 00268055 I := ZEXTEND(ARG1); 00268060 REPLACE A BY I FOR 12 DIGITS; 00268070 SCAN A FOR J:11 WHILE = "0"; 00268080 ARG1 := (IF I<0 THEN 2 ELSE 1)+J; 00268090 END 00268091 ELSE 00268092 IF BIGP(ARG1) THEN 00268094 BEGIN 00268096 MICROBUMP(20); 00268097 I := ZEXTEND(MCAR[MCDR[ARG1.FIELD]]); 00268098 REPLACE A BY I FOR DZ DIGITS; 00268100 SCAN A FOR J:DZ WHILE = "0"; 00268102 I := ZEXTEND(MCAR[ARG1.FIELD]); 00268104 ARG1 := (IF I>0 THEN (I-1)*DZ ELSE (-I-1)*DZ+1)+J; 00268106 END 00268108 ELSE MTMSMTCH(ARG1,GATOM,GEXPLODE); 00268110 ARG1 := ZTRACT(ARG1); 00268120 MICROBUMP(6); 00268130 PRIMCOUNTER(2); 00268140 END XLENGTHC; 00268160 00268170 00268180 PROCEDURE XGETV; 00268200 % RETRIEVES THE ELEMNT OF A VECTOR. TYPE MISMATCH ERROR OCCURS IF 00268300 % ARG1 IS NOT A VECTOR, OR ARG2 IS NOT AN INTEGER. 00268400 BEGIN LABEL EXIT; 00268500 DECLAREANDWEIGH; 00268550 IF NOT MVECTORP(ARG1) THEN 00268600 MTMSMTCH(ARG1, GVECTOR, GGETV); 00268700 IF NOT SMALLP(ARG2) THEN 00268800 MTMSMTCH(ARG2, GINTEGER, GGETV); 00268900 IF ARG20 THEN 00270700 DO BEGIN 00270800 IF VSP[P]=L THEN BEGIN 00270900 VSP[P]:=ARG1; 00271000 ARG1:=P; 00271100 ARG1.TAG:=VECTORTAG; 00271200 IF Q<0 THEN VSPFREE:=VSP[P+1] 00271300 ELSE VSP[Q+1]:=VSP[P+1]; 00271400 P:=-1; 00271500 MICROBUMP(9); 00271600 END 00271700 ELSE 00271800 IF VSP[P]>L+1 THEN BEGIN 00271900 TMP:=P; 00272000 VSP[P+L+2]:=VSP[P]-L-2; 00272100 VSP[P]:=ARG1; 00272200 VSP[P+L+3]:=VSP[P+1]; 00272300 IF Q<0 THEN VSPFREE:=P+L+2 00272400 ELSE VSP[Q+1]:=P+L+2; 00272500 ARG1 := TMP; 00272600 ARG1.TAG:=VECTORTAG; 00272700 P:=-1; 00272800 MICROBUMP(12); 00272900 END 00273000 ELSE 00273100 BEGIN 00273200 Q:=P; 00273300 P:=VSP[Q+1]; 00273400 MICROBUMP(5); 00273500 END; 00273600 END UNTIL P<0; 00273700 MICROBUMP(5); 00273800 END GETVECTOR; 00273900 00274000 PROCEDURE XMKVECT; 00274100 % CREATE A VECTOR OF LENGTH OF THE SINGLE ARGUMENT. TYPE MISMTACH 00274200 % ERROR CHECKING ONLY. 00274300 BEGIN REAL I,J; 00274400 DECLAREANDWEIGH; 00274450 IF NOT SMALLP(ARG1) THEN BEGIN 00274500 MTMSMTCH(ARG1, GINTEGER, GMKVECT); 00274600 END 00274700 ELSE BEGIN %INTEGER ARGUMENT, CHECK FOR SIZE. 00274800 J:=ZEXTEND(ARG1); 00274900 GETVECTOR(J); 00275000 IF SMALLP(ARG1) THEN BEGIN 00275100 ZGARBAGE(3); 00275200 GETVECTOR(J); 00275300 IF SMALLP(ARG1) THEN BEGIN 00275400 MLIST(ARG1,ERRS[9]); 00275500 ZERROR(109,ARG1); 00275600 END; 00275700 END; 00275800 I:=ARG1.FIELD+1; 00275900 DO BEGIN 00276000 VSP[I] := NIL; 00276100 I:=I+1; 00276200 MICROBUMP(4); 00276300 J:=*-1 ; 00276400 END UNTIL J<0; 00276500 END; 00276600 MICROBUMP(7); 00276700 PRIMCOUNTER(47); 00276800 END XMKVECT; 00276900 00277000 00277100 PROCEDURE XPUTV; 00277200 % PLACES ARG3 AT POSITION ARG2 IN VECTOR ARG1. TYPE MISMATCH CHECKING 00277300 % ON ARG1, ARG2 AND SUBSCRIPT RANGE CHECKING ON ARG2. 00277400 BEGIN LABEL EXIT; 00277500 DECLAREANDWEIGH; 00277550 IF NOT MVECTORP(ARG1) THEN 00277600 MTMSMTCH(ARG1, GVECTOR, GPUTV); 00277700 IF NOT SMALLP(ARG2) THEN 00277800 MTMSMTCH(ARG2, GINTEGER, GPUTV); 00277900 IF ARG2 N AND RETURNS 00280600 % A POINTER TO IT. 00280700 BEGIN LABEL EXIT; 00280800 REAL A; 00280900 MICROBUMP(3*N+5); 00281000 A := NIL; 00281100 WHILE N>0 DO 00281200 A := ZCONS(ARGS[N:=N-1], A); 00281300 ZREGLIST:=A; 00281400 END ZREGLIST; 00281500 00281600 00281700 00281800 BOOLEAN PROCEDURE ZEQUAL(P,Q); VALUE P,Q; REAL P,Q; 00281900 BEGIN LABEL L,EXIT; 00282000 DECLAREANDWEIGH; 00282050 L: MICROBUMP(3); 00282100 IF P=Q THEN BEGIN ZEQUAL:=TRUE; GO TO EXIT; END; 00282200 IF P.TAG NEQ Q.TAG THEN GO TO EXIT; 00282300 IF MPAIRP(P) THEN 00282400 BEGIN 00282500 MICROBUMP(2); 00282600 STOPCOUNT; 00282650 IF NOT ZEQUAL(MCAR[P],MCAR[Q]) THEN 00282700 BEGIN 00282710 STARTCOUNT; 00282720 GO TO EXIT; 00282730 END; 00282740 STARTCOUNT; 00282750 MICROBUMP(2); 00282800 P:=MCDR[P]; Q:=MCDR[Q]; GO TO L; 00282900 END; 00283000 MICROBUMP(1); 00283010 IF BIGP(P) THEN 00283020 BEGIN 00283030 MICROBUMP(3); 00283040 P.TAG:=0; Q.TAG:=0; 00283045 DO BEGIN 00283050 IF MCAR[P] NEQ MCAR[Q] THEN GO TO EXIT; 00283060 MICROBUMP(4); 00283070 P:=MCDR[P]; Q:=MCDR[Q]; 00283080 END UNTIL Q=NIL; 00283090 ZEQUAL:=TRUE; 00283100 GO TO EXIT; 00283110 END; 00283120 MICROBUMP(1); 00283130 IF NOT MVECTORP(P) THEN GO TO EXIT; 00283200 MICROBUMP(1); 00283300 IF VSP[P.FIELD] NEQ VSP[Q.FIELD] THEN GO TO EXIT; 00283400 MICROBUMP(6); 00283500 ZEQUAL := POINTER(VSP[P.FIELD+1]) = POINTER(VSP[Q.FIELD+1]) 00283600 FOR (ZEXTEND(VSP[P.FIELD])+1)*6; 00283700 EXIT: 00283800 MICROBUMP(3); 00283900 PRIMCOUNTER(62); 00284000 END ZEQUAL; 00284100 00284200 00284300 PROCEDURE XLENGTH; 00284400 BEGIN REAL I; 00284500 DECLAREANDWEIGH; 00284550 WHILE MPAIRP(ARG1) DO 00284600 BEGIN 00284700 I:=I+1; 00284800 ARG1:=MCDR[ARG1]; 00284900 MICROBUMP(3); 00285000 END; 00285100 ARG1:=ZTRACT(I); 00285200 MICROBUMP(5); 00285300 PRIMCOUNTER(63); 00285400 END XLENGTH; 00285500 00285600 00285700 PROCEDURE XREVERSIP; 00285800 BEGIN REAL P,Q; 00285900 DECLAREANDWEIGH; 00285950 Q:=NIL; 00286000 WHILE ARG1 NEQ NIL DO 00286100 BEGIN 00286200 P:=MCDR[ARG1]; 00286300 MCDR[ARG1]:=Q; 00286400 Q:=ARG1; 00286500 ARG1:=P; 00286600 MICROBUMP(5); 00286700 END; 00286800 ARG1:=Q; 00286900 MICROBUMP(6); 00287000 PRIMCOUNTER(64); 00287100 END XREVERSIP; 00287200 00287300 00287400 REAL PROCEDURE MMEMQ(P,Q); VALUE P,Q; REAL P,Q; 00287500 BEGIN LABEL EXIT; 00287600 DECLAREANDWEIGH; 00287650 IF Q NEQ NIL THEN 00287700 DO BEGIN 00287800 MICROBUMP(3); 00287900 IF MCAR[Q] = P THEN GO TO EXIT; 00288000 Q:=MCDR[Q]; 00288100 END UNTIL Q=NIL; 00288200 EXIT: 00288300 MMEMQ:=Q; 00288400 MICROBUMP(5); 00288500 PRIMCOUNTER(65); 00288600 END MMEMQ; 00288700 00288800 00288900 REAL PROCEDURE MMEMBER(P,Q); VALUE P,Q; REAL P,Q; 00289000 BEGIN LABEL EXIT; 00289100 DECLAREANDWEIGH; 00289150 IF Q NEQ NIL THEN 00289200 IF MSIMPLE(P) THEN 00289300 DO BEGIN MICROBUMP(3); 00289400 IF MCAR[Q]=P THEN GO TO EXIT; 00289500 Q:= MCDR[Q]; 00289600 END UNTIL Q=NIL 00289700 ELSE 00289800 DO BEGIN MICROBUMP(3); 00289900 STOPCOUNT; 00289950 IF ZEQUAL(P,MCAR[Q]) THEN 00290000 BEGIN 00290010 STARTCOUNT; 00290020 GO TO EXIT; 00290030 END; 00290040 STARTCOUNT; 00290050 Q:=MCDR[Q]; 00290100 END UNTIL Q=NIL; 00290200 EXIT: 00290300 MMEMBER:=Q; 00290400 MICROBUMP(7); 00290500 PRIMCOUNTER(66); 00290650 END MMEMBER; 00290700 00290800 00290900 DEFINE XMEMQ = ARG1:=MMEMQ(ARG1,ARG2)#; 00291000 DEFINE XMEMBER = ARG1:=MMEMBER(ARG1,ARG2)#; 00291100 00291200 00291300 PROCEDURE XLITER; 00291400 BEGIN REAL S; 00291500 DECLAREANDWEIGH; 00291550 S:=NIL; 00291600 IF MIDP(ARG1) THEN 00291700 IF (ARG1:=ISPPNAME[ARG1.FIELD]).BUCKF = 0 THEN %SINGLE CHARACTER 00291800 IF ZLITER(ARG1.LETERF) THEN S:=T; 00291900 ARG1:=S; 00292000 MICROBUMP(8); 00292100 PRIMCOUNTER(67); 00292200 END ZLITER; 00292300 00292400 00292500 PROCEDURE XDIGIT; 00292600 BEGIN REAL S; 00292700 DECLAREANDWEIGH; 00292750 S:=NIL; 00292800 %PPDMTL07 00292900 %PPDMTL07 00293000 IF ZDIGIT(ARG1.LETERF) THEN S:=T; 00293100 ARG1:=S; 00293200 MICROBUMP(8); 00293300 PRIMCOUNTER(68); 00293400 END ZDIGIT; 00293500 00293600 00293700 $PAGE 00293800 00293900 00294000 DEFINE ALGOLPRIMATIVE(N) = 00294100 BEGIN 00294200 00294300 CASE N OF 00294400 BEGIN 00294500 XEXPLODE; %[0] 00294600 ZCATCH; %[1] 00294700 XLENGTHC; %[2] 00294800 XGENSYM; %[3] 00294900 XSETMOD; %[4] 00295000 XCOMPRESS; %[5] 00295100 XCRECIP; %[6] 00295200 XCMOD; %[7] 00295300 XCPLUS; %[8] 00295400 XCTIMES; %[9] 00295500 XCDIF; %[10] 00295600 XREMOB; %[11] 00295700 XRCONS; %[12] 00295800 XNCONS; %[13] 00295900 XCONS; %[14] 00296000 XRPLACA; %[15] 00296100 XRPLACD; %[16] 00296200 XTERPRI; %[17] 00296300 XPRINC; %[18] 00296400 XTHROW; %[19] 00296500 XINTERN; %[20] 00296600 XREADCH; %[21] 00296700 XLAMBIND; %[22] 00296800 XQUIT; %[23] 00296900 XPATOM; %[24] 00297000 XPATOM2; %[25] 00297100 XEQ; %[26] 00297200 XEQN; %[27] 00297300 XRECLAIM; %[28] 00297400 XPLUS2; %[29] 00297500 XTIMES2; %[30] 00297600 XDIFFERENCE; %[31] 00297700 XQUOTIENT; %[32] 00297800 XGREATERP; %[33] 00297900 XLESSP; %[34] 00298000 XSCAN; %[35] 00298100 XREMAINDER; %[36] 00298200 ZUNSTACK; %[37] 00298300 XCLOSE; %[38] 00298400 XEJECT; %[39] 00298500 XAPPLY; %[40] 00298600 XOPEN; %[41] 00298700 XPOSN; %[42] 00298800 XRDS; %[43] 00298900 XWRS; %[44] 00299000 ; %[45] 00299100 XGETV; %[46] 00299200 XMKVECT; %[47] 00299300 XPUTV; %[48] 00299400 XUPLIM; %[49] 00299500 XTIME; %[50] 00299600 XPUTPROP; %[51] 00299700 XGETPROP; %[52] 00299800 XPUTG; %[53] 00299900 XGETG; %[54] 00300000 XDUMP; %[55] 00300100 XORDERP; %[56] 00300200 XCHKPOINT; %[57] 00300300 XCONSTANTP; %[58] 00300400 XVECTORP; %[59] 00300500 XSETPCHAR; %[60] 00300600 XEXPT; %[61] 00300700 XEQUAL; %[62] 00300800 XLENGTH; %[63] 00300900 XREVERSIP; %[64] 00301000 XMEMQ; %[65] 00301100 XMEMBER; %[66] 00301200 XLITER; %[67] 00301300 XDIGIT; %[68] 00301400 XGET; %[69] 00301500 XGETD; %[70] 00301600 XGLOBALP; %[71] 00301700 XFLUIDP; %[72] 00301800 XGLOBAL; %[73] 00301900 XFLUID; %[74] 00302000 XUNFLUID; %[75] 00302100 XPUTD; %[76] 00302200 ; %[77] 00302300 ; %[78] 00302400 XATOM; %[79] 00302500 ZLIST; %[80] 00302600 XQUOTE; %[81] 00302700 XCAR; %[82] 00302800 XCDR; %[83] 00302900 XNULL; %[84] 00303000 XCODEP; %[85] 00303010 XIDP; %[86] 00303020 XNUMBERP; %[87] 00303030 XPAIRP; %[88] 00303040 XSTRINGP; %[89] 00303050 END CASE; 00303100 00303200 END ALGOLPRIMATIVE#; 00303300 00303400 $PAGE 00303500 %SEGMENT(B.MANAGEMENT); 00303600 00303700 00303800 00303900 00304000 $PAGE 00304100 00304200 DEFINE ZEVAL = 00304300 BEGIN 00304400 IF NOT MCONSTANTP(ARG1) THEN 00304500 IF MIDP(ARG1) THEN 00304600 BEGIN 00304700 MTEMP := ARG1; 00304800 ARG1 := ISPVALUE[MTEMP.FIELD]; 00304900 IF ARG1 = UNBOUND THEN 00305000 BEGIN 00305100 MLIST(ERRS[18],MTEMP); 00305200 ZERROR(100,ARG1); 00305300 END; 00305400 END 00305500 ELSE YEVAL; 00305600 END ZEVAL#; 00305700 00305800 DEFINE XFSUBR = 00305900 BEGIN 00306000 PRIMTRACE(77); 00306100 STOPCOUNT; 00306200 ZCALL(ARG2); 00306300 STARTCOUNT; 00306400 END XFSUBR#; 00306500 00306600 DEFINE XSUBR = 00306700 BEGIN 00306800 PRIMTRACE(78); 00306900 STOPCOUNT; 00307000 ZGET1 := ZSUBR; 00307100 STARTCOUNT; 00307200 MICROBUMP((13+5*MTEMP)); 00307300 STOPCOUNT; 00307400 ZCALL(ZGET1); 00307500 STARTCOUNT; 00307600 END XSUBR#; 00307700 00307800 REAL PROCEDURE ZSUBR; 00307900 BEGIN REAL N,L; 00308000 LABEL L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14; 00308100 SWITCH S := L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14; 00308200 MICROBUMP((MTEMP:=-1)); 00308300 ZSUBR := ARG1; 00308400 L := ARG2; 00308500 IF L NEQ NIL THEN 00308600 BEGIN 00308700 IF ES+16>ESPMAX THEN 00308800 RESIZE(ESP,ESPMAX:=ESPMAX+PAGESIZE,RETAIN); 00308900 ESP[ES:=ES+1] := L; %PROTECT L 00309000 N:=ES; 00309100 DO BEGIN 00309200 ARG1 := MCAR[L]; 00309300 ZEVAL; 00309400 ESP[ES:=ES+1] := ARG1; 00309500 L := MCDR[L]; 00309600 END UNTIL L=NIL; 00309700 L := ES-N; 00309800 ES := N; 00309900 GO TO S[L]; 00310000 L14: ARG14 := ESP[ES+14]; 00310100 L13: ARG13 := ESP[ES+13]; 00310200 L12: ARG12 := ESP[ES+12]; 00310300 L11: ARG11 := ESP[ES+11]; 00310400 L10: ARG10 := ESP[ES+10]; 00310500 L9: ARG9 := ESP[ES+9]; 00310600 L8: ARG8 := ESP[ES+8]; 00310700 L7: ARG7 := ESP[ES+7]; 00310800 L6: ARG6 := ESP[ES+6]; 00310900 L5: ARG5 := ESP[ES+5]; 00311000 L4: ARG4 := ESP[ES+4]; 00311100 L3: ARG3 := ESP[ES+3]; 00311200 L2: ARG2 := ESP[ES+2]; 00311300 L1: ARG1 := ESP[ES+1]; 00311400 ES := ES-1; 00311500 MICROBUMP((MTEMP:=L)); 00311600 END; 00311700 END ZSUBR; 00311800 00311900 PROCEDURE ZLIST; 00312000 BEGIN REAL Y,U; 00312100 DECLAREANDWEIGH; 00312200 U := ARG1; 00312400 IF U NEQ NIL THEN 00312500 BEGIN 00312600 ESP[ES:=ES+1] := U; 00312700 ARG1 := MCAR[U]; 00312800 STOPCOUNT; ZEVAL; STARTCOUNT; 00312900 Y := ZCONS(ARG1,NIL); 00313000 ESP[ES:=ES+1] := Y; 00313100 WHILE (U:=MCDR[U]) NEQ NIL DO 00313200 BEGIN 00313300 ARG1 := MCAR[U]; 00313400 STOPCOUNT; ZEVAL; STARTCOUNT; 00313500 Y := MCDR[Y] := ZCONS(ARG1,NIL); 00313600 MICROBUMP(3); 00313700 END; 00313800 ARG1 := ESP[ES]; 00313900 ES := ES-2; 00314000 MICROBUMP(7); 00314100 END; 00314200 MICROBUMP(5); 00314300 PRIMCOUNTER(80); 00314400 STOPCOUNT; 00314500 MICROBUMP((MTEMP:=-C)); 00314600 END ZLIST; 00314700 00314800 DEFINE XLIST = 00314900 BEGIN 00315000 STOPCOUNT; 00315100 ZLIST; 00315200 STARTCOUNT; 00315300 MICROBUMP((-MTEMP)); 00315400 END XLIST#; 00315500 $PAGE 00315600 00500100 00500200 00500300 00500400 % HERE ARE THE DEFINITIONS WHICH MAKE LISP ==> ALGOL WORK 00500500 00500600 DEFINE 00500700 00500800 GLOBAL[N] = ISPVALUE[QSP[QNUM+N].FIELD]#, 00500900 QUOTE[N] = QSP[QNUM+N]#, 00501000 FLUID[N] = ISPVALUE[QSP[QNUM+N].FIELD]#; 00501100 00501500 PROCEDURE MPROGBIND(Q); VALUE Q; REAL Q; 00501600 BEGIN REAL CNT,TPTR,I; 00501700 DECLAREANDWEIGH; 00501750 TPTR := TSPPTR; %BACK CHAIN POINTER. 00501800 CNT := ZEXTEND(QSP[Q]); 00501900 CHECKSTACK(CNT*2+2); 00502000 MICROBUMP(9); 00502100 WHILE I0 THEN 00519900 'BEGIN REAL V; 'END; 00520000 'FOR NUM:=1 STEP 1 UNTIL SNUM DO 00520100 'BEGIN REAL V'NUM; 'END; 00520200 'IF SNUM>0 THEN 00520400 'BEGIN V:="LOCAL " & SNUM [6:7]; 'END; 00520500 'LET QNUM := Q; 00520600 CORRECTLINK(Q,N)#, 00520700 LOCAL[N] = 'LET SNUM:=N+1; V'SNUM#; 00521000 00521100 $POP OMIT 00521200 00521300 $ SET OMIT = COUNT 00521900 00521910 DEFINE 00522000 KLOAD(R,E) = R := E#, 00522100 KSTORE(G,R) = GLOBAL[G] := R#, 00522300 KSET(S,R) = LOCAL[S] := R#, 00522400 00522405 KLINK(N,F) = F#, 00522410 KGOTO(L) = GO TO L#, 00522420 00522430 KJUMPNIL(L) = IF ARG1=NIL THEN GO TO L#, 00522440 KJUMPT(L) = IF ARG1 NEQ NIL THEN GO TO L#, 00522450 00522460 IFTRUE(L,B) = IF B THEN GO TO L#, 00522470 IFNOT(L,B) = IF NOT B THEN GO TO L#; 00522480 00522600 00522700 $ POP OMIT SET OMIT = NOT COUNT 00522800 00522810 DEFINE 00522900 KLOAD(R,E) = R := CT(E,100)#, 00523000 KSTORE(G,R) = GLOBAL[G] := CT(R,94)#; 00523100 00523400 PROCEDURE KSET(R,S); VALUE R,S; REAL R,S; 00524700 BEGIN 00524800 LOCAL[R] := S; 00524900 PRIMTRACE(96); 00525000 END; 00525100 00525200 DEFINE 00525300 KLINK(N,F) = PRIMTRACE(101); STOPCOUNT; F; STARTCOUNT#, 00525310 KGOTO(L) = PRIMTRACE(98); GO TO L#, 00525320 00525330 KJUMPNIL(L) = IF JUMP(ARG1=NIL) THEN GO TO L#, 00525340 KJUMPT(L) = IF JUMP(ARG1 NEQ NIL) THEN GO TO L#, 00525350 00525360 IFTRUE(L,B) = IF JUMP(B) THEN GO TO L#, 00525370 IFNOT(L,B) = IF JUMP(NOT B) THEN GO TO L#; 00525380 00525400 $ POP OMIT 00525900 00526000 DEFINE KUNDEFINED(S,N) = 00526100 BEGIN REAL I,J; 00526200 DEFINE A=EXPCOMARRAY#; 00526300 REPLACE A BY S; 00526400 SCAN A FOR I:80 UNTIL ="."; 00526500 J := ARG1; ARG1 := ZADDTOSTRINGS(A,80-I); 00526600 XINTERN; 00526700 I := ARG1; ARG1 :=J; 00526800 XCALL(MLINK(I,N)); 00526900 END#; 00527000 00527100 $PAGE 08000100 08000200 08000300 08000600 PROCEDURE XCALL(N); VALUE N; REAL N; 08000700 BEGIN LABEL EXIT; 08000800 COUNT(102); 08001100 IF N<255 THEN 08001200 ALGOLPRIMATIVE(N) 08001300 ELSE 08001400 BEGIN 08001500 CASE N-256 OF 08001600 BEGIN LISTOFPROCCALLS END; 08001700 END; 08002300 EXIT: 08002400 END OF XCALL; 08002500 08002600 08002700 08002800 COMMENT PROCEDURE (FOR TRACE BACK); 08999999 09000100 09000200 INITIALIZE; %GET THINGS SET UP. 09000300 YSTANDARDQ11LISP; 09000700 09000800 THU: 09001300 09001400 % END OF IT. 09999999 % 10000100 %********************************************************************* 10000200 %** ** 10000300 %** COMMENTS ON THE PATCHES WRITTEN BY MONTREAL PPD ** 10000400 %** ** 10000500 %********************************************************************* 10000600 % 10000700 %PPDMTL01 08/12/85 L. SANS CARTIER 10000800 %THIS PATCH WILL CHANGE THE ACCESS TO THE LISP LIBRARY. UP TO NOW, IT 10000900 %WAS IMPLEMENTED AS A SIMPLE OBJECT LIBRARY; IT WILL BE NOW A "SUPPORT 10001000 %LIBRARY". 10001100 % 10001200 %PPDMTL02 08/23/85 L. SANS CARTIER 10001300 %THIS WILL ADD AN ERROR MESSAGE IN THE CASE THAT AN IDENTIFIER HAVING 10001400 %MORE THAN 24 CHARACTERS IS USED. (--LISP--) 10001500 % 10001600 %PPDMTL04 08/23/85 L. SANS CARTIER 10002100 %THIS WILL DETECT THE CASE WHEN A CODE FILE IS GIVEN TO THE INPUT 10002200 %COMMAND "IN". (--REDUCE--) 10002300 % 10002400 %PPDMTL05 08/23/85 L. SANS CARTIER 10002500 %LINES 148900 AND 149000 HAD BEEN MOVED RIGHT AFTER LINE 148600 IN 10002600 %ORDER TO REMOVE THE "STACK UNDERFLOW" ERROR THAT OCCURED WHEN A CALL 10002700 %WITH EITHER TOO FEW OR TOO MUCH ARGUMENTS. (--LISP-- AND --REDUCE--) 10002800 % 10002900 %PPDMTL06 08/23/85 L. SANS CARTIER 10003000 %THIS IS TO CREATE OUTPUT DISK FILES AS SMALL AS POSSIBLE ("CRUNCH"). 10003100 %(--LISP-- AND --REDUCE--) 10003200 % 10003300 %PPDMTL07 08/23/85 L. SANS CARTIER 10003400 %THE FUNCTION "DIGIT" WASN'T WORKING AT ALL. THIS WILL CORRECT IT. 10003500 %(--LISP--) 10003600 % 10003700 %PPDMTL08 08/23/85 L. SANS CARTIER 10003800 %AN ERROR SHOULD BE DETECTED WHEN THE PRINTER IS OPENED IN INPUT MODE. 10003900 %(--LISP--) 10004000 % 10004100 %PPDMTL09 08/23/85 L. SANS CARTIER 10004200 %WHEN THE USER TRIES TO WRITE ON A DISK FILE THAT ALREADY EXISTS, A 10004300 %WARNING SHOULD BE GIVEN. (--LISP--) 10004400 % 10004500 %PPDMTL10 08/23/85 L. SANS CARTIER 10004600 %THIS WILL ALLOW THE USER TO CONTINUE AFTER A "FATAL ERROR" IS GIVEN. 10004700 %UP TO NOW, THE NEXT COMMAND ALWAYS PRODUCED A "SEG ARRAY ERROR" AND 10004800 %THEN DS-ED. 10004900 % **************** IMPORTANT NOTE TO THE USER ***************** 10005000 % * AFTER THE FATAL ERROR MESSAGE IS GIVEN, THE PROGRAM WILL * 10005100 % * WAIT FOR ANOTHER COMMAND (BUT WITHOUT GIVING THE PROMPT). * 10005200 % * THE NEXT COMMAND WILL BE A DUMMY ONE AND WILL ONLY MAKE * 10005300 % * THE PROGRAM GIVE THE PROMPT. THE USER WILL THEN BE ABLE * 10005400 % * TO CONTINUE NORMALLY. * 10005500 % ************************************************************* 10005600 %YOU MAY WISH TO REMOVE THIS PATCH IF THE FORMER RESULTS WERE MORE 10005700 %SUITED TO YOUR SPECIFIC NEEDS. 10005800 % 10005900 %PPDMTL11 08/23/85 L. SANS CARTIER 10006000 %THIS PATCH WILL ENABLE LISP TO RETURN NIL (INSTEAD OF AN INVALID 10006100 %INDEX) WHENEVER "CDR NIL" IS ASKED FOR. (--LISP--) 10006200 % 10006300 %PPDMTL19 01/08/86 L. SANS CARTIER 10006310 %THIS PATCH WILL ENABLE LISP TO WORK ON A9 MACHINES. BECAUSE THE A9 DO 10006320 %NOT NORMALIZE FLOATING POINT NUMBERS IN THE SAME WAY THAN THE A3 DOES, 10006330 %THE OVERFLOW TEST DIDN'T ALWAYS GIVE THE SAME RESULTS ON THE 2 MACHINES10006340 %EVENTHOUGH ACTUALLY THE VALUE WAS THE SAME. 10006350 % 10006360 %PPDMTL12 08/23/85 L. SANS CARTIER 10006400 %THE END-OF-LINE ("EOL") WAS NOT RECOGNIZED BY READCH. (--LISP--) 10006500