1 /****^  ***********************************************************
 2         *                                                         *
 3         * Copyright, (C) Honeywell Bull Inc., 1987                *
 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 get_kstep:
14      proc (a_segno, a_kstep, a_code);
15 
16 /*
17 
18    Written March 1975 by R. Bratt
19 
20    get_kstep provides generally useful kste validation functions
21 
22    ---> get_kstep checks to see that the segment number is connected to a segment
23    USAGE: call get_kstep (segno,kstep,code);
24 
25    ---> get_kstep$dir checks to see that the segment number is connected to a non-phoney directory
26    USAGE: call get_kstep$dir (segno,kstep,code);
27 
28 
29 
30    segno fixed bin (17) - - - segment number
31    kstep ptr - - - pointer to the kstep
32    code fixed bin(35) - - - error code (output)
33 
34    */
35 
36 
37 dcl  a_kstep ptr,
38      dir bit (1) aligned init ("1"b),
39      a_code fixed bin (35),
40     (a_segno, segno) fixed bin (17);
41 
42 dcl (error_table_$invalidsegno, error_table_$notadir) ext fixed bin (35);
43 
44           %include kst;
45 
46           dir = "0"b;
47 
48 dir:      entry (a_segno, a_kstep, a_code);
49 
50           segno = a_segno;
51           a_kstep = null();
52           a_code = 0;
53           kstp = pds$kstp;
54           if segno < kst.lowseg | segno > kst.highest_used_segno
55           then do;
56 err:           a_code = error_table_$invalidsegno;
57                return;
58           end;
59           kstep = addr (kst.kst_entry (segno));
60           if unspec (kste.entryp) = "0"b then go to err;
61           if dir
62           then if ^kste.dirsw | kste.uid = "0"b
63                then do;
64                     a_code = error_table_$notadir;
65                     return;
66                end;
67           a_kstep = kstep;
68           return;
69 
70      end get_kstep;