Trailing-Edge
-
PDP-10 Archives
-
BB-CH18A-BM_1985
-
sna-rje/snasub.mac
There are no other files named snasub.mac in the archive.
; SNASUB - SUBMIT facility for SNA RJE Workstations
;
ASCIZ /
COPYRIGHT (c) 1984, 1985
DIGITAL EQUIPMENT CORPORATION
/
; 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 Table of Contents
; Table of Contents for SNASUB
;
;
; Section Page
; 1. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 2. Searches and version . . . . . . . . . . . . . . . . . 3
; 3. Edit history . . . . . . . . . . . . . . . . . . . . . 4
; 4. Symbol definitions
; 4.1. AC Definitions. . . . . . . . . . . . . . . . 5
; 4.2. Parameters. . . . . . . . . . . . . . . . . . 5
; 4.3. External symbol definitions . . . . . . . . . 5
; 4.4. Message processor status bits (in S). . . . . 5
; 4.5. Create queue entry message offsets (from QUASAR) 5
; 5. Database definitions
; 5.1. Random static storage . . . . . . . . . . . . 6
; 5.2. Constant static storage . . . . . . . . . . . 7
; 5.3. Miscellaneous cells . . . . . . . . . . . . . 7
; 5.4. IB, Initialization block for GLXLIB . . . . . 8
; 5.5. Dispatch Table for Command Keywords . . . . . 9
; 5.6. Dispatch Table for Switch Keywords. . . . . . 9
; 5.7. Interrupt system database . . . . . . . . . . 10
; 6. Interrupt code
; 6.1. INTINI, Interrupt system initialization . . . 11
; 6.2. INTIPC, IPCF Interrupt routine. . . . . . . . 11
; 6.3. INTDEC, DECnet Interrupt routine. . . . . . . 11
; 7. SNASUB
; 7.1. Initialization code . . . . . . . . . . . . . 12
; 7.2. Main processing loop. . . . . . . . . . . . . 13
; 8. Command Processors
; 8.1. EXIT - Process EXIT Command . . . . . . . . . 14
; 8.2. HELP - Process HELP Command . . . . . . . . . 15
; 8.3. SUBMIT - Process SUBMIT Command . . . . . . . 16
; 9. Switch Processors
; 9.1. AFTER - Process /AFTER Switch . . . . . . . . 17
; 9.2. BATLOG - Process /BATCH-LOG Switch. . . . . . 18
; 9.3. JOBNAM - Process /JOBNAME Switch. . . . . . . 19
; 9.4. NOTAB - Process /NOTAB Switch . . . . . . . . 20
; 9.5. NOTRAN - Process /NOTRANSLATE Switch. . . . . 21
; 9.6. OUTPUT - Process /OUTPUT Switch . . . . . . . 22
; 9.7. PRIOR - Process /PRIORITY Switch. . . . . . . 23
; 9.8. PRONOD - Process /PROCESSING-NODE Switch. . . 24
; 9.9. RECORD - Process /RECORD Switch . . . . . . . 25
; 9.10. RESTAR - Process /RESTARTABLE Switch. . . . . 26
; 9.11. TAB - Process /TAB Switch . . . . . . . . . . 27
; 9.12. TIME - Process /TIME Switch . . . . . . . . . 28
; 9.13. TRANS - Process /TRANSLATE Switch . . . . . . 29
; 9.14. UNIQUE - Process /UNIQUE Switch . . . . . . . 30
; 10. IPCF Message Handling
; 10.1. MSGCHK, message checker . . . . . . . . . . . 31
; 10.2. MSGPRC, IPCF message processor. . . . . . . . 32
; 10.3. TEXTMS, Text message response . . . . . . . . 33
; 11. Subroutines
; 11.1. Initialization and Main Loop subroutines. . . 34
; 11.2. . OPDINI, Get operating system information . 34
; 11.3. . DISPAT, Dispatch table processing. . . . . 35
; 11.4. Queue create message handling . . . . . . . . 36
; 11.5. . INIQRQ, Initialize queue request to default 36
; 11.6. . INSENT, Insert entry . . . . . . . . . . . 37
; 11.7. . FNDENT, Find entry . . . . . . . . . . . . 38
; 11.8. . SNDQUE, send queue info to QUASAR. . . . . 39
; 11.9. IPCF message subroutines. . . . . . . . . . . 40
; 11.10. . SNDQSR, send a message to QUASAR . . . . . 40
; 11.11. . MISLP, sleep for specified time. . . . . . 41
; 12. Literals . . . . . . . . . . . . . . . . . . . . . . . 42
SUBTTL Searches and version
SALL ; Make nice clean listings
.DIRECTIVE FLBLST ; List only 1st binary word in
; multi word text strings
SEARCH GLXMAC ; Use GALAXY group's macros/symbols
SEARCH MONSYM
SEARCH MACSYM
SEARCH QSRMAC ; Symbols for setup message
SEARCH ORNMAC ; ORION communications symbols
PROLOGUE (SNASUB) ; Initialize Galaxy symbol definitions
; Version
XP SUBVER, 1 ; Major version number
XP SUBMIN, 0 ; Minor version number
XP SUBEDT, 2 ; Edit level
XP SUBWHO, 0 ; Who did last edit (0=DEC)
; Conditional assembly flags.
ND FTDEBUG, 0 ; If on .. then generate debuging code
; Version
%%.SUB=:<VRSN. (SUB)> ; Set value of edit level/version
; Print title/version information to log during compilation
Define VOUTX ($S1,$S2,$S3,$S4)
<TITLE $S1 $S2'$S3'('$S4')
PRINTX $S1 $S2'$S3'('$S4')>
IF1,<
IFN <SUBMIN>,<VOUTX (SNASUB - SNA SUBMIT facility for DECnet/SNA Gateway,\SUBVER,\"<"@"+SUBMIN>,\SUBEDT)>
IFE <SUBMIN>,<VOUTX (SNASUB - SNA SUBMIT facility for DECnet/SNA Gateway,\SUBVER,,\SUBEDT)>
IFN FTDEBUG,<PRINTX . with DEBUG features>
> ;End If PASS1
IF2,<PRINTX Pass 2.>
LOC 124 ; Reenter address
EXP EXIT.
LOC 137 ; Jobver
VERWRD: EXP %%.SUB
RELOC
SUBNAM: ASCIZ /SNASUB/ ; Name of program
EXP 0
SUBTTL Edit history
COMMENT &
Edit Date Who Why
1(0) 1-May-84 DRB Development of new product
1(1) 23-Oct-84 DRB Set up reenter address
1(2) 1-Nov-84 DRB Define .QCSNA to be .QBSNA if Galaxy V5
&
SUBTTL Symbol definitions -- AC Definitions
; Preserved AC's
J=:13 ; Queue request page
S=:16 ; Status flags
SUBTTL Symbol definitions -- Parameters
; Parameters which may be changed at assembly time
ND PDSIZE,450 ; Size of pushdown list
; System dependent parameters
SYSPRM SYSNML,5,10 ; Number of word in system name
; Constant parameters
; Define .QCSNA
; If symbol .QBSNA is defined (from MONSYM for Galaxy 5) use it;
; otherwise use the value defined in QSRMAC
IFDEF .QBSNA <.QCSNA==.QBSNA>
SUBTTL Symbol definitions -- External symbol definitions
SUBTTL Symbol definitions -- Message processor status bits (in S)
F.IPCSY==1B0 ; Message was from a GALAXY component
NODEL==1B1 ; No delete
SUBTTL Symbol definitions -- Create queue entry message offsets (from QUASAR)
XP CQBEG,MSHSIZ+2 ; Beginning of entries
XP CQARGN,MSHSIZ+1 ; Number of entries (arguments)
SUBTTL Database definitions -- Random static storage
LOWBEG==. ; Start of area to zero
; Environmental information
CNF: BLOCK SYSNML ; Monitor name string
CNTSTA: BLOCK 1 ; Node number of central station
NODNA6: BLOCK 1 ; Node name of local node (SIXBIT)
NODNAM:: BLOCK 2 ; Node name of local node (ASCIZ)
; IPCF Message handling cells
MDBADR: BLOCK 1 ; Message data block address for IPCF
SAB: BLOCK SAB.SZ ; Send argument block for sending messages
; Block in which to build FDB's
FDBARE: BLOCK FDXSIZ ; Maximum area for file name
; Block to hold File Parameter Information
FPINF: BLOCK 1
; Block to hold Processing Node Information
PNINF: BLOCK 1
LOWEND==. ; End of zeroed area plus 1
SUBTTL Database definitions -- Constant static storage
PDL: BLOCK PDSIZE ; Stack for MAIN context
PROMPT: ASCIZ \SNASUB>\ ;Program prompt string
PROMP2: ASCIZ \/PROCESSING-NODE:\ ;Prompt string for processing node
TOPS10 <
INTVEC==VECTOR ; Define interrupt vector address
>;End if TOPS10
TOPS20 <
INTVEC==:LEVTAB,,CHNTAB ; Define interrupt vector address
>;End if TOPS20
SUBTTL Database definitions -- Miscellaneous cells
WTORNM: EXP 5000 ; ACK code to usr for WTOR (incremented)
MSNDR: Z ; last IPCF msg sender name
; Dummy Object block (used for some error messages)
OBJBLK: EXP 0 ; Object type
EXP 0 ; Unit number
EXP 0 ; Station
; Text processing utility
TEXTBP: Z ; Byte pointer used by DEPBP
DEPBP: IDPB S1,TEXTBP ; Store byte at byte pointer
$RETT ; and return true
SUBTTL Database definitions -- IB, Initialization block for GLXLIB
IB: $BUILD IB.SZ ; Initialization block
$SET (IB.PRG,,%%.MOD) ; Sixbit program name (from PROLOG)
$SET (IB.INT,,INTVEC) ; Interrupt system base
$SET (IB.OUT,,T%TTY) ; Global TTY handling routine
$SET (IB.PIB,,PIB) ; Address of PSI block
$SET (IB.FLG,IP.STP,1) ; Send stopcodes to ORION
$EOB
PIB: $BUILD PB.MXS ; PSI information block
$SET (PB.HDR,PB.LEN,PB.MNS) ; Length of block is standard
$SET (PB.FLG,IP.PSI,1) ; PSI notification of IPCF message
$SET (PB.INT,IP.CHN,0) ; Use PSI channel 0
$SET (PB.FLG,IP.RSE,1) ; Return send errors immediately
$SET (PB.NAM,FWMASK,SUBNAM) ; Set name to be
$EOB
PRSBLK: $BUILD PAR.SZ ; PARSER argument block
$SET (PAR.TB,,PB$INI##) ; Top level parser data block
$SET (PAR.PM,,PROMPT) ; Program prompt string
$EOB
PRSNOD: $BUILD PAR.SZ ; PARSER argument block
$SET (PAR.TB,,PB$NOD##) ; Top level parser data block
$SET (PAR.PM,,PROMP2) ; Program prompt string
$EOB
SUBTTL Database definitions -- Dispatch Table for Command Keywords
CMDDSP: $STAB
XWD CMDEXT##,EXIT. ; EXIT Command
XWD CMDHLP##,HELP ; HELP Command
XWD CMDSUB##,SUBMIT ; SUBMIT Command
$ETAB
CMDLEN==.-CMDDSP
SUBTTL Database definitions -- Dispatch Table for Switch Keywords
SWTDSP: $STAB
XWD KYAFT##,AFTER ; /AFTER
; XWD KYBLG##,BATLOG ; /BATCH-LOG
XWD KYJNM##,JOBNAM ; /JOBNAME
XWD KYNTB##,NOTAB ; /NOTAB
XWD KYNTR##,NOTRAN ; /NOTRANSLATE
; XWD KYOUT##,OUTPUT ; /OUTPUT
XWD KYPRI##,PRIOR ; /PRIORITY
XWD KYNOD##,PRONOD ; /PROCESSING-NODE
XWD KYREC##,RECORD ; /RECORD
XWD KYRES##,RESTAR ; /RESTARTABLE
XWD KYTAB##,TAB ; /TAB
XWD KYTIM##,TIME ; /TIME
XWD KYTRN##,TRANS ; /TRANSLATE
XWD KYUNI##,UNIQUE ; /UNIQUE
$ETAB
SWTLEN==.-SWTDSP
SUBTTL Database definitions -- Interrupt system database
TOPS10 <
VECTOR: BLOCK 0 ; Start of interrupt vectors
VECIPC: BLOCK 4 ; IPCF vectors
ENDVEC==.-1 ; Symbol marking last vector
>;End if TOPS10
TOPS20 <
LEVTAB: EXP LEV1PC ; Where to store level 1 PC
EXP LEV2PC ; Where to store level 2 PC
EXP LEV3PC ; Where to store level 3 PC
CHNTAB: XWD 1,INTIPC ; IPCF interrupt on level 1, channel 0
BLOCK ^D35 ; Rest of table
LEV1PC: EXP 0 ; Level 1 PC
LEV2PC: EXP 0 ; Level 2 PC
LEV3PC: EXP 0 ; Level 3 PC
>;End if TOPS20
SUBTTL Interrupt code -- INTINI, Interrupt system initialization
; Here to initialize interrupt system
TOPS10 <
INTINI: MOVEI S1,INTIPC ; Address of IPCF interrupt routine
MOVEM S1,VECIPC+.PSVNP ; Save it in the vector
$RETT ; Return true always
>;End if TOPS10
TOPS20 <
INTINI: MOVX S1,.FHSLF ; Get fork handle
MOVX S2,1B0 ; Set channel 0
AIC ; Activate interrupt channels
$RETT ; Return
>;End if TOPS20
SUBTTL Interrupt code -- INTIPC, IPCF Interrupt routine
INTIPC: $BGINT 1, ; Set up interrupt context
$CALL C%INTR ; Call GLXLIB routine to post interrupt
$DEBRK ; Exit interrupt
SUBTTL Interrupt code -- INTDEC, DECnet Interrupt routine
INTDEC: $BGINT 1, ; Set up interrupt context
$DEBRK ; Exit interrupt
SUBTTL SNASUB -- Initialization code
SNASUB: RESET ; Clear out I/O system in case of start
MOVE P,[IOWD PDSIZE,PDL] ; Load stack pointer with initial value
MOVEI S1,IB.SZ ; Put size of initialization
MOVEI S2,IB ; block and address in argument regs
$CALL I%INIT ; and initialize GLXLIB
MOVEI S1,<LOWEND-LOWBEG> ; Get size of area to be zeroed
MOVEI S2,LOWBEG ; and start address
$CALL .ZCHNK ; and call GLXLIB routine to do it
SETZB S1,S2 ; No arguments
$CALL P$INIT## ; Initialize parser
$CALL INTINI ; Initialize interrupt system
$CALL OPDINI ; Get operating system information
$CALL I%ION ; Turn on interrupts
$CALL M%GPAG ; Get a page for create messages
MOVE J,S1 ; Keep address in "J"
JRST MAIN ; Start main loop
SUBTTL SNASUB -- Main processing loop
MAIN: $CALL INIQRQ ;Initialize for queue request
SETZM FPINF ;Reset File Parameter Word
SETZM PNINF ; and the Processing Node Word
MOVEI S1,PAR.SZ ;Size of the argument block
MOVEI S2,PRSBLK ;Address of the parser argument block
$CALL PARSER## ;Call the parser
JUMPF [MOVE S1,PRT.EM(S2) ;Address of error message
$CALL K%SOUT## ;Print it out
JRST MAIN] ;Try again
MOVE S1,PRT.CM(S2) ;Address of command block
ADDI S1,COM.SZ ;Skip header
$CALL P$SETU## ;Set up to process parsed command.
$CALL P$KEYW## ;Get the first keyword
JUMPF BADCMD ;Bad command
MOVEI S2,CMDDSP ;Point to dispatch table
$CALL DISPAT ;Go dispatch to process command
JUMPF MAIN ;If error, try again
$CALL SNDQUE
MAIN.1: MOVEI S1,^D30 ; Wait for ACK
$CALL I%SLP##
$CALL MSGCHK
JUMPF MAIN.1
JRST MAIN
BADCMD:
MOVEI S1,[ASCIZ /?Illegal command/]
$CALL K%SOUT## ; Print it out
JRST MAIN
SUBTTL Command Processors -- EXIT - Process EXIT Command
EXIT.:
$CALL I%EXIT##
$RET
SUBTTL Command Processors -- HELP - Process HELP Command
HELP:
$RET
SUBTTL Command Processors -- SUBMIT - Process SUBMIT Command
SUBMIT:
MOVEI S1,FDBARE+1 ; Address of FD
HRLI S1,(POINT 7) ; Make a pointer
MOVEM S1,TEXTBP ; Save for $TEXT
$CALL P$IFIL## ; Try for local file
JUMPF SUB0.1 ; Not that, try FIELD
JRST SUB2.1 ; Go for next field
SUB0.1: $CALL P$FLD## ; Try for FIELD
JUMPF SUBERR ; Not that, that's an error
$TEXT (DEPBP,^T/1(S1)/"^A) ; OK, move node name to FD
SUB1.1: $CALL P$QSTR## ; Go for quoted string
JUMPT SUB1.2 ; Looks good
$TEXT (DEPBP,"::^A) ; Not there, just a node terminator
SKIPA
SUB1.2: $TEXT (DEPBP,^T/1(S1)/"::^A)
$CALL P$TOK## ; Pick up double colon
$CALL P$IFIL## ; Look for a file
JUMPT SUB2.1 ; Found it
$CALL P$FLD## ; Not a FILE, try a FIELD
JUMPF SUBERR ; Not that, therefore an error
SUB2.1: $TEXT (DEPBP,^T/1(S1)/^0) ; Add to FD
;
; Pick up file name to use as jobname
;
MOVEI T1,1(S1) ; Point to file string
HRLI T1,(POINT 7) ; Make a real pointer
MOVE S1,T1 ; Keep original pointer in S1
SUB2.2: ILDB T2,T1
CAIN T2,":" ; Is it device terminator
MOVE S1,T1 ; Yes, keep pointer
CAIN T2,">" ; Is it directory terminator
MOVE S1,T1 ; Yes, keep pointer
CAIN T2,"]" ; Is it this directory terminator
MOVE S1,T1 ; Yes, keep pointer
JUMPN T2,SUB2.2 ; No, keep looking
$CALL S%SIXB## ; Get a SIXBIT string
MOVE T2,S2 ; SIXBIT value to block
MOVE T1,[XWD 2,.QCJBN] ; Block header
MOVEI S1,T1 ; Point to block
$CALL INSENT ; Insert it as an entry
JUMPF .POPJ ; Propagate error if we cannot
HRRZ T1,TEXTBP ; Current pointer
SUBI T1,FDBARE-1 ; Get length of block used
MOVEI S2,.QCFIL ; Get entry code
HRL S2,T1 ; and length
MOVEM S2,FDBARE ; Store in FDB
MOVEI S1,FDBARE ; Point to FDB
$CALL INSENT ; Insert it as an entry
JUMPF .POPJ ; Propagate error if we cannot
SUB3.1: $CALL P$SWIT## ; Get a switch
JUMPF SUB4.1 ; All done
MOVEI S2,SWTDSP ; Point to dispatch table
$CALL DISPAT ; Process switch
JUMPF SUBERR ; Failed
JRST SUB3.1 ; Look for more switches
SUB4.1: SKIPE PNINF ; /PROCESSING-NODE specified?
$RETT ; Yes, all done.
; No, force one.
SUB4.2: MOVEI S1,PAR.SZ ;Size of the argument block
MOVEI S2,PRSNOD ;Address of the parser argument block
$CALL PARSER## ;Call the parser
JUMPF [MOVE S1,PRT.EM(S2) ;Address of error message
$CALL K%SOUT## ;Print it out
JRST SUB4.2] ;Try again
MOVE S1,PRT.CM(S2) ;Address of command block
ADDI S1,COM.SZ ;Skip header
$CALL P$SETU## ;Set up to process parsed command.
$CALL PRONOD
JUMPF SUBERR ; Failed
$RETT
SUBERR:
$RETF
SUBTTL Switch Processors -- AFTER - Process /AFTER Switch
AFTER:
$CALL P$TIME## ; Get time field
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCAFT] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- BATLOG - Process /BATCH-LOG Switch
BATLOG:
$CALL P$KEYW## ; Get keyword
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCBLT] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- JOBNAM - Process /JOBNAME Switch
JOBNAM:
$CALL P$SIXF## ; Get SIXBIT field
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCJBN] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- NOTAB - Process /NOTAB Switch
NOTAB:
; No special processing required
;
$RET
SUBTTL Switch Processors -- NOTRAN - Process /NOTRANSLATE Switch
NOTRAN:
MOVE T2,FPINF ; Get previous FP values
TXO T2,FP.NXL!FP.TAB ; Set flags (NXL implies TAB, too)
MOVEM T2,FPINF ; Save updated FP
MOVE T1,[XWD 2,.QCSNA] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- OUTPUT - Process /OUTPUT Switch
OUTPUT:
$CALL P$KEYW## ; Get keyword
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCLOG] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- PRIOR - Process /PRIORITY Switch
PRIOR:
$CALL P$NUM## ; Get number
JUMPF .POPJ ; Propagate error
ANDI S1,77 ; Keep it in range
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCPRI] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- PRONOD - Process /PROCESSING-NODE Switch
PRONOD:
$CALL P$NODE## ; Get node name
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCNOD] ; Block header
MOVEI S1,T1 ; Point to block
SETOM PNINF ; Flag that we have one
PJRST INSENT
SUBTTL Switch Processors -- RECORD - Process /RECORD Switch
RECORD:
$CALL P$NUM## ; Get number
JUMPF .POPJ ; Propagate error
STORE S2,FPINF,FP.RCL ; Store record len in FP block
MOVE T2,FPINF ; Get FP values
MOVE T1,[XWD 2,.QCSNA] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- RESTAR - Process /RESTARTABLE Switch
RESTAR:
$CALL P$KEYW## ; Get keyword
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCRES] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- TAB - Process /TAB Switch
TAB:
MOVE T2,FPINF ; Get previous FP values
TXO T2,FP.TAB ; Set flag
MOVEM T2,FPINF ; Save updated FP
MOVE T1,[XWD 2,.QCSNA] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- TIME - Process /TIME Switch
TIME:
$CALL P$TIME## ; Get time field
JUMPF .POPJ ; Propagate error
MOVE S2,S1 ; Save in AC2
SETZM T2 ; Clear AC4
ODCNV ; Convert to local time
HRRZ T2,T2 ; Pick up time
MOVE T1,[XWD 2,.QCLIM] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL Switch Processors -- TRANS - Process /TRANSLATE Switch
TRANS:
; No special processing required
;
$RET
SUBTTL Switch Processors -- UNIQUE - Process /UNIQUE Switch
UNIQUE:
$CALL P$KEYW## ; Get keyword
JUMPF .POPJ ; Propagate error
MOVE T2,S1 ; Save it
MOVE T1,[XWD 2,.QCUNI] ; Block header
MOVEI S1,T1 ; Point to block
PJRST INSENT
SUBTTL IPCF Message Handling -- MSGCHK, message checker
; Routine - MSGCHK
;
; Function - This is a special purpose task executed by the MAIN routine.
; For each IPCF message that exists the routine MSGPRC is called.
; If any message processing routine causes the change in state
; of a task the flag SCHDGO is set. After each message is processed
; the current time NOW is updated.
;
; Returns - always
;
; NOW/ Most current time
; SCHDGO/ Turned on if any task state is changed
MSGCHK: $CALL C%RECV ; Get the next IPCF message
JUMPF .POPJ ; If none .. just return
$CALL MSGPRC ; Process this message
$CALL C%REL ; Now, .. release it
$RETT
SUBTTL IPCF Message Handling -- MSGPRC, IPCF message processor
; Routine - MSGPRC
;
; Function - This subroutine processes IPCF messages received from QUASAR
; and ORION. MSGPRC determines if message is from someone it knows,
; and then dispatches to the proper message processing routine.
;
; Upon entry, S1 has the address of the Message Data Block (MDB) for the
; message. When this routine dispatches to the message processors, P1
; will have the address of the message and S will have flags indicating
; what type of program sent the message, whether or not it is for
; HASP line, etc.
MSGPRC: MOVEM S1,MDBADR ; Store message data block address
MOVE S2,MDB.SI(S1) ; Get special index word
SETZ S, ; Clear flags
TXZN S2,SI.FLG ; Are we using special system index?
$RET ; No, don't process it
TXO S,F.IPCSY ; Indicate we have a system message
CAIE S2,SP.OPR ; It better be ORION
CAIN S2,SP.QSR ; or QUASAR
JRST MSGPR1 ; Yes, go process it
$WTOJ <Bad IPCF message>,<Message received from unknown system component (^O/S2/)>,OBJBLK
$RET ; Return to main loop after error
; Here after checking system message source
MSGPR1: LOAD P1,MDB.MS(S1),MD.ADR ; Get address of message
CAIE S2,SP.OPR ; save name of sender
SKIPA S1,[[ASCIZ /QUASAR/]]
MOVEI S1,[ASCIZ /ORION/]
MOVEM S1,MSNDR
LOAD S1,.MSTYP(P1),MS.TYP ; Get message type
MOVSI S2,-NMSGT ; Make AOBJN pointer for table
; Loop to scan MSGTAB for processing routine for this message
MSGPR2: HRRZ T1,MSGTAB(S2) ; Get message type from current entry
CAMN T1,S1 ; Is it the same as our message?
JRST MSGPR3 ; Yes, go process it
AOBJN S2,MSGPR2 ; No keep looking
$WTOJ <Bad IPCF message>,<Message received from ^T/@MSNDR/ with unknown type code (^O/S1/)>,OBJBLK
$RET ; Return to main loop
; Here when we have found MSGTAB entry for this message type
MSGPR3: HLRZ T2,MSGTAB(S2) ; Get entry vector address for msg type
JUMPE T2,.POPJ ; If no vector, ignore message
MOVE T2,@T2 ; Get contents of vector
TXNE S,F.IPCSY ; Are we processing system request?
MOVS T2,T2 ; Yes, swap vector
HRRZ T2,T2 ; Clear out inappropriate half
JUMPN T2,@T2 ; If we still have an address, go to it
$WTOJ <Invalid IPCF message type>,<"^T/MSGTNM(S2)/" message received from ^T/@MSNDR/ not valid for this component type>,OBJBLK
$RET ; Return to main loop after error
; Table of type,,entry vector for message process dispatch
; Entry vector points to a word that contains dispatch addresses:
; system-message-routine,,non-system-message-routine
MSGTAB: XWD 0,.QOSUP ; Setup/shutdown message
XWD 0,.QOABO ; User cancel
XWD 0,.QONEX ; Nextjob
XWD 0,.OMCAN ; Operator cancel
XWD 0,.OMSND ; Send console message to IBM
XWD 0,.OMSHS ; ORION show status command
XWD 0,.QORCK ; Request for a checkpoint
XWD TEXTMS,MT.TXT ; Text message
XWD 0,.OMPAU ; Stop message
XWD 0,.OMCON ; Continue message
XWD 0,.OMREQ ; Requeue message
XWD 0,.OMSHP ; ORION show parameters command
NMSGT==.-MSGTAB ; Size of table
MSGTNM: ASCIZ \Setup/shutdown\
ASCIZ /User cancel/
ASCIZ /Nextjob/
ASCIZ /Operator cancel/
ASCIZ /Send console message to IBM/
ASCIZ /ORION show status command/
ASCIZ /Request for a checkpoint/
ASCIZ /Text/
ASCIZ /Stop/
ASCIZ /Continue/
ASCIZ /Requeue/
ASCIZ /ORION show parameters command/
SUBTTL IPCF Message Handling -- TEXTMS, Text message response
; Routine - TEXTMS
;
; Function - To send a text IPCF message that IBMSPL has received to
; OPR.
; P1/QUASAR message ptr
TEXTMS: XWD TEXTM1,TEXTM1
TEXTM1:
MOVEI S1,.OHDRS+ARG.DA(P1) ; Start of data message
$CALL K%SOUT ; Print it out
$RET ; Return to main loop
SUBTTL Subroutines -- Initialization and Main Loop subroutines
SUBTTL Subroutines -- . OPDINI, Get operating system information
; Routine - OPDINI
;
; Function - Gets central site node number, monitor name and (if 20) the
; directory number for PS:<SPOOL>.
;
; Parameters - None
;
; Returns - True always
; CNTSTR is set to node number
; CNF is set to monitor name
; SPLDIR is set to PS:<SPOOL> directory number if TOPS20
;
; Note - Destroys T1-T3
COMMENT &
This routine is operating system dependent. For TOPS-10 it gets the
name of the monitor, and then the station number of the central site.
For TOPS-20 it zeros the station number, gets the monitor name, gets
the directory number for PS:<SPOOL> and finally issues MSTR to allow
structure access without prior mount.
&
OPDINI: ;operating system dependent
; initialization
TOPS10 <
CNFDSP==(%CNFG0) ;get displacement
CNFDSP==CNFDSP&RHMASK ; of first word in table
MOVE T3,[XWD -SYSNML,CNFDSP] ;LH=number of words to get,
; RH=first index for GETTAB
OPDIN1: MOVEI T2,.GTCNF ;get table number in RH
HRL T2,T3 ;get current index in LH
GETTAB T2, ;get that word into T2
SETZ T2, ;no GETTAB, no monitor name
MOVEM T2,CNF-CNFDSP(T3) ;put the word into the proper place in CNFG
; (the -CNFDSP is only necessary in
; case its value (now 0) changes
AOBJN T3,OPDIN1 ;loop control, index register advancement
; and index advancement for GETTAB
; in one instruction
MOVEI T1,.GTLOC ;table name for location
GETTAB T1, ;get central site number
SETZ T1, ;set to 0 if we don't have UUO
HRRZM T1,CNTSTA ;save it
>;End if TOPS10
TOPS20 <
SETZM CNTSTA ;set central site number to 0
MOVEI S1,NODNAM ;Make
HRLI S1,(POINT 7) ; a byte pointer
MOVEM S1,TEXTBP ; and save it for $TEXT
$CALL I%HOST ;Get Local Node Name
MOVEM S1,NODNA6 ;Save in SIXBIT
$TEXT (DEPBP,^W/NODNA6/^0) ; and in ASCIZ
MOVX S1,'SYSVER' ;get name of table
SYSGT ;convert into table number
HRLZ T1,S2 ;get table#,,0
MOVEI T2,SYSNML ;get number of words
OPDNI1: MOVS S1,T1 ;get n,,table#
GETAB ;get the entry
SETZ S1, ;use 0 if error
MOVEM S1,CNF(T1) ;store the result
CAILE T2,(T1) ;done enough?
AOJA T1,OPDNI1 ;no, go back for more
>;End if TOPS20
$RETT ;always return true
SUBTTL Subroutines -- . DISPAT, Dispatch table processing
; S1 contains code to look for
; S2 contains dispatch table address
DISPAT:
HLRZ T1,(S2) ; Get actual number of table entries
MOVN T1,T1 ; We want the negative number
HRL S2,T1 ; to make an AOBJN pointer
DISP.0: HLRZ T2,1(S2) ; T2 contains code to match
HRRZ T3,1(S2) ; T3 contains dispatch address
CAMN S1,T2 ; A match?
PJRST (T3) ; Yes, go process it
AOBJN S2,DISP.0 ; No, keep looking
$RETF ; No match
SUBTTL Subroutines -- Queue create message handling
SUBTTL Subroutines -- . INIQRQ, Initialize queue request to default
; Routine - INIQRQ
;
; Function - Puts default entries into queue request page (short create msg);
; can only be called from task level.
;
; Parameters - none
;
; Returns - False if INIPAG or INSENT fails, True otherwise
; S1/ ptr to fdb in queue create msg for random file namme
;
; Note - Destroys S2
; Changes queue request page for task
INIQRQ: ;here to initialize queue request page
$SAVE <T1,T2,T3>
SETZM 0(J) ;zero first word of page
MOVEI S1,1(J) ;get destination for BLT pointer
HRL S1,J ;and source
BLT S1,777(J) ;zero whole page
MOVE T1,[XWD 2,.QCQUE] ;get beginning of queue type entry
MOVX T2,.OTBAT ;get queue object type
MOVEI S1,T1 ;point to it
$CALL INSENT ;store it
JUMPF .POPJ ;propagate error if there is one
MOVE T1,[XWD 2,.QCBLT] ; Force
MOVEI T2,%BSPOL ; /BATCH-LOG:SPOOL
MOVEI S1,T1 ; Point to block
$CALL INSENT ; Insert it as an entry
JUMPF .POPJ ; Propagate error if we cannot
MOVE T1,[XWD 2,.QCLOG] ; Force
MOVEI T2,%EQONL ; /OUTPUT:NOLOG
MOVEI S1,T1 ; Point to block
$CALL INSENT ; Insert it as an entry
JUMPF .POPJ ; Propagate error if we cannot
$RET ;pass on either failure or success
SUBTTL Subroutines -- . INSENT, Insert entry
; Routine - INSENT
;
; Function - Inserts entry into queue create message, deleting a previous
; one if there (unless NODEL set in S).
;
; Parameters - S1/ address of queue create message entry
;
; Returns - False if no room in page, S1/0
; true otherwise, S1/ Address of inserted entry
;
; Note - Destroy S2
; Changes task's queue create message page
INSENT:: ;insert entry into queue create message
$SAVE <P1,P2,P3,P4,S> ;save registers
LOAD S2,0(S1),RHMASK ;get type code of new entry
MOVEI P1,CQBEG(J) ;get address of first entry
MOVE P2,CQARGN(J) ; and number of entries
JUMPE P2,INSADD ;if there are none, just add this one
SETZ P4, ;zero eventual pointer to matching entry
INSEN0: ;loop looking for a matching entry
LOAD P3,0(P1),RHMASK ;get type of current entry
CAMN P3,S2 ;is it the same as the one we are looking for?
MOVE P4,P1 ;yes, save its address
LOAD P3,0(P1),LHMASK ;get length of this entry
ADD P1,P3 ;point to next entry
SOJG P2,INSEN0 ;loop through all entries
JUMPE P4,INSADD ;if no match, add to end
TXNE S,NODEL ;is no-delete bit set?
JRST INSADD ;yes, go add to end
MOVE S2,0(P4) ;get length,,type of old entry
CAME S2,0(S1) ;compare with new entry
JRST INSDEL ;if not same length, must go delete it
HLRZ S2,S2 ;get length by itself
ADDI S2,-1(P4) ;get address of last word in RH of S2
HRL P4,S1 ;make BLT pointer (source,,dest)
HRRZ S1,P4 ;save destination for return to caller
BLT P4,0(S2) ;copy into existing slot
$RETT
INSDEL: ;here to delete an existing entry
HLRZS P3,S2 ;get length of old entry and save a copy
ADD S2,P4 ;point to next entry
HRL P4,S2 ;make BLT pointer next,,this
MOVE S2,P1 ;get pointer to end of block
SUBI S2,1(P3) ;make into last word to be transferred
BLT P4,0(S2) ;move other entries down
MOVEI P1,1(S2) ;point to next slot free
SETZM (P1) ; make sure the end is zero
SOS CQARGN(J) ;decrement argument count because we just
; deleted it
INSADD: ;here to add this entry to the end of the list
MOVE P3,P1 ;copy end of block address
LOAD P2,0(S1),LHMASK ;get length
JUMPE P2,.RETT ;if zero length, just exit
ADD P1,P2 ;new end point
CAIL P1,777(J) ;off the end of the page?
JRST [SETZ S1, ;yes, return error
$RETF]
AOS CQARGN(J) ;no, we now have one more argument
HRL P3,S1 ;make BLT pointer
HRRZ S1,P3 ;save destination for return to caller
BLT P3,-1(P1) ;copy new entry
SETZM (P1) ; make sure end is zero
$RETT ;give success return
SUBTTL Subroutines -- . FNDENT, Find entry
; Routine - FNDENT
;
; Function - Scans queue create message page for a particular entry type.
;
; Parameters - T2/ Entry code for which to search.
;
; Returns - True if found, false if not.
; S1/ Address of block containing entry
;
FNDENT::$SAVE <S2,T1> ;subroutine to find queue create entry
MOVEI S1,CQBEG(J) ;point to first entry address
FNDEN0: ;loop to look at an entry
HLRZ S2,0(S1) ;get length of this entry
JUMPE S2,.RETF ;if zero, we didn't find it
HRRZ T1,0(S1) ;get type code of entry
CAMN T1,T2 ;is it the one we want
$RETT ;yes, return with address in S1
ADD S1,S2 ;no, point to next entry
JRST FNDEN0 ;and try again
SUBTTL Subroutines -- . SNDQUE, send queue info to QUASAR
; Routine - SNDQUE
;
; Function - send queue info to QUASAR
;
; Parameters - J -> queue request page
;
; Returns - results of SNDQSR - caller must decide what to do about failure
SNDQUE: ;subroutine to send queue create
; to QUASAR
MOVEI S1,.QOCQE
STORE S1,.MSTYP(J),MS.TYP
MOVE S1,WTORNM ; Get ACK code
STORE S1,.MSCOD(J) ; Save in message
AOS WTORNM ; Increment for next time
MOVX S1,MF.ACK ; We want an ACK
STORE S1,.MSFLG(J) ; So set it in flags
MOVEI S1,CQBEG(J)
SNDQU0: HLRZ S2,0(S1)
JUMPE S2,SNDQU1
ADD S1,S2
JRST SNDQU0
SNDQU1: SUBI S1,0(J)
STORE S1,.MSTYP(J),MS.CNT ; Save count
SNDQU2: MOVE T1,J ; Point to message
$CALL SNDQSR ; and send it to QUASAR
JUMPT .RETT ; did it!
HRROI S1,[ASCIZ \SNASUB sleep - waiting for QUASAR to start
\]
$CALL K%SOUT ; tell the user
MOVEI S1,^D30 ; still hoping for the best
$CALL MISLP ; retire a while
JRST SNDQU2 ; and try again
SUBTTL Subroutines -- IPCF message subroutines
SUBTTL Subroutines -- . SNDQSR, send a message to QUASAR
; Routine - SNDQSR
;
; Function - Gets system index flag, puts QUASAR's index in, puts length
; and address of message in, and calls C%SEND to send message
;
; Parameters - T1/ Address of message
;
; Returns - true if send succeeds
; false if not, S1/C%SEND error code
;
; Note - Destroys S1, S2
; Changes SAB (send argument block for C%SEND)
COMMENT &
This subroutine fills in the send argument block with the
appropriate information for sending a message to QUASAR
and calls the GLXLIB routine C%SEND to send iT.
We can have a single send argument block only one task (or
the scheduler) can run at a time and whatever is running cannot
be interrupted until it does a $DSCHD.
&
SNDOPR: SKIPA S1,[SP.OPR] ;here to send message to ORION
SNDQSR: ;here to send message to QUASAR
MOVX S1,SP.QSR ;get QUASAR's system PID index
TXO S1,SI.FLG ; and turn on flag to indicate we
; are using system PIDs
STORE S1,SAB+SAB.SI ;store in system index word of send
; argument block
SETZM SAB+SAB.PD ;clear the destination PID word
LOAD S1,.MSTYP(T1),MS.CNT ;get length of message from the header
STORE S1,SAB+SAB.LN ;and store in length word
STORE T1,SAB+SAB.MS ;store message address also
MOVEI S1,SAB.SZ ;put length of send argument block into
; parameter register
MOVEI S2,SAB ;and its address
$CALL C%SEND ;call GLXLIB routine to send message
$RET ; return results of C%SEND
QSRDTH: $STOP SQF,<Send to QUASAR failed> ; SNDQSR users can come here to die
; when they cannot tolerate failure
SUBTTL Subroutines -- . MISLP, sleep for specified time
; Routine - MISLP
;
; Function - sleep for a specified amount of time
;
; Parameters - S1/no. of seconds
;
; RETURNS - TRUE always
MISLP: IMULI S1,3 ;sleep for a while in spite of interrupts
PUSH P,S1
$CALL I%NOW ; get now
ADDM S1,(P) ; keep wake time on pdl
MISLP1: $CALL I%NOW ; get new now
SUB S1,(P) ; find out how long to go
MOVNS S1 ; forwards
JUMPLE S1,MISLPX ; done
IDIVI S1,3 ; make seconds
SKIPE S2
AOS S1 ; at least 1
$CALL I%SLP ; try to sleep the whole time
JRST MISLP1
MISLPX: POP P,S1 ; time to awake
$RETT
SUBTTL Literals
SUBLIT: XLIST
LIT
LIST
SUBEND:
END SNASUB
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; Comment Begin:;
; Word Abbrev Mode:1
; End: