home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / MISC / PLM80.ARK / PLMSAMP.PLM < prev    next >
Text File  |  1989-04-05  |  6KB  |  71 lines
  1. /*                                                                              
  2.                        SAMPLE  PL/M  PROGRAM                                    
  3.                                                                                 
  4.     THIS PROGRAM CALCULATES AND PRINTS OUT THE SQUARE ROOTS OF                  
  5.     ALL INTEGERS BETWEEN 1 AND 1000.                                            
  6.                                                                */               
  7. DECLARE CR LITERALLY '0DH', LF LITERALLY '0AH', TRUE LITERALLY '1',             
  8.         FALSE LITERALLY '0';                                                    
  9.                                                                                 
  10. 10H:  /*  IS THE ORIGIN OF THIS PROGRAM */                                      
  11.                                                                                 
  12. SQUARE$ROOT: PROCEDURE(X) BYTE;                                                 
  13.     DECLARE (X,Y,Z) ADDRESS;                                                    
  14.     Y=X; Z=SHR(X+1,1);                                                          
  15.         DO WHILE Y<>Z;                                                          
  16.         Y=Z; Z=SHR(X/Y + Y + 1, 1);                                             
  17.         END;                                                                    
  18.     RETURN Y;                                                                   
  19.     END SQUAREROOT;                                                             
  20.                                                                                 
  21.     /* PRINT USING INTELLEC MONITOR */                                          
  22. PRINT$CHAR: PROCEDURE (CHAR);                                                   
  23.     DECLARE CHAR BYTE;                                                          
  24.     DECLARE IOCO LITERALLY '3809H';                                             
  25.     GO TO IOCO;                                                                 
  26.     END PRINT$CHAR;                                                             
  27.                                                                                 
  28. PRINT$STRING: PROCEDURE(NAME,LENGTH);                                           
  29.     DECLARE NAME ADDRESS,                                                       
  30.         (LENGTH,I,CHAR BASED NAME) BYTE;                                        
  31.         DO I = 0 TO LENGTH-1;                                                   
  32.         CALL PRINT$CHAR(CHAR(I));                                               
  33.         END;                                                                    
  34.     END PRINT$STRING;                                                           
  35.                                                                                 
  36. PRINT$NUMBER: PROCEDURE(NUMBER,BASE,CHARS,ZERO$SUPPRESS);                       
  37.     DECLARE NUMBER ADDRESS, (BASE,CHARS,ZERO$SUPPRESS,I,J) BYTE;                
  38.     DECLARE TEMP(16) BYTE;                                                      
  39.     IF CHARS > LAST(TEMP) THEN CHARS = LAST(TEMP);                              
  40.         DO I = 1 TO CHARS;                                                      
  41.         J=NUMBER MOD BASE + '0';                                                
  42.         IF J > '9' THEN J = J + 7;                                              
  43.         IF ZERO$SUPPRESS AND I <> 1 AND NUMBER = 0 THEN                         
  44.             J = ' ';                                                            
  45.         TEMP(LENGTH(TEMP)-I) = J;                                               
  46.         NUMBER = NUMBER / BASE;                                                 
  47.         END;                                                                    
  48.     CALL PRINT$STRING(.TEMP + LENGTH(TEMP) - CHARS,CHARS);                      
  49.     END PRINT$NUMBER;                                                           
  50.                                                                                 
  51. DECLARE I ADDRESS,                                                              
  52.     CRLF LITERALLY 'CR,LF',                                                     
  53.     HEADING DATA (CRLF,LF,LF,                                                   
  54.     '                        TABLE OF SQUARE ROOTS', CRLF,LF,                   
  55.     ' VALUE  ROOT VALUE  ROOT VALUE  ROOT VALUE  ROOT VALUE  ROOT',             
  56.     CRLF,LF);                                                                   
  57.                                                                                 
  58.     /* SILENCE TTY AND PRINT COMPUTED VALUES */                                 
  59.     DO I = 1 TO 1000;                                                           
  60.     IF I MOD 5 = 1 THEN                                                         
  61.         DO; IF I MOD 250 = 1 THEN                                               
  62.             CALL PRINT$STRING(.HEADING,LENGTH(HEADING));                        
  63.             ELSE                                                                
  64.             CALL PRINT$STRING(.(CR,LF),2);                                      
  65.         END;                                                                    
  66.     CALL PRINT$NUMBER(I,10,6,TRUE /* TRUE SUPPRESSES LEADING ZEROES */);        
  67.     CALL PRINT$NUMBER(SQUARE$ROOT(I), 10,6, TRUE);                              
  68.     END;                                                                        
  69.                                                                                 
  70. EOF                                                                             
  71.