1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 tio_:     procedure;                                        /* dummy tio_, write-around for old tio_ calls */
11 
12       dcl p ptr,                                            /* temporary storage */
13           l fixed bin;
14 
15       dcl aformat char(2) internal static init("^a");       /* for calls to ioa_ from tio_$write_line */
16 
17       dcl ioa_ ext entry,
18           (ios_$write_ptr, ios_$read_ptr) ext entry(ptr, fixed bin, fixed bin);
19 
20 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
21 
22 write_line:  entry(astring, awl);                           /* to write ascii string (w/nl) on user_output */
23 
24       dcl astring char(*) aligned,                          /* ascii string to be written-out (or read-into) */
25           awl fixed bin;
26 
27           if awl <= 0  then do;                             /* optimize typical case (awl= 0) */
28                call ioa_(aformat, astring);                 /* use length(astring) as string length */
29                return;
30                end;
31           l= length(astring);                               /* here if specific length specified by awl */
32           l= min(l, awl);                                   /* insure l <= length(astring) */
33           call ioa_(aformat, substr(astring, 1, l));        /* more expensive call to ioa_ than above */
34           return;
35 
36 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
37 
38 write_string:  entry(astring, awl);                         /* to write ascii string (wo/nl) on user_output */
39 
40           l= length(astring);                               /* compute proper string length */
41           if awl >= 0  then l= min(l, awl);                 /* for call to ios_$write_ptr */
42           p= addr(astring);                                 /* get pointer to base of string */
43           call ios_$write_ptr(p, 0, l);                     /* call ios_ to write string on user_output */
44           return;
45 
46 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
47 
48 read_line:  entry(astring, arl, art);                       /* to read ascii line (w/nl) from user_input */
49 
50       dcl arl fixed bin,                                    /* max. no. of characters to read into astring */
51           art fixed bin;                                    /* no. of characters actually read into astring */
52 
53           l= length(astring);                               /* compute proper string length */
54           if arl > 0  then l= min(l, arl);                  /* for call to ios_$read_ptr */
55           p= addr(astring);                                 /* get pointer to base of string */
56           call ios_$read_ptr(p, l, art);                    /* read one line from user_input */
57           return;
58 
59 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
60 
61 read_ptr: entry(workspace,nelem,nelemt);                    /* entry equivlaent to ios_$read_ptr */
62 
63           dcl workspace ptr,
64               nelem fixed bin,
65               nelemt fixed bin;
66 
67           call ios_$read_ptr(workspace,nelem,nelemt);
68           return;
69 
70 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
71 
72 write_ptr: entry(workspace,offset,nelem);                   /* entry equivalent to ios_$write_ptr */
73 
74           dcl offset fixed bin;
75 
76           call ios_$write_ptr(workspace,offset,nelem);
77           return;
78 
79 
80 end tio_;