Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
language-sources/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
;<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
; 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 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, 203 ; 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
SUBTTL Misc. definitions
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, ^d10 ; Times to check input permission req
XP RQTIM, ^d1 ; Sleep time between input per req chk
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. Before
; TOPS20 style entries can be logged, they must be first converted
; to CAL11. style which is done by the external routine FELOG.
; Under TOPS10 the CAL11. block is assumed pointer to by P3 and
; the C11LOG external routine is called.
;
; 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==1b1> ;; Before CAL11.
IFIDN <$%PHSE>,<AFTER>, <%%.PHS==1b0> ;; After CAL11.
IFE %%.PHS,<IF1,<PRINTX $FELOG called with illegal phase: "'$%PHSE'">>
JRST [MOVX T4,%%.PHS ;; Load the phase value
TDNN T4,DBGFLG# ;; Check for this phase being logged
JRST .+1 ;; No .. continue on main line
TOPS20 < $CALL FELOG##> ;; Yes .. call external log converter
TOPS10 < IOR T4,P3 ;; Point to the CAL11. argument block
$CALL C11LOG##> ;; Call directly to logger
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
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,OPNDIE) ; 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
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$RUN ; Get the input running flag
JUMPN S1,SINGO ; If yes then go do some input
$CALL LCKLIN ; Lock the line from use (2780/3780)
JUMPF ERT (D6DOL,SINBAD) ; Can't .. 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 @.RETF ; 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
$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
$LNCMD (LC.CTR,RLSHAN) ; Clear output transparency
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
$LNCMD (LC.STR,RLSHAN) ; Set transparency on/off
CND.9: $LNCMD (LC.DTR,RLSHAN) ; Set the data terminal ready
PJRST RLSHAN ; Release handle, FE and return
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, or give non-blocking return (if bit set) when no
; request has been made.
;
; Parameters -
;
; S2/ Handle list entry address
REQIN: $SAVE <T1,T2> ; Save registers
$CALL CKIABT ; Check for any outstanding input abort
JUMPF @.RETF ; Yes .. so just return with failure
TXNN T1,SDIPW!SDIRN ; Check for input perm. was requested
JRST ERT (D6DOL) ; No .. so say device offline
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 @.RETF ; Can't get line status .. error
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 @.RETF ; Failed .. give error return
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 @.RETF ; Failed .. give error return
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 APRNUM ; Is processor serial number known
$CALL PRCTYP ; No so type the processor
SKIPE 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
$CALL DEQD60 ; we can release the port.
JUMPF @.RETF ; Had a problem dequeueing the port
$RETT ; Return succesfully (true)
; 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
$CALL DEQD60 ; Release the line
$RET
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
;
; APRNUM/ Contains the processor serial number
; KSFLG/ 0 if KL, non-zero if KS
PRCTYP: $SAVE <S1,S2> ; Save some registers
MOVE S1,[SIXBIT \APRID\] ; Table in TOPS20 to check
SYSGT ; for the processor serial number
MOVEM S1,APRNUM ; Save the processor serial number
SETZM KSFLG ; Default to KL
CAIL S1,^d4096 ; Test for a KS serial number
SETOM KSFLG ; Yes .. so set such an indicator
$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
SKIPE 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
$CALL M%RMEM ; Give it back to GLXLIB
$RET ; Return, ignoring errors
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
SKIPN 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: $FELOG (BEFORE) ; Log before any action on FE device
$CALL PUTHDR ; Output the header to say read data
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
SKIPE 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: $FELOG (BEFORE) ; Log before any FE I/O action
$CALL PUTHDR ; Output the transmit header
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
SKIPE 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
SKIPE 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
SKIPE 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
SKIPE 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,[[$SAVE <TF> ; Define return through release routine
MOVX S1,C$SIZ ; Get size of block
MOVE S2,P3 ; Location of block
PJRST M%RMEM]] ; Give memory to GLX handler; return
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.
> ;End if TOPS10
SUBTTL Data area - Locals (to this fork)
LOCALS: ; This label must be first in local
; data base area.
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
APRNUM: BLOCK 1 ; Processor serial number
KSFLG: BLOCK 1 ; 0 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
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:;
; Auto Save Mode:2
; Word Abbrev Mode:1
; End: