Trailing-Edge
-
PDP-10 Archives
-
BB-J724A-SM_1980
-
sources/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
;<DN65-DEVELOPMENT>D60JSY.MAC.59, 28-Jan-80 11:07:32, Edit by JENNESS
; [207] Remove superfluous LC.CTR command in D60CND
;<DN65-DEVELOPMENT>, 26-Jan-80 11:53:06, Edit by JENNESS
; [206] Fix bug in D60STS line status routine that didn't return
; D6LGA error (just returned error code 3: reject).
;<DN65-DEVELOPMENT>D60JSY.MAC.55, 17-Dec-79 13:17:20, Edit by JENNESS
; [205] Change to a better 2020 test routine than checking serial number.
;<DN65-DEVELOPMENT>D60JSY.MAC.6, 4-Dec-79 13:35:42, Edit by JENNESS
; [204] Fix up code to do proper termination signon validation
;<DN65-DEVELOPMENT>D60JSY.MAC.3, 18-Oct-79 15:19:52, Edit by JENNESS
; [203] Decouple D60UNV from D60JSY because of QSRMAC deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.2, 9-Oct-79 14:26:28, Edit by JENNESS
; [202] Add code in D60CND to support transparent transmission enabling
; for HASP lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.256, 7-Sep-79 10:19:19, Edit by JENNESS
; [201] Remove edit 175 .. the BOOT JSYS has been fixed.
;<DN65-DEVELOPMENT>D60JSY.MAC.252, 4-Sep-79 15:29:44, Edit by JENNESS
; [200] Remove CONLY conditionals, remove QSRMAC symbol conflicts.
;<DN65-DEVELOPMENT>D60JSY.MAC.250, 4-Sep-79 13:50:44, Edit by JENNESS
; [177] Change arg block to condition call again .. make it QUASAR setup block.
;<DN65-DEVELOPMENT>D60JSY.MAC.249, 15-Aug-79 09:43:42, Edit by JENNESS
; [176] Change D6DNU error so that IBMSPL can turn it off in NBIO.
;<DN65-DEVELOPMENT>D60JSY.MAC.248, 14-Aug-79 09:17:23, Edit by JENNESS
; [175] Change 2020 read routine to do it's own byte pointer updating,
; the BOOT JSYS doesn't do it.
;<DN65-DEVELOPMENT>D60JSY.MAC.247, 16-Jul-79 14:11:56, Edit by JENNESS
; [174] Add external HOOKing code, gives access to guts of this package.
;<DN65-DEVELOPMENT>D60JSY.MAC.246, 11-Jul-79 16:17:53, Edit by JENNESS
; [173] Give D6DNU (DSR not up) on D60OPN call at appropriate times.
;<DN65-DEVELOPMENT>D60JSY.MAC.244, 5-Jul-79 15:28:28, Edit by JENNESS
; [172] Give reject error code when DN6x gives no bytes read with success code.
;<DN65-DEVELOPMENT>D60JSY.MAC.240, 2-Jul-79 16:25:45, Edit by JENNESS
; [171] Fix another dumb bug in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.238, 29-Jun-79 13:58:07, Edit by JENNESS
; [170] Another fix for 2780/3780 input/output deadlock race on input EOF.
;<DN65-DEVELOPMENT>D60JSY.MAC.237, 29-Jun-79 13:22:48, Edit by JENNESS
; [167] Typo fix in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:04:39, Edit by JENNESS
; [166] Change the ERRS macro to give DDT type out of the error values.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:00:27, Edit by JENNESS
; [165] Fix REQOUT to relieve the lost output grant.
;<DN65-DEVELOPMENT>D60JSY.MAC.233, 28-Jun-79 17:59:05, Edit by JENNESS
; [164] Fix to stop deadlock interaction between console and LPT under 3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.231, 26-Jun-79 09:00:59, Edit by JENNESS
; [163] Swap the line signature and line driver type in line status, makes it
; easier for front end to clear an old LCB.
;<DN65-DEVELOPMENT>D60JSY.MAC.230, 25-Jun-79 16:24:37, Edit by JENNESS
; [162] Change last D6DOL in REQOUT to a D6CGO .. fixes console deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.229, 25-Jun-79 09:33:46, Edit by JENNESS
; [161] Another fix in edit 153 when DTE is already selected.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 21-Jun-79 10:41:06, Edit by JENNESS
; [160] Fix the horrible mess made when releasing devices on disabled lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.224, 21-Jun-79 08:53:45, Edit by JENNESS
; [157] Fix REQOUT to check for line gone away in DSRLP.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 19-Jun-79 09:43:59, Edit by JENNESS
; [156] Fix a problem in OPNFE caused by edit 153 when FEJFN already open.
;<DN65-DEVELOPMENT>D60JSY.MAC.223, 18-Jun-79 13:11:44, Edit by JENNESS
; [155] Change FEI%O for TOPS10 to use reentrant type C11BLKs.
;<DN65-DEVELOPMENT>D60JSY.MAC.222, 15-Jun-79 16:44:48, Edit by JENNESS
; [154] Fix a glaring error in SRCPDD that has been there forever.
;<DN65-DEVELOPMENT>D60JSY.MAC.221, 14-Jun-79 16:54:35, Edit by JENNESS
; [153] Change a little in OPNFE to jump to SELDTE if JFN already assigned.
;<DN65-DEVELOPMENT>D60JSY.MAC.220, 14-Jun-79 15:22:36, Edit by JENNESS
; [152] Add code to release all devices opened on a D60CND line disable.
;<DN65-DEVELOPMENT>D60JSY.MAC.211, 12-Jun-79 13:54:04, Edit by JENNESS
; [151] Add printx to output name, version and other sundries during assembly.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:37:27, Edit by JENNESS
; [150] Append line and device command strings to FEI%O arg block. Get rid of
; the ALC1WD and RLS1WD routines.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:36:40, Edit by JENNESS
; [147] Change the status string symbols so SWAPB and SWAP32 aren't needed.
;<DN65-DEVELOPMENT>D60JSY.MAC.208, 12-Jun-79 09:45:35, Edit by JENNESS
; [146] Move some more symbols into the D60JSY.UNV universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.206, 11-Jun-79 11:19:10, Edit by JENNESS
; [145] Fix a bug in D60SOUT (bad load) and add IOWAIT to SNOOZE in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.204, 8-Jun-79 09:40:54, Edit by JENNESS
; [144] Add return immediate code in FEI%O to stop blocking on console read.
;<DN65-DEVELOPMENT>D60JSY.MAC.203, 7-Jun-79 17:20:51, Edit by JENNESS
; [143] Change in REQIN to reduce the possibility of a race.
;<DN65-DEVELOPMENT>D60JSY.MAC.202, 7-Jun-79 15:33:57, Edit by JENNESS
; [142] Change status formats to reflect more frontend bullet proofing.
;<DN65-DEVELOPMENT>D60JSY.MAC.199, 7-Jun-79 10:55:08, Edit by JENNESS
; [141] Fix D60SOUT for errors that are appropriate the running flag is cleared
;<DN65-DEVELOPMENT>D60JSY.MAC.197, 7-Jun-79 10:36:37, Edit by JENNESS
; [140] Some fixes for line status failure and a D60RLS on dead lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.196, 7-Jun-79 09:37:23, Edit by JENNESS
; [137] Fix a problem in REQIN that failed it input was already running.
;<DN65-DEVELOPMENT>D60JSY.MAC.194, 6-Jun-79 16:42:57, Edit by JENNESS
; [136] Fix a bug in the DSR wait loop in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.193, 6-Jun-79 09:32:56, Edit by JENNESS
; [135] Add IOWAIT argument to the SNOOZE macro for task descheduling.
;<DN65-DEVELOPMENT>D60JSY.MAC.191, 4-Jun-79 09:21:51, Edit by JENNESS
; [134] Dump output buffers (in 11) if outputing to a console device.
;<DN65-DEVELOPMENT>D60JSY.MAC.187, 1-Jun-79 10:58:38, Edit by JENNESS
; [133] Add code to handle new line hardware abort checking.
;<DN65-DEVELOPMENT>D60JSY.MAC.184, 30-May-79 16:18:50, Edit by JENNESS
; [132] Don't clear aborts in REQIN/REQOUT, now only set for valid reasons.
;<DN65-DEVELOPMENT>D60JSY.MAC.183, 30-May-79 13:32:02, Edit by JENNESS
; [131] More fixes for device error handling and input/output deadlock.
;<DN65-DEVELOPMENT>D60JSY.MAC.176, 25-May-79 16:23:21, Edit by JENNESS
; [130] Handle aborts caused by line disconnection.
;<DN65-DEVELOPMENT>D60JSY.MAC.175, 24-May-79 15:14:16, Edit by JENNESS
; [127] Fix D60EOF and the line releasing code for 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:46, Edit by JENNESS
; [126] Fix D60OPN to properly handle errors on the device commands.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:22, Edit by JENNESS
; [125] Have found some more holes in the FE releasing.
;<DN65-DEVELOPMENT>D60JSY.MAC.168, 21-May-79 11:41:31, Edit by JENNESS
; [124] More fixes for properly releasing FE devices.
;<DN65-DEVELOPMENT>D60JSY.MAC.167, 21-May-79 09:38:50, Edit by JENNESS
; [123] Add structure block sizes in universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.165, 21-May-79 09:36:35, Edit by JENNESS
; [122] Another fix in REQOUT to release the line when input is coming.
;<DN65-DEVELOPMENT>D60JSY.MAC.161, 17-May-79 18:11:01, Edit by JENNESS
; [121] Fix so FE is properly released if DTE select fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.160, 16-May-79 11:21:33, Edit by JENNESS
; [120] Fix write routine to release FE for a second after lot of data output.
;<DN65-DEVELOPMENT>D60JSY.MAC.159, 16-May-79 11:11:28, Edit by JENNESS
; [117] Change ENQD60 to block until lock is gained. Gives higher lock hits.
;<DN65-DEVELOPMENT>D60JSY.MAC.157, 16-May-79 09:22:10, Edit by JENNESS
; [116] Remove copy code for 8 bit DDCMP buffer, now can handle real byte ptrs.
;<DN65-DEVELOPMENT>D60JSY.MAC.152, 14-May-79 14:51:26, Edit by JENNESS
; [115] Add line signature code.
;<DN65-DEVELOPMENT>D60JSY.MAC.146, 10-May-79 12:42:28, Edit by JENNESS
; [114] Fix so delays from the FE on line commands resend command correctly.
;<DN65-DEVELOPMENT>D60JSY.MAC.145, 10-May-79 11:17:39, Edit by JENNESS
; [113] Change location of $FELOG logging calls in FEI%O.
;<DN65-DEVELOPMENT>D60JSY.MAC.144, 10-May-79 10:20:00, Edit by JENNESS
; [112] Add require for FELOG when FTDEBUG switch is turned on.
;<DN65-DEVELOPMENT>D60JSY.MAC.143, 3-May-79 09:57:26, Edit by JENNESS
; [111] And yet another fix for the deadlock problem, release if REQOUT fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.141, 2-May-79 14:29:16, Edit by JENNESS
; [110] Another fix to stop input/output deadlocks on 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.140, 1-May-79 16:48:50, Edit by JENNESS
; [107] Increase retry counter for BOOT JSYS retry on input.
;<DN65-DEVELOPMENT>D60JSY.MAC.139, 1-May-79 16:33:52, Edit by JENNESS
; [106] Some code clean up, more on the abort problem, and really use D60CGO.
;<DN65-DEVELOPMENT>D60JSY.MAC.137, 30-Apr-79 12:57:04, Edit by JENNESS
; [105] Fix input request code to block less and add better errors to D60CND.
;<DN65-DEVELOPMENT>D60JSY.MAC.133, 25-Apr-79 16:18:22, Edit by JENNESS
; [104] Put in error checks after device and line status calls.
;<DN65-DEVELOPMENT>D60JSY.MAC.129, 25-Apr-79 13:47:32, Edit by JENNESS
; [103] Fix so that the line isn't released if the device goes off line.
;<DN65-DEVELOPMENT>D60JSY.MAC.127, 25-Apr-79 08:25:46, Edit by JENNESS
; [102] Add device command in D60OPN to do space compression.
;<DN65-DEVELOPMENT>D60JSY.MAC.124, 24-Apr-79 14:39:33, Edit by JENNESS
; [101] Add code to ENQ/DEQ line for 2780/3780 so only 1 device can be active
; at a time.
; D60JSY - Interface package for DN62/DN65 Galaxy IBM spooling system
;
;
; COPYRIGHT (c) 1979, 1980
; 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.
;
; TITLE D60JSY DN62/DN65 interface to GALAXY spooling components.
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 QSRMAC ; Symbols for setup message
SEARCH ORNMAC ; Symbols to talk to ORION
SEARCH D60UNV ; Search for linkage symbols
PROLOGUE (D60JSY) ; Initialize Galaxy symbol definitions
; Version
XP D60VER, 3 ; Major version number
XP D60MIN, 0 ; Minor version number
XP D60EDT, 207 ; Edit level
XP D60WHO, 0 ; Who did last edit (0=DEC)
; Conditional assembly flags.
ND FTDEBUG, 0 ; If on .. then generate debuging code
ND FTNDNU, 0 ; Normally give the D6DNU error.
IFN FTDEBUG,<.REQUIRE FELOG> ; Get CAL11. logger if debugging
; Version
%%.D60=:<VRSN. (D60)> ; Set value of edit level/version
; Print information to log during compilation
Define VOUTX ($S1,$S2,$S3,$S4)
<TITLE $S1 $S2'$S3'('$S4')
PRINTX $S1 $S2'$S3'('$S4')>
IF1,<
IFN <D60MIN>,<VOUTX (D60JSY interface package,\D60VER,\"<"A"+D60MIN>,\D60EDT)>
IFE <D60MIN>,<VOUTX (D60JSY interface package,\D60VER,,\D60EDT)>
IFN <FTDEBUG>,<PRINTX Debug code enabled.>
.IF SNOOZE,MACRO,<PRINTX External SNOOZE macro definition being used.>
.IF HOOK,MACRO,<PRINTX External HOOK has been defined.
HOOK ; Invoke the HOOK
> ;End if HOOK defined
> ;End IF1
IF2,<Printx Pass 2.>
SUBTTL Misc. definitions
; Warning: do not change timing values untill all error paths have been
; thoroughly checked.
XP SEC, ^d1000 ; 1000 milliseconds in a second
XP TIMOFF, ^d3 ; Time off to wait for 11 to be freed
XP TIMDLY, ^d1 ; Time waiting for delayed to clear
XP TIMSTS, ^d2 ; Time waiting on delayed status
XP OFLDFL, ^d10 ; Default number of delay to offline
XP RQREP, ^d12 ; Times to check input permission req
XP RQTIM, ^d1 ; Sleep time between input per req chk
XP SONREP, ^d60 ; One minute of signon input timeout
XP RQOTIM, ^d30 ; Number of seconds to wait for DSR
XP SOTDLY, ^d1 ; Sleep time between output grant chks
XP RQDTRY, ^d10 ; Times to chk after output req. drops
XP TIMDSR, ^d1500 ; Time to wait between DSR check (ms)
XP DTEOFF, 10 ; Offset from port number to DTE number
XP MAXDTE, 13 ; Maximum DTE number
XP MAXFE, 15 ; Maximum number of FE's on system
XP MXNHSP, 5 ; Maximum device type on 2780/3780
XP MXHSP, 6 ; Maximum device type on HASP
XP MXUHSP, 4 ; Maximum unit number on HASP
XP HSPOFF, 20 ; HASP multiple device offset
XP RLSTHR, ^d2000 ; FE device transfer release threshold
SUBTTL Error symbol definitions
; Use the previously defined macros in D60JSY.UNV to set up the error symbol
; values.
D60ERR ; Invoke the error symbol macro
SUBTTL Macros -- ERT, Snooze
; Macro - ERT
;
; Function - To set an error code in S1 and jump to the specified exit vector.
;
; Parameters -
;
; $%ERR Error number (usually a D6xxx mnemonic)
; $%VEC Where to jump to after S1 is loaded with the error number
Define ERT ($%ERR,$%VEC)
<[MOVX S1,$%ERR ;; Load the error number to return
IFNB <$%VEC>,<SETZ TF, ;; Set success flag to failure (false)
JRST $%VEC> ;; If a jump vector given .. then jump there
IFB <$%VEC>,<JRST @.RETF> ;; else give a default of false return
]
> ;End of ERT definition
; Macro - Snooze
;
; Function - To put the process to sleep for the specified amount of time.
;
; Parameters -
;
; $%TIM # of milli-seconds to sleep
; $%DUM Dummy argument (used by externally defined SNOOZE's)
;
; Note -
;
; This macro is used to dismis the process because of a event wait. If
; the host program wishes to instead of sleeping reschedule an internal
; task this macro should be defined in a file that will prefix this one
; during assembly. This macro generates code that is non-skipable and
; will always preserve the intergrity of the registers.
.IFN SNOOZE,MACRO,<
Define SNOOZE ($%TIM,$%DUM)
< MOVX S1,$%TIM ;; Get number of milliseconds to sleep
TOPS10 <SLEEP S1,> ;; Use SLEEP MUUO on TOPS10
TOPS20 <DISMS> ;; and on TOPS20 dismiss the process
;; for the number of mS given.
> ;End SNOOZE definition
> ;End if SNOOZE not defined
SUBTTL Macros -- $LNCMD, $DVCMD
; Macro - $LNCMD
;
; Function - To set up the arguments to the line command routine (LINCMD)
;
; Parameters -
;
; $%CMD Command number
; $%VEC Where to vector to on command failure
Define $LNCMD ($%CMD,$%VEC)
< MOVX S1,$%CMD ;; Load the command number
$CALL LINCMD ;; Call the line command routine
IFNB <$%VEC>,<JUMPF $%VEC> ;; Command failure .. jump
> ;End $LNCMD definition
; Macro - $DVCMD
;
; Function - To set up the arguments to the device command routine (DEVCMD)
;
; Parameters -
;
; $%CMD Command number
; $%VEC Where to vector to on command failure
Define $DVCMD ($%CMD,$%VEC)
< MOVX S1,$%CMD ;; Load the command number
$CALL DEVCMD ;; Call the device command routine
IFNB <$%VEC>,<JUMPF $%VEC> ;; Command failure .. jump
> ;End $DVCMD definition
SUBTTL Macros -- $FELOG
; Macro - $FELOG
;
; Function - This macro generates the conditional code, depending on value
; of FTDEBUG, for writing entries to the CAL11. log file.
;
; Parameters -
;
; $%PHSE Phase of logging, "BEFORE" or "AFTER"
Define $FELOG ($%PHSE)
<IFN FTDEBUG,< ;; If debugging enabled
%%.PHS==0 ;; Init to no phase defined yet
IFIDN <$%PHSE>,<BEFORE>,<%%.PHS==PHSBEF> ;; Before CAL11.
IFIDN <$%PHSE>,<AFTER>, <%%.PHS==PHSAFT> ;; After CAL11.
IFE %%.PHS,<IF1,<PRINTX $FELOG called with illegal phase: "'$%PHSE'">>
JRST [MOVX T4,%%.PHS ;; Load the phase value
TOPS10 < IOR T4,P3> ;; Point to the CAL11. argument block
TOPS20 <
IFIDN <$%PHSE>,<BEFORE>,<IORI T4,XMTHDR>;; Before transmission .. give XMT hdr
IFIDN <$%PHSE>,<AFTER>,<IORI T4,RCVHDR> ;; After .. give RCV header
> ;End if TOPS20
$CALL FELOG## ;; Yes .. call logging routine
JRST .+1] ;; Return to main line
PURGE %%.PHS ;; Kill the extraneous symbol
>> ;End $FELOG definition
SUBTTL Global routine -- D60INI
; Routine - D60INI
;
; Function - To initialize internal data bases to the D60 communication package.
; This routine assumes that a "RESET" has already been done that will
; clear all ENQ/DEQ requests/entries and all device/JFN assignments.
;
; Parameters - none
ENTRY D60INI
D60INI: $SAVE <S1,S2> ; Save registers
HRRZ S1,SONSTR ; Get length of the table
SETZM SONSTR+1 ; Clear the first entry
CAIN S1,1 ; Check for only one entry
JRST D6I.1 ; Yes .. so skip BLT
MOVE S2,[SONSTR+1,,SONSTR+2] ; Standard zero BLTing argument
ADDI S1,SONSTR ; Find end of the table
BLT S2,(S1) ; Clear the table
D6I.1:
TOPS20< MOVEI S1,LOCALS ; Get location of local data base
LSH S1,-^d9 ; Convert to page number
HRLI S1,.FHSLF ; This process handle
MOVX S2,PA%RD+PA%WT+PA%EX+PA%CPY
SPACS ; Change locals to COPY-ON-WRITE
ERJMP @.RETF ; on failure .. give error return
MOVEI S1,ENDLOC ; Get where the locals end
LSH S1,-^d9 ; Convert to a page number
HRLI S1,.FHSLF ; Point to this process
MOVX S2,PA%RD+PA%WT+PA%EX+PA%CPY
SPACS ; Change up to end of locals to C-O-W
SETZM FEJFN ; Clear the JFN for I/O to the FE
SETZM LSTDTE ; Clear the last DTE to be selected.
>; End if TOPS20
SETOM HANLST ; Clear the handle list name
ININHN:
TOPS20 <MOVX S1,.DEQDA ; Dequeue all locks for this process
DEQ>
TOPS10 <HRLI S1,.DEQDA ; Dequeue all locks for this job
DEQ. S1,>
JFCL ; No relevant errors can occur
TOPS20 <MOVX S1,.FHSLF ; Point to this process again
MOVX S2,LSTRX1 ; No last error, error code
SETER> ; Clear any error up to this point
$RETT ; It worked (it should).
SUBTTL Global routine -- D60OPN
; Routine - D60OPN
;
; Function - To setup a device on a remote station (or link up to 360/370) and
; define a unique handle that will describe this link.
;
; Parameters -
;
; S1/ -Count of argument block
; S2/ Location of open block
;
; or
;
; S1/ Dev-type,,Unit
; S2/ Port,,Line
;
; The device type codes are:
; 1=LPT, 2=CDP, 3=CDR, 4=Console in, 5=Console out, 6=Signon
;
; Format of open block:
;
; ARGBLK/ Dev-type,,Unit
; ARGBLK+1/ Port,,Line
; ARGBLK+2/ Line signature
;
; Returns -
;
; True S1/ Handle used for referencing the device
; False S1/ Error code
;
ENTRY D60OPN
D60OPN: $SAVE <S2,T1> ; Save registers
ACVAR <SIG> ; Local storage for line signature
SETZ SIG, ; Clear line signature
JUMPG S1,OPN.1 ; If open block type parameters
LOAD SIG,(S2),OP$SIG ; Get line signature
ANDI SIG,177777 ; Clear to only 16 bits worth
LOAD S1,(S2),OP$DEV ; Get device and unit number
LOAD S2,(S2),OP$STA ; Get port and line number
OPN.1: $CALL PCKPDD ; Make up the PDD for the device
MOVE T1,S1 ; Put in another reg for safe keeping
SKIPGE S1,HANLST ; Check for handle list already started
$CALL L%CLST ; and make one up if not
MOVEM S1,HANLST ; Save the handle list name
MOVE S1,T1 ; Get the PDD of this device and
$CALL SRCPDD ; check to see if it already exists
JUMPT ERT (D6AUT) ; Error .. the device being used by us
MOVE S1,HANLST ; Get the name of the handle list
$CALL L%LAST ; Point after the last entry in list
MOVE S1,HANLST ; Get name again in case no entries
MOVX S2,H$SIZ ; Load in size of a handle list entry
$CALL L%CENT ; and create one.
STORE T1,(S2),H$PDD ; Save the PDD in this list entry
LOAD T1,(S2),H$DEV ; Get the generic device number
MOVE S1,DEFTHR ; Get the default offline threshold
CAIE T1,.OPCIN ; If either the console input
CAIN T1,.OPCOU ; or the console output
MOVX S1,1 ; set to very short offline threshold
STORE S1,(S2),H$THR ; and save it for this device
SETO S1, ; Initially set the bytes per message
STORE S1,(S2),H$BPM ; to +infinity to force I/O
LOAD S1,(S2),H$PRT ; Get the port number
CAIGE S1,DTEOFF ; Do we have a DL10 # (0-7)
JRST OPNDL ; Yes .. so go validate the DL10 #
CAILE S1,MAXDTE ; Check to see if the DTE # is ok
JRST ERT (D6NSP,OPNDIE) ; No .. it's too large
JRST PRTOK ; This port is valid.
OPNDL: ; On -10's DL10's are valid
TOPS20 <MOVX S1,D6NSP ; No such port (no DL10 on -20)
JRST OPNDIE> ; and go release the list entry
PRTOK: LOAD S1,(S2),H$PRT ; Get the port from the PDD
STORE S1,(S2),H$HPR ; put into the handle
LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL ENQDEV ; Enqueue the device (until released)
JUMPF ERT (D6AUA,OPNDEQ) ; Someone else already has it
$CALL OPNFE ; Go open a FE (-10 check for 11 up)
JUMPF ERT (D6COF,OPNDEQ) ; Can't open a front end
$CALL PRTSTS ; Get the port status
JUMPF ERT (D6COF,OPNDEQ) ; Can't get port status .. dead 11
LOAD S1,,S6LIN ; Get the maximum line number
LOAD T1,(S2),H$LIN ; Get the line number we want
CAILE T1,(S1) ; Check to see if in range
JRST ERT (D6NSL,OPNDEQ) ; No such line on this port
LOAD S1,,S6TRN ; Get the translation options
TXNN S1,TR$IBM ; Does the DN60 support IBM stuff?
JRST ERT (D6PIU,OPNDEQ) ; No ... this port is useless
$CALL LINSTS ; Get the line status
JUMPF OPNDEQ ; Someone died .. go release device
IFE FTNDNU,<
LOAD T1,,SLINF ; Get line info
TXNN T1,SLDSR ; Check for line dialed up (DSR set)
JRST ERT (D6DNU,OPNDEQ) ; No .. so give error
> ;End if not FTNDNU
LOAD T1,,SLSIG ; Get line signature
$CALL SWAPB ; Move the bytes around
CAIE T1,(SIG) ; Check against given line signature
JRST ERT (D6BLS,OPNDEQ) ; Bad line signature .. refuse open
STORE SIG,(S2),H$SIG ; Save the line signature for device
LOAD S1,,SLTYP ; Get the remote station type
STORE S1,(S2),H$STY ; Save the station type in list entry
CAIN S1,SLHSP ; Test to see if it is a HASP station
JRST OPNHSP ; Yes .. go create HASP device code
LOAD S1,(S2),H$UNT ; Get the unit number on 2780/3780
JUMPN S1,ERT (D6UNS,OPNDEQ) ; Can't give a unit number on non-HASP
LOAD S1,(S2),H$DEV ; Get the device code
CAILE S1,MXNHSP ; Check for max device on non-HASP
JRST ERT (D6UND,OPNDEQ) ; Unknown device
STORE S1,(S2),H$HDV ; Store as the unique device number
SETZ S1, ; All devices are really 0 on 2780/3780
STORE S1,(S2),H$CDV ; Store the -11 device com. number
JRST OPNDFD ; Device found ok .. continue
OPNHSP: LOAD S1,(S2),H$DEV ; Get the device code
CAILE S1,0 ; Check to see if the device type is
CAILE S1,MXHSP ; in range for a HASP station
JRST ERT (D6UND,OPNDEQ) ; No .. unknown device type
MOVE T1,[XWD 0,4 ; Translate OPN numbers to DN60 device
XWD 0,5 ; numbers used when talking to -11
XWD 0,3
XWD 0,2
XWD 0,1
XWD 0,3]-1(S1)
STORE T1,(S2),H$CDV ; Store as the -11 com. device number
MOVE T1,[SDLP1 ; Component code for a LPT
SDCP1 ; or a CDP (card punch)
SDCR1 ; or a CDR (card reader)
SDCIN ; or a input console
SDCOU ; or a output console
SDSON]-1(S1) ; or a sigon device
LOAD S1,(S2),H$UNT ; Get unit of device-type to select
CAILE S1,MXUHSP ; Check against maximum number of units
JRST ERT (D6UND,OPNDEQ) ; Too bad .. unknown unit
IMULI S1,HSPOFF ; Multiply by the unit offset
ADD S1,T1 ; Get the final device selection code
STORE S1,(S2),H$HDV ; Store as the unique device number
OPNDFD: LOAD S1,(S2),H$LIN ; Get the line number from the PDD
STORE S1,(S2),H$HLN ; put into handle to complete it.
LOAD T1,,SLFLG ; Get line status flags
LOAD T1,T1,SLETF ; Get termination/emulation flag
STORE T1,(S2),H$TEM ; Save it in the handle list entry
$CALL SETIOM ; Set the input/output mode of device
$DVCMD (DC.COE,OPNDEQ) ; Clear output EOF flag
$DVCMD (DC.CIE,OPNDEQ) ; Clear input EOF flag
; $DVCMD (DC.COA,OPNDEQ) ; Clear output abort
; $DVCMD (DC.CIA,OPNDEQ) ; Clear input abort
LOAD S1,(S2),H$TEM ; Get the emulation/termination flag
JUMPE S1,OPNSEM ; Jump if we want to do termination
$DVCMD (DC.SCI,OPNDEQ) ; Set interpret CC on input
$DVCMD (DC.CCO,OPNDEQ) ; Clear inpterpret CC on output
JRST OPNOV1 ; Continue on
OPNSEM: $DVCMD (DC.CCI,OPNDEQ) ; Clear interpret CC on input
$DVCMD (DC.SCO,OPNDEQ) ; Set interpret CC on output
LOAD S1,(S2),H$DEV ; Get device type
SETZ T1, ; Clear return immediate
CAIN S1,.OPCOU ; Unless a console (output from IBM)
SETO T1, ; Then set return immediate flag
STORE T1,(S2),H$RTI ; Store return immediate for FEI%O
OPNOV1: LOAD S1,(S2),H$STY ; Get the station type
CAIN S1,SLHSP ; If it is HASP then go give
JRST OPNHP2 ; component code
CAIN S1,SL278 ; Check for 2780 type station
JRST OPN278 ; Yes .. go set proper protocol
$DVCMD (DC.C27,OPNDEQ) ; Use new protocol for 3780
JRST OPNOV3 ; Go clear the component code
OPN278: $DVCMD (DC.S27,OPNDEQ) ; Use the old protocol for 2780
OPNOV3: $DVCMD (DC.DCC,OPNDEQ) ; 2780/3780 so don't use component code
$DVCMD (DC.CSC,OPNDEQ) ; Clear space compression flag
JRST OPNOV2 ; Continue again
OPNHP2: LOAD T1,(S2),H$HDV ; Get the device code from handle
$DVCMD (DC.SCC,OPNDEQ) ; Specify component code
$DVCMD (DC.C27,OPNDEQ) ; Don't use old protocol
$DVCMD (DC.SSC,OPNDEQ) ; Set space compression flag
OPNOV2: MOVX T1,^d82 ; Currently set to 82.
STORE T1,(S2),H$BPM ; Save as the bytes per message
$CALL SWAPB ; Swap bytes in 16 bit word
$DVCMD (DC.BPR,OPNDEQ) ; Set bytes per record of device
$CALL SONSET ; Set station signed on flag
LOAD S1,(S2),H$HAN ; Get the handle to pass back
$RETT ; Return saying success
;
; Here when the open has failed and we need to release (Dequeue) the device.
;
OPNDEQ: PUSH P,S1 ; Save the error code
LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL DEQDEV ; and release the device
SKIPA ; Now go destroy the list entry
;
; Here when the open fails and we need to delete the entry in the handle list
; that we have created temporarily for this open attempt.
;
OPNDIE: PUSH P,S1 ; Save the error code
MOVE S1,HANLST ; Get the handle list name
$CALL L%DENT ; Delete the current entry
POP P,S1 ; Restore the error code
$RETF ; and give the false return
SUBTTL Global routine -- D60SIN
; Global routine - D60SIN
;
; Function - To input a string from a remote station device.
;
; Parameters -
;
; S1/ Handle of remote device (gotten from D60OPN)
; S2/ Byte pointer to where string is to be read into
; T1/ Negative byte count to be read
ENTRY D60SIN
D60SIN: ACVAR <ARGI> ; Allocate register for input arg block
MOVE ARGI,S1 ; Save the handle temporarily
$CALL ALCARG ; Allocate an FEI%O arg block
EXCH ARGI,S1 ; Swap them back
STORE S2,(ARGI),ARG$PT ; Save the byte pointer to input area
STORE T1,(ARGI),ARG$BC ; Save the byte count
JUMPGE T1,ERT (D6CNN,SINFAI) ; Test for illegal byte count
MOVX T1,FC.RD ; Function to read from device
STORE T1,(ARGI),ARG$FC ; Put into I/O argument block
HRRZS S1 ; Clear the flags in left half
$CALL SRCHAN ; Look for handle on handle entry list
JUMPF ERT (D6NSH,SINFAI) ; Illegal handle
LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPE S1,ERT (D6DCI,SINFAI) ; Device can't do input
LOAD S1,(S2),H$SON ; Check for station signed on
JUMPN S1,SIN.SN ; If set .. skip signon checking
$CALL SONRD ; Read and validate signon string
JUMPF [$LNCMD (LC.DIS) ; Failed .. disable the line
MOVX S1,D6LGA ; Say that line has gone away
JRST SINFAI]
SIN.SN: LOAD S1,(S2),H$RUN ; Get the input running flag
JUMPN S1,SINGO ; If yes then go do some input
SIN.LK: $CALL LCKLIN ; Lock the line from use (2780/3780)
JUMPF [LOAD S1,(S2),H$SPN ; Check for signon pending
JUMPN S1,SIN.LK ; Yes .. go try locking again
JRST ERT (D6DOL,SINBAD)]; No .. device offline
$CALL REQIN ; Go check on input request
JUMPF SINFAI ; If input grant failed .. return
SINGO: MOVE S1,ARGI ; Point to the argblk for FE I/O
$CALL FEI%O ; Do the input
JUMPF SINREJ ; If failed .. check for EOF
LOAD S1,(S2),H$HAN ; Get the handle back on success
JRST SINSUC ; Set the true flag and return
SINREJ: $CALL CKIABT ; Check for input abort
JUMPF SINFAI ; Yes .. go release and clean up
TXNE T1,SDSUS ; Is the device suspended? (HASP)
JRST [MOVX S1,D6DOL ; Yes .. so device is offline
JRST SINBAD] ; Go say that still there, but offline
TXNE T1,SDIEC ; Did an EOF occur?
JRST [$DVCMD (DC.CIE) ; Yes .. clear EOF complete flag
MOVX S1,D6EOF ; Set EOF code
JRST SINFAI] ; Close off line and shutdown device
LOAD T1,(ARGI),ARG$RC ; Get the result code from FEI%O
CAIN T1,RC.REJ ; Check for a reject
JRST ERT (D6IOE,SINFAI) ; Yes .. a case of I/O error
LOAD T1,(S2),H$DEV ; No .. get generic device number
CAIE T1,.OPCIN ; Check for either type of console
CAIN T1,.OPCOU ; device and set the
JRST SINNBR ; non-blocking return code
MOVX S1,D6DOL ; Not console .. so device offline
SINFAI: ZERO ((S2),H$RUN) ; Clear the I/O running bit
$CALL RLSLIN ; Release the line (2780/3780)
JRST SINBAD ; Go set the failure and return
SINNBR: MOVX S1,D6NBR ; Set non-blocking code
SINSUC: SKIPA TF,[TRUE] ; Set true flag
SINBAD: MOVX TF,FALSE ; Set the failure flag
SINRET: LOAD T1,(ARGI),ARG$BC ; Get the count of bytes not transfered
LOAD S2,(ARGI),ARG$PT ; Get pointer where string left off
EXCH S1,ARGI ; Exchange return code(handle) and ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGI ; Get the return code(handle) back
$RET ; Give failure return
SUBTTL Global routine -- D60SOUT
; Global routine - D60SOUT
;
; Function - To output a string to a remote device
;
; Parameters -
;
; S1/ Handle of device received from D60OPN
; S2/ Byte pointer of string to output
; T1/ Negative byte count
ENTRY D60SOUT
D60SOU: ACVAR <ARGO> ; Allocate register for output arg blk
MOVE ARGO,S1 ; Save the handle temporarily
$CALL ALCARG ; Allocate an FEI%O arg block
EXCH ARGO,S1 ; Swap them back
STORE S2,(ARGO),ARG$PT ; Save the byte pointer to input area
STORE T1,(ARGO),ARG$BC ; Save the byte count
JUMPGE T1,ERT (D6CNN,SOTF.2) ; Test for illegal byte count
MOVX T1,FC.WD ; Function to write data to device
STORE T1,(ARGO),ARG$FC ; Put into I/O argument block
HRRZS S1 ; Clear the flags in left half
$CALL SRCHAN ; Look for handle on handle entry list
JUMPF ERT (D6NSH,SOTF.2) ; Illegal handle
LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,ERT (D6DCO,SOTF.2) ; Device can't do output
LOAD S1,(S2),H$RUN ; Check to see if the output already
JUMPN S1,SOTGO ; running
$CALL LCKLIN ; Lock the BSC line (2780/3780)
JUMPF ERT (D6CGO,SOTRET) ; Can't .. imply offline
$CALL REQOUT ; Request output permission
JUMPF SOTF.1 ; Didn't get it ... release line
SOTGO: MOVE S1,ARGO ; Point arg blk for FE I/O
$CALL FEI%O ; Do the output
JUMPF SOTTST ; Go check why the output failed
LOAD S1,(S2),H$DEV ; Get device type number
CAIE S1,.OPCIN ; Check for console input
CAIN S1,.OPCOU ; or console output device
JRST [$DVCMD (DC.DOB) ; Yes .. dump output buffers
JUMPF SOTF.1 ; Failed doing dump
JRST .+1] ; Continue on with output success
LOAD S1,(S2),H$HAN ; Get the handle back on success
MOVX TF,TRUE ; Set success code
JRST SOTRET ; Go release the arg block and return
SOTTST: LOAD T1,(ARGO),ARG$RC ; Get the result code from FEI%O
CAIN T1,RC.REJ ; Check for a reject
JRST ERT (D6IOE,SOTF.1) ; Yes .. a case of I/O error
$CALL CKOABT ; Check for output aborts
JUMPF SOTF.1 ; Yes .. go release and clean up
LOAD T1,(S2),H$DEV ; Get device type
CAIE T1,.OPCIN ; Check for console input device
CAIN T1,.OPCOU ; or console output device
SKIPA S1,[D6NBR] ; Yes .. set non-blocking error
MOVX S1,D6DOL ; No .. so device is off line
JRST SOTF.2 ; Go give a false return
SOTF.1: $CALL RLSLIN ; Release the BSC line (2780/3780)
ZERO ((S2),H$RUN) ; Clear the running flag
SOTF.2: MOVX TF,FALSE ; Set failure flag
JRST SOTRET ; Release arg block and return
SOTRET: LOAD T1,(ARGO),ARG$BC ; Get the count of bytes not done
LOAD S2,(ARGO),ARG$PT ; Get pointer where string left off
EXCH S1,ARGO ; Swap error code(handle) and ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGO ; Get the error code(handle) back
$RET ; Give failure return with code in S1
SUBTTL Global routine -- D60OPR
; Global routine - D60OPR
;
; Function - To set parameters and characteristics of a I/O link to a remote
; device
;
; Parameters -
;
; S1/ Handle of device
; S2/ Function code
; T1/ Optional argument value or block pointer
ENTRY D60OPR
D60OPR: $SAVE <S2,T1,P1> ; Save registers
MOVE P1,S2 ; Save the function code
HRRZS S1 ; Clear out the left half flags
$CALL SRCHAN ; Search for the handle on the list
JUMPF ERT (D6NSH) ; No such handle
CAIN P1,.MOABT ; Function to abort I/O transfers
JRST DOPABT ; Yes .. go set abort flags
CAIN P1,.MORQI ; Function to request output permission
JRST DOPRQI ; Yes .. go get it
CAIN P1,.MOTHR ; Function to set off line threshold
JRST DOPTHR ; Yes .. go set new threshold
JRST ERT (D6FNI) ; No .. no other function implemented
DOPRQI: LOAD S1,(S2),H$IOM ; Get the input/output mode of device
JUMPN S1,DOPIN ; Check to see if input .. go grant
$CALL REQOUT ; otherwise get output permission
CAIA ; (skip input grant)
DOPIN: $CALL REQIN ; Grant input permission
$RET ; Return T/F from REQOUT or REQIN
DOPABT: ZERO ((S2),H$RUN) ; Clear the I/O running flag
LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,DOPIAB ; Input flag .. set input abort
$DVCMD (DC.SOA) ; Signal output abort on device
$RET ; Propagate any error back
DOPIAB: $DVCMD (DC.SIA) ; Signal input abort on device
$RET ; Propagate any errors that occured
DOPTHR: STORE T1,(S2),H$THR ; Store new value as off line threshold
$RET
SUBTTL Global routine -- D60EOF
; Global routine - D60EOF
;
; Function - To signal the end of I/O on a handle and to turn the line
; around if it needs to.
;
; Parameters -
;
; S1/ Handle of device
ENTRY D60EOF
D60EOF: $SAVE <S2,T1> ; Save some registers
HRRZS S1 ; Clear out the left half flags
$CALL SRCHAN ; Find the handle list entry
JUMPF ERT (D6NSH) ; Didn't find the handle
PUSH P,[RLSLIN] ; Release the line if 2780/3780
INTEOF: $CALL LINSTS ; Get the line status
LOAD T1,,SLSIG ; Get line signature
$CALL SWAPB ; Swap the bytes around
LOAD S1,(S2),H$SIG ; Get signature from handle
CAME S1,T1 ; Check for a match
JRST ERT (D6LGA,EOFL.1) ; No .. so line has gone away
LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,ERT (D6DCO) ; Input device .. can't output EOF
LOAD S1,(S2),H$RUN ; Check to see if I/O is running
JUMPN S1,EOFSND ; Yes .. so go send the EOF
$CALL CKOABT ; Check for an output abort
JUMPF EOFL.1 ; Yes .. go clean up and return
TXNN T1,SDORN ; Test for output running
JRST EOFL.2 ; No .. so just give successful return
EOFSND: $DVCMD DC.SOE ; Signal EOF on device
EOFLOP: SNOOZE SEC ; Sleep for a second
LOAD T1,(S2),H$DEV ; Get the device number
CAIN T1,.OPSGN ; Check for signon device
JRST EOFL.2 ; Yes .. so don't try to read status
$CALL CKOABT ; Check for an output abort
JUMPF EOFL.1 ; Yes .. give error and failure return
TXNN T1,SDEOC ; Test for output EOF complete
JRST EOFLOP ; No .. so loop until it is.
$DVCMD DC.COE ; Yes .. so clear the EOF complete flg
JRST EOFL.2 ; Give successful return
EOFL.1: TDZA TF,TF ; Set the failue flag if here
EOFL.2: SETOM TF ; or to success if here
ZERO ((S2),H$RUN) ; Clear the run flag in handle entry
$RET ; Successful return
SUBTTL Global routine -- D60RLS
; Global routine - D60RLS
;
; Function - To release a device and handle of the device
;
; Parameters -
;
; S1/ Handle of device received from D60OPN
ENTRY D60RLS
D60RLS: HRRZS S1 ; Clear out and flags that may be set
$CALL SRCHAN ; Find the handle list entry
JUMPF ERT (D6NSH) ; If no entry .. give error return
$CALL D60EOF ; Make sure that the I/O is closed off
JUMPT RLS.1 ; If no problems releasing .. continue
CAIE S1,D6DCO ; If input device .. ignore error
$SAVE <TF,S1> ; Save error flag and error code
RLS.1: LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL DEQDEV ; and release the device to the world
PJRST RLSHAN ; Release the handle entry and possibly
; the FE device if not needed.
SUBTTL Global routine -- D60STS
; Global routine - D60STS
;
; Function - To get the status of a device(s) on a remote station.
;
; Parameters -
;
; S1/ Function,,arg
; S2/ Pointer to status return area or line number
;
; where function is:
;
; .STDEV 0 for device status
; .STPRT 1 for port status
; .STLIN 2 for line status
;
; where arg is:
;
; Port number (0-7, 10-13) for .STPRT and .STLIN
; Device handle (from D60OPN) for .STDEV
;
; Returns -
;
; Device status and line status - flags in S2
; Multiple device activity status - in block pointed to by S2
ENTRY D60STS
D60STS: $SAVE <T1,T2> ; Save registers
HLRZ T1,S1 ; Get function code
ANDX T1,7 ; Clear all bits except the function
CAIN T1,.STPRT ; Check for port status
JRST MULSTS ; Yes .. so get the activity status
CAIN T1,.STLIN ; Check for line status
JRST STSLIN ; Yes .. so get line staus flags
CAIE T1,.STDEV ; Check for device status
JRST ERT (D6FNI) ; No .. so the function is not here
HRRZS S1 ; Clear out the left half flags
$CALL SRCHAN ; Go find the handle in the handle list
JUMPF ERT (D6NSH) ; No .. so give error return
$CALL DEVSTS ; Get the device status
JUMPF @.RETF ; Can't get device status .. die
LOAD T1,,SDFLG ; Get the status flags for the device
LOAD T2,(S2),H$IOM ; Get the Input/Output mode
STORE T2,T1,SDIOM ; Put the mode into the status bits
MOVE S2,T1 ; Put the status value where looked for
$RETT ; Give a true return
MULSTS: MOVE T1,S2 ; Save the value return pointer
$CALL INIDMY ; Start up a dummy list entry
JUMPF @.RETF ; Can't get at the port
$CALL PRTSTS ; Get the port status
JUMPF RLSHAN ; If it failed .. give false return
HRLI S1,STSBUF+S6ACT ; Point to where active bits start
HRR S1,T1 ; and where to transfer them to
BLT S1,S6ALN-1(T1) ; Transfer to the user program
MOVX TF,TRUE ; Set success flag
PJRST RLSHAN ; Return while releasing dummy handle
STSLIN: MOVE T1,S2 ; Move line number to a safe place
$CALL INIDMY ; Start up a dummy list entry
JUMPF @.RETF ; Failed to start a front end
STORE T1,(S2),H$LIN ; Store lower 9 bits as line number
STORE T1,(S2),H$HLN ; in handle and PDD entries
$CALL LINSTS ; Get status of line
$CALL RLSHAN ; Release the dummy handle
JUMPF ERT (D6LGA) ; If line status failed .. bad return
LOAD T1,,SLFLG ; Get flags
ANDI T1,177400 ; Get only significant part
LOAD S2,,SLINF ; Get line info
IOR S2,T1 ; Put them all together
$RETT ; Return successfully
INIDMY: $SAVE <T1> ; Save a register
$CALL ALCHAN ; Make up a dummy handle entry
STORE S1,(S2),H$PRT ; Put the port number in to dummy entry
STORE S1,(S2),H$HPR ; in both places.
LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL OPNFE ; Open the front end
JUMPF ERT (D6COF,RLSHAN) ; Can't open front end, rls dummy
$RETT ; Front end opened just fine
SUBTTL GLobal routine -- D60CND, D60DIS
; Routine - D60CND, D60DIS
;
; Function - To condition a 2780/3780/HASP line with the appropriate parameters
;
; Parameters -
;
; S1/ Address of QUASAR setup message
;
; c(S1)+SUP.CN = address of conditioning arg block
;
; argblk/ Port,,Line ; Only need this word on disable
; Flags
; 1b15 Transparent
; 1b16 Primary protocol
; 1b17 Emulation
; right half - station translation type
; 1 - 3780
; 2 - 2780
; 3 - HASP
; Clear to send delay
; Silo warning area size
; Number of bytes/message
; Number of records/message
; Line signature
ENTRY D60CND, D60DIS
D60CND: $SAVE <S2,T1,T2,P1,P2,P3> ; Save some registers
MOVX P1,.CNENB ; Line enable function
MOVE P3,S1 ; Save address of setup message
MOVEI P2,SUP.CN(P3) ; Get address of conditioning block
JRST CNDGO ; Go to common code
D60DIS: $SAVE <S2,T1,T2,P1,P2,P3> ; Save some registers
MOVX P1,.CNDIS ; Line disable function
MOVE P2,S1 ; Get address of port,,line
CNDGO: LOAD T1,(P2),CN$PRT ; Get port number
LOAD T2,(P2),CN$LIN ; Get line number being disabled
CND.X: SKIPGE S1,HANLST ; Check for any devices opened
JRST CND.2 ; No .. just go disable line
$CALL L%FIRST ; Point to first entry in list
JUMPF CND.2 ; No first entry .. go disable line
CND.1: LOAD S1,(S2),H$PRT ; Get port number
CAME S1,T1 ; Check against one being disabled
JRST CND.1A ; No .. continue to next entry
LOAD S1,(S2),H$LIN ; Get line number of entry
CAME S1,T2 ; Check against one being disabled
JRST CND.1A ; No .. continue until last entry
LOAD S1,(S2),H$HAN ; Get handle of current entry
$CALL D60RLS ; Release the device (call global rtn)
JRST CND.X ; Go start at top of list again
CND.1A: MOVE S1,HANLST ; Get handle list name
$CALL L%NEXT ; Find next handle list entry
JUMPT CND.1 ; Another one .. check releasability
CND.2: $CALL ALCHAN ; Make up a dummy handle entry
LOAD S1,(P2),CN$PRT ; Get the port to start up
STORE S1,(S2),H$PRT ; and save it in pseudo handle block
LOAD S1,(P2),CN$LIN ; Get the line to init
STORE S1,(S2),H$LIN ; and save that also
LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL OPNFE ; Open up the front end for setup
JUMPF ERT (D6COF,RLSHAN) ; Couldn't open a front end
$CALL LINSTS ; Get the line status
; JUMPF RLSHAN ; Release handle, give error if failed
LOAD T1,,SLINF ; Get line info flags
TXNN T1,SLLEN ; Check for line enabled
JRST CND.5 ; No .. go issue line enable
LOAD T1,,SLTYP ; Get station type enabled for
CAIN T1,SLHSP ; Check for HASP
JRST CND.3 ; Yes .. just go disable line
$CALL DEVSTS ; Get device (0) sts on 2780/3780 line
JUMPF RLSHAN ; Failed .. release and clean up
LOAD T1,,SDFLG ; Get device flags
TXNN T1,SDOAS!SDIAS ; Check for any aborts pending
JRST CND.3 ; No .. just disable the line
$DVCMD (DC.CIA,RLSHAN) ; Clear input abort
$DVCMD (DC.COA,RLSHAN) ; Clear output abort
CND.3: $LNCMD (LC.DIS,RLSHAN) ; Shut down the line (disable)
SNOOZE SEC ; Sleep for a second, let -11 catch up
CND.5: CAIN P1,.CNDIS ; If the function was to disable the
$RETT ; line only .. we have gone far enough
LOAD S1,(P2),CN$ETF ; Get emulation/termination flag
JUMPN S1,CND.6 ; If emulation .. ignore signon
$CALL SONFIL ; Go read and setup signon string
JUMPF RLSHAN ; If failed .. just release and return
CND.6: $CALL PRTSTS ; Get status of front end
JUMPF RLSHAN ; Can't get port status .. so die
LOAD T1,(P2),CN$TYP ; Get desired translation type
MOVE T1,[EXP TR$X78,TR$X78,TR$HSP]-1(T1)
LOAD S1,,S6TRN ; Get translations avaiable in FE
TDNN S1,T1 ; Check wanted against available
JRST ERT (D6PIU,RLSHAN) ; Nope .. port is useless
LOAD T1,(P2),CN$TYP ; Get the station type (terminal type)
LSH T1,^d8 ; Shift it up to the second byte
LOAD S1,(P2),CN$MAP ; Get the emulation/termination flag
; and primary/secondary flag
IOR T1,S1 ; Put into second byte and
$LNCMD (LC.EL,RLSHAN) ; start it up again (enable)
LOAD T1,(P2),CN$CTS ; Get the clear to send delay
$CALL SWAPB ; swap the bytes in 16 bit word
$LNCMD (LC.CSD,RLSHAN) ; and set it
LOAD T1,(P2),CN$WRN ; Get the silo warning level
$CALL SWAPB ; swap the bytes in 16 bit word
$LNCMD (LC.WAR,RLSHAN) ; and set it
LOAD T1,(P2),CN$BPM ; Get the bytes per message
$CALL SWAPB ; swap the bytes in 16 bit word
$LNCMD (LC.BPM,RLSHAN) ; and set it
LOAD T1,(P2),CN$RPM ; Get the records per message
$CALL SWAPB ; swap the bytes in 16 bit word
$LNCMD (LC.RPM,RLSHAN) ; and set it
LOAD T1,(P2),CN$SIG ; Get line signature to set
ANDI T1,177777 ; Clear superfluous bits
$CALL SWAPB ; swap bytes in 16 bit word
$LNCMD (LC.SLS,RLSHAN) ; Set the line signature
LOAD S1,(P2),CN$TYP ; Get station type again
CAIE S1,SLHSP ; Check for HASP station
JRST CND.9 ; No.. ignore transparent transmission
LOAD T1,(P2),CN$TRA ; Get transparency flag
JUMPN T1,[$LNCMD (LC.STR,RLSHAN); Set transparency on
JRST CND.9]
$LNCMD (LC.CTR,RLSHAN) ; Set transparency off
CND.9: $LNCMD (LC.DTR,RLSHAN) ; Set the data terminal ready
PJRST RLSHAN ; Release handle, FE and return
SUBTTL Signon string validation
; The state diagram of the signon string comparison follows. This
; algorithm allows floating fields on the line.
XLIST
Comment &
Explaination of state diagram symbols
Start Where processing begins
(x) Condition causing transfer to next state
(EOS) End of string, either by character or count
(B) Blank character (tab or space)
(NB) Non-blank character
(OK) Result of comparison
<> Loop back to same state
GET A Get next character from "A" string
GET B Get next character from "B" string
A=B ? Compare last characters fetched from strings
"OK" String comparison succeeded
"F" String comparison failed
+======0+
! START !
+=======+
!
V
+======8+ +======1+
(B)<>! GET B !<--------------! GET A !<>(B)
+=======+ ^ (EOS) +=======+
! ! ! !
! ! ! (NB)!
(EOS)! !(NB) ! +<------------------------------------+
V V ! V !
"OK" "F" ! +======2+ (EOS) !
! (B)<>! GET B !---->"F" !
! +=======+ !
! ! !
! !(NB) !
! V !
! +======3+ !
! "F"<--! A=B ? !<--------+ !
! +=======+ ! !
! ! ! !
! !(OK) ! (NB) !
! V ! !
! (EOS) +======4+ (NB) +======6+ (B) !
+<------! GET A !------>! GET B !------>"F" !
! +=======+ +=======+ (EOS) !
! ! !
! !(B) !
! V !
! (EOS) +======5+ +======7+ (NB) !
+<------! GET A !------>! GET B !------>"F" !
+=======+ +=======+ (EOS) !
^ ! ! !
! !(B) ! (B) !
+--+ +---------------------+
&
LIST
Define $GETA (NB,B,EOS)
< XLIST
DMOVE P3,PTRA ; Get pointer, count for string "A"
$CALL G$SCHK ; Get character and check it
DMOVEM P3,PTRA ; Store byte pointer back
MOVEM S2,P1 ; Save character for later
JRST @[EXP NB,B,EOS](S1) ; Move onto next state
LIST
> ;End Define $GETA
Define $GETB (NB,B,EOS)
< XLIST
DMOVE P3,PTRB ; Get pointer, count for string "B"
$CALL G$SCHK ; Get character and check it
DMOVEM P3,PTRB ; Store byte pointer back
MOVEM S2,P2 ; Save character for later
JRST @[EXP NB,B,EOS](S1) ; Move onto next state
LIST
> ;End Define $GETB
SCS.0: $SAVE <P1,P2,P3,P4> ; Save working registers
SCS.1: $GETA (SCS.2,SCS.1,SCS.8) ; Loop until non-blank
SCS.2: $GETB (SCS.3,SCS.2,SCS.F) ; Loop also until non-blank
SCS.3: CAME P1,P2 ; Check for character match
JRST SCS.F ; No .. comparison failed
SCS.4: $GETA (SCS.6,SCS.5,SCS.8) ; Get next character in atom
SCS.5: $GETA (SCS.7,SCS.5,SCS.8) ; Atom done .. find next one
SCS.6: $GETB (SCS.3,SCS.F,SCS.F) ; Get character, if none .. failure
SCS.7: $GETB (SCS.F,SCS.2,SCS.F) ; Atom should be done
SCS.8: $GETB (SCS.F,SCS.8,SCS.T) ; Scan off trailing blanks
SCS.F: $RETF ; String compare failed
SCS.T: $RETT ; String compare suceeded
; Routine - G$SCHK
;
; Function - To get the next character from a string and set the state
; vector value appropriate for the type of character.
;
; Parameters -
;
; P3/ Byte pointer
; P4/ String character count
;
; Returns -
;
; S1/ State condition value
; 0 = Non-blank character
; 1 = Blank character (tab or space)
; 2 = Control character (end of string), or count expired
; S2/ Character read
G$SCHK: SOJL P4,G$S.E ; Check for end of string count
ILDB S2,P3 ; Get next character
CAIGE S2," " ; Check for control character
JRST G$S.E ; Yes .. end of string
CAIE S2," " ; Check for space
CAIN S2," " ; or tab
JRST [MOVEI S1,1 ; Blank character encountered
$RET] ; Return
CAILE S2,"_" ; Check for lowercase range
SUBI S2,"a"-"A" ; Yes .. convert to upper case
MOVEI S1,0 ; Non-blank character read
$RET ; Return
G$S.E: MOVEI S1,2 ; End of string
$RET
; Routine - SONSET
;
; Function - To set the station signed on flag to the appropriate value
; depending on emulation/termination, device type and signon string
; values.
;
; Parameters -
;
; S2/ Handle list entry address
SONSET: $SAVE <S2> ; Save the handle list entry address
LOAD S1,(S2),H$DEV ; Get device type code
CAIE S1,SDCDR ; Check for card reader
JRST SONS.5 ; No .. suppress reading signon
MOVE T1,S2 ; Make another copy of it.
LOAD S1,(S2),H$PRT ; Get port number
LOAD S2,(S2),H$LIN ; Get line number
LSH S1,^d9 ; Shift port
IOR S1,S2 ; and make port/line number
MOVEI S2,SONSTR ; Point to table of signon strings
$CALL T$EFND ; Find one for this port/line
MOVE S2,T1 ; Get entry address back
SETZ T1, ; Clear Signon done flag
SKIPT ; If no string found
SONS.5: SETO T1, ; then no signon needed (already done)
STORE T1,(S2),H$SON ; Save flag value
$RETT
; Routine - SONRD
;
; Function - To read the signon string from the RJE card-reader and match
; it against the string read from the .SON file.
;
; Parameters -
;
; S2/ Handle list entry address
SONRD: $SAVE <S2,P1,P2,P3>
MOVE P1,S2 ; Make copy of handle entry address
LOAD S1,(P1),H$RTI ; Get "return immediate" value
PUSH P,S1 ; Save (restore before exit)
SETO S1, ; Turn on the signed on
STORE S1,(P1),H$SON ; flag so that D60SIN can be recursive
STORE S1,(P1),H$SPN ; Set signon pending flag
LOAD S1,(P1),H$HAN ; Get device handle
HRROI S2,SONBUF ; Point to input string buffer
MOVX T1,-^d82 ; Length of string to read
$CALL D60SIN ; Read the signon string
JUMPF SRD.F ; If failed .. just return
DMOVE S1,[POINT 7,SONBUF
^d82] ; "A" string descriptor
DMOVEM S1,PTRA ; Save it
LOAD S1,(P1),H$PRT ; Get port number
LOAD T1,(P1),H$LIN ; Get line number
LSH S1,^d9 ; Shift the port number
IOR S1,T1 ; Combine to make port/line id
MOVEI S2,SONSTR ; Signon string table address
$CALL T$EFND ; Find the entry
JUMPF [$STOP SSD,<Signon string disappeared from data base.>]
DMOVE P2,S1 ; Save table address and block address
HRLI S1,440700 ; Make into a byte pointer
ADDI S1,SONTXT ; Add offset to string text
MOVX S2,^d82 ; Max length of string
DMOVEM S1,PTRB ; "B" string descriptor
$CALL SCS.0 ; Run string comparsion state machine
JUMPF SRD.F ; If failed .. just return
MOVE S2,P1 ; Restore handle list entry address
$DVCMD (DC.CIE) ; Clear input EOF complete
$CALL RLSLIN ; Release the line
SNOOZE SEC*3 ; Sleep for a while .. let LPT catch up
$WTO <Node signed on>,<>,<SONTYP(P2)>
MOVE S2,P1 ; Restore handle list entry address
$CALL RLSLIN ; Release the line
POP P,S1 ; Get the "return immediate" back
STORE S1,(P1),H$RTI
SETZ S1, ; Clear the signon pending flag
STORE S1,(P1),H$SPN
STORE S1,(P1),H$RUN ; Clear CDR running flag
$RETT ; and return
SRD.F: POP P,S1 ; Get the "return immediate" off stack
$RETF ; Failure during signon
; Routine - SONFIL
;
; Function - Read and store a signon file for a particular node.
;
; Parameters -
;
; P3/ Address of setup message from QUASAR
;
; Returns - False if failed to read signon file ($WTO sent)
; True if signon file read and string stored
SONFIL: $SAVE <S1,S2,T1,T2,P1,P2,P3>
MOVE S1,SUP.ST(P3) ; Get status word of node
TXNN S1,NETSGN ; Check for "signon" required
JRST SNF.NS ; No .. just clear any left around
; Open the signon file
SETZ P2, ; Clear IFN of file (so far)
$TEXT <-1,,SONFD+1>,<^T/SONDIR/^W/SUP.NO(P3)/.SON^0>
MOVX S1,FOB.MZ ; Get size of FOB
MOVEI S2,SONFOB ; Signon file FOB
$CALL F%IOPN ; Open file for input
JUMPF SNF.F ; Signon file failure
MOVE P2,S1 ; Save IFN of file
; Get a buffer to store signon string, from file, into
MOVX S1,SNBLEN ; Length for signon block
$CALL M%GMEM ; Get it from mangler
MOVE P1,S2 ; Save it's address
MOVE T2,S2 ; Make a byte pointer
HRLI T2,440700 ; to the string
ADDI T2,SONTXT ; Index to the string area in block
MOVX T1,^d82 ; Max string length of 82 characters
MOVE S1,P2 ; Get IFN of input file
; Loop to read in the signon string, max of 82 characters.
SNF.1: SOJL T1,SNF.E ; End of string (truncated)
$CALL F%IBYT ; Get next byte from file
JUMPF [CAIE S1,EREOF$ ; Check for EOF
JRST SNF.F ; No .. give error
JRST SNF.E] ; Yes .. end the string
IDPB S2,T2 ; Store byte and
JRST SNF.1 ; go onto the next one
; Here to put string into signon string table
SNF.E: SETZ S2, ; Put a null byte
IDPB S2,T2 ; at the end of the string
MOVE S1,P2 ; Get file IFN again
$CALL F%REL ; Release the file
DMOVE S1,SUP.TY(P3) ; Get device type/unit
DMOVEM S1,SONTYP(P1) ; Put into signon block
MOVE S1,SUP.NO(P3) ; Get device node
MOVEM S1,SONNOD(P1) ; Put that also into signon block
MOVEI P2,SUP.CN(P3) ; Get address of line conditioning blk
LOAD S1,(P2),CN$PRT ; Get port number
LOAD S2,(P2),CN$LIN ; Get line number
$CALL SNFREL ; Release any previous signon block
SETZ S1, ; Look for a null entry
MOVEI S2,SONSTR ; Address of table again
$CALL T$EFND
JUMPF [$STOP STF,<Signon table full .. can't setup signon string>]
MOVEM P1,(S2) ; Store address of signon block
HRLM P2,(S2) ; Store port/line code
$RETT ; Success in storing signon string
; Here when there is a failure reading the signon file.
SNF.F: $WTO <Signon failure>,<Signon file ^F/SONFD/^M^J^E/[-1]/>,<SUP.TY(P3)>
SKIPN S1,P2 ; Check for IFN already assigned
$RETF ; No .. just give error return
$CALL F%REL ; Release the file
$RETF ; then give a failure return
; Here if signon is not required. The port/line is searched for
; in the signon string block, and if found it is removed.
SNF.NS: MOVEI P2,SUP.CN(P3) ; Get address of line conditioning blk
LOAD S1,(P2),CN$PRT ; Get port number
LOAD S2,(P2),CN$LIN ; Get line number
PJRST SNFREL ; Release block and return
; Routine - SNFREL
;
; Function - To search for and release a previously allocated signon block.
;
; Parameters -
;
; S1/ Port number
; S2/ Line number
;
; Returns - True always P2/ port/line number
SNFREL: $SAVE <T1>
LSH S1,^d9 ; Move up the port number
IOR S1,S2 ; Combine with line number
MOVE P2,S1 ; 18bit unique port/line number
MOVEI S2,SONSTR ; Address of signon string table
$CALL T$EFND ; Find if there is one
JUMPF .RETT ; No .. just return
MOVE T1,S2 ; Save address of table entry
MOVE S2,S1 ; Get address of signon block
MOVX S1,SNBLEN ; Get length of signon block
$CALL M%RMEM ; Release block to free pool
SETZ S1, ; Yes .. make a null entry
MOVEM S1,(T1) ; and use it to clear table entry
$RETT ; Return
; Routine - T$EFND
;
; Function - To search a table for a particular 18 bit value and return
; the associated 18 bit data value if found.
;
; Parameters -
;
; S1/ Value to search for
; S2/ Address of table
;
; Table format:
;
; Max-entries,,actual-entry-count
; Key-value-1,,data-value-1
; Key-value-n,,data-value-n
; etc.
;
; Returns -
;
; False if not found in table (or no entries)
; True if found and S1 contains the associated data value.
T$EFND: HRRZ TF,(S2) ; Get count of entries in table
JUMPE TF,.RETF ; If none .. search fails
MOVNS TF ; Make negative count
HRL S2,TF ; Make AOBJP pointer for search loop
AOS S2 ; Move onto first entry in table
EFND.1: HLRZ TF,(S2) ; Get next table key value
CAMN TF,S1 ; Check for a match
JRST [HRRZ S1,(S2) ; If so .. get data value
$RETT] ; and give search success flag
AOBJN S2,EFND.1 ; No match .. move onto next entry
$RETF ; Ran out of entries .. search fails
SUBTTL Lock/release BSC lines for 2780/3780 half-duplex
; Routine - LCKLIN
;
; Function - This routine locks a BSC line so that no other process or task
; in this process can attempt to do I/O on the line while the current
; task has an object (card reader/line printer) already running.
;
; Parameters -
;
; S2/ Handle list entry
LCKLIN: $SAVE <S2> ; Save register
LOAD S1,(S2),H$STY ; Get terminal (station) type
CAIN S1,SLHSP ; Check for a HASP station
$RETT ; Yes .. so line needn't be locked
LOAD S1,(S2),H$PDD ; Get packed device descriptor
PJRST ENQLIN ; Enqueue the line and return
; Routine - RLSLIN
;
; Function - To release a line so that it can be turned around or another
; task can talk to a common device (such as a line-printer being used
; for both an output console and a printer).
;
; Parameters -
;
; S2/ Location of handle list entry
RLSLIN: $SAVE <TF,S1,S2> ; Save some error code and return value
LOAD S1,(S2),H$STY ; Get station type
CAIN S1,SLHSP ; Check for a HASP station
$RETT ; Yes .. so just return .. not locked
LOAD S1,(S2),H$PDD ; Get packed device descriptor
PJRST DEQLIN ; Release the line and return
SUBTTL Grant input permission
; Routine - REQIN
;
; Function - To grant an input request if one pending, wait for one and
; grant it.
;
; Parameters -
;
; S2/ Handle list entry address
REQIN: $SAVE <T1,T2> ; Save registers
SETZ T2, ; No .. clear repeat count
LOAD T1,(S2),H$SPN ; Get "signon pending" flag
SKIPE T1 ; Check if set
MOVX T2,SONREP ; Yes .. repeat test for a while
REQSPN: $CALL CKIABT ; Check for any outstanding input abort
JUMPF @.RETF ; Yes .. so just return with failure
TXNE T1,SDIPW!SDIRN ; Check for input perm. was requested
JRST REQRTY ; Yes .. go answer request
SOJLE T2,ERT (D6DOL) ; Check for more retrys .. else offline
SNOOZE SEC ; Sleep for a second
JRST REQSPN ; Go check for a request again.
REQRTY: MOVX T2,RQREP ; Get the max number of tries for req
REQRDS: $CALL CKIABT ; Check for input aborts again
JUMPF @.RETF ; Failure caused by abort
TXNE T1,SDIRN ; Check for input already running
JRST REQCKI ; Yes .. go check for aborts
TXNE T1,SDIPR ; Check for a new input request
JRST REQGRT ; Yes .. so go grant it
SNOOZE SEC*RQTIM ; No .. sleep for a while
SOJG T2,REQRDS ; If more tries left .. go check again
JRST ERT (D6DOL) ; else assume the device is offline
REQGRT: $DVCMD DC.GIP ; Do a device input permission grant
$DVCMD DC.CIP ; Clear the request flag
REQGLP: $CALL CKIABT ; Check for input aborts
JUMPF @.RETF ; Failure do to abort on device
TXNN T1,SDIPG ; Check for the grant cleared
JRST REQCKI ; Yes .. the device took the grant
SNOOZE SEC ; No .. sleep and loop
JRST REQGLP
REQCKI: TXNN T1,SDIEC!SDIRN ; Check for EOF or running
JRST REQRTY ; No .. grant was eaten .. try again
SETO T1, ; Yes .. so turn on
STORE T1,(S2),H$RUN ; the I/O running flag
$RETT ; Give a successful return
SUBTTL Request output permission
; Routine - REQOUT
;
; Funtion - To request output permission on a device
;
; Parameters -
;
; S2/ Handle list entry address
REQOUT: $SAVE <T1,T2> ; Save registers
MOVX T2,RQOTIM ; Number of times to retry DSR check
DSRLP: $CALL LINSTS ; Get the line status
JUMPF ERT (D6LGA) ; Failed .. line must be dead
LOAD T1,,SLINF ; Get the info status byte
TXNE T1,SLDSR ; Test for the DSR set
JRST STOGST ; Yes .. start output grant request
SNOOZE TIMDSR ; No .. so sleep and then
SOJG T2,DSRLP ; go try for DSR again
LOAD T1,,SLFLG ; Get line flags.
MOVX S1,D6CGO ; Can't get output perm. .. no line
TXNE T1,SLCME ; Check for line failure
MOVX S1,D6LGA ; Yes .. say line has gone away.
$RETF ; Failure return
STOGST: $DVCMD (DC.CIP) ; Clear input requested flag
LOAD S1,(S2),H$DEV ; Get the generic device type
CAIN S1,.OPSGN ; Check for a signon device
JRST STGRUN ; Yes .. so imply grant already gotten
$CALL CKOABT ; Check for output aborts
JUMPF @.RETF ; Yes .. just give error return
TXNE T1,SDIPW!SDIPR ; Check for input requested
JRST ERT (D6CGO) ; Input coming .. can't do output
TXNN T1,SDORN!SDOPG ; Output running or granted already?
JRST REQGO ; No so go request output
$CALL INTEOF ; and put out an EOF to stop the
JUMPF @.RETF ; output (unless failed .. give error)
REQGO: $DVCMD DC.ROP ; Request to do output
MOVX T2,RQDTRY ; Number of retries after request drops
STGRLP: SNOOZE (<SEC*SOTDLY>,IOWAIT) ; Wait for the request to be processed
$CALL CKOABT ; Check for output aborts
JUMPF @.RETF ; Yes .. failure on device
TXNE T1,SDOPG!SDORN ; Check to see if grant gotten
JRST STGRUN ; Yes .. so go set the run flag
TXNE T1,SDIPW!SDIPR ; Check for input requested
JRST ERT (D6CGO) ; Yes .. input is coming, can't output
TXNE T1,SDOPR ; Check to see if request still up
JRST STGRLP ; Yes .. wait for it to go down
SOJG T2,STGRLP ; Check for retry exhausted
JRST ERT (D6CGO) ; Device must be off line (maybe)
STGRUN: SETO T1, ; Set the flag saying that
STORE T1,(S2),H$RUN ; the output is now running
$RETT ; Give good return (output running)
SUBTTL Check for input abort
; Routine - CKIABT
;
; Function - This routine checks the device status for an occurence of either
; a hardware line abort or a protocol soft device abort. If either
; has occured, an error will be returned. If device status can't be
; gotten an error will also be returned. After a device soft abort
; is seen it will be acknowledged (cleared) so the front end will
; clean up.
;
; Parameters -
;
; S2/ Handle list entry address
;
; Returns -
;
; False S1/ error code
; True T1/ device flags
CKIABT: $CALL DEVSTS ; Get device status
JUMPF ERT (D6LGA) ; Failed .. line has done away
LOAD T1,,SDLFG ; Get line status flags
TXNE T1,SDHWA ; Check for a hardware abort
JRST ERT (D6LGA) ; Yes .. line gone away
LOAD T1,,SDFLG ; Get device flags
TXNN T1,SDIAS ; Has input abort occured?
$RETT ; No .. we are ok here
TXNN T1,SDIAC ; Has the abort completed?
JRST [SNOOZE SEC ; No .. sleep for a second
JRST CKIABT] ; Go check the status again
$DVCMD (DC.CIA) ; Clear input abort flag
SKIPF ; Failed to clear flag
MOVX S1,D6IOE ; Cleared .. I/O error occured
$RETF ; Give failure return for all
SUBTTL Check for output abort
; Routine - CKOABT
;
; Function - This routine checks the device status for an occurence of either
; a hardware line abort or a protocol soft device abort. If either
; has occured, an error will be returned. If device status can't be
; gotten an error will also be returned. After a device soft abort
; is seen it will be acknowledged (cleared) so the front end will
; clean up.
;
; Parameters -
;
; S2/ Handle list entry address
;
; Returns -
;
; False S1/ error code
; True T1/ device flags
CKOABT: $CALL DEVSTS ; Get device status
JUMPF ERT (D6LGA) ; Failed .. line has gone away
LOAD T1,,SDLFG ; Get line status flags
TXNE T1,SDHWA ; Check for a hardware abort
JRST ERT (D6LGA) ; Yes .. line gone away
LOAD T1,,SDFLG ; Get device flags
TXNE T1,SDIEC ; Check for old input EOF still there
JRST [$DVCMD DC.CIE ; Clear the input EOF completed
JRST CKOABT] ; Start abort checking all over.
TXNN T1,SDOAS ; Has output abort occured?
$RETT ; No .. we are ok here
TXNN T1,SDOAC ; Has the abort completed?
JRST [SNOOZE SEC ; No .. sleep for a second
JRST CKOABT] ; Go check the status again
$DVCMD (DC.COA) ; Clear output abort flag
SKIPF ; Failed to clear flag
MOVX S1,D6IOE ; Cleared .. I/O error occured
$RETF ; Give failure return for all
SUBTTL Pack a unique device descriptor
; Routine - PCKPDD
;
; Function - To pack the PORT, LINE, DEVICE-TYPE and UNIT numbers into a single
; word to use as a unique descriptor of that device. This is useful so
; that when searching tables we will only have to do single word compares.
;
; Parameters -
;
; S1/ dev-type#,,unit#
; S2/ port#,,line#
;
; Returns -
;
; S1/ port,line,dev,unit each in 9 bits
PCKPDD: $SAVE <T1,T2> ; Save a couple registers
HLL T1,S2 ; Get port number into LH
HLR T1,S1 ; Get device type number into RH
LSH T1,^d9 ; Shift them up to where they need be
TLZ T1,777 ; Clear out where line # will be
HRL T2,S2 ; Get line number into LH
HRR T2,S1 ; Get unit number into RH
AND T2,[777,,777] ; Clear out where port and device go
IOR T1,T2 ; Put them all together
MOVE S1,T1 ; and it's magic. (all packed into A)
$RETT ; Only a true return
SUBTTL Create/destroy a handle list entry
; Routine - ALCHAN
;
; Function - To create a new handle list entry in the handle list. This routine
; also initializes the needed values to talk to FEI%O.
;
; Parameters - none
;
; Returns -
;
; S2/ Location of the new handle list entry
ALCHAN: $SAVE <S1> ; Save a register
SKIPGE S1,HANLST ; Check for a handle list already
$CALL L%CLST ; No .. so create one
MOVEM S1,HANLST ; Save the name of the handle list
MOVX S2,H$SIZ ; Get the size of a handle entry
$CALL L%CENT ; Create a handle list entry
MOVE S1,DEFTHR ; Get the default threshold
STORE S1,(S2),H$THR ; and save it for this dummy
SETO S1, ; Set the bytes per message to
STORE S1,(S2),H$BPM ; +infinity so commands go through
$RETT ; Only success can be had.
; Routine - RLSHAN
;
; Function - To release a handle list entry and to optionally let the
; logical front end device (TOPS20) go back to the monitor pool.
; The reason that this routine searches for the handle entry in the
; list instead of assuming that the CURRENT entry is the one being
; used is that the CURRENT pointer may be changed when the TASK is
; descheduled whiling in a wait state.
;
; Parameters -
;
; S2/ Location of handle list entry
;
; This routine releases the logical front end when the handle list is
; empty.
RLSHAN: $SAVE <TF,S1,T1> ; Save a couple of registers
MOVE T1,S2 ; Make a copy of list entry address
SKIPGE S1,HANLST ; Get handle list name
PJRST RLSFE ; If no handle list .. go release FE
$CALL L%FIRST ; Point to first entry in list
JUMPF RLSFE ; If no first entry .. release FE
RLSH.1: CAMN T1,S2 ; Check for entry address
JRST RLSH.2 ; Yes .. so go kill the entry
$CALL L%NEXT ; Move onto the next entry
JUMPT RLSH.1 ; If an entry exists .. check it
PJRST RLSFE ; No more entries .. release FE
RLSH.2: MOVE S1,HANLST ; Get the handle list name
$CALL L%DENT ; Destroy the handle list entry
PJRST RLSFE ; Go conditionally release the FE
SUBTTL Enqueue a line or device for current task
; Routine - ENQLIN, ENQDEV
;
; Function -
; (ENQLIN) To block a line under 2780/3780 from use by any other process.
; This allows only one direction of I/O to proceed at a time.
;
; (ENQDEV) This routine blocks all others from ever using the device we
; are talking to so that two processes can't confuse him.
;
; Parameters -
;
; S1/ Packed device descriptor (Port/Line/Device/Unit)
ENQDEV: $SAVE <S1,S2> ; Save registers
$CALL QUEDEV ; Make argblk for device specific ENQ
JRST ENQ001 ; Go do the ENQ
ENQLIN: $SAVE <S1,S2> ; Save registers
$CALL QUELIN ; Make up argblk for line specific ENQ
ENQ001:
TOPS20 <MOVX S1,.ENQAA ; Get the enqueue function number
ENQ> ; and try to do it.
TOPS10 <HRLI S2,.ENQAA ; Put function number in left half
ENQ. S2,> ; try the enqueue.
$RETF ; False return if we can't ENQ
$RETT ; Do a true return
SUBTTL Enqueue a port for current task
; Routine - ENQD60
;
; Function -
; (ENQD60) To ENQ a DN60 front end to block others from using it while
; we are.
; Parameters -
;
; S1/ Packed device descriptor (Port/Line/Device/Unit)
ENQD60: $SAVE <S2> ; Save registers
$CALL QUED60 ; Make up the argblk for ENQ
TOPS20 <MOVX S1,.ENQBL ; Get the enqueue function number
ENQ> ; and try to do it.
TOPS10 <HRLI S2,.ENQBL ; Put function number in left half
ENQ. S2,> ; try the enqueue.
$RETF ; False return if we can't ENQ
$RETT ; Do a true return
SUBTTL Dequeue a port, line or device
; Routine - DEQD60, DEQDEV
;
; Function -
; (DEQD60) To dequeue a DN60 on a port so that others can use it again.
;
; (DEQDEV) To release a device off a 2780/3780/HASP station so that
; someone else can talk to it.
;
; Parameters-
;
; S1/ Packed device descriptor (Port/Line/Device/Unit)
DEQDEV: $SAVE <S1,S2> ; Save registers
$CALL QUEDEV ; Make arg block to DEQ specific device
JRST DEQ001 ; Go do the DEQ
DEQLIN: $SAVE <S1,S2> ; Save registers
$CALL QUELIN ; Make arg block to DEQ specific line
JRST DEQ001 ; Go DEQ the line
DEQD60: $SAVE <S1,S2> ; Save registers
$CALL QUED60 ; Make up the DEQ argblk
DEQ001:
TOPS20 <MOVX S1,.DEQDR ; Get the DEQ function code
DEQ>
TOPS10 <HRLI S2,.DEQDR ; Put function in LH w/ addr in rh
DEQ. S2,>
$RETF ; False return on error.
$RETT ; and give a true return on success
SUBTTL Create an ENQ/DEQ argument block for a port
; Routine - QUED60
;
; Function - To make up the argument block needed to ENQ/DEQ a specific port.
;
; Parameters -
;
; S1/ packed device descriptor (only port number used)
QUED60: $SAVE <S1> ; Save registers
MOVEI S2,QD60BF ; Location of ENQ D60 port string
ROT S1,6 ; Move high order port number around
DPB S1,QPRT1 ; and store it in string
ROT S1,3 ; Rotate around the low order number
DPB S1,QPRT0 ; and store that also
HRRM S2,ENQBLK+3 ; Store string loc in the byte pointer
MOVEI S2,ENQBLK ; Get the location of the ENQ/DEQ block
$RETT ; and do a true return
SUBTTL Create ENQ/DEQ argument block for a specific device
; Routine - QUEDEV
;
; Function - To make an argument block for the ENQ/DEQ monitor calls to lock
; or unlock a specific device. This is so that only one process can
; talk to a specific device during the life of that process or until
; it explicitly releases the device.
;
; Parameters -
;
; S1/ Packed device descriptor (port/line/device/unit)
; S2/ returns pointer to arg block here
QUEDEV: $SAVE <S1,T1,T2> ; Save registers
MOVEI S2,QDEVBF ; Get pointer to device Q' string
MOVE T2,S1 ; Put packed device descriptor in T2
LSHC T1,6 ; Shift up to high order port number
DPB T1,QPRT1 ; and store it
LSHC T1,3 ; Shift up the low order port number
DPB T1,QPRT0 ; and store that too.
LSHC T1,6 ; Shift up to high order line number
DPB T1,QLIN1 ; and store it
LSHC T1,3 ; Shift up the low order line number
DPB T1,QLIN0 ; and store it.
LSHC T1,3 ; Shift the first digit of device type
DPB T1,QDEV2 ; and store it
LSHC T1,3 ; Repeat for next two digits of the
DPB T1,QDEV1 ; device type number
LSHC T1,3
DPB T1,QDEV0
LSHC T1,6 ; Shift up the first unit number
DPB T1,QUNT1 ; and store it
LSHC T1,3 ; Get last number of unit and string
DPB T1,QUNT0 ; and store it too.
HRRM S2,ENQBLK+3 ; Store the pointer to the string
MOVEI S2,ENQBLK ; get the pointer to the ENQ block
$RETT ; Success and return
SUBTTL Create ENQ/DEQ argument block for a port/line
; Routine - QUELIN
;
; Function - To make up the argument block needed to ENQ/DEQ a whole station
; hung off a DN60 line.
;
; Parameters -
;
; S1/ PDD of the requested station
QUELIN: $SAVE <S1,T1,T2> ; Save registers
MOVEI S2,QLINBF ; Get pointer to line Q' string
MOVE T2,S1 ; Put packed device descriptor in T2
LSHC T1,6 ; Shift up to high order port number
DPB T1,QPRT1 ; and store it
LSHC T1,3 ; Shift up the low order port number
DPB T1,QPRT0 ; and store that too.
LSHC T1,6 ; Shift up to high order line number
DPB T1,QLIN1 ; and store it
LSHC T1,3 ; Shift up the low order line number
DPB T1,QLIN0 ; and store it.
HRRM S2,ENQBLK+3 ; Store the pointer to the string
MOVEI S2,ENQBLK ; and get the pointer to ENQ/DEQ blk
$RETT ; Only successful returns available
SUBTTL OPNFE -- Open a port and return JFN on TOPS20
TOPS20 <
; Routine - OPNFE
;
; Function - To open up a port and check out the 11
;
; Parameters -
;
; S1/ Packed device descriptor
OPNFE: SKIPN KSFLG ; Check for processor type known
$CALL PRCTYP ; No so type the processor
SKIPG KSFLG ; Check for a KS10 (2020)
JRST OPN.22 ; Yes .. so go flush DDCMP buffers
$SAVE <S2,T1,T2> ; Save registers
ACVAR <PDD,FENM> ; Temporary location to save the packed
; device descriptor code and FEn
MOVE PDD,S1 ; Save the PDD
SETZM LSTDTE ; Force a new DTE selection
LOAD S1,PDD,PD$PRT ; Get port number to work on.
SKIPE FEJFN ; If JFN already assigned .. then
PJRST SELDTE ; just go select the DTE
MOVX FENM,1 ; Start with FE device FE1:
MOVE S1,PDD ; Get the packed device descriptor
$CALL ENQD60 ; Enqueue the port and get a JFN.
OPFE2: MOVE S1,FENM ; Get the next FE number to try to get.
CAILE S1,MAXFE ; Check if have run out of FE:'s
JRST OPDIE ; Yes .. so let go and crap out.
$CALL FENAM ; Make up the front end name
MOVX S1,GJ%OLD+GJ%SHT ; Old file, short form of GETJFN
GTJFN ; and try it.
ERJMP OPERR1 ; Didn't get it.
MOVEM S1,FEJFN ; Save the JFN for everyone
MOVX S2,FLD(^d8,OF%BSZ)+OF%RD+OF%WR ; Read/write in 8 bit mode
OPENF ; Try to open the FE
ERJMP OPERR2 ; nope can't do it to this one.
OPNSEL: LOAD S1,PDD,PD$PRT ; Get the DTE number from the PDD
$CALL SELDTE ; Go select the DTE
JUMPF OPERR3 ; Didn't select properly
MOVE S1,PDD ; Get the PDD back again so that
PJRST DEQD60 ; we can release the port and return.
; Here if GTJFN fails on FEn:
OPERR1: CAIN S1,GJFX29 ; Device available?
AOJA FENM,OPFE2 ; No .. so try next one
JRST OPCLR ; Yes it was so just die.
; Here if the DTE select fails
OPERR3: EXCH S1,FEJFN ; Save error and get JFN of FE device
IORX S1,CZ%ABT ; Set abort and close flag
CLOSF ; Close the FE device
ERJMP OPCLR ; Can't release FE device so die
JRST OPERRX
; Here if OPENF fails
OPERR2: EXCH S1,FEJFN ; Get the JFN of the FE
RLJFN ; Release the JFN
ERJMP OPCLR ; Can't release the FE so die.
OPERRX: HRRZ S1,FEJFN ; Get the error code back again
CAIE S1,OPNX9 ; Check for simultaneous access or
CAIN S1,OPNX7 ; for device already assigned
AOJA FENM,OPFE2 ; Yes .. so go try another one
JRST OPCLR ; No .. we have some other error
; Here on fatal errors that need to dequeue the port
OPCLR: SETZM FEJFN ; Clear the JFN before returning
OPDIE: EXCH S1,PDD ; Get the device descriptor
$CALL DEQD60 ; Get rid of the port
EXCH S1,PDD ; Get the fatal error back
$RETF ; And give a failure (false) return.
; Routine - FENAM
;
; Function - To make a name string for a specific front end number. i.e. for
; front end number 1 we want string "FE1:".
;
; Parameters -
;
; S1/ FE#
; S2/ returns pointer to string
FENAM: MOVE T2,[POINT 7,FEDEVS,13] ; Point to byte for first digit
LDB T1,[POINT 3,S1,32] ; First octal digit
JUMPE T1,FEN1 ; If zero then suppress it
ADDX T1,"0" ; else make it ASCII
IDPB T1,T2 ; and store it in the name
FEN1: LDB T1,[POINT 3,S1,35] ; Get 2nd octal digit
ADDX T1,"0" ; make it ASCII
IDPB T1,T2 ; and store it in name
MOVX T1,":" ; Device name terminator
IDPB T1,T2 ; store in the name
SETZ T1, ; And the null byte
IDPB T1,T2 ; to make it an ASCIZ string
MOVE S2,[POINT 7,FEDEVS] ; Pointer to name string
$RETT ; and only a true return
SUBTTL OPNFE -- Routine to check out the 11 for 2020 TOPS20
; Routine - OPNFE
;
; Function - Under TOPS20 on a 2020 this routine checks to see if the front
; end is up and running. It as a side effect also checks to see
; if our DDCMP link to the DN200 is running.
; If any messages are in the input queue, it is assumed that they
; are garbage left from a fatally exited process. They are then
; flushed and thrown away.
OPN.22: $SAVE <T1,T2,T3,S1,S2> ; Save a register
LOAD T2,(S2),H$PRT ; Get the port number
SUBI T2,DTEOFF ; Remove the DTE offset
STORE T2,(S2),H$HPR ; Store back the DMC line number
LOAD T3,(S2),H$PDD ; Get packed device descriptor
MOVE S1,T3 ; Move to where enq routine expects it
$CALL ENQD60 ; ENQ the line
OPFE.1: MOVEI S2,BTARG ; Point to BOOT argument block
MOVEM T2,.BTDTE(S2) ; Set it as the DTE/line in BOOT block
MOVX T1,^D500 ; Abitrarily large number of bytes
MOVMM T1,.BTLEN(S2) ; Set number of bytes to read
MOVE T1,[POINT 8,XMSG] ; Point to flush buffer
MOVEM T1,.BTMSG(S2) ; Set pointer to 8 bit byte area
MOVX S1,.BTRDD ; Read DDCMP message function
BOOT ; Do the read
ERJMP ERT (D6CTF,OPFE.2) ; BOOT JSYS failed
SKIPE .BTLEN(S2) ; Check for no message returned
JRST OPFE.1 ; Message there .. continue Q flush
JRST OPFE.3 ; No more .. so return
OPFE.2: TDZA TF,TF ; Set error flag
OPFE.3: SETOM TF ; or set success flag
$SAVE <TF,S1> ; Save the failure flag and result code
MOVE S1,T3 ; Get the PDD again
PJRST DEQD60 ; Release the line and return
SUBTTL PRCTYP -- Routine to type the processor
; Routine - PRCTYP
;
; Function -
;
; This routine determines whether we are running on a KL or KS system.
;
; Parameters - none
;
; Returns - True always
;
; KSFLG/ 1 if KL, -1 if KS
PRCTYP: $SAVE <S1,S2> ; Save some registers
MOVX S2,1 ; Set to processor type KL20
MOVE S1,[.ABGAD,,.FHSLF] ; Try to get address break
ERJMP [SETO S2, ; No .. set processor to KS20
JRST .+1]
MOVEM S2,KSFLG ; Store process type flag
$RETT
> ;End if TOPS20
SUBTTL OPNFE -- Routine to check out the 11 for TOPS10
TOPS10 <
; Routine - OPNFE
;
; Function - Under TOPS10 to check to see if the 11 is up and running the
; proper program. This will also (obviously) catch if there is a FE
; there at all.
;
; Parameters -
;
; S1/ PDD (packed device descriptor)
;
; Returns - CAL11. error codes
OPNFE: $SAVE <T1,P2> ; Save registers
MOVEI P2,C11BLK ; Get location of CAL11. arg block
LOAD T1,S1,PD$PRT ; Get the port number from handle list
STORE T1,(P2),C$PRT ; Store it in the CAL11. block
MOVX T1,.C11UP ; CAL11. function to check up/down
STORE T1,(P2),C$FNC ; status of the FE
MOVE T1,[1,,C11BLK]
CAL11. T1, ; Well ... check it.
$RETF ; It didn't go.
CAIE T1,1 ; Check for 11 up?
JRST ERT (D6DNR) ; DN60 not running
MOVX T1,.C11NM ; Function to get program name from 11
STORE T1,(P2),C$FNC ; to see if it is our kind.
MOVE T1,[1,,C11BLK]
CAL11. T1,
$RETF ; Doesn't like us for some reason
CAME T1,[SIXBIT /DN60 /] ; Check for running DN60 type code
JRST ERT (D6DNR) ; No .. not running DN60 code
$RETT ; Else we are golden, give good return.
> ;End if TOPS10
SUBTTL Release front end for any device
; Routine - RLSFE
;
; Function - To release the remote device association with the front end.
; What this actually does is close the TOPS20 front end JFN
; if it is determined that there are no more devices in this
; process that are using the FE JFN.
RLSFE:
TOPS20 <
$SAVE <TF,S1> ; Save last error flag and return code
SKIPG KSFLG ; If a 2020 then just return
$RET ; saying that front end is released
SKIPGE S1,HANLST ; Get list name again
$RET ; If no handle list .. just return
$CALL L%FIRST ; Position to first entry
JUMPT .POPJ ; If entry found then return
MOVE S1,FEJFN ; Last entry in list is destroyed
IORX S1,CZ%ABT ; Don't try to clean up any FE buffers
CLOSF ; Close the front end
JFCL ; Ignore errors
SETZM FEJFN ; Clear the front end JFN
SETZM LSTDTE ; and the last port with it.
>; End if TOPS20
$RET ; Return saying that it is done.
SUBTTL Search handle linked list for PDD
; Routine - SRCPDD
;
; Function - To search the linked list that contains all the info about all the
; active handles to see if a device specified is already in the list.
;
; Parameters -
;
; S1/ PDD (packed device descriptor)
;
; Returns -
;
; True Found the PDD in the table, the current pointer points to it.
; False Didn't find the PDD in the table, the current pointer points to
; where it was before starting the search
SRCPDD: $SAVE <S1,T1,T2> ; Save registers
MOVE T1,S1 ; Put the PDD into another register so
; S1 can be used for subr linkage.
SKIPGE S1,HANLST ; Check to see if the list is created
$CALL L%CLST ; and make it if not.
MOVEM S1,HANLST ; Save the list name for future tests.
$CALL L%CURR ; Point to current entry
JUMPF SRCFST ; if none .. start at first entry
LOAD T2,(S2),H$PDD ; Get the handle in the entry
CAMN T1,T2 ; Check if this is the one
$RETT ; Yes .. then looking for current one
SRCFST: MOVE S1,HANLST ; Reset list name in case of error
$CALL L%FIRST ; Point to first entry in list
JUMPF @.RETF ; No entries ... so not found
SRCLOP: LOAD T2,(S2),H$PDD ; Get the PDD field in the entry
CAMN T1,T2 ; Compare the PDD against list entry
$RETT ; good compare ... this is it.
$CALL L%NEXT ; Move onto the next list entry
JUMPT SRCLOP ; If no error then assume entries left.
$RETF ; else give a false return
SUBTTL Search handle linked list for handle
; Routine - SRCHAN
;
; Function - To search the linked list that contains all the info about all the
; active handles to see if a device specified is already in the list.
;
; Parameters -
;
; S1/ Handle of device (received from D60OPN)
;
; Returns -
;
; True Found handle in the table, the current pointer points to it.
; False Didn't find handle in the table, the current pointer points to
; where it was before starting the search
SRCHAN: $SAVE <S1,T1,T2> ; Save registers
MOVE T1,S1 ; Put the PDD into another register so
; that S1 can be used for subr linkage
SKIPGE S1,HANLST ; Check to see if the list is created
$CALL L%CLST ; and make it if not.
MOVEM S1,HANLST ; Save the list name for future tests.
$CALL L%CURR ; Point to the current entry
JUMPF HSRFST ; If no current .. start at first
LOAD T2,(S2),H$HAN ; Get the handle in the entry
CAMN T1,T2 ; See if it is the one we want
$RETT ; Yes .. so point at this current one
HSRFST: MOVE S1,HANLST ; Reset list name in case of error
$CALL L%FIRST ; Point to first entry in list
JUMPF @.RETF ; No entries ... so not found
HSRCLP: LOAD T2,(S2),H$HAN ; Get the handle field in the entry
CAMN T1,T2 ; Compare the handle against list entry
$RETT ; good compare ... this is it.
$CALL L%NEXT ; Move onto the next list entry
JUMPT HSRCLP ; If no error then assume entries left.
$RETF ; and give a false return
SUBTTL Return port status
; Routine - PRTSTS
;
; Function - To get the status of a port specified in the given PDD.
;
; Parameters -
;
; S2/ Pointer to handle list entry
;
; Returns -
PRTSTS: $SAVE <T1,T2> ; Save registers
ACVAR <ARGP> ; Pointer to port argument block
$CALL ALCARG ; Allocate a FEI%O argument block
MOVE ARGP,S1 ; Save another copy of arg blk ptr
MOVX T1,FC.R6S ; Function to read port status
MOVEM T1,(ARGP) ; Put into argument block
DMOVE T1,[EXP -D6.BYT ; Reinitialize the byte count
POINT 8,STSBUF] ; and byte pointer, may be destroyed
DMOVEM T1,1(ARGP)
$CALL FEI%O ; I/O to the front end (Device status)
SETZ S1, ; Default to no error occured
SKIPT ; If an error occured
LOAD S1,(ARGP),ARG$RC ; get the result code
EXCH S1,ARGP ; Exchange error code and blk ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGP ; Get the error code again
JUMPE S1,@.RETT ; If no error then give success
$RETF ; else give error return
SUBTTL Return device status
; Routine - DEVSTS
;
; Function - To get the status of a device specified in the given PDD.
;
; Parameters -
;
; S2/ Pointer to handle list entry
;
; Returns -
DEVSTS: $SAVE <T1,T2> ; Save registers
ACVAR <ARGD> ; Pointer to device argument block
$CALL ALCARG ; Allocate a FEI%O argument block
MOVE ARGD,S1 ; Save another copy of arg blk ptr
MOVX T1,FC.RDS ; Function to read device status
MOVEM T1,(ARGD) ; Put into argument block
DMOVE T1,[EXP -DS.BYT ; Reinitialize the byte count
POINT 8,STSBUF] ; and byte pointer, may be destroyed
DMOVEM T1,1(ARGD)
$CALL FEI%O ; I/O to the front end (Device status)
SETZ S1, ; Default to no error occured
SKIPT ; If an error occured
LOAD S1,(ARGD),ARG$RC ; get the result code
EXCH S1,ARGD ; Exchange error code and blk ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGD ; Get the error code again
JUMPE S1,@.RETT ; If no error then give success
$RETF ; else give error return
SUBTTL Return line status
; Routine - LINSTS
;
; Function - To get the status of a line specified in the given PDD.
;
; Parameters -
;
; S2/ Pointer to handle list entry
;
; Returns -
LINSTS: $SAVE <T1,T2> ; Save registers
ACVAR <ARGL> ; Pointer to line argument block
$CALL ALCARG ; Allocate a FEI%O argument block
MOVE ARGL,S1 ; Save another copy of arg blk ptr
MOVX T1,FC.RLS ; Function to read line status
MOVEM T1,(ARGL) ; Put into argument block
DMOVE T1,[EXP -LS.BYT ; Reinitialize the byte count
POINT 8,STSBUF] ; and byte pointer, may be destroyed
DMOVEM T1,1(ARGL)
$CALL FEI%O ; I/O to the front end (Device status)
SETZ S1, ; Default to no error occured
JUMPT LNST.5 ; If no error .. continue on
SETZM STSBUF ; Clear first word in status buffer
MOVE S1,[XWD STSBUF,STSBUF+1] ; Point to the status buffer and
BLT S1,STSBUF+<LS.BYT-1>/4 ; clear all words
LOAD S1,(ARGL),ARG$RC ; Get the failure result code
LNST.5: EXCH S1,ARGL ; Exchange error code and blk ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGL ; Get the error code again
JUMPE S1,@.RETT ; If no error then give success
$RETF ; else give error return
SUBTTL SETIOM -- Set the I/O mode of a device
; Routine - SETIOM
;
; Function - To determine whether a device is setup to do input or output and
; save a flag in the handle list entry for future reference.
;
; Parameters -
;
; S2/ Location of handle list entry
SETIOM: $SAVE <S1,T1> ; Save a couple of registers
LOAD S1,(S2),H$STY ; Get the station type code
CAIN S1,SLHSP ; Check for a HASP station
JRST STHSP ; Yes .. go get IOM from device status
SETZ T1, ; On 2780/3780 figure out IOM
LOAD S1,(S2),H$DEV ; from the device type
CAIN S1,.OPCDR ; which if it is a card reader
MOVX T1,1 ; then it's doing input
LOAD S1,(S2),H$TEM ; unless we are in
SKIPE S1 ; emulation mode in which case
TXC T1,1 ; the I/O goes in the other direction
JRST SETDNE ; Done figuring out for a 2780/3780
STHSP: LOAD S1,(S2),H$DEV ; Get D60OPN device number
CAIN S1,.OPSGN ; Check for signon device
JRST STHP.1 ; Yes .. so infer default of input
CAIE S1,.OPCIN ; Check for console input device
CAIN S1,.OPCOU ; or for console output device
CAIA ; Yes .. set I/O mode
JRST HSPDEV ; No .. so get I/O mode from DN60
SETZ T1, ; Default to output device
CAIN S1,.OPCIN ; Check for console input device
STHP.1: MOVX T1,1 ; Yes so set to input mode
LOAD S1,(S2),H$TEM ; Get termination/emulation mode flag
SKIPE S1 ; Check for termination
TXC T1,1 ; No .. so reverse the I/O direction
JRST SETDNE ; Go store mode and return
HSPDEV: $CALL DEVSTS ; Get the device status
JUMPF @.RETF ; Can't get status so fail.
LOAD T1,,SDFLG ; Get the flags on the device
LOAD T1,T1,SDIOM ; Get the I/O mode flag
SETDNE: STORE T1,(S2),H$IOM ; Save the I/O mode for this device
$RETT ; Return succesfully
SUBTTL ALCARG, RLSARG -- FEI%O argument block allocation/release
; Routine - ALCARG
;
; Function - This routine allocates a dynamic argument block for use with
; FEI%O.
;
; Parameters -
;
; S1/ Pointer to block returned here
ALCARG: $SAVE <S2> ; Save a GLX parameter register
MOVX S1,ARGSIZ ; Size of argument block
$CALL M%GMEM ; Get from GLX memory mangler
MOVE S1,S2 ; Move pointer to return register
$RET ; Return, ignoring errors
; Routing - RLSARG
;
; Function - This routine releases a FEI%O argument block that was allocated
; with ALCARG.
;
; Parameters -
;
; S1/ Location of argument block
RLSARG: $SAVE <TF,S1,S2> ; Save GLX parameter register
MOVE S2,S1 ; Move block pointer
MOVX S1,ARGSIZ ; Size of argument block
PJRST M%RMEM ; Give it back to GLXLIB and return
SUBTTL LINCMD, DEVCMD -- Output a line (device) command
; Routine - LINCMD, DEVCMD
;
; Function - To output a DN60 line (device) command to the line (device)
; specified in the handle entry.
;
; Parameters -
;
; S1/ Line (device) command function code
; S2/ Handle list entry
; T1/ Command value (optional)
LINCMD: ACVAR <ARGC,FC,CLEN> ; Arg blk ptr, func code, cmd length
MOVX FC,FC.WLC ; Function code to write a line command
MOVE CLEN,LNCBYT(S1) ; Get number of bytes in value for cmd
JRST CNTCMD ; Continue on common command code
DEVCMD: ACVAR <ARGC,FC,CLEN> ; Arg blk ptr, func code, cmd length
MOVX FC,FC.WDC ; Function code to write a device cmd
MOVE CLEN,DVCBYT(S1) ; Get number of bytes in cmd string
CNTCMD:
LOAD TF,(S2),H$THR ; Get offline threshold for device
PUSH P,TF ; Save the offline threshold
SETZ TF, ; Set threshold so that when a delay
STORE TF,(S2),H$THR ; occurs .. off line returns
MOVE ARGC,S1 ; Save the command number
$CALL ALCARG ; Allocate a FEI%O arg block
EXCH S1,ARGC ; Swap arg blk ptr and command number
STORE FC,(ARGC),ARG$FC ; Save the function code (write cmd)
STORE S1,(ARGC),CMD$FC ; Put command function in cmd string
CAIN CLEN,1 ; Check for only 1 byte in cmd string
JRST SNDCMD ; Yes .. so no data follows it.
CAIN CLEN,2 ; Check for 2 bytes in cmd string
JRST B1CMD ; Yes .. so 1 byte of data follows
STORE T1,(ARGC),CMD$2B ; Otherwise we have 2 bytes of data
JRST SNDCMD ; to send
B1CMD: STORE T1,(ARGC),CMD$1B ; Store the single byte of cmd data
SNDCMD: MOVNS CLEN ; Make the byte count and
SNDC.1: MOVE S1,[POINT 8,] ; Make a pointer to the command string
HRRI S1,CMD$WD(ARGC) ; in dynamic memory
STORE S1,(ARGC),ARG$PT ; Put it into the FE I/O arg block
STORE CLEN,(ARGC),ARG$BC ; Set the number of bytes to output
MOVE S1,ARGC ; Point to the arg block
$CALL FEI%O ; and do the I/O to the front end
SETZ S1, ; Default to no error occured
JUMPF [LOAD S1,(ARGC),ARG$RC ; Get the result code on error
CAIE S1,D6DOL ; Check for device off line (delayed)
JRST .+1 ; Nope .. some other obtuse error
SNOOZE SEC ; Yes .. sleep for a second and
JRST SNDC.1] ; retry until it works
EXCH S1,ARGC ; Exchange error code and blk ptr
$CALL RLSARG ; Release the argument block
MOVE S1,ARGC ; Get the error code again
POP P,TF ; Get real offline threshold back
STORE TF,(S2),H$THR ; and put into handle list entry
JUMPE S1,@.RETT ; If no error then give success
$RETF ; else give error return
SUBTTL Routines -- SWAPB, SWAP32
; Routines - SWAPB, SWAP32
;
; Function - To swap the bytes in 16 bit numeric values before they are
; shipped to the DN60 front end. This is needed because the FE
; always swaps the bytes so that text strings are properly accessable.
;
; Parameters -
;
; T1/ Value be swapped
; SWAPB returns the 16 bit value in the lower order 15 bits of T1
SWAPB: $SAVE <S1,S2> ; Save a couple of registers
SETZB S1,S2 ; Clear them out
ROTC S2,-^d8 ; Shift high order byte into S2
LSHC S1,^d8 ; Shift it into S1
ROTC S2,-^d8 ; Shift the low order byte into S2
LSHC S1,^d8 ; Shift it lower into S1
MOVE T1,S1 ; Move to return value
$RET ; Give any old return .. no T/F
REPEAT 0,<
; SWAP32 Reverses the order of the 4 8bit bytes in T1
SWAP32: $SAVE <S1,S2> ; Save a couple of registers
SETZB S1,S2 ; Clear them out
ROTC S2,-^d8 ; Shift the high order byte
LSHC S1,^d8 ; Put into bottom of S1
ROTC S2,-^d8 ; Shift next byte down
LSHC S1,^d8 ; Put below MSB in S1
ROTC S2,-^d8 ; Same for 3rd byte
LSHC S1,^d8 ; and add into S1
ROTC S2,-^d8 ; Shift the LSB into S2
LSHC S1,^d8 ; Put as lowest byte in S1
MOVE T1,S1 ; Return value
$RET ; and go back
> ;End REPEAT 0
SUBTTL Select a DTE on the open FEn device
TOPS20 <
; Routine - SELDTE
;
; Function - To select which DTE is currently attached to the FEn: device
; that was previously opened. This routine assumes that the caller
; has already enq'd the port.
;
; Parameters -
;
; S1/ DTE # to be selected
;
; Returns -
;
; True was successful
; False MTOPR Jsys failed and the error code is in S1
;
; Note - It has been verified by looking at the monitor listings that this
; routine does not need the port ENQ'd before selecting the DTE.
SELDTE: MOVX S2,.MODTE ; Select the appropriate DTE
HRROI T1,-10(S1) ; Get the port number
CAMN T1,LSTDTE ; Was it the same as the last one used?
$RETT ; Yes so assume he is still set up.
HRRZ T1,T1 ; Make it only the DTE number
MOVE S1,FEJFN ; Use the FE JFN already opened
MTOPR ; Do the select
ERJMP DSLERR ; Didn't work, bad DTE
HRROM T1,LSTDTE ; Save the last DTE to be selected
$RETT ; It is now selected on the DTE
DSLERR: SETZM LSTDTE ; Clear the last DTE selected (none)
MOVX S1,.FHSLF ; Get the last error that occured
GETER ; in this process
HRRZ S1,S2 ; Set the error value
$RETF ; and return flaging failure.
>; End if TOPS20
SUBTTL FEI%O -- Front end I/O interface
; Routine - FEI%O
;
; Function - To do I/O to a device as specified by an argument block and the
; data in the specified handle list entry.
;
; Parameters -
;
; S1/ Location of argument block
; S2/ Pointer to handle list entry
;
; argument block format:
; 0/ function code
; 1/ negative number of bytes to transfer
; 2/ byte pointer to buffer to transfer from/to
; 3/ number of bytes actually transfered
; 4/ result code from I/O
FEI%O:
SUBTTL FEI%O -- TOPS20 SIN/SOUT front end interface (.C11QU functions)
TOPS20 <
$SAVE <P1,P2,T1,T2,T3,T4> ; Save registers
DMOVE P1,S1 ; Set up arg and handle structure ptrs
SETZM NBXFRD(P2) ; Clear the number of bytes transfered
SETZM NBSDLY(P2) ; Clear number of bytes since last dly
LOAD S1,(P2),H$PRT ; Get the DTE #
CAIL S1,DTEOFF ; Check to see if the DTE # is within
CAILE S1,MAXDTE ; valid bounds
JRST ERT (D6NSP,FIOFAI) ; Port number not defined
SKIPL KSFLG ; Check for KL style I/O
JRST [$CALL SELDTE ; Make the link to the correct DTE
JUMPF FIOFAI ; If didn't work give error return
JRST .+1] ; Go back to inline code
LOAD T1,(P1),ARG$BC ; Get the number of bytes to transmit
JUMPGE T1,ERT (D6CNN,FIOFAI) ; Must be greater than zero bytes
MOVEM T1,NBTXFR(P2) ; Save number of bytes yet to transfer
LOAD S1,(P2),H$PDD ; Get device descriptor
$CALL ENQD60 ; Enqueue the port for SIN/SOUT I/O
LOAD T1,(P1),ARG$PT ; Get the pointer to the buffer area
HLRZ T2,T1 ; Get the position/size part
CAIN T2,-1 ; If it is a HRRO type byte pointer
HRLI T1,440700 ; then convert it to a real byte pntr
STORE T1,(P1),ARG$PT ; Put the byte pointer back
LOAD T1,(P1),ARG$FC ; Get function code to perform
STORE T1,,XMTFC ; Put it into 2nd byte in header
LOAD T1,(P2),H$LIN ; Get line number to do I/O to.
STORE T1,,XMTLN ; Put it into 3rd byte in header
LOAD T1,(P2),H$CDV ; Get communications device number
STORE T1,,XMTDV ; Put the device code in the 4th byte
LOAD T1,(P1),ARG$FC ; Get the function we are doing
TRNN T1,1 ; If it is odd then we do a read
JRST WRITE ; else we are doing a write operation.
JRST READ ; Go do read
SUBTTL FEI%O -- Read in from device (TOPS20)
READ: $CALL PUTHDR ; Output the header to say read data
$FELOG (BEFORE) ; Log "BEFORE" event on FE device
JUMPF FIOFDQ ; Header failure test
$CALL GETHDR ; Get the response header
JUMPF FIOFDQ ; Input header no good
LOAD S1,,RCVRC ; Get the result of the header
CAIN S1,RC.REJ ; Check for reject of header
JRST FIOFDQ ; If so .. terminate this read
CAIE S1,RC.DLY ; Check for a delayed return
JRST READOK ; No .. so continue on reading
LOAD S1,(P2),H$DLY ; Get the transfered delayed count
AOJ S1, ; Increment the number of delays
STORE S1,(P2),H$DLY ; and save it for next check
LOAD S2,(P2),H$THR ; Get the off-line threshold
CAML S1,S2 ; Check for off-line by inference
JRST ERT (D6DOL,FIOFDQ) ; Yes .. too long to respond
$FELOG (AFTER) ; Log that a delay has occured
$CALL FIOSLP ; Dismiss while waiting for -11 to
JRST READ ; catch up .. then try again
READOK: LOAD T1,,RCVBC ; Number of bytes to read in
JUMPE T1,ERT (RC.REJ,FIOFDQ) ; Can't talk to FE if no bytes Xfer'd
MOVE S1,FEJFN ; Get JFN for logical FE
LOAD S2,(P1),ARG$PT ; Get byte pointer to data buffer
MOVN T1,T1 ; Negative the byte count to read
SKIPG KSFLG ; Check for 2020 style I/O
JRST RD.220 ; Yes so go do boots
SIN ; Read in the data string
ERJMP ERT (D6CTF,FIOFDQ) ; The input JSYS failed
STORE S2,(P1),ARG$PT ; Save the pointer to continue on
$CALL IOBRK ; Force all the input to be done
JUMPF FIOFDQ ; The force didn't work
JRST RD.WRK ; Input worked .. continue on
RD.220: $CALL RD2020 ; Do a 2020 style read data string
JUMPF FIOFDQ ; Input failed
STORE S2,(P1),ARG$PT ; Save byte pointer for continuation
RD.WRK: ZERO ((P2),H$DLY) ; Clear delayed return count
LOAD T1,,RCVBC ; Get the byte count to read again.
ADDM T1,NBXFRD(P2) ; Up the bytes transfered count
ADDB T1,NBTXFR(P2) ; Down the bytes yet to transfer
JUMPGE T1,FIOTDQ ; Test for no more bytes yet to move
LOAD T1,(P2),H$RTI ; Get return immediately on any data
JUMPN T1,FIOTDQ ; If set .. return on partial transfer
$FELOG (AFTER) ; Log that partial read has been done
JRST READ ; Go continue transfer
SUBTTL FEI%O -- Write out to device (TOPS20)
WRITE: $CALL PUTHDR ; Output the transmit header
$FELOG (BEFORE) ; Log "BEFORE" event on FE device
JUMPF FIOFDQ ; The header transmission failed
MOVE S1,FEJFN ; Get the JFN to do I/O on
LOAD S2,(P1),ARG$PT ; Point to the string to output
LOAD T1,,XMTBC ; Number of bytes to output
MOVN T1,T1 ; Make negative for JSYS size delimit
SKIPG KSFLG ; Check for 2020 style I/O
JRST WR.220 ; Yes .. go do the BOOTS
SOUT ; Output the string
ERJMP ERT (D6CTF,FIOFDQ) ; The SOUT failed .. can't talk to FE
MOVEM S2,LSTPNT(P2) ; Save the pointer to last byte
$CALL IOBRK ; Force the output to the -11
JUMPF FIOFDQ ; Die if the output didn't go to -11
JRST WRT.23 ; Data output just fine .. continue
WR.220: $CALL WR2020 ; Output string 2020 style
JUMPF FIOFDQ ; Output failed .. release the device
MOVEM S2,LSTPNT(P2) ; Save the updated byte pointer
WRT.23: $CALL GETHDR ; Get the -11's reply to transmission
JUMPF FIOFDQ ; Die if we can't get the result
LOAD S1,,RCVRC ; Get the result code
CAIN S1,RC.REJ ; Check for a reject
JRST FIOFDQ ; and if so .. give failure return
LOAD T1,,RCVBC ; Get the number of bytes sent
ADDM T1,NBXFRD(P2) ; add onto number of bytes transfered
ADDM T1,NBSDLY(P2) ; add onto bytes since last delay
ADDB T1,NBTXFR(P2) ; Remove from number of bytes yet to do
CAIE S1,RC.DLY ; Check for a delayed I/O return
JRST WRTOK ; No .. so the -11 is ready
SETZM NBSDLY(P2) ; Clear bytes transfered since this dly
LOAD S1,(P2),H$DLY ; Get the delayed count
AOJ S1, ; Increment it
STORE S1,(P2),H$DLY ; and save it back
LOAD S2,(P2),H$THR ; Get the offline threshold
CAML S1,S2 ; Check for offline inference
JRST ERT (D6DOL,FIOFDQ) ; Yes .. the device seems offline
$FELOG (AFTER) ; Log that a delay has occured
$CALL FIOSLP ; Dismiss process for a while
JRST WRITE ; Go retry to output
WRTOK: ZERO ((P2),H$DLY) ; Clear the delayed output counter
MOVE S2,LSTPNT(P2) ; Get the pointer to last byte
STORE S2,(P1),ARG$PT ; Save byte pointer to next byte
JUMPGE T1,FIOTDQ ; If none left .. then successful
$FELOG (AFTER) ; Log partial transfer done
MOVE S1,NBSDLY(P2) ; Get number of bytes since last delay
CAIL S1,RLSTHR ; Check against release threshold
$CALL FIOSLP ; Yes .. let go for a second
JRST WRITE ; Go finish writing
SUBTTL FEI%O -- Routine PUTHDR, GETHDR, IOBRK (TOPS20)
; Routine - PUTHDR
;
; Function - To create a transmit header for read/write function that contains
; the number of bytes to read/write in it. This routine is invoked before
; each read/write is done if more data is needed to be read/written.
; This routines also transmits the header and makes sure that it has gone
; out.
PUTHDR: MOVM T1,NBTXFR(P2) ; Get # of bytes left to read/write
LOAD T2,(P2),H$BPM ; Get number of bytes per message
SKIPG KSFLG ; Check for DDCMP (2020) line
MOVX T2,^O274 ; Max number of bytes for DMC driver
CAMLE T1,T2 ; Check to see if number of bytes legal
MOVE T1,T2 ; Too many .. truncate 1st message
STORE T1,,XMTBC ; Store in the # bytes to transfer cnt
MOVE S1,FEJFN ; Get the JFN for the FE
MOVE S2,[POINT 8,XMTHDR] ; Point to the transmit header
MOVX T1,-6 ; Get the string byte count
SKIPG KSFLG ; Check for 2020 style I/O
JRST PTH.22 ; Yes .. go do the BOOTS
SOUT ; Output the header to the device
ERJMP ERT (D6CTF) ; Can't talk to FE
PJRST IOBRK ; Make sure the header gets output.
PTH.22: $CALL WR2020 ; and output the header 2020 style
$RET ; Propagate return success/failure
; Routine - GETHDR
;
; Function - To read a receive header from the port that we are currently
; talking to.
GETHDR: MOVE S1,FEJFN ; Get the JFN of the FE
MOVE S2,[POINT 8,RCVHDR] ; Point to the receive header string
MOVX T1,-6 ; 6 bytes in the header
SKIPG KSFLG ; Check for 2020 style I/O
JRST GTH.22 ; Go do the BOOTS
SIN ; Read the header from the FE
ERJMP ERT (D6CTF) ; Can't talk to FE
PJRST IOBRK ; Force the header to be read
GTH.22: $CALL RD2020 ; Read header 2020 style
$RET ; Propagate error return code
; Routine - IOBRK
;
; Function - To create a break in the I/O stream and force the current buffers
; to be flushed or finished reading in.
IOBRK: MOVE S1,FEJFN ; Get the JFN of the FE device
MOVX S2,.MOEOF ; Get the EOF function
MOVX T1,1 ; Clear FE buffers w/o doing real EOF
MTOPR ; Force I/O completion
ERJMP ERT (D6CTF) ; Can't talk to FE
$RETT ; The I/O was completed succesfully.
; Routine - FIOSLP
;
; Function - This routine saves the transmission header before dismissing
; the process. This is needed during FEI%O (TOPS20) execution
; to insure if the host program is a multi-tasker, that the
; header is still intact and the port is DEQ/ENQ for others to use.
FIOSLP: $SAVE <XMTHDR,XMTHDR+1> ; Save the transmission header
LOAD S1,(P2),H$PDD ; Get the packed device descriptor
$CALL DEQD60 ; Release the port for some other task
FIOS.1: SNOOZE SEC*TIMDLY,IOWAIT ; Delay on time (or IO done if tasking)
LOAD S1,(P2),H$PDD ; Get the packec device desriptor again
$CALL ENQD60 ; Try to get the port back again
$RET
SUBTTL FEI%O -- Routines FIOTDQ, FIOFDQ, FIOFAI (TOPS20)
;
; Common return point for the FEI%O routines after the port has been ENQ'd.
; This is for good (successful) returns that give a zero result code.
;
FIOTDQ: LOAD S1,(P2),H$PDD ; Get the port number
$CALL DEQD60 ; Dequeue the port
ZERO ((P1),ARG$RC) ; Clear the result code for good signal
MOVE S1,NBXFRD(P2) ; Get the number of bytes transfered
STORE S1,(P1),ARG$XF ; and return that also
MOVE S1,NBTXFR(P2) ; Get number of bytes not transfered
STORE S1,(P1),ARG$BC ; Save it as the byte count
DMOVE S1,P1 ; Restore the arg registers
$FELOG (AFTER) ; Log the successful result from 11
$RETT ; Return with success
;
; Common failure return point before the port is enqueued
;
FIOFAI: STORE S1,(P1),ARG$RC ; Save the error result code
JRST FIOFD0 ; Go to common error exit
;
; Common failure return point .. Deq's the port and stores the error code
;
FIOFDQ: STORE S1,(P1),ARG$RC ; Save the result code
LOAD S1,(P2),H$PDD ; Get the packed device descriptor
$CALL DEQD60 ; Release the port
MOVE S1,NBTXFR(P2) ; Get number of bytes not transfered
STORE S1,(P1),ARG$BC ; Save it as the byte count
FIOFD0: MOVE S1,NBXFRD(P2) ; Get the number of bytes transfered
STORE S1,(P1),ARG$XF ; and return that also
DMOVE S1,P1 ; Restore the 2nd arg register
$FELOG (AFTER) ; Log the failed result from 11
$RETF ; Return type of a failure
SUBTTL Support for DN200 running DN65B code on a TOPS20 2020
; Routine WR2020
;
; Function - This routine is used to simulate the SOUT to a front end
; device. It actually ships the data over a synchronous link
; using DDCMP to a DN200
;
; Parameters -
;
; S1/ Ignored JFN
; S2/ Byte pointer to string
; T1/ Negative byte count
WR2020: SKIPLE T1 ; Check for valid byte count LSS 0
JRST ERT (D6CNN) ; Byte count not negative
MOVMM T1,.BTLEN+BTARG ; Set the byte count to transfer
MOVEM S2,.BTMSG+BTARG ; Set pointer to 8 bit byte area
LOAD S1,(P2),H$HPR ; Get synchronous line number
MOVEM S1,.BTDTE+BTARG ; Set it as the DTE/line in BOOT block
MOVEI S2,BTARG ; Get location of BOOT arg block
MOVX S1,.BTSDD ; Send DDCMP message to DN200
BOOT
ERJMP ERT (D6CTF) ; BOOT JSYS failed
MOVE S2,.BTMSG+BTARG ; Get update byte pointer
SETZ T1, ; Say that all the bytes where output
$RETT ; Sucess in sending data
; Routine RD2020
;
; Function - To read a string from a DN200 that is connected by a DDCMP
; synchronous link. This routine simulates the SIN JSYS that
; is normally used with a front end device.
;
; Parameters -
;
; S1/ Ignored JFN
; S2/ Byte pointer to input buffer
; T1/ Negative byte count to input
RD2020: DMOVEM S2,RDSAVE ; Save the read arguments
MOVX S1,20 ; Set up the retry counter so that
MOVEM S1,RETRY ; we try at least 2 seconds worth
LOAD S1,(P2),H$HPR ; Get synchronous line number
MOVEM S1,.BTDTE+BTARG ; Set it as the DTE/line in BOOT block
RD20ST: MOVMM T1,.BTLEN+BTARG ; Set the byte count to transfer
MOVEM S2,.BTMSG+BTARG ; Set pointer to data buffer
MOVEI S2,BTARG ; Get location of BOOT arg block
MOVX S1,.BTRDD ; Read DDCMP message function
BOOT ; Do the read
ERJMP ERT (D6CTF) ; BOOT JSYS failed
MOVE S1,.BTLEN+BTARG ; Get transfered length/error code
JUMPE S1,R20RTY ; If zero .. must try again
TXNN S1,BT%CTL ; Check for control message flag
JRST R20OK ; No .. so message was read ok
CAXE S1,BT%CTL+.BTCMP ; Transmission complete?
JRST ERT (D6DNR) ; No .. so front end not running
JRST R20AGN ; Try to read it again
R20RTY: SOSGE S1,RETRY ; Have we already tried enough?
JRST ERT (D6DNR) ; Yes .. so front end not running
MOVE S1,[DEC 1000,1000,1000,1000,1000,100,100,100
DEC 100,100,100,100,100,100,100,100](S1)
DISMS ; Increasing sleep increments
; with time
R20AGN: DMOVE S2,RDSAVE ; Get the arguments back again
JRST RD20ST ; Go try to read it again
R20OK: MOVE T1,S1 ; Get the count of bytes transfered
ADD T1,RDSLEN ; Make it minus the number yet to get
MOVE S2,.BTMSG+BTARG ; Get updated byte pointer
$RETT ; Success
>;End if TOPS20
SUBTTL FEI%O -- TOPS10 CAL11. interface (.C11QU function)
TOPS10 <
$SAVE <S1,S2,P1,P2,P3,T4> ; Save registers
DMOVE P1,S1 ; Setup regs for structure accesses
MOVX S1,C$SIZ ; Get size of a CAL11. argument block
$CALL M%GMEM ; Get a block from memory mangler
MOVE P3,S2 ; Point to the new, fresh block
PUSH P,[FIORET] ; Put memory release co-routine into
; return path
LOAD S2,(P2),H$PRT ; Get the port number
STORE S2,(P3),C$PRT ; Save it in the CAL11. block
LOAD S2,(P2),H$LIN ; Get the line number
STORE S2,(P3),C$LIN ; Save it also
LOAD S2,(P2),H$CDV ; Get device number to talk to
STORE S2,(P3),C$DEV ; Save in argument block
LOAD S1,(P1),ARG$FC ; Get the desired function to perform
STORE S1,(P3),C$FC ; Save in CAL11. argument block
MOVX S1,.C11QU ; We assume that all CAL11. functions
STORE S1,(P3),C$FNC ; are subfunctions of the "queue" func
LOAD S1,(P1),ARG$PT ; Get the byte pointer to the string
LOAD S2,S1,BP.ADR ; Get the address of the string
STORE S2,(P3),C$BFA ; and store as where the string starts
LOAD S2,S1,BP.SIZ ; Get the byte size
CAIN S2,77 ; Check for HRRO type byte pointer
MOVX S2,7 ; and if so assume ASCII (7bit)
MOVE S2,[0,,6 ; Get the number of bytes per word
0,,5 ; depending on the number of bits
0,,4]-6(S2) ; per byte in the string
STORE S2,(P3),C$BPW ; Save in CAL11. bytes per word entry
LOAD S2,S1,BP.POS ; Get the position of the first byte
CAIN S2,77 ; Check again for a HRRO pointer
MOVX S2,44 ; and start at MSB if so.
SUBX S2,44 ; Remove the number of bits per word
MOVM S1,S2 ; Get the magnitude of the difference
LOAD S2,(P3),C$BPW ; Retrieve the number of bytes per word
IDIV S1,S2 ; Divide to get the position of the
STORE S1,(P3),C$PFB ; first byte in the first word.
LOAD S2,(P1),ARG$BC ; Get the number of bytes to transfer
MOVM S2,S2 ; Get it as a positive number
STORE S2,(P3),C$NBT ; Save byte count to transfer
ADDI S2,-1(S1) ; add on the position of first byte -1
HRRZ S1,S2 ; Move them around so that
LOAD S2,(P3),C$BPW ; we can divide by the number of bytes
IDIV S1,S2 ; per word and then increment by
AOJ S1, ; one to round off the odd word
STORE S1,(P3),C$BFS ; Store as the buffer size in words.
FERTRY: ZERO ((P3),C$RC) ; Clear out the result code
HRLI S1,C$SIZ ; Length of CAL11. block
HRR S1,P3 ; Location of CAL11. block
$FELOG (BEFORE) ; Log the data before sending it
CAL11. S1, ; for the talk to the 11.
JRST FEERR ; Error while talking to 11
$FELOG (AFTER) ; Log the result from the 11
LOAD S1,(P3),C$BXF ; Get the number of byts transfered
STORE S1,(P1),ARG$XF ; and return in to the caller
LOAD S1,(P3),C$RC ; Get the result code of the transfer
STORE S1,(P1),ARG$RC ; return that also to the caller
$RETT ; Return with a good indication
FEERR: $FELOG (AFTER) ; Log the failure from the 11
CAIE S1,C11IU% ; Was the 11 in use when we tried it?
JRST FEFATL ; No .. we got some other fatal error
SNOOZE SEC*TIMOFF ; Take time off to give the other user
JRST FERTRY ; a chance to release the 11 and retry
FEFATL: STORE S1,(P1),ARG$RC ; Store error code for the caller to
$RETF ; see and return falsely.
; All return paths from FEI%O go through here.
FIORET: $SAVE <TF> ; Save result code
MOVX S1,C$SIZ ; Get size of block
MOVE S2,P3 ; Location of block
PJRST M%RMEM ; Release memory and return
> ;End if TOPS10
SUBTTL Data area - Locals (to this fork)
LOCALS: ; This label must be first in local
; data base area.
IFN FTDEBUG,<
LOGFLG:: BLOCK 1 ; Logging flags
>; End if FTDEBUG
ENQBLK: XWD 1,5 ; 1 lock,,length of block is 5
XWD 0,0 ; PSI chn 0,, ID
TOPS10 <BYTE (2)1(16)0(18)-2> ; No PSI or level and exclusive access
TOPS20 <EXP EN%BLN+EN%LTL+<0,,-3>> ; long term data base,, Operator only
POINT 7,0 ; Pointer to string of resource name
XWD 0,0 ; 1 resource,, number of accesses
QPRT0: POINT 3,1(S2),20 ; Low order digit of port number
QPRT1: POINT 3,1(S2),13 ; High order digit of port number
QLIN0: POINT 3,2(S2),6 ; Low order digit of line number
QLIN1: POINT 3,1(S2),34 ; High order digit of line number
QDEV0: POINT 3,2(S2),34 ; Low order digit of device number
QDEV1: POINT 3,2(S2),27 ; Middle digit of device number
QDEV2: POINT 3,2(S2),20 ; High order digit of device number
QUNT0: POINT 3,3(S2),20 ; Low order digit of unit number
QUNT1: POINT 3,3(S2),13 ; High order digit of unit number
QD60BF: ASCIZ \DN60-P00\ ; Same name as used by D60SPD and
; D60SPL so that if they run at the
; same time somehow we won't die.
QLINBF: ASCIZ \DN60-P00L00\ ; Use to ENQ/DEQ a particular station
QDEVBF: ASCIZ \DN60-P00L00D000U00\ ; Define unique Q' entry for a
; particular device on a specific 2780
FEDEVS: ASCIZ /FE/ ; Start of front end name
TOPS20 <
FEJFN: BLOCK 1 ; JFN of the front end device FEn:
LSTDTE: BLOCK 1 ; Last DTE that was selected
RCVHDR:: BLOCK 2 ; Receive header
XMTHDR:: BLOCK 2 ; Transmit header
KSFLG: BLOCK 1 ; 1 if KL -1 if KS
XMSG: BLOCK ^o274/4+1 ; DDCMP Q flush buffer
RETRY: BLOCK 1 ; BOOT retry counter
BTARG: BLOCK 5 ; BOOT JSYS argument block
RDSAVE: BLOCK 1 ; Save area for RD2020 arguments
RDSLEN: BLOCK 1 ; including the length
>;End if TOPS20
TOPS10 <
C11BLK: BLOCK C$SIZ ; Block for OPNFE DN60 checking
>;End if TOPS10
HANLST: EXP -1 ; Name of handle linked list.
STSBUF: BLOCK <STSMAX+3>/4 ; Status buffer for port,line or device
; status strings (8 bit bytes).
DEFTHR: EXP OFLDFL ; Default number of delayed returns
; before offline device implied
; Termination signon data base.
SONSTR: 5,,5 ; Length of table
BLOCK 5 ; Pointer to each string
; format: port/line,,address
SONFOB: SONFD ; Address of file descriptor
FB.LSN+7 ; ASCII and strip line seq numbers
SONFD: 6,,0 ; Max words in file name
BLOCK 5 ; Buffer for file descriptor
SONDIR: ASCIZ \PS:<DN60>\
PTRA: BLOCK 2 ; Pointer and count for A string
PTRB: BLOCK 2 ; Pointer and count for B string
SONBUF: BLOCK ^d25 ; Buffer to read RJE string into
ENDLOC==.-1 ; End of process local data base
SUBTTL Data area - literals
DVCBYT: EXP 0,2,3,1,1 ; Number of bytes in dev cmd's 0-4
EXP 0,1,1,1,1 ; 5-9
EXP 0,0,2,1,3 ; 10-14
EXP 1,3,1,1,1 ; 15-19
EXP 1,1,1,1,1 ; 20-24
EXP 1,1,1,1,1 ; 25-29
EXP 1,1,3 ; 30-32
LNCBYT: EXP 0,3,2,1,1 ; Number of bytes in line cmds 0-4
EXP 3,3,1,1,3 ; 5-9
EXP 3,3 ; 10,11
D6JVER:: EXP %%.D60 ; Cell containing version number
XLIST ; Suppress listing of literals
LIT
LIST
END
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; Word Abbrev Mode:1
; End: