%CONTROL X'0FFFFFFF'
!***********************************************************************
!*
!*  SERVICES
!*
!*  ADAPTED FROM EDINBURGH IMP MODULE FCSM10
!*  FOR USE IN BSV35/KSV17 PASCAL SYSTEM (PASCAL 20)
!*
!*  INCLUDES :- ITOE , IOCP/WRITE (LISTING FILE) , NDIAG (DUMMY)
!*  SUPPORTS :- LPUT , OMFOUT , NCODE .
!*
!*  T.MOORE    MARCH '80
!*
!***********************************************************************
!*
!*
%CONSTINTEGER RTMARGIN=120                                                      
%CONSTINTEGER NL=10,NP=12,CR=12                                                       
%CONSTINTEGER FALSEBOOL=0,TRUEBOOL=1
%OWNINTEGER OUTPTR                                                              
%OWNBYTEINTEGERARRAY OUTBUFF(-2:119)                                            
%OWNINTEGER LISTFILEWRITEFAILURE
!*                                                                              
%CONSTBYTEINTEGERARRAY ITOETAB(0 : 255) = %C                                    
     0,                                                                         
     1,     2,     3,    55,    45,                                             
    46,    47,    22,     5,    21,                                             
    11,    12,    13,    14,    15,                                             
    16,    17,    18,    19,    60,                                             
    61,    50,    38,    24,    25,                                             
    63,    39,    28,    29,    30,                                             
    31,    64,    79,   127,   123,                                             
    91,   108,    80,   125,    77,                                             
    93,    92,    78,   107,    96,                                             
    75,    97,   240,   241,   242,                                             
   243,   244,   245,   246,   247,                                             
   248,   249,   122,    94,    76,                                             
   126,   110,   111,   124,   193,                                             
   194,   195,   196,   197,   198,                                             
   199,   200,   201,   209,   210,                                             
   211,   212,   213,   214,   215,                                             
   216,   217,   226,   227,   228,                                             
   229,   230,   231,   232,   233,                                             
    74,   224,    90,    95,   109,                                             
   121,   129,   130,   131,   132,                                             
   133,   134,   135,   136,   137,                                             
   145,   146,   147,   148,   149,                                             
   150,   151,   152,   153,   162,                                             
   163,   164,   165,   166,   167,                                             
   168,   169,   192,   106,   208,                                             
   161,     7,    32,    33,    34,                                             
    35,    36,    37,     6,    23,                                             
    40,    41,    42,    43,    44,                                             
     9,    10,    27,    48,    49,                                             
    26,    51,    52,    53,    54,                                             
     8,    56,    57,    58,    59,                                             
     4,    20,    62,   225,    65,                                             
    66,    67,    68,    69,    70,                                             
    71,    72,    73,    81,    82,                                             
    83,    84,    85,    86,    87,                                             
    88,    89,    98,    99,   100,                                             
   101,   102,   103,   104,   105,                                             
   112,   113,   114,   115,   116,                                             
   117,   118,   119,   120,   128,                                             
   138,   139,   140,   141,   142,                                             
   143,   144,   154,   155,   156,                                             
   157,   158,   159,   160,   170,                                             
   171,   172,   173,   174,   175,                                             
   176,   177,   178,   179,   180,                                             
   181,   182,   183,   184,   185,                                             
   186,   187,   188,   189,   190,                                             
   191,   202,   203,   204,   205,                                             
   206,   207,   218,   219,   220,                                             
   221,   222,   223,   234,   235,                                             
   236,   237,   238,   239,   250,                                             
   251,   252,   253,   254,   255                                              
!*                                                                              
!*                                                                              
%EXTERNALROUTINESPEC ICL9LPCTABORT (%INTEGER COMPFAILFLAG)
%EXTERNALINTEGERFNSPEC ICL9HNOUTPUTLINE (%INTEGER BUFFDR0, BUFFDR1)
%EXTERNALINTEGERFNSPEC ICL9HNNEWLINE (%INTEGER LINES)
%EXTERNALINTEGERFNSPEC ICL9HNNEWPAGE
!*
!*
%SYSTEMROUTINE INITSERVICES
   OUTPTR = 0
   LISTFILEWRITEFAILURE = 0
