PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 1 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00001 0 0 [inherit('SYS$SHARE:STARLET','SYS$SHARE:PASCAL$LIB_ROUTINES')] 00002 0 0 00003 C 0 0 {******************************************************************************* 00004 C 0 0 * * 00005 C 0 0 * This program uses the Pseudo Terminal (FT) Driver to implement a terminal * 00006 C 0 0 * loopback in software. It creates two FT devices and copies data between the * 00007 C 0 0 * two: * 00008 C 0 0 * * 00009 C 0 0 * write +----------+ +----------+ read * 00010 C 0 0 * ------>| FT | - - - - - - > | FT |------> * 00011 C 0 0 * | device | | device | * 00012 C 0 0 * <------| 1 | < - - - - - - | 2 |<------ * 00013 C 0 0 * read +----------+ +----------+ write * 00014 C 0 0 * * 00015 C 0 0 * A process can be attached to each FT device. In practice, this program * 00016 C 0 0 * would be run as a subprocess, with the main process talking to one FT device * 00017 C 0 0 * and another process talking to the other. The "other" process could be * 00018 C 0 0 * started by a variety of means: * 00019 C 0 0 * - if the main process sens a CR to "it's" FT device, an interactive login * 00020 C 0 0 * will be initiated on the other FT device (ie Username: prompt) * 00021 C 0 0 * - the main process could create a subprocess attached to the other device. * 00022 C 0 0 * * 00023 C 0 0 * The FT devices are identified by the logical names FT_MASTER_DEVICE ad * 00024 C 0 0 * FT_SLAVE_DEVICE which are created in the JOB logical name table. * 00025 C 0 0 * * 00026 C 0 0 * * 00027 C 0 0 * Author Jeremy Begg 16-Jan-1992 * 00028 C 0 0 * ------ * 00029 C 0 0 * * 00030 C 0 0 * Modifications * 00031 C 0 0 * ------------- * 00032 C 0 0 * 29-Jan-92 JMB Add logging * 00033 C 0 0 * * 00034 C 0 0 *******************************************************************************} 00035 0 0 00036 0 0 Program PSEUDOTERMINAL_PIPE (input, output, pipelog); 00037 0 0 00038 0 0 Const 00039 0 0 data_buffer_size = 500; { Max amount of data in each buffer } 00040 0 0 00041 0 0 Type 00042 0 0 address_range = record 00043 0 0 start_addr, end_addr : unsigned; 00044 0 0 end; 00045 0 0 00046 0 0 thread_ident = (master_to_slave, slave_to_master); 00047 0 0 00048 0 0 io_buffer = [aligned(9), volatile] 00049 0 0 record 00050 0 0 sts : [word] 0..65535; 00051 0 0 data_buffer : [pos(16)] varying [data_buffer_size] of char; 00052 0 0 data_length : 0..data_buffer_size; 00053 0 0 end; 00054 0 0 io_buffer_ptr = ^io_buffer; 00055 0 0 PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 2 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00056 0 0 terminal_thread = [volatile] 00057 0 0 record 00058 0 0 buffer : io_buffer_ptr; 00059 0 0 ft_efn : unsigned; 00060 0 0 ft_chan : [word] 0..65535; 00061 0 0 this_ft : thread_ident; 00062 0 0 other_ft : ^terminal_thread; 00063 0 0 device_name : varying [64] of char; 00064 0 0 logged : boolean; 00065 0 0 end; 00066 0 0 00067 0 0 00068 0 0 Var 00069 0 0 ret_status : integer; 00070 0 0 00071 0 0 buffers : array [master_to_slave..slave_to_master] of io_buffer; {One per FT device} 00072 0 0 buffer_addr : address_range; 00073 0 0 00074 0 0 threads : [volatile] array [master_to_slave..slave_to_master] of terminal_thread value ZERO; 00075 0 0 00076 0 0 pipelog : [volatile] text; 00077 0 0 00078 0 0 exit_block : record 00079 0 0 forward_link : unsigned; 00080 0 0 handler_addr : unsigned; 00081 0 0 arg_count : integer; 00082 0 0 exit_sts_addr : unsigned; 00083 0 0 exit_status : integer; 00084 0 0 end; 00085 0 0 00086 0 0 00087 C 0 0 {******************************************************************************* 00088 C 0 0 * Exit Handler * 00089 C 0 0 *******************************************************************************} 00090 0 0 00091 1 0 procedure exit_handler (var exit_status : integer); 00092 1 1 begin 00093 1 1 LIB$DELETE_LOGICAL ('FT_MASTER_DEVICE', 'LNM$JOB'); 00094 1 1 LIB$DELETE_LOGICAL ('FT_SLAVE_DEVICE', 'LNM$JOB'); 00095 0 0 end; {exit_handler} 00096 0 0 00097 0 0 00098 C 0 0 { This routine is used for debugging } 00099 0 0 [asynchronous, unbound, optimize(noinline)] 00100 1 0 procedure exit (sts : integer); 00101 1 1 begin 00102 1 1 $EXIT(sts); 00103 0 0 end; 00104 0 0 00105 C 0 0 {******************************************************************************* 00106 C 0 0 * Pseudo Terminal Thread * 00107 C 0 0 * * 00108 C 0 0 * The thread consists of a single AST which is invoked when data has been read * 00109 C 0 0 * from its device's "screen", ie the last call to PTD$READ completed. It * 00110 C 0 0 * calls PTD$WRITE to write the data to the "other" FT device, then sets up * PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 3 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00111 C 0 0 * another PTD$READ and exits. This makes for a synchronous transfer from one * 00112 C 0 0 * terminal to the other and minimizes data transfer within this program. * 00113 C 0 0 * * 00114 C 0 0 * Flow control is implemented by examining the status of the PTD$WRITE call; * 00115 C 0 0 * if it is not SS$_NORMAL, the thread processing is suspended until the XON * 00116 C 0 0 * AST is activated which will call the thread_ast routine to continue the * 00117 C 0 0 * write. The PTD$READ request is not issued until all data has been written. * 00118 C 0 0 * * 00119 C 0 0 * Write-with-echo is not implemented to keep things simple. * 00120 C 0 0 * * 00121 C 0 0 *******************************************************************************} 00122 0 0 00123 0 0 [asynchronous,unbound] 00124 1 0 procedure thread_ast (var thread : terminal_thread); 00125 1 0 var ret_status : integer; 00126 1 0 datetime : packed array [1..23] of char; 00127 1 1 begin 00128 C 1 1 { Check the PTD$READ completion status } 00129 1 1 if not odd(thread.buffer^.sts) then exit(thread.buffer^.sts); 00130 1 1 00131 C 1 1 { 00132 C 1 1 Skip the PTD$WRITE if there is no data to write (which is quite possible 00133 C 1 1 if we are being called from XON_AST. Apparently PTD$WRITE doesn't like 00134 C 1 1 a buffer length of 0, even though the manual says it shouldn't mind. 00135 C 1 1 } 00136 1 1 if length(thread.buffer^.data_buffer) > 0 then 00137 1 2 begin 00138 C 1 2 { 00139 C 1 2 Save the length of the data to be written. This is necessary because 00140 C 1 2 the data_buffer.length field is reset to the actual number of bytes 00141 C 1 2 written by PTD$WRITE. The total length of data will be needed by XON_AST 00142 C 1 2 if the buffer is not completely written. 00143 C 1 2 } 00144 1 2 thread.buffer^.data_length := length(thread.buffer^.data_buffer); 00145 1 2 00146 C 1 2 { Write the buffer to the log file } 00147 1 2 if not thread.logged then 00148 1 3 begin 00149 1 3 if thread.this_ft = MASTER_TO_SLAVE then write(pipelog, '---->') else write(pipelog,'<----'); 00150 1 3 $ASCTIM (,datetime,,); 00151 1 3 writeln(pipelog,' ',datetime, thread.this_ft:20); 00152 1 3 writeln(pipelog, thread.buffer^.data_buffer); 00153 1 3 thread.logged := true; 00154 1 2 end; 00155 1 2 00156 C 1 2 { Write the buffer to the "other" device } 00157 1 2 ret_status := PTD$WRITE (thread.other_ft^.ft_chan 00158 1 2 , 00159 1 2 , 00160 1 2 ,thread.buffer^ 00161 1 2 ,length(thread.buffer^.data_buffer) 00162 1 2 ); 00163 1 2 if not odd(ret_status) then exit(ret_status); 00164 1 2 end 00165 1 1 else PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 4 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00166 1 1 ret_status := SS$_NORMAL; { So that PTD$READ is issued } 00167 1 1 00168 C 1 1 { 00169 C 1 1 Check to see if the entire buffer was written. If not, the XON AST will 00170 C 1 1 be triggered and it will call this routine to issue the next PTD$WRITE 00171 C 1 1 for this block of data. Otherwise, carry on. 00172 C 1 1 } 00173 1 1 if thread.buffer^.sts = SS$_NORMAL then 00174 C 1 1 { Set up the next PTD$READ } 00175 1 2 begin 00176 1 2 ret_status := PTD$READ (thread.ft_efn 00177 1 2 ,thread.ft_chan 00178 1 2 ,%immed thread_ast 00179 1 2 ,%ref thread 00180 1 2 ,thread.buffer^ 00181 1 2 ,data_buffer_size 00182 1 2 ); 00183 1 2 if not odd(ret_status) then exit(ret_status); 00184 1 2 thread.logged := false; 00185 1 1 end; 00186 1 1 00187 0 0 end; {thread_ast} 00188 0 0 00189 0 0 00190 C 0 0 { 00191 C 0 0 XON_ast is invoked when a thread has written more characters than the 00192 C 0 0 FTDRIVER's input buffer can cope with. It scans for threads which need 00193 C 0 0 to be restarted. Note that it is possible the terminal driver will issue 00194 C 0 0 an XOFF as the last character is being written, so it is possible that there 00195 C 0 0 is no data to write. In this case, reset the buffer and still call 00196 C 0 0 thread_ast to start the next PTD$READ. 00197 C 0 0 } 00198 1 0 [asynchronous, unbound] procedure XON_ast; 00199 1 0 var t : thread_ident; 00200 1 0 written : [word] 0..65535; 00201 1 0 remaining : [word] 0..65535; 00202 1 0 start : unsigned; 00203 1 1 begin 00204 1 1 for t := master_to_slave to slave_to_master do if (threads[t].buffer^.sts > 0) and_then not odd(threads[t].buffer^.sts) then with threads[t] do 00205 1 2 begin 00206 C 1 2 { Exit if it's an error we can't handle} 00207 1 2 if (buffer^.sts <> SS$_DATAOVERUN) and (buffer^.sts <> SS$_DATALOST) then exit(buffer^.sts); 00208 1 2 00209 C 1 2 { Move the data to be written to the start of the buffer } 00210 1 2 written := length(buffer^.data_buffer); 00211 1 2 remaining := buffer^.data_length - written; 00212 1 2 if remaining > 0 then 00213 1 3 begin 00214 C 1 3 { Move the unwritten data to the start of the buffer } 00215 1 3 start := iaddress(buffer^.data_buffer.body) + written; 00216 1 3 LIB$MOVC3 (remaining, %immed start, %ref buffer^.data_buffer.body); 00217 1 3 buffer^.data_buffer.length := remaining; 00218 1 3 end 00219 1 2 else PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 5 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00220 C 1 2 { We must still call thread_ast to start the next PTD$READ } 00221 1 2 buffer^.data_buffer := ''; 00222 1 2 00223 C 1 2 { Write the remaining data } 00224 1 2 buffer^.sts := 1; 00225 1 2 thread_ast(threads[t]); 00226 1 2 00227 1 1 end; {for/with} 00228 0 0 end; {XON_ast} 00229 0 0 00230 0 0 00231 C 0 0 { 00232 C 0 0 thread_detached_ast is called when an FT device has all its channels 00233 C 0 0 deassigned 00234 C 0 0 } 00235 1 0 procedure thread_detached_ast (var thread : terminal_thread); 00236 1 1 begin 00237 0 0 end; 00238 0 0 00239 0 0 00240 0 0 00241 C 0 0 {******************************************************************************* 00242 C 0 0 * Initialization * 00243 C 0 0 * * 00244 C 0 0 * This routine creates a Pseudo Terminal device and its logical name and * 00245 C 0 0 * initialises thread context for that device. The thread is started by the * 00246 C 0 0 * main program. * 00247 C 0 0 * * 00248 C 0 0 *******************************************************************************} 00249 0 0 00250 1 0 function create_thread (kind : thread_ident) : integer; 00251 1 0 var ret_status : integer; 00252 1 0 logical_name : varying [64] of char; 00253 1 1 begin 00254 1 1 with threads[kind] do 00255 1 2 begin 00256 1 2 LIB$GET_EF (ft_efn); 00257 1 2 this_ft := kind; 00258 1 2 if kind = master_to_slave then 00259 1 3 begin 00260 1 3 logical_name := 'FT_MASTER_DEVICE'; 00261 1 3 other_ft := address(threads[slave_to_master]) 00262 1 3 end 00263 1 2 else 00264 1 3 begin 00265 1 3 logical_name := 'FT_SLAVE_DEVICE'; 00266 1 3 other_ft := address(threads[master_to_slave]) 00267 1 2 end; 00268 1 2 buffer := address(buffers[kind]); 00269 1 2 logged := false; 00270 1 2 ret_status := PTD$CREATE (ft_chan 00271 1 2 , 00272 1 2 , 00273 1 2 , 00274 1 2 ,%immed thread_detached_ast PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 6 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00275 1 2 ,%ref threads[kind] 00276 1 2 , 00277 1 2 ,buffer_addr 00278 1 2 ); 00279 1 2 if odd(ret_status) then 00280 1 3 begin 00281 1 3 ret_status := LIB$GETDVI (DVI$_DEVNAM, ft_chan,,,device_name.body, device_name.length); 00282 1 3 if odd(ret_status) then 00283 1 3 ret_status := LIB$SET_LOGICAL (logical_name, device_name, 'LNM$JOB'); 00284 1 3 end 00285 1 3 00286 1 1 end; {with} 00287 1 1 00288 1 1 create_thread := ret_status; 00289 0 0 end; {create_thread} 00290 0 0 00291 0 0 00292 C 0 0 {******************************************************************************* 00293 C 0 0 * Main Program * 00294 C 0 0 * * 00295 C 0 0 * The main program calls create_thread twice to set up both threads, then * 00296 C 0 0 * issues a PTD$READ request for both threads. It then goes into hibernation * 00297 C 0 0 * from which it never awakens, except to service ASTs. * 00298 C 0 0 * * 00299 C 0 0 *******************************************************************************} 00300 0 0 00301 0 1 begin {PSEUDOTERMINAL_PIPE} 00302 0 1 00303 C 0 1 { 00304 C 0 1 Declare an Exit Handler 00305 C 0 1 } 00306 0 1 exit_block.handler_addr := iaddress(exit_handler); 00307 0 1 exit_block.arg_count := 1; 00308 0 1 exit_block.exit_sts_addr := iaddress(exit_block.exit_status); 00309 0 1 $DCLEXH (exit_block); 00310 0 1 00311 0 1 00312 C 0 1 { 00313 C 0 1 Set up the buffer addresses for PTD$CREATE 00314 C 0 1 } 00315 0 1 buffer_addr.start_addr := iaddress(buffers); 00316 0 1 buffer_addr.end_addr := uand(iaddress(buffers) + size(buffers), %XFFFFFE00); 00317 0 1 00318 C 0 1 { 00319 C 0 1 Create the master_to_slave thread 00320 C 0 1 } 00321 0 1 ret_status := create_thread (master_to_slave); 00322 0 1 if not odd(ret_status) then 00323 0 2 begin 00324 0 2 writeln('Error creating master_to_slave thread!'); 00325 0 2 exit(ret_status); 00326 0 1 end; 00327 0 1 writeln('FT_MASTER_DEVICE created on ',threads[master_to_slave].device_name); 00328 0 1 00329 0 1 PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 7 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00330 C 0 1 { 00331 C 0 1 Create the slave_to_master thread 00332 C 0 1 } 00333 0 1 ret_status := create_thread (slave_to_master); 00334 0 1 if not odd(ret_status) then 00335 0 2 begin 00336 0 2 writeln('Error creating slave_to_master thread!'); 00337 0 2 exit(ret_status); 00338 0 1 end; 00339 0 1 writeln('FT_SLAVE_DEVICE created on ',threads[slave_to_master].device_name); 00340 0 1 00341 0 1 00342 C 0 1 { 00343 C 0 1 Set XON ASTs for both threads 00344 C 0 1 } 00345 0 1 ret_status := PTD$SET_EVENT_NOTIFICATION (threads[master_to_slave].ft_chan, xon_ast,,,PTD$C_SEND_XON); 00346 0 1 if not odd(ret_status) then 00347 0 2 begin 00348 0 2 writeln('Error setting XON AST for master_to_slave thread!'); 00349 0 2 exit(ret_status); 00350 0 1 end; 00351 0 1 ret_status := PTD$SET_EVENT_NOTIFICATION (threads[slave_to_master].ft_chan, xon_ast,,,PTD$C_SEND_XON); 00352 0 1 if not odd(ret_status) then 00353 0 2 begin 00354 0 2 writeln('Error setting XON AST for slave_to_master thread!'); 00355 0 2 exit(ret_status); 00356 0 1 end; 00357 0 1 00358 0 1 00359 C 0 1 { 00360 C 0 1 Open the log file 00361 C 0 1 } 00362 0 1 open (file_variable := pipelog 00363 0 1 ,history := NEW 00364 0 1 ,record_length := data_buffer_size 00365 0 1 ,carriage_control := LIST 00366 0 1 ,sharing := READWRITE 00367 0 1 ); 00368 0 1 rewrite(pipelog); 00369 0 1 00370 0 1 00371 C 0 1 { 00372 C 0 1 Start the master_to_slave thread 00373 C 0 1 } 00374 0 1 ret_status := PTD$READ (threads[master_to_slave].ft_efn 00375 0 1 ,threads[master_to_slave].ft_chan 00376 0 1 ,%immed thread_ast 00377 0 1 ,%ref threads[master_to_slave] 00378 0 1 ,threads[master_to_slave].buffer^ 00379 0 1 ,data_buffer_size 00380 0 1 ); 00381 0 1 if not odd(ret_status) then 00382 0 2 begin 00383 0 2 writeln('Error starting master_to_slave thread!'); 00384 0 2 exit(ret_status); PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 8 01 Source Listing 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) -LINE-IDC-PL-SL- 00385 0 1 end; 00386 0 1 00387 0 1 00388 C 0 1 { 00389 C 0 1 Start the slave_to_master thread 00390 C 0 1 } 00391 0 1 ret_status := PTD$READ (threads[slave_to_master].ft_efn 00392 0 1 ,threads[slave_to_master].ft_chan 00393 0 1 ,%immed thread_ast 00394 0 1 ,%ref threads[slave_to_master] 00395 0 1 ,threads[slave_to_master].buffer^ 00396 0 1 ,data_buffer_size 00397 0 1 ); 00398 0 1 if not odd(ret_status) then 00399 0 2 begin 00400 0 2 writeln('Error starting slave_to_master thread!'); 00401 0 2 exit(ret_status); 00402 0 1 end; 00403 0 1 00404 0 1 00405 C 0 1 { 00406 C 0 1 Now we can go to sleep 00407 C 0 1 } 00408 0 1 writeln('Hibernating...'); 00409 0 1 $HIBER; 00410 0 1 00411 0 0 end. PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 9 01 Pascal Compilation Statistics 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) PSECT SUMMARY Name Bytes Attributes $CODE 3295 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) $LOCAL 1216 NOVEC, WRT, RD,NOEXE,NOSHR, LCL, REL, CON, PIC,ALIGN(9) ENVIRONMENT STATISTICS -------- Symbols -------- File Total Loaded Percent SYS$COMMON:[SYSLIB]STARLET.PEN;3 32078 99 0 SYS$COMMON:[SYSLIB]PASCAL$LIB_ROUTINES.PEN;3 1225 48 4 COMMAND QUALIFIERS PASCAL/CHECK/NOOPTIMIZE/LIST/DEB PTP /CHECK=(BOUNDS,CASE_SELECTORS,DECLARATIONS,OVERFLOW,POINTERS,SUBRANGE) /DEBUG=(SYMBOLS,TRACEBACK) /NODESIGN /SHOW=(DICTIONARY,INCLUDE,NOINLINE,HEADER,SOURCE,STATISTICS,TABLE_OF_CONTENTS) /NOOPTIMIZE /STANDARD=NONE /TERMINAL=(NOFILE_NAME,NOROUTINE_NAME,NOSTATISTICS) /USAGE=(NOUNUSED,UNINITIALIZED,NOUNCERTAIN) /NOANALYSIS_DATA /NOENVIRONMENT /LIST=$USERS:[JEREMY.PMDF]PTP.LIS;18 /OBJECT=$USERS:[JEREMY.PMDF]PTP.OBJ;18 /NOCROSS_REFERENCE /ERROR_LIMIT=30 /NOG_FLOATING /NOMACHINE_CODE /NOOLD_VERSION /WARNINGS COMPILER INTERNAL TIMING Phase Faults CPU Time Elapsed Time Initialization 184 00:00.2 00:00.7 Source Analysis 1000 00:03.6 00:06.7 Source Listing 14 00:00.5 00:01.0 Tree Construction 125 00:00.3 00:01.1 Flow Analysis 0 00:00.0 00:00.0 Value Propagation 0 00:00.0 00:00.0 Profit Analysis 0 00:00.0 00:00.0 Context Analysis 243 00:01.6 00:02.0 Name Packing 1 00:00.1 00:00.1 Code Selection 62 00:00.3 00:00.5 Final 24 00:00.6 00:00.7 TOTAL 1656 00:07.3 00:12.9 COMPILATION STATISTICS CPU Time: 00:07.3 (3401 Lines/Minute) Elapsed Time: 00:12.9 PSEUDOTERMINAL_PIPE 29-Jan-1992 12:45:08 VAX Pascal V4.1-33 Page 10 01 Pascal Compilation Statistics 29-Jan-1992 12:44:47 $USERS:[JEREMY.PMDF]PTP.PAS;15 (1) Page Faults: 1656 Pages Used: 2903 Compilation Complete