| Hello Volker,
Below is a User Written Print Symbiont which works (i.e.: the lat port
returns to the Idle State).
The INPUT_FILTER routine does not filter anything.
Best regards,
Philippe VOUTERS (working with Gerard-Louis)
$ create extern.for
c
c
c These are the external symbols used by both the main
c program and the subroutine
c
EXTERNAL psm$k_page_header,psm$k_start_task,psm$k_read
EXTERNAL smbmsg$k_file_specification,ss$_normal
EXTERNAL psm$k_open,psm$_funnotsup,psm$_eof,psm$k_format
EXTERNAL psm$k_input_filter,psm$m_lat_protocol
EXTERNAL smbmsg$k_account_name,smbmsg$k_user_name
$ create testsymbiont.for
c
c This is the main program. It modifies the VMS print symbiont
c to put a header at the top of each page containing the account,
c filename, and username. The steps here are
c 1) call psm$replace to tell the VMS symbiont which routine you
c want to replace
c 2) call psm$print to tell the symbiont we're ready to start
c processing requests
c
PROGRAM testsymbiont
IMPLICIT INTEGER*4(A-Z)
PARAMETER STREAMS = 1 ! Single stream
EXTERNAL header
EXTERNAL input_filter
INCLUDE 'EXTERN.FOR'
code = %LOC(psm$k_page_header) ! Replace page header routine
stat = psm$replace(code,header) ! Tell the job controller
IF (.NOT.stat) CALL lib$signal(%VAL(stat))
code = %LOC(psm$k_input_filter) ! Replace page header routine
stat = psm$replace(code,input_filter)! Tell the job controller
IF (.NOT.stat) CALL lib$signal(%VAL(stat))
options = %LOC(psm$m_lat_protocol)
stream = STREAMS
stat = psm$print(stream,,,,options)! Tell the job controller
c ! We're ready
IF (.NOT.stat) CALL lib$signal(%VAL(stat))
END
INTEGER*4 function input_filter(context,work_area,func,
1 funcdesc,funcarg,funcdesc2,funcarg2)
IMPLICIT INTEGER*4(A-Z)
INCLUDE 'extern.for'
IF (func.EQ.%LOC(psm$k_format)) GOTO 100
stat = %LOC(psm$_funnotsup)
GOTO 200
100 funcarg2 = funcarg
stat = str$copy_dx(funcdesc2,funcdesc)
stat = %LOC(SS$_NORMAL)
200 input_filter = stat
RETURN
END
INTEGER*4 function header(context,work_area,func,
1 funcdesc,funcarg)
IMPLICIT INTEGER*4(A-Z)
INCLUDE 'extern.for'
CHARACTER*12 user,account
CHARACTER*60 file
CHARACTER*126 header_line
CHARACTER*132 output_line
c
c Select the correct routine to branch to depending on the
c function code that the job controller sent us
c In this example, only two functions are performed.
c More could be added.
c
IF (func.EQ.%LOC(psm$k_start_task)) GOTO 220
IF (func.EQ.%LOC(psm$k_read)) GOTO 250
stat = %LOC(psm$_funnotsup)
GOTO 1000
*
* Start a new file
*
220 page = 0
line = 2
code = %LOC(smbmsg$k_account_name) ! Get the acct name
stat = psm$read_item_dx(context,code,account)
IF (.NOT.stat) GOTO 1000
code = %LOC(smbmsg$k_file_specification) ! Get the filespec
stat = psm$read_item_dx(context,code,file)
IF (.NOT.stat) GOTO 1000
code = %LOC(smbmsg$k_user_name)
stat = psm$read_item_dx(context,code,user) ! Get the user name
IF (.NOT.stat) GOTO 1000
stat = str$trim(account,account,acct_len) ! Trim spaces
stat = str$trim(file,file,file_len)
stat = str$trim(user,user,user_len)
header_line = ' '
c
c Here, we format the line that will appear at the top of each
c page. The page number is added in the page header routine
c itself (starting at line 250).
WRITE(header_line,30)account(1:acct_len),user(1:user_len),
1 file(1:file_len)
30 FORMAT('Account [',a,',',a,'] File:',a,' page:')
stat = %LOC(SS$_NORMAL)
GOTO 1000
*
* Read a page header
*
250 line = line -1
IF (line.EQ.0) GOTO 260
IF (line.LT.0) GOTO 270
page = page + 1
stat = str$trim(header_line,header_line,header_line_len)
c
c Take the prototype line that we build as a result of being
c called the first time and append the page number
c
WRITE(output_line,60)header_line(1:header_line_len),page
60 FORMAT(a,I4)
stat = str$trim(output_line,output_line,output_line_len)
stat = str$copy_dx(funcdesc,output_line(1:output_line_len))
GOTO 1000
c
c output a line of dashes
c
260 DO i=1,80
output_line(i:i) = '-'
ENDDO
stat = str$copy_dx(funcdesc,output_line(1:80))
GOTO 1000
270 line = 2 !Here if we're done with the header
stat = %LOC(PSM$_EOF)
1000 header = stat
RETURN
END
$ create symbols.mar
.LIBRARY/SYS$LIBRARY:LIB.MLB/
;
; This routine gives us the psm and smb symbols used above
;
$PSMDEF GLOBAL
$SMBDEF GLOBAL
.END
$ mac/list symbols
$ fort/list/machine testsymbiont
$ link/exe=sys$system:testsymbiont.exe testsymbiont,symbols
|