$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  2-JUN-1993 11:01:04.00   By user ROBERT
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.TXT;1
$!       2. CARDSMB.FOR;1
$!       3. COMMON.FOR;1
$!       4. SMBDEF.FOR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X `09`09`09`09 CARDREADER_SMB
X `09`09`09A VMS CARDREADER/MAILBACK symbiont
X
XVersion 1.0 6/2/93
X
XAuthor:  Robert Eden                robert@cpvax.tu.com
X `09 Comanche Peak S.E.S        eden@fallout.lonestar.org`20
X         Glen Rose Tx, 76043       `20
X         (817) 897-0491
X
X        This program is a VAX/VMS server symbiont to provide a
X        queue on the VAX that acts as a cardreader.  A second queue is
X        also available to mail output back to the original user.
X
X `09Any file sent to a queue assigned to device CARDIN gets run`20
X `09through DEC's INPSMB image. Login errors are sent to
X `09the CLUSTER operator(s)' console by the symbiont and logged
X `09normally by IMPSMB.
X
X `09Any file sent to a queue assigned to device MAILOUT gets sent
X `09as a mail message to the username owning the job.  This`20
X `09is used so the output from the batch job submitted to CARDREADER
X `09can be returned as a mail message.
X
X        This symbiont can connect to up to 16 queues, but only 1
X        is active at any one time.  (Hey, I'm lazy.) (Why would
X `09anyone want more than 1 cardreader and 1 mailback queue
X `09anyway).
X
X `09Login failure notification is sent to the CLUSTER operator console(s).
X
X `09To Build:
X `09`09$ FORTRAN `09CARDSMB.FOR
X `09`09$ LINK/NOTRACE  CARDSMB.OBJ
X `09`09$ copy cardsmb.exe sys$system
X
X `09`09(notrace prevents a lot of errors from JOB CONTROL should
X `09`09 the program terminate abnormally)
X
X `09To setup:
X `09 `09$ INIT/QUEUE/PROC=CARDSMB/ON=CARDIN  CARDREADER
X `09 `09$ INIT/QUEUE/PROC=CARDSMB/ON=MAILOUT MAILBACK
X
X
X `09To Test PRINT the following file to the CARDREADER queue:
X `09 `09$ JOB username /QUEUE=SYS$BATCH/PRINT=MAILBACK
X `09 `09$ PASSWORD password
X `09 `09$
X `09 `09$ dir
X `09 `09$
X `09 `09$ eoj
X
X`09The file will be processed by CARDREADER, and be SUBMITed to
X`09SYS$BATCH.  After it executes, the log file will be mailed
X`09back to "username".
X
X `09If you end up using this program, please drop a note to me at
X        the above addresses so I get a warm fuzzy and can make you aware
X`09of updates/changes.
X
$ CALL UNPACK AAAREADME.TXT;1 1952252413
$ create 'f'
X
X`09PROGRAM CARDSMB
XC+
XC`20
XC ABSTRACT:`20
XC`20
XC        This program is a VAX/VMS server symbiont to provide a`20
XC        queue on the VAX that acts as a cardreader.  A second queue is`20
XC        also available to mail output back to the original user.
XC
XC`09 The cardreader queue should be assigned device CARDIN.
XC        The mailback   queue should be assigned device MAILOUT.
XC
XC        This symbiont can connect to up to 16 queues, but only 1`20
XC        is active at any one time.
XC       `20
XC AUTHOR(S):`20
XC`20
XC        10-SEP-1991 Robert Eden
XC`20
XC COMMON BLOCKS:
XC `20
XC     State information for each stream is maintained in an array of
XC     structures stored in a common block.  See the file COMMON.FOR
XC     for information on this block.   This common block is used by
XC     all subroutines.
XC `20
XC`20
XC MODIFICATION HISTORY:
XC`20
XC        Date     `7C Name  `7C Description
XC ----------------+-------+-------------------------------------------------
V----
XC 02-MAR-1993     `7C  RME  `7C added SYS$SNDOPR interface for INPSMB errors
XC ----------------+-------+-------------------------------------------------
V----
XC `5Bchange_entry`5D
XC-
XCDEC$ TITLE 'CARDIN READER SYMBIONT'
XCDEC$ IDENT 'Version 1.1'
X
X`09IMPLICIT NONE
X        INCLUDE 'COMMON/LIST'
X `09INCLUDE 'SMBDEF'
X `09INCLUDE '($PRVDEF)'
X
X        PARAMETER  DBGFILE      = 'SYS$COMMON:`5BSYSEXE`5DCARDSMB.DBG'
X `09PARAMETER  SS$_NORMAL   = 1
X `09INTEGER  STATUS,SYS$TRNLNM,SYS$SETPRV,I
X        INTEGER SYS$CREPRC,SYS$CREMBX,SYS$DELMBX
X `09EXTERNAL HANDLE_ERROR,MSG_AST
X
XC CREATE OUR OWN ERROR HANDLER
X `09CALL LIB$ESTABLISH(HANDLE_ERROR)
X
XC SET DEBUG MODE
X        DEBUG  = .FALSE.
X `09STATUS = SYS$TRNLNM(,'LNM$SYSTEM','CARDSMB$DEBUG',,)
X        IF (STATUS) THEN`20
X `09`09    DEBUG = .TRUE.
X `09`09    OPEN(DBG_LU,FILE=DBGFILE,SHARED,
X     +                          CARRIAGECONTROL='LIST',STATUS='NEW')
X     `09            WRITE (DBG_LU,*) 'IBMPRTSMB - DEBUG MODE STARTED!'
X`09`09    ENDIF
X
XC
XC TURN ON CMKRNL SO WE CAN REQUEUE
XC
X  `09STATUS = SYS$SETPRV( %VAL(1) , ! ENABLE
X     +                       %REF( PRV$M_NETMBX + PRV$M_TMPMBX +
X     +                             PRV$M_CMKRNL + PRV$M_SYSPRV ),
X     +                       %VAL(1),  ! SET IT FOR GOOD!
X     +                       %VAL(0))  ! DON'T CARE ABT OLD VALUE
X`09IF (DEBUG) WRITE (DBG_LU,*) 'SYS$SETPRV - STATUS',STATUS
X `09IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
XC
XC create mailboxs and CARDREADER process
XC
X        STATUS = sys$crembx (,inpsmb_inp_chan,,,,,'INPSMB$MBX')
X              IF (DEBUG) WRITE(DBG_LU,*) 'CREMBX1: ',STATUS
X    `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X        STATUS = sys$crembx (,inpsmb_err_chan,,,,,'ERRSMB$MBX')
X              IF (DEBUG) WRITE(DBG_LU,*) 'CREMBX2: ',STATUS
X    `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X       `20
XC
XC initiate AST routine to handle errors
XC
X        CALL inpsmb_err_queue
X
XC
XC start subprocess to queue jobs
XC
X        STATUS = sys$creprc (,   !  PID
X     1               'SYS$SYSTEM:INPSMB.EXE',`20
X     1               'INPSMB$MBX:',`20
X     1               'NLA0:',`20
X     1               'ERRSMB$MBX',
X     1                ,           ! privs`20
X     1                ,           ! quota
X     1               'CARDREADER', `20
X     1               %val(4),     ! priority
X     1               ,            ! uic
X     1               ,            ! termination mailbox
X     1                )           ! options
X              IF (DEBUG) WRITE(DBG_LU,*) 'CREPRC: ',STATUS
X    `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X      OPEN(MBX_LU,FILE='INPSMB$MBX:',
X     +           CARRIAGECONTROL='LIST',STATUS = 'OLD')
X
XC
XC INITIALIZE SYMBIONT
XC
X `09STATUS = SMB$INITIALIZE( %REF(SMBMSG$K_STRUCTURE_LEVEL),
X     +                           %REF(MSG_AST), ! OUR AST ROUTINE
X     +                           %REF(NUM_STREAMS)) ! USE ALL 16 STREAMS
X`09IF (DEBUG) WRITE (DBG_LU,*) 'SMB$INITIALIZE - STATUS',STATUS
X `09IF (STATUS.NE.SS$_NORMAL) CALL SYS$EXIT( %VAL(STATUS) )
X
XC
XC MAIN LOOP!
XC
X100     IF (TASKS.EQ.0) CALL SYS$HIBER()  ! NOTHING TO DO, SO WAIT
X `09DO I=1,NUM_STREAMS
X `09    IF (DEBUG) WRITE(DBG_LU,*) 'MAIN_LOOP:',I,STREAM(I).STATE
X `09    CUR_ID = I
X `09    IF ((STREAM(I).STATE.EQ.STRM_START).AND.
X     +         (STREAM(I).DEV_NAM.EQ.'CARDIN')) CALL RUN_CARDREADER(I)
X `09    IF ((STREAM(I).STATE.EQ.STRM_START).AND.
X     +         (STREAM(I).DEV_NAM.EQ.'MAILOUT')) CALL RUN_MAILOUT(I)
X `09    IF (STREAM(I).STATE.EQ.STRM_ABORT)   CALL ABORT_TASK(I)
X            END DO
X        WRITE(MBX_LU,*) '$EOJ'  ! make sure we've cleared the reader
X `09GOTO 100
X
X   `09END
X`0C
X `09SUBROUTINE MSG_AST
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09*** AST CONTEXT ***
XC`20
XC    This AST routine is used to process messages received from the
XC    JOB_CONTROLLER.  It calls routines to notifiy streams to abort,
XC    and other routines to set up structures for a new job.
XC`20
XC`20
XC-
X `09IMPLICIT NONE
X `09INCLUDE 'COMMON'
X `09INCLUDE 'SMBDEF'
X
X `09INTEGER STATUS,ID,REQUEST
X
X `09PARAMETER SS$_NORMAL = 1
X
X `09IF (DEBUG) WRITE (DBG_LU,*) 'MSG_AST ACTIVE'
X
X `09STATUS = SMB$CHECK_FOR_MESSAGE()
X `09IF (STATUS.NE.0) THEN
X`09     STATUS = SMB$READ_MESSAGE( %REF (ID),
X     +                                  %DESCR(MESSAGE),
X     +                                  %REF (REQUEST))
X
X`09     IF (DEBUG) WRITE (DBG_LU,*) 'READ_MESSAGE: ',REQUEST,STATUS
X`09     IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X `09ID = ID + 1 ! our ID's must start with 1, for FORTRAN arrays
X             IF (REQUEST.EQ.SMBMSG$K_START_STREAM) THEN
X                                    CALL START_STREAM(ID)
X `09ELSE IF ((REQUEST.EQ.SMBMSG$K_STOP_STREAM) .OR.
X     +           (REQUEST.EQ.SMBMSG$K_RESET_STREAM)) THEN`20
X                                    CALL STOP_STREAM(ID)
X `09ELSE IF ((REQUEST.EQ.SMBMSG$K_START_TASK)) THEN
X                                    CALL START_TASK(ID)
X `09ELSE IF ((REQUEST.EQ.SMBMSG$K_STOP_TASK)) THEN
X `09`09`09`09    CALL ABORT_TASK(ID)
X             ENDIF
X `09IF (TASKS.EQ.0)   CALL SYS$WAKE
X        IF (ACTIVE.EQ.0)  CALL SYS$EXIT(%VAL(SS$_NORMAL))
X `09ENDIF
X        RETURN
X        END
X
X`0C
X `09SUBROUTINE START_STREAM(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09*** AST CONTEXT ***
XC`20
XC    This procedure processes the START_STREAM request from the JOB CONTROLL
VER,
XC    effectivly starting the queue.  The /ON= parameter is read and stored
XC    in the STREAM(ID) common area.
XC
XC    note: one is added to the JOB CONTROLLER stream ID so we can use it
XC          as an array reference.
XC`20
XC-
X`09IMPLICIT NONE
X`09INCLUDE 'COMMON'
X`09INCLUDE 'SMBDEF'
X`09
X `09PARAMETER SS$_NORMAL = 1
X
X`09CHARACTER*100 DATA_STR
X`09INTEGER*4     DATA(25)
X`09INTEGER*2     DATA_LEN
X`09EQUIVALENCE   (DATA_STR , DATA(1))
X
X`09INTEGER CONTEXT,STATUS,ITEM
X `09INTEGER `09ID`09`09 ! STREAM ID
X
X`09IF (DEBUG) WRITE(DBG_LU,*) '        START-STREAM ACTIVE'
X
X`09STREAM(ID).DEV_STS = SMBMSG$M_LOWERCASE + SMBMSG$M_SERVER
X `09STREAM(ID).STATE   = STRM_AVAIL
X `09STREAM(ID).ABORT   = .FALSE.
X        STREAM(ID).PAUSED  = .FALSE.
X
XC`20
XC search message items for DEV_NAM + DEV_LEN
XC
X         CONTEXT = 0`20
X `09 STREAM(ID).ID = ID - 1 ! SMB ID IS ONE LESS THAN FORTRAN'S
X100      STATUS = SMB$READ_MESSAGE_ITEM(%DESCR(MESSAGE),
X     +                                  %REF(CONTEXT  ),
X     +                                  %REF(ITEM     ),
X     +                                %DESCR(DATA_STR ),
X     +                                  %REF(DATA_LEN ))
X`09 IF (DEBUG) WRITE(DBG_LU,*) 'READ_ITEM:',ITEM,STATUS
X         IF (STATUS.EQ.SMB$_NOMOREITEMS) STATUS = SS$_NORMAL
X`09 IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X `09 IF (ITEM.EQ.SMBMSG$K_DEVICE_NAME) THEN
X `09`09`09      STREAM(ID).DEV_NAM = DATA_STR(1:DATA_LEN)
X `09`09`09      STREAM(ID).DEV_LEN = DATA_LEN
X `09`09`09      ENDIF
X`09 IF (CONTEXT.NE.0) GOTO 100`20
X
XC TELL THE JOB CONTROLLER WE'RE READY
X
X`09 STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(ID).ID),
X     +`09`09`09`09      %REF(SMBMSG$K_START_STREAM),
X     +`09`09`09`09      %VAL(0), ! ACCOUNTING
X     +`09`09`09`09      %VAL(0), ! CHECKPOINT
X     +`09`09`09`09      %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09      %VAL(0))
X`09 IF (DEBUG) WRITE(DBG_LU,*) 'SEND_START_STREAM',ID,STATUS
X`09 IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X `09 ACTIVE = ACTIVE + 1
X
X`09 RETURN
X`09 END
X`0C
X `09SUBROUTINE STOP_STREAM(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09*** AST CONTEXT ***
XC`20
XC    This routine processes the STOP_STREAM requeues from the JOB CONTROLLER
XC    effectivly stopping the queue.
XC`20
XC`20
XC-
X
X`09IMPLICIT NONE
X`09INCLUDE 'COMMON'
X`09INCLUDE 'SMBDEF'
X
X`09INTEGER STATUS,ID
X
X`09IF (DEBUG) WRITE(DBG_LU,*) '                STOP-STREAM ACTIVE'
X
XC
XC if STATE=STRM_RUN or STRM_ABORT then we must stop the current task
XC before we stop the stream
XC
X `09IF ((STREAM(ID).STATE.EQ.STRM_RUN) .OR.
X     +      (STREAM(ID).STATE.EQ.STRM_ABORT)) CALL ABORT_TASK(ID)
X
X`09 STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(ID).ID),
X     +`09`09`09`09      %REF(SMBMSG$K_STOP_STREAM),
X     +`09`09`09`09      %VAL(0), ! ACCOUNTING
X     +`09`09`09`09      %VAL(0), ! CHECKPOINT
X     +`09`09`09`09      %VAL(0), ! DEVICE_STATUS
X     +`09`09`09`09      %VAL(0)) ! ERROR
X`09 IF (DEBUG) WRITE(DBG_LU,*) 'SEND_STOP_STREAM:',ID,STATUS
X`09 IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X         STREAM(ID).STATE = STRM_DOWN
X         ACTIVE = ACTIVE - 1
X
X `09 RETURN
X`09 END
X`0C
X `09SUBROUTINE ABORT_TASK(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09*** AST CONTEXT ***
XC`20
XC    This procedure processes the ABORT_TASK request from the JOB CONTROLLER
XC    It closes any files that may be open, and resets the queue state to
XC    available.
XC     `20
XC`20
XC-
X `09IMPLICIT NONE
X        INCLUDE 'COMMON'
X `09INCLUDE 'SMBDEF'
X `09INCLUDE '($SJCDEF)'
X `09
X `09INTEGER ID,STATUS
X
XC
XC ABORT IS TRUE!!
XC
X602 `09 CLOSE(INP_LU,DISPOSE='DELETE',ERR=603)
X
XC NOTIFY JOB CONTROLLER WE'RE DONE!
X603 `09     STREAM(ID).STATE = STRM_AVAIL
X             TASKS = TASKS - 1
X `09     STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(ID).ID),
X     +`09     `09`09`09           %REF(SMBMSG$K_TASK_COMPLETE),
X     +`09`09`09`09           %DESCR(STREAM(ID).ACCOUNTNG),
X     +`09`09`09`09           %VAL(0), ! CHECKPOINT
X     +`09`09`09`09           %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09           %REF(STREAM(ID).ERROR))`20
X`09      IF (DEBUG) WRITE(DBG_LU,*) 'SEND COMPLETE:',ID,STATUS
X  `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X            `20
X900    RETURN
X       END
X`0C `09
X`09SUBROUTINE START_TASK(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09*** AST CONTEXT ***
XC`20
XC    This procedure processes the START_TASK request from the JOB CONTROLLER
XC    It reads the parameters assigned to the job and sets up the common
XC    area appropriatly.
XC
XC    A GETQUI call is also made to get information on the form the user
XC    has specified.  IBM setup information is expected to be stored here.
XC    `20
XC   `20
XC-
X `09IMPLICIT NONE
X`09INCLUDE '($QUIDEF)'
X        INCLUDE 'COMMON'
X `09INCLUDE 'SMBDEF'
X
X `09PARAMETER SS$_NORMAL = 1
X
X `09CHARACTER*100 DATA_STR
X`09INTEGER*4     DATA(25)
X`09INTEGER*2     DATA_LEN
X`09EQUIVALENCE   (DATA_STR , DATA(1))
X
X `09STRUCTURE /ITMLST_TYPE/
X `09`09INTEGER*2 BUFLEN,ITMCOD
X `09`09INTEGER*4 BUFADR,LENADR
X `09`09END STRUCTURE
X `09RECORD`09/ITMLST_TYPE/    ITMLST(15)
X`09INTEGER STATUS,CONTEXT,ITEM,ID,I,SYS$GETQUIW
X
X`09IF (DEBUG) WRITE(DBG_LU,*) '              START_TASK STARTED'
X
X        TASKS                  = TASKS+1
X        STREAM(ID).STATE       = STRM_START
X
XC APPLY DEFAULTS
X        STREAM(ID).UIC         = '00800080'X  ! DEFAULT UIC, (SHOULDN'T HAPP
VEN)
X`09STREAM(ID).FILE`09       = ' '
X`09STREAM(ID).USER`09       = ' '`09
X`09STREAM(ID).JOB`09       = ' '
X        STREAM(ID).FILE_LEN    = 1
X        STREAM(ID).USER_LEN    = 1
X        STREAM(ID).JOB_LEN     = 1
X
XC
XC READ MESSAGE ITEMS
XC
X         CONTEXT = 0`20
X100      STATUS = SMB$READ_MESSAGE_ITEM(%DESCR(MESSAGE  ),
X     +                                  %REF(CONTEXT    ),
X     +                                  %REF(ITEM       ),
X     +                                  %DESCR(DATA_STR ),
X     +                                  %REF(DATA_LEN   ))
X`09 IF (DEBUG) WRITE(DBG_LU,*) 'READ_ITEM:',ITEM,STATUS
X         IF (STATUS.EQ.SMB$_NOMOREITEMS) STATUS = SS$_NORMAL
X`09 IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X
X      IF (ITEM.EQ.SMBMSG$K_ENTRY_NUMBER) THEN
X`09`09`09`09`09STREAM(ID).ENTRY    = DATA(1)
X
X      ELSE IF (ITEM.EQ.SMBMSG$K_FILE_IDENTIFICATION ) THEN
X                                STREAM(ID).FID_INFO = DATA_STR(1:28)
X
X      ELSE IF (ITEM.EQ.SMBMSG$K_FILE_SPECIFICATION ) THEN
X                                STREAM(ID).FILE_LEN = DATA_LEN
X`09`09`09`09STREAM(ID).FILE = DATA_STR(1:DATA_LEN)
X
X      ELSE IF (ITEM.EQ.SMBMSG$K_JOB_NAME  ) THEN
X`09`09`09`09STREAM(ID).JOB_LEN  = DATA_LEN
X`09`09`09`09STREAM(ID).JOB = DATA_STR(1:DATA_LEN)
X
X      ELSE IF (ITEM.EQ.SMBMSG$K_USER_NAME)   THEN
X`09`09`09`09STREAM(ID).USER_LEN = DATA_LEN
X`09`09`09`09STREAM(ID).USER = DATA_STR(1:DATA_LEN)
X     `09   IF (DEBUG) WRITE(DBG_LU,*) 'USERNAME:',DATA_STR(1:DATA_LEN)
X      ENDIF
X
X      IF (CONTEXT.NE.0) GOTO 100`20
X
XC
XC WE DON'T GET A CORRECT LENGTH FOR THE USERNAME, LET'S FIND OUR OWN
XC
X      STREAM(ID).USER_LEN = INDEX(STREAM(ID).USER,' ')-1
X
X      STREAM(ID).ERROR(1) = 0
X      STREAM(ID).ERROR(2) = 0
X      STREAM(ID).ERROR(3) = 0
X      STREAM(ID).ERROR(4) = 0
X      STREAM(ID).PAUSED   = .FALSE.
X      STREAM(ID).ABORT    = .FALSE.
X      STREAM(ID).ACCOUNTNG(1) = 0
X      STREAM(ID).ACCOUNTNG(2) = 0
X      STREAM(ID).ACCOUNTNG(3) = 0
X      STREAM(ID).ACCOUNTNG(4) = 0
X
X      RETURN
X      END
X`0C
X`09SUBROUTINE RUN_MAILOUT(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09
XC`20
XC    This procedure does the main work for MAILOUT queues.
XC    Mail is sent via the MAIL$ calls to the username of the job.
XC    creating the INPSMB process and passing stuff to it.
XC   `20
XC-
X      IMPLICIT NONE
X      INCLUDE 'COMMON'
X      INCLUDE 'SMBDEF'
X      INCLUDE '($SJCDEF)'
X      INCLUDE '($SSDEF)'
X      INCLUDE '($MAILDEF)'
X
X
X      CHARACTER*80  SUBJECT
X
X      INTEGER STATUS,CONTEXT,ID,SUB_LEN
X      INTEGER SYS$SNDJBCW     `20
X      INTEGER mail$send_begin  , mail$send_add_attribute
X      INTEGER mail$send_end    , mail$send_add_bodypart
X      INTEGER mail$send_message, mail$send_add_address
X
X      STRUCTURE /itm_list/
X              integer*2 buflen,item
X              integer*4 buffer,retlen
X          END STRUCTURE    !itm_list
X
X      RECORD /itm_list/ mail_item(5),null_list
X
X
X      null_list.item = 0
X      null_list.buflen = 0
X     `20
X      IF (DEBUG) WRITE(DBG_LU,*) '              RUN_MAILOUT STARTED'
X
XC
XC Tell JOB controller we're starting
XC
X`09      STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(ID).ID),
X     +`09     `09`09`09           %REF(SMBMSG$K_START_TASK),
X     +`09`09`09`09           %VAL(0), ! ACCOUNTING
X     +`09`09`09`09           %VAL(0), ! CHECKPOINT
X     +`09`09`09`09           %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09           %REF(STREAM(ID).ERROR))`20
X`09      IF (DEBUG) WRITE(DBG_LU,*) 'SEND START TASK:',ID,STATUS
X    `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
XC
XC begin conversation with MAIL
XC
X      context = 0`20
X      status = mail$send_begin(context,null_list,null_list)
X`09    IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_BEGIN:',ID,STATUS
X            if (.not.status) call lib$signal(%val(status))
X
XC
XC build our SUBJECT and send attributes to MAIL
XC
X      subject = 'output of VAX JOB: '//stream(id).job
X      sub_len = min( (20+stream(id).job_len), len(subject))
X
X      mail_item(1).item    = mail$_send_from_line
X      mail_item(1).buffer  = %loc(stream(id).user)
X      mail_item(1).buflen  =      stream(id).user_len
X
X      mail_item(2).item    = mail$_send_subject
X      mail_item(2).buffer  = %loc(subject)
X      mail_item(2).buflen  =      sub_len
X     `20
X      mail_item(3).item    = 0
X      mail_item(3).buflen  = 0
X
X      status = mail$send_add_attribute(context,mail_item,null_list)
X`09IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_ADD_ATTRIBUTE:',ID,STATUS
X        if (.not.status) call lib$signal(%val(status))
X
XC
XC build distribution list`20
XC
X      mail_item(1).item   = mail$_send_username
X      mail_item(1).buffer  = %loc(stream(id).user)
X      mail_item(1).buflen  =      stream(id).user_len
X     `20
X      mail_item(2).item   = 0
X      mail_item(2).buflen = 0
X
X      status = mail$send_add_address(context,mail_item,null_list)
X`09 IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_ADD_ADDRESS:',ID,STATUS
X         if (.not.status) call lib$signal(%val(status))
X      `20
XC
XC give mail the FILEID to send
XC
X
X      mail_item(1).item   = mail$_send_FID
X      mail_item(1).buflen =  6
X      mail_item(1).buffer = %loc(stream(id).NAM_FID)
X
X      mail_item(2).item   = MAIL$_SEND_FID
X      mail_item(2).buflen =  6
X      mail_item(2).buffer = %loc(stream(id).NAM_FID)
X
X      mail_item(3).item   = MAIL$_SEND_DEFAULT_NAME
X      mail_item(3).buflen =  LEN(stream(id).NAM_DVI)
X      mail_item(3).buffer = %loc(stream(id).NAM_DVI)
X
X      mail_item(4).item   = 0
X      mail_item(4).buflen = 0
X
X      status = mail$send_add_bodypart(context,mail_item,null_list)
X`09    IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_ADD_BODYPART:',ID,STATUS
X            if (.not.status) call lib$signal(%val(status))
X
XC
XC send message and cleanup
XC
X      status = mail$send_message(context,null_list,null_list)
X`09    IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_MESSAGE:',ID,STATUS
X            if (.not.status) call lib$signal(%val(status))
X
X      status = mail$send_end(context,null_list,null_list)
X`09    IF (DEBUG) WRITE(DBG_LU,*) 'MAIL$SEND_END:',ID,STATUS
X            if (.not.status) call lib$signal(%val(status))
X
XC NOTIFY JOB CONTROLLER WE'RE DONE!
X500`09     STREAM(ID).STATE = STRM_AVAIL
X `09     STATUS = SMB$SEND_TO_JOBCTL(  %REF(STREAM(ID).ID),
X     +`09     `09`09`09           %REF(SMBMSG$K_TASK_COMPLETE),
X     +`09`09`09`09           %DESCR(STREAM(ID).ACCOUNTNG),
X     +`09`09`09`09           %VAL(0), ! CHECKPOINT
X     +`09`09`09`09           %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09           %REF(STREAM(ID).ERROR))`20
X`09      IF (DEBUG) WRITE(DBG_LU,*) 'SEND COMPLETE:',ID,STATUS
X  `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X       RETURN
X
XC
XC ABORT REQUESTED.... LET'S GET OUTA HERE
XC
X600    STREAM(ID).STATE = STRM_ABORT
X
X       RETURN
X
X       END
X`0C
X`09SUBROUTINE RUN_CARDREADER(ID)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09
XC`20
XC    This procedure does the main work of the CARDIN queue.`20
XC    The input file is opened by FILE_ID, and passed line by line
XC    to the mailbox that hopefully has the INPSMB process on the other
XC    end.
XC   `20
XC    Errors are written to the file SYS$COMMON:`5BSYSEXE`5DINPSMB.ERR
XC`20
XC-
X `09IMPLICIT NONE
X        INCLUDE 'COMMON'
X `09INCLUDE 'SMBDEF'
X `09INCLUDE '($SJCDEF)'
X `09INCLUDE '($SSDEF)'
X
X
X `09EXTERNAL FIDOPEN
X
X        CHARACTER*80 STRING
X`09INTEGER STATUS,SYS$SNDJBCW,ID,I,J
X
X`09IF (DEBUG) WRITE(DBG_LU,*) '              RUN_CARDREADER STARTED'
X
X      OPEN(INP_LU,FILE=STREAM(ID).FILE(1:STREAM(ID).FILE_LEN),
X     +           STATUS='OLD',READONLY,USEROPEN=FIDOPEN)
X
XC FILES OPENED, NOTIFY JOB CONTROLLER
X`09      STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(ID).ID),
X     +`09     `09`09`09           %REF(SMBMSG$K_START_TASK),
X     +`09`09`09`09           %VAL(0), ! ACCOUNTING
X     +`09`09`09`09           %VAL(0), ! CHECKPOINT
X     +`09`09`09`09           %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09           %REF(STREAM(ID).ERROR))`20
X`09      IF (DEBUG) WRITE(DBG_LU,*) 'SEND START TASK:',ID,STATUS
X    `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
XC
XC MAIN COPY LOOP - copy text of report to .JCL file
XC
X151`09FORMAT(Q,A)
X152`09FORMAT(A)
X `09IF (DEBUG) WRITE(DBG_LU,*) 'COPY STARTED'
X150     IF (STREAM(ID).ABORT) GOTO 600
X            STREAM(ID).ACCOUNTNG(2) = STREAM(ID).ACCOUNTNG(2) + 1
X`09    READ(INP_LU,FMT=151,END=200 ) I,STRING
X `09    I = MAX(1,MIN(I,80)) ! cardreader only handles 80 character lines
X
XC
XC the following section is necessary to handle junk characters that show
XC up when the print originates from the SNAGWY SNAPRE service.
XC`20
X            J = INDEX (STRING,' '//CR)            ! TRIM SP CR
X            DO WHILE (J.GT.0)
X                STRING(j:) = string(j+2:)
X                J = INDEX (STRING,' '//CR)
X                END DO
X
X            J = INDEX (STRING,CR//LF) `09           ! TRIM CR LF
X            DO WHILE (J.GT.0)
X                STRING(j:) = string(j+2:)
X                J = INDEX (STRING,CR//LF)
X                END DO
X
X            J = INDEX (STRING,LF) `09           ! TRIM LF
X            DO WHILE (J.GT.0)
X                STRING(j:) = string(j+1:)
X                J = INDEX (STRING,CR//LF)
X                END DO
X
X      `09    WRITE(MBX_LU,FMT=152) STRING(1:I)
X            GOTO 150
XC
XC close files, they're keepers
XC
X200   WRITE(MBX_LU,*) '$EOJ'
X      CLOSE(INP_LU)
X
X
XC NOTIFY JOB CONTROLLER WE'RE DONE!
X500`09     STREAM(ID).STATE = STRM_AVAIL
X `09     STATUS = SMB$SEND_TO_JOBCTL(  %REF(STREAM(ID).ID),
X     +`09     `09`09`09           %REF(SMBMSG$K_TASK_COMPLETE),
X     +`09`09`09`09           %DESCR(STREAM(ID).ACCOUNTNG),
X     +`09`09`09`09           %VAL(0), ! CHECKPOINT
X     +`09`09`09`09           %REF(STREAM(ID).DEV_STS),
X     +`09`09`09`09           %REF(STREAM(ID).ERROR))`20
X`09      IF (DEBUG) WRITE(DBG_LU,*) 'SEND COMPLETE:',ID,STATUS
X  `09      IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X       RETURN
X
XC
XC ABORT REQUESTED.... LET'S GET OUTA HERE
XC
X600    STREAM(ID).STATE = STRM_ABORT
X
X       RETURN
X
X
X       END
X`0C
X `09INTEGER*4 FUNCTION HANDLE_ERROR(SIGARGS, MECHARGS)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09
XC`20
XC    This routine handles normal errors.  Should an FORTRAN error
XC    happen during a job, this routine would trap it and notify
XC    the JOB CONTROLLER that the stream died.
XC
XC    The stream is not stopped and other streams are unaffected. (I hope)
XC`20
XC`20
XC-
X `09IMPLICIT NONE
X `09INCLUDE 'COMMON'
X `09INCLUDE '($SSDEF)'
X`09INCLUDE 'SMBDEF'
X
X `09INTEGER*4 SIGARGS(*), MECHARGS(5),STATUS
X `09INTEGER*4 SYS$UNWIND,SYS$FAOL,SYS$GETMSG
X        INTEGER*2     MSGLEN
X        CHARACTER*255 MSG
X `09EXTERNAL MAJOR_ERROR
X
X
X `09IF (SIGARGS(2).EQ.SS$_UNWIND) GOTO 700 !UNWIND IN PROGRESS!
X
X `09CALL LIB$ESTABLISH(MAJOR_ERROR)
X
X         IF (DEBUG) THEN
X `09     WRITE(DBG_LU,*,ERR=600) 'ERROR DETECTED - ',SIGARGS(2)
X             status = sys$getmsg (%val(sigargs(2)),msglen,msg,,)
X   `09     WRITE(DBG_LU,*,ERR=600) 'SYS$GETMSG - ',STATUS
X
X             status = sys$faol (
X     1                    msg(1:msglen),`20
X     1                    msglen,`20
X     1                    msg,`20
X     1                    sigargs(4))
X   `09     WRITE(DBG_LU,*,ERR=600) 'SYS$FAO- ',STATUS
X   `09     WRITE(DBG_LU,*,ERR=600) 'TEXT     ',MSG(1:MSGLEN)
X             ENDIF
X
X `09IF (SIGARGS(2).NE.SS$_NORMAL) THEN`20
X `09     STREAM(CUR_ID).ERROR(4) = STREAM(CUR_ID).ERROR(3)
X `09     STREAM(CUR_ID).ERROR(3) = STREAM(CUR_ID).ERROR(2)
X `09     STREAM(CUR_ID).ERROR(2) = SIGARGS(2)
X             IF (STREAM(CUR_ID).ERROR(1).LT.3)`20
X     +                 STREAM(CUR_ID).ERROR(1)=STREAM(CUR_ID).ERROR(1)+1
X
X
XC
XC NOTE: WE MUST CLEAN EVERYTHING UP BEFORE WE TELL THE JOB CONTROLLER
XC      `20
X `09IF (STREAM(CUR_ID).STATE.GT.STRM_AVAIL) THEN`20
X `09     WRITE(MBX_LU,fmt=*,err=102) '$EOJ'
X102`09     CLOSE(INP_LU,ERR=103)
X        `20
X103          STREAM(CUR_ID).STATE = STRM_AVAIL
X`09     STATUS = SMB$SEND_TO_JOBCTL( %REF(STREAM(CUR_ID).ID),
X     +`09     `09`09`09      %REF(SMBMSG$K_TASK_COMPLETE),
X     +`09`09`09`09      %DESCR(STREAM(CUR_ID).ACCOUNTNG),
X     +`09`09`09`09      %VAL(0),         ! CHECKPOINT
X     +`09`09`09`09      %REF(STREAM(CUR_ID).DEV_STS),
X     +`09`09`09`09      %REF(STREAM(CUR_ID).ERROR))`20
X`09     IF (DEBUG) WRITE(DBG_LU,*) 'SEND COMPLETE:',CUR_ID,STATUS
X `09     IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X             END IF
X        END IF
X
XC
XC UNWIND TO OUR MAIN ROUTINE (WHERE THE ERROR HANDLER WAS STARTED)
XC
X600 `09STATUS = SYS$UNWIND(%REF(MECHARGS(3)) ,%VAL(0))
X `09     IF (.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
X
X700     CONTINUE
X `09RETURN
X
X `09END
X`0C
X `09INTEGER*4 FUNCTION MAJOR_ERROR(SIGARGS,MECHARGS)
X `09IMPLICIT NONE
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09
XC`20
XC    We got trouble if this baby executes.  This is an error handler
XC    for our error handler.  It aborts the server process with the
XC    best known error code.  The JOB CONTOLLER then notifies OPCOM
XC    of an "UNEXPECTED SYMBIONT TERMINATION" and printes this error code.
XC   `20
XC`20
XC`20
XC-
X
X `09INTEGER*4 SIGARGS(*), MECHARGS(5)
X
X `09CALL SYS$EXIT(%VAL(SIGARGS(2)))
X
X `09RETURN
X `09END
X
X`0C
X `09INTEGER FUNCTION FIDOPEN(FAB,RAB,LUN)
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:                         *** USER OPEN CONTEXT ***
XC`20
XC
XC This function opens a file by FID.  It is necessary because of a bug
XC in the JOB CONTROLLER where the text filename given can be WRONG!!
XC (Try a print/header of something in SYS$COMMON and check it out)
XC
XC A short subroutine is used to modify the NAM block because FORTRAN
XC doesn't directly provide indirect addressing.
XC`20
XC FUNCTION VALUE:
XC`20
XC    A VMS status code returned by $CREATE system service
XC`20
XC-
X `09IMPLICIT NONE
X `09INCLUDE '($FABDEF)'
X        INCLUDE 'COMMON'
X
X `09RECORD /FABDEF/ FAB
X
X `09INTEGER SYS$CONNECT,SYS$OPEN
X `09INTEGER RAB,LUN  ! WE DON'T LOOK AT THESE ANYWAY
X
X        CALL SETFID(%VAL(FAB.FAB$L_NAM))
X
X        FAB.FAB$L_FOP = FAB.FAB$L_FOP .OR. FAB$M_NAM
X
X `09FIDOPEN =    SYS$OPEN(FAB) `09     ! OPEN AND CONNECT TO FILE
X `09IF (DEBUG) WRITE(DBG_LU,*) 'USEROPEN FIDOPEN -',FIDOPEN
X `09IF (FIDOPEN) FIDOPEN = SYS$CONNECT(RAB)
X `09IF (DEBUG) WRITE(DBG_LU,*) '         CONNECT-',FIDOPEN
X
X`09IF (.NOT.FIDOPEN) CALL LIB$SIGNAL(%VAL(FIDOPEN))
X
X  `09RETURN
X `09END
X
X       `20
X        SUBROUTINE SETFID(NAM)
XC
Xc This routine simply inserts the current fid into the RMS NAM block
XC        `20
X        IMPLICIT NONE
X        INCLUDE '($NAMDEF)'
X        INCLUDE 'COMMON'
X        `20
X        RECORD /NAMDEF/ NAM
X
X        NAM.NAM$T_DVI    = STREAM(CUR_ID).NAM_DVI
X        NAM.NAM$W_FID(1) = STREAM(CUR_ID).NAM_FID(1)
X        NAM.NAM$W_FID(2) = STREAM(CUR_ID).NAM_FID(2)
X        NAM.NAM$W_FID(3) = STREAM(CUR_ID).NAM_FID(3)
X
X        NAM.NAM$W_DID(1) = STREAM(CUR_ID).NAM_DID(1)
X        NAM.NAM$W_DID(2) = STREAM(CUR_ID).NAM_DID(2)
X        NAM.NAM$W_DID(3) = STREAM(CUR_ID).NAM_DID(3)
X
X        RETURN
X
X        END
X
X      SUBROUTINE inpsmb_err_queue
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:`09
XC`20
XC    This routine queues a read to the INPSMB process's error mailbox
XC    An AST is then triggered to notify the operator of the problem.
XC`20
XC-
X      IMPLICIT NONE
X      include '($IODEF)'
X      include 'common'
X`20
X      integer status,sys$qio
X      external inpsmb_err_ast
X
X      status = sys$qio (
X     1             %val(0),`20
X     1             %val(inpsmb_err_chan),`20
X     1             %val(io$_readvblk),`20
X     1             %ref(inpsmb_iosb),`20
X     1             %ref(inpsmb_err_ast),`20
X     1             %val(0),`20
X     1             %ref(inpsmb_msg.text),`20
X     1             %val(len(inpsmb_msg.text)),,,,)
X              if (.not.status) call lib$signal(%val(status))
X
X      RETURN
X      END
X
X      subroutine inpsmb_err_ast
XC+
XC`20
XC FUNCTIONAL DESCRIPTION:    *** AST CONTEXT ***
XC`20
XC    This AST routine is caused by IO completion to the INPSMB error
XC    mailbox.  It forwards the contents of the mailbox to OPCOM.
XC`20
XC`20
X      IMPLICIT NONE
X      INCLUDE '($OPCDEF)'
X      INCLUDE 'common'
X      integer status,sys$sndopr
X
X      inpsmb_msg.type =  OPC$_RQ_RQST+(OPC$M_NM_CLUSTER*256)
X      status = sys$sndopr(inpsmb_msg.string(1:inpsmb_iosb.length+20),)
X          if (.not.status) call lib$signal(%val(status))
X
X      call inpsmb_err_queue
X      END
$ CALL UNPACK CARDSMB.FOR;1 1198986724
$ create 'f'
XC This file contains common setup information for the IBMPRINT symbiont.
XC
XC An ARRAY of STRUCTURE is used to keep information on the various`20
XC streams and jobs.  The array offset is ONE PLUS the JOB CONTROLLER's
XC stream id.  This is done so we can use the JOB CONTROLLER's value for
XC our array offset.
XC
XC
XC
X        PARAMETER LF              = CHAR(10)
X        PARAMETER CR              = CHAR(13)
X
X `09PARAMETER NUM_STREAMS = 15
X
X `09PARAMETER STRM_DOWN   = 0
X `09PARAMETER STRM_AVAIL  = 1  `20
X `09PARAMETER STRM_START  = 2 ! START PENDING (OPEN FILES)
X `09PARAMETER STRM_RUN    = 3 ! JOB in process`20
X `09PARAMETER STRM_ABORT  = 4 ! ABORT in process`20
X        PARAMETER DBG_LU     = 100
X        PARAMETER INP_LU     = 103
X        PARAMETER MBX_LU     = 104
X
X `09STRUCTURE / STREAM_PARAMETERS /`20
XC STREAM INFORMATION
X                INTEGER*4 ID              ! STREAM ID TO SYMBIONT
X `09`09INTEGER*2 STATE`09`09  ! STREAM STATE (STRM_*)
X `09`09INTEGER*2 DEV_LEN         ! DEVICE NAME LENGTH
X `09`09CHARACTER DEV_NAM*50`09  ! DEVICE NAME
X `09`09INTEGER*4 DEV_STS         ! STATUS OF THE DEVICE
X `09`09LOGICAL   ABORT,PAUSED
XC TASK CHARACTERISTICS
X `09`09INTEGER*4 ACCOUNTNG(4)    ! ACCOUTING VALUES
X `09`09INTEGER*4 ERROR(4)`09  ! LAST 4 ERROR CODES `09
X `09`09INTEGER*4 UIC             ! UIC OF THE CURRENT USER
X                UNION`20
X                MAP
X                    CHARACTER*28 FID_INFO
X                END MAP
X                MAP
X                    CHARACTER NAM_DVI*16`20
X                    INTEGER*2 NAM_FID(3)
X                    INTEGER*2 NAM_DID(3)
X                END MAP
X                END UNION
X`09`09INTEGER*4 ENTRY
X                CHARACTER*80 FILE
X`09`09                    INTEGER*2    FILE_LEN
X`09`09CHARACTER*20 USER
X`09`09`09`09    INTEGER*2    USER_LEN
X`09`09CHARACTER*40 JOB
X`09`09`09`09    INTEGER*2    JOB_LEN
X
X`09`09END STRUCTURE
X
X `09RECORD / STREAM_PARAMETERS / STREAM(NUM_STREAMS)
X
X
X       STRUCTURE /oper_msg_type/
X           UNION`20
X           MAP
X              integer*4 type
X              integer*4 rqstid
X              character*12 title/'CARDREADER: '/
X              character*80 text`20
X           END MAP
X           MAP
X               character*(80+12+8) string
X           END MAP
X           END UNION
X          END STRUCTURE    !message
X      RECORD /oper_msg_type/ inpsmb_msg
X
X      STRUCTURE /iosb_type/
X `09`09INTEGER*2 status,length
X `09`09INTEGER*4 junk
X          END STRUCTURE    !iosb_type
X      RECORD /iosb_type/ inpsmb_iosb
X
X        LOGICAL DEBUG`09`09     `09 ! DEBUG STATE
X        INTEGER  CUR_STREAM,CUR_ID
X `09INTEGER  ACTIVE,TASKS            ! NUMBER OF ACTIVE STREAMS/TASKS
X        CHARACTER*1024 MESSAGE           ! MESSAGE BUFFER
X
X      INTEGER inpsmb_inp_chan,inpsmb_err_chan
X
X      COMMON /misc/ debug,message`20
X      COMMON /streams/ STREAM,ACTIVE,CUR_ID`20
X      COMMON /inpsmb/ inpsmb_inp_chan,inpsmb_err_chan,
X     +                inpsmb_msg,inpsmb_iosb
X
$ CALL UNPACK COMMON.FOR;1 510510283
$ create 'f'
XC   `20
XC    PRINT SYMBIONT CONSTANTS  (SMB$, SMBMSG$)
XC
XC    THIS FORTRAN INCLUDE WAS CONVERT FROM VMS 5.0 SYS$LIBRARY:LIB.MLB($SMBD
VEF)
XC
X      INTEGER SMB$INITIALIZE
X      INTEGER SMB$CHECK_FOR_MESSAGE
X      INTEGER SMB$READ_MESSAGE
X      INTEGER SMB$READ_MESSAGE_ITEM
X      INTEGER SMB$SEND_TO_JOBCTL
X      PARAMETER SMB$_NOMOREITEMS        = '01108002'X
X
X      PARAMETER SMBMSG$K_STRUCTURE_LEVEL`09= 1
X      PARAMETER SMBMSG$K_STRUCTURE_LEVEL_1`09= 1
X      PARAMETER SMBMSG$K_PAUSE_TASK`09= 1
X      PARAMETER SMBMSG$K_RESET_STREAM`09= 2
X      PARAMETER SMBMSG$K_RESUME_TASK`09= 3
X      PARAMETER SMBMSG$K_START_STREAM`09= 4
X      PARAMETER SMBMSG$K_START_TASK`09= 5
X      PARAMETER SMBMSG$K_STOP_STREAM`09= 6
X      PARAMETER SMBMSG$K_STOP_TASK`09= 7
X      PARAMETER SMBMSG$K_TASK_COMPLETE`09= 8
X      PARAMETER SMBMSG$K_TASK_STATUS`09= 9
X      PARAMETER SMBMSG$K_MAX_REQUEST_CODE`09= 10
X      PARAMETER SMBMSG$S_REQUEST_HEADER`09= 4
X      PARAMETER SMBMSG$W_REQUEST_CODE`09= 0
X      PARAMETER SMBMSG$B_STRUCTURE_LEVEL`09= 2
X      PARAMETER SMBMSG$B_STREAM_INDEX`09= 3
X      PARAMETER SMBMSG$K_ACCOUNTING_DATA`09= 1
X      PARAMETER SMBMSG$K_ACCOUNT_NAME`09= 2
X      PARAMETER SMBMSG$K_AFTER_TIME`09= 3
X      PARAMETER SMBMSG$K_ALIGNMENT_PAGES`09= 4
X      PARAMETER SMBMSG$K_BOTTOM_MARGIN`09= 5
X      PARAMETER SMBMSG$K_CHARACTERISTICS`09= 6
X      PARAMETER SMBMSG$K_CHECKPOINT_DATA`09= 7
X      PARAMETER SMBMSG$K_CONDITION_VECTOR`09= 8
X      PARAMETER SMBMSG$K_DEVICE_NAME`09= 9
X      PARAMETER SMBMSG$K_DEVICE_STATUS`09= 10
X      PARAMETER SMBMSG$K_ENTRY_NUMBER`09= 11
X      PARAMETER SMBMSG$K_EXECUTOR_QUEUE`09= 12
X      PARAMETER SMBMSG$K_FILE_COPIES`09= 13
X      PARAMETER SMBMSG$K_FILE_COUNT`09= 14
X      PARAMETER SMBMSG$K_FILE_SETUP_MODULES`09= 15
X      PARAMETER SMBMSG$K_FIRST_PAGE`09= 16
X      PARAMETER SMBMSG$K_FORM_LENGTH`09= 17
X      PARAMETER SMBMSG$K_FORM_NAME`09= 18
X      PARAMETER SMBMSG$K_FORM_SETUP_MODULES`09= 19
X      PARAMETER SMBMSG$K_FORM_WIDTH`09= 20
X      PARAMETER SMBMSG$K_FILE_IDENTIFICATION`09= 21
X      PARAMETER SMBMSG$K_FILE_SPECIFICATION`09= 22
X      PARAMETER SMBMSG$K_JOB_COPIES`09= 23
X      PARAMETER SMBMSG$K_JOB_COUNT`09= 24
X      PARAMETER SMBMSG$K_JOB_NAME`09= 25
X      PARAMETER SMBMSG$K_JOB_RESET_MODULES`09= 26
X      PARAMETER SMBMSG$K_LAST_PAGE`09= 27
X      PARAMETER SMBMSG$K_LEFT_MARGIN`09= 28
X      PARAMETER SMBMSG$K_LIBRARY_SPECIFICATION`09= 29
X      PARAMETER SMBMSG$K_MAXIMUM_STREAMS`09= 30
X      PARAMETER SMBMSG$K_MESSAGE_VECTOR`09= 31
X      PARAMETER SMBMSG$K_NOTE`09= 32
X      PARAMETER SMBMSG$K_PAGE_SETUP_MODULES`09= 33
X      PARAMETER SMBMSG$K_PARAMETER_1`09= 34
X      PARAMETER SMBMSG$K_PARAMETER_2`09= 35
X      PARAMETER SMBMSG$K_PARAMETER_3`09= 36
X      PARAMETER SMBMSG$K_PARAMETER_4`09= 37
X      PARAMETER SMBMSG$K_PARAMETER_5`09= 38
X      PARAMETER SMBMSG$K_PARAMETER_6`09= 39
X      PARAMETER SMBMSG$K_PARAMETER_7`09= 40
X      PARAMETER SMBMSG$K_PARAMETER_8`09= 41
X      PARAMETER SMBMSG$K_PRINT_CONTROL`09= 42
X      PARAMETER SMBMSG$K_PRIORITY`09= 43
X      PARAMETER SMBMSG$K_QUEUE`09= 44
X      PARAMETER SMBMSG$K_REFUSE_REASON`09= 45
X      PARAMETER SMBMSG$K_RELATIVE_PAGE`09= 46
X      PARAMETER SMBMSG$K_REQUEST_CONTROL`09= 47
X      PARAMETER SMBMSG$K_REQUEST_RESPONSE`09= 48
X      PARAMETER SMBMSG$K_RIGHT_MARGIN`09= 49
X      PARAMETER SMBMSG$K_SEARCH_STRING`09= 50
X      PARAMETER SMBMSG$K_SEPARATION_CONTROL`09= 51
X      PARAMETER SMBMSG$K_STOP_CONDITION`09= 52
X      PARAMETER SMBMSG$K_TIME_QUEUED`09= 53
X      PARAMETER SMBMSG$K_TOP_MARGIN`09= 54
X      PARAMETER SMBMSG$K_UIC`09= 55
X      PARAMETER SMBMSG$K_USER_NAME`09= 56
X      PARAMETER SMBMSG$K_MAX_ITEM_CODE`09= 57
X      PARAMETER SMBMSG$S_ITEM_HEADER`09= 4
X      PARAMETER SMBMSG$W_ITEM_SIZE`09= 0
X      PARAMETER SMBMSG$W_ITEM_CODE`09= 2
X      PARAMETER SMBMSG$S_ACCOUNTING_DATA`09= 16
X      PARAMETER SMBMSG$L_PAGES_PRINTED`09= 0
X      PARAMETER SMBMSG$l_qio_puts`09= 4
X      PARAMETER SMBMSG$l_rms_gets`09= 8
X      PARAMETER SMBMSG$L_CPU_TIME`09= 12
X      PARAMETER SMBMSG$S_CHECKPOINT_DATA`09= 24
X      PARAMETER SMBMSG$B_FILLER`09= 0
X      PARAMETER SMBMSG$B_CHECKPOINT_LEVEL`09= 1
X      PARAMETER SMBMSG$W_OFFSET`09= 2
X      PARAMETER SMBMSG$L_CARCON`09= 4
X      PARAMETER SMBMSG$L_PAGE`09= 8
X      PARAMETER SMBMSG$L_RECORD_NUMBER`09= 12
X      PARAMETER SMBMSG$S_USER_KEY`09= 8
X      PARAMETER SMBMSG$Q_USER_KEY`09= 16
X      PARAMETER SMBMSG$M_LOWERCASE`09= 1
X      PARAMETER SMBMSG$M_PAUSE_TASK`09= 2
X      PARAMETER SMBMSG$M_REMOTE`09= 4
X      PARAMETER SMBMSG$M_SERVER`09= 8
X      PARAMETER SMBMSG$M_STALLED`09= 16
X      PARAMETER SMBMSG$M_STOP_STREAM`09= 32
X      PARAMETER SMBMSG$M_TERMINAL`09= 64
X      PARAMETER SMBMSG$M_UNAVAILABLE`09= 128
X      PARAMETER SMBMSG$M_SYM_NOTIFIES`09= 256
X      PARAMETER SMBMSG$M_SYM_REQUESTS_OPER`09= 512
X      PARAMETER SMBMSG$M_SYM_COPIES_FILE`09= 1024
X      PARAMETER SMBMSG$M_SYM_COPIES_JOB`09= 2048
X      PARAMETER SMBMSG$M_SYM_ACCEPTS_ALL_FORMS`09= 4096
X      PARAMETER SMBMSG$M_SYM_NO_JOB_CHECKPOINT`09= 8192
X      PARAMETER SMBMSG$S_DEVICE_STATUS`09= 4
X      PARAMETER SMBMSG$L_DEVICE_FLAGS`09= 0
X      PARAMETER SMBMSG$V_LOWERCASE`09= 0
X      PARAMETER SMBMSG$V_PAUSE_TASK`09= 1
X      PARAMETER SMBMSG$V_REMOTE`09= 2
X      PARAMETER SMBMSG$V_SERVER`09= 3
X      PARAMETER SMBMSG$V_STALLED`09= 4
X      PARAMETER SMBMSG$V_STOP_STREAM`09= 5
X      PARAMETER SMBMSG$V_TERMINAL`09= 6
X      PARAMETER SMBMSG$V_UNAVAILABLE`09= 7
X      PARAMETER SMBMSG$V_SYM_NOTIFIES`09= 8
X      PARAMETER SMBMSG$V_SYM_REQUESTS_OPER`09= 9
X      PARAMETER SMBMSG$V_SYM_COPIES_FILE`09= 10
X      PARAMETER SMBMSG$V_SYM_COPIES_JOB`09= 11
X      PARAMETER SMBMSG$V_SYM_ACCEPTS_ALL_FORMS`09= 12
X      PARAMETER SMBMSG$V_SYM_NO_JOB_CHECKPOINT`09= 13
X      PARAMETER SMBMSG$M_DOUBLE_SPACE`09= 1
X      PARAMETER SMBMSG$M_PAGE_HEADER`09= 2
X      PARAMETER SMBMSG$M_PAGINATE`09= 4
X      PARAMETER SMBMSG$M_PASSALL`09= 8
X      PARAMETER SMBMSG$M_SEQUENCED`09= 16
X      PARAMETER SMBMSG$M_SHEET_FEED`09= 32
X      PARAMETER SMBMSG$M_TRUNCATE`09= 64
X      PARAMETER SMBMSG$M_WRAP`09= 128
X      PARAMETER SMBMSG$M_RECORD_BLOCKING`09= 256
X      PARAMETER SMBMSG$M_PAGE_FOOTER`09= 512
X      PARAMETER SMBMSG$S_PRINT_CONTROL`09= 4
X      PARAMETER SMBMSG$L_PRINT_FLAGS`09= 0
X      PARAMETER SMBMSG$V_DOUBLE_SPACE`09= 0
X      PARAMETER SMBMSG$V_PAGE_HEADER`09= 1
X      PARAMETER SMBMSG$V_PAGINATE`09= 2
X      PARAMETER SMBMSG$V_PASSALL`09= 3
X      PARAMETER SMBMSG$V_SEQUENCED`09= 4
X      PARAMETER SMBMSG$V_SHEET_FEED`09= 5
X      PARAMETER SMBMSG$V_TRUNCATE`09= 6
X      PARAMETER SMBMSG$V_WRAP`09= 7
X      PARAMETER SMBMSG$V_RECORD_BLOCKING`09= 8
X      PARAMETER SMBMSG$V_PAGE_FOOTER`09= 9
X      PARAMETER SMBMSG$M_ALIGNMENT_MASK`09= 1
X      PARAMETER SMBMSG$M_PAUSE_COMPLETE`09= 2
X      PARAMETER SMBMSG$M_RESTARTING`09= 4
X      PARAMETER SMBMSG$M_TOP_OF_FILE`09= 8
X      PARAMETER SMBMSG$S_REQUEST`09= 4
X      PARAMETER SMBMSG$L_REQUEST_FLAGS`09= 0
X      PARAMETER SMBMSG$V_ALIGNMENT_MASK`09= 0
X      PARAMETER SMBMSG$V_PAUSE_COMPLETE`09= 1
X      PARAMETER SMBMSG$V_RESTARTING`09= 2
X      PARAMETER SMBMSG$V_TOP_OF_FILE`09= 3
X      PARAMETER SMBMSG$M_FILE_BURST`09= 1
X      PARAMETER SMBMSG$M_FILE_FLAG`09= 2
X      PARAMETER SMBMSG$M_FILE_TRAILER`09= 4
X      PARAMETER SMBMSG$M_FILE_TRAILER_ABORT`09= 8
X      PARAMETER SMBMSG$M_JOB_FLAG`09= 16
X      PARAMETER SMBMSG$M_JOB_BURST`09= 32
X      PARAMETER SMBMSG$M_JOB_RESET`09= 64
X      PARAMETER SMBMSG$M_JOB_RESET_ABORT`09= 128
X      PARAMETER SMBMSG$M_JOB_TRAILER`09= 256
X      PARAMETER SMBMSG$M_JOB_TRAILER_ABORT`09= 512
X      PARAMETER SMBMSG$M_FIRST_FILE_OF_JOB`09= 1024
X      PARAMETER SMBMSG$M_LAST_FILE_OF_JOB`09= 2048
X      PARAMETER SMBMSG$S_SEPARATION_CONTROL`09= 4
X      PARAMETER SMBMSG$L_SEPARATION_FLAGS`09= 0
X      PARAMETER SMBMSG$V_FILE_BURST`09= 0
X      PARAMETER SMBMSG$V_FILE_FLAG`09= 1
X      PARAMETER SMBMSG$V_FILE_TRAILER`09= 2
X      PARAMETER SMBMSG$V_FILE_TRAILER_ABORT`09= 3
X      PARAMETER SMBMSG$V_JOB_FLAG`09= 4
X      PARAMETER SMBMSG$V_JOB_BURST`09= 5
X      PARAMETER SMBMSG$V_JOB_RESET`09= 6
X      PARAMETER SMBMSG$V_JOB_RESET_ABORT`09= 7
X      PARAMETER SMBMSG$V_JOB_TRAILER`09= 8
X      PARAMETER SMBMSG$V_JOB_TRAILER_ABORT`09= 9
X      PARAMETER SMBMSG$V_FIRST_FILE_OF_JOB`09= 10
X      PARAMETER SMBMSG$V_LAST_FILE_OF_JOB`09= 11
$ CALL UNPACK SMBDEF.FOR;1 1208288437
$ v=f$verify(v)
$ EXIT