90000000  $SET $                                                                            
90001000  $ SET INTRINSICS LINEINFO LIBRARY                                                 
90002000  $SET VMODE                                                                        
90003000 %***********************************************************************           
90004000 %***********************************************************************           
90005000 %*                                                                    **           
90006000 %*      (C) COPYRIGHT A.H.J.SALE 1977                                 **           
90007000 %*                    R.A.FREAK                                       **           
90008000 %*                                                                    **           
90009000 %*      ALL RIGHTS RESERVED.                                          **           
90010000 %*                                                                    **           
90011000 %*      THIS MATERIAL MAY NOT BE REPRODUCED OR COPIED OR USED         **           
90012000 %*        WITHOUT THE AUTHOR'S PERMISSION, OR AS EXPRESSED IN         **           
90013000 %*        A SOFTWARE LICENCE.                                         **           
90014000 %*                                                                    **           
90015000 %*      ADDRESS:                                                      **           
90016000 %*        PROFESSOR A.H.J.SALE,                                       **           
90017000 %*        DEPARTMENT OF INFORMATION SCIENCE,                          **           
90018000 %*        UNIVERSITY OF TASMANIA,                                     **           
90019000 %*        BOX 252C, G.P.O., HOBART,                                   **           
90020000 %*        TASMANIA.                                                   **           
90021000 %*        AUSTRALIA                                                   **           
90022000 %*                                                                    **           
90023000 %***********************************************************************           
90024000 %***********************************************************************           
90025000                                                                                    
90026000 [                                                                                  
90027000 PROCEDURE PASCALSETTAG4(WORD); REAL WORD; EXTERNAL;                                
90028000 PROCEDURE PASCALTEXTOPEN(F,BUFFER,DATA,STATUS,WORDFILE);                           
90029000 VALUE STATUS,WORDFILE;                                                             
90030000 FILE F;                                                                            
90031000 EBCDIC ARRAY BUFFER[0];                                                            
90032000 REAL ARRAY DATA[0];                                                                
90033000 REAL STATUS;                                                                       
90034000 BOOLEAN WORDFILE;                                                                  
90035000 EXTERNAL;                                                                          
90035100 INTEGER PROCEDURE PASCALTEXTREAD                                                   
90035110 (F,BUFFER,DATA,ITEM,ITEMPTR,LOWBOUND,HIGHBOUND,SCALARNAMES,FLAGS);                 
90035120 VALUE ITEMPTR,LOWBOUND,HIGHBOUND,SCALARNAMES,FLAGS;                                
90035130 FILE F;                                                                            
90035140 EBCDIC ARRAY BUFFER[0];                                                            
90035150 REAL ARRAY DATA[0];                                                                
90035160 REAL ITEM,LOWBOUND,HIGHBOUND,FLAGS;                                                
90035170 POINTER ITEMPTR,SCALARNAMES;                                                       
90035180 EXTERNAL;                                                                          
90036000 ]                                                                                  
90037000 PROCEDURE PASCALERROR(ERRORNUMBER);                                                
90038000 %         ***********                                                              
90039000   VALUE ERRORNUMBER;                                                               
90040000   INTEGER ERRORNUMBER;                                                             
90041000 BEGIN                                                                              
90042000   REAL VALUE ARRAY ERRMESSAGES(                                                    
90043000 %       "123456789012345678901234",                                                
90044000         " SUCC/PRED RANGE OFLO.  ",   %1                                           
90045000         " NO HEAP SPACE LEFT.    ",   %2                                           
90046000         " NO LABEL FOR CASE EXPR.",   %3                                           
90047000         " DO VAR CHANGED IN LOOP.",   %4                                           
90048000         " BOUNDS EXCEEDED.       ",   %5                                           
90049000         0);                                                                        
90050000                                                                                    
90051000   REAL ARRAY ERRMSG[0:5];                                                          
90052000                                                                                    
90053000   %====================EXECUTABLE PART==================================           
90054000                                                                                    
90055000   REPLACE POINTER(ERRMSG,8) BY                                                     
90056000         "ERROR:",                                                                  
90057000         POINTER(ERRMESSAGES[(ERRORNUMBER-1)*4],8) FOR 24 UNTIL = ".",              
90058000         48"00";                                                                    
90059000   DISPLAY(POINTER(ERRMSG,8));                                                      
90060000   MYSELF.STATUS:=-1;                                                               
90061000 END; % OF PASCAL-ERROR                                                             
90062000 INTEGER PROCEDURE PASCALREAD(FYLE,FYLEBUFFER,FYLEDATA,LISTPROC,CALLDATA)           
90063000 ;%        **********                                                               
90064000 %***********************************************************************           
90065000 %***********************************************************************           
90066000 %**                                                                                
90067000 %**     (C) COPYRIGHT  A.H.J.SALE  1977                                            
90068000 %**                                                                                
90069000 %***********************************************************************           
90070000 %***********************************************************************           
90071000   VALUE CALLDATA;                                                                  
90072000   BOOLEAN CALLDATA;                                                                
90073000   FILE FYLE;                                                                       
90074000   EBCDIC ARRAY FYLEBUFFER[0];                                                      
90075000   REAL ARRAY FYLEDATA[0];                                                          
90076000   BOOLEAN PROCEDURE LISTPROC(SIMPLE,SCALAR);                                       
90077000     REAL PROCEDURE SIMPLE(J);                                                      
90078000       VALUE J;                                                                     
90079000       INTEGER J;                                                                   
90080000       FORMAL;                                                                      
90081000     INTEGER PROCEDURE SCALAR(P);                                                   
90082000       VALUE P;                                                                     
90083000       POINTER P;                                                                   
90084000       FORMAL;                                                                      
90085000     FORMAL;                                                                        
90086000                                                                                    
90087000 BEGIN                                                                              
90088000   LABEL                                                                            
90089000         FINISHED,                                                                  
90090000         DISASTERPOINT;                                                             
90091000   BOOLEAN                                                                          
90092000         ENDOFLINE;                                                                 
90093000   INTEGER                                                                          
90094000         COUNT,                                                                     
90095000         BUFLENGTH,                                                                 
90096000         CH;                                                                        
90097000   POINTER                                                                          
90098000         PTR;                                                                       
90099000         % THE FOLLOWING ?S ARE LOWER-CASE LETTERS A-Z                              
90100000   TRUTHSET                                                                         
90101000         START                                                                      
90102000           ("ABCDEFGHIJKLMNOPQRSTUVWXYZ" OR                                         
90103000            "abcdefghijklmnopqrstuvwxyz" OR                                         
90104000            "0123456789+-_."),                                                      
90105000         NONDIGITS                                                                  
90106000           (NOT "0123456789"),                                                      
90107000         SIGNDIGITS                                                                 
90108000           ("0123456789+-_."),                                                      
90109000         NOTALPHANUMERIC                                                            
90110000 (NOT"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxys0123456789_");            
90111000   TRANSLATETABLE                                                                   
90112000         LCTOUC                                                                     
90113000           (EBCDIC TO EBCDIC,                                                       
90114000   "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ");                   
90115000   EBCDIC VALUE ARRAY                                                               
90116000         BOOLEANDESCRIPTION                                                         
90117000           (48"05" "FALSE", 48"04" "TRUE" 48"00");                                  
90118000   DEFINE                                                                           
90119000         ASCIIFLAG=CALLDATA#,                                                       
90120000         FATAL    =CALLDATA.[1:1]#;                                                 
90121000                                                                                    
90122000   DEFINE                                                                           
90123000         CHARTYPE        =0#,                                                       
90124000         INTTYPE         =1#,                                                       
90125000         REALTYPE        =2#,                                                       
90126000         ETYPE           =3#,    % NOT USED HERE                                    
90127000         BOOLTYPE        =4#,                                                       
90128000         RADIXTYPE       =5#;    % NOT USED HERE                                    
90129000                                                                                    
90130000   DEFINE                                                                           
90131000         FYLERESULT      =FYLEDATA[0]#,                                             
90132000         FYLESTATUS      =FYLEDATA[1].[3:4]#,                                       
90133000         FYLEBUFLENGTH   =FYLEDATA[2]#,                                             
90134000         FYLECOUNT       =FYLEDATA[3]#,                                             
90135000         FYLEMAXRECSIZE  =FYLEDATA[4]#,                                             
90136000         FYLETYPE        =FYLEDATA[5]#;                                             
90137000                                                                                    
90138000 %=================PROCEDURE DECLARATIONS FOLLOW=========================           
90139000                                                                                    
90140000 PROCEDURE ERROR(NO);                                                               
90141000 %         *****                                                                    
90142000   VALUE NO; INTEGER NO;                                                            
90143000 BEGIN                                                                              
90144000   REAL VALUE ARRAY ERRMESSAGES(                                                    
90145000 %       "123456789012345678",                                                      
90146000         "READFILE=WRITEBUSY",                                                      
90147000         " END OF READ-FILE.",                                                      
90148000         " NO DIGIT AFTER +-",                                                      
90149000         " TOO MANY DIGITS. ",                                                      
90150000         " NO DIGIT AFTER . ",                                                      
90151000         " EXPONENT TOO LONG",                                                      
90152000         " NO EXPNT DIGIT.  ",                                                      
90153000         " NOT SCALAR NAME. ",                                                      
90154000         " RADIX <> 2/4/8/16",                                                      
90155000         " DIGIT >= RADIX.  ",                                                      
90156000         " NUM TOO BIG/SMALL",                                                      
90157000         " REAL/INT CLASH.  ",                                                      
90158000         " SCALAR/NUM CLASH.",                                                      
90159000         0);                                                                        
90160000                                                                                    
90161000   REAL ARRAY ERRMSG[0:4];                                                          
90162000                                                                                    
90163000   IF FATAL THEN BEGIN                                                              
90164000     REPLACE POINTER(ERRMSG,8) BY                                                   
90165000           "ERROR:",                                                                
90166000           POINTER(ERRMESSAGES[(NO-1)*3],8) FOR 18 UNTIL = ".",                     
90167000           48"00";                                                                  
90168000     DISPLAY(POINTER(ERRMSG,8));                                                    
90169000     GO DISASTERPOINT;   %WIPE STACK SO AVOID CONFUSING USER                        
90170000   END;                                                                             
90171000   FYLECOUNT:=-1;                                                                   
90172000   PASCALREAD:=NO;                                                                  
90173000   % THIS IS A NON-LOCAL GOTO                                                       
90174000   GO FINISHED;                                                                     
90175000 END; % OF ERROR                                                                    
90176000                                                                                    
90177000 PROCEDURE READNEXTLINE;                                                            
90178000 %         ***********                                                              
90179000 BEGIN                                                                              
90180000   BOOLEAN RESULT;                                                                  
90181000   %                                                                                
90182000   IF BOOLEAN(FYLERESULT) THEN BEGIN                                                
90183000     CALLDATA:=BOOLEAN(2); ERROR(2);                                                
90184000   END;                                                                             
90185000   RESULT:=READ(FYLE,FYLEMAXRECSIZE,FYLEBUFFER[*]);                                 
90186000   IF (FYLETYPE=3) THEN BEGIN                                                       
90187000     BUFLENGTH:=REAL(RESULT.[47:20]);    % A SHORT READ                             
90188000     IF (FYLE.UNITS = VALUE(WORDS)) THEN BUFLENGTH:=BUFLENGTH*6;                    
90189000     FYLEBUFLENGTH:=MIN(BUFLENGTH,SIZE(FYLEBUFFER));                                
90190000   END;                                                                             
90191000   FYLERESULT:=REAL(RESULT);                                                        
90192000   IF RESULT THEN BEGIN                                                             
90193000     FYLECOUNT:=0;      % REACHED END-OF-FILE, MARK LINE EMPTY                      
90194000     PASCALREAD:=2;                                                                 
90195000     GO FINISHED;  % A NON-LOCAL GOTO                                               
90196000   END;                                                                             
90197000   COUNT:=BUFLENGTH;                                                                
90198000   PTR:=FYLEBUFFER[0];                                                              
90199000 END; % OF READ-NEW-LINE                                                            
90200000                                                                                    
90201000   PROCEDURE NEXTCH;                                                                
90202000   %         ******                                                                 
90203000 BEGIN                                                                              
90204000   COUNT:=COUNT-1;                                                                  
90205000   IF (COUNT > 0) THEN BEGIN                                                        
90206000     PTR:=PTR+1; CH:=REAL(PTR,1);                                                   
90207000   END ELSE IF (COUNT = 0) THEN BEGIN                                               
90208000     CH:=(IF ASCIIFLAG THEN 32 ELSE 64);     % END-OF-LINE CHARACTER                
90209000   END ELSE BEGIN        % COUNT < 0                                                
90210000     READNEXTLINE; CH:=REAL(PTR,1);                                                 
90211000   END;                                                                             
90212000 END; % OF NEXTCH                                                                   
90213000                                                                                    
90214000 %=======================================================================           
90215000                                                                                    
90216000 INTEGER PROCEDURE SCALARELEMENT(DESCRIPTION);                                      
90217000 %                 *************                                                    
90218000   VALUE DESCRIPTION;                                                               
90219000   POINTER DESCRIPTION;                                                             
90220000   %---------------------------------------------------------------------           
90221000   %                                                                                
90222000   % SCALARELEMENT ATTEMPTS TO READ A SCALAR CONSTANT BY LOOKING                    
90223000   %     FOR A SCALAR CONSTANT NAME THAT MATCHES THE DECLARED                       
90224000   %     NAMES HELD IN AN ARRAY.                                                    
90225000   %                                                                                
90226000   % PARAMETERS ARE:                                                                
90227000   %     A POINTER TO THE DESCRIPTION START                                         
90228000   %                                                                                
90229000   % RETURNED:                                                                      
90230000   %     THE SCALAR VARIABLE TO BE SET                                              
90231000   %                                                                                
90232000   %---------------------------------------------------------------------           
90233000 BEGIN                                                                              
90234000   LABEL                                                                            
90235000         LOOKING,                                                                   
90236000         MATCHED;                                                                   
90237000   INTEGER                                                                          
90238000         NEWCOUNT,                                                                  
90239000         SCALARVALUE,                                                               
90240000         INPUTLENGTH,                                                               
90241000         CONSTANTLENGTH;                                                            
90242000   POINTER                                                                          
90243000         P;                                                                         
90244000                                                                                    
90245000 LOOKING:                                                                           
90246000   WHILE (COUNT <= 0) DO READNEXTLINE;                                              
90247000   SCAN PTR:PTR FOR COUNT:COUNT UNTIL IN START;                                     
90248000   IF (COUNT=0) THEN BEGIN                                                          
90249000     READNEXTLINE;                                                                  
90250000     GO LOOKING;                                                                    
90251000   END;                                                                             
90252000   IF (PTR IN SIGNDIGITS) THEN ERROR(13);   % BEGINS WITH DIGIT, OR +-_             
90253000   SCAN PTR FOR NEWCOUNT:COUNT UNTIL IN NOTALPHANUMERIC;                            
90254000   INPUTLENGTH:=COUNT-NEWCOUNT;                                                     
90255000   REPLACE PTR BY PTR FOR INPUTLENGTH WITH LCTOUC;                                  
90256000   P:=DESCRIPTION;                                                                  
90257000   SCALARVALUE:=0; CONSTANTLENGTH:=REAL(P,1);                                       
90258000   WHILE (CONSTANTLENGTH NEQ 0) DO BEGIN                                            
90259000     IF (INPUTLENGTH = CONSTANTLENGTH) THEN BEGIN                                   
90260000       IF (PTR = (P+1) FOR CONSTANTLENGTH) THEN GO MATCHED;                         
90261000     END;                                                                           
90262000     P:=P+(CONSTANTLENGTH+1);                                                       
90263000     SCALARVALUE:=*+1; CONSTANTLENGTH:=REAL(P,1);                                   
90264000   END;                                                                             
90265000   ERROR(8);                                                                        
90266000 MATCHED:                                                                           
90267000   COUNT:=NEWCOUNT;                                                                 
90268000   IF (COUNT > 0) THEN PTR:=PTR+INPUTLENGTH;                                        
90269000   SCALARELEMENT:=SCALARVALUE;                                                      
90270000 END; % OF SCALAR-ELEMENT                                                           
90271000                                                                                    
90272000 %=======================================================================           
90273000                                                                                    
90274000 REAL PROCEDURE SIMPLEELEMENT(ELTYPE);                                              
90275000 %              *************                                                       
90276000   VALUE ELTYPE;                                                                    
90277000   INTEGER ELTYPE;                                                                  
90278000   %---------------------------------------------------------------------           
90279000   %                                                                                
90280000   % SIMPLEELEMENT HANDLES READING OF SIMPLE TYPES:                                 
90281000   %     BOOLEAN,INTEGER,REAL,CHAR.                                                 
90282000   %                                                                                
90283000   % PARAMETERS:                                                                    
90284000   %     THE TYPE OF THE THING                                                      
90285000   %                                                                                
90286000   % RETURNED:                                                                      
90287000   %     THE VALUE READ                                                             
90288000   %                                                                                
90289000   %---------------------------------------------------------------------           
90290000 BEGIN                                                                              
90291000   DEFINE                                                                           
90292000         TENPOWER(J)                                                                
90293000           =(POTL[(J).[5:6]]*POTC[(J).[11:6]]*POTH[(J).[14:3]])#;                   
90294000   LABEL                                                                            
90295000         LOOKING;                                                                   
90296000   BOOLEAN                                                                          
90297000         NEGVALUE,                                                                  
90298000         POSITIVE;                                                                  
90299000   DOUBLE                                                                           
90300000         DNUMBER;                                                                   
90301000   INTEGER                                                                          
90302000         LENGTH,                                                                    
90303000         NEWCOUNT,                                                                  
90304000         EXPONENT;                                                                  
90305000   REAL                                                                             
90306000         VAL;                                                                       
90307000   DEFINE                                                                           
90308000         UPDATEPTR=                                                                 
90309000                 BEGIN                                                              
90310000                   COUNT:=NEWCOUNT;                                                 
90311000                   IF (COUNT > 0) THEN BEGIN                                        
90312000                     PTR:=PTR+LENGTH; CH:=REAL(PTR,1);                              
90313000                   END ELSE BEGIN                                                   
90314000                     CH:=12;                                                        
90315000                   END;                                                             
90316000                 END#;                                                              
90317000                                                                                    
90318000   PROCEDURE RADIXREAD;                                                             
90319000   %         *********                                                              
90320000   BEGIN                                                                            
90321000     INTEGER                                                                        
90322000         BITS,                                                                      
90323000         NUMCH;                                                                     
90324000     REAL                                                                           
90325000         RVAL;                                                                      
90326000         % THE ?S ARE LOWER-CASE A-F                                                
90327000     TRUTHSET HEXCHAR ("0123456789ABCDEFabcdef");                                   
90328000     TRANSLATETABLE                                                                 
90329000         HEXTOBIN (EBCDIC TO 48"FF",                                                
90330000                  "0123456789ABCDEFabcdef" TO                                       
90331000                  48"000102030405060708090A0B0C0D0E0F0A0B0C0D0E0F");                
90332000     %                                                                              
90333000     IF (ELTYPE=INTTYPE) THEN ERROR(12);                                            
90334000     NEXTCH;                                                                        
90335000     CASE VAL OF BEGIN                                                              
90336000       %                                                                            
90337000       2: BITS:=1;                                                                  
90338000       4: BITS:=2;                                                                  
90339000       8: BITS:=3;                                                                  
90340000      16: BITS:=4;                                                                  
90341000    ELSE: ERROR(9);                                                                 
90342000     END; % OF CASE                                                                 
90343000     RVAL:=0; NUMCH:=0;                                                             
90344000     WHILE (CH IN HEXCHAR) DO BEGIN                                                 
90345000       REPLACE PTR BY PTR FOR 1 WITH HEXTOBIN;                                      
90346000       IF ((CH:=REAL(PTR,1)) >= VAL) THEN ERROR(10);                                
90347000       RVAL:=(RVAL.[(47-BITS):48]) & CH [(BITS-1):BITS];                            
90348000       NUMCH:=NUMCH+1; NEXTCH;                                                      
90349000     END;                                                                           
90350000     IF (NUMCH > (48 DIV BITS)) THEN ERROR(4);                                      
90351000     VAL:=RVAL;                                                                     
90352000   END; % OF RADIX-READ                                                             
90353000                                                                                    
90354000   IF (ELTYPE=CHARTYPE) THEN BEGIN                                                  
90355000     IF (COUNT < 0) THEN READNEXTLINE;                                              
90356000     IF (COUNT = 0) THEN BEGIN                                                      
90357000       SIMPLEELEMENT:=(IF ASCIIFLAG THEN 32 ELSE 64);                               
90358000     END ELSE BEGIN                                                                 
90359000       IF ASCIIFLAG THEN BEGIN                                                      
90360000         REPLACE PTR BY PTR FOR 1 WITH EBCDICTOASCII;                               
90361000       END;                                                                         
90362000       SIMPLEELEMENT:=REAL(PTR,1);                                                  
90363000       IF (COUNT > 1) THEN PTR:=PTR+1;                                              
90364000     END;                                                                           
90365000     COUNT:=COUNT-1;                                                                
90366000   END ELSE BEGIN                                                                   
90367000 LOOKING:                                                                           
90368000     WHILE (COUNT <= 0) DO READNEXTLINE;                                            
90369000     SCAN PTR:PTR FOR COUNT:COUNT UNTIL IN START;                                   
90370000     IF (COUNT=0) THEN BEGIN                                                        
90371000       READNEXTLINE;                                                                
90372000       GO LOOKING;                                                                  
90373000     END;                                                                           
90374000                                                                                    
90375000     CASE ELTYPE OF BEGIN                                                           
90376000       %                                                                            
90377000     BOOLTYPE:                                                                      
90378000       SIMPLEELEMENT:= SCALARELEMENT(BOOLEANDESCRIPTION[0]);                        
90379000       %                                                                            
90380000     INTTYPE: REALTYPE:                                                             
90381000       BEGIN                                                                        
90382000         CH:=REAL(PTR,1);                                                           
90383000         IF (CH = "-") THEN BEGIN                                                   
90384000           NEGVALUE:=TRUE; NEXTCH;                                                  
90385000         END ELSE BEGIN                                                             
90386000           NEGVALUE:=FALSE;                                                         
90387000           IF (CH = "+") THEN NEXTCH;                                               
90388000         END;                                                                       
90389000         SCAN PTR FOR NEWCOUNT:COUNT UNTIL IN NONDIGITS;                            
90390000         LENGTH:=COUNT-NEWCOUNT;                                                    
90391000         IF (LENGTH = 0) THEN BEGIN                                                 
90392000           ERROR(3); % NO DIGIT AFTER + OR -                                        
90393000         END ELSE IF (LENGTH <= 12) THEN BEGIN                                      
90394000           VAL:=INTEGER(PTR,LENGTH);                                                
90395000         END ELSE BEGIN                                                             
90396000           ERROR(4); % TOO MANY DIGITS                                              
90397000         END;                                                                       
90398000         UPDATEPTR;                                                                 
90399000         IF ((CH=".") OR (CH="E") OR (CH="e")) THEN BEGIN                           
90400000           IF (ELTYPE=INTTYPE) THEN ERROR(12);    % REAL/INT MISMATCH               
90401000           DNUMBER:=0; EXPONENT:=0;                                                 
90402000           % PROCESS A POSSIBLE FRACTIONAL PART                                     
90403000           % ----------------------------------                                     
90404000           IF (CH = ".") THEN BEGIN                                                 
90405000             NEXTCH;                                                                
90406000             IF (CH >= "0") AND (CH <= "9") THEN BEGIN                              
90407000               SCAN PTR FOR NEWCOUNT:COUNT UNTIL IN NONDIGITS;                      
90408000               LENGTH:=COUNT-NEWCOUNT;                                              
90409000               IF (LENGTH <= 23) THEN BEGIN                                         
90410000                 DNUMBER:=DOUBLE(PTR,LENGTH);                                       
90411000                 EXPONENT:=LENGTH;                                                  
90412000               END ELSE BEGIN                                                       
90413000                 DNUMBER:=DOUBLE(PTR,23);                                           
90414000                 EXPONENT:=23;                                                      
90415000               END; % OF IF LENGTH <= 23                                            
90416000               DNUMBER:= VAL + (DNUMBER / TENPOWER(EXPONENT));                      
90417000               UPDATEPTR;                                                           
90418000             END ELSE BEGIN                                                         
90419000               ERROR(5);                    % NO FRACTION DIGIT                     
90420000             END;                                                                   
90421000           END ELSE BEGIN                                                           
90422000             DNUMBER := VAL;                                                        
90423000           END; % OF FRACTION PROCESSING                                            
90424000                                                                                    
90425000           % PROCESS A POSSIBLE EXPONENT PART                                       
90426000           % --------------------------------                                       
90427000           IF (CH = "E") OR (CH = "e") THEN BEGIN                                   
90428000             NEXTCH;                                                                
90429000             EXPONENT:=0;                                                           
90430000             IF (CH = "-") THEN BEGIN                                               
90431000               POSITIVE:=FALSE;                                                     
90432000               NEXTCH;                                                              
90433000             END ELSE BEGIN                                                         
90434000               POSITIVE:=TRUE;                                                      
90435000               IF (CH = "+") THEN NEXTCH;                                           
90436000             END; % OF IF ON SIGN CHARACTER                                         
90437000             IF (CH >= "0") AND (CH <= "9") THEN BEGIN                              
90438000               SCAN PTR FOR NEWCOUNT:COUNT UNTIL IN NONDIGITS;                      
90439000               LENGTH:=COUNT-NEWCOUNT;                                              
90440000               IF (LENGTH <= 3) THEN BEGIN                                          
90441000                 EXPONENT:=INTEGER(PTR,LENGTH);                                     
90442000               END ELSE BEGIN                                                       
90443000                 ERROR(6);                  % TOO MANY EXPONENT DIGITS              
90444000               END;                                                                 
90445000               UPDATEPTR;                                                           
90446000             END ELSE BEGIN                                                         
90447000               ERROR(7);                    % NO EXPONENT DIGITS                    
90448000             END;                                                                   
90449000             IF POSITIVE THEN BEGIN                                                 
90450000               DNUMBER:= DNUMBER * TENPOWER(EXPONENT);                              
90451000             END ELSE BEGIN                                                         
90452000               DNUMBER:= DNUMBER / TENPOWER(EXPONENT);                              
90453000             END;                                                                   
90454000           END; % OF EXPONENT PROCESSING                                            
90455000                                                                                    
90456000           % ACQUIRE SINGLE-PRECISION REAL NUMBER                                   
90457000           % ------------------------------------                                   
90458000           IF (DNUMBER < 3"1771000000000000")                                       
90459000           OR (DNUMBER > 3"0777777777777777") THEN BEGIN                            
90460000             IF (DNUMBER NEQ 0) THEN ERROR(11);      % UNREPRESENTABLE              
90461000             VAL:=0;                                                                
90462000           END ELSE BEGIN                                                           
90463000             VAL:=REAL(DNUMBER);                                                    
90464000           END;                                                                     
90465000         END ELSE IF (CH="R") OR (CH="r") THEN BEGIN                                
90466000           RADIXREAD;                                                               
90467000         END;                                                                       
90468000         SIMPLEELEMENT:=(IF NEGVALUE THEN (-VAL) ELSE VAL);                         
90469000       END; % OF INTYPE & REALTYPE                                                  
90470000       %                                                                            
90471000     END; % OF CASE OF ELTYPE (CHARTYPE AND ASCIITYPE CANNOT OCCUR)                 
90472000                                                                                    
90473000   END; % OF ELSE OF IF (ELTYPE=CHARTYPE)                                           
90474000                                                                                    
90475000 END; % OF SIMPLE-ELEMENT                                                           
90476000                                                                                    
90477000 %=========================EXECUTABLE PART===============================           
90478000                                                                                    
90479000   IF (FYLESTATUS NEQ 1) THEN BEGIN                                                 
90480000     IF (FYLESTATUS = 0) THEN BEGIN                                                 
90481000       FYLESTATUS:=1;   %MARK OPEN FOR READ AND BUSY                                
90482000       FYLE.OPEN:=TRUE;                                                             
90483000       FYLETYPE:=FYLE.FILETYPE;                                                     
90484000       FYLEMAXRECSIZE:= BUFLENGTH:= FYLE.MAXRECSIZE;                                
90485000       IF (FYLE.UNITS = VALUE(WORDS)) THEN BEGIN                                    
90486000         BUFLENGTH:=BUFLENGTH*6;                                                    
90487000       END;                                                                         
90488000       IF (FYLE.KIND = VALUE(READER)) THEN BEGIN                                    
90489000         BUFLENGTH:=80;                                                             
90490000       END ELSE IF (FYLE.FILEKIND = 193) THEN BEGIN  % SEQDATA                      
90491000         BUFLENGTH:=72;                                                             
90492000       END;                                                                         
90493000       BUFLENGTH:=FYLEBUFLENGTH:=MIN(BUFLENGTH,SIZE(FYLEBUFFER));                   
90494000       READNEXTLINE;                                                                
90495000     END ELSE BEGIN                                                                 
90496000       ERROR(1);        % ITS ALREADY OPEN FOR WRITE                                
90497000     END;                                                                           
90498000   END ELSE BEGIN        % ALL WAS OK                                               
90499000     COUNT:=FYLECOUNT;                                                              
90500000     BUFLENGTH:=FYLEBUFLENGTH;                                                      
90501000   END;                                                                             
90502000   IF (COUNT > 0) THEN PTR:=FYLEBUFFER[BUFLENGTH-COUNT];                            
90503000                                                                                    
90504000   ENDOFLINE:=LISTPROC(SIMPLEELEMENT,SCALARELEMENT);                                
90505000   IF ENDOFLINE THEN BEGIN                                                          
90506000     COUNT := -1;                                                                   
90507000   END;                                                                             
90508000                                                                                    
90509000   FYLECOUNT:=COUNT;                                                                
90510000   PASCALREAD:=0;                                                                   
90511000   GO FINISHED;                                                                     
90512000                                                                                    
90513000 DISASTERPOINT:                                                                     
90514000   % THIS KLUDGE IS HERE SO WE CAN WIPE THE STACK OF INTERNAL                       
90515000   % CALLS BEFORE DYING.  THE STACK HISTORY IS THEN LESS                            
90516000   % CONFUSING TO A NAIVE USER.                                                     
90517000   MYSELF.STATUS:=-1;    % AAARGH.H...                                              
90518000                                                                                    
90519000 FINISHED:                                                                          
90520000 END; % OF PASCAL-READ                                                              
90521000 PROCEDURE PASCALWRITE(FYLE,BUFFER,FYLEDATA,FYLELIST);                              
90522000 %         ***********                                                              
90523000 %***********************************************************************           
90524000 %***********************************************************************           
90525000 %**                                                                                
90526000 %**     (C) COPYRIGHT  A.H.J.SALE  1977                                            
90527000 %**                                                                                
90528000 %***********************************************************************           
90529000 %***********************************************************************           
90530000   FILE FYLE;                                                                       
90531000   EBCDIC ARRAY BUFFER[0];                                                          
90532000   REAL ARRAY FYLEDATA[0];                                                          
90533000   BOOLEAN PROCEDURE FYLELIST(SIMPLE,STRING,SCALAR);                                
90534000     PROCEDURE SIMPLE(R,J,K,L);                                                     
90535000       VALUE R,J,K,L;                                                               
90536000       REAL R;                                                                      
90537000       INTEGER J,K,L;                                                               
90538000       FORMAL;                                                                      
90539000     PROCEDURE STRING(P,J,B,K);                                                     
90540000       VALUE P,J,B,K;                                                               
90541000       POINTER P;                                                                   
90542000       INTEGER J,K;                                                                 
90543000       BOOLEAN B;                                                                   
90544000       FORMAL;                                                                      
90545000     PROCEDURE SCALAR(J,P,K);                                                       
90546000       VALUE J,P,K;                                                                 
90547000       INTEGER J,K;                                                                 
90548000       POINTER P;                                                                   
90549000       FORMAL;                                                                      
90550000     FORMAL;                                                                        
90551000                                                                                    
90552000 %***********************************************************************           
90553000 %*                                                                                 
90554000 %* PASCALWRITE IMPLEMENTS PASCAL STREAM I/O                                        
90555000 %*                                                                                 
90556000 %***********************************************************************           
90557000 BEGIN                                                                              
90558000   INTEGER                                                                          
90559000         COUNT,                  % NO OF CHARS LEFT IN LINE                         
90560000         LENGTH,                 % LINE LENGTH IN CHARS                             
90561000         EPOWER,                 % EXPONENT POWER FOR -REAL-S                       
90562000         FILLCHARS;              % WHERE WE LEFT OFF WITH ERROR                     
90563000   BOOLEAN                                                                          
90563100         FLUSHDONE,                                                                 
90564000         WRITELN,                % IS THIS A WRITE OR WRITELN?                      
90565000         EFLAG;                  % MARKS AN ERROR OCCURRED                          
90566000   POINTER                                                                          
90567000         PTR;                    % SCANS BUFFER                                     
90568000   EBCDIC VALUE ARRAY                                                               
90569000         HEXCHAR("0123456789ABCDEF"),    % USED FOR RADIX CONVERT                   
90570000         EMESS(                          % ERROR MESSAGES OF 24 CHARS               
90571000         "YURK                    ",                                                
90572000         "NEGATIVE WIDTH          ",                                                
90573000         "NEGATIVE D SPECIFIED    ",                                                
90574000         "RADIX <> 0/2/4/8/16     ",                                                
90575000         "                        ",                                                
90576000         "SIZE > WIDTH            ",                                                
90577000         "STRING > LINELENGTH     ",                                                
90578000         "NOT SCALAR CONSTANT     ",                                                
90579000         "SCALAR NAME TOO LONG    ",                                                
90580000         "WIDTH > LINELENGTH      ",                                                
90581000         "USE E FORMAT-NO. TOO BIG",                                                
90582000         "YURK                    "),                                               
90583000                                                                                    
90584000         ERRMSG(                                                                    
90585000                 "ERROR: END OF WRITE-FILE"48"00"                                   
90586000                 "ERROR: READFILE=WRITEBUSY"48"00");                                
90587000                                                                                    
90588000   DEFINE                                                                           
90589000         CHARTYPE        =0#,                                                       
90590000         INTTYPE         =1#,                                                       
90591000         REALTYPE        =2#,                                                       
90592000         ETYPE           =3#,                                                       
90593000         BOOLTYPE        =4#,                                                       
90594000         RADIXTYPE       =5#;                                                       
90595000                                                                                    
90596000   DEFINE                                                                           
90597000         FYLERESULT      =FYLEDATA[0]#,                                             
90598000         FYLESTATUS      =FYLEDATA[1].[3:4]#,                                       
90599000         FYLEBUFLENGTH   =FYLEDATA[2]#,                                             
90600000         FYLECOUNT       =FYLEDATA[3]#,                                             
90601000         FYLEMAXRECSIZE  =FYLEDATA[4]#,                                             
90602000         FYLETYPE        =FYLEDATA[5]#;                                             
90603000                                                                                    
90604000   DEFINE                                                                           
90605000         TENPOWER(J)                                                                
90606000           =(POTL[(J).[5:6]]*POTC[(J).[11:6]]*POTH[(J).[14:3]])#,                   
90607000           % A B6700 THING TO GIVE TEN TO POWER OF J (J>=0)                         
90608000         DIGITSIN(J)                                                                
90609000           =(((FIRSTONE(SCALERIGHTF(J,12))-1) DIV 4) + 1)#;                         
90610000           % A REALLY B6700 KLUDGE TO FIND OUT HOW MANY                             
90611000           %   DIGITS NEED TO BE REPRESENTED IN J.                                  
90612000                                                                                    
90613000 %===========PROCEDURE DECLARATIONS FOLLOW===============================           
90614000                                                                                    
90615000 PROCEDURE FLUSHBUFFER;                                                             
90616000 %         ***********                                                              
90617000   %---------------------------------------------------------------------           
90618000   %                                                                                
90619000   % FLUSHBUFFER FORCES THE CURRENT BUFFER TO BE FLUSHED OUT                        
90620000   %     TO THE FILE, PROVIDED THERE IS SOMETHING IN IT.                            
90621000   %                                                                                
90622000   %---------------------------------------------------------------------           
90623000 BEGIN                                                                              
90624000   IF (COUNT > 0) THEN                                                              
90625000     REPLACE PTR BY " " FOR COUNT;                                                  
90626000   IF BOOLEAN(FYLERESULT) THEN BEGIN                                                
90627000     DISPLAY(ERRMSG[0]);                                                            
90628000     MYSELF.STATUS:=-1;          % AARRGH.H...                                      
90629000   END;                                                                             
90630000   FYLERESULT:=REAL(WRITE(FYLE,FYLEMAXRECSIZE,BUFFER[*]));                          
90631000   PTR:=BUFFER[0];                                                                  
90632000   COUNT:=LENGTH;                                                                   
90633000 END; % OF FLUSH-BUFFER                                                             
90634000                                                                                    
90635000 PROCEDURE RESTORE;                                                                 
90636000 %         *******                                                                  
90637000   %---------------------------------------------------------------------           
90638000   %                                                                                
90639000   % RESTORE REMOVES THE EFFECT OF INTERVENING MESSAGE FROM ERRORS                  
90640000   %     AND RETURNS BUFFER POINTER TO PLACE OF LEAVING.                            
90641000   %                                                                                
90642000   %---------------------------------------------------------------------           
90643000 BEGIN                                                                              
90644000   FLUSHBUFFER; EFLAG:=FALSE;                                                       
90645000   IF (FILLCHARS > 0) THEN BEGIN                                                    
90646000     REPLACE PTR:PTR BY ">" FOR FILLCHARS;                                          
90647000     COUNT:=COUNT-FILLCHARS;                                                        
90648000     FILLCHARS:=0;                                                                  
90649000   END;                                                                             
90650000 END; % OF RESTORE                                                                  
90651000                                                                                    
90652000 PROCEDURE ICONVERT(J);                                                             
90653000 %         ********                                                                 
90654000   VALUE J;                                                                         
90655000   INTEGER J;                                                                       
90656000   %---------------------------------------------------------------------           
90657000   %                                                                                
90658000   % ICONVERT IS USED SOLELY FOR MESSAGES ASSOCIATED WITH PERROR.                   
90659000   %     NO CHECK ON LINE OFLO IS MADE.                                             
90660000   %     THE PARAMETER -J- IS SIMPLY PRINTED IN MINIMUM SPACE                       
90661000   %       AND A LEADING SPACE CHARACTER INSERTED.                                  
90662000   %                                                                                
90663000   %---------------------------------------------------------------------           
90664000 BEGIN                                                                              
90665000   INTEGER K;                                                                       
90666000   %                                                                                
90667000   REPLACE PTR:PTR BY " ";                                                          
90668000   IF (J < 0) THEN BEGIN                                                            
90669000     REPLACE PTR:PTR BY "-";                                                        
90670000     COUNT:=COUNT-1;                                                                
90671000     J:=ABS(J);                                                                     
90672000   END;                                                                             
90673000   REPLACE PTR:PTR BY J FOR (K:=DIGITSIN(J)) DIGITS;                                
90674000   COUNT:=COUNT-K-1;                                                                
90675000 END; % OF I-CONVERT                                                                
90676000                                                                                    
90677000 PROCEDURE PERROR(NO);                                                              
90678000 %         ******                                                                   
90679000   VALUE NO;                                                                        
90680000   INTEGER NO;                                                                      
90681000 BEGIN                                                                              
90682000   IF NOT EFLAG THEN FILLCHARS:=LENGTH-COUNT;                                       
90683000   FLUSHBUFFER;                                                                     
90684000   REPLACE PTR:PTR BY "===> E","RROR F",                                            
90685000                      NO FOR 2 DIGITS,                                              
90686000                      ": ",                                                         
90687000                      EMESS[NO*24] FOR 24;                                          
90688000   COUNT:=COUNT-40;                                                                 
90689000 END;                                                                               
90690000                                                                                    
90691000 PROCEDURE ERRORWITH1(NO,J);                                                        
90692000 %         **********                                                               
90693000   VALUE NO,J;                                                                      
90694000   INTEGER NO,J;                                                                    
90695000 BEGIN                                                                              
90696000   PERROR(NO); ICONVERT(J);                                                         
90697000   FLUSHBUFFER; EFLAG:=TRUE;                                                        
90698000 END; % OF ERROR-WITH-1                                                             
90699000                                                                                    
90700000 PROCEDURE ERRORWITH2(NO,J,K);                                                      
90701000 %         **********                                                               
90702000   VALUE NO,J,K;                                                                    
90703000   INTEGER NO,J,K;                                                                  
90704000 BEGIN                                                                              
90705000   PERROR(NO); ICONVERT(J); ICONVERT(K);                                            
90706000   FLUSHBUFFER; EFLAG:=TRUE;                                                        
90707000 END; % OF ERROR-WITH-2                                                             
90708000                                                                                    
90709000 PROCEDURE ASTERISKFILL(SIZE);                                                      
90710000 %         ************                                                             
90711000   VALUE SIZE;                                                                      
90712000   INTEGER SIZE;                                                                    
90713000 BEGIN                                                                              
90714000   IF (SIZE > COUNT) THEN SIZE:=COUNT;                                              
90715000   REPLACE PTR:PTR BY "*" FOR SIZE;                                                 
90716000   COUNT:=COUNT-SIZE;                                                               
90717000 END;                                                                               
90718000                                                                                    
90719000 %=======================================================================           
90720000                                                                                    
90721000 PROCEDURE SIMPLEELEMENT(PARAMETER,ELTYPE,WSPEC,DSPEC);                             
90722000 %         *************                                                            
90723000   VALUE PARAMETER,ELTYPE,WSPEC,DSPEC;                                              
90724000   REAL PARAMETER;                                                                  
90725000   INTEGER ELTYPE,WSPEC,DSPEC;                                                      
90726000   %---------------------------------------------------------------------           
90727000   %                                                                                
90728000   % SIMPLE-ELEMENT HANDLES ALL THE ONE-WORD THINGS EXCEPT SCALARS.                 
90729000   %     SUCH AS REAL, INTEGER, BOOLEAN, CHAR                                       
90730000   %     INCLUDES FACILITIES FOR EXACT-WIDTH INTEGERS                               
90731000   %     HEXADECIMAL/OCTAL/BINARY VALUES                                            
90732000   %     NON-ZERO-SUPPRESSED INTEGERS                                               
90733000   %                                                                                
90734000   %     PARAMETERS ARE:                                                            
90735000   %       THE THING TO BE CONVERTED                                                
90736000   %       THE TYPE OF THE THING'S CONVERSION                                       
90737000   %       THE WIDTH IN CHARACTER UNITS                                             
90738000   %       A SECOND SPECIFICATION USED FOR REAL AND RADIX                           
90739000   %                                                                                
90740000   %---------------------------------------------------------------------           
90741000 BEGIN                                                                              
90742000   DEFINE                                                                           
90743000         BPARAMETER=BOOLEAN(PARAMETER)#,                                            
90744000         RPARAMETER=PARAMETER#,                                                     
90745000         IPARAMETER=INTEGERT(PARAMETER)#,                                           
90746000         ASCIIFLAG =BOOLEAN(DSPEC)#;                                                
90747000   LABEL                                                                            
90748000         FINISHED;                                                                  
90749000   INTEGER                                                                          
90750000         INTPART,                % INTEGER PART OF NUMBER                           
90751000         BITS,                   % NO OF BITS IN A RADIX-CONVERSION                 
90752000         SIZE;                   % SIZE OF FIELD                                    
90753000   BOOLEAN                                                                          
90754000         SIGN;           % SIGN OF NUMBER                                           
90755000   DOUBLE                                                                           
90756000         DVALUE;                                                                    
90757000                                                                                    
90758000   INTEGER PROCEDURE EXPONENT(D);                                                   
90759000   %                *********                                                       
90760000   VALUE D; DOUBLE D;                                                               
90761000   BEGIN                                                                            
90762000     INTEGER CURRENT, STEPSIZE;                                                     
90763000     %                                                                              
90764000     IF (D < 10) THEN BEGIN                                                         
90765000       EXPONENT:=0;                                                                 
90766000     END ELSE BEGIN                                                                 
90767000       CURRENT:=0; STEPSIZE:=128;                                                   
90768000       DO BEGIN                                                                     
90769000         CURRENT:= CURRENT + (STEPSIZE:=STEPSIZE DIV 2);                            
90770000         IF (D < TENPOWER(CURRENT)) THEN BEGIN                                      
90771000           CURRENT:=CURRENT-STEPSIZE;                                               
90772000         END;                                                                       
90773000       END UNTIL (STEPSIZE <= 0);                                                   
90774000       EXPONENT:=CURRENT;                                                           
90775000     END; % OF IF                                                                   
90776000   END; % OF EXPONENT PROCEDURE                                                     
90777000                                                                                    
90778000   PROCEDURE FCONVERT(D,W1,W2,SIGN);                                                
90779000   %         ********                                                               
90780000     VALUE D,W1,W2,SIGN;                                                            
90781000     DOUBLE D;                                                                      
90782000     INTEGER W1,W2;                                                                 
90783000     BOOLEAN SIGN;                                                                  
90784000   BEGIN                                                                            
90785000       INTEGER LEADINGDIGITS, SIGDIGITS;                                            
90786000     IF (D>549755813887) THEN BEGIN                                                 
90787000       PERROR(10);                                                                  
90788000     END ELSE BEGIN                                                                 
90789000       %                                                                            
90790000       REPLACE PTR:PTR BY                                                           
90791000         (IF SIGN THEN "-     " ELSE "      ") FOR 1,                               
90792000         (LEADINGDIGITS:=INTEGERT(D)) FOR W1 DIGITS,                                
90793000         ".";                                                                       
90794000       SIGDIGITS:=(IF (W2 > 11) THEN 11 ELSE W2);                                   
90795000       REPLACE PTR:PTR BY                                                           
90796000         (INTEGERT((D-LEADINGDIGITS)*TENPOWER(SIGDIGITS)))                          
90797000           FOR SIGDIGITS DIGITS;                                                    
90798000       IF (W2 > SIGDIGITS) THEN BEGIN                                               
90799000         REPLACE PTR:PTR BY "0" FOR (W2-SIGDIGITS);                                 
90800000       END;                                                                         
90801000     END;                                                                           
90802000   END; % OF F-CONVERT                                                              
90803000                                                                                    
90804000   % CHECK THE SPECIFICATIONS FOR NEGATIVENESS                                      
90805000   IF (WSPEC < 0) THEN BEGIN                                                        
90806000     ERRORWITH1(1,WSPEC);                                                           
90807000     WSPEC:=0;                                                                      
90808000   END;                                                                             
90809000   IF (DSPEC < 0) THEN BEGIN                                                        
90810000     ERRORWITH1(2,DSPEC);                                                           
90811000     DSPEC:=0;                                                                      
90812000   END;                                                                             
90813000   IF EFLAG THEN RESTORE;                                                           
90814000                                                                                    
90815000   % WHAT REAL SIZE DOES OBJECT OCCUPY?                                             
90816000   CASE ELTYPE OF BEGIN                                                             
90817000     %                                                                              
90818000   CHARTYPE:                                                                        
90819000         SIZE:=1;                                                                   
90820000         IF (WSPEC = 0) THEN WSPEC:=1;                                              
90821000   INTTYPE:                                                                         
90822000         INTPART:=ABS(IPARAMETER);                                                  
90823000         SIZE:=DIGITSIN(INTPART);                                                   
90824000         IF (DSPEC > 0) THEN BEGIN                                                  
90825000           IF (SIZE < DSPEC) THEN SIZE:=DSPEC;                                      
90826000         END;                                                                       
90827000         IF (IPARAMETER < 0) THEN SIZE:=SIZE+1;                                     
90828000         IF (WSPEC = 0) THEN WSPEC:=SIZE+1;                                         
90829000   REALTYPE: ETYPE:                                                                 
90830000         SIGN:=(PARAMETER NEQ (ABS(PARAMETER)));                                    
90831000         IF (ELTYPE = REALTYPE) THEN BEGIN                                          
90832000           IF (WSPEC = 0) THEN DSPEC:=6;                                            
90833000           DVALUE:=ABS(RPARAMETER)+(0.5/TENPOWER(DSPEC));                           
90834000           EPOWER:=(IF (DVALUE < 1) THEN 1 ELSE EXPONENT(DVALUE)+1);                
90835000           SIZE:=(IF (EPOWER > 0) THEN EPOWER ELSE 1)+DSPEC+2;                      
90836000           IF (WSPEC = 0) THEN BEGIN                                                
90837000             WSPEC:=15;                                                             
90838000             IF (ABS(RPARAMETER) < 0.0001) OR (SIZE > 14) THEN                      
90839000               ELTYPE:=ETYPE;                                                       
90840000           END;                                                                     
90841000         END;                                                                       
90842000                                                                                    
90843000         IF (ELTYPE = ETYPE) THEN BEGIN                                             
90844000           IF (WSPEC = 0) THEN BEGIN                                                
90845000             WSPEC:=15;  DSPEC:=7;                                                  
90846000           END ELSE BEGIN                                                           
90847000             DSPEC:=MIN(11,MAX(1,(WSPEC-8)));                                       
90848000           END;                                                                     
90849000           SIZE:=DSPEC+7;                                                           
90850000         END;                                                                       
90851000   BOOLTYPE:                                                                        
90852000         SIZE:=(IF BPARAMETER THEN 4 ELSE 5);                                       
90853000         IF (WSPEC = 0) THEN WSPEC:=SIZE+1;                                         
90854000   RADIXTYPE:                                                                       
90855000         CASE DSPEC OF BEGIN                                                        
90856000           0: 16:        BITS:=4; DSPEC:=16;                                        
90857000           2:            BITS:=1;                                                   
90858000           4:            BITS:=2;                                                   
90859000           8:            BITS:=3;                                                   
90860000           ELSE:         ERRORWITH1(3,DSPEC); BITS:=4; DSPEC:=16;                   
90861000         END; % OF CASE                                                             
90862000         SIZE:=(IF (WSPEC>(48 DIV BITS)) THEN (48 DIV BITS) ELSE WSPEC);            
90863000         IF (WSPEC = 0) THEN WSPEC:= (SIZE:=48 DIV BITS) + 1;                       
90864000   END; % OF CASE                                                                   
90865000                                                                                    
90866000   % IS THERE ROOM FOR THIS OBJECT?                                                 
90867000   IF (COUNT < WSPEC) THEN BEGIN                                                    
90868000     % HERE WE HAVE A PROBLEM: IF ITS A CR CHARACTER AT THE                         
90869000     % LINE END, WE DON'T WANT TO FLUSHBUFFER TWICE.                                
90870000     IF (ELTYPE=CHARTYPE) THEN BEGIN                                                
90871000       IF (RPARAMETER = (IF ASCIIFLAG THEN 13 ELSE 12)) THEN BEGIN                  
90872000         IF COUNT = (WSPEC-1) THEN BEGIN                                            
90873000           FLUSHBUFFER;                                                             
90874000           GO FINISHED;                                                             
90875000         END;                                                                       
90876000       END;                                                                         
90877000     END;                                                                           
90878000     % EVERYTHING ELSE IS SIMPLE                                                    
90879000     FLUSHBUFFER;                                                                   
90880000   END;                                                                             
90881000                                                                                    
90882000   % IS THE WIDTH SPECIFIED BIG ENOUGH?                                             
90883000   IF (WSPEC < SIZE) THEN BEGIN                                                     
90884000     ASTERISKFILL(WSPEC);                                                           
90885000     ERRORWITH2(5,SIZE,WSPEC);                                                      
90886000     WSPEC:=SIZE;                                                                   
90887000   END;                                                                             
90888000                                                                                    
90889000   IF (WSPEC > LENGTH) THEN BEGIN                                                   
90890000     % ERROR - TOO BIG FOR LINE                                                     
90891000     ERRORWITH2(9,WSPEC,LENGTH);                                                    
90892000   END ELSE BEGIN                                                                   
90893000     % IS SPACE PADDING NEEDED?                                                     
90894000     IF (WSPEC > SIZE) THEN BEGIN                                                   
90895000       REPLACE PTR:PTR BY " " FOR (WSPEC-SIZE);                                     
90896000       COUNT:=COUNT-(WSPEC-SIZE);                                                   
90897000     END;                                                                           
90898000                                                                                    
90899000     % PUT THE OBJECT INTO THE SPACE                                                
90900000     CASE ELTYPE OF BEGIN                                                           
90901000           %                                                                        
90902000     CHARTYPE:                                                                      
90903000           IF ASCIIFLAG THEN BEGIN                                                  
90904000             IF (RPARAMETER = 13) THEN BEGIN                                        
90905000               FLUSHBUFFER;                                                         
90906000             END ELSE BEGIN                                                         
90907000               REPLACE PTR BY RPARAMETER.[7:48] FOR 1;                              
90908000               REPLACE PTR:PTR BY PTR FOR 1 WITH ASCIITOEBCDIC;                     
90909000             END;                                                                   
90910000           END ELSE BEGIN                                                           
90911000             IF (RPARAMETER = 13) THEN BEGIN                                        
90912000               FLUSHBUFFER;                                                         
90913000             END ELSE BEGIN                                                         
90914000               REPLACE PTR:PTR BY RPARAMETER.[7:48] FOR 1;                          
90915000             END;                                                                   
90916000           END;                                                                     
90917000     INTTYPE:                                                                       
90918000           IF (IPARAMETER < 0) THEN BEGIN                                           
90919000             REPLACE PTR:PTR BY "-";                                                
90920000             SIZE:=SIZE-1; COUNT:=COUNT-1;                                          
90921000           END;                                                                     
90922000           IF (SIZE > 12) THEN BEGIN                                                
90923000             REPLACE PTR:PTR BY "0" FOR (SIZE-12);                                  
90924000             COUNT:=COUNT-(SIZE-12);                                                
90925000             SIZE:=12;                                                              
90926000           END;                                                                     
90927000           REPLACE PTR:PTR BY INTPART FOR SIZE DIGITS;                              
90928000     REALTYPE:                                                                      
90929000           FCONVERT(DVALUE,(SIZE-DSPEC-2),DSPEC,SIGN);                              
90930000     ETYPE:                                                                         
90931000           DVALUE:=ABS(PARAMETER);                                                  
90932000           IF (DVALUE=0) THEN BEGIN                                                 
90933000             EPOWER := 0;                                                           
90934000           END ELSE BEGIN                                                           
90935000             IF (DVALUE < 1) THEN BEGIN                                             
90936000               EPOWER:=-EXPONENT(1/DVALUE);                                         
90937000               DVALUE:=DVALUE*TENPOWER(-EPOWER);                                    
90938000             END ELSE BEGIN                                                         
90939000               EPOWER:=EXPONENT(DVALUE);                                            
90940000               DVALUE:=DVALUE/TENPOWER(EPOWER);                                     
90941000             END;                                                                   
90942000           END;                                                                     
90943000           DVALUE:=DVALUE+(0.5/TENPOWER(DSPEC));         % ROUNDING                 
90944000           IF (DVALUE >= 10) THEN BEGIN                                             
90945000             % IN CASE ROUNDING WENT OVER 9.99999999                                
90946000             DVALUE:=DVALUE/10; EPOWER:=EPOWER+1;                                   
90947000           END;                                                                     
90948000                                                                                    
90949000           FCONVERT(DVALUE,1,DSPEC,SIGN);                                           
90950000                                                                                    
90951000           IF (EPOWER < 0) THEN BEGIN                                               
90952000             REPLACE PTR:PTR BY "E-", ABS(EPOWER) FOR 2 DIGITS;                     
90953000           END ELSE BEGIN                                                           
90954000             REPLACE PTR:PTR BY "E+", EPOWER FOR 2 DIGITS;                          
90955000           END;                                                                     
90956000     BOOLTYPE:                                                                      
90957000           IF BPARAMETER THEN BEGIN                                                 
90958000             REPLACE PTR:PTR BY "TRUE  " FOR 4;                                     
90959000           END ELSE BEGIN                                                           
90960000             REPLACE PTR:PTR BY "FALSE " FOR 5;                                     
90961000           END;                                                                     
90962000     RADIXTYPE:                                                                     
90963000           IF (WSPEC < (48 DIV BITS)) THEN BEGIN                                    
90964000             RPARAMETER:=RPARAMETER.[(WSPEC*BITS-1):48];                            
90965000           END;                                                                     
90966000           WHILE (SIZE > 0) DO BEGIN                                                
90967000           REPLACE PTR:PTR BY                                                       
90968000                   HEXCHAR[RPARAMETER.[47:BITS]] FOR 1;                             
90969000             RPARAMETER:=RPARAMETER.[(47-BITS):48];                                 
90970000             SIZE:=SIZE-1; COUNT:=COUNT-1;                                          
90971000           END;                                                                     
90972000           %                                                                        
90973000     END; % OF CASE                                                                 
90974000                                                                                    
90975000     % FINALIZE THE TRANSACTION                                                     
90976000     COUNT:=COUNT-SIZE;                                                             
90977000   END; % OF IF (WSPEC > LENGTH)                                                    
90978000                                                                                    
90979000 FINISHED:                                                                          
90980000   IF EFLAG THEN RESTORE;                                                           
90981000                                                                                    
90982000 END; % OF PROCEDURE SIMPLE-ELEMENT                                                 
90983000                                                                                    
90984000 %=======================================================================           
90985000                                                                                    
90986000 PROCEDURE STRINGELEMENT(P,L,ASCIIFLAG,WSPEC);                                      
90987000 %         *************                                                            
90988000   VALUE P,L,ASCIIFLAG,WSPEC;                                                       
90989000   POINTER P;                                                                       
90990000   INTEGER L,WSPEC;                                                                 
90991000   BOOLEAN ASCIIFLAG;                                                               
90992000   %---------------------------------------------------------------------           
90993000   %                                                                                
90994000   % STRING-ELEMENT HANDLES PASCAL ELEMENTS WHICH ARE STRINGS.                      
90995000   %                                                                                
90996000   %     THE PARAMETERS ARE:                                                        
90997000   %       A POINTER TO THE STRING START                                            
90998000   %       A LENGTH IN CHARACTER UNITS                                              
90999000   %       A WIDTH OF OUTPUT IN CHARACTER UNITS (0=DEFAULT)                         
91000000   %       A FLAG TO SHOW EBCDIC (0) OR ASCII(1)                                    
91001000   %                                                                                
91002000   %---------------------------------------------------------------------           
91003000 BEGIN                                                                              
91004000   %                                                                                
91005000                                                                                    
91006000   % TEST WIDTH SPECIFICATION                                                       
91007000   IF (WSPEC < 0) THEN BEGIN                                                        
91008000     ERRORWITH1(1,WSPEC);                                                           
91009000     WSPEC:=0;                                                                      
91010000   END;                                                                             
91011000   IF (WSPEC = 0) THEN BEGIN                                                        
91012000     WSPEC:=L;                                                                      
91013000   END;                                                                             
91014000   IF (WSPEC > COUNT) THEN BEGIN                                                    
91015000     FLUSHBUFFER;                                                                   
91016000     IF (WSPEC > LENGTH) THEN BEGIN                                                 
91017000       ERRORWITH2(6,WSPEC,LENGTH);                                                  
91018000       WSPEC:=LENGTH;                                                               
91019000     END;                                                                           
91020000   END;                                                                             
91021000                                                                                    
91022000   % ANY LEADING SPACES?                                                            
91023000   IF (WSPEC < L) THEN BEGIN                                                        
91024000     L:=WSPEC;                                                                      
91025000   END ELSE IF (WSPEC > L) THEN BEGIN                                               
91026000     REPLACE PTR:PTR BY " " FOR (WSPEC-L);                                          
91027000   END;                                                                             
91028000                                                                                    
91029000   % PUT OUT THE STRING                                                             
91030000   IF ASCIIFLAG THEN BEGIN                                                          
91031000     REPLACE PTR:PTR BY P FOR L WITH ASCIITOEBCDIC;                                 
91032000   END ELSE BEGIN                                                                   
91033000     REPLACE PTR:PTR BY P FOR L;                                                    
91034000   END;                                                                             
91035000                                                                                    
91036000   % FINALIZE TRANSACTION                                                           
91037000   COUNT:=COUNT-WSPEC;                                                              
91038000   IF EFLAG THEN RESTORE;                                                           
91039000                                                                                    
91040000 END; % OF PROCEDURE STRING-ELEMENT                                                 
91041000                                                                                    
91042000 %=======================================================================           
91043000                                                                                    
91044000 PROCEDURE SCALARELEMENT(PARAMETER,DESCRIPTION,WSPEC);                              
91045000 %         *************                                                            
91046000   VALUE PARAMETER,DESCRIPTION,WSPEC;                                               
91047000   INTEGER PARAMETER,WSPEC;                                                         
91048000   POINTER DESCRIPTION;                                                             
91049000   %---------------------------------------------------------------------           
91050000   %                                                                                
91051000   % SCALAR-ELEMENT HANDLES USER-DEFINED SCALAR VALUES                              
91052000   %                                                                                
91053000   %     THE PARAMETERS ARE:                                                        
91054000   %       THE SCALAR TO BE PRINTED                                                 
91055000   %       A POINTER TO STRING OF CONSTANT NAMES                                    
91056000   %       THE WIDTH IN CHARACTER UNITS                                             
91057000   %                                                                                
91058000   %---------------------------------------------------------------------           
91059000 BEGIN                                                                              
91060000   INTEGER L,SCALARVALUE;                                                           
91061000   POINTER P;                                                                       
91062000                                                                                    
91063000   P:=DESCRIPTION;                                                                  
91064000   L:=REAL(P,1);                                                                    
91065000   SCALARVALUE:=0;                                                                  
91066000   WHILE (SCALARVALUE < PARAMETER) AND (L NEQ 0) DO BEGIN                           
91067000     P:=P+(L+1); L:=REAL(P,1);                                                      
91068000     SCALARVALUE:=SCALARVALUE+1;                                                    
91069000   END;                                                                             
91070000                                                                                    
91071000   IF (WSPEC = 0) THEN WSPEC:=L+1;                                                  
91072000   IF (L = 0) THEN BEGIN                                                            
91073000     % ERROR, PARAMETER OUT OF RANGE                                                
91074000     ASTERISKFILL(WSPEC);                                                           
91075000     ERRORWITH1(7,PARAMETER);                                                       
91076000   END ELSE BEGIN                                                                   
91077000     IF (WSPEC < L) THEN BEGIN                                                      
91078000       % ERROR, WIDTH NOT BIG ENOUGH                                                
91079000       ASTERISKFILL(WSPEC);                                                         
91080000       ERRORWITH2(8,WSPEC,L);                                                       
91081000       WSPEC:=L;                                                                    
91082000     END;                                                                           
91083000     % THEN CONVERT IT OUT...                                                       
91084000     IF (WSPEC > COUNT) THEN FLUSHBUFFER;                                           
91085000     IF (WSPEC > LENGTH) THEN BEGIN                                                 
91086000       % ERROR, TOO LONG FOR LINE LENGTH                                            
91087000       ERRORWITH2(9,WSPEC,LENGTH);                                                  
91088000     END ELSE BEGIN                                                                 
91089000       % YES, ITS GOOD AFTER ALL THAT.                                              
91090000       IF (WSPEC > L) THEN BEGIN                                                    
91091000         REPLACE PTR:PTR BY " " FOR (WSPEC-L);                                      
91092000       END;                                                                         
91093000       REPLACE PTR:PTR BY (P+1) FOR L;                                              
91094000       COUNT:=COUNT-WSPEC;                                                          
91095000     END;                                                                           
91096000   END;                                                                             
91097000                                                                                    
91098000   IF EFLAG THEN RESTORE;                                                           
91099000                                                                                    
91100000 END; % OF SCALAR-ELEMENT                                                           
91101000                                                                                    
91102000 %==============EXECUTABLE MAIN FOLLOWS==================================           
91103000                                                                                    
91104000   IF (FYLESTATUS NEQ 3) THEN BEGIN                                                 
91105000     IF (FYLESTATUS = 0) THEN BEGIN       % FILE IS NOT BUSY                        
91106000       FYLESTATUS:=3;                     % SET FILE BUSY FOR WRITE                 
91107000       IF (FYLE.KIND NEQ VALUE(REMOTE)) THEN BEGIN                                  
91108000         IF NOT FYLE.OPEN THEN BEGIN                                                
91109000           FYLE.MYUSE:=VALUE(OUT);                                                  
91110000         END;                                                                       
91111000       END;                                                                         
91112000       FYLE.OPEN:=TRUE;                  % SO ATTRIBUTES ARE RIGHT                  
91113000       FYLEMAXRECSIZE:= LENGTH:= FYLE.MAXRECSIZE;                                   
91114000       FYLETYPE:=FYLE.FILETYPE;          % NOT USED BY WRITE                        
91115000       IF (FYLE.UNITS = VALUE(WORDS)) THEN LENGTH:=LENGTH*6;                        
91116000       IF (FYLE.KIND = VALUE(PUNCH)) THEN LENGTH:=80;                               
91117000       FYLEBUFLENGTH:= COUNT:= LENGTH;                                              
91118000     END ELSE BEGIN                                                                 
91119000       DISPLAY(ERRMSG[25]);                                                         
91120000       MYSELF.STATUS:=-1;                                                           
91121000     END;                                                                           
91122000   END ELSE BEGIN                                                                   
91123000     LENGTH:=FYLEBUFLENGTH;                                                         
91124000     COUNT:=FYLECOUNT;                                                              
91125000   END;                                                                             
91126000   IF(COUNT=0) THEN BEGIN                                                           
91126100     FLUSHBUFFER;                                                                   
91126200     FLUSHDONE:=TRUE;                                                               
91126300   END;                                                                             
91127000   PTR:=BUFFER[LENGTH-COUNT];                                                       
91128000                                                                                    
91129000   WRITELN:=FYLELIST(SIMPLEELEMENT,                                                 
91130000                     STRINGELEMENT,                                                 
91131000                     SCALARELEMENT);                                                
91132000                                                                                    
91133000   IF WRITELN AND                                                                   
91133100     ((COUNT NEQ LENGTH) OR (COUNT=LENGTH AND NOT FLUSHDONE)) THEN                  
91133200     FLUSHBUFFER;                                                                   
91134000                                                                                    
91135000   FYLECOUNT:=COUNT;                                                                
91136000                                                                                    
91137000 END; % OF PASCAL-WRITE                                                             
91138000 BOOLEAN PROCEDURE PASCALARRAYEQUAL(AI,A,BI,B,L,FAST);                              
91139000 %                 ****************                                                 
91140000   VALUE AI,BI,L,FAST;                                                              
91141000   REAL ARRAY A[0],B[0];                                                            
91142000   INTEGER AI,BI,L;                                                                 
91143000   BOOLEAN FAST;                                                                    
91144000 %-----------------------------------------------------------------------           
91145000 %                                                                                  
91146000 % PASCALARRAYEQUAL COMPARES TWO PASCAL ARRAYS STARTING FROM                        
91147000 %       A[AI] AND B[BI] FOR L WORDS.                                               
91148000 %       THIS VERSION WORKS FOR SEGMENTED ARRAYS IF (FAST=FALSE)                    
91149000 %       IF FAST=TRUE THEN VECTORMODE CODE IS USED                                  
91150000 %                                                                                  
91151000 %-----------------------------------------------------------------------           
91152000 BEGIN                                                                              
91153000   LABEL                                                                            
91154000  $SET OMIT=NOT VMODE                                                               
91155000         NOTTRUE,                                                                   
91156000  $POP OMIT                                                                         
91157000         EXIT;                                                                      
91158000   INTEGER ALIMIT;                                                                  
91159000   %                                                                                
91160000  $SET OMIT=NOT VMODE                                                               
91161000   IF NOT FAST THEN BEGIN                                                           
91162000  $POP OMIT                                                                         
91163000     % NOT VECTORMODE CODE                                                          
91164000     ALIMIT:=AI+L;                                                                  
91165000     DO BEGIN                                                                       
91166000       IF (A[AI] NEQ B[BI]) THEN BEGIN                                              
91167000         PASCALARRAYEQUAL:=FALSE;                                                   
91168000         GO EXIT;                                                                   
91169000       END;                                                                         
91170000       BI:=BI+1;                                                                    
91171000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91172000     PASCALARRAYEQUAL:=TRUE;                                                        
91173000  $SET OMIT=NOT VMODE                                                               
91174000   END ELSE BEGIN                                                                   
91175000     DO VECTORMODE                                                                  
91176000       (A[AI],B[BI], FOR L) BEGIN                                                   
91177000       IF (A NEQ B) THEN GO NOTTRUE;                                                
91178000       INCREMENT A,B;                                                               
91179000     END;                                                                           
91180000     PASCALARRAYEQUAL:=TRUE;                                                        
91181000     GO EXIT;                                                                       
91182000 NOTTRUE:                                                                           
91183000     PASCALARRAYEQUAL:=FALSE;                                                       
91184000   END;                                                                             
91185000  $POP OMIT                                                                         
91186000 EXIT:                                                                              
91187000 END; % OF PASCAL ARRAY EQUAL                                                       
91188000                                                                                    
91189000 INTEGER PROCEDURE PASCALARRAYCOMPARE(AI,A,BI,B,L,FAST);                            
91190000 %                 ******************                                               
91191000   VALUE AI,BI,L,FAST;                                                              
91192000   REAL ARRAY A[0],B[0];                                                            
91193000   INTEGER AI,BI,L;                                                                 
91194000   BOOLEAN FAST;                                                                    
91195000 %-----------------------------------------------------------------------           
91196000 %                                                                                  
91197000 % PASCALARRAYCOMPARE COMPARES TWO WORD ARRAYS FOR PASCAL USING                     
91198000 %       ARITHMETIC COMPARISONS, AS FOR PASCALARRAYEQUAL.                           
91199000 %       THIS VERSION WORKS FOR SEGMENTED ARRAYS IF FAST=FALSE.                     
91200000 %       IF FAST=TRUE THEN VECTORMODE IS USED.                                      
91201000 %                                                                                  
91202000 %-----------------------------------------------------------------------           
91203000 BEGIN                                                                              
91204000   LABEL EXIT;                                                                      
91205000   INTEGER ALIMIT,AT,BT,RESULT;                                                     
91206000   DEFINE LESS=0#,EQUAL=1#,GREATER=2#;                                              
91207000   %                                                                                
91208000  $SET OMIT=NOT VMODE                                                               
91209000   IF NOT FAST THEN BEGIN                                                           
91210000  $POP OMIT                                                                         
91211000     % NOT VECTORMODE CODE                                                          
91212000     ALIMIT:=AI+L;                                                                  
91213000     DO BEGIN                                                                       
91214000       IF ((AT:=A[AI]) < (BT:=B[BI])) THEN BEGIN                                    
91215000         RESULT:=LESS;                                                              
91216000         GO EXIT;                                                                   
91217000       END;                                                                         
91218000       IF (AT > BT) THEN BEGIN                                                      
91219000         RESULT:=GREATER;                                                           
91220000         GO EXIT;                                                                   
91221000       END;                                                                         
91222000       BI:=BI+1;                                                                    
91223000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91224000  $SET OMIT=NOT VMODE                                                               
91225000   END ELSE BEGIN                                                                   
91226000     % VECTORMODE CODE                                                              
91227000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91228000       IF (A < B) THEN BEGIN                                                        
91229000         RESULT:=LESS;                                                              
91230000         GO EXIT;                                                                   
91231000       END;                                                                         
91232000       IF (A > B) THEN BEGIN                                                        
91233000         RESULT:=GREATER;                                                           
91234000         GO EXIT;                                                                   
91235000       END;                                                                         
91236000       INCREMENT A,B;                                                               
91237000     END;                                                                           
91238000   END;                                                                             
91239000  $POP OMIT                                                                         
91240000   RESULT:=EQUAL;                                                                   
91241000 EXIT:                                                                              
91242000   PASCALARRAYCOMPARE:=RESULT;                                                      
91243000 END; % OF PASCAL-ARRAY-COMPARE                                                     
91244000 PROCEDURE PASCALLONGSETOPERATOR(AI,A,BI,B,L,FUNC);                                 
91245000 %         *********************                                                    
91246000   VALUE AI,BI,L,FUNC;                                                              
91247000   BOOLEAN ARRAY A[0],B[0];                                                         
91248000   INTEGER AI,BI,L,FUNC;                                                            
91249000 %-----------------------------------------------------------------------           
91250000 %                                                                                  
91251000 % PASCALLONGSETOPERATOR IMPLEMENTS THE OPERATORS + * -                             
91252000 %       FOR LONG SETS (MORE THAN A WORD).                                          
91253000 %       FUNC DETERMINES WHETHER VECTORMODE IS USED OR NOT.                         
91254000 %                                                                                  
91255000 %-----------------------------------------------------------------------           
91256000 BEGIN                                                                              
91257000   INTEGER ALIMIT;                                                                  
91258000   DEFINE UNIONOP=0#, INTERSECTIONOP=1#, SUBTRACTIONOP=2#,                          
91259000         VUNIONOP=3#,VINTERSECTIONOP=4#,VSUBTRACTIONOP=5#;                          
91260000   CASE FUNC OF BEGIN                                                               
91261000   UNIONOP:                                                                         
91262000     ALIMIT:=AI+L;                                                                  
91263000     DO BEGIN                                                                       
91264000       A[AI]:=* OR B[BI];                                                           
91265000       BI:=BI+1;                                                                    
91266000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91267000   INTERSECTIONOP:                                                                  
91268000     ALIMIT:=AI+L;                                                                  
91269000     DO BEGIN                                                                       
91270000       A[AI]:=* AND B[BI];                                                          
91271000       BI:=BI+1;                                                                    
91272000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91273000   SUBTRACTIONOP:                                                                   
91274000     ALIMIT:=AI+L;                                                                  
91275000     DO BEGIN                                                                       
91276000       A[AI]:=* AND (NOT B[BI]);                                                    
91277000       BI:=BI+1;                                                                    
91278000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91279000     %                                                                              
91280000  $SET OMIT=NOT VMODE                                                               
91281000   VUNIONOP:                                                                        
91282000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91283000       A:=A OR B;                                                                   
91284000       INCREMENT A,B;                                                               
91285000     END;                                                                           
91286000   VINTERSECTIONOP:                                                                 
91287000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91288000       A:=A AND B;                                                                  
91289000       INCREMENT A,B;                                                               
91290000     END;                                                                           
91291000   VSUBTRACTIONOP:                                                                  
91292000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91293000       A:=A AND NOT B;                                                              
91294000       INCREMENT A,B;                                                               
91295000     END;                                                                           
91296000   %                                                                                
91297000  $POP OMIT                                                                         
91298000   END; % OF CASE                                                                   
91299000 END; % OF PASCAL LONG SET OPERATOR                                                 
91300000                                                                                    
91301000 BOOLEAN PROCEDURE PASCALLONGSETCOMPARE(AI,A,BI,B,L,FUNC);                          
91302000 %                 ********************                                             
91303000   VALUE AI,BI,L,FUNC;                                                              
91304000   BOOLEAN ARRAY A[0],B[0];                                                         
91305000   INTEGER AI,BI,L,FUNC;                                                            
91306000 %-----------------------------------------------------------------------           
91307000 %                                                                                  
91308000 % PASCALLONGSETCOMPARE IMPLEMENTS COMPARISONS  = >= <=                             
91309000 %       ON LONG SETS (MORE THAN A WORD).                                           
91310000 %       FUNC DETERMINES WHETHER VECTORMODE IS USED OR NOT.                         
91311000 %                                                                                  
91312000 %-----------------------------------------------------------------------           
91313000 BEGIN                                                                              
91314000   INTEGER ALIMIT;                                                                  
91315000   LABEL EXIT,NOTTRUE;                                                              
91316000   DEFINE EQUAL=0#, RIGHTINCLUSION=1#, LEFTINCLUSION=2#,                            
91317000         VEQUAL=3#,VRIGHTINCLUSION=4#,VLEFTINCLUSION=5#;                            
91318000   %                                                                                
91319000   CASE FUNC OF BEGIN                                                               
91320000   %                                                                                
91321000   EQUAL:                                                                           
91322000     ALIMIT:=AI+L;                                                                  
91323000     DO BEGIN                                                                       
91324000       IF (REAL(A[AI]) ISNT REAL(B[BI])) THEN GO NOTTRUE;                           
91325000       BI:=BI+1;                                                                    
91326000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91327000   RIGHTINCLUSION:                                                                  
91328000     ALIMIT:=AI+L;                                                                  
91329000     DO BEGIN                                                                       
91330000       IF (REAL((NOT A[AI]) AND B[BI]) ISNT 0) THEN GO NOTTRUE;                     
91331000       BI:=BI+1;                                                                    
91332000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91333000   LEFTINCLUSION:                                                                   
91334000     ALIMIT:=AI+L;                                                                  
91335000     DO BEGIN                                                                       
91336000       IF (REAL(A[AI] AND (NOT B[BI])) ISNT 0) THEN GO NOTTRUE;                     
91337000       BI:=BI+1;                                                                    
91338000     END UNTIL ((AI:=AI+1) >= ALIMIT);                                              
91339000  $SET OMIT=NOT VMODE                                                               
91340000     %                                                                              
91341000   VEQUAL:                                                                          
91342000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91343000       IF (REAL(A) ISNT REAL(B)) THEN GO NOTTRUE;                                   
91344000       INCREMENT A,B;                                                               
91345000     END;                                                                           
91346000   VRIGHTINCLUSION:                                                                 
91347000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91348000       IF (REAL((NOT A) AND B) ISNT 0) THEN GO NOTTRUE;                             
91349000       INCREMENT A,B;                                                               
91350000     END;                                                                           
91351000   VLEFTINCLUSION:                                                                  
91352000     DO VECTORMODE (A[AI],B[BI], FOR L) BEGIN                                       
91353000       IF (REAL(A AND (NOT B)) ISNT 0) THEN GO NOTTRUE;                             
91354000       INCREMENT A,B;                                                               
91355000     END;                                                                           
91356000   %                                                                                
91357000  $POP OMIT                                                                         
91358000   END; % OF CASE                                                                   
91359000   PASCALLONGSETCOMPARE:=TRUE;                                                      
91360000   GO EXIT;                                                                         
91361000 NOTTRUE:                                                                           
91362000   PASCALLONGSETCOMPARE:=FALSE;                                                     
91363000 EXIT:                                                                              
91364000 END; % OF PASCAL LONG SET COMPARE                                                  
91365000                                                                                    
91366000 INTEGER PROCEDURE PASCALLONGSETCARDINALITY(AI,A,L);                                
91367000 %                 ************************                                         
91368000   VALUE AI,L;                                                                      
91369000   INTEGER AI,L;                                                                    
91370000   BOOLEAN ARRAY A[0];                                                              
91371000 %-----------------------------------------------------------------------           
91372000 %                                                                                  
91373000 % PASCALLONGSETCARDINALITY MEASURES THE NUMBER OF ELEMENTS IN                      
91374000 %       THE LONG SET GIVEN TO IT.                                                  
91375000 %                                                                                  
91376000 %-----------------------------------------------------------------------           
91377000 BEGIN                                                                              
91378000   INTEGER ALIMIT,COUNT;                                                            
91379000   %                                                                                
91380000   COUNT:=0;                                                                        
91381000   ALIMIT:=AI+L;                                                                    
91382000   DO BEGIN                                                                         
91383000     COUNT:=COUNT+ONES(REAL(A[AI]));                                                
91384000   END UNTIL ((AI:=AI+1) >= ALIMIT);                                                
91385000   PASCALLONGSETCARDINALITY:=COUNT;                                                 
91386000 END;                                                                               
91387000 PROCEDURE PASCALTIMESTAMP(YEARINDEX,TIMEVECTOR);                                   
91388000 %         ***************                                                          
91389000   VALUE YEARINDEX;                                                                 
91390000   INTEGER YEARINDEX;                                                               
91391000   INTEGER ARRAY TIMEVECTOR[0];                                                     
91392000 BEGIN                                                                              
91393000   REAL TMDY;                                                                       
91394000   INTEGER SECONDS;                                                                 
91395000                                                                                    
91396000   DEFINE INT(W,P1,P2)=((W.[P1:4]*10)+(W.[P2:4]))#;                                 
91397000                                                                                    
91398000   SECONDS:=TIME(1)/60;                                                             
91399000   TMDY:=TIME(15);                                                                  
91400000   TIMEVECTOR[YEARINDEX  ]:=INT(TMDY,11,03)+1900;                                   
91401000   TIMEVECTOR[YEARINDEX+1]:=INT(TMDY,43,35);                                        
91402000   TIMEVECTOR[YEARINDEX+2]:=INT(TMDY,27,19);                                        
91403000   TIMEVECTOR[YEARINDEX+5]:=SECONDS MOD 60;                                         
91404000   TIMEVECTOR[YEARINDEX+4]:=(SECONDS:=SECONDS DIV 60) MOD 60;                       
91405000   TIMEVECTOR[YEARINDEX+3]:=(SECONDS DIV 60) MOD 24;                                
91406000 END;                                                                               
91407000                                                                                    
91408000 PROCEDURE PASCALFLUSHBUFFER(FYLE,FYLEBUFFER,FYLEDATA);                             
91409000 %         *****************                                                        
91410000 FILE FYLE;                                                                         
91411000 EBCDIC ARRAY FYLEBUFFER[0];                                                        
91412000 REAL ARRAY FYLEDATA[0];                                                            
91413000 BEGIN                                                                              
91414000   POINTER PTR;                                                                     
91415000   EBCDIC VALUE ARRAY                                                               
91416000     ERRMSG("ERROR: END OF WRITE-FILE"48"00");                                      
91417000   DEFINE                                                                           
91418000         FYLERESULT      =FYLEDATA[0]#,                                             
91419000         FYLESTATUS      =FYLEDATA[1]#,                                             
91420000         FYLEBUFLENGTH   =FYLEDATA[2]#,                                             
91421000         FYLECOUNT       =FYLEDATA[3]#,                                             
91422000         FYLEMAXRECSIZE  =FYLEDATA[4]#,                                             
91423000         FYLETYPE        =FYLEDATA[5]#;                                             
91424000                                                                                    
91425000   IF(FYLESTATUS = 3) THEN BEGIN   %OUTPUT FILES                                    
91426000     IF(FYLECOUNT NEQ FYLEBUFLENGTH) THEN BEGIN                                     
91427000       IF (FYLECOUNT > 0) THEN BEGIN                                                
91428000         PTR:=FYLEBUFFER[FYLEBUFLENGTH-FYLECOUNT];                                  
91429000         REPLACE PTR BY " " FOR FYLECOUNT;                                          
91430000       END;                                                                         
91431000       IF BOOLEAN(FYLERESULT) THEN BEGIN                                            
91432000         DISPLAY(ERRMSG);                                                           
91433000         MYSELF.STATUS:=-1;                                                         
91434000       END;                                                                         
91435000       FYLERESULT:=REAL(WRITE(FYLE,FYLEMAXRECSIZE,FYLEBUFFER[*]));                  
91436000       FYLECOUNT := FYLEBUFLENGTH;                                                  
91437000     END;                                                                           
91438000   END;                                                                             
91439000 END;                                                                               
91440000 PROCEDURE PASCALLONGSETBITS(I,J,AI,A,LOWERBOUND,UPPERBOUND);                       
91441000 %         *****************                                                        
91442000   VALUE I,J,AI,LOWERBOUND,UPPERBOUND;                                              
91443000   INTEGER I,J,LOWERBOUND,AI,UPPERBOUND;                                            
91444000   BOOLEAN ARRAY A[0];                                                              
91445000 %**********************************************                                    
91446000 %                                                                                  
91447000 % PROCEDURE FOR SETTING BIT I TO J OF AN ARRAY                                     
91448000 %   FOR A LONG SET.                                                                
91449000 %                                                                                  
91450000 %**********************************************                                    
91451000 BEGIN                                                                              
91452000   EBCDIC VALUE ARRAY MSG(" SET BOUNDS EXCEEDED   "48"00");                         
91453000   INTEGER IW,IB,JW,JB;                                                             
91454000                                                                                    
91455000   IF I<=J THEN BEGIN                                                               
91456000     IF (I<LOWERBOUND) OR (J>UPPERBOUND) THEN                                       
91457000         BEGIN                                                                      
91458000           DISPLAY(MSG);                                                            
91459000           MYSELF.STATUS:=-1;                                                       
91460000         END;                                                                       
91461000     I:=I-LOWERBOUND;                                                               
91462000     J:=J-LOWERBOUND;                                                               
91463000     IW:=I DIV 48;                                                                  
91464000     JW:=J DIV 48;                                                                  
91465000     IB:=I-IW*48;                                                                   
91466000     JB:=J-JW*48;                                                                   
91467000     IF IW=JW THEN BEGIN                                                            
91468000       A[AI+IW]:=A[AI+IW]&NOT FALSE[47-IB:JB-IB+1]                                  
91469000     END ELSE BEGIN                                                                 
91470000       A[AI+IW]:=A[AI+IW]&NOT FALSE[47-IB:48-IB];                                   
91471000       IW:=IW+1;                                                                    
91472000       WHILE IW NEQ JW DO                                                           
91473000         BEGIN                                                                      
91474000           A[AI+IW]:=NOT FALSE;                                                     
91475000           IW:=IW+1;                                                                
91476000         END;                                                                       
91477000       A[AI+JW]:=A[AI+JW]&NOT FALSE[47:JB+1];                                       
91478000     END;                                                                           
91479000   END;                                                                             
91480000 END;                                                                               
91481000 BOOLEAN PROCEDURE PASCALLONGSETIN(I,AI,A,LOWERBOUND,UPPERBOUND);                   
91482000 %                 ***************                                                  
91483000 VALUE I,AI,LOWERBOUND,UPPERBOUND;                                                  
91484000 INTEGER I,AI,LOWERBOUND,UPPERBOUND;                                                
91485000 BOOLEAN ARRAY A[0];                                                                
91486000                                                                                    
91487000 BEGIN                                                                              
91488000 INTEGER                                                                            
91489000   IWORD,IBIT;                                                                      
91490000                                                                                    
91491000   IF (I<LOWERBOUND) THEN BEGIN                                                     
91492000     PASCALLONGSETIN := FALSE;                                                      
91493000   END ELSE BEGIN                                                                   
91494000     IF (I>UPPERBOUND) THEN BEGIN                                                   
91495000       PASCALLONGSETIN := FALSE;                                                    
91496000     END ELSE BEGIN                                                                 
91497000       I:=I-LOWERBOUND;                                                             
91498000       IWORD := I DIV 48;                                                           
91499000       IBIT := 47 - (I MOD 48);                                                     
91500000       PASCALLONGSETIN := A[AI+IWORD].[IBIT:1];                                     
91501000     END;                                                                           
91502000   END;                                                                             
91503000 END;    %OF PASCALLONGSETIN                                                        
91504000                                                                                    
91505000                                                                                    
91506000 PROCEDURE PASCALPACK(UNPACKED,ULOWER,UUPPER,UDPLMT,I,PACKPROC);                    
91507000 %         **********                                                               
91508000 VALUE ULOWER,UUPPER,UDPLMT,I;                                                      
91509000 ARRAY UNPACKED[0];                                                                 
91510000 INTEGER ULOWER,UUPPER,UDPLMT,I;                                                    
91511000 PROCEDURE PACKPROC(PACK1BIT,PACK4BITS,PACK6BITS,PACK8BITS,PACK48BITS);             
91512000   PROCEDURE PACK1BIT(PA,PL,PU,PO);                                                 
91513000     VALUE PL,PU,PO;                                                                
91514000     ARRAY PA[0];                                                                   
91515000     INTEGER PL,PU,PO;                                                              
91516000     FORMAL;                                                                        
91517000   PROCEDURE PACK4BITS(PA,PL,PU,PO,PB);                                             
91518000     VALUE PL,PU,PO,PB;                                                             
91519000     HEX ARRAY PA[0];                                                               
91520000     INTEGER PL,PU,PO,PB;                                                           
91521000     FORMAL;                                                                        
91522000   PROCEDURE PACK6BITS(PA,PL,PU,PO,PB);                                             
91523000     VALUE PL,PU,PO,PB;                                                             
91524000     BCL ARRAY PA[0];                                                               
91525000     INTEGER PL,PU,PO,PB;                                                           
91526000     FORMAL;                                                                        
91527000   PROCEDURE PACK8BITS(PA,PL,PU,PO,PB);                                             
91528000     VALUE PL,PU,PO,PB;                                                             
91529000     EBCDIC ARRAY PA[0];                                                            
91530000     INTEGER PL,PU,PO,PB;                                                           
91531000     FORMAL;                                                                        
91532000   PROCEDURE PACK48BITS(PA,PL,PU,PO,PB);                                            
91533000     VALUE PL,PU,PO,PB;                                                             
91534000     ARRAY PA[0];                                                                   
91535000     INTEGER PL,PU,PO,PB;                                                           
91536000     FORMAL;                                                                        
91537000 FORMAL;                                                                            
91538000 BEGIN                                                                              
91539000                                                                                    
91540000 INTEGER J,TEMP,TEMP2;                                                              
91541000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91542000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91543000                                                                                    
91544000 DEFINE                                                                             
91545000   ERROR = BEGIN                                                                    
91546000     DISPLAY(ERRMSG);                                                               
91547000     MYSELF.STATUS:=-1;                                                             
91548000   END#;                                                                            
91549000                                                                                    
91550000                                                                                    
91551000 PROCEDURE PACK1BIT(PACKED,PLOWER,PUPPER,PDPLMT);                                   
91552000 %         ********                                                                 
91553000 VALUE PLOWER,PUPPER,PDPLMT;                                                        
91554000 ARRAY PACKED[0];                                                                   
91555000 INTEGER PLOWER,PUPPER,PDPLMT;                                                      
91556000 BEGIN                                                                              
91557000   INTEGER                                                                          
91558000     IWORD,                                                                         
91559000     IBIT;                                                                          
91560000   TEMP:=UDPLMT+I-ULOWER;                                                           
91561000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91562000     IWORD:=((J-PDPLMT) DIV 48) + PDPLMT;                                           
91563000     IBIT:=47-((J-PDPLMT) MOD 48);                                                  
91564000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91565000     PACKED[IWORD].[IBIT:1]:=UNPACKED[J+TEMP-PDPLMT];                               
91566000   END;                                                                             
91567000 END;   %OF PACK1BIT                                                                
91568000                                                                                    
91569000 PROCEDURE PACK4BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE);                        
91570000 %         *********                                                                
91571000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                              
91572000 HEX ARRAY PACKED[0];                                                               
91573000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                            
91574000 BEGIN                                                                              
91575000   TEMP:=UDPLMT+I-ULOWER;                                                           
91576000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91577000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91578000     TEMP2:=UNPACKED[J+TEMP-PDPLMT]-PSUBRBASE;                                      
91579000     REPLACE PACKED[J] BY TEMP2.[3:48] FOR 1;                                       
91580000   END;                                                                             
91581000 END;   %OF PACK4BITS                                                               
91582000                                                                                    
91583000 PROCEDURE PACK6BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE);                        
91584000 %         *********                                                                
91585000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                              
91586000 BCL ARRAY PACKED[0];                                                               
91587000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                            
91588000 BEGIN                                                                              
91589000   TEMP:=UDPLMT+I-ULOWER;                                                           
91590000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91591000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91592000     TEMP2:=UNPACKED[J+TEMP-PDPLMT]-PSUBRBASE;                                      
91593000     REPLACE PACKED[J] BY TEMP2.[5:48] FOR 1;                                       
91594000   END;                                                                             
91595000 END;   %OF PACK6BITS                                                               
91596000                                                                                    
91597000 PROCEDURE PACK8BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE);                        
91598000 %         *********                                                                
91599000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                              
91600000 EBCDIC ARRAY PACKED[0];                                                            
91601000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                            
91602000 BEGIN                                                                              
91603000   TEMP:=UDPLMT+I-ULOWER;                                                           
91604000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91605000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91606000     TEMP2:=UNPACKED[J+TEMP-PDPLMT]-PSUBRBASE;                                      
91607000     REPLACE PACKED[J] BY TEMP2.[7:48] FOR 1;                                       
91608000   END;                                                                             
91609000 END;   %OF PACK8BITS                                                               
91610000                                                                                    
91611000 PROCEDURE PACK48BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE);                       
91612000 %         *********                                                                
91613000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                              
91614000 ARRAY PACKED[0];                                                                   
91615000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE;                                            
91616000 BEGIN                                                                              
91617000   TEMP:=UDPLMT+I-ULOWER;                                                           
91618000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91619000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91620000     PACKED[J]:=UNPACKED[J+TEMP-PDPLMT]-PSUBRBASE;                                  
91621000   END;                                                                             
91622000 END;   %OF PACK48BITS                                                              
91623000                                                                                    
91624000 %=======================================================================           
91625000 %       MAIN SECTION OF PACK                                                       
91626000 %=======================================================================           
91627000                                                                                    
91628000   PACKPROC(PACK1BIT,                                                               
91629000            PACK4BITS,                                                              
91630000            PACK6BITS,                                                              
91631000            PACK8BITS,                                                              
91632000            PACK48BITS);                                                            
91633000 END;   %OF PASCALPACK                                                              
91634000                                                                                    
91635000 PROCEDURE PASCALUNPACK1BIT(PACKED,PLOWER,PUPPER,PDPLMT,                            
91636000 %         ****************                                                         
91637000       UNPACKED,ULOWER,UUPPER,UDPLMT,I);                                            
91638000 VALUE PLOWER,PUPPER,PDPLMT,ULOWER,UUPPER,UDPLMT,I;                                 
91639000 ARRAY PACKED[0],UNPACKED[0];                                                       
91640000 INTEGER PLOWER,PUPPER,PDPLMT,ULOWER,UUPPER,UDPLMT,I;                               
91641000 BEGIN                                                                              
91642000   INTEGER                                                                          
91643000     J,                                                                             
91644000   TEMP,                                                                            
91645000     IBIT,                                                                          
91646000     IWORD;                                                                         
91647000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91648000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91649000                                                                                    
91650000 DEFINE                                                                             
91651000   ERROR = BEGIN                                                                    
91652000     DISPLAY(ERRMSG);                                                               
91653000     MYSELF.STATUS:=-1;                                                             
91654000   END#;                                                                            
91655000                                                                                    
91656000   TEMP:=UDPLMT+I-ULOWER;                                                           
91657000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91658000     IWORD:=((J-PDPLMT) DIV 48)+PDPLMT;                                             
91659000     IBIT:=47-((J-PDPLMT) MOD 48);                                                  
91660000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91661000     UNPACKED[J+TEMP-PDPLMT]:=PACKED[IWORD].[IBIT:1];                               
91662000   END;                                                                             
91663000 END;   %OF PASCALUNPACK1BIT                                                        
91664000                                                                                    
91665000                                                                                    
91666000 PROCEDURE PASCALUNPACK4BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE,                 
91667000 %         ****************                                                         
91668000       UNPACKED,ULOWER,UUPPER,UDPLMT,I);                                            
91669000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                       
91670000 ARRAY UNPACKED[0];  HEX ARRAY PACKED[0];                                           
91671000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                     
91672000 BEGIN                                                                              
91673000   INTEGER                                                                          
91674000     TEMP,                                                                          
91675000     J,K;                                                                           
91676000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91677000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91678000                                                                                    
91679000 DEFINE                                                                             
91680000   ERROR = BEGIN                                                                    
91681000     DISPLAY(ERRMSG);                                                               
91682000     MYSELF.STATUS:=-1;                                                             
91683000   END#;                                                                            
91684000                                                                                    
91685000   TEMP:=UDPLMT+I-ULOWER;                                                           
91686000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91687000     K:=J+TEMP-PDPLMT;                                                              
91688000     IF((K-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                                     
91689000     UNPACKED[K]:=0;                                                                
91690000     REPLACE POINTER(UNPACKED[K],4)+11 BY PACKED[J] FOR 1;                          
91691000     UNPACKED[K]:=*+PSUBRBASE;                                                      
91692000   END;                                                                             
91693000 END;   %OF PASCALUNPACK4BITS                                                       
91694000                                                                                    
91695000 PROCEDURE PASCALUNPACK6BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE,                 
91696000 %         ****************                                                         
91697000       UNPACKED,ULOWER,UUPPER,UDPLMT,I);                                            
91698000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                       
91699000 ARRAY UNPACKED[0];  BCL ARRAY PACKED[0];                                           
91700000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                     
91701000 BEGIN                                                                              
91702000   INTEGER                                                                          
91703000     TEMP,                                                                          
91704000     J,K;                                                                           
91705000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91706000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91707000                                                                                    
91708000 DEFINE                                                                             
91709000   ERROR = BEGIN                                                                    
91710000     DISPLAY(ERRMSG);                                                               
91711000     MYSELF.STATUS:=-1;                                                             
91712000   END#;                                                                            
91713000                                                                                    
91714000   TEMP:=UDPLMT+I-ULOWER;                                                           
91715000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91716000     K:=J+TEMP-PDPLMT;                                                              
91717000     IF((K-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                                     
91718000     UNPACKED[K]:=0;                                                                
91719000     REPLACE POINTER(UNPACKED[K],6)+7 BY PACKED[J] FOR 1;                           
91720000     UNPACKED[K]:=*+PSUBRBASE;                                                      
91721000   END;                                                                             
91722000 END;   %OF PASCALUNPACK6BITS                                                       
91723000                                                                                    
91724000 PROCEDURE PASCALUNPACK8BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE,                 
91725000 %         ****************                                                         
91726000       UNPACKED,ULOWER,UUPPER,UDPLMT,I);                                            
91727000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                       
91728000 ARRAY UNPACKED[0];  EBCDIC ARRAY PACKED[0];                                        
91729000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                     
91730000 BEGIN                                                                              
91731000   INTEGER                                                                          
91732000     TEMP,                                                                          
91733000     J,K;                                                                           
91734000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91735000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91736000                                                                                    
91737000 DEFINE                                                                             
91738000   ERROR = BEGIN                                                                    
91739000     DISPLAY(ERRMSG);                                                               
91740000     MYSELF.STATUS:=-1;                                                             
91741000   END#;                                                                            
91742000                                                                                    
91743000   TEMP:=UDPLMT+I-ULOWER;                                                           
91744000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91745000     K:=J+TEMP-PDPLMT;                                                              
91746000     IF((K-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                                     
91747000     UNPACKED[K]:=0;                                                                
91748000     REPLACE POINTER(UNPACKED[K],8)+5 BY PACKED[J] FOR 1;                           
91749000     UNPACKED[K]:=*+PSUBRBASE;                                                      
91750000   END;                                                                             
91751000 END;   %OF PASCALUNPACK8BITS                                                       
91752000                                                                                    
91753000 PROCEDURE PASCALUNPACK48BITS(PACKED,PLOWER,PUPPER,PDPLMT,PSUBRBASE,                
91754000 %         ****************                                                         
91755000       UNPACKED,ULOWER,UUPPER,UDPLMT,I);                                            
91756000 VALUE PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                       
91757000 ARRAY UNPACKED[0],PACKED[0];                                                       
91758000 INTEGER PLOWER,PUPPER,PDPLMT,PSUBRBASE,ULOWER,UUPPER,UDPLMT,I;                     
91759000 BEGIN                                                                              
91760000   INTEGER                                                                          
91761000     TEMP,                                                                          
91762000     J;                                                                             
91763000 EBCDIC VALUE ARRAY ERRMSG(                                                         
91764000   "ERROR: BOUNDS ERROR" 48"00");                                                   
91765000                                                                                    
91766000 DEFINE                                                                             
91767000   ERROR = BEGIN                                                                    
91768000     DISPLAY(ERRMSG);                                                               
91769000     MYSELF.STATUS:=-1;                                                             
91770000   END#;                                                                            
91771000                                                                                    
91772000   TEMP:=UDPLMT+I-ULOWER;                                                           
91773000   FOR J:=PDPLMT STEP 1 UNTIL PUPPER+PDPLMT-PLOWER DO BEGIN                         
91774000     IF((J+TEMP-PDPLMT-UDPLMT)>(UUPPER-ULOWER)) THEN ERROR;                         
91775000     UNPACKED[J+TEMP-PDPLMT]:=PACKED[J]+PSUBRBASE;                                  
91776000   END;                                                                             
91777000 END;   %OF PASCALUNPACK48BITS                                                      
91778000                                                                                    
91779000 PROCEDURE PASCALTEXTOPEN(F,BUFFER,DATA,STATUS,WORDFILE);                           
91780000 VALUE STATUS,WORDFILE;                                                             
91781000 FILE F;                                                                            
91782000 EBCDIC ARRAY BUFFER[0];                                                            
91783000 REAL ARRAY DATA[0];                                                                
91784000 REAL STATUS;                                                                       
91785000 BOOLEAN WORDFILE;                                                                  
91786000 BEGIN                                                                              
91787000 DEFINE       CURRENTWORD     =DATA[3]#;                                            
91788000 DEFINE       FILEDEAD        =DATA[0]#;                                            
91789000 DEFINE       FILESTATUS      =DATA[1].[3:4]#;                                      
91789100 DEFINE       FYLETYPE        =DATA[5]#;                                            
91790000 DEFINE       LINELENGTH      =FILEDEAD.[47:20]#;                                   
91791000 DEFINE       MAXBYTES        =DATA[2]#;                                            
91792000 DEFINE       MAXWORDS        =DATA[2]#;                                            
91792100 POINTER      P;                                                                    
91793000 DEFINE       READBUSY        =1#;                                                  
91794000 ARRAY        REALBUFFER[0]   =BUFFER;                                              
91795000 DEFINE       RESET           =17#;                                                 
91796000 DEFINE       REWRITE         =18#;                                                 
91797000 DEFINE       STBRWD          =DATA[6]#;                                            
91797100 DEFINE       TRIMBLANKS      =REAL(WORDFILE.[46:1])#;                              
91798000 DEFINE              WRITEBUSY           =3#;                                       
91799000 %                                                                                  
91800000 IF F.OPEN THEN                                                                     
91801000   IF STATUS=RESET THEN LOCK(F) ELSE CLOSE(F,PURGE);                                
91802000 IF STATUS=READBUSY OR STATUS=RESET                                                 
91803000    THEN BEGIN F.MYUSE:=VALUE(IN); FILESTATUS:=READBUSY END                         
91804000    ELSE BEGIN F.MYUSE:=VALUE(OUT); FILESTATUS:=WRITEBUSY END;                      
91805000 F.OPEN := TRUE;                                                                    
91805100 FYLETYPE:=F.FILETYPE;                                                              
91806000 IF WORDFILE THEN                                                                   
91807000  BEGIN MAXWORDS := F.MAXRECSIZE;                                                   
91808000    IF SIZE(REALBUFFER)<MAXWORDS THEN RESIZE(REALBUFFER,MAXWORDS*6);                
91809000    IF FILESTATUS=READBUSY THEN                                                     
91810000      FILEDEAD:=REAL(READ(F,MAXWORDS,REALBUFFER[0]));                               
91811000    CURRENTWORD:=0                                                                  
91812000  END                                                                               
91813000 ELSE %TEXTFILE                                                                     
91814000  BEGIN MAXBYTES:=IF F.KIND=VALUE(PUNCH) OR F.KIND=VALUE(READER) THEN 80            
91815000                  ELSE IF F.FILEKIND=VALUE(SEQDATA) THEN 72 ELSE                    
91816000                  IF F.UNITS=VALUE(CHARACTERS) THEN                                 
91817000                   F.MAXRECSIZE ELSE 6*F.MAXRECSIZE;                                
91818000    IF SIZE(BUFFER)<MAXBYTES THEN RESIZE(BUFFER,MAXBYTES);                          
91819000    IF FILESTATUS=READBUSY THEN                                                     
91820000               BEGIN FILEDEAD:=0;                                                   
91820100                    STBRWD:=0;                                                      
91820200                    PASCALTEXTREAD(F,BUFFER,DATA,0,P,0,0,P,7&1[47:1]&               
91820300                      TRIMBLANKS[46:1]);                                            
91822000               END                                                                  
91823000    ELSE STBRWD:=0 & (MAXBYTES-1)[35:16] & 1[47:12];                                
91824000    PASCALSETTAG4(STBRWD);                                                          
91825000  END;                                                                              
91826000 END;                                                                               
91827000 %*********************************************************************             
91828000 INTEGER PROCEDURE PASCALTEXTREAD                                                   
91829000 (F,BUFFER,DATA,ITEM,ITEMPTR,LOWBOUND,HIGHBOUND,SCALARNAMES,FLAGS);                 
91830000 VALUE ITEMPTR,LOWBOUND,HIGHBOUND,SCALARNAMES,FLAGS;                                
91831000 FILE F;                                                                            
91832000 EBCDIC ARRAY BUFFER[0];                                                            
91833000 REAL ARRAY DATA[0];                                                                
91834000 REAL ITEM,LOWBOUND,HIGHBOUND,FLAGS;                                                
91835000 POINTER ITEMPTR,SCALARNAMES;                                                       
91836000 BEGIN                                                                              
91837000 DEFINE              ASCIIFLAG           =BOOLEAN(FLAGS.[43:1])#;                   
91838000 REAL                B                   ;                                          
91839000 DEFINE              BITLENGTH           =FLAGS.[15:6]#;                            
91840000 EBCDIC VALUE ARRAY  BOOLEANNAMES  (48"05""FALSE"48"04""TRUE"48"00");               
91841000 DEFINE              BOOLEANTYPE         =4#;                                       
91842000 POINTER             BUFPTR              ;                                          
91843000 REAL                BYTESLEFT           ;                                          
91844000 REAL                CH                  ;                                          
91845000 DEFINE              CHARTYPE            =0#;                                       
91846000 DEFINE              CURRENTBYTE         =STEPBRANCHWORD.[15:16]#;                  
91847000 DEFINE              CURRENTWORD         =DATA[3]#;                                 
91848000 DOUBLE              DVAL                ;                                          
91849000 DEFINE              EOFFLAG             =BOOLEAN(DATA[1].[47:1])#;                 
91850000 DEFINE              ETYPE               =3#;                                       
91851000 TRUTHSET            FIGURES             ("0123456789");                            
91852000 DEFINE              FILEDEAD            =DATA[0]#;                                 
91853000 DEFINE              FILESTATUS          =DATA[1].[3:4]#;                           
91853100 DEFINE              FYLETYPE            =DATA[5]#;                                 
91854000 LABEL               FINISHED            ;                                          
91855000 DEFINE              INTEGERTYPE         =1#;                                       
91856000 DEFINE              LASTBYTE            =STEPBRANCHWORD.[35:16]#;                  
91857000 REAL                LENGTH              ;                                          
91858000 DEFINE              LINELENGTH          =FILEDEAD.[47:20]#;                        
91859000 LABEL               MATCHED           ;                                            
91860000 DEFINE              MAXBYTES            =DATA[2]#;                                 
91861000 DEFINE              MAXWORDS            =DATA[2]#;                                 
91862000 REAL                NAMELENGTH          ;                                          
91863000 BOOLEAN             NEGATIVE            ;                                          
91864000 BOOLEAN             NEGEXP              ;                                          
91865000 DEFINE              NULLTYPE            =7#;                                       
91866000 POINTER             P                   ;                                          
91867000 DEFINE              PACKEDITEM          =BOOLEAN(FLAGS.[41:1])#;                   
91867100 DEFINE              PACKEDARRAY         =BOOLEAN(FLAGS.[40:1])#;                   
91868000 DEFINE              RADIXTYPE           =5#;                                       
91869000 DEFINE              RANGECHECK          =BOOLEAN(FLAGS.[42:1])#;                   
91870000 DEFINE              READBUSY            =1#;                                       
91871000 DEFINE              READFUNCTION        =BOOLEAN(FLAGS.[45:1])#;                   
91872000 DEFINE              READLN              =BOOLEAN(FLAGS.[47:1])#;                   
91873000 ARRAY               REALBUFFER[0]   =BUFFER;                                       
91874000 DEFINE              REALTYPE            =2#;                                       
91875000 DEFINE              SCALARTYPE          =6#;                                       
91876000 DEFINE              STARTBIT            =FLAGS.[9:6]#;                             
91877000 DEFINE              STBRWD              =DATA[6]#;                                 
91878000 REAL                STEPBRANCHWORD      ;                                          
91879000 DEFINE              STRINGLENGTH        =LOWBOUND#;                                
91880000 DEFINE              STRINGTYPE          =8#;                                       
91881000 DEFINE              TRIMBLANKS          =BOOLEAN(FLAGS.[46:1])#;                   
91882000 DEFINE              TYPE                =FLAGS.[3:4]#;                             
91883000 TRANSLATETABLE      UPPERCASE           (EBCDIC TO EBCDIC,                         
91884000                                         "abcdefghijklmnopqrstuvwxyz" TO            
91885000                                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ");             
91886000 REAL                VAL                 ;                                          
91887000 DEFINE              WORDFILE            =BOOLEAN(FLAGS.[44:1])#;                   
91888000 DEFINE              WRITEBUSY           =3#;                                       
91889000 DEFINE                                                                             
91890000 GETBUFFER=BEGIN FILEDEAD:=REAL(READ(F,MAXBYTES,BUFFER[*]));                        
91891000            IF NOT BOOLEAN(FILEDEAD) THEN BEGIN                                     
91892000             BYTESLEFT := IF (FYLETYPE=3) THEN                                      
91892100                            IF F.UNITS=VALUE(CHARACTERS) THEN LINELENGTH            
91892200                            ELSE 6*LINELENGTH                                       
91892300                          ELSE                                                      
91892400                            MAXBYTES;                                               
91894000             IF TRIMBLANKS THEN                                                     
91895000              BEGIN B:= BYTESLEFT-1;                                                
91896000                WHILE B>=0 DO                                                       
91897000                IF BUFFER[BYTESLEFT-1] NEQ " " THEN B:=-1                           
91898000                ELSE BEGIN BYTESLEFT:=B; B:=*-1 END                                 
91899000              END;                                                                  
91900000             STBRWD:=0 & (BYTESLEFT-1)[35:16] & 1[47:12];                           
91900100             IF TRIMBLANKS THEN BEGIN                                               
91900110               IF BYTESLEFT=0 THEN BEGIN                                            
91900120                 STBRWD := 5 & 1[35:16] & 1[47:12];                                 
91900130               END;                                                                 
91900140             END;                                                                   
91900150             STEPBRANCHWORD:=STBRWD;                                                
91901000            END                                                                     
91902000           END#,                                                                    
91903000 SKIPBLANKS=BEGIN SCAN BUFPTR:BUFPTR FOR BYTESLEFT:BYTESLEFT WHILE=" ";             
91904000             WHILE BYTESLEFT <= 0 DO                                                
91905000              BEGIN GETBUFFER;                                                      
91906000               IF BOOLEAN(FILEDEAD) THEN ERROREXIT(2,READFUNCTION);                 
91907000               SCAN BUFPTR:BUFFER[0] FOR BYTESLEFT:BYTESLEFT WHILE=" "              
91908000              END                                                                   
91909000            END#;                                                                   
91910000 PROCEDURE ERROREXIT(NO,NONFATAL);                                                  
91911000 VALUE NO,NONFATAL;                                                                 
91912000 INTEGER NO; BOOLEAN NONFATAL;                                                      
91913000 BEGIN                                                                              
91914000 REAL VALUE ARRAY    ERRORS             ("READFILE=WRITEBUSY", %1                   
91915000                                         " END OF READFILE. ", %2                   
91916000                                         " NO INITIAL DIGIT ", %3                   
91917000                                         " TOO MANY DIGITS. ", %4                   
91918000                                         " NO DIGIT AFTER . ", %5                   
91919000                                         " EXPONENT TOO LONG", %6                   
91920000                                         " NO EXPNT DIGIT.  ", %7                   
91921000                                         " NOT SCALAR NAME. ", %8                   
91922000                                         " RADIX <> 2/4/8/16", %9                   
91923000                                         " DIGIT >= RADIX.  ", %10                  
91924000                                         " NUM TOO BIG/SMALL", %11                  
91925000                                         " REAL/INT CLASH.  ", %12                  
91926000                                         " SCALAR/NUM CLASH.", %13                  
91927000                                         " NOT IMPLEMENTED. ", %14                  
91928000                                         " RANGE VALUE ERROR", %15                  
91929000                                         0);                                        
91930000 ARRAY               ERRMSG[0:4];                                                   
91931000 %                                                                                  
91932000 PASCALTEXTREAD:= NO; DATA[1].[47:1]:=REAL(NO=2);                                   
91933000   IF NOT NONFATAL THEN BEGIN                                                       
91934000     REPLACE POINTER(ERRMSG,8) BY                                                   
91935000      "ERROR:",POINTER(ERRORS[(NO-1)*3],8) FOR 18 UNTIL =".",48"00";                
91936000     DISPLAY(POINTER(ERRMSG,8));                                                    
91937000     MYSELF.STATUS:= -1;                                                            
91938000   END;                                                                             
91939000   GO FINISHED                                                                      
91940000 END;                                                                               
91941000 %                                                                                  
91942000     PASCALTEXTREAD:=0;                                                             
91943000     IF FILESTATUS NEQ READBUSY THEN BEGIN                                          
91944000       IF FILESTATUS = WRITEBUSY THEN ERROREXIT(1,READFUNCTION);                    
91945000       PASCALTEXTOPEN(F,BUFFER,DATA,READBUSY,WORDFILE&TRIMBLANKS[46:1]);            
91946000        IF BOOLEAN(FILEDEAD) THEN ERROREXIT(2,READFUNCTION);                        
91947000     END                                                                            
91948000     ELSE IF BOOLEAN(FILEDEAD) THEN                                                 
91949000           ERROREXIT(2,READFUNCTION AND NOT EOFFLAG);                               
91950000   IF WORDFILE THEN BEGIN                                                           
91951000     VAL := REALBUFFER[CURRENTWORD]; CURRENTWORD:=*+1;                              
91952000     IF CURRENTWORD>=MAXWORDS OR READLN THEN                                        
91953000       BEGIN FILEDEAD := REAL(READ(F,MAXWORDS,REALBUFFER[0]));                      
91954000           CURRENTWORD:=0                                                           
91955000       END                                                                          
91956000     END                                                                            
91957000   ELSE BEGIN  % TEXTFILE                                                           
91958000     STEPBRANCHWORD := (STBRWD := *).[47:48];                                       
91959000     BYTESLEFT := LASTBYTE - CURRENTBYTE +1;                                        
91960000     BUFPTR := BUFFER[CURRENTBYTE];                                                 
91961000     CASE TYPE OF BEGIN                                                             
91962000       CHARTYPE: IF ASCIIFLAG THEN                                                  
91963000                  REPLACE BUFPTR BY BUFPTR FOR 1 WITH EBCDICTOASCII;                
91964000                 VAL := REAL(BUFPTR,1); BYTESLEFT := *-1;                           
91965000       STRINGTYPE:                                                                  
91966000           WHILE BYTESLEFT <= 0 DO                                                  
91967000            BEGIN GETBUFFER;                                                        
91968000             IF BOOLEAN(FILEDEAD) THEN ERROREXIT(2,READFUNCTION)                    
91969000            END;                                                                    
91970000           B := MIN(STRINGLENGTH,BYTESLEFT);                                        
91971000                 IF ASCIIFLAG THEN                                                  
91972000                  REPLACE ITEMPTR BY BUFPTR FOR B WITH EBCDICTOASCII,               
91973000                                     7" " FOR STRINGLENGTH-B                        
91974000                 ELSE                                                               
91975000                  REPLACE ITEMPTR BY BUFPTR FOR B,                                  
91976000                                     " " FOR STRINGLENGTH-B;                        
91977000                  BYTESLEFT := *-B;                                                 
91978000       BOOLEANTYPE:                                                                 
91979000       SCALARTYPE: SKIPBLANKS;                                                      
91980000             SCAN BUFPTR FOR B:BYTESLEFT WHILE IN ALPHA;                            
91981000             IF LENGTH := BYTESLEFT-B = 0 THEN ERROREXIT(8,READFUNCTION);           
91982000             REPLACE BUFPTR BY BUFPTR FOR LENGTH WITH UPPERCASE;                    
91983000             IF TYPE = BOOLEANTYPE THEN P := BOOLEANNAMES[0]                        
91984000                                   ELSE P := SCALARNAMES;                           
91985000             VAL := 0;                                                              
91986000             WHILE NAMELENGTH := REAL(P,1) NEQ 0 DO                                 
91987000              BEGIN IF LENGTH = NAMELENGTH THEN                                     
91988000               IF BUFPTR = P+1 FOR LENGTH THEN GO MATCHED;                          
91989000               P:= P+(NAMELENGTH+1); VAL :=*+1                                      
91990000              END;                                                                  
91991000             ERROREXIT(8,READFUNCTION);                                             
91992000           MATCHED: BYTESLEFT := B;                                                 
91993000       INTEGERTYPE:                                                                 
91994000       ETYPE:                                                                       
91995000       REALTYPE:  SKIPBLANKS;                                                       
91996000             IF (NEGATIVE := (CH := REAL(BUFPTR,1)) = "-") OR CH = "+"              
91997000             THEN BEGIN BUFPTR := *+1; BYTESLEFT := *-1 END;                        
91998000             SCAN P:BUFPTR FOR B:BYTESLEFT WHILE IN FIGURES;                        
91999000             IF LENGTH := BYTESLEFT-B = 0 THEN ERROREXIT(3,READFUNCTION);           
92000000             IF LENGTH > 12 THEN ERROREXIT(4,READFUNCTION);                         
92001000             VAL := INTEGER(BUFPTR,LENGTH);                                         
92002000             IF TYPE = REALTYPE AND B>0 THEN BEGIN                                  
92003000              IF REAL(P,1) = "." THEN BEGIN                                         
92004000                 IF B=1 THEN ERROREXIT(5,READFUNCTION);                             
92005000               SCAN BUFPTR:P+1 FOR BYTESLEFT:B-1 WHILE IN FIGURES;                  
92006000               LENGTH := MIN(23,B-BYTESLEFT-1);                                     
92007000               DVAL := VAL + DOUBLE(P+1,LENGTH)/POTL[LENGTH]                        
92008000              END ELSE BEGIN                                                        
92008100               DVAL:=VAL;                                                           
92008110               BUFPTR:=P;                                                           
92008120               BYTESLEFT:=B;                                                        
92008130              END;                                                                  
92009000              IF BYTESLEFT > 0 THEN                                                 
92010000               IF REAL(BUFPTR,1) = "e" OR REAL(BUFPTR,1) = "E" THEN BEGIN           
92011000                IF BYTESLEFT < 2 THEN ERROREXIT(7,READFUNCTION);                    
92012000                IF (NEGEXP := (CH := REAL(BUFPTR+1,1)) = "-") OR CH = "+"           
92013000                THEN BEGIN BUFPTR := *+2; BYTESLEFT := *-2 END                      
92014000                ELSE BEGIN BUFPTR := *+1; BYTESLEFT := *-1 END;                     
92015000                SCAN P:BUFPTR FOR B:BYTESLEFT WHILE IN FIGURES;                     
92016000                IF LENGTH:=(BYTESLEFT-B)>2 THEN                                     
92017000                       ERROREXIT(6,READFUNCTION)                                    
92018000                ELSE IF LENGTH=0 THEN ERROREXIT(7,READFUNCTION);                    
92019000                IF NEGEXP THEN                                                      
92020000                 DVAL := */POTL[MIN(63,INTEGER(BUFPTR,LENGTH))]                     
92021000                ELSE DVAL := **POTL[MIN(63,INTEGER(BUFPTR,LENGTH))];                
92022000                BYTESLEFT := B                                                      
92023000              END;                                                                  
92024000              IF DVAL < 3"1771000000000000"                                         
92025000              OR DVAL > 3"0777777777777777" THEN                                    
92026000               IF DVAL = 0 THEN VAL := 0 ELSE ERROREXIT(11,READFUNCTION)            
92027000               ELSE VAL := REAL(DVAL)                                               
92028000             END                                                                    
92029000             ELSE BYTESLEFT := B;                                                   
92030000           IF NEGATIVE THEN VAL := -VAL;                                            
92031000       RADIXTYPE: ERROREXIT(14,READFUNCTION);                                       
92032000       NULLTYPE:;                                                                   
92033000     END OF CASE;                                                                   
92034000     IF READLN OR BYTESLEFT<0 THEN GETBUFFER                                        
92035000     ELSE                                                                           
92036000      IF BYTESLEFT=0 THEN                                                           
92037000       BEGIN REPLACE BUFFER[0] BY " " FOR 6;                                        
92038000        STBRWD := 5 & 1[35:16] & 1[47:12]                                           
92039000       END                                                                          
92040000      ELSE STBRWD := STEPBRANCHWORD & (LASTBYTE-BYTESLEFT+1)[15:16];                
92041000   END  OF TEXTFILE;                                                                
92041100   IF RANGECHECK THEN BEGIN                                                         
92041110     IF VAL < LOWBOUND OR VAL > HIGHBOUND THEN                                      
92041120             ERROREXIT(15,READFUNCTION);                                            
92041130   END;                                                                             
92042000   IF PACKEDITEM THEN BEGIN                                                         
92043000     IF RANGECHECK THEN BEGIN                                                       
92046000      ITEM.[STARTBIT:BITLENGTH] := VAL-LOWBOUND                                     
92047000     END ELSE ITEM.[STARTBIT:BITLENGTH] := VAL                                      
92048000   END ELSE BEGIN                                                                   
92051000     IF TYPE<NULLTYPE THEN                                                          
92051100         IF PACKEDARRAY THEN                                                        
92051110           REPLACE ITEMPTR BY VAL.[7:48] FOR 1                                      
92051120         ELSE                                                                       
92051130           ITEM:=VAL;                                                               
92051140   END;                                                                             
92052000  FINISHED: IF NOT WORDFILE THEN PASCALSETTAG4(STBRWD);                             
92053000 END;                                                                               
92054000 %*****************************************************************                 
92055000 PROCEDURE PASCALTEXTWRITE                                                          
92056000 (F,BUFFER,DATA,ITEM,ITEMPTR,FIELD,SUBFIELD,SCALARNAMES,FLAGS);                     
92057000 VALUE ITEM,ITEMPTR,FIELD,SUBFIELD,SCALARNAMES,FLAGS;                               
92058000 FILE F;                                                                            
92059000 EBCDIC ARRAY BUFFER[0];                                                            
92060000 REAL ARRAY DATA[0];                                                                
92061000 REAL ITEM,FLAGS;                                                                   
92062000 INTEGER FIELD,SUBFIELD;                                                            
92063000 POINTER ITEMPTR,SCALARNAMES;                                                       
92064000 BEGIN                                                                              
92065000 DEFINE                                                                             
92066000 ALIGNBUFFER(X)=BEGIN IF FIELD:=MAX(FIELD,X)>BYTESLEFT THEN                         
92067000                 BEGIN IF BYTESLEFT>0 THEN                                          
92068000                       REPLACE BUFPTR BY " " FOR BYTESLEFT;                         
92069000                   WRITE(F,MAXBYTES,BUFFER[0]);                                     
92070000                   IF FIELD>MAXBYTES THEN                                           
92071000                    IF X > MAXBYTES THEN                                            
92072000                    BEGIN                                                           
92073000                     REPLACE BUFFER[0] BY                                           
92074000                      "ERROR: FIELD WIDTH ",FIELD FOR 3 DIGITS,                     
92075000                      " > LINE LENGTH ",MAXBYTES FOR 3 DIGITS;                      
92076000                     WRITE(F,40,BUFFER[0]); GO FINISHED                             
92077000                    END                                                             
92078000                    ELSE FIELD:=MAXBYTES;                                           
92079000                    CURRENTBYTE := 0;                                               
92080000                   BYTESLEFT:=MAXBYTES; BUFPTR:=BUFFER[0] ;                         
92081000                 END;                                                               
92082000                   REPLACE BUFPTR:BUFPTR BY " " FOR FIELD-X END#;                   
92083000 DEFINE                                                                             
92084000 DIGITSIN(X)=MAX((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1,1)#;                       
92084100   DEFINE                                                                           
92084110         TENPOWER(J)                                                                
92084120           =(POTL[(J).[5:6]]*POTC[(J).[11:6]]*POTH[(J).[14:3]])#;                   
92084130           % A B6700 THING TO GIVE TEN TO POWER OF J (J>=0)                         
92084200                                                                                    
92084210   INTEGER PROCEDURE EXPNT(D);                                                      
92084220   %                *********                                                       
92084230   VALUE D; REAL D;                                                                 
92084240   BEGIN                                                                            
92084250     INTEGER CURRENT, STEPSIZE;                                                     
92084260     %                                                                              
92084270     IF (D < 10) THEN BEGIN                                                         
92084280       EXPNT:=0;                                                                    
92084290     END ELSE BEGIN                                                                 
92084300       CURRENT:=0; STEPSIZE:=128;                                                   
92084310       DO BEGIN                                                                     
92084320         CURRENT:= CURRENT + (STEPSIZE:=STEPSIZE DIV 2);                            
92084330         IF (D < TENPOWER(CURRENT)) THEN BEGIN                                      
92084340           CURRENT:=CURRENT-STEPSIZE;                                               
92084350         END;                                                                       
92084360       END UNTIL (STEPSIZE <= 0);                                                   
92084370       EXPNT:=CURRENT;                                                              
92084380     END; % OF IF                                                                   
92084390   END; % OF EXPNT PROCEDURE                                                        
92084400                                                                                    
92085000   REAL              ABSVAL              ;                                          
92086000 DEFINE              ASCIIFLAG           =BOOLEAN(FLAGS.[43:1])#;                   
92087000 EBCDIC VALUE ARRAY  ASTERISKS           ("******");                                
92088000 EBCDIC VALUE ARRAY  BOOLEANNAMES  (48"05" "FALSE" 48"05""TRUE " 48"00");           
92089000 DEFINE              BOOLEANTYPE         =4#;                                       
92090000 POINTER             BUFPTR              ;                                          
92091000 REAL                BYTESLEFT           ;                                          
92092000 DEFINE              CHARTYPE            =0#;                                       
92093000 REAL                CURRENTBYTE         ;                                          
92094000 DEFINE              CURRENTWORD         =DATA[3]#;                                 
92095000 DEFINE              DEFAULT(X)          =BOOLEAN(X.[47:1])#;                       
92096000 DEFINE              ETYPE               =3#;                                       
92097000 INTEGER             EXPONENT            ;                                          
92098000 EBCDIC VALUE ARRAY  FATALERROR     ("FATAL ERROR: WRITEFILE=READBUSY");            
92099000 EBCDIC VALUE ARRAY  FIGURES             ("0123456789ABCDEF");                      
92100000 DEFINE              FILESTATUS          =DATA[1].[3:4]#;                           
92101000 LABEL               FINISHED            ;                                          
92102000 INTEGER             I                   ;                                          
92103000 DEFINE              INTEGERTYPE         =1#;                                       
92104000 INTEGER             J                   ;                                          
92105000 DEFINE              LASTBYTE            =STEPBRANCHWORD.[35:16]#;                  
92106000 REAL                LENGTH              ;                                          
92107000 DEFINE              MAXBYTES        =DATA[2]#;                                     
92108000 DEFINE              MAXWORDS        =DATA[2]#;                                     
92109000 BOOLEAN             NEGATIVE            ;                                          
92110000 DEFINE              NULLTYPE            =7#;                                       
92111000 POINTER             P                   ;                                          
92112000 DEFINE              RADIXTYPE           =5#;                                       
92113000 DEFINE              READBUSY            =1#;                                       
92114000 ARRAY               REALBUFFER[0]   =BUFFER;                                       
92115000 DEFINE              REALTYPE            =2#;                                       
92116000 DEFINE              SCALARTYPE          =6#;                                       
92117000 INTEGER             SCALARVALUE         ;                                          
92118000 DEFINE              STBRWD              =DATA[6]#;                                 
92119000 REAL                STEPBRANCHWORD      ;                                          
92120000 DEFINE              STRINGLENGTH        =SUBFIELD#;                                
92121000 DEFINE              STRINGTYPE          =8#;                                       
92122000 DEFINE              TYPE                =FLAGS.[3:4]#;                             
92123000 DEFINE              WORDFILE            =BOOLEAN(FLAGS.[44:1])#;                   
92124000 DEFINE              WRITEBUSY           =3#;                                       
92125000 DEFINE              WRITELN             =BOOLEAN(FLAGS.[47:1])#;                   
92125100 INTEGER             ZEROFILL            ;                                          
92126000 %                                                                                  
92127000 IF FILESTATUS NEQ WRITEBUSY THEN                                                   
92128000  IF FILESTATUS=READBUSY THEN                                                       
92129000    BEGIN DISPLAY(FATALERROR[0]); MYSELF.STATUS:=-1; GO FINISHED END                
92130000  ELSE PASCALTEXTOPEN(F,BUFFER,DATA,WRITEBUSY,WORDFILE);                            
92131000 IF WORDFILE THEN                                                                   
92132000  BEGIN                                                                             
92133000   REALBUFFER[CURRENTWORD]:=ITEM; CURRENTWORD:=*+1;                                 
92134000   IF CURRENTWORD>=MAXWORDS OR WRITELN THEN                                         
92135000     BEGIN WRITE(F,MAXWORDS,REALBUFFER[0]);                                         
92136000       CURRENTWORD:=0                                                               
92137000     END;                                                                           
92138000  END                                                                               
92139000 ELSE % TEXTFILE                                                                    
92140000  BEGIN                                                                             
92141000   STEPBRANCHWORD := (STBRWD:=*).[47:48];                                           
92142000    CURRENTBYTE := STEPBRANCHWORD.[15:16];                                          
92143000   BYTESLEFT := LASTBYTE - CURRENTBYTE +1;                                          
92144000   IF BYTESLEFT>0 THEN BUFPTR := BUFFER[CURRENTBYTE];                               
92145000   CASE TYPE OF BEGIN                                                               
92146000    CHARTYPE: ALIGNBUFFER(1);                                                       
92147000      REPLACE BUFPTR BY ITEM.[7:48] FOR 1;                                          
92148000      IF ASCIIFLAG THEN                                                             
92149000       REPLACE BUFPTR BY BUFPTR FOR 1 WITH ASCIITOEBCDIC;                           
92150000          BUFPTR:=*+1;                                                              
92151000    STRINGTYPE: IF NOT DEFAULT(FIELD) THEN                                          
92152000                  STRINGLENGTH:=MIN(MAX(FIELD,1),STRINGLENGTH);                     
92153000      ALIGNBUFFER(STRINGLENGTH);                                                    
92154000      IF ASCIIFLAG THEN                                                             
92155000       REPLACE BUFPTR:BUFPTR BY ITEMPTR FOR STRINGLENGTH                            
92156000                                           WITH ASCIITOEBCDIC                       
92157000      ELSE REPLACE BUFPTR:BUFPTR BY ITEMPTR FOR STRINGLENGTH;                       
92158000    BOOLEANTYPE:                                                                    
92159000    SCALARTYPE:  IF TYPE=SCALARTYPE THEN P:=SCALARNAMES                             
92160000                ELSE P:=BOOLEANNAMES[0];                                            
92161000      SCALARVALUE:=0;                                                               
92162000      WHILE LENGTH:=REAL(P,1) NEQ 0 AND SCALARVALUE<ITEM DO                         
92163000       BEGIN SCALARVALUE:=*+1; P:=*+(LENGTH+1) END;                                 
92164000      IF LENGTH=0 THEN                                                              
92165000           BEGIN WRITE(F,CURRENTBYTE,BUFFER[0]);                                    
92166000             REPLACE BUFFER[0] BY "**** ERROR ****",                                
92167000                                  "EXCEEDS SCALAR CONSTANT RANGE";                  
92168000            WRITE(F,44,BUFFER[0]);                                                  
92169000         REPLACE BUFFER[0] BY " " FOR CURRENTBYTE;                                  
92170000            P:=ASTERISKS[0]; LENGTH:=3;                                             
92171000           END;                                                                     
92172000      IF NOT DEFAULT(FIELD) THEN LENGTH:=MIN(MAX(FIELD,1),LENGTH);                  
92173000      ALIGNBUFFER(LENGTH);                                                          
92174000      REPLACE BUFPTR:BUFPTR BY P+1 FOR LENGTH;                                      
92175000    INTEGERTYPE:                                                                    
92176000      NEGATIVE:=BOOLEAN(LENGTH:=ITEM.[46:1]);                                       
92177000      LENGTH:=*+DIGITSIN(I:=ABS(ITEM));                                             
92178000      ALIGNBUFFER(LENGTH);                                                          
92179000      IF NEGATIVE THEN BEGIN                                                        
92180000       REPLACE BUFPTR:BUFPTR BY "-"; LENGTH:=*-1 END;                               
92181000      REPLACE BUFPTR:BUFPTR BY I FOR LENGTH DIGITS;                                 
92182000    REALTYPE:                                                                       
92183000    ETYPE:                                                                          
92184000      IF DEFAULT(SUBFIELD) THEN   %FLOATING-POINT                                   
92185000       BEGIN EXPONENT:=0; ABSVAL:=ABS(ITEM);                                        
92186000        IF DEFAULT(FIELD) THEN ALIGNBUFFER(15)                                      
92186100        ELSE ALIGNBUFFER(MAX(FIELD,8));                                             
92187000        SUBFIELD:=FIELD-7;                                                          
92187100       IF SUBFIELD>10 THEN BEGIN                                                    
92187200        ZEROFILL:=SUBFIELD-10; SUBFIELD:=10                                         
92187300       END ELSE ZEROFILL:=0;                                                        
92188000        IF ABSVAL<1 AND (ABSVAL NEQ 0) THEN BEGIN                                   
92189000          DO BEGIN ABSVAL:=**10; EXPONENT:=*-1 END UNTIL ABSVAL>=1;                 
92189100         IF ABSVAL=10.0 THEN BEGIN ABSVAL:=1; EXPONENT:=*+1 END;                    
92190000        END ELSE                                                                    
92191000          ABSVAL:=*/POTL[EXPONENT:=EXPNT(ABSVAL)];                                  
92192000        LENGTH:=DIGITSIN(ABS(EXPONENT));                                            
92193000        I:=INTEGERT(ABSVAL);                                                        
92194000        IF J:=ABSVAL MOD 1*POTL[SUBFIELD] GEQ POTL[SUBFIELD] THEN                   
92195000          BEGIN J:=0; I:=*+1;                                                       
92195200          END;                                                                      
92196000        IF ITEM<0 THEN REPLACE BUFPTR:BUFPTR BY "-"                                 
92197000                 ELSE REPLACE BUFPTR:BUFPTR BY " ";                                 
92198000        REPLACE BUFPTR:BUFPTR BY I FOR 1 DIGITS,".",                                
92199000                                 J FOR SUBFIELD DIGITS;                             
92199050       IF ZEROFILL NEQ 0 THEN                                                       
92199100        REPLACE BUFPTR:BUFPTR BY "0" FOR ZEROFILL ;                                 
92200000        IF EXPONENT<0 THEN REPLACE BUFPTR:BUFPTR BY "E-"                            
92201000                      ELSE REPLACE BUFPTR:BUFPTR BY "E+";                           
92202000        REPLACE BUFPTR:BUFPTR BY "0" FOR 2-LENGTH,                                  
92203000                          ABS(EXPONENT) FOR LENGTH DIGITS;                          
92204000       END                                                                          
92205000      ELSE BEGIN   %FIXED-POINT                                                     
92205100       IF SUBFIELD>10 THEN BEGIN                                                    
92205200        ZEROFILL:=SUBFIELD-10; SUBFIELD:=10                                         
92205300       END ELSE ZEROFILL:=0;                                                        
92206000       I:=INTEGERT(ABSVAL:=ABS(ITEM));                                              
92207000       IF J:=ITEM MOD 1*POTL[SUBFIELD] GEQ POTL[SUBFIELD] THEN                      
92208000         BEGIN J:=0; I:=*+1 END;                                                    
92209000       LENGTH:=DIGITSIN(I)+SUBFIELD+ZEROFILL+2;                                     
92210000       ALIGNBUFFER(LENGTH);                                                         
92211000       IF ITEM<0 THEN REPLACE BUFPTR:BUFPTR BY "-"                                  
92212000                ELSE REPLACE BUFPTR:BUFPTR BY " ";                                  
92213000       REPLACE BUFPTR:BUFPTR BY I FOR LENGTH-SUBFIELD-ZEROFILL-2 DIGITS,            
92214000                         ".",J FOR SUBFIELD DIGITS;                                 
92214100       IF ZEROFILL NEQ 0 THEN                                                       
92214200        REPLACE BUFPTR:BUFPTR BY "0" FOR ZEROFILL ;                                 
92215000      END;                                                                          
92216000    NULLTYPE:FIELD:=0;                                                              
92217000    RADIXTYPE: I:=4;                                                                
92218000       IF SUBFIELD NEQ 0 THEN                                                       
92219000        BEGIN                                                                       
92220000         WHILE SUBFIELD<16 DO                                                       
92221000          BEGIN I:=*-1; SUBFIELD:=**2 END;                                          
92222000         IF SUBFIELD NEQ 16 THEN                                                    
92223000          BEGIN                                                                     
92224000           REPLACE BUFFER[0] BY "**** ERROR ****",                                  
92225000                                 "RADIX <> 0,2,4,8,16";                             
92226000           WRITE(F,34,BUFFER[0]);                                                   
92227000           REPLACE BUFFER[0] BY " " FOR CURRENTBYTE                                 
92228000          END                                                                       
92229000        END;                                                                        
92230000        J:=48 DIV I; ALIGNBUFFER(J);                                                
92231000        FOR J:=47 STEP -I UNTIL I-1 DO                                              
92232000         REPLACE BUFPTR:BUFPTR BY FIGURES[ITEM.[J:I]] FOR 1;                        
92233000   END OF CASE;                                                                     
92234000   FINISHED:                                                                        
92235000    BYTESLEFT:=*-FIELD;                                                             
92236000    IF WRITELN THEN                                                                 
92237000     BEGIN IF BYTESLEFT>0 THEN                                                      
92238000           REPLACE BUFPTR BY " " FOR BYTESLEFT;                                     
92239000       WRITE(F,MAXBYTES,BUFFER[0]);                                                 
92240000        STBRWD:=STEPBRANCHWORD & 0[15:16];                                          
92241000   END                                                                              
92242000  ELSE STBRWD:=STEPBRANCHWORD & (CURRENTBYTE+FIELD)[15:16];                         
92243000  PASCALSETTAG4(STBRWD)                                                             
92244000  END OF TEXTFILE;                                                                  
92245000 END.                                                                               