From fecaa658900695f2155498791665432a809b0b45 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sun, 18 Jun 2017 13:42:03 -0700 Subject: [PATCH] Commit LONGALG patch to Mark XIII Extended Algol for support of LONG ARRAY type required by the B6500 simulator. --- source/B65SIM/B65SIM-COMPILE-PRT.lst | 7651 +++++++++++++++++ source/B65SIM/B65SIM-COMPILE.card | 8 + source/B65SIM/LONGALG-DELTA.pdf | Bin 0 -> 58699 bytes source/B65SIM/LONGALG-PATCH.alg_m | 127 + source/B65SIM/LONGALG.alg_m | 11147 +++++++++++++++++++++++++ source/B65SIM/SOURCE.alg_m | 2 +- 6 files changed, 18934 insertions(+), 1 deletion(-) create mode 100644 source/B65SIM/B65SIM-COMPILE-PRT.lst create mode 100644 source/B65SIM/B65SIM-COMPILE.card create mode 100644 source/B65SIM/LONGALG-DELTA.pdf create mode 100644 source/B65SIM/LONGALG-PATCH.alg_m create mode 100644 source/B65SIM/LONGALG.alg_m diff --git a/source/B65SIM/B65SIM-COMPILE-PRT.lst b/source/B65SIM/B65SIM-COMPILE-PRT.lst new file mode 100644 index 0000000..2979968 --- /dev/null +++ b/source/B65SIM/B65SIM-COMPILE-PRT.lst @@ -0,0 +1,7651 @@ + LABEL 000000000LINE 00187158?COMPILE B65SIM/DISK WITH LONGALG LIBRARY LONGALG/B65SIM + + + + + + RETRO-B5500 LONGALG COMPILER MARK XIII.0 SUNDAY, 06/07/87, 7:30 AM. + + + + + + COMMENT 00099999 T 0000 + ***************************** 00100000 T 0000 + ***** B6500 SIMULATOR ***** 00101000 T 0000 + ***************************** 00102000 T 0000 + ********************************* 00200000 T 0000 + ***** ERROR MESSAGE INDEX ***** 00201000 T 0000 + ********************************* 00202000 T 0000 + # PROCEDURE EXPLANATION 00203000 T 0000 + -- --------- ----------- 00204000 T 0000 + 0 CONTROLSECTION MORE THAN 1 OF VARF,LEEF,TEEF,SEEF ON 00205000 T 0000 + 1 VARI TRIED TO EXECUTE VARI OPERATOR 00206000 T 0000 + 2 (RESERVED FOR TEED) 00207000 T 0000 + 3 (RESERVED FOR TEEU) 00208000 T 0000 + 4 (RESERVED FOR ILED) 00209000 T 0000 + 5 (RESERVED FOR ILEU) 00210000 T 0000 + 6 EXSD TRIED TO EXECUTE EXSD OPERATOR 00211000 T 0000 + 7 EXSU TRIED TO EXECUTE EXSU OPERATOR 00212000 T 0000 + 10 ERVSFLOW INVALID CALL ON ERVSFLOW (FELL THRU SWITCH) 00213000 T 0000 + 11 ERVSFLOW NOT(AROF AND BROF) IN SPECIALINDEX 00214000 T 0000 + 13 ERVSFLOW STACK UNDERFLOW P22 NOTE THIS WILL BE INTERRUPT 00215000 T 0000 + 14 ERVSFLOW PAGE 7A AROF TRUE 00216000 T 0000 + 15 ERVSFLOW BROF FALSE IN NORMALINDEX 00217000 T 0000 + 98 ADJ INVALID PARAMETERS TO ADJ 00218000 T 0000 + 99 ADJ ADJ DIDNT PERFORM REQUESTED ACTION 00219000 T 0000 + 100 RDIV QUOTIENT CANNOT BE INTEGERIZED. 00220000 T 0000 + 101 INTERRUPTCONTROL INT HAS IMPROPER VALUE. 00221000 T 0000 + 200 MULTIPLEXOR A NON-EXISTENT HARDWARE TYPE WAS REQUESTED. 00222000 T 0000 + 201 MULTIPLEXOR THE BUFFER LENGTH FOR A FILE IS TO SMALL. 00223000 T 0000 + 202 IDLE NO INTERRUPTS PENDING FOR IDLE OPERATOR 00224000 T 0000 + % ## TYPE OF TRACE 00225000 T 0000 + % -- ------------- 00226000 T 0000 + % 0 NO TRACE 00227000 T 0000 + % 1 A X B Y REGISTERS 00228000 T 0000 + % 2 C REGISTERS 00229000 T 0000 + % 3 P REGISTER 00230000 T 0000 + % 4 DISPLAY REGISTERS 00231000 T 0000 + % 5 STACK CONTENTS 00232000 T 0000 + % 6 A X B Y C 00233000 T 0000 + % 7 A X B Y P 00234000 T 0000 + % 6 A X B Y DISPLAY 00235000 T 0000 + % 9 A X B Y STACK 00236000 T 0000 + % 10 A X B Y C P 00237000 T 0000 + % 11 A X B Y C DISPLAY 00238000 T 0000 + % 12 A X B Y C STACK 00239000 T 0000 + % 13 A X B Y P DISPLAY 00240000 T 0000 + % 14 A X B Y P STACK 00241000 T 0000 + % 15 A X B Y DISPLAY STACK 00242000 T 0000 + % 16 A X B Y C P DISPLAY 00243000 T 0000 + % 17 A X B Y C P STACK 00244000 T 0000 + % 18 A X B Y C P DISPLAY STACK 00245000 T 0000 + % 19 TYPE 18 TRACE AND MEMORY DUMP % 00246000 T 0000 + % 00247000 T 0000 + % SIMULATOR DIRECTORY 00248000 T 0000 + % 00249000 T 0000 + % SEQ. NR. ITEM 00250000 T 0000 + % 00200000 ERROR MESSAGE INDEX 00251000 T 0000 + % 00400000 HARDWARE 00252000 T 0000 + % 00600000 MISCELLANEOUS DECLARATIONS(SEE ALSO 01000000 AND 01700000) 00253000 T 0000 + % 00700000 B6500 REGISTER,FLIP-FLOP,FLAG,LINE AND BUSS DECLARATIONS 00254000 T 0000 + % 01000000 MISCELLANEOUS DECLARATIONS(SEE ALSO 00600000 AND 01700000) 00255000 T 0000 + % 01200000 B6500 PARTIAL FIELD DEFINES 00256000 T 0000 + % 01400000 WORD FORMAT DESCRIPTIONS 00257000 T 0000 + % 01600000 FORWARD PROCEDURE DECLARATIONS 00258000 T 0000 + % 01700000 MISCELLANEOUS PROCEDURE,DEFINE AND OTHER DECLARATIONS 00259000 T 0000 + % (SEE ALSO 00600000 AND 01000000) 00260000 T 0000 + % 01800000 INTERRUPT CONTROLLER 00261000 T 0000 + % 02000000 SIMULATOR CONTROL SECTION 00262000 T 0000 + % 04000000 SIMULATOR UTILITY PROCEDURES(PSYLLABLES, STEPPSR, ETC.) 00263000 T 0000 + % 07000000 B6500 OPERATOR PROCEDURES 00264000 T 0000 + % 50000000 ERVSFLOW 00265000 T 0000 + % 51000000 STORE (STOD, STON, OVRD, OVRN) 00266000 T 0000 + % 60000000 B6500 MICRO-OPERATORS (ADJ, ETC.) 00267000 T 0000 + % 71000000 SIMULATOR INITIALIZATION 00268000 T 0000 + % 72000000 MULTIPLEXOR 00269000 T 0000 + % 73000000 SIMULATOR 00270000 T 0000 + % 74000000 TRACE 00271000 T 0000 + % 75000Q00 B6500 MEMORY DUMP 00272000 T 0000 + % 76000000 ERROR ROUTINE 00273000 T 0000 + % 77000000 HEADINGLINE 00274000 T 0000 + % 78000000 SIMULATOR STARTS ( I.E. DECLARATIONS AND PROCEDURES END) 00275000 T 0000 + ; 00276000 T 0000 + BEGIN COMMENT SIMULATOR OUTER BLOCK; 00277000 T 0000 +PRT(22) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* +PRT(23) = *OUTER BLOCK DESCRIPTOR* +PRT(24) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 2 + COMMENT DO NOT CHANGE THE PRT LOCATION OF THE FOLLOWING 5 VARIABLES; 00278000 T 0000 + INTEGER TRACEWORD % 25 00278001 T 0000 +PRT(25) = TRACEWORD + ,STATUSWORD % 26 00278002 T 0000 +PRT(26) = STATUSWORD + ,HALTING % 27 00278003 T 0000 +PRT(27) = HALTING + ,TRACTER % 30 00278004 T 0000 +PRT(30) = TRACTER + ,MONITORVALUE % PRT 31 THE SIMULATOR READS AND ACCEPTS THIS 00278005 T 0000 +PRT(31) = MONITORVALUE + % VALUE & PLACES IT IN D[31]. THE MCP MOVES IT 00278006 T 0000 + % FROM D[31] AND PLACES IT IN A GLOBAL 00278007 T 0000 + ; 00278010 T 0000 + REAL PROCCLOCK, % PROCESSOR CLOCK RATE IN MEGACYCLES DEFAULT=10 00279000 T 0000 +PRT(32) = PROCCLOCK + MPXQUAN , % NUMBER OF MULTIPLEXORS DEFAULT= 1 00280000 T 0000 +PRT(33) = MPXQUAN + MPXAOPS , % MAXIMUM OPERATIONS FOR MPXA DEFAULI=10 00281000 T 0000 +PRT(34) = MPXAOPS + MPXBOPS , % MAXIMUM OPERATIONS FOR MPXB DEFAULT=10 00282000 T 0000 +PRT(35) = MPXBOPS + MEMMODS , % NUMBER OF 16K MEMORY MODULES DEFAULT= 2 00283000 T 0000 +PRT(36) = MEMMODS + MEMTIME , % MEMORY CYCLE TIME DEFAULT=1.2 00284000 T 0000 +PRT(37) = MEMTIME + PROCID , % PROCESSOR IDENTIFICATION DEFAULT = 1 00284500 T 0000 +PRT(40) = PROCID + DISKLOAD, % ESPOL = 0; ALGOL = 1; COBOL = 2; 00285000 T 0000 +PRT(41) = DISKLOAD + BUFRMAX , % MAXIMUM BUFFER SIZE 00286000 T 0000 +PRT(42) = BUFRMAX + ROWLENGTH; % LENGTH OF M ARRAY ROW (6500 WORDS) 00287000 T 0000 +PRT(43) = ROWLENGTH + REAL ETIME, PTIME, STARTDATE; 00288000 T 0000 +PRT(44) = ETIME +PRT(45) = PTIME +PRT(46) = STARTDATE + REAL TIMEOFDAY; % WHAT IT SAYS - SEE SCNI - SCNO 00288010 T 0000 +PRT(47) = TIMEOFDAY + SAVE ARRAY TBUF [0:16]; % FORMATTING AREA FOR TRACE AND MEMDUMP 00289000 T 0000 +PRT(50) = TBUF + BOOLEAN PRINTERNOTYETOPENED; 00290000 T 0001 +PRT(51) = PRINTERNOTYETOPENED + REAL STREAM PROCEDURE MKABS (A); BEGIN SI ← A; MKABS ← SI END; 00291000 T 0001 +PRT(52) = MKABS + ARRAY EBCTOBCL [0:31]; % INDEXED BY AN 8 BIT EBCDIC CHARACTER TO 00292000 T 0004 +PRT(53) = EBCTOBCL + % FIND A 6 BIT BCL CHARACTER-MOSTLY INV CHR 00293000 T 0006 + ARRAY BUFFERS [0:3, 0:13]; % BUFFER LENGTHS FOR LOGICAL UNITS 00294000 T 0006 +PRT(54) = BUFFERS + % INDEXED BY HDWE TYPE AND SWITCH FILE INDX 00295000 T 0008 + INTEGER NCR; % ABSOLUTE ADDRESS MESS [0] 00296000 T 0008 +PRT(55) = NCR + DEFINE FILLBUFFERS = % DEFAULT BUFFER LENGTHS 00297000 T 0008 + % HDWE TYPES: DSC SPO BIDS LP CR CP TAPE 00298000 T 0008 + FILL BUFFERS [0,*] WITH 0, 30, 10, 0,0,0,15,0,0,10,10,0,0,1023; 00299000 T 0008 + FILL BUFFERS [1,*] WITH 0, 30, 0, 0,0,0,15,0,0, 0, 0,0,0,1023; 00300000 T 0008 + FILL BUFFERS [2,*] WITH 0, 30, 0, 0,0,0, 0,0,0, 0, 0,0,0,1023; 00301000 T 0008 + FILL BUFFERS [3,*] WITH 0, 30, 0, 0,0,0, 0,0,0, 0, 0,0,0,1023; 00302000 T 0008 + #; 00303000 T 0008 + ARRAY PERIPHERALT[0:69]; %TIMING CONSTANTS FOR PERIPHERAL UNITS 00304000 T 0008 +PRT(56) = PERIPHERALT + DEFINE FILLT=FILL PERIPHERALT[*] WITH 00305000 T 0010 + 0,0,0,0,0, %0 00306000 T 0010 + 80,2@5,0,0,0, %DISK-MPX CYCLE TIME, LATENCY TIME 1 00307000 T 0010 + 0,0,0,0,0, %2 00308000 T 0010 + 0,0,0,0,0, %3 00309000 T 0010 + 0,0,0,0,0, %4 00310000 T 0010 + 0,0,0,0,0, %5 00311000 T 0010 + 2.42@4,57.6@4,24.3@4,6.6@4,10@4, %BUFFERED PRINTER 6 00312000 T 0010 + %MPX BUSY TIME,DRUM ROTATION TIME, 00313000 T 0010 + %FIRST SPACING TIME,EACH ADDITIONAL 00314000 T 0010 + %SPACING TIME 00315000 T 0010 + 27.1@4,75@4,24.3@4,6.6@4,10@4, %UNBUFFERED PRINTER 7 00316000 T 0010 + %SAME AS BUFFERED PRINTER 00317000 T 0010 + 0,0,0,0,0, %8 00318000 T 0010 + 24.3@4,75@4,0.0,0, %CARD READER -EL.CYCLE,ME.CYCLE 9 00319000 T 0010 + 24.3@4,6@6,0,0,0, %CARD PUNCH-EL.CYCLE,ME.CYCLE 10 00320000 T 0010 + 0,0,0,0,0, %11 00321000 T 0010 + 0,0,0,0,0, %12 00322000 T 0010 + 120,800,6.7@4,.6,0; %MAGNETIC TAPE- 13 00323000 T 0010 + %SPEED,DENSITY,START TIME,RECORD GAP 00324000 T 0010 + #; 00325000 T 0010 + ARRAY STATVECTOR [0:7]; % PERIPHERAL STATUS WORDS 00325100 T 0010 +PRT(57) = STATVECTOR + ARRAY OLDSTATVEC [0:7]; % TO SAVE OFF CHANGED STATUS WORD 00325300 T 0012 +PRT(60) = OLDSTATVEC + ALPHA 00326000 T 0014 + ARRAY MPX [0:6, 0:31]; COMMENT INDEXED BY MULTIPLEXOR 00327000 T 0014 +PRT(61) = MPX + AND LOGICAL UNIT NO. CONTAINS: 00328000 T 0016 + RESULT DESCRIPTOR MPX [MPXUNIT+4,LOGICALUNIT] 00329000 T 0016 + AND MPX INFO WORD 00330000 T 0016 + ; 00331000 T 0016 + BOOLEAN MULTIPLEX; % TRUE FOR SCNO (IIO) 00332000 T 0016 +PRT(62) = MULTIPLEX + BOOLEAN SPOED; % TRUE FOR NOTHINGTODO READ 00333000 T 0016 +PRT(63) = SPOED + ARRAY CUP[0:11]; 00334000 T 0016 +PRT(64) = CUP + REAL TUBA, 00335000 T 0017 +PRT(65) = TUBA + PID; % PROCESSOR I.D. 00335500 T 0017 +PRT(66) = PID + SAVE ALPHA 00336000 T 0017 + ARRAY EVENTS [0:31]; COMMENT INDEXED BY LOGICAL UNIT OR SELF. 00337000 T 0017 +PRT(67) = EVENTS + CONTAINS THE REAL TIME FOR THE COMPLETION OF THE I-O 00338000 T 0019 + BEING PERFORMED ON THIS UNIT AND A LINK TO THE NEXT 00339000 T 0019 + EVENT AND A MULTIPLEXOR INDICATOR. 00340000 T 0019 + ; 00341000 T 0019 + ARRAY UNITAVAILTIME[0:31]; COMMENT-INDEXED BY LOGICAL UNIT. 00342000 T 0019 +PRT(70) = UNITAVAILTIME + CONTAINS REALTIME WHEN NEXT I/O COULD BE 00343000 T 0021 + INITIATED ON THIS UNIT.; 00344000 T 0021 + DEFINE % DEFINES FOR MPX AND EVENTS PARTIAL FIELDS 00345000 T 0021 + EVTIME = [12:36]#, % I-O COMPLETE TIME 00346000 T 0021 + EVLINK = [ 7: 5]#, % EVENT LINK 00347000 T 0021 + EVBUSY = [ 6: 1]#, % BUSY BIT 00348000 T 0021 + EVMPX = [ 1: 2]#, % MPX FOR THIS I-O 00349000 T 0021 + RSLTERR = [31:17]#, % ERROR FIELD 00350000 T 0021 + RSLTUNIT = [23: 8]#, % UNIT 00351000 T 0021 + TCHRS = [20: 3]#, % RESULT CHRS 00352000 T 0021 + RSLTADRS = [ 1:19]#, % ADDRESS 00353000 T 0021 + MPXINT = [38:10]#, % MPX INTERRUPT VALUE 00354000 T 0021 + MPXHDWE = [32: 6]#, % HARDWARE UNIT TYPE 00355000 T 0021 + MPXSWFI = [24: 6]#, % SWITCH FILE INDEX 00356000 T 0021 + MPXWLO = [ 1: 1]#, % 1 = WRITE LOCK-OUT 00357000 T 0021 + TUB = [ 2:9]#, % TU & BUF ADDRESS 00358000 T 0021 + MPXBUFF = [14:10]#; % BUFFER LENGTH 00359000 T 0021 + %>RETRO 00360000 T 0021 + REAL ARRAY FIRSTEVENT [0:15], LASTEVENT [0:15]; %>RETRO 00361000 T 0021 +PRT(71) = FIRSTEVENT +PRT(72) = LASTEVENT + INTEGER ARRAY FIRSTEVENTI[0:15], LASTEVENTI[0:15]; %>RETRO 00362000 T 0024 +PRT(73) = FIRSTEVENTI +PRT(74) = LASTEVENTI + REAL CURRENTT, % THE TIME FOR THE NEXT MULTIPLEXOR INTERRUPT 00363000 T 0028 +PRT(75) = CURRENTT + CURRENTMPX; % THE MPX FOR THE NEXT MULTIPLEXOR INTERRUPT 00364000 T 0028 +PRT(76) = CURRENTMPX + ARRAY MPXOPS [0:2];%OPERATIONS PER MPX 00365000 T 0028 +PRT(77) = MPXOPS + DEFINE DELTAMPX = 4#; % THE INCREMENT REQUIRED TO FIND THE RESULT 00366000 T 0030 + % DESCRIPTOR IN MPX ARRAY. 00367000 T 0030 + INTEGER INTTIMER; % THE NEXT REAL TIME FOR A TIME INTERRUPT 00368000 T 0030 +PRT(100) = INTTIMER + REAL MONITORMASKOLD;% TEMPORARY MONITOR MASK 00369000 T 0030 +PRT(101) = MONITORMASKOLD + REAL MONITORMASK; 00369100 T 0030 +PRT(102) = MONITORMASK + PROCEDURE HARDWARE; 00400000 T 0030 +PRT(103) = HARDWARE + BEGIN 00401000 T 0030 + DEFINE LUNIT= TBUF [0]#, 00402000 T 0030 + START OF SEGMENT ********** 3 + HTYPE= TBUF [1]#, 00403000 T 0000 + MPXAB= TBUF [2]#, 00404000 T 0000 + BUFLG= TBUF [3]#, 00405000 T 0000 + WLO = TBUF [4]#; 00406000 T 0000 + INTEGER I, J, S; 00407000 T 0000 +STACK(F+2) = I +STACK(F+3) = J +STACK(F+4) = S + LABEL EOF; 00408000 T 0000 + DEFINE 00409000 T 0000 + TIMEADJUST = ;#; %%%%%%%%%% 00410000 T 0000 + TBUF [16] ← MKABS (TBUF); 00411000 T 0000 + PRINTERNOTYETOPENED ← TRUE; 00412000 T 0002 + FILLBUFFERS; 00413000 T 0003 + START OF SEGMENT ********** 4 + 4 IS 14 LONG, NEXT SEG 3 + START OF SEGMENT ********** 5 + 5 IS 14 LONG, NEXT SEG 3 + START OF SEGMENT ********** 6 + 6 IS 14 LONG, NEXT SEG 3 + START OF SEGMENT ********** 7 + 7 IS 14 LONG, NEXT SEG 3 + FILLT; 00414000 T 0011 + START OF SEGMENT ********** 8 + 8 IS 69 LONG, NEXT SEG 3 + FILL EBCTOBCL [*] WITH % GRAPHIC UNDER LOW-ORDER OCTADE 00415000 T 0013 + OCT1414141414141414, 00416000 T 0013 + START OF SEGMENT ********** 9 + OCT1414141414141414, 00417000 T 0014 + OCT1414141414141414, 00418000 T 0014 + OCT1414141414141414, 00419000 T 0014 + OCT1414141414141414, 00420000 T 0014 + OCT1414141414141414, 00421000 T 0014 + OCT1414141414141414, 00422000 T 0014 + OCT1414141414141414, 00423000 T 0014 + OCT6014141414141414, 00424000 T 0014 + % BLANK 00425000 T 0014 + OCT1414143236352037, 00426000 T 0014 + % . < ( + ← 00427000 T 0014 + OCT3414141414141414, 00428000 T 0014 + % & 00429000 T 0014 + OCT1414405253555657, 00430000 T 0014 + % × $ * ) ; ≤ 00431000 T 0014 + OCT5461141414141414, 00432000 T 0014 + % - / 00433000 T 0014 + OCT1414767273741614, 00434000 T 0014 + % ] , % ≠ > QUESTION MARK 00435000 T 0014 + OCT3314141414141414, 00436000 T 0014 + % [ 00437000 T 0014 + OCT1414151213177577, 00438000 T 0014 + % : # @ ≥ = " 00439000 T 0014 + OCT1414141414141414, 00440000 T 0014 + OCT1414141414141414, 00441000 T 0014 + OCT1414141414141414, 00442000 T 0014 + OCT1414141414141414, 00443000 T 0014 + OCT1414141414141414, 00444000 T 0014 + OCT1414141414141414, 00445000 T 0014 + OCT1414141414141414, 00446000 T 0014 + OCT1414141414141414, 00447000 T 0014 + OCT1421222324252627, 00448000 T 0014 + % A B C D E F G 00449000 T 0014 + OCT3031141414141414, 00450000 T 0014 + % H I 00451000 T 0014 + OCT1441424344454647, 00452000 T 0014 + % J K L M N O P 00453000 T 0014 + OCT5051141414141414, 00454000 T 0014 + % Q R 00455000 T 0014 + OCT1414626364656667, 00456000 T 0014 + % S T U V W X 00457000 T 0014 + OCT7071141414141414, 00458000 T 0014 + % Y Z 00459000 T 0014 + OCT0001020304050607, 00460000 T 0014 + % 0 1 2 3 4 5 6 7 00461000 T 0014 + OCT1011141414141414; 00462000 T 0014 + 9 IS 32 LONG, NEXT SEG 3 + % 8 9 00463000 T 0014 + BEGIN 00464000 T 0014 + FILE CONFIGURATION (1, 10); 00465000 T 0014 +PRT(104) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 10 +STACK(F+5) = CONFIGURATION + READ (CONFIGURATION, /, PROCCLOCK, MPXQUAN, MPXAOPS, 00466000 T 0004 +PRT(105) = +PRT(106) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + MPXBOPS, MEMMODS, MEMTIME, PROCID, DISKLOAD 00467000 T 0011 + ,HALTING 00467010 T 0017 + ,MONITORMASK 00467100 T 0018 + ,MONITORVALUE 00467200 T 0019 + ); 00468000 T 0020 +PRT(107) = INPUT(W) + MONITORMASKOLD ← MONITORVALUE; 00468900 T 0024 + IF PROCCLOCK = 0 THEN PROCCLOCK ← 10; % MEGACYCLES 00469000 T 0025 + IF MPXQUAN = 0 THEN MPXQUAN ← 1; % MULTIPLEXORS 00470000 T 0027 + MPXAOPS ← 00471000 T 0029 + MPXOPS [1] ← IF MPXAOPS = 0 THEN 10 ELSE MPXAOPS; 00472000 T 0029 + MPXBOPS ← 00473000 T 0033 + MPXOPS [2] ← IF MPXBOPS = 0 THEN 10 ELSE MPXBOPS; 00474000 T 0033 + IF MEMTIME = 0 THEN MEMTIME ← 1.2;% MICROSECONDS 00475000 T 0037 + MEMTIME ← MEMTIME × 10; 00476000 T 0039 + MEMMODS ← (2*14×2×(IF MEMMODS = 0 THEN 2 ELSE MEMMODS))-1; 00477000 T 0040 + IF PROCID = 0 THEN PID ← 1 ELSE PID ← PROCID; 00477500 T 0047 + IF DISKLOAD > 0 THEN INTTIMER ← 0 ; 00478000 T 0051 + END; 00479000 T 0053 +PRT(110) = *SEGMENT DESCRIPTOR* + 10 IS 57 LONG, NEXT SEG 3 + BEGIN 00480000 T 0016 + FILE CABLING (2, 10); 00481000 T 0016 +PRT(111) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 11 +STACK(F+5) = CABLING + STREAM PROCEDURE STATUS(SWORD, LUNIT); VALUE LUNIT; 00481100 T 0004 +PRT(112) = STATUS + BEGIN DI ← SWORD; SKIP LUNIT DB; DS ← 1 SET END STATUS; 00481200 T 0004 + LABEL EOF; 00482000 T 0006 + STATUSWORD ← 1; 00482100 T 0006 + DO BEGIN 00483000 T 0007 + READ (CABLING, /, LUNIT, HTYPE, MPXAB, BUFLG 00484000 T 0007 +PRT(113) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + , WLO , TUBA )[EOF]; 00485000 T 0017 +PRT(114) = EOF +PRT(115) = GO TO SOLVER + IF MPXAB = 0 THEN MPXAB ← 1; 00486000 T 0025 + MPX [I ← MPXAB, J ← LUNIT].MPXWLO ← WLO; 00487000 T 0028 + MPX [I, J].MPXHDWE ← HTYPE; 00488000 T 0033 + MPX [I, J].MPXSWFI ← S ← MPX [0, HTYPE]; 00489000 T 0036 + MPX [0, HTYPE] ← MPX [0, HTYPE] + 1; 00490000 T 0041 + IF BUFLG ≠ 0 THEN BUFFERS [S, HTYPE] ← 00491000 T 0045 + BUFLG; 00492000 T 0048 + MPX [I, J].MPXBUFF ← BUFLG; 00493000 T 0049 + I ← 46 - LUNIT; 00493100 T 0053 + STATUS (STATUSWORD, I); 00493200 T 0054 + END UNTIL FALSE; 00494000 T 0055 + EOF: END; 00495000 T 0056 +PRT(116) = *SEGMENT DESCRIPTOR* + 11 IS 60 LONG, NEXT SEG 3 + S ← 10; % MINIMUM BUFFER SIZE IS 10 00496000 T 0017 + FOR I ← 0 STEP 1 UNTIL 3 DO 00497000 T 0017 + FOR J ← 0 STEP 1 UNTIL 13 DO 00498000 T 0019 + IF BUFFERS [I, J] > S THEN S ← BUFFERS [I, J]; 00499000 T 0020 + BUFRMAX ← S; 00500000 T 0028 + LUNIT ← 0; 00501000 T 0029 + ETIME ← TIME (1); 00502000 T 0030 + PTIME ← TIME (2); 00503000 T 0031 + STARTDATE ← TIME (0); 00504000 T 0033 + TIMEADJUST; 00505000 T 0034 + ROWLENGTH ← 256; 00506000 T 0034 + END OF HARDWARE INITIALIZE; 00507000 T 0035 + 3 IS 40 LONG, NEXT SEG 2 + HARDWARE; 00508000 T 0030 + BEGIN 00509000 T 0030 + LABEL EOJ; 00600000 T 0030 +PRT(117) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 12 + INTEGER T; 00601000 T 0000 +PRT(120) = T + DEFINE STACKVECTOR = D0+2#; 00602000 T 0000 + %**************************************** 00700000 T 0000 + %***** B6500 REGISTER DECLARATIONS ***** 00701000 T 0000 + %**************************************** 00702000 T 0000 + %NAME #BITS DESCRIPTION 00703000 T 0000 + REAL A,AX, % 51 TOP OPERAND IN STACK 00704000 T 0000 +PRT(121) = A +PRT(122) = AX + X,XX, % 51 EXTENSION OF A 00705000 T 0000 +PRT(123) = X +PRT(124) = XX + B,BX, % 51 SECOND OPERAND IN STACK 00706000 T 0000 +PRT(125) = B +PRT(126) = BX + Y,YX, % 51 EXTENSION OF B 00707000 T 0000 +PRT(127) = Y +PRT(130) = YX + C,CX, % 51 GENERAL PURPOSE REGISTER 00708000 T 0000 +PRT(131) = C +PRT(132) = CX + P,PX; % 51 PROGRAM REGISTER 00709000 T 0000 +PRT(133) = P +PRT(134) = PX + BOOLEAN AROF, % 1 A REGISTER OCCUPIED 00710000 T 0000 +PRT(135) = AROF + BROF, % 1 B REGISTER OCCUPIED 00711000 T 0000 +PRT(136) = BROF + PROF; % 1 P REGISTER OCCUPIED 00712000 T 0000 +PRT(137) = PROF + DEFINE MEMCYCLE = DELTATIME ← DELTATIME + MEMTIME;#; 00713000 T 0000 + LONG ARRAY M [0:MEMMODS]; 00714000 T 0000 +PRT(140) = M + %NOTE: INDICIES ARE AUTOMATICALLY DOUBLED 00715000 T 0005 + % AND THE ARRAY IS PARTIONED INTO A 00716000 T 0005 + % TWO-DIMENSIONAL ARRAY WITH 256-WD ROWS 00717000 T 0005 + % BY SPECIAL COMPILER PATCHES. 00718000 T 0005 + REAL MA, % 3 MANTISSA EXTENSION OF A 00719000 T 0005 +PRT(141) = MA + MB, % 3 MANTISSA EXTENSION OF B 00720000 T 0005 +PRT(142) = MB + EA, % 1 EXPONENT EXTENSION OF A 00721000 T 0005 +PRT(143) = EA + EB, % 1 EXPONENT EXTENSION OF B 00722000 T 0005 +PRT(144) = EB + AA, % 42 10 MC ADDER CAPTIVE REGISTER (ADDEND) 00723000 T 0005 +PRT(145) = AA + BB, % 42 10 MC ADDER CAPTIVE REGISTER (AUGEND) 00724000 T 0005 +PRT(146) = BB + CC, % 42 10 MC ADDER CAPTIVE REGISTER (IDLER) 00725000 T 0005 +PRT(147) = CC + SGNF, % 1 EXTERNAL SIGN 00726000 T 0005 +PRT(150) = SGNF + MM, % 20 MAIN MEMORY ADDRESSING REGISTER 00727000 T 0005 +PRT(151) = MM + LL, % 5 LEXIOGRAPHIC LEVEL (DISPLAY MEMORY POINTER) 00728000 T 0005 +PRT(152) = LL + BRS, % 7 BASE READ SELECT (I.C. MEMORY ADDRESSING REG.) 00729000 T 0005 +PRT(153) = BRS + BWS, % 7 BASE WRITE SELECT (I.C. MEMORY ADDRESSING REG.) 00730000 T 0005 +PRT(154) = BWS + IRS, % 4 INDEX READ SELECT (I.C. MEMORY ADDRESSING REG.) 00731000 T 0005 +PRT(155) = IRS + IWS, % 4 INDEX WRITE SELECT (I.C. MEMORY ADDRESSINS REG.) 00732000 T 0005 +PRT(156) = IWS + OPSR,% 3 OLD PSR 00733000 T 0005 +PRT(157) = OPSR + PICR,% 20 PROGRAM INDEX COUNTER FOR SINGLE INSTRUCTION 00734000 T 0005 +PRT(160) = PICR + DRS; % 6 DISPLAY READ SELECT REGISTER 00735000 T 0005 +PRT(161) = DRS + ARRAY D[0:31];%20 I.C. DISPLAY MEMORY 00736000 T 0005 +PRT(162) = D + DEFINE D0 = D[ 0]#, D8 = D[ 8]#, D16 = D[16]#, D24 = D[24]#, 00737000 T 0007 + D1 = D[ 1]#, D9 = D[ 9]#, D17 = D[17]#, D25 = D[25]#, 00738000 T 0007 + D2 = D[ 2]#, D10 = D[10]#, D18 = D[18]#, D26 = D[26]#, 00739000 T 0007 + D3 = D[ 3]#, D11 = D[11]#, D19 = D[19]#, D27 = D[27]#, 00740000 T 0007 + D4 = D[ 4]#, D12 = D[12]#, D20 = D[20]#, D28 = D[28]#, 00741000 T 0007 + D5 = D[ 5]#, D13 = D[13J#, D21 = D[21]#, D29 = D[29]#, 00742000 T 0007 + D6 = D[ 6]#, D14 = D[14]#, D22 = D[22]#, D30 = D[30]#, 00743000 T 0007 + D7 = D[ 7]#, D15 = D[15]#, D23 = D[23]#, D31 = D[31]#, 00744000 T 0007 + D00 = D[ 0]#, D03 = D[03]#, D06 = D[06]#, D09 = D[09]#, 00745000 T 0007 + D01 = D[ 1]#, D04 = D[04]#, D07 = D[07]#, 00746000 T 0007 + D02 = D[02]#, D05 = D[05]#, D08 = D[08]#; 00747000 T 0007 + INTEGER SP, % 6 SOURCE REGISTER POINTER 00748000 T 0007 +PRT(163) = SP + DP, % 6 DESTINATION REGISTER POINTER 00749000 T 0007 +PRT(164) = DP + G, % 6 00750000 T 0007 +PRT(165) = G + K, % 6 00751000 T 0007 +PRT(166) = K + TP, % 4 TABLE BASE POINTER 00753000 T 0007 +PRT(167) = TP + PSR; % 3 PROGRAM SYLLABLE REGISTER 00754000 T 0007 +PRT(170) = PSR + COMMENT THE FOLLOWING DECLARATION IS FOR THE 8 I.C. BASE REGISTERS 00755000 T 0007 + AND ITS INTERNAL SEQUENCE SHOULD NOT BE DISTURBED WITHOUT 00756000 T 0007 + CHECKING THE ARRAY BRSR, PROCEDURES RPRR AND SPRR, ETC.; 00757000 T 0007 + REAL PBR, SBR, DBR, TBR, S, SNR, PDR, TEMP; %DLK 00758000 T 0007 +PRT(171) = PBR +PRT(172) = SBR +PRT(173) = DBR +PRT(174) = TBR +PRT(175) = S +PRT(176) = SNR +PRT(177) = PDR +PRT(200) = TEMP + DEFINE BUF2 = TBR#; % SHARED REGISTERS 00759000 T 0007 + REAL TSR; 00760000 T 0007 +PRT(201) = TSR + COMMENT THE FOLLOWING DECLARATION IS FOR THE 8 I.C. INDEX REGISTERS 00761000 T 0007 + AND ITS INTERNAL SEQUENCE SHOULD NOT BE DISTURBED WITHOUT 00762000 T 0007 + CHECKING THE ARRAY BRSR, PROCEDURES RPRR AND SPRR, ETC.; 00763000 T 0007 + REAL PIR, SIR, DIR, TIR, LOSR, BOSR, F, BUF1; %DLK 00764000 T 0007 +PRT(202) = PIR +PRT(203) = SIR +PRT(204) = DIR +PRT(205) = TIR +PRT(206) = LOSR +PRT(207) = BOSR +PRT(210) = F +PRT(211) = BUF1 + DEFINE BUF3 = TIR#; % SHARED REGISTERS 00765000 T 0007 + COMMENT ***** EXPLANATORY ONLY (SEE ABOVE) ****************** 00766000 T 0007 + PBR, % 20 PROGRAM BASE REGISTER 00767000 T 0007 + SBR, % 20 SOURCE BASE REGISTER 00768000 T 0007 + DBR, % 20 DESTINATION BASE REGISTER 00769000 T 0007 + BUF2, % 20 UTILITY REGISTER - SHARED WITH TBR 00770000 T 0007 + S, % 20 TOP OF STACK POINTER 00771000 T 0007 + SNR, % 20 STACK NUMBER REGISTER 00772000 T 0007 + PDR, % 20 PROGRAM DESCRIPTOR REGISTER 00773000 T 0007 + TEMP, % 20 TEMPORARY G.P. REGISTER 00774000 T 0007 + PIR, % 20 PROGRAM INDEX REGISTER 00775000 T 0007 + PICR, %4 DELTA PIR FOR OPERATOR, USED TO RESTORE PIR 00776000 T 0007 + SIR, % 20 SOURCE INDEX REGISTER 00777000 T 0007 + DIR, % 20 DESTINATION INDEX REGISTER 00778000 T 0007 + TIR, % 20 TABLE INDEX REGISTER 00779000 T 0007 + BUF3, % 20 UTILITY REGISTER - SHARED WITH TIR 00780000 T 0007 + LOSR, % 20 LIMIT OF STACK REGISTER 00781000 T 0007 + BOSR, % 20 BASE OF STACK REGISTER 00782000 T 0007 + F, % 20 MARK STACK POINTER 00783000 T 0007 + BUF; % 20 BUFFER G.P. REGISTER 00784000 T 0007 + DEFINE BUF = BUF1#; % TO OVERCOME NOMENCLATURE DIFFICULTY 00785000 T 0007 + INTEGER 00786000 T 0007 + SIB, % 6 SOURCE BIT INDEX REGISTER 00787000 T 0007 +PRT(212) = SIB + DIB, % 6 DESTINATION BIT INDEX REGISTER 00788000 T 0007 +PRT(213) = DIB + RPF, % 20 REPEAT FIELD REGISTER 00789000 T 0007 +PRT(214) = RPF + DIS, % 00790000 T 0007 +PRT(215) = DIS + TOM, % 6 TOP OF MASK 00791000 T 0007 +PRT(216) = TOM + TOA; % 6 TOP OF APERATURE 00792000 T 0007 +PRT(217) = TOA + ARRAY IRSR, BRSR [0:7]; % USED TO HOLD BASE AND INDEX REGISTERS 00793000 T 0007 +PRT(220) = IRSR +PRT(221) = BRSR + ARRAY MONITOROUTPUT [0:13]; 00793100 T 0011 +PRT(222) = MONITOROUTPUT + FORMAT MONFMT (X1,A1,A6,X1,I1, X1, 16I1, 7(X2, I5, X1, I5)); 00793200 T 0013 + START OF SEGMENT ********** 13 +PRT(223) = MONFMT + 13 IS 16 LONG, NEXT SEG 12 + DEFINE NULLB=0#,% NULL STATE FOR I.C. MEMORY BASE REGISTERS 00794000 T 0013 + NULLI=0#;% NULL STATE FOR I.C. MEMORY INDEX REGISTERS 00795000 T 0013 + REAL AB, % 20 ADDRESS BASE BUSS 00796000 T 0013 +PRT(224) = AB + AI; % 20 ADDRESS INDEX BUSS 00797000 T 0013 +PRT(225) = AI + BOOLEAN NCSF; % 1 NORMAL STATE FF 00798000 T 0013 +PRT(226) = NCSF + REAL QP; % MISC CONTROL FLIP/FLOPS (STRING OPERATORS) 00798500 T 0013 +PRT(227) = QP + REAL Q; % 18 Q0 AND QC SETS OF G.P. LOGICAL FFS (CLEARED AT SECL) 00799000 T 0013 +PRT(230) = Q + DEFINE Q00F = Q.[47:1]#, Q03F = Q.[44:1]#, Q06F = Q.[41:1]#, 00800000 T 0013 + Q01F = Q.[46:1]#, Q04F = Q.[43:1]#, Q07F = Q.[40:1]#, 00801000 T 0013 + Q02F = Q.[45:1]#, Q05F = Q.[42:1]#, Q08F = Q.[39:1]#, 00802000 T 0013 + QC0F = Q.[38:1]#, QC3F = Q.[35:1]#, QC6F = Q.[32:1]#, 00803000 T 0013 + QC1F = Q.[37:1]#, QC4F = Q.[34:1]#, QC7F = Q.[31:1]#, 00804000 T 0013 + QC2F = Q.[36:1]#, QC5F = Q.[33:1]#, QC8F = Q.[30:1]#; 00805000 T 0013 + REAL N; % 4 G.P. COUNT REGISTER (CLEARED AT SECL) 00806000 T 0013 +PRT(231) = N + BOOLEAN LPF, % 1 LINE PARITY--READ 00807000 T 0013 +PRT(232) = LPF + IIHF, % 1 00807500 T 0013 +PRT(233) = IIHF + SUFL, % 1 STACK UNDER FLOW FLIP/FLOP 00807600 T 0013 +PRT(234) = SUFL + EXTF, % 1 ENTERNAL SIGN FLIP FLOP 00808000 T 0013 +PRT(235) = EXTF + TFFF, % 1 TRUE/FALSE FF 00809000 T 0013 +PRT(236) = TFFF + OFFF, % 1 OVERFLOW FF 00810000 T 0013 +PRT(237) = OFFF + FLTF , % 1 FLOAT FLIP FLOP 00811000 T 0013 +PRT(240) = FLTF + TEEF, % 1 TABLE EDIT ESCAPE 00812500 T 0013 +PRT(241) = TEEF + LEEF, % 1 LINE EDIT ESCAPE 00813000 T 0013 +PRT(242) = LEEF + EDITF , % 1 EDIT MODE FLIP FLOP 00814000 T 0013 +PRT(243) = EDITF + EXSF , % 1 EXECUTE SINGLE SHOT 00815000 T 0013 +PRT(244) = EXSF + ESPF , % 1 EXECUTE SINGLE POINTER 00815500 T 0013 +PRT(245) = ESPF + UPDF , % 1 UPDATE 00816000 T 0013 +PRT(246) = UPDF + SOPF , % 1 SINGLE PRECISION OPERAND 00817000 T 0013 +PRT(247) = SOPF + RNTF , % 1 RE-ENTER FLIP/FLOP FOR CHARACTER MODE 00818000 T 0013 +PRT(250) = RNTF + VARF; % 1 VARIANT ESCAPE 00819000 T 0013 +PRT(251) = VARF + DEFINE SEEF = EXSF#; 00820000 T 0013 + REAL SSZ, % 2 SOURCE CHARACTER SIZE 00821000 T 0013 +PRT(252) = SSZ + DSZ, % 2 DESTINATION CHARACTER SIZE 00822000 T 0013 +PRT(253) = DSZ + TCS, % 2 TABLE CHARACTER SIZE 00823000 T 0013 +PRT(254) = TCS + OFS, % 6 OFFSET REGISTER (SIEERING CONTROL) 00824000 T 0013 +PRT(255) = OFS + J1F, % 6 FAMILY 1 SEQUENCE COUNTER 00825000 T 0013 +PRT(256) = J1F + J2F; % 6 FAMILY 2 SEQUENCE COUNTER 00826000 T 0013 +PRT(257) = J2F + BOOLEAN REQ, % 1 REQUEST (MEM. INTERFACE) 00827000 T 0013 +PRT(260) = REQ + WRT, % 1 WRITE (MEM. INTERFACE) 00828000 T 0013 +PRT(261) = WRT + PRO, % 1 PROTECT (MEM. INTERFACE) 00829000 T 0013 +PRT(262) = PRO + MROF; % 1 MEM. READ OBTAINED (MEM. INTERFACE) 00830000 T 0013 +PRT(263) = MROF + BOOLEAN STKOVFF; % ADJ SETS TRUE FOR STACK OVERFLOW 00830100 T 0013 +PRT(264) = STKOVFF + DEFINE % ALARM INTERRUPTS 00831000 T 0013 + LOOPI = 33554433 #, % 2*25+2*0 OPERATOR LOOP 00832000 T 0013 + MEMPARI = 33554434 #, % 2*25+2*1 MEMORY PARITY 00833000 T 0013 + MPXPARI = 33554436 #, % 2*25+2*2 MULTIPLEXOR PARITY 00834000 T 0013 + INVADRI = 33554440 #, % 2*25+2*3 INVALID ADDRESS 00835000 T 0013 + STKUNFI = 33554448 #, % 2*25+2*4 STACK UNDERFLOW 00836000 T 0013 + INVOPA = 33554464 #, % 2*25+2*5 UNKNOWN OPERATOR 00837000 T 0013 + % SYLLABLE DEPENDENT INTERRUPTS 00838000 T 0013 + MEMPROI = 16777217 #, % 2*24+2*0 MEMORY PROTECT 00839000 T 0013 + INVOP = 16777218 #, % 2*24+2*1 INVALID OPERATOR 00840000 T 0013 + DIVZROI = 16777220 #, % 2*24+2*2 DIVIDE BY ZERO 00841000 T 0013 + EXPOVFI = 16777224 #, % 2*24+2*3 EXPONENT OVERFLOW 00842000 T 0013 + EXPUNFI = 16777232 #, % 2*24+2*4 EXPONENT UNDERFLOW 00843000 T 0013 + INVINXI = 16777248 #, % 2*24+2*5 INVALID INDEX 00844000 T 0013 + INTOVFI = 16777280 #, % 2*24+2*6 INTEGER OVERFLOW 00845000 T 0013 + BOSINT = 16777344 #, % 2*24+2*7 BOTTOM OF STACK 00846000 T 0013 + PRESBIT = 16777472 #, % 2*24+2*8 PRESENCE BIT 00847000 T 0013 + SEQERRI = 16777728 #, % 2*24+2*9 SEQUENCE ERROR 00848000 T 0013 + % GENERAL CONTROL INTERRUPTS 00849000 T 0013 + INTTIMI = 4194305 #, % 2*22+2*0 INTERVAL TIMER 00850000 T 0013 + STKOVFI = 4194306 #, % 2*22+2*1 STACK OVERFLOW 00851000 T 0013 + % EXTERNAL INTERRUPTS 00852000 T 0013 + EXTINTI = 1048816#, % BITS 20, 7-4 ON EXTERNAL INTERRUPT 00853000 T 0013 + %I/O FINISH BEING FORCED, MLC NOT HONORD 00854000 T 0013 + PTOPI = 2097152 #, % 2*21 PROCESSOR TO PROCESSOR 00855000 T 0013 + DUMMYI = 0#; 00856000 T 0013 + REAL INT; % INTERRUPT FLIP/FLOPS 00857000 T 0013 +PRT(265) = INT + % FLIP/FLOP FUNCTION 00858000 T 0013 + DEFINE EXIA = INT.[27:1]#, % [20:1] EXIA MPXA 00859000 T 0013 + PTPI = INT.[26:1]#, %[21:1] PTPI PROCESSOR 00860000 T 0013 + GCIF = INT.[25:1]#, % [22:1] GENERAL CONTROL 00861000 T 0013 + SDIS = INT.[23:2]#, %[24:2] SDIS SYLLABLE DEPENDENT 00862000 T 0013 + ALRM = INT.[22:1]#, %[25:1] ALRM ALARM INTERRUPT 00863000 T 0013 + % GCIF & ALRM HAVE NOONES APPROVAL 00864000 T 0013 + DUMMYF = 0#; 00865000 T 0013 + REAL E, % 4 MEM. CYCLE REQUEST (MEM. INTERFACE) 00866000 T 0013 +PRT(266) = E + RF; % 8 REPEAT FIELD REGISTER 00867000 T 0013 +PRT(267) = RF + REAL ICR1; % INTERRUPT CONTROL REGISTER 00868000 T 0013 +PRT(270) = ICR1 + INTEGER 01000000 T 0013 + NSTACK, % VALUE USED FOR TRACING STACK 01001000 T 0013 +PRT(271) = NSTACK + NDISPLAY; % VALUE USED FOR TRACING DISPLAYS 01002000 T 0013 +PRT(272) = NDISPLAY + REAL TANK; % ABSOLUTE ADDRESS OF SAVE ARRAY TBUF 01003000 T 0013 +PRT(273) = TANK + SAVE 01004000 T 0013 + ARRAY TBUF[0:16]; % FORMATING AREA FOR TRACE AND MEMDUMP 01005000 T 0013 +PRT(274) = TBUF + ALPHA MULFILID, FILID; % THE SOURCE FILE FOR INITIALIZE 01005100 T 0016 +PRT(275) = MULFILID +PRT(276) = FILID + REAL JUNK; 01007000 T 0016 +PRT(277) = JUNK + INTEGER INTG; 01008000 T 0016 +PRT(300) = INTG + ARRAY MNEMONIC[0:2,0:255]; 01009000 T 0016 +PRT(301) = MNEMONIC + INTEGER TS1; 01010000 T 0019 +PRT(302) = TS1 + SAVE ARRAY DELTAMASK[0:31]; % MASKS OUT DELTA PART OF ADRCPL FIELDS 01011000 T 0019 +PRT(303) = DELTAMASK + SAVE ARRAY REFLECTION[0:31];% REFLECTS LL PARTS OF ADRCPL FIELDS 01012000 T 0021 +PRT(304) = REFLECTION + FILE TRACK 14(1,5); % DATA COM FILE TO READ TRACE PARAMETERS 01013000 T 0024 +PRT(305) = TRACK + DEFINE BITS=(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP 1 SB)#, 01014000 T 0028 + DIG=(DS:=3 RESET; 3 BITS)#, 01015000 T 0028 + PRINT=WRITE(LP,15,TBUF[*])#; 01016000 T 0028 + DEFINE HEADING = IF PRINTERNOTYETOPENED THEN 01017000 T 0028 + IF PRINTERNOTYETOPENED.[46:1] 01017250 T 0028 + THEN HEADINGLINE(TAPED) 01017500 T 0028 + ELSE HEADINGLINE(LP)#; 01017750 T 0028 + REAL INTMASKA, % INTERRUPT MASKS AND REGISTERS FOR MPXA AND MPXB 01018000 T 0028 +PRT(306) = INTMASKA + INTMASKB, % 10 BITS EACH 01019000 T 0028 +PRT(307) = INTMASKB + INTREGA, 01020000 T 0028 +PRT(310) = INTREGA + INTREGB; 01021000 T 0028 +PRT(311) = INTREGB + REAL SCANBUSA, SCANBUSAX,% SCAN AND DATA BUSES FOR MPXS 01022000 T 0028 +PRT(312) = SCANBUSA +PRT(313) = SCANBUSAX + DATABUSA, DATABUSAX;% WITH MOVE EXTENSIONS 01023000 T 0028 +PRT(314) = DATABUSA +PRT(315) = DATABUSAX + REAL ABORTTIME,% THE REAL TIME FOR NEXT ABORT INTERRUPT 01024000 T 0028 +PRT(316) = ABORTTIME + IDLETIME ;% THE REAL TIME FOR NEXT INTERRUPT 01025000 T 0028 +PRT(317) = IDLETIME + REAL REALTIME, COMMENT THE TIME IN 100 NANOSECOND UNITS SINCE THE 01026000 T 0028 +PRT(320) = REALTIME + BEGINNING OF SIMULATION. USED WITH TIMEOFDAY AND 01027000 T 0028 + REALETIME FOR SCAN IN AND OUT OF TIME OF DAY CLOCK.; 01028000 T 0028 + TIMEOFDAY, 01029000 T 0028 +PRT(321) = TIMEOFDAY + REALETIME, 01030000 T 0028 +PRT(322) = REALETIME + DELTATIME;COMMENT THE TIME INCREMENT SINCE THE REAL TIME CLOCK 01031000 T 0028 +PRT(323) = DELTATIME + WAS UPDATED. USUALLY THE TIME REQUIRED FOR AN OPER- 01032000 T 0028 + ATOR.; 01033000 T 0028 + %********************************************** 01200000 T 0028 + %***** B6500 FIELD ABBREVIATION DEFINES ***** 01201000 T 0028 + %********************************************** 01202000 T 0028 + DEFINE % ABBR. B5500 B6500 FIELD/BIT NAME 01203000 T 0028 + TAG = [44: 3]#, % [50: 3] TAG FIELD 01204000 T 0028 + % TAG VALUES... 01205000 T 0028 + SINGL = 0#, % SINGLE PRECISION OPERAND 01206000 T 0028 + IRW = 1#, % INDIRECT REFERENCE WORD 01207000 T 0028 + DOUBL = 2#, % DOUBLE PRECISION OPERAND 01208000 T 0028 + MEMLINK= 3#, % STORAGE LINK 01209000 T 0028 + CODE = 3#, % CODE 01210000 T 0028 + SEGDESC= 3#, % SEGMENT DESCRIPTOR 01211000 T 0028 + MSCW = 3#, % MARK STACK CONTROL WORD 01212000 T 0028 + TOS = 3#, % TOP OF STACK CONTROL WORD 01213000 T 0028 + RCW = 3#, % RETURN CONTROL WORD 01214000 T 0028 + SIW = 4#, % STEP INDEX WORD 01214100 T 0028 + DATADESC=5#, % DATA DESCRIPTOR 01215000 T 0028 + UNITAL = 6#, % UNINITIALIZED OPERAND 01216000 T 0028 + PCW = 7#, % PROGRAM CONTROL WORD (PGM DESC) 01217000 T 0028 + % END TAG VALUES 01218000 T 0028 + ROBIT = [46:1]#, % [48:1] READ ONLY FIELD 01219000 T 0028 + LOBIT = [47:1]#, % [0:1] LOW ORDER BIT 01220000 T 0028 + PBIT = [47: 1]#, % [47: 1] PRESENCE BIT (IN DATADESC,SEGDESC 01221000 T 0028 + DSBIT = [47: 1]#, % [47: 1] DIFFERENT STACK BIT (IN MSCW) 01222000 T 0028 + SGNFF = [47:1]#, % [47:1] SGNF FIELD IN TOS CONTROL WORD 01223000 T 0028 + EXPEXT = [ 1: 8]#, % [47: 9] EXPONENT EXTENTION (DBL PREC) 01223100 T 0028 + INCRF = [ 1:11]#, % [47:12] INCREMENT FIELD (IN STEP INDEX) 01223500 T 0028 + CBIT = [ 1: 1]#, % [46: 1] COPY BIT (IN DATADESC,SEGDESC) 01224000 T 0028 + EBIT = [ 1: 1]#, % [46: 1] ENVIRONMENT BIT (IN IRW,MSCW) 01225000 T 0028 + SOBIT = [ 1: 1]#, % [46:1] SIGN OF OPERAND BIT 01226000 T 0028 + OFFFF = [1:1]#, % [46:1] OFFF FIELD IN TOS CONTROL WORD 01227000 T 0028 + IBIT = [ 2: 1]#, % [45: 1] INDEXED BIT 01228000 T 0028 + SEBIT = [ 2: 1]#, % [45: 1] SIGN OF EXPONENT BIT 01229000 T 0028 + TFFFF = [2:1]#, % [45:1] TFFF FIELD IN TOS CONTROL WORD 01230000 T 0028 + STKNR = [ 2:10]#, % [45:10] STACK NR FIELD (IN IRW,MSCW) 01231000 T 0028 + SBIT = [ 3: 1]#, % [44: 1] SEGMENTED BIT (DATADESC) 01232000 T 0028 + FLTFF = [ 3: 1]#, % [44: 1] FLOAT FLIP/FLOP 01232500 T 0028 + EXPF = [ 3: 6]#, % [44: 6] EXPONENT FIELD 01233000 T 0028 + SEXPF = [2:7]#, % [45:7] SIGNED EXPONENT FIELD 01234000 T 0028 + RBIT = [ 4: 1]#, % [43: 1] READ-ONLY-DATA BIT 01235000 T 0028 + SZ = [ 5: 3]#, % [42:3] CHARACTER SIZE FIELD 01236000 T 0028 + CHRSZ = [ 5: 2]#, % [42:2] CHARACTER SIZE IN DATA DESC. 01237000 T 0028 + CHARF = [ 8: 4]#, % [39: 4] CHARACTER NUMBER FIELD 01238000 T 0028 + DBIT = [ 7: 1]#, % [40: 1] DOUBLE PRECISION BIT (IN DATADESC 01239000 T 0028 + SIBF = [ 7: 6]#, % [40: 6] SIB FOR STRING DESCRIPTORS 01240000 T 0028 + INDEX = [ 8:20]#, % [39:20] INDEX/LENGTH FIELD 01241000 T 0028 + LENGTH = [ 8:20]#, % [39:20] INDEX/LENGTH FIELD 01242000 T 0028 + DS = [8:20]#, % [39:20] DISPLACEMENT FIELD IN TOS CW 01243000 T 0028 + PSRF = [12: 3]#, % [35: 3] PSR FIELD (IN PCW, RCW) 01244000 T 0028 + MANF = [ 9:39]#, % [38:39] MANTISSA FIELD 01245000 T 0028 + PIRF = [15:13]#, % [32:13] PIR FIELD (IN PCW, RCW) 01246000 T 0028 + DISP = [12:16]#, % [35:16] BASE-OF-STACK-RELATIVE DISPLACMNT 01247000 T 0028 + SIRF = [12:16]#, % [35:16] INDEX FIELD FOR STRING DESCRIPTORS 01248000 T 0028 + FVF = [12:16]#, % [35:16] FINAL VALUE FIELD (IN SIW) 01248500 T 0028 + VBIT = [28: 1]#, % [19: 1] ACC. ENTRY ON VALC OR EVAL 01249000 T 0028 + NBIT = [28: 1]#, % [19: 1] NORMAL/CONTROL STATE BIT 01250000 T 0028 + NCSFF = [28:1]#, % [19:1] NCSF FIELD IN TOS CONTROL WORD 01251000 T 0028 + ADDR = [28:20]#, % [19:20] MEMORY ADDRESS/DISK ADDRESS FIELD 01252000 T 0028 + LLF = [29: 5]#, % [18: 5] LL FIELD 01253000 T 0028 + CVF = [32:16]#, % [15:16] CURRENT VALUE FIELD (IN SIW) 01253500 T 0028 + ADRCPL = [34:14]#, % [13:14] ADDRESS COUPLE FIELD (11,DELTA) 01254000 T 0028 + ADRCPLSIR = [35:13]#, % [12:13] ADDRESS COUPLE STUFFED IRW(DEL) 01255000 T 0028 + DF = [34:14]#, % [13:14] SELF-RELATIVE INDEX 01256000 T 0028 + % TO PREVIOUS MSCW (LODELTAF) 01257000 T 0028 + LEVELPCW = [34:1]#,%[13:1] ONE BIT LEVEL ADDRESS PCW 01258000 T 0028 + DELTAPCW = [35:13]#,%[12:13] DELTA ADDRESS PCW 01259000 T 0028 + SDIF = [34:14]#; % [13:14] SEGMENT DICTIONARY INDEX FIELD 01260000 T 0028 + DEFINE 01261000 T 0028 + SBRF = ADDR#, 01262000 T 0028 + DBRF = ADDR#, 01263000 T 0028 + DIRF = SIRF#, TIRF = SIRF#, 01264000 T 0028 + DIBF = SIBF#, 01265000 T 0028 + DSZF = SZ #; 01266000 T 0028 + DEFINE % FUNCTION CODE DEFINES 6.33 01267000 T 0028 + MPXAB = [47: 1]#, % [ 0: 1] RESPONDING MULTIPLEXOR(S) 01268000 T 0028 + MPXFC = [43: 4]#, % [ 4: 4] MPX DESIGNATOR 01269000 T 0028 + VARIF = [39: 4]#, % [ 8: 4] SCAN VARIANT 01270000 T 0028 + GCARF = [37: 2]#, % [10: 2] GCA REGISTER 01271000 T 0028 + REGIV = [39: 1]#, % [ 9: 1] READ REGISTER VARIANT 01272000 T 0028 + VECTF = [36: 2]#, % [11: 2] VECTOR NUMBER 01273000 T 0028 + LUNIT = [31: 8]#; % [16: 8] LOGICAL UNIT NUMBER 01274000 T 0028 + DEFINE % RESULT ERROR DEFINES 01275000 T 0028 + RSLTPRO= [31: 1]#, % [16: 1] PROTECT TERMINATE ON MEMORY WRITE 01276000 T 0028 + RSLTEXC= [47: 1]#, % [ 0: 1] EXCEPTION 01277000 T 0028 + RSLTATT= [46: 1]#, % [ 1: 1] ATTENTION 01278000 T 0028 + RSLTBSY= [45: 1]#, % [ 2: 1] BUSY 01279000 T 0028 + RSLTNRY= [44: 1]#, % [ 3: 1] NOT READY 01280000 T 0028 + RSLTDSC= [43: 1]#, % [ 4: 1] DESCRIPTOR ERROR 01281000 T 0028 + RSLTMAD= [42: 1]#, % [ 5: 1] MEMORY ADDRESS 01282000 T 0028 + RSLTPAR= [41: 1]#; % [ 6: 1] MEMORY PARITY 01283000 T 0028 + DEFINE % RESULT DESCRIPTOR UNIT ERRORS 01284000 T 0028 + RSLTTO = [32: 1]#, % [15: 1] BLANK TAPE 01285000 T 0028 + RSLTRW = [33: 1]#, % [14: 1] REWINDING 01286000 T 0028 + RSLTOP = [34: 1]#, % [13: 1] NON-PRESENT 01287000 T 0028 + RSLTCR = [35: 1]#, % [12: 1] CRC CORRECTION 01288000 T 0028 + RSLTOF = [36: 1]#, % [11: 1] OVERFLOW 01289000 T 0028 + RSLTCC = [37: 1]#, % [10: 1] CONTROL CARD 01290000 T 0028 + RSLTVY = [38: 1]#, % [ 9: 1] VALIDITY 01291000 T 0028 + RSLTET = [39: 1]#, % [ 8: 1] END OF TAPE 01292000 T 0028 + RSLTMA = [40: 1]#, % [ 7: 1] MEMORY ACCESS 01293000 T 0028 + RSLTUF = RSLTCC#,% UNDERFLOW 01294000 T 0028 + RSLTWL = RSLTVY#;% WRITE LOCK-OUT 01295000 T 0028 + DEFINE % I/O CONTROL WORD DEFINES 01296000 T 0028 + IOABIT = [ 2: 1]#, % [45: 1] ATTENTION 01297000 T 0028 + IOWBIT = [ 3: 1]#, % [44: 1] MEMORY WRITE 01298000 T 0028 + IOIBIT = [ 4: 1]#, % [43: 1] MEMORY INHIBIT 01299000 T 0028 + IOXBIT = [ 5: 1]#, % [42: 1] TRANSLATE 01300000 T 0028 + IOSBIT = [ 6: 1]#, % [41: 1] FRAME LENGTH (0 = 6 BIT;1= 8 BIT) 01301000 T 0028 + IOPBIT = [ 7: 1]#, % [40: 1] MEMORY PROTECT 01302000 T 0028 + IOBBIT = [ 8: 1]#, % [39: 1] BACKWARD TRANSFER 01303000 T 0028 + IOTBIT = [ 9: 1]#, % [38: 1] 01304000 T 0028 + IOTAGS = [10: 2]#, % [37: 1] & [36:1] TAG TRANSFER 01305000 T 0028 + IOSKIP = [12: 4]#, % [35: 4] PRINTER SKIP 01306000 T 0028 + IOSPAC = [16: 2]#; % [31: 2] PRINTER SPACE 01307000 T 0028 + DEFINE RECS = [24:10]#; % [23:10] TAPE SPACE 01308000 T 0028 + SAVE ARRAY MESS [0:BUFRMAX-1];%UTILITY INPUT-OUTPUT AREA 01309000 T 0028 +PRT(324) = MESS + COMMENT BUFFERS IS INDEXED BY SWITCH FILE INDEX AND HARDWARE TYPE; 01310000 T 0032 + FILE DISKA DISK RANDOM [20:1000] (1, BUFFERS [0, 1],SAVE 99), 01311000 T 0032 +PRT(325) = DISKA +PRT(326) = FILE ATTRBUTS + DISKB DISK RANDOM [20:1000] (1, BUFFERS [1, 1],SAVE 99), 01312000 T 0040 +PRT(327) = DISKB + DISKC DISK RANDOM [20:1000] (1, BUFFERS [2, 1],SAVE 99), 01313000 T 0048 +PRT(330) = DISKC + DISKD DISK RANDOM [20:1000] (1, BUFFERS [3, 1],SAVE 99), 01314000 T 0056 +PRT(331) = DISKD + SPO 14 (1, BUFFERS [0, 2]), 01315000 T 0064 +PRT(332) = SPO + AIDS 14 (1, BUFFERS [0, 3]), 01316000 T 0069 +PRT(333) = AIDS + LP 4 (1, BUFFERS [0, 6]), 01317000 T 0074 +PRT(334) = LP + SIMLP 14 (1, BUFFERS [1, 6]), 01318000 T 0080 +PRT(335) = SIMLP + CARD (1, BUFFERS [0, 9]), 01319000 T 0085 +PRT(336) = CARD + PUNCH 0 (1, BUFFERS [0,10]), 01320000 T 0090 +PRT(337) = PUNCH + TAPEA 2 (1, BUFFERS [0,13], SAVE 1), 01321000 T 0095 +PRT(340) = TAPEA + TAPEB 2 (1, BUFFERS [1,13], SAVE 1), 01322000 T 0103 +PRT(341) = TAPEB + TAPEC 2 (1, BUFFERS [2,13], SAVE 1), 01323000 T 0111 +PRT(342) = TAPEC + TAPED 2 (1, BUFFERS [3,13], SAVE 1); 01324000 T 0119 +PRT(343) = TAPED + SWITCH FILE TAPES ← TAPEA, TAPEB, TAPEC, TAPED; 01325000 T 0127 +PRT(344) = TAPES + SWITCH FILE DISKS ← DISKA, DISKB, DISKC, DISKD; 01326000 T 0135 +PRT(345) = DISKS + SWITCH FILE LINES ← LP, SIMLP; 01327000 T 0142 +PRT(346) = LINES + COMMENT 01328000 T 0147 + ******************************* 01329000 T 0147 + ***** B6500 WORD FORMAT ***** 01330000 T 0147 + ******************************* 01331000 T 0147 + SEGMENT DESCRIPTOR 01332000 T 0147 + 5 5 4 4 4 4 4 4 4 4 3 2 1 01333000 T 0147 + 1 0 8 7 6 5 4 3 2 0 9 0 9 0 01334000 T 0147 + -------------------------------------------------------------- 01335000 T 0147 + :X:011:P:C: UNUSED : LENGTH : ADDR : 01336000 T 0147 + -------------------------------------------------------------- 01337000 T 0147 + INDIRECT REFERENCE WORD (NORMAL) 01338000 T 0147 + 5 5 4 4 4 4 1 1 01339000 T 0147 + 1 0 8 7 6 5 4 3 0 01340000 T 0147 + -------------------------------------------------------------- 01341000 T 0147 + :X:001:U:0: . . . . . .UNUSED. . . . . . . . :ADDRESSCOUPLE : 01342000 T 0147 + -------------------------------------------------------------- 01343000 T 0147 + INDIRECT REFERENCE WORD (STUFFED) 01343100 T 0147 + 5 5 4 4 4 4 3 3 2 1 1 1 . 01343200 T 0147 + 1 0 8 7 6 5 6 5 0 9 3 2 0 01343300 T 0147 + -------------------------------------------------------------- 01343400 T 0147 + :X:001:U:1: STKNR : DISP :UNUSED :INDEX FIELD : 01343500 T 0147 + -------------------------------------------------------------- 01343600 T 0147 + MARK STACK CONTROL WORD 01344000 T 0147 + 5 5 4 4 4 4 3 3 2 1 1 1 1 01345000 T 0147 + 1 0 8 7 6 5 6 5 0 9 8 4 3 0 01346000 T 0147 + -------------------------------------------------------------- 01347000 T 0147 + :X:011:DS:E: STKNR : DISP :V:LLF: DF : 01348000 T 0147 + -------------------------------------------------------------- 01349000 T 0147 + PROGRAM CONTROL WORD 01350000 T 0147 + 5 5 4 4 4 4 3 3 3 3 2 1 1 1 1 01351000 T 0147 + 1 0 8 7 6 5 6 5 3 2 0 9 8 4 3 0 01352000 T 0147 + -------------------------------------------------------------- 01353000 T 0147 + :X:111:UU : STKNR : PSRF : PIRF :N:LLF: SDIF : 01354000 T 0147 + -------------------------------------------------------------- 01355000 T 0147 + RETURN CONTROL WORD 01356000 T 0147 + 5 5 4 4 4 4 4 4 3 3 3 3 2 1 1 1 1 01357000 T 0147 + 1 0 8 7 6 5 4 3 6 5 3 2 0 9 8 4 3 0 01358000 T 0147 + -------------------------------------------------------------- 01359000 T 0147 + :X:011:X:O:T:F: UNUSED : PSRF : PIRF :N:LLF: SDIF : 01360000 T 0147 + -------------------------------------------------------------- 01361000 T 0147 + SINGLE PRECISION OPERAND 01362000 T 0147 + 5 5 4 4 4 4 4 3 3 01363000 T 0147 + 1 0 8 7 6 5 4 9 8 01364000 T 0147 + -------------------------------------------------------------- 01365000 T 0147 + :X:000:U:SO:SE: EXPF : MANF : 01366000 T 0147 + -------------------------------------------------------------- 01367000 T 0147 + DOUBLE PRECISION OPERAND 01368000 T 0147 + 5 5 4 4 4 4 4 3 3 (FIRST HALF) 01369000 T 0147 + 1 0 8 7 6 5 4 9 8 0 01370000 T 0147 + -------------------------------------------------------------- 01371000 T 0147 + :X:010:U:SO:SE: EXPX : MANF : 01372000 T 0147 + -------------------------------------------------------------- 01373000 T 0147 + 5 5 4 4 3 3 (SECOND HALF) 01374000 T 0147 + 1 0 8 7 9 8 0 01375000 T 0147 + -------------------------------------------------------------- 01376000 T 0147 + :X:010: EXPD EXT. : MANF : 01377000 T 0147 + -------------------------------------------------------------- 01378000 T 0147 + WORD DATA DESCRIPTOR 01379000 T 0147 + 5 5 4 4 4 4 4 4 44 4 3 2 1 01380000 T 0147 + 1 0 8 7 6 5 4 3 21 0 9 0 9 0 01381000 T 0147 + -------------------------------------------------------------- 01382000 T 0147 + :X:101:P:C:I:S:R:SZ:D: LENGTH/INDEX : ADDR : 01383000 T 0147 + -------------------------------------------------------------- 01384000 T 0147 + STRING DESCRIPTOR (NON-INDEXED) 01385000 T 0147 + 5 5 4 4 4 4 4 4 44 4 3 2 1 01386000 T 0147 + 1 0 8 7 6 5 4 3 21 0 9 0 9 0 01387000 T 0147 + -------------------------------------------------------------- 01388000 T 0147 + :X:101:P:C:O:S:R: SZ : LENGTH IN CHR : ADDR : 01389000 T 0147 + -------------------------------------------------------------- 01390000 T 0147 + STRING DESCRIPTOR (INDEXED) 01391000 T 0147 + 5 5 4 4 4 4 4 4 44 4 3 3 2 1 01392000 T 0147 + 1 0 8 7 6 5 4 3 21 0 5 4 0 9 0 01393000 T 0147 + -------------------------------------------------------------- 01394000 T 0147 + :X:101:P:C:1:S:R: SZ :BYTE INX:WORD INDEX: ADDR : 01395000 T 0147 + -------------------------------------------------------------- 01396000 T 0147 + STEP INDEX WORD 01397000 T 0147 + 5 5 4 4 3 3 2 1 1 1 01398000 T 0147 + 1 0 8 7 6 5 0 9 6 5 0 01399000 T 0147 + -------------------------------------------------------------- 01400000 T 0147 + :X:100: INCREMENT : FINAL VALUE : U :CURRENT VALUE : 01401000 T 0147 + -------------------------------------------------------------- 01402000 T 0147 + ; 01403000 T 0147 + %******************************************** 01600000 T 0147 + %***** FORWARD PROCEDURE DECLARATIONS ***** 01601000 T 0147 + %******************************************** 01602000 T 0147 + %%%%% BEGIN OPERATOR FORWARDS %%%%%%%%%% 01603000 T 0147 + DEFINE V = PROCEDURE#, W = ; FORWARD;#; 01604000 T 0147 + V MKST W V IMKS W V NAMC W V VALC W V EVAL W V ENTR W V EXIT W V RETN W 01605000 T 0147 +PRT(347) = MKST +PRT(350) = IMKS +PRT(351) = NAMC +PRT(352) = VALC +PRT(353) = EVAL +PRT(354) = ENTR +PRT(355) = EXIT +PRT(356) = RETN + V IRWL W V PCWL W V BRUN W V BRTR W V BRFL W V DBUN W V DBTR W V DBFL W 01606000 T 0150 +PRT(357) = IRWL +PRT(360) = PCWL +PRT(361) = BRUN +PRT(362) = BRTR +PRT(363) = BRFL +PRT(364) = DBUN +PRT(365) = DBTR +PRT(366) = DBFL + V NOOP W V HALT W V NVLD W V VARI W V ADD W V SUBT W V MULT W V MULX W 01607000 T 0150 +PRT(367) = NOOP +PRT(370) = HALT +PRT(371) = NVLD +PRT(372) = VARI +PRT(373) = ADD +PRT(374) = SUBT +PRT(375) = MULT +PRT(376) = MULX + V DIVD W V IDIV W V RDIV W V NTIA W V NTGR W V SNGT W V SNGL W V XTND W 01608000 T 0150 +PRT(377) = DIVD +PRT(400) = IDIV +PRT(401) = RDIV +PRT(402) = NTIA +PRT(403) = NTGR +PRT(404) = SNGT +PRT(405) = SNGL +PRT(406) = XTND + V JOIN W V SPLT W V LAND W V LOR W V LNOT W V SAME W V LEQV W V GRTR W 01609000 T 0150 +PRT(407) = JOIN +PRT(410) = SPLT +PRT(411) = LAND +PRT(412) = LOR +PRT(413) = LNOT +PRT(414) = SAME +PRT(415) = LEQV +PRT(416) = GRTR + V GREQ W V EQUL W V LSEQ W V LESS W V NEQL W V INDX W V STBR W V NXLN W 01610000 T 0150 +PRT(417) = GREQ +PRT(420) = EQUL +PRT(421) = LSEQ +PRT(422) = LESS +PRT(423) = NEQL +PRT(424) = INDX +PRT(425) = STBR +PRT(426) = NXLN + V NXLV W V LOAD W V LODT W V EXCH W V RSDN W V RSUP W V DUPL W V DLET W 01611000 T 0150 +PRT(427) = NXLV +PRT(430) = LOAD +PRT(431) = LODT +PRT(432) = EXCH +PRT(433) = RSDN +PRT(434) = RSUP +PRT(435) = DUPL +PRT(436) = DLET + V MVST W V PUSH W V STOD W V STON W V OVRD W V OVRN W V FLTR W V DFTR W 01612000 T 0150 +PRT(437) = MVST +PRT(440) = PUSH +PRT(441) = STOD +PRT(442) = STON +PRT(443) = OVRD +PRT(444) = OVRN +PRT(445) = FLTR +PRT(446) = DFTR + V ISOL W V DISO W V INSR W V DINS W V SRCH W V LLLU W V ZERO W V ONE W 01613000 T 0150 +PRT(447) = ISOL +PRT(450) = DISO +PRT(451) = INSR +PRT(452) = DINS +PRT(453) = SRCH +PRT(454) = LLLU +PRT(455) = ZERO +PRT(456) = ONE + V LT8 W V LT16 W V LT48 W V MPCW W V BSET W V DBST W V BRST W V DBRS W 01614000 T 0150 +PRT(457) = LT8 +PRT(460) = LT16 +PRT(461) = LT48 +PRT(462) = MPCW +PRT(463) = BSET +PRT(464) = DBST +PRT(465) = BRST +PRT(466) = DBRS + V CHSN W V CBON W V LOG2 W V STAG W V RTAG W V SINT W V RDLK W V STFF W 01615000 T 0150 +PRT(467) = CHSN +PRT(470) = CBON +PRT(471) = LOG2 +PRT(472) = STAG +PRT(473) = RTAG +PRT(474) = SINT +PRT(475) = RDLK +PRT(476) = STFF + V WHOI W V EEXI W V DEXI W V IDLE W V HEYU W V RPRR W V SPRR W V SCNI W 01616000 T 0150 +PRT(477) = WHOI +PRT(500) = EEXI +PRT(501) = DEXI +PRT(502) = IDLE +PRT(503) = HEYU +PRT(504) = RPRR +PRT(505) = SPRR +PRT(506) = SCNI + V SCNO W V TWSD W V TWSU W V TWOD W V TWOU W V TGTD W V TGTU W V TGED W 01617000 T 0150 +PRT(507) = SCNO +PRT(510) = TWSD +PRT(511) = TWSU +PRT(512) = TWOD +PRT(513) = TWOU +PRT(514) = TGTD +PRT(515) = TGTU +PRT(516) = TGED + V TGEU W V TEQD W V TEQU W V TLED W V TLEU W V TLSD W V TLSU W V TNED W 01618000 T 0150 +PRT(517) = TGEU +PRT(520) = TEQD +PRT(521) = TEQU +PRT(522) = TLED +PRT(523) = TLEU +PRT(524) = TLSD +PRT(525) = TLSU +PRT(526) = TNED + V TNEU W V TWTD W V TWTU W V TWFD W V TWFU W V TUND W V TUNU W V SGTD W 01619000 T 0150 +PRT(527) = TNEU +PRT(530) = TWTD +PRT(531) = TWTU +PRT(532) = TWFD +PRT(533) = TWFU +PRT(534) = TUND +PRT(535) = TUNU +PRT(536) = SGTD + V SGTU W V SGED W V SGEU W V SEQD W V SEQU W V SLED W V SLEU W V SLSD W 01620000 T 0150 +PRT(537) = SGTU +PRT(540) = SGED +PRT(541) = SGEU +PRT(542) = SEQD +PRT(543) = SEQU +PRT(544) = SLED +PRT(545) = SLEU +PRT(546) = SLSD + V SLSU W V SNED W V SNEU W V SWTD W V SWTU W V SWFD W V SWFU W V CGTD W 01621000 T 0150 +PRT(547) = SLSU +PRT(550) = SNED +PRT(551) = SNEU +PRT(552) = SWTD +PRT(553) = SWTU +PRT(554) = SWFD +PRT(555) = SWFU +PRT(556) = CGTD + V CGTU W V CGED W V CGEU W V CEQD W V CEQU W V CLED W V CLEU W V CLSD W 01622000 T 0150 +PRT(557) = CGTU +PRT(560) = CGED +PRT(561) = CGEU +PRT(562) = CEQD +PRT(563) = CEQU +PRT(564) = CLED +PRT(565) = CLEU +PRT(566) = CLSD + V CLSU W V CNED W V CNEU W V UABD W V UABU W V USND W V USNU W V PACD W 01623000 T 0150 +PRT(567) = CLSU +PRT(570) = CNED +PRT(571) = CNEU +PRT(572) = UABD +PRT(573) = UABU +PRT(574) = USND +PRT(575) = USNU +PRT(576) = PACD + V PACU W V TRNS W V SCLF W V DSLF W V SCRS W V DSRS W V SCRT W V DSRT W 01624000 T 0150 +PRT(577) = PACU +PRT(600) = TRNS +PRT(601) = SCLF +PRT(602) = DSLF +PRT(603) = SCRS +PRT(604) = DSRS +PRT(605) = SCRT +PRT(606) = DSRT + V SCRR W V DSRR W V SCRF W V DSRF W V OCRX W V SISO W V SXSN W V RTFF W 01625000 T 0150 +PRT(607) = SCRR +PRT(610) = DSRR +PRT(611) = SCRF +PRT(612) = DSRF +PRT(613) = OCRX +PRT(614) = SISO +PRT(615) = SXSN +PRT(616) = RTFF + V ROFF W V ICVD W V ICVU W V TEED W V TEEU W V EXSD W V EXSU W V EXPU W 01626000 T 0150 +PRT(617) = ROFF +PRT(620) = ICVD +PRT(621) = ICVU +PRT(622) = TEED +PRT(623) = TEEU +PRT(624) = EXSD +PRT(625) = EXSU +PRT(626) = EXPU + V MCHR W V MVNU W V SFSC W V SRSC W V SFDC W V SRDC W V INSU W V INSC W 01627000 T 0150 +PRT(627) = MCHR +PRT(630) = MVNU +PRT(631) = SFSC +PRT(632) = SRSC +PRT(633) = SFDC +PRT(634) = SRDC +PRT(635) = INSU +PRT(636) = INSC + V INSG W V INOP W V RSTF W V ENDF W V MINS W V MFLT W V ENDE W 01628000 T 0150 +PRT(637) = INSG +PRT(640) = INOP +PRT(641) = RSTF +PRT(642) = ENDF +PRT(643) = MINS +PRT(644) = MFLT +PRT(645) = ENDE + %%%%% END OPERATOR FORWARDS %%%%%%%%%% 01629000 T 0150 + DEFINE CHECOP=( (AX.TAG=SINGL OR AX.TAG=DOUBL ) 01700000 T 0150 + AND(BX.TAG=SINGL OR BX.TAG=DOUBL))#, 01701000 T 0150 + CHECOPRNDB=IF NOT (BX.TAG=SINGL OR BX.TAG=DOUBL) 01702000 T 0150 + THEN BEGIN SETINTERRUPT (INVOP)#, 01703000 T 0150 + CHECOPRNDA=IF NOT (AX.TAG=SINGL OR AX.TAG=DOUBL) 01704000 T 0150 + THEN BEGIN SETINTERRUPT(INVOP)#; 01705000 T 0150 + DEFINE PRESENCEBITINTERRUPT= 01706000 T 0150 + BEGIN SETINTERRUPT(PRESBIT); GO TO OC END#, 01707000 T 0150 + INVALIDINDEXINTERRUPT= 01708000 T 0150 + BEGIN SETINTERRUPT(INVINXI); GO TO OC END#, 01709000 T 0150 + INVALIDOPERATORINTERRUPT= 01710000 T 0150 + BEGIN SETINTERRUPT(INVOP); GO TO OC END#; 01711000 T 0150 + PROCEDURE ADJ(NEWAROF,NEWBROF); VALUE NEWAROF,NEWBROF; 01712000 T 0150 +PRT(646) = ADJ + INTEGER NEWAROF,NEWBROF; FORWARD; 01713000 T 0150 + STREAM PROCEDURE MOVE(SOURCE,DESTINATION); 01714000 T 0150 +PRT(647) = MOVE + BEGIN SI←SOURCE; DI←DESTINATION; DS←2 WDS; END MOVE; 01715000 T 0150 + PROCEDURE ERROR(ERRNUM); VALUE ERRNUM; REAL ERRNUM; FORWARD; 01716000 T 0151 +PRT(650) = ERROR + BOOLEAN PROCEDURE EQUAL (A,AX,B,BX); VALUE A,AX,B,BX; REAL A,AX,B,BX; 01717000 T 0151 +PRT(651) = EQUAL + EQUAL ← (AX.[44:4] = BX.[44:4]) AND 01718000 T 0151 + (REAL(BOOLEAN(A) EQV BOOLEAN (B)) = REAL (NOT FALSE)); 01719000 T 0152 + STREAM PROCEDURE DYALS (P, A, N, N1, TURN); VALUE N, N1, TURN; 01720000 T 0157 +PRT(652) = DYALS + BEGIN 01721000 T 0157 + DI ← P; SI ← P; SI ← SI + 15; 01722000 T 0158 + SKIP 5 SB; IF SB THEN DS ← SET ELSE DS ← RESET; 01723000 T 0158 + SI ← A; SI ← SI + 15; SKIP 5 SB; 01724000 T 0160 + DI ← A; IF SB THEN DS ← SET ELSE DS ← RESET; 01725000 T 0161 + SI ← P; DI ← A; SKIP N SB; SKIP N1 DB; TURN BITS; 01726000 T 0162 + DI ← A; DI ← DI + 15; SKIP 5 DB; 01727000 T 0166 + SI ← A; IF SB THEN DS ← SET ELSE DS ← RESET; 01728000 T 0167 + DI ← P; DS ← RESET; 01729000 T 0169 + DI ← A; DS ← RESET; 01730000 T 0169 + END OF DYAL; 01731000 T 0170 + PROCEDURE DYAL (P, A, N, N1, TURN); VALUE N, N1, TURN; 01732000 T 0170 +PRT(653) = DYAL + REAL P, A; 01733000 T 0170 + INTEGER N, N1, TURN; 01734000 T 0170 + BEGIN 01735000 T 0170 + INTEGER NN, NN1; 01736000 T 0170 + START OF SEGMENT ********** 14 +STACK(F+2) = NN +STACK(F+3) = NN1 + NN ← 47-N; 01737000 T 0000 + NN1 ← 47-N1; 01738000 T 0001 + DYALS (P, A, NN, NN1, TURN); 01739000 T 0002 + END; 01740000 T 0004 + 14 IS 7 LONG, NEXT SEG 12 + DEFINE SYLLABLE = (IF PROF THEN SYLLABLES[PSR] ELSE PSYLLABLES)#; 01741000 T 0170 + INTEGER ARRAY SYLLABLES[0:5]; 01742000 T 0170 +PRT(654) = SYLLABLES + INTEGER PROCEDURE PSYLLABLES; FORWARD; % RETURNS P[PSR] 01743000 T 0173 +PRT(655) = PSYLLABLES + PROCEDURE STEPPSR(N); VALUE N; INTEGER N; FORWARD; % STEPS PSR+PIR,PROF 01744000 T 0173 +PRT(656) = STEPPSR + PROCEDURE TRACE; FORWARD; 01745000 T 0173 +PRT(657) = TRACE + PROCEDURE MEMDUMP; FORWARD; 01746000 T 0173 +PRT(660) = MEMDUMP + PROCEDURE SETINTERRUPT(I); VALUE I; INTEGER I; FORWARD; 01747000 T 0173 +PRT(661) = SETINTERRUPT + INTEGER PROCEDURE LEVEL(WORD); VALUE WORD; REAL WORD; FORWARD; 01748000 T 0173 +PRT(662) = LEVEL + INTEGER PROCEDURE DELTA(WORD); VALUE WORD; REAL WORD; FORWARD; 01749000 T 0173 +PRT(663) = DELTA + PROCEDURE ERVSFLOW(OP); VALUE OP; INTEGER OP; FORWARD; 01750000 T 0173 +PRT(664) = ERVSFLOW + BOOLEAN PROCEDURE INTEGERIZE(ROUND,REG);VALUE ROUND; 01751000 T 0173 +PRT(665) = INTEGERIZE + BOOLEAN ROUND; REAL REG; FORWARD; 01752000 T 0173 + REAL PROCEDURE GETRESULT (MPXAB); VALUE MPXAB; REAL MPXAB; FORWARD; 01753000 T 0173 +PRT(666) = GETRESULT + PROCEDURE STORE(OP); VALUE OP; REAL OP; FORWARD; 01754000 T 0173 +PRT(667) = STORE + PROCEDURE WRITETIME; FORWARD; % WRITES OUT TIME SINCE INITIALIZATION 01755000 T 0173 +PRT(670) = WRITETIME + PROCEDURE HEADINGLINE (LP); FILE LP; FORWARD; 01756000 T 0173 +PRT(671) = HEADINGLINE + PROCEDURE INTFAMD(TYPE); VALUE TYPE; REAL TYPE; 01757000 T 0173 +PRT(672) = INTFAMD + BEGIN 01757100 T 0173 + LABEL INVALIDOP1 , INVALIDOP2 , INVALIDOP3 , INVALIDOP4 , 01757200 T 0173 + START OF SEGMENT ********** 15 + INVALIDOP5 , MEMPROT , 01757300 T 0000 + INVINDX2 , PRESBIT1 , PRESBIT2 01757400 T 0000 + ,OC , LO , BACKUP , L2 01757500 T 0000 + ; 01757600 T 0000 + SWITCH INTERRUPT ← 01757700 T 0000 + INVALIDOP1 , INVALIDOP2 , INVALIDOP3 , INVALIDOP4 , 01757701 T 0002 + INVALIDOP5 , MEMPROT , 01757702 T 0002 + INVINDX2 , PRESBIT1 , PRESBIT2 01757703 T 0002 + ; 01757704 T 0002 + GO TO INTERRUPT[TYPE]; 01757800 T 0007 + INVALIDOP1: ADJ(0,0); GO LO; 01757900 T 0010 + INVALIDOP2: ADJ(0,0); MOVE(C,A); GO LO; 01758000 T 0011 + INVALIDOP3: MOVE(B,A); GO LO; 01758100 T 0014 + INVALIDOP4: AROF ← TRUE; MOVE(B,A); ADJ(1,0); GO LO; 01758200 T 0016 + INVALIDOP5: ADJ(0,0); MOVE(B,A); 01758300 T 0020 + LO: BX ← 0; 01758400 T 0023 + AROF ← BROF ← TRUE; SDIS ← 1; 01758500 T 0023 + B ← INVOP ; 01758600 T 0026 + BACKUP: 01758700 T 0027 + PIR ← PIR - PICR; PSR ← OPSR; GO OC; 01758800 T 0028 + MEMPROT: 01758900 T 0032 + ADJ(0,0); 01759000 T 0032 + MOVE(C,A); 01759100 T 0033 + BX ← 0; 01759200 T 0034 + AROF←BROF←TRUE; SDIS ← 1; 01759300 T 0034 + B ← MEMPROI; 01759400 T 0037 + GO BACKUP; 01759500 T 0038 + INVINDX2: 01759600 T 0040 + ADJ(0,0); 01759700 T 0040 + BX ← A ← AX ← 0; 01759800 T 0041 + AROF←BROF←TRUE; SDIS ← 1; 01759900 T 0042 + B ← INVINXI; 01760000 T 0045 + GO BACKUP; 01760100 T 0046 + PRESBIT1: 01760200 T 0048 + AROF←FALSE; 01760250 T 0048 + ADJ(0,0); 01760300 T 0048 + MOVE(C,A); 01760500 T 0049 + GO L2; 01760600 T 0050 + PRESBIT2: 01760700 T 0051 + MOVE(X,A); 01760800 T 0052 + AROF ← TRUE; 01760900 T 0053 + ADJ(0,0); 01761000 T 0053 + MOVE(C,A); 01761200 T 0054 + AROF ← TRUE; 01761300 T 0055 + ADJ(0,0); 01761400 T 0056 + L2: 01761500 T 0057 + BX ← 0; 01761600 T 0058 + AROF←BROF←TRUE; SDIS ← 1; 01761700 T 0058 + B ← PRESBIT; 01761800 T 0061 + B.SOBIT ← 1; 01761900 T 0062 + GO BACKUP; 01762000 T 0064 + OC: 01762100 T 0066 + END; 01762200 T 0066 + 15 IS 67 LONG, NEXT SEG 12 + 01762300 T 0173 + PROCEDURE INTFAMA(TYPE); VALUE TYPE; REAL TYPE; 01765000 T 0173 +PRT(673) = INTFAMA + BEGIN 01765100 T 0173 + DEFINE CLEARAB = A←AX←B←BX ← 0#; 01765200 T 0173 + START OF SEGMENT ********** 16 + IF TYPE < 0 THEN 01765300 T 0000 + BEGIN 01765400 T 0000 + ADJ(0,0); 01765500 T 0001 + CLEARAB; 01765600 T 0002 + B ← INVOP; 01765700 T 0004 + 01765800 T 0005 + END ELSE 01765900 T 0005 + BEGIN 01766000 T 0005 + CLEARAB; 01766100 T 0007 + B ← ABS(TYPE); 01766200 T 0009 + END; 01766300 T 0010 + AROF ← BROF ← TRUE; 01766400 T 0010 + SDIS ← 1; 01766500 T 0011 + PIR ← PIR - PICR; PSR ← OPSR; 01766600 T 0013 + END INTFAMD; 01766700 T 0015 + 16 IS 16 LONG, NEXT SEG 12 + PROCEDURE INTFAMB(TYPE); VALUE TYPE; REAL TYPE; 01767000 T 0173 +PRT(674) = INTFAMB + BEGIN 01767100 T 0173 + 01767200 T 0173 + IF TYPE=2 THEN 01767300 T 0173 + BEGIN 01767400 T 0174 + ADJ(0,0); MOVE(C,A); 01767500 T 0175 + END ELSE 01767600 T 0177 + MOVE(B,A); 01767700 T 0177 + B ← BX ← 0; 01767800 T 0178 + SDIS ← 1; 01767900 T 0180 + BROF ← AROF ← TRUE; 01768000 T 0181 + B ← INVOP; 01768100 T 0183 + PIR ← PIR - PICR; PSR ← OPSR; 01768200 T 0183 + END INFAMB; 01768300 T 0185 + PROCEDURE INTERRUPTCONTROLLER; 01800000 T 0187 +PRT(675) = INTERRUPTCONTROLLER + IF BOOLEAN (PTPI) THEN INT ← 0 ELSE % IGNORE PROC TO PROC IN SIM 01800100 T 0187 + BEGIN COMMENT INTERRUPT CONTROLLER IS PRIMARILY CONCERNED WITH 01801000 T 0189 + MAKING THE STACK LOOK LIKE A PROCEDURE IS TO BE 01802000 T 0189 + CALLED AND THEN CALLING IT. MUCH OF THE CURRENT CODE 01803000 T 0189 + IS CONCERNED WITH INFORMING PEOPLE AS TO WHAT IS 01804000 T 0189 + HAPPENING. 01805000 T 0189 + 9/12/67; 01806000 T 0189 + REAL TEMPB, SWFI; 01807000 T 0189 +PRT(676) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 17 +STACK(F+2) = TEMPB +STACK(F+3) = SWFI + DEFINE 01808000 T 0000 + BASSDI = 0#, 01809000 T 0000 + BASEXI = 10#, 01810000 T 0000 + BASGCI = 12#, 01811000 T 0000 + BASALI = 14#; 01812000 T 0000 + SWITCH FORMAT INTS 01813000 T 0000 + START OF SEGMENT ********** 18 +PRT(677) = INTS + ←(10 ("X"), " INTERRUPT ERROR." ,X2,10("X")) 01814000 T 0000 + ,(10 ("X"), " MEMORY PROTECT INTERRUPT." ,X2,10("X")) 01815000 T 0000 + ,(10 ("X"), " INVALID OPERATOR INTERRUPT." ,X2,10("X")) 01816000 T 0000 + ,(10 ("X"), " DIVIDE BY ZERO INTERRUPT." ,X2,10("X")) 01817000 T 0000 + ,(10 ("X"), " EXPONENT OVERFLOW INTERRUPT." ,X2,10("X")) 01818000 T 0000 + ,(10 ("X"), " EXPONENT UNDERFLOW INTERRUPT." ,X2,10("X")) 01819000 T 0000 + ,(10 ("X"), " INVALID INDEX INTERRUPT." ,X2,10("X")) 01820000 T 0000 + ,(10 ("X"), " INTEGER OVERFLOW INTERRUPT." ,X2,10("X")) 01821000 T 0000 + ,(10 ("X"), " BOTTOM OF STACK INTERRUPT." ,X2,10("X")) 01822000 T 0000 + ,(10 ("X"), " PRESENCE BIT INTERRUPT." ,X2,10("X")) 01823000 T 0000 + ,(10 ("X"), " SEQUENCE ERROR INTERRUPT," ,X2,10("X")) 01824000 T 0000 + ,(10 ("X"), " MULTIPLEXOR A INTERRUPT." ,X2,10("X")) 01825000 T 0000 + ,(10 ("X"), " MULTIPLEXOR B INTERRUPT." ,X2,10("X")) 01826000 T 0000 + ,(10 ("X"), " INTERVAL TIMER INTERRURT." ,X2,10("X")) 01827000 T 0000 + ,(10 ("X"), " STACK OVERFLOW INTERRUPT." ,X2,10("X")) 01828000 T 0000 + ,(10 ("X"), " OPERATOR LOOP INTERRUPT." ,X2,10("X")) 01829000 T 0000 + ,(10 ("X"), " MEMORY PARITY INTERRUPT." ,X2,10("X")) 01830000 T 0000 + ,(10 ("X"), " MULTIPLEXOR PARITY INTERRUPT." ,X2,10("X")) 01831000 T 0000 + ,(10 ("X"), " INVALID ADDRESS INTERRUPT." ,X2,10("X")) 01832000 T 0000 + ,(10 ("X"), " STACK UNDERFLOW INTERRUPT." ,X2,10("X")) 01833000 T 0000 + ; 01834000 T 0000 + 18 IS 317 LONG, NEXT SEG 17 + IF SDIS ≠ 0 01835000 T 0000 + THEN BEGIN 01836000 T 0000 + TEMPB ← B; 01837000 T 0001 + ADJ (0, 0); 01838000 T 0002 + AX ← 0; 01839000 T 0003 + AROF ← TRUE; 01840000 T 0004 + A ← 0 & TEMPB [33:33:15]; 01841000 T 0005 + LOG2; 01842000 T 0006 + SWFI ← B; 01843000 T 0006 + BROF ← FALSE; 01844000 T 0007 + ADJ (1, 1); 01845000 T 0008 + MOVE (M[D[0] +3], C); 01846000 T 0009 + IF CX.TAG ≠ PCW 01847000 T 0014 + THEN BEGIN 01848000 T 0015 + WRITE(LP [DBL], INTS [SWFI]); 01849000 T 0015 +PRT(700) = OUTPUT(W) + MEMDUMP; 01850000 T 0019 + GO EOJ; 01851000 T 0020 +PRT(701) = EOJ + END; 01852000 T 0022 + END 01853000 T 0022 + ELSE IF EXIA ≠ 0 01854000 T 0022 + THEN BEGIN 01855000 T 0023 + SWFI ← BASEXI + B - EXTINTI; 01856000 T 0024 + IF SWFI > BASGCI THEN SWFI ← BASEXI + 1; 01856100 T 0026 + END 01857000 T 0029 + ELSE IF GCIF ≠ 0 01858000 T 0029 + THEN BEGIN 01859000 T 0031 + SWFI ← B - INTTIMI + BASGCI + 1; 01860000 T 0032 + INTTIMER ← 2*36 ; 01861000 T 0035 + END 01862000 T 0038 + ELSE IF INT.[43:5] ≠ 0 01863000 T 0038 + %LOOP + MPEI + MPXP + INVA + SUFL ≠0 01864000 T 0041 + THEN BEGIN 01865000 T 0042 + TEMPB ← B; 01866000 T 0042 + ADJ (0, 0); 01866100 T 0043 + A ← B - LOOPI + 1; AX ← 0; 01866200 T 0044 + AROF ← TRUE; 01866300 T 0047 + LOG2; 01866400 T 0047 + SWFI ← B + BASALI; 01866450 T 0048 + BROF ← FALSE; 01866600 T 0049 + ADJ (1, 1); 01866700 T 0050 + END 01867000 T 0051 + ELSE ERROR (101); 01868000 T 0051 + IMKS; 01869000 T 0053 + ADJ (0, 1); 01870000 T 0054 + A ← 3; 01871000 T 0055 + AX.TAG ← IRW; 01872000 T 0056 + AROF ← TRUE; 01873000 T 0057 + RSDN; 01874000 T 0058 + ENTR; 01875000 T 0059 + INT ← 0; 01876000 T 0059 + IF NOT (TRACEWORD = 0 OR (TRACEWORD ≥ 100 AND TRACTER = 0)) 01877000 T 0060 + THEN BEGIN 01878000 T 0062 + WRITE (LP, INTS [SWFI MOD 20]); 01879000 T 0063 + END; 01880000 T 0068 + END INTERRUPT CONTROLLER; 01881000 T 0068 +PRT(702) = *SEGMENT DESCRIPTOR* + 17 IS 69 LONG, NEXT SEG 12 + PROCEDURE TIMING (OP); 01882000 T 0192 +PRT(703) = TIMING + VALUE OP; 01883000 T 0192 + INTEGER OP; 01884000 T 0192 + BEGIN 01885000 T 0192 + DELTATIME ← DELTATIME + OP.[41:6]; %%%%%%%%%%% 01886000 T 0192 + REALTIME ← REALTIME + DELTATIME; 01887000 T 0194 + TIMEOFDAY ← TIMEOFDAY + DELTATIME; 01887100 T 0196 + DELTATIME ← 0; 01888000 T 0197 + END; 01889000 T 0198 + PROCEDURE CONTROLSECTION; 02000000 T 0198 +PRT(704) = CONTROLSECTION + BEGIN 02001000 T 0198 + DEFINE VARIANTESCAPE = 149#, 02002000 T 0198 + START OF SEGMENT ********** 19 + SINGLESHOTESCAPED = 210#, 02003000 T 0000 + TRACESCAPE = 202#, 02004000 T 0000 + SINGLESHOTESCAPEU = 218#; 02005000 T 0000 + DEFINE XXXX = NVLD#; 02006000 T 0000 + DEFINE PRIMARYMODETABLE = 02007000 T 0000 + BEGIN 02008000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02009000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02010000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02011000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02012000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02013000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02014000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02015000 T 0000 + VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02016000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02017000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02018000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02019000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02020000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02021000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02022000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02023000 T 0000 + NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02024000 T 0000 + ADD ; SUBT; MULT; DIVD; IDIV; RDIV; NTIA; NTGR; 02025000 T 0000 + LESS; GREQ; GRTR; LSEQ; EQUL; NEQL; CHSN; MULX; 02026000 T 0000 + LAND; LOR ; LNOT; LEQV; SAME; VARI; BSET; DBST; 02027000 T 0000 + FLTR; DFTR; ISOL; DISO; INSR; DINS; BRST; DBRS; 02028000 T 0000 + BRFL; BRTR; BRUN; EXIT; STBR; NXLN; INDX; RETN; 02029000 T 0000 + DBFL; DBTR; DBUN; ENTR; EVAL; NXLV; MKST; STFF; 02030000 T 0000 + ZERO; ONE ; LT8 ; LT16; PUSH; DLET; EXCH; DUPL; 02031000 T 0000 + STOD; STON; OVRD; OVRN; XXXX; LOAD; LT48; MPCW; 02032000 T 0000 + SCLF; DSLF; SCRT; DSRT; SCRS; DSRS; SCRF; DSRF; 02033000 T 0000 + SCRR; DSRR; ICVD; ICVU; SNGT; SNGL; XTND; IMKS; 02034000 T 0000 + TEED; PACD; EXSD; TWSD; TWOD; SISO; SXSN; ROFF; 02035000 T 0000 + TEEU; PACU; EXSU; TWSU; TWOU; EXPU; RTFF; HALT; 02036000 T 0000 + TLSD; TGED; TGTD; TLED; TEQD; TNED; TUND; XXXX; 02037000 T 0000 + TLSU; TGEU; TGTU; TLEU; TEQU; TNEU; TUNU; XXXX; 02038000 T 0000 + CLSD; CGED; CGTD; CLED; CEQD; CNED; XXXX; XXXX; 02039000 T 0000 + CLSU; CGEU; CGTU; CLEU; CEQU; CNEU; NOOP; NVLD; 02040000 T 0000 + END#; % OF PRIMARYMODETABLE 02041000 T 0000 + DEFINE VARIANTMODETABLE = 02042000 T 0000 + BEGIN 02043000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02044000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02045000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02046000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02047000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02048000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02049000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02050000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02051000 T 0000 + XXXX; XXXX; JOIN; SPLT; IDLE; SINT; EEXI; DEXI; 02052000 T 0000 + XXXX; XXXX; SCNI; SCNO; XXXX; XXXX; WHOI; HEYU; 02053000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02054000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02055000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02056000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02057000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02058000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02059000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; OCRX; XXXX; XXXX; 02060000 T 0000 + XXXX; XXXX; XXXX; LOG2; XXXX; XXXX; XXXX; XXXX; 02061000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02062000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02063000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02064000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; IRWL; PCWL; MVST; 02065000 T 0000 + XXXX; XXXX; XXXX; XXXX; STAG; RTAG; RSUP; RSDN; 02066000 T 0000 + RPRR; SPRR; RDLK; CBON; LODT; LLLU; SRCH; XXXX; 02067000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02068000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02069000 T 0000 + USND; UABD; TWFD; TWTD; SWFD; SWTD; XXXX; TRNS; 02070000 T 0000 + USNU; UABU; TWFU; TWTU; SWFU; SWTU; XXXX; HALT; 02071000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02072000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02073000 T 0000 + SLSD; SGED; SGTD; SLED; SEQD; SNED; XXXX; XXXX; 02074000 T 0000 + SLSU; SGEU; SGTU; SLEU; SEQU; SNEU; NOOP; NVLD; 02075000 T 0000 + END#; % OF VARIANTMODETABLE 02076000 T 0000 + DEFINE EDITMODETABLE = 02077000 T 0000 + BEGIN 02078000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02079000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02080000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02081000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02082000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02083000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02084000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02085000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02086000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02087000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02088000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02089000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02090000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02091000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02092000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02093000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02094000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02095000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02096000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02097000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02098000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02099000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02100000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02101000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02102000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02103000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02104000 T 0000 + MINS; MFLT; SFSC; SRSC; RSTF; ENDF; MVNU; MCHR; 02105000 T 0000 + INOP; INSG; SFDC; SRDC; INSU; INSC; ENDE; HALT; 02106000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02107000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02108000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02109000 T 0000 + XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; NOOP; NVLD; 02110000 T 0000 + END#; % OF EDITMODETABLE 02111000 T 0000 + LABEL PSC,ESCP; 02112000 T 0000 + PSC: VARF←FALSE; 02113000 T 0000 + Q ← QP ← N ← 0; 02114000 T 0000 + OPSR ← PSR; 02116000 T 0002 + PICR ← 0; 02117000 T 0003 + ESCP:IF (TS1←REAL(VARF)+REAL(LEEF)+REAL(TEEF)+REAL(SEEF))>1 THEN 02118000 T 0004 + BEGIN ERROR(0); MEMDUMP; GO TO EOJ; 02119000 T 0006 + END; 02120000 T 0010 + T←SYLLABLE; 02121000 T 0010 + IF TS1=0 THEN 02122000 T 0013 + IF (VARF←(T=VARIANTESCAPE)) THEN 02123000 T 0014 + BEGIN 02124000 T 0016 + STEPPSR (1); 02125000 T 0016 + GO TO ESCP; 02126000 T 0017 + END 02127000 T 0017 + ELSE IF T = TRACESCAPE THEN 02128000 T 0017 + BEGIN STEPPSR(1); TRACTER ← SYLLABLE; 02129000 T 0019 + STEPPSR(1); GO TO PSC; 02130000 T 0023 + END 02131000 T 0024 + ELSE IF NOT BOOLEAN(T.[40:1]) THEN DRS.[42:6] ← T; 02132000 T 0024 + STEPPSR (1); 02133000 T 0028 + IF TS1=0 THEN CASE T OF PRIMARYMODETABLE 02134000 T 0028 +PRT(705) = *CASE STATEMENT DESCRIPTOR* + ELSE IF VARF THEN CASE T OF VARIANTMODETABLE 02135000 T 0286 + START OF SEGMENT ********** 20 + 20 IS 256 LONG, NEXT SEG 19 +PRT(706) = *CASE STATEMENT DESCRIPTOR* + ELSE CASE T OF EDITMODETABLE; 02136000 T 0545 + START OF SEGMENT ********** 21 + 21 IS 256 LONG, NEXT SEG 19 +PRT(707) = *CASE STATEMENT DESCRIPTOR* + START OF SEGMENT ********** 22 + 22 IS 256 LONG, NEXT SEG 19 + IF STKOVFF THEN BEGIN SETINTERRUPT(STKOVFI); STKOVFF←FALSE END; 02136100 T 0804 + TIMING (T); 02137000 T 0806 + END OF CONTROL SECTION; 02138000 T 0807 + 19 IS 814 LONG, NEXT SEG 12 + INTEGER PROCEDURE PSYLLABLES; 04000000 T 0198 + BEGIN 04001000 T 0198 + IF NOT PROF THEN 04002000 T 0198 + BEGIN MOVE(M[PIR+PBR],P); MEMCYCLE; 04003000 T 0199 + IF PX.TAG≠CODE THEN SETINTERRUPT(INVOP); 04004000 T 0205 + PROF:=TRUE; 04005000 T 0208 + SYLLABLES[0] ←P.[ 1:7] & PX [40:47:1]; 04006000 T 0209 + SYLLABLES[1] ← P.[8:8]; 04007000 T 0211 + SYLLABLES[2] ← P.[16:8]; 04008000 T 0213 + SYLLABLES[3] ← P.[24:8]; 04009000 T 0215 + SYLLABLES[4] ← P.[32:8]; 04010000 T 0217 + SYLLABLES[5] ← P.[40:8]; 04011000 T 0218 + END; 04012000 T 0220 + PSYLLABLES ← SYLLABLES[PSR]; 04013000 T 0220 + END PSYLLABLES; 04014000 T 0221 + PROCEDURE STEPPSR(N); VALUE N; INTEGER N; 04015000 T 0224 + BEGIN 04016000 T 0224 + LABEL L; 04017000 T 0224 + START OF SEGMENT ********** 23 + INTEGER PICRT; 04018000 T 0000 +STACK(F+2) = PICRT + L: IF (PSR ← PSR + N) ≥ 6 04019000 T 0000 + THEN BEGIN 04020000 T 0001 + PICRT ← PSR DIV 6; 04021000 T 0002 + PICR ← PICR + PICRT; 04022000 T 0003 + PIR ← PIR + PICRT; 04023000 T 0004 + PSR ← PSR MOD 6; 04024000 T 0006 + PROF ← FALSE; 04025000 T 0007 + END; 04026000 T 0008 + IF PSR < 0 04027000 T 0008 + THEN BEGIN 04028000 T 0008 + PSR ← PSR + ABS(N); 04029000 T 0009 + DO PIR ← PIR - 1 UNTIL N ← N + 6 ≥ 0; 04030000 T 0010 + GO L; 04031000 T 0014 + END; 04032000 T 0014 + END STEPPSR; 04033000 T 0014 + 23 IS 17 LONG, NEXT SEG 12 + PROCEDURE SETINTERRUPT(I); VALUE I; INTEGER I; 04034000 T 0224 + BEGIN 04035000 T 0224 + ADJ (0, 0); % TEMPORARY NO FLOWS 04036000 T 0224 + INT ← B ← I; 04037000 T 0226 + BX ← 0; 04038000 T 0227 + BROF ← TRUE; 04039000 T 0228 + AROF ← TRUE; 04040000 T 0228 + END SETINTERRUPT; 04041000 T 0229 + PROCEDURE NOTYETCODED; 04042000 T 0229 +PRT(710) = NOTYETCODED + BEGIN 04043000 T 0229 + FORMAT F (10("X")," OPERATOR NOT YET CODED ",84("X")); 04044000 T 0229 + START OF SEGMENT ********** 24 + START OF SEGMENT ********** 25 +PRT(711) = F + 25 IS 14 LONG, NEXT SEG 24 + WRITETIME; 04045000 T 0000 + HEADING; 04046000 T 0000 + WRITE(LP,F); 04047000 T 0005 + MEMDUMP; 04048000 T 0008 + GO TO EOJ; 04049000 T 0008 + END NOTYETCODED; 04050000 T 0010 + 24 IS 11 LONG, NEXT SEG 12 + PROCEDURE WRITETIME; 04051000 T 0229 + BEGIN 04052000 T 0229 + REAL E,P; 04053000 T 0229 + START OF SEGMENT ********** 26 +STACK(F+2) = E +STACK(F+3) = P + FORMAT TIMES (10("-")," B5500 TIME SINCE START OF RUN: ", 04054000 T 0000 + START OF SEGMENT ********** 27 +PRT(712) = TIMES + "PROCESSOR TIME =",F9.3," SECONDS, ", 04055000 T 0000 + "ELAPSED TIME =",F9.3," SECONDS "8("-")); 04056000 T 0000 + 27 IS 27 LONG, NEXT SEG 26 + E←(TIME(1)-ETIME)/60; P←(TIME(2)-PTIME)/60; 04057000 T 0000 + HEADING; 04058000 T 0004 + WRITE(LP,TIMES,P,E); 04059000 T 0009 +PRT(713) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + END WRITETIME; 04060000 T 0018 + 26 IS 21 LONG, NEXT SEG 12 + PROCEDURE MKST ; % MARK STACK 07000000 T 0229 + BEGIN 07001000 T 0229 + ERVSFLOW (10); 07002000 T 0229 + 07003000 T 0230 + 07004000 T 0230 + 07005000 T 0230 + 07006000 T 0230 + 07007000 T 0230 + 07008000 T 0230 + END MKST; 07009000 T 0230 + PROCEDURE IMKS ; % INSERT MARK STACK * 07010000 T 0231 + BEGIN 07011000 T 0231 + % REVISED PER L. HANSON FLOWS 8/8/68 BY B.M.M. 07012000 T 0231 + ADJ(1,1); 07013000 T 0231 + MOVE(B,C); 07014000 T 0232 + BX ← 2×MSCW; 07015000 T 0233 + B ← S + 1 - F; 07016000 T 0234 + F ← S + 1; 07017000 T 0236 + ADJ(1,0); 07018000 T 0237 + MOVE(C,B); 07019000 T 0238 + BROF←TRUE; 07020000 T 0239 + END IMKS; 07021000 T 0240 + PROCEDURE NAMC ; % NAME CALL 07022000 T 0240 + BEGIN 07023000 T 0240 + ADJ(0,2); 07024000 T 0240 + C ← SYLLABLE & DRS [34:42:6]; 07025000 T 0242 + CX ← 2×IRW; 07026000 T 0245 + AROF:=TRUE; 07027000 T 0247 + MOVE (C, A); 07028000 T 0247 + STEPPSR(1); 07029000 T 0248 + END NAMC; 07030000 T 0249 + PROCEDURE VALC ; % VALUE CALL 07031000 T 0249 + BEGIN 07032000 T 0249 + ERVSFLOW(1); 07033000 T 0249 + END VALC; 07034000 T 0250 + PROCEDURE EVAL ; % EVALUATE DESCRIPTOR 07035000 T 0251 + BEGIN 07036000 T 0251 + ERVSFLOW(2); 07037000 T 0251 + END EVAL; 07038000 T 0251 + PROCEDURE ENTR ; % ENTER 07039000 T 0252 + BEGIN 07040000 T 0252 + ERVSFLOW(3); 07041000 T 0252 + END ENTR; 07042000 T 0252 + PROCEDURE EXIT ; % EXIT 07043000 T 0253 + BEGIN 07044000 T 0253 + ERVSFLOW(4); 07045000 T 0253 + END EXIT; 07046000 T 0253 + PROCEDURE RETN ; % RETURN 07047000 T 0254 + BEGIN 07048000 T 0254 + ERVSFLOW(5); 07049000 T 0254 + END RETN; 07050000 T 0254 + PROCEDURE IRWL ; % (HARDWARE PSEUDO-INSTRUCTION) 07051000 T 0255 + BEGIN 07052000 T 0255 + ERVSFLOW(19); 07053000 T 0255 + END IRWL; 07054000 T 0255 + PROCEDURE PCWL ; % (HARDWARE PSEUDO INSTRUCTION) 07055000 T 0256 + BEGIN 07056000 T 0256 + ERVSFLOW (20); 07057000 T 0256 + END PCWL; 07058000 T 0256 + PROCEDURE BRUN ; % BRANCH UNCONDITIONAL 07059000 T 0257 + BEGIN 07060000 T 0257 + ERVSFLOW(17); 07061000 T 0257 + END BRUN; 07062000 T 0257 + PROCEDURE BRTR ; % BRANCH TRUE 07063000 T 0258 + BEGIN 07064000 T 0258 + ERVSFLOW(15); 07065000 T 0258 + END BRTR; 07066000 T 0258 + PROCEDURE BRFL ; % BRANCH FALSE 07067000 T 0259 + BEGIN 07068000 T 0259 + ERVSFLOW(16); 07069000 T 0259 + END BRFL; 07070000 T 0259 + PROCEDURE PCWORD; % PROGRAM CONTROL WORD 07071000 T 0260 +PRT(714) = PCWORD + BEGIN 07072000 T 0260 + LABEL OC; 07073000 T 0260 + START OF SEGMENT ********** 28 + IF LL ≠ C.LLF 07074000 T 0000 + THEN SETINTERRUPT (INVOP) 07075000 T 0000 + ELSE BEGIN 07076000 T 0002 + PDR ← C.SDIF; 07077000 T 0004 + PSR ← C.PSRF; 07078000 T 0005 + PIR ← C.PIRF; 07079000 T 0006 + MOVE (M[D[C.[34:1]] + C.[35:13]], C); 07080000 T 0007 + MEMCYCLE; 07081000 T 0013 + IF CX.TAG ≠ SEGDESC 07082000 T 0014 + THEN BEGIN 07083000 T 0015 + SETINTERRUPT (INVOP); 07084000 T 0016 + GO OC; 07085000 T 0017 + END 07086000 T 0019 + ELSE IF CX.PBIT ≠ 1 07087000 T 0019 + THEN BEGIN 07088000 T 0020 + SETINTERRUPT (PRESBIT); 07089000 T 0021 + GO OC; 07090000 T 0022 + END 07091000 T 0024 + ELSE BEGIN 07092000 T 0024 + PBR ← C.ADDR; 07093000 T 0024 + PROF ← AROF ← FALSE; 07094000 T 0025 + END; 07095000 T 0027 + END; 07096000 T 0027 + OC: END FETCH OF PROGRAM CONTROL WORD; 07097000 T 0027 + 28 IS 28 LONG, NEXT SEG 12 + PROCEDURE DYNAMICBRANCH; % UTILITY PROCEDURE FOR DYNAMIC BRANCHES 07098000 T 0260 +PRT(715) = DYNAMICBRANCH + BEGIN 07099000 T 0260 + INTEGER TTAG; 07100000 T 0260 + START OF SEGMENT ********** 29 +STACK(F+2) = TTAG + LABEL IRWORD; 07101000 T 0000 + IF (TTAG ← AX.TAG) = SINGL OR TTAG = DOUBL 07102000 T 0000 + THEN BEGIN 07103000 T 0002 + IF A < 0 OR A ≥ 2*21 OR INTEGERIZE(TRUE, A) 07104000 T 0003 + THEN SETINTERRUPT (INVOP) 07105000 T 0008 + ELSE BEGIN 07106000 T 0010 + PSR ← IF BOOLEAN (A)THEN 3 ELSE 0; 07107000 T 0012 + PIR ← A.[27:20]; 07108000 T 0014 + PROF ← AROF ← FALSE; 07109000 T 0015 + END 07110000 T 0016 + END 07111000 T 0016 + ELSE BEGIN 07112100 T 0016 + MOVE (A, C); 07113000 T 0017 + IRWORD: IF TTAG ← CX. TAG = IRW 07114000 T 0018 + THEN BEGIN 07115000 T 0020 + IF C.EBIT = 0 07116000 T 0021 + THEN BEGIN 07117000 T 0022 + MOVE(M[D[LEVEL(C)]+DELTA(C)],C); 07118000 T 0023 + MEMCYCLE; 07119000 T 0028 + GO TO IRWORD; 07120000 T 0030 + END 07121000 T 0030 + ELSE SETINTERRUPT (INVOP); 07122000 T 0030 + END 07123000 T 0031 + ELSE IF TTAG ≠ PCW 07124000 T 0031 + THEN SETINTERRUPT (INVOP) 07125000 T 0034 + ELSE PCWORD; 07126000 T 0035 + END; 07127000 T 0038 + END OF DYNAMIC BRANCH UTILITY ROUTINE; 07128000 T 0038 + 29 IS 41 LONG, NEXT SEG 12 + PROCEDURE DBUN; % DYNAMIC BRANCH UNCONDITIONAL DBUN 07129000 T 0260 + BEGIN 07130000 T 0260 + ERVSFLOW(14); 07131000 T 0260 + END DBUN; 07132000 T 0260 + PROCEDURE DBTR; % DYNAMIC BRANCH ON TRUE DBTR 07133000 T 0261 + BEGIN 07134000 T 0261 + ERVSFLOW(12); 07135000 T 0261 + END DBTR; 07136000 T 0261 + PROCEDURE DBFL; % DYNAMIC BRANCH ON FALSE 07137000 T 0262 + BEGIN 07138000 T 0262 + ERVSFLOW(13); 07139000 T 0262 + END DBFL; 07140000 T 0262 + PROCEDURE NOOP ; % NO OPERATION 07141000 T 0263 + BEGIN 07142000 T 0263 + END NOOP; 07143000 T 0263 + PROCEDURE HALT ; % CONDITIONAL HALT 07144000 T 0263 + BEGIN 07145000 T 0263 + FILE SPO 11(1,10); 07145010 T 0263 + START OF SEGMENT ********** 30 +STACK(F+2) = SPO + FORMAT HALTER("**B6500/SIM: PDR = ",I3,":PIR = ",I4,"←"); 07145020 T 0003 + START OF SEGMENT ********** 31 +PRT(716) = HALTER + 31 IS 12 LONG, NEXT SEG 30 + IF HALTING=0 THEN WRITE(SPO,HALTER,PDR,PIR); 07145030 T 0003 +PRT(717) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + WHILE HALTING=0 DO WHEN(10); 07145040 T 0014 + CASE HALTING MOD 4 OF 07145050 T 0017 + BEGIN 07145060 T 0017 +PRT(720) = *CASE STATEMENT DESCRIPTOR* + ; 07145070 T 0018 + NOTYETCODED; 07145080 T 0018 + MEMDUMP; 07145090 T 0019 + ; 07145100 T 0020 + END; 07146000 T 0020 + START OF SEGMENT ********** 32 + 32 IS 4 LONG, NEXT SEG 30 + END HALT; 07147000 T 0020 + 30 IS 24 LONG, NEXT SEG 12 + PROCEDURE NVLD ; % INVALID OPERATOR 07148000 T 0263 + BEGIN 07149000 T 0263 + SETINTERRUPT(INVOP); 07150000 T 0263 + END NVLD; 07151000 T 0264 + PROCEDURE VARI ; % ESCAPE TO 16-BIT INSTRUCTION 07156000 T 0266 + BEGIN 07157000 T 0266 + ERROR(1); MEMDUMP; GO TO EOJ; 07158000 T 0266 + END VARI; 07159000 T 0269 + PROCEDURE ADD ; % ADD 07160000 T 0269 + BEGIN 07161000 T 0269 + DEFINE FORCESEGMENTATION = #; %>RETRO 07161099 T 0269 + START OF SEGMENT ********** 33 + ADJ(1,1); 07162000 T 0000 + IF NOT CHECOP THEN INTFAMA(-1) ELSE 07163000 T 0001 + IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07164000 T 0008 + BEGIN 07165000 T 0011 + B:= B + A; 07166000 T 0012 + BX.PBIT:= REAL(AROF:=FALSE); 07167000 T 0013 + END ELSE 07168000 T 0015 + BEGIN 07169000 T 0015 + IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07170000 T 0016 + IF BX.TAG=SINGL THEN Y:=YX:= 0; 07171000 T 0019 + DOUBLE(A,X,B,Y,+,←,B,Y); 07172000 T 0022 + BX←DOUBL+DOUBL; 07173000 T 0025 + AROF:=FALSE; 07174000 T 0026 + END; 07175000 T 0027 + END ADD ; 07176000 T 0027 + 33 IS 28 LONG, NEXT SEG 12 + PROCEDURE SUBT ; % SUBTRACT 07177000 T 0269 + BEGIN 07178000 T 0269 + DEFINE FORCESEGMENTATION = #; %>RETRO 07178099 T 0269 + START OF SEGMENT ********** 34 + ADJ(1,1); 07179000 T 0000 + IF NOT CHECOP THEN INTFAMA(-1) ELSE 07180000 T 0001 + IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07181000 T 0008 + BEGIN 07182000 T 0011 + B:= B - A; 07183000 T 0012 + BX.PBIT:= REAL(AROF:=FALSE); 07184000 T 0013 + END ELSE 07185000 T 0015 + BEGIN 07186000 T 0015 + IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07187000 T 0016 + IF BX.TAG=SINGL THEN Y:=YX:= 0; 07188000 T 0019 + DOUBLE(B,Y,A,X,-,←,B,Y); 07189000 T 0022 + BX←DOUBL+DOUBL; 07190000 T 0025 + AROF:=FALSE; 07191000 T 0026 + END; 07192000 T 0027 + END SUBT; 07193000 T 0027 + 34 IS 28 LONG, NEXT SEG 12 + PROCEDURE MULT ; % MULTIPLY 07194000 T 0269 + BEGIN 07195000 T 0269 + DEFINE FORCESEGMENTATION = #; %>RETRO 07195099 T 0269 + START OF SEGMENT ********** 35 + ADJ(1,1); 07196000 T 0000 + IF NOT CHECOP THEN INTFAMA(-1) ELSE 07197000 T 0001 + IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07198000 T 0008 + BEGIN 07199000 T 0011 + B:= B × A; 07200000 T 0012 + BX.PBIT:= REAL(AROF:=FALSE); 07201000 T 0013 + END ELSE 07202000 T 0015 + BEGIN 07203000 T 0015 + IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07204000 T 0016 + IF BX.TAG=SINGL THEN Y:=YX:= 0; 07205000 T 0019 + DOUBLE(A,X,B,Y,×,←,B,Y); 07206000 T 0022 + BX:=YX:=DOUBL+DOUBL; 07207000 T 0025 + AROF:=FALSE; 07208000 T 0026 + END; 07209000 T 0027 + END MULT; 07210000 T 0027 + 35 IS 28 LONG, NEXT SEG 12 + PROCEDURE MULX ; % EXTENDED MULTIPLY 07211000 T 0269 + BEGIN 07212000 T 0269 + NOTYETCODED; 07213000 T 0269 + END MULX; 07214000 T 0270 + PROCEDURE DIVD ; % DIVIDE 07215000 T 0270 + BEGIN 07216000 T 0270 + LABEL OC; 07217000 T 0270 + START OF SEGMENT ********** 36 + ADJ(1,1); 07218000 T 0000 + IF NOT CHECOP THEN INTFAMA(-1) ELSE 07219000 T 0001 + IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07220000 T 0008 + IF A=0 THEN BEGIN INTFAMA( DIVZROI); GO OC END ELSE 07221000 T 0011 + BEGIN 07222000 T 0016 + B:= B/A; 07223000 T 0016 + BX.PBIT:= REAL(AROF:=FALSE); 07224000 T 0017 + END ELSE 07225000 T 0020 + BEGIN 07226000 T 0020 + IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07227000 T 0020 + IF BX.TAG=SINGL THEN Y:=YX:=0; 07228000 T 0023 + IF A=0 AND X=0 THEN BEGIN INTFAMA(DIVZROI); 07229000 T 0027 + GO TO OC; 07230000 T 0030 + END; 07231000 T 0032 + DOUBLE(B,Y,A,X,/,←,B,Y); 07232000 T 0032 + BX←DOUBL+DOUBL; 07233000 T 0034 + AROF:=FALSE; 07234000 T 0035 + END; 07235000 T 0036 + OC: 07236000 T 0036 + END DIVD; 07237000 T 0037 + 36 IS 38 LONG, NEXT SEG 12 + PROCEDURE IDIV ; % INTEGER DIVIDE 07238000 T 0270 + BEGIN 07239000 T 0270 + DIVD; 07240000 T 0270 + IF INT =0 07241000 T 0271 + THEN IF INTEGERIZE(FALSE,B) THEN INTFAMA(INTOVFI); 07242000 T 0271 + END IDIV; 07243000 T 0275 + PROCEDURE RDIV ; % REMAINDER DIVIDE 07244000 T 0277 + BEGIN 07245000 T 0277 + LABEL OC; 07246000 T 0277 + START OF SEGMENT ********** 37 + INTEGER SIGNQ, SIGNQH; 07247000 T 0000 +STACK(F+2) = SIGNQ +STACK(F+3) = SIGNQH + REAL TA, TX, TB, TY; 07248000 T 0000 +STACK(F+4) = TA +STACK(F+5) = TX +STACK(F+6) = TB +STACK(F+7) = TY + ADJ (1, 1); 07249000 T 0000 + TA←A; TX←IF AX.TAG≠SINGL THEN X ELSE 0; 07250000 T 0001 + TB←B; TY←IF BX.TAG≠SINGL THEN Y ELSE 0; 07251000 T 0005 + DIVD; 07252000 T 0009 + IF INT ≠0 THEN GO TO OC; 07253000 T 0009 + SIGNQ ← SIGN(B); 07254000 T 0010 + B.SOBIT ← 0; 07255000 T 0013 + IF INTEGERIZE (FALSE, B) THEN BEGIN ERROR(100); GO OC END; 07256000 T 0015 + Y ← 0; 07257000 T 0017 + DOUBLE (TB, TY, TA, TX, SIGNQ, SIGNQH, B, Y, ×,×, -, ←, B, Y); 07258000 T 0018 + IF INTEGERIZE(FALSE,B) THEN INTFAMA(INTOVFI); 07259000 T 0022 + OC: 07260000 T 0024 + END RDIV; 07261000 T 0025 + 37 IS 30 LONG, NEXT SEG 12 + PROCEDURE NTIA ; % INTEGER TRUNCATED 07262000 T 0277 + BEGIN 07263000 T 0277 + INTEGER EB; % EXPONENT IN B AT ENTRY,IN CODE USED 07264000 T 0277 + START OF SEGMENT ********** 38 +STACK(F+2) = EB + % AS 8-BASED EXPONENT,IN COMMENTS,FOR 07265000 T 0000 + % CONVENIENCE,REFERENCED AS 2-BASED 07266000 T 0000 + DEFINE I1INVALIDOPERATOR = BEGIN 07269000 T 0000 + INTFAMA(-1); 07270000 T 0000 + GO TO OC END#, 07271000 T 0000 + I2INTEGEROVERFLOW = BEGIN 07272000 T 0000 + INTFAMA(INTOVFI); 07273000 T 0000 + GO TO OC END#; 07274000 T 0000 + % INTERRUPT PROCESSING TO BE DEFINED 07275000 T 0000 + LABEL L1,NEGEXPLBL,OC; 07276000 T 0000 + INTEGER T1,T2; % WORKING LOCAL INTEGERS 07277000 T 0000 +STACK(F+3) = T1 +STACK(F+4) = T2 + ADJ(0,1); 07278000 T 0000 + IF BX.TAG ≠SINGL AND BX.TAG ≠ DOUBL THEN I1INVALIDOPERATOR; 07279000 T 0001 + IF(EB←B.EXPF)=0 THEN GO TO L1; 07280000 T 0005 + IF BX.TAG = SINGL THEN Y ← 0; 07281000 T 0008 + IF B.SEBIT=1 THEN GO TO NEGEXPLBL; 07282000 T 0010 + IF (T1←B.MANF)>8*(13-EB)-1 THEN I2INTEGEROVERFLOW; % IF EB< NB 07283000 T 0012 +PRT(721) = LN +PRT(722) = EXP +PRT(723) = X TO THE I + T1 ← T1×8*EB; % T1.[36:39-EB] ← B.[38-EB:39-EB] 07284000 T 0020 + B.MANF←T1+(T2←Y.MANF) DIV (8*(13-EB));%B←B.[38-EB:39-EB] 07285000 T 0023 + %+Y.[38-EB] 07286000 T 0029 + B.SEXPF ← 0; 07287000 T 0029 + GO TO L1; 07288000 T 0031 + NEGEXPLBL: 07289000 T 0031 + B.MANF←(T1←B.MANF) DIV (8*EB);%B.[38-EB:39-EB]←B.[38:39-EB] 07290000 T 0032 + % B.[38-EB] ← 0 IMPLIED 07291000 T 0037 + B.SEXPF ← 0; 07292000 T 0037 + L1: BX.TAG ← SINGL; 07293000 T 0039 + OC: 07294000 T 0040 + END NTIA; 07295000 T 0041 + 38 IS 44 LONG, NEXT SEG 12 + PROCEDURE NTGR; % INTEGERISE ROUNDED 07296000 T 0277 + BEGIN 07297000 T 0277 + INTEGER EB; % EXPONENT IN B AT ENTRY,IN CODE USED 07298000 T 0277 + START OF SEGMENT ********** 39 +STACK(F+2) = EB + % AS 8-BASED EXPONENT,IN COMMENTS,FOR 07299000 T 0000 + % CONVENIENCE,REFERENCED AS 2-BASED 07300000 T 0000 + DEFINE I1INVALIDOPERATOR = BEGIN 07303000 T 0000 + INTFAMA(-1); 07304000 T 0000 + GO TO OC END#, 07305000 T 0000 + I2INTEGEROVERFLOW = BEGIN 07306000 T 0000 + INTFAMA(INTOVFI); 07307000 T 0000 + GO TO OC END#; 07308000 T 0000 + % INTERRUPT PROCESSING TO BE DEFINED 07309000 T 0000 + LABEL L1,NEGEXPLBL,L2,L3,L4,OC; 07310000 T 0000 + INTEGER T1,T2; % WORKING LOCAL INTEGERS 07311000 T 0000 +STACK(F+3) = T1 +STACK(F+4) = T2 + ADJ(0,1); 07312000 T 0000 + IF BX.TAG ≠ SINGL AND BX.TAG ≠ DOUBL THEN I1INVALIDOPERATOR; 07313000 T 0001 + IF BX.TAG = SINGL THEN Y ← 0; 07314000 T 0005 + IF (EB←B.EXPF) = 0 THEN GO TO L1; 07315000 T 0008 + IF B.SEBIT =1 THEN GO TO NEGEXPLBL; 07316000 T 0010 + IF (T1 ← B.MANF) > 8*(13-EB)-1 THEN I2INTEGEROVERFLOW; % EB≤NB 07317000 T 0012 + T1 ← T1×8*EB; % T1← B.[38-EB:39-EB] 07318000 T 0020 + B.MANF←T1+(T2←Y.MANF) DIV (8*(13-EB));%B←B.[38-EB:39-EB] 07319000 T 0023 + %+Y.[38:EB] 07320000 T 0029 + Y ← (T1 ← Y.MANF)× 8*EB; % Y.[38:39-EB] ← Y.[38-EB:39-EB] 07321000 T 0029 + % Y.[EB:EB] ← 0 IMPLIED 07322000 T 0033 + B.SEXPF ← 0; 07323000 T 0033 + IF BX.TAG=SINGL THEN GO TO L4; 07324000 T 0035 + L1: IF B.SOBIT = 0 THEN GO TO L3; 07325000 T 0037 + IF Y.MANF ≤ 274877906944 THEN GO TO L4; % IF FRACTION ≤ 0.5 07326000 T 0039 + L2: IF B.MANF = 549755813887 THEN I2INTEGEROVERFLOW; % IF B=2*39-1 07327000 T 0041 + B.MANF ← B.MANF+1; 07328000 T 0048 + GO TO L4; 07329000 T 0050 + L3: IF Y.MANF ≥ 274877906944 THEN GO TO L2 ELSE GO TO L4; 07330000 T 0051 + % LAST STATEMENT EQUIVALENT TO IF FRACTION ≥ 0.5.... 07331000 T 0054 + NEGEXPLBL: 07332000 T 0054 + B.MANF←(T1←B.MANF) DIV (8*EB);%B.[38-EB:39-EB]←B.[38:39-EB] 07333000 T 0055 + % B.[38:EB] ← 0 IMPLIED 07334000 T 0060 + Y←T1×8*(13-EB); % Y.[38:EB] ← B.[EB:EB] 07335000 T 0060 + B.SEXPF ← 0; 07336000 T 0064 + GO TO L1; 07337000 T 0065 + L4: BX.TAG ← SINGL; 07338000 T 0068 + OC: 07339000 T 0069 + END NTGR; 07340000 T 0070 + 39 IS 73 LONG, NEXT SEG 12 + PROCEDURE NTGD; % DOUBLE PRECISION INTEGERIZE 07340010 T 0277 +PRT(724) = NTGD + BEGIN 07340020 T 0277 + INTEGER XA, XB, KT, LZCT; 07340060 T 0277 + START OF SEGMENT ********** 40 +STACK(F+2) = XA +STACK(F+3) = XB +STACK(F+4) = KT +STACK(F+5) = LZCT + LABEL OC, L1, L2, L10; 07340070 T 0000 + ADJ (0,1); 07340080 T 0000 + CHECOPRNDB END; IF SDIS = 1 THEN GO TO OC; 07340090 T 0001 + BX.TAG ← DOUBL; 07340100 T 0007 + A.SEXPF ← 013; 07340110 T 0008 + IF B.MANF = 0 AND Y.MANF = 0 THEN GO TO L10; 07340120 T 0010 + XA ← XA & XX[33:47:1] & X[34:1:8] & A[42:3:6]; 07340130 T 0014 + XB ← XB & YX[33:47:1] & Y[34:1:8] & A[42:3:6]; 07340140 T 0017 + IF XA = XB THEN GO TO OC; 07340150 T 0021 + IF XA > XB THEN 07340160 T 0022 + BEGIN 07340170 T 0023 + IF B.SEXPF ≠ 1 THEN 07340180 T 0024 + BEGIN 07340190 T 0025 + FOR KT ← XA - XB STEP -1 UNTIL 0 DO 07340200 T 0025 + BEGIN 07340210 T 0030 + X.[12:36] ← X.[9:36]; 07340220 T 0030 + X.[9:3] ← Y.[45:3]; 07340230 T 0032 + Y.[12:36] ← Y.[9:36]; 07340240 T 0034 + Y.[9:3] ← B.[45:3]; 07340250 T 0036 + B.[12:36] ← B.[9:36]; 07340260 T 0039 + B.[9:3] ← 0; 07340270 T 0041 + END; 07340280 T 0043 + L1: IF X.[9:3] > 4 THEN 07340290 T 0045 + BEGIN 07340300 T 0046 + AX ← A ← 0; XX ← X ← 0; 07340310 T 0046 + X ← 1; AX.TAG ← DOUBL; 07340320 T 0049 + AROF ← TRUE; 07340330 T 0051 + ADD; 07340340 T 0052 + END; 07340350 T 0053 + GO TO L10; 07340360 T 0053 + END; 07340370 T 0053 + IF B.MANF ≠ 0 THEN 07340380 T 0053 + BEGIN 07340390 T 0054 + Y.[9:39] ← B.[9:39]; 07340400 T 0055 + B.[9:39] ← 0; 07340410 T 0057 + XB ← XB - XA; 07340420 T 0059 + IF XB < XA THEN 07340430 T 0060 + BEGIN 07340440 T 0061 + FOR KT ← XA - XB STEP -1 UNTIL 0 DO 07340450 T 0061 + BEGIN 07340460 T 0066 + X.[9:3] ← Y.[45:3]; 07340470 T 0066 + Y.[12:36] ← Y.[9:36]; 07340480 T 0068 + Y.[9:3] ← 0; 07340490 T 0070 + END; 07340500 T 0072 + GO TO L1; 07340510 T 0072 + END; 07340520 T 0073 + END; 07340530 T 0073 + Y.[9:39] ← 0; 07340540 T 0073 + GO TO L10; 07340550 T 0075 + END; 07340560 T 0075 + XB ← XB - 13; 07340570 T 0075 + IF XA < XB THEN 07340580 T 0076 + BEGIN 07340590 T 0077 + IF B.MANF ≠ 0 THEN BEGIN 07340600 T 0078 + SETINTERRUPT (INTOVFI); 07340601 T 0079 + GO TO OC; END; 07340602 T 0080 + B.[9:39] ← Y.[9:39]; 07340610 T 0082 + Y.[9:39] ← 0; 07340620 T 0084 + XB ← XB - 13; 07340630 T 0086 + IF XB > XA THEN BEGIN SETINTERRUPT (INTOVFI); 07340640 T 0087 + GO TO OC; 07340641 T 0089 + END; 07340642 T 0091 + END; 07340650 T 0091 + MOVE (B, JUNK); 07340660 T 0091 + LZCT ← 0; 07340670 T 0092 + L2: IF JUNK.[9:3] = 0 THEN 07340680 T 0092 + BEGIN 07340690 T 0094 + LZCT ← LZCT + 1; 07340700 T 0094 + JUNK.[9:36] ← JUNK.[12:36]; 07340710 T 0096 + GO TO L2; 07340720 T 0098 + END; 07340730 T 0098 + IF LZCT < XB THEN BEGIN SETINTERRUPT (INTOVFI); 07340740 T 0098 + GO TO OC; 07340741 T 0100 + END; 07340742 T 0103 + FOR KT ← XB STEP -1 UNTIL 0 DO 07340750 T 0103 + BEGIN 07340760 T 0104 + B.[9:36] ← B.[12:36]; 07340770 T 0104 + B.[45:3] ← Y.[9:3]; 07340780 T 0106 + Y.[9:36] ← Y.[12:36]; 07340790 T 0108 + Y.[45:3] ← 0; 07340800 T 0110 + END; 07340810 T 0112 + B.SEXPF ← A.SEXPF; 07340820 T 0114 + GO TO OC; 07340830 T 0117 + L10: 07340840 T 0117 + Y.EXPEXT ← 0; 07340850 T 0118 + B.SEXPF ← A.SEXPF; 07340860 T 0119 + OC: 07340870 T 0122 + END OF DOUBLE PRECISION INTEGERIZE; 07340880 T 0122 + 40 IS 125 LONG, NEXT SEG 12 + PROCEDURE SNGT ; % SET TO SINGLE PRECISION, TRUNCATED 07341000 T 0277 + BEGIN 07342000 T 0277 + ADJ(0,1); 07343000 T 0277 + CHECOPRNDB END; 07344000 T 0278 + BX.TAG←Y←YX←0 07345000 T 0282 + END SNGT; 07346000 T 0282 + PROCEDURE SNGL ; % SET TO SINGLE PRECISION; ROUNDED 07347000 T 0287 + BEGIN 07348000 T 0287 + ADJ(0,1); 07349000 T 0287 + CHECOPRNDB END 07350000 T 0288 + ELSE IF BX.TAG=DOUBL THEN 07351000 T 0292 + BEGIN IF X.[9:1]=1 THEN A← (A+1)&A[1:1:8]; 07352000 T 0295 + AX.TAG ← X ← XX ←0; 07353000 T 0299 + BX.TAG←Y←YX←0; 07354000 T 0302 + END; 07355000 T 0305 + END SNGL; 07356000 T 0305 + PROCEDURE XTND ; % SET TO DOUBLE PRECISION 07357000 T 0305 + BEGIN 07358000 T 0305 + ADJ(0,1); 07359000 T 0305 + CHECOPRNDB END 07360000 T 0307 + ELSE IF BX.TAG=SINGL THEN 07361000 T 0311 + BEGIN BX.TAG←DOUBL; 07362000 T 0314 + Y←YX←0; 07363000 T 0316 + END; 07364000 T 0317 + END XTND; 07365000 T 0317 + PROCEDURE JOIN; % MAKE TWO SINGLES INTO A DOUBLE PRECISION OPERAND 07366000 T 0318 + BEGIN 07367000 T 0318 + ADJ (1,1); 07368000 T 0318 + IF NOT CHECOP THEN SETINTERRUPT (INVOP) ELSE 07368200 T 0319 + BEGIN 07368300 T 0326 + Y ← A; 07368400 T 0328 + BX.TAG ← DOUBL; 07368500 T 0328 + AROF ← FALSE 07368600 T 0330 + END; 07368700 T 0330 + END JOIN; 07369000 T 0331 + PROCEDURE SPLT; % MAKE A DOUBLE PRECISION INTO TWO SINGLE OPERANDS 07370000 T 0331 + BEGIN 07371000 T 0331 + ADJ (0,1); 07371100 T 0331 + CHECOPRNDB END 07371200 T 0333 + ELSE IF BX.TAG = DOUBL THEN A ← Y 07371300 T 0337 + ELSE A ← 0; 07372000 T 0340 + AX.TAG ← SINGL; 07372050 T 0342 + BX.TAG ← SINGL; 07372100 T 0344 + AROF ← TRUE; 07372200 T 0346 + END SPLT; 07373000 T 0347 + PROCEDURE LAND ; % LOGICAL AND 07374000 T 0347 + BEGIN 07375000 T 0347 + ADJ(1,1); 07376000 T 0347 + B:=REAL(BOOLEAN(A)AND BOOLEAN(B)); 07377000 T 0349 + BX ← REAL(BOOLEAN(AX) AND BOOLEAN(BX)); 07378000 T 0350 + IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07379000 T 0351 + BEGIN 07380000 T 0354 + IF AX.TAG≠DOUBL THEN X:=XX:=0; 07381000 T 0354 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07382000 T 0357 + Y:=REAL(BOOLEAN(Y)AND BOOLEAN(X)); 07383000 T 0360 + YX.PBIT:=REAL(BOOLEAN(YX.PBIT)AND BOOLEAN(XX.PBIT)); 07384000 T 0362 + BX.TAG←DOUBL; 07385000 T 0365 + END; 07386000 T 0367 + AROF:=FALSE; 07387000 T 0367 + END LAND; 07388000 T 0367 + PROCEDURE LOR ; % LOGICAL OR 07389000 T 0368 + BEGIN 07390000 T 0368 + ADJ(1,1); 07391000 T 0368 + B:=REAL(BOOLEAN(A) OR BOOLEAN(B)); 07392000 T 0369 + BX ← REAL(BOOLEAN(AX) OR BOOLEAN(BX)); 07393000 T 0370 + IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07394000 T 0371 + BEGIN 07395000 T 0374 + IF AX.TAG≠DOUBL THEN X:=XX:=0; 07396000 T 0374 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07397000 T 0377 + Y:=REAL(BOOLEAN(Y) OR BOOLEAN(X)); 07398000 T 0380 + YX.PBIT:=REAL(BOOLEAN(YX.PBIT) OR BOOLEAN(XX.PBIT)); 07399000 T 0382 + BX.TAG←DOUBL; 07400000 T 0385 + END; 07401000 T 0387 + AROF:=FALSE; 07402000 T 0387 + END LOR ; 07403000 T 0387 + PROCEDURE LNOT ; % LOGICAL NEGATE 07404000 T 0388 + BEGIN 07405000 T 0388 + ADJ(1,2); 07406000 T 0388 + A:=REAL(NOT BOOLEAN(A)); 07407000 T 0389 + AX ← REAL(NOT BOOLEAN(AX)); 07408000 T 0390 + IF AX.TAG=DOUBL THEN 07409000 T 0391 + BEGIN 07410000 T 0392 + X:=REAL(NOT BOOLEAN(X)); 07411000 T 0392 + XX.PBIT:=REAL(NOT BOOLEAN(XX.PBIT)); 07412000 T 0393 + END; 07413000 T 0396 + END LNOT; 07414000 T 0396 + PROCEDURE SAME ; % LOGICAL EQUAL 07415000 T 0396 + BEGIN 07416000 T 0396 + REAL PROCEDURE EQUAL(A,B,C,D);VALUE A,B,C,D; REAL A,B,C,D; 07417000 T 0396 + START OF SEGMENT ********** 41 +PRT(725) = EQUAL + EQUAL← REAL(REAL(BOOLEAN(A)EQV BOOLEAN(B)) = REAL(NOT FALSE) 07418000 T 0000 + AND C=D); 07419000 T 0001 + ADJ(1,1); 07420000 T 0005 + IF AX.TAG≠BX.TAG THEN B:=0 ELSE 07421000 T 0007 + BEGIN 07422000 T 0010 + B:=EQUAL(A,B,AX.PBIT,BX.PBIT); 07423000 T 0010 + IF AX.TAG=DOUBL THEN 07424000 T 0013 + B:=REAL(BOOLEAN(B)AND BOOLEAN(EQUAL(X,Y, 07425000 T 0014 + XX.PBIT,YX.PBIT))); 07426000 T 0016 + END; 07427000 T 0018 + AROF:=FALSE; 07428000 T 0018 + BX.[44:4]:=0; 07429000 T 0019 + END SAME; 07430000 T 0021 + 41 IS 22 LONG, NEXT SEG 12 + PROCEDURE LEQV ; % LOGICAL EQUIVALENCE 07431000 T 0396 + BEGIN 07432000 T 0396 + ADJ(1,1); 07433000 T 0396 + B:=REAL(BOOLEAN(A)EQV BOOLEAN(B)); 07434000 T 0398 + BX ← REAL(BOOLEAN(AX) EQV BOOLEAN(BX)); 07435000 T 0399 + IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07436000 T 0400 + BEGIN 07437000 T 0403 + IF AX.TAG≠DOUBL THEN X:=XX:=0; 07438000 T 0403 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07439000 T 0406 + Y:=REAL(BOOLEAN(Y)EQV BOOLEAN(X)); 07440000 T 0409 + YX.PBIT:=REAL(BOOLEAN(YX.PBIT)EQV BOOLEAN(XX.PBIT)); 07441000 T 0411 + BX.TAG←DOUBL; 07442000 T 0414 + END; 07443000 T 0416 + AROF:=FALSE; 07444000 T 0416 + END LEQV; 07445000 T 0416 + DEFINE NOTOPERAND= IF NOT CHECOP THEN BEGIN SETINTERRUPT(INVOP); 07446000 T 0417 + GO TO OC; END#; 07447000 T 0417 + PROCEDURE GRTR ; % GREATER THAN 07448000 T 0417 + BEGIN 07449000 T 0417 + LABEL OC; 07450000 T 0417 + START OF SEGMENT ********** 42 + ADJ(1,1); 07451000 T 0000 + NOTOPERAND; 07452000 T 0001 + C:=B; 07453000 T 0010 + B:=REAL(B>A); 07454000 T 0010 + IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07455000 T 0012 + BEGIN 07456000 T 0015 + IF AX.TAG≠DOUBL THEN X:=XX:=0 ELSE 07457000 T 0016 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07458000 T 0019 + B:= REAL(Y>X); 07459000 T 0022 + END; 07460000 T 0024 + BX.[44:4 ]:= REAL(AROF:=FALSE); 07461000 T 0024 + OC: 07462000 T 0026 + END GRTR; 07463000 T 0027 + 42 IS 28 LONG, NEXT SEG 12 + PROCEDURE GREQ ; % GREATER THAN OR EQUAL 07464000 T 0417 + BEGIN 07465000 T 0417 + LABEL OC; 07466000 T 0417 + START OF SEGMENT ********** 43 + ADJ(1,1); 07467000 T 0000 + NOTOPERAND; 07468000 T 0001 + C:=B; 07469000 T 0010 + B:=REAL(B≥A); 07470000 T 0010 + IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07471000 T 0012 + BEGIN 07472000 T 0015 + IF AX.TAG≠DOUBL THEN X:=XX:=0 ELSE 07473000 T 0016 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07474000 T 0019 + B:=REAL(Y≥X); 07475000 T 0022 + END; 07476000 T 0024 + BX.[44:4 ]:= REAL(AROF:=FALSE); 07477000 T 0024 + OC: 07478000 T 0026 + END GREQ; 07479000 T 0027 + 43 IS 28 LONG, NEXT SEG 12 + PROCEDURE EQUL ; % EQUAL 07480000 T 0417 + BEGIN 07481000 T 0417 + LABEL OC; 07482000 T 0417 + START OF SEGMENT ********** 44 + ADJ(1,1); 07483000 T 0000 + NOTOPERAND; 07484000 T 0001 + B:=REAL(B=A); 07485000 T 0010 + IF(AX.TAG=DOUBL OR BX.TAG=DOUBL) AND BOOLEAN(B) THEN 07486000 T 0011 + BEGIN 07487000 T 0014 + IF AX.TAG≠DOUBL THEN X:=XX:=0 ELSE 07488000 T 0015 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07489000 T 0018 + B:=REAL(Y=X); 07490000 T 0021 + END; 07491000 T 0022 + BX.[44:4 ]:= REAL(AROF:=FALSE); 07492000 T 0022 + OC: 07493000 T 0025 + END EQUL; 07494000 T 0025 + 44 IS 26 LONG, NEXT SEG 12 + PROCEDURE LSEQ ; % LESS THAN OR EQUAL 07495000 T 0417 + BEGIN 07496000 T 0417 + LABEL OC; 07497000 T 0417 + START OF SEGMENT ********** 45 + ADJ(1,1); 07498000 T 0000 + NOTOPERAND; 07499000 T 0001 + C:=B; 07500000 T 0010 + B:=REAL(B≤A); 07501000 T 0010 + IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07502000 T 0012 + BEGIN 07503000 T 0015 + IF AX.TAG≠DOUBL THEN X:=XX:=0 ELSE 07504000 T 0016 + IF BX.TAG≠DOUBL THEN Y:=YX:=0; 07505000 T 0019 + B:=REAL(Y≤X); 07506000 T 0022 + END; 07507000 T 0024 + BX.[44:4 ]:= REAL(AROF:=FALSE); 07508000 T 0024 + OC: 07509000 T 0026 + END LSEQ; 07510000 T 0027 + 45 IS 28 LONG, NEXT SEG 12 + PROCEDURE LESS ; % LESS THAN 07511000 T 0417 + BEGIN 07512000 T 0417 + LABEL OC; 07513000 T 0417 + START OF SEGMENT ********** 46 + ADJ(1,1); 07514000 T 0000 + NOTOPERAND; 07515000 T 0001 + C:=B; 07516000 T 0010 + B:=REAL(B MEMMODS %LOAD 07594100 T 0072 + THEN BEGIN 07594200 T 0073 + SETINTERRUPT (INVADRI); 07594300 T 0074 + GO OC 07594400 T 0075 + END; 07594500 T 0075 + MOVE(M[MM],A); MEMCYCLE; 07595000 T 0077 + CASE AX.TAG OF 07596000 T 0082 + BEGIN 07597000 T 0083 +PRT(727) = *CASE STATEMENT DESCRIPTOR* + ; % SINGLE PRECISION OPERAND 07598000 T 0083 + ; % IRW 07599000 T 0083 + BEGIN MOVE (M[MM+1], X); MEMCYCLE END; % DOUBLE PRECISION 07600000 T 0083 + INVALIDOPERATORINTERRUPT; % TAG=3 S.D MSCW RCW 07601000 T 0089 + ; %UNASSIGNED 07602000 T 0092 + % D A T A D E S C R I P T O R 07603000 T 0092 + BEGIN 07603100 T 0092 + IF (AX.PBIT=0 AND A.CBIT=0) THEN 07604000 T 0092 + A.ADDR ← MM; A.CBIT ← 1 END; 07605000 T 0095 + ; %UNINITIALIZED OPERAND 07606000 T 0099 + INVALIDOPERATORINTERRUPT; % PROGRAM CONTROL WORD 07607000 T 0099 + END; 07608000 T 0102 + START OF SEGMENT ********** 50 + 50 IS 8 LONG, NEXT SEG 48 + OC: 07609000 T 0102 + END LOAD; 07610000 T 0103 + 48 IS 104 LONG, NEXT SEG 12 + PROCEDURE LODT ; % LOAD TRANSPARENT 07611000 T 0421 + BEGIN 07612000 T 0421 + LABEL OC; 07613000 T 0421 + START OF SEGMENT ********** 51 + ADJ(1,2); 07614000 T 0000 + MOVE(A,C); MM← C.ADDR; 07615000 T 0001 + CASE CX.TAG OF 07616000 T 0003 + BEGIN 07617000 T 0004 +PRT(730) = *CASE STATEMENT DESCRIPTOR* + ; % SINGLE PRECISION OPERAND 07618000 T 0004 + IF NOT BOOLEAN(C.EBIT) THEN % NORMAL IRW 07619000 T 0004 + MM← D[LEVEL(C)] + DELTA(C) 07620000 T 0005 + ELSE BEGIN % STUFFED IRW 07621000 T 0007 + IF SNR=C.STKNR THEN TEMP← BOSR 07622000 T 0009 + ELSE BEGIN 07623000 T 0010 + MOVE(M[D0+2],C); MEMCYCLE; 07624000 T 0012 + IF NOT BOOLEAN(CX.PBIT) THEN 07625000 T 0018 + PRESENCEBITINTERRUPT; 07626000 T 0019 + IF C.LENGTH < A.STKNR THEN 07627000 T 0022 + INVALIDINDEXINTERRUPT; 07628000 T 0023 + MOVE(M[C.ADDR+A.STKNR],C); MEMCYCLE; 07629000 T 0027 + IF NOT BOOLEAN(CX.PBIT) THEN 07630000 T 0033 + PRESENCEBITINTERRUPT; 07631000 T 0034 + TEMP← C.ADDR; 07632000 T 0038 + END; 07633000 T 0039 + MM← A.DISP + A.[35:13] + TEMP; 07634000 T 0039 + END; 07635000 T 0042 + ; % DOUBLE PRESESION OPERAND 07636000 T 0042 + ; % TAG = 3 S.D. MSCW RCW 07637000 T 0042 + ; % UNASSIGNED 07638000 T 0042 + % D A T A D E S C R I P T O R 07639000 T 0042 + IF NOT BOOLEAN(CX.PBIT) THEN PRESENCEBITINTERRUPT 07640000 T 0042 + ELSE IF BOOLEAN(C.IBIT) THEN MM← C.ADDR + C.LENGTH; 07641000 T 0047 + ; % UNINITIALIZED OPERAND 07642000 T 0051 + ; % PROGRAM CONTROL WORD 07643000 T 0051 + END; 07644000 T 0051 + START OF SEGMENT ********** 52 + 52 IS 8 LONG, NEXT SEG 51 + IF MM + MM > MEMMODS THEN SETINTERRUPT (INVADRI) ELSE % LODT 07644900 T 0051 + MOVE(M[MM],A); MEMCYCLE; 07645000 T 0054 + OC: 07646000 T 0061 + END LODT; 07647000 T 0062 + 51 IS 63 LONG, NEXT SEG 12 + PROCEDURE EXCH ; % EXCHANGE 07648000 T 0421 + BEGIN 07649000 T 0421 + REAL T1,T2; 07650000 T 0421 + START OF SEGMENT ********** 53 +STACK(F+2) = T1 +STACK(F+3) = T2 + ADJ(1,1); 07651000 T 0000 + MOVE(A,T1); 07652000 T 0001 + MOVE(B,A); 07653000 T 0002 + MOVE(T1,B); 07654000 T 0003 + MOVE(X,T1); 07655000 T 0004 + MOVE(Y,X); 07656000 T 0005 + MOVE(T1,Y); 07657000 T 0006 + END EXCH; 07658000 T 0007 + 53 IS 10 LONG, NEXT SEG 12 + PROCEDURE RSDN ; % ROTATE STACK DOWN 07659000 T 0421 + BEGIN 07660000 T 0421 + ADJ(1,1); 07661000 T 0421 + MOVE(B,C); 07662000 T 0422 + MOVE(Y,AA); 07663000 T 0423 + BROF:=FALSE; 07664000 T 0424 + ADJ(1,1); 07665000 T 0424 + EXCH; 07666000 T 0425 + ADJ(1,0); 07667000 T 0426 + MOVE(C,B); 07668000 T 0427 + BROF←TRUE; 07669000 T 0428 + MOVE(C,B); 07670000 T 0429 + MOVE(AA,Y); 07671000 T 0430 + EXCH; 07672000 T 0431 + AROF←TRUE; 07673000 T 0431 + END RSDN; 07674000 T 0432 + PROCEDURE RSUP ; % ROTATE STACK UP 07675000 T 0432 + BEGIN 07676000 T 0432 + ADJ(1,1); 07677000 T 0432 + MOVE(A,C); 07678000 T 0434 + MOVE(X,AA); 07679000 T 0435 + AROF:=FALSE; 07680000 T 0436 + ADJ(1,1); 07681000 T 0436 + EXCH; 07682000 T 0437 + ADJ(1,0); 07683000 T 0438 + MOVE(C,B); 07684000 T 0439 + MOVE(AA,Y); 07685000 T 0440 + BROF:=TRUE; 07686000 T 0441 + END RSUP; 07687000 T 0442 + PROCEDURE DUPL ; % DUPLICATE TOP OF STACK 07688000 T 0442 + BEGIN 07689000 T 0442 + ADJ(0,1); 07690000 T 0442 + MOVE(B,A); 07691000 T 0444 + MOVE(Y,X); 07692000 T 0445 + AROF:=TRUE; 07693000 T 0446 + END DUPL; 07694000 T 0446 + PROCEDURE DLET ; % DELETE TOP OF STACK 07695000 T 0447 + BEGIN 07696000 T 0447 + ADJ(1,2); 07697000 T 0447 + AROF:=FALSE; 07698000 T 0448 + END DLET; 07699000 T 0448 + PROCEDURE MVST ; % MOVE STACK 07700000 T 0449 + BEGIN 07701000 T 0449 + ERVSFLOW(11); 07702000 T 0449 + END MVST; 07703000 T 0449 + PROCEDURE PUSH ; % PUSH DOWN STACK REGISTERS 07704000 T 0450 + BEGIN 07705000 T 0450 + ADJ(0,0); 07706000 T 0450 + END PUSH; 07707000 T 0451 + PROCEDURE STOD ; % STORE DESTRUCTIVE 07708000 T 0451 + BEGIN 07709000 T 0451 + STORE(0); 07710000 T 0451 + END STOD; 07711000 T 0452 + PROCEDURE STON ; % STORE NON-DESTRUCTIVE 07712000 T 0453 + BEGIN 07713000 T 0453 + STORE(1); 07714000 T 0453 + END STON; 07715000 T 0453 + PROCEDURE OVRD ; % OVERWRITE DESTRUCTIVE 07716000 T 0454 + BEGIN 07717000 T 0454 + STORE(2); 07718000 T 0454 + END OVRD; 07719000 T 0454 + PROCEDURE OVRN ; % OVERWRITE NON-DESTRUCTIVE 07720000 T 0455 + BEGIN 07721000 T 0455 + STORE(3); 07722000 T 0455 + END OVRN; 07723000 T 0455 + BOOLEAN PROCEDURE GETSYLLABLES (N);% UTILITY FOR FLTR, ISOL AND INSR. 07724000 T 0456 +PRT(731) = GETSYLLABLES + VALUE N; INTEGER N; 07725000 T 0456 + BEGIN 07726000 T 0456 + DEFINE S = TBUF#; 07727000 T 0456 + START OF SEGMENT ********** 54 + INTEGER I,T,J; 07728000 T 0000 +STACK(F+3) = I +STACK(F+4) = T +STACK(F+5) = J + BOOLEAN B; 07729000 T 0000 +STACK(F+6) = B + LABEL OC; 07729100 T 0000 + DO BEGIN 07730000 T 0000 + T ← S [I] ← IF PROF THEN SYLLABLES [PSR] 07731000 T 0000 + ELSE PSYLLABLES; 07732000 T 0001 + J←IF I=N-1 THEN 48 ELSE 47; 07733000 T 0003 + IF B←T>J 07734000 T 0007 + THEN BEGIN INTFAMB(2); GO OC END; 07735000 T 0007 + STEPPSR (1); 07736000 T 0010 + END UNTIL I ← I + 1 ≥ N OR B; 07737000 T 0010 + GETSYLLABLES ← B; 07738000 T 0013 + OC: 07738100 T 0014 + END GETSYLLABLES; 07739000 T 0015 + 54 IS 19 LONG, NEXT SEG 12 + STREAM PROCEDURE MOVEN (S, D, N); VALUE N; 07740000 T 0456 +PRT(732) = MOVEN + BEGIN SI ← S; DI ← D; DS←N WDS END MOVE OF N WORDS FROM S TO D; 07741000 T 0456 + BOOLEAN PROCEDURE GETGKL (N); % UTILITY FOR DFTR, DISO AND DINS. 07742000 T 0457 +PRT(733) = GETGKL + VALUE N; INTEGER N; 07743000 T 0457 + BEGIN 07744000 T 0457 + DEFINE GKL = TBUF#; % MOMENTARY STORAGE 07745000 T 0457 + START OF SEGMENT ********** 55 + INTEGER I,J; 07746000 T 0000 +STACK(F+3) = I +STACK(F+4) = J + BOOLEAN BOOLE; 07747000 T 0000 +STACK(F+5) = BOOLE + LABEL OC; 07747100 T 0000 + J←48; 07748000 T 0000 + DO BEGIN 07749000 T 0000 + ADJ (0, 1); 07750000 T 0000 + IF BOOLE←INTEGERIZE(TRUE,B) OR B<0 OR B>J 07751000 T 0001 + THEN BEGIN INTFAMB(3); GO OC END 07752000 T 0004 + ELSE GKL [I] ← B; 07753000 T 0007 + BROF ← FALSE; 07754000 T 0008 + J←47; 07755000 T 0009 + END UNTIL I ← I + 1 ≥ N OR BOOLE; 07756000 T 0010 + GETGKL ← BOOLE; 07757000 T 0013 + OC: 07757100 T 0013 + END VALIDATION OF OPERANDS FOR DYNAMIC FIELD OPERATORS; 07758000 T 0014 + 55 IS 17 LONG, NEXT SEG 12 + PROCEDURE FLTR ; % FIELD TRANSFER 07759000 T 0457 + BEGIN 07760000 T 0457 + DEFINE S = TBUF#; 07761000 T 0457 + START OF SEGMENT ********** 56 + INTEGER K, G, L; 07762000 T 0000 +STACK(F+2) = K +STACK(F+3) = G +STACK(F+4) = L + IF NOT GETSYLLABLES (3) 07763000 T 0000 + THEN BEGIN 07764000 T 0000 + ADJ (1, 1); 07765000 T 0001 + MOVEN (S[0], K, 3); % SYLLABLES TO LOCALS 07766000 T 0002 + DYAL (A, B, G, K, L); % B.[K:L]; ← A.[G:L] 07767000 T 0004 + AROF ← FALSE; 07768000 T 0005 + END; 07769000 T 0006 + END FLTR; 07770000 T 0006 + 56 IS 9 LONG, NEXT SEG 12 + PROCEDURE DFTR ; % DYNAMIC FIELD TRANSFER 07771000 T 0457 + BEGIN 07772000 T 0457 + DEFINE LGK = TBUF#; 07773000 T 0457 + START OF SEGMENT ********** 57 + INTEGER L, G, K; % DO NOT DISTURB G, K, OR L 07774000 T 0000 +STACK(F+2) = L +STACK(F+3) = G +STACK(F+4) = K + IF NOT GETGKL (3) % STACK ADJUST AND VALIDITY 07775000 T 0000 + THEN BEGIN 07776000 T 0000 + ADJ (1, 1); 07777000 T 0001 + MOVEN (LGK [0], L, 3); % OPERANDS TO LOCALS 07778000 T 0002 + DYAL (A, B, G, K, L); % B.[K:L] ← A.[G,L] 07779000 T 0004 + AROF ← FALSE; 07780000 T 0005 + END; 07781000 T 0006 + END DFTR; 07782000 T 0006 + 57 IS 9 LONG, NEXT SEG 12 + PROCEDURE ISOL ; % FIELD ISOLATE 07783000 T 0457 + BEGIN 07784000 T 0457 + DEFINE S = TBUF#; 07785000 T 0457 + START OF SEGMENT ********** 58 + INTEGER G, L, K ; % DO NOT DISTURB G AND L 07786000 T 0000 +STACK(F+2) = G +STACK(F+3) = L +STACK(F+4) = K + IF NOT GETSYLLABLES (2) 07787000 T 0000 + THEN BEGIN 07788000 T 0000 + ADJ (1, 0); 07789000 T 0001 + MOVEN (S[0], G, 2); % SYLLABLES TO LOCALS 07790000 T 0002 + K ← L - 1; 07791000 T 0004 + B ← BX ← 0; 07792000 T 0005 + DYAL (A, B, G, K, L); % B.[K:L] ← A.[G:L] 07793000 T 0006 + AROF ← FALSE; 07794000 T 0008 + BROF ← TRUE; 07795000 T 0009 + END; 07796000 T 0009 + END ISOL; 07797000 T 0009 + 58 IS 12 LONG, NEXT SEG 12 + PROCEDURE DISO ; % DYNAMIC FIELD ISOLATE 07798000 T 0457 + BEGIN 07799000 T 0457 + DEFINE LG = TBUF#; 07800000 T 0457 + START OF SEGMENT ********** 59 + INTEGER L, G, K; % DO NOT DISTURB L AND G 07801000 T 0000 +STACK(F+2) = L +STACK(F+3) = G +STACK(F+4) = K + IF NOT GETGKL (2) % STACK ADJ & VALIDITY CHECK 07802000 T 0000 + THEN BEGIN 07803000 T 0000 + AROF ← TRUE; % GETGKL SETS FALSE; 07804000 T 0001 + MOVEN (LG[0], L, 2); % OPERANDS TO LOCALS 07805000 T 0002 + K ← L - 1; 07806000 T 0003 + A ← AX ← 0; 07807000 T 0005 + ADJ(1,1); 07808000 T 0006 + DYAL (B, A, G, K, L); % A.[K:L] ← B.[G:L] 07809000 T 0007 + BROF ← FALSE; 07810000 T 0009 + END; 07811000 T 0009 + END DISO; 07812000 T 0009 + 59 IS 12 LONG, NEXT SEG 12 + PROCEDURE INSR ; % FIELD INSERT 07813000 T 0457 + BEGIN 07814000 T 0457 + INTEGER K, L; % DO NOT DISTURB ORDER OF K AND L 07815000 T 0457 + START OF SEGMENT ********** 60 +STACK(F+2) = K +STACK(F+3) = L + DEFINE S = TBUF#; % ALSO SEE GETSYLLABLES 07816000 T 0000 + IF NOT GETSYLLABLES (2) 07817000 T 0000 + THEN BEGIN 07818000 T 0000 + ADJ (1, 1); 07819000 T 0001 + MOVEN (S[0], K, 2); % SYLLABLES TO LOCALS 07820000 T 0002 + G ← L - 1; 07821000 T 0004 + DYAL (A, B, G, K, L); % B.[K:L] ← A.[G:L]; 07822000 T 0005 + AROF ← FALSE; 07823000 T 0007 + END; 07824000 T 0007 + END INSR; 07825000 T 0007 + 60 IS 10 LONG, NEXT SEG 12 + PROCEDURE DINS ; % DYNAMIC FIELD INSERT 07826000 T 0457 + BEGIN 07827000 T 0457 + DEFINE LK = TBUF#; 07828000 T 0457 + START OF SEGMENT ********** 61 + INTEGER L, K, G; % DO NOT DISTURB ORDER 07829000 T 0000 +STACK(F+2) = L +STACK(F+3) = K +STACK(F+4) = G + ADJ (1, 1); % SAVE A WHILE L & K ARE& 07830000 T 0000 + AROF ← FALSE; 07831000 T 0001 + IF NOT GETGKL (2) 07832000 T 0001 + THEN BEGIN 07833000 T 0002 + ADJ (0, 1); 07834000 T 0003 + % AROF ← TRUE; 07835000 T 0004 + MOVEN (LK[0], L, 2); % L AND K TO LOCALS 07836000 T 0004 + G ← L - 1; 07837000 T 0005 + DYAL (A, B, G, K, L); % B.[K:L] ← A.[G:L] 07838000 T 0007 + % AROF ← FALSE; 07839000 T 0008 + END; 07840000 T 0008 + END DINS; 07841000 T 0008 + 61 IS 11 LONG, NEXT SEG 12 + PROCEDURE SRCH ; % MASKED SEARCH FOR EQUAL 07842000 T 0457 + BEGIN 07843000 T 0457 + BOOLEAN FINIS; 07844000 T 0457 + START OF SEGMENT ********** 62 +STACK(F+2) = FINIS + LABEL OC,LOOP,JUMP; 07845000 T 0000 + ADJ (1, 1); % DESCRIPTOR AND MASK 07846000 T 0000 + IF AX.TAG ≠ DATADESC 07847000 T 0001 + THEN BEGIN 07848000 T 0002 + SETINTERRUPT (INVOP); 07849000 T 0002 + GO OC; 07850000 T 0003 + END; 07851000 T 0005 + IF AX.PBIT≠1 THEN BEGIN SETINTERRUPT(PRESBIT); GO OC END; 07852000 T 0005 + MOVE (A, C); 07853000 T 0009 + AROF ← FALSE; 07854000 T 0010 + ADJ (1, 1); % MASK AND VALUE 07855000 T 0010 + MOVE (A, X); 07856000 T 0011 + IF C.LENGTH=0 THEN GO JUMP; 07857000 T 0012 + LOOP: 07858000 T 0014 + C.LENGTH ← C.LENGTH - 1; 07859000 T 0015 + JUMP: 07860000 T 0017 + MOVE (M[C.ADDR + C.LENGTH], A); 07861000 T 0018 + MEMCYCLE; 07862000 T 0023 + A ← REAL (BOOLEAN (A) AND BOOLEAN (X)); 07863000 T 0024 + AX ← REAL(BOOLEAN(AX) AND BOOLEAN (XX)); 07864000 T 0026 + FINIS ← EQUAL (A, AX, B, BX); 07865000 T 0027 + IF C.LENGTH≠0 AND (NOT FINIS) THEN GO LOOP; 07866000 T 0029 + IF (NOT FINIS) THEN A←1 ELSE A←0&C[28:8:20]; 07867000 T 0032 + AX ← 0; 07868000 T 0036 + BROF←FALSE; 07869000 T 0036 + OC: 07870000 T 0037 + END SRCH; 07871000 T 0038 + 62 IS 41 LONG, NEXT SEG 12 + PROCEDURE LLLU ; % LINKED LIST LOOKUP 07872000 T 0457 + BEGIN 07873000 T 0457 + LABEL OC,LOOP,NEG; 07874000 T 0457 + START OF SEGMENT ********** 63 + INTEGER PSEUDOA, PSEUDOC; % TO EXPEDITE FLAG BIT TESTING 07875000 T 0000 +STACK(F+2) = PSEUDOA +STACK(F+3) = PSEUDOC + ADJ (1, 1); % INDEX AND DATA DESCRIPTOR 07876000 T 0000 + IF INTEGERIZE (TRUE, A) 07877000 T 0001 + THEN BEGIN SETINTERRUPT (INTOVFI); GO OC; END; 07878000 T 0001 + IF BX.TAG ≠ DATADESC 07879000 T 0005 + THEN BEGIN SETINTERRUPT (INVOP); GO OC END; 07880000 T 0006 + BUF ← B.ADDR; 07881000 T 0009 + X ← A & B [8:8:20]; % INITIAL INDEX AND SIZE 07882000 T 0010 + BROF ← FALSE; 07883000 T 0012 + ADJ (1, 1); % INDEX AND ARGUMENT 07884000 T 0012 + MOVE (A, C); 07885000 T 0013 + PSEUDOA ← B.[20:28]; % ARGUMENT TO A 07886000 T 0014 + LOOP: IF A.ADDR > X.LENGTH 07887000 T 0016 + THEN BEGIN SETINTERRUPT (INVINXI);GO OC END; 07888000 T 0016 + MOVE (M[BUF + A.ADDR], C); % NEW LINK WORD TO C 07889000 T 0021 + PSEUDOC ← 0 &C[21:1:27] 07890000 T 0026 + &CX[20:47:1]; 07891000 T 0027 + MEMCYCLE; 07892000 T 0028 + IF PSEUDOA > PSEUDOC 07893000 T 0030 + THEN BEGIN 07894000 T 0030 + X.ADDR ← A.ADDR; % SAVE THIS INDEX 07895000 T 0031 + A.ADDR ← C.ADDR; 07896000 T 0033 + IF(A.ADDR=0)THEN BEGIN A←-1; GO NEG END; 07897000 T 0035 + GO LOOP; 07898000 T 0039 + END; 07899000 T 0039 + A ← X.ADDR; 07900000 T 0039 + NEG: 07901000 T 0040 + AX ← 0; 07902000 T 0041 + BROF ← FALSE; 07903000 T 0041 + OC: 07904000 T 0042 + END LLLU; 07905000 T 0043 + 63 IS 46 LONG, NEXT SEG 12 + PROCEDURE ZERO ; % LIT CALL ZERO 07906000 T 0457 + BEGIN 07907000 T 0457 + ADJ(0,2); 07908000 T 0457 + AX.[44:4]:=A:=0; 07909000 T 0459 + AROF:=TRUE; 07910000 T 0461 + END ZERO; 07911000 T 0462 + PROCEDURE ONE ; % LIT CALL ONE 07912000 T 0462 + BEGIN 07913000 T 0462 + ZERO; 07914000 T 0462 + A:=1; 07915000 T 0463 + END ONE ; 07916000 T 0464 + PROCEDURE LT8 ; % LIT CALL 8 BITS 07917000 T 0464 + BEGIN 07918000 T 0464 + ZERO; 07919000 T 0464 + A:=SYLLABLE; 07920000 T 0465 + STEPPSR(1); 07921000 T 0468 + END LT8; 07922000 T 0469 + PROCEDURE LT16 ; % LIT CALL 16 BITS 07923000 T 0469 + BEGIN 07924000 T 0469 + ZERO; 07925000 T 0469 + A.[32:8]:=SYLLABLE; 07926000 T 0470 + STEPPSR(1); 07927000 T 0474 + A.[40:8]:=SYLLABLE; 07928000 T 0475 + STEPPSR(1); 07929000 T 0478 + END LT16; 07930000 T 0479 + PROCEDURE LT48 ; % LIT CALL 48 BITS 07931000 T 0479 + BEGIN 07932000 T 0479 + REAL T1,T2; 07933000 T 0479 + START OF SEGMENT ********** 64 +STACK(F+2) = T1 +STACK(F+3) = T2 + ZERO; 07934000 T 0000 + IF PSR≠0 THEN STEPPSR(6-PSR); T1←SYLLABLE; 07935000 T 0000 + A:=P; 07936000 T 0005 + AX:=PX.PBIT; 07937000 T 0006 + STEPPSR(6); 07938000 T 0007 + END LT48; 07939000 T 0008 + 64 IS 11 LONG, NEXT SEG 12 + PROCEDURE MPCW ; % MAKE PROGRAM CONTROL WORD 07940000 T 0479 + BEGIN 07941000 T 0479 + LT48; 07942000 T 0479 + AX.TAG ← PCW; 07943000 T 0480 + END LPCW; 07944000 T 0482 + PROCEDURE BITSET; % UTILITY FOR BIT SETTING OPERATORS 07945000 T 0482 +PRT(734) = BITSET + BEGIN 07946000 T 0482 + INTEGER Z10, Z10X; % Z10X - SAFE IN DYALS 07947000 T 0482 + START OF SEGMENT ********** 65 +STACK(F+2) = Z10 +STACK(F+3) = Z10X + Z10 ← T.[44:1] + 1; % NEGATE BIT 3 OF OPERATOR 07948000 T 0000 + DYAL (Z10, B, 0, C, 1); 07949000 T 0001 + END BITSET; 07950000 T 0003 + 65 IS 6 LONG, NEXT SEG 12 + PROCEDURE BSET ; % BIT SET 07951000 T 0482 + BEGIN 07952000 T 0482 + BRST ; 07953000 T 0482 + END BSET; 07954000 T 0483 + PROCEDURE DBST ; % DYNAMIC BIT SET 07955000 T 0483 + BEGIN 07956000 T 0483 + DBRS; 07957000 T 0483 + END DBST; 07958000 T 0484 + PROCEDURE BRST ; % BIT RESET 07959000 T 0484 + BEGIN 07960000 T 0484 + C ← PSYLLABLES; 07961000 T 0484 + STEPPSR (1); 07962000 T 0486 + IF C > 47 THEN INTFAMB(2) ELSE BEGIN 07962100 T 0486 + ADJ (0, 1); 07963000 T 0489 + BITSET; 07964000 T 0490 + END; 07964100 T 0490 + END BRST; 07965000 T 0490 + PROCEDURE DBRS ; % DYNAMIC BIT RESET 07966000 T 0491 + BEGIN 07967000 T 0491 + ADJ (0, 1); 07968000 T 0491 + IF INTEGERIZE (TRUE, B) OR B < 0 OR B > 47 07969000 T 0492 + THEN INTFAMB(3) 07970000 T 0494 + ELSE BEGIN 07971000 T 0495 + MOVE (B, C); 07972000 T 0496 + BROF ← FALSE; 07973000 T 0497 + ADJ (0, 1); 07974000 T 0498 + BITSET; 07975000 T 0499 + END; 07976000 T 0500 + END DBRS; 07977000 T 0500 + PROCEDURE CHSN ; % CHANGE SIGN BIT 07978000 T 0500 + BEGIN 07979000 T 0500 + ADJ(1,2); 07980000 T 0500 + CHECOPRNDA END; 07981000 T 0502 + A.SOBIT← REAL(NOT BOOLEAN(A.SOBIT)); 07982000 T 0506 + END CHSN; 07983000 T 0508 + PROCEDURE CBON ; % COUNT BINARY ONES 07984000 T 0510 + BEGIN 07985000 T 0510 + INTEGER STREAM PROCEDURE COUNT (W); 07986000 T 0510 + START OF SEGMENT ********** 66 +PRT(735) = COUNT + BEGIN 07987000 T 0000 + SI ← W; 47 (SKIP SB; IF SB THEN TALLY ← TALLY + 1); 07988000 T 0000 + COUNT ← TALLY; 07989000 T 0001 + END; 07990000 T 0002 + CHECOPRNDA END; 07991000 T 0003 + AA←COUNT(A)+AX.PBIT; 07992000 T 0007 + IF AX.TAG=DOUBL THEN 07993000 T 0010 + AA←COUNT(X)+XX.PBIT+AA; 07994000 T 0011 + AX ← 0; 07995000 T 0015 + A←AA; 07996000 T 0015 + END CBON; 07997000 T 0016 + 66 IS 18 LONG, NEXT SEG 12 + PROCEDURE LOG2; % LEADING ONE TEST LOG2 07998000 T 0510 + BEGIN 07999000 T 0510 + INTEGER STREAM PROCEDURE LEADING (ONE); 08000000 T 0510 + START OF SEGMENT ********** 67 +PRT(736) = LEADING + BEGIN 08001000 T 0000 + SI ← ONE; 08002000 T 0000 + 47 (SKIP SB; IF SB THEN JUMP OUT ELSE TALLY ← TALLY + 1); 08003000 T 0000 + LEADING ← TALLY; 08004000 T 0003 + END LEADING; 08005000 T 0003 + ADJ(0,1); 08006000 T 0004 + B←IF BOOLEAN(BX) THEN 48 ELSE 47-LEADING(B); 08007000 T 0006 + BX←0; 08008000 T 0009 + END LOG2; 08009000 T 0010 + 67 IS 11 LONG, NEXT SEG 12 + PROCEDURE STAG ; % SET TAG FIELD 08010000 T 0510 + BEGIN 08011000 T 0510 + ADJ(1,1); 08012000 T 0510 + BX.TAG:=A.[45:3]; 08013000 T 0511 + AROF:=FALSE; 08014000 T 0513 + END STAG; 08015000 T 0514 + PROCEDURE RTAG ; % READ TAG FIELD 08016000 T 0514 + BEGIN 08017000 T 0514 + ADJ(1,2); 08018000 T 0514 + A:=0&AX[45:44:3]; 08019000 T 0516 + AX.[44:4]:=0; 08020000 T 0517 + END RTAG; 08021000 T 0519 + PROCEDURE SINT ; % SET INTERVAL TIMER 08022000 T 0519 + BEGIN 08023000 T 0519 + ADJ (1, 2); % TEMPORARY NO FLOWS 08024000 T 0519 + INTTIMER ← (INTTIMER ← A + .5).[37:11] × 5000 + REALTIME; 08025000 T 0521 + AX ← 0; 08026000 T 0524 + AROF ← FALSE; 08027000 T 0525 + IF INTTIMER < IDLETIME OR IDLETIME = 0 THEN IDLETIME←INTTIMER; 08028000 T 0525 + END SINT; 08029000 T 0528 + PROCEDURE RDLK ; % READ WITH LOCK 08030000 T 0531 + BEGIN 08031000 T 0531 + STORE(7); 08032000 T 0531 + END RDLK; 08033000 T 0531 + PROCEDURE STFF ; % STUFF ENVIRONMENT 08034000 T 0532 + BEGIN 08035000 T 0532 + ERVSFLOW(18); 08036000 T 0532 + END STFF; 08037000 T 0532 + PROCEDURE WHOI ; % READ PROCESSOR IDENTIFICATION 08038000 T 0533 + BEGIN 08039000 T 0533 + ADJ (0,2); 08039500 T 0533 + A ← AX ← 0; 08040000 T 0534 + A ← PID; AROF ← TRUE; 08040500 T 0535 + END WHOI; 08041000 T 0536 + PROCEDURE EEXI ; % ENABLE EXTERNAL INTERRUPTS 08042000 T 0537 + BEGIN 08043000 T 0537 + IF IDLETIME ≥ REALTIME THEN REALTIME ← IDLETIME; 08043100 T 0537 + IIHF ← FALSE; 08044000 T 0539 + END EEXI; 08045000 T 0539 + PROCEDURE DEXI ; % DISABLE EXTERNAL IMTERRUPTS 08046000 T 0540 + BEGIN 08047000 T 0540 + IIHF ← TRUE; 08048000 T 0540 + END DEXI; 08049000 T 0540 + PROCEDURE IDLE ; % IDLE UNTIL INTERRUPT 08050000 T 0541 + BEGIN 08051000 T 0541 + IF NOT NCSF THEN SETINTERRUPT (INVOP) ELSE 08051100 T 0541 + IF IDLETIME ≥ REALTIME % TEMPORARY - NO FLOWS 08052000 T 0542 + THEN BEGIN 08053000 T 0545 + IF DISKLOAD > 0 08054000 T 0546 + THEN BEGIN 08055000 T 0546 + DISKLOAD ← -1 ; 08056000 T 0547 + INTTIMER ← IDLETIME ← CURRENTT ← 08057000 T 0548 + REALTIME ← 1 ; 08058000 T 0548 + END ; 08059000 T 0550 + REALTIME ← IDLETIME; 08060000 T 0550 + IDLETIME ← CURRENTT; 08061000 T 0551 + END 08062000 T 0552 + ELSE SETINTERRUPT (LOOPI); 08063000 T 0552 + END IDLE; 08064000 T 0553 + PROCEDURE HEYU ; % INTERRUPT OTHER PROCESSOR 08065000 T 0555 + BEGIN 08066000 T 0555 + PTPI ← 1; 08067000 T 0555 + END HEYU; 08068000 T 0556 + PROCEDURE RPRR ; % READ PROCESSOR REGISTER 08069000 T 0557 + BEGIN 08070000 T 0557 + INTEGER I, J, FREG, CHI, PREG, PREGX; 08070050 T 0557 + START OF SEGMENT ********** 68 +STACK(F+2) = I +STACK(F+3) = J +STACK(F+4) = FREG +STACK(F+5) = CHI +STACK(F+6) = PREG +STACK(F+7) = PREGX + LIST MONLIST(M[F+2].[6:6], M[F+2], CX.TAG, CHI, 08070100 T 0000 +PRT(737) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + C.[3:3],C.[6:3], C.[9:3], C.[12:3], C.[15:3], C.[18:3],C.[21:3] 08070200 T 0016 + ,C.[24:3],C.[27:3],C.[30:3],C.[33:3],C.[36:3],C.[39:3],C.[42:3] 08070300 T 0031 + ,C.[45:3], FOR J ← 0 STEP 1 UNTIL I DO MONITOROUTPUT [J]); 08070400 T 0049 +STACK(F+10) = MONLIST + ADJ (1, 2); 08071000 T 0061 + MOVE (A, C); 08072000 T 0062 + IF C = 64 % TO PROVIDE A MEANS OF 08073000 T 0063 + THEN A ← TRACTER % PRESERVING TRACTER 08074000 T 0064 + ELSE IF C =63 08074050 T 0064 + THEN BEGIN 08074100 T 0066 + IF PRINTERNOTYETOPENED 08074120 T 0067 + THEN BEGIN PRINTERNOTYETOPENED.[46:1] ← TRUE; HEADING END; 08074140 T 0067 + FREG ← F - M[F].DF; 08074150 T 0074 + MOVE (M[F+3], C); 08074200 T 0079 + CHI ← C.[1:2] & CX[45:47:1]; 08074250 T 0083 + WHILE I < 14 AND FREG > BOSR +2 DO 08074300 T 0085 + BEGIN 08074350 T 0088 + MOVE(M[FREG+1], PREG); 08074375 T 0088 + MONITOROUTPUT [I] ← PREG .SDIF; 08074400 T 0093 + MONITOROUTPUT[I←I+1] ← PREG .PIRF; 08074450 T 0094 + FREG ← FREG - M[FREG].DF; 08074500 T 0097 + I ← I + 1; 08074550 T 0102 + END; 08074600 T 0103 + I ← I - 1; 08074650 T 0104 + WRITE (TAPED, MONFMT, MONLIST); 08074700 T 0105 + END ELSE IF C = 62 THEN A ← IDLETIME ELSE IF C = 61 THEN A ← REALTIME 08074750 T 0108 + ELSE 08075000 T 0112 + IF C < 32 08076000 T 0113 + THEN A ← D [C.[43:5]] 08077000 T 0114 + ELSE IF C.[42:2] = 2 08078000 T 0116 + THEN BEGIN % THE MOVES ARE THE SIMULATORS 08079000 T 0118 + %"CORRECTING NETWORK" 08080000 T 0119 + MOVEN (PIR, IRSR, 8); 08081000 T 0119 + A ← IRSR [C.[45:3]]; 08082000 T 0120 + END 08083000 T 0122 + ELSE BEGIN 08084000 T 0122 + MOVEN (PBR, BRSR, 8); 08085000 T 0122 + A ← BRSR [C.[45:3]]; 08086000 T 0124 + END; 08087000 T 0125 + END RPRR; 08088000 T 0125 + 68 IS 129 LONG, NEXT SEG 12 + PROCEDURE SPRR ; % SET PROCESSOR REGISTER 08089000 T 0557 + BEGIN 08090000 T 0557 + ADJ (1, 1); 08091000 T 0557 + MOVE (B, C); 08092000 T 0558 + IF C = 64 % TO PROVIDE A MEANS OF SETTING 08093000 T 0559 + THEN TRACTER ← A % TRACTER 08094000 T 0559 + ELSE 08095000 T 0560 + IF C < 32 08096000 T 0561 + THEN D [C] ← A. ADDR 08097000 T 0561 + ELSE IF C.[42:2] = 2 08098000 T 0563 + THEN BEGIN % THE MOVENS ARE THE SIMULATORS 08099000 T 0565 + % "CORRECTING NETWORK 08100000 T 0566 + MOVEN (PIR, IRSR, 8); 08101000 T 0566 + IRSR [C.[45:3]] ← A.ADDR; 08102000 T 0568 + MOVEN (IRSR, PIR, 8); 08103000 T 0570 + END 08104000 T 0572 + ELSE BEGIN 08105000 T 0572 + MOVEN (PBR, BRSR, 8); 08106000 T 0572 + BRSR [C.[45:3]] ← A.ADDR; 08107000 T 0574 + MOVEN (BRSR, PBR, 8); 08108000 T 0576 + END; 08109000 T 0577 + AROF ← BROF ← FALSE; 08110000 T 0577 + END SPRR; 08111000 T 0579 + PROCEDURE SCNI ; % SCAN IN 08112000 T 0579 + BEGIN 08113000 T 0579 + DEFINE MBIT = MPXAB#, 08114000 T 0579 + START OF SEGMENT ********** 69 + HTYPE= MPXHDWE#, 08114050 T 0000 + Z = MPXFC#; 08114100 T 0000 + ADJ (1, 0); 08114200 T 0000 + Y ← 0; 08114300 T 0001 + CASE A.VARIF OF 08114400 T 0001 + BEGIN 08114500 T 0002 +PRT(740) = *CASE STATEMENT DESCRIPTOR* + BEGIN % IO PATH INTERROGATE 0 08114600 T 0003 + IF EVENTS [A.LUNIT].EVBUSY = 0 THEN % UNIT NOT BUSY 08114700 T 0003 + BEGIN 08114800 T 0005 + Y.LUNIT ← A.LUNIT; 08114810 T 0005 + IF MPX [1, A.LUNIT].HTYPE ≠ 0 % U CABLED TO MPA 08114900 T 0007 + AND MPXOPS [1] ≠ 0 % MPXA NOT LOADED 08115000 T 0010 + THEN BEGIN Y.Z ← 1; Y.MBIT ← 1 END; 08115100 T 0011 + IF A.Z = 2 THEN Y ← 0; 08115150 T 0015 + IF MPX [2, A.LUNIT].HTYPE ≠ 0 % U CABLED TO MPB 08115200 T 0018 + AND MPXOPS [2] ≠ 0 % MPXB NOT LOADED 08115300 T 0020 + THEN BEGIN Y.Z ← Y.Z + 2; Y.MBIT ← 1 END; 08115400 T 0021 + END 08115500 T 0027 + END PATH INTERROGATE; 08115600 T 0027 + BEGIN % READ STATUS WORD 1 08115700 T 0027 + IF A.LUNIT = 0 THEN Y ← STATUSWORD; 08115800 T 0027 + % ONLY ONE VECTOR IN SIMULATOR 08115900 T 0030 + % STATUSWORD BUILT INITIALLY AT CABLING TIME 08116000 T 0030 + END STATUS; 08116100 T 0030 + BEGIN % READ RESULT DESCRIPTOR 2 08116200 T 0030 + Y ← GETRESULT (A.Z); 08116300 T 0030 + END READ RESULT DESCRIPTOR; 08116500 T 0032 + Y ← ENTIER (TIMEOFDAY DIV 24); % TIME OF DAY 3 08116600 T 0033 + BEGIN % READ INTERRUPT MASK OR REGISTER 4 08116800 T 0035 + Y ← IF BOOLEAN (A.LUNIT) % READ MASK 08116900 T 0035 + THEN IF A.Z = 1 THEN INTMASKA ELSE INTMASKB 08117000 T 0036 + ELSE IF A.Z = 1 THEN INTREGA ELSE INTREGB; 08117100 T 0039 + END; 08117200 T 0043 + BEGIN % READ GCA 5 08117300 T 0044 + NOTYETCODED; 08117400 T 0044 + END; 08117500 T 0044 + BEGIN % INTERROGATE UNIT TYPE 6 08117600 T 0045 + IF BOOLEAN (A) 08117700 T 0045 + THEN Y ← MPX [A.Z, A.LUNIT].HTYPE 08117800 T 0045 + ELSE IF Y ← MPX [1, A.LUNIT].HTYPE = 0 08117900 T 0047 + THEN Y ← MPX [2, A.LUNIT].HTYPE; 08118000 T 0053 + END UNIT TYPE; 08118100 T 0057 + ; % 7 08118150 T 0058 + ; % 8 08118200 T 0058 + ; % 9 08118250 T 0058 + ; % 10 08118300 T 0058 + ; % 11 08118350 T 0058 + ; % 12 08118400 T 0058 + ; % 13 08118450 T 0058 + ; % 14 08118500 T 0058 + BEGIN % READ INTERRUPT LITERAL 15 08118550 T 0058 + BOOLEAN B; 08118560 T 0058 +PRT(741) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 70 +STACK(F+2) = B + INTEGER I, MPXI; 08118600 T 0000 +STACK(F+3) = I +STACK(F+4) = MPXI + REAL E; 08118605 T 0000 +STACK(F+5) = E + MPXI ←A.Z; 08118610 T 0000 + IF FIRSTEVENT [MPXI] ≤ REALTIME 08118630 T 0001 + AND FIRSTEVENT[MPXI] ≠0 08118640 T 0001 + THEN BEGIN 08118650 T 0002 + I ← FIRSTEVENTI[MPXI]; 08118660 T 0004 + Y ← MPX[MPXI, I].MPXINT; 08118670 T 0005 + B ← Y ≠0; 08118672 T 0007 + MPX [MPXI, I].MPXINT ← 0; 08118675 T 0008 + WHILE (E ← EVENTS[I]).EVTIME ≤ REALTIME 08118680 T 0011 + AND E ≠ 0 AND NOT B 08118685 T 0013 + DO BEGIN 08118690 T 0014 + IF E.EVMPX = MPXI 08118695 T 0016 + THEN BEGIN 08118700 T 0016 + Y ← MPX[MPXI,I].MPXINT; 08118705 T 0017 + B ← TRUE; 08118707 T 0018 + MPX[MPXI, I].MPXINT ←0; 08118710 T 0020 + END; 08118715 T 0022 + I ← E.EVLINK; 08118720 T 0024 + END 08118725 T 0025 + END 08118730 T 0025 + ELSE Y ← 0; 08118740 T 0025 + END; 08118750 T 0027 +PRT(742) = *SEGMENT DESCRIPTOR* + 70 IS 28 LONG, NEXT SEG 69 + END CASE; 08118800 T 0059 + START OF SEGMENT ********** 71 + 71 IS 16 LONG, NEXT SEG 69 + B ← Y; BX ← 0; 08118850 T 0059 + AROF ← FALSE; BROF ← TRUE; 08118900 T 0061 + END SCNI; 08119000 T 0062 + 69 IS 65 LONG, NEXT SEG 12 + PROCEDURE SCNO ; % SCAN OUT 08120000 T 0579 + BEGIN 08121000 T 0579 + DEFINE MBIT = MPXAB#, 08122000 T 0579 + START OF SEGMENT ********** 72 + Z = MPXFC#; 08122200 T 0000 + INTEGER T; 08122400 T 0000 +STACK(F+2) = T + ADJ (1, 1); 08123000 T 0000 + IF T ← A.VARIF = 4 OR T = 0 AND NOT NCSF 08124000 T 0001 + THEN SETINTERRUPT (INVOP) 08124300 T 0003 + ELSE CASE T OF 08124600 T 0005 + BEGIN 08124900 T 0008 +PRT(743) = *CASE STATEMENT DESCRIPTOR* + BEGIN% INITIATE I/O 0 08125000 T 0008 + MOVE (A, SCANBUSA); 08125300 T 0008 + MOVE (B, DATABUSA); 08125600 T 0009 + MULTIPLEX ← TRUE; 08125900 T 0010 + MOVE (B, DATABUSA); 08126000 T 0011 + END IIO; 08126300 T 0012 + ; % 1 08126600 T 0013 + ; % 2 08126900 T 0013 + TIMEOFDAY ← ENTIER (B × 24); % 3 08127000 T 0013 + IF A.Z = 1 THEN INTMASKA ← B ELSE INTMASKB ← B; % 4 08127300 T 0015 + NOTYETCODED; % SET GCA 5 08127600 T 0021 + END CASE; 08127900 T 0022 + START OF SEGMENT ********** 73 + 73 IS 6 LONG, NEXT SEG 72 + AROF ← BROF ← FALSE; 08128000 T 0022 + END SCNO; 08129000 T 0023 + 72 IS 26 LONG, NEXT SEG 12 + BOOLEAN SCANORXFER, XLATE, XFERWD, XFERW, SCANWH; 08130000 T 0579 +PRT(744) = SCANORXFER +PRT(745) = XLATE +PRT(746) = XFERWD +PRT(747) = XFERW +PRT(750) = SCANWH + 08131000 T 0579 + DEFINE QF01 = QP.[47:1]#, QF02 = QP.[46:1]#, QF03 = QP.[45:1]#, 08132000 T 0579 + QF04 = QP.[44:1]#, QH01 = QP.[43:1]#, QH02 = QP.[42:1]#, 08133000 T 0579 + QH03 = QP.[41:1]#, SPSF = QP.[40:1]#, SPRF = QP.[39:1]#, 08134000 T 0579 + DPSF = QP.[38:1]#, P2R2 = QP.[37:1]#, P2R3 = QP.[36:1]#, 08135000 T 0579 + P2R4 = QP.[35:1]#, FWDT = QP.[34:1]#, BKIP = QP.[33:1]#, 08136000 T 0579 + LHFF = QP.[32:1]#, XROF = QP.[31:1]#, SWPS = QP.[30:1]#; 08137000 T 0579 + DEFINE INVOPI = BEGIN SETINTERRUPT (INVOP); GO TO OC END#, 08138000 T 0579 + INTOFL = BEGIN SETINTERRUPT (INTOVFI); GO TO OC END#, 08139000 T 0579 + INVINX = BEGIN SETINTERRUPT (INVINXI); GO TO OC END#, 08140000 T 0579 + MEMPRO = BEGIN SETINTERRUPT (MEMPROI); GO TO OC END#, 08141000 T 0579 + PRESBI = BEGIN SETINTERRUPT (PRESBIT); GO TO OC END#, 08142000 T 0579 + JFIF = BEGIN 08143000 T 0579 + ADJ (0,0); BROF ← TRUE; AROF ← TRUE; 08144000 T 0579 + A ← AX ← 0; 08144500 T 0579 + B ← BX ← 0; SDIS ← 1; BKIP ← 1; 08145000 T 0579 + IF QF01 = 1 THEN B.[46:1] ← 1 ELSE 08146000 T 0579 + IF QF02 = 1 THEN B.[39:1] ← 1 ELSE 08147000 T 0579 + IF QF03 = 1 THEN B.[47:1] ← 1 ELSE 08148000 T 0579 + B.[37:1] ← 1; 08149000 T 0579 + IF P2R2 = 1 THEN A.[46:1] ← 1 ELSE 08150000 T 0579 + IF P2R3 = 1 THEN A.[46:2] ← 3 ELSE 08151000 T 0579 + A.[45:3] ← 4; 08152000 T 0579 + IF QF01 = 1 THEN INVOPI ELSE 08153000 T 0579 + IF QF02 = 1 THEN PRESBI ELSE 08154000 T 0579 + IF QF03 = 1 OR QF04 = 1 THEN MEMPRO 08155000 T 0579 + END#, 08156000 T 0579 + JGIF = BEGIN 08157000 T 0579 + ADJ (0,0); A ← AX + 0; B ← BX ← 0; 08158000 T 0579 + B ← RPF; BROF ← TRUE; 08159000 T 0579 + IF TEEF THEN 08160000 T 0579 + BEGIN 08161000 T 0579 + A.ADDR ← TBR; A.INDEX ← TIR; 08162000 T 0579 + A.PSRF ← PSR; A.SBIT ← 1; AROF ← TRUE 08163000 T 0579 + END ELSE 08164000 T 0579 + IF FWDT = 1 THEN 08165000 T 0579 + BEGIN AROF ← TRUE; MOVE (Y, A) END; 08166000 T 0579 + JFIF; 08167000 T 0579 + END#, 08168000 T 0579 + MEMPROTECT = BEGIN 08168100 T 0579 + UPDF ← TRUE; ENDE; 08168200 T 0579 + QF04 ← 1; JGIF; 08168300 T 0579 + GO TO OC; 08168310 T 0579 + END#, 08168400 T 0579 + FETCHSOURCE = 08169000 T 0579 + BEGIN 08170000 T 0579 + IF SOPF THEN ELSE 08171000 T 0579 + BEGIN 08172000 T 0579 + IF NOT AROF THEN 08173000 T 0579 + BEGIN 08174000 T 0579 + MM ← SBR ← SIR; 08175000 T 0579 + MOVE (M[MM], A); MEMCYCLE; 08176000 T 0579 + AROF ← TRUE; 08177000 T 0579 + IF BOOLEAN(AX.TAG)THEN MEMPROTECT 08178000 T 0579 + END; 08179000 T 0579 + END; 08180000 T 0579 + END#, 08181000 T 0579 + FETCHDESTINATION = 08182000 T 0579 + BEGIN 08183000 T 0579 + IF NOT BROF THEN 08184000 T 0579 + BEGIN 08185000 T 0579 + MM ← DBR ← DIR; 08186000 T 0579 + MOVE (M[MM], B); MEMCYCLE; 08187000 T 0579 + BROF ← TRUE; 08188000 T 0579 + IF BOOLEAN (BX.TAG) THEN MEMPROTECT 08189000 T 0579 + END; 08190000 T 0579 + END#, 08191000 T 0579 + CHARSZ = BEGIN 08192000 T 0579 + IF SSZ = 0 THEN 08193000 T 0579 + BEGIN 08194000 T 0579 + IF DSZ = 0 THEN SSZ ← DSZ ← 6 ELSE 08195000 T 0579 + SSZ ← DSZ 08196000 T 0579 + END ELSE 08197000 T 0579 + IF DSZ = 0 THEN DSZ ← SSZ 08198000 T 0579 + END#, 08199000 T 0579 + 08200000 T 0579 + 08201000 T 0579 + 08202000 T 0579 + 08203000 T 0579 + COMPARECHAR = IF ACHAR ≠ BCHAR THEN 08204000 T 0579 + IF ACHAR > BCHAR THEN 08205000 T 0579 + IF RELATION < 3 OR RELATION=5 THEN ELSE 08206000 T 0579 + TFFF ← FALSE 08207000 T 0579 + ELSE 08208000 T 0579 + IF RELATION.[46:1]=1 THEN ELSE 08209000 T 0579 + TFFF ← FALSE 08210000 T 0579 + ELSE 08211000 T 0579 + IF RELATION> 3 THEN ELSE TFFF←FALSE#, 08218000 T 0579 + SWITCHSOURCE = 08219000 T 0579 + BEGIN 08220000 T 0579 + IF SIB = 0 THEN 08221000 T 0579 + BEGIN 08222000 T 0579 + IF SOPF THEN 08223000 T 0579 + BEGIN 08224000 T 0579 + IF AX.TAG = DOUBL THEN 08225000 T 0579 + BEGIN 08226000 T 0579 + 08227000 T 0579 + JUNK ← A; 08228000 T 0579 + A ← X; 08229000 T 0579 + X ← JUNK; 08230000 T 0579 + END; 08231000 T 0579 + END ELSE 08232000 T 0579 + BEGIN 08232100 T 0579 + AROF ← FALSE; 08233000 T 0579 + SIR ← SIR + 1; 08234000 T 0579 + END; 08234100 T 0579 + END; 08235000 T 0579 + END#, 08236000 T 0579 + STOREB = BEGIN 08237000 T 0579 + MOVE (B, M[DBR + DIR]); MEMCYCLE; 08238000 T 0579 + BROF ← FALSE; 08239000 T 0579 + END#, 08240000 T 0579 + STEPSP = BEGIN 08241000 T 0579 + SIB ← 0; 08242000 T 0579 + SIR ← SIR ← 1; 08243000 T 0579 + END#, 08244000 T 0579 + STEPDP = BEGIN 08245000 T 0579 + DIB ← 0; 08246000 T 0579 + DIR ← DIR + 1; 08247000 T 0579 + END#, 08248000 T 0579 + SIBLNG = 2 × REAL (SSZ = 6) + 4 × REAL (SSZ = 8)#, 08249000 T 0579 + DIBLNG = 2 × REAL (DSZ = 6) + 4 × REAL (DSZ = 8)#, 08250000 T 0579 + TWOTO20 = 1048576#, 08251000 T 0579 + DYALSIB = 47 - SIB × SSZ#, 08252000 T 0579 + DYALDIB = 47 - DIB × SSZ#, 08253000 T 0579 + DYALSET = SIB× SSZ - 1#, 08253100 T 0579 + DYALSZ = SIB× SSZ #, 08253200 T 0579 + DYALSIZ = 48 - SIB × SSZ #, 08253300 T 0579 + BUMPSIB = SIB ← (SIB + 1) MOD (48 DIV SSZ)#, 08254000 T 0579 + BUMPDIB = DIB ← (DIB + 1) MOD (48 DIV SSZ)#, 08255000 T 0579 + BASE = (IF SOURCE THEN SBR ELSE DBR)#, 08256000 T 0579 + WORDZ = (IF SOURCE THEN SIR ELSE DIR)#, 08257000 T 0579 + BYTE = (IF SOURCE THEN SIB ELSE DIB)#, 08258000 T 0579 + SYZE = (IF SOURCE THEN SSZ ELSE DSZ)#, 08259000 T 0579 + SETUPEXSF = IF EXSF THEN ELSE 08260000 T 0579 + IF NOT RNTF THEN 08261000 T 0579 + BEGIN 08262000 T 0579 + C ← SYLLABLE; 08263000 T 0579 + CX ← 0; 08264000 T 0579 + END ELSE 08265000 T 0579 + STEPPSR (1)#; 08266000 T 0579 + PROCEDURE ENTEREDIT (TYPE, UPDATE); 08267000 T 0579 +PRT(751) = ENTEREDIT + VALUE TYPE, UPDATE; 08268000 T 0579 + INTEGER TYPE; 08269000 T 0579 + BOOLEAN UPDATE; 08270000 T 0579 + BEGIN 08271000 T 0579 + DEFINE TABLENTER = TYPE = 3#, 08272000 T 0579 + START OF SEGMENT ********** 74 + SINGLEPOINT = TYPE = 1#, 08273000 T 0000 + SINGLESHOT = TYPE = 0#; 08274000 T 0000 + LABEL OC, L1, L2, L3, L4, L5; 08275000 T 0000 + IF TABLENTER THEN 08276000 T 0000 + BEGIN 08277000 T 0000 + ADJ (0,1); 08278000 T 0001 + IF BX.TAG ≠ DATADESC THEN 08279000 T 0002 + BEGIN 08280000 T 0003 + QF01 ← 1; 08281000 T 0004 + JFIF; 08282000 T 0005 + GO TO OC 08283000 T 0053 + END; 08284000 T 0053 + IF BX.PBIT ≠ 1 THEN 08285000 T 0053 + BEGIN 08286000 T 0054 + QF02 ← 1; 08287000 T 0055 + JFIF; 08288000 T 0057 + GO TO OC 08289000 T 0104 + END; 08290000 T 0104 + BROF ← FALSE; 08291000 T 0104 + TBR ← B.ADDR; 08292000 T 0105 + IF B.IBIT = 1 THEN TIR ← B.INDEX 08293000 T 0106 + ELSE TIR ← 0; 08294000 T 0108 + IF B.SBIT = 1 THEN RNTF ← TRUE; 08295000 T 0110 + MOVE (B, C); 08296000 T 0113 + GO TO L1; 08297000 T 0114 + END; 08298000 T 0114 + ADJ (0,1); 08299000 T 0114 + IF BX.TAG ≠ SINGL AND BX.TAG ≠ DOUBL THEN 08300000 T 0115 + BEGIN 08301000 T 0118 + IF NOT SCANORXFER THEN 08302000 T 0119 + BEGIN 08303000 T 0119 + QF01 ← 1; 08304000 T 0120 + JFIF; 08305000 T 0121 + GO TO OC 08306000 T 0169 + END ELSE 08307000 T 0169 + BEGIN MOVE(C,Y); C← 0&REAL(NOT BOOLEAN(CX←0)) 08308000 T 0169 + [28:28:20] END 08308100 T 0172 + END ELSE 08309000 T 0173 + BEGIN NTGR; IF SDIS = 1 THEN INTOFL; 08310000 T 0173 + MOVE (C,Y); MOVE (B,C); 08311000 T 0179 + BROF ← FALSE; 08312000 T 0181 + END; 08313000 T 0181 + 08314000 T 0181 + IF SINGLEPOINT THEN 08315000 T 0181 + BEGIN 08316000 T 0182 + ADJ (0,1); 08317000 T 0183 + AROF ← TRUE; 08318000 T 0184 + MOVE (B,A) 08319000 T 0184 + END; 08320000 T 0185 + L1: 08321000 T 0185 + ADJ (1,1); 08322000 T 0186 + 08322100 T 0187 + SPSF ← A.SBIT; 08323000 T 0187 + SPRF ← A.RBIT; 08324000 T 0189 + DPSF ← B.SBIT; 08325000 T 0191 + IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN 08326000 T 0193 + BEGIN 08327000 T 0196 + 08328000 T 0197 + SSZ ← 0; 08329000 T 0197 + SIB ← 0; 08330000 T 0197 + SOPF ← TRUE; 08330500 T 0198 + IF AX.TAG = SINGL THEN MOVE (A,X); 08331000 T 0199 + GO TO L2 08332000 T 0202 + END; 08333000 T 0202 + IF AX.PBIT ≠ 1 THEN 08334000 T 0202 + BEGIN QF02 ← 1; GO TO L3 END; 08335000 T 0203 + SBR ← A.ADDR; 08336000 T 0206 + SSZ ← IF A.SZ = 0 THEN 6 ELSE 2×A.SZ; 08337000 T 0207 + SIB ← 0; 08338000 T 0212 + IF A.IBIT ≠ 0 THEN 08339000 T 0212 + BEGIN 08340000 T 0214 + IF A.SZ ≠ 0 THEN 08341000 T 0214 + BEGIN 08342000 T 0215 + SIB ← A.[8:4]; 08343000 T 0216 + SIR ← A.[12:16]; 08344000 T 0217 + END 08345000 T 0218 + ELSE 08346000 T 0218 + SIR ← A.INDEX 08347000 T 0218 + END ELSE 08348000 T 0219 + SIR ← 0; 08349000 T 0220 + 08350000 T 0221 + AROF ← FALSE; 08351000 T 0221 + L2: IF SWPS = 1 THEN GO TO L5; 08352000 T 0222 + IF BX.TAG ≠ DATADESC THEN 08353000 T 0224 + BEGIN 08354000 T 0226 + L4: 08355000 T 0226 + QF01 ← 1; 08356000 T 0227 + L3: 08357000 T 0228 + IF SINGLEPOINT THEN 08358000 T 0229 + BROF ← FALSE; 08359000 T 0229 + AROF ← TRUE; 08359500 T 0231 + ADJ (0,0); 08360000 T 0231 + MOVE (Y,A); 08360500 T 0232 + IF TABLENTER THEN AROF ← TRUE ELSE 08361000 T 0233 + BEGIN 08361500 T 0235 + MOVE (C,B); 08362000 T 0236 + BROF ← TRUE; 08362500 T 0237 + IF FWDT = 1 THEN AROF ← TRUE; 08363000 T 0238 + END; 08363500 T 0240 + JFIF; 08364000 T 0240 + GO TO OC 08365000 T 0288 + END; 08366000 T 0288 + IF BX.PBIT ≠ 1 THEN 08367000 T 0288 + BEGIN QF02 ← 1; GO TO L3 END; 08367500 T 0289 + DBR ← B.ADDR; 08368000 T 0292 + DSZ ← IF B.SZ=0 THEN 6 ELSE 2×B.SZ; 08368500 T 0293 + IF AX.TAG = DATADESC THEN 08369000 T 0298 + BEGIN 08369500 T 0299 + IF NOT XLATE THEN 08370000 T 0299 + BEGIN 08370500 T 0300 + IF SSZ ≠ DSZ THEN GO TO L4 08371000 T 0300 + END; 08371500 T 0301 + END; 08372000 T 0302 + IF NOT XFERWD THEN 08373000 T 0302 + BEGIN 08374000 T 0302 + IF B.RBIT = 1 THEN 08375000 T 0303 + BEGIN 08376000 T 0304 + QF03 ← 1; 08377000 T 0304 + GO TO L3 08378000 T 0306 + END; 08379000 T 0307 + END; 08380000 T 0307 + L5: DBR ← B.ADDR; 08380500 T 0307 + DSZ ← IF B.SZ = 0 THEN 6 ELSE 2 × B.SZ; 08380600 T 0308 + DIB ← 0; 08381000 T 0312 + IF B.IBIT ≠ 0 THEN 08382000 T 0313 + BEGIN 08383000 T 0314 + IF B.SZ ≠ 0 THEN 08384000 T 0315 + BEGIN 08385000 T 0316 + DIB ← B.[8:4]; 08386000 T 0316 + DIR ← B.[12:16] 08387000 T 0318 + END ELSE 08388000 T 0318 + DIR ← B.INDEX 08389000 T 0319 + END ELSE 08390000 T 0319 + DIR ← 0; 08391000 T 0321 + BROF ← FALSE; 08392000 T 0322 + IF UPDATE THEN UPDF ← TRUE; 08393000 T 0323 + IF NOT TABLENTER THEN EXSF ← ESPF ← TRUE 08394000 T 0324 + ELSE 08395000 T 0326 + BEGIN 08396000 T 0327 + TEEF ← TRUE; PSR ← C.[38:3] 08397000 T 0327 + END; 08398000 T 0328 + OC: 08399000 T 0329 + END ENTEREDIT; 08400000 T 0330 + 74 IS 331 LONG, NEXT SEG 12 + PROCEDURE XFERWDS (UPDATE,OVERITE); 08400010 T 0579 +PRT(752) = XFERWDS + VALUE UPDATE, OVERITE; 08400020 T 0579 + BOOLEAN UPDATE, OVERITE; 08400030 T 0579 + BEGIN 08400040 T 0579 + LABEL OC, L1; 08400050 T 0579 + START OF SEGMENT ********** 75 + XFERWD ← OVERITE; 08400055 T 0000 + ENTEREDIT (0,UPDATE); 08400060 T 0000 + IF SIB ≠ 0 THEN STEPSP; 08400070 T 0001 + IF DIB ≠ 0 THEN STEPDP; 08400080 T 0005 + IF C.ADDR > 0 THEN 08400090 T 0008 + BEGIN 08400100 T 0009 + RPF ← C.ADDR; 08400110 T 0010 + WHILE (RPF ← RPF - 1) ≥ 0 DO 08400120 T 0011 + BEGIN 08400130 T 0013 + IF SOPF THEN ELSE 08400140 T 0013 + BEGIN 08400150 T 0014 + MM ← SBR ← SIR; 08400160 T 0014 + MOVE (M[MM], A); MEMCYCLE; 08400170 T 0016 + IF NOT OVERITE THEN 08400180 T 0021 + IF BOOLEAN (AX.TAG) THEN GO L1; 08400190 T 0021 + END; 08400200 T 0023 + MM ← DBR ← DIR; 08400210 T 0023 + MOVE (M[MM], C); 08400220 T 0025 + IF NOT OVERITE THEN 08400230 T 0029 + BEGIN 08400240 T 0029 + IF BOOLEAN (CX.TAG) THEN GO TO L1; 08400250 T 0030 + END; 08400260 T 0030 + MOVE (A, M[MM]); MEMCYCLE; 08400270 T 0031 + IF SOPF THEN 08400280 T 0036 + BEGIN 08400290 T 0037 + IF AX.TAG ≠ SINGL THEN 08400300 T 0037 + BEGIN 08400310 T 0038 + MOVE (A, JUNK); 08400320 T 0039 + MOVE (X, A); 08400330 T 0040 + MOVE (JUNK, A); 08400340 T 0041 + END 08400350 T 0042 + END ELSE 08400360 T 0042 + SIR ← SIR + 1; 08400370 T 0042 + DIR ← DIR + 1; 08400380 T 0044 + END; 08400390 T 0045 + END; 08400400 T 0045 + ENDE; GO TO OC; 08400500 T 0045 + L1: 08400600 T 0046 + UPDF ← TRUE; 08400700 T 0047 + ENDE; 08400750 T 0047 + QF04 ← 1; 08400800 T 0048 + JGIF; 08400850 T 0050 + 08400900 T 0115 + OC: 08400950 T 0115 + END XFERWDS; 08401000 T 0115 + 75 IS 116 LONG, NEXT SEG 12 + PROCEDURE XFERWHILE (UPDATE,RELATION); 08402000 T 0579 +PRT(753) = XFERWHILE + VALUE UPDATE, RELATION; 08403000 T 0579 + BOOLEAN UPDATE; 08404000 T 0579 + INTEGER RELATION; 08405000 T 0579 + BEGIN 08406000 T 0579 + REAL ACHAR, BCHAR; 08407000 T 0579 + START OF SEGMENT ********** 76 +STACK(F+2) = ACHAR +STACK(F+3) = BCHAR + LABEL OC, L1, L2, L3, L4; 08408000 T 0000 + ADJ (1,1); 08409000 T 0000 + IF AX.TAG ≠ SINGL THEN 08410000 T 0001 + BEGIN 08411000 T 0002 + QF01 ← 1; 08412000 T 0002 + JFIF; 08413000 T 0004 + GO TO OC 08414000 T 0052 + END; 08415000 T 0052 + MOVE (A, C); 08416000 T 0052 + AROF ← FALSE; SCANORXFER ← TRUE; XFERW ← TRUE; 08417000 T 0053 + ENTEREDIT (0, UPDATE); 08418000 T 0055 + CHARSZ; 08419000 T 0056 + DYAL (Y, BCHAR, SSZ-1, SSZ-1, SSZ); 08420000 T 0064 + TFFF ← TRUE; 08420500 T 0067 + RPF ← C.ADDR; 08421000 T 0067 + IF C.ADDR = 0 THEN 08422000 T 0069 + BEGIN 08423000 T 0070 + ENDE; GO TO OC; 08424000 T 0070 + END; 08425000 T 0071 + L1: FETCHSOURCE; 08426000 T 0071 + FETCHDESTINATION; 08427000 T 0151 + 08428000 T 0229 + DYAL (A, ACHAR, DYALSIB, SSZ-1, SSZ); 08429000 T 0229 + COMPARECHAR; 08430000 T 0232 + IF TFFF THEN 08431000 T 0245 + BEGIN 08432000 T 0245 + DYAL (A, B, DYALSIB, DYALDIB, SSZ); 08433000 T 0246 + RPF ← RPF - 1; 08434000 T 0249 + IF RPF = 0 THEN QH03 ← 1 ELSE 08435000 T 0251 + L2: BEGIN 08436000 T 0254 + BUMPSIB; 08437000 T 0255 + SWITCHSOURCE; 08438000 T 0257 + BUMPDIB; 08439000 T 0265 + IF DIB = 0 THEN 08440000 T 0268 + BEGIN 08440010 T 0268 + STOREB; DIR ← DIR + 1 08440020 T 0269 + END; 08440030 T 0276 + IF QH03 = 0 THEN GO TO L1; 08440040 T 0277 + IF UPDF THEN GO TO L3 ELSE GO TO L4; 08440050 T 0278 + END; 08440060 T 0280 + END; 08440070 T 0280 + STOREB; 08440080 T 0280 + IF TFFF THEN GO TO L2; 08440090 T 0286 + L3: ENDE; 08440100 T 0287 + ADJ (0,2); 08440110 T 0288 + A ← RPF; AX ← 0; 08440120 T 0289 + AROF ← TRUE; 08440130 T 0291 + GO TO OC; 08440140 T 0291 + L4: ENDE; 08440150 T 0292 + OC: SCANORXFER ← FALSE; XFERW ← FALSE; 08440160 T 0293 + END XFERWHILE; 08440170 T 0295 + 76 IS 298 LONG, NEXT SEG 12 + PROCEDURE TWSD; % TRANSFER WORDS, DESTRUCTIVE 08440180 T 0579 + BEGIN P2R3 ← 1; 08440190 T 0579 + XFERWDS (FALSE, FALSE); P2R3 ← 0; 08440200 T 0581 + END TWSD; 08440210 T 0584 + PROCEDURE TWSU; % TRANSFER WORDS, UPDATE 08440220 T 0584 + BEGIN P2R3 ← 1; 08440230 T 0584 + XFERWDS (TRUE, FALSE); P2R3 ← 0; 08440240 T 0586 + END TWSU; 08440250 T 0589 + PROCEDURE TWOD; % TRANSFER WORDS OVERWRITE, DESTRUCTIVE 08440260 T 0589 + BEGIN P2R3 ← 1; 08440270 T 0589 + XFERWDS (FALSE, TRUE); P2R3 ← 0; 08440280 T 0591 + END TWOD; 08440290 T 0594 + PROCEDURE TWOU; % TRANSFER WORDS OVERWRITE, UPDATE 08440300 T 0594 + BEGIN P2R3 ← 1; 08440310 T 0594 + XFERWDS (TRUE, TRUE); P2R3 ← 0; 08440320 T 0596 + END TWOU; 08440330 T 0599 + PROCEDURE TGTD; % TRANSFER WHILE GREATER, DESTRUCTIVE 08440340 T 0599 + BEGIN P2R4 ← 1; FWDT ← 1; 08440350 T 0599 + XFERWHILE (FALSE, 1); P2R4 ← 0; FWDT ← 0; 08440360 T 0603 + END TGTD; 08440370 T 0608 + PROCEDURE TGTU; % TRANSFER WHILE GREATER, UPDATE 08440380 T 0608 + BEGIN P2R4 ← 1; FWDT ← 1; 08440390 T 0608 + XFERWHILE (TRUE, 1); P2R4 ← 0; FWDT ← 0; 08440400 T 0612 + END TGTU; 08440500 T 0617 + PROCEDURE TGED; % TRANSFER WHILE GREATER OR EQUAL, DESTRUCTIVE 08440600 T 0617 + BEGIN P2R4 ← 1; FWDT ← 1; 08440700 T 0617 + XFERWHILE (FALSE, 5); P2R4 ← 0; FWDT ← 0; 08440800 T 0621 + END TGED; 08440900 T 0626 + PROCEDURE TGEU; % TRANSFER WHILE GREATER OR EQUAL, UPDATE 08441000 T 0626 + BEGIN P2R4 ← 1; FWDT ← 1; 08441100 T 0626 + XFERWHILE (TRUE, 5); P2R4 ← 0; FWDT ← 0; 08441200 T 0630 + END TGEU; 08441300 T 0635 + PROCEDURE TEQD; % TRANSFER WHILE EQUAL, DESTRUCTIVE 08441400 T 0635 + BEGIN P2R4 ← 1; FWDT ← 1; 08441500 T 0635 + XFERWHILE (FALSE, 4); P2R4 ← 0; FWDT ← 0; 08441600 T 0639 + END TEQD; 08441700 T 0644 + PROCEDURE TEQU; % TRANSFER WHILE EQUAL, UPDATE 08441800 T 0644 + BEGIN P2R4 ← 1; FWDT ← 1; 08441900 T 0644 + XFERWHILE (TRUE, 4); P2R4 ← 0; FWDT ← 0; 08442000 T 0648 + END TEQU; 08442100 T 0653 + PROCEDURE TLED; % TRANSFER WHILE LESS OR EQUAL, DESTRUCTIVE 08442200 T 0653 + BEGIN P2R4 ← 1; FWDT ← 1; 08442300 T 0653 + XFERWHILE (FALSE, 6); P2R4 ← 0; FWDT ← 0; 08442400 T 0657 + END TLED; 08442500 T 0662 + PROCEDURE TLEU; % TRANSFER WHILE LESS OR EQUAL, UPDATE 08442600 T 0662 + BEGIN P2R4 ← 1; FWDT ← 1; 08442700 T 0662 + XFERWHILE (TRUE, 6); P2R4 ← 0; FWDT ← 0; 08442800 T 0666 + END TLEU; 08442900 T 0671 + PROCEDURE TLSD; % TRANSFER WHILE LESS, DESTRUCTIVE 08443000 T 0671 + BEGIN P2R4 ← 1; FWDT ← 1; 08444000 T 0671 + XFERWHILE (FALSE, 3); P2R4 ← 0; FWDT ← 0; 08445000 T 0675 + END TLSD; 08446000 T 0680 + PROCEDURE TLSU; % TRANSFER WHILE LESS, UPDATE 08447000 T 0680 + BEGIN P2R4 ← 1; FWDT ← 1; 08448000 T 0680 + XFERWHILE (TRUE, 3); P2R4 ← 0; FWDT ← 0; 08448500 T 0684 + END TLSU; 08449000 T 0689 + PROCEDURE TNED; % TRANSFER WHILE NOT EQUAL, DESTRUCTIVE 08449500 T 0689 + BEGIN P2R4 ← 1; FWDT ← 1; 08450000 T 0689 + XFERWHILE (FALSE, 2); P2R4 ← 0; FWDT ← 0; 08451000 T 0693 + END TNED; 08452000 T 0698 + PROCEDURE TNEU; % TRANSFER WHILE NOT EQUAL, UPDATE 08453000 T 0698 + BEGIN P2R4 ← 1; FWDT ← 1; 08454000 T 0698 + XFERWHILE (TRUE, 2); P2R4 ← 0; FWDT ← 0; 08455000 T 0702 + END TNEU; 08456000 T 0707 + DEFINE MEMPROT = MEMPRO #; 08456500 T 0707 + PROCEDURE XFERWHILETF(TOGLE,UPDATE); 08457000 T 0707 +PRT(754) = XFERWHILETF + VALUE TOGLE,UPDATE; 08458000 T 0707 + BOOLEAN TOGLE,UPDATE; 08459000 T 0707 + BEGIN 08460000 T 0707 + LABEL OC,L12,L13,L14,L100,L1; 08461000 T 0707 + START OF SEGMENT ********** 77 + BOOLEAN LHFF; 08461100 T 0000 +STACK(F+2) = LHFF + ADJ (1,2); 08462000 T 0000 + IF AX.TAG ≠ DATADESC THEN 08463000 T 0001 + BEGIN 08464000 T 0002 + QF01 ← 1; 08465000 T 0002 + L1: JFIF; 08466000 T 0004 + GO OC; 08467000 T 0052 + END; 08468000 T 0052 + IF AX.PBIT = 0 THEN 08469000 T 0052 + BEGIN 08470000 T 0053 + QF02 ← 1; 08471000 T 0054 + 08472000 T 0056 + GO L1; 08473000 T 0056 + END; 08474000 T 0056 + IF A.IBIT ≠ 1 THEN TIR ← 0 ELSE 08475000 T 0056 + TIR ← IF A.SZ=0 THEN A.[12:16] ELSE A.INDEX; 08476000 T 0059 + TBR ← A.ADDR + TIR; 08477000 T 0063 + MOVE(A,C); 08478000 T 0065 + AROF ← FALSE; 08479000 T 0066 + IF UPDATE THEN EXSU ELSE EXSD; 08480000 T 0067 + CHARSZ; 08481000 T 0069 + IF RPF ← C.ADDR = 0 THEN BEGIN ENDE; GO OC END; 08482000 T 0077 + QH03 ← 1; 08483000 T 0080 + TFFF ← TRUE; 08484000 T 0082 + L12: 08484100 T 0082 + FETCHSOURCE; 08485000 T 0083 + IF QH03 = 1 THEN QH03 ← 0; 08486000 T 0162 + L13: FETCHDESTINATION; 08487000 T 0166 + L14: 08488000 T 0243 + MM ← DIS ← 0; 08489000 T 0244 + DYAL(A,MM,DYALSIB,2×REAL(SSZ=8),REAL(SSZ≠4)+2×REAL(SSZ=8)); 08490000 T 0245 + MM ← MM ← TBR; 08491000 T 0251 + DYAL(A,DIS,DYALSIB+1+2×REAL(SSZ=8),4-REAL(SSZ=4), 08492000 T 0252 + 5-REAL(SSZ=4)); 08493000 T 0257 + MOVE(M[MM],Y); MEMCYCLE; 08494000 T 0259 + IF BOOLEAN(YX.TAG) THEN MEMPROTECT; 08495000 T 0264 + DYAL(Y,AA,DIS,0,1); 08496000 T 0333 + Q03F ← REAL(TFFF← BOOLEAN(AA) EQV TOGLE); 08497000 T 0335 + IF Q03F=1 THEN DYAL(A,B,DYALSIB,DYALDIB,SSZ); 08498000 T 0338 + RPF ← RPF -1; 08499000 T 0343 + IF RPF = 0 THEN 08500000 T 0344 + BEGIN 08501000 T 0345 + LHFF ← TRUE; 08502000 T 0346 + STOREB; 08503000 T 0346 + IF TFFF THEN 08504000 T 0353 + BEGIN 08505000 T 0353 + L100: 08506000 T 0354 + ENDE; 08507000 T 0354 + ADJ(0,2); 08508000 T 0354 + A ← RPF; AX ← 0; 08509000 T 0355 + AROF ← TRUE; 08510000 T 0357 + GO OC; 08511000 T 0357 + END; 08512000 T 0358 + END; 08513000 T 0358 + BUMPSIB; 08514000 T 0358 + SWITCHSOURCE; 08514100 T 0360 + IF BUMPDIB=0 THEN 08514200 T 0369 + BEGIN 08514300 T 0371 + STOREB; 08514400 T 0372 + STEPDP; 08514500 T 0378 + END; 08514600 T 0380 + IF LHFF THEN IF UPDF THEN BEGIN ENDE; GO OC END ELSE GO L100; 08514700 T 0380 + IF SIB=0 THEN GO L12; 08514800 T 0383 + GO L13; 08514900 T 0384 + OC: 08515000 T 0385 + END OF TRANSFER ; 08516000 T 0385 + 77 IS 388 LONG, NEXT SEG 12 + PROCEDURE TWTD; % TRANSFER WHILE TRUE, DESTRUCTIVE 7.1.19 08517000 T 0707 + BEGIN 08518000 T 0707 + XFERWHILETF( TRUE , FALSE); % TRUE DESTRUCTIVE 08519000 T 0707 + END TWTD; 08520000 T 0709 + PROCEDURE TWTU ; % TRANSFER WHILE TRUE, UPDATE 7.1.20 08521000 T 0709 + BEGIN 08522000 T 0709 + XFERWHILETF( TRUE , TRUE ); % TRUE UPDATE 08523000 T 0709 + END TWTU; 08524000 T 0711 + PROCEDURE TWFD ; % TRANSFER WHILE FALSE, DESTRUCTIVE 7.1.21 08525000 T 0711 + BEGIN 08526000 T 0711 + XFERWHILETF( FALSE, FALSE); % FALSE DESTRUCTIVE 08527000 T 0711 + END TWFD; 08528000 T 0713 + PROCEDURE TWFU ; % TRANSFER WHILE FALSE, UPDATE 7.1.22 08529000 T 0713 + BEGIN 08530000 T 0713 + XFERWHILETF( FALSE, TRUE ); % FALSE UPDATE 08531000 T 0713 + END TWFU; 08532000 T 0715 + PROCEDURE TUND ; % TRANSFER UNCONDITIONAL , DESTRUCTIVE 7.1.23 08533000 T 0715 + BEGIN 08534000 T 0715 + ADJ(0,2); 08535000 T 0715 + A ← AX ← 0; 08536000 T 0717 + AROF ← TRUE; 08537000 T 0718 + XFERWHILE(FALSE,5); 08538000 T 0719 + END TUND; 08539000 T 0720 + PROCEDURE TUNU ; % TRANSFER UNCONDITIONAL , UPDATE 7.1.24 08540000 T 0720 + BEGIN 08541000 T 0720 + ADJ(0,2); 08542000 T 0720 + A←AX←0; 08543000 T 0722 + AROF←TRUE; 08544000 T 0723 + XFERWHILE(TRUE,5); 08545000 T 0724 + END TUNU; 08546000 T 0725 + PROCEDURE SCANWHILE(UPDATE,RELATION); 08547000 T 0725 +PRT(755) = SCANWHILE + VALUE UPDATE,RELATION; 08548000 T 0725 + BOOLEAN UPDATE; 08549000 T 0725 + INTEGER RELATION; 08550000 T 0725 + BEGIN 08551000 T 0725 + REAL ACHAR, BCHAR; 08552000 T 0725 + START OF SEGMENT ********** 78 +STACK(F+2) = ACHAR +STACK(F+3) = BCHAR + LABEL OC, L1, L2; 08553000 T 0000 + ADJ(1,1); 08553500 T 0000 + IF AX.TAG ≠ SINGL THEN 08554000 T 0001 + BEGIN 08554500 T 0002 + QF01 ← 1; 08555000 T 0002 + JFIF; 08555500 T 0004 + GO TO OC; 08556000 T 0052 + END; 08556500 T 0052 + MOVE(A,C); 08557000 T 0052 + AROF ← FALSE; SCANORXFER ← TRUE; SCANWH ← TRUE; 08557500 T 0053 + ENTEREDIT(1,UPDATE); 08558000 T 0055 + IF SSZ = 0 THEN SSZ ← 6; 08558500 T 0056 + DYAL(Y,BCHAR, SSZ - 1, SSZ - 1, SSZ); 08559000 T 0058 + TFFF ← TRUE; 08559500 T 0061 + IF C.ADDR = 0 THEN GO TO L2; 08560000 T 0062 + L1: FETCHSOURCE; 08561000 T 0064 + 08562000 T 0143 + DYAL (A, ACHAR,DYALSIB, SSZ - 1, SSZ); 08563000 T 0143 + COMPARECHAR; 08564000 T 0146 + IF NOT TFFF THEN ELSE 08565000 T 0159 + BEGIN 08566000 T 0160 + RPF ← RPF - 1; 08567000 T 0160 + IF RPF = 0 THEN LHFF ← 1; 08568000 T 0162 + BUMPSIB; 08569000 T 0165 + SWITCHSOURCE; 08570000 T 0167 + IF LHFF ≠ 1 THEN GO TO L1; 08571000 T 0175 + L2: IF NOT UPDF THEN 08572000 T 0177 + BEGIN 08572100 T 0178 + ENDE; 08573000 T 0179 + GO TO OC; 08574000 T 0179 + END; 08574100 T 0180 + END; 08575000 T 0180 + ENDE; 08576000 T 0180 + ADJ(0,2); 08577000 T 0180 + A ← RPF; AX ← 0; 08578000 T 0181 + AROF ← TRUE; 08579000 T 0183 + OC: SCANORXFER← SCANWH ← FALSE; 08580000 T 0183 + END OF SCANWHILE; 08581000 T 0185 + 78 IS 188 LONG, NEXT SEG 12 + PROCEDURE SGTD ; % SCAN WHILE GREATER, DESTRUCTIVE 7.2.1 08582000 T 0725 + BEGIN P2R3 ← 1; FWDT ← 1; 08583000 T 0725 + SCANWHILE ( FALSE , 1 ); 08584000 T 0729 + END SGTD; 08585000 T 0730 + PROCEDURE SGTU ; % SCAN WHILE GREATER, UPDATE 7.2.2 08586000 T 0730 + BEGIN P2R3 ← 1; FWDT ← 1; 08587000 T 0730 + SCANWHILE ( TRUE , 1 ); 08588000 T 0734 + END SGTU; 08589000 T 0735 + PROCEDURE SGED ; % SCAN WHILE GREATER OR EQUAL, DESTRUCTIVE7.2.3 08590000 T 0735 + BEGIN P2R3 ← 1; FWDT ← 1; 08591000 T 0735 + SCANWHILE ( FALSE , 5 ); 08592000 T 0739 + END SGED; 08593000 T 0740 + PROCEDURE SGEU ; % SCAN WHILE GREATER OR EQUAL, UPDATE 7.2.4 08594000 T 0740 + BEGIN P2R3 ← 1; FWDT ← 1; 08595000 T 0740 + SCANWHILE ( TRUE , 5 ); 08596000 T 0744 + END SGEU; 08597000 T 0745 + PROCEDURE SEQD ; % SCAN WHILE EQUAL, DESTRUCTIVE 7.2.5 08598000 T 0745 + BEGIN P2R3 ← 1; FWDT ← 1; 08599000 T 0745 + SCANWHILE ( FALSE , 4 ); 08600000 T 0749 + END SEQD; 08601000 T 0750 + PROCEDURE SEQU ; % SCAN WHILE EQUAL, UPDATE 7.2.6 08602000 T 0750 + BEGIN P2R3 ← 1; FWDT ← 1; 08603000 T 0750 + SCANWHILE ( TRUE , 4 ); 08604000 T 0754 + END SEQU; 08605000 T 0755 + PROCEDURE SLED ; % SCAN WHILE LESS OR EQUAL, DESTRUCTIVE 7.2.7 08606000 T 0755 + BEGIN P2R3 ← 1; FWDT ← 1; 08607000 T 0755 + SCANWHILE ( FALSE , 6 ); 08608000 T 0759 + END SLED; 08609000 T 0760 + PROCEDURE SLEU ; % SCAN WHILE LESS OR EQUAL, UPDATE 7.2.8 08610000 T 0760 + BEGIN P2R3 ← 1; FWDT ← 1; 08611000 T 0760 + SCANWHILE ( TRUE , 6 ); 08612000 T 0764 + END SLEU; 08613000 T 0765 + PROCEDURE SLSD ; % SCAN WHILE LESS, DESTRUCTIVE 7.2.9 08614000 T 0765 + BEGIN P2R3 ← 1; FWDT ← 1; 08615000 T 0765 + SCANWHILE ( FALSE , 3 ); 08616000 T 0769 + END SLSD; 08617000 T 0770 + PROCEDURE SLSU ; % SCAN WHILE LESS, UPDATE 7.2.10 08618000 T 0770 + BEGIN P2R3 ← 1; FWDT ← 1; 08619000 T 0770 + SCANWHILE ( TRUE , 3 ); 08620000 T 0774 + END SLSU; 08621000 T 0775 + PROCEDURE SNED ; % SCAN WHILE NOT EQUAL, DESTRUCTIVE 7.2.11 08622000 T 0775 + BEGIN P2R3 ← 1; FWDT ← 1; 08623000 T 0775 + SCANWHILE ( FALSE , 2 ); 08624000 T 0779 + END SNED; 08625000 T 0780 + PROCEDURE SNEU ; % SCAN WHILE NOT EQUAL, UPDATE 7.2.12 08626000 T 0780 + BEGIN P2R3 ← 1; FWDT ← 1; 08627000 T 0780 + SCANWHILE ( TRUE , 2 ); 08628000 T 0784 + END SNEU; 08629000 T 0785 + PROCEDURE SCANWHILETF(TOGLE,UPDATE); 08630000 T 0785 +PRT(756) = SCANWHILETF + VALUE TOGLE,UPDATE; 08631000 T 0785 + BOOLEAN TOGLE,UPDATE; 08632000 T 0785 + BEGIN 08633000 T 0785 + LABEL OC,L8 ,L100,L21; 08634000 T 0785 + START OF SEGMENT ********** 79 + BOOLEAN LHFF; 08634100 T 0000 +STACK(F+2) = LHFF + ADJ(1,2); 08635000 T 0000 + IF AX.TAG≠ DATADESC THEN 08636000 T 0001 + BEGIN 08637000 T 0002 + QF01 ← 1; 08638000 T 0002 + L21: 08639000 T 0004 + JFIF; 08640000 T 0005 + GO OC; 08641000 T 0052 + END; 08642000 T 0052 + IF AX.PBIT=0 THEN 08643000 T 0052 + BEGIN 08644000 T 0053 + QF02←1; 08644100 T 0054 + GO L21; 08644200 T 0056 + END; 08644300 T 0056 + AROF ← FALSE; 08645000 T 0056 + IF NOT(BOOLEAN(A.IBIT)) THEN TIR←0 ELSE 08646000 T 0057 + TIR ← IF A.CHRSZ = 0 THEN A.INDEX ELSE A.TIRF; 08647000 T 0059 + TIR←A.ADDR+TIR; 08648000 T 0064 + ENTEREDIT(1,UPDATE); 08649000 T 0066 + IF SSZ = 0 THEN SSZ ← 6; 08650000 T 0067 + RPF ← C.ADDR; 08651000 T 0069 + IF RPF =0 THEN 08652000 T 0070 + BEGIN 08653000 T 0071 + L100: 08654000 T 0071 + ENDE; 08655000 T 0072 + ADJ(0,2); 08656000 T 0072 + A ←RPF; AX ← 0; 08657000 T 0073 + AROF ← TRUE; 08658000 T 0075 + GO OC; 08659000 T 0075 + END; 08660000 T 0076 + TFFF ← TRUE; 08661000 T 0076 + L8: 08662000 T 0077 + FETCHSOURCE; 08663000 T 0077 + MM ← DIS ← 0; 08664000 T 0156 + DYAL(A,MM,DYALSIB,2×REAL(SSZ=8),REAL(SSZ≠4)+2×REAL(SSZ=4)); 08665000 T 0157 + MOVE(M[MM],Y); MEMCYCLE; 08666000 T 0163 + IF BOOLEAN(YX.TAG) THEN MEMPROTECT; 08667000 T 0168 + DYAL(Y,AA,DIS,0,1); 08668000 T 0238 + Q03F ← REAL(TFFF←BOOLEAN(AA) EQV TOGLE); 08669000 T 0240 + IF Q03F=0 THEN BEGIN TFFF←FALSE; GO L100 END; 08670000 T 0243 + RPF ← RPF -1; 08671000 T 0246 + IF RPF = 0 THEN LHFF ← TRUE; 08672000 T 0247 + BUMPSIB; SWITCHSOURCE; 08673000 T 0249 + IF LHFF THEN IF UPDF THEN GO L100 ELSE BEGIN ENDE; GO OC END; 08674000 T 0260 + GO TO L8; 08675000 T 0262 + 08676000 T 0263 + OC: 08677000 T 0263 + END OF SCAN ; 08678000 T 0264 + 79 IS 267 LONG, NEXT SEG 12 + PROCEDURE SWTD ; % SCAN WHILE TRUE, DESTRUCTIVE 7.2.13 08679000 T 0785 + BEGIN 08680000 T 0785 + SCANWHILETF( TRUE , FALSE); % TRUE DESTRUCTIVE 08681000 T 0785 + END SWTD; 08682000 T 0787 + PROCEDURE SWTU ; % SCAN WHILE TRUE, UPDATE 7.2.14 08683000 T 0787 + BEGIN 08684000 T 0787 + SCANWHILETF( TRUE , TRUE ); % TRUE UPDATE 08685000 T 0787 + END SWTU; 08686000 T 0789 + PROCEDURE SWFD ; % SCAN WHILE FALSE, DESTRUCTIVE 7.2.15 08687000 T 0789 + BEGIN 08688000 T 0789 + SCANWHILETF( FALSE, FALSE); % FALSE DESTRUCTIVE 08689000 T 0789 + END SWFD; 08690000 T 0791 + PROCEDURE SWFU ; % SCAN WHILE FALSE, UPDATE 7.2.16 08691000 T 0791 + BEGIN 08692000 T 0791 + SCANWHILETF( FALSE, TRUE ); % FALSE UPDATE 08693000 T 0791 + END SWFU; 08694000 T 0793 + PROCEDURE COMPARECHRS(UPDATE,RELATION); 08695000 T 0793 +PRT(757) = COMPARECHRS + VALUE UPDATE,RELATION; 08696000 T 0793 + BOOLEAN UPDATE; 08697000 T 0793 + INTEGER RELATION; 08698000 T 0793 + BEGIN 08699000 T 0793 + INTEGER ACHAR, BCHAR; 08700000 T 0793 + START OF SEGMENT ********** 80 +STACK(F+2) = ACHAR +STACK(F+3) = BCHAR + LABEL OC, L1; 08701000 T 0000 + ENTEREDIT(0,UPDATE); 08702000 T 0000 + CHARSZ; 08703000 T 0001 + RPF ← C.ADDR; 08704000 T 0008 + IF RPF = 0 THEN 08705000 T 0009 + BEGIN 08706000 T 0010 + ENDE; 08707000 T 0011 + GO TO OC; 08708000 T 0011 + END; 08709000 T 0012 + L1: TFFF ← TRUE; 08710000 T 0012 + FETCHSOURCE; 08711000 T 0012 + FETCHDESTINATION; 08712000 T 0091 + DYAL(A,BCHAR,DYALSIB, SSZ - 1, SSZ); 08713000 T 0169 + DYAL(B, ACHAR, DYALDIB, SSZ - 1, SSZ); 08714000 T 0172 + COMPARECHAR; 08715000 T 0176 + RPF ← RPF - 1; 08716000 T 0188 + BUMPSIB; 08717000 T 0189 + SWITCHSOURCE; 08718000 T 0192 + IF BUMPDIB = 0 THEN 08719000 T 0200 + BEGIN 08720000 T 0203 + STEPDP; 08721000 T 0203 + BROF ← FALSE; 08722000 T 0205 + END; 08723000 T 0206 + IF RPF = 0 THEN 08724000 T 0206 + BEGIN 08725000 T 0207 + BROF ← FALSE; 08726000 T 0207 + ENDE; 08727000 T 0208 + GO TO OC; 08728000 T 0209 + END; 08729000 T 0209 + GO TO L1; 08730000 T 0209 + OC: 08730500 T 0210 + END OF COMPARE CHARACTERS; 08731000 T 0210 + 80 IS 213 LONG, NEXT SEG 12 + PROCEDURE CGTD ; % COMPARE CHARACTERS GREATER, DESTRUCTIVE 7.3.1 08732000 T 0793 + BEGIN P2R3 ← 1; 08733000 T 0793 + COMPARECHRS( FALSE , 1 ); % DESTRUCTIVE GREATER 08734000 T 0795 + END CGTD; 08735000 T 0796 + PROCEDURE CGTU ; % COMPARE CHARACTERS GREATER, UPDATE 7.3.2 08736000 T 0797 + BEGIN P2R3 ← 1; 08737000 T 0797 + COMPARECHRS( TRUE , 1 ); % UPDATE GREATER 08738000 T 0798 + END CGTU; 08739000 T 0799 + PROCEDURE CGED ; % COMPARE CHARACTERS GREATER OR EQUAL, DST7.3.3 08740000 T 0800 + BEGIN P2R3 ← 1; 08741000 T 0800 + COMPARECHRS( FALSE , 5 ); % DESTRUCTIVE GREATER EQUAL 08742000 T 0801 + END CGED; 08743000 T 0802 + PROCEDURE CGEU ; % COMPARE CHARACTERS GREATER OR EQUAL, UPD7.3.4 08744000 T 0803 + BEGIN P2R3 ← 1; 08745000 T 0803 + COMPARECHRS( TRUE , 5 ); % UPDATE GREATER EQUAL 08746000 T 0804 + END CGEU; 08747000 T 0805 + PROCEDURE CEQD ; % COMPARE CHARACTERS EQUAL, DESTRUCTIVE 7.3.5 08748000 T 0806 + BEGIN P2R3 ← 1; 08749000 T 0806 + COMPARECHRS( FALSE , 4 ); % DESTRUCTIVE EQUAL 08750000 T 0807 + END CEQD; 08751000 T 0808 + PROCEDURE CEQU ; % COMPARE CHARACTERS EQUAL, UPDATE 7.3.6 08752000 T 0809 + BEGIN P2R3 ← 1; 08753000 T 0809 + COMPARECHRS( TRUE , 4 ); % UPDATE EQUAL 08754000 T 0810 + END CEQU; 08755000 T 0811 + PROCEDURE CLED ; % COMPARE CHARACTERS LESS OR EQUAL, DST 7.3.7 08756000 T 0812 + BEGIN P2R3 ← 1; 08757000 T 0812 + COMPARECHRS( FALSE , 6 ); % DESTRUCTIVE LESS EQUAL 08758000 T 0813 + END CLED; 08759000 T 0814 + PROCEDURE CLEU ; % COMPARE CHARACTERS LESS OR EQUAL, UPD 7.3.8 08760000 T 0815 + BEGIN P2R3 ← 1; 08761000 T 0815 + COMPARECHRS( TRUE , 6 ); % UPDATE LESS EQUAL 08762000 T 0816 + END CLEU; 08763000 T 0817 + PROCEDURE CLSD ; % COMPARE CHARACTERS LESS, DESTRUCTIVE 7.3.9 08764000 T 0818 + BEGIN P2R3 ← 1; 08765000 T 0818 + COMPARECHRS( FALSE , 3 ); % DESTRUCTIVE LESS 08766000 T 0819 + END CLSD; 08767000 T 0820 + PROCEDURE CLSU ; % COMPARE CHARACTERS LESS, UPDATE 7.3.10 08768000 T 0821 + BEGIN P2R3 ← 1; 08769000 T 0821 + COMPARECHRS( TRUE , 3 ); % UPDATE LESS 08770000 T 0822 + END CLSU; 08771000 T 0823 + PROCEDURE CNED ; % COMPARE CHARACTERS NOT EQUAL, DESTRUCTVE7.3.11 08772000 T 0824 + BEGIN P2R3 ← 1; 08773000 T 0824 + COMPARECHRS( FALSE , 2 ); % DESTRUCTIVE NOT EQUAL 08774000 T 0825 + END CNED; 08775000 T 0826 + PROCEDURE CNEU ; % COMPARE CHARACTERS NOT EQUAL, UPDATE 7.3.12 08776000 T 0827 + BEGIN P2R3 ← 1; 08777000 T 0827 + COMPARECHRS( TRUE , 2 ); % UPDATE NOT EQUAL 08778000 T 0828 + END CNEU; 08779000 T 0829 + DEFINE RPZF = BKIP#; 08779500 T 0830 + PROCEDURE UNPACKS(SIGNED,UPDATE); 08780000 T 0830 +PRT(760) = UNPACKS + VALUE SIGNED,UPDATE; 08781000 T 0830 + BOOLEAN SIGNED,UPDATE; 08782000 T 0830 + BEGIN 08783000 T 0830 + LABEL OC, L1, L2, L3, L4, L5, L6, L7, L8; 08784000 T 0830 + START OF SEGMENT ********** 81 + INTEGER RITEJUSTIFY; 08784500 T 0000 +STACK(F+2) = RITEJUSTIFY + ADJ (1,1); 08785000 T 0000 + IF BX.TAG = SINGL OR BX.TAG = DOUBL THEN ELSE 08785500 T 0001 + BEGIN 08786000 T 0004 + QF01 ← 1; 08786500 T 0004 + JFIF; 08787000 T 0006 + GO TO OC; 08787500 T 0054 + END; 08788000 T 0054 + ENTEREDIT (0, UPDATE); 08788500 T 0054 + RPF ← C.ADDR; 08789000 T 0055 + IF C.ADDR > 24 THEN 08789500 T 0056 + BEGIN 08790000 T 0058 + BROF ← TRUE; 08790500 T 0058 + QF01 ← 1; 08791000 T 0059 + JFIF; 08791500 T 0061 + GO TO OC; 08792000 T 0108 + END; 08792500 T 0108 + SSZ ← 4; 08793000 T 0108 + IF DSZ = 0 THEN DSZ ← 6; 08793500 T 0109 + IF RPF = 0 THEN 08794000 T 0111 + BEGIN 08794500 T 0112 + ENDE; GO TO OC; 08795000 T 0112 + END; 08795500 T 0113 + IF RPF = 1 THEN LHFF ← 1; 08796000 T 0113 + IF DSZ = 4 THEN RPZF ← 1; 08796500 T 0116 + L4: FETCHDESTINATION; 08797000 T 0119 + L7: IF DSZ = 4 THEN GO TO L1; 08797500 T 0197 + IF DSZ = 6 THEN GO TO L2; 08798000 T 0199 + IF NOT SIGNED THEN ELSE 08798500 T 0200 + IF LHFF ≠ 1 THEN ELSE 08799000 T 0201 + IF EXTF THEN 08799500 T 0203 + BEGIN 08800000 T 0204 + RITEJUSTIFY.[40:4] ← 32; 08800500 T 0205 + GO TO L3; 08801000 T 0206 + END; 08801500 T 0207 + RITEJUSTIFY.[40:4] ← 36; 08802000 T 0207 + L3: DYAL (RITEJUSTIFY, B, 40, DYALDIB, 4); 08802500 T 0209 + DYAL (A, B, DYALSIB, (DYALDIB - 4), 4); 08803000 T 0211 + GO TO L8; 08803500 T 0216 + L2: IF NOT SIGNED THEN ELSE 08804000 T 0216 + IF LHFF ≠ 1 THEN ELSE 08804500 T 0218 + IF EXTF THEN 08805000 T 0220 + BEGIN 08805500 T 0221 + RITEJUSTIFY.[42:2] ← 2; 08806000 T 0221 + GO TO L6; 08806500 T 0223 + END; 08807000 T 0223 + RITEJUSTIFY.[42:2] ← 0; 08807500 T 0223 + L6: DYAL (RITEJUSTIFY, B, 42, DYALDIB, 2); 08808000 T 0225 + DYAL (A, B, DYALSIB, (DYALDIB - 2), 4); 08808500 T 0228 + GO TO L8; 08809000 T 0233 + L1: IF SIGNED THEN 08809500 T 0233 + BEGIN 08810000 T 0234 + IF RPZF = 1 THEN 08810500 T 0234 + BEGIN 08811000 T 0236 + IF EXTF THEN RITEJUSTIFY ← 14 ELSE 08811500 T 0236 + RITEJUSTIFY ← 15; 08812000 T 0238 + DYAL(RITEJUSTIFY,B,3,DYALDIB,4); 08812500 T 0239 + GO TO L5; 08813000 T 0242 + END; 08813500 T 0242 + END; 08814000 T 0242 + DYAL (A, B, DYALSIB, DYALDIB, 4); 08815000 T 0242 + L8: BUMPSIB; 08816000 T 0246 + L5: IF BUMPDIB = 0 THEN 08817000 T 0249 + BEGIN 08818000 T 0252 + STOREB; 08819000 T 0253 + STEPDP; 08820000 T 0259 + END; 08821000 T 0261 + BEGIN 08822000 T 0261 + IF AX.TAG = DOUBL THEN 08822500 T 0261 + BEGIN 08823000 T 0263 + MOVE (A, JUNK); 08823500 T 0263 + MOVE (X, A); 08823800 T 0264 + MOVE (JUNK, X); 08824000 T 0265 + END; 08824400 T 0266 + END; 08824800 T 0266 + IF RPZF = 1 THEN RPZF ← 0 ELSE 08825000 T 0266 + RPF ← RPF - 1; 08825500 T 0270 + IF RPF = 0 THEN 08826000 T 0271 + BEGIN 08827000 T 0272 + IF DIB ≠ 0 THEN BROF ← TRUE; 08828000 T 0273 + ENDE; 08828500 T 0275 + GO TO OC; 08829000 T 0275 + END; 08830000 T 0276 + IF RPF = 1 THEN LHFF ← 1; 08831000 T 0276 + IF DIB = 0 THEN GO TO L4; 08832000 T 0279 + GO TO L7; 08833000 T 0280 + OC: 08834000 T 0280 + END OF UNPACKS; 08835000 T 0281 + 81 IS 284 LONG, NEXT SEG 12 + PROCEDURE PACKS (UPDATE); 08835100 T 0830 +PRT(761) = PACKS + VALUE UPDATE; 08835200 T 0830 + BOOLEAN UPDATE; 08835300 T 0830 + BEGIN 08835400 T 0830 + LABEL OC, L1, L2, L3; 08835500 T 0830 + START OF SEGMENT ********** 82 + ENTEREDIT (1, UPDATE); 08835600 T 0000 + RPF ← C.ADDR; 08835700 T 0001 + IF C.ADDR > 24 THEN 08835800 T 0002 + BEGIN 08835900 T 0003 + AROF ← TRUE; 08836000 T 0004 + QF01 ← 1; 08836100 T 0004 + JFIF; 08836200 T 0006 + GO TO OC; 08836300 T 0054 + END; 08836400 T 0054 + IF C.ADDR = 0 THEN 08836500 T 0054 + BEGIN 08836600 T 0055 + ENDE; 08836700 T 0056 + GO TO OC; 08836800 T 0056 + END; 08836900 T 0057 + TFFF←BOOLEAN(B←BX←0); 08836910 T 0057 + IF RPF > 12 THEN 08837000 T 0059 + BEGIN 08837100 T 0059 + BX.TAG ← DOUBL; 08837200 T 0060 + QH02 ← 1; 08837300 T 0062 + DIB ← 24 -RPF; 08837400 T 0063 + END ELSE 08837500 T 0065 + DIB ← 12 -RPF; 08837600 T 0065 + DSZ ← 4; 08837700 T 0066 + IF SSZ = 0 THEN 08837800 T 0067 + BEGIN 08837900 T 0068 + SSZ ← 6; 08838000 T 0068 + MOVE (A, Y); 08838100 T 0069 + END; 08838200 T 0070 + QH03 ← 1; 08838300 T 0070 + IF NOT SOPF THEN 08838400 T 0072 + BEGIN 08838500 T 0072 + L1: MM ← SBR + SIR; 08838600 T 0073 + MOVE (M[MM], A); 08838700 T 0075 + IF BOOLEAN (AX.TAG) THEN 08838800 T 0079 + BEGIN 08838900 T 0080 + MOVE (Y, A); 08839000 T 0080 + MOVE (C, B); 08839100 T 0081 + AROF ← BROF ← TRUE; 08839200 T 0082 + QF04 ← 1; 08839300 T 0083 + JFIF; 08839400 T 0085 + GO TO OC; 08839500 T 0133 + END; 08839600 T 0133 + END; 08839700 T 0133 + L3: IF SSZ ≠ 4 THEN 08839800 T 0133 + BEGIN 08839900 T 0134 + IF SSZ = 6 THEN 08840000 T 0135 + BEGIN DYAL(A,B,DYALSIB-2,DYALDIB,4); 08840100 T 0136 + DYAL(A,INTG,DYALSIB,0,1); TFFF←BOOLEAN(INTG); 08840110 T 0140 + 08840120 T 0144 + END ELSE 08840130 T 0144 + BEGIN DYAL(A,B,DYALSIB-4,DYALDIB,4); 08840200 T 0144 + DYAL(A,INTG,DYALSIB-2,0,1); 08840210 T 0149 + TFFF ← INTG = 0; 08840220 T 0152 + END; 08840230 T 0153 + END ELSE 08840300 T 0153 + IF QH03 = 1 THEN 08840400 T 0153 + BEGIN 08840500 T 0155 + QH03 ← 0; 08840600 T 0155 + DYAL (A, JUNK, DYALSIB, 44, 4); 08840700 T 0157 + IF JUNK.[44:4] > 9 THEN TFFF←JUNK.[44:4]=13 08840800 T 0160 + ELSE DYAL(A,B,DYALSIB,DYALDIB,4); 08840900 T 0162 + END ELSE 08841000 T 0168 + GO TO L2; 08841100 T 0168 + BUMPDIB; 08841200 T 0168 + L2: IF BUMPSIB = 0 THEN 08841300 T 0170 + BEGIN 08841400 T 0173 + IF SOPF THEN 08841500 T 0174 + BEGIN 08841600 T 0174 + MOVE (A, JUNK); 08841700 T 0175 + MOVE (X, A); 08841800 T 0176 + MOVE (JUNK, X); 08841900 T 0177 + END ELSE 08842000 T 0178 + SIR ← SIR + 1; 08842100 T 0178 + IF DIB ≠ 0 THEN GO TO L1; 08842200 T 0179 + IF QH02 = 1 THEN 08842300 T 0181 + BEGIN 08842400 T 0182 + QH02 ← 0; 08842500 T 0182 + GO TO L1; 08842600 T 0184 + END ELSE 08842700 T 0185 + BEGIN 08842800 T 0185 + BROF ← TRUE; 08842900 T 0185 + ADJ (2, 0); 08843000 T 0186 + ENDE; 08843100 T 0187 + GO TO OC; 08843200 T 0187 + END; 08843300 T 0188 + END ELSE 08843400 T 0188 + IF DIB ≠ 0 THEN GO TO L3; 08843500 T 0188 + BROF ← TRUE; 08843600 T 0190 + IF AROF THEN ADJ(1,0) ELSE ADJ(0,0); 08843700 T 0190 + IF QH02 = 1 THEN 08844000 T 0194 + BEGIN 08844500 T 0195 + QH02 ← 0; 08845000 T 0195 + GO TO L3; 08845500 T 0197 + END; 08846000 T 0198 + TFFF←DSZ=6 AND B.[42:1]=1 OR DSZ =8 AND B.[42:1]=0; 08847000 T 0198 + ENDE; 08847500 T 0203 + OC: 08848000 T 0203 + END OF PACKS; 08848500 T 0204 + 82 IS 205 LONG, NEXT SEG 12 + 08849000 T 0830 + PROCEDURE UABD; % UNPACK ABSOLUTE, DESTRUCTIVE 08849500 T 0830 + BEGIN P2R3 ← 1; 08850000 T 0830 + UNPACKS (FALSE, FALSE); 08850500 T 0831 + END UABD; 08851000 T 0832 + PROCEDURE UABU; % UNPACK ABSOLUTE, UPDATE 08851500 T 0833 + BEGIN P2R3 ← 1; 08852000 T 0833 + UNPACKS (FALSE, TRUE); 08852500 T 0834 + END UABU; 08853000 T 0835 + PROCEDURE USND; % UNPACK SIGNED, DESTRUCTIVE 08853500 T 0836 + BEGIN P2R3 ← 1; 08854000 T 0836 + UNPACKS (TRUE, FALSE); 08854500 T 0837 + END USND; 08855000 T 0838 + PROCEDURE USNU; % UNPACK SIGNED, UPDATE 08855500 T 0839 + BEGIN P2R3 ← 1; 08856000 T 0839 + UNPACKS (TRUE, TRUE); 08856500 T 0840 + END USNU; 08857000 T 0841 + PROCEDURE PACD; % PACK DESTRUCTIVE 08857500 T 0842 + BEGIN SWPS ← 1; P2R2 ← 1; 08858000 T 0842 + PACKS (FALSE); 08858500 T 0845 + END PACD; 08859000 T 0846 + PROCEDURE PACU; % PACK UPDATE 08859100 T 0846 + BEGIN SWPS ← 1; P2R2 ← 1; 08859200 T 0846 + PACKS (TRUE); 08859300 T 0850 + END PACU; 08859400 T 0851 + PROCEDURE TRNS ; % TRANSLATE 7.5 08860000 T 0851 + BEGIN 08861000 T 0851 + LABEL OC; 08862000 T 0851 + START OF SEGMENT ********** 83 + ADJ(1,2); 08863000 T 0000 + IF AX.TAG ≠ DATADESC THEN INVOPI; 08864000 T 0001 + IF BOOLEAN(AX) THEN ELSE 08865000 T 0005 + BEGIN 08866000 T 0005 + ADJ(0,0); 08867000 T 0006 + AX ← BX ← 0; 08868000 T 0007 + AROF ← BROF ← TRUE; 08869000 T 0008 + A ← S; 08870000 T 0009 + SETINTERRUPT(B←PRESBIT); 08871000 T 0010 + END; 08872000 T 0011 + AROF ← FALSE; 08873000 T 0011 + IF A.IBIT=0 THEN TIR ← 0 ELSE 08874000 T 0012 + TIR ← IF A.CHRSZ = 0 THEN A.INDEX ELSE A.TIRF; 08875000 T 0015 + TBR ← TIR + A.ADDR; 08876000 T 0021 + ENTEREDIT( 0,FALSE); 08877000 T 0023 + CHARSZ; 08878000 T 0024 + DIS ← 7; 08879000 T 0031 + RPF ← C.ADDR - 1; 08880000 T 0032 + WHILE RPF ≥ 0 DO 08881000 T 0034 + BEGIN 08882000 T 0035 + FETCHSOURCE; 08883000 T 0035 + FETCHDESTINATION; 08884000 T 0114 + MM ← 0; 08885000 T 0192 + DYAL(A,JUNK,DYALSIB,5,SSZ-2); 08886000 T 0193 + IF SSZ=4 THEN MM←JUNK.[42:2] ELSE 08887000 T 0196 + IF SSZ=6 THEN MM←JUNK.[42:4] ELSE MM←JUNK.[42:6]; 08888000 T 0199 + MM ← TBR + MM; 08889000 T 0203 + DYAL(A,JUNK,DYALSIB-SSZ+2,4,2); 08890000 T 0205 + DIS.[43:2] ← REAL(NOT BOOLEAN(JUNK)).[43:2]; 08891000 T 0208 + MOVE(M[MM],C); MEMCYCLE; 08892000 T 0211 + DYAL(C,8,DIS,DYALDIB,DSZ); 08893000 T 0216 + RPF ← RPF - 1; 08894000 T 0219 + BUMPSIB; 08895000 T 0220 + SWITCHSOURCE; 08896000 T 0222 + IF BUMPSIB = 0 THEN 08897000 T 0231 + BEGIN 08898000 T 0234 + STOREB; 08899000 T 0234 + STEPDP; 08900000 T 0241 + DIR ← DIR + 1; 08901000 T 0243 + END; 08902000 T 0244 + END; 08903000 T 0244 + ENDE; 08904000 T 0244 + OC: 08905000 T 0245 + END TRNS; 08906000 T 0246 + 83 IS 247 LONG, NEXT SEG 12 + PROCEDURE SCALE(TOG); VALUE TOG; BOOLEAN TOG; 08906010 T 0851 +PRT(762) = SCALE + BEGIN 08906020 T 0851 + DEFINE DYNAMIC = TOG #, %1 08906030 T 0851 + START OF SEGMENT ********** 84 + SAVER = TOG.[46:1]#, % 2 08906040 T 0000 + RIGHT = TOG.[45:1]#, % 4 08906050 T 0000 + FINAL = TOG.[44:1]#, % 6 08906060 T 0000 + ROUND = TOG.[43:1]#; % 16 08906070 T 0000 + REAL DIGR, TA, TX; 08906080 T 0000 +STACK(F+2) = DIGR +STACK(F+3) = TA +STACK(F+4) = TX + LABEL OC; 08906090 T 0000 + INTEGER SIGNQ,SIGNQH; 08906100 T 0000 +STACK(F+5) = SIGNQ +STACK(F+6) = SIGNQH + DEFINE SETINT = BEGIN 08906110 T 0000 + SETINTERRUPT(INVOP ); 08906120 T 0000 + ADJ(0,0); AROF ← BROF ← TRUE; 08906130 T 0000 + GO OC; 08906140 T 0000 + END#; 08906150 T 0000 + ADJ(0,1); 08906160 T 0000 + IF DYNAMIC THEN 08906170 T 0001 + BEGIN 08906180 T 0001 + NTGR; 08906190 T 0001 + IF SDIS=1 THEN 08906200 T 0002 + BEGIN 08906210 T 0003 + SETINTERRUPT(INTOVFI); 08906220 T 0004 + GO OC; 08906230 T 0004 + END; 08906240 T 0007 + END ELSE 08906250 T 0007 + BEGIN 08906260 T 0007 + C ← SYLLABLE; CX ← 0; 08906270 T 0007 + STEPPSR(1); 08906280 T 0011 + MOVE(C,A); 08906290 T 0011 + END; 08906300 T 0012 + DIGR ← A.[44:4]; 08906310 T 0012 + AROF ← FALSE; 08906320 T 0014 + IF INTEGERIZE(FALSE,B) THEN 08906330 T 0014 + BEGIN 08906340 T 0015 + SETINTERRUPT(INTOVFI); 08906350 T 0016 + GO OC; 08906360 T 0017 + END; 08906370 T 0019 + ADJ(1,0); 08906380 T 0019 + IF DIGR < 13 THEN ELSE 08906390 T 0020 + IF RIGHT THEN SETINT ELSE 08906400 T 0021 + BEGIN 08906410 T 0028 + OFFF ← TRUE; 08906420 T 0028 + GO OC; 08906430 T 0029 + END; 08906440 T 0029 + IF RIGHT THEN 08906450 T 0029 + BEGIN 08906460 T 0030 + MOVE(A,TA); 08906470 T 0031 + DOUBLE(A,X,10*DIGR,0,/,←,A,X); 08906480 T 0032 + SIGNQ ← SIGN(A); B.SOBIT ← 0; 08906490 T 0036 + MOVE(A,SSZ); 08906500 T 0040 + IF INTEGERIZE(FALSE,SSZ) THEN 08906510 T 0041 + BEGIN 08906520 T 0042 + SETINTERRUPT(INTOVFI); 08906530 T 0043 + GO OC; 08906540 T 0044 + END; 08906550 T 0046 + DSZ ← 0; 08906560 T 0046 + DOUBLE(TA,TX,10*DIGR,0,SIGNQ,SIGNQH,SSZ,DSZ, 08906570 T 0046 + ×,×,-,←,TA,TX); 08906580 T 0051 + FOR JUNK←0 STEP 1 UNTIL DIGR-1 DO 08906590 T 0052 + DYAL(TA,B,36-6×JUNK,4×JUNK,4); 08906600 T 0057 + END ELSE 08906610 T 0060 + DOUBLE(A,X,10*DIGR,0,×,←,A,X); 08906620 T 0060 + IF ROUND THEN ELSE GO OC; 08906630 T 0065 + IF FINAL THEN 08906640 T 0067 + BEGIN 08906650 T 0067 + BROF ← TRUE; 08906660 T 0068 + AROF ← FALSE; EXTF ← BOOLEAN(SIGN(A)); 08906670 T 0069 + IF A≠0 THEN OFFF ← TRUE; 08906680 T 0072 + END ELSE 08906690 T 0074 + IF SAVER THEN BROF ← TRUE ELSE 08906700 T 0074 + IF ROUND THEN 08906710 T 0076 + IF BX.PBIT=1 OR B.[1:3]>4 THEN X ← X + 1; 08906720 T 0078 + OC: 08906730 T 0083 + END SCALE; 08906740 T 0083 + 84 IS 87 LONG, NEXT SEG 12 + PROCEDURE SCLF ; % SCALE LEFT 7.6.1 08907000 T 0851 + BEGIN 08908000 T 0851 + SCALE(BOOLEAN( 0)); 08909000 T 0851 + END SCLF; 08910000 T 0852 + PROCEDURE DSLF ; % DYNAMIC SCALE LEFT 7.6.2 08911000 T 0853 + BEGIN 08912000 T 0853 + SCALE(BOOLEAN( 1)); 08913000 T 0853 + END DSLF; 08914000 T 0853 + PROCEDURE SCRS ; % SCALE RIGHT SAVE 7.6.3 08915000 T 0854 + BEGIN 08916000 T 0854 + SCALE(BOOLEAN( 6)); 08917000 T 0854 + END SCRS; 08918000 T 0854 + PROCEDURE DSRS ; % DYNAMIC SCALE RIGHT SAVE 7.6.4 08919000 T 0855 + BEGIN 08920000 T 0855 + SCALE(BOOLEAN( 7)); 08921000 T 0855 + END DSRS; 08922000 T 0855 + PROCEDURE SCRT ; % SCALE RIGHT TRUNCATE 7.6.5 08923000 T 0856 + BEGIN 08924000 T 0856 + SCALE(BOOLEAN(20)); 08925000 T 0856 + END SCRT; 08926000 T 0856 + PROCEDURE DSRT ; % DYNAMIC SCALE RIGHT TRUNCATE 7.6.6 08927000 T 0857 + BEGIN 08928000 T 0857 + SCALE(BOOLEAN(21)); 08929000 T 0857 + END DSRT; 08930000 T 0857 + PROCEDURE SCRR ; % SCALE RIGHT ROUND 7.6.7 08931000 T 0858 + BEGIN 08932000 T 0858 + SCALE(BOOLEAN( 4)); 08933000 T 0858 + END SCRR; 08934000 T 0858 + PROCEDURE DSRR ; % DYNAMIC SCALE RIGHT ROUND 7.6.8 08935000 T 0859 + BEGIN 08936000 T 0859 + SCALE(BOOLEAN( 5)); 08937000 T 0859 + END DSRR; 08938000 T 0859 + PROCEDURE SCRF ; % SCALE RIGHT FINAL 7.6.9 08939000 T 0860 + BEGIN 08940000 T 0860 + SCALE(BOOLEAN(12)); 08941000 T 0860 + END SCRF; 08942000 T 0860 + PROCEDURE DSRF ; % DYNAMIC SCALE RIGHT FINAL 7.6.10 08943000 T 0861 + BEGIN 08944000 T 0861 + SCALE(BOOLEAN(13)); 08945000 T 0861 + END DSRF; 08946000 T 0861 + PROCEDURE OCRX ; % OCCURS INDEX 7.7 08947000 T 0862 + BEGIN 08948000 T 0862 + LABEL OC; 08949000 T 0862 + START OF SEGMENT ********** 85 + ADJ(1,1); 08950000 T 0000 + IF AX.TAG=SINGL AND BX.TAG=SINGL OR BX.TAG=DOUBL THEN ELSE 08951000 T 0001 + BEGIN INTFAMA(-1); GO OC END; 08952000 T 0005 + MOVE(A,C); A←AX ←X ← XX ← 0; 08953000 T 0007 + A.[32:1] ← C.[16:16]; 08954000 T 0011 + X.[32:16] ← 0&CX [32:47:1]&C[33:1:15]; 08955000 T 0013 + AROF ← FALSE; 08956000 T 0017 + IF INTEGERIZE(FALSE,B) THEN BEGIN INTFAMA(INTOVFI);GO OC END; 08957000 T 0017 + IF B < 0 AND B > A THEN BEGIN INTFAMA(INVINXI); GO OC END; 08958000 T 0022 + MOVE(X,A); XX ← 0; 08959000 T 0027 + X ← C.[32:16]; 08960000 T 0028 + AROF ← TRUE; 08961000 T 0030 + B ← X + A × (B-1); 08962000 T 0030 + OC: 08966000 T 0033 + END OCRX; 08967000 T 0033 + 85 IS 34 LONG, NEXT SEG 12 + PROCEDURE SISO; % STRING ISOLATE 08968000 T 0862 + BEGIN 08968100 T 0862 + LABEL OC, L1, L2, L3; 08968200 T 0862 + START OF SEGMENT ********** 86 + ENTEREDIT (1, FALSE); 08968300 T 0000 + IF SSZ = 0 THEN SSZ ← 6; 08968400 T 0001 + IF C.ADDR > (96 DIV SSZ) THEN 08968500 T 0003 + BEGIN 08968600 T 0004 + MOVE (C, A); 08968700 T 0005 + AROF ← BROF ← TRUE; 08968800 T 0006 + QF01 ← 1; 08968900 T 0007 + JFIF; 08969000 T 0009 + GO TO OC; 08969100 T 0057 + END; 08969200 T 0057 + RPF ← C.ADDR; 08969300 T 0057 + BX ← B ← YX ← Y ← 0; 08969400 T 0058 + IF C.ADDR > (48 DIV SSZ) THEN 08969500 T 0061 + BEGIN 08969600 T 0062 + C.ADDR ← (C.ADDR - 48 DIV SSZ); 08969700 T 0063 + QH02 ← 1; 08969800 T 0066 + END; 08969900 T 0068 + DIB ← (48 DIV SSZ - C.ADDR); 08970000 T 0068 + IF SOPF THEN 08970100 T 0070 + BEGIN 08970200 T 0070 + MOVE (A, X); 08970300 T 0071 + L3: MM ← SBR + SIR; 08970400 T 0072 + MOVE (M[MM],A); 08970500 T 0074 + AROF ← TRUE; 08970600 T 0078 + IF BOOLEAN (AX.TAG) THEN 08970700 T 0079 + BEGIN 08970800 T 0079 + IF SOPF THEN 08970900 T 0080 + BEGIN 08971000 T 0080 + MOVE (X, A); 08971100 T 0081 + AROF ← TRUE; 08971200 T 0082 + END ELSE 08971300 T 0082 + BEGIN 08971400 T 0082 + IF QH01 = 1 THEN 08971500 T 0083 + BEGIN 08971600 T 0084 + MOVE (A, JUNK); 08971700 T 0085 + MOVE (X, A); 08971800 T 0086 + MOVE (JUNK, X); 08971900 T 0087 + END; 08972000 T 0088 + END; 08972100 T 0088 + QF04 ← 1; 08972200 T 0088 + JGIF; 08972300 T 0089 + GO TO OC; 08972400 T 0155 + END; 08972500 T 0155 + END; 08972600 T 0155 + L1: IF LHFF = 1 THEN 08972700 T 0155 + BEGIN 08972800 T 0157 + BX.TAG ← DOUBL; 08972900 T 0157 + DYAL (A, Y, DYALSIB, DYALDIB, SSZ); 08973000 T 0159 + END ELSE 08974000 T 0163 + DYAL (A, B, DYALSIB, DYALDIB, SSZ); 08975000 T 0163 + IF BUMPDIB = 0 THEN 08976000 T 0167 + BEGIN 08977000 T 0170 + IF LHFF ≠ 0 THEN GO TO L2; 08978000 T 0170 + IF QH02 ≠ 1 THEN GO TO L2; 08979000 T 0172 + LHFF ← 1; 08980000 T 0174 + END; 08981000 T 0176 + IF BUMPSIB = 0 THEN 08982000 T 0176 + BEGIN 08983000 T 0178 + QH01 ← 1; 08984000 T 0179 + IF NOT SOPF THEN GO TO L3 ELSE 08985000 T 0181 + BEGIN 08986000 T 0181 + MOVE (A, JUNK); 08987000 T 0181 + MOVE (X, A); 08988000 T 0182 + MOVE (JUNK, X); 08989000 T 0183 + END; 08990000 T 0184 + END; 08991000 T 0184 + GO TO L1; 08992000 T 0184 + L2: AROF ← EXSF ← SOPF ← FALSE; 08993000 T 0185 + BROF ← TRUE; 08994000 T 0187 + OC: 08995000 T 0188 + END OF STRING ISOLATE; 08996000 T 0189 + 86 IS 190 LONG, NEXT SEG 12 + PROCEDURE SXSN ; % SET EXTERNAL SIGN 7.9 08997000 T 0862 + BEGIN 08998000 T 0862 + ADJ(1,2); 08999000 T 0862 + 09000000 T 0863 + EXTF ← BOOLEAN(A.SOBIT); 09001000 T 0863 + END SXSN; 09002000 T 0864 + PROCEDURE RTFF ; % READ TRUE/FALSE FLIP-FLOP 7.10 09003000 T 0864 + BEGIN 09004000 T 0864 + ADJ(0,2); 09005000 T 0864 + AX ← A ← 0; 09006000 T 0866 + AROF ← TRUE; 09006500 T 0867 + A ← REAL(TFFF); 09007000 T 0868 + END RTFF; 09008000 T 0868 + PROCEDURE ROFF ; % READ AND CLEAR OVERFLOW FLIP-FLOP 7.11 09009000 T 0869 + BEGIN 09010000 T 0869 + ADJ(0,2); 09011000 T 0869 + AX ← A ← 0; 09012000 T 0870 + AROF ← TRUE; 09012500 T 0871 + A ← REAL(OFFF); 09013000 T 0872 + OFFF ← FALSE; 09014000 T 0872 + END ROFF; 09015000 T 0873 + PROCEDURE INPCONV( UPDATE); VALUE UPDATE; BOOLEAN UPDATE; 09015010 T 0873 +PRT(763) = INPCONV + BEGIN 09015020 T 0873 + REAL DIGR ; 09015030 T 0873 + START OF SEGMENT ********** 87 +STACK(F+2) = DIGR + LABEL OC; 09015040 T 0000 + ADJ(0,1); 09015050 T 0000 + IF INTEGERIZE(FALSE,B) THEN 09015060 T 0001 + BEGIN 09015070 T 0002 + SETINTERRUPT(INTOVFI); 09015080 T 0002 + ADJ(0,0); AROF ← BROF ← TRUE; 09015090 T 0003 + GO OC; 09015100 T 0005 + END; 09015110 T 0007 + ADJ(1,1); 09015120 T 0007 + IF A.[43:5] > 23 THEN 09015130 T 0008 + BEGIN 09015140 T 0009 + SETINTERRUPT(INVOP); 09015150 T 0009 + ADJ(0,0); AROF ← BROF ← TRUE; 09015160 T 0010 + GO OC; 09015170 T 0012 + END; 09015180 T 0015 + IF UPDATE THEN 09015190 T 0015 + BEGIN 09015200 T 0015 + PACU; ADJ(1,1); 09015210 T 0015 + END ELSE 09015220 T 0017 + BEGIN 09015230 T 0017 + PACU; ADJ(0,1); 09015240 T 0017 + END; 09015250 T 0019 + MOVE(A,C); 09015260 T 0019 + JUNK ← DIGR ← 09015270 T 0020 + A ← AX ← X ← XX ← 0; 09015280 T 0020 + DO BEGIN 09015290 T 0023 + DOUBLE(A,X,10,0,×,←,A,X); 09015300 T 0023 + IF DIGR < 12 THEN 09015310 T 0026 + BEGIN 09015320 T 0026 + DYAL(B,JUNK,47-4×DIGR,3,4); 09015330 T 0027 + X ← X + JUNK.[44:4]; 09015340 T 0030 + END ELSE 09015350 T 0031 + BEGIN 09015360 T 0031 + DYAL(Y,JUNK,48-4×DIGR,3,4); 09015370 T 0032 + X ← X + JUNK.[44:4]; 09015380 T 0035 + END; 09015390 T 0036 + END UNTIL DIGR ← DIGR + 1 = 24; 09015400 T 0036 + MOVE(A,B); MOVE(X,Y); MOVE(C,A); 09015410 T 0039 + IF B ≠ 0 THEN 09015420 T 0042 + BEGIN 09015430 T 0042 + B.SOBIT ← 1; 09015440 T 0043 + TFFF ← FALSE; 09015450 T 0045 + BX.TAG ← DOUBL; 09015460 T 0045 + 09015470 T 0047 + END ELSE 09015480 T 0047 + BEGIN 09015490 T 0047 + MOVE(Y,B); 09015500 T 0048 + B.SOBIT ← REAL(TFFF); 09015510 T 0049 + TFFF ← TRUE; 09015520 T 0050 + BX.TAG ← SINGL; 09015530 T 0051 + END; 09015540 T 0053 + OC: 09015545 T 0053 + END OF INPCONV; 09015550 T 0054 + 87 IS 57 LONG, NEXT SEG 12 + PROCEDURE ICVD ; % INPUT CONVERT, DESTRUCTIVE 7.12.1 09016000 T 0873 + BEGIN 09017000 T 0873 + INPCONV(FALSE); 09018000 T 0873 + END ICVD; 09019000 T 0874 + PROCEDURE ICVU ; % INPUT CONVERT, UPDATE 7.12.2 09020000 T 0875 + BEGIN 09021000 T 0875 + INPCONV(TRUE ); 09022000 T 0875 + END ICVU; 09023000 T 0875 + PROCEDURE TEED ; % TABLE ENTER EDIT, DESTRUCTIVE 7.13.1 09024000 T 0876 + BEGIN 09025000 T 0876 + ENTEREDIT(3,FALSE); 09026000 T 0876 + END TEED; 09027000 T 0877 + PROCEDURE TEEU ; % TABLE ENTER EDIT, UPDATE 7.13.2 09028000 T 0877 + BEGIN 09029000 T 0877 + ENTEREDIT(3, TRUE); 09030000 T 0877 + END TEEU; 09031000 T 0879 + PROCEDURE ILED ; % IN LINE ENTER EDIT, DESTRUCTIVE 7.13.3 09032000 T 0879 +PRT(764) = ILED + BEGIN 09033000 T 0879 + ENTEREDIT(2,FALSE); 09034000 T 0879 + END ILED; 09035000 T 0881 + PROCEDURE ILEU ; % IN LINE ENTER EDIT, UPDATE 7.13.4 09036000 T 0881 +PRT(765) = ILEU + BEGIN 09037000 T 0881 + ENTEREDIT(2, TRUE); 09038000 T 0881 + END ILEU; 09039000 T 0883 + PROCEDURE EXPU ; % SINGLE PINTER ENTER EDIT 09040000 T 0883 + BEGIN 09041000 T 0883 + ENTEREDIT(1,TRUE); 09042000 T 0883 + END OF SPEE; 09043000 T 0885 + PROCEDURE EXSD ; % EXECUTE SINGLE MICRO, DESTRUCTIVE 7.13.5 09044000 T 0885 + BEGIN 09045000 T 0885 + ENTEREDIT(0,FALSE); 09046000 T 0885 + END EXSD; 09047000 T 0887 + PROCEDURE EXSU ; % EXECUTE SINGLE MICRO, UPDATE 7.13.6 09048000 T 0887 + BEGIN 09049000 T 0887 + ENTEREDIT(0, TRUE); 09050000 T 0887 + END EXSU; 09051000 T 0889 + PROCEDURE MOVES (NUMRIC); 09052000 T 0889 +PRT(766) = MOVES + VALUE NUMRIC; 09053000 T 0889 + BOOLEAN NUMRIC; 09054000 T 0889 + BEGIN 09055000 T 0889 + INTEGER PLUG; 09055500 T 0889 + START OF SEGMENT ********** 88 +STACK(F+2) = PLUG + LABEL OC, L1, L2, L3, L4, L5; 09056000 T 0000 + EDITF ← TRUE; 09057000 T 0000 + SETUPEXSF; 09058000 T 0000 + CHARSZ; 09059000 T 0007 + IF C.ADDR = 0 THEN GO TO L1; 09060000 T 0015 + RPF ← C.ADDR; 09061000 T 0017 + QH03 ← 1; 09062000 T 0018 + L2: IF NOT SOPF THEN 09063000 T 0020 + BEGIN 09064000 T 0020 + MM ← SBR + SIR; 09065000 T 0021 + MOVE (M[MM], A); MEMCYCLE; 09066000 T 0022 + IF BOOLEAN (AX.TAG) THEN 09067000 T 0027 + BEGIN 09068000 T 0028 + L4: BKIP ← 1; 09069000 T 0028 + MEMPROTECT; 09070000 T 0030 + END; 09071000 T 0099 + END; 09072000 T 0099 + IF QH03 = 1 THEN QH03 ← 0 ELSE 09073000 T 0099 + L5: IF DIB ≠ 0 THEN GO TO L3; 09074000 T 0103 + IF BROF THEN BROF ← FALSE ELSE 09075000 T 0105 + BEGIN 09076000 T 0106 + MM ← DBR + DIR; 09077000 T 0107 + MOVE (M[MM], B); MEMCYCLE; 09078000 T 0108 + IF BOOLEAN (BX.TAG) THEN GO TO L4; 09079000 T 0113 + END; 09080000 T 0115 + L3: IF NUMRIC THEN 09081000 T 0115 + BEGIN 09082000 T 0116 + IF SSZ = 4 THEN 09083000 T 0116 + BEGIN 09084000 T 0117 + DYAL (A, B, DYALSIB, DYALDIB, 4); 09085000 T 0118 + END ELSE 09086000 T 0121 + IF SSZ = 6 THEN 09087000 T 0121 + BEGIN 09088000 T 0123 + PLUG ← 0; 09089000 T 0123 + DYAL (PLUG, B, 46, DYALDIB,2); 09089500 T 0124 + DYAL (A, B,(DYALSIB - 2), (DYALDIB -2),4); 09090000 T 0127 + END ELSE 09091000 T 0131 + BEGIN 09092000 T 0131 + PLUG ← 17; 09093000 T 0132 + DYAL (PLUG, B, 44, DYALDIB, 4); 09093050 T 0133 + DYAL (A, B,(DYALSIB -4),(DYALDIB -4), 4); 09094000 T 0135 + END; 09095000 T 0140 + END ELSE 09096000 T 0140 + DYAL (A, B, DYALSIB, DYALDIB, SSZ); 09097000 T 0140 + BUMPSIB; 09098000 T 0144 + SWITCHSOURCE; 09099000 T 0147 + RPF ← RPF - 1; 09100000 T 0155 + IF RPF = 0 THEN 09101000 T 0156 + BEGIN 09102000 T 0157 + MOVE (B, M[DBR + DIR]); MEMCYCLE; 09103000 T 0158 + LHFF ← 1; 09104000 T 0163 + END; 09105000 T 0165 + IF BUMPDIB = 0 THEN 09106000 T 0165 + BEGIN 09107000 T 0168 + MOVE (B, M[DBR + DIR]); MEMCYCLE; 09108000 T 0168 + END; 09109000 T 0174 + STEPDP; 09110000 T 0174 + IF LHFF = 0 THEN 09111000 T 0176 + BEGIN 09112000 T 0177 + IF SIB = 0 THEN GO TO L2; 09113000 T 0178 + GO TO L5; 09114000 T 0179 + END; 09115000 T 0180 + L1: IF EXSF THEN ENDE ELSE BROF ← TRUE; 09116000 T 0180 + OC: 09117000 T 0182 + END OF MOVES FOR MOVE CHARAS AND NUMERIC UNCOND; 09118000 T 0183 + 88 IS 186 LONG, NEXT SEG 12 + PROCEDURE MCHR; % MOVE CHARACTERS 09119000 T 0889 + BEGIN 09120000 T 0889 + P2R3 ← 1; 09121000 T 0889 + MOVES (FALSE); 09122000 T 0891 + END; 09123000 T 0892 + PROCEDURE MVNU; % MOVE NUMERIC UNCONDITIONAL 09124000 T 0892 + BEGIN 09125000 T 0892 + P2R3 ← 1; 09126000 T 0892 + MOVES (TRUE); 09127000 T 0894 + END; 09128000 T 0895 + PROCEDURE SKIPS (FORWAD, SOURCE); 09130000 T 0895 +PRT(767) = SKIPS + VALUE FORWAD, SOURCE; 09130500 T 0895 + BOOLEAN FORWAD, SOURCE; 09131000 T 0895 + BEGIN 09131500 T 0895 + LABEL OC, L1, L2, L3, MPERR, L4; 09132000 T 0895 + START OF SEGMENT ********** 89 + EDITF ← TRUE; 09132500 T 0000 + SETUPEXSF; 09133000 T 0000 + RPF ← BUF ← C.ADDR; 09133500 T 0007 + IF C.ADDR ≤ 0 THEN GO TO L3; 09134000 T 0009 + QH03 ← 1; 09134500 T 0011 + IF SOURCE THEN 09135000 T 0013 + BEGIN 09135500 T 0013 + IF SSZ = 0 THEN SSZ ← 6; 09136000 T 0013 + IF NOT SOPF THEN 09136500 T 0015 + BEGIN 09137000 T 0016 + L1: MM ← SBR + SIR; 09137500 T 0016 + MOVE (M[MM], A); 09138000 T 0018 + IF BOOLEAN (AX.TAG) THEN GO TO MPERR; 09138500 T 0022 + IF QH03 = 0 THEN 09139000 T 0023 + L2: IF FORWAD THEN 09139500 T 0025 + BEGIN 09140000 T 0026 + BUF ← RPF - 1; 09140500 T 0026 + RPF ← RPF - 1; 09141000 T 0028 + IF RPF = 0 THEN GO TO L3; 09141500 T 0029 + END ELSE 09142000 T 0030 + BEGIN 09143000 T 0030 + SIB ←(48 DIV SSZ); 09144000 T 0031 + END ELSE 09145000 T 0032 + QH03 ← 0; 09146000 T 0032 + END; 09147000 T 0034 + IF FORWAD THEN RPF ← RPF -(48 DIV SSZ -(SIB+1)) 09148000 T 0034 + ELSE 09149000 T 0037 + BEGIN 09150000 T 0038 + RPF ← RPF - SIB; 09151000 T 0038 + BUF ← RPF; 09152000 T 0039 + END; 09153000 T 0040 + IF RPF < 0 THEN RPZF ← 1; 09154000 T 0040 + IF RPF = 0 THEN LHFF ← 1; 09155000 T 0043 + IF FORWAD THEN 09156000 T 0046 + BEGIN 09157000 T 0046 + IF LHFF = 1 OR RPZF = 1 THEN 09158000 T 0047 + BEGIN 09159000 T 0050 + SIB ← SIB + BUF; 09160000 T 0050 + GO TO L3; 09161000 T 0051 + END; 09162000 T 0052 + SIB ← 0; 09163000 T 0052 + IF NOT SOPF THEN 09164000 T 0053 + BEGIN 09165000 T 0053 + SIR ← SIR + 1; 09166000 T 0054 + GO TO L1 09167000 T 0055 + END ELSE 09168000 T 0055 + BEGIN 09169000 T 0055 + MOVE (A, JUNK); 09170000 T 0056 + MOVE (X, A); 09171000 T 0057 + MOVE (JUNK, X); 09172000 T 0058 + GO TO L2; 09173000 T 0059 + END; 09174000 T 0059 + END ELSE 09175000 T 0059 + BEGIN 09176000 T 0059 + SIB ← 0; 09177000 T 0060 + IF LHFF = 1 OR RPZF = 1 THEN 09178000 T 0061 + BEGIN 09179000 T 0063 + SIB ← ABS (BUF + 0); 09180000 T 0064 + GO TO L3; 09181000 T 0065 + END; 09182000 T 0066 + IF NOT SOPF THEN 09183000 T 0066 + BEGIN 09184000 T 0066 + SIR ← SIR - 1; 09185000 T 0067 + GO TO L1; 09186000 T 0068 + END ELSE 09187000 T 0069 + BEGIN 09188000 T 0069 + MOVE (A, JUNK); 09189000 T 0069 + MOVE (X, A); 09190000 T 0070 + MOVE (JUNK, X); 09191000 T 0071 + GO TO L2; 09192000 T 0072 + END; 09193000 T 0073 + END; 09194000 T 0073 + END ELSE 09195000 T 0073 + BEGIN 09196000 T 0073 + IF DSZ = 0 THEN DSZ ← 6; 09197000 T 0073 + IF NOT BROF THEN 09198000 T 0075 + BEGIN 09199000 T 0076 + L4: MM ← DBR + DIR; 09200000 T 0076 + MOVE (M[MM], B); 09201000 T 0078 + IF BOOLEAN (BX.TAG) THEN GO TO MPERR; 09202000 T 0082 + END; 09203000 T 0083 + IF FORWAD THEN 09204000 T 0083 + BEGIN 09205000 T 0084 + IF QH03 = 0 THEN 09206000 T 0084 + BEGIN 09207000 T 0085 + BUF ← RPF - 1; 09208000 T 0086 + RPF ← BUF; 09209000 T 0087 + IF RPF = 0 THEN GO TO L3; 09210000 T 0088 + END ELSE 09211000 T 0089 + QH03 ← 0; 09212000 T 0089 + RPF ← RPF - (48 DIV SSZ - (DIB + 1)); 09213000 T 0091 + END ELSE 09214000 T 0094 + BEGIN 09215000 T 0094 + IF QH03 = 0 THEN DIB ← (48 DIV SSZ) ELSE 09216000 T 0095 + QH03 ← 0; 09217000 T 0098 + RPF ← RPF - DIB; 09218000 T 0100 + BUF ← RPF; 09218500 T 0101 + END; 09219000 T 0102 + IF RPF < 0 THEN RPZF ← 1; 09220000 T 0102 + IF RPF = 0 THEN LHFF ← 1; 09221000 T 0105 + IF FORWAD THEN 09222000 T 0108 + BEGIN 09223000 T 0108 + IF LHFF = 1 OR RPZF = 1 THEN 09224000 T 0109 + BEGIN 09225000 T 0111 + DIB ← DIB + BUF; 09226000 T 0112 + GO TO L3; 09227000 T 0113 + END ELSE 09228000 T 0114 + BEGIN 09229000 T 0114 + DIB ← 0; 09230000 T 0114 + BROF ← FALSE; 09231000 T 0115 + DIR ← DIR + 1; 09232000 T 0116 + GO TO L4; 09233000 T 0117 + END; 09234000 T 0117 + END ELSE 09235000 T 0117 + BEGIN 09235500 T 0117 + DIB ← 0; 09236000 T 0118 + IF LHFF = 1 OR RPZF = 1 THEN 09237000 T 0119 + BEGIN 09238000 T 0121 + DIB ← ABS (RPF + 0); 09239000 T 0122 + GO TO L3; 09240000 T 0123 + END ELSE 09241000 T 0124 + BEGIN 09242000 T 0124 + BROF ← FALSE; 09243000 T 0124 + DIR ← DIR - 1; 09244000 T 0125 + GO TO L4; 09245000 T 0126 + END; 09245500 T 0127 + END; 09246000 T 0127 + END; 09246500 T 0127 + MPERR: 09247000 T 0127 + UPDF ← TRUE; 09248000 T 0128 + ENDE; 09249000 T 0128 + BKIP ← 1; QF04 ← 1; 09250000 T 0129 + JGIF; 09251000 T 0132 + GO TO OC; 09252000 T 0198 + L3: IF EXSF THEN ENDE; 09253000 T 0198 + OC: 09254000 T 0200 + END OF SKIPS; 09255000 T 0201 + 89 IS 202 LONG, NEXT SEG 12 + PROCEDURE SFSC; % SKIP FORWARD SOURCE CHARACTERS 09255500 T 0895 + BEGIN P2R3 ← 1; 09256000 T 0895 + SKIPS (TRUE, TRUE); 09257000 T 0897 + END SFSC; 09258000 T 0898 + PROCEDURE SRSC; % SKIP REVERSE SOURCE CHARACTERS 09259000 T 0899 + BEGIN P2R3 ← 1; 09260000 T 0899 + SKIPS (FALSE, TRUE); 09261000 T 0900 + END SRSC; 09262000 T 0901 + PROCEDURE SFDC; % SKIP FORWARD DESTINATION CHARACTERS 09263000 T 0902 + BEGIN P2R3 ← 1; 09264000 T 0902 + SKIPS (TRUE, FALSE); 09265000 T 0903 + END SFDC; 09265500 T 0904 + PROCEDURE SRDC; % SKIP REVERSE DESTINATION CHARACTERS 09266000 T 0905 + BEGIN P2R3 ← 1; 09267000 T 0905 + SKIPS (FALSE, FALSE); 09268000 T 0906 + END SRDC; 09269000 T 0907 + PROCEDURE INSERTS(CONDITIONAL); 09270000 T 0908 +PRT(770) = INSERTS + VALUE CONDITIONAL; 09271000 T 0908 + BOOLEAN CONDITIONAL; 09272000 T 0908 + BEGIN 09273000 T 0908 + LABEL OC; 09274000 T 0908 + START OF SEGMENT ********** 90 + EDITF ← TRUE; 09274100 T 0000 + SETUPEXSF; 09275000 T 0000 + RPF←C; 09276000 T 0007 + Y←SYLLABLE; 09277000 T 0008 + STEPPSR(1); 09278000 T 0011 + IF CONDITIONAL THEN 09279000 T 0012 + IF NOT FLTF THEN STEPPSR(1) ELSE 09280000 T 0012 + BEGIN 09281000 T 0014 + Y ← SYLLABLE; YX ← 0; 09282000 T 0015 + STEPPSR(1); 09283000 T 0018 + END; 09284000 T 0019 + WHILE RPF > 0 DO 09285000 T 0019 + BEGIN 09286000 T 0020 + FETCHDESTINATION; 09287000 T 0020 + DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09288000 T 0098 + IF BUMPDIB = 0 THEN 09289000 T 0101 + BEGIN 09290000 T 0104 + STOREB; 09291000 T 0105 + STEPDP; 09292000 T 0111 + END; 09293000 T 0113 + RPF ← RPF - 1; 09294000 T 0113 + END; 09295000 T 0114 + IF EXSF THEN ENDE; 09296000 T 0115 + OC: 09297000 T 0116 + END OF INSERTS; 09298000 T 0117 + 90 IS 118 LONG, NEXT SEG 12 + PROCEDURE INSU ; % INSERT UNCONDITIONAL 8.4.1 09299000 T 0908 + BEGIN 09300000 T 0908 + INSERTS(FALSE); 09301000 T 0908 + END INSU; 09302000 T 0908 + PROCEDURE INSC ; % INSERT CONDITIONAL 8.4.2 09303000 T 0909 + BEGIN 09304000 T 0909 + INSERTS(TRUE ); 09305000 T 0909 + END INSC; 09306000 T 0909 + PROCEDURE INSG ; % INSERT DISPLAY SIGN 8.4.3 09307000 T 0910 + BEGIN 09308000 T 0910 + LABEL OC; 09309000 T 0910 + START OF SEGMENT ********** 91 + EDITF ← TRUE; 09309100 T 0000 + IF DSZ = 0 THEN DSZ ← 6 ELSE 09310000 T 0000 + IF DSZ = 4 THEN 09311000 T 0002 + BEGIN 09311100 T 0004 + UPDF ← TRUE; 09311200 T 0004 + ENDE; 09311300 T 0005 + QF01 ← 1; 09311400 T 0005 + BKIP ← 1; 09311500 T 0007 + JGIF; 09311600 T 0009 + GO OC; 09311700 T 0074 + END; 09311800 T 0074 + IF EXTF THEN ELSE STEPPSR(1); 09312000 T 0074 + Y← SYLLABLE; YX←0; 09313000 T 0076 + IF EXTF THEN STEPPSR(2) ELSE STEPPSR(1); 09314000 T 0080 + FETCHDESTINATION; 09315000 T 0082 + DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09316000 T 0160 + BUMPDIB; 09317000 T 0163 + IF DIB = 0 THEN 09318000 T 0166 + BEGIN 09320000 T 0166 + STOREB; 09321000 T 0167 + STEPDP; 09322000 T 0173 + END; 09323000 T 0175 + IF EXSF THEN ENDE; 09324000 T 0175 + OC: 09325000 T 0177 + END INSG; 09326000 T 0177 + 91 IS 178 LONG, NEXT SEG 12 + PROCEDURE INOP ; % INSERT OVERPUNCH 8.4.4 09327000 T 0910 + BEGIN 09328000 T 0910 + LABEL OC; 09329000 T 0910 + START OF SEGMENT ********** 92 + EDITF ← TRUE; 09330000 T 0000 + IF DSZ=0 THEN DSZ←6 ELSE 09331000 T 0000 + IF DSZ=4 THEN 09332000 T 0002 + BEGIN 09333000 T 0004 + UPDF ← TRUE; ENDE; 09334000 T 0004 + QF01← 1; 09335000 T 0005 + BKIP ← 1; 09336000 T 0007 + JGIF; 09337000 T 0009 + GO OC; 09338000 T 0074 + END; 09339000 T 0074 + FETCHDESTINATION; 09340000 T 0074 + IF EXTF THEN 09341000 T 0152 + IF (DIB←DIB-DSZ) < 0 THEN 09342000 T 0152 + IF DSZ=6 THEN DYAL(INTG←2,B,1,DYALDIB,2) 09343000 T 0155 +PRT(771) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + ELSE DYAL(INTG←13,B,3,DYALDIB,4); 09344000 T 0162 +PRT(772) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + BUMPDIB; 09345000 T 0170 + IF DIB=0 THEN 09346000 T 0172 + BEGIN 09347000 T 0173 + STOREB; 09347100 T 0173 + STEPDP; 09347200 T 0180 + END; 09347300 T 0182 + IF EXSF THEN ENDE; 09347400 T 0182 + OC: 09348000 T 0183 + END INOP; 09349000 T 0184 + 92 IS 185 LONG, NEXT SEG 12 + PROCEDURE RSTF ; % RESET FLOAT 09350000 T 0910 + BEGIN 09351000 T 0910 + FLTF ← FALSE; 09352000 T 0910 + END RFLT; 09353000 T 0910 + PROCEDURE ENDF ; % END FLOAT 8.9 09354000 T 0911 + BEGIN 09355000 T 0911 + LABEL OC; 09356000 T 0911 + START OF SEGMENT ********** 93 + EDITF ← TRUE; 09356100 T 0000 + IF FLTF THEN 09357000 T 0000 + BEGIN 09358000 T 0001 + STEPPSR(2); 09359000 T 0001 + FLTF ← FALSE; 09360000 T 0002 + GO OC; 09361000 T 0003 + END; 09362000 T 0003 + IF DSZ=0 THEN DSZ←6; 09363000 T 0003 + FETCHDESTINATION; 09364000 T 0005 + Y ← SYLLABLE; YX ← 0; 09365000 T 0083 + STEPPSR(1); 09366000 T 0087 + IF EXTF THEN Y ← SYLLABLE; 09367000 T 0087 + STEPPSR(1); 09368000 T 0091 + DYAL(Y,B,DSZ-1,DIB,DSZ); 09369000 T 0092 + BUMPDIB; 09370000 T 0094 + IF DIB = 0 THEN 09371000 T 0096 + BEGIN 09372000 T 0097 + STOREB; 09373000 T 0097 + STEPDP; 09374000 T 0104 + END; 09375000 T 0106 + IF EXSF THEN ENDE; 09376000 T 0106 + OC: 09377000 T 0107 + END ENDF; 09378000 T 0108 + 93 IS 109 LONG, NEXT SEG 12 + PROCEDURE MINS ; % MOVE WITH INSERT 8.10 09379000 T 0911 + BEGIN 09380000 T 0911 + BOOLEAN LHFF; 09381000 T 0911 + START OF SEGMENT ********** 94 +STACK(F+2) = LHFF + LABEL L12,L8,L10,L14,L20,L11,OC; 09382000 T 0000 + EDITF ← TRUE; 09383000 T 0000 + SETUPEXSF; 09384000 T 0000 + Y ← SYLLABLE; YX ← 0; STEPPSR(1); 09385000 T 0007 + CHARSZ; 09386000 T 0012 + IF C = 0 THEN GO TO L11; 09387000 T 0019 + RPF ← C.ADDR; 09388000 T 0020 + QH03 ← 1; 09389000 T 0022 + L12: 09390000 T 0023 + FETCHSOURCE; 09391000 T 0024 + L8: 09392000 T 0103 + IF QH03 = 1 THEN QH03←0 ELSE IF DIB≠0 THEN GO L14; 09393000 T 0104 + IF BROF THEN BROF ← FALSE ELSE 09394000 T 0109 + L10: 09395000 T 0110 + FETCHDESTINATION; 09396000 T 0112 + L14: 09397000 T 0189 + IF FLTF THEN 09398000 T 0190 + BEGIN 09399000 T 0190 + INTG ← 15×REAL(SSZ=8); 09400000 T 0190 + IF SSZ≠4 THEN DYAL(INTG,B,SSZ-5,DYALDIB,SSZ-4); 09401000 T 0192 + DYAL(A,8,DYALSIB-SIBLNG,DYALDIB-DIBLNG,4); GO L20; 09402000 T 0197 + END; 09403000 T 0207 + 09404000 T 0207 + DYAL(A,INTG,DYALSIB-SIBLNG,3,4); 09405000 T 0207 + IF INTG.[44:4] ≠ 0 THEN BEGIN FLTF←TRUE;GO L14 END; 09406000 T 0213 + 09407000 T 0216 + DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09408000 T 0216 + L20: BUMPSIB; 09409000 T 0219 + SWITCHSOURCE; 09410000 T 0222 + BUMPDIB; 09411000 T 0230 + RPF ← RPF - 1; 09412000 T 0233 + IF RPF = 0 THEN 09413000 T 0234 + BEGIN 09414000 T 0235 + STOREB; 09415000 T 0235 + LHFF ← TRUE; 09416000 T 0242 + END; 09417000 T 0242 + IF DIB = 0 THEN 09418000 T 0242 + BEGIN 09418100 T 0243 + STOREB; 09418200 T 0244 + STEPDP; 09418300 T 0250 + END; 09418400 T 0252 + IF NOT LHFF THEN IF SIB=0 THEN GO L12 ELSE 09418500 T 0252 + GO L10; 09418600 T 0254 + L11: IF EXSF THEN ENDE ELSE BROF ← TRUE; 09418700 T 0255 + OC: 09418800 T 0258 + END MINS; 09418900 T 0259 + 94 IS 262 LONG, NEXT SEG 12 + PROCEDURE MFLT ; % MOVE WITH FLOAT 8.11 09419000 T 0911 + BEGIN 09420000 T 0911 + LABEL L11,L9,L14,L15,L22,L10,L12,OC; 09421000 T 0911 + START OF SEGMENT ********** 95 + BOOLEAN LHFF; 09421100 T 0000 +STACK(F+2) = LHFF + EDITF ← TRUE; 09422000 T 0000 + SETUPEXSF; 09423000 T 0000 + Y ← SYLLABLE; YX ← 0; STEPPSR(1); 09424000 T 0007 + CHARSZ; 09425000 T 0012 + IF C = 0 THEN GO TO L10; 09426000 T 0019 + RPF ← C.ADDR; 09427000 T 0020 + QH03 ← 1; 09428000 T 0022 + L11: 09429000 T 0023 + FETCHSOURCE; 09430000 T 0024 + L9: 09431000 T 0103 + IF QH03 = 1 THEN QH03 ← 0 ELSE IF DIB ≠ 0 THEN GO TO L15; 09432000 T 0104 + IF BROF THEN BROF ← FALSE ELSE 09433000 T 0109 + L14: FETCHDESTINATION; 09434000 T 0110 + L15: 09435000 T 0189 + IF FLTF THEN 09436000 T 0190 + BEGIN 09437000 T 0190 + INTG ← 15×REAL(SSZ=8); 09438000 T 0190 + IF SSZ ≠ 4 THEN DYAL(INTG,B,SSZ-5,DYALDIB,SSZ-4); 09439000 T 0192 + DYAL(A,B,DYALSIB-SIBLNG,DYALDIB-DIBLNG,4); 09440000 T 0197 + END ELSE 09441000 T 0207 + BEGIN 09442000 T 0207 + DYAL(A,INTG,DYALSIB-SIBLNG,3,4); 09443000 T 0207 + IF INTG.[44:4] = 0 THEN 09444000 T 0213 + DYAL(Y,B,DSZ-1,DYALDIB,DSZ) ELSE 09445000 T 0214 + BEGIN 09446000 T 0218 + FLTF ← TRUE; 09447000 T 0219 + Y ← SYLLABLE; YX ← 0; STEPPSR(1); 09448000 T 0219 + IF EXTF THEN Y ← SYLLABLE; STEPPSR(1); 09449000 T 0224 + DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09450000 T 0228 + QH01 ← 1; 09451000 T 0231 + GO TO L22; 09452000 T 0233 + END; 09453000 T 0233 + END; 09454000 T 0233 + BUMPSIB; 09455000 T 0233 + IF SIB=0 AND NOT SOPF THEN SIR ← SIR + 1; 09456000 T 0236 + L22: 09457000 T 0239 + BUMPDIB; 09458000 T 0240 + IF QH01 = 0 THEN 09459000 T 0242 + BEGIN 09460000 T 0243 + RPF ← RPF - 1; 09461000 T 0244 + IF RPF = 0 THEN BEGIN STOREB; LHFF←TRUE END; 09462000 T 0245 + END ELSE QH01 ← 0; 09463000 T 0253 + IF DIB = 0 THEN 09464000 T 0256 + BEGIN 09465000 T 0256 + STOREB; 09466000 T 0257 + STEPDP; 09467000 T 0263 + END; 09468000 T 0265 + IF LHFF THEN GO L12; 09469000 T 0265 + IF SIB = 0 THEN GO L11; 09470000 T 0266 + GO L14; 09471000 T 0268 + L10: 09472000 T 0268 + IF QH03 = 0 THEN STEPPSR(2); 09473000 T 0269 + L12: 09474000 T 0271 + IF EXSF THEN ENDE ELSE BROF ← TRUE; 09474100 T 0272 + OC: 09474200 T 0274 + END MFLT; 09474300 T 0275 + 95 IS 278 LONG, NEXT SEG 12 + PROCEDURE ENDE; % END EDIT 09475000 T 0911 + BEGIN 09476000 T 0911 + LABEL OC, L1; 09477000 T 0911 + START OF SEGMENT ********** 96 + IF BROF THEN 09478000 T 0000 + BEGIN 09479000 T 0000 + MM ← DBR + DIR; 09480000 T 0000 + MOVE (B, M[MM]); MEMCYCLE; 09481000 T 0002 + BROF ← FALSE 09482000 T 0007 + END; 09483000 T 0007 + IF NOT UPDF THEN 09484000 T 0008 + BEGIN 09485000 T 0008 + FLTF ← FALSE; 09486000 T 0009 + AROF ← FALSE; 09487000 T 0009 + GO TO L1 09488000 T 0010 + END; 09489000 T 0011 + BROF ← TRUE; 09490000 T 0011 + B ← BX ← 0; 09490500 T 0011 + B ← DBR; 09491000 T 0013 + B.DIRF ← DIR; 09492000 T 0013 + B.CHARF ← DIB; 09493000 T 0015 + B.SZ ← DSZ DIV 2; 09494000 T 0017 + BX.TAG ← DATADESC; 09495000 T 0019 + B.IBIT ← 1; 09496000 T 0021 + BX.PBIT ← 1; 09497000 T 0023 + B.CBIT ← 1; 09498000 T 0024 + B.SBIT ← DPSF; 09499000 T 0026 + 09500000 T 0028 + IF SOPF THEN 09501000 T 0028 + BEGIN 09502000 T 0029 + IF AX.TAG = SINGL THEN 09503000 T 0029 + BEGIN 09504000 T 0030 + IF SIB ≠ 47 THEN 09505000 T 0031 + BEGIN 09506000 T 0032 + DYAL (A,C,DYALSIB,47,DYALSIZ); 09507000 T 0032 + DYAL (A,C,47,DYALSET,DYALSZ); 09508000 T 0036 + MOVE (C, A); 09509000 T 0039 + END; 09510000 T 0040 + AROF ← TRUE; 09511000 T 0040 + XROF ← 0; 09512000 T 0041 + END ELSE 09513000 T 0043 + IF SIB ≠ 47 THEN 09514000 T 0043 + BEGIN 09515000 T 0044 + DYAL (A,C,DYALSIB,47,DYALSIZ); 09516000 T 0044 + DYAL (X,C,47,DYALSET,DYALSZ); 09517000 T 0048 + DYAL (X,X,DYALSIB,47,DYALSIZ); 09518000 T 0051 + DYAL (A,X,47,DYALSET,DYALSZ); 09519000 T 0055 + MOVE (C, A); 09520000 T 0058 + END; 09521000 T 0059 + AROF ← TRUE; 09522000 T 0059 + XROF ← 1; GO TO L1; 09523000 T 0060 + END ELSE 09524000 T 0062 + AROF ← TRUE; 09525000 T 0062 + A ← AX ← 0; 09525500 T 0064 + A ← SBR; 09526000 T 0065 + A.SIRF ← SIR; 09527000 T 0066 + A.CHARF ← SIB; 09528000 T 0067 + A.SZ ← SSZ DIV 2; 09529000 T 0069 + AX.TAG ← DATADESC; 09530000 T 0071 + A.IBIT ← 1; 09531000 T 0073 + AX.PBIT ← 1; 09532000 T 0075 + A.CBIT ← 1; 09533000 T 0077 + A.SBIT ← SPSF; 09534000 T 0078 + A.RBIT ← SPRF; 09535000 T 0081 + L1: IF NOT EDITF THEN 09536000 T 0083 + BEGIN 09537000 T 0084 + IF SWPS = 1 THEN BROF ← FALSE 09538000 T 0085 + END ELSE 09539000 T 0087 + IF ESPF THEN AROF ← FALSE; 09540000 T 0087 + ESPF ← EXSF ← UPDF ← SOPF ← EDITF ← FALSE; 09541000 T 0089 + OC: 09542000 T 0092 + END ENDEDIT; 09543000 T 0093 + 96 IS 94 LONG, NEXT SEG 12 + PROCEDURE ERVSFLOW(OP); VALUE OP; INTEGER OP; 50000000 T 0911 + BEGIN 50001000 T 0911 + LABEL STARTVALC,STARTEVAL,STARTENTR,STARTEXIT,STARTRETN, 50002000 T 0911 + START OF SEGMENT ********** 97 + STARTINDX,STARTNXLN,STARTNXLV,STARTSTBR,STARTMKST, 50003000 T 0000 + STARTMVST,STARTDBTR,STARTDBFL,STARTDBUN,STARTBRTR, 50004000 T 0000 + STARTBRFL,STARTBRUN,STARTSTFF,STARTIRWL,STARTPCWL; 50005000 T 0000 + SWITCH START ← 50006000 T 0000 + STARTVALC,STARTEVAL,STARTENTR,STARTEXIT,STARTRETN, 50007000 T 0002 + STARTINDX,STARTNXLN,STARTNXLV,STARTSTBR, 50008000 T 0002 + STARTMKST,STARTMVST,STARTDBTR,STARTDBFL, 50009000 T 0002 + STARTDBUN,STARTBRTR,STARTBRFL,STARTBRUN, 50010000 T 0002 + STARTSTFF,STARTIRWL,STARTPCWL; 50011000 T 0002 + DEFINE VALC=OP=1#,EVAL=OP=2#,ENTR=OP=3#,EXIT=OP=4#,RETN=OP=5#, 50012000 T 0013 + INDX=OP=6#,NXLN=OP=7#,NXLV=OP=8#,STBR=OP=9#, 50013000 T 0013 + MKST=OP=10#,MVST=OP=11#,DBTR=OP=12#, 50014000 T 0013 + DBFL=OP=13#,DBUN=OP=14,BRTR=OP=15#,BRFL=OP=16#, 50015000 T 0013 + BRUN=OP=17#,STFF =OP=18#,IRWL = OP=19#, 50016000 T 0013 + PCWL= OP=20#; 50017000 T 0013 + LABEL LABELA,LABELB,LABELC,LABELD,LABELE,LABELF,LABELG, 50018000 T 0013 + LABELH,LABELP,LABELQ,LABELS,LABELT,LABELW,LABELX, 50019000 T 0013 + LABELZ, L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13, 50020000 T 0013 + L14,L15,L16,L17,L18,DESCPAGE6,INDEXINDESC,NXLNPAGE9, 50021000 T 0013 + NORMALINDEX,SPECIALINDEX,OPERAND,INDEXWORD,STUFFEDIRW, 50022000 T 0013 + NORMALIRW,PCWPAGE22,DISPLAYUPDATE,BYPASUPDATE, 50023000 T 0013 + SEGMENTDESC,PCW2,INVOPLBL,INVINDLBL,STKUNFLBL,BOSLBL, 50024000 T 0013 + SEQERLBL,INTLBL,PRES10LBL,PRES11LBL,PRES12LBL, 50025000 T 0013 + PRES13LBL,OC,LABELOPND; 50026000 T 0013 + 50027000 T 0013 + REAL TS,T1,T2; 50028000 T 0013 +STACK(F+2) = TS +STACK(F+3) = T1 +STACK(F+4) = T2 + DEFINE I1INVALIDOPERATOR = GO TO INVOPLBL#, % ON PAGE 44 50029000 T 0013 + I2INTEGERIZE = BEGIN B ← BX ← 0; 50030000 T 0013 + GO TO INTLBL END#, % ON PAGE 45 50030500 T 0013 + I2MULT = I2INTEGERIZE#, 50031000 T 0013 + I2INTEGERDIV = I2INTEGERIZE#, 50032000 T 0013 + I3INVALIDINDEX = BEGIN LL ← X.LLF; 50033000 T 0013 + GO TO INVINDLBL END#, % PAGE 44 50033500 T 0013 + I4INVALIDINDEX = GO TO INVINDLBL#, % ON PAGE 44 50034000 T 0013 + I5BOSERROR = GO TO STKUNFLBL#, % ON PAGE 44 50035000 T 0013 + I6BOSNORMAL = GO TO BOSLBL#, % ON PAGE 45 50036000 T 0013 + I7SEQUENCEERROR = BEGIN LL ← X.LLF; 50037000 T 0013 + GO TO SEQERLBL END#, % PAGE 45 50037500 T 0013 + I8SEQUENCEERROR = GO TO SEQERLBL#, % ON PAGE 45 50038000 T 0013 + I9INVALIDINDEX = BEGIN MOVE (A,C); AROF ← FALSE; 50039000 T 0013 + GO TO INVINDLBL END#, % PAGE 44 50040000 T 0013 + I10PRESENCEBIT = GO TO PRES10LBL#, % ON PAGE 46 50041000 T 0013 + I11PRESENCEBIT = GO TO PRES11LBL#, % ON PAGE 46 50042000 T 0013 + I12PRESENCEBIT = GO TO PRES12LBL#, % ON PAGE 46 50043000 T 0013 + I13PRESENCEBIT = GO TO PRES13LBL#; % ON PAGE 46 50044000 T 0013 + %%% 50045000 T 0013 + DEFINE INTFL = SDIS=1#; %TO OVERCOME NOMENCLATURE DIFFICULTY 50046000 T 0013 + %%% 50047000 T 0013 + GO TO START[OP]; ERROR(10); MEMDUMP; GO TO EOJ; 50048000 T 0013 + % PAGE 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50049000 T 0019 + STARTEVAL: 50050000 T 0019 + STARTSTBR: 50051000 T 0020 + LABELE: 50052000 T 0020 + ADJ(1,2); 50053000 T 0020 + GO TO L1; 50054000 T 0021 + STARTNXLV: 50055000 T 0021 + STARTNXLN: 50056000 T 0022 + STARTINDX: 50057000 T 0022 + ADJ(1,1); 50058000 T 0022 + IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN EXCH; 50059000 T 0023 + L1: MOVE(A,C); AROF ← FALSE; 50060000 T 0026 + IF AX.TAG = IRW THEN GO TO LABELA ELSE GO TO DESCPAGE6; 50061000 T 0028 + % PAGE 3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50062000 T 0031 + STARTENTR: 50063000 T 0031 + ADJ(0,0); 50064000 T 0031 + MOVE(M[F + 1], C); MEMCYCLE; 50065000 T 0032 + IF CX.TAG ≠ IRW THEN I1INVALIDOPERATOR; % ON PAGE 44 50066000 T 0037 + STARTIRWL: 50067000 T 0039 + LABELA: 50068000 T 0040 + MOVE (C,A); 50069000 T 0040 + IF C.EBIT = 1 THEN GO TO STUFFEDIRW ELSE GO TO NORMALIRW; 50070000 T 0041 + % PAGE 4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50071000 T 0043 + STARTVALC: 50072000 T 0043 + T1 ← T1&DRS[34:42:6] & SYLLABLE[40:40:8]; STEPPSR(1); 50073000 T 0044 + BUF2 ← D[LEVEL(T1)] + DELTA(T1); 50074000 T 0049 + MOVE(M[D[LEVEL(T1)]+DELTA(T1)],C); MEMCYCLE; 50075000 T 0052 + QC1F ← 1; 50076000 T 0059 + IF AROF THEN ADJ(0,2); 50077000 T 0060 + IF CX.TAG = SINGL OR CX.TAG = DOUBL THEN 50078000 T 0062 + BEGIN 50079000 T 0065 + IF CX.TAG = DOUBL THEN MOVE (M[BUF2 + 1],X); 50080000 T 0065 + MOVE (C,A); AROF ← TRUE; 50081000 T 0072 + GO TO OC; 50082000 T 0073 + END; 50083000 T 0074 + IF CX.TAG = IRW THEN GO TO LABELA; % ON PAGE 3 50084000 T 0074 + % PAGE 6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50085000 T 0076 + DESCPAGE6: 50086000 T 0076 + IF CX.TAG ≠ DATADESC THEN I1INVALIDOPERATOR; 50087000 T 0076 + IF C.CHRSZ = 0 THEN 50088000 T 0077 + BEGIN 50089000 T 0079 + QC6F ← 1; QC7F ← C.DBIT 50090000 T 0079 + END; 50091000 T 0081 + IF C.IBIT = 1 THEN GO TO L2; % ON PAGE 7 50092000 T 0083 + IF EVAL THEN GO TO LABELZ; % ON PAGE 9 50093000 T 0085 + IF NOT (NXLV OR NXLN OR INDX) THEN I1INVALIDOPERATOR; 50094000 T 0086 + LABELT: 50095000 T 0089 + IF C.CHRSZ = 0 OR INDX THEN GO TO NORMALINDEX % ON PAGE 10 50096000 T 0090 + ELSE I1INVALIDOPERATOR; 50097000 T 0092 + % PAGE 7 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50098000 T 0093 + L2: 50099000 T 0093 + IF INDX THEN I1INVALIDOPERATOR; 50100000 T 0094 + IF EVAL THEN GO TO LABELZ; % ON PAGE 9 50101000 T 0095 + INDEXINDESC: 50102000 T 0096 + IF C.SBIT ≠ 1 AND C.CHRSZ ≠ 0 THEN I1INVALIDOPERATOR; 50103000 T 0097 + IF CX.PBIT ≠ 1 THEN I11PRESENCEBIT; 50104000 T 0100 + T1 ← C.SBIT; 50105000 T 0102 + MOVE(M[BUF2 ← C.INDEX + C.ADDR],C); MEMCYCLE; 50106000 T 0103 + IF T1 = 1 THEN GO TO DESCPAGE6; 50107000 T 0110 + % PAGE 8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50108000 T 0112 + IF NXLN THEN GO TO NXLNPAGE9; 50109000 T 0112 + LABELC: 50110000 T 0113 + IF CX.TAG=SINGL OR CX.TAG=DOUBL THEN GO TO OPERAND; % ON PAGE15 50111000 T 0114 + IF CX.TAG = SIW THEN GO TO INDEXWORD; % ON PAGE 17 50112000 T 0117 + IF NXLV THEN I1INVALIDOPERATOR; 50113000 T 0119 + GO TO DESCPAGE6; 50114000 T 0120 + % PAGE 9 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50115000 T 0121 + NXLNPAGE9: 50116000 T 0121 + IF CX.TAG ≠ DATADESC THEN I1INVALIDOPERATOR; 50117000 T 0121 + IF C.IBIT = 1 THEN I1INVALIDOPERATOR; 50118000 T 0122 + LABELZ: 50118100 T 0124 + IF CX.PBIT ≠ 1 THEN BEGIN 50119000 T 0125 + IF C.CBIT ≠ 1 THEN C.ADDR ← BUF2 50120000 T 0126 + END; 50121000 T 0128 + 50122000 T 0130 + C.CBIT ← 1; 50123000 T 0130 + MOVE(C,A); AROF ← TRUE; 50124000 T 0132 + GO TO OC; 50125000 T 0133 + % PAGE 10 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50126000 T 0134 + NORMALINDEX: 50127000 T 0134 + NTGR; IF INTFL THEN I2INTEGERIZE; 50128000 T 0135 + IF B.MANF < 0 OR B.MANF ≥ C.INDEX THEN I4INVALIDINDEX; 50129000 T 0139 + IF C.SBIT = 1 THEN GO TO LABELP; % ON PAGE 12 50130000 T 0143 + IF C.CHRSZ ≠ 0 THEN GO TO LABELQ; % ON PAGE 14 50131000 T 0144 + IF C.DBIT = 1 THEN B ← B × 2; 50131555 T 0146 + C.INDEX ← B.ADDR; 50132000 T 0149 + % PAGE 11 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50133000 T 0151 + SPECIALINDEX: 50134000 T 0151 + C.IBIT ← 1; BROF ← FALSE; 50135000 T 0152 + IF NOT INDX THEN GO TO INDEXINDESC; % ON PAGE 7 50136000 T 0154 + GO LABELZ; 50136600 T 0155 + MOVE (C,A); AROF ← TRUE; 50137000 T 0156 + GO TO OC; 50138000 T 0158 + % PAGE 12 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50139000 T 0158 + LABELP: 50140000 T 0158 + CASE C.SZ OF 50141000 T 0159 + BEGIN 50142000 T 0159 +PRT(773) = *CASE STATEMENT DESCRIPTOR* + % SZ = 000 (DATA DESCRIPTOR) SINGLE PRECISION 50143000 T 0160 + BEGIN A ← 256; GO TO L4 END; 50144000 T 0160 + % SZ = 001 (DATA DESCRIPTOR) DOUBLE PRECISION 50145000 T 0162 + BEGIN A ← 128; GO TO L4 END; 50146000 T 0162 + % SZ = 010 4-BIT CHARACTERS (STRING DESCRIPTOR) 50147000 T 0163 + BEGIN A ← 3072; GO TO L4 END; 50148000 T 0163 + % SZ = 011 6-BIT CHARACTERS (STRING DESCRIPTOR) 50149000 T 0166 + BEGIN A ← 2048; GO TO L4 END; 50150000 T 0166 + % SZ = 100 8-BIT CHARACTERS (STRING DESCRIPTOR) 50151000 T 0169 + BEGIN A ← 1536; GO TO L4 END; 50152000 T 0169 + END; 50153000 T 0172 + START OF SEGMENT ********** 98 + 98 IS 5 LONG, NEXT SEG 97 + % PAGE 13 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50154000 T 0172 + L4: 50155000 T 0172 + AROF ← TRUE; 50156000 T 0173 + IDIV; IF INTFL THEN I2INTEGERDIV; 50157000 T 0173 + C.INDEX ← B.ADDR; MOVE (A,B); C.IBIT ← 1; 50158000 T 0177 + GO TO INDEXINDESC; % ON PAGE 7 50159000 T 0182 + % PAGE 14 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50160000 T 0183 + LABELQ: 50161000 T 0183 + CASE C.SZ OF 50162000 T 0184 + BEGIN 50163000 T 0184 +PRT(774) = *CASE STATEMENT DESCRIPTOR* + % SZ = 000 NOT POSSIBLE AT THIS POINT 50164000 T 0185 + ; 50165000 T 0185 + % SZ = 001 NOT POSSIBLE AT THIS POINT 50166000 T 0185 + ; 50167000 T 0185 + % SZ = 010 4-BIT CHARACTERS 50168000 T 0185 + BEGIN T1 ← 12; T2 ← 4 END; 50169000 T 0185 + % SZ = 011 6-BIT CHARACTERS 50170000 T 0187 + BEGIN T1 ← 8; T2 ← 6 END; 50171000 T 0187 + % SZ = 100 8-BIT CHARACTERS 50172000 T 0189 + BEGIN T1 ← 6; T2 ← 8 END; 50173000 T 0189 + END; 50174000 T 0191 + START OF SEGMENT ********** 99 + 99 IS 5 LONG, NEXT SEG 97 + MOVE (A,B); BROF ← TRUE; A ← T1; 50175000 T 0191 + IDIV; IF INTFL THEN I2INTEGERDIV; 50176000 T 0193 + C.[13:15] ← B.[33:15]; AROF ← TRUE; AX.TAG ← SINGL; B ← T2; 50177000 T 0197 + MULT; IF INTFL THEN I2MULT; 50178000 T 0203 + MOVE (B,A); B ← 47; BROF ← FALSE; 50179000 T 0207 + B ← B - A; 50180000 T 0209 + C.[7:6] ← B.[42:6]; 50181000 T 0211 + GO TO SPECIALINDEX; % ON PAGE 11 50182000 T 0213 + % PAGE 15 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50183000 T 0213 + OPERAND: 50184000 T 0213 + IF EVAL THEN GO TO L7; % ON PAGE 16 50185000 T 0214 + IF QC6F = 1 THEN 50186000 T 0215 + BEGIN 50187000 T 0216 + IF QC7F = 1 THEN BEGIN CX.TAG ← DOUBL; 50188000 T 0217 + GO TO L5 END ELSE 50189000 T 0220 + BEGIN CX.TAG ← SINGL; 50190000 T 0221 + GO TO L6 END; 50191000 T 0223 + END; 50192000 T 0223 + IF CX.TAG ≠ DOUBL THEN GO TO L6; 50193000 T 0223 + L5: 50194000 T 0225 + MOVE (M[BUF2 + 1], X); MEMCYCLE; 50195000 T 0226 + L6: 50196000 T 0231 + MOVE (C,A); 50197000 T 0232 + % PAGE 16 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50198000 T 0233 + L7: 50199000 T 0233 + AROF ← TRUE; 50200000 T 0233 + IF NOT STBR THEN GO TO OC; 50201000 T 0233 + ADJ (0,1); 50202000 T 0235 + A ← AX ← 0; AROF ← TRUE; STEPPSR (2); 50203000 T 0236 + GO TO OC; 50204000 T 0238 + % PAGE 17 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50205000 T 0239 + INDEXWORD: 50206000 T 0239 + C.CVF ← C.CVF + C.INCRF; 50207000 T 0240 + MOVE (C, M[BUF2]); MEMCYCLE; 50208000 T 0243 + IF C.CVF ≤ C.FVF THEN 50209000 T 0248 + BEGIN 50210000 T 0250 + A ← AX ← 1; STEPPSR (2); AROF ← TRUE; 50211000 T 0250 + GO TO OC 50212000 T 0253 + END; 50213000 T 0254 + GO TO STARTBRUN; 50214000 T 0254 + 50215000 T 0254 + % PAGE 18 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50216000 T 0254 + STUFFEDIRW: 50217000 T 0254 + QC6F ← 0; Q04F ← 1; 50218000 T 0255 + LABELX: 50219000 T 0258 + IF SNR = C.STKNR THEN 50220000 T 0259 + BEGIN QC7F ← 0; TEMP ← BOSR END 50221000 T 0260 + ELSE 50222000 T 0263 + BEGIN 50223000 T 0263 + MOVE(M[STACKVECTOR],C); MEMCYCLE; QC7F ← 1; 50224000 T 0263 + IF CX.PBIT ≠1 THEN I10PRESENCEBIT; 50225000 T 0271 + IF C.LENGTH ≤ A.STKNR THEN I4INVALIDINDEX; 50226000 T 0273 + MOVE (M[C.ADDR + A.STKNR], C); MEMCYCLE; 50227000 T 0275 + IF CX.PBIT ≠1 THEN I10PRESENCEBIT; 50228000 T 0282 + TEMP ← C.ADDR; 50229000 T 0284 + END; 50230000 T 0285 + % PAGE 19 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50231000 T 0285 + IF Q04F ≠ 1 THEN 50232000 T 0285 + IF STFF THEN 50233000 T 0286 + GO TO LABELW % ON PAGE 42 50234000 T 0287 + ELSE GO TO LABELD; % ON PAGE 22 50235000 T 0287 + BUF ← TEMP + A.DISP; 50236000 T 0288 + BUF2 ← BUF + A.ADRCPLSIR; 50237000 T 0290 + IF IRWL THEN GO TO OC; 50238000 T 0292 + Q04F ← 0; MOVE(M[BUF + A.ADRCPLSIR] ,C); MEMCYCLE; 50239000 T 0293 + IF CX.TAG = IRW AND C.EBIT = 0 THEN I1INVALIDOPERATOR 50240000 T 0301 + ELSE GO TO LABELH; % ON PAGE 20 50241000 T 0304 + % PAGE 20 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50242000 T 0305 + NORMALIRW: 50243000 T 0305 + BUF ← D [LEVEL(C)]; BUF2 ← BUF + DELTA(C); 50244000 T 0306 + IF IRWL THEN GO TO OC; 50245000 T 0309 + MOVE (M[BUF + DELTA(C)],C); MEMCYCLE; 50246000 T 0310 + LABELH: 50247000 T 0316 + IF CX.TAG = IRW THEN GO TO LABELA; % ON PAGE 3 50248000 T 0317 + IF CX.TAG = PCW THEN GO TO PCWPAGE22; 50249000 T 0318 + IF ENTR THEN I1INVALIDOPERATOR; 50250000 T 0320 + IF NOT (NXLN OR NXLV OR INDX) THEN 50251000 T 0321 + BEGIN 50252000 T 0324 + QC6F ← 0; 50253000 T 0325 + GO TO LABELC % ON PAGE 8 50254000 T 0327 + END; 50255000 T 0327 + % PAGE 21 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50256000 T 0327 + IF CX.TAG ≠ DATADESC OR C.IBIT ≠ 0 THEN I1INVALIDOPERATOR; 50257000 T 0327 + GO TO DESCPAGE6; % ON PAGE 6 50258000 T 0331 + % PAGE 22 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50259000 T 0331 + STARTPCWL: 50260000 T 0331 + PCWPAGE22: 50261000 T 0332 + IF NOT (ENTR OR BOOLEAN (QC1F)) THEN 50262000 T 0332 + BEGIN 50263000 T 0334 + PIR ← PIR - PICR; 50264000 T 0334 + PSR ← OPSR; 50265000 T 0335 + END; 50266000 T 0336 + MOVE (C,X); 50267000 T 0336 + IF A.EBIT ≠ 0 THEN GO TO L8; 50268000 T 0337 + 50269000 T 0339 + A.STKNR ← C.STKNR; 50270000 T 0339 + GO TO LABELX; 50271000 T 0341 + LABELD: 50272000 T 0342 + TS ← D[LEVEL(A)]; 50273000 T 0342 + A.DISP ← TS - TEMP; 50274000 T 0343 + L8: 50275000 T 0345 + C ← CX ← 0; 50276000 T 0346 + C.NBIT ← REAL(NCSF); IIHF ← BOOLEAN(X.NBIT); 50277000 T 0347 + NCSF ← BOOLEAN(X.NBIT); 50278000 T 0350 + C.SDIF ← PDR; PDR ← X.SDIF; 50279000 T 0351 + % PAGE 23 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50280000 T 0354 + C.PSRF ← PDR; PDR ← X.PSRF; 50281000 T 0354 + C.PIRF ← PIR; PIR ← X.PIRF; 50282000 T 0357 + C.FLTFF ← REAL (FLTF); 50283000 T 0360 + C.TFFFF ← REAL (TFFF); 50284000 T 0362 + C.OFFFF ← REAL (OFFF); 50285000 T 0364 + CX.SGNFF ← SGNF; 50286000 T 0365 + C.LLF ← LL; 50287000 T 0367 + TS ← LL; LL ← X.LLF; X.[10:5] ← TS; 50288000 T 0369 + CX.TAG ← RCW; 50289000 T 0373 + IF ENTR THEN 50290000 T 0374 + BEGIN % EXPECTED PROCEDURE ENTRY 50291000 T 0375 + MOVE (C,M[F + 1]); MEMCYCLE; 50292000 T 0376 + MOVE (M[F],C); MEMCYCLE; 50293000 T 0381 + C.STKNR ← A.STKNR; 50294000 T 0387 + C.DISP ← A.DISP; 50295000 T 0389 + CX.DSBIT ← QC7F; 50296000 T 0391 + C.LLF ← LL; 50297000 T 0393 + C.EBIT ← 1; 50298000 T 0395 + MOVE (C,M[F]); MEMCYCLE; 50299000 T 0397 + GO TO DISPLAYUPDATE; % ON PAGE 25 50300000 T 0402 + END; 50300500 T 0403 + % PAGE 24 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50301000 T 0403 + % ACCIDENTAL PROCEDURE ENTRY 50302000 T 0403 + ADJ (0,0); 50303000 T 0403 + MOVE (A,B); 50304000 T 0404 + MOVE (C,A); 50305000 T 0405 + B.DSBIT ← QC7F; 50306000 T 0406 + B.DF ← S + 1 - F; 50307000 T 0408 + F ← S + 1; 50308000 T 0411 + B.VBIT ← QC1F; 50309000 T 0412 + BX.TAG ← MSCW; 50310000 T 0414 + B.LLF ← LL; 50311000 T 0416 + B.EBIT ← 1; 50312000 T 0418 + AROF ← BROF ← TRUE; 50313000 T 0419 + ADJ (0,0); 50314000 T 0421 + % PAGE 25 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50315000 T 0422 + DISPLAYUPDATE: 50316000 T 0422 + D [LL] ← F; 50317000 T 0422 + X.LLF ← LL; 50318000 T 0423 + L9: 50319000 T 0425 + IF LL = 0 OR QC6F = 1 THEN 50320000 T 0425 + BEGIN 50321000 T 0427 + BYPASUPDATE: 50322000 T 0427 + LL ← X.LLF; 50323000 T 0428 + IF MVST THEN GO TO OC 50324000 T 0429 + ELSE GO TO SEGMENTDESC; % ON PAGE 28 50325000 T 0430 + END; 50326000 T 0431 + LL ← LL - 1; 50327000 T 0431 + IF D[LL] = BUF AND LL ≤ X.[10:5] THEN GO TO BYPASUPDATE; 50328000 T 0432 + D[LL] ← BUF; MOVE (M[BUF], C); MEMCYCLE; 50329000 T 0435 + % PAGE 26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50330000 T 0442 + IF CX.TAG ≠ MSCW OR LL ≠ C.LLF THEN 50331000 T 0442 + BEGIN 50332000 T 0444 + QC2F ← 1; I7SEQUENCEERROR; 50333000 T 0445 + END; 50334000 T 0448 + LABELF: 50335000 T 0448 + IF CX.DSBIT = 0 THEN 50336000 T 0449 + BEGIN 50337000 T 0450 + BUF ← TEMP + C.DISP; 50338000 T 0450 + GO TO L9 50339000 T 0452 + END; 50340000 T 0453 + MOVE (C,A); 50341000 T 0453 + BUF2 ← D0 + 2; 50342000 T 0454 + MOVE (M[STACKVECTOR], C); MEMCYCLE; 50343000 T 0455 + IF CX.PBIT ≠ 1 THEN I12PRESENCEBIT; 50344000 T 0461 + IF C.LENGTH ≤ A.STKNR THEN 50345000 T 0463 + BEGIN 50346000 T 0465 + QC2F ← 1; 50347000 T 0465 + I3INVALIDINDEX; 50348000 T 0467 + END; 50349000 T 0469 + % PAGE 27 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50350000 T 0469 + BUF2 ← C.ADDR + A.STKNR; 50351000 T 0469 + MOVE (M[BUF2], C); MEMCYCLE; 50352000 T 0471 + IF CX.PBIT ≠ 1 THEN I12PRESENCEBIT; 50353000 T 0476 + TEMP ← C.ADDR; 50354000 T 0478 + BUF ← TEMP + A.DISP; 50355000 T 0479 + GO TO L9; 50356000 T 0481 + % PAGE 28 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50357000 T 0481 + SEGMENTDESC: 50358000 T 0481 + C.SDIF ← PDR; 50359000 T 0482 + BUF2 ← D[C.LEVELPCW] + C.DELTAPCW; 50360000 T 0483 + MOVE (M[D[C.LEVELPCW] + C.DELTAPCW], C); MEMCYCLE; 50361000 T 0486 + IF CX.TAG ≠ SEGDESC THEN 50362000 T 0493 + BEGIN 50363000 T 0494 + QC2F ← 1; 50364000 T 0495 + I8SEQUENCEERROR; 50365000 T 0496 + END; 50366000 T 0497 + IF CX.PBIT ≠ 1 THEN I12PRESENCEBIT; 50367000 T 0497 + PBR ← C.ADDR; PROF ← FALSE; 50368000 T 0499 + IF NOT RETN THEN GO TO OC; 50369000 T 0501 + % PAGE 29 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50370000 T 0502 + IF QC1F ≠ 1 THEN GO TO OC; 50371000 T 0502 + OP ← 1; % FORCE A VALC INTO THE T REGISTER AND CONTINUE THE 50372000 T 0504 + % PROCESSING AS A VALUE CALL OPERATOR 50373000 T 0504 + GO TO LABELE; % ON PAGE 2 50374000 T 0504 + % PAGE 30 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50375000 T 0505 + STARTRETN: 50376000 T 0505 + ADJ (0,1); 50377000 T 0506 + L10: 50378000 T 0507 + F ← D[LL]; 50379000 T 0507 + MOVE (M[F + 1], C); MEMCYCLE; 50380000 T 0508 + IIHF ←BOOLEAN(C.NBIT); PDR ← C.SDIF; PIR ← C.PIRF; 50381000 T 0513 + PSR ← C.PSRF; NCSF ←BOOLEAN(C.NBIT); X.[10:5] ← LL; 50382000 T 0517 + FLTF ←BOOLEAN(C.FLTFF); TFFF ←BOOLEAN(C.TFFFF); OFFF ← BOOLEAN 50383000 T 0521 + (C.OFFFF); SGNF ← CX.SGNFF; LL ← C.LLF; 50384000 T 0524 + S ← F - 1; 50385000 T 0528 + TEMP ← BOSR; X.LLF ← LL; 50386000 T 0529 + IF F = BOSR + 1 THEN 50387000 T 0531 + BEGIN 50388000 T 0533 + QC2F ← 1; 50389000 T 0533 + I6BOSNORMAL; 50390000 T 0535 + END; 50391000 T 0535 + GO TO LABELG; % ON PAGE 31 50392000 T 0535 + % PAGE 31 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50393000 T 0536 + STARTEXIT: 50394000 T 0536 + ADJ (0,0); 50395000 T 0537 + GO TO L10; % ON PAGE 30 50396000 T 0538 + LABELG: 50397000 T 0538 + MOVE (M[F], C); MEMCYCLE; 50398000 T 0539 + IF CX.TAG ≠ MSCW THEN 50399000 T 0544 + BEGIN 50400000 T 0545 + QC2F ← 1; 50401000 T 0546 + I8SEQUENCEERROR; 50402000 T 0547 + END; 50403000 T 0548 + F ← F - C.DF; 50404000 T 0548 + BUF ← F; QC1F ← C.VBIT; 50405000 T 0550 + LABELS: 50406000 T 0553 + IF BOSR > BUF THEN 50407000 T 0553 + BEGIN 50408000 T 0553 + SUFL ← TRUE; 50409000 T 0554 + I5BOSERROR; 50410000 T 0555 + END; 50411000 T 0555 + D[LL] ← BUF; MOVE (M[BUF], C); MEMCYCLE; 50412000 T 0555 + % PAGE 32 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50413000 T 0562 + IF CX.TAG ≠ MSCW THEN 50414000 T 0562 + BEGIN 50415000 T 0563 + QC2F ← 1; I8SEQUENCEERROR; 50416000 T 0563 + END; 50417000 T 0566 + IF LL = C.LLF AND C.EBIT = 1 THEN GO TO LABELF; % ON PAGE 26 50418000 T 0566 + BUF ← D[LL] - C.DF; 50419000 T 0569 + GO TO LABELS; % ON PAGE 31 50420000 T 0571 + % PAGE 33 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50421000 T 0572 + STARTMVST: 50422000 T 0572 + ADJ (0,1); 50423000 T 0572 + C.DF ← S - F; C.LLF ← LL; C.NBIT ← REAL (NCSF); 50424000 T 0573 + C.DS ← S - BOSR; 50425000 T 0578 + C.FLTFF ←REAL(FLTF); C.TFFFF ←REAL(TFFF); C.OFFFF ←REAL(OFFF); 50426000 T 0581 + CX.SGNFF ← SGNF; CX.TAG ← TOS; 50427000 T 0586 + MOVE (M[BOSR], T1); 50428000 T 0589 + IF T2.ROBIT ≠ 1 THEN 50429000 T 0593 + BEGIN MOVE (C,M[BOSR]); MEMCYCLE END; 50430000 T 0595 + COMMENT THE LAST TWO STATEMENTS USE PSEUDO REGISTER T1,T2 TO 50431000 T 0600 + SIMULATE PROTECT LOGIC IN MEMORY MODULES; 50432000 T 0600 + BUF2 ← D0 + 2; 50433000 T 0600 + MOVE (M[STACKVECTOR], C); MEMCYCLE; 50434000 T 0602 + IF CX.PBIT ≠ 1 THEN I13PRESENCEBIT; 50435000 T 0608 + NTGR; IF INTFL THEN I2INTEGERIZE; 50436000 T 0610 + IF B.MANF < 0 OR B.MANF ≥ C.LENGTH THEN I4INVALIDINDEX; 50437000 T 0614 + BUF2 ← C.ADDR + B.ADDR; 50438000 T 0618 + MOVE (M[C.ADDR + B.ADDR], A); MEMCYCLE; 50439000 T 0620 + % PAGE 34 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50440000 T 0627 + IF AX.PBIT ≠ 1 THEN 50441000 T 0627 + BEGIN MOVE (A,C); I13PRESENCEBIT; END; 50442000 T 0628 + SNR ← B.ADDR;BROF ← FALSE; 50443000 T 0630 + BOSR ← A.ADDR; TEMP ← A.ADDR; LOSR ← A.ADDR + A.LENGTH; 50444000 T 0632 + C ← PID; CX.TAG ← SINGL; 50445000 T 0637 + MOVE (M[BOSR], T1); MOVE (C, M[BOSR]); MOVE (T1, C); MEMCYCLE; 50446000 T 0639 + S ← C.DS + BOSR; F ← S - C.DF; BUF ← S - C.DF; LL ← C.LLF; 50447000 T 0649 + X.[10:5] ← LL; NCSF ← BOOLEAN (C.NBIT); IIHF ← BOOLEAN(C.NBIT); 50448000 T 0656 + FLTF ← BOOLEAN (C.FLTFF); TFFF ← BOOLEAN (C.TFFFF); 50449000 T 0660 + OFFF ← BOOLEAN (C.OFFFF); SGNF ← C.SGNFF; 50450000 T 0663 + X.LLF ← LL; 50451000 T 0665 + GO TO LABELS; % ON PAGE 31 50452000 T 0667 + % PAGE 35 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50453000 T 0667 + STARTDBTR: 50454000 T 0667 + ADJ (1,1); 50455000 T 0668 + IF B.LOBIT ≠ 1 THEN GO TO L11 50456000 T 0669 + ELSE GO TO L12; 50457000 T 0670 + STARTDBFL: 50458000 T 0671 + ADJ (1,1); 50459000 T 0672 + IF B.LOBIT = 1 THEN 50460000 T 0673 + L11: BEGIN AROF ← FALSE; BROF ← FALSE; GO TO OC END; 50461000 T 0674 + L12: BROF ← FALSE; 50462000 T 0677 + GO TO LABELB; % ON PA6E 36 50463000 T 0677 + % PAGE 36 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50464000 T 0678 + STARTDBUN: 50465000 T 0678 + ADJ (1,2); 50466000 T 0679 + LABELB: 50467000 T 0680 + IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN 50468000 T 0680 + GO TO LABELOPND; % ON PAGE 36 50469000 T 0682 + MOVE (A,C); 50470000 T 0683 + L13: IF CX.TAG = IRW THEN 50471000 T 0684 + BEGIN 50472000 T 0686 + IF C.EBIT ≠ 0 THEN 50473000 T 0686 + BEGIN AROF ← FALSE; I8SEQUENCEERROR END; 50474000 T 0688 + MOVE (M[D[LEVEL(C) ] + DELTA(C) ], C);MEMCYCLE; 50475000 T 0689 + GO TO L13; 50476000 T 0696 + END; 50477000 T 0697 + % PAGE 37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50478000 T 0697 + IF CX.TAG = PCW THEN GO TO PCW2; % ON PAGE 39 50479000 T 0697 + AROF ← FALSE; 50480000 T 0699 + I1INVALIDOPERATOR; 50481000 T 0699 + % PAGE 38 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50482000 T 0700 + LABELOPND: 50483000 T 0700 + NTGR; IF INTFL THEN I2INTEGERIZE; 50484000 T 0701 + IF B.MANF < 0 THEN I9INVALIDINDEX; 50485000 T 0705 + IF B.MANF ≥ 2097152 THEN I9INVALIDINDEX; 50486000 T 0709 + IF B.LOBIT = 0 THEN PSR ← 0 50487000 T 0714 + ELSE PSR ← 3; 50488000 T 0715 + PIR ← B.[27:20]; PROF ← FALSE; BROF ← FALSE; 50489000 T 0717 + GO TO OC; 50490000 T 0720 + % PAGE 39 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50491000 T 0721 + PCW2: 50492000 T 0721 + IF LL ≠ C.LLF THEN 50493000 T 0721 + BEGIN AROF ← FALSE; I8SEQUENCEERROR END; 50494000 T 0722 + PDR ← C.SDIF; PSR ← C.PSRF; PIR ← C.PIRF; 50495000 T 0724 + BUF2 ← D[C.LEVELPCW] + C.DELTAPCW; 50496000 T 0727 + MOVE (M[D[C.LEVELPCW] + C.DELTAPCW], C); 50497000 T 0730 + AROF ← FALSE; 50498000 T 0736 + IF CX.TAG ≠ SEGDESC THEN 50499000 T 0736 + BEGIN QC2F ← 1; I8SEQUENCEERROR END; 50500000 T 0738 + IF CX.PBIT ≠ 1 THEN I12PRESENCEBIT; 50501000 T 0740 + PBR ← C.ADDR; PROF ← FALSE; 50502000 T 0742 + GO TO OC; 50503000 T 0744 + % PAGE 40 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50504000 T 0745 + STARTBRTR: 50505000 T 0745 + ADJ (1,2); 50506000 T 0745 + IF A.LOBIT ≠ 1 THEN 50507000 T 0746 + L14: BEGIN STEPPSR (2); AROF ← FALSE; GO TO OC END; 50508000 T 0747 + L15: 50509000 T 0750 + AROF ← FALSE; 50510000 T 0750 + STARTBRUN: 50511000 T 0750 + C.[32:8] ← SYLLABLE; STEPPSR(1); C.[40:8] ← SYLLABLE; 50512000 T 0751 + PSR ← C.[32:3]; PIR ← C.[35:13]; PROF ← FALSE; 50513000 T 0759 + GO TO OC; 50514000 T 0762 + STARTBRFL: 50515000 T 0763 + ADJ (1,2); 50516000 T 0763 + IF A.LOBIT = 0 THEN GO TO L15 ELSE GO TO L14; 50517000 T 0764 + % PAGE 41 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50518000 T 0766 + STARTSTFF: 50519000 T 0766 + ADJ (1,2); 50520000 T 0767 + IF AX.TAG ≠ IRW THEN 50521000 T 0768 + BEGIN MOVE (A, C); I1INVALIDOPERATOR END; 50522000 T 0769 + BUF ← BUF2 ← D[LEVEL(A)]; 50523000 T 0771 + L16: 50524000 T 0773 + MOVE (M[BUF2], C); 50525000 T 0774 + IF CX.TAG ≠ MSCW THEN I8SEQUENCEERROR; 50526000 T 0778 + IF CX.DSBIT ≠ 0 THEN 50527000 T 0779 + BEGIN BUF2 ← BUF2 - C.DF; GO TO L16 END; 50528000 T 0781 + A.STKNR ← C.STKNR; 50529000 T 0783 + GO TO LABELX; % ON PAGE 18 50530000 T 0786 + % PAGE 42 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50531000 T 0786 + LABELW: 50532000 T 0786 + A.DISP ← BUF - TEMP; A.ADRCPL ← DELTA(A); A.EBIT ← 1; 50533000 T 0787 + GO TO OC; 50534000 T 0793 + % PAGE 43 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50535000 T 0793 + STARTMKST: 50536000 T 0793 + ADJ (0,0); 50537000 T 0794 + B ← BX ← 0; 50538000 T 0795 + B.DF ← S + 1 - F; F ← S + 1; BX.TAG ← MSCW; BROF ← TRUE; 50539000 T 0796 + ADJ (0,0); 50540000 T 0802 + GO TO OC; 50541000 T 0803 + % PAGE 44 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SET INTERRUPTS FOR ALL ERVSFLOW 50542000 T 0804 + % SYLLABLE DEPENDENT INTERRUPTS 50543000 T 0804 + % (NON-PRESENCE BIT) 50544000 T 0804 + INVOPLBL: 50545000 T 0804 + ADJ (0,0); 50546000 T 0805 + B ← BX ← 0; 50547000 T 0806 + B ← INVOP; 50548000 T 0807 + GO TO L17; 50549000 T 0808 + INVINDLBL: 50550000 T 0810 + ADJ (0,0); 50551000 T 0810 + B ← BX ← 0; 50552000 T 0811 + B ← INVINXI; 50553000 T 0812 + GO TO L17; 50554000 T 0813 + STKUNFLBL: 50555000 T 0815 + ADJ (0,0); 50556000 T 0815 + B ← BX ← 0; 50557000 T 0816 + B ← STKUNFI; 50558000 T 0817 + BROF ← TRUE; 50559000 T 0818 + GO TO OC; 50560000 T 0818 + % PAGE 45 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50561000 T 0821 + BOSLBL: 50562000 T 0821 + ADJ (0,0); 50563000 T 0821 + B ← BX ← 0; 50564000 T 0822 + B ← BOSINT; 50565000 T 0823 + GO TO L17; 50566000 T 0824 + SEQERLBL: 50567000 T 0826 + ADJ (0,0); 50568000 T 0826 + B ← BX ← 0; 50569000 T 0827 + B ← SEQERRI; 50570000 T 0828 + L17: PIR ← PIR - PICR; PSR ← OPSR; 50571000 T 0829 + INTLBL: % SET INTERRUPT FOR INTERRUPT CONDITION RECOGNISED WHEN 50572000 T 0831 + % INTEGERIZE USED AS SUB-OPERATOR IN ERVSFLOW. NOTE THAT 50573000 T 0831 + % SETTING OF B WITH INTERRUPT ID AND OTHER NECESSARY OPER- 50574000 T 0831 + % ATIONS TOOK PLACE AT TIME INTERRUPT WAS RECOGNISED IN 50575000 T 0831 + % INTEGERIZE. 50576000 T 0831 + BROF ← TRUE; 50577000 T 0831 + SDIS ← 1; MOVE (C,A); AROF ← TRUE; 50578000 T 0831 + GO TO OC; 50579000 T 0835 + % PAGE 46 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50580000 T 0837 + PRES13LBL: 50581000 T 0837 + ADJ (0,0); 50582000 T 0837 + PRES11LBL: 50583000 T 0838 + IF C.CBIT ≠ 1 THEN 50584000 T 0838 + BEGIN C.CBIT ← 1; C.ADDR ← BUF2 END; 50585000 T 0839 + MOVE (C,A); 50586000 T 0843 + PRES10LBL: 50587000 T 0844 + ADJ (0,0); 50588000 T 0845 + IF NOT (VALC OR ENTR OR MVST) THEN T1 ← 1; % CHECK ** 50589000 T 0846 + PIR ← PIR - PICR; PSR ← OPSR; 50590000 T 0850 + L18: 50591000 T 0852 + B ← BX ← 0; 50592000 T 0853 + SDIS ← 1; AROF ← BROF ← TRUE; B.SOBIT ← T1; 50593000 T 0854 + B.[18:30] ← PRESBIT; 50594000 T 0859 + GO TO OC; 50595000 T 0860 + PRES12LBL: 50596000 T 0863 + % PAGE 47 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50597000 T 0863 + IF C.CBIT ≠ 1 THEN 50598000 T 0863 + BEGIN C.CBIT ← 1; C.ADDR ← BUF2 END; 50599000 T 0864 + MOVE (C,A); 50600000 T 0868 + ADJ (0,0); 50601000 T 0869 + GO TO L18; % ON PAGE 46 50602000 T 0870 + OC: 50603000 T 0870 + END ERVSFLOW; 50604000 T 0871 + 97 IS 874 LONG, NEXT SEG 12 + PROCEDURE STORE(OP); VALUE OP; REAL OP; 51000000 T 0911 + COMMENT OP=0: STORE DESTRUCTIVE 51001000 T 0911 + OP=1: STORE NON-DESTRUCTIVE 51002000 T 0911 + OP=2: OVERWRITE DESTRUCTIVE 51003000 T 0911 + OP=3: OVERWRITE NON-DESTRUCTIVE 51004000 T 0911 + OP=7: READ-WITH-LOCK; 51005000 T 0911 + BEGIN 51006000 T 0911 + LABEL EVALDESC,EVALIRW,TRYWRITE,MIXEDTYPECHECK,FIXROFS, 51007000 T 0911 + START OF SEGMENT ********** 100 + LABELF,ACCIDENTALENTRY, 51008000 T 0000 + OC; 51009000 T 0000 + DEFINE INVALIDOP = BEGIN INTFAMD(2); GO OC; END#, 51010000 T 0000 + PRESENCEBIT = BEGIN INTFAMD(8); GO OC END#, 51011000 T 0000 + INVALIDINDEX= BEGIN INTFAMD(7); GO OC END#, 51012000 T 0000 + MEMORYPROTECT=BEGIN INTFAMD(6); GO OC END#; 51013000 T 0000 + DEFINE OVERWRITE = (OP=2 OR OP=3)#, 51014000 T 0000 + NONDESTRUCTIVE = BOOLEAN(OP)#, 51015000 T 0000 + DESTRUCTIVE = NOT NONDESTRUCTIVE#, 51016000 T 0000 + READWITHLOCK = (OP=7)#; 51017000 T 0000 + %%%%% PAGE 1 %%%%%%%%%%%%%%% 51018000 T 0000 + ADJ(1,1); 51026000 T 0000 + IF AX.TAG=SINGL OR AX.TAG=DOUBL THEN EXCH; 51027000 T 0001 + MOVE(A,C); 51029000 T 0004 + IF CX.TAG=IRW THEN GO TO EVALIRW; 51030000 T 0005 + IF CX.TAG≠DATADESC OR C.IBIT≠1 THEN INVALIDOP; 51031000 T 0007 + EVALDESC: 51032000 T 0012 + IF C.RBIT≠0 THEN MEMORYPROTECT; 51033000 T 0012 + IF CX.PBIT≠1 THEN PRESENCEBIT; 51034000 T 0015 + MM←C.INDEX+C.ADDR; 51035000 T 0018 + TRYWRITE: 51036000 T 0020 + IF MM + MM > MEMMODS % INVALID ADDRESS CHECK FOR STORES 51036100 T 0021 + THEN BEGIN 51036200 T 0021 + SETINTERRUPT (INVADRI); 51036300 T 0022 + GO OC 51036400 T 0023 + END; 51036500 T 0024 + MOVE(M[MM],C); MEMCYCLE; 51037000 T 0025 + IF OVERWRITE OR READWITHLOCK OR NOT BOOLEAN(CX.TAG) 51038000 T 0030 + THEN MOVE(B,M[MM]); 51039000 T 0033 + IF OVERWRITE OR READWITHLOCK THEN GO TO LABELF; 51040000 T 0038 + %%%%% PAGE 2 %%%%%%%%%%%%%%% 51041000 T 0042 + CASE CX.TAG OF 51042000 T 0042 + BEGIN % CASE TYPE 51043000 T 0043 +PRT(775) = *CASE STATEMENT DESCRIPTOR* + ; % 0 SINGL 51044000 T 0043 + GO TO EVALIRW; % 1 IRW 51045000 T 0043 + ; % 2 DOUBL 51046000 T 0044 + MEMORYPROTECT; % 3 LINKS,CODE,MSCW,RCW,L 51047000 T 0044 + ; % 4 STEP INDEX WORD 51048000 T 0045 + IF C.IBIT=1 THEN GO EVALDESC ELSE MEMORYPROTECT; % 5 51049000 T 0045 + ; % 6 UNINITIALIZED 51050000 T 0049 + GO TO ACCIDENTALENTRY; % 7 PCW 51051000 T 0049 + END; 51052000 T 0049 + START OF SEGMENT ********** 101 + 101 IS 8 LONG, NEXT SEG 100 + MIXEDTYPECHECK: 51053000 T 0049 + CASE REAL(CX.TAG=DOUBL)×2 + REAL(BX.TAG=DOUBL) OF 51054000 T 0050 + BEGIN % C B 51055000 T 0053 +PRT(776) = *CASE STATEMENT DESCRIPTOR* + ; % S S 51056000 T 0053 + BEGIN IF Y.[9:1]=1 THEN B←(B+1)&B[1:1:8]; % S D 51057000 T 0053 + BX.TAG←0; MOVE(B,M[MM]); MEMCYCLE; % 51058000 T 0057 + END; % 51059000 T 0064 + BEGIN BX.TAG←DOUBL; Y←YX←0; YX.TAG←DOUBL; % D S 51060000 T 0065 + MOVE(B,M[MM ]); MEMCYCLE; % 51061000 T 0070 + MOVE(Y,M[MM+1]); MEMCYCLE; % 51062000 T 0075 + END; % 51063000 T 0081 + BEGIN MOVE(Y,M[MM+1]); MEMCYCLE; % D D 51064000 T 0081 + END; % 51065000 T 0087 + END; 51066000 T 0087 + START OF SEGMENT ********** 102 + 102 IS 4 LONG, NEXT SEG 100 + FIXROFS: 51067000 T 0087 + AROF←FALSE; 51068000 T 0088 + BROF←NONDESTRUCTIVE; 51069000 T 0088 + GO TO OC; 51070000 T 0089 + LABELF: 51071000 T 0090 + IF NOT READWITHLOCK THEN GO TO FIXROFS; 51072000 T 0090 + MOVE(C,A); 51073000 T 0091 + BROF ← FALSE; 51073100 T 0092 + GO TO OC; 51074000 T 0093 + %%%%% PAGE 3 %%%%%%%%%%%%%%% 51075000 T 0093 + EVALIRW: 51076000 T 0093 + IF C.EBIT=0 THEN 51077000 T 0094 + BEGIN %%%%% NORMAL IRW %%%%% 51078000 T 0095 + Q02F←1; 51079000 T 0095 + A.DISP←D[LEVEL(C)] - BOSR; 51080000 T 0097 + A.STKNR←SNR; 51081000 T 0100 + TEMP←BOSR; 51082000 T 0102 + BUF←D[LEVEL(C)]; 51083000 T 0103 + MM←BUF+DELTA(C); 51084000 T 0104 + END 51085000 T 0106 + ELSE 51086000 T 0106 + BEGIN %%%%% STUFFED IRW %%%%% 51087000 T 0106 + Q02F←0; 51088000 T 0106 + MOVE(C,A); 51089000 T 0108 + IF SNR = C.STKNR THEN TEMP←BOSR 51090000 T 0109 + ELSE BEGIN 51091000 T 0111 + MOVE(M[STACKVECTOR],C); MEMCYCLE; 51092000 T 0112 + IF CX.PBIT=0 THEN PRESENCEBIT; 51093000 T 0118 + IF C.LENGTH≤A.STKNR THEN INVALIDINDEX; 51094000 T 0121 + MOVE(M[C.ADDR+A.STKNR],C); MEMCYCLE; 51095000 T 0125 + IF CX.PBIT=0 THEN PRESENCEBIT; 51096000 T 0131 + TEMP←C.ADDR; 51097000 T 0134 + END; 51098000 T 0136 + BUF←TEMP+A.DISP; 51099000 T 0136 + MM←BUF+A.[35:13]; 51100000 T 0137 + END; 51101000 T 0139 + GO TO TRYWRITE; 51102000 T 0139 + ACCIDENTALENTRY: 51103000 T 0140 + Q01F←1; 51104000 T 0140 + NOTYETCODED; 51105000 T 0141 + OC: 51106000 T 0142 + END STORE; 51107000 T 0143 + 100 IS 144 LONG, NEXT SEG 12 + PROCEDURE ADJ(NEWAROF,NEWBROF); VALUE NEWAROF,NEWBROF; 60000000 T 0911 + INTEGER NEWAROF,NEWBROF; 60001000 T 0911 + BEGIN DEFINE 60002000 T 0911 + START OF SEGMENT ********** 103 + PUSHA = 60003000 T 0000 + BEGIN 60003150 T 0000 + STKOVFF ← S ← S + 1 =LOSR; 60003300 T 0000 + MOVE(A, M[S]); MEMCYCLE; AROF ← FALSE; 60004000 T 0000 + IF AX.TAG = DOUBL 60004300 T 0000 + THEN BEGIN 60004600 T 0000 + STKOVFF ← S ← S + 1 = LOSR; 60005000 T 0000 + XX.TAG ← DOUBL; MOVE(X, M[S]); MEMCYCLE; 60006000 T 0000 + END 60006300 T 0000 + END#, 60006600 T 0000 + PUSHB = 60007000 T 0000 + BEGIN 60007150 T 0000 + STKOVFF ← S ← S + 1 =LOSR; 60007300 T 0000 + MOVE(B, M[S]); MEMCYCLE; BROF ← FALSE; 60008000 T 0000 + IF BX.TAG = DOUBL 60008300 T 0000 + THEN BEGIN 60008600 T 0000 + STKOVFF ← S ← S + 1 = LOSR; 60009000 T 0000 + YX.TAG ← DOUBL; MOVE(Y, M[S]); MEMCYCLE; 60010000 T 0000 + END 60010300 T 0000 + END#, 60010600 T 0000 + POPA = BEGIN MOVE(M[S],A); S←S-1; MEMCYCLE; AROF←TRUE; 60011000 T 0000 + IF AX.TAG=DOUBL THEN 60012000 T 0000 + BEGIN X←A; XX←AX; 60013000 T 0000 + MOVE(M[S],A); S←S-1; MEMCYCLE; 60014000 T 0000 + END; 60015000 T 0000 + END#, 60016000 T 0000 + POPB = BEGIN MOVE(M[S],B); S←S-1; MEMCYCLE; BROF←TRUE; 60017000 T 0000 + IF BX.TAG=DOUBL THEN 60018000 T 0000 + BEGIN Y←B; YX←BX; 60019000 T 0000 + MOVE(M[S],B); S←S-1; MEMCYCLE; 60020000 T 0000 + END; 60021000 T 0000 + END#, 60022000 T 0000 + ATOB = BEGIN B←A; BX←AX; AROF←FALSE; BROF←TRUE; 60023000 T 0000 + IF AX.TAG=DOUBL THEN BEGIN Y←X; YX←XX; END; 60024000 T 0000 + END#, 60025000 T 0000 + BTOA = BEGIN A←B; AX←BX; AROF←TRUE; BROF←FALSE; 60026000 T 0000 + IF BX.TAG=DOUBL THEN BEGIN X←Y; XX←YX; END; 60027000 T 0000 + END#; 60028000 T 0000 + IF NEWAROF<0 OR NEWAROF>1 OR NEWBROF<0 OR NEWBROF>2 60029000 T 0000 + THEN BEGIN ERROR(98); GO TO EOJ; END; 60030000 T 0003 + AROF←AROF AND TRUE; BROF←BROF AND TRUE; 60031000 T 0007 + CASE (0&NEWAROF[45:47:1]&NEWBROF[43:46:2] 60032000 T 0009 + &REAL(AROF)[46:47:1]&REAL(BROF)[47:47:1]) OF 60033000 T 0012 + BEGIN % NEWA NEWB AROF BROF CASE 60034000 T 0014 +PRT(777) = *CASE STATEMENT DESCRIPTOR* + ; % 0 0 0 0 0 60035000 T 0014 + PUSHB; % 0 0 0 1 1 60036000 T 0014 + PUSHA; % 0 0 1 0 2 60037000 T 0034 + BEGIN PUSHB; PUSHA; END; % 0 0 1 1 3 60038000 T 0054 + POPA; % 1 0 0 0 4 60039000 T 0093 + BTOA; % 1 0 0 1 5 60040000 T 0110 + ; % 1 0 1 0 6 60041000 T 0117 + PUSHB; % 1 0 1 1 7 60042000 T 0117 + POPB; % 0 1 0 0 8 60043000 T 0137 + ; % 0 1 0 1 9 60044000 T 0154 + ATOB; % 0 1 1 0 10 60045000 T 0154 + BEGIN PUSHB; ATOB; END; % 0 1 1 1 11 60046000 T 0161 + BEGIN POPA; POPB; END; % 1 1 0 0 12 60047000 T 0187 + BEGIN BTOA; POPB; END; % 1 1 0 1 13 60048000 T 0221 + POPB; % 1 1 1 0 14 60049000 T 0245 + ; % 1 1 1 1 15 60050000 T 0263 + ; % 0 2 0 0 16 60051000 T 0263 + ; % 0 2 0 1 17 60052000 T 0263 + ATOB; % 0 2 1 0 18 60053000 T 0263 + BEGIN PUSHB; ATOB; END; % 0 2 1 1 19 60054000 T 0269 + POPA; % 1 2 0 0 20 60055000 T 0295 + BTOA; % 1 2 0 1 21 60056000 T 0313 + ; % 1 2 1 0 22 60057000 T 0320 + ; % 1 2 1 1 23 60058000 T 0320 + END; 60059000 T 0320 + START OF SEGMENT ********** 104 + 104 IS 24 LONG, NEXT SEG 103 + IF NOT (NEWAROF=REAL(AROF) AND (NEWBROF=2 OR 60060000 T 0320 + NEWBROF=REAL(BROF))) 60061000 T 0321 + THEN BEGIN ERROR(99); MEMDUMP; GO EOJ END; 60062000 T 0322 + END ADJ; 60063000 T 0327 + 103 IS 328 LONG, NEXT SEG 12 + INTEGER PROCEDURE LEVEL(WORD); VALUE WORD; REAL WORD; 60064000 T 0911 + BEGIN 60065000 T 0911 + LEVEL ← REFLECTION[REAL( 60066000 T 0911 + BOOLEAN(WORD) AND NOT BOOLEAN(DELTAMASK[LL]) 60067000 T 0911 + ).[34:5]]; 60068000 T 0911 + END LEVEL; 60069000 T 0913 + INTEGER PROCEDURE DELTA(WORD); VALUE WORD; REAL WORD; 60070000 T 0915 + BEGIN 60071000 T 0915 + DELTA ← REAL(BOOLEAN(WORD) AND BOOLEAN(DELTAMASK[LL])); 60072000 T 0915 + END DELTA; 60073000 T 0917 + BOOLEAN PROCEDURE INTEGERIZE(ROUND,REG); VALUE ROUND; 60074000 T 0919 + BOOLEAN ROUND; REAL REG; 60075000 T 0919 + BEGIN 60076000 T 0919 + STREAM PROCEDURE M0VE4(S,D); 60077000 T 0919 + START OF SEGMENT ********** 105 +PRT(1000) = M0VE4 + BEGIN SI←S; DI←D; DS←4 WDS; 60078000 T 0000 + END M0VE4; 60079000 T 0000 + REAL OWNA,OWNAX,OWNX,OWNXX; 60080000 T 0001 +STACK(F+3) = OWNA +STACK(F+4) = OWNAX +STACK(F+5) = OWNX +STACK(F+6) = OWNXX + INTEGER I; 60081000 T 0001 +STACK(F+7) = I + LABEL FINIS; 60082000 T 0001 + DEFINE MAXNTGR = 549755813887#; 60083000 T 0001 + M0VE4(REG,OWNA); 60084000 T 0001 + IF OWNAX.TAG≠SINGL AND OWNAX.TAG≠DOUBL THEN 60085000 T 0002 + INTEGERIZE ← TRUE; 60086000 T 0005 + IF (INTEGERIZE←ABS(OWNA)>MAXNTGR) THEN GO TO FINIS; 60087000 T 0006 + IF NOT ROUND THEN 60088000 T 0008 + I ← OWNA DIV 1 60089000 T 0009 + ELSE IF OWNAX.TAG =SINGL THEN 60090000 T 0009 + I ← OWNA 60091000 T 0014 + ELSE % DOUBLE PRECISION ROUNDED CASE 60092000 T 0014 + BEGIN 60093000 T 0015 + DOUBLE(OWNA,OWNX,(I←OWNA DIV 1),0,-, 60094000 T 0016 + ←,OWNAX,OWNXX); 60095000 T 0018 + IF I≥0 AND OWNAX≥(0.5) THEN 60096000 T 0019 + BEGIN 60097000 T 0021 + IF (INTEGERIZE←(I+1)>+(MAXNTGR)) THEN 60098000 T 0021 + GO TO FINIS; 60099000 T 0023 + I←I+1; 60100000 T 0024 + END 60101000 T 0025 + ELSE IF I<0 AND OWNAX<-(0.5) THEN 60102000 T 0025 + BEGIN 60103000 T 0030 + IF (INTEGERIZE←(I-1)<-(MAXNTGR)) THEN 60104000 T 0030 + GO TO FINIS; 60105000 T 0032 + I←I-1; 60106000 T 0033 + END; 60107000 T 0034 + END; 60108000 T 0034 + OWNA←1; OWNAX←SINGL+SINGL; MOVE(OWNA,REG); 60109000 T 0034 + FINIS: 60110000 T 0037 + END INTEGERIZE; 60111000 T 0038 + 105 IS 44 LONG, NEXT SEG 12 + PROCEDURE INITIALIZE; 71000000 T 0919 +PRT(1001) = INITIALIZE + BEGIN 71001000 T 0919 + FILE CODE DISK SERIAL (2,30); 71002000 T 0919 + START OF SEGMENT ********** 106 +STACK(F+2) = CODE + FORMAT ERROR ("EQUATED FILE IS NOT ON DISK. ", 32("X"), //); 71003000 T 0003 + START OF SEGMENT ********** 107 +PRT(1002) = ERROR + 107 IS 13 LONG, NEXT SEG 106 + LABEL EOF; 71004000 T 0003 + ARRAY JUNK[0:59],JUNK1[0:29]; 71005000 T 0003 +STACK(F+3) = JUNK +STACK(F+4) = JUNK1 + ARRAY MEMS[0:89]; 71005100 T 0007 +STACK(F+5) = MEMS + LABEL EOF1; 71006000 T 0008 + INTEGER MSTART; 71007000 T 0008 +STACK(F+6) = MSTART + STREAM PROCEDURE MOVEN(S,D,N); VALUE N; 71008000 T 0008 +PRT(1003) = MOVEN + BEGIN SI←S; DI←D; DS←N WDS END; 71009000 T 0008 + STREAM PROCEDURE STRIP(J,M); 71010000 T 0011 +PRT(1004) = STRIP + BEGIN LOCAL S,SS; 71011000 T 0011 + SI←J; DI←M; 71012000 T 0012 + 45(48 BITS; SKIP 31 DB; 16 BITS; SKIP 1 DB); 71013000 T 0012 + END; 71014000 T 0017 + STREAM PROCEDURE NFLAG(M); 71015000 T 0017 +PRT(1005) = NFLAG + BEGIN SI←M; DI←M; DI←DI+8; DI←DI+7; SKIP 5 DB; 71016000 T 0017 + 1 BITS; DI←DI+4; DI←M; DS←1 RESET; END; 71017000 T 0019 + SEARCH(CODE,TBUF[*]); 71018000 T 0022 + IF TBUF[0] > 0 THEN 71019000 T 0025 + BEGIN 71020000 T 0026 + MULFILID ← TBUF[1]; 71020100 T 0026 + FILID ← TBUF [2]; 71020200 T 0027 + MSTART←0; 71021000 T 0028 + DO BEGIN 71022000 T 0029 + READ(CODE,30,JUNK[*])[EOF]; 71023000 T 0029 +PRT(1006) = EOF + READ(CODE,30,JUNK1[*])[EOF1]; 71024000 T 0034 +PRT(1007) = EOF1 + MOVEN(JUNK1,JUNK[30],30); 71025000 T 0039 + EOF1: 71026000 T 0041 + STRIP(JUNK,MEMS); 71027000 T 0042 + FOR INTG←0 STEP 2 UNTIL 89 DO 71028000 T 0044 + BEGIN 71028100 T 0045 + IF MSTART+INTG/2 > 8191 THEN GO EOF; 71028110 T 0045 + NFLAG(MEMS[INTG]); 71028200 T 0047 + MOVE(MEMS[INTG],M[MSTART+INTG/2]); 71028300 T 0048 + END; 71029000 T 0053 + MSTART←MSTART+45; 71030000 T 0056 + END UNTIL FALSE; 71031000 T 0057 + EOF: 71032000 T 0058 + END ELSE BEGIN WRITE (LP, ERROR); GO EOF END; 71033000 T 0058 + 71034000 T 0063 + 71035000 T 0063 + 71036000 T 0063 + 71037000 T 0063 + 71038000 T 0063 + S←8192; PDR←2; SNR←2; 71039000 T 0063 + SNR ←0; 71040000 T 0066 + SETINTERRUPT (EXTINTI + 15); 71045000 T 0066 + P←0&32768[8:28:20]; 71046000 T 0068 + PX←11; 71047000 T 0069 + MOVE(P,M[4]); 71048000 T 0070 + END OF INITIALIZE; 71049000 T 0074 + 106 IS 83 LONG, NEXT SEG 12 + PROCEDURE COBOLSIM; % SPECIAL INITIALIZATION FOR COBOL SIMULATION; 71050000 T 0919 +PRT(1010) = COBOLSIM + BEGIN 71051000 T 0919 + FILE DK DISK SERIAL "SIM" "INPUT" (2,30,150); 71052000 T 0919 + START OF SEGMENT ********** 108 +STACK(F+2) = DK + ARRAY J[0:29]; 71053000 T 0003 +STACK(F+3) = J + REAL SZ; 71054000 T 0005 +STACK(F+4) = SZ + INTEGER I,K; 71055000 T 0005 +STACK(F+5) = I +STACK(F+6) = K + STREAM PROCEDURE MV(F,T); 71056000 T 0005 +PRT(1011) = MV + BEGIN 71057000 T 0005 + SI ← F; DI ← T; DS ←2 WDS; 71058000 T 0006 + END MV; 71059000 T 0006 + READ(DK,30,J[*]); 71060000 T 0007 + D0 ← J[0]; 71061000 T 0011 + D1 ← J[2]; 71062000 T 0012 + D2 ← J[4]; 71063000 T 0014 + S ← (D3 ←F ← J[6]) + 2; 71064000 T 0015 + LOSR ← J[8]; 71065000 T 0018 + BOSR ← 0; 71066000 T 0019 + PBR ← J[10].[28:20]; 71067000 T 0020 + LL ← 3; 71068000 T 0022 + SZ ← J[10].[8:20]; 71069000 T 0022 + I ← -1; WHILE I ←1 +1 ≤ SZ DO 71070000 T 0024 + BEGIN 71071000 T 0027 + K ←-2; WHILE K <30 DO 71072000 T 0027 + MV(J[K ← K + 2],M[I]); 71073000 T 0029 + READ(DK,30,J[*]); 71074000 T 0035 + END; 71075000 T 0040 + END COBOLSIM; 71076000 T 0040 + 108 IS 46 LONG, NEXT SEG 12 + INTEGER PROCEDURE PROTECT (IOAREA, IOCW, RESULT); 71077000 T 0919 +PRT(1012) = PROTECT + VALUE IOAREA, IOCW; 71078000 T 0919 + REAL IOAREA, IOCW, RESULT; 71079000 T 0919 + BEGIN COMMENT CHECK AN INPUT AREA FOR THE PRESENCE 0F PROTECTED 71080000 T 0919 + WORDS AND RETURN THE MAXIMUM NUMBER OF WORDS THAT CAN BE 71081000 T 0919 + WRITTEN T0 MEMORY. PLACE THE ENDING ADDRESS IN THE RESULT 71082000 T 0919 + DESCRIPTOR.; 71083000 T 0919 + INTEGER WORDS; 71084000 T 0919 + START OF SEGMENT ********** 109 +STACK(F+3) = WORDS + REAL R, S; 71085000 T 0000 +STACK(F+4) = R +STACK(F+5) = S + LABEL FINISH; 71086000 T 0000 + IF BOOLEAN (IOCW.IOPBIT) AND BOOLEAN (IOCW.IOWBIT) 71087000 T 0000 + THEN BEGIN 71088000 T 0000 + S ← IOAREA.ADDR +IOAREA.LENGTH; 71089000 T 0002 + FOR R ← IOAREA.ADDR + 1.5 STEP 1 UNTIL S DO 71090000 T 0004 + IF BOOLEAN (M [R].TAG) 71091000 T 0009 + THEN BEGIN 71092000 T 0009 + WORDS ← R - 1.5 -IOAREA.ADDR; 71093000 T 0013 + RESULT.RSLTPRO ← 1; 71094000 T 0015 + GO FINISH; 71095000 T 0018 + END; 71096000 T 0020 + END 71097000 T 0020 + ELSE WORDS ← IOAREA.LENGTH - 1; 71098000 T 0020 + FINISH: 71099000 T 0022 + RESULT.RSLTADRS ← IOAREA.ADDR + WORDS + 1; 71100000 T 0023 + PROTECT ← WORDS; 71101000 T 0026 + END PROTECT AND ENDING ADDRESS PROCESSING; 71102000 T 0027 + 109 IS 30 LONG, NEXT SEG 12 + REAL PROCEDURE GETRESULT (MPXAB); 71103000 T 0919 + VALUE MPXAB; 71104000 T 0919 + REAL MPXAB; 71105000 T 0919 + BEGIN COMMENT GET THE NEXT RESULT DESCRIPTOR FOR MPXAB AND UPDATE 71106000 T 0919 + FIRSTEVENT, FIRSTEVENTI, CURRENT TIME AND MPX. THE 71107000 T 0919 + RESULT DESCRIPTOR THAT IS GOTTEN, IS FORGOTTEN.; 71108000 T 0919 + REAL R; 71109000 T 0919 + START OF SEGMENT ********** 110 +STACK(F+3) = R + REAL E, L; 71109100 T 0000 +STACK(F+4) = E +STACK(F+5) = L + INTEGER I, J, F; 71110000 T 0000 +STACK(F+6) = I +STACK(F+7) = J +STACK(F+10) = F + R ← MPX [I ← MPXAB + DELTAMPX, J ← FIRSTEVENTI [MPXAB]]; 71111000 T 0000 + IF R.RSLTERR ≠ 0 THEN R.RSLTEXC ← 1; 71112000 T 0003 + F ← FIRSTEVENTI [MPXAB] ← EVENTS [J].EVLINK; 71113000 T 0007 + L ← J; 71113100 T 0009 + DO L ← (E ← EVENTS[L]).EVLINK UNTIL E =0 OR E.EVMPX =MPXAB; 71113200 T 0010 + IF E ≠0 AND MPX[MPXAB, L].MPXINT =0 71113300 T 0015 + THEN MPX[MPXAB, L].MPXINT ← MPX[MPXAB, J].MPXINT; 71113400 T 0017 + MPX [I, J] ← EVENTS [J] ← 0; 71114000 T 0023 + FIRSTEVENT [MPXAB] ← EVENTS [F].EVTIME; 71115000 T 0026 + CURRENTT ← FIRSTEVENT [CURRENTMPX ← IF J ← FIRSTEVENT [2] = 0 71116000 T 0028 + OR (I ← FIRSTEVENT [1] ≤ J AND I ≠ 0) THEN 1 ELSE 2]; 71117000 T 0029 + IF CURRENTT ≠ 0 AND(CURRENTT < IDLETIME OR IDLETIME = 0) 71118000 T 0034 + THEN IDLETIME ← CURRENTT ELSE IDLETIME ← INTTIMER; 71119000 T 0037 + MPXOPS [MPXAB] ← MPXOPS [MPXAB] + 1; 71120000 T 0040 + IF CURRENTT = 0 THEN LASTEVENT [MPXAB] ← 0; 71121000 T 0042 + GETRESULT ← R; 71122000 T 0045 + END GETTING RESULT DESCRIPTOR; 71123000 T 0046 + 110 IS 50 LONG, NEXT SEG 12 + PROCEDURE PUTRESULT (LUNIT, MPXAB, IOTIME, RESULT); 71124000 T 0919 +PRT(1013) = PUTRESULT + VALUE LUNIT, MPXAB, IOTIME; 71125000 T 0919 + REAL RESULT; 71126000 T 0919 + INTEGER LUNIT, MPXAB, IOTIME; 71127000 T 0919 + BEGIN COMMENT DO THE LINKED LIST UPDATING BASED ON IOTIME (THE TIME 71128000 T 0919 + INCREMENT FOR AN I/O) AND UPDATE CURRENTT AND 71129000 T 0919 + CURRENTMPX AS REQUIRED. PUT THE RESULT DESCRIPTOR IN 71130000 T 0919 + MPX BASED ON LUNIT AND MPXAB.; 71131000 T 0919 + INTEGER T, I, J, K; 71132000 T 0919 + START OF SEGMENT ********** 111 +STACK(F+2) = T +STACK(F+3) = I +STACK(F+4) = J +STACK(F+5) = K + DEFINE EVERYTHING =MPXAB [1:46:2] 71133000 T 0000 + &1 [6:47:1] % BUSY 71134000 T 0000 + &I [7:43:5] % EVENT LINK 71135000 T 0000 + #; 71136000 T 0000 + IF T←IOTIME≥LASTEVENT [MPXAB] % COMMON CASE 71137000 T 0000 + THEN BEGIN 71138000 T 0001 + EVENTS [LASTEVENTI[MPXAB]].EVLINK ← LUNIT; 71139000 T 0002 + LASTEVENT [MPXAB] ← T; 71140000 T 0004 + LASTEVENTI[MPXAB] ← LUNIT; 71141000 T 0006 + IF FIRSTEVENT [MPXAB] = 0 71142000 T 0007 + THEN BEGIN 71143000 T 0007 + FIRSTEVENT [MPXAB] ← T; 71144000 T 0008 + FIRSTEVENTI[MPXAB] ← LUNIT; 71145000 T 0010 + END; 71146000 T 0011 + END 71147000 T 0011 + ELSE BEGIN 71148000 T 0011 + I ← K ← FIRSTEVENTI [MPXAB]; 71149000 T 0011 + WHILE EVENTS [I].EVTIME ≤ T 71150000 T 0013 + DO I ← EVENTS [J ← I].EVLINK; 71151000 T 0014 + IF I = K % T IS EARLIER THAN EARLIEST 71152000 T 0017 + THEN BEGIN 71153000 T 0018 + FIRSTEVENTI [MPXAB] ← LUNIT; 71154000 T 0019 + FIRSTEVENT [MPXAB] ← T; 71155000 T 0020 + J ← I; 71156000 T 0021 + END; 71157000 T 0022 + EVENTS [J].EVLINK ← LUNIT 71158000 T 0022 + END; 71159000 T 0023 + EVENTS [LUNIT] ← T & EVERYTHING; 71160000 T 0024 + RESULT.RSLTUNIT ← LUNIT; 71161000 T 0029 + MPX [MPXAB + DELTAMPX, LUNIT] ← RESULT; 71162000 T 0031 + MPX[MPXAB, LUNIT].MPXINT ← MPXAB ← 240; % INTERRUPT LITERAL 71163000 T 0033 + IF T < CURRENTT OR CURRENTT = 0 71164000 T 0037 + THEN BEGIN CURRENTT ← T; CURRENTMPX ← MPXAB END; 71165000 T 0038 + IF T < IDLETIME OR IDLETIME =0 THEN IDLETIME ← T; 71166000 T 0041 + MPXOPS [MPXAB] ← MPXOPS [MPXAB] - 1; 71167000 T 0044 + END SORTING TIME AND RESULT DESCRIPTOR FOR AN IO; 71168000 T 0046 + 111 IS 49 LONG, NEXT SEG 12 + PROCEDURE FLAGHANDLE (MESS, MINDEX, WORDS, IOCW); 71169000 T 0919 +PRT(1014) = FLAGHANDLE + VALUE MINDEX, WORDS, IOCW; 71170000 T 0919 + INTEGER MINDEX, WORDS; 71171000 T 0919 + ARRAY MESS [0]; 71172000 T 0919 + REAL IOCW; 71173000 T 0919 + BEGIN COMMENT MOVE INPUT FROM WORK AREA (MESS) TO M ARRAY START- 71174000 T 0919 + ING AT MINDEX + 1 AND MOVE THE FLAG BIT TO THE EXTENSION 71175000 T 0919 + WORD.; 71176000 T 0919 + INTEGER I, J, K, MI, R, W; 71177000 T 0919 + START OF SEGMENT ********** 112 +STACK(F+2) = I +STACK(F+3) = J +STACK(F+4) = K +STACK(F+5) = MI +STACK(F+6) = R +STACK(F+7) = W + INTEGER JDIV, JMOD, TAG, BCD; 71178000 T 0000 +STACK(F+10) = JDIV +STACK(F+11) = JMOD +STACK(F+12) = TAG +STACK(F+13) = BCD + DEFINE FLAGGER = 71179000 T 0000 + DI ← B; DI ← DI + 15; SKIP 2 DB; 71180000 T 0000 + SI ← LOC TAG; SKIP 45 SB; 71181000 T 0000 + 3 BITS; SI ← A; 71182000 T 0000 + IF SB THEN DS ← 1 SET ELSE DS ← 1 RESET; 71183000 T 0000 + DI ← A; DS ← 1 RESET; SI ← A; DI ← B; 71184000 T 0000 + DS ← WDS; A ← SI; DI ← DI + 8; B ← DI; #; 71185000 T 0000 + STREAM PROCEDURE FLAGIN (S, D, JDIV, JMOD, TAG); 71186000 T 0000 +PRT(1015) = FLAGIN + VALUE JDIV, JMOD, TAG; 71187000 T 0000 + BEGIN 71188000 T 0000 + LOCAL A, B; 71189000 T 0000 + SI ← S; A ← SI; DI ← D; B ← DI; 71190000 T 0000 + JMOD (FLAGGER); 71191000 T 0001 + JDIV (32(FLAGGER)); 71192000 T 0009 + END; 71193000 T 0017 + DEFINE TAGGERIN = 71194000 T 0017 + SKIP BCD SB; 71195000 T 0017 + DI ← B; DI ← DI + 15; SKIP 2 DB; 71196000 T 0017 + 4 BITS; DI ← B; SKIP DB; 47 BITS; %>RETRO 71197000 T 0017 + DI ← DI + 8; B ← DI; #; %>RETRO 71198000 T 0017 + STREAM PROCEDURE TAGIN (M, MESS, JDIV, JMOD, BCD); %>RETRO 71199000 T 0017 +PRT(1016) = TAGIN + VALUE JDIV, JMOD, BCD; %>RETRO 71200000 T 0017 + BEGIN 71201000 T 0017 + LOCAL B; 71202000 T 0018 + SI ← MESS; DI ← M; B ← DI; 71203000 T 0018 + JMOD (TAGGERIN); 71204000 T 0018 + JDIV (32(TAGGERIN)); 71205000 T 0026 + END; 71206000 T 0034 + DEFINE FLAGGEROUT = 71207000 T 0034 + SI ← A; SI ← SI + 15; SKIP 5 SB; 71208000 T 0034 + DI ← A; IF SB THEN DS ← 1 SET ELSE DS ← 1 RESET; 71209000 T 0034 + DI ← B; SI ← A; DS ← WDS; B ← DI; 71210000 T 0034 + DI ← A; DS ← 1 RESET; 71211000 T 0034 + SI ← A; SI ← SI + 16; A ← SI;#; 71212000 T 0034 + STREAM PROCEDURE FLAGOUT (S, D, JDIV, JMOD); 71213000 T 0034 +PRT(1017) = FLAGOUT + VALUE JDIV, JMOD; 71214000 T 0034 + BEGIN 71215000 T 0034 + LOCAL A, B; 71216000 T 0035 + SI ← S; A ← SI; DI ← D; B ← DI; 71217000 T 0035 + JMOD (FLAGGEROUT); 71218000 T 0036 + JDIV (32(FLAGGEROUT)); 71219000 T 0041 + END; 71220000 T 0048 + DEFINE TAGGER = 71221000 T 0048 + SI ← A; SI ← SI + 15; SKIP 2 SB; 71222000 T 0048 + DI ← B; DS ← 3 LIT "0"; DI ← B; SKIP BCD DB;4 BITS; 71223000 T 0048 + SI ← A; SKIP SB; 47 BITS; SI ← SI + 8; 71224000 T 0048 + A ← SI; B ← DI;#; 71225000 T 0048 + STREAM PROCEDURE TAGOUT (M, MESS, JDIV, JMOD, BCD); 71226000 T 0048 +PRT(1020) = TAGOUT + VALUE JDIV, JMOD, BCD; 71227000 T 0048 + BEGIN 71228000 T 0048 + LOCAL A, B; 71229000 T 0049 + SI ← M; A ← SI; DI ← MESS; B ← DI; 71230000 T 0049 + JMOD (TAGGER); 71231000 T 0050 + JDIV (32(TAGGER)); 71232000 T 0059 + END; 71233000 T 0068 + MI ← MINDEX + 1; 71234000 T 0068 + W ← WORDS; 71235000 T 0070 + TAG ← IF I ← IOCW.IOTAGS = 0 THEN SINGL ELSE 71236000 T 0071 + IF I = 1 THEN CODE ELSE IF I = 3 THEN DOUBL ELSE 4; 71237000 T 0074 + BCD ← IF IOCW.IOSBIT = 1 THEN 13 ELSE 9; 71238000 T 0078 + DO BEGIN 71239000 T 0082 + I ← MI MOD ROWLENGTH; 71240000 T 0082 + J ← IF (R ← ROWLENGTH- I) > W THEN W ELSE R; 71241000 T 0083 + JDIV ← J DIV 32; 71242000 T 0087 + JMOD ← J MOD 32; 71243000 T 0088 + IF IOCW.IOWBIT = 1 71244000 T 0089 + THEN BEGIN 71245000 T 0090 + IF TAG < 4 71246000 T 0091 + THEN FLAGIN (MESS[K],M[MI],JDIV,JMOD,TAG) 71247000 T 0091 + ELSE TAGIN (MESS[K],M[MI],JDIV,JMOD,BCD); 71248000 T 0097 + END 71249000 T 0104 + ELSE BEGIN 71250000 T 0104 + IF TAG < 4 71251000 T 0104 + THEN FLAGOUT (M[MI], MESS[K], JDIV, JMOD) 71252000 T 0105 + ELSE TAGOUT (M[MI],MESS[K],JDIV,JMOD, BCD); 71253000 T 0110 + END; 71254000 T 0117 + K ← K + J; 71255000 T 0117 + MI ← MI + J; 71256000 T 0119 + END UNTIL W ← W - J ≤ 0; 71257000 T 0120 + END INPUT FLAG BIT MANIPULATI0NS; 71258000 T 0122 + 112 IS 127 LONG, NEXT SEG 12 + INTEGER PROCEDURE MPXTIME(ELTIME,METIME,LUNIT); 71259000 T 0919 +PRT(1021) = MPXTIME + VALUE ELTIME,METIME,LUNIT; 71260000 T 0919 + INTEGER ELTIME,METIME,LUNIT; 71261000 T 0919 + BEGIN 71262000 T 0919 + IF(EVENTS[LUNIT].EVTIME)REALTIME 71264000 T 0921 + THEN MPXTIME←UNITAVAILTIME[LUNIT]+ELTIME 71265000 T 0922 + ELSE MPXTIME←REALTIME+ELTIME; 71266000 T 0924 + IF (EVENTS[LUNIT].EVTIME)=0 71267000 T 0926 + THEN UNITAVAILTIME[LUNIT]←REALTIME+METIME 71268000 T 0927 + ELSE UNITAVAILTIME[LUNIT]←EVENTS[LUNIT].EVTIME+METIME; 71269000 T 0929 + END EVALUATION OF MPXTIME FOR AN IO; 71270000 T 0933 + PROCEDURE CARDLOAD; 71271000 T 0935 +PRT(1022) = CARDLOAD + BEGIN 71272000 T 0935 + FILE EDOC DISK SERIAL (2,3,30); 71273000 T 0935 + START OF SEGMENT ********** 113 +STACK(F+2) = EDOC + DEFINE CODE = EDOC#; 71273100 T 0003 + FORMAT ERROR ("EQUATED FILE IS NOT ON DISK. ", 32("X"),//); 71274000 T 0003 + START OF SEGMENT ********** 114 +PRT(1023) = ERROR + 114 IS 13 LONG, NEXT SEG 113 + LABEL EOF; 71275000 T 0003 + SEARCH (CODE, TBUF[*]); 71276000 T 0003 + IF TBUF[0] > 0 THEN 71277000 T 0005 + BEGIN 71278000 T 0006 + READ (CODE, *, PBR, S, D[0]); 71279000 T 0007 +PRT(1024) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + DO BEGIN 71280000 T 0018 + READ (CODE, *, MM, A, AX) [EOF]; 71281000 T 0018 +PRT(1025) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* +PRT(1026) = EOF + MOVE (A, M[MM]); 71282000 T 0030 + END 71283000 T 0034 + UNTIL FALSE; 71284000 T 0034 + EOF: 71285000 T 0034 + END 71286000 T 0035 + ELSE 71287000 T 0035 + BEGIN 71288000 T 0035 + WRITE (LP, ERROR); GO EOF END 71289000 T 0035 + END; 71290000 T 0039 + 113 IS 43 LONG, NEXT SEG 12 + PROCEDURE MULTIPLEXOR; 72000000 T 0935 +PRT(1027) = MULTIPLEXOR + BEGIN COMMENT MULTIPLEXOR IS CALLED WHEN THE PROCESSOR HAS INITIATED 72001000 T 0935 + AN I/O. A SWITCH BASED ON HARDWARE UNIT TYPE IS INVOKED 72002000 T 0935 + AND THE SIMULATED I/O IS PERFORMED. TIMING CALCULATIONS 72003000 T 0935 + ARE COMPLETED AND EXCEPTION CONDITIONS ARE NOTED AND THE 72004000 T 0935 + RESULT DESCRIPTOR IS LINKED INTO THE EVENTS AND MPX ARRAYS 72005000 T 0935 + BASED ON MPX AND TIME. THE A & B REGISTERS ARE ASSUMED T0 72006000 T 0935 + BE FULL.; 72007000 T 0935 + REAL MPXINFO, RESULT, WORDS, EVENTIME; 72008000 T 0935 + START OF SEGMENT ********** 115 +STACK(F+2) = MPXINFO +STACK(F+3) = RESULT +STACK(F+4) = WORDS +STACK(F+5) = EVENTIME + INTEGER LDIV,LMOD,DESC,SKIP,SWFI, ELTIME,METIME; 72009000 T 0000 +STACK(F+6) = LDIV +STACK(F+7) = LMOD +STACK(F+10) = DESC +STACK(F+11) = SKIP +STACK(F+12) = SWFI +STACK(F+13) = ELTIME +STACK(F+14) = METIME + BOOLEAN SPACLP; 72010000 T 0000 +STACK(F+15) = SPACLP + REAL FUNCD, FUNCDX, IOAD , IOAREAX, IOCW, IOCWX; 72011000 T 0000 +STACK(F+16) = FUNCD +STACK(F+17) = FUNCDX +STACK(F+20) = IOAD +STACK(F+21) = IOAREAX +STACK(F+22) = IOCW +STACK(F+23) = IOCWX + LABEL AROUND, PUT, CEOF, OC; 72012000 T 0000 + DEFINE EBCDIC = 6(DI ← LOC J; SKIP 43 DB; 5 BITS ; 72013000 T 0000 + DI ← LOC K; SKIP 45 DB; 3 BITS ; 72014000 T 0000 + A ← SI; 72015000 T 0000 + SI ← TABLE; 72016000 T 0000 + J (SI ← SI + 8); SI ← SI + K; 72017000 T 0000 + DI ← B; DS ← CHR; B ← DI; 72018000 T 0000 + SI ← A;)#, 72019000 T 0000 + WORDIV = WORDS.[38:5], WORDS.[43:5]#; 72020000 T 0000 + STREAM PROCEDURE EBCOUT (MESS, TABLE, WMOD, WDIV); 72021000 T 0000 +PRT(1030) = EBCOUT + VALUE WMOD, WDIV; 72022000 T 0000 + BEGIN 72023000 T 0000 + LOCAL A, B, J, K; 72024000 T 0000 + SI ← MESS; A ← SI; 72025000 T 0000 + WMOD (EBCDIC); 72026000 T 0000 + WDIV (32(EBCDIC)); 72027000 T 0010 + END CONVERSION OF EBCDIC INTERNAL TO BCL GRAPHIC; 72028000 T 0021 + DEFINE ERROR201 = 72029000 T 0021 + IF IOAD.LENGTH - 1 > MPXINFO.MPXBUFF 72030000 T 0021 + THEN BEGIN ERROR (201); GO EOJ END;#, 72031000 T 0021 + BADUNIT = 72032000 T 0021 + BEGIN ERROR (200); MEMDUMP; GO EOJ END#; 72033000 T 0021 + STREAM PROCEDURE BLANK (M, LMOD, LDIV); VALUE LMOD, LDIV; 72034000 T 0021 +PRT(1031) = BLANK + BEGIN DI ← M; DS ← 8 LIT " "; SI ← M; DS←LMOD WDS; 72035000 T 0021 + LDIV (DS ← 32 WDS) END; 72036000 T 0024 + REAL STREAM PROCEDURE NFLAG(WORD); 72037000 T 0026 +PRT(1032) = NFLAG + BEGIN SI ← WORD; DI← LOC NFLAG; DS ← 1 WDS; 72038000 T 0026 + DI ← DI - 8; DS ← 1 RESET; 72039000 T 0026 + END; 72040000 T 0027 + DEFINE 72041000 T 0028 + T=PERIPHERALT#, 72042000 T 0028 + TSKIP=5×MPXINFO.MPXHDWE#; 72043000 T 0028 + LABEL EOF,PAR; 72044000 T 0028 + DEFINE READS = IF BOOLEAN(IOCW.IOBBIT) THEN 72045000 T 0028 + BEGIN 72046000 T 0028 + READ REVERSE(TAPES[SWFI], 72047000 T 0028 + MPXINFO.MPXBUFF,MESS[*]) 72048000 T 0028 + [EOF:PAR]; 72049000 T 0028 + IF NFLAG(MESS)=TMK THEN GO EOF; 72050000 T 0028 + MPX[0,FUNCD.LUNIT] ← 72051000 T 0028 + MPX[0,FUNCD.LUNIT] - 1; 72052000 T 0028 + END ELSE 72053000 T 0028 + BEGIN 72054000 T 0028 + READ(TAPES[SWFI],MPXINFO. 72055000 T 0028 + MPXBUFF,MESS[*])[EOF:PAR]; 72056000 T 0028 + IF NFLAG(MESS)=TMK THEN GO EOF; 72057000 T 0028 + BUMPIT; 72058000 T 0028 + END#, 72059000 T 0028 + TRANSLATE = IF BOOLEAN(IOCW.IOXBIT) THEN 72060000 T 0028 + BEGIN 72061000 T 0028 + FLAGHANDLE(MESS,IOAD.ADDR, 72062000 T 0028 + WORDS,IOCW); 72063000 T 0028 + IF BOOLEAN(IOCW.IOSBIT)THEN 72064000 T 0028 + BEGIN 72065000 T 0028 + EBCOUT(MESS, 72066000 T 0028 + EBCTOBCL,WORDIV); 72067000 T 0028 + WORDS ← ENTIER 72068000 T 0028 + (WORDS/.75); 72069000 T 0028 + END; 72070000 T 0028 + END #, 72071000 T 0028 + TIMEIT = ELTIME ← ELTIME + T[TSKIP]; 72072000 T 0028 + METIME ← METIME + T[TSKIP + 1] #, 72073000 T 0028 + BUMPIT = MPX[0,FUNCD.LUNIT] ← 72074000 T 0028 + MPX[0,FUNCD.LUNIT] + 1 #, 72075000 T 0028 + TMK = "≥≥≥≥≥≥≥"&"≥"[1:43:5] # , 72076000 T 0028 + TM = [13:1] #; 72077000 T 0028 + ALPHA STREAM PROCEDURE EXAMIN (NCR); VALUE NCR; 72078000 T 0028 +PRT(1033) = EXAMIN + BEGIN SI←NCR; DI←LOC EXAMIN; DI←DI+7; DS←CHR; END EXAMIN; 72079000 T 0028 + INTEGER STREAM PROCEDURE OUTPCVT(ADDR); VALUE ADDR; 72080000 T 0031 +PRT(1034) = OUTPCVT + BEGIN 72081000 T 0031 + SI ← LOC ADDR; DI ← LOC OUTPCVT; DS ← 8 OCT; 72082000 T 0031 + END; 72083000 T 0031 + REAL SAVIOAD, RECNT; 72084000 T 0032 +STACK(F+24) = SAVIOAD +STACK(F+25) = RECNT + LABEL PRINTERS; 72084100 T 0032 + MOVE (SCANBUSA, FUNCD); 72085000 T 0032 + MOVE (DATABUSA, IOAD); 72086000 T 0034 + MOVE (M[IOAD .ADDR ], IOCW); 72087000 T 0035 + MEMCYCLE; 72087100 T 0039 + RESULT.RSLTATT ← IOCW.IOABIT; 72088000 T 0040 + MPXINFO ← MPX [FUNCD.MPXFC, FUNCD.LUNIT]; 72089000 T 0043 + MULTIPLEX ← FALSE; 72090000 T 0045 + IF BOOLEAN (IOCW.IOTBIT) % TEST 72091000 T 0046 + THEN BEGIN 72092000 T 0047 + A ← MPX [FUNCD.MPXFC + DELTAMPX, FUNCD.LUNIT]; 72093000 T 0047 + A.RSLTBSY ← EVENTS [FUNCD.LUNIT].EVBUSY; 72094000 T 0051 + AX ← 0; 72095000 T 0054 + AROF ← TRUE; 72096000 T 0054 + GO OC; 72097000 T 0055 + END; 72098000 T 0056 + CASE MPXINFO.MPXHDWE OF 72099000 T 0056 + BEGIN % INTERNAL NAME CASE 72100000 T 0056 +PRT(1035) = *CASE STATEMENT DESCRIPTOR* + BADUNIT;% NONE 0 72101000 T 0057 + BEGIN% DISK 1 72102000 T 0061 + IF(JUNK←OUTPCVT(IOCW.[20:28])) < 9999 AND JUNK ≥ 0 THEN 72103000 T 0061 + BEGIN 72104000 T 0065 + SAVIOAD ← IOAD; 72105000 T 0066 + IOAD.LENGTH ← 60; 72106000 T 0066 + RECNT ← 0 ; 72107000 T 0068 + ERROR201; 72108000 T 0069 + IF BOOLEAN (IOCW.IOWBIT) 72109000 T 0075 + THEN DO BEGIN 72110000 T 0075 + READ (DISKA[JUNK], 60, MESS[*]); 72111000 T 0076 + WORDS ← PROTECT (IOAD, IOCW, RESULT); 72112000 T 0081 + FLAGHANDLE (MESS, IOAD.ADDR, WORDS, 72113000 T 0083 + IOCW); 72114000 T 0085 + RECNT ← RECNT + 1; 72115000 T 0086 + JUNK ← JUNK + WORDS; 72116000 T 0087 + TIMEIT; 72117000 T 0089 + END UNTIL SAVIOAD.LENGTH ≤ RECNT 72118000 T 0094 + OR RESULT.[31:17] ≠ 0 72119000 T 0095 + ELSE DO BEGIN 72120000 T 0096 + FLAGHANDLE (MESS, IOAD.ADDR, 60, 72121000 T 0100 + IOCW); 72122000 T 0102 + WRITE (DISKA[JUNK], 60, MESS[*]); 72123000 T 0102 + RECNT ← RECNT + 1; 72124000 T 0107 + JUNK ← JUNK + WORDS; 72125000 T 0109 + TIMEIT; 72126000 T 0110 + END UNTIL SAVIOAD.LENGTH ≤ RECNT 72127000 T 0115 + OR RESULT.[31:17] ≠ 0 72128000 T 0116 + END ELSE 72129000 T 0117 + BEGIN 72130000 T 0119 + RESULT.RSLTNRY ← 1; 72131000 T 0119 + TIMEIT; 72132000 T 0121 + END; 72133000 T 0126 + EVENTIME ← MPXTIME (ELTIME, METIME, FUNCD.LUNIT); 72134000 T 0126 + END; 72135000 T 0129 + BEGIN% SPO 2 72136000 T 0129 + IF TUBA.[9:9]= 0 THEN RESULT.RSLTNRY ← 1 ELSE 72137000 T 0129 + BEGIN 72138000 T 0133 + ERROR201; 72139000 T 0133 + WORDS ← PROTECT(IOAD,IOCW,RESULT); 72140000 T 0139 + IF BOOLEAN(IOCW.IOWBIT) THEN 72141000 T 0141 + BEGIN % READ 72142000 T 0142 + IF SPOED THEN 72143000 T 0142 + BEGIN 72144000 T 0143 + FLAGHANDLE(CUP,IOAD. 72145000 T 0143 + ADDR,WORDS,IOCW); 72146000 T 0144 + SPOED ← FALSE; 72147000 T 0146 + END ELSE 72148000 T 0147 + BEGIN 72149000 T 0147 + READ(SPO(TUBA) 72150000 T 0147 + ,10,MESS[*]); 72151000 T 0148 + FLAGHANDLE(MESS,IOAD. 72152000 T 0153 + ADDR,WORDS,IOCW); 72153000 T 0154 + END 72154000 T 0156 + END ELSE 72155000 T 0156 + BEGIN % WRITE 72156000 T 0156 + FLAGHANDLE(MESS,IOAD.ADDR, 72157000 T 0156 + WORDS,IOCW); 72158000 T 0158 + EBCOUT(MESS,EBCTOBCL,WORDIV); 72159000 T 0159 + WORDS ← ENTIER(WORDS / .75); 72160000 T 0163 + WRITE(SPO(TUBA), 72161000 T 0165 + 10,MESS[*]); 72162000 T 0168 + END; 72163000 T 0171 + ELTIME ← T[TSKIP]; 72164000 T 0171 + METIME ← T[TSKIP + 1]; 72165000 T 0173 + END; 72166000 T 0175 + END; 72167000 T 0175 + BEGIN% BIDS 3 72168000 T 0176 + END; 72169000 T 0176 + BADUNIT;% 4 72170000 T 0176 + BADUNIT;% 5 72171000 T 0180 + BEGIN% LP OR PRINT 6 72172000 T 0184 + PRINTERS: 72172100 T 0184 + ERROR201; 72173000 T 0185 + WORDS ← PROTECT (IOAD , IOCW, RESULT); 72174000 T 0190 + IF BOOLEAN (IOCW.IOXBIT) % TRANSLATE 72175000 T 0192 + THEN BEGIN 72176000 T 0193 + FLAGHANDLE (MESS, IOAD.ADDR, WORDS, 72177000 T 0194 + IOCW); 72178000 T 0196 + IF BOOLEAN (IOCW.IOSBIT) % 8 BIT 72179000 T 0196 + THEN BEGIN 72180000 T 0197 + EBCOUT (MESS, EBCTOBCL, WORDIV); 72181000 T 0198 + WORDS ← ENTIER (WORDS/.75); 72182000 T 0202 + END; 72183000 T 0204 + END 72184000 T 0204 + ELSE IF NOT BOOLEAN (IOCW.IOIBIT) %MEMORY INHIBIT 72185000 T 0204 + THEN BEGIN 72186000 T 0207 + RESULT.RSLTDSC ← DESC ← 1; 72187000 T 0208 + ELTIME←200; METIME←0; GO AROUND; 72188000 T 0210 + END 72189000 T 0212 + ELSE BEGIN 72190000 T 0212 + LDIV ← (LMOD ← WORDS ) DIV 32; 72191000 T 0213 + LMOD ← LMOD MOD 32 - 1; 72192000 T 0215 + BLANK (MESS, LMOD, LDIV); 72193000 T 0216 + END; 72194000 T 0218 + SWFI ← MPXINFO.MPXSWFI; 72195000 T 0218 + IF SKIP ← IOCW.IOSKIP = 0 72196000 T 0219 + THEN BEGIN 72197000 T 0221 + WRITE (LINES[SWFI][NO], WORDS 72198000 T 0222 + , MESS [*]); 72199000 T 0224 + SKIP ← IOCW.IOSPAC; SPACLP ← TRUE; 72200000 T 0226 + METIME←METIME+(T[TSKIP+2]+T[TSKIP+3]× 72201000 T 0228 + (SKIP-1)); 72202000 T 0232 + WHILE SKIP > 0 72203000 T 0234 + DO BEGIN 72204000 T 0235 + WRITE (LINES [SWFI]); 72205000 T 0236 + SKIP ← SKIP - 1; 72206000 T 0240 + END; 72207000 T 0241 + END 72208000 T 0242 + ELSE BEGIN 72209000 T 0242 + WRITE (LINES[SWFI][SKIP], WORDS, 72210000 T 0242 + MESS [*]); 72211000 T 0245 + METIME←METIME+T[TSKIP+4]; 72212000 T 0247 + END; 72213000 T 0250 + ELTIME←T[TSKIP]; 72214000 T 0250 + METIME←METIME+T[TSKIP+1]; 72215000 T 0252 + AROUND: EVENTIME←MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72216000 T 0255 + END; 72217000 T 0258 + BEGIN% LP 7 72218000 T 0259 + GO PRINTERS; 72218100 T 0259 + END; 72219000 T 0259 + BADUNIT;% 8 72220000 T 0260 + BEGIN% CR 9 72221000 T 0264 + ERROR201; 72222000 T 0264 + IF IOCW.IOWBIT = 1 AND (IOCW.IOXBIT = 1 OR 72223000 T 0269 + IOCW.IOSBIT = 1) 72224000 T 0272 + THEN BEGIN 72225000 T 0273 + READ (CARD, MPXINFO.MPXBUFF,MESS[*])[CEOF]; 72226000 T 0274 +PRT(1036) = CEOF + RESULT.RSLTVY ← REAL (EXAMIN(NCR)= "←"); 72227000 T 0279 + RESULT.RSLTCC ← RESULT.RSLTVY; 72228000 T 0283 + WORDS ← PROTECT (IOAD , IOCW, RESULT); 72229000 T 0286 + FLAGHANDLE (MESS, IOAD.ADDR, WORDS, IOCW); 72230000 T 0288 + ELTIME←T[TSKIP]; 72231000 T 0290 + METIME←T[TSKIP+1]; 72232000 T 0292 + GO PUT; 72233000 T 0295 + END 72234000 T 0295 + ELSE BEGIN 72235000 T 0295 + RESULT.RSLTDSC ← 1; 72236000 T 0296 + ELTIME←200; METIME←0; 72237000 T 0298 + GO PUT; 72238000 T 0299 + END; 72239000 T 0300 + CEOF:RESULT.RSLTNRY ← 1; 72240000 T 0300 + ELTIME←200; METIME←0; 72241000 T 0301 + PUT: EVENTIME←MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72242000 T 0303 + END; 72243000 T 0306 + BEGIN% CP 10 72244000 T 0307 + END; 72245000 T 0307 + BADUNIT;% 11 72246000 T 0307 + BADUNIT;% 12 72247000 T 0311 + BEGIN% MT 13 72248000 T 0315 + ELTIME ← METIME ← 0; 72249000 T 0315 + SWFI ← MPXINFO.MPXSWFI; 72250000 T 0316 + CASE 0&IOCW[46:3:2] OF 72251000 T 0318 + BEGIN 72252000 T 0319 +PRT(1037) = *CASE STATEMENT DESCRIPTOR* + % % % % WRITES % % % % 72253000 T 0320 + IF BOOLEAN(IOCW.TM) THEN 72254000 T 0320 + BEGIN 72255000 T 0320 + WRITE(TAPES[SWFI],*,TMK); 72256000 T 0321 +PRT(1040) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + TIMEIT; 72257000 T 0333 + BUMPIT; 72258000 T 0339 + END ELSE 72259000 T 0343 + BEGIN 72260000 T 0343 + ERROR201; 72261000 T 0344 + WORDS ← PROTECT(IOAD,IOCW,RESULT) 72262000 T 0349 + ;TRANSLATE; 72263000 T 0350 + WRITE(TAPES[SWFI],WORDS,MESS[*]); 72264000 T 0363 + TIMEIT; 72265000 T 0366 + BUMPIT; 72266000 T 0373 + END; 72267000 T 0378 + % % REWIND OR ERASE % % 72268000 T 0378 + IF BOOLEAN(IOCW.IOBBIT) THEN 72269000 T 0378 + BEGIN 72270000 T 0379 + INTG ← MPX[0,FUNCD.LUNIT]; 72271000 T 0379 + ELTIME ← T[TSKIP]; 72272000 T 0382 + FOR JUNK←1 STEP 1 UNTIL INTG DO 72273000 T 0384 + BEGIN 72274000 T 0387 + READ REVERSE(TAPES 72275000 T 0387 + [SWFI],1,MESS[*]) 72276000 T 0387 + [EOF:PAR]; 72277000 T 0390 +PRT(1041) = EOF +PRT(1042) = PAR + IF NFLAG(MESS)=TMK THEN GO EOF; 72278000 T 0393 + GO TO EOF; 72279000 T 0397 + MPX[0,FUNCD.LUNIT] ← 72280000 T 0399 + MPX[0,FUNCD.LUNIT] -1; 72281000 T 0400 + METIME ← METIME + 72282000 T 0403 + T[TSKIP + 1]; 72283000 T 0403 + END; 72284000 T 0406 + RESULT.RSLTRW ← 1; 72285000 T 0408 + END ELSE 72286000 T 0410 + BEGIN TIMEIT END; 72287000 T 0410 + % % % % READS % % % % 72288000 T 0417 + BEGIN 72289000 T 0417 + ERROR201; 72290000 T 0417 + READS; 72291000 T 0422 + IF FALSE THEN 72292000 T 0456 + PAR: 72293000 T 0456 + BEGIN 72294000 T 0457 + RESULT.RSLTMA ← 1; 72295000 T 0457 + RESULT.RSLTCC ← 1; 72296000 T 0458 + RESULT.RSLTOF ← 1; 72297000 T 0460 + END; 72298000 T 0462 + WORDS ← PROTECT(IOAD,IOCW,RESULT); 72299000 T 0462 + FLAGHANDLE(MESS,IOAD.ADDR,WORDS,IOCW); 72300000 T 0464 + TIMEIT; 72301000 T 0466 + END; 72302000 T 0472 + % % % % SPACE % % % % 72303000 T 0473 + BEGIN 72304000 T 0473 + IF (INTG←IOCW.RECS) =0 THEN INTG←100; 72305000 T 0473 + FOR JUNK←1 STEP 1 UNTIL INTG DO 72306000 T 0476 + BEGIN 72307000 T 0478 + READS; 72308000 T 0478 + TIMEIT; 72309000 T 0512 + END; 72310000 T 0517 + END; 72311000 T 0520 + END; 72312000 T 0520 + START OF SEGMENT ********** 116 + 116 IS 4 LONG, NEXT SEG 115 + IF FALSE THEN 72313000 T 0520 + EOF: BEGIN 72314000 T 0520 + RESULT.RSLTVY ← 1; 72315000 T 0522 + RESULT.RSLTNRY← 1; 72316000 T 0523 + TIMEIT; 72317000 T 0525 + END; 72318000 T 0531 + EVENTIME ← MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72319000 T 0531 + END; 72320000 T 0533 + END; 72321000 T 0534 + START OF SEGMENT ********** 117 + 117 IS 14 LONG, NEXT SEG 115 + PUTRESULT (FUNCD.LUNIT, FUNCD.MPXFC, EVENTIME , RESULT); 72322000 T 0534 + OC: 72323000 T 0536 + END MULTIPLEXOR; 72324000 T 0537 + 115 IS 547 LONG, NEXT SEG 12 + PROCEDURE NEXTEVENT; 72325000 T 0935 +PRT(1043) = NEXTEVENT + BEGIN COMMENT NEXTEVENT WORRIES ABOUT INTERRUPT PRIORITIES AND SETS 72326000 T 0935 + APPROPRIATE INTERRUPTS. PRIORITY (HIGH TO LOW) IS 72327000 T 0935 + ALARM, SYLLABLE-DEPENDENT, CONTROL AND EXTERNAL. 72328000 T 0935 + SOME FUNCTIONS OF INTERRUPT CONTROL ARE HANDLED. 72329000 T 0935 + ; 72330000 T 0935 + IF ABORTTIME ≤ REALTIME 72331000 T 0935 + THEN BEGIN 72332000 T 0936 + END 72333000 T 0937 + ELSE IF IDLETIME ≤ REALTIME AND SDIS + GCIF = 0 72334000 T 0937 + 72335000 T 0940 + THEN BEGIN 72336000 T 0940 + IF INTTIMER ≤ REALTIME 72337000 T 0941 + THEN BEGIN 72338000 T 0941 + SETINTERRUPT (INTTIMI); 72338500 T 0942 + INTTIMER ← 2*36; 72339000 T 0943 + IDLETIME ← CURRENTT; 72339050 T 0947 + END 72339500 T 0948 + ELSE IF NOT IIHF 72340000 T 0948 + AND CURRENTT ≤ REALTIME 72340100 T 0950 + AND CURRENTT ≠ 0 72340200 T 0950 + THEN BEGIN 72341000 T 0951 + SETINTERRUPT (EXTINTI + CURRENTMPX); 72342000 T 0953 + CURRENTT ← 0; 72342500 T 0954 + IDLETIME ← INTTIMER; 72342600 T 0955 + END; 72343000 T 0955 + END; 72344000 T 0955 + END OF NEXT EVENT; 72345000 T 0955 + PROCEDURE SIMULATOR; 73000000 T 0957 +PRT(1044) = SIMULATOR + BEGIN COMMENT THIS IS THE PRINCIPAL DRIVER FOR THE SIMULATOR. ; 73001000 T 0957 + LABEL NDIN; 73002000 T 0957 + START OF SEGMENT ********** 118 + CASE DISKLOAD OF 73003000 T 0000 + BEGIN 73004000 T 0000 +PRT(1045) = *CASE STATEMENT DESCRIPTOR* + INITIALIZE; % ESPOL 73005000 T 0001 + CARDLOAD; % ALGOL 73006000 T 0002 + COBOLSIM; % COBOL 73007000 T 0003 + END; 73008000 T 0004 + START OF SEGMENT ********** 119 + 119 IS 3 LONG, NEXT SEG 118 + 73009000 T 0004 + 73010000 T 0004 + TBUF[16]:=MKABS(TBUF); 73010100 T 0004 + ABORTTIME ← INTTIMER ← 2*36; 73010200 T 0007 + IF DISKLOAD = 0 THEN INTTIMER ← 2*36 73010300 T 0011 + ELSE IDLETIME ← 2*36; 73010400 T 0013 + NCR ← MKABS (MESS); 73010500 T 0020 + D31 ← MONITORVALUE & MONITORMASK[28:38:10]; 73010600 T 0022 + DO BEGIN 73011000 T 0025 + IF INT ≠ 0 73012000 T 0025 + THEN INTERRUPTCONTROLLER 73013000 T 0025 + ELSE BEGIN 73014000 T 0026 + CONTROLSECTION; 73015000 T 0027 + TRACE; 73016000 T 0027 + END; 73017000 T 0028 + IF MONITORVALUE≠ MONITORMASKOLD 73017100 T 0028 + THEN D31 ← MONITORMASKOLD ← MONITORVALUE; 73017200 T 0028 + IF MULTIPLEX THEN MULTIPLEXOR; 73018000 T 0031 + NEXTEVENT; 73019000 T 0032 + IF TUBA.[9:9]=0 THEN ELSE 73020000 T 0033 + IF SPOED THEN ELSE 73021000 T 0035 + BEGIN 73022000 T 0036 + READ(SPO(TUBA,1),10,CUP[*])[NDIN]; 73023000 T 0037 +PRT(1046) = NDIN + SPOED ← TRUE; 73024000 T 0044 + NDIN: 73025000 T 0044 + END; 73026000 T 0045 + END UNTIL FALSE; 73027000 T 0045 + END SIMULATOR CONTROL; 73028000 T 0045 + 118 IS 50 LONG, NEXT SEG 12 + PROCEDURE TRACE; 74000000 T 0957 + BEGIN 74001000 T 0957 + LABEL EXIT; 74002000 T 0957 + START OF SEGMENT ********** 120 + STREAM PROCEDURE PBIS(SYLL,PBR,PIR,PSR,TANK); 74003000 T 0000 +PRT(1047) = PBIS + VALUE SYLL,PBR,PIR,PSR,TANK; 74004000 T 0000 + BEGIN 74005000 T 0000 + DI:=TANK; SI:=LOC SYLL;SI:=SI+4; DS:=4 CHR; DS:=4 LIT" "; 74006000 T 0000 + DS:=12 LIT ""PBR:PIR:PSR"; DS:=3 LIT ""= "; 74007000 T 0001 + 2(SI:=SI+4; 8(DS:=3 RESET; 3 BITS); DS:= LIT ":"); 74008000 T 0004 + SI:=SI+7; DS:=CHR; 2(DS:=39 LIT " "); 74009000 T 0008 + END OF PBIS; 74010000 T 0014 + REAL STREAM PROCEDURE OCTIZE(TAG1,WD1,TAG2,WD2,DBLE,TANK); 74011000 T 0014 +PRT(1050) = OCTIZE + VALUE TAG1,WD1,TAG2,WD2,DBLE,TANK; 74012000 T 0014 + BEGIN 74013000 T 0014 + DI:=TANK; SI:=LOC TAG1; 74014000 T 0015 + DBLE(SKIP 44 SB; DS:=3 RESET; 3 BITS; DS:=LIT " "; 74015000 T 0015 + DS:=3 RESET; 1 BITS; SKIP SB; 2 BITS; 74016000 T 0019 + 7(DS:=3 RESET; 3 BITS); DS:=LIT " "; 74017000 T 0024 + 8(DS:=3 RESET; 3 BITS); DS:=2 LIT " "); 74018000 T 0027 + OCTIZE:= DI; 74019000 T 0030 + END OF OCTIZE; 74020000 T 0031 + STREAM PROCEDURE BLANK(TANK); 74021000 T 0032 +PRT(1051) = BLANK + VALUE TANK; 74022000 T 0032 + BEGIN LOCAL T; 74023000 T 0032 + DI:=TANK; T:=DI; DS:=8 LIT " "; SI:=T; DS:=14 WDS; 74024000 T 0032 + END OF BLANK; 74025000 T 0034 + PROCEDURE TOS; 74026000 T 0034 +PRT(1052) = TOS + BEGIN 74027000 T 0034 + FORMAT TOSREG(X8,"AREG",X17,"XREG",X17,"BREG",X17,"YRE6"); 74028000 T 0034 + START OF SEGMENT ********** 121 + START OF SEGMENT ********** 122 +PRT(1053) = TOSREG + 122 IS 11 LONG, NEXT SEG 121 + BLANK(TANK); 74029000 T 0000 + WRITE(LP,TOSREG); 74030000 T 0001 + IF AROF THEN 74031000 T 0004 + TANK:=OCTIZE(AX,A,XX,X,2,TANK); 74032000 T 0004 + IF BROF THEN 74033000 T 0008 + TANK:=OCTIZE(BX,B,YX,Y,2,TANK+65541×(REAL(NOT AROF)).[47:1]); 74034000 T 0008 + PRINT; 74035000 T 0014 + END OF TOS; 74036000 T 0018 + 121 IS 20 LONG, NEXT SEG 120 + PROCEDURE REGISTER(TAGE,WORDE,FMTE); 74037000 T 0034 +PRT(1054) = REGISTER + VALUE TAGE,WORDE,FMTE; 74038000 T 0034 + REAL TAGE,WORDE,FMTE; 74039000 T 0034 + BEGIN 74040000 T 0034 + SWITCH FORMAT REGS:= 74041000 T 0034 + START OF SEGMENT ********** 123 + START OF SEGMENT ********** 124 +PRT(1055) = REGS + ("C = "), 74042000 T 0000 + ("P = "); 74043000 T 0000 + 124 IS 12 LONG, NEXT SEG 123 + REAL STREAM PROCEDURE SYLLABLIZE(PX,P,TANK); VALUE PX,P,TANK; 74044000 T 0000 +PRT(1056) = SYLLABLIZE + BEGIN 74045000 T 0000 + DI← TANK; SI← LOC PX; 74046000 T 0000 + SKIP 44 SB; DS← 3 RESET; 3 BITS; DS← LIT " "; 74047000 T 0000 + DS← 4 RESET; 1 BITS; SKIP SB; 1 BITS; 74048000 T 0003 + 2(DS← 3 RESET; 3 BITS); DS← LIT " "; 74049000 T 0008 + 5(DS←4 RESET; 2 BITS; 2(DS←3RESET; 3 BITS);DS←LIT" "); 74050000 T 0011 + END; 74051000 T 0017 + TANK:=TBUF[16]; 74052000 T 0018 + WRITE(LP[NO],REGS[FMTE]); 74053000 T 0020 + BLANK(TANK); 74054000 T 0024 + IF FMTE=0 THEN TANK←OCTIZE(TAGE,WORDE,0,0,1,TANK+1) ELSE 74055000 T 0025 + IF FMTE=1 AND PROF THEN TANK←SYLLABLIZE(TAGE,WORDE,TANK+1); 74056000 T 0030 + PRINT; 74057000 T 0036 + END OF REGISTER; 74058000 T 0040 + 123 IS 41 LONG, NEXT SEG 120 + STREAM PROCEDURE OCTAL(TANK,DPLAY,WRDS); 74059000 T 0034 +PRT(1057) = OCTAL + VALUE TANK,WRDS; 74060000 T 0034 + BEGIN 74061000 T 0034 + DI←TANK; SI←DPLAY; 74062000 T 0035 + WRDS(SI:=SI+5; 6(DS:= 3 RESET; 3 BITS); DS:=2 LIT " "; ); 74063000 T 0035 + END OF OCTAL; 74064000 T 0040 + PROCEDURE DISPLAY; 74065000 T 0040 +PRT(1060) = DISPLAY + BEGIN 74066000 T 0040 + FORMAT DREGS("DISPLAY REGISTERS 0 THROUGH ",I2," LL= ",I2); 74067000 T 0040 + START OF SEGMENT ********** 125 + START OF SEGMENT ********** 126 +PRT(1061) = DREGS + 126 IS 11 LONG, NEXT SEG 125 + DEFINE N=NDISPLAY#; 74068000 T 0000 + INTEGER I,LINES,NMOD15; 74069000 T 0000 +STACK(F+2) = I +STACK(F+3) = LINES +STACK(F+4) = NMOD15 + INTEGER DPLAID; 74070000 T 0000 +STACK(F+5) = DPLAID + TANK:=TBUF[16]; 74071000 T 0000 + IF N=0 THEN N:=DPLAID:=31; 74072000 T 0001 + WRITE(LP,DREGS,N-1,LL); 74073000 T 0003 +PRT(1062) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + LINES:= N DIV 15; 74074000 T 0014 + FOR I:=1 STEP 1 UNTIL LINES DO 74075000 T 0015 + BEGIN 74076000 T 0017 + BLANK(TANK); 74077000 T 0017 + OCTAL(TANK,D[(I-1)×15],15); 74078000 T 0018 + PRINT; 74079000 T 0021 + END; 74080000 T 0025 + IF (NMOD15:=N MOD 15)≠0 THEN 74081000 T 0027 + BEGIN 74082000 T 0029 + BLANK(TANK); 74083000 T 0029 + OCTAL(TANK,D[LINES×15], NMOD15 ); 74084000 T 0031 + PRINT; 74085000 T 0033 + END; 74086000 T 0037 + IF DPLAID≠0 THEN N:=0; 74087000 T 0037 + END OF DISPLAY; 74088000 T 0039 + 125 IS 42 LONG, NEXT SEG 120 + OWN BOOLEAN ASTERICKS; 74089000 T 0040 +PRT(1063) = ASTERICKS + PROCEDURE STACK; 74090000 T 0040 +PRT(1064) = STACK + BEGIN 74091000 T 0040 + BOOLEAN STREAM PROCEDURE NOTZERO(ADDR); VALUE ADDR; 74092000 T 0040 + START OF SEGMENT ********** 127 +PRT(1065) = NOTZERO + BEGIN LOCAL L1,L2,L3; 74093000 T 0000 + DI:=LOC L3; DS:=21 LIT"0 OOOOOOOO 00000000 "; SI:=ADDR; 74094000 T 0000 + 4(DI:=LOC L3;SI:=SI+1; DI:=DI+1; 74095000 T 0003 + IF 20 SC≠DC THEN BEGIN TALLY:=1; JUMP OUT END); 74095100 T 0004 + NOTZERO:=TALLY; 74096000 T 0007 + END OF NOTZERO; 74097000 T 0007 + STREAM PROCEDURE STARS(ADDR); VALUE ADDR; 74098000 T 0008 +PRT(1066) = STARS + BEGIN LOCAL T; 74099000 T 0008 + DI:=ADDR; DS:=21 LIT "* ******** ******** "; 74100000 T 0009 + SI:=ADDR; 3(DS:=21 CHR); 74101000 T 0012 + END OF STARS; 74102000 T 0013 + FORMAT STACKS("STACK CONTENTS WORD F TO F+",I6,X4,"S= ",O, 74103000 T 0013 + START OF SEGMENT ********** 128 +PRT(1067) = STACKS + " F= ",O," BOSR= ",O," LOSR= ",O); 74104000 T 0013 + 128 IS 20 LONG, NEXT SEG 127 + DEFINE N=NSTACK#; 74105000 T 0013 + REAL T,T1; INTEGER I,LINES,J; 74106000 T 0013 +STACK(F+2) = T +STACK(F+3) = T1 +STACK(F+4) = I +STACK(F+5) = LINES +STACK(F+6) = J + INTEGER ISTACK; 74107000 T 0013 +STACK(F+7) = ISTACK + STREAM PROCEDURE OCTL(A,B,C,D,E); VALUE A,B,C,D,E; 74108000 T 0013 +PRT(1070) = OCTL + BEGIN DI←A; SI←LOC B; 4(SI←SI+4; 8(DS←3RESET; 3 BITS))END; 74109000 T 0013 + TANK:=TBUF[16]; 74110000 T 0018 + IF N=0 THEN N:=ISTACK:= S-F+1; 74111000 T 0020 + OCTL(TANK,S,F,BOSR,LOSR); 74112000 T 0023 + WRITE(LP,STACKS,N-1,TBUF[0],TBUF[1],TBUF[2],TBUF[3]); 74113000 T 0025 +PRT(1071) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + LINES:=N DIV 4; 74114000 T 0041 + FOR I:=1 STEP 1 UNTIL LINES DO 74115000 T 0042 + BEGIN 74116000 T 0044 + TANK:= TBUF[16]; 74117000 T 0044 + BLANK(TANK); 74118000 T 0045 + FOR J:=0 STEP 1 UNTIL 3 DO 74119000 T 0046 + BEGIN 74120000 T 0047 + MOVE(M[(F+J)+(I-1)×4],T); 74121000 T 0047 + TANK:=OCTIZE(T1,T,0,0,1,TANK); 74122000 T 0053 + END; 74123000 T 0056 + IF NOTZERO(TBUF[16]) THEN 74124000 T 0058 + BEGIN ASTERICKS:=FALSE; PRINT END ELSE 74125000 T 0061 + IF NOT ASTERICKS THEN 74126000 T 0066 + BEGIN STARS(TBUF[16]); PRINT; 74127000 T 0068 + ASTERICKS:=TRUE; WRITE(LP); 74128000 T 0074 + END; 74129000 T 0079 + END; 74130000 T 0079 + IF (I:=N MOD 4)≠0 THEN 74131000 T 0081 + BEGIN 74132000 T 0083 + TANK:= TBUF[16]; 74133000 T 0083 + BLANK(TANK); 74134000 T 0084 + FOR J:=1 STEP 1 UNTIL I DO 74135000 T 0086 + BEGIN 74136000 T 0087 + MOVE(M[(F+(J-1))+ LINES×4],T); 74137000 T 0087 + TANK:=OCTIZE(T1,T,0,0,1,TANK); 74138000 T 0093 + END; 74139000 T 0096 + PRINT; 74140000 T 0098 + END; 74141000 T 0102 + IF ISTACK≠0 THEN N:=0; 74142000 T 0102 + END OF STACK; 74143000 T 0104 + 127 IS 108 LONG, NEXT SEG 120 + LABEL NONE; 74144000 T 0040 + FORMAT TOGS ( X43,"VARF = ",I1," , LEEF = ",I1," , TEEF = ",I1, 74145000 T 0040 + START OF SEGMENT ********** 129 +PRT(1072) = TOGS + " , SEEE = ",I1," , NCSE = ",I1," UPDF S ",I1 74146000 T 0040 + ); 74147000 T 0040 + 129 IS 22 LONG, NEXT SEG 120 + INTEGER REALTI; 74148000 T 0040 +STACK(F+2) = REALTI + MONITOR LP (REALTI); 74149000 T 0040 + NONE: 74150000 T 0040 + ASTERICKS:=FALSE; 74151000 T 0041 + TANK:=TBUF[16]; 74152000 T 0042 + IF TRACEWORD = 0 OR ( TRACEWORD > 100 AND TRACTER=0) THEN 74153000 T 0043 + GO TO EXIT; 74154000 T 0045 + HEADING; 74155000 T 0046 + IF TS1=0 THEN JUNK:=MNEMONIC[0,T] 74156000 T 0051 + ELSE IF VARF THEN JUNK:=MNEMONIC[1,T] 74157000 T 0053 + ELSE JUNK← MNEMONIC[2,T]; 74158000 T 0056 + WRITE(LP[NO],TOGS,REAL(VARF),REAL(LEEF),REAL(TEEF),REAL(SEEF), 74159000 T 0059 +PRT(1073) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + REAL(NCSF),REAL(UPDF)); 74160000 T 0071 + PBIS(JUNK,PBR,PIR,PSR,TANK); 74161000 T 0078 + PRINT; 74162000 T 0080 + REALTI ← REALTIME; 74163000 T 0084 +PRT(1074) = DUMP + TANK:= TBUF[16]; 74164000 T 0091 + IF (JUNK←TRACEWORD) ≥ 100 THEN 74165000 T 0092 + JUNK ← TRACTER; 74166000 T 0093 + CASE JUNK OF 74167000 T 0094 + BEGIN 74168000 T 0095 +PRT(1075) = *CASE STATEMENT DESCRIPTOR* + ; 74169000 T 0095 + TOS; % TRACE OF A,X,B,Y REGISTERS 74170000 T 0095 + REGISTER(CX,C,0); % TRACE OF C REGISTER 74171000 T 0097 + REGISTER(PX,P,1); % TRACE OF P REGISTER 74172000 T 0099 + DISPLAY; % TRACE 0F N DISPLAY REGISTERS 74173000 T 0101 + STACK; % TRACE 0F N WORDS IN THE STACK 74174000 T 0102 + BEGIN TOS; REGISTER(CX,C,0) END; % 6 74175000 T 0103 + BEGIN TOS; REGISTER(PX,P,1) END; % 7 74176000 T 0106 + BEGIN TOS; DISPLAY END; % 8 74177000 T 0109 + BEGIN TOS; STACK END; % 9 74178000 T 0111 + BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1) END; % 10 74179000 T 0113 + BEGIN TOS; REGISTER(CX,C,0); DISPLAY END; % 11 74180000 T 0117 + BEGIN TOS; REGISTER(CX,C,0); STACK END; % 12 74181000 T 0120 + BEGIN TOS; REGISTER(PX,P,1); DISPLAY END; % 13 74182000 T 0124 + BEGIN TOS; REGISTER(PX,P,1); STACK END; % 14 74183000 T 0127 + BEGIN TOS; DISPLAY; STACK END; % 15 74184000 T 0131 + BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); DISPLAY END;%16 74185000 T 0134 + BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); STACK END; % 17 74186000 T 0139 + BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); 74187000 T 0144 + DISPLAY;STACK; 74188000 T 0147 + END; % 18 74189000 T 0149 + MEMDUMP; % 19 74190000 T 0149 + BEGIN LABEL DUMPER; %%%%%%%%%%%%%%% 74191000 T 0150 +PRT(1076) = *SEGMENT DESCRIPTOR* + START OF SEGMENT ********** 130 + DUMP LP (MPX, FIRSTEVENT, LASTEVENT, FIRSTEVENTI, LASTEVENTI, 74192000 T 0000 +PRT(1077) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + CURRENTT,UNITAVAILTIME,EVENTS,CURRENTMPX,MPXOPS, 74193000 T 0031 + BUFRMAX)DUMPER:1; 74194000 T 0059 +STACK(F+3) = *LABEL DESCRIPTOR* + DUMPER: END; 74195000 T 0065 +PRT(1100) = *SEGMENT DESCRIPTOR* + 130 IS 70 LONG, NEXT SEG 120 + END; 74196000 T 0152 + START OF SEGMENT ********** 131 + 131 IS 21 LONG, NEXT SEG 120 + WRITE(LP); 74197000 T 0152 + EXIT: 74198000 T 0156 + END OF TRACE; 74199000 T 0157 + 120 IS 160 LONG, NEXT SEG 12 + PROCEDURE MEMDUMP; 75000000 T 0957 + BEGIN 75001000 T 0957 + INTEGER ADDRESS,I,ROW,J,WRDS,TANK; 75002000 T 0957 + START OF SEGMENT ********** 132 +STACK(F+2) = ADDRESS +STACK(F+3) = I +STACK(F+4) = ROW +STACK(F+5) = J +STACK(F+6) = WRDS +STACK(F+7) = TANK + INTEGER SAVETRACEWORD,SAVEN,SAVENN; 75003000 T 0000 +STACK(F+10) = SAVETRACEWORD +STACK(F+11) = SAVEN +STACK(F+12) = SAVENN + BOOLEAN ASTERICKS; 75004000 T 0000 +STACK(F+13) = ASTERICKS + ARRAY MD[0:9]; 75005000 T 0000 +STACK(F+14) = MD + ARRAY XMD[0:9]; 75005100 T 0001 +STACK(F+15) = XMD + DEFINE N= NDISPLAY#, NN=NSTACK#; 75006000 T 0003 + STREAM PROCEDURE OCTIZE(LOCM,ADDR,WRDS,BLK,TANK); 75007000 T 0003 +PRT(1101) = OCTIZE + VALUE LOCM,WRDS,BLK,TANK; 75008000 T 0003 + BEGIN 75009000 T 0003 + DI:=TANK; DS:=4 LIT " "; SI:=LOC LOCM; SI:=SI+4; 75010000 T 0004 + 8(DS:=3 RESET; 3 BITS); DS:=3 LIT " "; 75011000 T 0005 + SI:=ADDR; 75012000 T 0009 + WRDS(SKIP 44 SB; DS:=3 RESET; 3 BITS; DS:=LIT " "; 75013000 T 0009 + DS:=3 RESET; 1 BITS; SKIP SB; 2 BITS; 75014000 T 0013 + 7(DS:=3 RESET; 3 BITS); DS:=LIT " "; 75015000 T 0017 + 8(DS:=3 RESET; 3 BITS); DS:=2 LIT " "); 75016000 T 0021 + BLK(2(DS:=42 LIT " " )); 75017000 T 0024 + END OF OCTIZE; 75018000 T 0031 + BOOLEAN STREAM PROCEDURE NOTSAME(XMD,MD,WRDS); 75019000 T 0032 +PRT(1102) = NOTSAME + VALUE WRDS; 75020000 T 0032 + BEGIN LOCAL RPF; 75021000 T 0032 + SI ← XMD; DI ← MD; 75022000 T 0032 + WRDS(IF 8 SC≠DC THEN BEGIN TALLY←1; JUMP OUT END); 75022100 T 0032 + NOTSAME← TALLY; RPF ← TALLY; 75023000 T 0036 + RPF(SI←MD; DI←XMD; DS←WRDS WDS); 75024000 T 0036 + END; 75027000 T 0038 + STREAM PROCEDURE STARS(LOCM,TANK); 75028000 T 0039 +PRT(1103) = STARS + VALUE LOCM,TANK; 75029000 T 0039 + BEGIN 75030000 T 0039 + LOCAL T; 75031000 T 0040 + DI:=TANK; DS:=4 LIT " "; SI:=LOC LOCM; SI:=SI+4; 75032000 T 0040 + 8(DS:=3 RESET; 3 BITS); DS:=3 LIT " "; 75033000 T 0041 + T:=DI; DS:=21 LIT "* ******** ******** "; 75034000 T 0045 + SI:=T; 4(DS:=21 CHR); 75035000 T 0048 + END OF STARS; 75036000 T 0049 + STREAM PROCEDURE MOVIT(HERE,THERE,WORDS); 75037000 T 0049 +PRT(1104) = MOVIT + VALUE WORDS; 75038000 T 0049 + BEGIN 75039000 T 0049 + SI:=HERE; DI:=THERE; SI:=SI+8; 75040000 T 0050 + WORDS(DS:=WDS; SI:=SI+8; DI:=DI+8); 75041000 T 0050 + SI:=HERE; DI:=THERE; DI:=DI+8; 75042000 T 0052 + WORDS(DS:=WDS; SI:=SI+8; DI:=DI+8;); 75043000 T 0053 + END OF MOVIT; 75044000 T 0055 + SAVETRACEWORD:=TRACEWORD; SAVEN:=N; SAVENN:=NN; 75045000 T 0055 + TRACEWORD:=18; N:=32; NN:=99; 75046000 T 0058 + TRACE; 75047000 T 0060 + ADDRESS:=0; ASTERICKS:=FALSE; 75048000 T 0061 + TANK:=TBUF[16]; 75049000 T 0062 + FOR I ← 0 STEP 256 UNTIL (MEMMODS + 1) DIV 2 - 1 DO 75050000 T 0063 + BEGIN 75051000 T 0068 + FOR J:=0 STEP 5 UNTIL 255 DO 75052000 T 0068 + BEGIN 75053000 T 0070 + WRDS:= IF J=255 THEN 1 ELSE 5; 75054000 T 0070 + MOVIT(M[I+J],MD, WRDS); 75055000 T 0072 + IF NOTSAME(XMD,MD,2×WRDS)THEN 75056000 T 0078 + BEGIN 75057000 T 0081 + OCTIZE(ADDRESS, MD ,WRDS,WRDS≠5,TANK); 75058000 T 0081 + PRINT; 75059000 T 0084 + ASTERICKS:=FALSE; 75060000 T 0088 + END ELSE 75061000 T 0089 + IF NOT ASTERICKS THEN 75062000 T 0089 + BEGIN 75063000 T 0090 + STARS(ADDRESS,TANK); 75064000 T 0091 + PRINT; 75065000 T 0092 + ASTERICKS:=TRUE; 75066000 T 0096 + WRITE(LP); 75067000 T 0097 + END; 75068000 T 0101 + ADDRESS:=ADDRESS+WRDS; 75069000 T 0101 + END; 75070000 T 0102 + IF NOT ASTERICKS THEN 75071000 T 0105 + WRITE(LP); 75072000 T 0105 + END; 75073000 T 0110 + TRACEWORD:=SAVETRACEWORD; N:=SAVEN; NN:=SAVENN; 75074000 T 0110 + END OF MEMDUMP; 75075000 T 0112 + 132 IS 119 LONG, NEXT SEG 12 + PROCEDURE ERROR(ERRNUM); VALUE ERRNUM; REAL ERRNUM; 76000000 T 0957 + BEGIN 76001000 T 0957 + FORMAT ERR("ERROR # ",I3,X2,107("X")); 76002000 T 0957 + START OF SEGMENT ********** 133 + START OF SEGMENT ********** 134 +PRT(1105) = ERR + 134 IS 10 LONG, NEXT SEG 133 + TRACE; 76003000 T 0000 + WRITE(LP,ERR,ERRNUM); 76004000 T 0000 +PRT(1106) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + END ERROR; 76005000 T 0008 + 133 IS 9 LONG, NEXT SEG 12 + PROCEDURE HEADINGLINE (LP); FILE LP; 77000000 T 0957 + BEGIN 77001000 T 0957 + ARRAY DAYS[0:6], MONTHS[0:23]; 77002000 T 0957 + START OF SEGMENT ********** 135 +STACK(F+2) = DAYS +STACK(F+3) = MONTHS + INTEGER I,Q,P,DAY,MONTH,DATE,YEAR,HOURS,MINUTES; 77003000 T 0003 +STACK(F+4) = I +STACK(F+5) = Q +STACK(F+6) = P +STACK(F+7) = DAY +STACK(F+10) = MONTH +STACK(F+11) = DATE +STACK(F+12) = YEAR +STACK(F+13) = HOURS +STACK(F+14) = MINUTES + FORMAT CONF (X14, 77004000 T 0003 + START OF SEGMENT ********** 136 +PRT(1107) = CONF + " CLOCK RATE NUMBER OF OPERATIONS/MPX ", 77005000 T 0003 + " MEMORY SPEED MEMORY SIZE",/, X14, 77006000 T 0003 + " (MEGACYCLES) MULTIPLEXORS A B ", 77007000 T 0003 + "(MICROSECONDS) (16K MODULES)", 77008000 T 0003 + /, X14, I9, X3, I10, I11, I7, X11, 77009000 T 0003 + F3.1, X9 , I3,/), 77010000 T 0003 + CABH (X14, 77011000 T 0003 + " LOGICAL UNIT HARDWARE TYPE MULTIPLEXOR", 77012000 T 0003 + " BUFFER LENGTH WRITE LOCK-OUT INTERNAL NAME", /), 77013000 T 0003 + CABF (X14, I9, I11," = ", A4, X7, A6, X3, 77014000 T 0003 + I10, X10, A5, X12, A6), 77015000 T 0003 + FILF (/, X14, "SOURCE FILE IS: ", A1, A6, "/", A1, A6, "."), 77015100 T 0003 + CABT (//////); 77016000 T 0003 + 136 IS 104 LONG, NEXT SEG 135 + LIST CONL 77017000 T 0003 + (PROCCLOCK, MPXQUAN, MPXAOPS, IF MPXQUAN=1 THEN 0 ELSE MPXBOPS, 77018000 T 0003 +PRT(1110) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + MEMTIME/10,(MEMMODS+1)DIV 2*15 ); 77019000 T 0011 +STACK(F+15) = CONL + LIST FILEL (MULFILID.[6:6], MULFILID.[12:36], FILID.[6:6], 77019100 T 0023 +PRT(1111) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + FILID.[12:36]); 77019200 T 0033 +STACK(F+16) = FILEL + ARRAY HT [0:133], NAMES [0:3, 0:13]; 77020000 T 0038 +STACK(F+17) = HT +STACK(F+20) = NAMES + ALPHA ALF; 77021000 T 0042 +STACK(F+21) = ALF + REAL MPXI; 77022000 T 0042 +STACK(F+22) = MPXI + LABEL OWT; 77023000 T 0042 + FORMAT HEADFMT(X25,"BURROUGHS B-6500 SIMULATOR " 77024000 T 0042 + START OF SEGMENT ********** 137 +PRT(1112) = HEADFMT + X05,A6,"DAY, ",A3,A6,I3,", ",I4, 77025000 T 0042 + ", ",I2,":",I2,X1,"M."//); 77026000 T 0042 + 137 IS 25 LONG, NEXT SEG 135 + PRINTERNOTYETOPENED←FALSE; 77027000 T 0042 + FILL DAYS[*] WITH 77028000 T 0043 + " SUN"," MON"," TUES","WEDNES"," THURS"," FRI", 77029000 T 0043 + START OF SEGMENT ********** 138 + " SATUR"; 77030000 T 0045 + 138 IS 7 LONG, NEXT SEG 135 + FILL MONTHS[*] WITH 77031000 T 0045 + " J","ANUARY"," FE","BRUARY"," "," MARCH", 77032000 T 0045 + START OF SEGMENT ********** 139 + " "," APRIL"," "," MAY"," "," JUNE", 77033000 T 0046 + " "," JULY"," ","AUGUST"," SEP","TEMBER", 77034000 T 0046 + " O","CTOBER"," NO","VEMBER"," DE","CEMBER"; 77035000 T 0046 + 139 IS 24 LONG, NEXT SEG 135 + I←STARTDATE; 77036000 T 0046 + DATE←I.[30:6]×100+I.[36:6]×10+I.[42:6]; 77037000 T 0047 + YEAR←1900+I.[18:6]×10+I.[24:6]; 77038000 T 0051 + FOR I←31,IF YEAR MOD 4 = 0 THEN 29 ELSE 28,31,30,31,30, 77039000 T 0055 + 31,31,30,31,30 DO 77040000 T 0069 + IF DATE≤I THEN GO OWT 77041000 T 0080 +STACK(F+23) = *TEMPORARY STORAGE* + ELSE BEGIN DATE←DATE-I; MONTH←MONTH+1; END; 77042000 T 0080 + OWT: I←ETIME; 77043000 T 0086 + HOURS←I DIV (60×60×60); 77044000 T 0086 + MINUTES←(I DIV (60×60)) MOD 60; 77045000 T 0089 + IF MONTH<2 THEN BEGIN Q←MONTH+11; P←YEAR-1900-1; END 77046000 T 0091 + ELSE BEGIN Q←MONTH- 1; P←YEAR-1900 ; END; 77047000 T 0095 + DAY←((Q×26-2) DIV 10+DATE+P+P.[36:10]+1) MOD 7; 77048000 T 0099 + WRITE(LP,HEADFMT,DAYS[DAY], 77049000 T 0104 +PRT(1113) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + MONTHS[MONTH×2],MONTHS[MONTH×2+1],DATE,YEAR, 77050000 T 0111 + I←HOURS MOD 12, MINUTES, 77051000 T 0118 + IF HOURS>12 THEN "P" ELSE "A"); 77052000 T 0122 + FILL HT [*] WITH "NONE", "DISK", "SPO ", "AIDS", "NONE","NONE", 77053000 T 0129 + START OF SEGMENT ********** 140 + "LP ","LP ", "NONE", "CR ", "CP ", 0,0,"TAPE"; 77054000 T 0131 + 140 IS 14 LONG, NEXT SEG 135 + WRITE (LP, CONF, CONL); 77055000 T 0131 + WRITE (LP, CABH); 77056000 T 0134 + FILL NAMES [0, *] WITH 77057000 T 0137 + "NONE ","DISKA ","SPO ","AIDS ","NONE ","NONE " , 77058000 T 0138 + START OF SEGMENT ********** 141 + "LP ","LP ","NONE ","CARD ","PUNCH ",0,0,"TAPEA "; 77059000 T 0139 + FILL NAMES [1, *] WITH 77060000 T 0139 + 141 IS 14 LONG, NEXT SEG 135 + 0,"DISKB ",0,0,0,0,"SIMLP ","SIMLP ",0,0,0,0,0,"TAPEB "; 77061000 T 0140 + START OF SEGMENT ********** 142 + 142 IS 14 LONG, NEXT SEG 135 + FILL NAMES [2, *] WITH 0,"DISKC ",0,0,0,0,0,0,0,0,0, 77062000 T 0141 + START OF SEGMENT ********** 143 + 0,0,"TAPEC "; 77063000 T 0143 + 143 IS 14 LONG, NEXT SEG 135 + FILL NAMES [3, *] WITH 0,"DISKD ",0,0,0,0,0,0,0,0,0, 77064000 T 0143 + START OF SEGMENT ********** 144 + 0,0,"TAPED "; 77065000 T 0145 + 144 IS 14 LONG, NEXT SEG 135 + FOR I ← 1, 2 77066000 T 0145 + DO BEGIN 77067000 T 0147 +STACK(F+24) = *TEMPORARY STORAGE* + ALF ← IF I = 1 THEN "1 = A" ELSE "2 = B"; 77068000 T 0150 + FOR Q ← 0 STEP 1 UNTIL 31 77069000 T 0152 + DO IF MPXI ← MPX [I, Q] ≠ 0 77070000 T 0152 + THEN BEGIN 77071000 T 0157 + P ← MPXI.MPXHDWE; 77072000 T 0158 + WRITE (LP, CABF, Q, P, HT [P], ALF, 77073000 T 0160 +PRT(1114) = *LIST, LABEL, OR SEGMENT DESCRIPTOR* + MPXI.MPXBUFF, 77074000 T 0168 + IF P ≠ 13 THEN " N/A " 77075000 T 0171 + ELSE IF MPXI.MPXWLO = 1 77076000 T 0173 + THEN "TRUE " ELSE "FALSE", 77077000 T 0174 + NAMES [MPXI.MPXSWFI, P]); 77078000 T 0181 + END; 77079000 T 0186 + END; 77080000 T 0188 + WRITE (LP, FILF, FILEL); 77080100 T 0189 + WRITE (LP, CABT); 77081000 T 0192 + END HEADINGLINE; 77082000 T 0195 + 135 IS 204 LONG, NEXT SEG 12 + FILL MNEMONIC[0,*] WITH 78000000 T 0957 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78001000 T 0957 + START OF SEGMENT ********** 145 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78002000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78003000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78004000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78005000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78006000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78007000 T 0959 + "VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78008000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78009000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78010000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78011000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78012000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78013000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78014000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78015000 T 0959 + "NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78016000 T 0959 + "ADD ","SUBT","MULT","DIVD","IDIV","RDIV","NTIA","NTGR", 78017000 T 0959 + "LESS","GREQ","GRTR","LSEQ","EQUL","NEQL","CHSN","MULX", 78018000 T 0959 + "LAND","LOR ","LNOT","LEQV","SAME","VARI","BSET","DBST", 78019000 T 0959 + "FLTR","DFTR","ISOL","DISO","INSR","DINS","BRST","DBRS", 78020000 T 0959 + "BRFL","BRTR","BRUN","EXIT","STBR","NXLN","INDX","RETN", 78021000 T 0959 + "DBFL","DBTR","DBUN","ENTR","EVAL","NXLV","MKST","STFF", 78022000 T 0959 + "ZERO","ONE ","LT8 ","LT16","PUSH","DLET","EXCH","DUPL", 78023000 T 0959 + "STOD","STON","OVRD","OVRN","XXXX","LOAD","LT48","MPCW", 78024000 T 0959 + "SCLF","DSLF","SCRT","DSRT","SCRS","DSRS","SCRF","DSRF", 78025000 T 0959 + "SCRR","DSRR","ICVD","ICVU","SNGT","SNGL","XTND","IMKS", 78026000 T 0959 + "TEED","PACD","EXSD","TWSD","TWOD","SISO","SXSN","ROFF", 78027000 T 0959 + "TEEU","PACU","EXSU","TWSU","TWOU","EXPU","RTFF","HALT", 78028000 T 0959 + "TLSD","TGED","TGTD","TLED","TEQD","TNED","TUND","XXXX", 78029000 T 0959 + "TLSU","TGEU","TGTU","TLEU","TEQU","TNEU","TUNU","XXXX", 78030000 T 0959 + "CLSD","CGED","CGTD","CLED","CEQD","CNED","XXXX","XXXX", 78031000 T 0959 + "CLSU","CGEU","CGTU","CLEU","CEQU","CNEU","NOOP","NVLD"; 78032000 T 0959 + 145 IS 256 LONG, NEXT SEG 12 + FILL MNEMONIC[1,*] WITH 78033000 T 0959 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78034000 T 0959 + START OF SEGMENT ********** 146 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78035000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78036000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78037000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78038000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78039000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78040000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78041000 T 0961 + "XXXX","XXXX","JOIN","SPLT","IDLE","SINT","EEXI","DEXI", 78042000 T 0961 + "XXXX","XXXX","SCNI","SCNO","XXXX","XXXX","WHOI","HEYU", 78043000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78044000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78045000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78046000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78047000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78048000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78049000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","OCRX","XXXX","XXXX", 78050000 T 0961 + "XXXX","XXXX","XXXX","LOG2","XXXX","XXXX","XXXX","XXXX", 78051000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78052000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78053000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78054000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","IRWL","PCWL","MVST", 78055000 T 0961 + "XXXX","XXXX","XXXX","XXXX","STAG","RTAG","RSUP","RSON", 78056000 T 0961 + "RPRR","SPRR","RDLK","CBON","LODT","LLLU","SRCH","XXXX", 78057000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78058000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78059000 T 0961 + "USND","UABD","TWFD","TWTD","SWFD","SWTD","XXXX","TRNS", 78060000 T 0961 + "USNU","UABU","TWFU","TWTU","SWFU","SWTU","XXXX","HALT", 78061000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78062000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78063000 T 0961 + "SLSD","SGED","SGTD","SLED","SEQD","SNED","XXXX","XXXX", 78064000 T 0961 + "SLSU","SGEU","SGTU","SLEU","SEQU","SNEU","NOOP","NVLD"; 78065000 T 0961 + 146 IS 256 LONG, NEXT SEG 12 + FILL MNEMONIC[2,*] WITH 78066000 T 0961 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78067000 T 0961 + START OF SEGMENT ********** 147 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78068000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78069000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78070000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78071000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78072000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78073000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78074000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78075000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78076000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78077000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78078000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78079000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78080000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78081000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78082000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78083000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78084000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78085000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78086000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78087000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78088000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78089000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78090000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78091000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78092000 T 0963 + "MINS","MFLT","SFSC","SRSC","RSTF","ENDF","MVNU","MCHR", 78093000 T 0963 + "INOP","INSG","SFDC","SRDC","INSU","INSC","ENDE","HALT", 78094000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78095000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78096000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78097000 T 0963 + "XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","NOOP","NVLD"; 78098000 T 0963 + 147 IS 256 LONG, NEXT SEG 12 + FILL DELTAMASK[*] WITH 78099000 T 0963 + 8191,8191, % 0 AND 1 78100000 T 0963 + START OF SEGMENT ********** 148 + 4095,4095, % 2 AND 3 78101000 T 0964 + 2047,2047,2047,2047, % 4 THRU 7 78102000 T 0964 + 1023,1023,1023,1023,1023,1023,1023,1023, % 8 THRU 15 78103000 T 0964 + 511, 511, 511, 511, 511, 511, 511, 511, % 16 THRU 31 78104000 T 0964 + 511, 511, 511, 511, 511, 511, 511, 511; 78105000 T 0964 + 148 IS 32 LONG, NEXT SEG 12 + FILL REFLECTION[*] WITH 78106000 T 0964 + 0, 16, 8, 24, 4, 20, 12, 28, 78107000 T 0965 + START OF SEGMENT ********** 149 + 2, 18, 10, 26, 6, 22, 14, 30, 78108000 T 0966 + 1, 17, 9, 25, 5, 21, 13, 29, 78109000 T 0966 + 3, 19, 11, 27, 7, 23, 15, 31; 78110000 T 0966 + 149 IS 32 LONG, NEXT SEG 12 + F:=D[2];%%%%%%%%%%%%%%%%%%%%% 78111000 T 0966 + PDR ← 8; 78112000 T 0967 + SIMULATOR; 78113000 T 0968 + EOJ:END; 78114000 T 0969 +PRT(1115) = *SEGMENT DESCRIPTOR* + 12 IS 973 LONG, NEXT SEG 2 + END. 78115000 T 0031 + 2 IS 34 LONG, NEXT SEG 1 +PRT(722) = EXP INTRINSIC, SEGMENT NUMBER = 150. +PRT(721) = LN INTRINSIC, SEGMENT NUMBER = 151. +PRT(700) = OUTPUT(W) INTRINSIC, SEGMENT NUMBER = 152. +PRT(5) = BLOCK CONTROL INTRINSIC, SEGMENT NUMBER = 153. +PRT(107) = INPUT(W) INTRINSIC, SEGMENT NUMBER = 154. +PRT(1074) = DUMP INTRINSIC, SEGMENT NUMBER = 155. +PRT(723) = X TO THE I INTRINSIC, SEGMENT NUMBER = 156. +PRT(115) = GO TO SOLVER INTRINSIC, SEGMENT NUMBER = 157. +PRT(14) = ALGOL WRITE INTRINSIC, SEGMENT NUMBER = 158. +PRT(15) = ALGOL READ INTRINSIC, SEGMENT NUMBER = 159. +PRT(16) = ALGOL SELECT INTRINSIC, SEGMENT NUMBER = 160. +PRT(326) = FILE ATTRBUTS INTRINSIC, SEGMENT NUMBER = 161. + 1 IS 2 LONG, NEXT SEG 0 + 162 IS 69 LONG, NEXT SEG 0 +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 286 SECONDS. + +PRT SIZE = 590; TOTAL SEGMENT SIZE = 13917 WORDS; DISK SIZE = 720 SEGS; NO. PGM. SEGS = 162 + +ESTIMATED CORE STORAGE REQUIRED = 14388 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + + + + + + + + LABEL 000000000LINE 00187158?COMPILE B65SIM/DISK WITH LONGALG LIBRARY LONGALG/B65SIM diff --git a/source/B65SIM/B65SIM-COMPILE.card b/source/B65SIM/B65SIM-COMPILE.card new file mode 100644 index 0000000..42aa377 --- /dev/null +++ b/source/B65SIM/B65SIM-COMPILE.card @@ -0,0 +1,8 @@ +?REMOVE B65SIM/DISK +?COMPILE B65SIM/DISK WITH LONGALG LIBRARY +?ALGOL FILE TAPE=SYMBOL/B65SIM SERIAL +?ALGOL FILE NEWTAPE=NEWSYM/B65SIM SERIAL +?DATA CARD +$TAPE LIST SINGLE PRT +$ 99999990 +?END diff --git a/source/B65SIM/LONGALG-DELTA.pdf b/source/B65SIM/LONGALG-DELTA.pdf new file mode 100644 index 0000000000000000000000000000000000000000..3aa422c3d162e748eea47ca1d8e0a8340b47290f GIT binary patch literal 58699 zcmagEW0<8&lc-&`ZQHhO+csC(>N2~mE*ssYF59;4>awj|MT|DC%hEX7Aua#Kx!uFgLR{b#(*~F|!B=FiKe4xtaqQ zCG3n{&HrNxqqLYVpQso!yEwaum^cR;6Nj*)-&|9wnuMioa#S0YyCzXzy($%crXjZw|Z$(&J3#oU5XQaD5{|%#1ELjfA`OTLC1B(wVG}>1 zMG~T(4G^;N65z;zQtWgr?8RU?W21igH%q=dSfXyAO(=K_c$hE2{%h@jiP*)}7~tv& zFt>n*VSKOa zGO{o-Vlg%{HZp=YM=}xu0?vbjMFP+n8U3L;wAp!?8X4w}4>C@qR8p})gafz|5!JDf zb;Az8!RcZ@VPTO8p7B0K`o%T$oQcYuQ3KMVx&-)IKy1iO0Tc-qV7m-N7#2o!tuP0l zKu}CTh9`uV|8Um71^+KR<;`7<&5T`*iI_S6)`pU?rMaB3iMgE%5evuv?fGhO{oVLm zNupol?Hn!ti%(XT{}PU*!H#tONvk}n)*{aDdJJXQ zmyk_35y~{nwJV~eSwn83j}=W0?P5-EQM$fhcWhp)nm-;zXUQx*KU3A`B+gK1MPvIL zc(cFSK8R8FiQ!gfWdx53IjOBU9n@b)A~8#a-(A>s<;K{`h0?782Go>;MuPP?rUOOmBY9BT7W zH@1L~^_IP-yi--{V4k3EoHKSQX>d-Z%}Y zI+fcg@=f(XPKJ-<@@4%QTEtUUk`^9jcO1L2P?_&GITwUquL{TK{Qlt=un;ELQ7g&+ zVDvbJ>ih2Ke)!Oe(9Yb{Gq3;JRl|B&KF#_Zs3; zTz?IYm_51oWQZ3#g|{Bti59-`yE@Ae91Cb1vG&W){|_(nH}n6ptbgzl|MG=goNWJv zj#OlJs=eYG6VlMutLnNe4f2rtTe6ImjjV8Js=GawD42YeE1a0It+3VW9q&-SkaI;$ zgU#-1F5!iT0O$3`x4wnM238cy3?PIR#9krMqM)D#HPHg%titmsv1Df86*Sxx)Ro!V z81Ov^A+};W3OtDr33t)tVi=OjayjBPa$P)=X@x%)V3edXMf1DO)C)M@iuHnbf^A@< zv7PHL3)g@d4j|I5z_NRQCMU0-QO=iylIx6;^CG`NwZTT{d64Qqnw(j>Ddd1A*#?#O z&&~(S)p%gz4GwxDFKynR!!a-tSja0m_l{xNs~W|C=m-oZ%is-#K90V_BgbteLWM-A zvi(|5TMC%@u@@6@QUm{tVJSjQd>eKfzZm}bVSTcw+v?KCc6;$F%#snA@9jC%Pr+L< z!Ea*orx*RAN6u6vOET=ZpgB&F0yV{!)4nc+47C2f0(GVd4GiLG;`i1@*)V5*Sw98; z)G)GzWk84cwXbZ0D?h5`L%am{ZIOwt%{rZfLF;OU__C$$4~rZ^M$2gPoOlKT$6Mb= z{}-;@4Sue^-46>6H%0qmtg+jHGh=5$zsJ~v_dOFHQTa+~$AqKzof-eiE=5L%U!4=U z$e2=Rg?*fp^`Isj68G5EISf1}ImxOobZ>*h*#2Ce44HdWb6&<-sF6g?xai8&c-R0l zW5Sz^{vX9*$0#*Y&9B-Dmk}I4ADlq;F96w4Y)@!D(ovb2cQVa~a1I9gFQ%(ywJg`s z?$MqriMfLtJy)`rG8ESij)3M48{&NX?%a`MA_jY;&h)mLegnErjVrvpW-yJ^v0Ljw z*?nRW2^CZbH7a9)%VJDETB=lKW7>Q)NCppE-_TN4ycqBI3tN)FM`Oa5j)!J;f$DAK zUQ(MqWZWw)g;=QDYZWXdAy{MhfT z^L`}aTiWXrDa)+}+(@d}^oJ^;oW<>kZ0|Da`o6igG3?~O+1$!Q6K;#3tu36t--9>f z)-wvHAs4jVZhjbnbkt)sFdV!?`3i#i=06JXA<;7Ro~cA^<{%@aRM)5MMT?C!>qPF!rqQG9?_taUXWqjb}V zECXyBp<>r8@GEWerH960bT{tsLOVHCSZ02com?$Bm@aLR2F&!4PKHX}j9L|7BjWRT zXwDEN7v*o&vnySfUPumhmQr}q2SAP`ec1wlS5RI%LXfb7&YVgtNEVe)FnssrZuEMz z=Q*TdQiBq_HsDfWlb!8oO|n225z>h|Ij6Diz+W?beYiYMcy$8cHkRI-jP_E?Ot|SP zhoWzQ{+Q>}YK}^T#+N7JpUeDXW-=L&o@raX2aJc(`-_H{yiJA_x&@L4nq9xOJ92Dk z2^COY@k;zdo#{w$-1fQ|A>s|lii^tJdo$^#; z2`&B+_pQ_zw%%KVTv}f@$<2ofu164w&S9?pw&B?5c9hMTGFtv(qxP;X?BpEheEM2$ zR@&B7x4+aQ;i`p?s?@_4eg2$U9eM4P8=OC9FJA(|u_+nq4b=!}X_b8VpD_I^ocUk> zR@k|@{vFeH4f*&vCZvv6&2eyQss2;vx9@l!ZTVoW=QhwN*|ZqY&nTTuh zzi9zdWB@NaLrjZ}Lhc)m%{O!6h-G->t*K`Rs%ei+@~# zX>yXbv4}Z?kc^S8^SIY<35KpU?`MLZ&ORQs4X&$%AL#d^orhyoU;E6kI<4WlQ4@_~ zV7l-+?+mE6!muAMx}Uo08ajJ@DEdi`9F*WgsB)RrWYuU?%*~;vn~c#NHg?4>x9lp^ zzFI}k%)NwN-|mi#l~X%P@6`NYGhRV_MW%a8zHKytB|j_o7}p|sLmr?|nEe2$%X9Qe zsCcAjEM+B;7&fPa4kZh{!8a;q4l;Dp??0K1IN7cQ2+t5zFBYdC0}ibjBo?v5Y()x# zDaCkJvkfhfy#+{Ff*EBw{iji!v8L_R3;iUFL`1*$?(kW~LmA={SXqt+Cn6^5TMFkQ z5!E4n;Qmp9S-|!C@#@>_c9A3z+eu!DV^W~nImX4xDGwrVaLk^Cl=0)&5oZO(Qn2qa zzW2diWpX`Dh)0=s5B>{}`oyJ@=FC~db}kSoko+v$;XkqYS4986v&qKs?`-y`$~%6! z(6Gx7bg(es4dM!cx0FpZUD;4>0Ie;SH^ORP4cZ^T@)n^vql3+mJ4_J)q6o?8ZebdQ zxd^rS_6L||uAu&4+1B?#G@aL7e+XC!mAvg6pzvx!CbM0B=TmJY8SYyL7EE+XW7*Id zE%}BB6ckXD`u?^!qivSOZn7h(qvq03fdWf zS^?@Tt*tC9uDUv)y5ey^`kER`XKZfrgAu{Ng$lDBsLv~k)G|hl+31AJ&f|U`K@%3) zgdqT2y$$K82B1g}eG!t<2aU!fL3othPu;(H>ON!{dllX!Bb~K@;q3;>rDaVhbo6BN z=a-H)Q*lTYn}SUtU>X8ouYM@=DuiH(&Q{P-AGMbh)?-njKdx_E?!409%n|A zN)pWL=|x)#lBGpU>ve%r5R5-&8)CeCX1a&@lAncr=<_C-5S<@77Jk`T#>i`89t(H^3)Vn`ijyJ<3 zLJp@qPn6WnYEc%(rAMbXc<=Iix^;}EOg%H^(`U`?Zx`a9Zi*dP_oyEvQnN~IO_5s; zcL=`WKZruRK;VFG$O(M^iL<|68UI(#I9dN&Xx*`{@~>$0tNj*C9Er? zmO|UNV3AkMDPjFl#A=W5{;ChXyBrx*1gQxLQMAz6cSsLAdfib>NN1t$uQe;^c?XI zKZ7JFy_zFBVW#Ry0Zp)i>%R~}dW#T&!5DkF1r@<^b7J1v3(TJoLrm`^r?3n_Lj^%@ zof<7)_7|Rt?ghf3d|KykmOhPA4ijGYi5r@M>`CLjoQr{&+_Hto@G6dur!8w(6`Qe&Om@`-!Jm#lanL%x{u@9*ug z5xU(2^TnC&U&S*6<>$@CAJo@VXE6*K!2yoFDEh7=ttQ@3?EspN!#{EdE-lEnD@MvY z5?;lx4-DM&x0EzKlAEXly3BAj2#MFr{|{aof|*{z=7F-_(v zGg5^&V$D4%6HKm}CQd`jQE>jtBEM-=?;^6?{>NUT!DFS8M;1e1tJSuSMhb0ixZIyA zyyIbWZc6A>g!_*?ZFcdnrk>7-8Q^EP3r0;9-x(gPrr=eQ|rL z@L!pWz{|HN54+-SJEuUglb*o(uaMPVHM5#u{j^AW&6xY_@)CQNjg6RW4u=qFCupmb z@si&Ol*ot$5-}jV^4QMZ-k)pdus{+j-yX;bI)_1c$(lwiH7z&)J57jMYS>Y6Si7E- z+n79q>~>_8yhi{rZoW|)RPnc+pN^V#0!@&}i5R^_C_d~BBI>Up}%0fY0E2)1)De*?u$G*xFjq0#p!)7K8|64Tq; zNsakmC8Sc{N?P*uS=Gs2t}-WzQ!ADh^M!%7A?uLYSZcEqNxQ0t__8wI`U z2N7nl{!+&qFaHGNj%q1sKM~R_sfr5aaQZ-?XoZr`KrDZ}H%IJ32uvffnM?EJx zOB$C5tw{>?#RH4|%Dar9;u&aDu=qFtUv15nkJ6e7QZ!c6zZ%LX$DE|+RPF5%S^2v6 zZJWu)E*JAsY#MKRmRE9GWAlN|hy&CHm=4K8C9shhMBzCop_7Zgx14WlTXmgqB5K zH$-@+5bW>hpEsIkh*cH5n)H=|i6ch}dmNJRY>@P29t5;KkL+C@Q4*!}?-WCA6!i z^CNHlB~igTE<#BrKQhiR_sF~L3GmSi9$|LK5Pj~gZx1&}bmaMx-_6!!z#Az`1J5!+ z?IyAUvjqiqC6P{@4Fb#_R8)0(V+&avXcr+ikPtzIkCeYhKqRy-GPKudkah@H48$$e zYXv8bQ5+)vrx_Az*r8z0S{>Z4B20=XOibc z0t){T2)F`&0WmtM{}r`y4{hCf^~*K07OY}dLYb$tij#f3!{al!36*znv>M6XW?$W= zKd^2-6O4Fh^9$Hl7-FhcU$BWz;Y z+vxDS6!QP=!KQ3t!^PHm-HD?b^}UCfrB{22JOm}SVbrGWdD)OKhT=AX6!`!u43B*r z&Z5L&#I};NR?hcm7odF(lR2(&F_E}Z?<2~h>q~PQOu2;Q)_f;^er5QTGl;h!YyBr0 z|4LK;uQYNn{dXEu{(cz?yL?6`RhJ@S?;)(63-*>uvR+cjq>Ga^MlOvK7eRye-o9j2 zSUqQWmr4`8>XEiMd%ET&P^1b98UsD?hh&tL>jG?nbg)XqFmG}JvNKSKCu(zQdTOo| znXxusC<)=}v*s1{x9MHk2M0Xm0{FGwymwTgdfJiouXxsMv>b_XfFC#9-$^41z*Qk7PAW44EX%AdoCswN;L@!w^A@kboQ0V zk!~U=6+<8}=0LKwi7w;D2l9~BG^e!yFZ*{e#A2p=q~XLXM^^chcCAkySc<*82UtJ8 z7b-##GmZ$;S7LlHH8S0)x6UWCH{;sL&w)U54IwgB+L~AbP|4}qcOVGQK;RM}Chg<$ zPT`9lAu>izOz+lV=(p%iIAE!_PV+ykr|9KO8o$nINkl?TtAEznkesF9( zg^~!zXf0Oh^l|iSU1vL%@C*c?D6&Rat}0LDtcdh}LA*Y$vx)vi}0CX|YOOe`xaYiu)K>i6cnuG0XXH+a8me$s3AuC(xr(MWTc zBrsR!4J~SEY7qf`{*;m3Y4}gR{!gx}U$0Q{CqRv5!JYZRCOM9|;5&AOWLzDXrgcy&i@jg70QwmhjYaJ?4VH zzy5TJeEL2a`-*pjf+c4O{fr%LyK4(Q9SB4Qj6MvCo(Jq2M9c)L(T%|c!dV0I6l8>i zun2+?0XY(g$RfTM1+PQF6xYgh$7N5jZp?g6H1e>Q-=J4!2_-z z_)`RQn%@d7GuS_LvkyuxxV(m?3Ldu)ZW;O^EM$k>2`?MssQdX!p&8_7NPN%v75Ed6 zFC;-wZeKl=Py`gbvM3xf#BT5tF|rh0uOtUis1&zKcmt8X6e9o@Te#%A2NhgYa6uuQ zawCsmvow>mf|AcV6qhYXnO2w%v${;9VszH&)vhy@9!u;YcL78J;sAIpA}ty%ynxGt z;~R&Y$eXqU-hD#qJhVG>5HuEa1R6b+bd4gKRhl|9Sae0IP0iqxyA+U=MQVJF6V*(0 z4dn+V1@+BezRF%Yp(VRziFqm|01b1QlmeSyqw4gk{G~5346+^tlryw{`0udU$=Maz z^L46qx>nm;N_!k#~dK$KDWGH_GgPisp=(4b4^GYr_y z$hw=I%ZRB4tz+Js+R=Jr)>t$#Kgl@ExPGS$d182oYO1X7PiSq4^S5hPCWL?PEg^m)PFMXr7tFCWD zL*2e^qn3iUwT`&1x-L9x8C-w_^IjDD>gtMj;l1^#2S+LgNERwb*D}s3#VW^&0>hH_ zq_#nq@3_K7oVBJcr-@=ye50V5;BMYww`-Y;=Wf}~u)Cd8w$rSOj1$k{UGGYN#^w4U z-;v2)-R40%?e58r&Y#swiam^7jpK)9{SE%fjupSbzFyNGLtcsvrAx}5G>_EP?zdbzh-z;4#-hK)I zp>7i@p z5cSc0XS&F2Y1(d5VQQhpP~}&3WGCs4?Gt4>M13IFzdDdQs4%!Pa2}ZzLiJ7E1n`VlS~UN%7juGqODgEhV`sIY=#JK6w5+TUJAdHLI_q zzbH>~Cq;*<5c<2^J+xb>ZfGI)1GYN0BdaK@qJ^~Ob=^zdeZ7a7;(qgyZwJEfxZgi{ zHR(NEF8+9z-v7qUgJ;HV<+QOI-{R^VF`b*4_%;!l6)?;?LObEpL2f6j*$Mb4d8@4^ z(9MD+gLwk)TeE9gu#>bua=6?w?lk?3Qw%-pwH2ojKM*I3(jHjqWO=XHtqlE9%lj%z zCyQ{=d$xOyvwB|hYE|xPt#G_du*H9FeplC9x8zg!U_fuEVNf4mquA_N)LUBM(slTu z|0<|9sJU4V_-RwEQL(Aa?-A%{bd|T)lZtbYS&;b{-W-0h=sn-KWWAI^IEXjN_0}NJ z(D`UPxD*Qy11}Cw7=INPg9p#II%l=8yj(P|HVelIn^hVoPSExod&>EPK8*f%b;Dx8 z-gfiVQ@vwh7e3F9U%@Ncp4pg(&X#(U@+!<){=?ZrM%+`}_sOftAXQogH;)zf-+qpF z@89QaN-HOabEvsxxv~P>cl0J(R&L9WN*Vk0u}Ugk4;5X#C^eS-n z-tT(|c@`cO?@iby;1%HAoX}o#mGxB?c>H$z`cE8jMl8_ayokDpK)qBX zU}P!K0^u;>2_hmAi)DNvF*P$VH;9z$C@P$p=s;46g{@x|ZK6WiEmMA-0T&Y)w~PKK z^W1K!Hh6>BrulXVq#Rb;3FFzNCqwp@RR;)n2>86tcl+k{jP@3G7f^#wqqXq@iLRTr zjizU+gAG-6Bae!BKlz=)m=pc7E_0bW>`brw`mkIIHx9FIUM12#8XlZ5Om7j5_`2}$ zQ*|c(dNFRI%Y7PdXcsh3E`;}XZljRH;niXNZ8)U$DI0T;s))yLUuTOTZv5^&uITM_ z*Z9UtiU#{XQ1m-}|*m&8lJ4fH~oI~3+E38dwbcVSWBCyR_L}k%5=$8 zR&8$k%;z2@KZD(5e26(nO%Jc;u?-dzYkV4`I%q?Um|Pk|$PChxVI%+jP%T?z)E;%K zul_ginP^q+$VDFV9nz1(+k3TlW}c~3>llgJ>$7I(QM8fN4Am7DRqWiK@hVKJIf_1V zgafwAUekD@pJKe&+109)7Ixtr%UDKm-5F!kO$vT#&s`LdKJhk|O{K(;RD%~tj8(0jW9exRACY9mRb`#LY zz}g9H0e5D2VPu(Po6se87;|9rSZDv11=!84cgQw*IWS6l`)C2Y+i)|b5nN_DIIML4 z+!g8MIx0mHIKr)2ux&{=jB#xIcp12a_y4~6^D-~7NQYpqLpRXwQF&vUy9i8uMTGOE z%|q1`uw);G`+3T5qdU8NQ#24aP>zqudvTgRY1DKWSpaVO5^0F}N)qc=cho9~pGdEn zg6co-DuCr-PAF>;ni;Zmh1`5h?hDR%a73K+oUmfEKF>1jEpRc-$B~tLM5`4UEK8Tu z!rXn0Lj&e+?Vg-l&?Xiwv(_~a8O`Qulbcc(I-Y-B;4T+Z$~^2Ymfl+GkuKr zmTf-D3(+5^awz0dhQZ4pRZrFvwOtRigsvY^64Xf95=sPpl@?@s@DIV2Km00$05Fft_b>qSa2|Lw z%uKK|tdlmuYEIwOxiN&xR-E)9m{S`9pKedOqDl>=D=cGL9_e5;EC0=<^7d!QL$D_j zp5*RB`$(M@<@8Da#Xux|-YuSPk%Iy_ZEw{>758bu-F03o_6nCG>_BlOd9CYu146StN65q!tN&zP@k!hcp6 zuUjRcrES{O94*O3xrc(^Lu}n48yb1@Qnp)R41SW~tdmnsXxl~4{(;eoPEIN!UgBJc z5~H5EzjD8=d1VU}KgR)=6$n)aw-WC;ELc_d;)6XMWZ!p^k?;hU zod@TkvpHFOMz6#meCfRi(Ux5Q+Ve>Az~+9A5TFB${WA3(@;B+9cw;8|BJ<8B7dk?6BT{}ReIh)1D7b{kWd zJ`&PU>J^qh4jPJ=r6+t#0TeI%0eN0VZ+KnTja)bN2j~OuL@DUvwZ}8s2c&;WJaF~* zGDBnDg;sK3_V#g%D`!d{LqPE&%_xhmk?hrk8AesR>O|Q$N0T>5{af)}xuXU!&&|0j zQ|GsKMrGei*}Dz~ir3Af=g}$um|rm|DxZ=I@K_bTmud$ArRBVw=uH+h7w^jRK0w4ZziC2Bvr{cyt!q>V8LIe_8{)S)*m>UotlUid2=37^v3tVdA&w(8Ng1jNhr zewZck)s{i6kL%`{o8^KbUjB;)jwi1MM{QeEsUF$j4za~NZ4D6`cly#;0Wj+y|EI@4D?=Ynybu$+_-Un&vd*6 z^(fJt%RLb#rIQG`Wll7Y=3Ee!w`Bz?l;P|V?IjMvVu{*ex-VYuNcHW3U(`6kp&qDX z6qgTBynBoz6_uFFQ1MZhN%~133K2j_XM@nd2EWDDpwW%F9@2?!$5q8dcr#&1uuXLr z0}`riLx&B}3;GD1_GkEW|Bcvv9r7r{evwrsGTz ztJ312`TpRl$!A5p$`hK?oY7a9+k$V%U)T%NqRF_U8F7XO*NKyEhjbsGu(s>=Jo~z% zijYa6zVFBv;f!FIr_*@rX%oBwjLR3nYLtRM;n!pns&`Gz&ok-lT^A_<1o!!BXtSOQ zVN50v3@vbNx0qjEvn~X;nI6A)po2+V2fLW6g9`g z=>(RAD`-}(=&oEj_v-%6blU=fprplEx!-V6q475&|8Tx74V<;SG%X_ucGt_BZukk> z7*9`0ZLU3%KIly4NWRf39oz<~nEb97b7VI$4zfWn!=5s|zdZwI*NI&%4ALPVBoO)x zvEx@fsC0TY2-E1xixqDs74PIEa7{9 zraXd~fkJ?I-)y#n`kp&g(E+=QDFz5+KToHP`t&p*9F^NqTtX=}5}1--o#5AAFnG@8 zV4aRihKMMh!4Qt*cGEOfpi}GgJ+p1*`gJEIEO9g68ca`u(_2fkq(PZ5g~RMt39Ycj z^Tc!ayirGdPf!T0TRsQ&x!)UFvQ$Vo@0Vz2_PF(_@`HJAN%}I507j2i?GLqxES0jG z&8-jVDH3H1;3Z3SmY3AZIkpML5N$D}EDI8rc$+AIV+KFFc)-Wu5CJF9jU}_N+||JA zcqgadn3@GL(3aiSS=eZpjInj|eEK^?_tMrK&C?O^ZA&3Aac!)h-u6N>_! zwp!ytJ=(?ydU?Px%oZs0i>mGV*$7h>jy_*ty4iF}66ZP-)D6ZoBX8B}=zI3Unh zoLh6Co#68!=JSy5v%2F~;e{?#z`>y)5#*C_&IgWtEm%vp(=~r{Qk}Gz#COJL^?D@v z0e?dh38H!l>@(0|6#zdTcE8;?W3O$cvt%uF#sJ0EYZc;6ETMyU9~NEB$c8HR5={Gs z02~krzZC{?;>!@{trZ95RY#Vi8R2#{x#mW!XJX7E^F77sz`51}?r+_l_$=BduxW7q zkEPX#p|-v@*Ke4kgX0KSdk)F7x_6d09ueP9-Z_vBy8=4F{TzH*k(*ezLvEcyuy=#U ziF11KFNZIH?v!1kuSF6ryXYE+ z2%ZJ!cHk$37+~u&RfxY@7M?}kVEo=q9n^7FZH38&7uu6bVqQTV^6z~tJa0p=(AW0{!z zQgMW7eq3vNQ4T<#@Q8cC>>WOH8a4i^8#xeC_QaYUwZCfLIs~9q9sMoM7%s~=+6`czX5-H6J%icW_4J0@SrbIH6Sm^iyDHd*UMoP~ z9BA{tF+CYZx|^Y6C}9P14!J7%VR~tTcwa!Kc#cPCDvS2=?9ceD0EE!aEMRY5{fE0v zcFcFLFV5gHJ%ZB^uj2L32k&)SDAf6XU6Zoe_h$*_G}By8@IrIGZw44 z9*4H>g7Jz0*~;*geHdtKCTDr>94?vr?q?qO3vSuHlp+B+uqTja|F-)2B0bte9xOWS zQ6|t4A5KnK;2o9gJ1cMS)I-hiWEE7aeE5+Kcsn|OWvvOrrp_%=HUD-8lJg(!c8VN{ z6;#)(J`GbMUCvDz{h;#h$!@spbB1y2$ZNcD+b|uBN%cU#MCEvhX6D3in_S8EGq|8R zI=#8>VGVU!nHW=Bq8IPjpGXEfFh%zC@ij)k%;YlOowEZH(cZiIpWHdrjL};aPJsfCwvt z?vfjDUtsUzt%}x>4qXU&_<^%)8qTz?XU!`Yy$^x5xDM>Q22ak$*EA={E>T-j;Fi9S zGhU#wo;Jo=*NLDPmu)wQQ8l35qPn?Hi{rIp+^q&R#=!vPU3zXAlKSVv@(-hoOJ4H& z^1O~ZuC2XMhc@XVv}4?0dLs-cDy7ae?10$ZP`ism-ro`1Jf0W+vF-kGX-~0lp9HyE zPsGEezlxv4oYCm;cb(=?GF0~64&WN=tXHVg#I_zQ8lDW4%r&$1QWfiRdTt@T)X67F zr%?Ffe~lg)i~4>BI%1C)sCpS*IbMD4Z;^aRettOB2cUDuR^79)+#HX#4UTQSvrWn_ zJ7_6eo`qn=HrXf#YJUEB-sJpf{pN$-kmz~N33=}$s=1u_M!x4V_)#^nqr9fMY3gb{ zS!hJ@?Gmr#R*FI?Uda$MPJF%m1mPau()Jo&^?v$%>z=K(*^6pCu^AtPhydi4%t7_8 z$|e>3XJWJVg1k*!{z>Zz^c3VB zZCW_CW=;XE%iUO-4t84jjCs6&Ir_UR^W4)hjsAGiC(2!69wFe52$`RuxSLU}f|7pq z<+q{IfTg5PenT5yUGXE?V_adw+-S~D3|EGnP88P%;1`wYfQu5w4`fSU=adg*Ny~~q zF2cFcFL$oV*X4P0%6E@6FKd*_gIi#Jb!7cdWKjY+;)HHRs#e)2Qk39+PnucR`FUNd zf4=1*g5evUvBhzgJ{BJH3twu?)XFqD%T4nJ$4wSAf#W0JrRMe7ipGitBfz{w=W&AL z19gCYZ`e|JeYoIwfL?7oA~3ylSml-6s$a7|YYBhwyxVYCCI2&}uGUr+eI1tfgUa2Y zcuCkcJa0+H+K0LWM`BH{L46uy$2w0F%pT*85_18{`?;8D?*Px6I>umqpUuEdG%NdV zDE4@e&~j$b^(7<^KG*=Mp_6A)%TQ)viZ|wj%X?FJYQ^eDo@MPweehz~Y~}*?AdYY) z>u~gYhq~Htn0-wt6iSz|2( zna9%U|3qrD(FPGtG zNxm~Vo=KgPGcqt4sZ*O$1|I$7Xf{6k(wslzW@4ynWMuKK8T z5*FtGKL2~!+SN^YNoQiO_GCc6H`as_eaQx{njwd&P?pQB`~Y(L25kji5zEWw8LuJg zOrvmELHzgn9`%AF>O3}`Yp2W)u#MF)9vGT$fv~dWqVBAPqJ}g`$+-m9`>>;@vgh@g z*ypb*3{iT*-0A70RJeUB6I7Mh<^`$Pve=7Oq^6w3P0>uVq|_Z6No$QRT(R!R^9psk z#ibj&9J62>!5K}><<*NbRw*!V|=6hrzq~DNkHB6jTaIRe4xS5y!$a%EuC}%;MraF=eh%u1a8s;$n%g zr~1L!TrKtKc*{LIWZ{PHJI3y$eA&J4b+E9%v5nnfZpRqV>R^8>Q<*i1HtCKqTxtXn zkPL?-T~7&cAX^dFx@B^lH#BhEJ)SR)RlNk4cN zJQBA=x!t&z69A+DYEBw$V;eCVCT>P;V#Q)Tdza?}=hGp56vHiN^=xWG!Hd!669BR2 z8gD;(j`k#d+GTSv5>KXP^o;Gm1G@=afWa<~fD!#K2QHFE(cqD7zpPrE%NC213H9MH zZx&P-od#)Z0s_TF%U;zSYOR^WjF^KR+CLe~hu79z(IXh>y>{+R)qYY1^b?yiz#9uo z+zb)0p`i+CDDR=Ln$xa&P8dAqX_ZXTk`hOU`$xYWQ!-6hnx>{EBIBgDmA{wFCu_8` z$2)(1)M)TJ2z^3Q+~G1g7@vboCC9{M>%(H6qjjjbX|BDbJA=L|rcZZ$g2LKjdY6=x zT3+hZ)TCmOCD*#f(cv9bS5eaN-Vd#=O{UbHVX3`2#`B&Xu}rUmfXu zzSG_Ll@oIKe*=SAw#{Ky2tS00uMJ=AGZ7IzKR$1WX~5z`007pG4sch%nX~J6LE0Aj z;axo4t>|P6(OeprQWDP|DAZaO(?zv$9XOQhHVQC{$cGvu5fv9n>Fo7Ju2YpHeZy!g zLiXlbMeoD$9G^q?gR_(KOq7D&HhFvwdL=JSrQD5}N|-7y6Hw|&&wSKyVfTC@%MfI1 zZ`M2wUgdINGcrt7bi=Rb(NdQLx`;qGWU`g9|FDRQOJwyCX;GgCuXzTgjxIGhi2Iu6 zcCwd3z^$-bv~`SD5UflCuDv*w{*mwVGvjlPJySas~k=8PS@?a zQXSDm^>N+Hztr&6UA1+ds-UlBc5HA*ybL&9-|P5f>h&Sxpx~oW`zV^Q?HA9q0n{p4 zSC_b*t<)&7lBPutto9n2aJwmZS>ny=$m^&T(Ng?QNnP4h7g9Z%%Hj;@@Hmk9HR7hR z?tMW!bG;7ke?@5dl+QDb58PTE;yRJ|Gb3C}tLg#BmXuj-#JfY8SZw3Pp8%PFUNv87SX5UOq8g?PQg0YiJH@_QR1K zU)892?b@&nfFx;2ORt&0Bo>yvCHeFjjVgu0e$`p}0WT5X%JN#t!M!gOt9s5WXlLB5 z^`5OZH4Qz=UbVkb#DHQE<3?EZiRgXY5Fw760^{a*Xb|shY}wSeRm)Ru6ooM}{O(GekXqKh3-J~qLZQs;tdu+N7!Qcb>)S%vwLZfgWMmnqm zYf7cU!O`idS0mTYNu5L5Mc8CV2t^#-qFb;M@`RrS-_S0ItAZ%AJAZxj`tQv%qB6S( zoHY}=V)mM7(KLBw&Jb2JI0kRv>Za6`n5&7jQ)dj6exoF#Z0yev8gd3so-`2gx)Dh| zDwLzx%FakGx5UXPk#i{_pUbo!gQGSPZ^*_hIJq8nRXQhivRTD@4^ zSWW!8;@@ewrucgQKIlK^f9pTyf9k*XkwDNjBxgj6Qy$MIktvZWsUx9tFxVwocEJBe z@UuN|t5BlIN+Fz<6LLn%wz{*tB0OM4u&XaGC=~x?(ojXa#mw6LV3v@<@M9-jHmv~` zJOl#W6>C~imr?*pa)5UiG-u%UT5d{*u_Ur(SDN`N$EkR=;`@De1HC_mVERYw?;Ej1 z&87B164qNC`tlO6U<;AFe$jiGYwk3&X~}NRoAs8Px*MiVWxJh_&7J3a$E822uL}J3N}Kk4oRVn->@m0HtEn&LU-x|s ztmDyL!n*jMKS&D|Zxf7*@f8;4=kX4)nSF<S@2|guJGE!&qV!|uYXZeqvKP*GF9?+Rg>NeFj0byS~_kwXQ8Pwd%R@na5pr-GVFtL zSJpFz;e+Bu70OaDZ6ZNz@vF!Bd&-(UT~9$)?>T)R-u?aTPC1gh#-d(Ob1`9PLi{LG zsGWp`=_s+arI_xA^G%av9G<~1BQ=24(XJ9zk?s6zrO6vC5*lx4Vr*jj| z;?K7%trgUb@^rX^o_4|Nzt6-Onsw!E9NlA$LwPBKYGIYBk`rFydAe=6?{)6pR$xzk zuD@rq2h@yK5kgo+%83RMv|JP!mFCxGNi(Q)*S>qzRT&Th?>`G>1wX_J$MN235wj;X zI$Uo31!5yHx;HBaQEwej!1s>|81X>z$CK}{J*4&j25O>l+`2y|QfwxCsPh%hRpe-A zQOw%d7RIV^JnDhN6NGe5sc7e6^$^PU(gEf4=9I{x#eyko-0cbM9A2OKrWRu?@^IbU ztCE8x{?mc7;FP_Gu{JFU-?n)NR!t)!yOvXHIhqQj+%!tRcS z=u2v)Pvpf&T{jJ?kn5~S{yb^plAf?@f-+B{tmC-N55Y8Q)A~(@$?j%150L~}ZEaq* zs?CUIv(Wl3zyHw~Q|Ww8AGp_bZubXlJEhcWyYXE{FE1z*EwelESzoTtJZ8PT9Y2%= zEZ5-_CDUmvtG>Txhq8Q2=~@lid{ju}C(%ENBuxuFOZ#$6fK2t`DhG+QFp3fll&k84 zqKsK$tQr__w5|S0=}94U2Ylt%+2bUx3|VK#L>=YBG3VQ~PD8Mz_B)vJ>%ny8O#$zj z=g0$=d)?b)Emg&2I5b5Lg%gKj1pCe6-vhOJ4OwKE;Uv+!tJr!EtLKvN*C0!rHB;}v z@&CNMrb<*1&H<@kz^ho09na4mRu00b6>~7y)C53q?<0<$#I$1&#>#c;;@npK)9#>z zgCJvDdsVVOpy$9+9@JuxVx+HTP|l)Rcc=6+ah<#&ovBw2Sll@R;5JO%h9}rog{>*6 z^b*IiE|SSrTBx&!A5R~2tZ%C<9?acT@L_>=cW{|+;N_{v{L;DdI3Q+CmzQ!I9;Qrf zzhR+{*t-b}FaBg64Wy5kSkpb4G&TQv_eYHh6Iq_*l7qXj4Jtb({P{=V@}zfS>}$|VYe^HGr`8T*&CQz!3it_ z5!gK6+1nHcEtxWxJm)NpH-zt4?*t%;*787`DL+|0e^-l4{pD;qP)=XnGuAcQK5D&P z4u~@3UAHaSHPP>&ryUVGLsc52Q|=O$CKQM$e4m*GJP!IpCQ;-u%i*|f+A~H@BhwdR zIQDrF_Ic5b`=k~+hnZ@pFI?yj^foKQXX4t1AR|rd>VnKkN&zj&WNi%z#Sb7zGVjsc zX!Z8D*}#WI2E*A~LqVI4KXVA16*<1=p|?5d9B##DgKpl>vw%mnF3OrPeNlvK^FcF~ zR9=<*#aOpE7V$x zw8Wz`4RV^(q*kk2^t8;AaFa5IJ`6Z0_Pxvm6AW{WpLUq^J%|thBs(TAkzal`5d;Em z=eDEc9e~Z|12uoTz}RY&jb~RQgvFfaf%mU%ZMv0C^iXP=-S5j7quI0|EAeVSWh;RwcznA z|4J6}N%G3ZvTxi?!ix$s$H_rM-$-Vu2~nQLpxD2V#C{7}QnBH7wKqP*l5 zQmrpNvX=h~a@8Mf93>srV}k?p*ZGn0Ms!{daCsmdWiy&zn%ey0_9hz|C0o<<5sjf@ z5R$%#BPCGG-~klH*K8yR1UtWKtDhS`(Y4v@ ztpcwPQp)~-_tDQ+^wIpD!h^qt%=$f2_mnPcGUF&*mBW?Y6^&x-C^J^Z+V@Xm4>Bt4 zv+`z2;}L=#)OeIVN=8kNN?@qY*XDPBq3ktAJpKZFdZ5`^>mW~)nQPT$THA3a5Ud6&l5yiBf* z!Hw4)99sv?bkO>T4H+oH8u&L`<9WCa&%2}7lhlw!0vBRuaku{AgTKl>S42z-m+$+t zg)c5Oo!>92qh;E1-7;C9EqGQ*(@HMjwG`_IEn0EzncI@>bRptHu4}Rn7<4GT6f z$|T1d7a^yYspc*?IF`!*{t-Y)*)F0HpQ}qd0K}y6g*+5`C*ACOBU<|BEzPx{XNj{| zk1z{vxZ_;I%6-G7|aH;Wr3(m6(=%uvHr{cnlei$ z_F%CYybzop1g?pm5n9-CPVlT1Q{~T8cmU#zyJE*Yy{<0;_l!!bEk&Kf4#8R9rkU5h zeh+VLYWrZ{qhZ9NeS6XR?LeF%92xUCHd6ba-g@PYOeWG8Gf5f|My$a##EA+l`C-ci zw#NUgw8(ON%~~WHT;`0au`q3#?o2gDVV_V@APR&7>ar-}Z!7Vgk_WMM-)_q3D6J@I zC~nIAAuEB=X_u!rH-a{q@wScDY%SVK5k9D?hVqRQ(GOOQFrNULKPvtr7f&T{3@vtR zb3X?mDjX2twp&l|TSfGTAh^`uQX32|GQI=sI)v3J*#5P)Lpb(@OO%`Th6x%T5dj0H(vx0+{teZdLNNnW=f`9@TmWgqhHuJh%-f*gqt#+#Esbk zfvS84CB?;(7K2LoH4(8K1Cpap3`6cbc;9tKD4N8zTrx$nl`>1La4O5h=uZ<44T1}lp}GuM7<`91du z**y0~cdPU}$1yli1Evn=?6wO*pOS=5qr#&0nv=xs|I2ARg6;^D1lQhy@)+D8KX9AF zkkHiVVSoWLS7`N*>&Tv+z20^m=3YrLNAVbAuu)Ig?IZRl z|HS5uCoIEr5wV;F2<}PAWxJVp$%X+~~?T z*lfMX*)n!cmKkW8O-#(p)=$(HIl7W}@n^;-rlzo+{#wAaX_#hCnNhTd8V#7mCkCEn zJc#W(K4nL0e9^-pu`|L`hr1wEAQcn^gp}d_1`15&;9Zl}Gs_oK-+w6-hp!fg=iV5i z^uO9 zR0l4Eo$Hq%313Lo-1&trmxeDE%VfEu$Bi4`WUm7|ls?kU$?5YW&NXF`ctSG^(`RNE z&@ZK*Bj2UHLAxU?=4uv({Tw68U1fjHG4W!!F4kQvTTjn|5n{Z*fY)w#xi>z^7M*zf zeYRvylCh2!NJb%j?G=`|h46VLg(aYUyMSmXshmh;>x=TJ@D}{-m>IbYcTkjpzc^&a zRBd7bNC-rOAC&r*k=;w_;R@o`z3OWMDhg$X+J$+AgrSjDQM3Iiy(X|MXnX9%J@hIB zB5VCU`Gkt$k31MuW?^~7LJ_y`oP_YFT`6{U)$#9(YQ5+kS`jzqXam{8#!X2STf}K* z1&~iN&^q5Zl2vTc>qBQ4?Ai1@#3P7_W|%9MKj-^|FVFyb)}gM}@!wzWZkV-406`ij zK*Fho(SOYtS>%JT+)zPn+#=FfQqPwMUURJc)MC@}%O&n|(uB7s%u8(omslCRg2&O4u!Eu82R%7&;- z3KYTP9mE&mu^e#~<@@DIow@2-UfjYh9I5@OQe;gr#v76CG@-u>4!hLgPg(Cz@(E4W z8?3{2iC_A#jUo07e-H72(fOA0Td~>7CMzu1CD^$5A?@&2jBH!M4QPy5AhY;q`|VSh zNMu*TCMA_tN)r0~J!{_`^$kOKU+CT1Xcms`#o7ya6d`W%xP#!gWAKz?9{ z=-en)>dA26G*73v8pVE-;V@?sv|Mn}vkKsTq$CuOJ|Fi5)xllOdI)*eXB{S`;us!= zLC~7ZOH>l(crucQU_hK5)Nv<5UHnvbPt88K*ZP^#{%8^D$ z?z>42tiu)srqZXCPz04ednh8POBX*;$=IGz@N*n~+rYt<1V(8KsRjw@5a6X`ie=cV zw(qjc4i|Ace7|O;c+6<8Fkd^PNm}VHI~|K_J*<>Dk{uo*8RT<#oz%E*le_-C)C|S* zyxb{FXGXHrgFkXMmKjGDgx*StH9`F)1S&ZG&n6#PH#c=izp-TI9)5Eio94n>TpR^! zCODyNt)HtfOpDjQx(m?lP*z^p#uN3uY+v*`T6!sMTVmEgep@uj;(hQ}wCTdLBit_N7xniL2 z?NQ(kWZ0`#`0@BW*ZU})4(d&8M#D@sfAVz8TDD$d#zwV0WkvUH47{m--H^p5#eN^( zLUm|xkWO=PJbS}jY!3H)VxhP}GMk~|_Y=Owm(IPOexZ&Dd>g%zSv>;796;(*=^$`r zqF)(qXQkgMc7dYTmA99djA0v1LCG+hg_?w#4L2{sNf&R4w_0L-h~5y-S2~4y339K( z&!ku~dJO^$@F6j^{mtp>XU8R>CSiatFVZ^7Ub3234aTwLS$rrpaWO?jH}1L@{|lHY zg8mqVIuuBzhvk*8{?50ZZUt3Pv8tt~AZs)ba+UAlEfqp{jT0lpK5wyvV+B~YXkN{~ zg0!9}{sR&Pdlwq&89M>YRp-)s$Nf%$owyj<3aR0-3nea9J9k%T9w^yXKSkg z;52!h$x)-z;}FSGD@^oZ3~8&)!)%f^iz z?wpw~u~~`434fp0>g`AldE@cHi6x%8X(3E*jf^+uk5>TGZeKA@))9{r%hEnxR=N0 zP_}cO(yka53mptZF##7_H(@;%ka0&uUN-JHwn580J%gVovJZ`yVR;G*hD}fD;niix ze3LIie$HLrHDN?6LKUC8w=Ln*mVZPM{!sfqM^WNB^&On4)$?mDzM3$6JFCJ|pq1S@e6Y^mCFEBf`R!^-?Ezv?mmO*fpg@~GZgb5~{k`S^~J^n-eMn+~oOdu32Ltucxj?|)vGt`tfSi*+y{>&X1n z#PP|hnMrQbKeQ-5iiFNh>KcI16mOAsmag@nQD^&buvAV5rjnBz-%_S%r>U9I8@|$; z{j6BgC#u=#xHE%~hC2?85dG5a&v?#n4eA9Iy;fJtFBp~$W@F28588&5sgR{|A;tXZO!5 zlXr9+WN}+)R|~K^9FPrUkd1#RBJ>9A8zK>m4iDy(2;&t(J%~YWGZqn!bt|3(WfLY) zG2RWq3!d=)B(P#^7z8a)*U2CSH1V#)7_g&#mKx%7QNURjk-NSS>>u|*Tp;tvL;{dF z?JGNA!qB#fUr>7;-lY58a>ab%U}!Yzzh(bdlQ%OEr6X^fHyB~o@_j|1(4QNE={nql zX30_nMohT^F2*rrT*KzzjllsDVmu{CIH!@3VFZGB#s~i)Qguh^i$IG)eCgS-sR?{O z^3iBVrJXk~R$w$@RxG*fmoeucA63>$jrNx>Fq5;~pV2&uJs#9_L3)q~p?Y&zYOzNp zt_s1(dE~#57xT5ZJHbY{W8nw$8f)q&o9fYOc@(!h-JjD8zFx?`nFZgSHYjto5VcJD zKH4%|vmm{7wa@5H3+ktNJ>gOGg~9rKXK4C(g-Gr-wem!udbgE}b>Cq6+5R4}wKGEB zoes^DIBI|CYIM%S7zl189om)gU~q8TRcS8OYRV|J*%y=)RdUWSwRNx4x2l?vk2>x-(&c9irq)f(FhW|UeA29#6}HS~JxIx4p6%Um@zRihbgboP_Jy8ax` zVVSVGBwATn{@zEM<3>$7E&)B%2E>>B!QwQqo|w0%REdM(FIUutl;9MEs5J1!GXRUy z#?lHAA6NnT3pz?6Y(pDm#Fn%OQL9SvTjAFLGNTE$8@VS5d@N)GrIQcoJOFH_F5C@1 zQyw=d0wIq|*u=Fm-{3Z~%{XLYNWB$gHMv$Nb!^<}qX-aG*Ue{#g(U>DF2ws|6K6QOQndUIn zmx%AGN+Ga;mwicf%faijM);+98~=QM|6h_!Cc^{7{~wk1zf9`?V|E7<3*&!b&;Ku? z_8*nT%*gWpq0**200w_m8{C%pUSCq=J9x6aZ?A}q^F{mw3E>(75z(0#!+=3VjiEA0 z384eSD8t&0h=>UT{RRThC<6}!F%JhIXYvROV#dM_(XmEH^9)a4KC?HaAfslwetQ_i zww-P@Fa9o$#?I_(zt<@drs9)2^O&gM?vJ^w4hdd8`=Kd}DanaR4J0InM4 zD4t5^_1rM3%=Q>s73VROQu{j>X4-bpxWb)ry-#cyeaq{M4pCSZ?Lde5&X0U>D- z9LXC%zMypIJhanWVlf4Vq#&EM`*B@ONGGbXnRbWhR}tZdZCk)QL!y zGaGSxdH)GCJISM%R`RZja%BY!*h~9N_qu5zGew%df7oL_*Pi$&Um(3TbD*uytJM{$ z5(7~T@%!4%G_eGlvd}4_QRqL?V|fopHU8nmT|w{kl3yk3Bnh0_4zgN?3llO)z3hJD z4V*4t$XEk=DXQtQm(`uW_Ob3EA}M49_*=UizU(TthY8I+S^rG@*Y9T}ZL3LWvagpY z8IDS&Qsu^NCwJx1=d>vYz-U4IXw8Sz;*I5cOXwdJu#Q71IuY8{29xf3ldziRd+Z zjJ&q0M9r87+@%i|fZD13&yFUJNCbx#UdJC*sLn64v;R{SaZQ$I5c|{(4^dQYKZRB^B zaHQJ?(;c(ndKg}1qh5eiJD5d7%%@P-|2~Ej*laO`g=l>?|Epe5FN^PKCFE1mWBz(h zl>S)Al!^_EzAxv(qJij?IYX?sKvtT`cvHr9ka^-Cjudz*wXsZ*z0Q)y;6zc2r+=(u zAVKt$JAHsDa{X?iG3b;(8Uy1-s0C`3L@ANG^tX(+6u>v;H~hL(bWU9H@^gcYw7i! zA9jHxVuy%ABcU%HX=O=m|NNjIv1GiTc0-8xyy8WKDp{5&pS`>Y(CdR75X9H(DD4|E z2hhwtgkOIc@-DHhCYJ)S0C3#*yBER1As7Bk==u!TM`l)78dnk)&A_JL1(N=*U+5dU zQ_*T1%|qR${S2@ij<*Ox0Yge`-Y@RK7G$4}Pwwa)`%n0&14GRblQi%(^Gfw$Fs8Rg zz5hxsnfi!UAhQp(J-TSUKaEEEsL1&&Z@NHV&gqa0FoZF8L7F@8%NWenY2k;8NA{25 z9{D!b8(S!r&kIma=RXuHdmqn#4)}wU6SZud>r{34M<93g$L^bvueO|r-5NZ&b~O3p zRBtJI|Cm2s{;lx43!N7az!LC+owDOnaHWCA&1$fLofTqtL@Pf#OAl+3@9Pv@s~U!a z)-{#aAr4$$TPnu2bi-A5E#mZVa%Sz1tYmic+%c(HvsU3U5#Qm7<(VP9DFD6VSH(Y= z7@1P;po5|lbwpXE+LE}+=CO)&Sg?X1`mehcl8%^VM^&hiUT>MtA8VY4moofmDaSN{Y<#&z*~TMs*i$K`@pA*)_lo z%TLy&K7nEF$vrg9hneu?eIkP%*6*^494HPtU9s4{uy*9C>m91Nx`naWI2Y?{!bTwT z?0B|IfV5ePD6+i8KhO?BDXLTEgYDyXQi6kVt;u5{&SHd-xB|Ig!Xa z)G>_)qU47EU@OvsbQ^D#$XykD`f(7FP>#}jTYxt$VK}@oX{hV3{Ti6NLEFCCUNQaW z=rU&6pnLnFQQJZ|cN2as+|x(*AEB&D7tW^4{q@_Nhw&reA3J;}+L+!vL-C0T0S(^` zM91;FuhtyJcoN&=%wtuo@U8H*e0%O^<-C*1+X-V4Ee=D4tJ9ULkE6FI%0t<4z9BmY z@vujk4QTn;V=Wmxl?9^p_xk4*hd)wtk4M;M6P+$aq}1UmJ3{e637U6FCh!Fd|)cR&v=dwJh2eC^^+sOk&ied+0Mu+kL!-l7sEWC z*mb`eyQ3li{V-qXy!24pDWYQKb$mpUlh?d!UM0AU1MKC$K_+orQC@A=$mB!PGjVSF zw%FO%@0{h9#*_g{Ga>fk6|U0G@(SU6kfQ^iYc}ecl|N4UBCG(F1vh;H1byyV_}>MC z9}7*LJ~Hn?VigBbVNx65PzLgz$83ipnJ<&}7#JZpuqO3#1Ydy*zI`&Jjhyt;9NXju zwTxDEwbvRee?pj&|I_^E4mt8i=Pzd%>Ic_%R_{)4OR-aAh1unLT?M1jSFSS%g)PU*&-Ab9 zTJU8+53EwFd_|K8mcjQztJe?hst#QGB1*p=O-RIDx; zJu(hE`!pdy8`7iKuhPgb;pDHyZ6%OE^)E?XF7Fq(qaR1n)3xfD9-pXh#W7AdylcDv zPdHOK#oZ>m%h7s&>25ryn=c30kg5~QIZ9e0+SS4>uAV4V(>J? z{vx)~gKn1LJPv|ZYw+q}$s{C)F7QJU?LzS~CAu-`Iv_nQL&H7f4ORo<90&8yd_(g= zxvC_iY&VMK*$D6IUyT2*ml9Q=rqDp0=Q<#4yS>}bdvREtj6xSMtW)U5{ z&U(>!GRkOJtv)#R+H1bQE?DNGP61n*iT$yo?${)>EMD!S(ubWm)}2#NP&UHaRLy5z~nS@_=iMamV;@sYwOF!^7R;lBGjSUzC80nnoaP%I4& z_jJg&#P&9($~_np-MPRbgrr_4YSEl#^v9Kh6%8gDw8G>uEQ&=3cYo5SsXlXF)8W=% zQ%e@&rQ7{?j=U6tpf(@SuMe!ZM#HJ|2nL8XV#!OH6ZS2Dw)XTsy|eW& zG#Z0U8YPRjK2Ip;r$5_ZKQKf#%ug5)xk-`f>v42A927Wz8-yBhC{Y8{0s4vevZLx4 z_M2$jG7uC>8i!*1>S2(3Vx~0S+SKCU2HpryC)D>|0TTE6Z@LS6pGX`(g27MvFJt=~adM3E`ip@?o$$j?Sp}J9R84;zU*Xy! z9hZr-+$ne?|8b>*hZ-R+hoSo?DxIa`o88Z9>`>1UKwwcvUo|lhkD>OY(#>syY^YGVSmSpz*1dO!hLdL`W+D!e<{^TJTjS%L8o=79gD+E8|naUp5x+BpJ1Lc1mWAGmC=9e>bPhcgcf|kwU z+sTgDT-B-T%N>=2O@NIbeC?_JimOmhjg7Xq0ZwiiyD#ILt&NiB4@c2YQMH(fq`v?J zzoi|-qDG*+)n*L_w3ks+N}s8S9(0$vSL(raZS_OzgXI&Bi}hYRI{?J(k15y>K4)+v z^uThi*Lx>PUiM+}x3d5JW~ozMLi^a*gZ(HXmEv@>i3=!fPY+a77x{H2*!0};#A=xb zl$-X$yuG64jkdc6MksuEDnfW_P1vq35`-RZ5gsS09xkcgUBvE6JyQHTyh5{aJ))Uy0jrOPICU|(Y_izeD_eRR*aH3wlCWe9zQf5uq zs7pPQ&X;;fSu9fQ*}*?u>$zc(4h@0n@@jo@d>xE@K1{NeY8T5(;vub4cLR@v7eDna zI}EEEo}%jcVed-2`5PY68||8!9u5(0??{bnmD_2=${PpsO2c73`1%IDFD(ojLAzje z+TP7-x>{tn&SBkWL(Swirzj2R2$^m}D015Shz?Ap$e0c4dJPP>GsFD=MH`{AGyw+v z%-Tr6djWVM+vLy|CX?91>BsrnlsjUd>Dgok*rjWZJQcU9axc(CC!N0lPk- z$X_Elm*g~mQ}N`qnCudYa0_{*;>hxjw1UX-Nzr0@a@Fwg-iSH!ivx8e!vOWDS(w!k ziSP(Y2bN$fj!VNV^{t}FdL!YcdU+;t(I|Yh;^-QT!insSGD@WzR1z1agAr;Q(eAc- zY1q|aMqOCEgO!k#NFrONw+KvUF<2dP@FzDb(3J2WTL+P-GaT}Xu7X&ZCwjO=kIRB4 z^)NMTa*yD!9I|<>Sr4TJ5>c9Pbh621e4>I-h3g$U@yi`uXHchYLs5rS%xd?vGcDA7 zmuMt0q=8K`@kh0AddwSS5@;AhFD0#izDkHB5A(^nqz~MkOKRK(&0yU;i$3E zuM`iri|NFbYD9`ex`bwAZ-U{CbGVwA>E+Sm#RDIBFRT_ zcMl+`<#VNkGkOK9hAGBD$sxZWhMFoM6T$xz=^eISrG@_oC2bxOWZKCn165ri)o4kc z$%tpX3sYf=wjo5WUsbUJlOJSB45iSY*Dn*QD_ zf5C`${jzlL;JysHJ<4(A-M71|dDUdw79$nZORJ(Q%T^2nF5b!y^Bl^b+FIj;L;~J; z1(BN;=}MDz!bkoC|M~LqLUt8O@_Pn?%pYNe>g(bpFJW6rhR`yylF|?fFi`N0;oZ3K z{^h%7E+c;(x@S=lgW-s!I_C#0s1z6fD8E}juzS{*QaWOU7mTsyNffm&lA?RU8aq?h z?tH8iDUcI%^F9UDD11y7q4WvVb3ci|=MKeFganX%`}BzP{zm=mV|@ebk>10aW$p85 z`BeH+x=@;j{?u&jqWZs~N6@xxrOKS7;j$5v@NFt*XQA%LoLDL-YxuM1Uei(z;W0F* z4E!Mz;|Xe?15kH7xi_uuI&Yo(c1lUlJ$1Ymymqf<*G`twbo}wS930kV38sl6At@jf z<~M6k;M_=#y|LYnj4TKwXkcL;Fjj+4g2S~hP|#f0zI;0wWHH60(6q!xf7qHpmjnADd+4)WjHO2!tu3o;_^(dhjf+p#j zFDQ`y_y3G>s}hfvzo^_0Ke~Tt?baO29DRQ{FltCNx^~!Kx!Oz|v}@f!Voi9on+=P; zOu!~M%+q1ZkIcX>&%m{$c5%tEwEQVs2izY<*4!l^hsS*!Y^KidC+X4`*3NA=YsYgy zKNJ<4I#xg>U;sLW;M8JFuQ5h=8EUm$&gLpq8Jskw0061k_~Vb;<-4rhp1oGRj@KM@ zz4p_c)Hb)+coJ!k80>1bt|!_${Y1GS?KNysjc+ z)G8K|yYi2k7rKU1{HG|pfPsj-tSk9-u600m^4C_-&>uUc)dSmYIb9D@a&qIRvFRDf zrG+w?7&fBm?P7AdHmiYC@nz1Fuy?NYbE@|DdW&!>sQneM3ncu>m!zyaXBqxYIkK79 zjErwN#?Z(bSfttX>Z|3t5Zbi%3Ob(zvXr+og)hdNJvnfv|8^DYM?Rn*B*vSsxbt&QGJAN zzlT#j)=zgIDhYfC9%@UYKFkX`}`_bmOB*d z=#q@3nLeg^X-jhIQXu$_)|-L5u=Rctdv}a~^Z_}OU&&(Sp&u@s9z3U>7 z()u|JhOJFM5%1Snc>4L9Q~4{R-|vR=F?pyy1b>X%756Bn{Fi*$!hK6+gc#wJDpGre z^7N_K;6{nFlJP3A9m2dmfR7Q2z9)~1^ObV9>=%8BLvRM*?_*iKzgXy{7F;2yiIleE zEZyJ?wG_E0p#C%Ld(W_OPGE-PV^4K6#<_)bjP@wc3GL)+!^)23hUJds7B*vn>r=i7{CbIPqjjTgqfLT^GPVrtX-Fkp zMG)dV@FqVh19%OP6+b#e=9g4VK4FQsFh@~brC4(bS&1nLT8SzNYYAcO@_3wN@%b`v zC=M;`>gbk{xF_v5^qal$t#a~Il^wxUmc;CRF}*+BWOSGka7 z$5axuO!DX6HsOa}SXUn0FSA8LeR%%B4J9%r<$q|=L*Gv8L-PzAN%LRz$W~)`|OwDej%|n_PN;nlu%Bp8xPRPtYMN}<{jx9MJiTgkq^i36V zb|5IW?b%BhV&Zdb83`G@)Q;L23lgWkQ%D~cy0z9B{HDIcC)WzwJdT%?*G)I8z3?#0 zy>CZW-?vm$)|2C!F0TbHnwlX#YTz@KDov4ha_4`qWE>Y4C>Ixk=Ez>SPZ$1X*@tXL z1iEwvv8?A1eWSd=bWn`%cs|JTkYeLT6_}1w+14hc6tra>-HTJv(3HwmR%I~-E{fZ> z{oAB(-rFzt{W|+pczhcnN?v`I0RYT)&Nn&kmK8i$X7{5X z7RbSFFD$dn+|CyN*cvt4i%}BmB)>v!pk^2(i;UZX7s`o~(zGpYdFc1VbMh}=hZ`e! zszrit7xhm1TCL}0^8(^JTg>ELn`Sp_N?$rmg! z&TSJtSWLH?y*8puCL3IryT5)u z8CGv5W~{ZGPAY3>wswb%XiTTd+5j8QS=U>Anl3>vRKt7Lou3KQ^)fbHK^IHKN-aml zGh9lKEK@aqN_mo$b@NB|2i`IQLpPUPjs7#KR(Hy#8HXq(A=4|MzMJ4o#@*6oov-L> z^$)6!@^^UU=xD z3MYwcEzH&kH=ZaoI)6v4dGjM$0N*2}gj# zLh=50fk%D}-(Zegt{gOc&QWAdM`sf8r%I78VM*aMDa%tzHv)s zn{eCYtwoZo<#{JbsVJCcX0l;`u#IfKl7nrsW+ALdX{kKcemUuvrLvEXxXh_lTj*-Z zVKrAC*mBK+_p`r0NMDln^o-HOrBFFNP(IRJd03002G zssgG$&1N8kiO5>*U*jHVf4|PO8xgy?TI9Mh>Y^Im4m!#~7i(2Nv#Ca)%~DWAs^Ijh zk(X0lPtTrR4|WDp>a=_$67vRsAYa_Z>N=5)G}V!C@tlr16ABNi>e`awP5BcmhBo?L z_JpHeZC77tQl0i0Iy(M&{U5<{AHTw9@t$ac`C0iT47s`43cDs=suSJuW59<;x)t$7 zd1W(;F%d?wB7wdKt?Fjg^1iB$jdl)hC0VB~5&E#`zZlBt_&8%S3HJht4STCG_z?cV z_DSf@Wv1|!RM=V7*WwdKJ4-E&+nCRc3`^T=UI~ShM}eQGvk$)C=&;B9oT{rO2sQee z%yQVJT>4y2hpE+G-{bu2{F;)G*I&e^W1M|E83W(?q}#|yU7<2iu`}pT9kXb(V}q=7ZvOz z5;JpV5FF`N?*q@zKl=T>p9LfJ5uWfcyHc&R9{-fLTI-W8YgD$4SSV$&FYx9|9o3bD z1S0j)c1dfoH01fjC70BX8bCl>Q0~5-6@EUk=|uD`D+p8xRB@Esy-)HRvse+-$^Az6 zDC*};{#KFy-Uf4{dWI-c=rAa* z{h$cHrmIY9NGY69CRrc=U-5qdo~r?}p)q+Q7EH6GRh@85lq@uk#yk0wDYTYn6?a@I zN+VdOKl$&wYON+G>5q1ip`a7ej8#eeY|K3%tl1rAHS7&r<_&svYb>LVE9G4Z+N5o% z2vb4QFkvYro}(2%%ZK_+J4#sJy&-{ih2}E&!ta_VNJQ0S;#OLO?TvxL$`Ol#rs8*O z)Q-De@>j#|fO#gf&dxozl-lif>&4y2_bp2ZPy_QyvSQo9SQDmoShuuRf%`aEZ7LzjOx8#JZKIWv z3i`5+-V_{dqdy^%doHl^QJT+NV|XyonS879y!l@}+g@I?LptI# z9b;NoH?G%WO*CasXRTDEHH}of3wM@56CSVIlamC~+7nSlkwGKJrgmm;`4F*tQgx&B zCi*EK-RLpKKQTmTuwd`xjm+C=1q9^`>YqV8)6u};3DicJ1NwV4)>~9K{97OQu5Is1 zl%i(o^9+@7EqTe(vczWsHkCAt!#r~ulZH3W4Uk4y;VS!e=i5vfHJw>ZXkiQaY4C9Ok-*wxl5D6{726FjagRqwt$XddZ$=HVj; zv1>_bxTNjGQVuJVk0<^^{&6hzv^B^}?PDkrx7*`9!$e+L|5G86AZQu15BGkNY(~^@h3owF^N#sEqTD3aDSFmnsfqRpS<@w< za$H;%DMi&z8(!8@^5+e#`AcvX4P4eOZHR>RA>DT34-y+Cr%$ol-$tartO_}$9JkwU zyWiWMyRepbRuiTs*u%d@JxDwYZ||||iFW23;LPu_<}Go8kCvAX6i%{2rMWN}gIpKG zEZkFBCtSb+<}GLf7G7q&JuFzUr6Ed(X|;CBHF@1KRO)XC4Ai~q^txS=Q$vnQ`NjlT zN-vZm6Lk%tQ3eDtMbCYZ>x%f#1vX~nJLyb!zz|w*AgQK*n922`U&d*l$9Z8?n4U;# z5%6&_Im@hxV)NWgMC|UT@rw=`Cn8$<`&%k+b=x2GF7Tq&drG{@Vz%?e{g~gb;k9E( zDEhgu#^3Q=am>KoeCDp)AcE@z_+ZZ0(xndBQh)_l2N;d8)+weROsCOM@ET1slP)Kc zqYPed0OxSWT3UK~F(f3$w^52URI#QsSMSmYRAVIQ7JsG)@n0xX5nA&`Af?X5Il!&iv$@d zw({PR;MZWYMKM@D_bYY;Jn~}2jm4dwjh3?^3xHNe(gHbrj^~a6#FmXK_|pCaI7E1p zLjm`Bful<}@`oWJm0B{Qrz0|%!F77dmQ3kLz8$~q!$WA9X2M(ENrpH4|VW9CR$!O6gs>w7Q3|3?rLhRds_tS ziiKrBq^~bbsjP5%hQ%ed8BRx@;T*9_&$Ty0p4oH5{kyiJYgdcxCt&4cpq=8Opnofn zT*x5L!U*48W~vv68Jr@?mrDKA#+;hYk!nh?Wki#VzfQClZ+Z8?I{b87O(R>6 zE^m+8X_wp^7hc{HT>x})ViB1d)dV`L+)bpZ;(>sg9ZkOsnnoOA+t(hxZ3e4vVOK72 z6^VOnjxRNqMaT)k|CvFlQzOiCpJR^xR1H?Mqynh0+L@R3qG!Nd%^Tz;a=!oI7Lp|aIxd0MmINTHb5S}x{l6M=VRd%kZ-R>SNaKu}1o*^!u zWLH+n5}#<^9h7m{_)dB!8EkN3nJhmist6~+?j7OjPVffaUVK#L?Gj#wg)M*HHGN%pG znu)Sc%DI&0I?Hb^Va5Sm zL`_r3@O&9>HH@6T=@=|=XnUZse9h{va5|@$kc(Te4dG}FmslLqIYq@Ebj>oJjVEA@ zieVRtr5D5UoNQ7MFy@>T484ti=>T(YLKU#*iZmQonrXeV($H1qT^xDgZG^K}dpd&kBiRzoC zSV?m^7p0eCY1+ZUXsP&Is@EhAALSg0s-JMv1)L|Ceu#`ja4jKRd-O7c(tEq|OY%?6 z9_vh(xKlUGQw4ii;!qwF@fy^i=oQjO_@^0SmFKy1yzK2}%3o|^arTX$rfCnkNxSqjyP$_Uz>G{n zK-3T(__G(bcW-x9RM%7M@d!RL(MuB-0k+C-N{EXkGk&M<1&~Ep<_$jcJ&jykhBEQ7 zck%iM9iyW9f3rD05~TA-cdC+;v$K>qgMQ+W}P5N^kk6u-c`vs3sA&1P9d^URp{LO~9 z#=>JpS^lKprQo38q2SH1GuMp_?{6h=2xo~A3_A_#_}@)u^ORe{VD`^nOJdHWLU?a) z%l*;i^>m19#5Ct6e-SE_}ZSxC+AyUQ!?jQ6yJdeu- zseGaXJlP4MLqPh;Nf#969uZ0CYMw@4X;>{SE0g-MG%0oWXtONR;!TX=AS4CtV>W4c z>6rx~>}6c#c8GhE2LK(k$fPU?X6Ss)E;}V=39?PWo-z#(EAg_<+_LM)=VSyn$-vJn z`}8X9wZ|I9n@PJ{2kWu@qrc}@Y47k8Uz`P&+b;RzX|&Yg5QnF|z!vd1`-7e(kSt{) zN(@#dr88oW@0w0f3{JLn`>Bmj$^wj~s)@{Q;%+f0syGtmpk`wweLM3J{?CpU8Mn!| zi0LCu86yLjR&skP^C67qzcI4ISvAJzsleYwkSCBnfPIEZZu9oxulql8Ea=HE3E+DP z@ZopNX&y2P_`K1W4?HS<)^Sz!zJA|2#*Gz+MqklM5YWt`V}`Nc6h|1uMWGmRM2DfI z`ZQBjj>@fL+;RS)bh|NNMD}LYfOBgyOdTpdrjt8$)v|cQ*|YT)&Ockri=S7suQ#Hb zy!f088?Ud2(HBj;jz@DbUY=zKIxmA~a;ja&gDfnW<@;$hN7=uqh^lSv`tq=`e`Jx0 zibS^~@U7hE$tYpN8Pv<+PB5rNv09_x7)mMr46ieC(a<`%I8U$duuj$eEgCV~wpQj% z|CV=Qk5BxTn7ekF{_gmidW*fwhNI%moc6l^SeWqjEIBG0Pu6~jWJLT$(FJZ<&Dn}# zhHiOmWeb7qJ7Er*F<{vfKVaUYXuQ7{E6ljU&lqVBSvi}k)$t(Ojj=emR#qs{)(V+7 zh?w4Yn0n+hMXtljF#gd^kRLgp&u2q4Y_`Jxnm{Uhk-pkt=9LDC*%;kzq`>C-yxlUm z3E^!jg(tIH>kz$vTVYeo^-Z|ejtvr{7@zvF1 z^Fq*YumOME?4ET+Ipm68HK)IfQ#snuLP}^jTG!?k&kvXPi_y|wZx@f%=qbdr#W=x~ z;?YnMeYi!a9#f#sp>RVp|8ib8W_d7bZtQk3?M&z?E?8sbj$6u)ADIJ z;fvKd#a*YjI6NjB(X-oc58&sGXZkt_=FA2P@o+!>=6^-ypblk8LjJ;E1ykvyK5sSV zq!HF1kl+JYdZ|_dvM!HUF-boCV_cEl`BWI*jA<1p*_-}Rsj7IY?YSrR+_NTnwOl_( zTzOie^)Vg30ROk#Mu*VtH6w+$JL$uuuU8|EZd~1S4l?Q|7jQsxwcX?A-tSK+k?I83 z0%agg%G2)ea@RSN5(xv|UFCjoAVNsLNjbFSsAo>(m}g2~*I&EDjx6}XnjrMDKx(gu zrbWve^ovoUK75&?4?dCsxKr$_h+UwzyE9=+-8rzeTM)KM#MiB~mSfz(-4?D0+URrP?p3#KXu@ARV_-wz>ZS~NCn!JIJ zOync2(4W2t1pvX*Ek^`bNc0xQVULb>DaflUYbpL#?b6+eia?_? zGqvw92Rw{j@`d;!LlLW^8N%sFfHL*-Veb$sWG$;p*kwrC7wUjC_e zvtPHij(C$U#X4%3MOnGQel5q-!Nf<$hjDRLi*{?Vu0cS1b%FG+QN!zgLrtfey=p~= zKs#w;hf|+#JIm(k9O7BR?*xXHI#C&zdM79Aq&1JW-<%%(EMqDa+MVrE<*ii>#Wu<| zvNkUh9a$*mDO~>!>{Ukl;Y-}F%~APr;1$z*BE_U=e<+T6_j~pL%N)e)xZ$dgDMqk;gyah zEJoCIk4Bb-ki5uh#jtA^{qBsPo#=nRIfIb(U>|+JD}oQ6X)~5iIT{9d)Pf#75Du2# zv@Hv@E@UAWj}`vjrPN<{Jzy7Q9fFt-;`hrnQB<{4cyL8{;Hjnpv&5LuY56?;y>frq zK>OWi1cjmOM&yurnayJWFj$Y)iAr<2<^_QPN<&zG_)m_<{D;oAf;QHUM%IoF z1po9BRiG2Jx3Lwlas5sI{f(7@k${bzQHxI6$k0sh|8rGN&;ENM0VCkw7AhDy*f`l6 z7<~)+N4f%?f{o*MH&Oz2dO9UHTO&F-Jrg4y9#|u5!+(zD{D;P+B4+<|E~OK({GKgj zWME@x^zSEf2$)z|S^i^#(*EBz4*AWPK3B52H&UFF)P%3_{n93((l|(#?ZKAL*o;|c z&K?&Nmluvt)|V3te>#wQ`&kJ_WO`=~(GZ?rPM+T5vPE|-lL@c)o_dUU0Amg?2*Y12 zzPW57EEUqqK50Du!=KfxCT?d=u>vA4(+y$~MIbLOmrf49AN{1>xs=U8{? zlopn+CkKX}Ekv_r=&c_Dt8R8g^|LyVK7naxw(~S#p{};)pHz<@p zyQ?e8(HF|!FGv^+QIO=JRBSn0Dj&Zvp99%YiyP$KC%uhNqwA|v2~!I6SAROa=)w=+yS!<`PnKf3ykG9`=xzs_ z{_=XgQcTfe22@jYdc7X3EzS9qL|p0kd_3MHnC?+W90|u2M5w2ZujBK4JwMTr7efg` z#eBRZ480p~ztN(Vklt+U%An79kt&=VbP3$ay~6_w2kJrx#OREA=s+-EYaT`@_DFva zp!D}Vnn2jNVBCjBw7l!-Fj7Q9<<0u~awIPUXBfm!9?cLz)|nz!_U?lY=aYf%T zi2jP*r0e!d^`j0)+j}JqO}&cHsk8xFDOcRJ7Y<}p4Wvwda`XC%5$tWhJ~Uh{VK8Rs2`sdz3In;UiA*{B(UM-2C1#btO-cX&G)12J+@nQ; zTs~QP2nnu{FgQbBMn?>=h?GE+KZ2H+4-Xx(jIif~ILC%0V@XXmHdi=3aT-upSZt9S z?dFOtZX}#zsS=*HSvhLK9!T3?qS2Gf+W!m@@vX2p$_yE454OkSj*LN=$R1-xDx(o^ zC4+^KL9nRaV->8MnWsx^7CJRJ57{8rN~^4#+B;wfi|Lwy=_&a&+wbYyo2EvwMEH~< zbLa0M0V553#Igwh{A}0=WG7`7AQ}Q|!6=)8B06d!_*!CejYI>9!ZKq2kQi=ka}Z*d z4+6bd%&-=ouHikmz(B$-Pz>?bAzeJWNxJYE#Q1*5 zR$y&d_)7L*z~?QVfr%QhIj}!H8kUlnKaCm9i!`Zf$IQ5`NQz6jvO8NF8ZuQBSM)El zwqDy1`kQAN{2fKy6D4xtWGxByYz#FTj)8KH3GL$1S=4w&(eb(AyK4~>j1{K}&wN3z z-oakOB1H7*s9EYZ)z0bjY$8VKR$;wRRw*JMSvAq6`Cpt`*duNWj57V1W_VTBJ=11) zw6o)Ljcp`Izp4A8s1%@6hKzYFrp}v+bk<_5q^l&R-nd+Edrvi!OFs+AG&jKJS$vOL z$Q~?~ggS%b7w)tqw1r=&F3`w|}iX!~`2I zpAMWJpjlAJz2u2Omh2$J;p>i(tl^o7)h}kC^5nvD*Q>~PUpBl$eQ);zvG{qeh$_oP z53qy7Q$%#P7f=`tQFZ5kwQYE)s1dp%tDG{dH&Lg;ZVlO;_wL*|So|T#aFa0^X)qyy zfpB&M1&Z!wb`-dTDb5|P36VJ!lZMSw>+f=y@y~i1hK^&(Z0oD5>*9E`t%hZoPi4Cg z2qZKWkIYO$C)Umc7*XXHoeYGclJBDRcKywxrxdZ7qN^Hv;pj!zKm9zcoSR3lAq-7} zK1D?o9A5Mf6p9<6NV}G1h(~A4;1_tm%H%*JleVJRMPr?ZM+>f|VZT9b{>1OCm1zL# zJ3tT;NAuHDOa4)@zEPBp?25L24-!N;OOdZfA_DOlZ^Rs#JN6OHsKGHpNHv7&Cgvo7 zC@ogs>Thd<5FeugNfn{IJHu;777K~M6BMzLkW7<25Sh2& z{(LDb<=(I{n=3L;Wr!P7qdkyR%qd*Z)j%Yv2p)BWgPU*?;h!X%L}-_kSySMFrIOCVdf8MEjH={+s+o8!nee0By|V$RwiHt# zidj>YuemE@tVuCndwHj5^MrNvIMEDQHg3X(RSTNDz<9zL^VvH;$(rU&>2JQ~C2o=C zL%T`~huNp!s4^XM((lErMm3J_VqtXRtg4_nz15w8H!Bfo$f}qqYfV+y;NMsqrX0|9 zToId_!V%*8O6cYH-e)6l(!VM~n(d$$dt=f>)(O2U_SFH5L687Ore95caoADLr!4Nb z7N<`LvMPh7&PKAtle|h@AuqKJMHV`PjTvXGfplOk;_b~zZuUj2DgE*gyTaN2)bQj@ zOY(pPOOIFpCi7&WtqXg;35ik{@E(;Lo~=Mh^qI zSk{}utB61Y19SI5QRyN=>y}D33)+m`b_@SlHDH%y`Gh>gDpw4eA5g9JDStcvvnWx3 zI94SNUa?FEvTR?zwF|-H+1+;*V@YJdzJHUYu)Cr=n!kExxRRqB7Ytth*8{v#xqGg~ z!NN{E&BZd6HdT#%gF`uesghZ@D*#E>R= zhSmP9-TkQtgnRn28~3IcSSp!$A}|k6f^*Gx{5a8K5DWQ?Q)>KALfaCP-&g1%nFUFL z^Kf}X56Fu(+9_y37>4p!SCBtgP{vsEx?4pQvs92*wg#Bf1K2o`wd}$Mr2&36#zk%6 z%S=e-YW^MV5ecR1_lG=kdeJdwo=)g~H}aSG&xd)&E~qsoB;(a!zt%nM+}L!`h)o+9 zjet;6t%^LHT3x7NSdyop5Df++E(OSyV3b$2jt}H%Q6`tJuQ!Q6xbGf~|EOCwTtY%O zEz4F!+t1t^d)+}q*(|Z`6<;AQMleGzEa4d7;!Fi&+=-ld$J$18^xq=%-PXZD4>b{p zbWOC1lHh1eLeu7}x4YtHc7IPx%)uwYd2LJ}HLICBmWbrqeh0w;oF>|)f-@`=4c_|& z3TiD1b7@=0n@YA~S*2Q|FJat zK-5t@h06od)+g|%^BqvhZ|ZR%e=8LIAmQ&HaP~m?)qEP2td+v|3sSM|-GLaKjjewa z_7~XeAWdlfWOe~JVjY?^XNC*j8df!8BBfQ5_@(CY+-O-$qlJj{gv;G`DN_#50=5?P zQ~XJwmGi9r@o%$+nk46P4O6Re6;|IHYlsVnhNS7wHY>OBtN3zPs_A|F{N^bNQ>vmV;N*QyZ*6cM@Rqi^_94YHuW4Z^rPgl@_h z%83u$w_$`OKovawbmPd=NzKvPACM4ohC`o4+-+L5`I7=KmY8 zXRNdD{n)UD(rpYP&F&KBrgLDFP9{&GUj&tYGT!p*%WT9vQLMjl`&gCw*UR_*M!L33 zOSe_ua&A+FFnV6J$EkGA#$*4+W@a*x&7cbiA|=fKT%9`-Sxbg!^Dr3?gI7FUbSY0B zt?2q~rQ?(A5f|hU*$^?EWO;faqnjAaRzAIk{%YR?foVnYIURHykf`HPeeslGq=tyO zOrjO}2h#zw7TP|mu(vY~;qECz+!d2lH~u>v6L~Awzv+RfY(#WuIAY`mA7izxi>+V( zhu}UeFuiLFMz#F9PZ?>lyR~9JI%XbO1g+onCyf_TE}9XV`mtM6a-$|uMDbq!HUf6U zOp3a@kO0jnH4($aOlt+|W`&K+%pSPXLzKPS1QuKap~#=AhtNRQu6aYb+IxRDM!|8T zWe!s`PW_c;A3@A(u0fqn?-c3RLPjK;n-OE_S%-+F~ zfaU*!rwsJ;bTR}C|AM!&`sRv`R{s&LGBPUB%T?FRxJ*us(EXqllac|q3!gxd8uvru zcXocQLM6TIAq^uXfPT^y1V{c^68PI&8(NN3@aH?X%z!vp(I4EPVU7ylF3v-}$z|K9=Z{}m$mFM<6(%Kls44JI}K z;6J*m|F@L`b`#>~q>i7=&^KvtkLysDnn^H{><_DO!;yrG{(DD_1@VlU-O?l}9_IWl z?RK22XfB`-Vp*!+q9jkkFa!qmoVO+>6?ck>FzRtU~cgtprCBYfIz7IK;(dL zJsvh<0+>P(fM2p+W4~B2!c)#k`PD%9CNVjSF{o{1ZvQ}V`Qc=eg4CkyC-lVnr|_8y zB*UZB0jD4!Khz;WcOwQ+10xmFi+3-{f=+yBe0WqYe-(UwK+uD*ZTE>jeEukV}Uo9r~HpxSB%8#$F|M@Iy35N0;VOeCms}pd>*;0PJ5E3PsgHd zA^{W#xFU+$?zNt)Tj$C;kLT-a^$PXZ=h@MO@$JFo(wi*rSKc?3{6Vp-%j*XC5tJ3H z4)4e9!`KS%c}NIdmv_fofvNxBVz!J4ONK7Isj8hV-mmATw*)3B1c8vx_mQFZ2Lf>d zc?FB@kMqgHl{WuEt(32lB+*kJ3^f8239$8zjH^pX>ZDlm)5_i=PXx;C*tfJE9Y{Jl ze6VH@AbRb)Di$l*ixNM=D6&<5K^XOx zplbZgb;Qui@7k_jiswBnU$a#5_M=3OCsN|h<7dGR7SLPjy-Y>9sRvpQiZPUH{Vp+M zEnv`^oYuK<|A&;#I7i&KPRS#^t4bvuW9 z+|#rUBP?QlGA8()nI_OPb|x|&4h_K;_nKB5y&GIJO|Be1jQ7#R@-R%rfYMEpg{M_2 zM-JT@S79cw%syWmlKc_{5^ZEQ%8S8!8MdcmH@W^&`-Ati4Bs;FK#F$N14tmS4g(Hb zNDR3ucp!*GS;`mLo711IS0JifpoLW=xDML^s`rYChJ#Mt>^l;#W zYC%_2*3Q9%;1jr^&7nO2*k5>=LPDe|XICBoAQ~PdVPVqK;h%aW0I48IV#zz*eFBbN z7V4TwGoe8Xj-o$OHj_G~(ry-ZkzC2gKJP8Em;0n*jH1>0t+Q;wbfd^Z|-A^fXLb{FK{S{gjjSp936s5ugxzMCZeN5xX zGVvw@1JQF|MPuNQw^apnjT2Z=b2}?CiIuK;EfX$}B7PWi>Gh%;gML#J@LEA? z=Lxh0ow}hL^A-)wzoLk{1q|KWpavD2q=eLl0SXXtQ&%g+dXW|$RkI(=L3!a8S&$OX z2dn)_T4P-tS|YD>3bvl_6$CSUuq5~A%USt@m}Toe*Mw5&nWDi6DO3cEt!&va<3@UfYTx#Q0s4;-$gq`G{OovE=Y3fPZ^mhipM!Ci*xpx_={obE)E=2 zkK@n|F+@Yan^N+tr6gvB2=hBwR7V_N8$lzr9KHcNE?9bYVBXFrxHBvdi&+{%VK>awKw=5r63i8} z_!5>-CE!Cw(kh^e2l4gm>xvWUi3?OCEu!U_-qkq9aN)Y4E{&vhB0T}7dc zn-1S9MuN2Oa>x5G)xbepEy+ABRw3Vx8nmsqq?}%GG>McGS0$Icj+hk>fSArs( zOm14j#b4t4ZIMPgBsSzs5Nw~^<8BrjOHX^lu~Bsxwd}Ngqx_Ups`X?gILg0gx^r)zKcjrSGl>5D5bp z1JrY5m=(oaCao0au{&|YV0EBKXK;pWjLC=mgZz$!#NbkDyu+qIjY&I}o!PX9McNJ8 zlSS;)Uw@8%Mo1Yt`$E)#GR{N|;~B=6iL(bE3y|f~BYqI%HyAazHhq4cZ|JiCztT8f z6%DTg!5%^&Re79eIJnK2l90q4P&kn3OOUzmrtrnT6 zl|4Dc6cxkLi-wJJ0$LXfUvZ9FfQP-FbCG<9vjeLPZ<&$j{_7l7fBvUOk6aZ3k>(3U-3-Duu?GSoPQAR_KAUA@rs1X zh>Elnq~n|8d8o`AX}30!+!(I#xDxF3Job|%!XOPHdlG$VykUh`Qv>OUGv1nb{K*1k zf?)&v4v9L$fkCaI_dYw#Q(?>dQs=dEU|sBy7|1hwidk(l&8b9!m4~}PTfItgqI~$p zFC~>IZozDbXXVnCj`0>7{k8c_3$2Zp1m`TYCAz33gq9G?ot>y& zC73=6xpXVjJAhKQXwj(jJ2AWHWYj&P*+55yP>2D^(RwJx0dR zMXy9KYSRn?FsNF@ouSW0Xk?~Zuu!mLrDl`pjofq#kt8&H&oP&CN1^AI z=$#$>kft)j?7VmIOCT$#=oHr3t{0hqOtB1ZIDF3R6v#+8^u!Er85e@TYP^` z*W(r{JR<3eu1gu%;6~5OLw;*lqu}{x(-5xrhj^dh0$7m)MfSN#fQVQ}OMd+g%vf!w zix7Dh_pPWf1cvGzo-A1gvS?#YYz&DVd%u9xhwHU7GE}w1n5F(|yv(}2B+x$X~ah8C^h^e!0YI5&2`fa!u( zlL=61jfc7c1g&X$ZRHG)-ofQ5MAsQpl~O(Av`pk&C0YZ4r;3)E8fJJ_xV)d(GG+D- z_{;N>Bdx%C`->UF+IWbgM^qPcQ5M#g)DrUp|qxsqTFr*4Q8yB7?wmH-9q%{lGT^m z4h9Bhc$PRqiK|{e#D%6wW!R;-TMfkU z7R+Y-zdMsFFhoija2zhyML0BQIhx8br=HTTxg%e4jP(pKtL9QouPnbT_MPS{H1Mxr`{Wy zl2{%yQb6Ftl|H~vpd#-|KWV+0S9IaPorM2_V{eV^tzRQ#ud_WaV-OzEK-ot=U5LOC z@_ZAUTTS`h9y++u{(>$`RQ?>wgjgM=uYX1Ml%JpX!W6?&-Yblww9|V%|5XracUJif zR~13at!**|k@Tdnt?-2WnW_uxi=>y5pt)E(D4#U$J~cjS)7nSv0KJ@Tl(J+aQ3$ZY z3)H}82E)A1XPV82wxR;u&|q4vZJg4IhAVGyUx6A^s+7RD@a{$$m-QE=pnmnf|2CIj!K8tF>2szj9vYbZoJmyVEH&|JcgYb82tsyok_e9 z-Xb!K4s}%pLd?Q%+aFbT44=L{(V4r~P`VsT<9{TOT4=~VWPO2wKvzz5{}V{g`d=dA z|J9g+!vDdTf+YkV_@Rl_&}Ts5#cnU7{txInU+(cbpFaTSN=ydMFJAi}U( zhQD>m8z2?##JFWSYsnBXoAxx9qVsuU%Rz!-;Ca3$dv#mRkKl?T_iOiJ0v7#7bgtks zT zY%9Uf94PdWF99P6xpnSI7zHwWCd6Flc|2c1N98`KH#Zw5JWM<{vE&kYDuHVwvjAN+ zV=nH6VT{;5;%ZyyK%j4s(DVn5B&@V%swNeI^1~;B3i8V_A-#lEVqOh=G8BSHR$=U*_V2u5bXAs?`E0SdNMg z#DG{<)(_)s3OC}N!6H>Tdy;9+;touN{O48RL!QGHUq5u<$?)`ki8(j(Cv21KM8jIj$ONa2y znXfb*M~Bv*g%A1FwV)M(EbGqOGkjSoYj-{@*+A$=RwPO09(C-9zQ^GB;Gt~@D63GX z_>z1YBP;m35hKSGfL>s@KI!@UFp`|Ae(Jw>y}MbJ`56FpDJBjQTqSkjc-nacNOSjI zq-tY(GR)RclM#@P^Ze~++IhKOEZoG<&poZt2&s6F=+4!_2IkgQYD>zrGsx45k${$VeIk9Kx@#@46= zhXSxJjRrPRK@2Mk{i?nb+2KxO3v&yx>rt!Qw&>>N5)&BX_&l@3g*m`=@mbUYu1lnR}T2{p6PrIjqQJsj0+mE~+ zrXHO$YcN#ek0&#qBRs-5YzinP&#^&y0>=5ra>MX~s9@RDrY6Rt@}$vN%JCeGg6XNi zQ%s3y#`WX9Qc=~>n14z_HxN1MaFy~fltx!B=}S_H+2&^|FLGupw>{C%klTABAF#wQ zOeTY0D2_@%$ZZM990`jcNg^G{_4$HKw)8eQ=a|#2WJ+%9_8f6R$2}j+9O8X62BXR< z34-AE11qa6V@xq@)Cs!^5}bERNXcF1GPI800V0xhziK_R zOv+8s{#5QVr)T#3Jz&(%qEU5Yu5n-cfnb+Acsl+V9c1^_omB`%hWL_xN$u*ohSML- z`-T@+Pz8pQCfCIp`|Ty zN}#@fL#PC)Nx#i}1M*CV{~X zl{a?ueCb;m6KVYR8tLl{Hqv%g4{9!m2O68Rj*vP_#FOPh5YSgIsZsl6kHmP=PHO+0 zp}gZGKw{1b@8AXpO~52YF?A_Vxsxqpq2QGnfc4|Kdlv2cR6#=n5Pg9>io@W4oxPH6;dC zq}7`$D!cGQ=2#%o0%NB#4r;s=!QoyB)|SHg`=3E__|KIL%QAeFu=Z7PJDnm2$B;Vx z?)Dr-LglE+iaPC9FQn&#{vlHbt0?}wD?oh;d47?&Y?Fw%+M+QcX0Ji|c%ik-R_)zk zGkd&>Grk#19AUdHJNu9I&A7@sgNIu42DzDUcr5oIItErsd93iw9eoFWwfgc3w`S;O zY&<3}nBZ*!JKf}1O3A74v(Z2U5R$|)Vj5?>_Wj#IsFp;f8bC0h$T{6CP8W;Kf^P`(G;4|?yu_gdOV5a@40d~GprZO{;u?NT9C_bIWC?w7^!%LBsyLRyWfO8@!`nMJQ*ZdS|@5fok0mt6U{8FN>WTXq56>TAIJyKc`HJaRf}BnDb% zdCci;SBW~#O#a`;*GKDC6gyj^MWwwC;zNA85Uv-gM>tGHrSHpm!IJ)iB8^IUB4X4CNEW(8u#g+MGDz`id^0`XxGSXnU zW=~n^PUhmdrS*D{@r#jIvZMKjl~DiQINCbkC>SiT%>x!ECYmAQrHS9{3^xeN*3?pT zYo`}3CvcY!>8>G1DoW*PGINGtKmydf05&a(3cj9_m zSGwJvI4MzUj${@>p2uqeL86^k+sNLm5nDWeKBn-24sAz>mGqv|HreDvTTw$86F65d z<7p__yj~o}GVrEO#Dm5u$+}ZFlBz%FYYq9Ej*ZdKbEm~T zqLI4Ai8hkK%`wMzL{Ep-2~_d0o3v?{R$@;dRYnV|4mmuq(vWia6fNACIF$U-?ShtLoZrl{@QW_nh>0Ao22O4v~r<&o`U zBwfrC(e+a?J9Kr$Ma|QD%ehdrP4$Wp)I-@57p{ruZ<_IgFUJ$-ZWvw_^vG-tgIVZ_ z=^HMKSZm#_PXinF!SLWY;}rL;$Bf2n%oV$$T7z*m#biu3M6C>2?FCZ2=KVt_-%6q= zMN+og3vXK027%Pam_HdtkO6VhJ6M3go??Z@IYVGk&iUq5y%{0cxW%Y>5#!t<5j9cR z!faiwdt*tN9TX{P`B4&J77g+h{U{#oLHZ==S_`#n*m6~>A5Hts8oNb~nK|P>X_A+R zsrTohEJmQY30vdyspPU>C@2J|5X@53`@Vj%ENmH`L}|SAuneHB)S1|8TGea`!4abw zW7N#l(v|Lkts5aa8jxuG{d;5#Q<)c|;WeIE^-gAsR$EB)1LxxgKA(eW&paSNM8w~U z=k|KxXIfN>pdKzurdusG6P*r%qAKWmJq4Pk>$0(L!@s{m_;HK3!jRbFOq^Gu_3`#+ zB&f%qIo%xIZ!8?nw-w%Ju3O1C8SxPdM+c{}(u4-(;5B0E)6~f+5myvKU2bdDi^^{M z1U!W>Bp%NwFQ=KTF-@p&4i0hV49>vJ+4H~uld0CMg4F*{KpFdgiHZJKQKicNNmS{8 z2l1a6!0=Cn`M;yO{|PG@{#82uzXMnPlL`NCaOJ;g`|p7zGZVxABUznsmax`{*xhyZ zw;O$G-N}=Flf>ZxQhis;aV9Lh-yu^ZO~&16!`Sm?UWV*XdRK?*H6boKf*3bZjFq^g zIXW*jS_Js>sk8J<2wgtg!LhPBqmcZ|Uqt>NT9iVuVl@JqxwqmzPkN3)(0V1F^Z27% zqUfhdt^-ig2>LqEH>ky?Za(UtT=A62$5hH{h9#NNv?T69iHQ3LV!yCQz!Zyo(2#>j z5Y-AOaxrBT?_WNKO}iF+uIgX^JZx5(%OP$C*8b9sqi9t&#%yk!^S`kewSp?+!kHAGlBkx_v8I@rrm>>lrUrB=&8&5)A0fRX=ki> zi-)&!iIH@v?rp+Yo7#Hl?)UrL5WJ61YkOWK0^|J=oe%Yuh*@}AB?W(V z4&PB%j-b+ZzPa6<2``GR2 z7x)Mp?a9RmEgrgQ_jguN17^zPt^5pqBVg%pH`o#T9g_G6C_8aGA}-B};l9FOpv{IL z4vXmHo(_5f<7Lm*A5EJ9BYt{ux`sefWOjMF^fF)pz=l8=5)_B}-E!&DTd%>h1J>Pd!+hgr z2r~M~TzCML!+<$d0b8)4JQu9@MI#o1EOgVPlyddY#`Ge`WTwiZlBT^EL2Wk~LyE&( zX0j=xx7zgV!q__Mo5cBx}jwWpkEeYTb`#FqzH0!%T4_d&8;w2QR zvG!>PfX$*JVS9Qk0S&Nsx;0zR!`~V+zkRw{o0=!sAv^%Ft;?DTE#(RPt;!IHP>igv zOcbcG?>P3MP!Ji@SC|6bI53@vIkYIg$CQB3HyF`qblxO8L&@+Nl{u8Gfz+h=LFG{J z+iRv2Y@}axbREiuKxnyAsq$f^AyKGq(~d?6m?EpQuPbC^sF;Dm6!6B8X<8&0kqQ6o zAAJNPEUw1VpKL}Yh>w_Ma={>JulKO*poNZCqx>HW)9p=4I&XC|6NBsF?~L`Wv_YPwamI7n$# zh`6{~n#w;kFy!9@u=e8gcm6eu_-R!L0{Ix9$cxZs{|M@nQq=3DKR3i<^+hmDXc%}% zrEf18b$U59DOk8f(*gyB_2b z&vwyTVx_$}FU9KlV-^|9%J#ThYVC}wVuFBW9uw|Q>}5M?6&_0sF+qht1K>rF|#~A@3dOb+%<(x+L~6mNJ?eGVT1cOJY?YhHH}*xCB1?! zT``SlefcuVxOi@SSkyK`GHIlvqft8BmX-}H0m8kDOzCzb{C zr>A#Jqbs5FUspaG)QZ&$aL1G2FcKZLSTm+JRJhD_dm zNFh=wF&z4*!+P4jOvkk#GiQ;4po=TUHhnh|=+U|w9l0yB1hZtq#;RZ>fW;lDJhxqP zNuh!Zt!#NsVj$8pf>AlF+A@0xk~{(B!1(KQT@j3H8Q+$_RuIt&7Rs6e>~HP$+bK8P zEU81UNjV2JJQ~!RO@MC2bruJOEnnc=McB1r6%Ti-rGgzp8~^GRuzEXx8o*BT`FEyi zhm7s#x0wjhz$al2QDl zxzm?r z(!|wL2$u@Fcz`k7NRF3_BqRY6h$4hj!4**+IY=ZINeJhPhzEiqiXw=zfUF?vi5x1T z;DLC6eja!LUaP1JA}k1>D9iT(DqyjGYnA)YRHf==rl-57yJzxxs=LSi{O!G=J9?sX zW}R%QiVey5-zHz7XJ`o9g7wl^Kw*Xl?)^Lvtw z+WYFO*38>mno`E!u{ER2Om-x3$-1|jy@~+D;)+H=_P&$$IS20@A6HX4?%F;Kv1A** zW2+;laMP}rzelX}5G5gg_F(8akfd$i-U5UtBm04&%UR30t-;g!lB4d;DXMqO&DwAw zfA=(PrRT=_nm-ABloc}+hiN@#-hxwaE-JF}5@)Mcl@Se#+h>+pZf2ytp*zGNd<|## z#VtcyD#VxPxE1ZRw{y!!78Su>#0g^0T=j45R8geRIyAZdp!A||X5Iq9#fACS9yEQg zaBhG>fc=(?wxzoF4JO_+E=arFkV9*Q6+CR#u(01UEh#JYBwl`QzxSOwRZdjYZvuaz zk3FGc(=GehR~5~b^c6AFv?cRPyDK*o_meUXls|s8QtY6oU|wDIn`fI(ZY2dfcg>1cuJrU2|1N%UkD2>pS*B%^%DGBw zwyV{2*YwiTzSCDWoJ{who8sEUE&oHy!O_yXu~8M7zwoTAg}i4%ts|CV7P28#*tsZX z6+gDLbe8_C>2(%L%5N+8>U*rmJx;i})k#(;(u>q(anj;q9+9W&Zef|O5s0*Dg2JJud{W{nc>gaVI;oHST#=>;3G)btGDi>Bjkh zi?{rd^^XP%o@Z&Fc&(-4c;E8bZ7kDyakr+Bj~tB6_MZ3{IhMot<(%QKb$Px2O_%qP z$yk>X0wco9hh5$wNA+8{yhDNBUkuL%Mg)leed0CQ4l~N*^>Iq!K_8(5k!93Z|F6z?Uiu}4_{YV z<#%)%oF3SCZeXIP&H5t@YgeOVrM^MN1yyf_ycIEVJ9M4$kND}Rb_958F-mo1 zfv4BsAfj!Jr)eb_m|thun9x-d`>6v*0>x!f^mnmwSpz9QEt&cz(01PiCl{o#^Y<7GB8S z4hHSG4X>+2ZP`9UYib9Dx7_@v8|CP|qQqzVLXZ~9{R|_6{2(CWCh@Z~22zJT)@A(>%<=J~Z`cXBe z2vxzU3Pjt}Nzupe>W5E7>*zdrJGtXzLBd;%HDFR*qf7+IGX3kzC`glEZ<p#_ezydJ$%)Qfise`)Z*ciXg#Wm3<>{ zAZ=O6t@rJ*e(baQsd0-Hbo<6mcG%U(wl+P(DZvFD^PSuC`Y!Qm(5PQE^O)%{Ny@T7 z&=ov^p#RlcDCvE2-Rih+35At$-8^eR3!{;EfjibQBJkyWjj!EQ7ypZ!s+et}Io998 zKZ&maKHl;Q$K#=#9qixd?D%55Fj#*~$s#Cor*~c*GG$_yuHhOe>1H*fx(}sNX+TG^ zdwVqN$Kqr}pv=&nvTz*1j)3+J4_2xxU@T#~57A}wlpq&Wg2Q_()ge*_azc4ZcrY(S zD4`)gSduLq zi@}i5(3Q9V2?-D=7!n18hky7W=rHJsD(CVkKF+KU1fgFvgg~j3QPAj!hzL{!4keX` zpaC)&LW4zPu}BC4sfdy&!APV;VLF85BOYg-f+H8oltQTluEq-nOT(2k1VT;d(`RUA zT+SytvT(U*kP4TB=81S>b@383fCA8;kV9jsTn>dVm5V_o9hAvLLJp{=f|halRP=Dy zFd;R(Qm7R1250$+_~3M%M9R^vYW!+`MMAY0C?Zf2LPJC%xja4?E>a@sizS1oxK#8I z)acPet)r0+GW9uqHBTHl4^&F!pJ7m=_2q?)ZXMaS z3Z6iL>=I)~!C7pgzDOz+(Y<^Jjf{ZeibQZfo?M|eHv(k-*b!JhzO<>V@sc_Q^!r^_y z%i{uk4s;7R5(kpVNIV|kBguS#fF$F|1dxX(k%_n=TN^$0i*g!LJhVqb8#MaU4*hZc zeA-(6m51R8|10Q+kbWofRl@x)uJ7XdDhYfQ@OSI_F0QYVz*hl(x2|s{F4(Y-2h~8N zAtE3TZY(GA%gGL(IpjpOH~aS$D2ly4_~YohdES_tz4h+aDMaEAu!+`2Yg`R5LcJ-# zYOfl&jh{n)F?_KD9H5ont=EHBX++mgIXV_|Ul(;m_#$_)n`qhz7(9vBmz znz!ZFCZBz}!Fc-&$DU(lEm$ye>sAy?)q6bFjh~;sv``@*u%ua(dzeJogENswQMQJ` z-L*Etd~kf++IzqDVl{IQ#pgXQ&m>a*gP#L=_T`sIx5t<_c0{bwP>D*Y_N7=srJ|Wq zQMg#5faB3#a;Qiq2lCb60G3Wik8!x_>Ks62Is*h30>jybh{q6}m@Wh|mc=9zm}CZn zjKMOT=~O2Y24FGm>=;-agG9tTky$JjjtLMk0N$B|bs^CM(XJA{6pmHv!slZx5)uKb zw<%S^aYF%AzQSl89QUE}<`N$sAMGCiKovfLz~M6o!GqvnjUOy(v@DG>jErW*Pk5-D z+zQ`x1wFyc=+Uy}Q!;FsxCNb*$-R>|T|sF4j#b5T1D&QSoSNo1+H<2Em+@^Um?j1V rO_=IFP`zxm#(0fg99^F=ga^HG%axIG9$yy*07PAwxw(rcOBeP(z>f_< literal 0 HcmV?d00001 diff --git a/source/B65SIM/LONGALG-PATCH.alg_m b/source/B65SIM/LONGALG-PATCH.alg_m new file mode 100644 index 0000000..a619e64 --- /dev/null +++ b/source/B65SIM/LONGALG-PATCH.alg_m @@ -0,0 +1,127 @@ +?REMOVE LONGALG/DISK, LONGALG/NEW, NEWSYM/LONGALG 00000100 +?COMPILE LONGALG/NEW ALGOL LIBRARY 00000200 +?ALGOL STACK=1000 00000300 +?ALGOL FILE TAPE=SYMBOL/ALGOL SERIAL 00000400 +?ALGOL FILE NEWTAPE=NEWSYM/LONGALG SERIAL 00000450 +?FILE LINE = LINE BACK UP DISK 00000500 +?FILE NEWTAPE = "0CRDIMG" TAPE 00000600 +?FILE PNCH = PNCH PUNCH 00000700 +?DATA CARD 00000800 +$ TAPE CHECK NEW 00000900 +% THE SECOND COMING OF THE B-5500 LONGALG COMPILER 00001020 +% 3 JUNE 2017 00001040 + 506 BLOCK: LONG APPEARS IMMEDIATELY BEFORE IDENTIFIER(NO TYPE). 00305070 + [22:1] =IF 1, THIS IS THE FINAL ROW OF A LONG ARRAY, WHICH 01106700 + WILL REQUIRE DOUBLING OF THE RAW INDEX VALUE AND 01106800 + AN EXTRA LEVEL OF INDEXING FOR LONGROWSZ-WORD ROWS. 01106900 + DEFINEV =19#, COMMENT 23; 01298000 + LONGV =20#; COMMENT 24; 01298100 +DEFINE LONGROWSZ=256#; % SIZE OF LONG-ARRAY SEGMENTED ROWS 01299300 + LASTSEQUENCE =156#, 01575000 + SORTA =666# ; 01580000 + P5, COMMENT TELLS WHETHER LONG WAS SEEN; 01589600 + 1023 THEN FLAG(59); 13530000 + EMITL(T); 13530100 + END 13530200 + ELSE 13530300 + BEGIN 13530400 + % FOR A LONG ARRAY, DOUBLE THE SIZE OF 13530500 + % THE LAST DIMENSION AND SPLIT IT INTO 13530600 + % LONGROWSZ-WORD ROWS. 13530700 + T~(2|T+LONGROWSZ-1) DIV LONGROWSZ; 13530800 + EMITL(T); % # ROWS 13530900 + EMITL(LONGROWSZ); % FINAL ROW SIZE 13531000 + IF T>1023 THEN FLAG(59); 13531100 + IF T1022 WORDS. 00069000 + 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100 + 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200 + 041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300 + 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400 + 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500 + 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600 +045 DEFINEDEC: MISSING "=" AFTER DEFINE ID. 00069700 +046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800 +047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900 + 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910 + 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920 + 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930 + 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931 + ACTUAL DECLARATION 00069932 + 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933 + IDENTIFIER. 00069934 + 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938 + 060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940 + 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950 + INTOVR, OR INDEX. 00069960 + 070 CASESTMT: MISSING BEGIN. 00069970 + 071 CASESTMT: MISSING END. 00069980 + 080 PRIMARY : MISSING COMMA . 00069990 + 090 PARSE: MISSING LEFT BRACKET 00069991 + 091 PARSE: MISSING COLON 00069992 + 092 PARSE: ILLEGAL BIT NUMBER 00069993 + 093 PARSE: FIELD SIZE MUST BE LITERAL 00069994 + 094 PARSE: MISSING RIGHT BRACKET 00069995 + 095 PARSE: ILLEGAL FIELD SIZE 00069996 + 100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000 + 101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000 + IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000 + TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000 + AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000 + 102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000 + 103 PRIMARY: PRIMARY MAY NOT BEGIN WITH A QUANTITY OF THIS 00076000 + TYPE. 00077000 + 104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000 + 105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000 + 106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000 + 107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000 + 108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000 + AS THE ARITHMETIC EXPRESSIONS. 00083000 + 109 BOOSEC,SIMPBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000 + 110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000 + EXPRESSION. 00086000 + 111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000 + TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000 + 112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000 + TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000 + 113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000 + A CONCATENATE OPERATOR IS INCORRECT. 00092000 + 114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS00093000 + FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000 + 115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE. 00095000 + 116 IFCLAUSE: MISSING THEN. 00096000 + 117 BANA: MISSING LEFT BRAKET. 00097000 + 118 BANA: MISSING RIGHT BRAKET. 00098000 + 119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000 + 120 COMPOUNDTAIL: MISSING END. 00100000 + 121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000 + ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000 + PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000 + METER. 00104000 + 122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000 + EXPRESSION PASSED TO IT BY NAME. 00106000 + 123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000 + AGREE AS TO TYPE. 00108000 + 124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000 + NUMBER OF DIMENSIONS. 00110000 + 125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000 + PARAMETER TO A PROCEDURE. 00112000 + 126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000 + QUANTITY OF THIS TYPE. 00114000 + 127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000 + STREAM PROCEDURE. 00116000 + 128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000 + NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000 + 129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000 + 130 RELSESTMT: NO FILE NAME. 00120000 + 131 DOSTMT: MISSING UNTIL. 00121000 + 132 WHILESTMT: MISSING DO. 00122000 + 133 LABELR: MISSING C OLON. 00123000 + 134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000 + 135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000 + 136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000 + 137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000 + INTEGER WHERE AN INTEGER IS REQUIRED. 00128000 + 138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000 + PHRASE. 00130000 + 139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000 + 140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000 + 141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000 + CHARACTORS. 00134000 + 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000 + (BLANK SUPPRESSED). 00136000 + 143 COMPOUNDTAIL: EXTRA END. 00137000 + 144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000 + 145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000 + 146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000 + A MISSING END OF A PROCEDURE OR A MISPLACED 00141000 + DECLARATION. 00142000 + 147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000 + DECLARATION. 00144000 + 148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000 + ARE REQUIRED FOR THIS PROGRAM. 00146000 + 149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000 + PROCEDURE. 00148000 + 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000 + STREAM PROCEDURES. 00150000 + 151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000 + 152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000 + 153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000 + 154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000 + 155 IFEXP: MISSING ELSE 00155000 + 156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST00156000 + ELEMENT. 00157000 + 157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00158000 + 158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000 + 159 PROCSTMT: ILLEGAL USE OF PROCEDURE OR FUNCTION IDENTIFIER00160000 + 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000 + 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000 + 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500 + 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000 + 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000 + 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100 + 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720 + DECLARATION. 00164725 + 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730 + AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735 + 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740 + PARAMETRIC DEFINE INVOCATION. 00164745 + 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750 + 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00164850 + VARIABLE, OR A TYPED PROCEDURE IDENTIFIER. 00164851 + 199 E: INFO ARRAY HAS OVERFLOWED. 00164900 + 200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00165000 + 201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00166000 + IN A LEFT PART LIST. 00167000 + 202 SIMPLE VARIABLE: MISSING . OR ~ . 00168000 + 203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000 + DESIGNATOR. 00170000 + 204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00171000 + 205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000 + AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00173000 + 206 SUBSCRIPTED VARIABLE: MISSING ]. 00174000 + 207 SUBSCRIPTED VARIABLE: MISSING [. 00175000 + 208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00176000 + 209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00177000 + MOST IN A LEFT PART LIST. 00178000 + 210 SUBSCRIPTED VARIABLE: MISSING . OR ~ . 00179000 + 211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00180000 + 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100 + PARAMETER ONLY. 00180200 + 250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00181000 + 251 ANY STREAM STMT PROCEDURE: MISSING ~. 00182000 + 252 INDEX: MISSING + OR - . 00183000 + 253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000 + 00185000 + 255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00186000 + 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000 + A FORMAL PARAMETER. 00188000 + 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000 + NEST LEVEL AS A PRECEDING APPEARANCE OF THE 00190000 + LABEL. 00191000 + 258 LABELS: MISSING :. 00192000 + 259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000 + 260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000 + 261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000 + 262 NESTS: MISSING PARENTHESIS. 00196000 + 263 IFS:MISSING SC IN IF STATEMENT. 00197000 + 264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000 + 265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000 + 266 IFS: MISSING THEN INIF STATEMENT. 00200000 + 267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000 + UNDEFINED. 00202000 + 268 EMITC: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00203000 + FORMAL PARAMETERS,LOCALS AND LABELS. 00204000 + 269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000 + OR TOO SMALL. 00206000 + 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00206100 + 271 IFS: IMPROPER CONSTRUCT FOR . 00206200 + 281 DBLSTMT: MISSING (. 00207000 + 282 DBLSTMT: TOO MANY OPERATORS. 00208000 + 283 DBLSTMT: TOO MANY OPERANDS. 00209000 + 284 DBLSTMT: MISSING , . 00210000 + 285 DBLSTMT: TOO FEW OPERANDS. 00211000 + 286 DBLSTMT: ILLEGAL PARAMETER . 00211100 + 290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00211510 + 291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE00211520 + 292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00211530 + 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540 + 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550 + 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551 + IN A LEFT PART LIST. 00211552 + 300 FILLSTMT: THE INDNTIFIER FOLLOWING THE WORD FILL IS NOT 00212000 + AN ARRAY IDENTIFIER. 00213000 + 301 FILLSTMT: MISSING WITH IN FILL STATEMENT. 00214000 + 302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000 + 303 FILLSTMT: NON OCTAL CHARACTER IN OCTAL FILL. THE THREE 00216000 + LOW ORDER BITS ARE CONVERTED AND COMPILATION 00217000 + CONTINUES. 00218000 +304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100 + 350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00218200 + SORT OR MERGE STATEMENT. 00218210 + 351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00218220 + 352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00218230 + NOT HAVE EXACTLY TWO PARAMETERS. 00218240 + 353 OUTPROCHECK: FIRST PARAMETER OF OUTPUT PROCEDURE MUST 00218250 + BE BOOLEAN. 00218260 + 354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00218270 + ONE-DIM ARRAY. 00218280 + 355 SORTSTMT: MISSING (. 00218290 + 356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO00218300 + 357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00218310 + PARAMETER. 00218320 + 358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00218330 + 359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00218340 + 360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00218350 + TWO PARAMETERS. 00218360 + 361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00218370 + 362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00218380 + 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390 + 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400 + PARAMETER. 00218410 + 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420 + 366 SORTSTMT: MISSING ). 00218430 + 367 MERGESTMT: MISSING (. 00218440 + 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450 + 369 MERGESTMT: MISSING ). 00218460 + 381 CMPLXSTMT: MISSING (. 00218500 + 382 CMPLXSTMT: TOO MANY OPERATORS. 00218505 + 383 CMPLXSTMT: TOO MANY OPERANDS. 00218510 + 384 CMPLXSTMT: MISSING , . 00218515 + 385 CMPLXSTMT: TOO FEW OPERANDS. 00218520 + 386 CMPLXSTMT: ILLEGAL PARAMETER. 00218525 + 400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00219000 + 401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00220000 + 402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00221000 + 403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00222000 + MONITOR LIST ELEMENT. 00223000 + 404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00224000 + ELEMENT. 00225000 + 405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00226000 + 406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00227000 + 407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00228000 + 408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00229000 + 409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00230000 + 410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00231000 + 411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00232000 + SUBSCRIPTS. 00233000 + 412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00234000 + SUBSCRIPTS. 00235000 + 413 DMUP:IMPROPER ARRAY DUMP LIST ELEMENT. 00236000 + 414 DMUP:ILLEGAL DUMP LIST ELEMENT. 00237000 + 415 DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS 00238000 + IN ONE DUMP DECLARATION. 00239000 + 416 DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER. 00240000 + 417 DMUP:MISSING OR NON-LOCAL LABEL IN DUMP DECLARATION. 00241000 + 418 DMUP:MISSING COLON IN DUMP DECLARATION. 00242000 + 419 DMUP:IMPROPER DUMP DECLARATION DELIMITER. 00243000 + 420 READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT. 00244000 + 421 READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE 00245000 + STATEMENT. 00246000 + 422 READSTMT:MISSING FILE IN READ STATEMENT. 00247000 + 00248000 + 424 READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT 00249000 + 425 READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT. 00250000 + 426 READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ 00251000 + STATEMENT. 00252000 + 427 READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT. 00253000 + 428 READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ 00254000 + STATEMENT. 00255000 + 429 READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT. 00256000 + 430 READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00257000 + STATEMENT. 00258000 + 00259000 + 00260000 + 00261000 + 00262000 + 433 HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT 00263000 + BRACKET IN READ OR SPACE STATEMENT. 00264000 + 434 SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT. 00265000 + 435 SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT. 00266000 + 436 SPACESTMT:MISSING COMMA IN SPACE STATEMENT. 00267000 + 437 SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT. 00268000 + 438 WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT. 00269000 + 439 WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT. 00270000 + 440 WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A 00271000 + WRITE STATEMENT. 00272000 + 441 WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART 00273000 + OF A WRITE STATEMENT. 00274000 + 442 WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE 00275000 + STATEMENT. 00276000 + 443 WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE 00277000 + STATEMENT. 00278000 + 444 WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT. 00279000 + 445 WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00280000 + IN A WRITE STATEMENT. 00281000 + 446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00282000 + 447 WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00283000 + STATEMENT. 00284000 + 448 WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT. 00285000 + 449 READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT. 00286000 + 450 LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT. 00287000 + 451 LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT. 00288000 + 452 LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT. 00289000 + 453 LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK 00290000 + STATEMENT. 00291000 + 454 LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT. 00292000 + 455 CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT. 00293000 + 456 CLOSESTMT:IMPROPER FILE PART IN A CLOSE STATEMENT. 00294000 + 457 CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT. 00295000 + 458 CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE 00296000 + STATEMENT. 00297000 + 459 CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00298000 + 460 RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT. 00299000 + 461 RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT. 00300000 + 462 RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00301000 + 463 BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION 00302000 + PART OF A PROCEDURE. 00303000 + 464 BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00304000 + OF A PROCEDURE. 00305000 + 465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003 + SIMPLE VARIABLE 00305004 + 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010 + 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020 + 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030 + 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040 + 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050 + 505 SEARCHLIB: MISSING BRACKET. 00305060 + 506 BLOCK: LONG APPEARS IMMEDIATELY BEFORE IDENTIFIER(NO TYPE). 00305070 + 507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080 + 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00305100 +; 00306000 +BEGIN COMMENT OUTERMOST BLOCK; 00500000 + INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000 + SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000 + INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000 + IF COMPILE & GO =0. FOR SYNTAX, =-1. MUST BE AT R+26;00504000 + INTEGER CARDNUMBER; 00504100 + INTEGER LASTADDRESS; 00504200 + ARRAY ENIL[0:7,0:127]; 00504300 + INTEGER ENILPTR; 00504400 + DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500 + ARRAY LDICT[0:7,0:127]; 00504600 + BOOLEAN BUILDLINE; 00504700 + COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS, 00505000 + TO SAVE SOME STACK SPACE; 00506000 + REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000 + COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000 + THE MAIN BLOCK; 00509000 + COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000 + REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000 + BEGIN SI~NCR; DI~LOC EXAMIN; DI~DI+7; DS~CHR END; 00512000 + REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100 + BEGIN 00512200 + SI ~ AC; SI ~ SI + CT; 00512300 + DI ~ LOC EXAMINELAST; DI ~ DI+7; 00512400 + DS ~ 1 CHR; 00512500 + END EXAMINELAST; 00512600 + COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000 + IN SORCE TO THE DK-TH CHARACTER IN DEST. 0{N{63,0{SK{127; 00514000 + DEFINE DK=DSK#; 00514500 + STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000 + VALUE N, SK, DSK ; 00516000 + BEGIN SI~LOC SK; SI~SI+6; 00517000 + IF SC!"0" THEN BEGIN SI~SORCE; 2(SI~SI+32); SORCE~SI END; 00518000 + SI~LOC DK; SI~SI+6; DI~DEST; 00519000 + IF SC!"0" THEN 2(DI~DI+32); 00520000 + SI~SORCE; SI~SI+SK; DI~DI+DK; DS~N CHR; 00521000 + END MOVECHARACTERS; 00522000 + INTEGER STREAM PROCEDURE GETF(Q); VALUE Q; 00523000 + BEGIN SI~LOC GETF; SI~SI-7; DI~LOC Q; DI~DI+5; 00524000 + SKIP 3 DB; 9(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB); 00525000 + DI~LOC Q; SI~Q; DS~WDS; SI~Q; GETF~SI 00526000 + END GETF; 00527000 + COMMENT START SETTING UP FILE PARAMETERS; 00528000 + IF EXAMIN(RR11~GETF(3)+"Y08" )!12 THEN RR1~5 ELSE 00529000 + BEGIN RR1~2; RR2~150END; 00530000 + IF EXAMIN(RR11+5)!12 THEN RR3~4 ELSE 00531000 + BEGIN RR3~2; RR4~150END; 00532000 + IF EXAMIN(RR11+10)=12 THEN 00533000 + BEGIN RR5~2; RR6~10; RR7~150END ELSE 00534000 + BEGIN RR5~1; RR6~56; RR7~10 END; 00535000 + IF EXAMIN(RR11+15)=12 THEN 00536000 + BEGIN RR8~10; RR9~150END ELSE 00537000 + BEGIN RR8~56; RR9~10 END; 00538000 + IF EXAMIN(RR11+20)=12 THEN RR10~150; 00539000 + BEGIN 01000000 + 01000100 + 01000200 + 01000300 + 01000400 + 01000500 + 01000600 + 01000700 + BOOLEAN CHECKTOG; 01000800 + BOOLEAN GOGOGO;% TRUE FOR SPECIAL WRITES AND READS 01000810 +PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830 + BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840 + % EVALUATING AN ARRAY BOUND 01000850 + INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860 + COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870 + BASENUM IS STARTING VALUE 01000880 + TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890 + CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900 + BOOLEAN SEQTOG, NEWBASE; COMMENT SEQTOG INDICATES SEQUENCING IS 01000910 + REQD. NEWBASE INDICATES A NEW BASENUM IS FOUND ON A NEW $ CRD;01000920 + BOOLEAN LASTCRDPATCH; COMMENT NORMALLY FALSE, SET TO 01000960 + TRUE WHEN THE LAST CARD FROM SYMBOLIC LIBRARY 01000970 + READ IS PATCHED FROM THE CARD READER; 01000980 + BOOLEAN LISTOG,PRTOG,DEBUGTOG,NEWTOG,PUNCHTOG,VOIDTAPE; 01001000 + BOOLEAN SINGLTOG; 01001010 +DEFINE NOHEADING=LISTOG.[46:1]# ; %%% TRUE IFF DATIME HAS NOT BEEN CALLD01001100 + COMMENT THESE TOGGLES SPECIFY THE ACTION REQUIRED BY A CONTROL CARD;01002000 + ARRAY SPECIAL[0:31]; 01003000 + COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000 + CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000 + SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000 + ARRAY INFO[0:31,0:255]; 01007000 + COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 + OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000 + THE INTERNAL CODE ( OR ELBAT WORD AS IT IS USUALLY 01010000 + CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000 + [1:1]) FOR PROCEDURES, THE LINK TO PREVIOUS ENTRY (IN 01012000 + [4:8]), THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000 + TION (IN [12:6]), AND THE FIRST 5 CHARACTORS OF ALPHA. 01014000 + SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000 + FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000 + AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLIT ACROSS A ROW 01017000 + OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000 + RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000 + DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000 + IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000 + OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 01022000 + ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000 + THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000 + THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000 + RESERVED WORDS OCCUPY THE SECOND ROW. IT IS FILLED DURING 01026000 + INITIALIZATION; 01027000 +COMMENT INFO FORMAT 01028000 + FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000 + ENTERED IN INFO: 01030000 + THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000 + THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000 + ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000 + ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000 + E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 01035000 + LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000 + THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000 + THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000 + POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000 + THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.,THE 01040000 + LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000 + FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000 + ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000 + WILL NOT DETRACT FROM THE DISCUSSION. 01044000 + ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000 + THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000 + FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000 + THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 01048000 + S[L] 01049000 + NOW THE DECLARATION 01050000 + BEGIN REAL A,B,C IS ENCOUNTERED 01051000 + IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000 + THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000 + CONSTRUCTED FOR A) 01054000 + T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 01055000 + INFO[NEXTINFO]~T. S[L]~NEXTINFO. 01056000 + NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000 + ENTRY. 01058000 + NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000 + ITSELF CONTAINS THE STOP FLAG ZERO. 01060000 + B IS ENTERED SIMILARLY TO A. 01061000 + NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000 + ENTRY FOR A. 01063000 + SIMILARLY,AFTER C IS ENTERED 01064000 + S[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000 + POINTS TO A. 01066000 + THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000 + FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000 + FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL 01069000 + FULL DECLARATION. 01070000 + PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000 + INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBTRACTED 01072000 + FROM THE CURRENT ENTRY INDEX. 01073000 + [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY.(<64) 01074000 + [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000 + AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000 + THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000 + THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000 + FOR X WOULD APPEAR AS FOLLOWS: 01079000 + INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000 + I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000 + I+2 = L 01082000 + I+3 = ELBATWRD (MADE FOR X) 01083000 + I+4 = 031X 01084000 + THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000 + THE ENTRY BEFORE SYMBOL, AND 01086000 + INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000 + ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000 + THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000 + FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000 + NECESSARY. 01091000 + THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000 + REAL 01093000 + BOOLEAN 01094000 + INTEGER 01095000 + ALPHA 01096000 + FILE 01097000 + FORMAT 01098000 + LIST 01099000 + OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000 + ARRAYS: 01101000 + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000 + DIMENSIONS(IN THE LOW ORDER PART).[40:8] 01103000 + EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000 + BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000 + THESE WORDS ARE MADE UP AS FOLLOWS: 01106000 + [22:1] =IF 1, THIS IS THE FINAL ROW OF A LONG ARRAY, WHICH 01106700 + WILL REQUIRE DOUBLING OF THE RAW INDEX VALUE AND 01106800 + AN EXTRA LEVEL OF INDEXING FOR LONGROWSZ-WORD ROWS. 01106900 + [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000 + SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000 + RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000 + TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000 + SUBTRACTED. 01111000 + [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000 + REQUIRES A PRT OR STACK CELL,OTHERWISE THE BIT 01113000 + 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000 + REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000 + [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000 + IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000 + PROCEDURES: 01118000 + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000 + PARAMETERS [40:8] 01120000 + IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000 + [13:11] ENDING PRT ADDRESS FOR LABELS, 01122000 + [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000 + OF LOCALS. 01124000 + SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000 + OF APPEARANCE IN FORMAL PARAPART) ARE 01126000 + ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000 + VALUE OR NOT([10:1]). 01128000 + THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000 + IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000 + CONTAINS THE NUMBER OF DIMENSIONS.OTHERWISE INCR IS MEANINGLESS. 01131000 + LINK([35:13]) IS MEANINGLESS. 01132000 + IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMATER IS 01133000 + THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000 + IS DONE IN THE STREAM PROCEDURE. 01135000 + LABELS: 01136000 + AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000 + BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000 + IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000 + LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000 + 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000 + SWITCHES: 01142000 + THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000 + ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000 + IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000 + NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000 + DEFINE MON =[ 1: 1]#, 01147000 + CLASS =[ 2: 7]#, 01148000 + FORMAL=[ 9: 1]#, 01149000 + VO =[10: 1]#, 01150000 + LVL =[11: 5]#, 01151000 + ADDRESS=[16:11]#, 01152000 + INCR =[27: 8]#, 01153000 + LINK =[35:13]#, 01154000 + DYNAM =[11:16]#, 01154100 + LINKR =[35: 5]#, 01155000 + LINKC =[40: 8]#; 01156000 + COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD. 01157000 + MON IS THE BIT WHICH IS TURNED ON IF: 01158000 + 1. THE QUANTITY IS TO BE MONITORED, OR 01158100 + 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200 + A DEFINE WITHOUT PARAMETERS. 01158300 + CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000 + QUANTITY. 01160000 + FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000 + PARAMETER. 01162000 + VO IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000 + DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000 + FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000 + FROM OTHERS. 01166000 + LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000 + ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000 + DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100 + DEFINE PARAMETER ENTRIES, ONLY. IT IS AN INDEX 01168200 + INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300 + THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400 + DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500 + NOT USE THE LVL FIELD, BUT MAKES USE OF NINFOO. 01168600 + INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION 01169000 + NEEDED, RELATIVE TO THE LOCATION IN INFO. 01170000 + LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE 01171000 + QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE 01172000 + NEXT ITEM IN THE STACK. ZERO IS AN END FLAG. 01173000 + LINKR AND LINKC ARE SUBDIVISIONS OF LINK.; 01174000 + COMMENT CLASSES FOR ALL QUANTITIES - OCTAL CLASS IS IN COMMENT; 01175000 + COMMENT CLASSES FOR IDENTIFIERS; 01176000 + DEFINE UNKNOWNID =00#, COMMENT 000; 01177000 + STLABID =01#, COMMENT 001; 01178000 + LOCLID =02#, COMMENT 002; 01179000 + DEFINEDID =03#, COMMENT 003; 01180000 + LISTID =04#, COMMENT 004; 01181000 + FRMTID =05#, COMMENT 005; 01182000 + SUPERFRMTID =06#, COMMENT 006; 01183000 + FILEID =07#, COMMENT 007; 01184000 + SUPERFILEID =08#, COMMENT 010; 01185000 + SWITCHID =09#, COMMENT 011; 01186000 + PROCID =10#, COMMENT 012; 01187000 + INTRNSICPROCID =11#, COMMENT 013; 01188000 + STRPROCID =12#, COMMENT 014; 01189000 + BOOSTRPROCID =13#, COMMENT 015; 01190000 + REALSTRPROCID =14#, COMMENT 016; 01191000 + ALFASTRPROCID =15#, COMMENT 017; 01192000 + INTSTRPROCID =16#, COMMENT 020; 01193000 + BOOPROCID =17#, COMMENT 021; 01194000 + REALPROCID =18#, COMMENT 022; 01195000 + ALFAPROCID =19#, COMMENT 023; 01196000 + INTPROCID =20#, COMMENT 024; 01197000 + BOOID =21#, COMMENT 025; 01198000 + REALID =22#, COMMENT 026; 01199000 + ALFAID =23#, COMMENT 027; 01200000 + INTID =24#, COMMENT 030; 01201000 + BOOARRAYID =25#, COMMENT 031; 01202000 + REALARRAYID =26#, COMMENT 032; 01203000 + ALFAARRAYID =27#, COMMENT 033; 01204000 + INTARRAYID =28#, COMMENT 034; 01205000 + LABELID =29#, COMMENT 035; 01206000 + COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000 + TRUTHV =30#, COMMENT 036; 01208000 + NONLITNO =31#, COMMENT 037; 01209000 + LITNO =32#, COMMENT 040; 01210000 + STRNGCON =33#, COMMENT 041; 01211000 + LEFTPAREN =34#, COMMENT 042; 01212000 + COMMENT CLASS FOR ALL DECLARATORS; 01213000 + DECLARATORS =35#, COMMENT 043; 01214000 + COMMENT CLASSES FOR STATEMENT BEGINNERS 01215000 + READV =36#, COMMENT 044; 01216000 + WRITEV =37#, COMMENT 045; 01217000 + SPACEV =38#, COMMENT 046; 01218000 + CLOSEV =39#, COMMENT 047; 01219000 + LOCKV =40#, COMMENT 050; 01220000 + REWINDV =41#, COMMENT 051; 01221000 + DOUBLEV =42#, COMMENT 052; 01222000 + FORV =43#, COMMENT 053; 01223000 + WHILEV =44#, COMMENT 054; 01224000 + DOV =45#, COMMENT 055; 01225000 + UNTILV =46#, COMMENT 056; 01226000 + ELSEV =47#, COMMENT 057; 01227000 + ENDV =48#, COMMENT 060; 01228000 + FILLV =49#, COMMENT 061; 01229000 + SEMICOLON =50#, COMMENT 062; 01230000 + IFV =51#, COMMENT 063; 01231000 + GOV =52#, COMMENT 064; 01232000 + RELEASEV =53#, COMMENT 065; 01233000 + BEGINV =54#, COMMENT 066; 01234000 + COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000 + SIV =55#, COMMENT 067; 01236000 + DIQ =56#, COMMENT 070; 01237000 + CIV =57#, COMMENT 071; 01238000 + TALLYV =58#, COMMENT 072; 01239000 + DSV =59#, COMMENT 073; 01240000 + SKIPV =60#, COMMENT 074; 01241000 + JUMPV =61#, COMMENT 075; 01242000 + DBV =62#, COMMENT 076; 01243000 + SBV =63#, COMMENT 077; 01244000 + TOGGLEV =64#, COMMENT 100; 01245000 + SCV =65#, COMMENT 101; 01246000 + LOCV =66#, COMMENT 102; 01247000 + DCV =67#, COMMENT 103; 01248000 + LOCALV =68#, COMMENT 104; 01249000 + LITV =69#, COMMENT 105; 01250000 + TRNSFER =70#, COMMENT 106; 01251000 + COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000 + COMMENTV =71#, COMMENT 107; 01253000 + FORWARDV =72#, COMMENT 110; 01254000 + STEPV =73#, COMMENT 111; 01255000 + THENV =74#, COMMENT 112; 01256000 + TOV =75#, COMMENT 113; 01257000 + VALUEV =76#, COMMENT 114; 01258000 + WITHV =77#, COMMENT 115; 01259000 + COLON =78#, COMMENT 116; 01260000 + COMMA =79#, COMMENT 117; 01261000 + CROSSHATCH =80#, COMMENT 120; 01262000 + LFTBRKET =81#, COMMENT 121; 01263000 + PERIOD =82#, COMMENT 122; 01264000 + RTBRKET =83#, COMMENT 123; 01265000 + RTPAREN =84#, COMMENT 124; 01266000 + COMMENT CLASSES FOR OPERATORS; 01267000 + NOTOP =85#, COMMENT 125; 01268000 + ASSIGNOP =86#, COMMENT 126; 01269000 + AMPERSAND =87#, COMMENT 127; 01270000 + EQVOP =88#, COMMENT 130; 01271000 + IMPOP =89#, COMMENT 131; 01272000 + OROP =90#, COMMENT 132; 01273000 + ANDOP =91#, COMMENT 133; 01274000 + RELOP =92#, COMMENT 134; 01275000 + ADOP =93#, COMMENT 135; 01276000 + MULOP =94#, COMMENT 136; 01277000 + FACTOP =95#, COMMENT 137; 01278000 + FAULTID = 126#, COMMENT 176; 01278100 + SUPERLISTID =127#, COMMENT 177; 01278500 + COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000 + OWNV =01#, COMMENT 01; 01280000 + SAVEV =02#, COMMENT 02; 01281000 + BOOV =03#, COMMENT 03; 01282000 + REALV =04#, COMMENT 04; 01283000 + ALFAV =05#, COMMENT 05; 01284000 + INTV =06#, COMMENT 06; 01285000 + LABELV =07#, COMMENT 07; 01286000 + DUMPV =08#, COMMENT 10; 01287000 + LISTV =09#, COMMENT 11; 01288000 + OUTV =10#, COMMENT 12; 01289000 + INV =11#, COMMENT 13; 01290000 + MONITORV =12#, COMMENT 14; 01291000 + SWITCHV =13#, COMMENT 15; 01292000 + PROCV =14#, COMMENT 16; 01293000 + ARRAYV =15#, COMMENT 17; 01294000 + FORMATV =16#, COMMENT 20; 01295000 + FILEV =17#, COMMENT 21; 01296000 + STREAMV =18#, COMMENT 22; 01297000 + DEFINEV =19#, COMMENT 23; 01298000 + LONGV =20#; COMMENT 24; 01298100 +DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000 +DEFINE LONGROWSZ=256#; % SIZE OF LONG-ARRAY SEGMENTED ROWS 01299300 + REAL TIME1; 01300000 + INTEGER SCRAM; 01301000 + COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000 + OR RESERVED WORD SCANNED; 01303000 +ARRAY FILEATTRIBUTES[0:30] ; 01303500 + ALPHA ARRAY ACCUM[0:10]; 01304000 + COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000 + SCANNED ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000 + IN INFO, THAT IS ACCUM[1] = 00NAAAAA. ACCUM[I] , I> 1, 01307000 + HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000 + THE ELBAT WORD BY THE ENTER ROUTINES; 01309000 + ARRAY STACKHEAD,SUPERSTACK[0:124]; %WF 01310000 + COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO. THIS INDEX %WF 01311000 + POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100 + LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200 + BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300 + AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400 + WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500 + 1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600 + 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700 + 3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800 + STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900 + FOR MORE INFORMATION ON THE USE OF SUPERSTACK, SEE %WF 01312000 + COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100 + INTEGER COUNT; 01313000 + COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 01314000 + SCANNED; 01315000 + ALPHA Q; 01316000 + COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000 + WORD SCANNED; 01318000 + ARRAY ELBAT[0:75]; INTEGER I, NXTELBT; 01319000 + COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000 + QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000 + (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000 + GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000 + FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000 + POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000 + INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000 + FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000 + INTEGER ELCLASS; 01328000 + COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000 + INTEGER LASTELCLASS; 01329100 + COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200 + INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000 + INTEGER MAXTLCR; 01331000 + COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF 01332000 + THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS 01333000 + OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000 + CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000 + THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000 + IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000 + DEFINE BUFFSIZE = 56#; 01338000 + 01339000 + INTEGER GTIX; 01339050 + ARRAY TEN[0:69]; 01340000 + INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050 + DECLARED IN THE OBJECT PROGRAM; 01340060 + INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070 + GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080 + REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500 + INTEGER IDLOC,IDLOCTEMP; 01341000 + ARRAY PDPRT[0:31,0:63]; 01342000 + COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000 + IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000 + BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000 + OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000 + TYPE 1 ENTRY 01347000 + BIT POSITION KIND OF ENTRY 01348000 + 0-3 ZERO 01349000 + 4 MODE BIT(1=CHAR 0=WORD) 01350000 + 5 ARGUMENT BIT 01351000 + 6-7 ZERO 01352000 + 8-17 RELATIVE ADDRESS IN PRT 01353000 + 18-27 RELATIVE ADDRESS IN SEGMENT 01354000 + 28-37 SEGMENT NUMBER 01355000 + 38-47 ZERO 01356000 + TYPE 2 ENTRY 01357000 + BIT POSITION KIND OF ENTRY 01358000 + 0 EMPTY 01359000 + 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000 + 2 ON IFF INTRINSIC PROCEDURE 01361000 + 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050 + 4-12 EMPTY 01361100 + 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200 + 28-37 SEGMENT NUMBER 01361300 + 38-47 NUMBER OF WORDS IN SEGMENT 01362000 + THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000 + IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000 + ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000 + DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000 + IS READY FOR OUTPUT; 01367000 +COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010 + COMPILATION IS AS FOLLOWS: 01367020 + SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030 + BIT POSITIONS CONTENTS OF FIELD 01367040 + [0:1] EMPTY 01367050 + [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060 + [2:1] ON IFF INTRINSIC PROCEDURE 01367070 + [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075 + [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080 + [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085 + [8:10] R-RELATIVE LINK TO A PRT ENTRY FOR THIS SEGMENT 01367090 + [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100 + [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110 + PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120 + BIT POSITIONS CONTENTS OF FIELD 01367130 + [0:4] 1101(BINARY) NON-PRESENT PROG. DESC. ID BITS 01367140 + [4:2] MODE AND ARGUMENT BITS 01367150 + [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160 + [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170 + PRT ENTRY FOR SEGMENT I 01367180 + [18:15] I 01367190 + [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200 +COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210 + WORD CONTENTS 01367220 + 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230 + 1 SIZE OF SEGMENT DICTIONARY 01367240 + 2 RELATIVE LOCATION OF PRT 01367250 + 3 SIZE OF PRT 01367260 + 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270 + 5 SIZE OF FILE PARAMETER BLOCK 01367280 + 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290 + 7 N 01367300 + . O U 01367310 + . T S 01367320 + . E 01367330 + 29 D; 01367340 +INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000 +INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000 +INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000 + ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000 + COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000 + AS SPECIFIED BY "L". 01373000 + IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 01374000 + THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 01375000 + REAL LASTENTRY ; 01376000 + COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 01377000 + INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 01378000 + BOOLEAN MRCLEAN ; 01379000 + COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000 + FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000 + POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000 + DURING AN ARRAY DECLARATION ; 01383000 + REAL GT1,GT2,GT3,GT4,GT5; 01384000 + INTEGER GTI1; 01384500 + COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000 + INTEGER RESULT; 01386000 + COMMENT THIS VARIABLE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000 + ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000 + VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000 + USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000 + INTEGER LASTUSED; 01391000 + COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000 + READACARD, THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000 + OR PREPARES THE CARD FOR THE SCANNER. 01394000 + IF LASTUSED = 1 THEN READ CARDS ONLY 01395000 + IF LASTUSED = 2 THEN LAST CARD IMAGE FROM READER (MERGING)01396000 + IF LASTUSED = 3 THEN LAST CARD IMAGE FROM TAPE (MERGING) 01397000 + IF LASTUSED = 4 THEN READ NO CARD (FOR INITIALIZATION); 01398000 + BOOLEAN LINKTOG; 01399000 + COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK, 01400000 + OTHERWISE IT IS TRUE; 01401000 + INTEGER LEVEL,FRSTLEVEL,SUBLEVEL,MODE; 01402000 + COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 01403000 + TRACK OF LEVELS OF DEFINITION. LEVEL GIVES THE DEPTH OF 01404000 + NESTING IN DEFINITION, WHERE EACH BLOCK AND EACH PROCEDURE01405000 + GIVES RISE TO A NEW LEVEL. SUBLEVEL GIVES THE LEVEL OF 01406000 + THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 01407000 + FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST 01408000 + GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED. MODE 01409000 + IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000 + NESTED (AT COMPILE TIME); 01411000 + INTEGER AUXMEMREQ; 01411010 + BOOLEAN SAVEPRTOG; 01411020 + COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030 + ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040 + AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050 + WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060 + "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070 + TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080 + TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090 + ROUTINE IS "PSEUDO-SAVE". 01411100 + ; 01411110 + BOOLEAN ERRORTOG; 01412000 + COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000 + ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000 +BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000 + COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000 + BOOLEAN STREAMTOG; 01417000 + COMMENT STREAMTOG IS TRUE IF WE ARE COMPILING STREAM STATEMENT. IT 01418000 + IS USED TO CONTROL COUMPOUNDTAIL; 01419000 +DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000 + FI = 6#, FIO = 7#; 01420500 + COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE. 01421000 + THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000 + THEIR MEANING IS: 01423000 + FS MEANS FROM STATEMENT, 01424000 + FP MEANS FROM PRIMARY, 01425000 + FL MEANS FROM LIST, 01426000 + FR MEANS FROM FOR, 01427000 + FIO MEANS FROM IODEC, 01427250 + FA MEANS FROM ACTUALPARAPART, 01427500 + FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600 + INTEGER L; 01428000 + COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000 + DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#; 01430000 + COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000 + PROGRAMS. 01432000 + BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000 + BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000 + IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000 + BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T301436000 + INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 01437000 + JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 01438000 + IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 01439000 + THINGS ON THE TOP OF THE STACK. 01440000 + XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 01441000 + WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 01442000 + USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 01443000 + THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE01444000 + STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 01445000 + LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 01446000 + THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 01447000 + BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW. THIS CARRIES YOU 01448000 + TO THE PROPER ITEM IN THE LIST. THE FORMATING ROUTINES 01449000 + SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 01450000 + LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 01451000 + DEFINE BTYPE =1#, DTYPE =2#, ATYPE =3#; 01452000 + COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 01453000 + ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 01454000 + BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 01455000 + FOR ARITHMETIC EXPRESSIONS; 01456000 + BOOLEAN TB1; 01457000 + COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE; 01458000 + INTEGER JUMPCTR; 01459000 + COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK01460000 + AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000 + BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000 + SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000 + MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000 + OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED01465000 + IF LEVEL = JUMPCTR; 01466000 + BOOLEAN GOTOG; 01467000 + COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY01468000 + LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000 + MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000 + REAL STLB; 01471000 + COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000 + THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000 + ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000 + INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000 + FOR TEMPORARY STORAGE; 01476000 + DEFINE BUMPL = L~L+2#; 01477000 + COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000 + DEFINE IDMAX = LABELID#; 01479000 + COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000 + INTEGER DEFINECTR,DEFINEINDEX; 01481000 + ALPHA ARRAY DEFINFO[0:89]; 01481100 + ALPHA ARRAY TEXT[0:31,0:255]; 01481200 + INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300 + INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400 + REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000 + LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000 + NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS;01484000 + JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000 + COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000 + ARRAY MACRO[0:35]; 01487000 + COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000 +REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000 + Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000 + SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000 + COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000 + DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS. 01493000 + THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000 + TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000 + THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000 + ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000 + THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000 + INTEGER BEGINCTR; 01499000 + COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED01500000 + FOR ERROR CONTROL ONLY; 01501000 + INTEGER DIALA,DIALB; 01502000 + COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000 + DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000 + WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000 + BY SETTING DIALA AND DIALB TO ZERO; 01506000 + 01507000 + 01508000 + 01509000 + 01510000 + 01511000 + 01512000 + 01513000 + 01514000 + 01515000 + 01516000 + 01517000 + 01518000 + 01519000 + 01520000 + 01521000 +BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000 + SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000 + COMMENT AT RR1; 01524000 + BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000 +DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000 + THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000 + THE FIRST WORD OF ADDITIONAL INFO; 01528000 +DEFINE SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000 + THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000 + INFO FOR MONITORED SIMPLE VARIABLES; 01531000 +DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000 + FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000 + IN NODIMPART; 01534000 +DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01536000 + INFO THAT CONTAINS THE MONITOR FILE 01537000 + ADDRESS FOR LABELS; 01538000 +DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01540000 + INFO THAT CONTAINS THE MONITOR FILE 01541000 + ADDRESS FOR LABELS; 01542000 +DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01544000 + INFO THAT CONTAINS THE MONITOR FILE 01545000 + ADDRESS FOR LABELS; 01546000 +DEFINE DUMPEE = [2:11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000 + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000 + THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000 + EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000 + APPEARS IN A DUMP DECLARATION; 01551000 +DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000 + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000 + THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000 + FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000 + THE PRINTI ROUTINE; 01556000 + DEFINE CHUNK = 180#; 01556100 + FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200 + FILE IN CARD (RR1,10,RR2); 01557000 + SAVE 01558000 + FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000 + ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010 + INTEGER DA; 01559020 +DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) ELSE 01559030 + WRITE(LINE[DBL],15,LIN[*])#; 01559039 + SAVE FILE OUT NEWTAPE DISK SERIAL [20:2400] (RR5,RR6,RR7,SAVE 1); 01560000 + FILE IN TAPE "0CRDIMG" (2,RR8,RR9); 01561000 + SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005 + COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010 + FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020 + FILE IN CASTB(1,BUFFSIZE); 01561030 + FILE IN CASTC(1,BUFFSIZE); 01561040 + SWITCH FILE LIBRARY~CASTA,CASTB,CASTC; 01561050 + FILE OUT REMOTE 19 (2,10); 01561055 + BOOLEAN REMOTOG; 01561056 + ARRAY LIBARRAY[0:24]; COMMENT LIBARRAY IS USED TO KEEP INFORMATION 01561060 + AS TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070 + EACH ENTRY CONSISTS OF THREE WORDS CONTAINING; 01561080 + DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090 + NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100 + DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110 + INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120 + COMMENT LIBINDEX IS A INDEX INTO LIBARRAY 01561130 + INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140 + LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150 + MAXTLCR USED IN READACARD. FILEINX IS THE 01561160 + LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 01561170 + SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180 + FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190 + REAL RECOUNT,FINISHPT; 01561200 + BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202 + PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204 + BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206 + CARD READER ELSE FALSE; 01561208 + COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210 + BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215 + OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217 + DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220 + BLOCKS PER LIBRARY TAPE; 01561230 + ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240 + DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250 + A: 1 CAR- NUMBER OF DIRECTORY BLOCKS, 01561260 + B: 1 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270 + IDENTIFIER NAME, 01561280 + C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER, 01561290 + D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300 + ENTRIES. 01561310 + ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320 + LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330 + DIRECTORY BLOCKS. 01561340 + ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350 + AND THEN ITEM D WILL FOLLOW INDICATING THE 01561360 + LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370 + ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380 + BLOCK, 01561390 + IN ORDER TO CHANGE: 01561400 + NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410 + 01561020 - 01561050. 01561420 + - CHANGE "3" AT 01561430 + NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440 + AT ; 01561450 + REAL C; 01562000 + COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000 + REAL T; 01564000 + COMMENT T IS A TEMPORARY CELL; 01565000 + INTEGER TCOUNT; 01566000 + COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000 + FOR THE USE OF CONVERT; 01568000 + REAL STACKCT; %A 01568500 + DEFINE LOGI =443#, 01569000 + EXPI =440#, 01570000 + XTOTHEI =480#, 01571000 + GOTOSOLVER =484#, 01572000 + PRINTI =477#, 01573000 + MERGEI =500#, 01573100 + POWERSOFTEN =663#, 01574000 + LASTSEQUENCE =154#, 01575000 + LASTSEQROW = 2#, 01576000 + INTERPTO =461#, 01577000 + SUPERMOVER =555#, 01577500 + CHARI =465#, 01578000 + INTERPTI =469#, 01579000 + SORTI =473#, 01579100 + DIALER =559#, 01579200 + FILATTINT =563#, 01579300 + POWERALL =567#, 01579350 + SPECIALMATH =570#, 01579355 + SORTA =664# ; 01580000 + COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000 + IN INFO OF THE CORRESPONDING ROUTINE; 01582000 +INTEGER KOUNT,BUFFACCUM; 01583000 +INTEGER FILENO; 01584000 + BOOLEAN 01585000 + FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000 + FUNCTION; 01587000 + P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 01588000 + P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 01589000 + P5, COMMENT TELLS WHETHER LONG WAS SEEN; 01589600 + VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000 + FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000 + PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000 +SPECTOG, 01593000 + STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000 + ONE ID AND THEN EIXT; 01595000 + AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000 +BOOLEAN STOPDEFINE; 01597000 +REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100 +INTEGER MAXSAVE; 01598000 + COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000 + DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000 + FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000 + REAL 01602000 + KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000 + ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000 + LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000 + LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000 + INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000 + PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000 + DECLARED; 01609000 + G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000 + TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000 + BEING DECLARED; 01612000 + PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000 + DECLARED; 01614000 + MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000 + OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000 + PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000 + J, COMMENT ARRAY COUNTER; 01618000 + LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000 + NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000 + FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000 + IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000 + SAVEL; COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000 +INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000 + ENTERED IN INFO AT ANY GIVEN TIME; 01625000 + REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100 +PROCEDURE UNHOOK;FORWARD; 01626000 +PROCEDURE MAKEUPACCUM;FORWARD; 01627000 +DEFINE PURPT=[4:8]#,SECRET=2#; 01628000 + COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000 + NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000 + FULL NAME IS ALSO GIVEN; 01631000 + DEFINE 01632000 + ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000 + BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000 + BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000 + BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000 + BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000 + CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000 + CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000 + COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000 + COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000 + DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; %A 01642000 + DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000 + EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000 + LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000 + LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000 + GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000 + LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000 + LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000 + GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000 + IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000 + INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000 + ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000 + ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000 + LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000 + LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000 + LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000 + LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000 + LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000 + LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQIVALENCE; 01660000 + LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000 + MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100 + MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000 + MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000 + NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000 + NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000 + PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000 + PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000 + RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000 + RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000 + RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000 + SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000 + SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100 + SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000 + STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000 + SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000 + XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000 + XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000 + ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000 + COMMENT THESE DEFINES ARE USED BY EMITD; 01678000 + DEFINE 01679000 + DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000 + DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000 + TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000 +REAL MAXSTACK,STACKCTR; 01683000 +INTEGER MAXROW; 01684000 + COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000 + ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000 +INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000 +INTEGER F; 01688000 + STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010 + BEGIN LOCAL T1,T2,T3; 01688020 + SI~EDOC;T1~SI;SI~TEDOC;T2~SI;SI~LOC EDOC;SI~SI+3;DI~LOC T3; 01688030 + DI~DI+5;SKIP 3 DB;15(IF SB THEN DS~1 SET ELSE DS~1 RESET; 01688040 + SKIP 1 SB);SI~LOC EDOC;DI~LOC T2; DS~ 5 CHR;3(IF SB THEN DS~ 01688050 + 1 SET ELSE DS ~ 1 RESET; SKIP 1 SB);DI~T3;SI~LOC T2;DS~WDS; 01688060 + DI~LOC T3;DI~DI+5;SKIP 3 DB;SI~LOC TEDOC;SI~SI+3;15(IF SB 01688070 + THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);SI~ LOC TEDOC;DI~LOC 01688080 + T1; DS~5 CHR;3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB); 01688090 + DI~T3;SI~LOC T1;DS~WDS 01688100 + END; 01688110 + REAL NLO,NHI,TLO,THI; 01689000 + BOOLEAN DPTOG; 01690000 + COMMENT THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;01691000 +DEFINE FZERO=896#; 01692000 +REAL T1,T2,N,K,AKKUM; 01693000 +BOOLEAN STOPGSP; 01694000 +INTEGER BUP; 01695000 + COMMENT UNIQUE GLOBAL TEMP FOR BLOCK; 01696000 +ARRAY GTA1[0:10]; 01697000 + BOOLEAN ARRAY SPRT[0:31]; 01698000 + COMMENT SPRT IS TO BE CONSIDERED TO BE AN ARRAY OF 32 32 BIT 01699000 + FIELDS. THE 32 BITS ARE IN THE LOW ORDER PART OF EACH 01700000 + WORD. THE BIT IS ON IF AND ONLY IF THE CORRESPONDING 01701000 + PRT CELL HAS A PERMANENT ASSIGNMENT; 01702000 + INTEGER PRTI,PRTIMAX; 01703000 + COMMENT PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-01704000 + MENT. PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000 + TEMPORARY ASSIGNMENT; 01706000 +DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000 + POSITION IN THE SECOND WORD OF INFO WHICH 01708000 + CONTAINS THE LENGTH OF ALPHA; 01709000 +DEFINE EDOCINDEX = L.[36:3],L.[39:7]#; COMMENT EDOCINDEX IS THE WORD 01710000 + PORTION OF L SPLIT INTO A ROW AND01711000 + COLUMN INDEX FOR EDOC; 01712000 +DEFINE CPLUS1 = 769#; COMMENT SEE COMMENT AT CPLUS2 DEFINE; 01713000 +DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000 + USED IN THE GENERATION OF C-RELATIVE CODE; 01715000 + PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01716000 + ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD; 01717000 + BOOLEAN MACROID; 01717800 + REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900 + PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950 + PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000 + REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100 + PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200 + INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000 + BOOLEAN LISTMODE; 01720000 + COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000 + IS BEING GENERATED OR A STATEMENT; 01722000 + INTEGER LSTR; 01723000 + COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000 + USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000 + PROCEDURE SCANNER; FORWARD; 01730000 + COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLUTE ADDRESS; 01732000 + REAL STREAM PROCEDURE MKABS(A); 01733000 + BEGIN DI ~ A; MKABS ~ DI END MKABS; 01734000 + STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000 + BEGIN LOCAL T; 01736000 + SI~LOC W; DI~LOC T; SI~SI+6; DI~DI+7; DS~CHR; 01736100 + SI~A; DI~B; T(DS~32 WDS; DS~32 WDS); DS~W WDS; 01736200 + END MOVE; 01736300 + STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000 + VALUE NDIV32,NMOD32 ; 01737050 + BEGIN DI := DEST; 01737100 + NDIV32(32(DS :=8 LIT"0")); 01737150 + NMOD32(DS := 8 LIT"0"); 01737200 + END; 01737250 +COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 01737300 +STREAM PROCEDURE BLANKET(N,THERE); VALUE N; 01737350 + BEGIN 01737400 + DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS; 01737450 + END BLANKET; 01737500 + 01738000 + 01739000 + 01740000 + PROCEDURE STEPIT; FORWARD; 01741000 + COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100 + STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200 + BEGIN 01741300 + DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400 + END; 01741500 + STREAM PROCEDURE SEQERR(L);BEGIN DI~L;DS~8 LIT" SEQ";END; 01742100 + BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200 + COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300 + TRUE IF ANY VISIBLE CHARACTER ; 01742400 + BEGIN 01742500 + LABEL NED; 01742600 + SI~FCR; 01742700 + TALLY~0; 01742800 + 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900 + TALLY~63; 01743000 + NED: TALLY~TALLY+1; 01743100 + NONBLANK~TALLY 01743200 + END NONBLANK; 01743300 + INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN-TIME ERROR KLUDGE-- 01750000 + GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000 + FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000 + BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000 + ABOUT FAULTLEVEL; 01754000 + INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000 +STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR); VALUE NCR; 01756000 + BEGIN 01757000 + LABEL L,TRANS; 01758000 + LOCAL N; 01759000 + SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000 + SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000 + 2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000 + SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-80. 01763000 +L: 01764000 + IF SC=""" THEN 01765000 + BEGIN 01766000 + SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN 01767000 + NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01768000 + 8(IF SC=""" THEN JUMP OUT ELSE 01769000 + BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01770000 + END 01771000 + ELSE BEGIN 01772000 + NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01773000 + DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN 01774000 + 8(IF SC=" " THEN JUMP OUT ELSE 01775000 + BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01776000 + END; 01777000 +TRANS: 01778000 + SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000 + SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000 + N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000 + DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000 + DI:=VR; SI:=LOC VP; DS:=WDS;% ADDRESS OF VOID RANGE. 01783000 + END OF GETVOID; 01784000 +REAL VOIDCR,VOIDPLACE; 01785000 +BOOLEAN SORTMERGETOG; 01786000 + FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000 + PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000 + BUG(X24,4(A4,X2)); 01802000 +PROCEDURE DATIME; 01820000 + BEGIN 01821000 + INTEGER H,MIN,Q; 01822000 + ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE; 01823000 + BEGIN 01824000 + DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2; 01825000 + 2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR; 01826000 + END OF DATER; 01827000 + H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60; 01828000 + WRITE(LINE[DBL], 01829000 + , 01832000 + TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000 + Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000 + IF H}12 THEN "P" ELSE "A"); 01835000 + NOHEADING:=FALSE; 01836000 + END OF DATIME; 01837000 + DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000 + COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000 + AND SCANNING THEM; 02001000 + BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020 + VALUE ROW ; 02001030 + BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040 + REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050 + ; 02001060 + LOCAL DPPOS,TEMP,LGTH; 02001070 + LABEL LOOP,EXIT; 02001080 + SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090 + DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100 + SI~SI+8; 02001110 + LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120 + DI~ACC1; DI~DI+2; SI~SI-1; 02001130 + IF SC = DC 02001140 + THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150 + IF LGTH SC = DC 02001160 + THEN BEGIN COMMENT FOUND IT; 02001170 + DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180 + IF SC = "0" 02001190 + THEN BEGIN COMMENT WE MAY BE IN THE02001200 + WRONG ROW; 02001210 + SI~SI+1;DI~LOC LOOK; 02001220 + IF 3 SC = DC 02001230 + THEN BEGIN COMMENT WE ARE02001240 + IN THE WRONG 02001250 + ROW; 02001260 + SI~DPPOS; 02001270 + SI~SI+8; 02001280 + DPPOS~SI; 02001290 + DI~LOC TEMP; 02001300 + DS~WDS; 02001310 + SI~TEMP; 02001320 + END 02001330 + ELSE SI~SI-4; 02001340 + END; 02001350 + DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360 + SI~SI+ LGTH; 02001370 + DI~STOPOS; DS~5 LIT"0"; 02001375 + DS~3 CHR; GO TO EXIT; 02001380 + END; 02001390 + SI~SI+3; 02001400 + END 02001410 + ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420 + SI~SI-1; 02001430 + IF SC = "0" 02001440 + THEN BEGIN COMMENT MAY BE NEW ROW; 02001450 + SI~SI+1; DI~LOC LOOK; 02001460 + IF 3 SC = DC 02001470 + THEN BEGIN COMMENT CHANGE ROWS; 02001480 + SI~DPPOS;SI~SI+8;DPPOS~SI;02001490 + DI~LOC TEMP; DS~WDS; 02001500 + SI~TEMP; 02001510 + END 02001520 + ELSE BEGIN COMMENT IT IS NOT HERE; 02001530 + TALLY~1; LOOK~TALLY; 02001540 + GO TO EXIT; 02001550 + END; 02001560 + GO TO LOOP; 02001563 + END; 02001565 + SI~SI+LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568 + END; 02001570 + GO TO LOOP; 02001580 + EXIT:; 02001590 + END LOOK; 02001600 + 02001750 + 02001760 + 02001763 + 02001765 + 02001770 + 02001780 + 02001790 + 02001800 + 02001810 + 02001820 + 02001825 + 02001826 + 02001827 + 02001828 + 02001830 + REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831 + BEGIN 02001832 + SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833 + END CONV; 02001834 + COMMENT ZOT INSERTS THE CHARACTOR CHAR INTO THE POSITION GIVEN BY 02002000 + LCR. IT RETURNS THE CHARACTOR PREVIOUSLY IN LCR THROUGH 02003000 + RET. THE PRIMARY PURPOSE OF THE ROUTINE IS TO INSERT A 02004000 + PERCENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02005000 + THE SCANNER AND TO REMEMBER THE PREVIOUS CHARACTOR IN CASE02006000 + IT IS NEEDED BY THE ERROR ROUTINES; 02007000 + STREAM PROCEDURE ZOT(RET,CHAR,LCR); VALUE CHAR,LCR; 02008000 + BEGIN DI ~ RET; SI ~ LCR; DS ~ WDS; 02009000 + COMMENT BRING OUT THE CHARACTOR IN COLUMN 73; 02010000 + DI~LCR; SI~LOC LCR; SI~SI-1; DS~CHR; 02011000 + COMMENT CHANGE CHARACTOR IN COLUMN 73 TO CHAR; 02012000 + END ZOT; 02013000 + COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010 + IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020 + THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030 + NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040 + VARIABLE AD; 02013050 + STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060 + VALUE AD,DESCRP; 02013065 + BEGIN 02013070 + LOCAL HOLD,ZONEP; 02013073 + DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074 + COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075 + DI~SUM; DI~DI+7; DS~2 RESET; 02013076 + COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077 + SI~LOC DESCRP; SI~SI+7; 02013078 + IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080 + DS~WDS; DI~HOLD; END 02013085 + ELSE DI~SEQLOC; 02013090 + COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091 + HOLD~DI; DI~DI+7; DS~2 RESET; DI~HOLD; 02013095 + SI ~ LOC AD; 02013100 + SI ~ SI + 7; 02013110 + IF SC = "1" THEN BEGIN SI~ SUM; DS~8 ADD; END 02013120 + ELSE BEGIN SI~ SUM; DS~8 SUB; END; 02013130 + SI~LOC ZONEP; DI~HOLD; DS~8 ZON; 02013135 + SI~LOC ZONEP; DI~SUM; DS~8 ZON; 02013136 + COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137 + END ADDER; 02013140 +COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150 +COMPILABLE QUANTITIES, THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155 +A LIBRAY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160 + PROCEDURE SEARCHLIB(DOLLAR); 02013165 + VALUE DOLLAR; BOOLEAN DOLLAR; 02013170 + BEGIN 02013175 + LABEL EXIT,EXITOUT, NOPARTIAL; 02013180 + BOOLEAN TEMPLISTOG; 02013183 + IF DOLLAR THEN 02013185 + BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190 + RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195 + RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200 + IF FILEINX~ACCUM[1].[21:3]<1 OR FILEINX > 3 THEN BEGIN 02013205 + COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013220 + FLAG(500); LISTOG~TEMPLISTOG; GO TO EXIT; 02013222 + END; 02013225 + FILEINX ~ FILEINX -1; 02013230 + IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235 + BEGIN COMMENT MUST READ DIRECTORY; 02013240 + GT3~MKABS(LIBRARY[FILEINX](0)); 02013245 + MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250 + GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255 + WHILE GT2 ~ GT2-1 > 0 DO 02013260 + BEGIN 02013265 + READ(LIBRARY[FILEINX]); 02013270 + MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275 + END; 02013280 + END; 02013285 + RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROG.ID.; 02013290 + IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295 + BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013303 + FLAG(501); LISTOG~TEMPLISTOG; GO TO EXIT; 02013305 + END; 02013310 + WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013313 + DO BEGIN 02013315 + IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317 + RESULT~5; SCANNER; 02013318 + END; 02013319 + GO TO NOPARTIAL; 02013320 + EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT SPACE PAST "[" ;02013330 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET START POINT;02013335 + IF RESULT ! 3 THEN 02013340 + BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013348 + FLAG(502); LISTOG~TEMPLISTOG; GO TO EXIT; 02013350 + END; 02013355 + GT1 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013365 + IF RESULT ! 2 THEN 02013370 + BEGIN COMMENT ERROR 503 - NO SEPERATOR; 02013375 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013378 + FLAG(503); LISTOG~TEMPLISTOG; GO TO EXIT; 02013380 + END; 02013385 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET LENGTH; 02013390 + IF RESULT ! 3 THEN 02013395 + BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013403 + FLAG(504); LISTOG~TEMPLISTOG; GO TO EXIT; 02013405 + END; 02013410 + GT2 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013420 + IF ACCUM[1] ! "1]0000" THEN 02013425 + BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430 + TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013433 + FLAG(505); LISTOG~TEMPLISTOG; GO TO EXIT; 02013435 + END; 02013440 + WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013445 + DO BEGIN RESULT ~ 5; SCANNER END; 02013446 + END; 02013450 + NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475 + LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480 + LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490 + LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495 + LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497 + FINISHPT ~ GT2; 02013500 + IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3].FILEINDEX) 02013505 + |3,0] ~ RECOUNT -1; 02013510 + RECOUNT~GT1; 02013515 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525 + IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526 + ELSE IF MAXLTLCR.[33:15]-NCR.[33:15]<11 THEN 02013527 + GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528 + LIBARRAY[LIBINDEX+2].NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530 + IF LASTUSED{2 OR LASTUSED=5 THEN 02013533 + LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534 + LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535 + IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536 + LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537 + LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538 + END ELSE BEGIN 02013539 + LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540 + ELSE LASTUSED~5; 02013541 + LIBINDEX ~ LIBINDEX + 3; 02013542 + END 02013545 + ELSE 02013550 + BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555 + LIBINDEX ~ LIBINDEX -3; 02013560 + RECOUNT~RECOUNT-1; 02013563 + LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565 + IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567 + DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568 + DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570 + IF LIBINDEX > 0 THEN 02013575 + FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580 + FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600 + IF LIBINDEX ! 0 THEN 02013610 + MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615 + IF LASTUSED{2 OR LASTUSED=5 THEN NCR~MKABS(CARD(0)) ELSE 02013617 + NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620 + IF LASTUSED{2 OR LASTUSED=5 THEN LCR~MKABS(CARD(9)) ELSE 02013621 + LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625 + NORELEASE~TRUE; 02013627 + IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628 + END OF UNLINK; 02013630 + IF LIBINDEX = 0 THEN 02013635 + BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640 + SEQSUM~0; 02013645 + END 02013650 + ELSE 02013655 + BEGIN 02013660 + GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665 + GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670 + GT3 ~(GT2 - GT1)DIV 5; 02013675 + SPACE(LIBRARY[FILEINX],GT3); 02013680 + 02013681 + 02013682 + READ(LIBRARY[FILEINX]); 02013685 + 02013690 + 02013693 + 02013695 + MOVE(1,LIBRARY[FILEINX](0),GTI1); 02013697 + IF GTI1!GT2 AND GTI1 ! 0 THEN 02013699 + BEGIN COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 02013701 + FLAG(507); GO TO EXIT; 02013702 + END; 02013703 + LTLCR~MKABS(LIBRARY[FILEINX](10))+(GTI1~(((RECOUNT-1) MOD 5) |11)); 02013705 + MAXLTLCR~MKABS(LIBRARY[FILEINX](0))+54; 02013710 + ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713 + IF LASTUSED= 6 THEN BEGIN 02013714 + NCR~LCR~MKABS(LIBRARY[FILEINX](0)); 02013715 + ZOT(GT1, "%", LCR); 02013716 + END; 02013717 + END; 02013718 + EXIT: END SEARCHLIB; 02013720 + COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000 + AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000 + BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000 + BEGIN SI~FCR; IF SC!"$" THEN TALLY~1; 02017000 + DI~NEW; DS~10 WDS; WRITNEW~TALLY 02018000 + END WRITNEW; 02019000 + 02020000 + 02021000 + 02022000 + 02023000 + STREAM PROCEDURE PRINT(LINE,NCR,R,SYMBOL); VALUE NCR,R,SYMBOL; 02024000 + BEGIN 02025000 + DI ~ LINE; DS ~ 16 LIT " "; 02026000 + SI ~ NCR; DS ~ 9 WDS; 02027000 + DS ~ 8 LIT " "; 02028000 + DS ~ WDS; 02029000 + DS~LIT" "; SI~LOC SYMBOL; SI~SI+7; 02030000 + DS~CHR; DS~2 LIT" "; 02030100 + SI~LOC R; SI~SI+4; 02030200 + IF SC =" " THEN DS~4 LIT" " ELSE 02030300 + BEGIN SI~SI-4; DS~4 DEC END; 02030400 + SI ~ LINE; DS ~ WDS END PRINT; 02031000 + COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02032000 + TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02033000 + RESULT = 1 ELSE RESULT = 2; 02034000 + REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02035000 + BEGIN SI ~ TAPE; DI ~ CARD; 02036000 + IF 8 SC } DC THEN 02037000 + BEGIN SI ~ SI-8; DI ~ DI-8; TALLY ~ 1; 02038000 + IF 8 SC = DC THEN TALLY ~ 2 END; 02039000 + COMPARE ~ TALLY END COMPARE; 02040000 + 02041000 + 02042000 + 02043000 + 02044000 + 02045000 + 02046000 + 02047000 + 02047050 + 02047055 + 02047060 + 02047065 + 02047070 + 02047075 + 02048000 + 02049000 + 02050000 + 02051000 + 02052000 + 02053000 + 02054000 + 02055000 + 02055100 + 02055200 + 02055300 + 02056000 + 02057000 + 02058000 + 02059000 + 02060000 + COMMENT EQUAL COMPARES COUNT CHARACTORS LOCATED AT A AND B FOR 02061000 + EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02062000 + QUANTITIES IN THE DIRECTORY; 02063000 + BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02064000 + BEGIN TALLY ~ 1; SI~A; DI~B; 02065000 + IF COUNT SC = DC THEN EQUAL ~ TALLY END; 02066000 +PROCEDURE READACARD; FORWARD; %WF 02067000 +PROCEDURE SCANNER; %WF 02068000 + BEGIN %WF 02069000 + 02070000 + COMMENT SCAN IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING.02071000 + IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED SCAN- 02072000 + NER, WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A 02073000 + CARD. SCAN IS CONTROLED BY A VARIABLE CALLED RESULT. 02074000 + SCAN ALSO INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE 02075000 + SAME VARIABLE. HENCE THE VARIABLE, RESULT, IS PASSED BY 02076000 + BOTH NAME AND VALUE. 02077000 + THE MEANING OF RESULT AS INPUT IS: 02078000 + 0: INITIAL CODE - DEBLANK AND START TO FETCH THE 02079000 + NEXT QUANTITY. 02080000 + 1: CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02081000 + END OF CARD BREAK). 02082000 + 2: LAST QUANTITY BUILT WAS SPECIAL CHARACTOR. HENCE 02083000 + EXIT (INTERRUPTION BY END OF CARD BREAK IS NOT 02084000 + IMPORTANT). 02085000 + 3: CONTINUE BUILDING A NUMBER (INTERRUPTED BY END OF 02086000 + CARD BREAK). 02087000 + 4: LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE02088000 + EXIT (INTERRUPTION BY END OF CARD BREAK NOT 02089000 + IMPORTANT). 02090000 + 5: GET NEXT CHARACTOR AND EXIT. 02091000 + 6: SCAN A COMMENT. 02092000 + 7: DEBLANK ONLY. 02093000 + THE MEANING OF RESULT AS OUTPUT IS: 02094000 + 1: AN IDENTIFIER WAS BUILT. 02095000 + 2: A SPECIAL CHARACTOR WAS OBTAINED. 02096000 + 3: A NUMBER (INTEGER) WAS BUILT. 02097000 + SCAN PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02098000 + BLANK ELIMINATED) INTO ACCUM (CALLED ACCUMULATOR FOR REST 02099000 + OF THIS DISCUSSION). 02100000 + COUNT IS THE VARIABLE THAT GIVES THE NUMBER OF CHARAC- 02101000 + TORS SCAN HAS PUT IN THE ACCUMULATOR. SINCE SCAN NEEDS 02102000 + THE VALUE SO THAT IT CAN PUT MORE CHARACTORS IN THE ACCUM-02103000 + ULATOR AND NEEDS TO UPDATE COUNT FOR THE OUTSIDE WORLD, 02104000 + COUNT IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 02105000 + CONVENIENT TO HAVE 63-COUNT. THIS IS CALLED COMCOUNT. 02106000 + NCR (NEXT CHARACTOR TO BE SCANNED) IS ALSO PASSED BY 02107000 + NAME AND VALUE SO THAT IT MAY BE UPDATED. 02108000 + ST1 AND ST2 ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02109000 + PASSED TO SCAN IN ORDER TO OBTAIN THE MOST USEFULL STACK 02110000 + ARRANGEMENT; 02111000 + STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02112000 + COUNT,ST2,NCRV,ST1); 02113000 + VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02114000 + BEGIN 02115000 + LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR, 02116000 + COMMENTS,COMMANTS; 02117000 + DI ~ RESULT; DI ~ DI+7; 02118000 + SI ~ NCRV; 02119000 + COMMENT SETUP DI FOR A CHANGE IN RESULT AND SI FOR A LOOK AT BUFFER;02120000 + CI ~ CI+RESULTV; COMMENT SWITCH ON VALUE OF RESULT; 02121000 + GO TO DEBLANK; COMMENT 0 IS INITIAL CODE; 02122000 + GO TO IDBLDR; COMMENT 1 IS ID CODE; 02123000 + GO TO FINIS; COMMENT 2 IS SPECIAL CHARACTER CODE; 02124000 + GO TO NUMBERS; COMMENT 3 IS NUMBER CODE; 02125000 + GO TO FINIS; COMMENT 4 IS ERROR CODE; 02126000 + GO TO GNC; COMMENT 5 IS GET NEXT CHARACTOR CODE; 02127000 + GO TO COMMANTS; COMMENT 6 IS COMMENT CODE; 02128000 + COMMENT 7 IS DEBLANK ONLY CODE; 02129000 + IF SC=" " THEN 02130000 + BEGIN K: SI~SI+1; 02131000 + IF SC =" " THEN GO TO K 02132000 + END; 02133000 + GO TO FINIS; 02134000 + DEBLANK: IF SC = " " THEN 02135000 + BEGIN L: SI~SI+1; IF SC = " " THEN GO TO L END; 02136000 + COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTOR; 02137000 + NCRV ~ SI; 02138000 + IF SC } "0" THEN GO TO NUMBERS; 02139000 + IF SC = ALPHA THEN GO TO IDBLDR; 02140000 + COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTOR (OR GNC); 02141000 + GNC: DS ~ LIT "2"; 02142000 + TALLY ~ 1; SI ~ SI +1; GO TO EXIT; 02143000 + COMMANTS: IF SC ! ";" THEN BEGIN 02144000 + COMMENTS: SI ~ SI+1; 02145000 + IF SC > "%" THEN GO TO COMMENTS; 02146000 + IF SC < ";" THEN GO TO COMMENTS; 02147000 + COMMENT CHARACTORS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD 02148000 + MODE PART OF COMMENT ROUTINE; 02149000 + END; 02150000 + GO TO FINIS; 02151000 + IDBLDR: TALLY ~ 63; DS ~ LIT "1"; 02152000 + COMCOUNT( TALLY~ TALLY+1; 02153000 + IF SC = ALPHA THEN SI~SI+1 ELSE JUMP OUT TO EXIT); 02154000 + TALLY ~ TALLY+1; IF SC = ALPHA THEN BEGIN 02155000 + ERROR: DI~DI-1; DS ~ LIT "4"; GO TO EXIT; 02156000 + END ELSE GO TO EXIT; 02157000 + COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTORS 02158000 + IN AN IDENTIFIER OR NUMBER; 02159000 + NUMBERS: TALLY ~ 63; DS ~ LIT "3"; 02160000 + COMCOUNT( TALLY~ TALLY+1; 02161000 + IF SC <"0"THEN JUMP OUT TO EXIT; SI~SI+1); 02162000 + GO TO ERROR; 02163000 + EXIT: ST1 ~ TALLY; COMMENT ST1 CONTAINS NUMBER OF CHAR- 02164000 + ACTORS WE ARE GOING TO MOVE INTO THE 02165000 + ACCUMULATOR; 02166000 + TALLY ~ TALLY+COUNTV; ST2 ~ TALLY; 02167000 + DI ~ COUNT; SI ~ LOC ST2; DS ~ WDS; 02168000 + COMMENT THIS CODE UPDATED COUNT; 02169000 + DI ~ ACCUM; SI ~ SI-3; DS ~ 3 CHR; 02170000 + COMMENT THIS CODE PLACES COUNT IN ACCUM AS WELL; 02171000 + DI ~ DI+COUNTV; COMMENT POSITION DI PAST CHARACTORS 02172000 + ALREADY IN THE ACCUMULATOR, IF ANY; 02173000 + SI ~ NCRV; DS ~ ST1 CHR; 02174000 + COMMENT MOVE CHARACTORS INTO ACCUM; 02175000 + FINIS: DI ~ NCR; ST1 ~ SI; SI ~ LOC ST1; DS ~ WDS; 02176000 + COMMENT RESET NCR TO LOCATION OF NEXT CHARACTOR TO BE SCANNED; 02177000 + END OF SCAN; 02178000 + LABEL L;% %WF 02178100 + L: SCAN(NCR, COUNT, ACCUM[1], 63-COUNT, RESULT, %WF 02178200 + RESULT, COUNT, 0, NCR, 0); %WF 02178300 + IF NCR=LCR THEN %WF 02178400 + BEGIN READACARD; %WF 02179000 + IF LIBINDEX!0 THEN %WF 02179100 + IF RECOUNT=FINISHPT THEN %WF 02179200 + BEGIN SEARCHLIB(FALSE); %WF 02179300 + READACARD; %WF 02179400 + NORELEASE ~ FALSE; %WF 02180000 + END; %WF 02180100 + GO TO L; %WF 02180200 + END; %WF 02180300 + END SCANNER; %WF 02180400 + PROCEDURE READACARD; 02181000 + COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02182000 + TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02183000 + LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02184000 + SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02185000 + FCR,NCR,LCR,TLCR, AND CLCR; 02186000 + BEGIN 02187000 +PROCEDURE READTAPE(LCR,MAXLCR,LIB); 02188000 + VALUE LIB; 02189000 + BOOLEAN LIB; 02190000 + REAL LCR, MAXLCR; 02191000 + IF LIB THEN 02192000 + BEGIN RECOUNT~RECOUNT+1; 02193000 + IF LCR~LCR+11>MAXLCR THEN 02194000 + BEGIN READ(LIBRARY[FILEINX]); 02195000 + MAXLCR~46+LCR~MKABS(LIBRARY[FILEINX](0))+10; 02196000 + END; 02196010 + ADDER(SEQSUM,LCR,TRUE,TRUE); 02196015 + END ELSE 02196030 + BEGIN READ(TAPE); 02196040 + MAXLCR~LCR~MKABS(TAPE(9)) 02196050 + END READTAPE; 02196060 + 02196070 + 02196080 + 02196090 + 02196100 + 02196110 + 02196120 + 02196130 + 02196140 + 02196141 + 02196142 +PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); 02196150 + VALUE LIB; 02196160 + BOOLEAN LIB; 02196170 + REAL TLCR, CLCR ; 02196180 + BEGIN 02196190 + IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMBER 02196200 + BEGIN 02196210 + LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02196220 + END 02196230 + ELSE BEGIN 02196240 + IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02196250 + BEGIN 02196260 + IF EXAMIN(GT1:=CLCR-9)="$" IMP EXAMIN(GT1+32768)="$" THEN 02196270 + BEGIN 02196275 + IF LIB THEN 02196280 + BEGIN 02196290 + IF FINISHPT-RECOUNT=1 THEN 02196300 + LASTCRDPATCH:=TRUE 02196305 + ELSE READTAPE(LTLCR,MAXLTLCR,TRUE) 02196310 + END 02196320 + ELSE READTAPE(TLCR,MAXTLCR,FALSE); 02196330 + END 02196340 + ELSE IF LIB THEN READTAPE(LTLCR,MAXTLCR,TRUE) %-101 02196345 + ELSE READTAPE(TLCR,MAXTLCR,FALSE) 02196350 + END; 02196360 + LCR:=CLCR; 02196370 + LASTUSED:=IF LIB THEN 5 ELSE 2; 02196380 + END; 02196390 + END OF SEQCOMPARE; 02196400 + LABEL CARDONLY, CARDLAST, TAPELAST, FIRSTIME, EXIT, 02197000 + EOF, USETHESWITCH, 02197100 + COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02198000 + SWITCH USESWITCH ~ CARDONLY,CARDLAST,TAPELAST,FIRSTIME, 02199000 + LIBCLAST, LIBTLAST; 02199010 + USETHESWITCH: 02199900 + GO TO USESWITCH[LASTUSED]; 02200000 + MOVE(1,TEXT[LASTUSED.LINKR,LASTUSED.LINKC], 02201000 + DEFINEARRAY[DEFINEINDEX-2]); 02202000 + LASTUSED ~ LASTUSED + 1; 02203000 + NCR ~ LCR-1; 02204000 + GO TO XIT; 02205000 + CARDONLY: IF NORELEASE THEN GO TO EXIT; READ(CARD); 02206000 + FIRSTIME: LCR ~ MKABS(CARD(9)); 02207000 + GO TO EXIT; 02208000 + COMMENT THIS RELEASES CARD FROM READER AND SETS LCR; 02209000 + CARDLAST: IF NORELEASE THEN GO TO EXIT; READ(CARD)[EOF]; 02210000 + CLCR ~ MKABS(CARD(9)); 02211000 + GO COMPAR; 02212000 + EOF: DEFINEARRAY[25]~"ND;END."&"E"[1:43:5]; 02212100 + DEFINEARRAY[34]~"9999"&"9999"[1:25:23]; 02212200 + CLCR~MKABS(DEFINEARRAY[34]); 02212300 + ZOT(DEFINEARRAY[33],"%",CLCR-8); 02212400 + GO COMPAR; 02212700 + COMMENT THIS RELEASES THE PREVIOUS CARD FROM CARD READER AND SETS 02213000 + UP CLCR; 02214000 +TAPELAST: READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02215000 + COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02216000 + LIBCLAST: IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; 02217000 + GO TO COMPAR END; 02217100 + READ(CARD)[EOF]; 02217200 + CLCR ~ MKABS(CARD(9)); 02218000 + IF LASTCRDPATCH THEN BEGIN 02218100 + LASTCRDPATCH~FALSE; 02218200 + RECOUNT~RECOUNT+1; 02218300 + GO TO XIT END; 02218400 + GO TO COMPAR; 02219000 + LIBTLAST: 02220000 + IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; GO TO COMPAR END; 02220500 + READTAPE(LTLCR,MAXLTLCR,TRUE); 02221000 + IF RECOUNT=FINISHPT THEN GO TO XIT; 02221100 + 02222000 + 02223000 + 02224000 + 02225000 + 02226000 + COMPAR: IF LASTUSED = 2 OR LASTUSED = 3 THEN 02227000 + SEQCOMPARE(TLCR,CLCR,FALSE) 02228000 + ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02229000 + EXIT: NCR ~ FCR~ LCR - 9; 02229010 + COMMENT SETS UP NCR AND FCR; 02230000 + IF VOIDCR ! 0 THEN 02230010 + BEGIN IF COMPARE(LCR,VOIDCR) = 0 THEN 02230020 + BEGIN IF VOIDTAPE AND LASTUSED=3 OR 02230025 + NOT VOIDTAPE THEN GO TO USETHESWITCH 02230030 + END ELSE BEGIN 02230035 + VOIDCR ~ VOIDPLACE ~ 0; 02230040 + VOIDTAPE~FALSE END; 02230045 + END; 02230050 + IF(IF SEQTOG THEN NONBLANK(FCR) ELSE TRUE) THEN 02230100 + IF EXAMIN(FCR)!"$" THEN BEGIN 02231000 + IF REAL(LISTOG)=3 THEN DATIME; 02231050 + IF SEQTOG THEN BEGIN IF TOTALNO = -10 OR NEWBASE THEN 02231100 + BEGIN NEWBASE ~ FALSE; GTI1~ TOTALNO~BASENUM END ELSE 02231200 + GTI1~ TOTALNO~ TOTALNO + ADDVALUE; 02231300 + CHANGESEQ(GTI1,LCR); END; 02231400 + IF LISTOG OR (IF CHECKTOG THEN GT1~ 02231500 + COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR) = 1 02231600 + ELSE FALSE) THEN 02232000 + BEGIN PRINT(LIN,FCR,L.[36:10],IF LASTUSED=6 THEN FILEINX 02233000 + +17 ELSE IF LASTUSED=3 THEN "T" ELSE IF LASTUSED02233100 + =2 OR LASTUSED=5 THEN "R" ELSE 48); 02234000 + IF CHECKTOG AND GT1=1 THEN SEQERR(LIN[14]); 02235000 + IF NOHEADING THEN DATIME ; 02235100 + WRITELINE; 02236000 + END; 02237000 + IF NEWTOG THEN 02238000 + IF WRITNEW (LIN,FCR) THEN 02239000 + WRITE(NEWTAPE,10,LIN[*]); 02240000 + 02241000 + 02242000 + COMMENT WRITES NEW TAPE IF NECESSARY; 02243000 + END; 02244000 + ZOT(INFO[LASTSEQROW,LASTSEQUENCE],"%",LCR); 02245000 + COMMENT PUTS % IN COLUMN 73 AND SEQUENCE NUMBER IN INFO; 02246000 + CARDNUMBER ~ CONV(INFO[LASTSEQROW,LASTSEQUENCE-1], 5, 8); 02246100 + IF BUILDLINE THEN 02246200 + IF LASTADDRESS ! (LASTADDRESS ~ L) THEN 02246300 + BEGIN ENILSPOT ~ L.[36:10] & CARDNUMBER[10:20:28]; 02246400 + IF (ENILPTR ~ ENILPTR+1)}1023 THEN 02246500 + BEGIN FLAG(80); ENILPTR ~ 512; END; 02246600 + END; 02246700 + XIT: END READACARD; 02247000 +REAL PROCEDURE CONVERT; 02248000 + BEGIN REAL T; INTEGER N; 02249000 + TLO~0; THI~ 02250000 + T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000 + FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000 + IF DPTOG THEN 02253000 + BEGIN 02254000 + DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~, 02255000 + THI,TLO); 02256000 + T~THI; 02257000 + END ELSE 02258000 + T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000 + CONVERT~T; 02260000 + END; 02261000 +REAL STREAM PROCEDURE FETCH(F); VALUE F; %WF 02262000 + BEGIN SI~F; SI~SI-8; DI~LOC FETCH; DS~WDS; END FETCH; %WF 02263000 +PROCEDURE DUMPINFO; 02264000 + BEGIN 02264050 + ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100 + STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400 + BEGIN 02264450 + SI:=S; DI:=D; 02264500 + N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550 + DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600 + END OF OCTALWORDS; 02264650 + STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700 + BEGIN 02264750 + SI:=S; DI:=D; 02264800 + N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850 + END OF ALPHAWORDS; 02264900 + IF NOHEADING THEN DATIME; WRITE(LINE[DBL],); 02264950 + FOR JEDEN:=0 STEP 6 UNTIL 71 DO 02265000 + BEGIN 02265050 + BLANKET(14,A); OCTALWORDS(ELBAT[JEDEN],A,6); 02265100 + WRITE(LINE[DBL],15,A[*]); 02265150 + END; 02265200 + BLANKET(14,A); OCTALWORDS(ELBAT[72],A,4); 02265250 + WRITE(LINE[DBL],15,A[*]); 02265300 + FOR JEDEN:=0 STEP 1 UNTIL NEXTINFO DIV 256 DO 02265350 + BEGIN 02265400 + WRITE(LINE[DBL],,JEDEN); 02265450 + FOR DWA:=0 STEP 6 UNTIL 251 DO 02265500 + BEGIN 02265550 + BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600 + WRITE(LINE,15,A[*]); 02265650 + BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700 + WRITE(LINE[DBL],15,A[*]); 02265750 + END; 02265800 + BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850 + WRITE(LINE,15,A[*]); 02265900 + BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950 + WRITE(LINE[DBL],15,A[*]); 02266000 + END; 02266050 + END OF DUMPINFO; 02266100 + COMMENT TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER 02277000 + USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY. 02278000 + THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED. 02279000 + TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY 02280000 + ELBAT. ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR 02281000 + COMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD. NXTELBT02282000 + IS ALMOST EXCLUSIVELY USED BY TABLE, ALTHOUGH AN OCCASION-02283000 + AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS02284000 + SCANNED. (SEE FOR EXAMPLE COMPOUNDTAIL). FOR FURTHER 02285000 + GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES.02286000 + THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY 02287000 + DESIRED (USUALLY I-1,I, OR I+1). 02288000 + THE GENERAL PLAN OF TABLE IS THIS: 02289000 + I) IF P < NXTELBAT GO ON TO III). 02290000 + II) PROCESS ONE QUANTITY. 02291000 + A) SCAN. 02292000 + B) TEST FOR IDENTIFIER, NUMBER, 3R SPECIAL CHARACTOR.02293000 + 1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS 02294000 + IN SPECIAL MANNER IF COMMENT OR DEFINED ID. 02295000 + 2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART, 02296000 + AND EXPONENT PART. 02297000 + 3) TEST IF SPECIAL CHARACTOR REQUIRES SPECIAL 02298000 + PROCESSING - OTHERWISE GET ELBAT WORD FROM 02299000 + SPECIAL. 02300000 + C) LOAD ELBAT AND INCREMENT NXTELBT. 02301000 + D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P. 02302000 + E) GO BACK TO I). 02303000 + III) RETURN WITH CLASS OF ELBAT[P]. 02304000 + FURTHER DETAILS ARE GIVEN IN BODY OF TABLE; 02305000 + INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 02306000 + BEGIN 02307000 + LABEL PERCENT,SPECIALCHAR,COMPLETE,COLON,DOT,ATSIGN,QUOTE, 02308000 + STRNGXT, MOVEIT, 02308100 + SCANAGAIN,FPART,EPART,IPART,IDENT,ROSE,COMPOST,DOLLAR,RTPAREN,ARGH, 02309000 + CROSSHATCH, DBLDOLLAR; 02310000 + SWITCH SPECIALSWITCH ~ PERCENT,DOLLAR,DOT,ATSIGN,COLON,QUOTE,RTPAREN, 02311000 + CROSSHATCH,DBLDOLLAR; 02312000 + SWITCH RESULTSWITCH~ IDENT, SPECIALCHAR,IPART; 02313000 + BOOLEAN STREAM PROCEDURE OCTIZE(A,S,C); VALUE S,C; 02313100 + COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS, PACKING 02313200 + LEFT BY REMOVING THE HIGH-ORDER OCTADE OF EACH CHARACTER; 02313300 + BEGIN DI~A; DI~DI+2; SI~LOC C; SI~SI+7; DS~CHR; % COUNT 02313400 + SI~A; SI~SI+3; S(DS~3 RESET); % IF ODD # OF OCTADES. 02313500 + 2(C(3(IF SB THEN TALLY~1; SKIP SB); % SET ERROR IF NOT 0-7. 02313600 + 3(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB))); 02313700 + OCTIZE~TALLY; % TRUE IS BAD NEWS: NUMBER WASNT OCTAL. 02313800 + END OCTIZE; 02313900 + WHILE P } NXTELBT 02314000 + DO BEGIN 02315000 + SCANAGAIN: COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02316000 + GO TO RESULTSWITCH[RESULT]; 02317000 + ARGH: Q ~ ACCUM[1]; FLAG(141); GO TO SCANAGAIN; 02318000 + SPECIALCHAR: GT1 ~ ACCUM[1].[18:6] - 2; 02319000 + ENDTOG ~ GT1 = 57 AND ENDTOG; 02320000 + COMMENT OBTAIN ACTUAL CHARACTOR FROM ACCUM; 02321000 + T ~ SPECIAL[GT1>1[42:41:3]]; 02322000 + COMMENT NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF 02323000 + ELBAT WORDS FOR SPECIAL CHARACTORS; 02324000 + IF GT1 ~ T.INCR = 0 THEN GO TO COMPLETE; 02325000 + GO TO SPECIALSWITCH[GT1]; 02326000 + COMMENT INCR FIELD OF SPECIAL CHARACTOR IS NON-ZERO FOR SPECIAL 02327000 + CHARACTORS REQUIRING SPECIAL HANDELING. INCR IS SWITCHED 02328000 + ON TO OBTAIN DISCRIMINATION; 02329000 + COLON: RESULT ~ 7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02330000 + FOR := IN PLACE OR ~ ; 02331000 + IF EXAMIN (NCR) = "=" THEN BEGIN RESULT ~0; SCANNER; 02332000 + T ~ SPECIAL[13] END; 02333000 + RESULT ~ 2; GO TO COMPLETE; 02334000 + DOT: IF EXAMIN(NCR)>9 OR ENDTOG THEN GO TO COMPLETE; 02335000 + NHI~NLO~0; 02336000 + C~0; FSAVE~0; GO TO FPART; 02337000 + ATSIGN: NHI~C~1; NLO~FSAVE~0; GO TO EPART; 02338000 + COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02339000 + 02340000 + QUOTE: COUNT~0; T~IF STREAMTOG THEN 63 ELSE IF STREAMTOG.[2:1] 02341000 + THEN 16 ELSE 7+REAL(STREAMTOG.[46:1]); 02342000 + DO BEGIN 02343000 + RESULT ~ 5; SCANNER; 02344000 + IF COUNT=T THEN IF EXAMIN(NCR) ! """ 02345000 + THEN GO TO ARGH; 02345100 + END UNTIL EXAMIN(NCR) = """; 02346000 + Q ~ ACCUM[1]; RESULT ~ 5; SCANNER; COUNT~COUNT-1; 02347000 + IF COUNT<0 THEN COUNT~COUNT+64; 02347100 + ACCUM[1] ~ Q; RESULT ~ 4; 02348000 + STRNGXT: T~C~0; 02349000 + IF COUNT < 8 THEN 02350000 + MOVEIT: 02350100 + MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT); 02351000 + T.CLASS ~ STRNGCON; GO TO COMPLETE; 02352000 + COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02353000 + THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02354000 + THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02355000 + THE TWO CASES ARE PROCESSED DIFERENTLY. THE FIRST CASE 02356000 + MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02357000 + CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID.02358000 + FOR A FULL DISCUSSION SEE DEFINEGEN; 02359000 + CROSSHATCH: IF DEFINECTR!0 THEN GO TO COMPLETE; 02360000 + ZOT(GT1,0,LCR); 02361000 + IF DEFINEINDEX = 0 THEN GO TO ARGH; 02362000 + LCR ~ (GT1 ~ DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02363000 + NCR ~ GT1 MOD 262144; 02364000 + GT2~0&(T~DEFINEARRAY[DEFINEINDEX~DEFINEINDEX-3]) 02365000 + [33:18:15]; 02365100 + LASTUSED~T.[33:15]; 02365200 + IF GT2 ! 0 THEN 02365300 + BEGIN 02365400 + NEXTTEXT ~ (GT2 ~ TAKE(GT2)).DYNAM; 02365500 + DEFSTACKHEAD ~ GT2.LINK; 02365600 + END; 02365700 + GO TO SCANAGAIN; 02366000 + DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02367000 + IF GT1~EXAMIN(NCR)="$" THEN GO TO DBLDOLLAR; 02367010 + COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02368000 + Q ~ ACCUM[1]; 02369000 + IF Q = "4VOID0" THEN 02369100 + BEGIN GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369200 + READACARD; 02369300 + GO TO SCANAGAIN; 02369400 + END; 02369500 + IF Q="5VOIDT" THEN BEGIN 02369600 + VOIDTAPE~TRUE; 02369700 + GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369800 + READACARD;GO SCANAGAIN END; 02369900 + IF Q = "4TAPE0" THEN 02370000 + BEGIN 02371000 + LASTUSED ~ 2; COMMENT NEXT CARD READ IS FROM RDR; 02372000 + IF MAXTLCR = 0 THEN 02373000 + BEGIN INTEGER STREAM PROCEDURE FEJ(F,T); VALUE T; 02374000 + BEGIN SI~F; DI~LOC T; DS~WDS; SI~T; SI~SI-16; 02375000 + DI~LOC FEJ; DS~WDS END FEJ; 02376000 + STREAM PROCEDURE FIX(F,T); VALUE T; 02377000 + BEGIN SI~F; SI~SI-24; DI~LOC T; DS~WDS; DI~T; 02378000 + DI~DI+47; SKIP 4 DB; DS~2 RESET; DI~DI+48; 02379000 + DI~DI+48; DS~8 LIT "00#01+0#"; END FIX; 02379100 + IF GT1~FEJ(TAPE,0)=10 THEN 02379200 + BEGIN REWIND(TAPE); FIX(TAPE,0) END; 02379300 + MAXTLCR~GT1+TLCR~9+MKABS(TAPE(0)); 02379400 + LASTUSED~2; 02379500 + END; END 02380000 + ELSE BEGIN IF Q! "4CARD0" THEN GO TO PERCENT; 02381000 + IF LASTUSED } 5 THEN ELSE LASTUSED ~1 END; 02382000 + CHECKTOG~FALSE; 02382100 + LISTOG.[47:1]~FALSE; 02382200 + PRTOG~NEWTOG~DEBUGTOG~PUNCHTOG~FALSE; 02383000 + SINGLTOG:=FALSE; 02383100 + DO BEGIN 02384000 + COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; Q ~ ACCUM[1];02385000 + IF Q = "1%0000" THEN GO TO PERCENT ELSE 02385100 + IF Q="6SEQXE" AND BUILDLINE.[45:1] THEN 02385400 + BUILDLINE ~ TRUE ELSE 02385600 + IF Q = "4LIST0" THEN LISTOG.[47:1]~TRUE ELSE 02386000 + IF Q = "6SINGL" OR Q = "3SGL00" THEN 02386100 + LISTOG.[47:1]:=SINGLTOG:=TRUE ELSE 02386110 + 02386120 + 02386130 + 02386140 + 02386150 + 02386160 + 02386170 + 02386180 + 02386190 + 02386200 + 02386210 + IF Q = "3PRT00" THEN PRTOG:=TRUE ELSE 02387000 + IF Q= "5CHECK" THEN CHECKTOG~TRUE ELSE 02387100 + IF Q = "4INFO0" THEN DUMPINFO ELSE 02387200 + IF Q = "3NEW00" THEN NEWTOG ~ TRUE ELSE 02388000 + IF Q = "5NOSEQ" THEN SEQTOG~FALSE ELSE 02388100 + IF Q = "3SEQ00" THEN SEQTOG~ TRUE ELSE 02388200 + IF RESULT = 3 THEN BEGIN 02388300 + BASENUM~ CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388400 + TOTALNO~-10; 02388450 + NEWBASE ~ TRUE 02388500 + END ELSE 02388600 + IF RESULT = 2 THEN BEGIN 02388700 + IF ACCUM[1]= "1+0000" THEN 02388800 + BEGIN RESULT~ COUNT~ ACCUM[1]~0; 02388900 + SCANNER; IF RESULT = 3 THEN 02388910 + ADDVALUE~CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388920 + END END ELSE 02388930 + IF Q = "6DEBUG" THEN 02389000 + BEGIN LISTOG.[47:1]:=DEBUGTOG:=PRTOG:=TRUE; 02390000 + FILL WOP[*] WITH 02391000 + "LITC"," ", 02392000 + "OPDC","DESC", 02393000 + 10,"DEL ", 11,"NOP ", 12,"XRT ", 16,"ADD ", 17,"AD2 ", 18,"PRL ", 02394000 + 19,"LNG ", 21,"GEQ ", 22,"BBC ", 24,"INX ", 35,"LOR ", 37,"GTR ", 02395000 + 38,"BFC ", 39,"RTN ", 40,"COC ", 48,"SUB ", 49,"SB2 ", 64,"MUL ", 02396000 + 65,"ML2 ", 67,"LND ", 68,"STD ", 69,"NEQ ", 71,"XIT ", 72,"MKS ", 02397000 + 128,"DIV ",129,"DV2 ",130,"COM ",131,"LQV ",132,"SND ",133,"XCH ", 02398000 + 134,"CHS ",167,"RTS ",168,"CDC ",197,"FTC ",260,"LOD ",261,"DUP ", 02399000 + 278,"LBC ",280,"SSF ",294,"LFC ",322,"ZP1 ",384,"IDV ",453,"FTF ", 02400000 + 515,"MDS ",532,"ISD ",533,"LEQ ",534,"BBW ",548,"ISN ",549,"LSS ", 02401000 + 550,"BFW ",581,"EQL ",582,"SSP ",584,"ECM ",709,"CTC ",790,"LBU ", 02401100 + 806,"LFU ",896,"RDV ",965,"CTF ", 02401200 + 1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023; 02402000 + FILL COP[*] WITH % CHARACTER MODE MNEMONICS 02403000 + "EXC ","NOP ","BSD ","BSS ","RDA ","TRW ","SED ","TDA ", 02404000 + " "," ","TBN "," ","SDA ","SSA ","SFD ","SRD ", 02405000 + " "," ","SES "," ","TEQ ","TNE ","TEG ","TGR ", 02406000 + "SRS ","SFS "," "," ","TEL ","TLS ","TAN ","BIT ", 02407000 + "INC ","STC ","SEC ","CRF ","JNC ","JFC ","JNS ","JFW ", 02408000 + "RCA ","ENS ","BNS ","RSA ","SCA ","JRC ","TSA ","JRV ", 02409000 + "CEQ ","CNE ","CEG ","CGR ","BIS ","BIR ","OCV ","ICV ", 02410000 + "CEL ","CLS ","FSU ","FAD ","TRP ","TRN ","TRZ ","TRS "; 02411000 + 02412000 + FILL POP[*] WITH 02412100 + "ZFN ","ZBN ","ZFD ","ZBD ","ISO ",0,"DIA ","DIB ","TRB ","CFL ","CFE "02412200 + ; 02412300 + END ELSE 02413000 + IF Q = "5PUNCH" THEN PUNCHTOG ~ TRUE ELSE 02414000 + END UNTIL FALSE; 02415000 + PERCENT: IF NCR ! FCR THEN READACARD; 02416000 + IF LIBINDEX!0 THEN 02416200 + IF RECOUNT=FINISHPT THEN 02416400 + BEGIN SEARCHLIB(FALSE); READACARD; NORELEASE~FALSE END; 02416600 + GO TO SCANAGAIN; 02417000 + COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02418000 + PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02419000 + SIDE AFFECT IS THAT ALL CHARACTORS ON A CARD ARE IGNORED 02420000 + AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR02421000 + COMMENT; 02422000 + COMMENT MIGHT BE FUNNY COMMA - HANDEL HERE; 02423000 + RTPAREN: RESULT ~ 7; SCANNER; 02424000 + IF EXAMIN(NCR) = """ 02425000 + THEN BEGIN 02426000 + RESULT ~ 0; SCANNER; 02427000 + DO BEGIN RESULT ~ 5; SCANNER END UNTIL EXAMIN(NCR) 02428000 + = """; 02429000 + RESULT ~ 0; SCANNER; 02430000 + RESULT ~ 7; SCANNER; 02431000 + IF EXAMIN(NCR) ! "(" THEN 02432000 + GO TO ARGH; 02433000 + RESULT ~ 0; SCANNER; Q ~ ACCUM[1]; 02434000 + T ~ SPECIAL[24] 02435000 + END; 02436000 + RESULT ~ 2; GO TO COMPLETE; 02437000 + IPART: TCOUNT~0; 02438000 + FSAVE~0; 02438500 + C~CONVERT; 02439000 + IF DPTOG THEN BEGIN NHI~THI; NLO~TLO; END; 02440000 + IF EXAMIN(NCR)="." THEN 02441000 + BEGIN RESULT~0; 02442000 + SCANNER; 02443000 + C ~ 1.0| C; 02444000 + FPART: TCOUNT~COUNT; 02445000 + IF EXAMIN(NCR){9 THEN 02446000 + BEGIN RESULT~0; 02447000 + SCANNER; 02448000 + IF DPTOG THEN 02449000 + BEGIN 02450000 + DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02451000 + 0,/,~,THI,TLO); 02452000 + FOR T~12 STEP 12 UNTIL COUNT - TCOUNT DO 02453000 + DOUBLE(THI,TLO,TEN[12],0,/,~,THI,TLO); 02454000 + DOUBLE(THI,TLO,NHI,NLO,+,~,NHI,NLO); 02455000 + C~NHI END ELSE 02456000 + C~CONVERT+C|TEN[FSAVE~COUNT-TCOUNT]; 02457000 + END 02458000 + END; 02459000 + RESULT ~7; SCANNER; 02460000 + IF EXAMIN(NCR)="@" THEN 02461000 + BEGIN RESULT~0; 02462000 + SCANNER; 02463000 + EPART: TCOUNT~COUNT; 02464000 + C~C|1.0; 02465000 + RESULT ~7; SCANNER; 02466000 + IF T~EXAMIN(NCR)>9 THEN 02467000 + IF T="-" OR T = "+" THEN 02467100 + BEGIN RESULT~0; 02468000 + SCANNER; 02469000 + TCOUNT~COUNT; 02470000 + END ELSE FLAG(47); RESULT ~ 0; 02471000 + SCANNER; 02472000 + IF RESULT ! 3 THEN FLAG (47);COMMENT NOT A NUMBER; 02472100 + Q~ACCUM[1]; 02473000 + IF GT1~T~(IF T="-"THEN -CONVERT ELSE CONVERT)<-46 OR T>69 02474000 + THEN 02475000 + FLAG(269) 02476000 + ELSE BEGIN T~TEN[ABS(GT3~T-FSAVE)]; 02477000 + IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] + 12) 02478000 + >63 THEN 02479000 + FLAG(269) ELSE 02480000 + IF DPTOG THEN 02481000 + IF GT1<0 THEN 02482000 + BEGIN 02483000 + GT1~-GT1; 02484000 + DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,~,NHI,NLO); 02485000 + FOR GT2~12 STEP 12 UNTIL GT1 DO 02486000 + DOUBLE(NHI,NLO,TEN[12],0,/,~,NHI,NLO); 02487000 + END ELSE 02488000 + BEGIN 02489000 + DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,~,NHI,NLO); 02490000 + FOR GT2~12 STEP 12 UNTIL GT1 DO 02491000 + DOUBLE( NHI,NLO,TEN[12],0,|,~,NHI,NLO); 02492000 + END ELSE C~IF GT3<0 THEN C/T ELSE C|T; 02493000 + END; 02494000 + END ELSE IF FSAVE ! 0 THEN C~C/TEN[FSAVE]; 02495000 + Q ~ ACCUM[1]; RESULT ~ 3; 02496000 + T~0; 02497000 + IF REAL(BOOLEAN(C)AND NOT BOOLEAN(1023))=0 THEN 02498000 + BEGIN T.CLASS~LITNO ; T.ADDRESS~C.[38:10] END 02499000 + ELSE T.CLASS~NONLITNO ; 02500000 + GO TO COMPLETE; 02501000 + COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02502000 + IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02503000 + ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02504000 + TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK, %WF 02505000 + TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR %WF 02505100 + COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO %WF 02505200 + COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND %WF 02506000 + ROSE IS ENTERED. THE LAST THING DONE FOR ANY %WF 02506100 + IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION %WF 02506200 + OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS %WF 02507000 + ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, %WF 02507100 + SHOULD THIS BE REQUIRED. ; %WF 02507200 + IDENT: IF T ~ SUPERSTACK[SCRAM ~ (Q ~ ACCUM[1]) MOD 125]!0 02508000 + THEN BEGIN %WF 02508100 + IF INFO[GT1 ~ T.LINKR,(GT2 ~ T.LINKC)+1]=Q %WF 02508200 + THEN BEGIN %WF 02508300 + T ~ INFO[GT1,GT2]&T[35:35:13]; %WF 02508400 + GO TO COMPLETE %WF 02508500 + END %WF 02508600 + END; %WF 02508700 + IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN 02508730 + T ~ DEFSTACKHEAD ELSE 02508770 + T ~ STACKHEAD[SCRAM]; %WF 02508800 + ROSE : GT1 ~ T.LINKR; 02509000 + IF(GT2 ~ T.LINKC)+GT1= 0 THEN 02510000 + BEGIN T ~ 0; GO TO COMPLETE END; 02511000 + T ~ INFO[GT1,GT2]; 02512000 + IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO TO ROSE; 02513000 + IF COUNT { 5 THEN GO TO COMPOST ; 02514000 + IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2]) 02515000 + THEN GO TO ROSE; 02516000 + COMPOST: T ~ T>1[35:43:5]>2[40:40:8]; 02517000 + COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02518000 + IF NOT ENDTOG THEN BEGIN 02519000 + IF GT1 ~ T.CLASS = COMMENTV THEN BEGIN 02520000 + WHILE EXAMIN(NCR) ! ";" DO 02521000 + BEGIN RESULT ~ 6; COUNT ~ 0; SCANNER END; 02522000 + RESULT~0;SCANNER;GO TO SCANAGAIN END END; 02523000 + IF STOPDEFINE THEN GO TO COMPLETE; 02524000 + IF GT1 ! DEFINEDID THEN GO TO COMPLETE; 02525000 + COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02526000 + IF BOOLEAN(T.MON) THEN % THIS IS A PARAMETRIC DEFINE 02526500 + GT1 ~ GIT(T ~ FIXDEFINEINFO(T)) ELSE GT1 ~ 0; 02526600 + IF DEFINEINDEX = 24 THEN BEGIN FLAG(139);GO TO ARGH END; 02527000 + DEFINEARRAY[DEFINEINDEX] ~ LASTUSED & GT1[18:33:15]; 02528000 + LASTUSED ~ T.DYNAM; 02529000 + DEFINEARRAY[DEFINEINDEX+2] ~ 262144|LCR+NCR; 02530000 + LCR ~ (NCR ~ MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02531000 + ZOT(GT4,"%",LCR); DEFINEINDEX ~ DEFINEINDEX+3; 02532000 + GO TO PERCENT; 02533000 + DBLDOLLAR: CARDCALL~IF LASTUSED=5 THEN TRUE ELSE FALSE; 02533010 + SEARCHLIB(TRUE); GO TO SCANAGAIN; 02533500 + COMPLETE: ELBAT[NXTELBT] ~ T; 02534000 + STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINES AGAIN; 02535000 + IF NXTELBT ~ NXTELBT+1 > 74 02536000 + THEN IF NOT MACROID 02536500 + THEN BEGIN 02537000 + COMMENT ELBAT IS FULL: ADJUST IT; 02538000 + MOVE(10,ELBAT[65],ELBAT); 02539000 + I~ I-65; 02540000 + P~ P-65; 02541000 + NXTELBT ~ 10 END END; 02542000 + IF TABLE ~ ELBAT[P].CLASS = COMMENTV 02543000 + THEN BEGIN 02544000 + COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02545000 + C ~ INFO[0,ELBAT[P].ADDRESS]; 02546000 + ELBAT[P].CLASS ~ TABLE ~ NONLITNO END; 02547000 + STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINE; 02547500 + END TABLE ; 02548000 + COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02549000 + IT USED THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02550000 + PLACES EITHER A CHARACTOR OR A CONVERTED NUMBER WITH A 02551000 + NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESS BLANKS; 02552000 + PROCEDURE NEXTENT; 02553000 + BEGIN LABEL DEBLANK; 02554000 + COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02555000 +DEBLANK: 02556000 + IF EXAMIN(NCR)=" " THEN 02557000 + BEGIN 02558000 + RESULT:=7; SCANNER; 02559000 + END; 02560000 + IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02561000 + BEGIN 02562000 + RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02563000 + IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02564000 + ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02565000 + END 02566000 +ELSE IF EXAMIN(NCR)="%" THEN 02567000 + BEGIN 02568000 + READACARD; GO DEBLANK; 02569000 + END 02570000 +ELSE BEGIN 02571000 + RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02572000 + Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02573000 + END 02574000 + END OF NEXTENT; 02575000 + COMMENT THIS SECTION CONTAINS FORWARD DECLARATIONS; 03000000 + PROCEDURE AEXP; FORWARD; 03001000 + PROCEDURE ARITHSEC; FORWARD; 03002000 + PROCEDURE SIMPARITH; FORWARD; 03003000 + PROCEDURE ARITHCOMP; FORWARD; 03004000 + PROCEDURE PRIMARY; FORWARD; 03005000 + PROCEDURE BEXP; FORWARD; 03006000 + INTEGER PROCEDURE EXPRSS; FORWARD; 03007000 + INTEGER PROCEDURE BOOSEC; FORWARD; 03008000 + PROCEDURE SIMPBOO; FORWARD; 03009000 + PROCEDURE BOOCOMP; FORWARD; 03010000 + INTEGER PROCEDURE BOOPRIM; FORWARD; 03011000 + PROCEDURE RELATION; FORWARD; 03012000 + INTEGER PROCEDURE IFEXP; FORWARD; 03013000 + PROCEDURE PARSE; FORWARD; 03014000 + PROCEDURE DOTIT; FORWARD; 03015000 + PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; FORWARD; 03016000 + PROCEDURE DEXP; FORWARD; 03017000 + PROCEDURE IFCLAUSE; FORWARD; 03018000 +INTEGER PROCEDURE GET(SYLLABLE);VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03019000 +INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; FORWARD; 03020000 + PROCEDURE PANA; FORWARD; 03021000 + PROCEDURE IFSTMT; FORWARD; 03022000 + PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 03023000 + VALUE LABELBAT,BRANCHTYPE; 03024000 + REAL LABELBAT,BRANCHTYPE; FORWARD; 03025000 + BOOLEAN PROCEDURE SIMPGO; FORWARD; 03026000 + PROCEDURE STMT; FORWARD; 03027000 + PROCEDURE EMIT(SYLLABLE); VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03028000 + PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; 03029000 + PROCEDURE STRMPROCSTMT; FORWARD; 03030000 + BOOLEAN PROCEDURE GETINT; FORWARD; 03031000 + INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); VALUE NUMBER; 03032000 + INTEGER P1,P2,NUMBER; FORWARD; 03033000 + PROCEDURE CONSTANTCLEAN; FORWARD; 03034000 + PROCEDURE SCATTERELBAT; FORWARD; 03035000 + PROCEDURE EMITB(BRANCH,FROM,TOWARDS); VALUE BRANCH,FROM,TOWARDS; 03036000 + INTEGER BRANCH,FROM,TOWARDS; FORWARD; 03037000 + PROCEDURE VARIABLE(FROM); REAL FROM; FORWARD; 03038000 + PROCEDURE IMPFUN; FORWARD; 03039000 + PROCEDURE STREAMSTMT; FORWARD; 03040000 + PROCEDURE SEGMENTSTART;FORWARD; 03041000 + PROCEDURE SEGMENT(SIZE,NO,NOO); 03042000 + VALUE SIZE,NO,NOO; 03043000 + REAL SIZE,NO,NOO; 03044000 + FORWARD; 03045000 +INTEGER PROCEDURE BAE; FORWARD; 03046000 +REAL PROCEDURE PROGDESCBLDR(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 03047000 + PROCEDURE BANA; FORWARD; 03048000 + PROCEDURE EMITNUM(A); VALUE A; REAL A; FORWARD; 03049000 + PROCEDURE EMITD(A,B,T); VALUE A,B,T; INTEGER A,B,T; FORWARD; 03050000 +INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L; 03051000 + INTEGER L; BOOLEAN S; FORWARD; 03051001 + PROCEDURE FORSTMT; FORWARD; 03052000 + 03053000 +PROCEDURE E; FORWARD; 03054000 +PROCEDURE ENTRY(TYPE); VALUE TYPE;REAL TYPE; FORWARD; 03055000 +PROCEDURE FORMATGEN;FORWARD; 03056000 +PROCEDURE EXPLICITFORMAT; FORWARD; 03056100 +BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; 03056200 +PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000 +PROCEDURE JUMPCHKNX; FORWARD; 03058000 +PROCEDURE JUMPCHKX; FORWARD; 03059000 + PROCEDURE DBLSTMT; FORWARD; 03060000 + PROCEDURE READSTMT; FORWARD; 03061000 +INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N; FORWARD ; 03061010 + PROCEDURE WRITESTMT; FORWARD; 03062000 + PROCEDURE SPACESTMT; FORWARD; 03063000 + PROCEDURE CLOSESTMT; FORWARD; 03064000 + PROCEDURE LOCKSTMT; FORWARD; 03065000 + PROCEDURE RWNDSTMT; FORWARD; 03066000 + PROCEDURE BLOCK(S); VALUE S; BOOLEAN S; FORWARD; 03067000 +PROCEDURE PURGE(STOPPER);VALUE STOPPER;REAL STOPPER;FORWARD; 03068000 +PROCEDURE ENTER(TYPEV); 03069000 + VALUE TYPEV; 03070000 + INTEGER TYPEV; FORWARD; 03071000 +INTEGER PROCEDURE PASSTYPE(P); VALUE P; REAL P; FORWARD; 03074000 +PROCEDURE PASSALPHA(P); VALUE P; REAL P; FORWARD; 03075000 + PROCEDURE LISTELEMENT; FORWARD; 03076000 +REAL PROCEDURE LISTGEN; FORWARD; 03077000 + PROCEDURE UNKNOWNSTMT; FORWARD; 03078000 + PROCEDURE FAULTSTMT; FORWARD; 03079000 + PROCEDURE FAULTDEC; FORWARD; 03080000 + PROCEDURE SORTSTMT; FORWARD; 03081000 + PROCEDURE MERGESTMT; FORWARD; 03082000 + PROCEDURE CASESTMT; FORWARD; 03083000 +PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000 + ALPHA PROCEDURE BUGGER(S); VALUE S; INTEGER S; FORWARD; 03100000 + COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 04000000 + ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 04001000 + COMMENT EMITL EMITS A LIT CALL; 04002000 + PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; 04003000 + EMIT(0&LITERAL[36:38:10]); 04004000 + COMMENT EMITO EMIT AN OPERATOR; 04005000 + PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; 04006000 + EMIT(1&OPERATOR[36:38:10]); 04007000 + COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTOR MODE 04008000 + OPERATORS. HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB; 04009000 +PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000 + INTEGER REPEAT,OPERATOR; 04011000 + BEGIN 04012000 + IF REPEAT}64 THEN FLAG(268); 04013000 + EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000 + COMMENT EMITV EMITS AN OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND 04015000 + HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04016000 + PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04017000 + BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04018000 + EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000 + COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000 + SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000 + PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000 + BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000 + EMIT(3 & ADDRESS [36:38:10]) END EMITN; 04024000 + COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000 + ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000 + EMITS PRTE; 04027000 + PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000 + VALUE ADDRESS,OPERATOR; 04029000 + INTEGER ADDRESS,OPERATOR; 04030000 + BEGIN 04031000 + EMITL(ADDRESS); 04032000 + IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000 + EMITO(OPERATOR) END EMITPAIR; 04034000 + COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000 + EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000 + OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000 + CODE CONSISTS OF A SERIES OF DUPS AND MULS. AS WITH 04038000 + EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000 + AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000 + NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 04041000 + IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000 + (APROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000 + OTHERWISE IT CALLS LN AND EXP; 04044000 + PROCEDURE EMITUP; 04045000 + BEGIN INTEGER BACKUP, CTR; 04046000 + LABEL E; 04047000 + IF NOT LINKTOG THEN GO TO E; 04048000 + COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000 + IF GET(L-1) = 537 THEN 04050000 + COMMENT LAST OPERATOR IS CHS; 04051000 + BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000 + IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000 + THEN BEGIN 04054000 + COMMENT IT IS A LITERAL; 04055000 + BACKUP ~ BACKUP+1; L ~ L-1; 04056000 + IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000 + COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000 + CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000 + WHILE GT4 DIV 2 ! 0 04060000 + DO BEGIN 04061000 + EMITO(DUP); 04062000 + IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000 + EMITO(MUL); 04064000 + GT4 ~ GT4 DIV 2 END; 04065000 + IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000 + ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000 + IF BACKUP = 2 04068000 + THEN BEGIN 04069000 + EMITL(1); 04070000 + EMITO(XCH); 04071000 + EMITO(128) END END 04072000 + ELSE BEGIN 04073000 + E: L ~ L+BACKUP; 04074000 + EMITO(MKS); 04075000 + EMITPAIR(GNAT(LOGI),LOD); 04076000 + EMITPAIR(GNAT(EXPI),LOD); 04077000 + EMITV(GNAT(XTOTHEI)); 04078000 + STACKCT ~ 0; %A 04078500 + EMITO(DEL) END END EMITUP; 04079000 + COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 04080000 + INERVENING SPACE WITH NOPS. IT CHECKS STREAMTOG TO DECIDE 04081000 + WHICH SORT OF NOP TO USE; 04082000 + PROCEDURE ADJUST; 04083000 + BEGIN 04084000 + DIALA ~ DIALB ~ 0; 04085000 + WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000 + END ADJUST; 04087000 + COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000 + NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000 + BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000 + (FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000 + OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000 + ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000 + COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000 + EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,04095000 + AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000 + EMITLNG; 04097000 + PROCEDURE EMITLNG; 04098000 + BEGIN LABEL E; 04099000 + IF NOT LINKTOG THEN GO TO E; 04100000 + COMMENT GO TO E IF LAST THING IS A LINK; 04101000 + IF GET(L) ! 0 THEN GO TO E; 04102000 + COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000 + LNG OR RELATIONAL OPERATOR; 04104000 + IF GT1 ~ GET(L-1) = 77 THEN L ~ L-1 04105000 + COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000 + ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000 + COMMENT LAST THING WAS A RELATIONAL; 04108000 + BEGIN L~L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000 + BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000 + COMMENT NEGATE THE RELATIONAL; END ELSE 04111000 + E: EMITO(LNG) END EMITLNG; 04112000 + COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000 + PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000 + VALUE BRANCH,FROM,TOWARDS; 04115000 + INTEGER BRANCH,FROM,TOWARDS; 04116000 + BEGIN 04117000 + INTEGER TL; 04118000 + TL ~ L; 04119000 + L ~ FROM-2; 04120000 + GT1 ~ TOWARDS-FROM; 04120100 + IF TOWARDS.[46:2] = 0 04120200 + THEN BEGIN 04120300 + BRANCH ~ BRANCH&1[39:47:1]; 04120400 + GT1 ~ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500 + EMITNUM(ABS(GT1)); 04121000 + EMITO(BRANCH&(REAL(GT1} 0)+1)[42:46:2]); 04122000 + IF BOOLEAN(BRANCH.[38:1]) THEN DIALA ~ DIALB ~ 0; 04123000 + L ~ TL 04124000 + END EMITB; 04125000 + COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000 + OCTAL, NAMELY : 04127000 + 1. 4 CHARACTERS FOR THE L REGISTER. 04128000 + 2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000 + STREAM PROCEDURE DEBUGWORD( SEQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000 + BEGIN 04131000 + DI~FEIL; SI~ LOC SEQ; SI~ SI+4; DS ~ 4 CHR; 04132000 + DS ~ 2 LIT" "; 04133000 + SI ~ LOC CODE ; 04134000 + 16( DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE 04135000 + DS ~ RESET ; SKIP 1 SB)); 04136000 + 49(DS ~ 2 LIT " "); 04137000 + END ; 04138000 + COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000 + DEBUGGING IS REQUIRED, "L" AND "WORD" ARE OUTPUT ON 04140000 + THE PRINTER FILE IN OCTAL FORMAT. ; 04141000 + PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000 + BEGIN 04143000 + ADJUST; 04144000 + IF L}4092 THEN ERR(200) 04145000 + ELSE BEGIN 04146000 + MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000 + IF DEBUGTOG THEN 04148000 + BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000 + WRITELINE END; 04150000 + L~L+4 END 04151000 + END EMITWORD; 04152000 + COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000 + BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000 + EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000 + OF C-RELATIVE OPDC S LEFT BY EMITNUM. IF C-RELATIVE 04156000 + ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000 + IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000 + THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000 + AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000 + F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000 + CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000 + PROCEDURE CONSTANTCLEAN ; 04163000 + IF MRCLEAN THEN 04164000 + BEGIN 04165000 + INTEGER J,TEMPL,D,LINK; 04166000 + BOOLEAN CREL; 04167000 + LABEL ALLTHU ; 04168000 + DIALA ~ DIALB ~ 0; 04169000 + FOR J ~ 1 STEP 2 UNTIL LASTENTRY DO 04170000 + BEGIN 04171000 + ADJUST; TEMPL~L; L~INFO[0,255-J+1]; 04172000 + CREL ~ FALSE; 04173000 + DO BEGIN 04174000 + IF D~(TEMPL-L+3)DIV 4}128 THEN 04175000 + BEGIN 04176000 + NCII~NCII+1; 04177000 + PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000 + PUTNBUMP(TAKE(255-J)); LASTINFO~NEXTINFO-2; 04179000 + GO TO ALLTHU; 04180000 + END; 04181000 + LINK~GET(L); 04182000 + CREL ~ TRUE; 04183000 + EMITV(D + 768); 04184000 + END UNTIL L~ LINK = 4095 ; 04185000 + ALLTHU: L ~ TEMPL; 04186000 + IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000 + END; 04188000 + LASTENTRY ~ 0; 04189000 + END ; 04190000 + COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000 + EXPLICIT AND IMPLICIT. IN EVERY CASE,EMITNUM WILL 04192000 + PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000 + THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000 + SYLLABLE IS PRODUCED. HOWEVER,NON-LITERALS ARE KEPT 04195000 + IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000 + POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000 + CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000 + TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000 + IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000 + ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000 + OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000 + PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000 + BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000 + IF C.[1:37]=0 THEN EMITL(C) 04205000 + ELSE 04206000 + BEGIN 04207000 + FOR N ~ 1 STEP 2 UNTIL LASTENTRY DO 04208000 + IF INFO[0,255-N] = C THEN GO TO FOUND ; 04209000 + INFO[0,255 -LASTENTRY] ~ L; 04210000 + INFO[0,255 -LASTENTRY-1]~ C ; 04211000 + EMITN(1023); 04212000 + LINKTOG~FALSE; 04213000 + IF LASTENTRY ~ LASTENTRY+2 } 128 THEN 04214000 + BEGIN 04215000 + C ~ BUMPL; 04216000 + CONSTANTCLEAN; 04217000 + EMITB(BFW,C,L); 04218000 + END; 04219000 + GO TO FINISHED; 04220000 + FOUND: EMIT(INFO[0,255 -N+1]); 04221000 + LINKTOG~FALSE; 04222000 + INFO[0,255-N+1]~ L-1; 04223000 + END; 04224000 + FINISHED:END EMITNUM ; 04225000 + COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000 + ARRAYS. GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000 + MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000 + BE FOUND SEARCH YIELDS BLANKS. 04229000 + NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000 + ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000 + BEGIN LABEL L; 04232000 + COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000 + BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000 + AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000 + THE LENGTH OF Q IS 128. ; 04236000 + INTEGER N,I ; 04237000 + N ~ 64 ; 04238000 + FOR I ~ 66 STEP IF Q[I] SUBLEVEL+1 THEN 04611000 + BEGIN 04612000 + EMIT(0); 04613000 + EMITPAIR(A, STD); 04614000 + END; 04615000 + EMITN(A); 04616000 +END CHECKDISJOINT; 04617000 + COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000 + COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000 + PROCEDURE STEPIT; ELCLASS ~ TABLE(I~I+1); 05002000 + INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1); 05003000 + COMMENT TAKE FETCHS A WORD FROM INFO; 05004000 + REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000 + TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC]; 05006000 + COMMENT PUT PLACES A WORD INTO INFO; 05007000 + PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000 + INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD; 05009000 + COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPPRESS FUTURE 05010000 + ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000 + PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000 + BEGIN 05013000 + COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000 + THE ERROR MESSAGE ON THE PRINTER; 05015000 + STREAM PROCEDURE WRITERROR(RMT,ERRNUM,ACCUM,LINE,COUNT,LSTSEQ); 05016000 + VALUE ERRNUM,COUNT; 05017000 + BEGIN 05018000 + DI ~ LINE; 44(DS~2LIT" "); COMMENT CLEAR BUFFER; 05019000 + SI ~LSTSEQ; SI ~ SI-8; DS ~WDS; 05020000 + SI ~ LINE; DS ~ 2 WDS; 05021000 + 4(DS ~ 2 LIT "XX"); COMMENT SET RIGHT MARGIN FLAG; 05022000 + SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000 + DI~LINE; SI~RMT; SI~SI+7; 05024000 + IF SC="1" THEN 05024100 + BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200 + 7(IF SC>"0" THEN JUMP OUT; 05024300 + SI~SI+1; TALLY~TALLY+1); 05024400 + RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500 + END ELSE DI~DI+7; 05024600 + DS~14 LIT " ERROR NUMBER "; 05025000 + SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000 + DS ~ 4 LIT " -- "; 05027000 + SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000 + COMMENT PLACE ALPHA IN BUFFER; 05029000 + DS ~ LIT "." 05030000 + END WRITERROR; 05031000 + IF ERRORTOG 05032000 + THEN BEGIN COMMENT DO NOTHING IF WE SUPPRESS MSSGS;05033000 + SPECTOG ~ FALSE; 05034000 + ERRORCOUNT ~ ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000 + IF NOT LISTOG AND NOT REMOTOG 05036000 + THEN BEGIN 05037000 + PRINT(LIN,FCR," ",IF LASTUSED=6 THEN FILEINX+17 05038000 + ELSE IF LASTUSED=3 THEN"T"ELSE IF LASTUSED=2 OR 05038500 + LASTUSED=5 THEN"R"ELSE 48); 05039000 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039500 + IF NOHEADING THEN DATIME ; 05039600 + WRITELINE; 05040000 + END; 05041000 + COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000 + ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000 + WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000 + INFO[LASTSEQROW,LASTSEQUENCE]); 05045000 + IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900 + IF NOT LISTOG.[46:1] THEN WRITELINE ; 05046000 + ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000 +IF PUNCHTOG THEN 05048000 + BEGIN 05049000 + STREAM PROCEDURE PUNCH(FL,ST); 05050000 + VALUE ST; 05051000 + BEGIN 05052000 + DI ~ FL; 05053000 + SI ~ ST; 05054000 + DS ~ 9 WDS 05055000 + END PUNCH; 05056000 + PUNCH(PNCH(0),FCR); 05057000 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000 + WRITE(PNCH) 05059000 + END 05060000 + 05061000 + 05062000 + 05063000 + 05064000 + 05065000 + 05066000 + 05067000 + 05068000 + 05069000 + 05070000 + 05071000 + 05072000 + 05073000 + 05074000 + 05075000 + 05076000 + 05077000 + 05078000 + 05079000 + 05080000 + 05081000 + 05082000 + 05083000 + 05084000 + 05085000 + 05086000 + 05087000 + 05088000 + 05089000 + 05090000 + 05091000 + 05092000 + 05093000 + 05094000 + 05095000 + 05096000 + 05097000 + 05098000 + 05099000 + 05100000 + END END FLAG; 05101000 + LABEL ENDOFITALL; 05101100 + COMMENT ERR,IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000 + RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000 + SEMICOLON, END, OR BEGIN; 05104000 + PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000 + BEGIN FLAG(ERRNUM); 05106000 + I ~ I-1; 05107000 + IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100 + DO IF STEPI = BEGINV THEN STMT UNTIL 05108000 + ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000 + DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000 + COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000 + UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000 + PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000 + BEGIN 05114000 + IF MODE } 2 THEN 05115000 + IF GT1 ~ ELBATWORD.LVL } FRSTLEVEL THEN 05116000 + IF GT1 < SUBLEVEL THEN 05117000 + IF ELBATWORD.[9:2] ! 1 05118000 + THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000 + END CHECKER; 05120000 + COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000 + GIVEN THE LINK TO THE ELBAT WORD; 05122000 + INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000 + GIT ~ TAKE(L).INCR+L.LINK; 05124000 + COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000 + IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000 + GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000 + INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000 + BEGIN 05129000 + REAL A; 05130000 + IF GNAT ~(A~TAKE(L)).ADDRESS=0 05131000 + THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11],L) 05132000 + END GNAT; 05133000 + COMMENT PASSFILE COMPILES CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR05134000 + POINTING AT THE I/O DESCRIPTOR (ON TOP). IT HANDLES 05135000 + SUPERFILES AS WELL AS ORDINARY FILES; 05136000 + PROCEDURE PASSFILE; 05137000 + BEGIN INTEGER ADDRES; 05138000 + CHECKER(ELBAT[I]); 05139000 + ADDRES ~ ELBAT[I].ADDRESS; 05140000 + IF ELCLASS = SUPERFILEID 05141000 + THEN BEGIN 05142000 + BANA; EMITN(ADDRES); EMITO(LOD) END 05143000 + ELSE BEGIN 05144000 + IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000 + STEPIT; 05146000 + EMITN(ADDRES) END END PASSFILE; 05147000 +PROCEDURE PASSMONFILE(ADDRESS); 05148000 + VALUE ADDRESS ; 05149000 + REAL ADDRESS ; 05150000 + BEGIN COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 05151000 + FILE TO PRINTI; 05152000 + IF ADDRESS < 768 OR ADDRESS > 1023 05153000 + THEN EMITL(5); 05154000 + EMITN(ADDRESS); 05155000 + END PASSMONFILE; 05156000 +PROCEDURE PASFILE; 05157000 + BEGIN COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 05158000 + MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 05159000 + DEFINE ELBATWORD = RR1#; COMMENT ELBATWORD CONTAINS THE 05160000 + ELBATWORD FOR THE FILE BEING 05161000 + OPERATED ON; 05162000 + DEFINE LTEMP = RR2#; COMMENT LTEMP IS USED TO HOLD THE L 05163000 + REGISTER SETTING FOR THE SAVE OR 05164000 + RELEASE LITERAL THAT GETS PASSED TO 05165000 + KEN MEYERS; 05166000 + EMITO(MKS); L~(LTEMP~L)+1; EMITL(0); 05167000 + EMITL(2); CHECKER(ELBATWORD~ELBAT[I]); 05168000 + IF RRB1~(RRB2~ ELCLASS = SUPERFILEID)OR 05169000 + BOOLEAN(ELBATWORD.FORMAL) 05170000 + THEN EMITO(LNG); 05171000 + IF RRB2 05172000 + THEN BANA 05173000 + ELSE STEPIT; 05174000 + EMITN(ELBATWORD.ADDRESS); 05175000 + IF RRB2 05176000 + THEN EMITO(LOD); 05177000 + IF RRB1 05178000 + THEN EMITO(INX); 05179000 + EMITL(4); EMITV(14); 05180000 + END PASFILE; 05181000 + COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE05182000 + PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000 + PROCEDURE CHECKPRESENCE; 05184000 + BEGIN 05185000 + EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000 + END CHECKPRESENCE; 05187000 + COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESC 05187500 + TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510 + PROCEDURE PASTOLIST; 05187520 + BEGIN 05187530 + INTEGER LISTADDRESS; 05187540 + COMMENT PASSLIST ASSUMES I POINTING AT LIST ID; 05187550 + CHECKER(ELBAT[I]); 05187560 + LISTADDRESS~ELBAT[I].ADDRESS; 05187570 + IF ELCLASS = SUPERLISTID 05187580 + THEN BEGIN COMMENT SUBSCRIPTED LIST ID; 05187590 + BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600 + END 05187610 + ELSE BEGIN 05187620 + IF LISTADDRESS<512 OR 05187630 + LISTADDRESS>1023 THEN 05187640 + BEGIN EMITL(LISTADDRESS); 05187650 + EMITN(10); 05187660 + END 05187670 + ELSE BEGIN 05187680 + IF LISTADDRESS<896 THEN 05187690 + EMITL(LISTADDRESS-512) 05187700 + ELSE BEGIN EMITL(LISTADDRESS- 05187710 + 897); EMITO(LNG) 05187720 + END; 05187730 + EMITN(512); EMITO(INX); 05187800 + END; 05187810 + STEPIT; 05187820 + END; 05187830 + END OF PASSTOLIST; 05187840 + REAL PROCEDURE TAKEFRST; 05188000 + TAKEFRST ~ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000 + COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000 + DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000 + STACK; 05198000 + PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000 + BEGIN 05200000 + EMITPAIR(ADDRESS,LOD); 05201000 + EMITN(512); 05202000 + EMITD(33,18,15) END STUFFF; 05203000 + COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000 + PRESENT CODE; 05205000 + BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000 + VALUE ELBATWORD; REAL ELBATWORD; 05207000 + BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000 + NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000 + LOCAL ~ TRUE END LOCAL; 05210000 + COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000 + PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000 + STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000 + PROCEDURE PASSFORMAT; 05214000 + BEGIN INTEGER ADRES; 05215000 + CHECKER(ELBAT[I]); 05216000 + ADRES ~ ELBAT[I].ADDRESS; 05217000 + IF BOOLEAN(ELBAT[I].FORMAL) 05218000 + THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END 05219000 + ELSE BEGIN 05220000 + IF TABLE(I) = SUPERFRMTID 05221000 + THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000 + END; 05223000 + IF TABLE(I) = SUPERFRMTID 05224000 + THEN BEGIN BANA; I ~ I-1; 05225000 + EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000 + EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000 + COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000 + WORDS - IT COMPLEMENTS THEIR STATE; 05229000 + PROCEDURE STREAMWORDS; 05230000 + BEGIN GT1 ~ 0; 05231000 + DO BEGIN 05232000 + INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000 + STACKHEAD[GT2] ~ T.LINK; 05234000 + GT1 ~ GT1+2; 05235000 + END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000 +STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000 + VALUE PRT,TYP,RELAD,SGNO; 05237500 + BEGIN LOCAL COUNT; 05238000 + DI:=LIN; DS:=6 LIT" PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 05238500 + 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05239000 + BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05239500 + COUNT:=TALLY; DS:=COUNT CHR; 05240000 + DS:= 31 LIT") = SEGMENT DESCRIPTOR, TYPE = "; 05240500 + SI:=LOC TYP; SI:=SI+7; DS:=CHR; % TYPE. 05241000 + DS:=21 LIT", RELATIVE ADDRESS = "; 05241500 + SI:=LOC RELAD; SI:=SI+4; DS:=4 CHR; % REL. ADDR. 05242000 + DS:=19 LIT", SEGMENT NUMBER = "; 05242500 + SI:=LOC SGNO; SI:=SI+4; DS:=4 CHR; DS:=LIT"."; 05243000 + END DEBUGDESC; 05243500 + REAL PROCEDURE PROGDESCBLDR(TYPE,RELAD,SPAC); 05245000 + COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE.IT IS 05246000 + CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 05247000 + BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 05248000 + SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 05249000 + THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 05250000 + TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE05251000 + AND ARGUMENT BIT FOR THE PROGRAM 05252000 + DESCRIPTOR TO BE BUILT. 05253000 + RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 05254000 + SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 05255000 + IF!0 THEN SPACE IS ALREADY GOTTEN 05256000 + ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000 + PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000 + VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000 + BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000 + PDPRT[PDINX.[37:5],PDINX.[42:6]]~0&RELAD[18:36:10] 05261000 + &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000 + IF DEBUGTOG THEN 05263000 + BEGIN 05263500 + BLANKET(14,LIN); 05264000 + DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO));05264500 + IF NOHEADING THEN DATIME; WRITELINE; 05265000 + END; 05265100 + PDINX~PDINX+1;PROGDESCBLDR~SPAC END PROGDESCBLDR; 05266000 + COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000 + IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000 + LITERALS INVOLVED; 05269000 + BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000 + INTEGER FIRST,SECOND; 05271000 + BEGIN 05272000 + LABEL EXIT; 05273000 + IF STEPI = LFTBRKET THEN 05274000 + IF STEPI = LITNO THEN 05275000 + IF STEPI = COLON THEN 05276000 + IF STEPI = LITNO THEN 05277000 + IF STEPI = RTBRKET THEN 05278000 + COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000 + IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000 + (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000 + IF FIRST + SECOND { 48 THEN 05282000 + COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000 + GO TO EXIT; 05284000 + ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000 + DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000 +BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000 + VALUE ELBATCLASS,ERRORNUMBER; 05288000 + REAL ELBATCLASS,ERRORNUMBER; 05289000 + BEGIN COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 05290000 + ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 05291000 + CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET05292000 + FALSE; 05293000 + IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000 + THEN ERR(ERRORNUMBER); 05295000 + END; 05296000 +BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000 + VALUE LOWER,UPPER; 05298000 + REAL LOWER,UPPER; 05299000 + COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000 + IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000 + UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000 + CLASS MUST BE IN ELCLASS; 05303000 + RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000 + COMMENT GET OBTAINS A SYLLABLE FROM EDOC, THE ARRAY INTO WHICH CODE IS 05305000 + EMITTED; 05306000 + INTEGER PROCEDURE GET(L); VALUE L; REAL L; 05307000 + BEGIN 05308000 + INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000 + BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000 + SI ~ W; SI ~ SI+S; SI ~ SI+S; DS ~ 2 CHR END; 05311000 + GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000 + COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000 + SCRIPTOR TO THE TOP OF THE STACK; 05314000 + PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000 + BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000 +REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000 + VALUE SIZE ; 05318000 + BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000 + FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000 + CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000 + ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000 + DI~LOC GETALPHA; DS~8 LIT"0 "; DI~DI-7; 05323000 + SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000 + END GETALPHA; 05325000 +PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010 + BEGIN 05325020 + LABEL EXIT; 05325030 + STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040 + VALUE PORS,CELL,N; 05325050 + BEGIN 05325060 + LOCAL COUNT; 05325070 + LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080 + SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090 + IF SC="P" THEN 05325100 + BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110 + ELSE BEGIN 05325120 + DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130 + IF SC}"6" THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140 + COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150 + DS:=11 RESET; DI:=COUNT; 05325160 + END; 05325170 + SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180 + 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190 + BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200 + COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210 + DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220 + CI:=CI+N; 05325230 + GO M0; 05325240 + GO M1; 05325250 + GO M2; 05325260 + GO M3; 05325270 + GO M4; 05325280 + GO M5; 05325290 + GO M6; 05325300 + GO M7; 05325310 +M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320 + DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330 + GO XIT; 05325340 +M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350 +M2: DI:=CELL; 05325360 + DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370 +M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380 +M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390 +M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400 +M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410 +M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420 +XIT: 05325430 + END FILLIT; 05325440 + BLANKET(14,LIN); 05325450 + IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460 +ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470 +ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480 + IF NOHEADING THEN DATIME; WRITELINE; 05325490 + END WRITEPRT; 05325500 + COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 05326000 + THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 05327000 + PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 05328000 + PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 05329000 + MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 05330000 +INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000 + BOOLEAN PERMANENT; INTEGER L; 05333000 + BEGIN LABEL L1,L2,EXIT; 05334000 + BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000 + BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000 + BOOLEAN M,Q; 05343000 + INTEGER ROW,COL,GS; 05344000 + IF PERMANENT 05345000 + THEN BEGIN 05346000 + IF PRTIMAX>1022 THEN FLAG(148);% 05347000 + SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000 + OR SPRT[GS]; 05349000 + PRTIMAX ~ (GS ~ PRTIMAX)+1 END 05350000 + ELSE IF MODE = 0 THEN BEGIN 05351000 + Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000 + M ~ MASK(COL ~ PRTI.[43:5]-35); 05353000 + COL ~ COL+35; 05354000 + L1: IF REAL(M AND Q) ! 0 05355000 + THEN BEGIN 05356000 + IF REAL(BOOLEAN(GS~4294967296-REAL(M)) AND Q) = GS 05357000 + THEN BEGIN 05358000 + COL ~ 0; M ~ TRUE; 05359000 + IF ROW ~ ROW+1 > 31 05360000 + THEN BEGIN FLAG(148); GS ~ PRTIMAX; 05361000 + GO TO L2 END; 05362000 + Q ~ SPRT[ROW]; 05363000 + GO TO L1 END; 05364000 + COL ~ COL+1; M ~ BOOLEAN(REAL(M)+REAL(M)); 05365000 + GO TO L1 END; 05366000 + PRTI ~ (GS ~ 32|ROW+COL)+1; 05367000 + IF PRTI > PRTIMAX THEN PRTIMAX ~ PRTI END 05368000 + ELSE BEGIN 05369000 + IF STACKCTR > 767 THEN FLAG(149); 05370000 + STACKCTR ~ (GS ~ STACKCTR)+1; Q ~ FALSE; 05371000 + GO TO EXIT END; 05372000 + L2: IF GS } 512 THEN GS ~ GS+1024; 05373000 + Q ~ TRUE; 05374000 + EXIT: GETSPACE ~ GS; 05375000 + IF GS > 1023 THEN GS ~ GS-1024; 05376000 + IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100 + END GETSPACE; 05378000 + COMMENT ARRAYCHECK CHECKS A PARAMETER-INFO WORD FOR SORT/MERGE; 05379000 + BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000 + ARRAYCHECK~AAW.CLASSINTARRAYID 05381000 + OR AAW.INCR !1; 05382000 + COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000 + BOOLEAN PROCEDURE COMMACHECK; 05384000 + BEGIN IF NOT(COMMACHECK~(STEPI=COMMA)) THEN ERR(350); 05385000 + STEPIT 05386000 + END COMMACHECK; 05387000 + COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000 + BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000 + IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000 + IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK~TRUE ELSE 05390100 + IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(357) ELSE 05391000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000 + HVCHECK~TRUE; 05393000 + COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000 + BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000 + IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000 + IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100 + IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000 + IF TAKE(GT1+1).CLASS!BOOID THEN ERR(353) ELSE 05398000 + IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000 + OUTPROCHECK~TRUE; 05400000 + COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000 + BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000 + IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000 + IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100 + IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000 + IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000 + EQLESCHECK~TRUE; 05407000 + COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000 + COMMENT AEXP IS THE ARITHMETIC EXPRESSION ROUTINE; 06001000 + PROCEDURE AEXP; 06002000 + BEGIN 06003000 + IF ELCLASS = IFV 06004000 + THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000 + ELSE BEGIN ARITHSEC; SIMPARITH END 06006000 + END AEXP; 06007000 + COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000 + IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000 + AND Q ARE PRIMARIES; 06010000 + PROCEDURE ARITHSEC; 06011000 + BEGIN 06012000 + IF ELCLASS = ADOP 06013000 + THEN BEGIN 06014000 + STEPIT; 06015000 + IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000 + ELSE BEGIN 06017000 + PRIMARY; 06018000 + WHILE ELCLASS = FACTOP DO %WF 06019000 + BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000 + ENDTOG ~ LINKTOG; EMITO(CHS); 06021000 + LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END 06022000 + ELSE PRIMARY END ARITHSEC; 06023000 + COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000 + ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000 + COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000 + WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000 + COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000 + SIMPARITH IS DONE BY ARITHCOMP, AN ARTIFIAL ROUTINE 06029000 + WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000 + ARITHCOMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000 + PROCEDURE SIMPARITH; 06032000 + BEGIN 06033000 + WHILE ELCLASS = AMPERSAND 06034000 + DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000 + WHILE ELCLASS}ADOP AND ELCLASS{FACTOP DO ARITHCOMP END; 06036000 + COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000 + ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000 + EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000 + IS OBTAINED BY RECURSION; 06040000 + PROCEDURE ARITHCOMP; 06041000 + BEGIN INTEGER OPERATOR, OPCLASS; 06042000 + DO BEGIN 06043000 + OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06044000 + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000 + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000 + OF THE ELBAT WORD; 06047000 + OPCLASS ~ ELCLASS; 06048000 + STEPIT; PRIMARY; 06049000 + IF OPCLASS = FACTOP THEN EMITUP 06050000 + ELSE BEGIN 06051000 + WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000 + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000 + STACKCT ~ 1; %A 06053500 + EMIT(OPERATOR) END 06054000 + END UNTIL OPCLASS ! ELCLASS END ARITHCOMP; 06055000 + COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 06056000 + PROCEDURE IMPFUN; 06057000 + BEGIN 06058000 + REAL T1,T2,T3 ; 06059000 + BOOLEAN B ; 06059050 + DEFINE ERRX(ERRX1)=BEGIN T1~ERRX1; GO ERROR END #; 06059100 + LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000 + MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100 + LABEL ERROR,L1,L2,L3 ; 06060110 + SWITCH S ~ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000 + MAXANDMIN, MAXANDMIN, DELAY;% 06061100 + DEFINE MAXV = 6#;% 06061200 + IF T2~(T1~ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000 + IF T2!25 THEN EMITO(MKS) ; 06062110 + IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120 + IF T2<24 THEN 06062125 + BEGIN 06062130 + L3: IF TABLE(I+1)=COMMA THEN 06062135 + IF ELCLASS>BOOID AND ELCLASSBOOPROCID THEN 06062370 + IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)06062380 + ELSE BEGIN EMITL(514); STEPIT END 06062385 + ELSE IF ELCLASSBOOARRAYID 06062390 + THEN VARIABLE(FL) 06062400 + ELSE ERRX(185) ; 06062420 + IF ELCLASS!RTPAREN THEN ERRX(104); STEPIT ; 06062430 + EMITO(IF B THEN ISD ELSE STD); EMITV(17); GO EXIT ;06062435 + END ; 06062440 + IF T2<23 THEN 06062470 + BEGIN % DMOD, DARCTAN2 06062480 + B~TRUE; GO L3 ; 06062500 + END ; 06062535 + IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540 + EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560 + ERROR: ERR(T1); GO EXIT ; 06062565 + OTHERS: EMITO(MKS) ; 06064000 + PANA; 06065000 + EMITV(GNAT(T1)); GO TO EXIT; 06066000 + ABS: PANA; EMITO(SSP); GO TO EXIT; 06067000 + SIGN: PANA; 06068000 + EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000 + EMITD(1,1,1); GO TO EXIT; 06070000 + ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000 + EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000 + MAXANDMIN:% 06072010 + IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030 + BEGIN STEPIT; AEXP;% 06072040 + WHILE ELCLASS=COMMA DO% 06072050 + BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060 + EMITPAIR(JUNK, SND);% 06072070 + IF T2=MAXV THEN EMITO(LSS) ELSE EMITO(GTR) ; 06072080 + EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090 + END;% 06072100 + IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110 + END;% 06072120 + GO TO EXIT;% 06072130 + DELAY: IF STEPI!LEFTPAREN THEN% 06072200 + BEGIN ERR(105); GO TO EXIT END;% 06072210 + STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220 + BEGIN ERR(165); GO TO EXIT END;% 06072230 + STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240 + BEGIN ERR(165); GO TO EXIT END;% 06072250 + STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260 + BEGIN ERR(104); GO TO EXIT END ELSE STEPIT;% 06072270 + EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280 + GO TO EXIT;% 06072290 + TIME: PANA; EMITL(1); EMITO(COM); 06073000 + GO TO EXIT; 06073100 + STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200 + IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250 + BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300 + EMITPAIR(32, COM); T1~3; 06073350 + END ELSE BEGIN EMIT(4); EMIT(0); T1~0; 06073400 + IF ELCLASS}BOOARRAYID AND ELCLASS{INTARRAYID THEN 06073450 + BEGIN T1~FI; VARIABLE(T1); END ELSE AEXP; 06073500 + IF T1=FI THEN 06073550 + BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1~3 06073600 + END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650 + BEGIN EMIT(0); EMITPAIR(32, COM); T1~3 END 06073700 + ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750 + EMITO(XCH); EMITO(DEL); 06073800 + IF ELCLASS!COMMA THEN 06073810 + BEGIN ERR(129); GO TO EXIT END; 06073820 + STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830 + END; END; END; 06073840 + GTI1~0; 06073845 + DO EMITO(DEL) UNTIL GTI1~GTI1+1=T1;% 06073850 + IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860 + GO TO EXIT; 06073870 + EXIT: END IMPFUN; 06074000 + COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000 + OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000 + DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000 + CASES; 06078000 + PROCEDURE PRIMARY; 06079000 + BEGIN 06080000 + LABEL 06081000 + L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000 + L30, L31, L32, L33, L34, L35; 06084000 + SWITCH S ~ 06085000 + L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000 + L30, L31, L32, L33, L34, L35; 06088000 + COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000 + LABEL EXIT,RP,LDOT,LAMPER; 06090000 + GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000 + IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005 + BEGIN 06092010 + IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015 + GO TO LAMPER ; 06092020 + END ; 06092025 + L12: L13: L17: L21: L25: L29: L30: 06093000 + COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000 + ERR(103); GO TO EXIT; 06095000 + L11: 06096000 + COMMENT INTRINSIC FUNCTIONS; 06097000 + IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A 06098000 + L14: L15: L16: 06099000 + COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100 + STRMPROCSTMT; GO TO LDOT; 06101000 + L18: L19: L20: 06102000 + COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100 + PROCSTMT(FALSE); GO TO LDOT; 06104000 + L22: L23: L24: L26: L27: L28: 06105000 + COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100 + VARIABLE(FP); GO TO LAMPER; 06107000 + L32: 06108000 + COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000 + EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000 + L31: L33: 06111000 + COMMENT STRINGS AND NONLITERALS; 06112000 + EMITNUM(C); STEPIT; GO TO LAMPER; 06113000 + L35: 06114000 + COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000 + EXPRESSION - OTHERWISE AN ERROR; 06116000 + IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000 + IF STEPI ! LEFTPAREN 06118000 + THEN BEGIN ERR(105); GO TO EXIT END; 06119000 + STEPIT; BEXP; GO TO RP END; 06120000 + ERR(106); GO TO EXIT; 06121000 + L34: 06122000 + COMMENT (; 06123000 + STEPIT; AEXP; 06124000 + STACKCT ~ STACKCT-1; %A 06124500 + RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000 + STEPIT; 06126000 + LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000 + LAMPER: STACKCT ~ STACKCT+1; %A 06128000 + WHILE ELCLASS = AMPERSAND %A 06128500 + DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000 + COMMENT THIS CODE HANDLES CANCATENATES; 06130000 + EXIT: END PRIMARY; 06131000 + COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000 + PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000 + COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000 + ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000 + BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000 + DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000 + OR DESIGNATIONAL EXPRESSION; 06138000 + INTEGER PROCEDURE EXPRSS; 06139000 + BEGIN 06140000 + IF ELCLASS = IFV 06141000 + THEN BEGIN 06142000 + IF EXPRSS ~ IFEXP = ATYPE 06143000 + THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000 + ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000 + END EXPRSS; 06146000 + COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000 + EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000 + AS EXPRSS REPORTS; 06149000 + INTEGER PROCEDURE BOOSEC; 06150000 + BEGIN BOOLEAN N; 06151000 + IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000 + GT4 ~ BOOSEC ~ BOOPRIM; 06153000 + IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000 + COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000 + RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000 + IF GT4 ! BTYPE THEN ERR(109) 06157000 + COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000 + LOGICALLY NEGATED; 06159000 + END END BOOSEC; 06160000 + COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000 + THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000 + ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000 + PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000 + A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000 + COMP, AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000 + LYSIS USING RECURSION; 06167000 + PROCEDURE SIMPBOO; 06168000 + BEGIN 06169000 + WHILE ELCLASS = AMPERSAND 06170000 + DO BEGIN 06171000 + STEPIT; 06172000 + IF BOOPRIM! BTYPE THEN ERR(109); 06173000 + PARSE END; 06174000 + WHILE ELCLASS } EQVOP AND ELCLASS { ANDOP DO BOOCOMP 06175000 + END BOOCOMP; 06176000 + COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000 + IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000 + OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000 + SION; 06180000 + PROCEDURE BOOCOMP; 06181000 + BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000 + DO BEGIN 06183000 + OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000 + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000 + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000 + OF THE ELBAT WORD; 06187000 + OPCLASS ~ ELCLASS; 06188000 + STEPIT; 06189000 + IF BOOSEC ! BTYPE 06190000 + THEN BEGIN ERR(109); GO TO EXIT END; 06191000 + WHILE OPCLASS < ELCLASS 06192000 + DO IF ELCLASS { ANDOP THEN BOOCOMP 06193000 + ELSE BEGIN ERR(110); GO TO EXIT END; 06194000 + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000 + STACKCT ~ 1; %A 06195500 + IF OPCLASS = IMPOP 06196000 + THEN BEGIN 06197000 + COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000 + ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000 + THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000 + EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000 + FUTURE. (SEE CODE FOR EMITLNG); 06202000 + EMITLNG; 06203000 + EMITO(LND); 06204000 + EMITO(LNG); 06205000 + EMIT(0); 06206000 + L ~ L-1 END 06207000 + ELSE EMIT(OPERATOR) 06208000 + END UNTIL OPCLASS ! ELCLASS; 06209000 + EXIT: END BOOCOMP; 06210000 + COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000 + DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000 + INTEGER PROCEDURE BOOPRIM; 06213000 + BEGIN INTEGER TYPE; 06214000 + LABEL L9, 06215000 + L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000 + L30, L31, L32, L33, L34, L35; 06218000 + SWITCH S ~ L9, 06219000 + L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000 + L30, L31, L32, L33, L34, L35; 06222000 + COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000 + LABEL EXIT,LE,D,TD,T; 06224000 + LABEL FAH ; 06224500 + GO TO S[ELCLASS-SUPERFILEID]; 06225000 + IF ELCLASS = ADOP THEN GO TO L11; 06226000 + IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500 + BEGIN 06227510 + BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520 + GO FAH ; 06227530 + END ; 06227540 + LE: L10: L12: 06228000 + COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000 + EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000 + ERR(111); GO TO EXIT; 06231000 + L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000 + THEN BEGIN PANA; GO TO TD END; 06233000 + IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000 + L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000 + L31: L32: L33: 06236000 + COMMENT ARITHMETIC TYPE STUFF; 06237000 + AEXP; 06238000 + D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000 + RELATION; 06240000 + BOOPRIM ~ BTYPE; GO TO EXIT; 06241000 + L13: 06242000 + COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100 + STRMPROCSTMT; GO TO TD; 06244000 + L17: 06245000 + COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100 + PROCSTMT(FALSE); GO TO TD; 06247000 + L21: L25: 06248000 + COMMENT BOOLEAN VARIABLES; 06249000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100 + VARIABLE(FP); GO TO T; 06250000 + L9: L29: 06251000 + COMMENT LABELS AND SWITCHES; 06252000 + DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000 + L30: 06254000 + COMMENT TRUE OR FALSE; 06255000 + EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000 + L34: 06257000 + COMMENT (; 06258000 + STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000 + COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000 + STACKCT ~ STACKCT-1; %A 06260500 + IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000 + STEPIT; 06262000 + FAH: 06262500 + IF TYPE = DTYPE THEN GO TO EXIT; 06263000 + COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000 + IF TYPE = BTYPE THEN BEGIN 06265000 + TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000 + T: STACKCT ~ STACKCT+1; %A 06267000 + WHILE ELCLASS = AMPERSAND DO %A 06267500 + COMMENT HANDLES CONCATENATE; 06268000 + BEGIN 06269000 + STEPIT; 06270000 + IF BOOPRIM ! BTYPE 06271000 + THEN BEGIN ERR(109); GO TO EXIT END; 06272000 + PARSE END; 06273000 + BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000 + COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000 + EXPRESSION; 06276000 + DOT; SIMPARITH; GO TO D; 06277000 + EXIT: END BOOPRIM; 06278000 + COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000 + EXPRESSION HAS ALREADY BEEN COMPILED; 06280000 + PROCEDURE RELATION; 06281000 + BEGIN INTEGER OPERATOR; 06282000 + OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06283000 + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06284000 + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06285000 + OF THE ELBAT WORD; 06286000 + STEPIT; AEXP; EMIT(OPERATOR); 06287000 + STACKCT ~ 1; %A 06287500 + EMIT(0); L ~ L-1; 06288000 + COMMENT THE LAST LINE IS PREPARATORY. EMITLNG USES THIS TO IMPROVE06289000 + CODE LATER; 06290000 + END RELATION; 06291000 + COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000 + OF EXPRESSIONS AS EXPRSS REPORTS; 06293000 + INTEGER PROCEDURE IFEXP; 06294000 + BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000 + IFCLAUSE; 06296000 + STACKCT ~ 0; %A 06296500 + THENBRANCH ~ BUMPL; 06297000 + COMMENT SAVE L FOR LATER FIXUP; 06298000 + IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000 + STACKCT ~ 0; %A 06299500 + ELSEBRANCH ~ BUMPL; 06300000 + EMITB(BFC,THENBRANCH,L); 06301000 + IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000 + STEPIT; 06303000 + IF TYPE = ATYPE THEN AEXP ELSE 06304000 + IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000 + STACKCT ~ 1; %A 06305500 + COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000 + EMITB(BFW,ELSEBRANCH,L); 06307000 + EMIT(1); L ~ L-1; 06308000 + COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000 + BOOSEC, BOOCOMP, AND RELATION; 06310000 + END END IFEXP; 06311000 + PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000 + BEGIN INTEGER FIRST,SECOND,THIRD; 06312500 + BOOLEAN P1,P2,P3; 06313000 + LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500 + IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000 + IF STEPI ! LITNO THEN GO TO L1; 06314500 + FIRST ~ C; 06315000 + IF TABLE(I+1) = COLON THEN 06315500 + BEGIN 06316000 + STEPIT; 06316500 + IF FIRST {0 THEN FLAG(92); 06317000 + END ELSE 06317500 + BEGIN 06318000 + L1: EMITO(MKS); 06318500 + AEXP; 06319000 + P1 ~ TRUE; 06319500 + IF ELCLASS ! COLON THEN BEGIN ERR(91);GO TO EXIT END; 06320000 + END; 06320500 + IF STEPI ! LITNO THEN GO TO L2; 06321000 + 06321100 + SECOND ~ C ; 06321500 + IF GT1 ~ TABLE(I+1) = COLON THEN 06322000 + BEGIN 06322500 + STEPIT; 06323000 + IF SECOND {0 THEN FLAG(092); 06323500 + END ELSE 06324000 + BEGIN 06324500 + IF GT1 = RTBRKET THEN 06325000 + BEGIN 06325500 + STEPIT; 06326000 + SECOND ~ 48 - (THIRD ~ SECOND); 06326500 + GO TO SKIP2; 06327000 + END; 06327500 + L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000 + AEXP; 06328500 + P1 ~ P2 ~ TRUE; 06329000 + IF ELCLASS = COLON THEN 06329100 + 06329200 + 06329300 + ELSE 06329350 + IF ELCLASS = RTBRKET THEN 06329400 + BEGIN 06329450 + EMITO(DUP); 06329500 + EMITL(48) ;EMITO(SUB); 06329550 + EMITO(CHS);EMITO(XCH); 06329600 + P3 ~ TRUE; 06329700 + GO TO SKIP1; 06329800 + END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900 + END; 06330000 + IF STEPI ! LITNO THEN GO L3 ; 06330500 + THIRD ~ C; 06330600 + IF TABLE(I+1) = RTBRKET THEN 06330700 + BEGIN 06330800 + STEPIT; 06331000 + SKIP2: IF THIRD {0 OR THIRD > 47 THEN FLAG(95); 06331100 + END ELSE 06331200 + BEGIN 06331300 + L3: IF NOT P2 THEN 06331500 + BEGIN 06331600 + IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700 + EMITL(SECOND); 06331800 + END; 06332000 + AEXP; 06332100 + P1~ P2~P3 ~TRUE; 06332200 + IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300 + END; 06332400 + SKIP1: IF P1 THEN 06332500 + BEGIN 06333000 + IF NOT P2 THEN EMITL(SECOND); 06333500 + IF NOT P3 THEN 06334000 + BEGIN 06334100 + EMITL(THIRD);EMITL(1); 06334200 + EMITV(GNAT(DIALER)); 06334500 + EMIT(TRB & THIRD[36:42:6]); 06334600 + END ELSE 06334700 + BEGIN 06335000 + EMITL(0); 06335100 + EMITV(GNAT(DIALER)); 06335200 + EMITO(DEL); 06335500 + END; 06335700 + END ELSE 06336000 + BEGIN 06336100 + IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200 + EMITD(SECOND,FIRST,THIRD); 06336300 + END; 06336400 + STEPIT; 06336500 + EXIT: STACKCT ~ 1; 06336600 + END PARSE; 06336700 + COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000 + THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100 + PROCEDURE DOTIT; 06338000 + BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000 + 06340000 + IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06341000 + %A 06342000 + EMITI(0,FIRST,SECOND); %A 06343000 + %A 06344000 + STEPIT; 06345000 + EXIT: END DOTIT; 06346000 + COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000 + PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000 + THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000 + SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000 + IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000 + IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000 + BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000 + THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000 + IS ALSO STORED IN F+1; 06355000 + PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000 + BEGIN INTEGER TLEVEL; 06357000 + EMITO(MKS); 06358000 + IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000 + JUMPCTR ~ TLEVEL; 06360000 + COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000 + INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000 + BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000 + JUMPING; 06364000 + IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000 + THEN BEGIN 06366000 + COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000 + EMIT(0); 06368000 + EMITL(TLEVEL) END 06369000 + ELSE BEGIN 06370000 + EMITN(512); 06371000 + EMITV(513); COMMENT PICK UP BLOCKCTR AT ENTRY 06372000 + FROM F+1; 06373000 + IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000 + THEN BEGIN 06375000 + EMITL(TLEVEL); 06376000 + EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000 + AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000 + END END; 06379000 + EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000 + END GENGO; 06381000 + COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000 + IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000 + THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000 + STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000 + SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000 + COMMUNICATE WILL BE DONE; 06387000 + PROCEDURE DEXP; 06388000 + BEGIN 06389000 + LABEL EXIT; 06390000 + BOOLEAN S,F; 06391000 + REAL ELBW; 06392000 + IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000 + THEN BEGIN 06394000 + CHECKER(ELBW ~ ELBAT[I]); 06395000 + SCATTERELBAT; 06396000 + IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000 + IF FAULTOG THEN 06397100 + IF S OR F THEN FAULTLEVEL~1 ELSE 06397200 + IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300 + IF S THEN BEGIN 06398000 + BANA; EMITPAIR(JUNK,ISD); 06399000 + EMITV(GNAT(ELBW)); 06400000 + IF F THEN GO TO EXIT; END 06401000 + ELSE BEGIN 06402000 + STEPIT; 06403000 + IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000 + EMITL(GNAT(ELBW)) END; 06405000 + GENGO(ELBW); 06406000 + END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000 + EXIT: END DEXP; 06408000 + PROCEDURE IFCLAUSE; 06409000 + BEGIN STEPIT; STACKCT ~ 0; BEXP; %A 06410000 + IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000 + COMMENT PANA COMPILES THE CONSTRUCT: (); 06412000 + PROCEDURE PANA; 06413000 + BEGIN 06414000 + IF STEPI ! LEFTPAREN THEN ERR(105) 06415000 + ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000 + ERR(104) ELSE STEPIT END END PANA; 06417000 + COMMENT BANA COMPILES THE CONSTRUCT: []; 06418000 + PROCEDURE BANA; 06419000 + BEGIN 06420000 + IF STEPI ! LFTBRKET THEN ERR(117) 06421000 + ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000 + ERR(118) ELSE STEPIT END END BANA ; 06423000 + PROCEDURE MAKEALABEL; 06500000 + BEGIN LABEL EXIT; REAL I; 06501000 + STREAMTOG~FALSE; 06502000 + EMITO(MKS); PASSFILE; 06503000 + IF ELCLASS!WITHV THEN 06504000 + BEGIN ERR(301); GO TO EXIT END; 06505000 + FOR I~1 STEP 1 UNTIL 6 DO 06506000 + BEGIN IF STEPI=FACTOP THEN 06507000 + BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000 + ELSE AEXP; 06509000 + IF ELCLASS!COMMA THEN GO TO EXIT; 06510000 + END; 06511000 +EXIT: FOR I:=I STEP 1 UNTIL 5 DO 06512000 +BEGIN EMIT(4);EMITO(CHS) END; 06512100 +EMITL(11); 06512200 + EMITV(5); 06513000 + END; 06514000 + COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES; 07000000 + COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 07001000 + COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES 07002000 + ARE SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE 07003000 + FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME 07004000 + CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 07005000 +PROCEDURE COMPOUNDTAIL; 07006000 + BEGIN LABEL ANOTHER; 07007000 + I ~ I-1; BEGINCTR ~ BEGINCTR+1; 07008000 + ANOTHER: ERRORTOG ~ TRUE; COMMENT ALLOW ERROR MESSAGES; 07009000 + STEPIT; 07010000 + IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000 + IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000 + IF ELCLASS ! ENDV 07013000 + THEN BEGIN 07014000 + ERR(119); GO TO ANOTHER END; 07015000 + ENDTOG~TRUE; 07016000 + DO STOPDEFINE~TRUE UNTIL 07017000 + STEPI{ENDV AND ELCLASS}UNTILV 07018000 + OR NOT ENDTOG; 07019000 + ENDTOG~FALSE; 07020000 + IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000 + THEN BEGIN 07022000 + IF BEGINCTR = 0 THEN 07023000 + BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000 + FLAG(120) END; 07025000 + IF ELCLASS = PERIOD THEN 07026000 + BEGIN 07027000 + GT5 ~ "ND;END."&"E"[1:43:5]; 07028000 + MOVE(1,GT5,CARD(0)); 07029000 + LASTUSED~4; 07030000 + ELBAT[I~I-2] ~SPECIAL[20]; 07031000 + ELCLASS ~ SEMICOLON END 07032000 + END COMPOUNDTAIL; 07033000 + COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000 + PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000 + ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000 + NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000 + CONCERNING THE PARAMETERS: 07038000 + FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000 + OR NOT. 07040000 + SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000 + PROCEDURE OR NOT. 07042000 + INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000 + INFORMATION; 07044000 + PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000 + VALUE FBIT,SBIT,INDEX; 07046000 + BOOLEAN FBIT,SBIT; 07047000 + INTEGER INDEX; 07048000 + BEGIN 07049000 + INTEGER PCTR,ACLASS,SCLASS; 07050000 + COMMENT 07051000 + PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000 + COMPILED. 07053000 + ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000 + SCLASS IS THE CLASS OF THE FORMAL PARAMETER. 07055000 + THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000 + TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000 + SIMILAR MEANINGS; 07058000 + REAL WHOLE; 07059000 + COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000 + PARAMETERS; 07061000 + BOOLEAN VBIT; 07062000 + COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000 + BE CALLED BY VALUE OR BY NAME; 07064000 + LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000 + LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000 + CERR,FGEN; 07067000 + LABEL 07068000 + L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000 + L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000 + L31,L32,L33; 07071000 + SWITCH S ~ 07072000 + L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000 + L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000 + L31,L32,L33; 07075000 + REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000 + TO REDUCING TOTAL NUMBER; 07077000 + PCTR ~ 1; 07078000 + ANOTHER: ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 07079000 + STACKCT ~ 0; %A 07079500 + COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000 + IF FBIT THEN BEGIN VBIT ~ FALSE; SCLASS ~ LOCLID END 07081000 + COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000 + IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000 + METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK 07084000 + ELSE BEGIN 07085000 + VBIT ~ BOOLEAN(GT1~ TAKE(INDEX+PCTR)).VO; 07086000 + IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000 + SCLASS } BOOSTRPROCID 07088000 + THEN IF GT1 ~ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000 + THEN SCLASS ~ SCLASS-GT1+1 07090000 + COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-07091000 + AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000 + SOURCE, HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000 + END; 07094000 + IF T1 ~ TABLE(I+1) ! COMMA THEN 07095000 + IF T1 ! RTPAREN THEN 07096000 + COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000 + HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000 + BEGIN IF ACLASS { IDMAX OR ACLASS = SUPERLISTID THEN 07099000 + CHECKER(WHOLE); 07099500 + IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000 + THEN BEGIN 07101000 + COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000 + HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000 + SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000 + IF ACLASS = SUPERFRMTID THEN 07105000 + BEGIN ACLASS ~ FRMTID; GO TO FGEN END; 07106000 + IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000 + THEN BEGIN 07108000 + T4~L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500 + IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505 + ACLASS ~ FILEID; 07109000 + COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000 + PASSFILE; 07111000 + IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200 + BEGIN 07111210 + IF VBIT THEN 07111220 + BEGIN 07111225 + T5~L; L~T4; EMITO(MKS); L~T5; T5~0 ; 07111230 + END ; 07111235 + ACLASS~IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240 + THEN REALID ELSE BOOID ; 07111250 + IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255 + IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260 + BEGIN 07111265 + SIMPARITH ; 07111270 + IF ELCLASS=RELOP THEN 07111275 + BEGIN 07111280 + ACLASS~BOOID; RELATION ; 07111285 + SIMPBOO ; 07111290 + END ; 07111295 + END ; 07111300 + IF NOT VBIT THEN 07111303 + BEGIN 07111307 + EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310 + EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315 + EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320 + EMITB(BFW,T4+2,L) ; 07111325 + STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330 + END ; 07111335 + GO BS ; 07111340 + END OF FILE ATTRIBUTE PARAMETER EXPRESSION;07111345 + IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000 + I ~ I-1; 07113000 + COMMENT IF WE ARE HERE IT IS INDEXED; 07114000 + CHECKPRESENCE; 07115000 + EMITO(LOD); PANA; EMITO(CDC); 07116000 + IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000 + THEN BEGIN ERR(121); GO TO CERR END 07118000 + COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000 + STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000 + RELEASE ON THIS DESCRIPTOR 07121000 + ELSE GO TO COMMON END ; 07122000 + IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500 + EMITN(WHOLE.ADDRESS); 07122510 + EMITO(LOD); 07122520 + EMITO(LOD); 07122530 + ACLASS~LISTID; GO TO BS END; 07122540 + COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000 + NORMAL: IF VBIT THEN 07124000 + VE: T1 ~ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000 + ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000 + IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000 + COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;07128000 + T2 ~ BAE; 07129000 + T3 ~ PROGDESCBLDR(0,L,0); 07130000 + COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000 + AROUND CODE FOR EXPRESSION; 07132000 + T1 ~ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000 + STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000 + COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000 + PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000 + INTO JUNK; 07137000 + LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000 + COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000 + THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000 + EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000 + THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000 + OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000 + END OF NAME CALL EXPRESSIONS; 07144000 + ACLASS ~ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000 + THEN BOOID ELSE LABELID; GO TO BS; 07146000 + END OF EXPRESSION CALL CODE; 07147000 + COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000 + ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000 + IF SCLASS } BOOARRAYID THEN 07150000 + IF SCLASS { INTARRAYID THEN 07151000 + BEGIN T2 ~ TAKE(INDEX+PCTR).INCR; 07152000 + COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.07153000 + THUS WE MUST HAVE A ROW DESIGNATOR; 07154000 + IF ACLASS ! BOOARRAYID THEN ACLASS ~ REALARRAYID; 07155000 + COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000 + VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000 + THEN BEGIN ERR(123); GO TO EXIT END; 07158000 + COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000 + COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000 + STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000 + LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000 + THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000 + ELSE GO TO BS END; 07167000 + IF VBIT THEN GO TO VE; 07168000 + COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000 + VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000 + IF SBIT 07171000 + THEN BEGIN 07172000 + T6 ~ FL; VARIABLE(T6); 07173000 + IF T6 ! 0 THEN GO TO BS; 07174000 + FLAG(122);GO TO CERR END; 07175000 + COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000 + CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000 + VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000 + THAN THIS IT SETS T6 TO ZERO; 07179000 + COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000 + WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000 + 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE, 07182000 + 2) A SUBSCRIPTED VARIABLE, OR 07183000 + 3) A GENUINE NAME CALL EXPRESSION; 07184000 + IF TABLE(I+2) = LITNO AND 07185000 + ( GT1 ~ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000 + THEN BEGIN 07187000 + COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000 + CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000 + ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000 + VARIABLE(FL); 07191000 + ACLASS ~ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000 + REALID; GO TO BS END; 07193000 + T2 ~ BAE; T3 ~ L; 07194000 + COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000 + IF WE HAVE ROW DESIGNATOR; 07196000 + T6 ~ FA; VARIABLE(T6); 07197000 + IF TABLE(I-2) = FACTOP 07198000 + THEN BEGIN 07199000 + COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000 + EMITB(BFW,T2,T3); T2 ~ STLB; GO TO LOWBD END; 07201000 + COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000 + T3 ~ PROGDESCBLDR(0,T3,0); 07203000 + T1 ~ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000 + IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000 + COMMENT WE ARE AT END OF PARAMETER; 07206000 + IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000 + GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000 + GO TO LRTS; 07209000 + IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000 + IF ELCLASS = RELOP THEN BEGIN T1 ~ BTYPE; RELATION; 07211000 + FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000 + COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000 + ACTUAL PARAMETER; 07214000 + IF ACLASS { IDMAX OR ACLASS = SUPERLISTID THEN 07215000 + CHECKER(WHOLE); STEPIT; 07215500 + GO TO S[ACLASS-3]; 07216000 + IF ACLASS = 0 THEN FLAG(100) ELSE 07217000 + IF ACLASS= SUPERLISTID THEN 07217500 + BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510 + FLAG(126); 07217520 + CERR: 07218000 + L12:L13:L14:L15:L16: 07219000 + COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000 + FLAG(125); ERRORTOG ~ TRUE; GO TO COMMON; 07221000 + LODPOINT: 07222000 + L4:L8: 07223000 + COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000 + EMITPAIR(ADDRSF,LOD); 07225000 + NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000 + COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000 + STREAM PROCEDURES; 07228000 + BS: IF SCLASS ! ACLASS THEN 07229000 + IF SCLASS ! LOCLID THEN 07230000 + COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000 + AGREE; 07232000 + BEGIN FLAG(123); GO TO CERR END; 07233000 + COMMON: 07234000 + COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000 + PCTR ~ PCTR+1; 07236000 + IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000 + IF ELCLASS ! RTPAREN 07238000 + THEN BEGIN ERROR(129); GO TO EXIT END; 07239000 + IF NOT FBIT THEN 07240000 + IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000 + THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000 + ERR(128); GO TO EXIT END; 07243000 + STEPIT; GO TO EXIT; 07244000 + L5: 07245000 + COMMENT FORMATS; 07246000 + I~I-1; 07247000 + FGEN: PASSFORMAT; 07248000 + IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000 + I~I+1; 07250000 + GO TO BS; 07251000 + L6: 07252000 + COMMENT SUPERFORMAT; 07253000 + IF FBIT 07254000 + THEN BEGIN EMITV(ADDRSF); ADDRSF ~ ADDRSF-1 END 07255000 + ELSE BEGIN I ~ I -1; EMITL(TAKEFRST); I ~ I+1 END; 07256000 + GO TO LODPOINT; 07257000 + L7: 07258000 + COMMENT FILE; 07259000 + I ~ I-1; ELCLASS ~ FILEID; 07260000 + PASSFILE; GO TO BS; 07261000 + L9: 07262000 + COMMENT SWITCH; 07263000 + IF FORMALF THEN GO TO LODPOINT; 07264000 + COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000 + MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000 + DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000 + ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000 + THEY ARE OR NOT; 07269000 + T2 ~ BAE; T3~PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000 + GENGO(WHOLE); 07271000 + EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000 + L10: 07273000 + COMMENT PROCEDURE; 07274000 + TB1 ~ TRUE; IF FORMALF THEN GO TO LODPOINT; 07275000 + LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000 + THEN BEGIN 07277000 + COMMENT THE PROCEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000 + IF TB1 THEN GO TO LODPOINT; 07279000 + COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000 + DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);07281000 + IF NOT FBIT THEN 07281900 + IF SCLASS { INTPROCID THEN SCLASS ~ SCLASS+4; 07282000 + I ~ I-2; STEPIT; 07283000 + GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000 + EXPRESSIONS HANDLE THIS CASE; 07285000 + END THE CASE OF ZERO PARAMETERS; 07286000 + TB1 ~ TRUE; 07287000 + FOR T2 ~ 1 STEP 1 UNTIL T1 07288000 + DO BEGIN 07289000 + IF BOOLEAN(T3~TAKE(WHOLE+T2)).VO 07290000 + THEN 07291000 + IF T4 ~ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000 + THEN BEGIN 07293000 + COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000 + IF TB1 THEN 07295000 + BEGIN 07296000 + COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000 + VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000 + PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000 + VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000 + PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK07301000 + CONSTRUCTIONS; 07302000 + GOBBLE: 07303000 + TB1 ~ FALSE; T5 ~ BAE; 07304000 + T6 ~ PROGDESCBLDR(1,L,0) END; 07305000 + EMITV(T4 ~ T3.ADDRESS); EMITPAIR(T4,STD)END END;07306000 + COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000 + IF NOT TB1 07308000 + THEN BEGIN 07309000 + COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000 + EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000 + CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000 + GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000 + L11: 07314000 + COMMENT INTRINSIC PROCEDURE; 07315000 + ADDRSF ~ GNAT(WHOLE); 07316000 + COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000 + ACLASS ~ REALPROCID; 07318000 + T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000 + COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000 + PROCEDURES; 07321000 + L19:L20: 07322000 + COMMENT ALFAPROC AND INTPROC; 07323000 + ACLASS ~ REALPROCID; 07324000 + L17:L18: 07325000 + COMMENT BOOPROC AND REAL PROC; 07326000 + IF FORMALF 07327000 + THEN BEGIN 07328000 + COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000 + IF SCLASS > INTPROCID THEN ACLASS ~ ACLASS+4; 07330000 + COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000 + EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000 + PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000 + IF VBIT 07334000 + THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000 + ELSE GO TO LODPOINT; 07336000 + COMMENT IF VBIT WE DO VALUE CALL, OTHERWISE WE PASS PROCEDURE 07337000 + DESCRIPTOR ALONG; 07338000 + END; 07339000 + TB1 ~ FALSE; GO TO LP; 07340000 + L23:L24: 07341000 + COMMENT INTEGER AND ALPHA IDS; 07342000 + ACLASS ~ REALID; 07343000 + L21:L22: 07344000 + COMMENT BOOLEAN AND REAL IDS; 07345000 + IF VBIT THEN EMITV(ADDRSF) 07346000 + ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000 + THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000 + COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000 + AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000 + THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000 + GO TO BS; 07352000 + L27:L28: 07353000 + COMMENT INTEGER AND ALPHA ARRAYS; 07354000 + ACLASS ~ REALARRAYID; 07355000 + L25:L26: 07356000 + COMMENT BOOLEAN AND REAL ARRAYS; 07357000 + EMITPAIR(ADDRSF,LOD); 07358000 + IF SBIT THEN GO TO BS; 07359000 + COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000 + T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000 + FOR T2 ~ 1 STEP 1 UNTIL T1 07362000 + DO BEGIN 07363000 + IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000 + THEN EMITV(T3) ELSE EMIT(STLB); 07365000 + IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000 + COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000 + IF FBIT THEN GO TO BS; 07368000 + IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000 + COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000 + OF DIMENSIONS; 07371000 + L29: 07372000 + COMMENT LABEL; 07373000 + ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000 + L30: 07375000 + COMMENT TRUTH VALUE; 07376000 + EMITL(ADDRSF); ACLASS ~ BOOID; GO TO BSX; 07377000 + L32: 07378000 + COMMENT LITERAL; 07379000 + EMITL(ADDRSF); 07380000 + BSXX: ACLASS ~ REALID; 07381000 + BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000 + L31:L33: 07383000 + EMITNUM(C); GO TO BSXX; 07384000 + EXIT: STACKCT ~ 0 END OF ACTUALPARAPART; %A 07385000 + COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000 + FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000 + PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000 + IS TRUE. PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000 + OPERATIONS; 07390000 + PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000 + BEGIN 07392000 + REAL HOLE,ADDRESS; 07393000 + LABEL EXIT; 07394000 + SCATTERELBAT; 07395000 + HOLE~ ELBAT[I]; 07396000 + ADDRESS ~ ADDRSF; 07397000 + CHECKER(HOLE); 07398000 + IF ELCLASS ! PROCID THEN 07399000 + IF NOT FORMALF THEN 07400000 + IF TABLE(I+1) = ASSIGNOP THEN 07401000 + BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000 + COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000 + IF ELCLASS ! PROCID EQV FROM 07404000 + THEN BEGIN ERR(159); GO TO EXIT END; 07405000 + COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000 + STEPIT; 07407000 + EMITO(MKS); 07408000 + IF ELCLASS = LEFTPAREN 07409000 + THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000 + ELSE IF FORMALF THEN 07411000 + IF FROM THEN ELSE L~L-1 07411100 + ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000 + EMITV(ADDRESS); 07413000 + COMMENT MONITOR CODE GOES HERE; 07414000 + IF HOLE < 0 07415000 + THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR07416000 + ; 07417000 + EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000 + EMITV(JUNK); EMITL(PASSTYPE(HOLE)); 07419000 + EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000 + EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000 + (GIT(HOLE)).FUNCMONFILE); EMITL(1); 07422000 + EMITV(GNAT(PRINTI)); 07423000 + END; 07424000 + EXIT: END PROCSTMT; 07425000 + COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000 + PROCEDURE STRMPROCSTMT; 07427000 + BEGIN 07428000 + INTEGER ADDRS; 07429000 + IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000 + THEN BEGIN 07431000 + UNKNOWNSTMT; 07432000 + END 07433000 + 07434000 + 07435000 + 07436000 + 07437000 + 07438000 + 07439000 + ELSE BEGIN 07440000 + IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000 + GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000 + GT4 ~ GT1-GT2.[7:6]; 07443000 + FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000 + DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000 + COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000 + JUMPS INSIDE OF STREAM PROCEDURES; 07447000 + GT4 ~ GT2.[1:6]; 07448000 + FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000 + COMMENT THIS CODE CALLS ZERO LITS TO MAKE SPACE FOR LOCALS INSIDE 07450000 + OF STREAM PROCEDURES; 07451000 + IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000 + ELSE BEGIN 07453000 + ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000 + END END STRMPROCSTMT; 07455000 + COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000 + ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000 + INTEGER PROCEDURE BAE; 07458000 + BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000 +COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000 + RELEASE() % AUXMEM RELEASE STATEMENT. 07460250 + RELEASE() % DATACOM RELEASE STATEMENT. 07460500 + RELEASE() % FILE RELEASE STATEMENT. 07460750 + ; 07461000 +PROCEDURE RELSESTMT; 07461250 + BEGIN 07461500 + LABEL DCR,PARENCHECK,EXIT; 07461750 + IF STEPI!LEFTPAREN THEN 07462000 + BEGIN ERR(105); GO EXIT END; 07462250 + IF STEPI=UNKNOWNID THEN 07462500 + BEGIN ERR(100); GO EXIT END; 07462750 + IF ELCLASS=PROCID OR RANGE(BOOPROCID,INTPROCID) THEN 07463000 + BEGIN 07463250 + EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITPAIR(38,COM); 07463500 + EMITO(DEL); STEPIT; GO PARENCHECK; 07463750 + END; 07464000 + IF RANGE(BOOARRAYID,INTARRAYID) THEN 07464250 + BEGIN 07464500 + VARIABLE(FL); 07464750 + IF TABLE(I-2)=FACTOP THEN % A[*] = AUXMEM RELEASE. 07465000 + BEGIN 07465250 + EMITPAIR(38,COM); EMITO(DEL); GO PARENCHECK; 07465500 + END 07465750 + ELSE BEGIN % DATACOM RELEASE. 07466000 +DCR: 07466250 + EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500 + EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750 + EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000 + END; 07467250 + END; 07467500 + IF ELCLASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750 + BEGIN AEXP; GO DCR END; 07468000 + CHECKER(ELBAT[I]); PASSFILE; 07468250 + IF ELCLASS = COMMA THEN EMITO(DUP); 07468500 +COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750 + CHECKPRESENCE; 07469000 +COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250 + NOT COMPLETED; 07469500 + EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750 + IF ELCLASS = COMMA THEN 07470000 + BEGIN 07470250 + EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500 + EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750 + END; 07471000 + EMITO(PRL); EMITO(DEL); 07471250 +PARENCHECK: 07471500 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750 +EXIT: 07472000 + END RELSESTMT; 07472250 + COMMENT DOSTMT HANDLES THE DO STATEMENT; 07481000 + PROCEDURE DOSTMT; 07482000 + BEGIN INTEGER TL; 07483000 + DIALA ~ DIALB ~ 0; 07484000 + STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000 + ELSE BEGIN 07486000 + STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000 + END DOSTMT; 07488000 + COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000 + PROCEDURE WHILESTMT; 07490000 + BEGIN INTEGER BACK,FRONT; 07491000 + DIALA ~ DIALB ~ 0; 07492000 + STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL; 07493000 + IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000 + BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000 + CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000 + COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000 + EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000 + OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000 + STORAGE RETURNED. SEE DEXP AND GENGO; 07500000 + PROCEDURE GOSTMT; 07501000 + BEGIN 07502000 + REAL ELBW; 07503000 + LABEL GOMCP,EXIT; 07504000 + IF STEPI = TOV THEN STEPIT; 07505000 + IF ELCLASS = LABELID THEN TB1 ~ TRUE 07506000 + ELSE IF ELCLASS = SWITCHID THEN TB1 ~ FALSE ELSE GO GOMCP;07507000 + IF NOT LOCAL(ELBAT[I]) THEN GO GOMCP; 07508000 + IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000 + CONSTANTCLEAN; GO EXIT END; 07510000 + ELBW ~ ELBAT[I]; 07511000 + IF ELBW < 0 07512000 + THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000 + EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000 + CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)). 07515000 + SWITMONFILE); EMITL(0); EMITV(GNAT( 07516000 + PRINTI)); 07517000 + END; 07518000 + BANA; EMITPAIR(JUNK,ISD); 07519000 + IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000 + AND ELBW.ADDRESS = 0 THEN BEGIN 07521000 + PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000 + EMITB(BBW,L,GT4~GT1.[36:12]); 07523000 + EMITB(BFW,GT4+13,L+3); 07524000 + EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000 + ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000 + GO EXIT; 07527000 + GOMCP: GOTOG ~ FALSE; DEXP; 07528000 + IF GOTOG THEN 07529000 + BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100 + ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200 + EXIT:END GOSTMT; 07530000 + COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 07531000 + PARAMETER. GOGEN ASSUMES THAT THE LABEL IS LOCAL. THE 07532000 + PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000 + OR NOT; 07534000 + PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000 + VALUE LABELBAT,BRANCHTYPE; 07536000 + REAL LABELBAT,BRANCHTYPE; 07537000 + BEGIN 07538000 + IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1] 07539000 + THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000 + COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000 + NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000 + THAT WE NOW KNOW WHERE TO GO; 07543000 + ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000 + PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000 + COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000 + A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000 + BOOLEAN PROCEDURE SIMPGO; 07548000 + BEGIN LABEL EXIT; 07549000 + IF ELCLASS = GOV 07550000 + THEN BEGIN 07551000 + IF STEPI = TOV THEN STEPIT; 07552000 + IF ELCLASS = LABELID THEN 07553000 + IF LOCAL(ELBAT[I]) THEN 07554000 + BEGIN SIMPGO ~ TRUE; GO EXIT END; 07555000 + I ~ I-1; ELCLASS ~ GOV END; 07556000 + EXIT: END SIMPGO; 07557000 + COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000 + OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000 + EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000 + PROCEDURE IFSTMT; 07561000 + BEGIN REAL T1,T2; LABEL EXIT; 07562000 + IFCLAUSE; 07563000 + IF SIMPGO 07564000 + THEN BEGIN 07565000 + T1 ~ ELBAT[I]; 07566000 + IF STEPI = ELSEV 07567000 + THEN BEGIN 07568000 + STEPIT; 07569000 + IF SIMPGO 07570000 + THEN BEGIN 07571000 + GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000 + STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000 + STMT ; GO TO EXIT END END ; 07574000 + EMITLNG; GOGEN(T1,BFC); 07575000 + GO EXIT END; 07576000 + T1 ~ BUMPL; STMT; 07577000 + IF ELCLASS ! ELSEV THEN 07578000 + BEGIN DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000 + STEPIT; 07580000 + IF SIMPGO 07581000 + THEN BEGIN 07582000 + T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000 + STEPIT; GO EXIT END; 07584000 + T2 ~ BUMPL; CONSTANTCLEAN; 07585000 + EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000 + EXIT: END IFSTMT; 07587000 + COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000 + ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000 + AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000 + UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 07591000 + IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 07592000 + PROCEDURE LABELR; 07593000 + BEGIN LABEL EXIT, ROUND; 07594000 +DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000 + =GT4#,NEXTLINK=GT5#; 07596000 + DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000 + BEGIN ERR(133); GO TO EXIT END; 07598000 + IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000 + THEN BEGIN FLAG(134); GO TO ROUND END; 07600000 + LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD))) 07601000 + .[36:12]; 07602000 + IF ADDITIONAL < 0 THEN 07603000 + BEGIN FLAG(135); GO TO ROUND END; 07604000 + WHILE LINK ! 0 07605000 + DO BEGIN 07606000 + NEXTLINK ~ GET(LINK-2); 07607000 + EMITB(GET(LINK-1),LINK,L); 07608000 + LINK ~ NEXTLINK; 07609000 + IF LASTENTRY } 126 THEN % DONT LET EMITNUM DO IT 07609100 + BEGIN REAL C; % HOLD L FOR A WHILE 07609200 + COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300 + (>1023 WORD) FORWARD REFERENCES TO A LABEL;07609400 + C ~ BUMPL; 07609500 + CONSTANTCLEAN; 07609600 + EMITB(BFW,C,L) END;END; 07609700 + PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000 + IF ELBATWORD < 0 07611000 + THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000 + OR MONITOR DECLARATION; 07613000 + IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000 + THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000 + LABELS; 07616000 + EMITO(MKS); PASSALPHA(ELBATWORD); 07617000 + EMITPAIR(GNAT(CHARI),LOD); 07618000 + PASSMONFILE(RR1); EMITL(0); 07619000 + EMITV(GNAT(PRINTI)); 07620000 + END; 07621000 + IF RR1~ADDITIONAL.DUMPEE ! 0 07622000 + THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000 + LABEL COUNTER; 07624000 + EMITV(RR1); EMITL(1); EMITO(ADD); 07625000 + EMITPAIR (RR1,STD); 07626000 + IF RR1~ADDITIONAL.DUMPOR ! 0 07627000 + THEN BEGIN COMMENT EMIT CODE TO CALL 07628000 + THE DUMP ROUTINE; 07629000 + 07630000 + 07631000 + 07632000 + STUFFF(RR1); EMITO07633000 + (XCH);EMITO(COC); 07634000 + 07635000 + 07636000 + 07637000 + 07638000 + 07639000 + 07640000 + EMITO(DEL); 07641000 + END; 07642000 + END; 07643000 + END; 07644000 + ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000 + EXIT: END LABELR; 07646000 +PROCEDURE CASESTMT; 07646100 +BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110 + CASE OF BEGIN 07646120 + AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130 + IN THE , DEPENDING ON THE VALUE OF THE . 07646140 + ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150 + THE . IF THERE ARE N STATEMENTS IN THE 07646160 + , THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1, 07646170 + AND THE MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 07646180 + WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 07646190 + THE STATEMENTS IN THE MAY BE ANY EXECUTABLE 07646200 + STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210 + AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220 + 07646230 + OPDC ARRAY 07646240 + BFW 07646250 + STMT 0 07646260 + BRANCH TO RESUME 07646270 + STMT 1 07646280 + BRANCH TO RESUME 07646290 + . 07646300 + . 07646310 + . 07646320 + STMT N-1 07646330 + RESUME: 07646340 + "ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 07646350 + CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 07646360 + BY THE VALUE OF AND CONTAINS SYLLABLE COUNTS 07646370 + FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 07646375 + IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 07646380 + TRANSFERS TO RESUME DIRECTLY; 07646385 + REAL LINK, TEMP, N, ADR, PRT, NULL; 07646390 + REAL ARRAY TEDOC[0:7, 0:127]; 07646400 + LABEL LOOP, XIT; 07646410 + LINK ~ N ~ NULL ~ 0; 07646420 + STEPIT; AEXP; 07646430 + IF STEPI ! BEGINV THEN BEGIN ERR( 70); GO TO XIT END; 07646440 + EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450 + EMITO(BFW); ADR ~ L; 07646460 +LOOP: 07646470 + ERRORTOG ~ TRUE; 07646475 + IF STEPI = SEMICOLON THEN 07646480 + BEGIN COMMENT NULL STATEMENT; 07646485 + TEDOC[N.[38:3], N.[41:7]] ~ NULL; 07646490 + NULL ~ N ~ N+1; GO TO LOOP; 07646495 + END; 07646500 + TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510 + IF SIMPGO THEN 07646515 + BEGIN COMMENT SIMPLE GO TO. DO NOT EMIT BRANCH TO RESUME; 07646520 + ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646525 + STMT; IF ELCLASS = SEMICOLON THEN GO TO LOOP 07646530 + END ELSE 07646535 + BEGIN STMT; IF ELCLASS = SEMICOLON THEN 07646540 + BEGIN EMIT (LINK); LINK ~ L ~ L+1; GO TO LOOP END 07646545 + END; 07646550 + IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555 + N := N-1 ; 07646556 + WHILE NULL ! 0 DO 07646560 + BEGIN TEMP ~ TEDOC[(NULL~NULL-1).[38:3], NULL.[41:7]]; 07646565 + TEDOC[NULL.[38:3], NULL.[41:7]] ~ L-ADR; 07646570 + NULL ~ TEMP; 07646575 + END; 07646580 + ENDTOG ~ TRUE; 07646585 + COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590 + DO STOPDEFINE ~ TRUE UNTIL STEPI { ENDV AND ELCLASS } UNTILV 07646595 + OR NOT ENDTOG; 07646600 + ENDTOG ~ FALSE; 07646610 + COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620 + MOVECODE(TEDOC, EDOC); 07646630 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07646635 + TEMP ~ SGNO; SEGMENTSTART; 07646640 + SGNO ~ SGAVL; 07646650 + Z ~ PROGDESCBLDR(LDES, 0, PRT); 07646660 + SEGMENT(-N, SGNO, TEMP); 07646670 + SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680 + BUILDLINE ~ BUILDLINE.[46:1] ; 07646685 + MOVECODE(TEDOC, EDOC); 07646690 + COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700 + IF (L-ADR)>1019 THEN ADJUST;% 07646705 + WHILE LINK ! 0 DO 07646710 + BEGIN TEMP ~ GET(LINK-2); 07646720 + EMITB(BFW, LINK, L); 07646730 + LINK ~ TEMP; 07646740 + IF LASTENTRY } 126 THEN 07646750 + BEGIN REAL C; 07646760 + COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770 + C ~ BUMPL; 07646780 + CONSTANTCLEAN; 07646790 + EMITB(BFW, C, L); 07646800 + END; 07646810 + END; 07646820 +XIT: 07646830 +END CASESTMT; 07646840 + PROCEDURE FILLSTMT;BEGIN 07647000 + COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07648000 + IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07649000 + THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07650000 + THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07651000 + NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07652000 + RESIDES ON THE DRUM AND IS READ INTO THE ROW DESIGNATED 07653000 + BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07654000 + EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07655000 + ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07656000 + NUMBERS LOOK LIKE IDENTIFIERS TO FILLSTMT AND ARE CONVERTED 07657000 + BY COCT.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN PDPRT 07658000 + TO SUPPLY INFO TO BUILD A DRUM DESCRIPTOR IN THE SEGMENT 07659000 + DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07660000 + REAL STREAM PROCEDURE COCT(N,SKBIT,ACC,CD);VALUE N,SKBIT; 07661000 + COMMENT COCT PERFORMS THE OCTAL CONVERT FOR THE FILL STATEMENT 07662000 + N---NUMBER OF CHARACTERS TO BE CONVERTED 07663000 + SKBIT---NUMBER OF BITS TO SKIP BEFORE STARTING THE CONVERSION07664000 + THIS IS BECAUSE THE NUMBER OF CHARACTERS MAY BE LESS 07665000 + THAN 8 AND IT MUST BE RIGHT JUSTIFIED IN CD(CODEFILE)07666000 + ACC ---ADDRESS OF THE ACCUM WHERE ALPHA INFO IS KEPT; 07667000 + BEGIN SI~ACC; SI~SI+6; DI~CD; DS~8 LIT"00000000"; 07668000 + DI~CD ; SKIP SKBIT DB;TALLY~1; 07669000 + N(IF SC>"7" THEN TALLY ~ 0 ELSE 07670000 + IF SC<"0" THEN TALLY ~ 0; SKIP 3 SB; 07670100 + 3(IF SB THEN DS~1 SET ELSE SKIP 1 DB; SKIP 1 SB)); 07671000 + COCT~TALLY END; 07672000 + COMMENT COCT IF THERE ARE ANY NON OCTAL NUMBERS THE RESULT OF THIS 07673000 + PROCEDURE IS 0 AND THE 3 LOW ORDER BITS OF THE BAD CHARACTER 07674000 + IS CONVERTED AFTER A MESSAGE IS PRINTED THE ERROR IS IGNORED;07675000 + REAL T1,T3; 07676000 + ARRAY TEDOC[0:7,0:127]; DEFINE T2=T3.[38:3],T3.[41:7]#; 07676500 + LABEL L,L1,EXIT; 07677000 + IF STEPIINTARRAYID THEN 07678000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07678100 + BEGIN MAKEALABEL; GO TO EXIT END ELSE 07678200 + BEGIN ERR(300); GO TO EXIT END; 07679000 + VARIABLE(FL );COMMENT FL TELLS THE VARIABLE ROUTINE 07680000 + IT IS COMING FROM THE FILL STATEMENT SO 07681000 + IT MAY EXPECT A ROW DESIGNATOR.VARIABLE 07682000 + THEN EMITS THE CODE; 07683000 + IF TABLE(I - 2) ! FACTOP THEN FLAG(304); 07683100 + IF ELCLASS!WITHV THEN BEGIN ERR(301); GO EXIT END; 07684000 + STREAMTOG ~ BOOLEAN(2); 07684005 + IF TABLE(I+1) { IDMAX THEN 07684010 + IF Q = "7INQUI" THEN 07684020 + BEGIN EMITL(9); EMITO(COM); EMITO(DEL); 07684030 + STREAMTOG ~ FALSE; 07684035 + I ~ I+1; STEPIT;GO TO EXIT END; 07684040 + EMITNUM(SGAVL); T1 ~ 2|SGAVL-1; EMITL(7);T1~T1&1[5:47:1]; 07685000 + EMITO(COM); EMITO(DEL); EMITO(DEL); SEGMENTSTART; 07686000 + MOVECODE(TEDOC,EDOC); 07686500 + 07687000 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07687500 + L:FOR T3~0 STEP 1 UNTIL 1022 DO 07688000 + BEGIN IF STEPI>IDMAX THEN 07689000 + BEGIN IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN 07690000 + IF ELCLASS!STRNGCON THEN 07691000 + IF ELCLASS=ADOP AND(STEPI=NONLITNO OR ELCLASS=LITNO)07692000 + THEN C~C&ELBAT[I-1][1:21:1] 07693000 + ELSE BEGIN ERROR(302);GO TO L1 END; 07694000 + IF ELCLASS=STRNGCON AND COUNT=8 THEN 07695000 + MOVECHARACTERS(8,ACCUM[1],3,EDOC[T2],0) 07696000 + ELSE MOVE(1,C,EDOC[T2]) 07697000 + END ELSE IF COUNT{19 AND ACCUM[1].[18:18]="OCT" THEN BEGIN 07698000 + IF COCT(COUNT-3,48-(COUNT-3)|3,ACCUM[1], 07699000 + EDOC[T2])=0 THEN FLAG(303) END 07700000 + ELSE BEGIN ERROR(302); GO TO L1 END ; 07701000 + IF STEPI!COMMA THEN GO TO L1 07702000 + END; 07703000 +L1: 07704000 + 07705000 + STREAMTOG~FALSE; 07706000 + SEGMENT(T3+1,SGAVL,SGNO); 07707000 + MOVECODE(TEDOC,EDOC); 07707500 + BUILDLINE ~ BUILDLINE.[46:1] ; 07707650 + SGAVL~SGAVL+1; 07708000 + EXIT: END; 07709000 + COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000 + CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000 + WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000 + AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000 + PROCEDURE STMT ; 07714000 + BEGIN 07715000 + LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000 + LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000 + LGO, LRELSE, LBEG, LBRK, EXIT; 07718000 + SWITCH S ~ 07719000 + LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000 + LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000 +LVAR, 07722000 + LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000 + LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000 + LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000 + EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000 + LRELSE,LBEG; 07727000 + COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010 + CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020 + GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030 + ADDRESSING IS NOT POSSIBLE; 07727040 + IF LASTENTRY !0 THEN 07727050 + BEGIN GT2 ~ INFO [0,255]; 07727055 + DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060 + IF L- GT1 > 400 THEN 07727065 + BEGIN GT1 ~ BUMPL; 07727070 + CONSTANTCLEAN; 07727075 + EMITB(BFW, GT1,L); 07727080 + END; 07727085 + END; 07727090 + STACKCT ~ 0; %A 07727100 + AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000 + IF ELCLASS = 0 THEN 07728500 + BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000 + IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07729190 + BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200 + FLAG(145); 07729500 + LERR: ERR(144); GO TO EXIT; 07730000 + LDEC: FLAG(146); 07731000 + IF TABLE(I-2) = ENDV AND MODE > 0 07732000 + THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000 + I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000 + ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000 + 07735500 + 07735510 + 07735520 + LPROC: PROCSTMT(TRUE); GO TO EXIT; 07736000 + LSPROC: STRMPROCSTMT; GO TO EXIT; 07737000 + LVAR: VARIABLE(FS); GO TO EXIT; 07738000 + LAB: LABELR; GO TO AGAIN; 07739000 + LREAD: READSTMT; GO TO EXIT; 07740000 + LWRITE: WRITESTMT; GO TO EXIT; 07741000 + LSPACE: SPACESTMT; GO TO EXIT; 07742000 + LCLOSE: CLOSESTMT; GO TO EXIT; 07743000 + LLOCK: LOCKSTMT; GO TO EXIT; 07744000 + LRWND: RWNDSTMT; GO TO EXIT; 07745000 + LDBL: DBLSTMT; GO TO EXIT; 07746000 + LFOR: FORSTMT; GO TO EXIT; 07747000 + LWHILE: WHILESTMT; GO TO EXIT; 07748000 + LDO: DOSTMT; GO TO EXIT; 07749000 + LFILL: FILLSTMT; GO TO EXIT; 07750000 + LIF: IFSTMT; GO TO EXIT; 07751000 + LGO: GOSTMT; GO TO EXIT; 07752000 + LRELSE: RELSESTMT; GO TO EXIT; 07753000 + LBEG: IF STEPI = DECLARATORS 07754000 + THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000 + ELSE COMPOUNDTAIL; 07756000 + EXIT: END STMT; 07757000 +PROCEDURE CMPLXSTMT; FORWARD ; 07777777 + PROCEDURE UNKNOWNSTMT; 07800000 + BEGIN LABEL XXX,E; 07801000 + REAL J,N,C; 07802000 + IF Q = "5BREAK" THEN 07803000 + BEGIN EMIT(0); 07804000 + EMIT(48); 07805000 + EMITO(COM); 07806000 + EMITO(DEL); 07807000 + STEPIT; 07808000 + GO TO XXX; 07809000 + END; 07810000 + IF Q="7COMPL" THEN BEGIN CMPLXSTMT; GO XXX END ; 07810100 + IF Q = "3ZIP00" THEN 07811000 + BEGIN IF TABLE(I+1) = WITHV THEN 07812000 + BEGIN STEPIT; 07813000 + IF STEPI < BOOARRAYID OR ELCLASS > 07814000 + INTARRAYID THEN 07814100 + IF ELCLASS=FILEID OR 07814200 + ELCLASS=SUPERFILEID THEN 07814300 + PASSFILE ELSE 07814400 + GO E ELSE 07814500 + BEGIN 07814600 + VARIABLE(FL); 07815000 + IF TABLE(I-2) ! FACTOP THEN GO TO E; 07816000 + END; 07816100 + EMIT(16); EMITO(COM); EMITO(DEL); 07817000 + GO TO XXX; 07818000 + END; 07819000 + N ~ 1; C ~ 8 07820000 + END ELSE 07821000 + IF Q = "5CHAIN" THEN 07821100 + BEGIN N ~ 1; C ~ 37 END ELSE 07821200 + IF Q = "4WHEN0" THEN 07822000 + BEGIN N ~ 0; C ~ 6 END ELSE 07823000 + IF Q = "4WAIT0" THEN 07824000 + BEGIN N ~ 1; C ~ 2 END ELSE 07825000 + IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500 + IF Q="4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000 + IF Q="5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000 + IF Q="6SEARC" THEN 07828000 + BEGIN IF STEPI!LEFTPAREN THEN 07829000 + BEGIN ERR(105); GO TO XXX END; 07830000 + IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000 + PASSFILE ELSE GO TO E; 07832000 + IF ELCLASS!COMMA THEN GO TO E; 07833000 + IF STEPIINTARRAYID THEN 07834000 + GO TO E; 07835000 + VARIABLE(FL); 07836000 + IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000 + IF ELCLASS!RTPAREN THEN 07838000 + BEGIN ERR(104); GO TO XXX END; 07839000 + EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000 + STEPIT; GO TO XXX; 07841000 + END ELSE 07842000 + IF Q="4SEEK0" THEN 07843000 + BEGIN IF STEPI!LEFTPAREN THEN 07844000 + BEGIN ERR(105); GO TO XXX; END; 07845000 + IF STEPI!FILEID AND ELCLASS!SUPERFILEID THEN 07846000 + GO TO E ELSE 07847000 + BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000 + IF ELCLASS!LEFTPAREN THEN 07849000 + BEGIN ERR(105); GO TO XXX; END; 07850000 + STEPIT; AEXP; EMITO(XCH); 07851000 + IF ELCLASS!RTPAREN THEN 07852000 + BEGIN ERR(104); GO TO XXX; END; 07853000 + IF STEPI!RTPAREN THEN 07854000 + BEGIN ERR(104); GO TO XXX; END; 07855000 + EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000 + EMITO(DEL); EMITO(DEL); STEPIT; 07857000 + END; GO TO XXX; 07858000 + END ELSE 07859000 + IF Q="6UNLOC" THEN 07859010 + BEGIN IF STEPI!LEFTPAREN THEN 07859020 + BEGIN ERR(105); GO TO XXX END; 07859030 + STEPIT; VARIABLE(FL); L ~ L-1; 07859040 + IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050 + EMITO(DUP); EMITO(LOD); EMITL(0); 07859060 + EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080 + GO TO XXX 07859090 + END ELSE 07859100 + BEGIN ERROR(100); GO TO XXX END; 07900000 + IF STEPI ! LEFTPAREN THEN 07901000 + BEGIN ERR(105); GO TO XXX END; 07902000 + STEPIT; AEXP; 07903000 + FOR J ~ 1 STEP 1 UNTIL N DO 07904000 + BEGIN IF ELCLASS ! COMMA THEN 07905000 + E: BEGIN ERR(164); GO TO XXX END; 07906000 + STEPIT; AEXP; 07907000 + END; 07908000 + IF ELCLASS ! RTPAREN THEN 07909000 + BEGIN ERR(104);GO TO XXX END; 07910000 + EMITL(C); EMITO(COM); 07911000 + FOR J ~ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000 + STEPIT; 07913000 + XXX: END; 07914000 + PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"~" 07920000 + KIND OF STATEMENT, FOR THE RUN-TIME ERROR MESS; 07921000 + BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000 + CHECKER(ELBW~ELBAT[I]); STR~IF FAULTOG THEN SND ELSE STD; 07923000 + FAULTOG~TRUE; COMMENT TELLS DEXP TO MESS WITH FAULTLEVEL; 07923100 + IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000 + IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000 + IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100 + EMITPAIR(ADRES,STR); 07926000 + FAULTOG~FALSE&(ELBW.LVLINTARRAYID THEN 07939000 + BEGIN ERR(429); GO TO EXIT; END; 07940000 + VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN 07941000 + BEGIN ERR(427); GO TO EXIT; END; 07942000 + IF ELCLASS!RTPAREN THEN BEGIN ERR(428); GO TO EXIT; END; 07943000 + EMITO(XCH); 07944000 + IF T<0 THEN COMMENT FROM WRITE...(<0 IS FROM READ); 07945000 + BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITV(JUNK); END; 07946000 + IF T>0 THEN IF TABLE(I+1)=LFTBRKET THEN 07947000 + BEGIN GOGOGO ~ FALSE;% JUST TO MAKE SURE... 07948000 + HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000 + L ~ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000 + EMITO(DEL); EMITO(DEL);% REMOVE LABEL WORDS... 07951000 + END ELSE STEPIT ELSE STEPIT;% WALTZ ON BY... 07952000 + EMITV(GNAT(SUPERMOVER));% BET YOU THOUGHT I"D NEVER DO IT 07953000 + EXIT: END THIS HAIRY KLUDGE;% 07954000 + COMMENT FORSTMT IS REPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 08000000 + IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 08001000 + THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 08002000 + ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 08003000 + CONSTANT, THEN THE CODE TAKES ON A MORE EFFICIENT FORM. 08004000 + IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 08005000 + THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 08006000 + STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 08007000 + PROCEDURE FORSTMT; 08008000 + BEGIN 08009000 + OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET, 08010000 + BRET; 08011000 + OWN BOOLEAN SIGNA,SIGNB,SIGNC, INT, 08012000 + CONSTANA,CONSTANB,CONSTANC; 08013000 + DEFINE SIMPLEB = SIGNC#, FORMALV = SIGNA#, 08014000 + SIMPLEV = CONSTANA#, A = V#, Q = REGO#, 08015000 + OPDC = TRUE#, DESC = FALSE#, K = BRET#; 08016000 + LABEL EXIT; 08017000 + COMMENT FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 08017100 + IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 08017200 + INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 08017300 + RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 08017400 + BOOLEAN PROCEDURE FORCLASS(CLSS); VALUE CLSS; INTEGER CLSS; 08017500 + IF STEPI = CLSS THEN FORCLASS ~ TRUE ELSE 08017600 + IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON THEN 08017700 + BEGIN INFO[0,K~K+1] ~ C; 08017800 + ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11] 08017900 + END FORCLASS; 08017950 + COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 08018000 + CONSTANT DEPENDING ON THE REQUIREMENTS; 08019000 + PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 08020000 + IF C THEN EMITNUM (A) ELSE BEGIN 08021000 + CHECKER (A); 08021100 + EMITV(A.ADDRESS) END; 08021200 + COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A 08022000 + CONSTANT OR A SIMPLE VARIABLE. IT MAKES A THROUGH REPORT 08023000 + ON ITS ACTIVITY. IT ALSO MAKES PROVISION FOR THE RESCAN 08024000 + OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE 08025000 + TABLE ROUTINE FOR FURTHER DETAILS); 08026000 + BOOLEAN PROCEDURE SIMPLE(B,A,S); BOOLEAN B,S; REAL A; 08027000 + BEGIN 08028000 + S ~ IF STEPI ! ADOP THEN FALSE ELSE ELBAT[I].ADDRESS 08029000 + = SUB; 08030000 + IF ELCLASS = ADOP THEN STEPIT; 08031000 + IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON 08032000 + THEN BEGIN K ~ K+1; SIMPLE ~ TRUE; 08033000 + ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11]; 08034000 + INFO[0,K] ~ A ~ C; B ~ TRUE END 08035000 + ELSE BEGIN 08036000 + B ~ FALSE; A ~ ELBAT[I]; 08037000 + SIMPLE ~ REALID { ELCLASS AND ELCLASS { INTID END; 08038000 + END SIMPLE; 08039000 + COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000 + PROCEDURE TEST; 08041000 + BEGIN 08042000 + IF NOT CONSTANB THEN 08043000 + BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000 + ELSE BEGIN 08045000 + EMITL(2+L-BRET); 08046000 + EMITB(BBW,BUMPL,B); 08047000 + END; 08048000 + EMITO(MUL); EMIT(0) END; 08049000 + EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000 + END TEST; 08051000 + BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000 + BEGIN 08053000 + CHECKER(VRET~ALL); 08054000 + ADDRES ~ ALL.ADDRESS; 08055000 + FORMALV ~ ALL.[9:2] = 2; 08056000 + IF T ~ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000 + GT1 ~ (T-BOOID) MOD 4 < 1 THEN 08058000 + ERR(REAL(T ! 0) | 51 + 100); 08059000 + INT ~ GT1 = 3; 08060000 + SIMPI ~ T { INTID END SIMPI; 08061000 + COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000 + PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000 + BEGIN 08064000 + IF FORMALV THEN BEGIN EMITO(XCH); S ~ FALSE END 08065000 + ELSE BEGIN 08066000 + EMITL(ADDRES); 08067000 + IF ADDRES > 1023 THEN EMITO(PRTE) END; 08068000 + T ~ (REAL(S)+1)|16; 08069000 + EMITO((IF INT THEN T+512 ELSE 4|T)+4) END STORE; 08070000 + COMMENT CALL EFFECTS A CALL ON THE INDEX; 08071000 + PROCEDURE CALL(S); VALUE S; BOOLEAN S; 08072000 + BEGIN 08073000 + IF SIMPLEV 08074000 + THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES) 08075000 + ELSE BEGIN 08076000 + EMITL(2+L-VRET); 08077000 + EMITB(BBW,BUMPL,V); 08078000 + IF S THEN EMITO(LOD) END END CALL; 08079000 + PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 08080000 + BEGIN 08081000 + PROCEDURE FIX(STORE,BACK,FORWART,START); 08082000 + VALUE STORE,BACK,FORWART,START; 08083000 + REAL STORE,BACK,FORWART,START; 08084000 + BEGIN 08085000 + EMITB(GET(FORWART-1),FORWART,START); 08086000 + IF RETURNSTORE ! 0 08087000 + THEN BEGIN 08088000 + L ~ STORE; EMITNUM(B-BACK); 08089000 + EMITPAIR(RETURNSTORE,STD) END END FIX; 08090000 + INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX; 08091000 + LABEL BRNCH,EXIT; 08092000 + STOREFIX ~ L; Q ~ REAL(MODE=0)+3; 08093000 + FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000 + IF NUMLE 08095000 + THEN BEGIN 08096000 + BACKFIX ~ L; 08097000 + IF FORMALV THEN CALL(DESC) END 08098000 + ELSE BACKFIX ~ V + REAL(SIMPLEV)-1; 08099000 + DIALA ~ DIALB ~ 0; 08100000 + AEXP; DIALA ~ DIALB ~ 0; 08101000 + COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 08102000 + IF ELCLASS = STEPV 08103000 + THEN BEGIN 08104000 + COMMENT HERE WE HAVE A STEP ELEMENT; 08105000 + BACKFIX ~ BUMPL; 08106000 + COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000 + IF FORMALV THEN CALL(DESC); CALL(OPDC); 08108000 + COMMENT FETCH INDEX; 08109000 + IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END 08110000 + ELSE REGO ~ I; 08111000 + IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND 08112000 + (STEPI = UNTILV OR ELCLASS = WHILEV) 08113000 + THEN BEGIN 08114000 + COMMENT WE HAVE A SIMPLE STEP FUNCTION; 08115000 + PLUG(CONSTANB ,B); 08116000 + END ELSE BEGIN 08117000 + COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 08118000 + SUBROUTINE; 08119000 + I ~ IF I < 4 THEN 0 ELSE REGO; STEPIT; 08120000 + SIGNB ~ CONSTANB ~ FALSE; 08121000 + EMIT(0); B ~ L; 08122000 + AEXP; EMITO(XCH); 08123000 + BRET ~ L; 08124000 + EMITO(BFW) END; 08125000 + EMITO(REAL(SIGNB)|32+ADD); 08126000 + EMITB(BFW,BACKFIX,L); 08127000 + IF ELCLASS = UNTILV 08128000 + THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000 + STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000 + STEPIT; AEXP; TEST END 08131000 + ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000 + IF ELCLASS ! WHILEV THEN 08133000 + BEGIN ERR(153); GO TO EXIT END; 08134000 + STEPIT; STORE(FALSE); BEXP END END 08135000 + ELSE BEGIN 08136000 + COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000 + STORE(FALSE); 08138000 + IF ELCLASS = WHILEV 08139000 + THEN BEGIN 08140000 + COMMENT WE HAVE A WHILE ELEMENT; 08141000 + STEPIT; BEXP END 08142000 + ELSE BEGIN 08143000 + COMMENT ONE EXPRESSION ELEMENT; 08144000 + IF ELCLASS ! COMMA THEN BEGIN 08145000 + EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END 08146000 + ELSE BACKFIX ~ L + 2; 08147000 + L ~ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000 + COMMENT THIS IS THE COMMON POINT; 08149000 + IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000 + EMIT(BFC); 08151000 + BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000 + IF ELCLASS = COMMA 08153000 + THEN BEGIN 08154000 + STEPIT; 08155000 + FORLIST(TRUE); 08156000 + FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000 + ELSE BEGIN 08158000 + IF ELCLASS ! DOV 08159000 + THEN BEGIN ERR(154); REGO~L; GO EXIT END; 08160000 + STEPIT; 08161000 + IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000 + IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000 + 08164000 + IF NUMLE THEN BEGIN 08165000 + EMITV(RETURNSTORE ~ FOOT); EMITO(BBW) END 08166000 + ELSE BEGIN 08167000 + EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000 + STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000 + CONSTANTCLEAN; REGO ~ L; 08170000 + FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000 + EXIT: END FORLIST; 08172000 + REAL T1,T2,T3,T4; 08173000 + NXTELBT ~ 1; I ~ 0; 08174000 + STEPIT; 08175000 + IF SIMPI(VRET~ELBAT[I]) 08176000 + THEN BEGIN 08177000 + IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000 + T1 ~ L; IF FORMALV THEN EMITN(ADDRES); 08179000 + K ~ 0; 08180000 + IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000 + IF FORCLASS(STEPV) THEN 08182000 + IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000 + IF FORCLASS(UNTILV) THEN 08184000 + IF SIMPLE(CONSTANC,Q,SIGNC) THEN 08185000 + IF FORCLASS(DOV) THEN 08186000 + BEGIN 08187000 + PLUG(CONSTANA,A); 08188000 + IF SIGNA THEN EMITO(CHS); 08189000 + RETURNSTORE ~ BUMPL; ADJUST; CONSTANTCLEAN; 08190000 + STMTSTART ~ L; 08191000 + STEPIT; 08192000 + T1 ~ ((((4096 | RETURNSTORE+STMTSTART)|2+ 08193000 + REAL(CONSTANB))|2+ 08194000 + REAL(CONSTANC))|2+ 08195000 + REAL(SIGNB))|2+ 08196000 + REAL(SIGNC); 08197000 + T2 ~ VRET; 08198000 + T3 ~ B; 08199000 + T4 ~ Q; 08200000 + IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000 + SIGNC ~ BOOLEAN(T1.[47:1]); 08202000 + SIGNB ~ BOOLEAN(T1.[46:1]); 08203000 + CONSTANC ~ BOOLEAN(T1.[45:1]); 08204000 + CONSTANB ~ BOOLEAN(T1.[44:1]); 08205000 + STMTSTART ~ T1.[32:12]; 08206000 + RETURNSTORE ~ T1.[20:12]; 08207000 + VRET ~ T2; 08208000 + B ~ T3; 08209000 + Q ~ T4; 08210000 + SIMPLEV~ SIMPI(VRET); 08211000 + IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000 + PLUG(CONSTANB,B); 08213000 + EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000 + EMITB(BFW,RETURNSTORE,L); 08215000 + STORE(TRUE); 08216000 + IF FORMALV THEN CALL(OPDC); 08217000 + PLUG(CONSTANC,Q); 08218000 + IF SIGNC THEN EMITO(CHS); 08219000 + SIMPLEB ~ TRUE; TEST; EMITLNG; 08220000 + EMITB(BBC,BUMPL,STMTSTART); 08221000 + GO TO EXIT END; 08222000 + I ~ 2; K ~ 0; 08223000 + SIMPLEV ~ SIMPI(VRET); 08224000 + V ~ T1 END 08225000 + ELSE BEGIN 08226000 + EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000 + VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000 + IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000 + END; 08230000 + STEPIT; FORLIST(FALSE); L ~ REGO; 08231000 + EXIT: K ~ 0 END FORSTMT; 08232000 +PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000 + BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000 + SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000 + LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000 + COLON HAS JUST BEEN DETECTED; 08237000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08238000 + EXECUTABLE STATEMENT IN THIS ROUTINE; 08239000 + IF STEPI = LFTBRKET 08240000 + THEN BEGIN COMMENT THIS CODE HANDLES PARITY AND END OF 08241000 + FILE LABELS; 08242000 + IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08243000 + IF ELCLASS ! COLON THEN EMIT(0) ELSE 08244000 + BEGIN STEPIT; DEXP END; 08245000 + 08246000 + 08247000 + 08248000 + 08249000 + 08250000 + 08251000 + 08252000 + 08253000 + 08254000 + 08255000 + 08256000 + 08257000 + 08258000 + 08259000 + 08260000 + 08261000 + 08262000 + 08263000 + 08264000 + 08265000 + 08266000 + 08267000 + 08268000 + 08269000 + 08270000 + 08271000 + 08272000 + 08273000 + 08274000 + 08275000 + 08276000 + IF CHECK(RTBRKET,433) 08277000 + THEN GO TO EXIT; 08278000 + COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 08279000 + IN READ OR SPACE STATEMENT; 08280000 + STEPIT; 08281000 + END 08282000 + ELSE BEGIN COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS08283000 + CASE; 08284000 + EMITL(0); EMITL(0); 08285000 + END; 08286000 + IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000 + EMITV(13) 08287100 + END ELSE EMITV(GNAT(INTERPTI)); 08287200 + GOGOGO ~ FALSE;% 08287300 + EXIT:; 08288000 + END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000 + DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010 + EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020 + EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030 +PROCEDURE READSTMT; 08290000 + BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI(WHICH IS08291000 + SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000 + DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000 + THE READ OR SPACE STATEMENT. 08294000 + THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000 + STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000 + REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000 + EXPRESSION IN THE SPACE STATEMENT. 08298000 + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000 + READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000 + ARE PASSED TO INTERPTI. 08301000 + **********************************************************08302000 + ::=REVERSE/ 08303000 + ::=/ 08304000 + ::=[NO]/ 08305000 + ::=[:]/ 08306000 + []/[:]/08307000 + 08308000 + CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000 + POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000 + CONVERSION. 08311000 + FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000 + ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000 + 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000 + REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000 + VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000 + PROCESSED. 08317000 + END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL08318000 + DESCRIPTOR FOR END OF FILE JUMPS. 08319000 + PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000 + DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000 + + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT08322000 + DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE08323000 + GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS08324000 + IN ACTION TYPE. 08325000 + LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000 + DESCRIPTRO WHICH WILL EITHER RETURN08327000 + AN ADDRESS OR VALUE DEPENDING ON 08328000 + THE CALL. 08329000 + N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000 + READ() 08331000 + 08332000 + - - - - - - - - - - - - - - 08333000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000 + ,PARITY LABEL) 08335000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000 + READ(, 08337000 + ) 08338000 + - - - - - - - - - - - - - - 08339000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000 + ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000 + SPACE(,) 08343000 + - - - - - - - - - - - - - - 08344000 + (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000 + PARITY LABEL) 08346000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000 + READ(, 08348000 + ,) 08349000 + - - - - - - - - - - - - - - 08350000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000 + ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000 + LABEL,PARITY LABEL) 08353000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000 + READ(, 08355000 + *,) 08356000 + - - - - - - - - - - - - - - 08357000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000 + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000 + READ(, 08361000 + ,) 08363000 + - - - - - - - - - - - - - - 08364000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000 + END OF FILE LABEL,PARITY LABEL) 08366000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000 + READ(, 08368000 + ,) 08369000 + - - - - - - - - - - - - - - 08370000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000 + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000 + *********************************************************;08373000 + DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE08374000 + IF THE STATEMENT BEING COMPILED08375000 + IS A READ REVERSE, OTHERWISE IT08376000 + IS SET FALSE; 08377000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08378000 + EXECUTABLE STATEMENT IN READSTMT; 08379000 + LABEL CHKACTIONLABELS; COMMENT THE CODE AT THIS LABEL 08380000 + ASSUMES I IS POINTING AT THE RIGHT 08381000 + PARENTHESIS; 08382000 + LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I TO08383000 + BE POINTING AT THE LAST QUANTITY IN THE 08384000 + SECOND PARAMETER; 08385000 + LABEL READXFORM; 08385100 + INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500 + BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600 + BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700 + INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800 + IF STEPI = LEFTPAREN 08386000 + THEN REVERSETOG~SEEKTOG~FALSE 08387000 + ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000 + REVERSETOG~ACCUM[1]="7REVER"; 08389000 + LOCKTOG~ELCLASS=LOCKV; 08390000 + SEEKTOG~ACCUM[1]="4SEEK0"; 08390500 + IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000 + ELSE BEGIN ERR(420); 08392000 + GO TO EXIT; 08393000 + END; 08394000 + IF CHECK(LEFTPAREN,421) 08395000 + THEN GO TO EXIT; 08396000 + COMMENT ERROR 421 MEANS MISSING LEFT 08397000 + PARENTHESIS IN READ REVERSE STATEMENT; 08398000 + END; 08399000 + EMITO(MKS); 08400000 + IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08401000 + BEGIN VARIABLE(FL); 08401020 + IF TABLE(I-2) ! FACTOP THEN 08401030 + BEGIN ERR(422); GO TO EXIT END; 08401040 + MAYI ~ TRUE; HOLD ~ L; 08401045 + EMIT(11); EMIT(4); EMITO(280); 08401050 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060 + EMITO(XCH); EMITL(0); EMITL(1); 08401070 + END ELSE 08401080 + BEGIN 08401090 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000 + IF NOT RANGE(FILEID,SUPERFILEID) 08403000 + THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000 + STATEMENT; 08405000 + ERR(422); GO TO EXIT; 08406000 + END; 08407000 + PASSFILE; 08408000 + IF ELCLASS = LFTBRKET 08409000 + THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000 + %%% [*],[*,*],[*,],[],[,*], 08410010 + %%% AND [,]. THE FIRST (LEFTMOST) 08410020 + %%% IS THE READSEEKDISTADDRESS, RESIDING08410030 + %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000 + %%% IS THE WAIT-TIME, RESIDING IN THE 08411010 + %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON08411020 + %%% THE EXP-SIGN BIT OF DSKADDR.X"S ARE EMPTIES08411030 + %%% IN THE ABOVE, NS = NO OR STOP. 08411040 + STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000 + IF RR1~IF ACCUM[1]="2NO000" THEN 1 ELSE 08412010 + IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020 + 0 ! 0 THEN %%% HAVE [NS 08412030 + IF STEPI=COMMA THEN %%% HAVE [NS, 08412040 + IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050 + BEGIN 08412060 + IF RR1=1 THEN EMITNO(1) 08412070 + ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080 + STEPIT ; 08412090 + END 08413000 + ELSE 08413010 + BEGIN %%% HAVE [NS,AEXP 08413020 + IF RR1=2 THEN EMITL(1) ; 08413030 + EMITTIME ; 08413040 + IF RR1=2 THEN 08413050 + BEGIN EMITO(LOR); EMITL(2) END 08413060 + ELSE EMITL(1) ; 08413080 + END 08413090 + ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100 + ELSE BEGIN EMITL(1); EMITL(2) END 08413110 + ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120 + IF STEPI=COMMA THEN %%% HAVE [*, 08413130 + IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000 + BEGIN EMITNO(2); STEPIT END 08414010 + ELSE BEGIN EMITTIME; EMITL(2) END%[*,A08414020 + ELSE EMITNO(2) %%% HAVE ONLY [* 08414030 + ELSE BEGIN %%% HAVE [AEXP 08415000 + AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010 + IF SEEKTOG THEN EMITO(CHS) ; 08415020 + EMITPAIR(JUNK,ISN) ; 08415030 + IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000 + IF STEPI=FACTOP THEN STEPIT %%%[AEXP,*08416010 + ELSE BEGIN EMITTIME; EMITO(LOR) END ; 08416020 + EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030 + END ; 08417000 + IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ;08417010 + END 08418000 + ELSE IF ELCLASS=LEFTPAREN THEN 08418100 + BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200 + IF STEPI!FACTOP THEN% 08418250 + BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300 + BEGIN EMITL(1); GRABTOG~TRUE; STEPIT END ELSE 08418350 + EMITPAIR(0,LNG); 08418400 + EMITD(33,33,15); 08418500 + EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600 + EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650 + IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700 + EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800 + END 08418900 + ELSE BEGIN EMITL(0); EMITL(2); END; 08419000 + IF REVERSETOG 08420000 + THEN EMITO(CHS); 08421000 + END; 08421500 + IF ELCLASS = RTPAREN 08422000 + THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000 + EMITL(0); EMITL(0); EMITL(0); 08424000 + GOGOGO ~ NOT MAYI;% 08424100 + GO CHKACTIONLABELS; 08425000 + END; 08426000 + IF CHECK(COMMA,424) 08427000 + THEN GO TO EXIT; 08428000 + COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000 + STATEMENT; 08430000 + IF STEPI = FACTOP 08431000 + THEN BEGIN COMMENT *,LIST CASE; 08432000 + EMITL(0); EMITL(0); GO PASSLIST; 08433000 + END; 08434000 + IF ELCLASS = MULOP 08435000 + THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000 + IF STEPI=MULOP THEN EMITL(2) ELSE 08437000 + BEGIN EMITL(1); I~I-1; END ; 08437050 + EMITL(0); GO TO PASSLIST ; 08437075 + END; 08438000 + IF RANGE(FRMTID,SUPERFRMTID) 08439000 + THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000 + PASSFORMAT; 08441000 +READXFORM: IF TABLE(I+1) = COMMA 08442000 + THEN GO PASSLIST; 08443000 + STEPIT; 08444000 + IF CHECK(RTPAREN,425) 08445000 + THEN GO TO EXIT; 08446000 + COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000 + DELIMITER IN READ STATEMENT; 08448000 + EMITL(0); GO CHKACTIONLABELS; 08449000 + END; 08450000 + IF Q:=ACCUM[1]="1<0000" THEN 08450010 + BEGIN EXPLICITFORMAT; GO TO READXFORM; END; 08450020 + IF MAYI THEN 08450100 + BEGIN KLUDGE(HOLD); 08450200 + GO TO EXIT; 08450300 + END ARRAY TO ARRAY CASE; 08450400 + EMITL(0); AEXP; 08451000 + IF CHECK(COMMA,426) 08452000 + THEN GO TO EXIT; 08453000 + COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000 + PARAMETER; 08455000 + STEPIT; 08456000 + IF RANGE(BOOARRAYID,INTARRAYID) 08457000 + THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000 + VARIABLE(FL); 08459000 + IF TABLE(I-2) ! FACTOP 08460000 + THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000 + ROW DESIGNATOR IN READ; 08462000 + ERROR(427); GO TO EXIT; 08463000 + END; 08464000 + IF CHECK(RTPAREN,428) 08465000 + THEN GO TO EXIT; 08466000 + COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000 + DELIMITER IN READ STATEMENT; 08468000 + GOGOGO ~ TRUE;% 08468100 + GO CHKACTIONLABELS; 08469000 + END 08470000 + ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000 + ERROR(429); GO TO EXIT; 08472000 + END; 08473000 + PASSLIST:STEPIT; 08474000 + IF CHECK(COMMA,430) 08475000 + THEN GO TO EXIT; 08476000 + COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000 + THE LIST IN A READ STATEMENT; 08478000 + IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000 + THEN BEGIN 08480000 + RR1~LISTGEN; 08481000 + I~I-1; 08482000 + GO TO CHKACTIONLABELS 08483000 + END; 08484000 + CHECKER(ELBAT[I]); 08484500 + IF ELCLASS = SUPERLISTID THEN 08485000 + BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000 + 08487000 + LISTADDRESS ~ELBAT[I].ADDRESS; 08488000 + BANA; 08489000 + EMITN(LISTADDRESS); 08489500 + EMITO(LOD); 08489510 + EMITO(LOD); I~I-1 END 08489520 + ELSE BEGIN COMMENT A COMMON LIST; 08489530 + 08489540 + EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550 + END; 08489560 + STEPIT; 08489570 + IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580 + COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590 + 08490000 +CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000 + EXIT:; 08492000 + END READSTMT; 08493000 +REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND08493010 +VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015 + BEGIN % RETURNS THE ASSOCIATED INDEX IF 08493020 + REAL I ; % IT IS A FILE ATTRIBUTE. 08493030 + LABEL EXIT ; 08493040 + STOPDEFINE~T ; % MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 08493050 + STEPIT ; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 08493060 + IF I~FILEATTRIBUTES[0]=0 THEN 08493070 + BEGIN 08493080 + FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090 + % BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091 + % ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092 + % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093 + 12 08493094 + ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095 + ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096 + ,"4SAVE0" 08493097 + ,"8OTHER" % "OTHERUSE". 08493098 + ,"404MFID0" 08493099 + ,"403FID00" 08493100 + ,"4REEL0" 08493101 + ,"4DATE0" 08493102 + ,"5CYCLE" 08493103 + ,"4TYPE0" 08493104 + ,"5AREAS" 08493105 + ,"8AREAS" % "AREASIZE". 08493106 + % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493110 + % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120 + ; % END OF FILL STATEMENT. 08493130 + I~FILEATTRIBUTES[0] ; 08493140 + END ; 08493150 + FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160 + BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170 + EXIT: 08493180 + END OF FILEATTRIBUTEINDX ; 08493190 +COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200 + A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210 + 1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220 + FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230 + AND XIT. 08493240 + 2. ACTUALPARAPART: 08493250 + PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260 + ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270 + THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280 + 3. PRIMARY: 08493290 + PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300 + IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310 + ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320 + THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330 + TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340 + IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350 + ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360 + ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370 + FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380 + (ATYPE OR BTYPE). 08493390 + 4. BOOPRIM: 08493400 + PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410 + 5. IODEC: 08493420 + PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430 + HAVE ALREADY BEEN EMITTED. THE ATTRIBUTEINDX IS 08493440 + DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450 +END OF COMMENT ; 08493460 +INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470 + BEGIN 08493480 + REAL ATTRIBUTEINDX ; 08493490 + BOOLEAN ASSOP ; 08493500 + LABEL DONESOME,DONEMORE,EXIT ; 08493510 + IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520 + BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530 + EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540 + GO TO DONEMORE ; 08493550 + END ; 08493560 + EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570 + IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580 + BEGIN 08493590 + DONESOME: 08493600 + IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610 + BEGIN 08493620 +STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625 + IF STEPI=LFTBRKET THEN 08493630 + BEGIN 08493640 + STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650 + END 08493660 + ELSE EMITL(0) ; 08493670 + EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675 + IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680 + BEGIN 08493700 +IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705 + DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710 + THEN FLAG(293) ; 08493720 + STEPIT ; 08493730 + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740 + THEN BEXP ELSE AEXP ; 08493750 + END 08493760 + ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770 + ELSE EMITL(0) ; 08493780 + EMITNUM(IF ATTRIBUTEINDX=1 THEN "6ACCESS" ELSE IF 08493790 + ATTRIBUTEINDX=4 THEN "6OTHRUS" ELSE IF ATTRIBUTEINDX=12 08493800 + THEN "6ARASIZ" ELSE 08493810 + 0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820 + & FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830 + EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840 + & REAL(ASSOP)[38:47:1]) ; 08493850 + EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860 + FILEATTRIBUTEHANDLER~ 08493870 + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880 + THEN BTYPE ELSE ATYPE ; 08493890 + END ; 08493900 + END ; 08493910 + EXIT: 08493920 + END OF FILEATTRIBUTEHANDLER ; 08493930 +PROCEDURE SPACESTMT; 08494000 + BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000 + SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000 + FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000 + PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000 + FOR THE READ STATEMENT; 08499000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000 + EXECUTABLE STATEMENT IN SPACESTMT; 08501000 + STEPIT; 08502000 + IF CHECK(LEFTPAREN,434) 08503000 + THEN GO TO EXIT; 08504000 + COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000 + SPACE STATEMENT; 08506000 + STEPIT; 08507000 + IF NOT RANGE(FILEID,SUPERFILEID) 08508000 + THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000 + IDENTIFIER IN SPACE STATEMENT; 08510000 + ERROR(435); GO TO EXIT; 08511000 + END; 08512000 + EMITO(MKS); 08513000 + EMITPAIR(GNAT( 08514000 + POWERSOFTEN),LOD); PASSFILE; 08515000 + EMITL(0); 08515100 + IF CHECK(COMMA,436) 08516000 + THEN GO TO EXIT; 08517000 + COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000 + STEPIT; AEXP; 08519000 + IF CHECK(RTPAREN,437) 08520000 + THEN GO TO EXIT; 08521000 + COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000 + SPACE STATEMENT; 08523000 + EMITL(0); EMITL(0); EMITL(1); 08524000 + HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000 + EXIT:; 08526000 + END SPACESTMT; 08527000 +PROCEDURE WRITESTMT; 08528000 + BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000 + INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000 + DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000 + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000 + WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000 + ARE PASSED TO INTERPTO. 08534000 + **********************************************************08535000 + FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000 + UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000 + READSTMT ROUTINE. 08538000 + ::= [DBL]/[PAGE]/[NO]// 08540000 + CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000 + TO CIMI FOR INPUT. 08542000 + [DBL] [PAGE] [NO] 08543000 + CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000 + LINESKIP 1 2 4 8 0 08545000 + WRITE()/ 08546000 + - - - - - - - - - - - - - - 08547000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000 + WRITE(,)/ 08550000 + - - - - - - - - - - - - - - 08551000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000 + INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000 + WRITE(,,)/08555000 + - - - - - - - - - - - - - - 08556000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000 + INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000 + WRITE(,*,)/ 08560000 + - - - - - - - - - - - - - - 08561000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000 + ROUTINE DESCRIPTOR) 08563000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000 + WRITE((CARRIAGE CONTROL>,,) 08566000 + - - - - - - - - - - - - - - 08567000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 08568000 + ROW DESCRIPTOR) 08569000 + ** ** ** ** ** ** ** ** ** ** ** ** ** **; 08570000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08571000 + EXECUTABLE STATEMENT IN WRITESTMT; 08572000 + LABEL CHKSECOND; COMMENT I IS NOW POINTING AT THE COMMA 08573000 + SEPARATING THE FIRST AND SECOND 08574000 + PARAMETERS; 08575000 + LABEL ONEPARFNSH; COMMENT I IS POINTING AT THE RIGHT 08576000 + PARENTHESIS AT THIS POINT AND I HAVE 08577000 + JUST DISCOVERED THAT THIS IS THE ONE 08578000 + PARAMETER CASE; 08579000 + DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000 + TEMPORARY CELL FOR ACCUM[1]; 08581000 +%VOID 08582000 +%VOID 08583000 +%VOID 08584000 +%VOID 08585000 + LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000 + PRECEEDING THE LIST WHEN THIS LABEL IS 08587000 + REACHED; 08588000 + LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000 + DELIMITER. THE CODE AT EMITCALL EMITS THE08590000 + CODE TO CALL INTERPTO; 08591000 + LABEL CHKRTPAREN; 08591100 + LABEL WRITXFORM; 08591200 + INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 + BOOLEAN LOCKTOG,ARC; 08591600 + INTEGER HOLD;% 08591700 + IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000 + IF CHECK(LEFTPAREN,438) 08593000 + THEN GO TO EXIT; 08594000 + COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000 + WRITE STATEMENT; 08596000 + EMITO(MKS); 08597000 + IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08597100 + BEGIN VARIABLE(FL); 08597200 + IF TABLE(I-2) ! FACTOP THEN 08597300 + BEGIN ERR(439); GO TO EXIT END; 08597400 + ARC ~ TRUE; HOLD ~ L; 08597450 + EMIT(11); EMIT(4); EMITO(280); 08597500 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600 + EMITO(XCH); 08597700 + END ELSE 08597800 + BEGIN 08597900 + IF NOT RANGE(FILEID,SUPERFILEID) 08598000 + THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000 + IDENTIFIER IN A WRITE STATEMENT; 08600000 + ERR(439); GO TO EXIT; 08601000 + END; 08602000 + 08603000 + EMITPAIR(GNAT( 08604000 + POWERSOFTEN),LOD); PASSFILE; 08605000 + END; 08605500 + IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000 + THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000 + EMITL(0); EMITL(1); 08608000 + IF RRB1 08609000 + THEN GO CHKSECOND; 08610000 + ONEPARFNSH:STEPIT; EMITL(0); EMITL(0); 08611000 + GOGOGO ~ NOT ARC;% 08611100 + EMITL(0); GO EMITCALL; 08612000 + END; 08613000 + IF ELCLASS=LEFTPAREN THEN 08613100 + BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200 + IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300 + EMITPAIR(0,LNG); 08613400 + EMITD(33,33,15); EMIT(0); 08613500 + IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN08613600 + END; 08613700 + IF CHECK(LFTBRKET,440) 08614000 + THEN GO TO EXIT; 08615000 + COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000 + PARARAMETER IN A WRITE STATEMENT; 08617000 + STEPIT; 08618000 + %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 + %%% [DPN,],[*],[*,*],[*,],[],[,*] 08619010 + %%% AND [,], WHERE DPN IS STOP, DBL, PAGE, OR 08619020 + %%% NO. THE FIRST (LEFTMOST) IS THE CHANNELSKIP, 08619030 + %%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND IS 08619040 + %%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP,08619050 + %%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP. 08619060 + %%% *"S ARE CONSIDERED TO BE EMPTIES. 08619070 + IF ACCUM1~IF ACCUM1~ACCUM[1]="3DBL00" THEN 2 ELSE 08619080 + IF ACCUM1="4PAGE0" THEN 4 ELSE 08619090 + IF ACCUM1="4STOP0" THEN 16 ELSE 08619095 + IF ACCUM1="2NO000" THEN 8 ELSE 0!0 THEN %%% [DPN08620000 + IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010 + IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020 + BEGIN EMITNO(ACCUM1); STEPIT END 08621000 + ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP08621010 + ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020 + ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000 + IF STEPI=COMMA THEN %%% HAVE [*, 08622010 + IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000 + BEGIN EMITNO(1); STEPIT END 08624000 + ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000 + ELSE EMITNO(1) %%% HAVE ONLY [* 08626000 + ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000 + %% HAVE [AEXP 08627100 + IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000 + IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,*08629000 + ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A08630000 + EMITL(0) ; %%% 0 IS NO DPN. 08631000 + END ; 08632000 + IF CHECK(RTBRKET,441) 08633000 + THEN GO TO EXIT; 08634000 + COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE08635000 + CONTROL PART; 08636000 + CHKRTPAREN:IF STEPI = RTPAREN 08637000 + THEN GO TO ONEPARFNSH; 08638000 + IF CHECK(COMMA,442) 08639000 + THEN GO TO EXIT; 08640000 + COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000 + DELIMITER IN A WRITE STATEMENT; 08642000 + CHKSECOND:STEPIT; 08643000 + IF RANGE(FRMTID,SUPERFRMTID) 08644000 + THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 + PASSFORMAT; 08646000 +WRITXFORM: IF STEPI = RTPAREN 08647000 + THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000 + CASE OF THE WRITE; 08649000 + STEPIT; EMITL(0); GO EMITCALL; 08650000 + END; 08651000 + GO PASSLIST; 08652000 + END; 08653000 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110 + IF ELCLASS!MULOP THEN ERR(443) 08653120 + ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140 + ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150 + GO TO PASSLIST ; 08653160 + END 08653170 + ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180 + BEGIN EMITL(1) ; 08653190 + IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210 + ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220 + GO TO PASSLIST ; 08653230 + END OF SCANNING FOR FREE FIELD FORMAT ; 08653240 + IF ELCLASS = FACTOP 08654000 + THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;08655000 + EMITL(0); EMITL(0); STEPIT; 08656000 + GO PASSLIST; 08657000 + END; 08658000 + IF ACCUM[1]="1<0000" THEN 08658010 + BEGIN EXPLICITFORMAT; GO TO WRITXFORM; END; 08658020 + IF ARC THEN 08658100 + BEGIN KLUDGE(-HOLD); 08658200 + GO TO EXIT; 08658300 + END ARRAY TO ARRAY CASE; 08658400 + EMITL(0); AEXP; 08659000 + IF CHECK(COMMA,443) 08660000 + THEN GO TO EXIT; 08661000 + COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000 + PARAMETER IN WRITE STATEMENT; 08663000 + STEPIT; 08664000 + IF RANGE(BOOARRAYID,INTARRAYID) 08665000 + THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 + VARIABLE(FL); 08667000 + IF TABLE(I-2) ! FACTOP 08668000 + THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000 + DESIGNATOR IN A WRITE STATEMENT; 08670000 + ERROR(444); GO TO EXIT; 08671000 + END; 08672000 + IF CHECK(RTPAREN,445) 08673000 + THEN GO TO EXIT; 08674000 + COMMENT ERROR 445 MEANS MISSING RIGHT 08675000 + PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000 + STATEMENT; 08677000 + GOGOGO ~ TRUE;% 08677100 + STEPIT; GO EMITCALL; 08678000 + END 08679000 + ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000 + ERROR(446); GO TO EXIT; 08681000 + END; 08682000 + PASSLIST:IF CHECK(COMMA,447) 08683000 + THEN GO TO EXIT; 08684000 + COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000 + LIST IN A WRITE STATEMENT; 08686000 + IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000 + THEN BEGIN RR1~LISTGEN; GO TO EMITCALL END; 08688000 + CHECKER(ELBAT[I]); 08688500 + IF ELCLASS = SUPERLISTID THEN 08689000 + BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000 + 08691000 + LISTADDRESS~ELBAT[I].ADDRESS; 08692000 + BANA; 08693000 + EMITN(LISTADDRESS); 08694000 + EMITO(LOD); 08694500 + EMITO(LOD); 08695000 + I~I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500 + END ELSE 08696000 + BEGIN COMMENT A COMMON LIST ID; 08696500 + 08696510 + EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520 + END; 08696530 + STEPIT; 08696540 + IF CHECK(RTPAREN,448) THEN GO TO EXIT; 08696550 + COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560 + STEPIT; 08697000 + EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000 + BEGIN EMITO(MKS); 08698100 + IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200 + IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300 + BEGIN STEPIT; DEXP END; 08698400 + IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500 + EMITL(15); EMITV(5); STEPIT; 08698600 + END;% 08698700 + IF GOGOGO THEN% 08698750 + BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800 + EMIT(0); EMIT(0); EMITV(12);% 08698850 + END ELSE EMITV(GNAT(INTERPTO));% 08698900 + GOGOGO ~ FALSE;% 08698950 + EXIT:; 08699000 + END WRITESTMT; 08700000 +PROCEDURE LOCKSTMT; 08701000 + BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000 + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000 + **********************************************************08705000 + ::=LOCK(,SAVE)/ 08706000 + - - - - - - - - - - - - - - 08707000 + (2,0,FILE,4) 08708000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000 + LOCK(,RELEASE) 08710000 + - - - - - - - - - - - - - - 08711000 + (6,0,FILE,4); 08712000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08713000 + EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000 + DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000 + FOR THE CURRENT L REGISTER; 08716000 + DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000 + L REGISTER SETTING FOR THE 08718000 + SAVE OR RELEASE LITERAL THAT 08719000 + GETS PASSED TO KEN MEYERS; 08720000 + STEPIT; 08721000 + IF CHECK(LEFTPAREN,450) 08722000 + THEN GO TO EXIT; 08723000 + COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 08724000 + IN A LOCK STATEMENT; 08725000 + STEPIT; 08726000 + IF NOT RANGE(FILEID,SUPERFILEID) 08727000 + THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000 + IF NOT RANGE(BOOARRAYID,INTARRAYID) THEN 08728100 + BEGIN ERR(451); GO TO EXIT END; 08728200 + VARIABLE(FL); L ~ L-1; 08728300 + IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400 + EMITO(DUP); EMITO(LOD); EMITL(24); 08728500 + EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000 + GO TO EXIT 08730000 + END; 08731000 + PASFILE; 08732000 + IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08732100 + RELEASEV ELSE 08732200 + IF CHECK(COMMA,452) 08733000 + THEN GO TO EXIT; 08734000 + COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT08735000 + ; 08736000 + THISL~L; L~LTEMP; 08737000 + IF(RRB1~STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000 + ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000 + THEN EMITL(IF RRB1 08740000 + THEN 6 08741000 + ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000 + ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000 + DISPOSITION PART; 08744000 + ERROR(453); GO TO EXIT; 08745000 + END; 08746000 + L~THISL; 08747000 + STEPIT; 08748000 + IF CHECK(RTPAREN,454) 08749000 + THEN GO TO EXIT; 08750000 + COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000 + LOCK STATEMENT; 08752000 + STEPIT; 08753000 + EXIT:; 08754000 + END LOCKSTMT; 08755000 +PROCEDURE CLOSESTMT; 08756000 + BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000 + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000 + **********************************************************08760000 + ::=CLOSE(,SAVE)/ 08761000 + - - - - - - - - - - - - - - 08762000 + (3,0,FILE,4) 08763000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000 + CLOSE(,RELEASE)/ 08765000 + - - - - - - - - - - - - - - 08766000 + (7,0,FILE,4) 08767000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000 + CLOSE(,*) 08769000 + - - - - - - - - - - - - - - 08770000 + (1,0,FILE,4) 08771000 + ::= CLOSE(, PURGE) 08771100 + -- -- -- -- -- --- -- -- -- -- -- -- 08771200 + (4,0,FILE,4) 08771300 + ** ** ** ** ** ** *** ** ** ** ** ** ; 08771400 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08772000 + EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE;08773000 + DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08774000 + FOR THE CURRENT LREGISTER; 08775000 + DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08776000 + L REGISTER SETTING FOR THE 08777000 + SAVE OR RELEASE LITERAL THAT 08778000 + GETS PASSED TO KEN MEYERS; 08779000 + LABEL EMITREST; COMMENT I IS POINTING AT THE UNIT 08780000 + DISPOTION PART AND CODE FOR THE LAST THREE08781000 + PARAMETERS TO THE FILE CONTROL ROUTINE 08782000 + MUST NOW BE GENERATED; 08783000 + STEPIT; 08784000 + IF CHECK(LEFTPAREN,455) 08785000 + THEN GO TO EXIT; 08786000 + COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 08787000 + CLOSE STATEMENT; 08788000 + STEPIT; 08789000 + IF NOT RANGE(FILEID,SUPERFILEID) 08790000 + THEN BEGIN COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A08791000 + CLOSE STATEMENT; 08792000 + ERROR(456); GO TO EXIT; 08793000 + END; 08794000 + PASFILE; 08795000 + IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08795100 + RELEASEV ELSE 08795200 + IF CHECK(COMMA,457) 08796000 + THEN GO TO EXIT; 08797000 + COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000 + STATEMENT; 08799000 + THISL~L; L~LTEMP; 08800000 + IF STEPI = RELEASEV 08801000 + THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000 + EMITL(7); GO EMITREST; 08803000 + END; 08804000 + IF ELCLASS = FACTOP 08805000 + THEN BEGIN COMMENT ASTERISK UNIT DISPOSITION PART CASE; 08806000 + EMITL(1); GO EMITREST; 08807000 + END; 08808000 + IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000 + THEN BEGIN COMMENT SAVE UNIT DISPOSTION PART CASE; 08810000 + EMITL(3); GO EMITREST; 08811000 + END; 08812000 + IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100 + EMITL(4); GO EMITREST; 08812200 + END; 08812300 + ERROR(458); GO TO EXIT; 08813000 + COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000 + IN A CLOSE STATEMENT; 08815000 + EMITREST:STEPIT; 08816000 + L~THISL; 08817000 + IF CHECK(RTPAREN,459) 08818000 + THEN GO TO EXIT; 08819000 + COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000 + CLOSE STATEMENT; 08821000 + STEPIT; 08822000 + EXIT:; 08823000 + END CLOSESTMT; 08824000 +PROCEDURE RWNDSTMT; 08825000 + BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000 + FOLLOWING PARAMETERS. 08828000 + **********************************************************08829000 + ::=REWIND() 08830000 + - - - - - - - - - - - - - - 08831000 + (0,0,FILE,4); 08832000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08833000 + EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000 + DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08835000 + FOR THE CURRENT L REGISTER; 08836000 + DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08837000 + L REGISTER SETTING FOR THE 08838000 + SAVE OR RELEASE LITERAL THAT 08839000 + GETS PASSED TO KEN MEYERS; 08840000 + STEPIT; 08841000 + IF CHECK(LEFTPAREN,460) 08842000 + THEN GO TO EXIT; 08843000 + COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000 + REWIND STATEMENT; 08845000 + STEPIT; 08846000 + IF NOT RANGE(FILEID,SUPERFILEID) 08847000 + THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A08848000 + REWIND STATEMENT; 08849000 + ERROR(461); GO TO EXIT; 08850000 + END; 08851000 + PASFILE; 08852000 + IF CHECK(RTPAREN,462) 08853000 + THEN GO TO EXIT; 08854000 + COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000 + REWIND STATEMENT; 08856000 + STEPIT; THISL~L; L~LTEMP; 08857000 + EMITL(0); L~THISL; 08858000 + EXIT:; 08859000 + END RWNDSTMT; 08860000 +PROCEDURE EXPLICITFORMAT; 08860050 + BEGIN INTEGER PRT; ARRAY TEDOC[0:7,0:127]; 08860100 + MOVECODE(TEDOC,EDOC); 08860150 + GT5:=SGNO; GT1:=(2|SGAVL-1)&2[4:46:2]; SGNO:=SGAVL; 08860200 + F := 0; PRT := GETSPACE(TRUE,-4); % FORMAT DESCR. 08860250 + PRT := PROGDESCBLDR(LDES,0,PRT); 08860300 + ELCLASS := "<"; TB1 := FORMATPHRASE; 08860350 + SEGMENT(-F,SGNO,GT5); SGAVL := SGAVL+1; 08860400 + SGNO := GT5; MOVECODE(TEDOC,EDOC); 08860450 + IF LASTELCLASS ! ">" THEN ERR(136); 08860500 + IF ELCLASS = "," THEN ELBAT[I].CLASS := COMMA ELSE 08860600 + IF ELCLASS = ")" THEN ELBAT[I].CLASS := RTPAREN ELSE 08860650 + ELBAT[I].CLASS := 0; I:=I-1; 08860700 + EMITL(0); EMITPAIR(PRT,LOD); 08860750 + END EXPLICITFORMAT; 08860800 + COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 08861000 + AND CALL SORTI, PASSING THE FOLLOWING: 08862000 + SORT: MERGE: 08863000 + 0 DISK SIZE,IF SPECIFIED 08864000 + 0 CORE SIZE,IF SPECIFIED 08865000 + 0 0 ALFA FLAG 08866000 + RECORD SIZE 08867000 + PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 08868000 + PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 08869000 + ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000 + 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000 + TP5 FL7 SCRATCH TAPES FOR SORT, 08872000 + TP4 FL6 OR MERGE FILES. POINTERS TO 08873000 + TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000 + TP2 FL4 IF NOT USED. 08875000 + TP1 FL3 08876000 + 0 FL2 DISK FILES FOR SORT 08877000 + DKO FL1 08878000 + 0/1 0 TRUE IF INPUT PROCEDURE 08879000 + 0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000 + INF 0 POINTER TO I/O DESC FOR INPUT 08881000 + OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000 + OF WORK ARRAY. 08883000 + PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000 + PD/0 PD/0 OUTPUT PROCEDURE 08885000 + 0 0 08886000 + 0 0 08887000 + 0 0 08888000 + LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000 + 0 0 08890000 + 0 1 SORT/MERGE FLAG 08891000 + ... MSCW 08892000 + 0 SORT-FILE MOTHER 08893000 + 0 DESCRIPTORS 08894000 + 0 . 08895000 + 0 . 08896000 + 0 . 08897000 + 0 . 08898000 + MSCW; 08900000 + PROCEDURE MERGESTMT; 08901000 + BEGIN INTEGER J,K,FILER,FILEND; 08902000 + BOOLEAN OPTOG; 08903000 + LABEL QUIT; 08904000 + STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000 + EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000 + EMIT(0); EMIT(0); EMIT(0); 08907000 + IF OPTOG~(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000 + ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000 + EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I~I-1 END ELSE 08911000 + EMITN(GNAT(SORTA)); 08911100 + IF NOT COMMACHECK THEN GO QUIT; 08912000 + EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000 + FILER~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000 + IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000 + AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000 + FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000 + BEGIN STEPIT; PASSFILE END; 08920000 + FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000 + IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000 + EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000 + IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000 + EMIT(0); EMIT(0); EMIT(0); 08925000 + QUIT: EMITV(GNAT(SORTI)); 08926000 + END MERGESTMT; 08927000 + PROCEDURE SORTSTMT; 08928000 + BEGIN BOOLEAN INPRO,OUTPRO; 08929000 + INTEGER A,J; 08930000 + LABEL QUIT; DEFINE RDS=1,280#; 08931000 + STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000 + VALUE FN, SFN ; 08933000 + BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000 + SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000 + DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000 + DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000 + DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000 + END STUFFILE; 08939000 + BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000 + IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000 + IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100 + IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000 + INPROCHECK~TRUE; 08944000 + IF SFILENO=0 THEN 08945000 + BEGIN SFILENO~FILENO; 08946000 + FOR J~1 STEP 1 UNTIL 7 DO 08947000 + IF MKABS(IDARRAY[127]); OCT1340000250002662, COMMENT }; 09201000 + OCT1350000200000000, COMMENT +; OCT0000000000000000, 09202000 + OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 09203000 + OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT (; 09204000 + OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT ~; 09205000 + OCT1360001000000000, COMMENT |; OCT0000000000000000, 09206000 + OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT *; 09207000 + OCT1350000600000000, COMMENT -; OCT1240000000160000, COMMENT ); 09208000 + OCT0620000000000000, COMMENT .,; OCT1340010250003470, COMMENT .{; 09209000 + OCT0000000000000000, OCT1360002000000000, COMMENT /; 09210000 + OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 09211000 + OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT =; 09212000 + OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 09213000 + 0,0; 09214000 + COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;09214100 +FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 09214105 + OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 09214110 + OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115 + OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 09214120 + OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 09214125 + OCT0030000170000000, "3NEQ00", 09214130 + OCT0030000200000000, "3LEQ00", 09214135 + OCT0030000210000000, "3LSS00", 09214140 + OCT0030000220000000, "5TIMES", 09214145 + OCT0030000230000000, "5INPUT", 09214150 + OCT0030000240000000, "2IO000", 09214155 + OCT0030000250000000, "6SERIA","L0000000", 09214160 + OCT0030000260000000, "6RANDO","M0000000", 09214165 + OCT0030000270000000, "6UPDAT","E0000000", 09214170 + OCT0030000300000000, "6OUTPU","T0000000", 09214180 + OCT0030000310000000, "7CANTU","SE000000", 09214190 + OCT0130000000740000, "3MIN00", OCT0000000003200000,%549 09214200 + OCT0130000001040000, "5DELAY", OCT0000000003300000,%552 09214210 + OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%555 09214220 + OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%559 09214230 + OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%563 09214240 + OCT0000000000040000, "5DCPWR", OCT0000000005600000,%567 09214250 + OCT0000000000040000, "5DCMTH", OCT0000000005500000,%570 09214255 + OCT0130000001140000, "5DSQRT", OCT0000000012300000,%573 09214260 + OCT0130000001240000, "4CEXP0", OCT0000000010000000,%576 09214270 + OCT0130000001340000, "3CLN00", OCT0000000010200000,%579 09214295 + OCT0130000001440000, "4CSIN0", OCT0000000010600000,%582 09214300 + OCT0130000001540000, "4CCOS0", OCT0000000011000000,%585 09214305 + OCT0130000001640000, "5CSQRT", OCT0000000012400000,%588 09214310 + OCT0130000001740000, "4DEXP0", OCT0000000007700000,%591 09214315 + OCT0130000002040000, "3DLN00", OCT0000000010100000,%594 09214320 + OCT0130000002140000, "4DSIN0", OCT0000000010500000,%597 09214325 + OCT0130000002240000, "4DCOS0", OCT0000000010700000,%600 09214330 + OCT0130000002360000, "7DARCT", "AN000000", OCT0000000011300000,%603 09214340 + OCT0130000002460000, "6DLOG1", "00000000", OCT0000000010400000,%607 09214345 + OCT0130000002560000, "8DARCT", "AN200000", OCT0000000011500000,%611 09214350 + OCT0130000002640000, "4DMOD0", OCT0000000006500000,%615 09214355 + OCT0130000002740000, "4CABS0", OCT0000000005300000,%618 09214360 + OCT0130000003060000, "7ARCTA", "N2000000", OCT0000000011400000,%621 09214365 + OCT0130000003160000, "6DROUN", "D0000000", OCT0000000006100000,%625 09214370 + OCT0130000000040000, "5LOG10", OCT0000000010300000,%629 09214375 + OCT0130000000040000, "5COTAN", OCT0000000011200000,%632 09214380 + OCT0130000000060000, "6ARCSI", "N0000000", OCT0000000011600000,%635 09214385 + OCT0130000000040000, "5ARCOS", OCT0000000011700000,%639 09214390 + OCT0130000000040000, "4SINH0", OCT0000000012000000,%642 09214395 + OCT0130000000040000, "4COSH0", OCT0000000012100000,%645 09214400 + OCT0130000000040000, "4TANH0", OCT0000000012200000,%648 09214405 + OCT0130000000040000, "3ERF00", OCT0000000012500000,%651 09214410 + OCT0130000000040000, "5GAMMA", OCT0000000012600000,%654 09214415 + OCT0130000000040000, "5LNGAM", OCT0000000012700000,%657 09214420 + OCT0130000000040000, "3TAN00", OCT0000000011100000,%660 09214425 + OCT2000000000004050, COMMENT POWERS OF TEN ; %663 09214430 + OCT0430000240000000, "4LONG0", %664 09214432 + 0, COMMENT SORTA ; %666 09214435 + " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %667 09214440 + COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500 +FOR NEXTINFO~512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510 +,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,635, 09214515 +639STEP 3UNTIL 660,664 09214516 +DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], 09214520 + LASTINFO~STACKHEAD[GT2]~NEXTINFO); 09214530 + NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980 + BUILDLINE.[45:1]~TRUE ; 09214985 + PUTNBUMP(0); 09214990 + FILL MACRO[*] WITH 09215000 + OCT0131, COMMENT SFS A 00 ; 09216000 + OCT0116, COMMENT SFD A 01 ; 09217000 + OCT0000, COMMENT SYNTAX ERROR02 ; 09218000 + OCT0140, COMMENT INC A 03 ; 09219000 + OCT0130, COMMENT SRS A 04 ; 09220000 + OCT0117, COMMENT SRD A 05 ; 09221000 + OCT0000, COMMENT SYNTAX ERROR06 ; 09222000 + OCT0000, COMMENT SYNTAX ERROR07 ; 09223000 + OCT00310143, COMMENT CRF A, SFS 008 ; 09224000 + OCT00160143, COMMENT CRF A, SFD 009 ; 09225000 + OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000 + OCT00400143, COMMENT CRF A, INC 011 ; 09227000 + OCT00300143, COMMENT CRF A, SRS 012 ; 09228000 + OCT00170143, COMMENT CRF A, SRD 013 ; 09229000 + OCT0000, COMMENT SYNTAX ERROR14 ; 09230000 + OCT0000, COMMENT SYNTAX ERROR15 ; 09231000 + OCT0153, COMMENT RSA A 16 ; 09232000 + OCT0104, COMMENT RDA A 17 ; 09233000 + OCT0150, COMMENT RCA A 18 ; 09234000 + OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000 + OCT0122, COMMENT SES A 20 ; 09236000 + OCT0106, COMMENT SED A 21 ; 09237000 + OCT0000, COMMENT SYNTAX ERROR22 ; 09238000 + OCT0000, COMMENT SYNTAX ERROR23 ; 09239000 + OCT0056, COMMENT TSA 0 24 ; 09240000 + OCT0000, COMMENT SYNTAX ERROR25 ; 09241000 + OCT0000, COMMENT SYNTAX ERROR26 ; 09242000 + OCT0000, COMMENT SYNTAX ERROR27 ; 09243000 + OCT0000, COMMENT SYNTAX ERROR28 ; 09244000 + OCT0007, COMMENT TDA 0 29 ; 09245000 + OCT0000, COMMENT SYNTAX ERROR30 ; 09246000 + OCT0000, COMMENT SYNTAX ERROR31 ; 09247000 + OCT0115, COMMENT SSA A 32 ; 09248000 + OCT0114, COMMENT SDA A 33 ; 09249000 + OCT0154, COMMENT SCA A 34 ; 09250000 + OCT0141; COMMENT STC A 35 ; 09251000 + FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010 + "[# ", 09251020 + "]# ", 09251030 + "># ", 09251040 + "}# ", 09251050 + "=# ", 09251060 + "!# ", 09251070 + "{# ", 09251080 + "<# ", 09251090 + "|# ", 09251100 + "1# ", 09251101 + "3# ", 09251102 + "0# ", 09251103 + "1# ", 09251104 + "2# ", 09251105 + "2# ", 09251106 + "0# " 09251107 +; 09251200 +NEXTTEXT~26 ; 09251300 + DO UNTIL STEPI = BEGINV; 09252000 + BUILDLINE.[45:1]~FALSE; 09252050 + 09252100 + COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000 + THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000 + LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000 + AND IS ALSO USED AS A ONE SYLLABLE 09256000 + CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000 + ITS PRIMARY FUNTION IS TO CUT BACK 09258000 + THE STACK AFTER A COMMUNICATE OPERATOR. 09259000 + MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000 + IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000 + C-RELATIVE ADDRESSING FOR CONSTANTS 09262000 + IN THE PROGRAM STREAM 09263000 + OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000 + THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000 + LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000 + CELL.AT THE START OF COMPILATION XXXX IS 09267000 + ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000 + IT IS CHANGED BEFORE COMPILATION IS 09269000 + COMPLETE TO LOOK LIKE A WORD MODE 09270000 + PROGRAM DESCRIPTOR; 09271000 + EMITL(0);EMITO(MKS); 09272000 + GT1~PROGDESCBLDR(3,0,0); 09273000 + GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000 + ERRORTOG~TRUE; BLOCK(FALSE); 09275000 + COMMENT THIS CODE WILL PUT AN EXTRA CARD ON 0CRDIMG TAPE 09275100 + THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200 + THE END. CARD OFF AN INPUT TAPE; 09275250 + IF NEWTOG THEN 09275300 + BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350 + "D ON 0CR","DING TAP","E ", " "," ", 09275400 + " ","99999999"; 09275450 + WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500 + END; 09275550 + 09275600 + 09275650 + 09275700 + 09275750 + 09275800 + 09275850 + 09275900 + 09275950 + 09276000 + COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000 + WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000 + USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000 + THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000 + IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000 + PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000 + INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000 + ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000 + FIELD IS BROKEN INTO 2 PARTS. [33:2] IS USED TO ADD TO THE 09285000 + INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000 + THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000 + PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000 + DRUM ADDRESSES TO THE INTRINSICS; 09289000 + 09290000 + GT1 ~ GT3 ~ STARTINTRSC; 09291000 + L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000 + IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000 + BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000 + BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000 + GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000 + | 2 + 1, 0, GT2.ADDRESS); 09296100 + PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000 + 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000 + & SGNO[28:38:10] & 1[2:47:1]; 09298100 + PDINX ~ PDINX + 1; 09299000 + IF LISTOG THEN % WRITE OUT SEGMENT USE 09300000 + BEGIN GT3 ~ GT3 + 1; 09300100 + BLANKET(14,LIN); % BLANK BUFFER. 09300150 + WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200 + B2D(GT2.[38:10]), LIN); 09301000 + IF NOHEADING THEN DATIME; WRITELINE; 09302000 + END 09303000 + END; 09304000 + GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000 + GO TO L1; 09305100 + END; 09306000 + L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100 + EMITL(5);EMITO(COM); 09307000 + ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100 + SEGMENT((L+3) DIV 4,1,0); 09308000 +COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000 + AT THIS TIME AS A TYPE 2 SEGMENT; 09310000 + IF GT1~GT2.ADDRESS!0 THEN 09311000 + BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000 + GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000 + MOVE(69,TEN,EDOC[0,0]); 09314000 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100 + SEGMENT(-69, SGNO,0); 09315000 + BUILDLINE ~ BUILDLINE.[46:1] ; 09315100 + END; 09316000 +BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000 + INTEGER PRTADR,SEGMNT,LINK; 09318000 + INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE); VALUE SIZE; 09319000 + ARRAY FROM[0,0]; INTEGER SIZE; 09320000 + BEGIN INTEGER NSEGS,I,J; 09321000 + REAL T; 09322000 + NSEGS~(SIZE+29) DIV 30; 09323000 + IF DA DIV CHUNK 16 THEN W-16 ELSE 0. 10049000 + IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000 + IF W < 8 THEN W1 = W, W2 = 0. ALWAYS D1=D2=0. 10051000 + FOR F IF D < 8 THEN D1 = D, D2=0. 10052000 + IF D > 8 THEN D1 = 8, D2=D-8. 10053000 + IF D >16 THEN ERROR. 10054000 + IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000 + SKIP=0. 10056000 + IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8. 10057000 + IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000 + FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000 + D+1 FOR D. SKIP = W-D-6. W1=W2=0. 10060000 + FOR O, W1=W2=D1=D2=SKIP=0. 10061000 + FOR L, W2=D1=D2=0. IF W > 5 THEN W1=5 ELSE W1 = W. 10062000 + SKIP = W-W1. 10063000 + FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100 + FOR B: SEE U-PHRASE DESCRIPTION. 10063110 + FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200 + FOR V: SKIP = W1 = W2 = UNSET. D1,D2 AS IN ABOVE 10063300 + F-PHRASE DESCRIPTION. 10063400 + FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000 + WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000 + BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000 + IF IT NOTICES AN ERROR; 10067000 + PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000 + BEGIN 10069000 + 10070000 + MOVE(1,W,EDOC[F.[38:3],F.[41:7]]); 10071000 + IF DEBUGTOG 10072000 + THEN BEGIN 10073000 + DEBUGWORD(B2D(F),W,LIN); 10074000 + WRITELINE END; 10075000 + F ~ F+1; 10076000 + 10077000 + 10078000 + 10079000 + 10080000 + 10081000 + END WHIPOUT; 10082000 + BOOLEAN PROCEDURE FORMATPHRASE; 10083000 + BEGIN 10084000 + LABEL EL,EX,EXIT,L1,L2,L3; 10085000 + PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000 + VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000 + REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000 + BOOLEAN S; 10089000 + BEGIN IF W > 63 THEN FLAG(163); 10090000 + W ~ REPEAT & W [ 6:42:6] 10091000 + & SKIP [32:42:6] 10092000 + & W1 [28:44:4] 10093000 + & W2 [24:44:4] 10094000 + & D1 [20:44:4] 10095000 + & D2 [16:44:4] 10096000 + & CODE [ 2:44:4] 10097000 + & REAL(S) [ 1:47:1]; 10098000 + WHIPOUT(W) END EMITFORMAT; 10099000 + STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000 + VALUE LETTER,CTR; 10101000 + BEGIN DI ~ PLACE; DS ~ LIT "B"; 10102000 + SI ~ LOC CTR; SI ~ SI+7; DS ~ CHR; 10103000 + SI ~ PLACE; SI ~ SI+3; DS ~ 5 CHR; 10104000 + SI ~ LOC LETTER; SI ~ SI+7; DS ~ CHR END PACKALPHA; 10105000 + INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000 + DEFINE RRIGHT = 0#, 10107000 + RLEFT = 4#, 10108000 + RSTROKE = 6#; 10109000 + DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500 + DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000 + RT=1 #, 10110010 + RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000 + IF ELCLASS < 0 THEN BEGIN REPEAT ~ -ELCLASS;NEXTENT; 10112000 + IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100 + ELSE BEGIN REPEAT:=REAL(ELCLASS ! "(" AND 10113000 + ELCLASS ! "<"); 10113010 + IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100 + NEXTENT; 10113200 + END END; 10113300 + IF ELCLASS="(" OR ELCLASS="<" 10114000 + THEN BEGIN 10115000 + SKIP ~ F; 10116000 + EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000 + DO BEGIN NEXTENT; 10118000 + EL: IF FORMATPHRASE THEN GO TO EX END 10119000 + UNTIL ELCLASS ! ","; 10120000 + WHILE ELCLASS = "/" 10121000 + DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000 + NEXTENT END; 10123000 + IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000 + THEN GO TO EL; 10124100 + IF LASTELCLASS = "," THEN GO TO EX; 10124200 + IF REPEAT = 0 THEN 10125000 + EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000 + REPEAT~F-SKIP; F~SKIP; 10127000 + WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100 + F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200 + ELSE IF ELCLASS = "O" 10128000 + THEN BEGIN CODE~RO; W~8 END 10129000 + ELSE IF ELCLASS = "D" 10130000 + THEN BEGIN CODE~RD; W~8 END 10131000 + ELSE IF ELCLASS = "," THEN GO TO L2 10132000 + ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000 + ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 10134000 + IF LASTELCLASS="," THEN GO EX ELSE GO EXIT 10134100 + ELSE IF ELCLASS = "S" THEN 10134500 + BEGIN 10134510 + NEXTENT; 10134520 + W ~ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530 + IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540 + IF ELCLASS="*" THEN REPEAT.[12:1]~1 ELSE 10134545 + IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550 + GO TO EXIT 10134560 + END 10134570 + ELSE REPEAT ~ - ELCLASS; 10134580 + EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590 + GO TO L2 10134600 + END 10134610 + ELSE IF ELCLASS = """ 10135000 + THEN BEGIN 10136000 + IF REPEAT ! 1 THEN FLAG(136); 10136500 + CODE ~ 100; 10137000 + DO BEGIN 10138000 + SKIP ~ 1; 10139000 + DO BEGIN RESULT ~ 5; COUNT ~ 0; SCANNER; 10140000 + IF ELCLASS ~ ACCUM[1].[18:6] = CODE 10141000 + THEN BEGIN 10142000 + IF SKIP ! 1 THEN WHIPOUT(W); 10143000 + GO TO L2 END; 10144000 + CODE ~ """; 10145000 + PACKALPHA(W,ELCLASS,SKIP); 10146000 + END UNTIL SKIP ~ SKIP+1 = 7; 10147000 + WHIPOUT(W) 10148000 + END UNTIL FALSE END 10149000 + ELSE BEGIN CODE~ELCLASS; 10150000 + IF CODE = "U" OR CODE = "B" THEN 10150100 + BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 10150110 + NEXTENT ; 10150120 + SKIP ~ 0 ; 10150125 + IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150130 + BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135 + IF ELCLASS = "*" THEN REPEAT.[13:1] ~ 1 10150140 + ELSE W ~ -ELCLASS ; 10150145 + NEXTENT ; 10150150 + IF ELCLASS = "." THEN 10150155 + BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 10150160 + NEXTENT ; 10150165 + IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150170 + BEGIN %%% PHRASE IS UW*.D*. 10150175 + IF ELCLASS = "*" THEN REPEAT.[14:1]~1 10150185 + ELSE SKIP ~ -ELCLASS ; 10150190 + NEXTENT ; 10150195 + END 10150200 + ELSE GO TO EX 10150205 + END 10150210 + END 10150215 + ELSE W ~-63 ; %%% PHRASE IS U. 10150220 + EMITFORMAT(FALSE,RU,REPEAT,SKIP,W,REAL(CODE="B"), 10150225 + REAL(W<0),0,0) ; 10150230 + GO TO EXIT ; 10150260 + END OF U PHRASE HANDLER ; 10150270 + IF GETINT THEN BEGIN W~11; REPEAT.[13:1]~1 END 10150280 + ELSE ELCLASS := -(W := ELCLASS); 10150290 + IF CODE = "I" 10151000 + THEN BEGIN 10152000 + SKIP ~ DIVIDE(W,W1,W2); CODE ~ RI END 10153000 + ELSE IF CODE = "F" 10154000 + THEN BEGIN CODE ~ RF; GO TO L1 END 10155000 + ELSE IF CODE = "R" THEN BEGIN CODE ~ RR; GO TO L1 END 10155500 + ELSE IF CODE = "E" 10156000 + THEN BEGIN CODE ~ RE; D1~1; 10157000 + L1: NEXTENT; 10158000 + IF ELCLASS!"." THEN GO EX; 10159000 + IF GETINT THEN BEGIN ELCLASS~3; REPEAT.[14:1]~1 END; 10159100 + IF DIVIDE(ELCLASS+D1,D1,D2) > 0 THEN GO TO EX; 10160000 + IF CODE = RF OR CODE = RR THEN 10161000 + SKIP ~ DIVIDE(W-ELCLASS-1,W1,W2) 10161500 + ELSE IF SKIP ~ W-ELCLASS-6 < 0 THEN GO TO EX END 10162000 + ELSE IF CODE = "X" 10163000 + THEN BEGIN CODE ~ RX; W1 ~ W.[38:4]; 10164000 + SKIP ~ W ~ W.[42:6] END 10165000 + ELSE IF CODE="T" THEN IF W~ABS(W)-1<0 THEN FLAG(136) 10165500 + ELSE BEGIN CODE~RT; W1~W.[38:4]; W~W.[42:6] END 10165505 + ELSE IF CODE = "A" 10166000 + THEN BEGIN CODE ~ RA; W1 ~6; GO TO L3 END 10167000 + ELSE IF CODE="V" THEN 10167100 + BEGIN CODE ~ RV ; 10167200 + COUNT~ACCUM[1]~0; 10167300 + IF EXAMIN(NCR)=" " THEN 10167400 + BEGIN RESULT~7; SCANNER END; 10167500 + IF EXAMIN(NCR)="." THEN 10167600 + BEGIN NEXTENT; 10167700 + IF GETINT THEN REPEAT.[14:1]~1 ELSE 10167800 + GT1~DIVIDE(ELCLASS,D1,D2); 10167900 + ELCLASS :=-ELCLASS; 10167910 + END; END ELSE IF CODE="L" 10168000 + THEN BEGIN CODE ~ RL; W1 ~ 5; 10169000 + L3: IF W 2047 10242000 + THEN BEGIN FLAG(142); TB1~ TRUE END 10243000 + ELSE BEGIN 10244000 + IF COUNT > REMCOUNT 10245000 + THEN BEGIN 10246000 + SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT); 10247000 + REMCOUNT ~ 2048 END 10248000 + ELSE REMCOUNT ~ REMCOUNT-COUNT; 10249000 + GT1 ~ CHARCOUNT DIV 8 + NEXTTEXT; 10250000 + PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3],10251000 + COUNT,0,CHAR); 10252000 + IF SKIPCOUNT ! 0 THEN 10253000 + PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000 + COUNT,CHAR); 10255000 + CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END 10256000 + END PUTOGETHER; 10257000 + INTEGER LASTRESULT; 10258000 + REAL K,N,ELCLASS; 10258100 + DEFINE I=NXTELBT#; 10258200 + LABEL FINAL,PACKIN; 10258300 + LABEL BACK,SKSC,EXIT; 10259000 + REAL DINFO; 10259200 + DINFO ~ J.[18:15]; 10259600 + J ~ J.[33:15]; 10259700 + TB1~ FALSE; 10260000 +STREAMTOG~TRUE; 10260100 + CHARCOUNT ~ 0; 10261000 + DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000 + REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000 + K~0; 10263200 + BACK: STOPDEFINE~TRUE; 10263300 + ELCLASS~TABLE(NXTELBT); 10263400 + SKSC: NXTELBT~NXTELBT-1; 10263500 + IF MACRO THEN 10263600 + BEGIN IF ELCLASS=COMMA THEN 10263700 + IF K=0 THEN 10263800 + FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900 + ELSE GO PACKIN; 10264000 + IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100 + BEGIN K~K+1; GO TO PACKIN END; 10264200 + IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300 + IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400 + IF ELCLASS=SEMICOLON THEN 10264410 + BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420 + END; 10264500 + IF RESULT = 1 THEN IF J ! 0 THEN 10264600 + FOR N ~ 1 STEP 1 UNTIL J DO 10264650 + BEGIN 10264700 + IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1], 10264750 + DEFINFO[(N-1)|10]) THEN 10264760 + BEGIN 10264800 + DEFINEPARAM(DINFO+1, N); 10264810 + GO PACKIN; 10264820 + END; 10264830 + END; 10264900 + PACKIN: 10264910 + IF RESULT = 4 10265000 + THEN BEGIN 10266000 + COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 10267000 + PUTOGETHER(2130706432); 10268000 + PUTOGETHER(ACCUM[1]); 10269000 + PUTOGETHER(2130706432) END 10270000 + ELSE BEGIN 10271000 + IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) 10272000 + THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000 + PUTOGETHER(ACCUM[1]) END; 10274000 + IF TB1 THEN GO TO EXIT; 10275000 + LASTRESULT ~ RESULT; 10276000 + IF MACRO THEN GO BACK; 10276500 + IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV10277000 + THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END; 10278000 + IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000 + IF DEFINECTR ! 1 10280000 + THEN BEGIN STOPDEFINE ~ TRUE; 10281000 + IF ELCLASS~TABLE(I)!COMMA THEN 10282000 + DEFINECTR~DEFINECTR-1; GO SKSC END; 10283000 +EXIT: DEFINECTR~0; STREAMTOG~FALSE; 10284000 + NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 + END DEFINEGEN; 10286000 + COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000 + ELEMENTS; 10288000 + PROCEDURE LISTELEMENT; 10289000 + BEGIN 10290000 + REAL T1,T2,T3; 10291000 + LABEL BOOFINISH,STORE,LRTS; 10292000 + DIALA ~ DIALB ~ 0; 10293000 + IF ELCLASS = FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000 + ELSE IF ELCLASS = LFTBRKET 10295000 + THEN BEGIN COMMENT GROUP OF LIST ELEMENTS; 10296000 + DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000 + IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 + ELSE BEGIN COMMENT THE MEAT OF THE MATTER: 10299000 + VARIABLES AND EXPRESSIONS; 10300000 + L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000 + EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000 + NEXT TIME AROUND; 10303000 + IF(GT1 ~ TABLE(I+1) = COMMA 10304000 + OR GT1 = RTPAREN 10305000 + OR GT1 = RTBRKET) 10306000 + AND ELCLASS } BOOID AND ELCLASS { INTID 10307000 + THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 + CHECKER(ELBAT[I]); 10308100 + EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 + ELSE BEGIN IF ELCLASS } BOOARRAYID 10310000 + AND ELCLASS { INTARRAYID 10311000 + THEN BEGIN COMMENT IS EITHER A SUBCRIPTED VARIABLE 10312000 + OR THE BEGINNING OF AN EXPRESSION. THIS10313000 + SITUATION IS VERY SIMILAR TO THAT IN 10314000 + ACTUALPARAPART (SEE COMMENTS THERE FOR 10315000 + FURTHER DETAILS); 10316000 + T2 ~ FL; T3 ~ ELCLASS; VARIABLE(T2); 10317000 + IF TABLE(I-2)=FACTOP AND TABLE(I-1)=RTBRKET THEN ERR(157);10318000 + IF ELCLASS = COMMA OR 10319000 + ELCLASS = RTPAREN OR 10320000 + ELCLASS = RTBRKET THEN 10321000 + IF T2 = 0 THEN GO TO STORE ELSE GO TO LRTS; 10322000 + IF T3 = BOOARRAYID THEN GO TO BOOFINISH; 10323000 + SIMPARITH; 10324000 + IF ELCLASS = RELOP THEN BEGIN RELATION; 10325000 + BOOFINISH: SIMPBOO END END 10326000 + ELSE IF EXPRSS = DTYPE THEN ERR(156); 10327000 + STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000 + LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000 + T2 ~ L; L ~ T1; EMITNUM(T2-LSTR); L~T2 END END LSTELMT; 10330000 + COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000 + LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000 + LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000 + CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000 + LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000 + FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000 + THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000 + FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000 + DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR. 10339000 + LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000 + LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000 + VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000 + ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000 + REAL PROCEDURE LISTGEN; 10344000 + BEGIN 10345000 + INTEGER JUMPLACE,LISTPLACE; 10346000 + JUMPLACE ~ BAE; 10347000 + LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000 + COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 + EMITV(LSTRTN); EMITO(BFW); LSTR ~ L; 10350000 + COMMENT INITIAL JUMP OF A LIST; 10351000 + LISTMODE ~ TRUE; 10352000 + COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000 + I~I-1; 10354000 + DO BEGIN 10355000 + STEPIT; 10356000 + LISTELEMENT 10357000 + END UNTIL ELCLASS ! COMMA; 10358000 + EMITL(1); EMITO(CHS); 10359000 + EMITPAIR(LSTRTN,SND); 10360000 + EMITO(RTS); 10361000 + COMMENT SET END FLAG OF -1; 10362000 + CONSTANTCLEAN; 10363000 + DIALA ~ DIALB ~ 0; 10364000 + LISTMODE ~ FALSE; 10365000 + ADJUST; 10365100 + EMITB(BFW,JUMPLACE,L); 10366000 + STUFFF(LISTPLACE); 10367000 + IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT 10368000 + END LISTGEN; 10369000 + BOOLEAN PROCEDURE MERRIMAC; 10370000 + BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000 + 03 JULY 1963 10372000 + THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000 + LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,10374000 + ARRAYS, AND FUNCTION DESIGNATORS. 10375000 + WITH ONE EXCEPTION, THE MERRIMAC ROUTINES ONLY FUNCTION 10376000 + IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE10377000 + VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000 + THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000 + THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000 + A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN10381000 + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000 + ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000 + THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000 + INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000 + FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000 + EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000 + AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000 + POSSIBLE CALLS ON PRINTI. 10389000 + ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000 + THE IDENTIFIER TO BE PRINTED. 10391000 + N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000 + ARRAY OR SUBSCRIPTED VARIABLE. 10393000 + V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000 + S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000 + PRINTED. 10396000 + S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000 + MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000 + ONLY IF THEY ARE EQUAL. 10399000 + FORMAT TYPE MONITOR DUMP 10400000 + ----------- ------- ---- 10401000 + 0 LABELS 10402000 + SWITCHES 10403000 + --------- ----- -- 10404000 + 1 SIMPLE VARIABLES LABELS 10405000 + FUNCTION SIMPLE VARIABLES 10406000 + --------- ----- -- 10407000 + 2 ARRAYS SUBSCRIPTED VARS 10408000 + --------- ----- -- 10409000 + 3 SUBSCRIPTED VARS 10410000 + --------- ----- -- 10411000 + 4 ARRAYS 10412000 + ********* ***** ** 10413000 + FORMAT TYPE PRINTOUT 10414000 + ----------- -------- 10415000 + 0 ID 10416000 + --------- ------ 10417000 + 1 ID=V 10418000 + --------- ------ 10419000 + 2 ID[S1---SN]=V 10420000 + --------- ------ 10421000 + 3 ID[S1---SN]=V 10422000 + --------- ------ 10423000 + 4 ID=V1---VN 10424000 + *********** ******** 10425000 + THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY10426000 + THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000 + PASSING THE TYPEV TO PRINTI. 10428000 + TYPE TYPEV 10429000 + ---- ----- 10430000 + BOOLEAN 0 10431000 + -- --- 10432000 + REAL 1 10433000 + -- --- 10434000 + ALPHA 2 10435000 + -- --- 10436000 + INTEGER 3 10437000 + **** ***** 10438000 + POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000 + AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000 + FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000 + ----------- --------------------------- 10442000 + 0 10443000 + --------- ------------------------- 10444000 + 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000 + --------- ------------------------- 10446000 + 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000 + FILE,2) 10448000 + --------- ------------------------- 10449000 + 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000 + ,ID,CHARI,FILE,3) 10451000 + --------- ------------------------- 10452000 + 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000 + POWERSOFTEN,ID,CHARI,FILE,4) 10454000 + *********** **************************** 10455000 + SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000 + MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000 + THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000 + THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000 + ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000 + ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000 + MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000 + MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000 + WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000 + MONITORING INFORMATION. 10465000 + *********FORMAT OF INFO FOR MONITORED ITEMS**********10466000 + ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000 + WORD WILL BE SET. 10468000 + SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000 + ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000 + THE MONITOR FILE IN [37:11]. I WILL HAVE A 10471000 + DEFINE SVARMONFILE = [37:11]#. 10472000 + ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000 + NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000 + MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000 + FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000 + DEFINE ARRAYMONFILE = [27:11]#. 10477000 + SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000 + SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000 + TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000 + OF INFO CONTAINING LOWER BOUND INFORMATION10481000 + ALSO CONTAINS MONITOR INFORMATION. EITHER10482000 + A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000 + IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000 + DESIGNATES WHETHER AN OPDC OR A LITC 10485000 + SHOULD BE GENERATED USING [12:11]. IF THE10486000 + BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000 + ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000 + MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000 + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000 + PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000 + SI* TO THE PRINTI ROUTINE. 10492000 + LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000 + THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000 + ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000 + DEFINE LABLMONFILE = [13:11]#. 10496000 + SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000 + I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000 + FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000 + WITH THE SAME NUMBER OF WORDS AS THE 10500000 + ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000 + REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000 + ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000 + FUNCMONFILE = [27:11]#; 10504000 + DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000 + ADDRESS OF THE MONITOR FILE; 10506000 + DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000 + SAVE THE ADDRESS OR VALUE OF A 10508000 + SUBSCRIPT. ONE ADDITIONAL BIT IS10509000 + USED TO TELL WHETHER TO EMIT AN 10510000 + OPDC OR A LITC ON THIS ADDRESS OR10511000 + VALUE; 10512000 + DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000 + DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000 + VARIABLE APPEARING IN A MONITOR LIST;10515000 + DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000 + ADDITIONAL INFO AND IS USED WHEN MAKING10517000 + A NEW ENTRY IN INFO FOR ARRAYS; 10518000 + DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000 + ELBAT WORD FOR A MONITOR LIST 10520000 + ELEMENT; 10521000 + DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000 + SUBSCRIPTED VARIABLES TO TELL ME 10523000 + WHETHER TO EMIT AN OPDC OR A LITC.10524000 + 0 IS USED FOR OPDC, 1 FOR LITC; 10525000 + DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000 + POINTING AT THE END OF ADDITIONAL 10527000 + INFO AND IS USED TO TELL WHEN TO 10528000 + STOP MOVING INFO FOR THE NEW ENTRY10529000 + FOR MONITORED ARRAYS; 10530000 + DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000 + LINK POINTING AT THE FIRST 10532000 + ADDITIONAL WORD OF INFO FOR 10533000 + MONITORED ARRAYS; 10534000 + DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000 + CONCATENATE DEFINE FOR 10536000 + STUFFING THE MONITOR FILE 10537000 + ADDRESS INTO THE FIRST 10538000 + ADDITIONAL INFO WORD FOR 10539000 + ARRAYS AND FUNCTIONS; 10540000 + DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000 + PARTIAL WORD DESIGNATOR [4010542000 + :8] USED TO EXTRACT THE 10543000 + NUMBER OF PARAMETERS FOR A 10544000 + GIVEN PROCEDURE FROM INFO; 10545000 + DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000 + OF PARAMETERS FOR A FUNCTION 10547000 + DESIGNATOR APPEARING IN A MONITOR 10548000 + LIST; 10549000 + LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000 + POINTING AT THE FILE IDENTIFIER IN THE 10551000 + MONITOR DECLARATION; 10552000 + LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000 + TURNS ON THE MONITOR BIT OF THE ELBAT10554000 + WORD IN THE MONITOR LIST AND STORES 10555000 + IT IN ACCUM[0] FOR THE E ROUTINE; 10556000 + LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000 + REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000 + EACH SUBSCRIPT EXPRESSION; 10559000 + LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000 + POINTING THE LAST LOGICAL QUANTITY OF THE 10561000 + MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000 + PROCESSED; 10563000 + LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000 + START:IF ELCLASS!FILEID THEN 10565000 + BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100 + "6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200 + ERR(400); GO EXIT; 10565300 + END 10566000 + COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000 + CHECKER(ELBAT[I]); 10568000 + FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000 + IF CHECK(LEFTPAREN,401) 10570000 + THEN GO TO EXIT; 10571000 + COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000 +MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000 + IF RANGE(BOOID,INTID) 10574000 + THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000 + E; PUTNBUMP(FILEIDENT); 10576000 + GO CHKCOMMA; 10577000 + END; 10578000 + IF RANGE(BOOARRAYID,INTARRAYID) 10579000 + THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000 + SUBSCRIPTED VARIABLES; 10581000 + E; NXTINFOTEMP~NEXTINFO; 10582000 + PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000 + TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000 + ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000 + DO PUTNBUMP(TAKE(INC~INC+1)) 10586000 + UNTIL INC } TESTVARB; 10587000 + IF TABLE(I+1) ! LFTBRKET 10588000 + THEN GO CHKCOMMA; 10589000 + TESTVARB~NODIM+NXTINFOTEMP; 10590000 + STEPIT; 10591000 + STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000 + STEPI ! NONLITNO 10593000 + THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000 + SUBSCRIPTED VARIABLES. EITHER A LITC 10595000 + OR AN OPDC ON A VARIABLE IS ALL THAT 10596000 + IS NEEDED TO CALL THE SUBSCRIPT; 10597000 + SUBSCRIPT~ELBAT[I].ADDRESS; 10598000 + OPLIT~0; 10598500 + IF NOT RANGE( INTRNSICPROCID,INTID) 10599000 + THEN IF CHECK(LITNO,402) 10600000 + THEN GO TO EXIT 10601000 + ELSE COMMENT MARK FOR LITC; 10602000 + OPLIT~1; 10603000 + COMMENT ERROR 402 IS BAD 10604000 + SUBSCRIPT IN MONITOR DECLARATION;10605000 + STEPIT; 10606000 + END 10607000 + ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000 + SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000 + SUBSCRIPT EXPRESSION MUST BE GENERATED10610000 + AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000 + PROGRAM DESCRIPTOR CREATED AND THE 10612000 + ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT10613000 + MUST BE MARKED FOR AN OPDC; 10614000 + JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000 + ADES,L,0); AEXP; EMITO(RTS); 10616000 + JUMPCHKX; 10616500 + OPLIT~0; 10617000 + IF MODE > 0 10618000 + THEN BEGIN COMMENT STUFF F AT THIS 10619000 + POINT IF MODE > 0; 10620000 + STUFFF(SUBSCRIPT);EMITPAIR( 10621000 + SUBSCRIPT,STD); 10622000 + END; 10623000 + END; 10624000 + PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000 + SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000 + NXTINFOTEMP); 10627000 + IF ELCLASS = COMMA 10628000 + THEN GO TO STORESUBS; 10629000 + IF CHECK(RTBRKET,403) 10630000 + THEN GO TO EXIT; 10631000 + COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000 + EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000 + IF NXTINFOTEMP ! TESTVARB 10634000 + THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000 + ELEMENT HAS IMPROPER NUMBER OF 10636000 + SUBSCRIPTS; 10637000 + I~I-1; ERROR(404); GO TO EXIT; 10638000 + END; 10639000 + GO CHKCOMMA; 10640000 + END; 10641000 + IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000 + THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000 + IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000 + THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000 + SWITCH MONITORED AT IMPROPER LEVEL; 10646000 + ERROR(405); GO TO EXIT; 10647000 + END; 10648000 + PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000 + ); 10650000 + PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000 + ELBATWORD); GO CHKCOMMA; 10652000 + END; 10653000 + IF RANGE(BOOPROCID,INTPROCID) 10654000 + THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000 + E ;% 10656000 +IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010 + BEGIN 10656011 + %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012 + %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013 + PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014 + PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015 + END ; 10656016 + PUTNBUMP(NOPAR ~ TAKEFRST & 10656030 + FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR 10657000 + ~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000 + LINK+ELBATWORD.INCR); 10659000 + DO PUTNBUMP(TAKE(INC~INC+1)) 10660000 + UNTIL INC } TESTVARB; 10661000 + GO CHKCOMMA; 10662000 + END; 10663000 + ERROR(406); GO TO EXIT; 10664000 + COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000 + CHKCOMMA:IF STEPI = COMMA 10666000 + THEN GO MARKMONITORED; 10667000 + IF CHECK(RTPAREN,407) 10668000 + THEN GO TO EXIT; 10669000 + COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000 + DECLARATION; 10671000 + IF STEPI = SEMICOLON 10672000 + THEN GO TO EXIT; 10673000 + IF CHECK(COMMA,408) 10674000 + THEN GO TO EXIT; 10675000 + COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000 + DELIMITER; 10677000 + STEPIT; GO TO START; 10678000 + EXIT:; 10679000 + END MERRIMAC; 10680000 +PROCEDURE DMUP; 10681000 + BEGIN COMMENT 15 JULY 1963 10682000 + THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000 + ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000 + ARRAYS. 10685000 + THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000 + THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000 + OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000 + THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000 + A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000 + HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000 + BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000 + COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000 + WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000 + THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000 + FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000 + THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000 + INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000 + ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000 + OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000 + . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000 + DUMP INDICATOR. IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000 + IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000 + FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000 + SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000 + LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000 + POINTING AT THE FILE INDENTIFIER IN THE DUMP 10707000 + DECLARATION; 10708000 + LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000 + ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000 + IS REACHED; 10711000 + DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000 + ADDRESS OF THE MONITOR FILE; 10713000 + LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000 + CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000 + STARTCALL IS REACHED, I MUST BE POINTING 10716000 + AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000 + DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000 + DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000 + DIMENSIONS OF AN ARRAY OR A 10720000 + SUBSCRIPTED VARIABLE APPEARING IN A 10721000 + DUMP LIST; 10722000 + DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000 + COUNTER SETTING AT WHICH CODE IS 10724000 + GENERATED TO EXIT THE ROUTINE EMITTED10725000 + BY DMUP; 10726000 + DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000 + LOCATION OF THE COUNTER 10728000 + ASSOCIATED WITH THIS LABEL IF 10729000 + SPACE HAS BEEN ASSIGNED FOR IT; 10730000 + DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000 + NODIM. IT IS THEN COUNTED DOWN TO 10732000 + ZERO AS SUBSCRIPT CODE IS GENERATED;10733000 + LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000 + NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000 + LABEL SUBSLOOP; COMMENT THE CODE AT SUBSLOOP PASSES 10736000 + SUBSCRIPTS TO PRINTI; 10737000 + ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000 + HOLDS THE ADDRESSES OF ALL LABEL 10739000 + COUNTERS FOR LABELS APPEARING IN 10740000 + THIS DUMP DECLARATION. IT IS 10741000 + NECESSARY TO RETAIN THIS 10742000 + INFORMATION SO THAT CODE MAY BE 10743000 + GENERATED AT THE END OF THE 10744000 + DECLARATION TO INITIALIZE THE 10745000 + COUNTERS; 10746000 + DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000 + VARIABLE USED TO INDEX INTO THE10748000 + LABELCTR ARRAY; 10749000 + DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000 + CONCATENATE DEFINE FOR INSERTING10751000 + THE COUNTER ASSOCIATED WITH THIS10752000 + LABEL INTO THE FIRST ADDITIONAL 10753000 + WORD OF INFO; 10754000 + DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000 + BOUND FOR MONITORED SUBSCRIPTED 10756000 + VARIABLES; 10757000 + DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000 + FORMAT TYPE REFERRED TO IN THE 10759000 + COMMENTS FOR THE MERRIMAC 10760000 + ROUTINE DESCRIBING PRINTI; 10761000 + DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000 + USED TO HOLD L WHILE THE DUMP 10763000 + INDICATOR TEST CODE IS BEING 10764000 + GENERATED; 10765000 + DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000 + LOCATION OF THE CODE THAT MUST BE 10767000 + GENERATED TO MAKE THE TEST TO 10768000 + DETERMINE WHETHER OR NOT DUMPING 10769000 + SHOULD OCCUR; 10770000 + DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000 + CONCATENATE DEFINE USED TO 10772000 + INSERT THE ADDRESS OF THE 10773000 + PROGRAM DESCRIPTOR FOR THE CODE 10774000 + GENERATED FROM THE DUMP 10775000 + DECLARATION; 10776000 + DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000 + ADDRESS OF THE PROGRAM DESCRIPTOR 10778000 + THAT DESCRIBES THE CODE GENERATED 10779000 + BY DMUP; 10780000 + DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000 + ELBAT WORD FOR THE DUMP LIST 10782000 + ELEMENT CURRENTLY BEING OPERATED 10783000 + ON; 10784000 + LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000 + ON PRINTI. IT GENERATES THE CODE TO 10786000 + PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000 + FILE, AND FORMAT TYPE; 10788000 + DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000 + DIMENSION NUMBER THAT IS CURRENTLY 10790000 + BEING WORKED ON; 10791000 + START:IF CHECK(FILEID,409) 10792000 + THEN GO TO EXIT; 10793000 + COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000 + CHECKER(ELBAT[I]); 10795000 + FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000 + IF CHECK(LEFTPAREN,410) 10797000 + THEN GO TO EXIT; 10798000 + COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000 + JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000 + (ADES,L,0); TESTLOC~L; L~L+3; 10801000 + LABELCTRINX~-1; EMITO(NOP); BUMPL; 10802000 + STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000 + [I]); 10804000 + IF RANGE(BOOARRAYID,INTARRAYID) 10805000 + THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000 + SUBSCRIPTED VARIABLES; 10807000 + NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000 + IF STEPI = LFTBRKET 10809000 + THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000 + VARIABLES; 10811000 + STEPIT; AEXP; EMITO(DUP); 10812000 + SUBSCTR~1; 10813000 + IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000 + ).[35:13] ! 0 10815000 + THEN BEGIN COMMENT SUBTRACT OFF THE 10816000 + LOWER BOUND BEFORE INDEXING;10817000 + IF LWRBND.[46:2] = 0 10818000 + THEN EMIT(LWRBND) 10819000 + ELSE EMITV(LWRBND.[35:11]); 10820000 + EMIT(LWRBND.[23:12]); 10821000 + END; 10822000 + IF DIMCTR-SUBSCTR = 0 10823000 + THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000 + VALUE,N; 10825000 + EMITV(ELBATWORD.ADDRESS); 10826000 + PASSN:EMITL(NODIM); 10827000 + IF CHECK(RTBRKET,411) 10828000 + THEN GO TO EXIT; 10829000 + COMMENT ERROR 411 MEANS 10830000 + DUMP LIST ELEMENT HAS WRONG 10831000 + NUMBER OF SUBSCRIPTS; 10832000 + FORMATTYPE~2; GO CALLPRINTI10833000 + END; 10834000 + EMITN(ELBATWORD.ADDRESS); 10835000 + SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000 + EMITL(JUNK); EMITO(SND); 10837000 + SUBSCTR~SUBSCTR+1; 10838000 + IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000 + ).[35:13] ! 0 10840000 + THEN BEGIN COMMENT SUBTRACT OFF THE 10841000 + LOWER BOUND BEFORE INDEXING;10842000 + IF LWRBND.[46:2] = 0 10843000 + THEN EMIT(LWRBND) 10844000 + ELSE EMITV(LWRBND.[35:11]); 10845000 + EMIT(LWRBND.[23:12]); 10846000 + END; 10847000 + IF DIMCTR-SUBSCTR = 0 10848000 + THEN BEGIN COMMENT EMIT COC; 10849000 + EMITO(COC); EMITV(JUNK10850000 + ); EMITO(XCH); 10851000 + GO PASSN; 10852000 + END; 10853000 + EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000 + IF CHECK(COMMA,412) 10855000 + THEN GO TO EXIT 10856000 + ELSE GO TO SUBSLOOP; 10857000 + COMMENT ERROR 412 MEANS DUMP LIST 10858000 + ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000 + ; 10860000 + END; 10861000 + COMMENT THIS CODE HANDLES ARRAYS; 10862000 + IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000 + THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000 + ARRAY DUMP LIST ELEMENT; 10865000 + ERR(413); GO TO EXIT; 10866000 + END; 10867000 + EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000 + FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000 + END; 10870000 + FORMATTYPE~1; 10871000 + IF RANGE(BOOID,INTID) 10872000 + THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000 + EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000 + END; 10875000 + IF CHECK(LABELID,414) 10876000 + THEN GO TO EXIT; 10877000 + COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000 + CODE HANDLES LABELS; 10879000 + PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10880000 + IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000 + THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000 + ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000 + EMITV(LABELCTR[ 10884000 + LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000 + ,ELBATWORD); 10886000 + EMITL(3); IF FALSE THEN 10887000 + CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000 + POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000 + EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000 + FILEIDENT); EMITL(FORMATTYPE); EMITV(GNAT(PRINTI));10891000 + IF STEPI = COMMA 10892000 + THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000 + IF LABELCTRINX = 100 10894000 + THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000 + ABOUT TO OVERFLOW WITH LABEL 10896000 + INFORMATION; 10897000 + ERR(415); GO TO EXIT; 10898000 + END; 10899000 + GO STARTCALL; 10900000 + END; 10901000 + IF CHECK(RTPAREN,416) 10902000 + THEN GO TO EXIT; 10903000 + COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000 + DELIMITER; 10905000 + LEXIT~L; EMITL(0); EMITO(RTS); 10906000 + JUMPCHKX; STEPIT; 10907000 + IF CHECK(LABELID,417) 10908000 + THEN GO TO EXIT; 10909000 + COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000 + PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000 + ELBATWORD); 10912000 + IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100 + PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000 + IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000 + THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000 + ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000 + EMITL(0); 10917000 + DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000 + EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000 + END 10920000 + UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000 + L~L-1; EMITO(STD); STEPIT; 10922000 + IF CHECK(COLON,418) 10923000 + THEN GO TO EXIT; 10924000 + COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000 + FINALL~L; L~TESTLOC; STEPIT; 10926000 + IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500 + AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510 + ! COMMA AND GT1 ! SEMICOLON) 10926520 + THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530 + UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540 + FLAG(465); GO TO EXIT; 10926550 + END; 10926560 + PRIMARY; EMITV(DUMPETEMP); 10927000 + EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000 + L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000 + DUMPR],GIT(ELBAT[I-3])); 10930000 + IF ELCLASS = COMMA 10931000 + THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000 + STEPIT; GO TO START; 10933000 + END; 10934000 + IF CHECK(SEMICOLON,419) 10935000 + THEN; 10936000 + COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000 + EXIT:; 10938000 + END DMUP; 10939000 + COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000 + AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000 + OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000 + SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000 + OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000 + IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000 + A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000 + SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION. FOR 10947000 + SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000 + SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000 + THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000 + JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000 + TO STUFF F INTO A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 + SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 + BOOLEAN PROCEDURE SWITCHGEN(BEFORE); VALUE BEFORE; BOOLEAN BEFORE; 10954000 + BEGIN 10955000 + LABEL LX,EXIT,BEF; 10956000 + REAL K,N,T1,TL; 10957000 + TL ~ L; 10958000 + EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000 + L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000 + EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000 + AND PREPARATION FOR SWITCH-JUMP; 10962000 + GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000 + IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000 + LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000 + THEN BEGIN 10966000 + INFO[0,N] ~ ELBAT[I]; 10967000 + IF N ~ N+1 = 256 10968000 + THEN BEGIN ERR(147); GO TO EXIT END; 10969000 + IF STEPI = COMMA THEN GO TO LX; 10970000 + EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000 + FOR K ~ 0 STEP 1 UNTIL N 10972000 + DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000 + EMIT((GT1~INFO[0,K]).[35:1]); 10974000 + EMIT(GT1) END; 10975000 + SWITCHGEN ~ FALSE END 10976000 + ELSE BEGIN 10977000 + BEF: L ~ BUMPL; N ~ N-1; 10978000 + FOR K ~ 0 STEP 1 UNTIL N 10979000 + DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000 + ADJUST; T1 ~ L; 10981000 + EMITL(GNAT(GT1~INFO[0,K])); 10982000 + GENGO(GT1); 10983000 + INFO[0,K] ~ T1; 10984000 + EMITO(RTS); 10985000 + CONSTANTCLEAN END; 10986000 + I ~ I-1; N ~ N+1; 10987000 + DO BEGIN ADJUST; 10988000 + STEPIT; INFO[0,N] ~ L; 10989000 + IF N ~ N+1 = 256 10990000 + THEN BEGIN ERR(147); GO TO EXIT END; 10991000 + DEXP; EMITO(RTS) END 10992000 + UNTIL ELCLASS ! COMMA; ADJUST; 10993000 + EMITB(BFW,TL+12,L); EMITO(BFC); 10994000 + EMIT(0); EMITO(RTS); N ~ N-1; 10995000 + FOR K ~ 0 STEP 1 UNTIL N 10996000 + DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000 + SWITCHGEN ~ TRUE END; 10998000 + T1 ~ L; 10999000 + L ~ TL+4; 11000000 + EMITL(N+1); 11001000 + L ~ T1; 12000000 + EXIT: END SWITCHGEN; 12001000 + PROCEDURE DBLSTMT; 12002000 + BEGIN 12003000 + REAL S,T; 12004000 + BOOLEAN B ; 12004100 + LABEL L1,L2,L3,L4,EXIT ; 12005000 + S~0; 12006000 + IF STEPI!LEFTPAREN THEN ERR(281) 12007000 + ELSE 12008000 + L1: BEGIN 12009000 + IF STEPI=COMMA THEN 12010000 + BEGIN 12011000 + DPTOG~TRUE; 12012000 + IF STEPI=ADOP THEN STEPIT; 12013000 + EMITNUM(NLO); 12014000 + EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000 + DPTOG~FALSE; 12016000 + STEPIT; 12017000 + GO TO L2; 12018000 + END; 12019000 + IF TABLE(I+1)=COMMA THEN 12020000 + BEGIN 12021000 + IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000 + BEGIN 12023000 + EMITO(ELBAT[I].ADDRESS+1); 12024000 + L4: IF (S~S-1){0 THEN FLAG(282); STEPIT ; 12025000 + GO TO L3; 12026000 + END; 12027000 + IF ELCLASS=ASSIGNOP THEN 12028000 + BEGIN 12029000 + IF S~S-1<0 THEN FLAG(285); T~0; STEPIT ; 12030000 + DO 12031000 + BEGIN 12032000 + IF ELCLASS !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000 + STEPIT; 12034000 + B~ELCLASS=INTID OR ELCLASS=INTARRAYID 12034100 + OR ELCLASS=INTPROCID ; 12034110 + IF ELCLASS{INTID AND ELCLASS}REALID THEN 12035000 + BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000 + ELSE IF ELCLASS{INTPROCID AND ELCLASS}REALPROCID THEN12036100 + IF ELBAT[I].LINK ! PROINFO.LINK THEN FLAG(211) 12036200 + ELSE BEGIN EMITL(514); STEPIT END 12036300 + ELSE IF ELCLASS>INTARRAYID OR ELCLASSBOOID AND ELCLASSBOOPROCID AND ELCLASSBOOARRAYID 12063000 + THEN VARIABLE(FL) 12063100 + ELSE ERRX(386) ; 12063200 + EMITO(IF B THEN ISD ELSE STD) ; 12063300 + END 12063400 + UNTIL T~T+1=2 ; 12063500 + IF ELCLASS!RTPAREN THEN GO L3 ; 12063600 + IF S!0 THEN FLAG(383) ELSE BEGIN STEPIT; GO EXIT END ; 12063610 + END ; 12063700 + IF ELCLASS=FACTOP THEN 12063800 + BEGIN 12063900 + EMITO(MKS); EMITL(8); EMITV(GNAT(POWERALL)); GO L5 ; 12064000 + END ; 12064100 + IF ELCLASS>BOOID AND ELCLASSIDMAX AND ELCLASS{FACTOP 13337000 + THEN FLAG(003); 13338000 + IF ELCLASS!DEFINEDID THEN % CHECK FOR DUP. DECLS. 13339000 + IF LEVELF=LEVEL THEN FLAG(1); % DECL. TWICE IN BLOCK. 13340000 + VONF~P2; 13341000 + IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000 + THEN ADDRSF ~ PJ ~PJ+1 13343000 + ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000 + ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000 + IF TYPE{INTARRAYID AND TYPE}BOOARRAYID 13346000 + THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000 + EMITL(ADDRSF); EMITN(10); 13347500 + END 13347510 + ELSE CHECKDISJOINT(ADDRSF); 13347520 + END; 13348000 + KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000 + END 13350000 + UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J 13351000 + END; 13352000 + PROCEDURE UNHOOK; 13353000 +COMMENT 13354000 + UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000 + FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000 + E WILL WORK AS NORMAL. ;13357000 + BEGIN 13358000 + REAL LINKT,A,LINKP; 13359000 + LABEL L; 13360000 + LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000 + IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK 13362000 + ELSE 13363000 + L: IF A~TAKE(LINKT).LINK=LINKP 13364000 + THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000 + ELSE BEGIN LINKT~A; GO TO L END; 13366000 + END; 13367000 +PROCEDURE MAKEUPACCUM; 13368000 + BEGIN 13369000 + IF PTOG 13370000 + THEN GT1~LEVELF ELSE GT1~LEVEL; 13371000 + ACCUM[0]~ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000 + & REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11]13373000 + ) 13374000 + END; 13375000 +PROCEDURE ARRAE; 13376000 +COMMENT 13377000 + ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000 + IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000 + STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000 + MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000 + EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000 + ARRAY A[0:10], 13383000 + MKS (THIS MARKS STACK TO CUT BACK AFTER COM)13384000 + DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000 + THE ADDRESS OF A) 13386000 + LITC 11 (SIZE OF ARRAY) 13387000 + LITC 1 (NUMBER OF DIMENSIONS) 13388000 + LITC 1 (NUMBER OF ARRAYS) 13389000 + LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000 + NON OWN ARRAYS) 13391000 + COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000 + DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000 + STACK) 13394000 + OWN ARRAY B,C[0:X,-1:10], 13395000 + MKS 13396000 + DESC B 13397000 + DESC C 13398000 + LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000 + OPDC X 13400000 + LITC JUNK (JUNK CELL) 13401000 + ISN (INTEGERIZE UPPER BOUND) 13402000 + LITC 1 (COMPUTE SIZE 13403000 + ADD OF DIMENSION 13404000 + LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000 + CHS 13406000 + LITC 12 (SIZE SECOND DIMENSION) 13407000 + LITC 2 (NUMBER DIMENSIONS) 13408000 + LITC 2 (NUMBER ARRAYS) 13409000 + LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000 + COM 13411000 + DESC XITR 13412000 + SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000 + MKS 13414000 + DESC D 13415000 + DESC E 13416000 + DESC F 13417000 + OPDC X 13418000 + LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000 + ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000 + DUP (MUST PASS LOWER BOUND FOR OWN) 13421000 + OPDC Y (INTEGERIZE 13422000 + LITC JUNK UPPER 13423000 + ISN BOUND) 13424000 + XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000 + SUB UPPER 13426000 + LITC 1 -LOWER 13427000 + ADD +1) 13428000 + OPDC M (COMPUTE LOWER BOUND 13429000 + OPDC N SECOND DIM) 13430000 + ADD 13431000 + LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000 + ISN (INTEGERIZE) 13433000 + DUP (PASS LOWER BOUND FOR OWN) 13434000 + OPDC T 13435000 + MUL V 13436000 + LITC JUNK (INTEGERIZE 13437000 + ISN UPPER) 13438000 + XCH (COMPUTE 13439000 + SUB SIZE 13440000 + LITC 1 13441000 + ADD ) 13442000 + LITC 2 (NUMBER DIMENSIONS) 13443000 + LITC 3 (NUMBER ARRAYS) 13444000 + LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000 + COM 13446000 + DESC XITR ; 13447000 + BEGIN 13448000 + REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000 + BOOLEAN LLITOG,ULITOG,LONGDIM; 13450000 +REAL ADDCON; 13451000 + LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000 + ARRAYFLAG ~ TRUE; 13452100 + TYPEV~REALARRAYID; 13453000 + IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000 + ELSE 13455000 + IF T1=OWNV THEN 13456000 + BEGIN 13457000 + P2~TRUE;IF SPECTOG THEN 13458000 + FLAG(013)13459000 + END 13460000 + ELSE 13461000 + IF T1= SAVEV THEN 13462000 + BEGIN 13463000 + P3~TRUE; 13464000 + IF SPECTOG THEN 13465000 + FLAG(014) 13466000 + END 13467000 + ELSE IF T1=LONGV THEN 13467100 + BEGIN 13467200 + P5~TRUE; 13467300 + END 13467400 + ELSE 13468000 + TYPEV ~REALID+T1; 13469000 + IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000 + ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000 +BETA1: 13472000 + IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ~0;SAVEDIM~1; 13473000 +TWO:IF STEPI=ADOP THEN 13474000 + BEGIN 13475000 + T1~ELBAT[I].ADDRESS; I~I+1 13476000 + END 13477000 + ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000 + ARPROGS~L; 13479000 + IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000 + BEGIN 13481000 + LLITOG~TRUE; 13482000 + IF T3~ELBAT[I].ADDRESS!0 13483000 + THEN 13484000 + BEGIN 13485000 + EMITL(T3); 13486000 + IF T1=SUBOP THEN 13487000 + BEGIN 13488000 + EMITO(CHS); 13489000 + ADDCON~ADDC 13490000 + END ELSE 13491000 + ADDCON~SUBC 13492000 + END; 13493000 + T2~T3|4+ADDCON 13494000 + END 13495000 + ELSE 13496000 + BEGIN 13497000 + LLITOG~FALSE; 13498000 + IF T1!0 THEN I~I-1; 13499000 + T2:=GETSPACE(P2,-1);%TEMP. 13500000 + AEXP;EMITSTORE(T2,ISN); 13501000 + T2~T2|4+SUBC+2; 13502000 + IF ELCLASS!COLON THEN 13503000 + FLAG(017);I~I-1 13504000 + END; 13505000 + IF P2 THEN 13506000 + BEGIN 13507000 + IF LLITOG AND T3=0 THEN EMITL(0);13508000 + ARPROGS~L;EMITO(DUP); 13509000 + END; 13510000 + IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000 + BEGIN 13512000 + IF T~TABLE(I~I+1)=COMMA OR 13513000 + T=RTBRKET 13514000 + THEN 13515000 + BEGIN 13516000 + EMITL(T4~ELBAT[I-1].ADDRESS); 13517000 + ULITOG~TRUE;GO TO CSZ 13518000 + END 13519000 + ELSE 13520000 + I~I-1 13521000 + END; 13522000 + ULITOG~FALSE; 13523000 + AEXP; 13524000 + EMITL(JUNK); 13525000 + EMITO(ISN); 13526000 +CSZ: 13527000 + LONGDIM:= P5 AND TABLE(I)=RTBRKET; % LAST DIM OF LONG ARRAY 13527100 + IF LLITOG AND ULITOG THEN 13527200 + BEGIN 13528000 + L~ARPROGS; 13529000 + T~IF ADDCON=ADDC THEN 13529500 + T4+T3+1 ELSE T4-T3+1; 13529600 + IF T{0 THEN FLAG(59); 13529700 + IF NOT LONGDIM THEN 13529800 + BEGIN 13529900 + IF T>1023 THEN FLAG(59); 13530000 + EMITL(T); 13530100 + END 13530200 + ELSE 13530300 + BEGIN 13530400 + % FOR A LONG ARRAY, DOUBLE THE SIZE OF 13530500 + % THE LAST DIMENSION AND SPLIT IT INTO 13530600 + % LONGROWSZ-WORD ROWS. 13530700 + T~(2|T+LONGROWSZ-1) DIV LONGROWSZ; 13530800 + EMITL(T); % # ROWS 13530900 + EMITL(LONGROWSZ); % FINAL ROW SIZE 13531000 + IF T>1023 THEN FLAG(59); 13531100 + IF TMAXSAVE 13533000 + THEN MAXSAVE~SAVEDIM 13534000 + END 13535000 + ELSE 13536000 + IF T>MAXROW THEN MAXROW~T; 13537000 + END 13538000 + ELSE 13539000 + BEGIN IF NOT(LLITOG AND T3=0) 13540000 + OR P2 13541000 + THEN 13542000 + BEGIN 13543000 + EMITO(XCH);EMITO(SUB) 13544000 + END;EMITL(1);EMITO(ADD); 13545000 + IF LONGDIM THEN 13545100 + BEGIN 13545200 + EMITO(DUP); 13545300 + EMITO(ADD); % DOUBLE THE SIZE 13545400 + EMITL(LONGROWSZ-1); 13545500 + EMITO(ADD); % ROUND UP TO LONGROWSZ 13545550 + EMITL(LONGROWSZ); 13545600 + EMITO(IDV); % # ROWS 13545650 + EMITL(LONGROWSZ); % FINAL ROW SIZE 13545700 + END; 13545800 + END; 13546000 +SLB: % IF LAST DIM OF LONG ARRAY, SET BIT 22 IN INFO DIMENSION WORD 13547000 + PUTNBUMP(T2 & REAL(LONGDIM)[22:47:1]); 13547100 + LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547200 + ELSE 13548000 + IF T!RTBRKET THEN FLAG(018); 13549000 + IF NOT SPECTOG THEN 13550000 + BEGIN 13551000 + COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400 + NOOFARRAYS~NOOFARRAYS + GTA1[0]; 13551500 + EMITL(LBJ+REAL(LONGDIM));EMITL(GTA1[0]); 13552000 +EMITL(REAL(P3) +2|REAL(P2)); 13553000 + EMITV(5) 13554000 + END; 13555000 + PUT(LBJ,SAVEINFO2-1); 13556000 + DO BEGIN 13557000 + T~TAKE(SAVEINFO); 13558000 + K~T.INCR; 13559000 + T.INCR~SAVEINFO2-SAVEINFO-1; 13560000 + PUT(T,SAVEINFO); 13561000 + END 13562000 + UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000 + IF STEPI!COMMA THEN GO TO START; 13564000 + IF NOT SPECTOG THEN EMITO(MKS); 13565000 + SAVEINFO~NEXTINFO; 13566000 + I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO~NEXTINFO+1;GO TO BETA1; 13567000 +BETA2: 13568000 + IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000 + THEN 13570000 + BEGIN 13571000 + IF ELCLASS~TABLE(I-1)=LITNO 13572000 + THEN 13573000 + BEGIN 13574000 + T3~ELBAT[I-1].ADDRESS; 13575000 + IF T1= SUBOP THEN 13576000 + ADDCON ~ADDC 13577000 + ELSE 13578000 + ADDCON ~SUBC; 13579000 + T2~T3|4+ADDCON; GO TO SLB; 13580000 + END; 13581000 + IF ELCLASS=FACTOP THEN 13582000 + BEGIN 13583000 + T2~-SUBC; GO TO SLB 13584000 + END 13585000 + END; 13586000 + FLAG(019); 13587000 +START: ARRAYFLAG ~ FALSE END; 13588000 + PROCEDURE PUTNBUMP(X); 13589000 + VALUE X; 13590000 + REAL X; 13591000 + BEGIN 13592000 + INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000 + NEXTINFO~NEXTINFO+1 13594000 + END ; 13595000 + PROCEDURE JUMPCHKX; 13596000 +COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000 + WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000 + ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000 + IS THE FIRST EXECUTABLE CODE; 13600000 +IF NOT SPECTOG THEN 13601000 +BEGIN 13602000 + IF AJUMP 13603000 + THEN 13604000 + BEGIN ADJUST; 13605000 + EMITB(BFW,SAVEL,L) 13606000 + END ELSE 13607000 + IF FIRSTX=4095 13608000 + THEN 13609000 + BEGIN 13610000 + ADJUST; 13611000 + FIRSTX~L; 13612000 + END; 13613000 + AJUMP~FALSE 13614000 +END; 13615000 + PROCEDURE JUMPCHKNX; 13616000 +COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000 + EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000 + NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED 13619000 + AND SAVED FOR A LATER BRANCH; 13620000 +IF NOT SPECTOG THEN 13621000 +BEGIN 13622000 + IF FIRSTX!4095 13623000 + THEN 13624000 + BEGIN 13625000 + IF NOT AJUMP 13626000 + THEN 13627000 + SAVEL~BUMPL; 13628000 + AJUMP~TRUE 13629000 + END;ADJUST 13630000 +END; 13631000 + PROCEDURE SEGMENTSTART; 13632000 +IF LISTOG THEN 13633000 + IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 + ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 +PROCEDURE SEGMENT(SIZE,NO,NOO); 13657000 + VALUE SIZE,NO,NOO; 13658000 + REAL SIZE,NO,NOO; 13659000 +BEGIN 13660000 + STREAM PROCEDURE MOVE2(S,D); BEGIN SI~S; DI~D; DS~2 WDS; END; 13674000 + 13675000 + 13676000 + INTEGER T,NSEGS,J,CNTR; 13677000 + DEFINE POINTER = NO.[38:3], NO.[41:7]#; 13677100 + NSEGS~(ABS(SIZE)+29) DIV 30; 13678000 + IF DA DIV CHUNKSEGSIZEMAX THEN SEGSIZEMAX~SIZE; 13682000 + AKKUM~AKKUM+SIZE; 13683000 + IF SAVEPRTOG THEN AUXMEMREQ := AUXMEMREQ+16|(SIZE. [38:6]+1); 13683010 + IF LISTOG THEN 13684000 + IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) 13684100 + ELSE WRITE(LINE[DBL],PRINTSIZE,NO,SIZE,NOO); 13684200 + 13685000 + 13686000 + 13687000 + 13688000 +CNTR~0; 13689000 + DO BEGIN 13690000 + FOR J~0 STEP 2 WHILE J<30 AND CNTRMAXSTACK THEN MAXSTACK~STACKCTR; 13748000 + CONSTANTCLEAN; 13749000 + IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 13750000 + THEN 13751000 + BEGIN ADJUST;LS~L; 13752000 + IF BT OR GOTSTORAGE 13753000 + THEN 13754000 + BEGIN 13755000 +% 13755500 + EMITV(BLOCKCTR); 13756000 + EMITL(1); 13757000 + EMITO(ADD); 13758000 + IF GOTSTORAGE OR FAULTOG.[46:1] 13759000 + THEN 13760000 + EMITSTORE(BLOCKCTR,SND) 13761000 + END 13762000 +% 13762500 + ELSE EMITL(0); 13763000 + K~K+NCII; 13764000 + WHILE K~K-1}0 13765000 + DO EMITL(0); 13766000 + PURGE(STOPPER); 13767000 + IF FAULTLEVEL{LEVEL THEN 13767100 + BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200 + EMITPAIR(0,MDS); EMITO(CHS); 13767300 + END OF THIS PART OF ERROR KLUDGE; 13767400 + EMIT(0); % DC & DISK 13767500 + BUMPL; 13768000 + 13768100 + EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000 + CONSTANTCLEAN 13770000 + END ELSE PURGE(STOPPER); 13771000 + Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000 + END HTTEOAP; 13773000 +PROCEDURE FORMATGEN; 13774000 + BEGIN 13775000 + INTEGER PRT;LABEL L; 13776000 + BOOLEAN TB2; 13777000 + ARRAY TEDOC[0:7,0:127]; 13777500 + MOVECODE(TEDOC,EDOC); 13777600 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700 + TB2~GTA1[J-1]=SWITCHV; 13778000 + GT5~SGNO; 13779000 +L: GT1~(2|SGAVL-1)&2[4:46:2]; STOPENTRY~TRUE;SEGMENTSTART; 13780000 + SGNO~SGAVL; 13781000 + 13782000 + F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000 + Z~PROGDESCBLDR(LDES,0,PRT); 13784000 + IF TB2 THEN 13785000 + BEGIN 13786000 + ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(36); 13787000 + PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000 + RR4~NEXTINFO;PUTNBUMP(0); 13789000 + DO 13790000 + BEGIN PUTNBUMP(F);IF STEPI!LEFTPAREN THEN FLAG(37);ELCLASS~"(";13791000 + TB1~FORMATPHRASE; 13792000 + END 13793000 + UNTIL ELCLASS!","; 13794000 + RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000 + DO 13796000 + WHIPOUT(TAKE(RR4~RR4+1)) 13797000 + UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000 + 13799000 + END ELSE 13800000 + BEGIN 13801000 + I~I-1; 13802000 + DO 13803000 + BEGIN 13804000 + STOPDEFINE~TRUE;STEPIT ; 13805000 + ENTRY(FRMTID);IF ELCLASS!LEFTPAREN THEN FLAG(32);ELCLASS~"("; 13806000 + PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000 + TB1~FORMATPHRASE; 13808000 + END 13809000 + UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000 + 13811000 + 13812000 + END; 13813000 + SEGMENT(-F,SGNO,GT5);SGAVL~SGAVL+1; 13814000 + IF TB1 AND ELCLASS="," THEN BEGIN I~I+1;GO TO L END; 13815000 + IF ELCLASS!";" THEN ELBAT[I]~0 ELSE ELBAT[I].CLASS~SEMICOLON; 13816000 + STOPGSP~STOPENTRY~FALSE; 13817000 + SGNO~GT5; 13818000 + MOVECODE(TEDOC,EDOC); 13818500 + BUILDLINE ~ BUILDLINE.[46:1] ; 13818600 + END FORMATGEN; 13819000 +PROCEDURE CHECKBOUNDLVL ; 13819100 + COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200 + DECLARED AT SAME LEVEL; 13819300 + IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400 + THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410 + COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 + ARRAY DECLARATION; 13819600 + PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR 13900000 + THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 13901000 + PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 13902000 + INTRINSIC, WHO WILL BUILD AIT ENTRIES; 13903000 + BEGIN INTEGER TP; REAL A; 13903100 + J~0; JUMPCHKX; EMITO(MKS); 13904000 + IF FAULTLEVEL>LEVEL THEN FAULTLEVEL~LEVEL; 13905000 + IF MODE=0 THEN FAULTLEVEL~1; 13906000 + DO BEGIN IF J>0 THEN STEPIT; J~J+1; 13907000 + SCATTERELBAT; A~ACCUM[1]; 13908000 + IF TP~REAL((Q="6INTOV")&(Q="6EXPOV")[46:47:1]&(Q="5INDEX" 13909000 + )[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1])=0 13910000 + THEN ERR (61) ELSE 13911000 + BEGIN IF TABLE(I+1)=ASSIGNOP THEN 13911100 + BEGIN STEPIT; COMMENT OVER THE ~; 13911200 + IF GT1~STEPI>IDMAX AND GT10 14229000 + THEN 14230000 + IF TB1 THEN GT1~GT2 ELSE 14231000 + GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000 + EMITSTORE(GT1,STD) 14233000 + END; 14234000 + END 14235000 + ELSE 14236000 + BEGIN 14237000 + IF ELCLASS!FORWARDV THEN FLAG(33); 14238000 + PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000 + PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000 + IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000 + STEPIT; 14242000 + FORMALF~TRUE 14243000 + END; 14244000 + PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]>1[16:37:11],LASTINFO); 14245000 + IF TB1 THEN 14246000 + BEGIN 14247000 + NEXTINFO~GT5; 14248000 + LASTINFO~GT4; 14249000 + END; 14250000 + START: 14251000 + END SWITCHDEC; 14252000 +GO TO START; 14253000 + DEFINEDEC: 14254000 + BEGIN LABEL START; 14254050 + REAL J,K,DINFO,LINKA,LINKB,T; 14254100 + STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000 + DO 14256000 + BEGIN 14257000 + STOPDEFINE:=TRUE; 14258000 + STEPIT; MOVE(9,ACCUM[1],GTA1); 14259000 + IF T:=ELBAT[NXTELBT-1].LINK!0 THEN % DEFINED B4 IN PROGRAM. 14259002 + IF T}NINFOO THEN FLAG(1); % DEFINED B4 IN THIS BLOCK. 14259004 + K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID); 14259010 + GTA1[0]~J+"100000"; J~0; 14259015 + DINFO ~ LASTINFO; 14259017 + IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020 + BEGIN 14259030 + IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040 + DO BEGIN STOPDEFINE~TRUE; 14259060 + STEPIT; 14259070 + IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075 + MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080 + DEFINEPARAM(DINFO+1, J); 14259085 + ACCUM[0] ~ 0; 14259090 + ACCUM[0].CLASS ~ DEFINEDID; 14259092 + LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094 + E; 14259096 + IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098 + PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100 + STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102 + STOPDEFINE ~ TRUE; 14259104 + END UNTIL STEPI!COMMA; 14259110 + IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120 + STOPDEFINE~TRUE; 14259130 + STEPIT; 14259140 + PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150 + PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155 + END; 14259160 + IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000 + THEN 14261000 + BEGIN 14262000 + FLAG(45); 14263000 + COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100 + I~I-1; 14264000 + END; 14265000 + MACROID~TRUE; 14265900 + LASTINFO ~ DINFO; 14265930 + PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950 + DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000 + MACROID~FALSE; 14266100 + END 14267000 + UNTIL STEPI!COMMA; 14268000 + START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000 +PROCEDUREDEC: 14270000 + BEGIN 14271000 + LABEL START,START1; 14272000 + LABEL START2, DOITANYWAY; 14273000 + COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000 + IF NOT SPECTOG THEN FUNCTOG~FALSE; 14275000 + FWDTOG := NEXTSAVE := FALSE; 14276000 + IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500 + MAXSTACKO~ MAXSTACK; 14277000 + IF G~GTA1[J~J-1]=STREAMV 14278000 + THEN 14279000 + BEGIN STREAMTOG~TRUE; 14280000 + IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000 + ELSE 14282000 + BEGIN 14283000 + IF TYPEV~PROCID +G>INTSTRPROCID OR 14284000 + TYPEV INTPROCID THEN FLAG(005) 14295000 + ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100 + IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000 + END; 14297000 + IF SPECTOG 14298000 + THEN 14299000 + BEGIN 14300000 + ENTRY(TYPEV); GO TO START2 14301000 + END; 14302000 + MODE~MODE+1; 14303000 + LO~PROINFO; 14304000 + SCATTERELBAT; 14305000 +COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000 + IF LEVELF=LEVEL 14307000 + THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000 + BEGIN 14309000 +IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000 + IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100 + FWDTOG~TRUE; 14312000 + PROAD~ADDRSF; 14313000 + PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT 14314000 + END 14316000 + ELSE 14317000 + DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000 + ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000 + PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000 + P2~STOPENTRY~FALSE 14321000 + END; 14322000 + IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000 + ELSE FLAG(039); 14323100 + PJ ~ 0; 14323200 + IF STREAMTOG THEN STREAMWORDS; 14324000 + IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000 + IF ELCLASS!LEFTPAREN THEN FLAG(007); 14326000 +COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000 + FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000 + RR1~NEXTINFO; 14329000 + LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000 + PUTNBUMP(0); 14331000 + PTOG~TRUE; I~I+1; 14332000 + ENTRY(SECRET); 14333000 +IF FWDTOG THEN BEGIN IF GT1 ~ TAKE(MARK).[40:8] ! PJ THEN% 14333100 + FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200 + COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300 + PUT(PJ,MARK); 14334000 + P~PJ; 14335000 + IF ELCLASS!RTPAREN 14336000 + THEN FLAG(008); 14337000 + IF STEPI!SEMICOLON 14338000 + THEN FLAG(009); 14339000 +COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000 + IF STEPI=VALUEV 14341000 + THEN 14342000 + BEGIN 14343000 + DO 14344000 + IF STEPI!SECRET 14345000 + THEN FLAG(010) 14346000 + ELSE 14347000 + BEGIN 14348000 + IF G~ELBAT[I].ADDRESS=0 OR G>PJ 14349000 + THEN 14350000 + FLAG(010); 14351000 + G~TAKE(ELBAT[I]); 14352000 + PUT(G&1[10:47:1],ELBAT[I]) 14353000 + END 14354000 + UNTIL 14355000 + STEPI!COMMA; 14356000 + IF ELCLASS!SEMICOLON 14357000 + THEN FLAG(011) 14358000 + ELSE STEPIT 14359000 + END;I~I-1; 14360000 + IF STREAMTOG 14361000 + THEN 14362000 + BEGIN 14363000 + BUP~PJ; SPECTOG~TRUE;GO TO START1 14364000 + END 14365000 + ELSE 14366000 + BEGIN 14367000 + SPECTOG~TRUE; 14368000 + BUP~0; 14369000 + IF ELCLASS!DECLARATORS 14370000 + THEN FLAG(012) 14371000 + END; 14372000 +START:PTOG~FALSE;LASTINFO~LASTINFOT;NEXTINFO~IF FWDTOG THEN RR1 ELSE 14373000 + MARK+PJ+1; 14374000 +START1:PINFOO~NEXTINFO; 14375000 +START2: END; 14376000 + IF SPECTOG OR STREAMTOG 14377000 + THEN 14378000 + GO TO START; 14379000 +COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 14380000 + PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS; 14381000 +HF: 14382000 + BEGIN 14383000 + LABEL START,STOP; 14384000 + IF STREAMTOG 14385000 + THEN BEGIN 14386000 + JUMPCHKNX;G~PROGDESCBLDR(CHAR,L,PROAD);PJ~P; 14387000 + PTOG~FALSE; 14388000 + IF FUNCTOG 14389000 + THEN 14390000 + PUT((Z~TAKE(PROINFO))&LOCLID[2:41:7]&(PJ~PJ+1)[16:37:11] 14391000 + , PROINFO); 14392000 + IF STEPI=BEGINV 14393000 + THEN 14394000 + BEGIN 14395000 + WHILE STEPI=DECLARATORS OR ELCLASS=LOCALV 14396000 + DO 14397000 + BEGIN 14398000 + IF ELBAT[I].ADDRESS=LABELV 14399000 + THEN 14400000 + BEGIN 14401000 + STOPDEFINE~STOPGSP~STOPENTRY~TRUE; 14402000 + DO BEGIN STOPDEFINE~TRUE;STEPIT;ENTRY(STLABID);PUTNBUMP(0) END UNTIL14403000 + ELCLASS!COMMA;STOPGSP~STOPENTRY~FALSE 14404000 + END 14405000 + ELSE 14406000 + BEGIN 14407000 + I~I+1; 14408000 + ENTRY(LOCLID) 14409000 + END 14410000 + END; 14411000 + COMPOUNDTAIL 14412000 + END 14413000 + ELSE 14414000 + STREAMSTMT ; 14415000 + COMMENT THE FOLLOWING BLOCK CONSTITUTES THE STREAM PROCEDURE PURGE; 14416000 + BEGIN 14417000 + REAL NLOC,NLAB; 14418000 + DEFINE SES=18#,SED=6#,TRW=5#; 14419000 + DEFINE RSA = 43 #; 14419100 + DEFINE LOC=[36:12]#,LASTGT=[24:12]#; 14420000 + J~ LASTINFO; 14421000 + NLOC~NLAB~0; 14422000 + DO 14423000 + BEGIN 14424000 + IF(GT1~TAKE(J)).CLASS=LOCLID THEN 14425000 + BEGIN 14426000 + IF BOOLEAN(GT1.FORMAL) THEN 14427000 + BEGIN 14428000 + IF GT1<0 THEN 14429000 + PUT(TAKE(GT2~MARK+P-GT1.ADDRESS+1)&FILEID[2:41:7] 14430000 + ,GT2); 14431000 + END 14432000 + ELSE NLOC~NLOC+1; 14433000 + END 14434000 + ELSE 14435000 + BEGIN 14436000 + IF GT1.ADDRESS!0 THEN NLAB~NLAB+1; 14437000 + IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000 + BEGIN 14439000 + MOVE(9,INFO[0,J],ACCUM[0]); 14440000 + Q~ACCUM[1]; 14441000 + FLAG(267); 14442000 + ERRORTOG~TRUE; 14443000 + END; 14444000 + END; 14445000 + G~(GT2~TAKE(J+1)).PURPT; 14446000 + IF GT1.[2:8] ! STLABID|2+1 THEN 14447000 + STACKHEAD[(0>2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000 + END UNTIL J~J-G{1; 14449000 + PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000 + [13:37:11],MARK); 14451000 + GT1~ L; L ~ FILETHING ; 14451100 + WHILE L ! 4095 DO 14451200 + BEGIN FILETHING ~ GET(L); 14451300 + EMITC(PJ+1,RSA); 14451400 + L ~ FILETHING; 14451500 + END; 14451600 + L ~ GT1; FILETHING ~ 4095 ; 14451700 + IF FUNCTOG THEN 14452000 + BEGIN 14453000 + EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000 + EMITC(PJ+2,SED); 14455000 + EMITC(1,TRW); 14456000 + PUT(Z, PROINFO); 14457000 + END; 14458000 + EMIT(0); 14459000 + STREAMWORDS; 14460000 + STREAMTOG~FALSE; 14461000 + END; 14462000 + LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000 + END 14464000 + ELSE 14465000 + BEGIN 14466000 + IF STEPI=FORWARDV 14467000 + THEN 14468000 + BEGIN 14469000 + PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000 + PURGE(PINFOO); 14471000 + STEPIT 14472000 + END 14473000 + ELSE 14474000 + BEGIN 14475000 + PROADO~PROAD; 14476000 + TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000 +% 14478000 + COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010 + COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020 + IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030 + MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040 + IF ELCLASS = BEGINV THEN 14479000 + IF TABLE(I+1) = DECLARATORS THEN 14480000 + BEGIN 14481000 + BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000 + ; PURGE(PINFOO); 14483000 + GO TO STOP END; 14484000 + BEGIN 14485000 + JUMPCHKNX; 14486000 + RELAD~L ; 14487000 + IF NEXTSAVE THEN FLAG(052); 14487010 + STMT; 14488000 + HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000 + END; 14490000 + STOP: 14491000 + SUBLEVEL~TSUBLEVEL; 14492000 + STACKCTR~STACKCTRO; 14493000 + END; 14494000 + END; 14495000 + PROINFO~LO; 14496000 + IF JUMPCTR=LEVEL 14497000 + THEN 14498000 + JUMPCTR~LEVEL-1; 14499000 + LEVEL~LEVEL-1; 14500000 + MODE~MODE-1; 14501000 + MAXSTACK~MAXSTACKO; 14502000 +START:END; 14503000 + GO TO START; 14504000 +CALLSTATEMENT: 14505000 + JUMPCHKX; 14506000 + IF SPECTOG THEN BEGIN 14507000 + FLAG(12);GO TO HF 14508000 + END; 14509000 + BEGINCTR ~ BEGINCTR-1; 14510000 + IF ERRORTOG 14511000 + THEN COMPOUNDTAIL 14512000 + ELSE 14513000 + BEGIN 14514000 + STMT; 14515000 + IF ELCLASS~TABLE(I+1)=DECLARATORS 14516000 + THEN 14517000 + BEGIN 14518000 + ELBAT[I].CLASS~SEMICOLON; 14519000 + BEGINCTR~BEGINCTR+1; 14520000 + GO TO START 14521000 + END 14522000 + ELSE 14523000 + COMPOUNDTAIL 14524000 + END; 14525000 +BEGIN 14526000 + RELAD~FIRSTX; 14534000 + IF STACKCTR>MAXSTACK 14535000 + THEN MAXSTACK~STACKCTR; 14536000 + IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000 + THEN 14538000 + IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000 + THEN 14540000 + BEGIN 14541000 + EMITV(BLOCKCTR); 14542000 + EMITL(1); 14543000 + EMITO(SUB); 14544000 + EMITSTORE(BLOCKCTR,STD); 14545000 + GOTSTORAGE~TRUE 14546000 + END 14547000 + ELSE 14548000 + BEGIN 14549000 + EMITL(10); 14550000 + EMITO(COM) 14551000 + END; 14552000 + FUNCTOG~FUNCTOGO; 14553000 + IF SOP 14554000 + THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000 + ELSE 14556000 + BEGIN 14557000 + IF LEVEL = 1 THEN EMITO(XIT) 14557500 + ELSE BEGIN 14557600 + EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000 + EMITO(BFW); 14558500 + END; 14558600 + CONSTANTCLEAN; 14559000 + IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000 + THEN 14561000 + BEGIN 14562000 + ADJUST; RELAD~L; 14563000 + IF GOTSTORAGE THEN BEGIN EMITV(BLOCKCTR);EMITL(1); 14564000 + EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000 + END; 14566000 +IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000 +=0; 14568000 + PURGE(NINFOO); 14569000 + IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100 + BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200 + BUMPL; 14570000 + EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000 + CONSTANTCLEAN 14572000 + END ELSE PURGE(NINFOO); 14573000 + IF RELAD =4095 THEN RELAD~0; 14574000 + NEXTTEXT ~ NTEXTO; 14574500 + G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000 + END; 14576000 + ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100 + SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000 + 14578000 + 14579000 + 14580000 + 14581000 + 14582000 + 14583000 + 14584000 + 14585000 + 14586000 + 14587000 + 14588000 + 14589000 + 14590000 + 14591000 + 14592000 + ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000 + MOVECODE(TENIL,ENIL); 14594000 + MOVECODE(TEDOC,EDOC);L~LOLD; 14595000 + DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000 + IF NOT SOP AND LEVEL ! 1 14597000 + THEN 14598000 + BEGIN 14599000 + ADJUST; 14600000 + G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000 + IF ELCLASS = FACTOP THEN 14601100 + BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200 + 14601300 + 14601400 + 14601500 + 14601600 + 14601610 + STEPIT; 14601700 + END; 14601800 + END; 14602000 + IF JUMPCTR=LEVEL THEN JUMPCTR~LEVEL-1; 14603000 + LEVEL~LEVEL-1; 14604000 + FUNCTOG~FUNCTOGO; 14605000 + AJUMP~AJUMPO; 14606000 + PRTI~PRTIO; 14607000 + FIRSTX~FIRSTXO; 14608000 + SAVEL~SAVELO; 14609000 + STACKCTR~STACKCTRO; 14610000 + SAVEPRTOG := SAVEPRTOGO; 14610100 + NCII~NCIIO; FAULTOG~FAULTOGO AND(FALSE&FAULTLEVEL 7 15035000 + THEN 7 15036000 + ELSE SIZEALPHA)); EMITB(BFW,LTEMP,L); 15037000 + END PASSALPHA; 15038000 + COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 15039000 + OF SIMPLE VARIABLES: 15040000 + 1. V ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15041000 + 2. V ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15042000 + 3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15043000 + 4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15044000 + 5. V.[S:L] ,ALL V. 15045000 + 6. V ,ALL V. 15046000 + CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 15047000 + 1. VN,EXP,M*,XCH,~. 15048000 + 2. EXP,M*,VL,~. 15049000 + 3. VN,DUP,COC,EXP,T,M*,XCH,~. 15050000 + 4. VV,EXP,T,M*,VL,~. 15051000 + 5. ZEROL,VV,T . 15052000 + 6. VV . 15053000 + WHERE VN = DESC V 15054000 + EXP= ARITH. OR BOOLEAN EXPRESSION,AS REQUIRED. 15055000 + M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000 + VL = LITC V 15057000 + VV = OPDC V 15058000 + ~ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000 + T = BIT TRANSFER CODE(DIA,DIB,TRB). 15060000 + ZEROL = LITC 0 15061000 + DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000 + OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 15063000 + THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 15064000 + GLOBAL FASHION. 15065000 + THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 15066000 + WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 15067000 + SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 15068000 + ; 15069000 + PROCEDURE VARIABLE(P1); REAL P1; 15070000 + BEGIN 15071000 + REAL TALL, COMMENT ELBAT WORD FOR VARIABLE; 15072000 + T1 , COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 15073000 + T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000 + J ; COMMENT SUBSCRIPT COUNTER ; 15075000 + REAL X, Z; 15075500 + LABEL EXIT; 15076000 + TALL~ELBAT[I] ; 15077000 + IF ELCLASS { INTPROCID THEN 15078000 + BEGIN 15079000 + IF TALL.LINK !PROINFO.LINK THEN 15080000 + BEGIN ERR(211); GO TO EXIT END; 15081000 +COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000 + TALL ~ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000 + END 15084000 + ELSE CHECKER(TALL); 15085000 + IF TALL.CLASS { INTID THEN 15086000 + BEGIN 15087000 + LABEL L1, EXIT ; 15088000 + DEFINE FORMALNAME=[9:2]=2 #; 15089000 + J ~ ELCLASS ; 15089010 + IF STEPI= ASSIGNOP THEN 15090000 + BEGIN STACKCT ~ 1; %A 15091000 + L1: IF TALL.FORMALNAME THEN 15092000 + BEGIN 15093000 + EMITN(TALL.ADDRESS); 15094000 + IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END; 15095000 + END 15096000 + ELSE IF T1!0 THEN EMITV(TALL.ADDRESS) 15097000 + ; STACKCT ~ REAL(T1!0); STEPIT; %A 15098000 + IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000 + EMITD(48-T2 ,T1 ,T2); 15100000 + IF TALL<0 THEN CLSMPMN(TALL,J}BOOPROCID AND J{INTPROCID) ; 15101000 + STACKCT ~ 0; %A 15101500 + GT1 ~ IF TALL.CLASS =INTID THEN IF P1= FS 15102000 + THEN ISD ELSE ISN ELSE 15103000 + IF P1 = FS THEN STD ELSE SND ; 15104000 + IF TALL.FORMALNAME THEN 15105000 + BEGIN EMITO(XCH); EMITO(GT1) END 15106000 + ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000 + END 15108000 + ELSE 15109000 + BEGIN 15110000 + IF ELCLASS= PERIOD THEN 15111000 + BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000 + IF STEPI=ASSIGNOP THEN 15113000 + IF P1! FS THEN 15114000 + BEGIN ERR(201);GO TO EXIT END 15115000 + ELSE GO TO L1 15116000 + %A 15117000 + END ; 15118000 + IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000 +COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000 + BY A LEFT ARROW OR PERIOD *;15121000 +COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000 + LEFT-MOST OF A LEFT PART LIST *;15123000 + EMITI(TALL,T1,T2); %A 15124000 + %A 15125000 + END ; 15126000 + EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000 + ELSE 15128000 + COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 15129000 + VARIABLES: 15130000 + 1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 15131000 + 2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 15132000 + 3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 15133000 + 4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 15134000 + 5. V[R] ~ ,ASSIGNMENT TO ARRAY ELEMENT. 15135000 + 6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000 + R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 15137000 + IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 15138000 + IS EMITTED FOR THE ABOVE CASES: 15139000 + 1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 15140000 + DIMENSION. THE CODE EMITTED IS: 15141000 + VL,LOD . 15142000 + EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 15143000 + 2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.15144000 + EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE15145000 + OF CODE: 15146000 + AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000 + ,LOD. 15148000 + FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 15149000 + PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 15150000 + THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000 + PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000 + [* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000 + NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 15154000 + EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000 + EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A15156000 + . THE SPECIFIC ROW DEPENDS UPON THE 15157000 + VALUES OF THE K-1 SUBSCRIPTS. 15158000 + FOR THE REMAINING CASES, 15159000 + SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 15160000 + HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000 + ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.15162000 + K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 15163000 + ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 15164000 + SUBSCRIPTS,IF K>1. 15165000 + AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 15166000 + AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 15167000 + EMITTED. 15168000 + 3. ADD THE SEQUENCE: 15169000 + IF FIRST SUBSCRIPT THEN VV ELSE COC. 15170000 + EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000 + 4. ADD THE SEQUENCE: 15172000 + IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL, 15173000 + XCH,T. 15174000 + 5. ADD THE SEQUENCE: 15175000 + IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000 + XCH,~. 15177000 + 6. ADD THE SEQUENCE: 15178000 + IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD, 15179000 + EXP,T, XCH,~. 15180000 + EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 15181000 + SIMPLE VARIABLE BLOCK. ; 15182000 + BEGIN 15183000 + LABEL EXIT,LAST,NEXT ; 15184000 + INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100 + DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF15185000 + DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000 + VARIABLE; 15187000 + DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000 + INDEX OF THE LAST ENTRY IN INFO 15189000 + FOR A MONITORED SUBSCRIPTED 15190000 + VARIABLE; 15191000 + DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX15192000 + INTO INFO TO PICK OUT SPECIAL MONITOR 15193000 + INFORMATION; 15194000 + DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT15195000 + POSITION OF THE SPECIAL MONITOR 15196000 + INFORMATION FOR SUBSCRIPTED 15197000 + VARIABLES; 15198000 + DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000 + EMIT AN OPDC OR LITC FOR PASSING 15200000 + THE SUBSCRIPTS FOR MONITORED 15201000 + SUBSCRIPTED VARIABLES.1 MEANS 15202000 + LITC, 0 MEANS OPDC; 15203000 + DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000 + BOUND WORD FROM INFO FOR MONITORED 15205000 + SUBSCRIPTED VARIABLES; 15206000 + DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000 + THE ADDRESS THAT WILL BE 15208000 + EMITTED IN AN OPDC OR LITC 15209000 + DEPENDING ON OPBIT; 15210000 + BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT15211000 + IS SET TRUE IF THE VARIABLE IN 15212000 + TALL IS SPECIAL MONITORED. 15213000 +; 15214000 +PROCEDURE INDEXER(TALL,J,BYNAME); 15214020 + VALUE TALL,J,BYNAME; 15214040 + REAL TALL,J; 15214060 + BOOLEAN BYNAME; 15214080 + BEGIN COMMENT 15214100 + INDEXER HANDLES THE COMPLEXITIES OF INITIAL AND FINAL 15214120 + INDEXING OF ARRAY DIMENSIONS WHERE DOUBLE-INDEXING OF THE 15214140 + LAST DIMENSION OF A LONG ARRAY MAY BE INVOLVED. ON ENTRY, 15214160 + ASSUMES THE RAW INDEX VALUE IS AT TOP OF STACK; 15214180 + 15214200 + IF BOOLEAN(TAKE(GIT(TALL)+J).[22:1]) THEN 15214220 + BEGIN % THIS IS THE LONG DIMENSION FOR A LONG ARRAY. 15214240 + EMITO(DUP); 15214260 + EMITO(ADD); % DOUBLE THE INDEX 15214280 + EMITPAIR(JUNK,ISN); % SAVE A COPY FOR THE COL INDEX 15214300 + EMITL(LONGROWSZ); 15214320 + EMITO(IDV); % COMPUTE THE SPLIT-ROW INDEX 15214340 + IF J=1 THEN 15214360 + EMITN(TALL.ADDRESS) 15214380 + ELSE 15214400 + EMITO(CDC); 15214420 + EMITO(LOD); % LOAD THE DESTINATION DESCRIPTOR15214440 + EMITV(JUNK); % RETRIEVE THE SAVED INDEX VALUE 15214460 + EMITL(LONGROWSZ); 15214480 + EMITO(RDV); % COMPUTE THE SPLIT-COL INDEX 15214500 + IF BYNAME THEN 15214520 + EMITO(CDC) 15214540 + ELSE 15214560 + EMITO(COC); 15214580 + END 15214600 + ELSE IF J=1 THEN 15214620 + IF BYNAME THEN 15214640 + EMITN(TALL.ADDRESS) 15214660 + ELSE 15214680 + EMITV(TALL.ADDRESS) 15214700 + ELSE 15214720 + IF BYNAME THEN 15214740 + EMITO(CDC) 15214760 + ELSE 15214780 + EMITO(COC); 15214800 + END INDEXER; 15214820 +PROCEDURE M4(TALL,J); 15215000 + VALUE TALL,J ; 15216000 + REAL TALL,J ; 15217000 + BEGIN STACKCT ~ 1; %A 15217500 + IF J = 1 15218000 + THEN BEGIN COMMENT FIRST TIME AROUND; 15219000 + IF TALL < 0 15220000 + THEN BEGIN COMMENT TALL IS MONITORED; 15221000 + EMITV(JUNK); EMITO(XCH); 15222000 + END; 15223000 + INDEXER(TALL,J,TRUE); 15224000 + END 15225000 + ELSE BEGIN COMMENT NOT THE FIRST TIME AROUND; 15226000 + INDEXER(TALL,J,TRUE); 15227000 + IF TALL < 0 15228000 + THEN BEGIN COMMENT CALL SUBSCRIPT; 15229000 + EMITV(JUNK); EMITO(XCH); 15230000 + END; 15231000 + END; END; %A 15232000 + IF STEPI ! LFTBRKET THEN BEGIN ERR(207);GO TO EXIT END; 15233000 + THENUMBEROFDECLAREDDIMENSIONS ~ TAKE(GIT(TALL)).[40:8]; 15233100 + J ~ 0; 15234000 + STACKCT ~ 0; %A 15234500 +COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000 + IF P1 > FP THEN TALL ~ ABS(TALL) ELSE 15236000 + IF TALL < 0 THEN 15237000 +COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000 + BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000 + VARIABLE; 15240000 + EMITO(MKS); 15241000 + IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000 + THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000 + TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000 + .NODIMPART)+INC; 15245000 + DO IF BOOLEAN(LWRBND~TAKE(INC~INC+1)).15246000 + OPBIT 15247000 + THEN EMITL(LWRBND.SPMONADR) 15248000 + ELSE EMITV(LWRBND.SPMONADR) 15249000 + UNTIL INC } TESTVARB 15250000 + END; 15251000 + END; 15252000 + NEXT: IF STEPI = FACTOP THEN 15253000 + BEGIN 15254000 + STLB ~ 1; 15254400 + WHILE TABLE(I+1) = COMMA DO 15254500 + BEGIN STEPIT; 15254600 + IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700 + BEGIN ERR(204); GO TO EXIT END; 15254800 + END; 15254900 + IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000 + BEGIN ERR(203);GO EXIT END; 15256000 +COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000 + ROW DESIGNATER DOES NOT MATCH THE ARRAY * 15258000 + DECLARATION. *;15259000 + IF STEPI ! RTBRKET THEN 15260000 + BEGIN ERR(204);GO EXIT END; 15261000 +COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000 + IF P1 ! FA THEN 15262500 + IF STLB > 1 THEN FLAG(212) ELSE 15262600 + IF P1!FI AND P1!FL THEN 15263000 + BEGIN ERR(205); GO TO EXIT; END; 15263100 +COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000 + STATEMENT OR ACTUAL PARAMETER LIST. *;15265000 + IF J=0 THEN 15266000 + EMITPAIR(TALL.ADDRESS,LOD); 15267000 +COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000 + IF TALL < 0 THEN 15269000 + BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000 + EMITL(5); EMITN(GNAT(PRINTI)); 15271000 + END; 15272000 + IF P1 = FA THEN 15272900 + FOR X ~ 1 STEP 1 UNTIL STLB DO 15273000 + BEGIN IF (Z~TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100 + THEN EMITV(Z) ELSE EMIT(Z); 15273200 + IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300 + END; 15273400 + STEPIT; 15274000 + GO TO EXIT; 15275000 + END OF ROW DESIGNATOR PORTION ; 15276000 + AEXP; 15277000 +COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000 + IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000 + J ~ J + 1; 15280000 + IF(GT1 ~ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000 + BEGIN 15282000 + IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000 + ELSE EMITV(GT1.[35:11]) ; 15284000 + EMIT(GT1.[23:12]); 15285000 + END OF LOWER BOUND ADJUSTMENT ; 15286000 + IF ELCLASS = COMMA THEN 15287000 + BEGIN 15288000 +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000 + M4 (TALL,J); 15290000 + EMITO(LOD) ; 15291000 + IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100 + BEGIN ERR(208); GO TO EXIT END; 15291200 + COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300 + DECLARATION *;15291400 + GO TO NEXT; 15292000 + END OF SUBSCRIPT COMMA HANDLER ; 15293000 + IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END; 15294000 +COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000 + IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000 + BEGIN ERR(208); GO TO EXIT END; 15297000 + 15298000 + 15299000 + STACKCT ~ 0; %A 15299500 + IF STEPI = ASSIGNOP THEN 15300000 + BEGIN 15301000 +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000 + LAST: M4(TALL,J); 15303000 + IF T1= 0 THEN 15304000 + BEGIN IF P1= FR THEN GO TO EXIT END 15305000 + ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; %WF 15306000 + IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000 + EMITD(48-T2,T1,T2) ; 15308000 + EMITO(XCH); 15309000 +COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000 + IF TALL < 0 15311000 + THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000 + IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000 + VALUE FROM JUNK; 15314000 + EMITO( 15315000 + IF TALL.CLASS = INTARRAYID 15316000 + THEN ISN 15317000 + ELSE SND); 15318000 + IF P1 ! FS 15319000 + THEN EMITPAIR(JUNK,SND); 15320000 + EMITL(J); EMITL(PASSTYPE(TALL)); 15321000 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000 + PASSALPHA(TALL); EMITPAIR(GNAT( 15323000 + CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000 + ARRAYMONFILE); 15325000 + EMITL(IF SPCLMON 15326000 + THEN 3 15327000 + ELSE 2); EMITV(GNAT(PRINTI)); 15328000 + IF P1 ! FS 15329000 + THEN EMITV(JUNK); 15330000 + P1~0; GO TO EXIT; 15331000 + END; 15332000 + EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000 + IF P1 = FS THEN ISD ELSE ISN ELSE 15334000 + IF P1=FS THEN STD ELSE SND); 15335000 + P1~0 ; 15336000 + GO TO EXIT ; 15337000 + END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000 + IF ELCLASS=PERIOD THEN 15339000 + BEGIN 15340000 + IF DOTSYNTAX(T1,T2) THEN GO TO EXIT; 15341000 + IF STEPI = ASSIGNOP THEN IF P1=FS THEN GO TO LAST 15342000 + ELSE BEGIN ERR(209); GO EXIT END; 15343000 + INDEXER(TALL,J,FALSE); 15344000 + END 15345000 + ELSE 15346000 +COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000 + BEGIN COMMENT MONITOR FUNCTION M10; 15348000 + SPCLMON~P1 = FP OR ELCLASS } AMPERSAND; 15349000 + INDEXER(TALL,J,NOT SPCLMON); 15350000 + IF TALL < 0 15357000 + THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000 + EMITL(5); 15359000 + IF SPCLMON 15360000 + THEN EMITV(GNAT(PRINTI)) 15361000 + ELSE EMITN(GNAT(PRINTI)) 15362000 + END; 15363000 + IF P1 =FS THEN ERR(210); 15364000 + IF P1 = FI THEN P1~0; 15364500 + GO TO EXIT; 15365000 + END; 15366000 + IF P1=FS THEN BEGIN ERR(210); GO TO EXIT END ; 15367000 +COMMENT 210 VARIABLE-MISSING LEFT ARROW OR PERIOD. *;15368000 + IF T1!0 THEN BEGIN EMITI(0,T1,T2); 15369000 + IF P1!FI THEN P1~0; 15369100 + END; 15369200 + IF P1=FI THEN 15369300 + IF ELCLASS!COMMA AND ELCLASS!RTPAREN 15369400 + THEN SIMPARITH; 15369500 + IF P1=FI THEN P1~0;% 15369600 + %A 15370000 +COMMENT ***** MONITOR FUNCTION M9 ; 15371000 + IF TALL < 0 15372000 + THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000 + EMITL(5); EMITV(GNAT(PRINTI)); 15374000 + END ; 15375000 + EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000 + EXIT : END OF THE VARIABLE ROUTINE; 15377000 +COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000 + PROCEDURE STREAMSTMT ; 16001000 + BEGIN 16002000 + DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#, 16003000 + LOCFLD=36:36:12#,LGTFLD=24:24:12#; 16004000 + DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000 + DEFINE 16006000 + JFW = 39#, COMMENT 7.5.5.1 JUMP FORWARD UNCONDITIONAL ; 16007000 + RCA = 40#, COMMENT 7.5.7.6 RECALL CONTROL ADDRESS ; 16008000 + JRV = 47#, COMMENT 7.5.5.2 JUMP REVERSE UNCONDITIONAL ; 16009000 + CRF = 35#, COMMENT 7.5.10.6 CALL REPEAT FIELD ; 16010000 + BNS = 42#, COMMENT 7.5.5.5 BEGIN LOOP ; 16011000 + NOP = 1#, COMMENT ; 16012000 + ENS = 41#, COMMENT 7.5.5.6 END LOOP ; 16013000 + TAN = 30#, COMMENT 7.5.3.7 TEST FOR ALPHAMERIC ; 16014000 + BIT = 31#, COMMENT 7.5.3.8 TEST BIT ; 16015000 + JFC = 37#, COMMENT 7.5.5.3 JUMP FORWARD CONDITIONAL ; 16016000 + SED = 06#, COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 16017000 + RSA = 43#, COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 16018000 + TRP = 60#, COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 16019000 + BSS = 3#, COMMENT 7.5.6.6 SKIP SOURCE BIT ; 16020000 + BSD = 2#, COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 16021000 + SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000 + JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ; 16023000 + COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 16024000 + OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 16025000 + A VALUE = 0 AND THE JUMP } 64 SYLLABLES A JFW 1 AND 16026000 + A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH 16027000 + MUST ALSO BE MANUFACTURED) IS EMITTED. ; 16028000 + PROCEDURE FIXC(S); VALUE S; REAL S; 16029000 + BEGIN 16030000 + REAL SAVL,D,F; 16031000 + SAVL~L; 16032000 +F~GET( S); 16033000 + IF D ~ L -( L~S) -1{63 THEN 16034000 + BEGIN 16035000 + IF F=BNS THEN 16036000 + BEGIN 16037000 + S~GET(L~L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D~D-2; 16038000 + END; 16039000 + EMITC(D,F); L ~ SAVL 16040000 + END 16041000 + ELSE BEGIN 16042000 + IF F!JFW THEN BEGIN 16043000 + EMITC(1,F); 16044000 + EMITC(1,JFW) END ; 16045000 + EMITC(PJ~PJ+1,RCA); 16046000 + L ~ SAVL; 16047000 + ADJUST; 16048000 + LPRT ~ PROGDESCBLDR(2,L,0); 16049000 + COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000 + PUTNBUMP(0&(STLABID|2+1) 16051000 + [2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000 + PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000 + PUTNBUMP(0); 16054000 + LASTINFO ~ NEXTINFO-3; 16055000 + END; 16056000 + END FIXC ; 16057000 + COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 16058000 + THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63 16059000 + SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 16060000 + STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 16061000 + RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000 + INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000 + POINTING TO OUR LABEL IN QUESTION. ; 16064000 + PROCEDURE EMITJUMP( E); VALUE E; REAL E; 16065000 + BEGIN 16066000 + REAL T,D; 16067000 + REAL ADDR; 16068000 + IF ABS( 16069000 + D~(T~TAKE(GIT(E)).LOC)-L-1)}64 THEN 16070000 + BEGIN 16071000 + IF ADDR~TAKE(E).ADDRESS=0 THEN 16072000 + BEGIN 16073000 + PUT(TAKE(E)&(ADDR~PJ~PJ+1)[16:37:11],E); 16074000 + LPRT ~ PROGDESCBLDR(2,T,0); 16075000 + END ; 16076000 + EMITC(ADDR,RCA); 16077000 + END 16078000 + ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW); 16079000 + END EMIT JUMP; 16080000 + COMMENT WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE16081000 + ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 16082000 + TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000 + LINK IS = 4096. ; 16084000 + PROCEDURE JUMPCHAIN( E); VALUE E;REAL E; 16085000 + BEGIN 16086000 + REAL SAVL ,LINK; 16087000 + SAVL ~ L; 16088000 + L ~ TAKE(GIT(E)).LASTGT ; 16089000 + WHILE L! 4095 DO 16090000 + BEGIN 16091000 + LINK ~ GET(L); 16092000 + EMITJUMP( E); 16093000 + L ~ LINK 16094000 + END; 16095000 + L~SAVL; 16096000 + END JUMPCHAIN ; 16097000 + COMMENT NESTS COMPILES THE NEST STATEMENT. 16098000 + A VARIABLE NEST INDEX CAUSES THE CODE, 16099000 + CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000 + AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 16101000 + THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH {63,OTHERWISE16102000 + IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000 + RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000 + MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000 + JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 + NEST LEVEL INCREASED BY ONE. 16107000 + WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000 + THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000 + OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000 + ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000 + JUMPS. 16112000 + FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000 + AND JOINFO RESTORED TO THEIR ORIGINAL VALUES. ; 16114000 + PROCEDURE NESTS; 16115000 + BEGIN 16116000 + LABEL EXIT; 16117000 + REAL JOINT,BNSFIX; 16118000 + IF ELCLASS!LITNO THEN 16119000 + BEGIN 16120000 + EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000 + EMIT ( BNS); EMIT(NOP);EMIT(NOP); 16122000 + END 16123000 + ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000 + IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000 + NESTLEVEL~NESTLEVEL + 1; 16126000 + JOINT ~ JOINFO; 16127000 + JOINFO ~ 0; 16128000 + DO BEGIN 16129000 + STEPIT; ERRORTOG ~ TRUE; STREAMSTMT 16130000 + END UNTIL ELCLASS ! SEMICOLON ; 16131000 + IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END; 16132000 + EMIT ( ENS); 16133000 + IF JOINFO ! 0 THEN 16134000 + BEGIN 16135000 + COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 16136000 + ADJUST; 16137000 + PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000 + JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000 + END; 16140000 + IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000 + NESTLEVEL ~ NESTLEVEL-1; 16142000 + JOINFO ~ JOINT ; 16143000 + EXIT: END NESTS ; 16144000 + COMMENT LABELS HANDLES STREAM LABELS. 16145000 + ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000 + WORD (IN THE PROGRAMSTREAM). 16147000 + IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000 + THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000 + [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000 + HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000 + MATCHES THE LEVEL OF THE LABEL. 16152000 + MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000 + FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000 + AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 16155000 +PROCEDURE LABELS; 16156000 + BEGIN 16157000 + ADJUST; 16158000 + GT1 ~ ELBAT[I]; 16159000 + IF STEPI ! COLON THEN ERR(258) 16160000 + ELSE 16161000 + BEGIN 16162000 + IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259); 16163000 + IF GT1>0 THEN 16164000 + BEGIN 16165000 + PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000 + PUT(-L,GT2) 16167000 + END 16168000 + ELSE 16169000 + BEGIN 16170000 + IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000 + PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000 + JUMPCHAIN(GT1); 16173000 + END; 16174000 + END 16175000 + ; STEPIT; 16176000 + END LABELS ; 16177000 + COMMENT IFS COMPILES IF STATEMENTS. 16178000 + FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000 + CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000 + THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000 + IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR. OTHERWISE 16182000 + THE CODE IS EMITTED STRAIGHTAWAY. 16183000 + A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000 + "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000 + SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000 + TO BE GENERATED. 16187000 + THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000 + IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000 + IF THEN GO TO L1 ELSE GO TO L2 ; 16190000 + PROCEDURE IFS; BEGIN 16191000 + DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000 + LABEL IFSB,IFTOG,IFSC,EXIT; 16193000 + SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000 + REAL ADDR,FIX1,FIX2 ; 16195000 + ADDR~1 ; 16196000 + GO TO IFSW[STEPI -SBV+1] ; 16197000 + IF ELCLASS=LOCLID THEN 16198000 + BEGIN 16199000 + EMITC(ELBAT[I].ADDRESS,CRF); 16200000 + ADDR~0; 16201000 + END 16202000 + ELSE 16203000 + IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000 + ELSE BEGIN ERR(250); GO TO EXIT END; 16205000 + IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000 + IFSC: IF STEPI ! RELOP THEN BEGIN ERR(264);GO TO EXIT END; 16207000 + IF STEPI = DCV THEN EMITC( ADDR,ELBAT[I-1].COMPARECODE) 16208000 + ELSE 16209000 + IF ELCLASS = STRNGCON THEN 16210000 + BEGIN 16211000 + IF ACCUM[1].[12:6] ! 1 OR ELBAT[I-3].CLASS ! IFV 16211100 + THEN BEGIN ERR(271); GO TO EXIT END 16211200 + ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 + END 16211400 + ELSE 16212000 + IF ACCUM[1] ! "5ALPHA" THEN 16213000 + BEGIN ERR(265);GO TO EXIT END 16213100 + ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 + ELSE BEGIN FLAG(270); ERRORTOG ~ TRUE END; 16214100 + GO TO IFTOG ; 16215000 + IFSB: EMITC(1,BIT); 16216000 + IFTOG: IF STEPI ! THENV THEN BEGIN ERR(266); GO TO EXIT END; 16217000 + FIX1 ~ L; 16218000 + EMIT(JFC); 16219000 + STEPIT; 16220000 + IF ELCLASS = BEGINV OR 16221000 + ELCLASS = IFV OR 16222000 + ELCLASS = LITNO OR 16223000 + ELCLASS = STLABID OR 16224000 + ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000 + BEGIN 16226000 + EMIT (NOP);EMIT (NOP) 16227000 + END; 16228000 + IF ELCLASS= ELSEV THEN ELSE 16228500 + STREAMSTMT; 16229000 + IF ELCLASS= ELSEV THEN 16230000 + BEGIN 16231000 + FIX2 ~ L; EMIT(JFW); 16232000 + FIXC(FIX1); 16233000 + STEPIT; 16234000 + STREAMSTMT; 16235000 + FIXC(FIX2); 16236000 + END 16237000 + ELSE FIXC(FIX1); 16238000 + EXIT:END IFS ; 16239000 + COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000 + STATEMENTS. 16241000 + IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000 + AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 16243000 + ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000 + GO TOS IN THE CASE OF FORWARD JUMPS. 16245000 + FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000 + AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000 + BE JUMPED OUT. OTHERWISE,NEST LEVEL IS DEFINED. ; 16248000 + PROCEDURE GOTOS; 16249000 + BEGIN 16250000 + LABEL EXIT; 16251000 + IF STEPI !TOV THEN I~I-1 ; 16252000 + IF STEPI ! STLABID THEN BEGIN ERR(260);GO TO EXIT END; 16253000 + IF(GT2~TAKE(GIT(GT1~ELBAT[I]))).MON=1 16254000 + OR GT2.LOC!0 THEN EMITJUMP(GT1) 16255000 + ELSE 16256000 + BEGIN PUT(0&L[24:36:12],GIT(GT1)); 16257000 + IF GT1>0 THEN 16258000 + BEGIN 16259000 + PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEVEL)[11:43:5]),GT1);16260000 + EMITN(1023); 16261000 + END 16262000 + ELSE 16263000 + BEGIN 16264000 + IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257); 16265000 + EMIT(GT2.LASTGT); 16266000 + END; 16267000 + END; 16268000 + JUMPLEVEL~0 ; 16269000 + EXIT: END GOTOS ; 16270000 + COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000 + THE CODE GENERATED IS : 16272000 + SED FILE 16273000 + RSA 0. 16274000 + AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000 + INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000 + BY THE DESTINATION ADDRESS. 16277000 + THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000 + THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 16279000 + MUST BE PASSED FOR THIS FORMAL PARAMETER; 16280000 +PROCEDURE RELEASES; 16281000 + IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000 + (GT1~ELBAT[I-1]).FORMAL=0 16283000 + THEN ERR(256) ELSE 16284000 + BEGIN 16285000 + EMITC( GT1.ADDRESS,SED); 16286000 + EMIT(FILETHING); FILETHING~L-1; 16287000 + INFO[GT1.LINKR,GT1.LINKC].MON ~ 1; 16288000 + END RELEASES; 16289000 + COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 16290000 + OR LOCALIDS . 16291000 + THREE CASES PRESENT THEMSELVES, 16292000 + LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 16293000 + CASE I LOCLID ~ X 16294000 + CASE II X ~ X ... 16295000 + CASE III X ~ EITHER LOC,LOCLID,SC OR DC. 16296000 + THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 16297000 + CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS16298000 + THE CODE TO BE EMITTED. 16299000 + EACH ELEMENT OF MACRO HAS 1-3 SYLLABLES ORDERED FROM 16300000 + RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000 + MAY REQUIRE AT MOST ONE REPEAT PART. 16302000 + IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000 + PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE" IS 16304000 + ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000 + ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000 + USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000 + THE PROPER ADDRESS AND OPERATOR . 16308000 + NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000 + ERROR. ; 16310000 +PROCEDURE INDEXS; 16311000 + BEGIN 16312000 + LABEL EXIT,GENERATE,L,L1; 16313000 + INTEGER TCLASS,INDEX,ADDR,J; 16314000 + TCLASS ~ ELCLASS ; 16315000 + IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000 + IF TCLASS = LOCLID THEN 16317000 + BEGIN 16318000 + IF SIV>STEPI OR ELCLASS>TALLYV THEN GO TO L; 16319000 + INDEX ~ 32 + ELCLASS-SIV; 16320000 + ADDR ~ ELBAT[I-2].ADDRESS; 16321000 + GO TO GENERATE; 16322000 + END; 16323000 + IF TCLASS = STEPI THEN 16324000 + BEGIN 16325000 + IF STEPI!ADDOP THEN BEGIN ERR(252); GO EXIT END ELSE 16326000 + IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100 + BEGIN ERR(253); GO EXIT END; 16327000 + INDEX ~ TCLASS-SIV 16328000 + +REAL(ELBAT[I-1].ADDRESS=SUB) | 4 16329000 + + REAL(ELCLASS =LOCLID) | 8; 16330000 + END 16331000 + ELSE 16332000 + BEGIN 16333000 + INDEX ~ TCLASS -SIV 16334000 + + ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000 + IF ELCLASS = LOCV THEN 20 ELSE 16336000 + IF ELCLASS = SCV THEN 24 ELSE 16337000 + IF ELCLASS= DCV THEN 28 ELSE 25); 16338000 + IF ELCLASS = LOCV THEN 16339000 + IF STEPI ! LOCLID THEN GO TO L; 16340000 + IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000 + BEGIN EMITC(ELBAT[I].ADDRESS,SEC);GO TO EXIT END; 16342000 + END ; 16343000 + ADDR ~ ELBAT[I].ADDRESS; 16344000 + GENERATE: 16345000 + IF MACRO[INDEX]= 0 THEN 16346000 + L: BEGIN ERR(250);GO TO EXIT END; 16347000 + J ~ 8; TCLASS ~0 ; 16348000 + L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 ); 16349000 + IF TCLASS!0 THEN 16350000 + BEGIN 16351000 + EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000 + GO TO L1 16353000 + END; 16354000 + EXIT:END INDEXS ; 16355000 + COMMENT DSS COMPILES DESTINATION STREAM STATEMENTS. 16356000 + DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000 + STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000 + NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000 + ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000 + THE OPCODE FIELD ; 16361000 +PROCEDURE DSS; 16362000 + BEGIN 16363000 + INTEGER ADDR,J,K,L,T; 16364000 + LABEL EXIT,L1; 16365000 + DEFINE OPCODE=[27:6]#; 16366000 + IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000 + IF STEPI = LOCLID THEN 16368000 + BEGIN 16369000 + EMITC(ELBAT[I].ADDRESS,CRF); 16370000 + ADDR~ 0; 16371000 + IF STEPI = LITV THEN GO TO L1 16372000 + END 16373000 + ELSE IF ELCLASS= LITNO THEN 16374000 + BEGIN 16375000 + ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000 + END 16377000 + ELSE ADDR ~ 1 ; 16378000 + IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000 + EMITC(ADDR,ELBAT[I].OPCODE) %A 16379500 + ELSE 16380000 + IF ELCLASS = LITV THEN 16381000 + BEGIN 16382000 + EMITC(ADDR,TRP); 16383000 + IF STEPI ! STRNGCON THEN BEGIN ERR(255);GO TO EXIT END; 16384000 + IF ADDR MOD 2 ! 0 THEN 16385000 + BEGIN 16386000 + EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000 + END ; 16388000 + FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000 + BEGIN 16390000 + FOR L ~6,7 DO 16391000 + MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000 + ELSE J),T,L ); 16393000 + EMIT(T); 16394000 + END END 16395000 + ELSE 16396000 + L1: ERR(250); 16397000 + EXIT:END DSS ; 16398000 + COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000 + IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000 + A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000 + OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000 +PROCEDURE SKIPS ; 16403000 + BEGIN 16404000 + REAL ADDR; 16405000 + IF STEPI = LOCLID THEN 16406000 + BEGIN 16407000 + EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000 + END 16409000 + ELSE IF ELCLASS = LITNO THEN 16410000 + BEGIN 16411000 + ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000 + END 16413000 + ELSE ADDR ~ 1 ; 16414000 + IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000 + ELSE 16416000 + IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000 + ELSE ERR(250); 16418000 + END SKIPS ; 16419000 + COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000 + JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO 16421000 + THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 16422000 + JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 16423000 + JUMP INSTRUCTION. 16424000 + SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000 + A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 16426000 + THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 16427000 + UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000 + THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING16429000 + GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 16430000 +PROCEDURE JUMPS; 16431000 + BEGIN 16432000 + JUMPLEVEL~1; 16433000 + IF STEPI!DECLARATORS THEN FLAG(261); 16434000 + IF STEPI = LITNO THEN JUMPLEVEL~ ELBAT[I].ADDRESS 16435000 + ELSE BEGIN 16436000 + IF ELCLASS! TOV AND ELCLASS! STLABID THEN 16437000 + BEGIN 16438000 + COMMENT SIMPLE JUMP OUT STATEMENT; 16439000 + IF JOINFO = 0 THEN 16440000 + BEGIN 16441000 + JOINFO ~ NEXTINFO ; 16442000 + PUTNBUMP(0&(STLABID|2+1) 16443000 + [2:40:8]&2[27:40:8 ]); 16444000 + PUTNBUMP(0&(JOINFO-LASTINFO )[ 4:40:8]); 16445000 + PUTNBUMP (0); 16446000 + LASTINFO ~ JOINFO; 16447000 + END; 16448000 + ELBAT[I~ I-1]~ TAKE(JOINFO)&JOINFO[35:35:13]; 16449000 + END; I~I-1 ; 16450000 + END; 16451000 + FOR GT1~ 1 STEP 1 UNTIL JUMPLEVEL DO 16452000 + EMIT( JNS); 16453000 + GOTOS; 16454000 + END JUMPS; 16455000 + COMMENT STREAMSTMT ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE 16456000 + THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 16457000 + THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 16458000 + IDENTIFIED BY PROCEDURE ENVOKED 16459000 + END GO TO FINI 16460000 + SEMICOLON GO TO FINI 16461000 + ) GO TO FINI 16462000 + IF IFS 16463000 + GO GOTOS 16464000 + RELEASE RELEASES 16465000 + BEGIN COMPOUNDTAIL 16466000 + SI,DI,CI,TALLY,LOCALID INDEXS 16467000 + DS DSS 16468000 + SKIP SKIPS 16469000 + JUMP JUMPS 16470000 + LABELID LABELS 16471000 + LITERAL NO.,LOCALID( NESTS 16472000 + UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO 16473000 + THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 16474000 + LABEL L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,EXIT,FINI,START; 16475000 + SWITCH TYPE ~ FINI,L,FINI,L3,L4,L5,L6,L7,L7,L7,L7,L8,L9,L10; 16476000 + START: GO TO TYPE[ ELCLASS-ENDV+1]; 16477000 + IF ELCLASS= RTPAREN THEN GO TO FINI ; 16478000 + IF ELCLASS = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 + = LFTPAREN THEN GO TO L1; 16480000 + IF ELCLASS= STLABID THEN GO TO L2 ; 16481000 + IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000 + L: ERR( 250 ); GO TO FINI ; 16483000 + L1: NESTS; GO TO EXIT; 16484000 + L2: LABELS; GO TO START; 16485000 + L3: IFS; GO TO FINI; 16486000 + L4: GOTOS; GO TO EXIT; 16487000 + L5: RELEASES; GO TO EXIT; 16488000 + L6: I~I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000 + L7: INDEXS; GO TO EXIT; 16490000 + L8: DSS; GO TO EXIT; 16491000 + L9: SKIPS; GO TO EXIT; 16492000 + L10: JUMPS; GO TO EXIT; 16493000 + EXIT: STEPIT; 16494000 + FINI: END STREAMSTMT; 16495000 + 16496000 + TIME1 ~ TIME(1); PROGRAM; 17000000 +ENDOFITALL:END MAIN BLOCK 17000100 + END. 17001000 +END;END. LAST CARD ON 0CRDIMG TAPE 99999990 +?END 99999999 diff --git a/source/B65SIM/SOURCE.alg_m b/source/B65SIM/SOURCE.alg_m index 578572e..64c26e4 100644 --- a/source/B65SIM/SOURCE.alg_m +++ b/source/B65SIM/SOURCE.alg_m @@ -98,7 +98,7 @@ REAL PROCCLOCK, % PROCESSOR CLOCK RATE IN MEGACYCLES DEFAULT=10 00279000 PROCID , % PROCESSOR IDENTIFICATION DEFAULT = 1 00284500 DISKLOAD, % ESPOL = 0; ALGOL = 1; COBOL = 2; 00285000 BUFRMAX , % MAXIMUM BUFFER SIZE 00286000 - ROWLENGTH; % LENGTH OF M ARRAY ROW (6500 WOROS) 00287000 + ROWLENGTH; % LENGTH OF M ARRAY ROW (6500 WORDS) 00287000 REAL ETIME, PTIME, STARTDATE; 00288000 REAL TIMEOFDAY; % WHAT IT SAYS - SEE SCNI - SCNO 00288010 SAVE ARRAY TBUF [0:16]; % FORMATTING AREA FOR TRACE AND MEMDUMP 00289000