1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(86-10-01,JRGray), approve(86-10-01,MCR7507),
 17      audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202):
 18      Modified to allow for joining blocks to the definition section.
 19                                                    END HISTORY COMMENTS */
 20 
 21 
 22 putout_:  procedure ;
 23 
 24 
 25 /* Modified for separate static on 06/15/75 by Eugene E Wiatrowski */
 26 /* Modified on 11/23/72 at 00:56:57 by R F Mabee. Removed eb_data_$zerbuf. */
 27 /* Modified by RHG on 7 August 1970 at 0534 to fix dimension of eb_data_$zerbuf */
 28 % include varcom ;
 29 
 30 % include concom ;
 31 
 32 % include curlc ;
 33 
 34 declare   (lary, rary, xlary, xlword) ptr ;
 35 
 36  declare  binword (n) fixed binary based (lary);
 37 
 38 declare   relword(n) based (rary) fixed bin (35) ;
 39 
 40 declare   ( xpc, xary, xword, xhow, xn, how, rword, xrary, xrword, relwrd, origin, segmnt, i, n ) fixed bin (35) ;
 41           declare word fixed bin (35);
 42 
 43 declare   ( eb_data_$mb28, eb_data_$mb29) fixed bin ( 35 )  ext ;
 44 
 45           /* EXTERNAL FUNCTIONS */
 46 declare   glpl_$clh ext entry (fixed bin) returns (fixed bin),
 47           glpl_$crh ext entry (fixed bin) returns (fixed bin),
 48           utils_$or ext entry (fixed bin (35), fixed bin (35)) returns (fixed bin (35)),
 49           utils_$and ext entry (fixed bin (35), fixed bin (35)) returns (fixed bin (35)) ;
 50 
 51           /* EXTERNAL ENTRIES */
 52 declare   putxt_$putxt_ ext entry (fixed bin (35), fixed bin (35), fixed bin (35)),
 53           pulnk_$pulnk_ ext entry (fixed bin (35), fixed bin (35), fixed bin (35)),
 54           pudef_$pudef_ ext entry (fixed bin (35), fixed bin (35), fixed bin (35)),
 55           pusmb_$pusmb_ ext entry (fixed bin (35), fixed bin (35), fixed bin (35)),
 56           prwrd_$prwrd2 ext entry (fixed bin (35), fixed bin (35), fixed bin (35), fixed bin (35)) ;
 57 
 58 
 59 putlst:   entry( xpc, xary, xhow, xn, xrary ) ;
 60 
 61           n = xn ;
 62 
 63           lary = addr( xary ) ;
 64 
 65           rary = addr(xrary) ;
 66 
 67           go to label_1000 ;
 68 
 69 
 70 
 71 putwrd:   entry( xpc, xword, xhow, rword ) ;
 72 
 73           n = 1 ;
 74 
 75           lary = addr( xword ) ;
 76 
 77           rary = addr( rword ) ;
 78 
 79           go to label_1000;
 80 
 81 
 82 
 83 
 84 putblk:   entry( xpc, xlary, xhow, xn, xlword ) ;
 85 
 86           n = xn ;
 87 
 88           lary = xlary ;
 89 
 90           rary = xlword ;
 91 
 92 
 93 
 94 
 95 
 96 
 97 label_1000:
 98 
 99           origin = glpl_$clh( curlc + 3 ) ;
100 
101           segmnt = glpl_$crh( curlc + 4 ) ;
102 
103 
104 label_1030:
105 
106           do i = 1 to n ;
107 
108                     word = lary -> binword(i)  ;
109 
110                     if rary ^= null () then relwrd = rary -> relword (i) ; else relwrd = 0;
111 
112                     how = xhow ;
113 
114           if utils_$and( word, eb_data_$mb29 ) ^= 0 & how = i642 then how = i1542 ;
115 
116           if tinhib ^= 0 & ( how = i642 | how = i1542 ) then word = utils_$or( word, eb_data_$mb28 ) ;
117 
118           if segmnt = 1 then go to label_1010 ;   /* link */
119 
120           if segmnt = 2 then go to label_1015 ;   /* symbol */
121 
122           if segmnt = 4 then go to label_1010 ;   /* separate static */
123 
124           if segmnt = 8 then go to label_1017 ;   /* definition */
125 
126 
127 label_1005:
128                                         /* text */
129 
130           call putxt_$putxt_ ( xpc+origin, word, relwrd ) ;
131 
132           go to label_1020 ;
133 
134 
135 label_1010:
136 
137           call pulnk_$pulnk_ ( xpc+origin, word, relwrd ) ;
138 
139           go to label_1020 ;
140 
141 label_1015:
142 
143           call pusmb_$pusmb_ ( xpc+origin, word, relwrd ) ;
144 
145           go to label_1020 ;
146 
147 label_1017:
148 
149           call pudef_$pudef_ ( xpc+origin, word, relwrd ) ;
150 
151 
152 label_1020:
153 
154           call prwrd_$prwrd2( xpc+origin, word, how, relwrd ) ;
155 
156           xpc = xpc + 1 ;
157 
158 end label_1030 ;
159 
160 end putout_ ;