C---------------------------------------------------------------------------------------------------------------------------------- C C BLACKBOARD C C Frederick S. Schebor C KMS Fusion Inc. C 700 KMS Place C P.O. Box 1567 C Ann Arbor, MI 48106-1567 C (313) 769-8500 C 03/13/89 C C A generic blackboard designed to run under VMS. C C---------------------------------------------------------------------------------------------------------------------------------- C C C MODULE NAME: BLACKBOARD C MODULE FUNCTION: Contains all routines necessary to implement the blackboard C SUBMODULES: C blackboard C initialize_blackboard_system C execute_all_left_hand_sides C insert_bids_into_ks_agenda C resolve_agendas C execute_chosen_ks C exit_blackboard_system C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C BLACKBOARD C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 03/13/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Main program for the blackboard system. C METHOD: Initialize the world, read knowledge source file. Enter the recognize/act cycle. C When no knowledge source left hand sides respond, its time to exit. C REFERENCED ROUTINES: initialize_blackboard_system SUBROUTINE C read_ks_description_file SUBROUTINE C resolve_agendas SUBROUTINE C execute_chosen_ks SUBROUTINE C exit_blackboard_system SUBROUTINE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND PROGRAM blackboard IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INTEGER*2 cycle_count, chosen_ks_index LOGICAL*1 error WRITE ( 6, '( 1X, /, 1X, ''VMS Blackboard System Version:'', A, / )' ) version_number !Whats running CALL initialize_blackboard_system ( error ) !Initialize the world IF ( .NOT. error ) THEN !Ok to continue? CALL read_ks_description_file ( error ) !Get the list of ks names cycle_count = 1 !Init for loop DO WHILE ( .NOT. error ) !Loop until we get an error WRITE ( 6, '( 1X, /, 1X, '' BB Cycle: '', I3.3 )' ) cycle_count !What count are we on? CALL execute_all_left_hand_sides ( error ) !Execute all left hand sides IF ( .NOT. error ) THEN !Spawn left hand sides successfully? CALL wait_for_lhs_completion ( error ) !Wait for all left hand sides to complt IF ( .NOT. error ) THEN !OK? CALL insert_bids_into_ks_agenda ( error ) !Read bids from the mailbox IF ( last_ks_agenda_entry .EQ. 0 ) THEN !Did anyone respond? error = .TRUE. !Set the flag if not WRITE ( 6, '( 1X, '' No knowledge source met the conditions ... exiting'' )' ) !Why are we exiting? ELSE IF ( .NOT. error ) THEN !Some knowledge sources responded CALL resolve_agendas ( chosen_ks_index ) !What knowledge source should we run? CALL execute_chosen_ks ( chosen_ks_index ) !Run it cycle_count = cycle_count + 1 !Here we go around again END IF ! END IF ! END IF ! END DO ! CALL exit_blackboard_system !Shut everything down END IF ! WRITE ( 6, '( 1X )' ) !Nice and pretty CALL EXIT !Lets not leave anything around END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK_KS_NAME C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 03/14/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Check a knowledge source name for goodness e.g. alpha characters and/or $, _ C METHOD: Check the name character by character C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE check_ks_name ( ks_name C*(*) I The knowledge source name C number_of_characters I*2 I Number of characters in the name C error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE check_ks_name ( ks_name, number_of_characters, error ) IMPLICIT NONE INTEGER*2 number_of_characters, char_index LOGICAL*1 error CHARACTER*1 test_char CHARACTER*(*) ks_name error = .FALSE. !No errors yet! CALL remove_leading_blanks ( ks_name, number_of_characters ) !Get rid of leading blanks IF ( number_of_characters .GT. 0 ) THEN !Is there anything there? char_index = 1 !Start at the first character DO WHILE ( ( char_index .LE. number_of_characters ) .AND. ( .NOT. error ) ) !While there are still more characters.. test_char = ks_name( char_index : char_index ) !Isolate the character IF ( ( ( test_char .GE. 'A' ) .AND. ( test_char .LE. 'Z' ) ) .OR. 1 ( ( test_char .GE. '0' ) .AND. ( test_char .LE. '9' ) .AND. ( char_index .GT. 1 ) ) .OR. 1 ( test_char .EQ. '_' ) .OR. ( test_char .EQ. '$' ) .OR. ( test_char .EQ. '-' ) ) THEN !Is it ok? char_index = char_index + 1 !Move on to the next character ELSE !Else we have a problem error = .TRUE. !Set the flag WRITE ( 6, '( 1X, '' ERROR - Invalid character: '', A, '' in knowledge source name: '', A )' ) test_char, 1 ks_name( 1 : number_of_characters ) !Display a message END IF ! END DO ! ELSE !If there are no characters there error = .TRUE. !Set the flag but no message END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ENTER_NAME_INTO_KS_TABLE C C FILE NAME: ML_AND_KS_UTILITIES.FOR C CREATION DATE: 03/14/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Enter a knowledge source name into the KS_DESCRIPTION_TABLE. C METHOD: If there is space left, append the name to the end. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE enter_name_into_ksd_table ( ks_name C*(*) I The knowledge source name C number_of_characters I*2 I Number of characters in the name C error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE enter_name_into_ksd_table( ks_name, number_of_characters, error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INTEGER*2 number_of_characters LOGICAL*1 error CHARACTER*(*) ks_name number_of_ks_names = number_of_ks_names + 1 !Increment the pointer IF ( number_of_ks_names .GT. max_number_of_ks_names ) THEN !Is there any space left? error = .TRUE. !Set the error flag WRITE ( 6, '( 1X, '' ERROR - maximum number of knowledge source names exceeded'' )' ) !Display a message ELSE ! error = .FALSE. !Clear the flag ks_description_table( number_of_ks_names ).ks_lhs_name = ks_name( 1 : number_of_characters ) !Enter the name END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C EXECUTE_ALL_LEFT_HAND_SIDES C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 04/01/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Execute all knowledge source left hand sides. C METHOD: For every knowledge source name in the list, append a "_LHS" to the name and spawn a RUN command to run it. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE execute_all_left_hand_sides ( error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE execute_all_left_hand_sides( error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INTEGER*2 knowledge_source_index, number_of_characters INTEGER*4 return_status, LIB$SPAWN, no_wait LOGICAL*1 error CHARACTER*15 process_name CHARACTER*31 knowledge_source_name PARAMETER ( no_wait = 1 ) error = .FALSE. !No errors yet knowledge_source_index = 1 !Init for the loop WRITE ( 6, '( 1X, '' Executing knowledge source left hand sides...'' )' ) !What are we waiting for? DO WHILE ( knowledge_source_index .LE. number_of_ks_names ) !For each ks name in the list... return_status = LIB$SPAWN ( 'RUN ' // ks_description_table( knowledge_source_index ).ks_lhs_name, , , no_wait, , 1 ks_description_table( knowledge_source_index ).ks_process_id ) IF ( .NOT. return_status ) THEN !Did the spawn go ok? error = .TRUE. !Flag it if not CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message ELSE ! knowledge_source_index = knowledge_source_index + 1 !How many so far? END IF ! END DO ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C EXECUTE_CHOSEN_KS C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 04/01/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Given an index into a list of ks names, execute the one pointed to by the index. C METHOD: Append a "_RHS" to the name and spawn a command to RUN it. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE execute_chosen_ks ( chosen_ks_index I*2 I The index of the ks to run C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE execute_chosen_ks ( chosen_ks_index ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INTEGER*2 chosen_ks_index, number_of_characters INTEGER*4 return_status, LIB$SPAWN CHARACTER*31 knowledge_source_name WRITE ( 6, '( 1X, '' Executing chosen knowledge source right hand side... '' )' ) !What are we doing return_status = LIB$SPAWN ( 'RUN ' // ks_agenda( chosen_ks_index ).ks_rhs_name, , , ) !Run the right hand side and wait IF ( .NOT. return_status ) THEN !Did the spawn go ok? CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message if not END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C EXIT_BLACKBOARD_SYSTEM C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 04/01/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Exit the blackboard system. C METHOD: Delete the agenda mailbox and the blackboard logical name table. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE exit_blackboard_system ( No passed parameters C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE exit_blackboard_system IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INCLUDE '( $PSLDEF )/NOLIST' INTEGER*4 return_status, SYS$DELLNM, SYS$DELMBX return_status = SYS$DELMBX ( %VAL ( agenda_mailbox_channel ) ) !Delete the agenda mailbox IF ( .NOT. return_status ) THEN !Problems deleting the mailbox? CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message END IF ! return_status = SYS$DELLNM ( 'LNM$SYSTEM_DIRECTORY', blackboard_table_name, %REF ( PSL$C_SUPER ) ) !Delete the blackboard IF ( .NOT. return_status ) THEN !Problems deleting the blackboard? CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C INITIALIZE_BLACKBOARD_SYSTEM C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 03/13/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Initialize the blackboard system. C METHOD: Create a mailbox where the knowledge source left hand sides can write their responses. Create a logical name table C which will act as the blackboard. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE initialize_blackboard_system ( error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: put_blackboard_data SUBROUTINE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE initialize_blackboard_system ( error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INCLUDE '( $LNMDEF )/NOLIST' INCLUDE '( $PSLDEF )/NOLIST' INTEGER*4 return_status, SYS$CRELNT, SYS$CREMBX LOGICAL*1 error number_of_ks_names = 0 !No knowledge sources have responded yet return_status = SYS$CREMBX ( , agenda_mailbox_channel, , , , , agenda_mailbox_name )!Create the agenda mailbox IF ( .NOT. return_status ) THEN !Was the mailbox created? error = .TRUE. !Flag it if not CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message ELSE ! return_status = SYS$CRELNT ( LNM$M_CREATE_IF, , , , 0, blackboard_table_name, 'LNM$SYSTEM_DIRECTORY', 1 %REF ( PSL$C_SUPER ) ) !Create blackboard logical name table IF ( .NOT. return_status ) THEN !Did we create the table? error = .TRUE. !Set the error flag CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message ELSE ! CALL put_blackboard_data ( 'BLACKBOARD_STATUS', 'STARTING', return_status ) !Set the initial blackboard value END IF ! END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C INSERT_BIDS_INTO_KS_AGENDA C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 04/02/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Get the bids from the left hand sides are put them into the agends C METHOD: Read from the mailbox until we get an end of file. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE insert_bids_into_ks_agenda ( error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE insert_bids_into_ks_agenda ( error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INCLUDE 'blackboard$dir:io_status_block.inc /NOLIST' INCLUDE '( $SSDEF ) /NOLIST' INCLUDE '( $IODEF ) /NOLIST' INTEGER*4 return_status, SYS$QIOW, read_code LOGICAL*1 error CHARACTER*31 agenda_element CHARACTER*255 ks_bid error = .FALSE. !No errors yet last_ks_agenda_entry = 0 read_code = IO$_READVBLK .OR. IO$M_NOW !Read a virtual block now return_status = SS$_NORMAL !Init for loop io_status_block.status = SS$_NORMAL !Init for loop DO WHILE ( ( return_status .EQ. SS$_NORMAL ) .AND. ( io_status_block.status .NE. SS$_ENDOFFILE ) ) !For every message... return_status = SYS$QIOW ( , %VAL ( agenda_mailbox_channel ), %VAL ( read_code ), io_status_block, , , %REF ( ks_bid ), 1 %VAL ( LEN ( ks_bid ) ), , , , ) !Read it IF ( .NOT. return_status ) THEN !Read ok? CALL LIB$SIGNAL ( %VAL ( return_status ) ) !Display the error message if not error = .TRUE. !Flag it ELSE IF ( io_status_block.status .EQ. SS$_ENDOFFILE ) THEN !Did we get an end of file? WRITE ( 6, '( 1X, '' All knowledge source bids received. Total: '', I3 )' ) last_ks_agenda_entry !# of resp ELSE !Transfer into the agenda CALL STR$ELEMENT ( agenda_element, 0, agenda_element_delimiter, ks_bid ) !Locate the 0th element READ ( agenda_element, '( A )' ) ks_agenda( last_ks_agenda_entry + 1 ).ks_rhs_name !Put into data structure CALL STR$ELEMENT ( agenda_element, 1, agenda_element_delimiter, ks_bid ) !Locate the 1st element READ ( agenda_element, * ) ks_agenda( last_ks_agenda_entry + 1 ).number_conditions_matched !Put into data stuc CALL STR$ELEMENT ( agenda_element, 2, agenda_element_delimiter, ks_bid ) !Locate the 2nd element READ ( agenda_element, * ) ks_agenda( last_ks_agenda_entry + 1 ).cpu_time_sec !Put into data structure CALL STR$ELEMENT ( agenda_element, 3, agenda_element_delimiter, ks_bid ) !Locate the 3rd element READ ( agenda_element, * ) ks_agenda( last_ks_agenda_entry + 1 ).certainty_of_result !Put into data structure last_ks_agenda_entry = last_ks_agenda_entry + 1 !How many so far END IF ! END DO ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C READ_KS_DESCRIPTION_FILE C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 03/13/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Read a file of knowledge source names. C METHOD: Prompt for the filename, open the file, read a record can call routines the check the name and enter it into the C KNOWLEDGE_SOURCE_DESCRIPTION_TABLE. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE read_ks_description_file ( error L*1 O .TRUE. if any error occured C ) C REFERENCED ROUTINES: check_ks_name SUBROUTINE C enter_name_into_ks_table SUBROUTINE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE read_ks_description_file ( error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INTEGER*2 number_of_characters INTEGER*4 io_status LOGICAL*1 error CHARACTER*31 ks_name CHARACTER*255 ksd_filename, ksd_record error = .TRUE. WRITE ( 6, '( 1X, '' Enter the knowledge source description filename: '', $ )' ) !Prompt for the filename READ ( 5, '( Q, A )', IOSTAT = io_status ) number_of_characters, ksd_filename !Read the user's response IF ( ( io_status .EQ. 0 ) .AND. ( number_of_characters .GT. 0 ) ) THEN !Anything there? OPEN ( UNIT = ksd_lun, NAME = ksd_filename, DEFAULTFILE = '.ks', STATUS = 'OLD', FORM = 'FORMATTED', READONLY, 1 IOSTAT = io_status ) !Open IF ( io_status .EQ. 0 ) THEN !Was the file opened ok? error = .FALSE. !No errors yet DO WHILE ( ( io_status .EQ. 0 ) .AND. ( .NOT. error ) ) !Until error or EOF... READ ( ksd_lun, '( Q, A )', IOSTAT = io_status ) number_of_characters, ksd_record !Read a line IF ( ( io_status .EQ. 0 ) .AND. ( number_of_characters .GT. 1 ) ) THEN !Anything there? CALL STR$UPCASE ( ksd_record, ksd_record ) !Convert to uppercase for easy matching CALL check_ks_name ( ksd_record, number_of_characters, error ) !Check for valid knowledge source name IF ( .NOT. error ) THEN !Is it a valid name? CALL enter_name_into_ksd_table( ksd_record, number_of_characters, error ) !If so enter it into the table END IF ! END IF ! END DO ! CLOSE ( UNIT = ksd_lun, STATUS = 'SAVE' ) !Close the file and don't delete ELSE !Else we couldn't open the file WRITE ( 6, '( 1X, '' ERROR - Unable to open the file: '', A )' ) ksd_filename( 1 : number_of_characters ) END IF ! END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C REMOVE_LEADING_BLANKS C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: Eons ago C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Remove any leading blanks from a string. C METHOD: Obvious C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE remove_leading_blanks ( string C*(*) I The string with possible leading C string_length I*2 I Number of characters in string C ) C REFERENCED ROUTINES: None C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE remove_leading_blanks ( string, string_length ) IMPLICIT NONE INTEGER*2 string_length, string_index CHARACTER*(*) string string_index = 1 !Initialize the index DO WHILE ( ( string( string_index : string_index ) .EQ. ' ' ) .AND. ( string_index .LE. string_length ) ) !Loop until char string_index = string_index + 1 !Move to the next character END DO ! IF ( string_index .GT. string_length ) THEN !Were there any characters? string_length = 0 !If not, indicate it ELSE IF ( string_index .GT. 1 ) THEN !If leading spaces string = string( string_index : string_length ) !Remove them string_length = string_length - string_index + 1 !And adjust the number of characters END IF ! RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C RESOLVE_AGENDAS C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 04/04/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Rate the knowledge source bids and resolve them with any meta-level knowledge commands. C METHOD: The bid rating is based on number of conditions met * 100 + centainty of result - cpu time. If we are to PREFER C the knowledge source, add 1000. If we are to NOT it, or if it is not in an ONLY, zero it. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE resolve_agendas ( chosen_ks_index I*2 O Index into the list of names C ) C REFERENCED ROUTINES: found_ks_name_in_list LOGICAL*1 FUNCTION C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE resolve_agendas ( chosen_ks_index ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INTEGER*2 chosen_ks_index, agenda_index, orgional_chosen_ks_index LOGICAL*1 found_ks_name_in_list REAL*4 ratings_vector( max_number_of_ks_names ), max_rating WRITE ( 6, '( 1X, '' Ranking knowledge sources...'' )' ) !Why are we waiting? DO agenda_index = 1, last_ks_agenda_entry !For each entry in the agenda... ratings_vector( agenda_index ) = ( ks_agenda( agenda_index ).number_conditions_matched * 100 ) + 1 ks_agenda( agenda_index ).certainty_of_result - 1 ks_agenda( agenda_index ).cpu_time_sec !Give it a numerical value END DO ! max_rating = -1000. !Init for loop DO agenda_index = 1, last_ks_agenda_entry !For each rated agenda... IF ( ratings_vector( agenda_index ) .GT. max_rating ) THEN !Find the maximum rating max_rating = ratings_vector( agenda_index ) ! chosen_ks_index = agenda_index ! END IF ! END DO ! WRITE ( 6, '( 1X, '' Highest ranked ks: '', A )' ) ks_agenda( chosen_ks_index ).ks_rhs_name !Display it RETURN ! END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C WAIT_FOR_LHS_COMPLETION C C FILE NAME: BLACKBOARD.FOR C CREATION DATE: 09/20/89 C AUTHOR: Frederick S. Schebor C REVISIONS: Date Initials Reason for Revision C PURPOSE: Loop in this routine until all knowledge source left hand sides finish executing. C METHOD: Use the GETJPIW service the check on the status of suprocesses. C DECLARATION: Routine_name Parameter(s) Type I/O Purpose C SUBROUTINE resolve_agendas ( error L*1 .TRUE. if any error occured C ) C REFERENCED ROUTINES: NONE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC OPTIONS /EXTEND SUBROUTINE wait_for_lhs_completion ( error ) IMPLICIT NONE INCLUDE 'blackboard$dir:blackboard_system_parameters.inc /NOLIST' INCLUDE 'blackboard$dir:blackboard_system_data_structures.inc /NOLIST' INCLUDE 'blackboard$dir:item_list.inc /NOLIST' INCLUDE 'blackboard$dir:io_status_block.inc /NOLIST' INCLUDE '( $JPIDEF )' INCLUDE '( $SSDEF )' INTEGER*4 subprocess_state, return_length, knowledge_source_index, return_status, SYS$GETJPIW LOGICAL*1 error, processes_still_running error = .FALSE. !No errors yet processes_still_running = .TRUE. !Init for loop DO WHILE ( processes_still_running ) !If any running then loop processes_still_running = .FALSE. !Re-initialize knowledge_source_index = 1 !Start at the top of the list DO WHILE ( knowledge_source_index .LE. number_of_ks_names ) !Until we reach end of list... IF ( ks_description_table( knowledge_source_index ).ks_process_id .NE. -1 ) THEN !IF id <> -1 then still running item_list.buffer_length = 4 !Construct the JPI item list item_list.item_code = JPI$_STATE !We want to check process state item_list.buffer_address = %LOC ( subprocess_state ) ! item_list.return_length_address = %LOC ( return_length ) ! item_list.terminator = 0 ! return_status = SYS$GETJPIW ( , ks_description_table( knowledge_source_index ).ks_process_id, , item_list, 1 io_status_block, , ) !Return the process state IF ( io_status_block.status .EQ. SS$_NONEXPR ) THEN !IF the process doesnt exist... ks_description_table( knowledge_source_index ).ks_process_id = -1 !Set the process id to -1 ELSE !Otherwise processes_still_running = .TRUE. !Processes are still running END IF ! END IF ! knowledge_source_index = knowledge_source_index + 1 !Move to the next process END DO ! END DO ! RETURN ! END