Source Code 1992 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3991 < prev next >

Wrap

Internet Message Format | 1991-09-09 | 14.7 KB

Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley From: koffley@nrlvx1.nrl.navy.mil Newsgroups: alt.sources Subject: VMS UAF PROFILE part 17 of 18 Message-ID: <1991Sep5.074820.561@nrlvx1.nrl.navy.mil> Date: 5 Sep 91 11:48:19 GMT Organization: NRL SPACE SYSTEMS DIVISION Lines: 509 -+-+-+-+-+-+-+-+ START OF PART 17 -+-+-+-+-+-+-+-+ X`09 if (icount .le. 20) then X2`09 kilo = randi (lower,upper) X`09 if ((kilo .le. upper) .or. (kilo .ge. lower)) then X`09 goto 1 X`09 else X`09 goto 2 X`09 endif X`09 else X`09 write (6,*) 'Unable to resolve collision.' X`09 stop X`09 endif X`09 endif X`09 elseif (status .eq. ss$_wasclr) then X`09 call repeat (servers(bit_num), ' ') Xd`09 write (66,*) 'Inserting ',server(1:length),' at ',bit_num X`09 servers(bit_num)(1:length) = server(1:length) X`09 endif X`09 endif X X X`09return X`09end X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X X X`09subroutine set_bit (a, bit_num, status) X X X X X`09include '($SSDEF)' X X`09integer*4 a (1), bit_num, status, array_index, position, i X X X X`09call test_bit (a, bit_num, status) X X X`09if (status .eq. ss$_wasset) then Xc`09 write (6,*) 'SETBIT: bit was already set .... returning.' X`09 return X`09endif X X`09i = bit_num - 1 X`09array_index = (i / 32) + 1 X`09position = bit_num - (32 * (array_index-1)) - 1 X`09`09 X`09a (array_index) = ibset (a(array_index),position) X X`09status = ss$_normal X X`09return X`09end X X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc X X`09subroutine test_bit (a, bit_num, status) X X X X X`09include '($SSDEF)' X X`09integer*4 a (1), bit_num, status, array_index, position, i, X`091 mask, c X X X X`09c = 0 X`09mask = 0 X X`09i = bit_num - 1 X`09array_index = (i / 32) + 1 X`09position = bit_num - (32 * (array_index-1)) - 1 X`09mask = ibset (mask, position) X`09c = iand (a(array_index), mask) X X`09if (c .eq. mask) then X`09 status = ss$_wasset X`09else X`09 status = ss$_wasclr X`09endif X X X`09return X`09end X X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc X X X X`09subroutine clear_bit (a, bit_num, status) X X X X X`09include '($SSDEF)' X X`09integer*4 a (1), bit_num, status, array_index, position, i X X X X`09call test_bit (a, bit_num, status) X X X`09if (status .eq. ss$_wasclr) then Xc`09 write (6,*) 'SETBIT: bit was already clear .... returning.' X`09 return X`09endif X X`09i = bit_num - 1 X`09array_index = (i / 32) + 1 X`09position = bit_num - (32 * (array_index-1)) - 1 X`09`09 X`09a (array_index) = ibclr (a(array_index),position) X X`09status = ss$_normal X X`09return X`09end X X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcc X X X X`09subroutine zero_page (a) X X X`09integer*4 a(1) X X X`09do i = 1, 4 X`09 a(i) = 0 X`09enddo X X X`09return X`09end X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X X`09subroutine find_set_bits (a, bit_num, num_longwords, status) X X X`09include 'sys$library:libdef.for/nolist' X`09include '($ssdef)' X X`09integer*4 a(1), bit_num, status X X`09character*20 servers (184) X`09common / server_info / servers, bitmap_base_addr X Xd`09write (66,*) Xd`09write (66,*) Xd`09write (66,*) X`09 X X`09bit_num = 0 X X`09do bit_num = 1, num_longwords*32 X`09 if (bit_num .gt. 0) then X`09 call test_bit (a, bit_num, status) X`09 if (status .eq. ss$_wasset) then Xd`09 write (66,*) 'bit ',bit_num,' was already set : ',servers(bit_n Vum) X`09 endif X`09 endif X`09enddo X X X`09return X`09end X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X X X`09INTEGER*4 FUNCTION RANDI (LOWER,UPPER) X X`09INTEGER*4 LOWER, UPPER X`09REAL*4 RANDU X`09EXTERNAL RANDU X X`09RANDI = LOWER + INT(RANDU() * (MAX(LOWER,UPPER) -`20 X`091 MIN(LOWER,UPPER) + 1)) X X X`09RETURN X`09END X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc X X`09REAL*4 FUNCTION RANDS (START) X X`09INTEGER*4 START,L,C,M,SEED X`09REAL*4 RANDU X X`09PARAMETER (L=1029,C=221591,M=1048576) X X`09SAVE SEED X`09DATA SEED /0/ X X`09SEED = MOD (ABS(START),M) X X`09ENTRY RANDU() X X`09SEED = MOD(SEED*L+C,M) X`09RANDU = FLOAT (SEED) / M X X`09RETURN X`09END X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vccc X X X`09subroutine DISPLAY_PORTS_SUMMARY`20 X X X X X`09implicit none X X`09include '($SSDEF)' X`09include '($SMGDEF)' X`09include '($TRMDEF)' X`09include '($SYSSRVNAM)' X`09include '($LIBDEF)' X X`09integer*4 bit_num X X`09character*20 servers (184) X`09common / server_info / servers, bitmap_base_addr X X`09common / SMG_data / paste_ID, kybd_ID, num_rows, num_cols, display_ID, X`091 mm_id X X`09integer*2 terminator X X`09integer*4 status, paste_ID, kybd_ID, num_rows,`20 X`091 num_cols, display_ID, mm_id, rows, cols, mask, X`092 modifiers, zero / 0 /, max_chars, scroll_ID, X`093 SMG$READ_STRING, num_q_elements, current_line, X`094 num_scroll_lines, address, i, num, bitmap_base_addr X X`09logical found X X`09character*50 out_str X`09character*5 in_string X X`09integer*4 length, len_trim, two / 2 /, one / 1 /, irow, X`091 max_buffer_size, num_Longwords, num_bits_set X X`09external len_trim, SMG$READ_STRING X X X X X X`09bit_num = 0 X`09num_Longwords = (8 * 24) / 32 X`09num_bits_set = 0 X X`09do bit_num = 1, num_longwords*32 X`09 if (bit_num .gt. 0) then X`09 call test_bit (%val(bitmap_base_addr), bit_num, status) X`09 if (status .eq. ss$_wasset) then X`09 num_bits_set = num_bits_set + 1 Xd`09 write (66,*) 'bit ',bit_num,' was already set : ',servers(bit_n Vum) X`09 endif X`09 endif X`09enddo X X X`09num_scroll_Lines = 5 Xc Xc ---`09Set up the scrolling region Xc X`09rows = num_bits_set + num_scroll_lines - 1 X`09cols = 52 X`09call SMG$CREATE_VIRTUAL_DISPLAY (rows, cols, scroll_ID, SMG$M_BORDER) X`09call SMG$LABEL_BORDER (scroll_ID, ' Ports Summary ') X`09call SMG$CREATE_VIEWPORT (scroll_ID, 1, 1, num_scroll_lines, 50) X`09mask = 0 X`09mask = SMG$M_SCROLL_SMOOTH + SMG$M_CURSOR_OFF X`09call SMG$SET_CURSOR_MODE (paste_ID, mask) X`09call SMG$HOME_CURSOR (scroll_ID, SMG$C_UPPER_LEFT) X`09modifiers = 0 X`09modifiers = TRM$M_TM_ESCAPE .or. TRM$M_TM_NOECHO .or.`09 X`091 TRM$M_TM_PURGE X X`09irow = 1 X`09bit_num = 0 X`09num_Longwords = (8 * 24) / 32 X`09max_buffer_size = 50 X X`09do bit_num = 1, num_longwords*32 X`09 if (bit_num .gt. 0) then X`09 call test_bit (%val(bitmap_base_addr), bit_num, status) X`09 if (status .eq. ss$_wasset) then X`09 call REPEAT (out_str, ' ') X`09 out_str = servers(bit_num) X`09 call CENTER_STRING (out_str, max_buffer_size, status) X`09 call SMG$PUT_CHARS (scroll_ID, out_str, irow, 3, zero, ,,0) X`09 irow = irow + 1 X`09 endif X`09 endif X`09enddo X X X700`09continue X`09max_chars = 6 X`09call SMG$PASTE_VIRTUAL_DISPLAY (scroll_ID, paste_ID, 13, 20) X`09status = SMG$READ_STRING (kybd_ID, in_string, , max_chars, modifiers,,,, X`091 terminator) X X`09irow = num_scroll_lines X`09current_Line = 1 X X`09do while ((status) .and. (terminator .ne. SMG$K_TRM_CR) .and. X`091 (terminator .ne. SMG$K_TRM_ENTER) .and. X`092 (terminator .ne. SMG$K_TRM_CTRLZ)) X`09 if (.not. status) call LIB$SIGNAL (%val(status)) X X`09 if ((terminator .eq. SMG$K_TRM_KP8) .or. X`091 (terminator .eq. SMG$K_TRM_UP) .or. X`092 (terminator .eq. SMG$K_TRM_NEXT_SCREEN)) then X`09 num = current_line + num_scroll_lines X`09 if (num .gt. num_bits_set) then X`09 num = num_bits_set - current_line X`09 current_line = num_bits_set X`09 else X`09 current_line = num X`09 num = num_scroll_lines X`09 endif X X`09 do i = 1, num X`09 call SMG$SCROLL_VIEWPORT (scroll_ID, SMG$M_UP, 1) X`09 enddo X X`09 elseif ((terminator .eq. SMG$K_TRM_KP2) .or. X`091 (terminator .eq. SMG$K_TRM_DOWN) .or. X`092 (terminator .eq. SMG$K_TRM_PREV_SCREEN)) then X`09 num = current_line - num_scroll_lines X`09 if (num .lt. 1) then X`09 num = current_line - 1 X`09 current_line = 1 X`09 else X`09 current_line = num X`09 num = num_scroll_lines X`09 endif X X`09 do i = 1, num X`09 call SMG$SCROLL_VIEWPORT (scroll_ID, SMG$M_DOWN, 1) X`09 enddo X X elseif (terminator.eq.smg$k_trm_ctrlw) then X call smg$repaint_screen ( paste_ID ) X X elseif ((terminator.eq.smg$k_trm_ctrlz) .or. X`091 (terminator .eq. SMG$K_TRM_CR)) then X`09 goto 1000 X X`09 endif X X`09 status = SMG$READ_STRING (kybd_ID, in_string,, max_chars, X`091 modifiers,,,, terminator) X`09enddo X X1000`09mask = 0 X X X`09mask = SMG$M_SCROLL_JUMP + SMG$M_CURSOR_ON X`09call SMG$DELETE_VIRTUAL_DISPLAY (scroll_ID) X`09call SMG$SET_CURSOR_MODE (paste_ID, mask) X`09call SMG$UNPASTE_VIRTUAL_DISPLAY (scroll_id, paste_id) X X X X X`09return X`09end X X X Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X X X $ CALL UNPACK PROFILE.FOR;130 1681590626 $ create 'f' XC************************************************************************ XC Common definitions for UAF XC************************************************************************ X Xd`09integer*4 uai$v_Restricted `20 Xd`09parameter (uai$v_Restricted = 16 ) Xd Xd`09integer*4 uai$v_Disforce_pwd_change Xd`09parameter (uai$v_Disforce_pwd_change = 15 ) X X`09Character*32 account X`09Character*23 exprdate, pwd_lifetime, password_change_date X`09Character*20 u, orig_uname X`09Character*15 uic X`09Character*12 username, password X`09Character*10 cpu_string X Character*6 maxjobs_string, fillm_string, bytlm_string, X .`09`09 maxacctjobs_string, shrfillm_string, X .`09`09 pbytlm_string, maxdetach_string, biolm_string, X .`09`09 jtquota_string, prclm_string, diolm_string, X .`09`09 wsdef_string, prio_string, astlm_string, X .`09`09 wsquo_string, queprio_string, tqelm_string, X .`09`09 wsextent_string, enqlm_string, pgflquo_string, X .`09`09 pwd_length_string X`09Character*23 char_last_login_i, char_last_login_n X`09Integer*4 smg$read_string, smg$create_virtual_keyboard, X .`09`09 smg$create_pasteboard, smg$paste_virtual_display, X .`09`09 smg$create_virtual_display, smg$set_cursor_abs, X .`09`09 smg$begin_pasteboard_update, smg$put_chars_wide, X .`09`09 smg$end_pasteboard_update, smg$put_chars,`20 X .`09`09 smg$change_rendition, smg$erase_display, X . smg$create_viewport, smg$label_border, X . smg$set_cursor_mode, smg$scroll_viewport, X . smg$home_cursor, X .`09`09 ots$cvt_l_ti, ots$cvt_ti_l, ots$cvt_to_l,`20 X .`09`09 sys$asctim, sys$bintim, sys$getuai, sys$setprv,`20 X .`09`09 sys$setuai, sys$assign, sys$qiow,`20 X . lib$disable_ctrl, lib$enable_Ctrl, lib$create_dir,`20 X . lib$getdvi, X .`09`09 lib$bbssi, lib$bbcci, lib$get_foreign, X .`09`09 lib$sys_fao, lib$getjpi, lib$find_file X`09Integer*4 flags, bytlm, prime, jtquota, prio, queprio, X .`09`09 cpu, end_list, days, hours, minutes,`20 X .`09`09 seconds, astlm, biolm, wsdef, diolm, enqlm,`20 X . `09`09 maxacctjobs, maxdetach, maxjobs, pbytlm, fillm, X .`09`09 mem, grp, pgflquo, prclm, shrfillm, tqelm, X .`09`09 wsextent, wsquo, batch_p, batch_s, dialup_p,`20 X .`09`09 dialup_s, local_p, local_s, network_p, network_s,`20 X .`09`09 remote_p, remote_s, uic_value X `09Integer*4 keyboard, main, message, priv_board, flags_board, X .`09`09 access_board, days_board, pasteboard, instruct, X .`09`09 error_message, term, login_board X`09Integer*4 account_len, defdev_len, defdir_len, X .`09`09 owner_len, username_len, password_len, uname_len, X .`09`09 tables_len, lgicmd_len, defcli_len, lastlogi, lastlogn, X . change_date_len X Integer*4 mem_len, grp_len, pwd_life_len, auth_priv_len,`20 X .`09`09 prime_len, def_priv_len, flags_len, pwd_length,`20 +-+-+-+-+-+-+-+- END OF PART 17 +-+-+-+-+-+-+-+- -- \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ < Joe Koffley KOFFLEY@NRLVAX.NRL.NAVY.MIL > < Naval Research Laboratory KOFFLEY@CCF.NRL.NAVY.MIL > < Space Systems Division AT&T : 202-767-0894 > \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/