home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3988 < prev    next >
Internet Message Format  |  1991-09-08  |  15KB
  1. Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley
  2. From: koffley@nrlvx1.nrl.navy.mil
  3. Newsgroups: alt.sources
  4. Subject: VMS UAF PROFILE part 14 of 18
  5. Message-ID: <1991Sep5.074703.558@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:47:03 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 527
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 14 -+-+-+-+-+-+-+-+
  11. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  12. Vcccc
  13. X
  14. X
  15. X`09subroutine SHO_QUEUE (qheader)
  16. X
  17. X
  18. X
  19. X
  20. X`09integer*4           qheader (2), address
  21. X
  22. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  23. X
  24. X`09record      / link_list /  qentry
  25. X
  26. X`09character*1      asterisk    / '*' /
  27. X `09character*80     asterisks
  28. X
  29. X
  30. X
  31. X
  32. X
  33. X`09if ((qheader(1) .eq. 0) .and. (qheader(2) .eq. 0)) then
  34. X`09   write (6,*) 'Queue was empty'
  35. X`09   return
  36. X`09endif
  37. X
  38. X`09call GET_Q_ELEMENT (%val(qheader(1)), qentry)
  39. Xd`09call REPEAT (asterisks, '*')
  40. X
  41. Xd`09write (66,'(1x,a80)' ) asterisks
  42. Xd`09write (66,'(1x,a4,z8)') 'FL = ', qentry.forward_link
  43. Xd`09write (66,'(1x,a4,z8)') 'BL = ',qentry.back_link
  44. Xd`09write (66,*) qentry.username
  45. Xd`09write (66,*) qentry.server
  46. Xd`09write (66,*) qentry.time_stamp
  47. Xd`09write (66,*) qentry.mode
  48. Xd`09write (66,*) qentry.master_pid
  49. Xd`09write (66,*) qentry.pid
  50. Xd`09write (66,*) qentry.login_time
  51. Xd`09write (66,*) qentry.uic
  52. Xd`09write (66,*) qentry.terminal
  53. Xd`09write (66,'(1x,a80)' ) asterisks
  54. X`09call DISPLAY_FIELDS (qentry.username, qentry.server, qentry.time_stamp,`2
  55. V0
  56. X`091                    qentry.mode, qentry.master_pid,`20
  57. X`092                    qentry.pid, qentry.login_time, qentry.uic,
  58. X`093                    qentry.terminal)
  59. X
  60. Xc
  61. Xc ---`09See if queue contained only a single element
  62. Xc
  63. X`09if ((qheader(1) .eq. qheader(2)) .or.
  64. X`091   (qentry.forward_link .eq. qentry.back_link)) then
  65. Xd`09   write (66,*) 'END       OF           QUEUE'
  66. Xd`09   write (66,'(1x,a80)' ) asterisks
  67. Xd`09   write (66,*)
  68. Xd`09   write (66,*)
  69. X`09   return
  70. X`09endif
  71. X
  72. X
  73. X`09do while (qentry.back_link .ne. qheader(2))
  74. X`09   if (qentry.back_link .eq. qheader(2)) then
  75. X`09      address = qentry.back_link
  76. X`09      call GET_Q_ELEMENT (%val(address), qentry)
  77. X
  78. X`09     call DISPLAY_FIELDS (qentry.username, qentry.server, qentry.time_sta
  79. Vmp,`20
  80. X`091                         qentry.mode, qentry.master_pid,`20
  81. X`092                         qentry.pid, qentry.login_time, qentry.uic,
  82. X`093                         qentry.terminal)
  83. Xd`09      write (66,'(1x,a80)' ) asterisks
  84. Xd`09      write (66,'(1x,a4,z8)') 'FL = ', qentry.forward_link
  85. Xd`09      write (66,'(1x,a4,z8)') 'BL = ',qentry.back_link
  86. Xd`09      write (66,*) qentry.username
  87. Xd`09      write (66,*) qentry.server
  88. Xd`09      write (66,*) qentry.time_stamp
  89. Xd`09      write (66,*) qentry.mode
  90. Xd`09      write (66,*) qentry.master_pid
  91. Xd`09      write (66,*) qentry.pid
  92. Xd`09      write (66,*) qentry.login_time
  93. Xd`09      write (66,*) qentry.uic
  94. Xd`09      write (66,*) qentry.terminal
  95. Xd`09      write (66,'(1x,a80)' ) asterisks
  96. Xd`09      write (66,*) 'END       OF           QUEUE'
  97. Xd`09      write (66,'(1x,a80)' ) asterisks
  98. Xd`09      write (66,*)
  99. Xd`09      write (66,*)
  100. X`09   else
  101. X`09      address = qentry.back_link
  102. X`09      call GET_Q_ELEMENT (%val(address), qentry)
  103. X
  104. X`09      call DISPLAY_FIELDS (qentry.username, qentry.server, qentry.time_st
  105. Vamp,`20
  106. X`091                          qentry.mode, qentry.master_pid,`20
  107. X`092                          qentry.pid, qentry.login_time, qentry.uic,
  108. X`093                          qentry.terminal)
  109. Xd`09      write (66,'(1x,a80)' ) asterisks
  110. Xd`09      write (66,'(1x,a4,z8)') 'FL = ', qentry.forward_link
  111. Xd`09      write (66,'(1x,a4,z8)') 'BL = ',qentry.back_link
  112. Xd`09      write (66,*) qentry.username
  113. Xd`09      write (66,*) qentry.server
  114. Xd`09      write (66,*) qentry.time_stamp
  115. Xd`09      write (66,*) qentry.mode
  116. Xd`09      write (66,*) qentry.master_pid
  117. Xd`09      write (66,*) qentry.pid
  118. Xd`09      write (66,*) qentry.login_time
  119. Xd`09      write (66,*) qentry.uic
  120. Xd`09      write (66,*) qentry.terminal
  121. Xd`09      write (66,'(1x,a80)' ) asterisks
  122. Xd`09      write (66,'(1x,a80)' ) asterisks
  123. X`09   endif
  124. X`09enddo
  125. X
  126. X`09if (qentry.back_link .eq. qheader(2)) then
  127. X`09   address = qentry.back_link
  128. X`09   call GET_Q_ELEMENT (%val(address), qentry)
  129. X`09   call DISPLAY_FIELDS (qentry.username, qentry.server, qentry.time_stamp
  130. V,`20
  131. X`091                       qentry.mode, qentry.master_pid,`20
  132. X`092                       qentry.pid, qentry.login_time, qentry.uic,
  133. X`093                       qentry.terminal)
  134. Xd`09   write (66,'(1x,a80)' ) asterisks
  135. Xd`09   write (66,'(1x,a4,z8)') 'FL = ', qentry.forward_link
  136. Xd`09   write (66,'(1x,a4,z8)') 'BL = ',qentry.back_link
  137. Xd`09   write (66,*) qentry.username
  138. Xd`09   write (66,*) qentry.server
  139. Xd`09   write (66,*) qentry.time_stamp
  140. Xd`09   write (66,*) qentry.mode
  141. Xd`09   write (66,*) qentry.master_pid
  142. Xd`09   write (66,*) qentry.pid
  143. Xd`09   write (66,*) qentry.login_time
  144. Xd`09   write (66,*) qentry.uic
  145. Xd`09   write (66,*) qentry.terminal
  146. Xd`09   write (66,'(1x,a80)' ) asterisks
  147. Xd`09   write (66,*) 'END       OF           QUEUE'
  148. Xd`09   write (66,'(1x,a80)' ) asterisks
  149. Xd`09   write (66,*)
  150. Xd`09   write (66,*)
  151. X`09endif
  152. X
  153. X
  154. X
  155. X`09return
  156. X`09end
  157. X
  158. X
  159. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  160. Vcccc
  161. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  162. Vcccc
  163. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  164. Vcccc
  165. X
  166. X
  167. X
  168. X`09subroutine GET_Q_ELEMENT (qentry, temp)
  169. X
  170. X
  171. X
  172. X
  173. X
  174. X
  175. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  176. X
  177. X`09record      / link_list /  qentry
  178. X`09record      / link_list /  temp
  179. X
  180. X
  181. X`09temp.forward_link = qentry.forward_link
  182. X`09temp.back_link    = qentry.back_link
  183. X`09temp.username     = qentry.username
  184. X`09temp.server       = qentry.server
  185. X`09temp.time_stamp   = qentry.time_stamp
  186. X`09temp.mode         = qentry.mode
  187. X`09temp.master_pid   = qentry.master_pid
  188. X`09temp.pid          = qentry.pid
  189. X`09temp.login_time   = qentry.login_time
  190. X`09temp.uic          = qentry.uic
  191. X`09temp.terminal     = qentry.terminal
  192. X
  193. X`09return
  194. X`09end
  195. X
  196. X
  197. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  198. Vcccc
  199. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  200. Vcccc
  201. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  202. Vcccc
  203. X
  204. X
  205. X
  206. X
  207. X`09subroutine REMQH (qheader, status)
  208. X
  209. X
  210. X
  211. X
  212. X`09include              '($SSDEF)'
  213. X`09include              '($LIBDEF)'
  214. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  215. X
  216. X`09record      / link_list /  qentry
  217. X
  218. X`09integer*4      address, qheader (2), temp, num_bytes, status,
  219. X`091              LIB$FREE_VM
  220. X
  221. X`09data            num_bytes     / 157 /
  222. X
  223. X
  224. X
  225. X`09if ((qheader(1) .eq. 0) .and. (qheader(2) .eq. 0)) then
  226. X`09   status = LIB$_QUEWASEMP
  227. Xd`09   write (66,*) 'Queue was empty'
  228. X`09   return
  229. X`09endif
  230. X
  231. X`09address = qheader (1)
  232. X`09call GET_Q_ELEMENT (%val(address), qentry)
  233. X
  234. X`09if ( (qheader(1) .eq. qheader(2) ) .and. (qheader(1) .ne. 0) .and.
  235. X`091    (qentry.back_link .eq. qentry.forward_link)) then
  236. X`09   status = LIB$_ONEENTQUE
  237. Xd`09   write (66,*) 'Last remaining queue entry being removed.'
  238. X`09   status = LIB$FREE_VM (num_bytes, qheader(1))
  239. X`09   if (.not. status) call LIB$SIGNAL (%val(status))
  240. X`09   qheader (1) = 0
  241. X`09   qheader (2) = 0
  242. X
  243. X`09else
  244. X`09   status = LIB$FREE_VM (num_bytes, qheader(1))
  245. X`09   if (.not. status) call LIB$SIGNAL (%val(status))
  246. X`09   qheader(1) = qentry.back_link
  247. X`09   address = qheader (1)
  248. X`09   call UPDATE_FORWARD_LINK (%val(address), qheader(2))
  249. X`09   address = qheader (2)
  250. X`09   call UPDATE_BACK_LINK (%val(address), qheader(1))
  251. X`09endif
  252. X
  253. X
  254. X
  255. X`09return
  256. X`09end
  257. X
  258. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  259. Vcccc
  260. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  261. Vcccc
  262. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  263. Vcccc
  264. X
  265. X
  266. X
  267. X
  268. X`09subroutine REMQT (qheader, status)
  269. X
  270. X
  271. X
  272. X
  273. X`09include              '($SSDEF)'
  274. X`09include              '($LIBDEF)'
  275. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  276. X
  277. X`09record      / link_list /  qentry
  278. X
  279. X`09integer*4      address, qheader (2), temp, num_bytes, status,
  280. X`091              LIB$FREE_VM
  281. X
  282. X`09data            num_bytes     / 157 /
  283. X
  284. X
  285. X
  286. X`09if ((qheader(1) .eq. 0) .and. (qheader(2) .eq. 0)) then
  287. Xd`09   write (66,*) 'Queue was empty'
  288. X`09   status = LIB$_QUEWASEMP
  289. X`09   return
  290. X`09endif
  291. X
  292. X`09address = qheader (2)
  293. X`09call GET_Q_ELEMENT (%val(address), qentry)
  294. X
  295. X`09if ( (qheader(1) .eq. qheader(2) ) .and. (qheader(1) .ne. 0) .and.
  296. X`091    (qentry.back_link .eq. qentry.forward_link)) then
  297. X`09   status = LIB$_ONEENTQUE
  298. Xd`09   write (66,*) 'Last remaining queue entry being removed.'
  299. X`09   status = LIB$FREE_VM (num_bytes, qheader(1))
  300. X`09   if (.not. status) call LIB$SIGNAL (%val(status))
  301. X`09   qheader (1) = 0
  302. X`09   qheader (2) = 0
  303. X
  304. X`09else
  305. X`09   status = LIB$FREE_VM (num_bytes, qheader(2))
  306. X`09   if (.not. status) call LIB$SIGNAL (%val(status))
  307. X`09   qheader(2) = qentry.forward_link
  308. X`09   address = qheader (2)
  309. X`09   call UPDATE_BACK_LINK (%val(address), qheader(1))
  310. X`09   address = qheader (1)
  311. X`09   call UPDATE_FORWARD_LINK (%val(address), qheader(2))
  312. X`09endif
  313. X
  314. X
  315. X
  316. X`09return
  317. X`09end
  318. X
  319. X
  320. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  321. Vcccc
  322. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  323. Vcccc
  324. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  325. Vcccc
  326. X
  327. X
  328. X
  329. Xc`09subroutine DELETE (qheader, mnemonic)
  330. X
  331. X
  332. X
  333. X
  334. Xc`09integer*4           qheader (2), address, T1, T2, status, LIB$FREE_VM,
  335. Xc`091                   num_bytes
  336. X
  337. Xc`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  338. X
  339. Xc`09record      / link_list /  qentry
  340. Xc`09data        num_bytes     / 157 /
  341. X
  342. Xc`09character*8     mnemonic
  343. X
  344. X
  345. X
  346. X
  347. Xc`09if ((qheader(1) .eq. 0) .and. (qheader(2) .eq. 0)) then
  348. Xc`09   write (66,*) 'Queue was empty'
  349. Xc`09   return
  350. Xc`09endif
  351. X
  352. Xc`09call GET_Q_ELEMENT (%val(qheader(1)), qentry)
  353. X
  354. Xc`09if (qentry.mnemonic .eq. mnemonic) then
  355. Xd`09   write (66,*) 'Removed entry from head of queue.'
  356. Xc`09   call REMQH (qheader)
  357. Xc`09   return
  358. Xc`09endif
  359. X
  360. Xc`09do while (qentry.back_link .ne. qheader(2))
  361. Xc`09   if (qentry.back_link .eq. qheader(2)) then
  362. Xc`09      address = qentry.back_link
  363. Xc`09      call GET_Q_ELEMENT (%val(address), qentry)
  364. Xc
  365. Xc`09      if (qentry.mnemonic .eq. mnemonic) then
  366. Xd`09         write (66,*) 'Removed entry from tail of queue.'
  367. Xc`09         call REMQT (qheader)
  368. Xc`09         return
  369. Xc`09      endif
  370. Xc
  371. Xc`09   else
  372. Xc`09      address = qentry.back_link
  373. Xc`09      call GET_Q_ELEMENT (%val(address), qentry)
  374. Xc`09      if (qentry.mnemonic .eq. mnemonic) then
  375. Xc`09         T1 = qentry.forward_link
  376. Xc`09         T2 = qentry.back_link
  377. Xc`09         status = LIB$FREE_VM (num_bytes, address)
  378. Xc`09         if (.not. status) call LIB$SIGNAL (%val(status))
  379. Xc`09         address = T1
  380. Xc`09         call UPDATE_BACK_LINK (%val(address), T2)
  381. Xc`09         address = T2
  382. Xc`09         call UPDATE_FORWARD_LINK (%val(address), T1)
  383. Xc`09         return
  384. Xc`09      endif
  385. Xc
  386. Xc`09   endif
  387. Xc`09enddo
  388. Xc
  389. Xc`09if (qentry.back_link .eq. qheader(2)) then
  390. Xc`09   address = qentry.back_link
  391. Xc`09   call GET_Q_ELEMENT (%val(address), qentry)
  392. Xc`09   if (qentry.mnemonic .eq. mnemonic) then
  393. Xd`09      write (66,*) 'Removed entry from tail of queue.'
  394. Xc`09      call REMQT (qheader)
  395. Xc`09      return
  396. Xc`09   endif
  397. Xc`09endif
  398. X
  399. X
  400. X
  401. X
  402. Xc`09return
  403. Xc`09end
  404. X
  405. X
  406. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  407. Vcccc
  408. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  409. Vcccc
  410. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  411. Vcccc
  412. X
  413. X
  414. X
  415. X`09subroutine SEARCH_QUEUE (qheader, matching_criterion)
  416. X
  417. X
  418. X
  419. X
  420. X`09integer*4           qheader (2), address, matching_criterion,
  421. X`091                   condition
  422. X
  423. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  424. X
  425. X`09record      / link_list /  qentry
  426. X
  427. X
  428. X
  429. X
  430. X
  431. X`09if ((qheader(1) .eq. 0) .and. (qheader(2) .eq. 0)) then
  432. X`09   write (6,*) 'Queue was empty'
  433. X`09   return
  434. X`09endif
  435. X
  436. X`09call GET_Q_ELEMENT (%val(qheader(1)), qentry)
  437. X
  438. X`09call MATCH (matching_criterion, qentry, condition)
  439. X`09if (condition) return
  440. X
  441. X
  442. X`09do while (qentry.back_link .ne. qheader(2))
  443. X`09   if (qentry.back_link .eq. qheader(2)) then
  444. X`09      address = qentry.back_link
  445. X`09      call GET_Q_ELEMENT (%val(address), qentry)
  446. X
  447. X`09      call MATCH (matching_criterion, qentry, condition)
  448. X`09      if (condition) return
  449. X
  450. X`09   else
  451. X
  452. X`09      address = qentry.back_link
  453. X`09      call GET_Q_ELEMENT (%val(address), qentry)
  454. X
  455. X`09      call MATCH (matching_criterion, qentry, condition)
  456. X`09      if (condition) return
  457. X
  458. X`09   endif
  459. X`09enddo
  460. X
  461. X`09if (qentry.back_link .eq. qheader(2)) then
  462. X`09   address = qentry.back_link
  463. X`09   call GET_Q_ELEMENT (%val(address), qentry)
  464. X
  465. X`09   call MATCH (matching_criterion, qentry, condition)
  466. X`09   if (condition) return
  467. X
  468. X`09endif
  469. X
  470. X
  471. X
  472. X`09return
  473. X`09end
  474. X
  475. X
  476. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  477. Vcccc
  478. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  479. Vcccc
  480. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  481. Vcccc
  482. X
  483. X
  484. X
  485. X
  486. X
  487. X`09subroutine MATCH (matching_criterion, qentry, condition)
  488. X
  489. X
  490. X
  491. X
  492. X`09integer*4           qheader (2), address, matching_criterion,
  493. X`091                   condition
  494. X
  495. X`09include              'dua2:`5Bkoffley.com`5Duserlog_struc.inc'
  496. X
  497. X`09record      / link_list /  qentry
  498. X
  499. X
  500. X`09condition = .false.
  501. X
  502. X
  503. X
  504. X`09return
  505. X`09end
  506. X
  507. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  508. Vcccc
  509. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  510. Vcccc
  511. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  512. Vcccc
  513. X
  514. X
  515. X
  516. X`09subroutine INIT_DISPLAYS
  517. X
  518. X
  519. X
  520. X`09common / SMG_data /  paste_ID, kybd_ID, num_rows, num_cols, display_ID,
  521. X`091                    mm_id
  522. X
  523. X`09include        '($syssrvnam)'
  524. X`09include        '($smgdef)'
  525. X`09include        '($iodef)'
  526. X`09include        '($libclidef)'
  527. X
  528. X
  529. X`09integer*4      paste_ID, kybd_ID, zero, num_rows, num_cols,
  530. +-+-+-+-+-+-+-+-  END  OF PART 14 +-+-+-+-+-+-+-+-
  531. -- 
  532. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  533. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  534. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  535. < Space Systems Division             AT&T  :  202-767-0894                   >
  536. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  537.