%END;                           ! INITSERVICES
!*
!*
%SYSTEMROUTINE ITOE(%INTEGER AD, L)                                             
%INTEGER I, J, K                                                                
      I = ADDR(ITOETAB(0))                                                      
      %RETURNIF L <= 0                                                          
      J = X'18000100'                                                           
      K = X'18000000'!L                                                         
      *LSS_I                                                                    
      *LUH_J                                                                    
      *LDTB_K                                                                   
      *LDA_AD                                                                   
      *TTR_%L=%DR                                                               
%END;                                   ! ITOE                                  
!*                                                                              
!*                                                                              
%ROUTINE OUTPUT RECORD
%INTEGER I,J,K
    %IF OUTPTR = 0 %THEN %C
        K = ICL9HNNEWLINE(1) %C
    %ELSESTART
        J = ADDR(OUTBUFF(0))
        ITOE(J,OUTPTR)
        I = X'18000000' ! OUTPTR
        OUTPTR = 0
WRITERECORD:
        K = ICL9HNOUTPUTLINE(I+2,J-2)
        %IF K > 0 %THENSTART
            %IF LISTFILEWRITEFAILURE  = 1 %THENSTART
                ICL9LPCTABORT (FALSEBOOL)
            %FINISH
            LISTFILEWRITEFAILURE = 1
            -> WRITERECORD ;              ! GETS DIVERTED TO JOURNAL
        %FINISH
    %FINISH
%END;                          ! OUTPUT RECORD
!*
!*                                                                              
%SYSTEMINTEGERFN IOCP(%INTEGER EP,N)                                            
%INTEGER I,J,K,L                                                                
%SWITCH SW(1:17)                                                                
      %UNLESS 0<EP<18 %THEN %MONITOR                                            
      -> SW(EP)                                                                 
!*                                                                              
!***  PRINT SYMBOL(N)                                                           
SW(3):                                                                          
!*                                                                              
!***   PRINT CH(N)                                                              
SW(5): %IF N=NL %OR N=NP %OR N=CR %OR OUTPTR >= RTMARGIN %THENSTART                      
          OUTPUT RECORD                                                         
          %IF N=NP %THEN I = ICL9HNNEWPAGE                             
       %FINISHELSESTART                                                         
          OUTBUFF(OUTPTR)=N&X'7F'                                               
          OUTPTR=OUTPTR+1                                                       
       %FINISH                                                                  
       %RESULT=0                                                                
!*                                                                              
!***  PRINTSTRING(N) WHERE N IS ADRESS OF STRING                                
SW(7):L=BYTEINTEGER(N)                                                          
      %IF L=0 %THEN %RESULT=0                                                   
      %CYCLE I=1,1,L                                                            
         J=BYTEINTEGER(I+N)&X'7F'                                               
         %IF J=NL %THEN OUTPUT RECORD %ELSESTART                                
            OUTBUFF(OUTPTR)=J                                                   
            OUTPTR=OUTPTR+1                                                     
            %IF OUTPTR>=RTMARGIN %THEN OUTPUT RECORD                            
         %FINISH                                                                
      %REPEAT                                                                   
      %RESULT = 0                                                               
!*                                                                              
!***   SELECT OUTPUT(N)                                                         
SW(11):
SW(9):%IF OUTPTR>0 %THEN OUTPUT RECORD                                          
      %RESULT=0                                                                 
