Trailing-Edge
-
PDP-10 Archives
-
k20v7d
-
uetp/lib/sender.mac
There are 3 other files named sender.mac in the archive. Click here to see a list.
TITLE SENDER
; COPYRIGHT (C) 1977, 1978, 1979 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
; COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
; ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
; SOFTWARE IS HEREBY TRANSFERRED.
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL Edit history
COMMENT \
Edit When Comment
1 ?????? (See Fred Engel)
2 21-Feb-79 Convert to GALAXY library use and conventions
3 3-May-79 Add new TAKE command from the UETP
4 15-Jul-79 Add new PARSER support (see UETP edit 63)
5 15-Oct-79 Finish changes to run under TOPS-10
Call this version 2 to synch with the UETP
\
SUBTTL Universal files
SEARCH GLXMAC,ORNMAC,QSRMAC
.TEXT \,REL:OPRPAR.REL/SEG:LOW\
PROLOG (SENDER)
AC13==13
AC14==14
AC15==15
; VERSION NUMBER DEFINITIONS
VMAJOR==2 ;MAJOR VERSION OF SENDER
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==5 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
VSENDER== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
TXTSIZ==BUFSIZ ;Size of Text buffer for .SEND
MSGBL==BUFSIZ
PDLEN==300 ;PUSH-DOWN STACK LENGTH
RETRY==2000 ;Number of retries for IPCF failure
TOPS10 <
IP%CFE==:77B29 ;field indicating an error occurs
>
TOPS20 <GJFSZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
>
TOPS10 <GJFSZ==FDXSIZ
>
SUBTTL Local macro's
;Define CALLRET
OPDEF CALLRET [JRST]
OPDEF RETSKP [JRST RSKP]
OPDEF RET [JRST R]
DEFINE JSERR <
PUSHJ P,PUTERR
>
; RITMSG - send a message to terminal
DEFINE RITMSG(STR)<
HRROI S1,[ASCIZ\STR\] ;POINT TO STRING
PUSHJ P,SNDMSG ;GO TYPE THE MSG
>
;
; ERRSND - MACRO TO CALL SNDERR, WHICH PRINTS THE ERROR MSG ON TTY AND/OR TAKE
; LOG FILE.
;
DEFINE ERRSND(MSG)<
HRROI S1,[ASCIZ\MSG\] ;POINT TO STRING
PUSHJ P,SNDERR ;GO TYPE THE MSG
>
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
SUBTTL Initialization data for GLXLIB
IB: $BUILD IB.SZ
$SET(IB.PIB,,PIB) ;PIB address
$SET(IB.OUT,,T%TTY)
$SET(IB.FLG,IT.OCT,1)
$SET(IB.PRG,,%%.MOD)
$EOB
PIB: $BUILD PB.MNS
$SET(PB.HDR,PB.LEN,PB.MNS)
$SET(PB.FLG,IP.RSE,1) ;Return to sender on failure
$EOB
SUBTTL Main entry point and initialization
START: JFCL ;No TOPS-10 CCL
RESET ;RESET THE UNIVERSE
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
;Hack #1
;
; Move zeros to the pages in between ZEROB: and ZEROE:
; This causes GALAXY to think I actually own them, since
; TOPS-20 didn't bother to keep them around when I did
; a @SAVE
;
SETZM ZEROB ;zero the first word
MOVE S1,[ZEROB,,ZEROB+1] ;put address to be cleared here
BLT S1,ZEROE-1
MOVX S1,IB.SZ ;GALAXY initialization
MOVEI S2,IB
$CALL I%INIT
PUSHJ P,GPID ;Get the UETP's PID
SUBTTL Command parser and dispatch
PARSE:
; Parser input block is Par%In
; Parser output is stored in Par%Adr
MOVEI S1,INITC ;Addr of main tables
STORE S1,PAR%IN+PAR.TB
MOVEI S1,2 ;length of input block
MOVEI S2,PAR%IN ;address of input block
PARS.1: PUSHJ P,PARSER## ;The only routine to use this label
;is the .TAKE routine. He builds a
;command in memory, and sets up S1
;and S2 for the call
MOVE P3,S2 ;save address of output block
JUMPT PARSOK ;jump if parse succeded
;Parse failed.
MOVE T1,PRT.FL(P3) ;get flags into T1
TXNE T1,P.ENDT ;end of take file
JRST [PUSHJ P,CLSLOG ;Yes, so close output file and parse
SETZM TAKFLG
JRST PARSE]
TXNE T1,P.INTE ;interrupted in parse ?
JRST PARSE ;yes, parse again
TXNE T1,P.TAKE ;a TAKE command ?
JRST PARSE ;yes, so parse again
PUSHJ P,TSTCOL ;output a crlf if not at col 1
MOVEI S1,77 ;put a "?" into S1
$CALL K%BOUT ;and put it at the terminal
MOVE S1,PRT.EM(P3) ;address of error message
$CALL K%SOUT
JRST PARSE ;loop back to parse
;Come here if the parse succeeded
PARSOK: HRRZ P4,PRT.CM(P3) ;Get address of parsed page
HRRZM P4,PAR%ADR ;and save it for future use
MOVE T1,PRT.FL(P3) ;get flags from parse
PUSHJ P,DSPCOM ;display the command if needed
ADD P4,7(P4) ;Point to the parsed block
MOVE S1,P4
$CALL P$SETU## ;Setup the pointer for the parser
$CALL P$KEYW## ;GET the keyword
PUSHJ P,(S1) ;call the command itself
MOVE S1,PAR%ADR
$CALL M%RPAG ;Release the page from the parse
JRST PARSE ;and parse again
CMDPMT: ITEXT (<^J^M^T/@PAR%IN+PAR.PM/>)
SUBTTL DSPCOM - display command if needed
DSPCOM: PUSHJ P,CHKDIS ;See if we need to display the command
JUMPF .RETT ;No, so return
MOVE T1,PRT.CM(P3) ;Address of message
MOVE T2,COM.CM(T1) ;Get text offset
ADDI T2,1(T1) ;Point to start of string
$TEXT (<-1,,TXTBUF>,<^I/CMDPMT/^T/(T2)/^0>)
HRROI S1,TXTBUF
PUSHJ P,SNDMSG ;Send the message
$RET
CHKDIS: MOVE T1,PRT.FL(P3) ;Get flag word
; TXNE T1,P.TAKE ;Take command itself ?
; $RETF ;yes, so don't display it
TXNE T1,P.CTAK ;A command from a take file ?
$RETT ;yes
$RETF ;no
SUBTTL TAKE (commands from) {file-spec} (logging output on) {file-spec}
.TAKE: SETZM TAKIFN ;Be overtly defensive
SETZM TAKJF1 ;reset all file JFN's and IFN's
SETZM OUTIFN
SETZM OUTJFN
$CALL P$FILE## ;Get the input file
JUMPF [ERRSND <Improper field (input file) in TAKE command>
RET]
STORE S1,TAKFOB+FOB.FD
MOVEI S1,FOB.MZ ;Size of FOB of input file
MOVEI S2,TAKFOB ;Addr of FOB
$CALL F%IOPN ;open for input
JUMPF [RITMSG <
?Cannot open TAKE command file
>
RET] ;return if error
MOVEM S1,TAKIFN ;Save the input file's IFN
TOPS20 <
MOVX S2,FI.CHN ;Get the JFN of the file
$CALL F%INFO
MOVEM S1,TAKJF1 ;Save the input file's JFN
MOVEI S2,7 ;Set the byte size of the file
;to 7-bit bytes
SFBSZ
ERJMP [ERRSND <Could not set file byte size for TAKE input file>
MOVE S1,TAKIFN
$CALL F%REL ;Close the input file
RET] ;and return
>;end TOPS20
$CALL P$FILE ;See if there is an output file
JUMPF TAK.1 ;No, so finish up with TAKE command
STORE S1,OUTFOB+FOB.FD ;Store the FD addr in the FOB
MOVEI S1,FOB.MZ ;size of FOB of output file
MOVEI S2,OUTFOB ;Addr of FOB
$CALL F%OOPN ;Open for output
JUMPF [RITMSG <
?Cannot open output file for TAKE command
>
MOVE S1,TAKIFN
$CALL F%REL ;Close the input file
RET] ;return
MOVEM S1,OUTIFN ;Save the output file's IFN
TOPS20 <
MOVX S2,FI.CHN ;Get the JFN of the file
$CALL F%INFO
MOVEM S1,OUTJFN ;Save the input file's JFN
MOVEI S2,7 ;Set the byte size of the file to
;7-bit bytes
SFBSZ
ERJMP [ERRSND <Could not set file byte size for TAKE output file>
MOVE S1,TAKIFN
$CALL F%REL ;Close the input file
MOVE S1,OUTIFN ;and the output file
$CALL F%REL
RET] ;and return
>;end TOPS20
TAK.1: MOVE S1,TAKJF1 ;Setup the TAKE command in the
;PARSER
$CALL P$STAK##
SETOM TAKFLG ;Set flag for processing take commands
RET
SUBTTL BLABEL - Command to define default test label
.BLABE: MOVE S1,[POINT 7,TSTLBL] ;Where default batch label goes
MOVEI S2,^D10 ;Label is 6 chars long
HRROI T1,[ASCIZ/?Error in BLABEL command (from SENDER)/] ;Error msg
PUSHJ P,TXTFIL ;Put the string into memory
RET ;and return
SUBTTL EXTRACT - Routine to extract disk records
.EXTRA: $CALL P$FILE## ;the log file name
JUMPF [RITMSG <
?Error when trying to parse filespec in EXTRACT command>
PUSHJ P,GALERR
RET]
; NOW OPEN THE FILE
TOPS20 <
HRROI S2,1(S1) ;Where to find filespec
MOVX S1,GJ%OLD+GJ%SHT ;Flags for GTJFN
GTJFN ;JSYS
ERJMP [ERRSND <Error opening file for EXTRACT command>
RET]
HRRM S1,EXTJFN ;Save the JFN
MOVE S1,EXTJFN ;GET THAT JFN FOR OPENING
MOVE T2,[7B5+OF%RD] ;READ THE FILE ONLY
OPENF ;NOW OPEN IT
ERJMP [HRROI S1,[ASCIZ/?ERROR IN OPEN FOR EXTRACT (FROM SENDER)/]
PUSHJ P,ERSEND ;SEND ERROR TO UETP AND TTY
RET] ;GET NEXT COMMAND
; Read-ship loop
EXTRD: MOVE S1,EXTJFN ;JFN FOR THE READING
HRROI S2,MSGBUF ;WHERE RECORD WILL BE STORED
MOVEI T1,MSGBL ;MAXIMUM LENGTH OF RECORD
MOVEI T2,.CHLFD ;END OF RECORD CHARACTER
SIN ;READ THE RECORD
ERJMP [MOVE S1,EXTJFN ;JFN FOR WHICH WE'RE EOF TESTING
GTSTS ;GET CURRENT STATUS
TXNE S2,GS%EOF ;SKIP IF NOT EOF
JRST EXTEOF ;YES EOF - THEN HANDLE IT
HRROI S1,[ASCIZ/?ERROR IN SIN IN EXTRACT (FROM SENDER)/]
PUSHJ P,ERSEND ;SEND MESSAGE TO UETP AND TTY
RET] ;READ MORE COMMANDS
MOVEI S2,MSGBL ;COMPUTE NUMBER OF BYTES READ
SUB S2,T1 ;(MAX LENGTH)-RESIDUAL COUNT
HRROI S1,MSGBUF ;POINT TO START OF AREA.
PUSHJ P,SHIP ;AND SHIP IT
JRST EXTRD ;KEEP READING TO EOF
EXTEOF: HRRZ S1,EXTJFN ;CLOSE FILE RELEASE JFN
CLOSF ;CLOSE IT
JFCL
SETZM EXTJFN ;CLEAN-UP AS A PRECAUTION
RET ;RETURN TO CALLER
> ;end TOPS20
TOPS10 <
RET
>
SUBTTL TEST - Test name default command
.TEST: MOVE S1,[POINT 7,TNAME] ;POINT TO WHERE DEFAULT NAME GOES
MOVEI S2,^D6 ;6 CHARACTER DEFAULT
HRROI T1,[ASCIZ/?ERROR IN TEST NAME COMMAND (FROM SENDER)/] ;ERROR MSG
PUSHJ P,TXTFIL ;GO PARSE DEFAULT NAME
RET
SUBTTL TYPE - TYPE OF MESSAGE DEFAULT COMMAND
.TYPE: MOVE S1,ACTNAM ;Get the arguement to the command
MOVEM S1,DEFTYP ;and put it there
RET ;Get next command
SUBTTL SEND - Command to send message to the UETP
.SEND: HRROI S1,TXTBFR ;Buffer to put message in
MOVEI S2,TXTSIZ ;Go the full length
HRROI T1,[ASCIZ/?Error in SEND command (from SENDER)/] ;ERROR MSG
PUSHJ P,TXTFIL ;CALL THE TEXT GETTER
IMULI S1,NCHPW ;Calculate the length of the string
MOVE S2,S1 ;and put in into S2
HRROI S1,TXTBFR ;Point to the buffer
PUSHJ P,SHIP ;Send the message
RET
SUBTTL HELP and EXIT commands
; HELP COMMAND
.HELP: MOVEI S1,HLPMSG
$TEXT (,<^T/0(S1)/>)
RET ;GO PARSE NEXT COMMAND
; EXIT COMMAND
.EXIT: TOPS20 <
SETOM S1 ;INDICATE ALL FILES SHOULD BE CLOSED
CLOSF ;CLOSE ALL OPEN FILES
JSERR ;UNEXPECTED ERROR
> ;end TOPS20
$CALL I%EXIT ;We won't start over
SUBTTL General subroutines
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: $CALL K%TPOS
SKIPE S1, ;If the terminal is at position 0
$TEXT (,<^J^M>) ;Don't need a CRLF...otherwise print it
RET
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL: CALL PUTERR
; RETURNS: +1 ALWAYS
TOPS20 <
PUTERR: MOVX S1,.PRIOU ;GET PRIMARY OUTPUT JFN
HRLOI S2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T1
ERSTR ;OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
RITMSG <
>
RET ;RETURN TO WHENCE WE CAME ...
>;end TOPS20
;LOGCMD - log a command to the take output file if TAKING
LOGCMD: HRROI S1,PRT.CM(P3) ;Address of command
PUSHJ P,SNDMSG ;print it out
RET ;and return
;CLSLOG - close the output file for a TAKE command
CLSLOG: MOVE S1,OUTIFN ;get the file number into S1
SKIPE S1
$CALL F%REL ;close the file
SETZM OUTIFN ;zero the output IFN
RET
SUBTTL BADSTR - Stop user from starting SENDER after an error
BADSTR: MOVE S1,[ASCIZ/ERROR/] ;GET NEW MSG TYPE
MOVEM S1,DEFTYP ;AND SAVE
HRROI S1,[ASCIZ/?SENDER started illegally. BATCH control error/]
MOVEI S2,^D49
PUSH P,S1
PUSHJ P,SHIP
POP P,S1
TOPS20 <PSOUT
ERJMP .+1>
TOPS10 <OUTSTR (1)
JRST .+1>
$CALL I%EXIT
SUBTTL ERSEND - Ship error messages to terminal and UETP
; Routine to ship ERROR messages to terminal and to UETP
;
;CALL: S1/POINTER TO USER DEFINED ERROR MESSAGE
;
;RETURNS: +1, ALWAYS
ERSEND: $SAVE <P2,P3,P3,AC13,AC14,AC15> ;SAVE THE AC'S
MOVEM S1,P2 ;SAVE THE POINTER
TOPS20 <PSOUT ;TYPE USER MSG ON TTY
ERJMP .+1>
TOPS10 <OUTSTR (1) ;TYPE USER MSG ON TTY
JRST .+1>
TOPS20 <
PUSHJ P,TSTCOLL ;Adjust cursor
JSERR ;and send out JSYS error message
>;end TOPS20
;Create a message to send to the UETP
MOVE AC13,DEFTYP ;SAVE CURRENT MESSAGE TYPE
MOVE S1,[ASCIZ/ERROR/] ;GET NEW MSG TYPE
MOVEM S1,DEFTYP ;AND SAVE
$TEXT (<-1,,MSGBUF>,<^T/0(P2)/^0>) ;PUT STRING IN BUFFER
HRROI S1,MSGBUF ;point to message to be sent
MOVEI S2,^D80 ;use arbitrary length of 80
PUSHJ P,SHIP ;AND SEND TO THE UETP
;Send the last JSYS error message to the UETP
TOPS20 <
MOVE S1,[POINT 7,MSGBUF] ;WHERE MESSAGE IS TO GO
MOVEI S2,"?" ;FLAG AS ERROR MESSAGE
IDPB S2,S1 ;STUFF INTO RECORD AREA
MOVE S2,[.FHSLF,,-1] ;WE WANT OUR LAST JSYS ERROR
MOVEI T1,MSGBL ;MAX SIZE
ERSTR ;GET THE JSYS ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
MOVEI S2,MSGBL
SUB S2,T1 ;compute length of message
HRROI S1,MSGBUF ;RECORD TO BE SENT
PUSHJ P,SHIP ;and send
>;end TOPS20
MOVEM AC13,DEFTYP ;RESTORE MESSAGE TYPE
RET
SUBTTL Parsing subroutines
GETST: MOVS T1,@CR.RES(S2) ;get pointer to ASCIZ string
DMOVE S1,(T1) ;get the test name into ACS 1-2
DMOVEM S1,ACTNAM ;and save it
$RETT ;true return...always
; ROUTINE TO OUTPUT COMMAND LINE TO TERMINAL IF PROCESSING TAKE FILE
;
; CALL: CALL TAKTST
; RETURNS: +1 ALWAYS, COMMAND LINE OUTPUT IF NEEDED
TAKTST: MOVEI S1,BUFFER
SKIPE TAKFLG ;Commands becoming from file ?
$TEXT (,<^T/0(S1)/>) ;No, so print
RET
SUBTTL TXTFIL - Routine to parse text and store result in memory
;
; ACCEPTS: S1 - POINTER TO MEMORY LOCATION FOR THE STORE
; S2 - COUNT OF NUMBER OF BYTES TO STORE
; T1 - POINTER TO ERROR MESSAGE IN CASE OF ERRORS
;CALL: CALL TXTFIL
;RETURNS: +1 ALWAYS
;
; S1 - The number of words input by P$TEXT
;
TXTFIL: $SAVE <P2,P3,P4,AC13,AC14,AC15> ;SAVE THE AC'S
MOVEM S1,P2 ;SAVE THE PARAMETERS
MOVEM S2,P3
MOVEM T1,P4
$CALL P$TEXT## ;Get the text
JUMPF [RITMSG <
?Error parsing TEXT field of current command>
PUSHJ P,GALERR
RET]
PUSH P,S2 ;Save the number of words of text
TOPS20 <
AOS S1 ;Point to the text from P$TEXT
HRRO S2,S1 ;Make T2 a fake (TOPS-20) byte pointer
MOVE S1,P2 ;Get pointer to memory
MOVE T1,P3 ;MOVE MAX COUNT
SETZ T2, ;END ON NULL CHARACTER
SOUT
ERJMP [HRROI S1,[ASCIZ/ERROR WITH SOUT JSYS AT STTXT:/]
PUSHJ P,ERSEND
RET]
>
TOPS10 <
AOS S1 ;point to test from P$TEXT
$TEXT (<-1,,0(P2)>,<^T/0(S1)/^0>)
>;end TOPS10
POP P,S1 ;Restore the number of words input
;into S1. This allows the SEND
;to calculate the length of a message
RET ;Return to caller
SUBTTL SHIP - Routine to send the UETP messages
;
;ACCEPTS: S1 - POINTER TO STRING TO BE SENT
; S2 - LENGTH OF STRING TO BE SENT
;
;CALL: CALL SHIP
;RETURNS: +1, ALWAYS
;
SHIP: SETZM MSGREC ;ZERO OUT THE ASCIZ FIELDS
MOVE T1,[MSGREC,,MSGREC+1] ;FOR THE BLT
BLT T1,MSGREC+RECLEN-1 ;ZERO IT ALL
MOVE T1,S2
ADDI T1,BASESZ ;Calculate the full message size
MOVEM T1,USAB+SAB.LN ;and store it away
$TEXT (<-1,,MSGREC>,<^T/0(S1)/^0>) ;write the message
$TEXT (<-1,,DATE>,<^H9/[-1]/^0>) ;and date
$TEXT (<-1,,TIME>,<^C/[-1]/^0>) ;and even the time
TOPS20 <
HRROI S1,-5 ;GET CPU TIME AND CONSOLE TIME
RUNTM ;FOR THE WHOLE JOB
PUSH P,T1 ;SAVE CONSOLE TIME FOR LATER
IDIV S1,S2 ;CONVERT TO SECONDS
HRROI T2,CPUTIM ;WHERE TO PUT CPU TIME USED
PUSHJ P,TIMOUT ;OUTPUT STRING
POP P,S1 ;RETURN CONVERSION FACTOR
IDIVI S1,^D1000 ;CONVERT TO SECONDS
HRROI T2,CNSTIM ;WHERE TO PUT CONSOLE TIME
PUSHJ P,TIMOUT ;CONVERT TO ASCII AND OUTPUT
> ;end TOPS20
TOPS10 <
SETZ S1, ;get my current runtime
RUNTIME S1,
JFCL
IDIVI S1,^D1000 ;convert to seconds
HRROI T2,CPUTIM
PUSHJ P,TIMOUT ;write the CPU time out
MOVE T1,[%CNDTM] ;Get the current daytime
GETTAB T1,
JFCL
MOVE S1,[-1,,.GTJLT] ;Get the time the job was logged in
GETTAB S1,
JFCL
SUB T1,S1 ;T1 has UDT fraction representing
;length of time job has been logged in
;UDT in T1
MULI T1,^D84600 ;CONVERT TO SECONDS IN T1-T2
ASHC T1,^D17 ;ALIGN BINARY POINT
TLNE T2,(1B1) ;REMAINDER MORE THAN 1/2 SEC?
ADDI T1,1 ;YES, ROUND UP
MOVE S1,T1
HRROI T2,CNSTIM ;Put the time job has been logged in there
PUSHJ P,TIMOUT
>;end TOPS10
; (continued on next page)
; (continued from previous page)
MOVEI T3,RETRY ;The number of times to retry
SENDIT: MOVEI S1,BASERC ;Address of message
MOVEM S1,USAB+SAB.MS ;stored in the SAB
MOVEI S1,SAB.SZ
MOVEI S2,USAB
$CALL C%SEND ;Send the message
JUMPT [RET]
;Allowable errors
;
; ERSLE$ System limit exceeded (try again)
; ERRQF$ Receiver's quota full (try again)
; ERUSE$ Unexpected System error
; ERSQF$ Sender's quota full
;
;Errors that are the UETP's fault
;
; ERNSP$ No such pid (oh boy !)
;
CAIN S1,ERSQF$ ;WAS IT SEND QUOTA EXCEEDED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
CAIN S1,ERRQF$ ;WAS IT RECEIVER'S QUOTA EXCEEDED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
CAIN S1,ERUSE$ ;WAS IT IPCF FREE SPACE EXHAUSTED?
JRST TRYAGN ;YES - WELL SEND ANOTHER ONE
SNDFL: $STOP (SNE,<Can't send message to UETP because ^E/[-1]/>)
TRYAGN:
SOJG T3,SENDIT ;RETRY SENDING "RETRY" TIMES
JRST SNDFL ;RETRIES FAILED TELL USER
SUBTTL TIMOUT - Subroutine to output time in S1 in HH:MM:SS format
;
;ACCEPTS: S1/ TIME TO BE OUTPUT IN SECONDS
; T2/ OUTPUT DESTINATION POINTER
;
;CALL: CALL TIMOUT
;RETURNS: +1,ALWAYS
;
TIMOUT:
$SAVE <S1,S2,T1> ;SAVE THE FIRST 3 AC'S
STKVAR <HOURS,MINUTE,SECOND> ;AND SETUP SOME VARIABLES
MOVE S2,S1 ;MOVE FOR JSYS SENDING
MOVE S1,T2 ;GET THE OUTPUT DESIGNATOR
IDIVI S2,^D3600 ;GET THE HOURS QUANTITY
MOVEM S2,HOURS ;SAVE THE HOURS
MOVE S2,T1 ;SETUP NEXT DIVISION
IDIVI S2,^D60 ;MAKE INTO MINUTES
MOVEM S2,MINUTE ;AND SAVE MINUTES
MOVEM T1,SECOND ;AND SECONDS
$TEXT (<-1,,0(T2)>,<^D2R0/HOURS/:^D2R0/MINUTE/:^D2R0/SECOND/^0>)
RET ;NORMAL RETURN
SUBTTL Msg output routines
;CALL: CALL SNDERR S1/POINTER TO ASCIZ STRING TO OUTPUT
;RETURNS: NOTHING
;
; THIS ROUTINE PUTS A STANDARD HEADER ON THE MESSAGE GIVEN AND
; THEN OUTPUTS THE LAST SYSTEM ERROR MSG FOR THIS JOB.
;
SNDERR: $SAVE <S2,T1,T2>
HRLI S1,0 ;Make the pointer an address
$TEXT (,<^J^M?SENDER error: ^T/0(S1)/>)
TOPS20 <
HRROI S1,WRKBUF ;WHERE SYSTEM ERROR MESSAGE IS TO GO
HRRI S2,-1 ;GET LATEST MESSAGE
HRLI S2,.FHSLF ;TELL MONITOR FOR WHOM WE WANT ERROR MSG
HRLZI T1,-<<WRKSIZ*5>-1> ;MAX NUMBER OF BYTES
ERSTR ;PUT ERROR MESSAGE INTO BUFFER
JFCL ;WE'LL IGNORE ERRORS HERE
JFCL
MOVEI S1,WRKBUF
$TEXT (,<^J^M?Jsys error message: ^T/0(S1)/>)
> ; end TOPS20
RET
;
; GALERR - prints the GALAXY error for any failing call to the library
GALERR: $TEXT (,<^J^M?GALAXY error: ^E/[-1]/>)
$RET
;
;SNDMSG - send a message to the terminal (batch log file)
;
SNDMSG: $TEXT (,<^T/0(S1)/>)
$RET
SUBTTL Action routines for PARSER
;Take command action routines
TOPS20 <
TAKD1: MOVE S2,CR.FLG(S2) ;Get address of command state block
MOVE T4,.CMGJB(S2) ;Get address of GTJFN block
MOVE S2,T4 ;put address of block into S2
MOVEI S1,1(S2) ;Set up to clear GTJFN block
HRL S1,S2
SETZM (S2) ;CLEAR FIRST WORD
BLT S1,GJFSZ-1(S2) ;CLEAR THE BLOCK
MOVX S1,GJ%OLD ;FILE MUST BE THERE
MOVEM S1,.GJGEN(T4) ;INTO FLAGS WORD
MOVE S1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
MOVEM S1,.GJSRC(T4) ;INTO BLOCK
HRROI S1,[ASCIZ/UETP/] ;POINT AT DEFAULT FILE NAME
MOVEM S1,.GJNAM(T4) ;SAVE FOR GTJFN
HRROI S1,[ASCIZ/CMD/] ;DEFAULT EXTENSION
MOVEM S1,.GJEXT(T4) ;SAVE IN GTJFN BLOCK
POPJ P, ;AND RETURN
> ;END TOPS20
TOPS10 <
TAKD1: MOVE S2,CR.FLG(S2) ;Get address of command state block
MOVE T4,.CMGJB(S2) ;Get address of GTJFN block
MOVE S2,T4 ;put address of block into S2
MOVEI S1,1(S2) ;Set up to clear GTJFN block
HRL S1,S2
SETZM (S2) ;CLEAR FIRST WORD
BLT S1,GJFSZ-1(S2) ;CLEAR THE BLOCK
MOVE S1,[SIXBIT/UETP/] ;GET FILE NAME
STORE S1,.FDNAM(T4) ;SAVE IN DEFAULT BLOCK
MOVSI S1,'CMD' ;GET DEFAULT EXTENSION
STORE S1,.FDEXT(T4) ;SAVE IN BLOCK
MOVSI S1,'DSK' ;GET STRUCTURE NAME
STORE S1,.FDSTR(T4)
POPJ P, ;AND RETURN
> ;END TOPS10
; (continued on next page)
; (continued from previous page)
TOPS20 <
TAKD2: MOVE S2,CR.FLG(S2) ;Get address of command state block
MOVE T4,.CMGJB(S2) ;Get address of GTJFN block
MOVE S2,T4 ;put address of block into S2
MOVEI S1,1(S2) ;Set up to clear GTJFN block
HRL S1,S2
SETZM (S2) ;CLEAR FIRST WORD
BLT S1,GJFSZ-1(S2) ;CLEAR THE BLOCK
MOVX S1,GJ%FOU ;FILE IS FOR OUTPUT
MOVEM S1,.GJGEN(T4) ;INTO FLAGS WORD
MOVE S1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
MOVEM S1,.GJSRC(T4) ;INTO BLOCK
HRROI S1,[ASCIZ/UETP/] ;POINT AT DEFAULT FILE NAME
MOVEM S1,.GJNAM(T4) ;SAVE FOR GTJFN
HRROI S1,[ASCIZ/LOG/] ;DEFAULT EXTENSION
MOVEM S1,.GJEXT(T4) ;SAVE IN GTJFN BLOCK
POPJ P, ;AND RETURN
> ;END TOPS20
TOPS10 <
TAKD2: MOVE S2,CR.FLG(S2) ;Get address of command state block
MOVE T4,.CMGJB(S2) ;Get address of GTJFN block
MOVE S2,T4 ;put address of block into S2
MOVEI S1,1(S2) ;Set up to clear GTJFN block
HRL S1,S2
SETZM (S2) ;CLEAR FIRST WORD
BLT S1,GJFSZ-1(S2) ;CLEAR THE BLOCK
MOVE S1,[SIXBIT/UETP/] ;GET FILE NAME
STORE S1,.FDNAM(T4) ;SAVE IN DEFAULT BLOCK
MOVSI S1,'LOG' ;GET DEFAULT EXTENSION
STORE S1,.FDEXT(T4) ;SAVE IN BLOCK
MOVSI S1,'DSK' ;GET STRUCTURE NAME
STORE S1,.FDSTR(T4)
POPJ P, ;AND RETURN
> ;END TOPS10
TAKCHK: SKIPN TAKFLG ;PROCESSING A TAKE COMMAND
$RETT ;NO..JUST RETURN
SETZ S1, ;Clear flag AC
MOVEI S2,[ASCIZ/Take command illegal within a take file..command ignored/]
$RETF ;FALSE RETURN TO ABORT COMMAND
; (continued on next page)
; (continued from previous page)
;Action routine to call if we get a bad file spec in a TAKE command
; parse
BADIFI: SETZM S2 ;CLEAR THE ERROR CODE
$RETF ;BAD INPUT FILE
SUBTTL Command tables
INITC: $INIT(CMD100)
CMD100: $KEYDSP(CMDTAB)
CMDTAB: $STAB
DSPTAB (W%BLA,.BLABE,BLABEL)
DSPTAB (W%EXI,.EXIT ,EXIT)
DSPTAB (W%EXT,.EXTRA,EXTRACT)
DSPTAB (W%HEL,.HELP ,HELP)
DSPTAB (W%SEN,.SEND ,SEND)
DSPTAB (W%TAK,.TAKE,TAKE)
DSPTAB (W%TES,.TEST ,TEST)
DSPTAB (W%TYP,.TYPE ,TYPE)
$ETAB
W%BLA: $CTEXT(W%CRLF,<current label of BATCH control file>)
W%EXI: $NOISE(W%CRLF,<to MONITOR>)
W%EXT: $NOISE(W%EXT1,<messages from>)
W%EXT1: $IFILE(W%CRLF,<file to extract messages from>)
W%HEL: $NOISE(W%CRLF,<with SENDER>)
W%SEN: $CTEXT(W%CRLF,<message to the UETP>)
;
;TAKE (commands from file) $INFILE (logging output on) $OUTFILE
;
;
W%TAK: $NOISE(W%TAK1,<commands from file>)
W%TAK1: $FILE(W%TAK2,<file to take commands from>,<$PREFILL(TAKD1),$ACTION(TAKCHK),$ERROR(BADIFI)>)
W%TAK2: $NOISE(W%TAK3,<logging output on>)
W%TAK3: $CRLF(<$ALTERNATE(W%TAK4)>)
W%TAK4: $FILE(W%TAK3,<file to log output in>,<$PREFILL(TAKD2),$ERROR(BADIFI)>)
;
;end of TAKE syntax
;
W%TES: $CTEXT(W%CRLF,<name of test>)
W%TYP: $NOISE(W%TYP1,<of message>)
W%TYP1: $KEY(W%CRLF,W%TYP2,<$ACTION(GETST)>)
W%TYP2: $STAB
KEYTAB(0,END ) ;MESSAGE TYPE IS END OF BATCH RUN
KEYTAB(0,ERROR) ; " " " ERROR IN " "
KEYTAB(0,LOG ) ;MESSAGE TYPE-RECORD IS A BATCH LOG RECORD
KEYTAB(0,MAJOR) ;MESSAGE TYPE- MAJOR EVENT IN BATCH RUN
KEYTAB(0,MINOR) ; " " MINOR " " " "
KEYTAB(0,START) ;MESSAGE TYPE IS START OF BATCH RUN
$ETAB
W%CRLF: $CRLF
PROMPT: ASCIZ /SENDER>/ ;PROMPT STRING
PAR%IN: EXP INITC
EXP PROMPT
BLOCK 2
PAR%ADR: BLOCK 1 ;Address of parsed page
ACTNAM: BLOCK 5 ;Type of message stored here
SUBTTL Constants
ENTVEC: JRST START ;MAIN ENTRY POINT
JRST START ;REENTER ENTRY POINT
EXP VSENDER ;VERSION OF SENDER PROGRAM
ASTERS: ASCIZ/
********************************************************************
/
; HELP TEXT
XLIST ;We suppress the help text
.DIRECTIVE FLBLST
HLPMSG: ASCIZ $
SENDER Program
FUNCTION THIS PROGRAM IS MEANT TO BE USED BY THE BATCH
TEST CREATOR FOR UETP COMMUNICATION. ALL EVENT AND
ERROR CONDITIONS OCCURING IN THE BATCH TEST CAN BE RELAYED
TO THE UETP VIA THIS PROGRAM. THERE IS NO OTHER WAY
TO COMMUNICATE WITH THE UETP.
COMMANDS
a. Commands which qualify the messages to be sent.
1. TEST NAME <text>
The first 10 characters of <text> go into the
test name field of all messages to be sent until
the next "TEST NAME" command.
2. BLABEL <text>
The first 10 characters of <text> go into the
batch test label field of all messages to be sent
until the next "BLABEL" command.
3. / MAJOR \
/ MINOR \
TYPE (OF MESSAGE) \ END /
\ ERROR /
\ START /
A code corresponding to message type will be
placed into the message type field of all
messages sent until the next "TYPE" command is
given. The message types are:
MAJOR major run milestone
MINOR minor run milestone
ERROR errors
END end of run (a major milestone message)
START start of run (a major milestone message)
b. Commands which relate to the message text.
1. EXTRACT (MESSAGES FROM) <file-spec>
This tells "SENDER" that the messages are to come from
the named file. These messages will be placed in the
ninth (text) position of message records. The first
eight field being filled in by SENDER.
Each message sent will also be written to the terminal
assigned to the job, so that in normal usage, running
under a batch control file, the messages will show up in
the test log file.
All the messages in the file will be sent in this
manner. When "SENDER" reaches "end of file" it will
return to the user terminal (batch control file) to
accept more commands.
2. SEND (MESSAGE TO UETP) <text><carraige return>
The contents of <text> will be used for a message which
will be sent immediately, along with any qualifying
information provided via the commands a.1 through a.6.
The time stamp will be taken from the current monitor
time and will be labeled "origination time stamp" ("O"
in position 19).
3. EXIT (TO MONITOR)
This command terminates the execution of SENDER.
RESTRICTIONS
The general conventions for running batch jobs are intended to
guarantee communication with the Command Processor at the
beginning and end of each batch run. To accomplish this goal
each batch job should run the SENDER program at the beginning
and end of each batch run.
SENDER gives the batch run creator
the ability to communicate with UETP which records all
information in the error and event logs. This recording is
essential to the sucess of UETP. If all batch runs follow the
recording conventions then their flow and status can be
monitored and reported promptly and accurately.
The basic conventions are quite simple. The first step in any
batch control statement will be an execution of SENDER. The
information sent must identify the sender and give the start
time. The last logical step must have two components. first, a
%ERR:: execution of SENDER which traps unknown errors and
informs UETP. Second, a SENDER run informing UETP that this
is a succesfull end of this run. An example may clarify the
convention:
@RUN SENDER
SENDER> TYPE (OF MESSAGE) START
SENDER> TEST NAME COBOL2
SENDER> SEND BEGINNING COBOL2 RUN
SENDER> EXIT
.
. ACTUAL BATCH RUN
.
@GOTO NOERR
; We execute here if there was an unexpected error
%ERR::@CHKPNT
PRINT COBOL2.LOG
@RUN SENDER
SENDER>TYPE ERROR
SENDER>BLABEL %ERR
SEBDER>TEST NAME COBOL2
SENDER>SEND UNKNOWN ERROR IN COBOL2 RUN
SENDER>TYPE MINOR
SENDER>EXTRACT COBOL2.LOG
SENDER>EXIT
;We always pass through this next section
NOERR::@RUN SENDER
SENDER> TYPE END
SENDER>TEST NAME COBOL2
SENDER> SEND END OF COBOL2 RUN
SENDER> EXIT
%FIN::;In case of disatorous errors
@CHKPNT
@PRINT COBOL2.LOG
The basic philosophy of the convention is to guarantee that some
message gets back to UETP about the ending status of this run.
If the run ends with no errors then that fact will be conveyed.
However, if any unexpected errors occur then UETP will still
receive information about the end of the test.
HINTS
EXAMPLES
$
.DIRECTIVE NO FLBLST
LIST
SUBTTL Special subroutines
RSKP: AOS 0(P)
R: POPJ P,
; Routine to get pid
;
; CALL: $Call GPID
; RETURNS: +1, always
;
; This routine puts the PID of the UETP we should talk to at UETPID
GPID:
TOPS20 <
HRROI S1,-1
MOVE S2,[-1,,4]
MOVX T1,.JIDNO ;get connected directory number
GETJI
ERJMP [ERRSND <Unexpected error in GETJI at GPID:>
$CALL I%EXIT]
HRROI S1,UPIDST+1 ;where to put octal directory number
MOVE S2,T2 ;the number
MOVE T1,[NO%MAG+^D8] ;no magnitude, octal number
NOUT
ERJMP [ERRSND <Unexpected error in NOUT at GPID:>
$CALL I%EXIT]
;Ask SYSTEM[INFO] to convert the PID string into a number
MOVEI T3,IPCOM ;POINT TO BASE IPCF BLOCK
MOVE S1,[1234,,.IPCIW] ;IDENTITY CODE,,GET PID CODE
MOVEM S1,.IPCI0(T3) ;INTO IPCF COMMUNICATION BLOCK
SETZM .IPCI1(T3) ;NO ONE ELSE TO GET THIS RESPONSE
HRROI S1,.IPCI2(T3) ;Put the string in the IPCF block
HRROI S2,UPIDST ;the string to write
SETZ T1,
SETZ T2,
SOUT
ERJMP [ERRSND <Error in SOUT Jsys attempting to write UETP's PID>
$CALL I%EXIT]
> ;END TOPS20
; (continued on next page)
; (continued from previous page)
;Ask SYSTEM[INFO] to convert the PID string into a number
TOPS10 <
MOVEI T3,IPCOM ;POINT TO BASE OF IPCF BLOCK
MOVE S1,[1234,,.IPCIW] ;IDENTITY CODE,,GET PID CODE
MOVEM S1,.IPCI0(T3) ;INTO IPCF COMMUNICATION BLOCK
SETZM .IPCI1(T3) ;NO ONE ELSE GETS THIS RESPONSE
MOVE S1,[XWD .DFJST+1,STRBLK] ;get the current structure name
JOBSTR S1,
JRST [RITMSG <
?Cannot get connected structure name in GPID:>
$HALT]
SETO S1, ;FOR COMPARE
CAMN S1,STRBLK+.DFJNM ;IS THE RETURNED STRUCTURE NAME -1 ?
JRST [MOVEI S1,'DSK' ;YES, SO PUT DSK: IN ITS PLACE
HRLZM S1,STRBLK+.DFJNM
JRST .+1]
GETPPN S1, ;get the PPN of this job
MOVE S2,STRBLK+.DFJNM ;and the SIXBIT structure name
$TEXT (<-1,,UPIDST>,<UETP^W/S2/^U/S1/^0>) ;and build UPID
> ;END TOPS10
; (continued on next page)
; (continued from previous page)
TOPS20 <
MOVEI S1,SAB.SZ ;Size of SAB for <SYSTEM>INFO
MOVEI S2,ISAB ;Address of SAB
$CALL C%SEND
JUMPF [$STOP(SN1,<Unable to send message to INFO becase ^E/[-1]/>)]
>;end TOPS20
TOPS10 <
MOVE S2,[XWD 4,PDB0]
IPCFS. S2,
$FATAL (Unable to send message to SYSTEM[INFO])
>;end TOPS10
$CALL C%BRCV ;Wait for the response
JUMPF [$STOP(SN2,<Failure in receiving INFO message: ^E/[-1]/>)]
LOAD T3,MDB.MS(S1),MD.ADR ;Put addr of message into T3
MOVE T1,MDB.FG(S1) ;Get the flags into S1
TXNE T1,IP%CFE ;Skip if no errors
$FATAL <Can't get UETP's PID ^T/UPIDST/ (probably not running in this directory)>
MOVE S1,.IPCI1(T3) ;GET THE PID NUMBER
MOVEM S1,UETPID ;AND SAVE FOR LATER USE
MOVEM S1,USAB+SAB.PD ;and place it in the SAB
RET ;return to caller
SUBTTL File control blocks
;
;File control block for the output file for a TAKE command
;
TAKFOB: $BUILD FOB.MZ ;BUILD FILE OPEN BLOCK
$SET(FOB.CW,FB.BSZ,7) ;BYTE SIZE OF SEVEN..ASCII
$EOB ;END THE BLOCK
OUTFOB: $BUILD FOB.MZ
$SET(FOB.FD,,0) ;Filled in by TAKE command
$SET(FOB.CW,FB.BSZ,7) ;7-bit bytes
$EOB
TAKJF1: BLOCK 1 ;Filled by TAKE command
TAKIFN: BLOCK 1
OUTIFN: BLOCK 1 ;Filled by TAKE command
OUTJFN: BLOCK 1 ;" "
TAKFLG: BLOCK 1 ;Flag indicating whether we're in TAKE
SUBTTL Communication Send Address Blocks
ISAB: $BUILD SAB.SZ
$SET(SAB.MS,,IPCOM) ;Address of message
$SET(SAB.LN,,20) ;Message is 20 words long
$SET(SAB.SI,SI.FLG,1) ;Special pid index should be used
$SET(SAB.SI,SI.IDX,SP.INF) ;<SYSTEM>INFO
$EOB
USAB: $BUILD SAB.SZ
$SET(SAB.MS,,BASERC) ;Address of message
$SET(SAB.LN,,0) ;(to be filled)
$EOB
TOPS20 <
UPIDST: ASCII /UETP-/
BLOCK 5 ;String for UETP's PID
>;END TOPS20
TOPS10 <
PDB0: 0
0
0
XWD 10,DMB0
DMB0: XWD 1234,.IPCIW
0
UPIDST: BLOCK 100
STRBLK: $BUILD 3
$SET(.DFJNM,,-1)
$EOB
>;end TOPS10
SUBTTL Variable data storage
ZEROB: BLOCK 1 ;Beginning of zeroed section
WRKSIZ==200 ;SIZE OF GENERAL PURPOSE BUFFER
WRKBUF: BLOCK WRKSIZ ;GENERAL PURPOSE WORK AREA
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
TXTBFR: BLOCK TXTSIZ ;Input text for send command
TXTBUF: BLOCK WRKSIZ ;Buffer for general $TEXT usage
MSGBUF: BLOCK MSGBL ;SENDING BUFFER
PDL: BLOCK PDLEN ;PUSH DOWN POINTER
NAMBUF: BLOCK 8 ;BUFFER FOR NAME OF INPUT FILE
EXTJFN: BLOCK 1 ;JFN OF EXTRACT FILE (EXTRACT COMMAND)
UETPID: BLOCK 1 ;PID FOR UETP
SUBTTL IPCF message to the UETP
;
; THIS NEXT SECTION MUST REMAIN IN IT'S CURRENT ORDER. EACH ITEM IS
; A FIELD IN A LARGER RECORD.
;
RELOC <<<<140+.>!777>+1>-140> ;MOVE TO PAGE BOUNDARY
BASERC:
DEFTYP: ASCII/ / ;DEFAULT MESSAGE TYPE VALUE
TNAME: ASCII/ / ;DEFAULT TEST NAME
DATE: ASCII/ / ;DATE OF RECORD
TIME: ASCII/ / ;TIME OF MESSAGE
TDEPTH: ASCII/ / ;DEPTH OF TEST
TSTLBL: ASCII/ / ;DEFAULT TEST LABEL
CPUTIM: ASCII/ / ;CPU TIME USED IN THIS JOB
CNSTIM: ASCII/ / ;TOTAL CONSOLE TIME (ELAPSED TIME)
BLOCK 1 ;SPACER FOR TOKENIZING
MESVER: EXP 2 ;Message version
BASESZ=.-BASERC ;SIZE OF BASE RECORD
RECLEN=1000-<.-BASERC> ;RECORD LENGTH
MSGREC: BLOCK RECLEN ;AREA FOR EXTRACTED RECORD
;
; END OF ORDERED SECTION FOR OUTPUT RECORDS
;
IPCOM: BLOCK 1000 ;Message to <SYSTEM>INFO
ZEROE: BLOCK 1 ;End of zeroed section
;%%%LOCAL MODES:
;%%%Comment Column:40
;%%%Comment Start:;
;%%%END:
END <3,,ENTVEC>