1 blip:     proc options(variable);
  2 
  3      dcl  Iarg_blip                     fixed bin,
  4           Iarg_non_blip                 fixed bin,
  5           Larg                          fixed bin(21),
  6           Parg                          ptr,
  7           blip_sec                      fixed dec (12,6),
  8           code                          fixed bin(35),
  9           conversion                    condition,
 10           (bell_flag, red_flag, new_line_after_flag, new_line_before_flag)
 11                                         bit (1) aligned;
 12 
 13      dcl  arg                           char(Larg) based(Parg);
 14 
 15      dcl  (addr, character, clock, convert, fixed, length, null, substr)
 16                                         builtin;
 17 
 18      dcl  com_err_                      entry() options(variable),
 19           cu_$arg_ptr                   entry (fixed bin, ptr, fixed bin(21), fixed bin(35)),
 20           hcs_$get_usage_values         entry (fixed bin, fixed bin (71), fixed bin(35)),
 21           iox_$put_chars                entry (ptr, ptr, fixed bin(21), fixed bin(35)),
 22           iox_$control                  entry (ptr, char(*), ptr, fixed bin(35)),
 23           timer_manager_$cpu_call_inhibit
 24                                         entry (fixed bin(71), bit(2), entry),
 25           timer_manager_$reset_cpu_call entry (entry);
 26 
 27      dcl  Iblip                         fixed bin int static,
 28           NL                            char(1) int static options(constant) init("
 29 "),
 30           Nblips                        fixed bin (17) int static,
 31                                                             /* the total number of blips we will cycle through*/
 32           blip_string (20)              char(12) varying int static,
 33           blip_time                     fixed bin(71) int static,
 34                                                             /* the time between blips                         */
 35           error_table_$bad_conversion   fixed bin(35) ext static,
 36           iox_$user_io                  ptr ext static,
 37           next_time                     fixed bin (71) int static;
 38                                                             /* the time in microseconds of the next bli       */
 39 
 40 ^L
 41           call timer_manager_$reset_cpu_call (next_blip);   /* turn off any current blips                     */
 42 
 43           call cu_$arg_ptr (1, Parg, Larg, code);           /* get the first argument                         */
 44           if code ^= 0 then go to NO_TIME;                  /* A CPU time must be first argument.             */
 45 
 46           on conversion go to BAD_TIME;
 47           blip_sec = convert (blip_sec, arg);
 48           blip_time = blip_sec * 1000000;
 49           revert conversion;
 50 
 51           red_flag = "1"b;
 52           bell_flag, new_line_before_flag, new_line_after_flag = "0"b;
 53           Nblips = 0;
 54           Iarg_non_blip = 0;
 55           do Iarg_blip = 2 to 21;
 56 
 57 get_new_arg:   call cu_$arg_ptr (Iarg_blip + Iarg_non_blip, Parg, Larg, code);
 58                if code ^= 0 then go to done_with_arg_loop;  /* get the  arguments                             */
 59 
 60                if arg = "-nl" then do;
 61                     new_line_after_flag = "1"b;
 62 inc_args:           Iarg_non_blip = Iarg_non_blip + 1;
 63                     go to get_new_arg;
 64                     end;
 65                if arg = "-nla" then do;
 66                     new_line_after_flag = "1"b;
 67                     go to inc_args;
 68                     end;
 69                if arg = "-nlb" then do;
 70                     new_line_before_flag = "1"b;
 71                     go to inc_args;
 72                     end;
 73                if arg = "-red" then do;
 74                     red_flag = "1"b;
 75                     go to inc_args;
 76                     end;
 77                if arg = "-black" then do;
 78                     red_flag = "0"b;
 79                     go to inc_args;
 80                     end;
 81                if arg = "-bl" then do;
 82                     red_flag = "0"b;
 83                     go to inc_args;
 84                     end;
 85                if arg = "-nnl" then do;
 86                     new_line_after_flag, new_line_before_flag = "0"b;
 87                     go to inc_args;
 88                     end;
 89                if arg = "-bell" then do;
 90                     bell_flag = "1"b;
 91                     go to inc_args;
 92                     end;
 93                if arg = "-no_bell" then do;
 94                     bell_flag = "0"b;
 95                     go to inc_args;
 96                     end;
 97 
 98                Nblips = Nblips + 1;
 99                blip_string (Nblips) = arg;
100 
101                if red_flag then                             /* put ribbon shifts around the blip              */
102                     blip_string(Nblips) = "^N" || blip_string(Nblips) || "^O";
103                if bell_flag then                            /* put BELL char before blip string.              */
104                     blip_string(Nblips) = "^G" || blip_string(Nblips);
105                if new_line_after_flag then                  /* put a newline after the blip                   */
106                     blip_string(Nblips) = blip_string(Nblips) || NL;
107                if new_line_before_flag then                 /* put a newline before the blip                  */
108                     blip_string(Nblips) = NL || blip_string(Nblips);
109                end;
110 
111 done_with_arg_loop:                                         /* If no blip strings given, use default.         */
112           if Nblips = 0 then do;                            /*   Must reinvoke blip with default strings.     */
113                call blip (character(blip_sec), "0", "1", "2", "3", "4", "5", "6", "7", "8", "9");
114                return;                                      /*   This is easiest way to get the job done.     */
115                end;
116 ^L
117           Iblip = 1;
118           call hcs_$get_usage_values (0, next_time, 0);     /* find out what absolute time to start from */
119           call next_blip;                                   /* get the ball rolling by simulating a timer going off */
120                                                             /* next_blip will set up a timer */
121           return;
122 
123 NO_TIME:  call com_err_ (code, "blip", "no time specified");
124           return;
125 
126 BAD_TIME: call com_err_ (error_table_$bad_conversion, "blip", "
127 ^a is not a valid CPU time increment.", arg);
128           return;
129 ^L
130 next_blip:
131           entry;
132 
133 
134           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
135           /*                                                                                        */
136           /* This entry handles the timer interrupts for blip - inhibit is used so the string of    */
137           /* timers cannot be broken                                                                */
138           /*                                                                                        */
139           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
140 
141           call iox_$put_chars (iox_$user_io, addr(substr(blip_string(Iblip),1)),
142                length(blip_string(Iblip)), code);           /* when the timer rings, we write a blip          */
143           Iblip = Iblip + 1;
144           if Iblip > Nblips then
145                Iblip = 1;
146           call iox_$control (iox_$user_io, "start", null, code);
147                                                             /* we may have messed up the tty di               */
148 
149           next_time = next_time + blip_time;                /* the time of the next blip is computed by       */
150                                                             /* adding the blip interval to the time at which  */
151                                                             /* this timer was supposed to have rung           */
152 
153           call timer_manager_$cpu_call_inhibit (next_time, "00"b, next_blip);
154                                                             /* absolute microseconds the fastest              */
155                                                             /* call cpu_call_inhibit so that the string of    */
156                                                             /* timers can never be broken                     */
157           return;
158 
159 blip_off: entry;                                            /* this command turns off all blips currently     */
160                                                             /* being given                                    */
161 
162           call timer_manager_$reset_cpu_call (next_blip);
163 
164      end blip;
165