!*                                                                              
!***  RESTRICTED PRINTSTRING. STRING MUST HAVE NO UNPRINTABLES OR               
!***  CONTROLS (EXCEPT LAST CHAR) AND MAY NOT EXCEED MARGINS                    
SW(15):L = BYTEINTEGER(N)!X'18000000'                                           
       I=ADDR(OUTBUFF(OUTPTR))                                                  
       *LSS_N                ;! ADDRESS OF STRING                               
       *IAD_1                ;! SKIP LENGTH BYTE                                
       *LUH_L                                                                   
       *LDA_I                ;! NEXT FREE BUFFER LOCATION                       
       *LDTB_L                                                                  
       *MV_%L=%DR                                                               
       *INCA_-1              ;! EXAMINE LAST CHAR                               
       *LSS_(%DR)                                                               
       *ST_I                                                                    
       OUTPTR=OUTPTR +(L&255)                                                   
       %IF I=10 %THEN OUTPTR=OUTPTR-1 %AND OUTPUT RECORD                        
       %RESULT=0                                                                
!*                                                                              
!***  MULTIPLE PRINT SYMBOL                                                     
SW(17):I=N&127                                                                  
       J=N>>8                                                                   
      %IF N<0 %OR J=0 %THEN %RESULT=0                                           
       %IF I=NL  %THENSTART                                                     
          %IF OUTPTR >0 %THEN I=IOCP(3,NL) %AND J=J-1;! FORCE OUT CURRENT LINE  
          %IF J>0 %THEN I=ICL9HNNEWLINE(J);! CALL MULTIPLE NEWLINE INTERFACE   
       %FINISHELSESTART                                                         
          %CYCLE L=1,1,J                                                        
             K=IOCP(3,I)                                                        
          %REPEAT                                                               
       %FINISH                                                                  
       %RESULT=0                                                                
%END;! IOCP                                                                     
!*
!*                                                                              
%SYSTEMROUTINE WRITE(%INTEGER I,N)                                              
%STRING(16) S                                                                   
%INTEGER D0,D1,D2,D3,MINCHARS,J                                                 
      N=N&15                                                                    
      %IF I=0 %THENSTART                                                        
         %IF N=0 %THEN N=1                                                      
         SPACES(N)                                                              
         PRINTSYMBOL('0')                                                       
         %RETURN                                                                
      %FINISH                                                                   
      D0=X'18000010'                                                            
      D1=ADDR(S)+1                                                              
      *LD_D0                                                                    
      *LSS_I                                                                    
      *CDEC_0;! 15 DECIMAL DIGITS IN ACC                                        
      *MPSR_X'20';! SET CC=0                                                    
      *SUPK_%L=15,0,32;! UNPACK 15 DIGITS, LEADING ZEROS SUPPRESSED             
      *STD_D0;! DESCRIPTOR TO END OF UNPACK AREA                                
      *LSD_%TOS                                                                 
      *ST_D2;! DESCRIPTOR TO POTENTIAL SIGN POSITION                            
      %IF D1-D3<3 %THENSTART;! ZERO                                             
         MINCHARS=2                                                             
         ->SETLEN                                                               
      %FINISH                                                                   
      %IF I<0 %THEN BYTEINTEGER(D3)='-'                                         
      MINCHARS=D1-D3                                                            
SETLEN:SPACES(N-MINCHARS+1)                                                     
      J=MINCHARS+1                                                              
      D1=D1-J                                                                   
      *LD_D0                                                                    
      *LDB_J;! LENGTH OF STRING                                                 
      *LB_J                                                                     
      *SBB_1                                                                    
      *MVL_%L=1;! INSERT LENGTH                                                 
      *MODD_1;! POINT TO FIRST DIGIT                                            
      *MVL_%L=%DR,15,48;! SET TOP QUARTETS FOR ISO                              
      J=IOCP(15,D1);! FAST PRINTSTRING                                          
%END;! WRITE                                                                    
!*                                                                              
!*                                                                              
%SYSTEMROUTINE NDIAG
    *IDV_0
%END;                 ! NDIAG
!*                                                                              
%ENDOFFILE