Trailing-Edge
-
PDP-10 Archives
-
BB-H138D-BM
-
galaxy-sources/d60jsy.mac
There are 66 other files named d60jsy.mac in the archive. Click here to see a list.
; [304] 30-SEP-82 RLS GCO 4.2.1514
; in D60RLS check for communications established if attempt to complete
; pending eof fails...if not, release the device anyway.
; [303] 29-SEP-82 RLS GCO 4.2.1513
; remove superfluous call to D60POL in D60DIS.
; [302] 02-SEP-82 TJW GCO 4.2.1508
; i nsert a ERJMP .+1 after the SPRIW JSYS
; [301] 02-SEP-82 RLS GCO 4.2.1507
; load TF properly before exiting from SINCD4 on eof case.
; [300] 17-AUG-82 RLS GCO 4.2.1492
; in D60SIN card input handling, transfer partial buffers at eof time
; to user area before returning a D6NBR.
; [277] 09-AUG-82 RLS GCO 4.2.1486
; return POLEST=0 on NBR return if some data was transferred
; [276] 18-JUN-82 RLS GCO 4.2.1392
; at SINREJ don't check error conditions unless request was rejected.
; [275] 24-MAY-82 RLS GCO 4.2.1346
; put component code setting commnand back in D60OPN.
; [274] 26-APR-82 RLS GCO 4.2.1335
; flush device default characteristics setting in D60OPN
; [273] 12-APR-82 RLS GCO 4.2.1309
; Make most errors go through EOFL.1. Make REQOUT check for output EOF
; set and clear it if on.
; [272] 21-MAR-82 RLS GC0 4.2.1283
; Check H$RUN in D60EOF...fe flags might not be set yet for signon device
; [271] 16-MAR-82 RLS GCO 4.2.1268
; Return actual protocol version in PROTYP...check it in OPNFE.
; [270] 12-MAR-82 RLS GCO 4.2.1266
; clean up better on obscure exits from D60EOF.
; [267] 10-MAR-82 RLS GCO 4.2.1262
; remove checks for SDHWA...no longer fatal indicator.
; [266] 07-MAR-82 RLS GCO 4.2.1250
; Fix PROTYP to return -1 for BOOT failure and no protocol running.
; [265] 24-FEB-82 RLS
; Make D60EOF always succeed unless its D6NBR.
; [264] 22-FEB-82 RLS
; D60OPN to return D6NBR instead of D6DOL. Check DSR in SONRD.
; [263] 09-FEB-82 RLS
; change port numbers for DN22 from 10-13 to 0-3
; [262] 18-JAN-82 RLS
; do CPUTYP as part of D60INI. Fix it too.
; [261] 14-JAN-82 RLS
; flush use of H$HPR,H$HLN, add timer to RD2020.
; [260] 13-JAN-82 RLS
; remove FELOG
; [257] 22-DEC-81 RLS
; Don't set line signature no more.
; [256] 17-DEC-81 RLS
; Create HI.Q and LO.Q parameters to defines scheduler queue bounds
; [255] 01-DEC-81 RLS
; Make D6.TRS and D6.TDT timeouts innocuous.
; [254] 01-DEC-81 RLS
; Do SPRIW in D60INI to set process(fork) to be a system process.
; Affects TOPS20 only.
; [253] 23-NOV-81 RLS
; remove setting of silo warning level in D60CND. Its settable only
; for diagnostic purposes now.
; [252] 19-NOV-81 RLS
; fix read for DN60 protocol.
; [251] 05-NOV-81 RLS
; GCO 4.2.1016 insert poll time estimates.
; [250] 15-OCT-81 RLS
; remove all device and line enq/deq cruft. only port enq's left.
; [247] 06-OCT-81 RLS
; Make data space for handles local to D60JSY.
; [246] 15-JUN-81 RLS
; Add TOPS-20 version protocol to FEI%O.
; [245] 26-MAY-81 RLS
; Make CDBUF a multiple card buffer - holds CDBFN card images.
; Make OPNFE more persistent in finding a viable FE device.
; [244] 18-MAY-81 RLS
; Replace PRCTYP with CPUTYP.
; [243] 12-May-81 WEM
; Modify CKIABT and CKOABT to return D6IAB and D6OAB error returns,
; respectively. These returns reflect soft aborts that should not
; cause the line to be disabled.
; [242] 3-MAR-81 RLS
; fix D60DIS so it can disable a line even with signon or enbale pending.
; check SDIEC (input eof complete) in CKIABT before abort flags
; [241] 8-Nov-80 KR
; add debugging messages for GALAXY testing. Defines DBGSTR macro
; to be used at an entry point which OUTSTRs the name of the entry
; point and the result code if both 135 and DBGSWT are non-zero.
; [240] 7-Nov-80 KR
; add crock to convert returned signon SIXBIT name to octal on exit
; of SONFIL. This to get around problems of first implementation of
; prototype node names in GALAXY.
; [237] 5-Nov-80 KR
; fix 2780/3780 console, which was broken by [235]
; [236] 3-NOV-80 RLS
; add silent device timeout for offline checking.
; [235] 23-OCT-80 RLS
; remove dump output buffers command for console devices in d60sout.
; make d60eof do it rather than real eof, d60rls will do a real eof for
; console devices.
; [234] 29-SEP-80 RLS
; CHANGE SONFIL TO COMPARE SIGNON CARD TO A FILE OF SIGNON STRINGS.
; SONRD NOW CALLS SONFIL WHEN SIGNON CARD HAS BEEN READ. ALL OLD COMPARE
; CRUFT HAS GONE AWAY. EXACT IMAGE IS NOW REQUIRED. SONFIL RETURNS
; SIXBIT NODE NAME IF MATCH OCCURS, WHICH IS EVENTUALLY RETURNED TO
; GALAXY COMPONENT DOING THE D60CND. ELIMINATE H$THR.
; [233] 19-SEP-80 RLS
; ADD OPNFE CHECK IN D60EOF SO IF FE IS DEAD , AN APPROPRIATE ERROR
; CODE IS RETURNED.
; [232] 09-SEP-80 RLS
; REMOVE SIGNON PROCESSING FROM D60SIN. ADD SIGNON PROCESSING TO END
; OF D60CND. PATCH D60OPN TO REFUSE DEVICE OPENS (EXCEPT FOR SIGNON
; DEVICE) UNTIL STATION IS SIGNED ON.
; [231] 26-AUG-80 RLS
; FIX D60SOU SO IT WILL CHECK FOR AN OUTPUT EOF IN PROGRESS IF
; THE SOUT FAILS. THIS CONDITION ARISES WHEN USER DOESN'T COMPLETE
; A D60EOF FUNCTION(WITH TRUE RETURN).
; [230] 26-AUG-80 RLS
; D60OPN - CHANGE TO RELEASE ANY DEVICE ALREADY OPEN, THEN DO
; THE OPEN.
; [227] 22-AUG-80 RLS
; FIX SO D6DOL MSG RETURNED ONLY WHEN SDSUS(HASP) OR SDOFL(2780/3780)
; SET. SOME SPECIAL CHECKING FOR CONSOL DEV IN D60SIN,D60SOU ERROR
; PROCESSING FLUSHED. MAKE CKIABT,CKOAABT RETURN LINE FLAGS(SDLFG)
; IN T2. CHANGE USE OF ALLOCATED AC VAR(ARGO) IN D60SOU TO P4.
; SIGNON PROCESSING IN D60SIN CHANGED(SONRD CALL - NO POSTMORTEM).
; USE H$SPN IN D60SIN,SONRD TIL SIGNON DONE.
; [226] 18-AUG-80 RLS
; ADD TOPS10 CONDITIONALS TO SIGNON FILE NAME CONSTRUCTION.
; [225] 13-AUG-80 RLS
; FIX SONFIL TO RETURN D6SON ERROR CODE(INSTEAD OF 0)
; [224] 11-AUG-80 RLS
; D60OPN - FIX SO CARRIAGE CONTROL SET ONLY FOR LPT DEVICE.
; TOPS10/FEI%O - FIX CALCULATION OF 1ST BYTE POSITION TO DIVIDE
; BY BP.SIZ INSTEAD OF BYTES PER WORD.
; [223] 5-AUG-80 RLS
; MODIFY D60SIN TO READ CARDS IN UNIT RECORDS. HANDLE LIST ENTRY FOR
; CARD INPUT DEVICES(CDR FOR TERMINATION,CDP FOR EMULATION) GETS A CARD
; IMAGE BUFFER ATTACHED TO BUFFER INPUT FROM FE. D60SIN RETURNS A D6NBR
; TIL A WHOLE CARD IS BUFFERED, THEN IT XFERS THE IMAGE. THUS CARDS ARE
; XFERRED CORRECTLY AS LONG AS USER ASKS FOR BYTES COUNTS IN MULTIPLES OF
; 82 BYTES. ANYTHING ELSE WORKS BUT WILL NOT BE IN SYNCH WITH CARD.
; ALCHAN,RLSHAN MODIFIED TO DEAL WITH CARD IMAGE BUFFERS.
; [222] 30-JUL-80 RLS
; MAKE TOPS10 FEI%O DO TRANSFERS IN UNITS OF H$BPM(RECORD SIZE) AND
; DO AS MUCH AS POSSIBLE BEFORE RETURNING...SIMILAR TO TOPS20 CRUFT.
; [221] 22-JUL-80 RLS
; ADD SYSERR FUNCTIONS
; [220] 16-JUL-80 RLS
; MAJOR SURGERY ON TOPS20 FEI%O FCNS TO ELIMNATE SOME GARBAGE AND
; MAKE INTERFACE MORE NEARLY IDENTICALLY TO TOPS10 CRUFT.
; [217] 17-JUN-80 RLS
; MAKE D60STS RETURN FULL LINE FLAGS IN S1,COMPOSITE LINE FLAGS AND
; LINE INFO FLAGS IN S2(AS BEFORE)
; MAKE STSBUF GLOBAL SO D60JSY USERS CAN LOOK AT FULL STATUS RETURNED.
; [216] 16-JUN-80 RLS
; CONVERT TOPS20 FEI%O ROUTINES TO NON-BLOCKING MODE.
; FIX LINSTS SO IT RETURNS "ZERO" STATUS WHEN LINE NOT ENABLED.
; [215] 27-MAY-80 RLS
; CONVERT D60JSY TO ALL NON-BLOCKING FORM. INCREMENT TO MAJOR VERSION: 4.
; [214] 20-MAY-80 RLS
; MAKE D60CND,D60DIS,LINCMD,DEVCMD NON-BLOCKING
; REQIN,CKIABT,CKOABT TOO
; [213] 20-MAY-80 RLS
; FIX D60OPN (OPNOV2) TO SET BYTES-PER-MSG TO 132 FOR LPT
; COSMETIC MODS TO REQIN
; [212] 12-MAY-80 RLS
; FIX REQOUT USE NON-BLOCKING RETURN. D60SIN,D60SOU CHANGED
; TO PERFORM EFFECTIVE ADDRESS CALCULATION ON STRING ARGS AT ENTRY.
; [211] 5-MAY-80 RLS
; FIX USERS OF FEI%O FOR NEW ERROR FORMAT. MAKE DEVSTS,LINSTS
; PRTSTS COMMON CODE
; [210] 1-MAY-80 RLS
; UPGRADE TOPS10 FEI%O
; UPDATE BYTE PTR AND COUNT AFTER IO,
; INTERPRET CAL11 UUO ERRORS INTO D60 ERRORS.
;<DN65-DEVELOPMENT>D60JSY.MAC.59, 28-Jan-80 11:07:32, Edit by JENNESS
; [207] Remove superfluous LC.CTR command in D60CND
;<DN65-DEVELOPMENT>, 26-Jan-80 11:53:06, Edit by JENNESS
; [206] Fix bug in D60STS line status routine that didn't return
; D6LGA error (just returned error code 3: reject).
;<DN65-DEVELOPMENT>D60JSY.MAC.55, 17-Dec-79 13:17:20, Edit by JENNESS
; [205] Change to a better 2020 test routine than checking serial number.
;<DN65-DEVELOPMENT>D60JSY.MAC.6, 4-Dec-79 13:35:42, Edit by JENNESS
; [204] Fix up code to do proper termination signon validation
;<DN65-DEVELOPMENT>D60JSY.MAC.3, 18-Oct-79 15:19:52, Edit by JENNESS
; [203] Decouple D60UNV from D60JSY because of QSRMAC deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.2, 9-Oct-79 14:26:28, Edit by JENNESS
; [202] Add code in D60CND to support transparent transmission enabling
; for HASP lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.256, 7-Sep-79 10:19:19, Edit by JENNESS
; [201] Remove edit 175 .. the BOOT JSYS has been fixed.
;<DN65-DEVELOPMENT>D60JSY.MAC.252, 4-Sep-79 15:29:44, Edit by JENNESS
; [200] Remove CONLY conditionals, remove QSRMAC symbol conflicts.
;<DN65-DEVELOPMENT>D60JSY.MAC.250, 4-Sep-79 13:50:44, Edit by JENNESS
; [177] Change arg block to condition call again .. make it QUASAR setup block.
;<DN65-DEVELOPMENT>D60JSY.MAC.249, 15-Aug-79 09:43:42, Edit by JENNESS
; [176] Change D6DNU error so that IBMSPL can turn it off in NBIO.
;<DN65-DEVELOPMENT>D60JSY.MAC.248, 14-Aug-79 09:17:23, Edit by JENNESS
; [175] Change 2020 read routine to do it's own byte pointer updating,
; the BOOT JSYS doesn't do it.
;<DN65-DEVELOPMENT>D60JSY.MAC.247, 16-Jul-79 14:11:56, Edit by JENNESS
; [174] Add external HOOKing code, gives access to guts of this package.
;<DN65-DEVELOPMENT>D60JSY.MAC.246, 11-Jul-79 16:17:53, Edit by JENNESS
; [173] Give D6DNU (DSR not up) on D60OPN call at appropriate times.
;<DN65-DEVELOPMENT>D60JSY.MAC.244, 5-Jul-79 15:28:28, Edit by JENNESS
; [172] Give reject error code when DN6x gives no bytes read with success code.
;<DN65-DEVELOPMENT>D60JSY.MAC.240, 2-Jul-79 16:25:45, Edit by JENNESS
; [171] Fix another dumb bug in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.238, 29-Jun-79 13:58:07, Edit by JENNESS
; [170] Another fix for 2780/3780 input/output deadlock race on input EOF.
;<DN65-DEVELOPMENT>D60JSY.MAC.237, 29-Jun-79 13:22:48, Edit by JENNESS
; [167] Typo fix in FEI%O for TOPS10.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:04:39, Edit by JENNESS
; [166] Change the ERRS macro to give DDT type out of the error values.
;<DN65-DEVELOPMENT>D60JSY.MAC.235, 29-Jun-79 09:00:27, Edit by JENNESS
; [165] Fix REQOUT to relieve the lost output grant.
;<DN65-DEVELOPMENT>D60JSY.MAC.233, 28-Jun-79 17:59:05, Edit by JENNESS
; [164] Fix to stop deadlock interaction between console and LPT under 3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.231, 26-Jun-79 09:00:59, Edit by JENNESS
; [163] Swap the line signature and line driver type in line status, makes it
; easier for front end to clear an old LCB.
;<DN65-DEVELOPMENT>D60JSY.MAC.230, 25-Jun-79 16:24:37, Edit by JENNESS
; [162] Change last D6DOL in REQOUT to a D6CGO .. fixes console deadly embrace.
;<DN65-DEVELOPMENT>D60JSY.MAC.229, 25-Jun-79 09:33:46, Edit by JENNESS
; [161] Another fix in edit 153 when DTE is already selected.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 21-Jun-79 10:41:06, Edit by JENNESS
; [160] Fix the horrible mess made when releasing devices on disabled lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.224, 21-Jun-79 08:53:45, Edit by JENNESS
; [157] Fix REQOUT to check for line gone away in DSRLP.
;<DN65-DEVELOPMENT>D60JSY.MAC.225, 19-Jun-79 09:43:59, Edit by JENNESS
; [156] Fix a problem in OPNFE caused by edit 153 when FEJFN already open.
;<DN65-DEVELOPMENT>D60JSY.MAC.223, 18-Jun-79 13:11:44, Edit by JENNESS
; [155] Change FEI%O for TOPS10 to use reentrant type C11BLKs.
;<DN65-DEVELOPMENT>D60JSY.MAC.222, 15-Jun-79 16:44:48, Edit by JENNESS
; [154] Fix a glaring error in SRCPDD that has been there forever.
;<DN65-DEVELOPMENT>D60JSY.MAC.221, 14-Jun-79 16:54:35, Edit by JENNESS
; [153] Change a little in OPNFE to jump to SELDTE if JFN already assigned.
;<DN65-DEVELOPMENT>D60JSY.MAC.220, 14-Jun-79 15:22:36, Edit by JENNESS
; [152] Add code to release all devices opened on a D60CND line disable.
;<DN65-DEVELOPMENT>D60JSY.MAC.211, 12-Jun-79 13:54:04, Edit by JENNESS
; [151] Add printx to output name, version and other sundries during assembly.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:37:27, Edit by JENNESS
; [150] Append line and device command strings to FEI%O arg block. Get rid of
; the ALC1WD and RLS1WD routines.
;<DN65-DEVELOPMENT>D60JSY.MAC.209, 12-Jun-79 11:36:40, Edit by JENNESS
; [147] Change the status string symbols so SWAPB and SWAP32 aren't needed.
;<DN65-DEVELOPMENT>D60JSY.MAC.208, 12-Jun-79 09:45:35, Edit by JENNESS
; [146] Move some more symbols into the D60JSY.UNV universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.206, 11-Jun-79 11:19:10, Edit by JENNESS
; [145] Fix a bug in D60SOUT (bad load) and add IOWAIT to SNOOZE in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.204, 8-Jun-79 09:40:54, Edit by JENNESS
; [144] Add return immediate code in FEI%O to stop blocking on console read.
;<DN65-DEVELOPMENT>D60JSY.MAC.203, 7-Jun-79 17:20:51, Edit by JENNESS
; [143] Change in REQIN to reduce the possibility of a race.
;<DN65-DEVELOPMENT>D60JSY.MAC.202, 7-Jun-79 15:33:57, Edit by JENNESS
; [142] Change status formats to reflect more frontend bullet proofing.
;<DN65-DEVELOPMENT>D60JSY.MAC.199, 7-Jun-79 10:55:08, Edit by JENNESS
; [141] Fix D60SOUT for errors that are appropriate the running flag is cleared
;<DN65-DEVELOPMENT>D60JSY.MAC.197, 7-Jun-79 10:36:37, Edit by JENNESS
; [140] Some fixes for line status failure and a D60RLS on dead lines.
;<DN65-DEVELOPMENT>D60JSY.MAC.196, 7-Jun-79 09:37:23, Edit by JENNESS
; [137] Fix a problem in REQIN that failed it input was already running.
;<DN65-DEVELOPMENT>D60JSY.MAC.194, 6-Jun-79 16:42:57, Edit by JENNESS
; [136] Fix a bug in the DSR wait loop in REQOUT.
;<DN65-DEVELOPMENT>D60JSY.MAC.193, 6-Jun-79 09:32:56, Edit by JENNESS
; [135] Add IOWAIT argument to the SNOOZE macro for task descheduling.
;<DN65-DEVELOPMENT>D60JSY.MAC.191, 4-Jun-79 09:21:51, Edit by JENNESS
; [134] Dump output buffers (in 11) if outputing to a console device.
;<DN65-DEVELOPMENT>D60JSY.MAC.187, 1-Jun-79 10:58:38, Edit by JENNESS
; [133] Add code to handle new line hardware abort checking.
;<DN65-DEVELOPMENT>D60JSY.MAC.184, 30-May-79 16:18:50, Edit by JENNESS
; [132] Don't clear aborts in REQIN/REQOUT, now only set for valid reasons.
;<DN65-DEVELOPMENT>D60JSY.MAC.183, 30-May-79 13:32:02, Edit by JENNESS
; [131] More fixes for device error handling and input/output deadlock.
;<DN65-DEVELOPMENT>D60JSY.MAC.176, 25-May-79 16:23:21, Edit by JENNESS
; [130] Handle aborts caused by line disconnection.
;<DN65-DEVELOPMENT>D60JSY.MAC.175, 24-May-79 15:14:16, Edit by JENNESS
; [127] Fix D60EOF and the line releasing code for 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:46, Edit by JENNESS
; [126] Fix D60OPN to properly handle errors on the device commands.
;<DN65-DEVELOPMENT>D60JSY.MAC.172, 23-May-79 15:21:22, Edit by JENNESS
; [125] Have found some more holes in the FE releasing.
;<DN65-DEVELOPMENT>D60JSY.MAC.168, 21-May-79 11:41:31, Edit by JENNESS
; [124] More fixes for properly releasing FE devices.
;<DN65-DEVELOPMENT>D60JSY.MAC.167, 21-May-79 09:38:50, Edit by JENNESS
; [123] Add structure block sizes in universal file.
;<DN65-DEVELOPMENT>D60JSY.MAC.165, 21-May-79 09:36:35, Edit by JENNESS
; [122] Another fix in REQOUT to release the line when input is coming.
;<DN65-DEVELOPMENT>D60JSY.MAC.161, 17-May-79 18:11:01, Edit by JENNESS
; [121] Fix so FE is properly released if DTE select fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.160, 16-May-79 11:21:33, Edit by JENNESS
; [120] Fix write routine to release FE for a second after lot of data output.
;<DN65-DEVELOPMENT>D60JSY.MAC.159, 16-May-79 11:11:28, Edit by JENNESS
; [117] Change ENQD60 to block until lock is gained. Gives higher lock hits.
;<DN65-DEVELOPMENT>D60JSY.MAC.157, 16-May-79 09:22:10, Edit by JENNESS
; [116] Remove copy code for 8 bit DDCMP buffer, now can handle real byte ptrs.
;<DN65-DEVELOPMENT>D60JSY.MAC.152, 14-May-79 14:51:26, Edit by JENNESS
; [115] Add line signature code.
;<DN65-DEVELOPMENT>D60JSY.MAC.146, 10-May-79 12:42:28, Edit by JENNESS
; [114] Fix so delays from the FE on line commands resend command correctly.
;<DN65-DEVELOPMENT>D60JSY.MAC.145, 10-May-79 11:17:39, Edit by JENNESS
; [113] Change location of FELOG logging calls in FEI%O.
;<DN65-DEVELOPMENT>D60JSY.MAC.144, 10-May-79 10:20:00, Edit by JENNESS
; [112] Add require for FELOG when FTDEBUG switch is turned on.
;<DN65-DEVELOPMENT>D60JSY.MAC.143, 3-May-79 09:57:26, Edit by JENNESS
; [111] And yet another fix for the deadlock problem, release if REQOUT fails.
;<DN65-DEVELOPMENT>D60JSY.MAC.141, 2-May-79 14:29:16, Edit by JENNESS
; [110] Another fix to stop input/output deadlocks on 2780/3780.
;<DN65-DEVELOPMENT>D60JSY.MAC.140, 1-May-79 16:48:50, Edit by JENNESS
; [107] Increase retry counter for BOOT JSYS retry on input.
;<DN65-DEVELOPMENT>D60JSY.MAC.139, 1-May-79 16:33:52, Edit by JENNESS
; [106] Some code clean up, more on the abort problem, and really use D60CGO.
;<DN65-DEVELOPMENT>D60JSY.MAC.137, 30-Apr-79 12:57:04, Edit by JENNESS
; [105] Fix input request code to block less and add better errors to D60CND.
;<DN65-DEVELOPMENT>D60JSY.MAC.133, 25-Apr-79 16:18:22, Edit by JENNESS
; [104] Put in error checks after device and line status calls.
;<DN65-DEVELOPMENT>D60JSY.MAC.129, 25-Apr-79 13:47:32, Edit by JENNESS
; [103] Fix so that the line isn't released if the device goes off line.
;<DN65-DEVELOPMENT>D60JSY.MAC.127, 25-Apr-79 08:25:46, Edit by JENNESS
; [102] Add device command in D60OPN to do space compression.
;<DN65-DEVELOPMENT>D60JSY.MAC.124, 24-Apr-79 14:39:33, Edit by JENNESS
; [101] Add code to ENQ/DEQ line for 2780/3780 so only 1 device can be active
; at a time.
; D60JSY - Interface package for DN62/DN65 Galaxy IBM spooling system
;
;
; COPYRIGHT (c) 1979, 1980, 1981,1982
; DIGITAL EQUIPMENT CORPORATION
;
; This software is furnished under a license and may be used
; and copied only in accordance with the terms of such license
; and with the inclusion of the above copyright notice. This
; software or any other copies thereof may not be provided or
; otherwise made available to any other person. No title to
; and ownership of the software is hereby transferred.
;
; The information in this software is subject to change
; without notice and should not be construed as a commitment
; by DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL assumes no responsibility for the use or reliability
; of its software on equipment which is not supplied by
; DIGITAL.
;
; TITLE D60JSY DN62/DN65 interface to GALAXY spooling components.
SALL ; Make nice clean listings
.DIRECTIVE FLBLST ; List only 1st binary word in multi
; word text strings
SEARCH GLXMAC ; Use GALAXY group's macros/symbols
SEARCH QSRMAC ; Symbols for setup message
SEARCH ORNMAC ; Symbols to talk to ORION
SEARCH D60UNV ; Search for linkage symbols
PROLOGUE (D60JSY) ; Initialize Galaxy symbol definitions
; Version
XP D60VER, 4 ; Major version number
XP D60MIN, 2 ; Minor version number
XP D60EDT, 304 ; Edit level
XP D60WHO, 0 ; Who did last edit (0=DEC)
; Conditional assembly flags.
ND FTDBST, 0 ; If on generate DBGSTR macro
ND JP%SYS,0 ; release 5 symbol
; 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 <FTDBST>,<PRINTX Entry/exit tracing enabled.>
> ;END IF1
IF2,<Printx Pass 2.>
;Define debugging string macros
Define DBGSTR (TXT) <>
IFN <FTDBST>,<
Define DBGSTR (TXT) <
PUSH P,[[ASCIZ |'TXT'-|]]
PUSH P,[EXP DBGRSL]
>;end Define DBGSTR
>;end IFN <FTDBST>
SUBTTL Misc. definitions
XP OFLDFL, ^d10 ; Default number of delay to offline
XP RQREP, ^d12 ; Times to check input permission req
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
XP LO.Q,2 ; low priority scheduler queue to run in
xp HI.Q,1 ; high priority scheduler queue to run in
; SYSERR definitions
XP SEC%D6, 233 ; Line status event code
XP SEC%DE, 234 ; Enable/disable event code
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 SYSERR entry format
Comment &
This is a description of the SYSERR entry header. The body descriptions
follow later.
TOPS20 VERSION
+===================================================+
! Code ! n/u ! T ! Version ! 4 ! Length !
+---------------------------------------------------+
! Date and time in Universal date/time format !
+---------------------------------------------------+
! System uptime !
+---------------------------------------------------+
! Processor serial number !
+===================================================+
TOPS10 VERSION
+===================================================+
! .DMERR !
+---------------------------------------------------+
! code !
+===================================================+
NOTE: DAEMON call in TOPS10 supplies rest of header info
&
TOPS20< DEFSTR (SYCOD,0,8,9) ; Event code
DEFSTR (SYT20,0,17,1) ; Entry was created by TOPS20
DEFSTR (SYVER,0,23,6) ; SYSERR entry type version number
DEFSTR (SYHLN,0,26,3) ; Header length (currently 4)
DEFSTR (SYLEN,0,35,9) ; Length of entry (w/o header)
DEFSTR (SYDAT,1,35,36) ; Date and time of this entry
DEFSTR (SYUPT,2,35,36) ; System uptime days,,fraction of day
DEFSTR (SYPSN,3,35,36) ; Proc. serial number of recording CPU
.SYDAT==4 ; Offset to data portion of entry
>
TOPS10< DEFSTR (SYFCN,0,35,36) ; DAEMON function code
DEFSTR (SYCOD,1,35,36) ; Event code
.SYDAT==2 ; Offset to data portion of entry
>
SUBTTL Data format for SYSERR code 233
Comment &
+===================================================+
! Port number ! Line number !
+---------------------------------------------------+
! Status string !
/ /
/ /
+===================================================+
The line status string is returned as a 8 bit byte string packed 4 bytes left
justified in a 36 bit word. In each byte the bit numbering is bit 0 to
the right (LSB) and bit 7 to the left (MSB).
Any 16 bit values have the 8 bit bytes that make it up swapped. So before
these bits defined below are valid, the bytes have to be swapped back again.
7 0 15 8 7 0 15 8 Bit no.'s in -11's word
! ! ! ! ! ! ! !
+------------------------------------------+
! byte 0 ! byte 1 ! byte 2 ! byte 3 ! ! Byte no. in -11
+------------------------------------------+
! 11-word 0 ! ! 11-word 1 ! ! Word no. in -11
0 15 16 31 35 Bit no.'s in -10's word
Line status [ 70 (8 bit) bytes, 18 (36 bit) words ]
Byte Meaning
---- -------
0 Terminal type: 0 = unknown, 1 = 3780, 2 = 2780, 3 = HASP
1-2 Flags: bit 0 set = simulate, clear = support
bit 1 set = primary BSC protocol, clear = secondary
bit 2 set = signed on
bit 3 set = transparent
bit 4 set = disable in progress
bit 5 set = line enable complete
bit 6 set = line abort complete
bit 7 set = off line (2780/3780 only)
bit 8 set = line disable complete
bit 9 set = disable done by DTE failure
bit 10 set = Line aborted by hardware failure
bit 11 set = Communications established
3 Line info:
bit 0 set = line is enabled
bit 1 set = DTR (data terminal ready)
bit 2 set = DSR (data set ready)
4-5 Count of DQ11/DUP11 error interrupts
6-7 DQ11/DUP11 status register 1 at last error
8-9 DQ11/DUP11 status register 2 at last error
10-11 Count of times receiver wasn't fast enough
12-13 Count of times transmitter wasn't fast enough
14-15 Count of CTS (clear to send) failures
16-17 Count of message sent and ACK'ed
18-19 Count of NAK's received (+wrong acknowledge after timeout)
20-21 Count of invalid responses to TTD
22-23 Count of invalid responses to messages
24-25 Count of TTD's sent
26-27 Count of WACK's received in response to messages
28-29 Count of EOT's (aborts) in response to messages
30-31 Count of invalid bids of responses to bids
32-33 Count of RVI's received while transmitting
34-35 Count of message received ok
36-37 Count of bad BCC's
38-39 Count of NAK's sent in response to data messages
40-41 Count of WACK's sent
42-43 Count of TTD's received
44-45 Count of EOT's sent or received which abort the stream
46-47 Count of messages ignored (out of chunks, unrecognizable or
timeout)
48-49 Count of transparent msg with an invalid character after DLE
50-51 Count of attempts to change between transparent and normal mode
in a blocked message
52-53 Count of transmitter timeouts
54-55 Clear to send delay in jiffies
56-57 Count of silo overflows
58-59 Number of bytes in silo warning area (usually 64, must be even)
60-61 Max number of bytes used in silo warning area since set last
62-63 Max bytes per message
64-65 Number of records per message
66-67 Line signature
68-69 Line driver type: 1 = DQ11, 2 = KMC11/DUP11, 3 = DUP11 w/o KMC
&
SUBTTL Format for SYSERR code 234
Comment &
Node enable/disable
+=======================================================+
! ! Enable/disable code !
+-------------------------------------------------------+
! Node name in sixbit !
+-------------------------------------------------------+
! Port # ! Line # !
+=======================================================+
! Flags ! Station type !
+-------------------------------------------------------+
! Clear to send delay (in jiffies) !
+-------------------------------------------------------+
! Silo warning level (in bytes) !
+-------------------------------------------------------+
! Bytes per message !
+-------------------------------------------------------+
! Records per message !
+-------------------------------------------------------+
! Line signature !
+=======================================================+
Where
Enable/disable code is:
.CNENB = 1 Enable the line
.CNDIS = 2 Disable the line (hang-up)
Node name is the sixbit name that GALAXY uses for the node
Port and line number uniquely describe the synchronous line
talking to IBM node
Flags are:
CN$TRA = 1b15 Transparency enabled
CN$PSP = 1b16 Primary protocol if 1,
secondary if 0
CN$ETF = 1b17 Emulation node if 1, termination if 0
Station type is:
SL378 = 1 3780 protocol
SL278 = 2 2780 protocol
SLHSP = 3 HASP multileaving protocol
Clear to send delay is a 16 bit value in jiffies.
Bytes per message and silo warning level are 16 bit values in bytes.
Records per message is a 16 bit value in records.
Line signature is a 16 bit value of no dimensions, used for
identification only.
&
NED.CD==.SYDAT+0 ; Enable/disable code
NED.NM==NED.CD+1 ; Node name
NED.ID==NED.NM+1 ; Port,,line (ID)
NED.FL==NED.ID+1 ; Flags,,type
NED.CS==NED.FL+1 ; Clear to send delay
NED.SW==NED.CS+1 ; Silo warning level
NED.BM==NED.SW+1 ; Bytes per message
NED.RM==NED.BM+1 ; Records per message
NED.SG==NED.RM+1 ; Line signature
NED.SZ==^d9 ; Size of entry w/o header
NED.SH==^d3 ; Short entry for disable
SUBTTL Macros -- ERT
; 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
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 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 - S1/SYSERR enable/disable arg: 0 => disable,enable otherwise
ENTRY D60INI
D60INI: DBGSTR <D60INI>
$SAVE <S2> ; Save registers
TOPS20< MOVEI S1,LOCALS ; make data local to forks into
; copy-on-write
LSH S1,-^D9 ; make page number
HRLI S1,.FHSLF ; process handle
MOVX S2,PA%RD+PA%WT+PA%EX+PA%CPY
SPACS ; do it
ERJMP @.RETF
MOVEI S1,ENDLOC ; get the end of said area
LSH S1,-^D9 ; make page number
HRLI S1,.FHSLF ; process handle
MOVX S2,PA%RD+PA%WT+PA%EX+PA%CPY
SPACS ; do it
ERJMP @.RETF
SETZM FEJFN ; no jfn for this fork yet
SETZM LSTDTE ; no dte assignment
MOVX S1,.FHSLF ; set ourselves to be a system process
MOVX S2,<<HI.Q>B29+<LO.Q+1>+JP%SYS>; JP%SYS only works for release 5+
SPRIW ; do it
ERJMP .+1 ; not a problem if we can't
$CALL CPUTYP ; determine processor type
>
SETZM LPAGE ; disable SYSERR logging
SKIPE S1 ; check for SYSERR logging state
$CALL LOGENB ; enable logging
$CALL HNDINI ; init handle space
MOVEI S1,.POMIN ; init polester
MOVEM S1,POLEST
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::DBGSTR <D60OPN>
$SAVE <S2,T1,T2> ; Save registers
JUMPG S1,OPN.1 ; If open block type parameters
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
$CALL FNDPDD ; check if it already exists
JUMPT [MOVE S1,S2
$CALL D60RLS ; yes - release it
JUMPT .+1 ; completed?
CAIE S1,D6NBR
CAIN S1,D6DOL
$RET ; no - come back later
JRST .+1] ; yes - continue
$CALL ALCHAN ; create new entry
JUMPF @.POPJ ; can't
; yes - proceed with the open
OPN.1A: LOAD T1,(S2),H$DEV ; Get the generic device number
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 #
TOPS20< SKIPL PTYPE> ; DN22 is 0-7
CAILE S1,MAXDTE ; Check to see if the DTE # is ok
JRST ERT (D6NSP,OPNDIE) ; No .. it's too large
TOPS20< JRST PRTOK> ; This port is valid.
OPNDL: ; On -10's DL10's are valid
TOPS20< SKIPGE PTYPE ; check for DN22
JRST PRTOK
MOVX S1,D6NSP ; No such port (no DL10 on -20)
JRST OPNDIE> ; and go release the list entry
PRTOK: LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL OPNFE ; Go open a FE (-10 check for 11 up)
JUMPF @.POPJ ; Can't open a front end
$CALL PRTSTS ; Get the port status
JUMPF @.POPJ ; 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) ; 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) ; No ... this port is useless
$CALL LINSTS ; Get the line status
JUMPF @.POPJ ; Someone died .. go release device
LOAD S1,,SLTYP ; Get the remote station type
STORE S1,(S2),H$STY ; Save the station type in list entry
LOAD T1,,SLINF ; get line info
TXNN T1,SLLEN ; make sure line is still up
JRST ERT(D6LGA) ; should not have called open unless it was
LOAD T1,,SLFLG ; Get line status flags
TXNE T1,SLETF
JRST OPNDF1 ; OK TO OPEN DEVICES IN EMULATION MODE
TXC T1,SLSON!SLCME ; check if ok to open a device yet
TXCN T1,SLSON!SLCME ; have to be talking and be signed on
JRST OPNDF1 ; ok to continue
LOAD T2,(S2),H$DEV ; only signon device can be opened
CAIE T2,.OPSGN ; note: sonrd opens .OPSGN for all station types
JRST RETNBR ; no - device is "offline" til it's online
OPNDF1: LOAD T1,T1,SLETF ; Get termination/emulation flag
STORE T1,(S2),H$TEM ; Save it in the handle list entry
OPNDF2: LOAD S1,(S2),H$STY ; now do some dev specific cruft
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) ; Can't give a unit number on non-HASP
LOAD S1,(S2),H$DEV ; Get the device code
CAIN S1,.OPSGN ; map SIGNON device to CDR
MOVEI S1,SDCDR ; SONRD opens .OPSGN for all stations
CAIN S1,.OPCOU ; map console out to lpt dev
MOVEI S1,SDLPT
CAILE S1,MXNHSP ; Check for max device on non-HASP
JRST ERT (D6UND) ; 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) ; 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
SDSGN]-1(S1) ; or a sigon device
CAIN T1,SDSGN ; check for input signon device
JRST [LOAD S1,(S2),H$TEM
SKIPN S1 ; skip if emulation mode
MOVEI T1,SDCR1 ; yes - map to cdr
JRST .+1]
LOAD S1,(S2),H$UNT ; Get unit of device-type to select
CAILE S1,MXUHSP ; Check against maximum number of units
JRST ERT (D6UND) ; 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: $CALL SETIOM ; Set the input/output mode of device
JUMPF OPNDIE
LOAD S1,(S2),H$STY ; CHECK FOR HASP
CAIE S1,SLHSP
JRST OPNOV1
LOAD T1,(S2),H$HDV ; yes - must set component code
$DVCMD (DC.SCC)
JUMPE OPNDIE
OPNOV1: LOAD T1,(S2),H$DEV ; check device type
CAIE T1,.OPCOU ; console out
CAIN T1,SDLPT ; or lpt
SKIPA T1,[^D134] ; use 132 columns + crlf
MOVX T1,^D82 ; otherwise use 80 columns + crlf
STORE T1,(S2),H$BPM ; Save as the bytes per message
LOAD S1,(S2),H$IOM ; check for input card device
JUMPE S1,OPNOV4 ; not an input device
LOAD S1,(S2),H$DEV ; input dev...check for card dev
CAIN S1,.OPSGN
JRST OPNSG1 ; SIGNON DEVICE
CAIE S1,SDCDR ; CDR
CAIN S1,SDCDP ; CDP
CAIA
JRST OPNOV4 ; neither
OPNSG1: LOAD S1,(S2),H$BPM ; get record size
IMULI S1,CDBFN ; buffer this may records
MOVEM S1,CDBSZ(S2) ; preserve this total byte count
PUSH P,S2 ; save handle ptr
IDIVI S1,5 ; calc. no. words
SKIPE S2
AOS S1
$CALL M%GMEM ; get card buffer
EXCH S2,(P) ; get handle ptr back
POP P,CDBUF(S2) ; drop the buffer ptr in handle entry
OPNOV4: SETZM IOTIM(S2) ; init offline timer for device
LOAD T1,(S2),H$DEV ; set up offline timer limit
LOAD S1,(S2),H$STY ; check for 2780/3780 console
CAIN S1,SLHSP ; Test to see if it is a HASP station
JRST OPNO4A ; yes - use device code
CAIN T1,.OPCOU ; map console out to lpt dev
MOVEI T1,SDLPT
OPNO4A: LOAD S1,(S2),H$TEM ; differentiate between emu/ter
SKIPE S1
SKIPA S1,EOLTB-1(T1) ; emulation device
MOVE S1,TOLTB-1(T1) ; termination device
MOVEM S1,OFLTIM(S2) ; crammit
MOVE S1,S2 ; Get the handle to pass back
$RETT ; Return saying success
; 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: $CALL RLSHAN ; release the handle
$RETF ; and give the false return
EOLTB: .EOLPT ; lpt
.EOCDP ; cdp
.EOCDR ; cdr
0 ; console input
0 ; console output
0 ; signon device
TOLTB: .TOLPT ; lpt
.TOCDP ; cdp
.TOCDR ; cdr
0 ; console input
0 ; console output
0 ; signon device
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: DBGSTR <D60SIN>
JUMPGE T1,ERT (D6CNN) ; Test for illegal byte count
$SAVE <T2,P1,P2,P3,P4>
TLC S2,-1 ; check for generic ascii ptr
TLCN S2,-1 ; skip if specific
HRLI S2,(POINT 7) ; map it
TOPS10< HRRI S2,@S2 ; perform effective adr calculation
TLZ S2,77> ; 'cause cal11. uuo can't handle it
TOPS10< TLNN S2,770000 ; check for position = 0
ADD S2,[440000,,1]> ; cause it can't handle this either
DMOVE P2,S2 ; save the user parameters
HRRZS S1 ; Clear the flags in left half
$CALL SRCHAN ; Look for handle on handle entry list
JUMPF ERT (D6NSH) ; Illegal handle
MOVE P1,S2 ; Save the handle temporarily
$CALL ALCARG ; Allocate an FEI%O arg block
MOVE P4,S1 ; keep arg block ptr safe
MOVX T1,FC.RD ; Function to read from device
STORE T1,(P4),ARG$FC ; Put into I/O argument block
LOAD S1,(P1),H$IOM ; Get the input/output mode
JUMPE S1,ERT (D6DCI,SINX1) ; Device can't do input
SIN.SN: LOAD S1,(P1),H$RUN ; Get the input running flag
JUMPN S1,SINGO ; If yes then go do some input
SIN.LK: $CALL REQIN ; Go check on input request
JUMPF SINX1 ; If input grant failed .. return
$CALL CRAMT ; init time we did input
MOVEM S1,POTIM(P1) ; init last time polled
MOVEI S1,.POTM0 ; init poll time estimate
MOVEM S1,IOPOL(P1) ; start fast
SETZM IOAMT(P1) ; init current amt xfer'd
SETZM CDERM(P1) ; init last FEI%O error seen
SINGO: MOVE S1,IOAMT(P1) ; save previous amt xfer'd
MOVEM S1,IOPRV(P1)
SETZM IOAMT(P1) ; init current amt xfer'd
SKIPE CDBUF(P1) ; check for input card dev
JRST SINCD ; yes - only these will have a card buf
; else - do input direct
STORE P2,(P4),ARG$PT ; Save the byte pointer to input area
STORE P3,(P4),ARG$BC ; Save the byte count
$CALL SINDO ; get the cruft
DMOVE P2,S2 ; update the user parameters
SINX: $CALL ESTPOL ; generate poll estimate
SINX1: DMOVE S2,P2 ; return updated user parameters
EXCH S1,P4 ; Exchange return code(handle) and ptr
$CALL RLSARG ; Release the argument block
MOVE S1,P4 ; Get the return code(handle) back
JUMPT @.POPJ ; true...return immediately
SINFAI: CAIE S1,D6NBR ; check for non-fatal errs
CAIN S1,D6DOL
$RET ; non-fatal
ZERO ((P1),H$RUN) ; Clear the I/O running bit
$RET
SINCD: DMOVE S2,CDPTR(P1) ; get current buf parameters
JUMPL T1,SINCD1 ; still trying to complete a buffer
JUMPG T1,SINCD2 ; some buffer left - user may be out of synch
SKIPE S1,CDERM(P1) ; check for leftover eof
CAXN S1,D6NBR ; anything other than nbr is terminal
CAIA
JRST SINCD4 ; yep
MOVE S2,CDBUF(P1) ; empty buffer - init pars
HRLI S2,(POINT 7)
MOVN T1,CDBSZ(P1) ; get the record size
DMOVEM S2,CDPTR(P1) ; save current state of cdbuf pars
SINCD1: STORE S2,(P4),ARG$PT ; Save the byte pointer to input area
STORE T1,(P4),ARG$BC ; Save the byte count
$CALL SINDO ; try to read a card
SKIPF ; save error code
SETZ S1,
MOVEM S1,CDERM(P1)
JUMPL T1,SINCD4 ; did buffer fill ?
MOVE S2,CDBUF(P1) ; yes - dump it to loser
HRLI S2,(POINT 7)
MOVE T1,CDBSZ(P1) ; S2,T1 set to xfer card image
SINCD2: $CALL SINXFR ; transfer the card buffer to caller's
SINCD4: DMOVEM S2,CDPTR(P1) ; xfer done - save current cdbuf pars
; the following code accounts for all
; manner of evil conditions
SKIPG T1 ; if buffer not empty, then user satisfied
SKIPN S1,CDERM(P1) ; check for error last time out
JRST [JUMPL P3,SINCD ; true ret+user space left means continue
MOVX TF,TRUE ; ELSE WE HAVE SUC'D!
JRST SINX]
MOVX TF,FALSE ; yes - set false return and check state
; error return - eof of particular interest
JUMPE T1,SINCD6 ; card boundary means return whatever
CAIE S1,D6EOF ; check evilness
JRST SINCD6 ; goodness prevails
JUMPG T1,SINCD5 ; we are already xferring a partial card
MOVE S2,CDBSZ(P1) ; EOF means no more input and we have
; a partial card. set up so user can
; retrieve last piece before seeing EOF
ADD T1,S2 ; calc number bytes in CDBUF
JUMPE T1,SINCD6 ; empty card after all
MOVE S2,CDBUF(P1) ; set buf pars to indicate partial card
HRLI S2,(POINT 7)
$CALL SINXFR ; transfer what there is
DMOVEM S2,CDPTR(P1) ; keep track of what is left
SKIPGE P3 ; if caller's request is satisfied
SINCD5: SKIPA S1,[D6NBR] ; return delay error
MOVX TF,TRUE ; return success
SINCD6: JRST SINX
SINDO: MOVE S1,P4 ; Point to the argblk for FE I/O
MOVE S2,P1 ; get the handle list entry ptr
$CALL FEI%O ; Do the input
JUMPF SINREJ ; If failed .. check for EOF
$CALL CRAMT ; stuff new iotim
MOVE S1,P1 ; Get the handle back on success
JRST SINSUC ; Set the true flag and return
SINREJ: ; either D6NBR or D6REJ
; have to check cases either way
LOAD S1,(P4),ARG$RC ; get the FEI%O error back
CAIE S1,D6REJ ; if reject, may be eof or input abort
JRST SINRJ1
$CALL CKIABT ; Check for input abort
JUMPF SINRET ; Yes .. go release and clean up
TXNE T1,SDIEC ; Did an EOF occur?
JRST [$DVCMD (DC.CIE) ; Yes .. clear EOF complete flag
JUMPF SINRET ; if fails, return error code
MOVX S1,D6EOF ; Set EOF code
JRST SINBAD] ; Close off line and shutdown device
TXNN T1,SDIRN ; input still running ?
JRST [$CALL RNLOST ; this is not so pretty good
JRST SINRET]
SINRJ1: $CALL CHKOFL ; check offline timer
SKIPF ; true if offline
SKIPA S1,[D6DOL] ; device is arbitrarily delacred offline
; when it doesn't speak for a while.
LOAD S1,(P4),ARG$RC ; get the FEI%O error back
JRST SINBAD
SINNBR: MOVX S1,D6NBR ; return non-blocking msg
SINBAD: MOVX TF,FALSE ; get false flag
CAIA
SINSUC: MOVX TF,TRUE ; get truth(and justice)
SINRET: LOAD T1,(P4),ARG$XF ; get amt xfer'd
ADDM T1,IOAMT(P1) ; update the current amt
LOAD T1,(P4),ARG$BC ; Get the count of bytes not transfered
LOAD S2,(P4),ARG$PT ; Get pointer where string left off
$RET
SINXFR: ILDB S1,S2 ; card xfer loop - come here when T1
; is positive
IDPB S1,P2 ; crammit
AOJL P3,SINXF1 ; count the byte into user area
SOJA T1,SINXFX ; user stuffed - count the byte out of
; card buffer
SINXF1: SOJG T1,SINXFR ; count the byte out of card buffer
SINXFX: $RET
GNOW: PUSH P,S2 ; protect device handle list entry
$CALL I%NOW ; get the time
POP P,S2
$RET
CRAMT: $CALL GNOW ; set a new io time for device
MOVEM S1,IOTIM(S2) ; time device last did io
$RET
CHKOFL: SKIPE IOTIM(S2) ; check if device offline(silent too long)
SKIPN OFLTIM(S2)
$RETF ; IOTIM not set up or no OFLTIM
; parameter implies not offline
$CALL GNOW ; device is subject to offline timing
SUB S1,IOTIM(S2) ; get time since last successful io
CAMLE S1,OFLTIM(S2) ; check threshold
$RETT ; yes, it is true that device is offline
$RETF ; no, it is false that device is offline
; IOPRV/previous amount xfer'd
; IOAMT/current amt xfer'd
; POTIM/time of last nonzero data xfer poll
ESTPOL: $SAVE <S1,S2>
LOAD S2,(P1),H$DEV ; check device
CAILE S2,.OPCDR
JRST ESTP3 ; only data xfer devices get this service
CAXN S1,D6NBR ; D6NBR return is special
SKIPN IOAMT(P1) ; check if data transferred
SKIPA S1,[.POMIN]
SETZ S1, ; try again immed
JRST ESTP1A ; performance demands this
MOVE S1,IOPRV(P1) ; get previous amt
MOVE S2,IOAMT(P1) ; get current amt xfer'd
LSH S1,-7 ; RESOLUTION MORE THAN CARD,LESS THAN LINE
LSH S2,-7
JUMPE S2,ESTP0 ; if no io this time, wait longer
CAMN S1,S2 ; have done io then and now
SOSA S1,IOPOL(P1) ; if static amt - back off
ESTP0: AOS S1,IOPOL(P1) ; if changing - increase time
ESTP1: SKIPG S1 ; S1/new poll time - apply limits
MOVEI S1,.POMIN
CAILE S1,.POLMX
MOVEI S1,.POLMX
ESTP1A: MOVEM S1,IOPOL(P1) ; set new poll time estimate
MOVEM S1,POLEST ; set in global variable
$RET
ESTP3: CAIE S2,.OPSGN ; non-data devices
SKIPA S1,[.POCON] ; console devices
MOVEI S1,.POSGN ; signon device
JRST ESTP1A
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: DBGSTR <D60SOU>
$SAVE <T2,P1,P4> ; save a couple
SOU.0: TLC S2,-1 ; check for generic ascii ptr
TLCN S2,-1 ; skip if specific
HRLI S2,(POINT 7) ; map it
TOPS10< HRRI S2,@S2 ; perform effective adr calculation
TLZ S2,77 ; 'cause cal11. uuo can't handle it
TLNN S2,770000 ; check for position = 0
ADD S2,[440000,,1]> ; cause it can't handle this either
MOVE P4,S1 ; Save the handle temporarily
$CALL ALCARG ; Allocate an FEI%O arg block
EXCH P4,S1 ; Swap them back
STORE S2,(P4),ARG$PT ; Save the byte pointer to input area
STORE T1,(P4),ARG$BC ; Save the byte count
JUMPGE T1,ERT (D6CNN,SOTRT1) ; Test for illegal byte count
MOVX T1,FC.WD ; Function to write data to device
STORE T1,(P4),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,SOTRT1) ; Illegal handle
MOVE P1,S2 ; Save the handle temporarily
LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,ERT (D6DCO,SOTRT1) ; Device can't do output
LOAD S1,(S2),H$RUN ; Check to see if the output already
JUMPN S1,SOTGO ; running
$CALL REQOUT ; Request output permission
JUMPF SOTRT1 ; Didn't get it ... release line
$CALL CRAMT ; init offline timer
MOVEM S1,POTIM(P1) ; init last time polled
MOVEI S1,.POTM0 ; init poll time estimate
MOVEM S1,IOPOL(P1) ; start fast
SETZM IOAMT(P1) ; init current amt xfer'd
SOTGO: MOVE S1,IOAMT(P1) ; save previous amt xfer'd
MOVEM S1,IOPRV(P1)
SETZM IOAMT(P1) ; init current amt xfer'd
MOVE S1,P4 ; Point arg blk for FE I/O
$CALL FEI%O ; Do the output
JUMPF SOTTST ; Go check why the output failed
$CALL CRAMT ; update offline timer
MOVE S1,S2 ; Get the handle back on success
MOVX TF,TRUE ; Set success code
JRST SOTRET ; Go release the arg block and return
SOTTST: ; error is either D6NBR or D6REJ
; either way we have to check some cases
$CALL CKOABT ; Check for output aborts
JUMPF SOTF.1 ; Yes .. go release and clean up
TXNE T1,SDEOS!SDEOC ; is there there and unrequitted eof ?
JRST [$CALL EOFLOP ; yes - try to consumate it
JUMPF SOTF.1 ; if can't, return eof's error
MOVE S1,S2 ; get the handle back
$CALL SOTRET ; eof satisfied, try the sout again
JRST SOU.0] ; without passing go
TXNN T1,SDORN!SDOPG ; output still running
JRST [$CALL RNLOST ; definitely not good
JRST SOTRET]
$CALL CHKOFL ; check if device is offline
SKIPF
SKIPA S1,[D6DOL] ; yes - return offline msg
MOVX S1,D6NBR ; No .. so device is merely delayed
SOTF.1: CAIE S1,D6NBR ; check non-fatal causes
CAIN S1,D6DOL
JRST SOTF.2 ; non-fatal
ZERO ((S2),H$RUN) ; Clear the running flag
SOTF.2: MOVX TF,FALSE ; Set failure flag
; Release arg block and return
SOTRET: LOAD T1,(P4),ARG$XF ; get amt xfer'd
ADDM T1,IOAMT(P1) ; update the current amt
$CALL ESTPOL ; generate poll estimate
SOTRT1: LOAD T1,(P4),ARG$BC ; Get the count of bytes not done
LOAD S2,(P4),ARG$PT ; Get pointer where string left off
EXCH S1,P4 ; Swap error code(handle) and ptr
$CALL RLSARG ; Release the argument block
MOVE S1,P4 ; Get the error code(handle) back
$RET
RNLOST: ZERO ((S2),H$RUN) ; lost io run status - this most likely
; to occur when there are two independent
; users of the same line...one disables
; and reenables the line while the other
; is not looking or due to a race at eof
; in 2780/3780.
$CALL DEVREJ ; analyze as device reject
$RET
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: DBGSTR <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
RETFNI: MOVX S1,D6FNI ; No .. no other function implemented
$RETF
DOPRQI: LOAD S1,(S2),H$IOM ; Get the input/output mode of device
JUMPN S1,REQIN ; Check to see if input .. go grant
JRST REQOUT ; otherwise get output permission
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
DOPAB0: $CALL CKOABT ; see if output abort in progress
JUMPT DOPAB1 ; no - set it
CAIE S1,D6OAB ; yes - skip if complete
$RET ; no - return(D6NBR
$RETT ; output abort completed and ccleared
DOPAB1: $DVCMD (DC.SOA) ; Signal output abort on device
JRST DOPAB0
DOPIAB: $CALL CKIABT ; check if input abort in progress
JUMPT DOPIA1 ; no - set it
CAIE S1,D6IAB ; yes - check if complete
$RET ; no - return(D6NBR)
$RETT ; yes - input abort completed and cleared
DOPIA1: $DVCMD (DC.SIA) ; Signal input abort on device
JRST DOPIAB
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: DBGSTR <D60EOF>
$SAVE <S2,T1,T2> ; 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
LOAD S1,(S2),H$PDD ; get the packed port descriptor
$CALL OPNFE ; find out if fe is alive
JUMPF .POPJ ; no - don't bother with more
LOAD S1,(S2),H$STY ; Get terminal (station) type [237]
CAIE S1,SLHSP ; Check for a HASP station [237]
JRST INTEOF ; no, do normal EOF processing for console [237]
LOAD S1,(S2),H$DEV ; Get device type number
CAIE S1,.OPCIN ; Check for console input
CAIN S1,.OPCOU ; or console output device
JRST CONEOF ; don't send eof's to console dev
INTEOF:
INTEO1: LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,EOFL.2 ; Input device .. can't output EOF
$CALL CKOABT ; Check for an output abort
JUMPF EOFL.1 ; Yes .. go clean up and return
LOAD S1,(S2),H$RUN ; check if we think io is running
JUMPN S1,EOFSND ; yes - so do the eof
TXNN T1,SDORN!SDOPG!SDEOS!SDEOC ; Test for output running
JRST EOFL.2 ; No .. so just give successful return
EOFSND: TXNE T1,SDEOS!SDEOC ; don't bother if eof already done
JRST EOFLP1
$DVCMD DC.SOE ; Signal EOF on device
JUMPF EOFL.1 ; just go away if err'd
EOFLOP: $CALL CKOABT ; Check for an output abort
JUMPF EOFL.1 ; Yes .. give error and failure return
EOFLP1: TXNN T1,SDEOC ; Test for output EOF complete
JRST RETNBR ; No .. so wait until it is.
$DVCMD DC.COE ; Yes .. so clear the EOF complete flg
JUMPT EOFL.2 ; Give successful return
EOFL.1: CAIN S1,D6NBR ; errs...check non-fatal
$RET ; non-fatal...come back later
EOFL.2: ZERO ((S2),H$RUN) ; Clear the run flag in handle entry
$RETT ; Successful return
CONEOF: LOAD S1,(S2),H$IOM ; Get the input/output mode
JUMPN S1,@.RETT ; Input device .. can't output EOF
LOAD S1,(S2),H$RUN ; Check to see if I/O is running
JUMPE S1,@.RETT ; no need
$DVCMD (DC.DOB) ; dump output buffers
JUMPF EOFL.1
$RETT
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: DBGSTR <D60RLS>
$SAVE <S2,T1,T2>
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
LOAD S1,(S2),H$RUN ; check if it is running
JUMPE S1,RLS.1 ; no - not much to do
LOAD S1,(S2),H$IOM ; check io mode of device
JUMPN S1,RLS.1 ; if input, no need to do eof
$CALL INTEOF ; Make sure that the I/O is closed off
JUMPT RLS.1 ; If no problems releasing .. continue
CAIE S1,D6NBR ; errs...check non-fatal
JRST RLS.1 ; if fatal - ignore the error
; Note: D6DOL is essentially fatal here
; since we are trying to get unstuck.
$CALL CKOABT ; check special case for signon device
JUMPF RLS.1 ; makes no difference now
; T1/SDFLG, T2/SDLFG from device status
TXNE T2,SDCME ; if communications established...
JRST RETNBR ; then wait
; otherwise, the eof will never complete
RLS.1: ZERO ((S2),H$RUN) ; make sure this device is not running
$CALL RLSHAN ; Release the handle entry and possibly
$RETT ; 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 -
;
; Line status in s1,composite upper line status,line info in s2
; Device status in S2
; Multiple device activity status - in block pointed to by S2
ENTRY D60STS
D60STS: DBGSTR <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 RETFNI ; 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 @.POPJ ; 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
HRLZ S2,S1 ; make a PDD
SETZ S1,
$CALL PCKPDD
$CALL INIDMY ; Start up a dummy list entry
JUMPF @.POPJ ; 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
JRST RLSHAN ; Return while releasing dummy handle
STSLIN: MOVE T1,S2 ; Move line number to a safe place
HRL S2,S1 ; make a PDD
SETZ S1,
$CALL PCKPDD
$CALL INIDMY ; Start up a dummy list entry
JUMPF @.POPJ ; Failed to start a front end
STORE T1,(S2),H$LIN ; Store lower 9 bits as line number
$CALL LINSTS ; Get status of line
$CALL RLSHAN ; Release the dummy handle
JUMPF @.POPJ ; If line status failed .. bad return
LOAD T1,,SLFLG ; Get flags
MOVE S1,T1 ; return full line flags in s1
ANDI T1,177400 ; Get only significant part
LOAD S2,,SLINF ; Get line info
IOR S2,T1 ; Put them all together
$RETT ; Return successfully
INIDMY: ; S1/PDD
$CALL ALCHAN ; Make up a dummy handle entry
$CALL OPNFE ; Open the front end
JUMPF RLSHAN ; Can't open front end, rls dummy
$RETT ; Front end opened just fine
SUBTTL GLobal routine -- D60CND
; Routine - D60CND
;
; 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
;
; Returns S1/sixbit node name if TRUE signon match(if required)
ENTRY D60CND
D60CND: DBGSTR <D60CND>
$SAVE <S2,T1,T2,P1,P2,P3> ; Save some registers
MOVE P3,S1 ; set up QUASAR msg ptr as a global parameter
MOVEI P2,SUP.CN(P3) ; Get address of conditioning block
MOVE S2,(P2) ; get S1/port,,line
SETZ S1,
$CALL PCKPDD ; check if this port-line is alive
$CALL FNDPDD
JUMPF CND.0 ; no - but kill it for good measure
LOAD S1,(S2),H$SPN ; yes - check for signon pending
JUMPN S1,CND.10 ; yes - skip all the other cruft
LOAD S1,(S2),H$ENB ; check ENABLE in progress
JUMPN S1,CND.7 ; continue ENABLE processing
; previously incarnated - blow it away
CND.0: MOVE S1,(P2) ; get S1/port,,line
MOVE S2,SUP.NO(P3) ; and S2/node name
$CALL DISABL ; make sure line was disabled
JUMPF @.POPJ ; exit if failed
; success - S2/handle list entry to use
CND.6: $CALL PRTSTS ; Get status of front end
JUMPF RLSHAN ; Can't get port status .. so die
LOAD T1,(P2),CN$TYP ; Get desired translation type
MOVE T1,[EXP TR$X78,TR$X78,TR$HSP]-1(T1)
LOAD S1,,S6TRN ; Get translations avaiable in FE
TDNN S1,T1 ; Check wanted against available
JRST ERT (D6PIU,RLSHAN) ; Nope .. port is useless
SETZ T1, ; build enable argument blocks
LOAD S1,(P2),CN$TYP ; Get the station type (terminal type)
STORE S1,T1,EN$TYP ; stuff in its place
LOAD S1,(P2),CN$MAP ; Get the emulation/termination flag
; and primary/secondary flag
STORE S1,T1,EN$MAP ; Put into second byte and
MOVE S1,SUP.ST(P3) ; get signon requirements
TXNN S1,NETSGN ; skip if signon is required
TXO T1,EN$SON ; not required - so claim it already is
LOAD S1,(P2),CN$TYP ; set transparency flag
CAIN S1,SLHSP ; only relevant to hasp
TXZA T1,EN$SON ; HASP always requires signon in the protocol
TDZA S1,S1 ; 2780/3780 - clear it
LOAD S1,(P2),CN$TRA ; HASP - get the argument
STORE S1,T1,EN$TRA ; and finally set the flag
$LNCMD (LC.EL,RLSHAN) ; start the line up again (enable)
SETO S1, ; set ENABLE in progress flag
STORE S1,(S2),H$ENB
CND.7: LOAD T1,(P2),CN$CTS ; Get the clear to send delay
$CALL SWAPB ; swap the bytes in 16 bit word
$LNCMD (LC.CSD,CNDERX) ; 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,CNDERX) ; 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,CNDERX) ; and set it
CND.9: $LNCMD (LC.DTR,CNDERX) ; Set the data terminal ready
SETZ S1,
STORE S1,(S2),H$ENB ; clear the enable in progress
CND.10: $CALL SONRD ; and do the signon processing
JUMPF @.POPJ ; no success exit till signed on
; S1/sixbit node name
CND.11: $CALL LOGUP ; log line going up
$CALL RLSHAN ; Release handle, FE and return
$RETT
CNDERX: CAIN S1,D6NBR ; analize errors during enable processing
$RET
CAIN S1,D6REJ ; io rejected means line went down
MOVEI S1,D6LGA
JRST RLSHAN ; anything else is fatal alsoRU
SUBTTL GLobal routine -- D60DIS
; Routine - D60DIS
;
; Function - To disable a specific line
;
; Parameters -
;
; S1/port,,line
; S2/node name - for logging
ENTRY D60DIS
D60DIS: DBGSTR <D60DIS>
$CALL DISABL ; disable the line
$CALL RLSHAN ; flush the handle
$RET
DISABL: $SAVE <T1,T2,P1,P2> ; make sure line is disabled
; S1/port,,line
; S2/node name
DMOVE P1,S1 ; save the args
HLRZ T1,P1 ; get T1/port
HRRZ T2,P1 ; get T2/line
CND.X: $CALL LFIRST ; 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.1B ; 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.1B ; No .. continue until last entry
; clear line enable special modes
SETZ S1,
STORE S1,(S2),H$SPN ; no signon pending
STORE S1,(S2),H$ENB ; no enable pending
PUSH P,S2 ; save this handle
$CALL LNEXT ; look up next one
EXCH S2,(P) ; recover current one and save next
MOVE S1,S2 ; Get handle of current entry
$CALL D60RLS ; Release the device
POP P,S2 ; recover next handle(current one is gonso)
JUMPF @.POPJ
JUMPN S2,CND.1 ; check for next handle
JRST CND.2 ; no - can proceed now
CND.1B: $CALL LNEXT ; Find next handle list entry
JUMPT CND.1 ; Another one .. check releasability
CND.2: SETZ S1, ; make a PDD
MOVE S2,P1
$CALL PCKPDD
$CALL ALCHAN ; Make up a dummy handle entry
LOAD S1,(S2),H$PDD ; Get the packed device descriptor
$CALL OPNFE ; Open up the front end for setup
JUMPF RLSHAN ; Couldn't open a front end
$CALL LINSTS ; check if line up now
JUMPF RLSHAN
LOAD S1,,SLFLG
LOAD T1,,SLINF ; get line status
TXNN S1,SLDIP!SLLDC ; check disable in progress or complete
TXNN T1,SLLEN ; check line enabled
$RETT ; no - nothing further to do
MOVE S1,P2 ; yes - log this shutdown
$CALL LOGDWN
CND.3: $LNCMD (LC.DIS,RLSHAN) ; Shut down the line (disable)
$RET
SUBTTL SONRD - signon processing
; Routine - SONRD
;
; Function - To read the signon string from the RJE card-reader and match
; it against the string read from the .SON file.
;
; Parameters -
;
; S2/ Handle list entry address for port,,line
; P2/ ptr to conditioning block
; P3/ ptr to QUASAR setup msg
;
; Returns - S1/sixbit node name if signon is TRUE
SONRD: LOAD S1,(P2),CN$ETF ; Get emulation/termination flag
JUMPN S1,SONRTA ; If emulation .. ignore signon
$SAVE <S2,T4,P1,P2,P3>
; register use:
; P1/handle list entry for port,,line
; P2/handle list entry for signon device
; P3/ptr to QUASAR setup msg
MOVE T4,P2 ; save conditioning block for open
MOVE P1,S2 ; Make copy of handle entry address
SETO S1,
STORE S1,(P1),H$SPN ; Set signon pending flag
SETZ P2, ; no signon device yet
LOAD S1,(P1),H$HSN ; get the signon device handle
JUMPN S1,SONRD1 ; it's already there!
MOVE S1,SUP.NO(P3) ; make node name = arg til known different
STORE S1,(P1),H$NOD
$CALL LINSTS ; check if already signed on
JUMPF SONRDF
LOAD S1,,SLINF ; check some basics 1st
TXNN S1,SLLEN ; line still up?
JRST SONLGA
TXNN S1,SLDSR ; has anyone called?
JRST SONNBR ; no need to get excited yet
LOAD S1,,SLFLG ; get the line flags
TXNE S1,SLSON
JRST SONSUC ; already signed on
MOVEI S2,SONOPB ; ptr to inhouse open block for signon dev
LOAD S1,(P1),H$PRT ; have to open it
STORE S1,(S2),OP$PRT ; stuff in open block
LOAD S1,(P1),H$LIN
STORE S1,(S2),OP$LIN ; stuff it too
MOVNI S1,3 ; length of open block
$CALL D60OPN ; open the signon device
JUMPF SONRDF ; hopefully just delayed
STORE S1,(P1),H$HSN ; SAVE THE SIGNON DEVICE HANDLE IN
; port/line handle entry
SONRD1: $CALL SRCHAN ; get the handle list entry
JUMPF SONDIE ; amazing!
MOVE P2,S2 ; save the signon device list entry
LOAD S1,(P2),H$SON ; did we make partial progress earlier?
JUMPN S1,SONRD0 ; yes - just need to clean up
MOVE S1,P2 ; Get device handle
HRROI S2,SONBUF ; Point to input string buffer
MOVX T1,-^d82 ; Length of string to read
$CALL D60SIN ; Read the signon string
SKIPE T1 ; ignore error if card was read
JUMPF SONRDF ; go analyze error
MOVE S1,SUP.ST(P3) ; check for signon required
TXNN S1,NETSGN
JRST [MOVE S1,SUP.NO(P3) ; get the node name arg
TLNN S1,-1 ; make sure it is sixbit
$CALL SMAP6
JRST SONRDS] ; claim everything is hunkydory
DMOVE S2,[POINT 7,SONBUF ; really need to validate the signon string
^d82] ; "A" string descriptor
$CALL SONFIL ; try to match signon string
JUMPF SONRDF ; mismatch
SONRDS: STORE S1,(P1),H$NOD ; save the node name til finally done
SETO S1,
STORE S1,(P2),H$SON ; we are actually signed on now
SONRD0: MOVE S2,P2 ; Restore handle list entry address
$DVCMD (DC.CIE) ; Clear input EOF complete
JUMPF @.POPJ
$LNCMD (LC.SON) ; set station signed on flag
JUMPF @.POPJ ; slowness
SONSUC: SKIPE S2,P2 ; release the signon device and line
$CALL RLS.1 ; release the signon device
SETZ S1, ; clean up the port,,line data base
STORE S1,(P1),H$SPN ; signon no longer pending
STORE S1,(P1),H$HSN ; no longer have a signon device handle
LOAD S1,(P1),H$NOD ; get the node name
$WTOJ <^N/S1/ signed on>,,<SUP.TY(P3)>
$RETT ; and return
SONLGA: SKIPA S1,[D6LGA] ; line went away while we were waiting
SONNBR: MOVX S1,D6NBR ; no phone connection yet
MOVX TF,FALSE
SONRDF: CAIE S1,D6NBR ; analyze failure exit
CAIN S1,D6DOL
JRST @.POPJ ; innocuous
; fatal
PUSH P,S1 ; save the error code
SKIPE S2,P2 ; release the signon device and line
$CALL RLS.1 ; release the signon device
SETZ S1, ; clean up the port,,line data base
STORE S1,(P1),H$SPN ; signon no longer pending
STORE S1,(P1),H$HSN ; no longer have a signon device handle
STORE S1,(P1),H$SON ; and definitely not signed on
POP P,S1 ; retrieve the error
$RETF ; and return the error
SONRTA: MOVE S1,SUP.NO(P3) ; return arg as node name
$RETT
SONDIE: $STOP (NSH,<can't find signon device handle after creating it!>)
SUBTTL SONFIL - read signon file for node
; Routine - SONFIL
;
; Function - Read and store a signon file for a particular node.
;
; Parameters -
; S2/ptr to signon string
; T1/- no. bytes in signon string
; P3/Address of setup message from QUASAR
;
; Returns - False if failed to read signon file ($WTOJ sent)
; TRUE - S1/sixbit node name of station signed on
;
; NOTE: signon file format:
; line pairs - line a: signon string to match against signon record
; line b: node name (1-6 alphanumeric characters)
;
; signon string has floating fields of nonblank characters, trailing
; blanks not required.
SONFIL: $SAVE <S2,T1,T2,T3,T4,P1,P2,P3,P4>
TOPS10< PUSH P,[SIXCVT]> ;convert SIXBIT to number on exit
; register use:
; S1/no. bytes left in current IBUF
; S2/ptr into current IBUF
; T1/current char in signon file(IBUF)
; T2/current char in signon string
; T3/current signon string ptr
; T4/ no. bytes currently left in signon string
; P1/ptr to signon string
; P2/no. byres in signon string
; P3/ptr to QUASAR setup msg
; P4/ifn for signon file
MOVE P1,S2 ; save the signon parameters
MOVM P2,T1 ; use positive count to be consistent
; with f%ibuf values(avoids confusing me)
DMOVE T3,P1 ; find last significant character in
; signon record
MOVE S1,P2 ; init char cnt
SONF00: $CALL SIGNB ; find next non-blank character
JUMPF SONF01 ; done
MOVE S1,T4 ; save char count of last nb char
JRST SONF00 ; T4/characters remaining in signon record
SONF01: SUB P2,S1 ; adjust P2 to number of significant characters
JUMPE P2,SONFL3 ; blank signon record not allowed
; Open the signon file
SETZ P4, ; Clear IFN of file (so far)
TOPS20< $TEXT <-1,,SONFD+1>,<^T/SONDIR/^N/SUP.NO(P3)/.SON^0>>
TOPS10< MOVE S1,SUP.NO(P3) ; get the station name
TLNN S1,-1 ; check for binary node number
$CALL SMAP6 ; map it to sixbit
MOVEM S1,SGNNAM > ; stuff it in fd
MOVX S1,FOB.MZ ; Get size of FOB
MOVEI S2,SONFOB ; Signon file FOB
$CALL F%IOPN ; Open file for input
JUMPF SNF.F ; Signon file failure
MOVE P4,S1 ; Save IFN of file
SONF0: SETZ S1, ; no chars in buffer initially
SONF1: DMOVE T3,P1 ; start new string compare
JRST SONF5 ; start on 1st nonblank
SONF2: $CALL SIGCH ; get a signon string character
JUMPF SONN1 ; end of signon string
; T2/current signon string character
SONF3: $CALL FILCH ; get next file line character
JUMPF SONN3 ; this is a mismatch
; T1/current signon file character
SONF4: CAME T1,T2 ; compare current characters of strings
JRST SONN2 ; fundamental mismatch
CAIE T1,40 ; check for blanks
JRST SONF2 ; continue scan
SONF5: $CALL SIGNB ; get next non blank signon string ch
JUMPF SONN1 ; end of signon string
; more significant signon string
$CALL FILNB ; get next non blank file ch
JUMPT SONF4 ; more significant file string, continue scan
JRST SONN3 ; mismatch
SONN1: $CALL FILNB ; end of signon string
; must be end of file line to match
JUMPT SONN2 ; more file left - mismatch
JUMPE T1,SONWN0 ; check for file done
SONWIN: ; match - get node name
$CALL GETNOD ; get the node name
SONWN0: PUSH P,TF ; save the truthity
EXCH S1,P4
$CALL F%REL ; close the signon file
MOVE S1,P4 ; get the node name back
POP P,TF ;learn the truth again
JUMPF SONRTA ; just return arg if none
$RETT
SONN2: $CALL SCNLIN ; mismatch - find next signon file string
JUMPF SONFDN ; no more - loses
SONN3: JUMPE T1,SONFDN ; check for file done
$CALL SCNLIN ; drop node name line
JUMPF SONFDN ; end of valid stations
JRST SONF1 ; ready for another try
; Here when there is a failure reading the signon file.
SNF.F: $WTOJ <^N/SUP.NO(P3)/ Signon failure>,<Signon file ^F/SONFD/, error: ^E/S1/>,<SUP.TY(P3)>
SKIPE S1,P4 ; Check for IFN already assigned
$CALL F%REL ; Release the file
RETSON: MOVX S1,D6SON
$RETF ; then give a failure return
SONFDN: CAIE S1,EREOF$ ; check input error
JRST SNF.F ; io error
SONFL2: MOVE S1,P4 ; ran out of file - this is a mismatch
$CALL F%REL ; close the file
SONFL3: ; here for blank signon record
$WTOJ <^N/SUP.NO(P3)/ SIGNON failure>,<signon record:^M^J^T/(P1)/... did not match signon file.>,<SUP.TY(P3)>
JRST RETSON
SIGCH: SOJL T4,SIGCHF ; precount char
ILDB T2,T3 ; get a signon string character
CAIN T2,11 ; map tabs
MOVEI T2,40
CAIE T2,15 ; check end of card image
CAIN T2,12
SIGCHF: $RETF ; yes - just fail
$RETT ; no - suc
FILCH: SOJGE S1,FILCH0 ; precount char
MOVE S1,P4 ; read some more
$CALL F%IBUF
SETZ T1, ; error exit flag
JUMPT FILCH ; continue
$RET ; just die - T1/0
FILCH0: ILDB T1,S2 ; get next file line character
CAIN T1,11 ; map tabs
MOVEI T1,40
CAIN T1,15 ; check for end
JRST FILCH ; end - don't stop on cr
CAIN T1,12
$RETF ; fail - T1/line feed
$RETT ; still in the running
SIGNB: $CALL SIGCH ; scan signon string for non blank
JUMPF @.POPJ ; just return if end of string
CAIN T2,40 ; is this a space
JRST SIGNB ; yes - continue scanning
$RETT ; T2/good character to compare
FILNB: $CALL FILCH ; scan file line for non blank
JUMPF @.POPJ ; we are done one way or another
CAIN T1,40 ; SPACE ?
JRST FILNB ; yes - continue scanning
$RETT ; T1/good char to compare
SCNLIN: ; scan off a line in signon file
$CALL FILCH ; get next character on line
JUMPT SCNLIN ; if there is one, continue scanning
JUMPE T1,@.POPJ ; if file error, this fails
$RETT ; otherwise it suc's
GETNOD: MOVE T3,[POINT 6,T2] ; get node name from signon file
MOVEI T4,6 ; S2/ptr to beg of node name line
SETZ T2,
GETND1: $CALL FILCH ; get a char
JUMPF GETNDX ; end of line/file - check for name
CAIL T1,"A" ; check valid node name characters
CAILE T1,"Z"
JRST GETND3 ; not a letter
GETND2: SUBI T1,40 ; make sixbit
IDPB T1,T3 ; crammit
SOJG T4,GETND1
GETNDX: JUMPE T2,@.RETF ; not a valid node name
MOVE S1,T2 ; return node name
$RETT
GETND3: CAIL T1,"0" ; check numeric
CAILE T1,"9"
JRST GETNDX ; terminate node name on 1st non-alphanumeric
JRST GETND2 ; numeric - keep going
SMAP6: $SAVE <S2,T1,T2> ; S1/binary number to convert to sixbit
MOVE S2,[POINT 6,S1] ; a sixbit ptr
MOVE T1,S1
SETZ S1, ; build sixbit in S1
SMAP61: IDIVI T1,^D8 ; the usual algorithm
PUSH P,T2 ; node numbers are octal
SKIPE T1
PUSHJ P,SMAP61
POP P,T2
ADDI T2,'0'
IDPB T2,S2
POPJ P,
TOPS10<
SIXCVT: ;convert S1 from SIXBIT to octal
$SAVE <TF,S2>
TDNE S1,[EXP 505050505050]
$RET
SETZ TF,
MOVEI S2,6
SIXLP: LSH S1,3
LSHC TF,3
JUMPE S1,SIXLPE
SOJG S2,SIXLP
SIXLPE: MOVE S1,TF
$RET
>
SUBTTL Grant input permission
; Routine - REQIN
;
; Function - To grant an input request if one pending, wait for one and
; grant it.
;
; Parameters -
;
; S2/ Handle list entry address
REQIN: $SAVE <T1,T2> ; Save registers
REQSPN: $CALL CKIABT ; Check for any outstanding input abort
JUMPF @.POPJ ; Yes .. so just return with failure
TXNN T1,SDIPR!SDIPG!SDIPW!SDIEC!SDIRN ; Check for input perm. was requested
JRST NOACTI ; no active or recent request
REQRTY: TXNE T1,SDIRN!SDIEC ; Check for input already running
JRST REQINS ; Yes
REQGRT: TXNE T1,SDIPG ; check for input permission already granted
JRST REQGLP
$DVCMD DC.GIP ; Do a device input permission grant
JUMPF @.POPJ
REQGLP: $CALL CKIABT ; Check for input aborts
JUMPF @.POPJ ; Failure do to abort on device
TXNN T1,SDIEC!SDIRN ; Check for EOF or running
JRST RETNBR ; not yet
REQINS: SETO T1, ; Yes .. so turn on
STORE T1,(S2),H$RUN ; the I/O running flag
$RETT ; Give a successful return
NOACTI: LOAD S1,(S2),H$TEM ; no active input request
JUMPN S1,RETIAB ; emulation is responding to device active
; termination is just fishing
RETNBR: MOVX S1,D6NBR ; return non-fatal, "wait awhile" error
$RETF
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
DSRLP: $CALL LINSTS ; Get the line status
JUMPF @.POPJ ; Failed .. line must be dead
LOAD T1,,SLINF ; Get the info status byte
TXNE T1,SLDSR ; Test for the DSR set
JRST STOGST ; Yes .. start output grant request
LOAD T1,,SLFLG ; Get line flags.
TXNN T1,SLCME ; Check for line failure
RETDSR: SKIPA S1,[D6DNU] ; no DSR
RETLGA: MOVX S1,D6LGA ; Yes .. say line has gone away.
$RETF ; Failure return
STOGST: 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
REQODV: $CALL CKOABT ; Check for output aborts
JUMPF @.POPJ ; Yes .. just give error return
TXNE T1,SDIPW!SDIPR!SDIRN!SDIPG!SDIEC ; Check for input requested
JRST RETCGO ; Input coming .. can't do output
TXNE T1,SDEOS!SDEOC
JRST REQEOF
TXNE T1,SDORN!SDOPG ; Output running or granted already?
JRST STGRUN ; No so go request output
REQGO: $DVCMD DC.ROP ; Request to do output
JUMPF @.POPJ
$CALL CKOABT ; Check for output aborts
JUMPF @.POPJ ; Yes .. failure on device
TXNE T1,SDOPG!SDORN ; Check to see if grant gotten
JRST STGRUN ; yes - go to it
TXNE T1,SDIPW!SDIPR!SDIRN!SDIPG!SDIEC ; no - check for reasons
JRST RETCGO ; input coming
TXNE T1,SDOPR ; still requesting output?
JRST RETNBR ; yes - wait
; just can't seem to get it right today
RETCGO: LOAD S1,(S2),H$TEM ; tell caller he can't DO output now
JUMPE S1,RETNBR ; LPTSPL can't stand D6CGO
MOVX S1,D6CGO ; and IBMSPL requires it!
$RETF
STGRUN: SETO T1, ; Set the flag saying that
STORE T1,(S2),H$RUN ; the output is now running
$RETT ; Give good return (output running)
REQEOF: $CALL EOFLP1
JUMPT REQODV
$RET
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 occurred, 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
; T2/ line flags
CKIABT: $CALL DEVSTS ; Get device status
JUMPF @.POPJ
LOAD T2,,SDLFG ; Get line status flags
LOAD T1,,SDFLG ; Get device flags
TXNE T1,SDIEC ; check for input eof 1st in case it
$RETT ; is one step ahead of disaster
TXNN T1,SDIAS ; Has input abort occurred?
$RETT ; No .. we are ok here
TXNN T1,SDIAC ; Has the abort completed?
JRST RETNBR ; no - wait
$DVCMD (DC.CIA) ; Clear input abort flag
JUMPF @.POPJ ; Failed to clear flag
RETIAB: MOVX S1,D6IAB ;[243] Cleared .. input abort occurred
$RETF ;[243] 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 occurred, 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
; T2/ line flags
CKOABT: $CALL DEVSTS ; Get device status
JUMPF @.POPJ
LOAD T2,,SDLFG ; Get line status flags
LOAD T1,,SDFLG ; Get device flags
TXNN T1,SDOAS ; Has output abort occurred?
$RETT ; No .. we are ok here
TXNN T1,SDOAC ; Has the abort completed?
JRST RETNBR ; no - wait
$DVCMD (DC.COA) ; Clear output abort flag
JUMPF @.POPJ ; Failed to clear flag
RETOAB: MOVX S1,D6OAB ;[243] Cleared .. I/O error occurred
$RETF ;[243] 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 - S1/PDD
;
; Returns -
;
; S2/ Location of the new handle list entry
ALCHAN: $CALL GETHND ; Create a handle list entry
JUMPF @.POPJ ; no more free space
PUSH P,S1
SETO S1, ; Set the bytes per message to
STORE S1,(S2),H$BPM ; +infinity so commands go through
SETZM CDPTR(S2) ; init input card dev data base
SETZM CDCNT(S2)
SETZM CDBUF(S2)
SETZM CDERM(S2)
POP P,S1
$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
$CALL VALHND ; make very sure
JUMPF @.POPJ
MOVE T1,S2 ; Make a copy of list entry address
RLSH.2: SKIPE CDBUF(S2) ; check for input card dev buffer
JRST [MOVE S1,CDBSZ(T1) ; yes - release buffer
PUSH P,S2 ; save the handle
PUSH P,CDBUF(S2) ; save the buffer address
IDIVI S1,5 ; calc no. words
SKIPE S2
AOS S1
POP P,S2 ; get the buffer address back
$CALL M%RMEM
POP P,S2 ; get the handle back
JRST .+1]
$CALL REMHND ; flush the handle
JRST RLSFE ; Go conditionally release the FE
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
;
; Function -
; (DEQD60) To dequeue a DN60 on a port so that others can use it again.
;
; Parameters-
;
; S1/ PDD
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 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: SKIPG PTYPE ; Check for a KS10 (2020)
$RETT ; yes - nothing to do
$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 the port number
CAIL S1,DTEOFF ; Check to see if the DTE # is within
CAILE S1,MAXDTE ; valid bounds
JRST ERT (D6NSP) ; Port number not defined
$CALL PROTYP ; check protocol version
JUMPL S1,RETDNR ; no protocol running
CAIN S1,.VND60
$RETT ; DN60 protocol running
CAIE S1,.VN20F
JRST ERT (D6PIU) ; some other protocol(MCB) running
; RSX20F protocol running
LOAD S1,PDD,PD$PRT ; get the port number
SKIPE FEJFN ; If JFN already assigned .. then
PJRST SELDTE ; just go select the DTE
MOVX FENM,1 ; Start with FE device FE1:
MOVE S1,PDD ; Get the packed device descriptor
$CALL ENQD60 ; Enqueue the port and get a JFN.
OPFE2: MOVE S1,FENM ; Get the next FE number to try to get.
CAILE S1,MAXFE ; Check if have run out of FE:'s
JRST OPDIE ; Yes .. so let go and crap out.
$CALL FENAM ; Make up the front end name
MOVX S1,GJ%OLD+GJ%SHT ; Old file, short form of GETJFN
GTJFN ; and try it.
ERJMP OPERR1 ; Didn't get it.
MOVEM S1,FEJFN ; Save the JFN for everyone
MOVX S2,FLD(^d8,OF%BSZ)+OF%RD+OF%WR ; Read/write in 8 bit mode
OPENF ; Try to open the FE
ERJMP OPERR2 ; nope can't do it to this one.
OPNSEL: LOAD S1,PDD,PD$PRT ; Get the DTE number from the PDD
$CALL SELDTE ; Go select the DTE
JUMPF OPERR3 ; Didn't select properly
MOVE S1,PDD ; Get the PDD back again so that
PJRST DEQD60 ; we can release the port and return.
RETDNR: MOVEI S1,D6DNR ; no protocol running on fe
$RETF
; Here if GTJFN fails on FEn:
OPERR1: AOJA FENM,OPFE2 ; No .. so try next one
; 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
; Here on fatal errors that need to dequeue the port
OPCLR: SETZM FEJFN ; Clear the JFN before returning
OPDIE: MOVE S1,PDD ; Get the device descriptor
$CALL DEQD60 ; Get rid of the port
MOVX S1,D6COF
$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 CPUTYP -- Routine to type the processor
; Routine - CPUTYP
;
; Function -
;
; This routine determines whether we are running on a KL or KS system.
;
; Parameters - none
;
; Returns - True always
;
; PTYPE/ processor type code
; CPUTYP - cleverly determine what processor we are on
CPUTYP: $SAVE <S1,S2,T1,T2>
JFCL .+1 ; clear the flags
JRST .+1 ; see if we change the pc flag
JFCL S1,PDP6 ; yes,it was a pdp-6
SETO S1, ; set ac to -1
AOBJN S1,.+1 ; see how it adds 1,,1 to -1
JUMPN S1,KA10 ; on a ka, it is two full adds
BLT S1,0 ; noop blt
JUMPE S1,KI10 ; ki wont update the word
DMOVE S1,[EXP 1,0] ; 1, and no string pointer
DMOVE T1,S1 ; offset of 1 and string length of 0
EXTEND S1,[CVTBDO] ; convert binary to decimal with offset
TLNE T2,200000 ; look for kl microcode bug
KL10: SKIPA S1,[P.KL10] ; set KL10 type
KS10: MOVX S1,P.KS10 ; set KS10 type
SETCPU: MOVEM S1,PTYPE ; set the cpu type
$RETT
KA10: SKIPA S1,[P.KA10] ; set KA10 type
KI10: MOVX S1,P.KI10 ; set KI10 type
JRST SETCPU
PDP6: MOVX S1,P.PDP6 ; set PDP-6 type
JRST SETCPU
;PTYPE: 0 ; processor type
P.KS10==1B0 ; KS10 - deliberately the sign bit
P.KL10==1B1 ; KL10
P.KI10==1B2 ; KI10
P.KA10==1B3 ; KA10
P.PDP6==1B4 ; PDP-6
> ;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 <S2,P2> ; Save registers
MOVEI P2,C11BLK ; Get location of CAL11. arg block
LOAD S1,S1,PD$PRT ; Get the port number from handle list
STORE S1,(P2),C$PRT ; Store it in the CAL11. block
MOVX S1,.C11UP ; CAL11. function to check up/down
STORE S1,(P2),C$FNC ; status of the FE
MOVE S1,[1,,C11BLK]
CAL11. S1, ; Well ... check it.
JRST OPNFER ; It didn't go.
CAIE S1,1 ; Check for 11 up?
JRST ERT (D6DNR) ; DN60 not running
MOVX S1,.C11NM ; Function to get program name from 11
STORE S1,(P2),C$FNC ; to see if it is our kind.
MOVE S1,[1,,C11BLK]
CAL11. S1,
JRST OPNFER ; Doesn't like us for some reason
CAME S1,[SIXBIT /DN60 /] ; Check for running DN60 type code
JRST ERT (D6DNR) ; No .. not running DN60 code
$RETT ; Else we are golden, give good return.
OPNFER: CAIN S1,C11IU% ; check non-fatal possibility
JRST RETNBR ; return non-fatalistic err
MOVX S1,D6COF ; fatal
$RETF
> ;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 <SKIPN FEJFN ; check if any jfn to release
$RET ; no - nothing to do
; jfn implies RSX20F protocol
$SAVE <TF,S1> ; Save last error flag and return code
$CALL LFIRST ; Position to first entry
JUMPT .POPJ ; If entry found then return
SKIPN S1,FEJFN ; Last entry in list is destroyed
$RET ; return if no jfn
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 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: MOVE S1,[-D6.BYT,,FC.R6S]
$CALL GETSTS ; do the status function
$RET
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: MOVE S1,[-DS.BYT,,FC.RDS]
$CALL GETSTS ; do the status function
JUMPF DEVREJ ; analyze possible reject
$RET
SUBTTL Return status
; Routine - GETSTS
;
; Function - To get the status specified in the given PDD.
;
; Parameters -
;
; S1/ -<BYTE COUNT>,,FCN CODE
; S2/ Pointer to handle list entry
;
; Returns - T/F AND STATUS IN STSBUF IF T
GETSTS: $SAVE <T1,T2> ; Save registers
MOVE T1,S1 ; SAVE THE ARGS
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
HRRZM T1,(ARGP) ; Put THE FCN CODE into argument block
HLRES T1 ; INIT THE BYTE COUNT
MOVE T2,[POINT 8,STSBUF] ; and byte pointer, may be destroyed
DMOVEM T1,1(ARGP)
$CALL FEI%O ; I/O to the front end (Device status)
LOAD S1,(ARGP),ARG$XF ; default to no. of bytes transferred
SKIPT ; If an error occurred
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
$RET ; RLSARG preserves TF so just 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: MOVE S1,[-LS.BYT,,FC.RLS]
$CALL GETSTS ;GET THE STATUS
JUMPT [SKIPN S1 ;SUC'D BUT NO STATUS IS LINE DISABLED
PUSHJ P,LINST1 ;CLEAR THE STATUS BUFFER - LINE DISABLED
$RETT] ;AND RETURN TRUE
LINST1: PUSH P,S1 ;FAILED - RETURN 0'S FOR STATUS
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
POP P,S1
$RETF ; 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
CAIE S1,.OPSGN
CAIN S1,.OPCDR ; which if it is a card reader
MOVX T1,1 ; then it's doing input
JRST STHP.2 ; unless in emulation mode
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
STHP.2: 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 @.POPJ ; 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: PUSH P,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
POP P,S2
$RET ; Return, ignoring errors
; Routing - RLSARG
;
; Function - This routine releases a FEI%O argument block that was allocated
; with ALCARG.
;
; Parameters -
;
; S1/ Location of argument block
RLSARG: $SAVE <TF,S1,S2> ; Save GLX parameter register
MOVE S2,S1 ; Move block pointer
MOVX S1,ARGSIZ ; Size of argument block
PJRST M%RMEM ; Give it back to GLXLIB and return
SUBTTL LINCMD, DEVCMD -- Output a line (device) command
; Routine - LINCMD, DEVCMD
;
; Function - To output a DN60 line (device) command to the line (device)
; specified in the handle entry.
;
; Parameters -
;
; S1/ Line (device) command function code
; S2/ Handle list entry
; T1/ Command value (optional)
LINCMD: $SAVE <P1,P2,P3> ; Arg blk ptr, func code, cmd length
MOVX P2,FC.WLC ; Function code to write a line command
MOVE P3,LNCBYT(S1) ; Get number of bytes in value for cmd
$CALL CNTCMD ; do the command function
$RET
DEVCMD: $SAVE <P1,P2,P3> ; Arg blk ptr, func code, cmd length
MOVX P2,FC.WDC ; Function code to write a device cmd
MOVE P3,DVCBYT(S1) ; Get number of bytes in cmd string
$CALL CNTCMD ; do the command function
JUMPF DEVREJ ; check out possible reject
$RET
CNTCMD: MOVE P1,S1 ; Save the command number
$CALL ALCARG ; Allocate a FEI%O arg block
EXCH S1,P1 ; Swap arg blk ptr and command number
STORE P2,(P1),ARG$FC ; Save the function code (write cmd)
STORE S1,(P1),CMD$FC ; Put command function in cmd string
CAIN P3,1 ; Check for only 1 byte in cmd string
JRST SNDCMD ; Yes .. so no data follows it.
CAIN P3,2 ; Check for 2 bytes in cmd string
JRST B1CMD ; Yes .. so 1 byte of data follows
STORE T1,(P1),CMD$2B ; Otherwise we have 2 bytes of data
JRST SNDCMD ; to send
B1CMD: STORE T1,(P1),CMD$1B ; Store the single byte of cmd data
SNDCMD: MOVNS P3 ; Make the byte count and
SNDC.1: MOVSI S1,(POINT 8) ; Make a pointer to the command string
HRRI S1,CMD$WD(P1) ; in dynamic memory
STORE S1,(P1),ARG$PT ; Put it into the FE I/O arg block
STORE P3,(P1),ARG$BC ; Set the number of bytes to output
MOVE S1,P1 ; Point to the arg block
$CALL FEI%O ; and do the I/O to the front end
LOAD S1,(P1),ARG$RC ; Get the result code on error
EXCH S1,P1 ; Exchange error code and blk ptr
$CALL RLSARG ; Release the argument block
MOVE S1,P1 ; Get the error code again
JUMPE S1,@.RETT ; If no error then give success
$RETF ; else give error return
SUBTTL DEVREJ -- analyze device function failure
; Routine - DEVREJ
;
; Function - analyze the failure of a device related function. A reject might
; mean any of several things - the most probable being the line is
; gone.
;
; Parameters - S1/error code from previous function call
; S2/device handle
;
; Returns - S1/possibly mapped error code
DEVREJ: CAIE S1,D6REJ ; check if previous device function was rejected
$RET ; no - just return
$CALL LINSTS ; yes - get the line status
JUMPF @.POPJ ; looks like the fe is dead or delayed
$SAVE T1
LOAD S1,,SLINF ; get line info
LOAD T1,,SLFLG ; get line flags
TXNN T1,SLDIP!SLLDC ; check line dying or dead
TXNN S1,SLLEN ; check line disabled
JRST RETLGA ; yes - reason for rejecting device fcn
JRST RETNBR ; no - must have been a race...maybe it will go away
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: DPB T1,[POINT 8,T1,19]
LSH T1,-^D8
$RET
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 occurred
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
TOPS20 <
$SAVE <S2,P1,P2,P4,T1,T2,T3,T4> ; Save registers
DMOVE P1,S1 ; Set up arg and handle structure ptrs
SETZM NBXFRD(P2) ; clear the number of bytes transferred
LOAD S1,(P2),H$PRT ; Get the DTE #
SETZ P4, ; default protocol flag to old
SKIPL PTYPE ; Check for KL style I/O
JRST [SKIPE P4,PVTYP-DTEOFF(S1) ; check for version 5 protocol
JRST .+1 ; yes - continue
$CALL SELDTE ; Make the link to the correct DTE
JUMPF ERT(D6DTE,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 to xfer
JUMPN P4,FEI1 ; no enq for version 5
LOAD S1,(P2),H$PDD ; Get device descriptor
$CALL ENQD60 ; Enqueue the port for SIN/SOUT I/O
JUMPF FIONBR ; nothing's going right today
FEI1: LOAD T1,(P1),ARG$PT ; Get the pointer to the buffer area
HLRZ T2,T1 ; Get the position/size part
CAIN T2,-1 ; If it is a HRRO type byte pointer
HRLI T1,440700 ; then convert it to a real byte pntr
STORE T1,(P1),ARG$PT ; Put the byte pointer back
LOAD T1,(P1),ARG$FC ; Get function code to perform
STORE T1,,XMTFC ; Put it into 2nd byte in header
LOAD T1,(P2),H$LIN ; Get line number to do I/O to.
STORE T1,,XMTLN ; Put it into 3rd byte in header
LOAD T1,(P2),H$CDV ; Get communications device number
STORE T1,,XMTDV ; Put the device code in the 4th byte
LOAD T1,(P1),ARG$FC ; Get the function we are doing
TRNN T1,1 ; If it is odd then we do a read
JRST WRITE ; else we are doing a write operation.
JRST READ ; Go do read
SUBTTL FEI%O -- Read in from device (TOPS20)
READ: $CALL PUTHDR ; Output the header to say read data
JUMPF FIOFDQ ; Header failure test
JUMPN P4,RD.PV5 ; if version 5, done
$CALL GETHDR ; Get the response header
JUMPF FIOFDQ ; Input header no good
LOAD T1,,RCVBC ; Number of bytes to read in
JUMPG T1,READOK ; check if any data to be read
LOAD S1,,RCVRC ; Get the result of the header
CAIN S1,RC.REJ ; Check for reject of header
JRST FIOREJ ; If so .. terminate this read
CAIE S1,RC.DLY ; delay ?
JRST FIOTDQ ; no - suc'd with no data returned
JRST FIONBR ; Dismiss while waiting for -11 to
; catch up .. then try again
READOK: MOVE S1,FEJFN ; Get JFN for logical FE
LOAD S2,(P1),ARG$PT ; Get byte pointer to data buffer
MOVN T1,T1 ; Negative the byte count to read
SKIPG PTYPE ; 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 the pointer to continue on
RD.WRK: LOAD T1,,RCVBC ; Get the byte count to read again.
LOAD S1,,RCVRC ; Get the result of the header
RD.WR1: JUMPE T1,RD.WR2 ; if no data xfer'd, skip updates
ADDM T1,NBXFRD(P2) ; Up the bytes transfered count
ADDB T1,NBTXFR(P2) ; Down the bytes yet to transfer
RD.WR2: CAIN S1,RC.DLY ; was last return a delay?
JRST FIONBR ; yes - don't bother to look for more
JUMPGE T1,FIOTDQ ; if no more bytes left - done
LOAD S1,(P1),ARG$FC ; partial suc - check operation type
CAIE S1,FC.RD ; data reads are continuous
JRST FIOTDQ ; other operations are 1 shots
JRST READ ; Go continue transfer
RD.PV5: LOAD T1,,D6CNT ; check how much happened
SKIPG S2,T1
JRST RD.P5A
LOAD S1,(P1),ARG$PT ; get the original byte ptr
ADJBP S2,S1 ; advance the ptr by that much
STORE S2,(P1),ARG$PT ; update the ptr
RD.P5A: LOAD S1,,D6RSP ; get the response code
CAIE S1,RC.REJ
JRST RD.WR1
JRST FIOREJ
SUBTTL FEI%O -- Write out to device (TOPS20)
WRITE: $CALL PUTHDR ; Output the transmit header
JUMPF FIOFDQ ; The header transmission failed
JUMPN P4,WR.PV5 ; if version 5, done
MOVE S1,FEJFN ; Get the JFN to do I/O on
LOAD S2,(P1),ARG$PT ; Point to the string to output
LOAD T1,,XMTBC ; Number of bytes to output
MOVN T1,T1 ; Make negative for JSYS size delimit
SKIPG PTYPE ; 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
$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
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 FIOREJ ; and if so .. give failure return
LOAD T1,,RCVBC ; Get the number of bytes
WRT.2A: JUMPE T1,WRT.24 ; if no data actually xferred, skip ptr update
ADDM T1,NBXFRD(P2) ; add onto number of bytes transferred
MOVE S2,T1 ; prepare to adjust the ptr
ADDB T1,NBTXFR(P2) ; Remove from number of bytes yet to do
LOAD T2,(P1),ARG$PT ; get the beginning byte ptr
ADJBP S2,T2 ; have to do this because the SOUT xferred
; the whole amt regardless of how much was
; accepted by the FE
STORE S2,(P1),ARG$PT ; save ptr to next byte
WRT.24: CAIN S1,RC.DLY ; Check for a delayed I/O return
JRST FIONBR ; Dismiss process for a while
JUMPGE T1,FIOTDQ ; If none left .. then successful
JRST WRITE ; Go finish writing
WR.PV5: LOAD T1,,D6CNT ; get the amount done
LOAD S1,,D6RSP ; and the response code
CAIE S1,RC.REJ
JRST WRT.2A
JRST FIOREJ
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 number of bytes left to xfer
JUMPN P4,PUTHD5 ; elsewhere for version 5 protocol
SKIPL PTYPE ; Check for DDCMP (2020) line
SKIPA T2,[^O376] ; limit for crock FE device service
MOVEI T2,^O274 ; Max number of bytes for DMC driver
CAMLE T1,T2 ; check device service limits
MOVE T1,T2
STORE T1,,XMTBC ; Store in the # bytes to transfer cnt
MOVE S1,FEJFN ; Get the JFN for the FE
MOVE S2,[POINT 8,XMTHDR] ; Point to the transmit header
MOVX T1,-6 ; Get the string byte count
SKIPG PTYPE ; 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.
PUTHD5: MOVEI S2,PUTARG ; send version 5 header
STORE T1,,D6CNT ; set count in XMTHDR
LOAD S1,(P1),ARG$FC
TRNE S1,1 ; skip if write fcn
MOVNS T1 ; read fcns use negative byte count
STORE T1,(S2),BT6DBC ; set byte count in BOOT arg block
LOAD S1,(P1),ARG$PT ; get the beginning byte ptr
STORE S1,(S2),BT6PTR ; and stuff it also
LOAD S1,(P2),H$PRT ; get the port number
ANDI S1,7
STORE S1,(S2),BT6DTE ; stuff the dte number
MOVEI S1,6 ; size of header
STORE S1,(S2),BT6HDR
MOVEI S1,XMTHDR
STORE S1,(S2),BT6HDR ; where it is
MOVEI S1,.BTD60 ; do a DN60 transaction
BOOT
ERJMP V5ERR
$RETT
V5ERR: ; analyze version errors
LOAD S1,(S2),BT6ERR ; get the error codes
TXNE S1,D6.BDP
JRST ERT(D6BAD) ; crufty byte ptr
TXNE S1,D6.TPO!D6.TRS!D6.TDT ; TRS observed when tgha run, assume
; TDT might also occur
JRST RETNBR ; waited too long for port
TXNE S1,D6.NT6
JRST RETDNR ; not a DN60 front end
MOVX S1,D6IOE ; bad things are happening
$RETF
PTH.22: $CALL WR2020 ; and output the header 2020 style
$RET ; Propagate return success/failure
; Routine - GETHDR
;
; Function - To read a receive header from the port that we are currently
; talking to.
GETHDR: MOVE S1,FEJFN ; Get the JFN of the FE
MOVE S2,[POINT 8,RCVHDR] ; Point to the receive header string
MOVX T1,-6 ; 6 bytes in the header
SKIPG PTYPE ; 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: $SAVE <S2,T1> ; preserve results of SIN/SOUT
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.
SUBTTL FEI%O -- Routines FIOTDQ, FIOFDQ, FIOFAI (TOPS20)
; 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
;REJECTED(AROGANTLY) IO RETURN
FIOREJ: MOVEI S1,D6REJ ; return rejectedness
JRST FIOFDQ
;COMMON NON-FATAL NONBLOCKING RETURN
FIONBR: SKIPA S1,[D6NBR] ; return non-fatal "wait awhile" error
; 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: SETZ S1, ; return error code of 0 to indicate success
; Common 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
SKIPN P4 ; if version 5 protocol, didn't enq
$CALL DEQD60 ; Release the port
MOVE S1,NBTXFR(P2) ; and the no. left to go
STORE S1,(P1),ARG$BC
FIOFD0: MOVE S1,NBXFRD(P2) ; return no. of bytes actually xfrred
STORE S1,(P1),ARG$XF
DMOVE S1,P1 ; Restore the 2nd arg register
LOAD 0,(P1),ARG$RC ; check out type of return
JUMPE 0,@.RETT ; suc'd
$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$PRT ; Get synchronous line number
ANDI S1,7 ; make 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: $SAVE T4
DMOVEM S2,RDSAVE ; Save the read arguments
LOAD S1,(P2),H$PRT ; Get synchronous line number
ANDI S1,7 ; make line number
MOVEM S1,.BTDTE+BTARG ; Set it as the DTE/line in BOOT block
MOVEI T4,^D100 ; set retry counter
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 RETDNR ; No .. so front end not running
JRST R20AGN ; Try to read it again
R20RTY: SOJL T4,RETDNR ; must be dead
MOVEI S1,^D10 ; take a catnap
DISMS
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
PROTYP: $SAVE S2 ; S1/port
PUSH P,S1
MOVEI S2,PROARG ; determine protocol version running on dte
ANDI S1,7
MOVEM S1,.BTDTE(S2) ; stuff dte number
MOVEI S1,.BTSTS ; get dte status
BOOT ; returns protocol version or -1
ERJMP PRODFL
SKIPA S1,PROARG+.BTCOD ; snatch the results
PRODFL: SETO S1, ; none running
POP P,S2
MOVEM S1,PVTYP-DTEOFF(S2)
$RET
>;End if TOPS20
SUBTTL FEI%O -- TOPS10 CAL11. interface (.C11QU function)
TOPS10 <
$SAVE <S1,S2,T1,P1,P2,P3> ; Save registers
DMOVE P1,S1 ; Setup regs for structure accesses
; P1/arg block ptr, P2/ptr to handle list entry
SETZ S1,
STORE S1,(P1),ARG$XF ; init number of bytes transferred
MOVX S1,C$SIZ ; Get size of a CAL11. argument block
$CALL M%GMEM ; Get a block from memory mangler
MOVE P3,S2 ; Point to the new, fresh block
PUSH P,[FIORET] ; Put memory release co-routine into
; return path
FERTR0: 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
JRST [HRLI S1,(POINT 7) ; MAP TO AN ASCII PTR
MOVX S2,7 ; and if so assume ASCII (7bit)
STORE S1,(P1),ARG$PT ; STUFF IT BACK
JRST .+1]
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
LOAD T1,S1,BP.SIZ ; get no. bits per byte
SUBX S2,44 ; Remove the number of bits per word
MOVM S1,S2 ; Get the magnitude of the difference
IDIV S1,T1 ; 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
CAL11. S1, ; for the talk to the 11.
JRST FEERR ; Error while talking to 11
LOAD S1,(P3),C$BXF ; Get the number of byts transfered
JUMPE S1,FERTR1 ; no bytes xferred
LOAD S2,(P1),ARG$XF ; update total transferred
ADD S2,S1
STORE S2,(P1),ARG$XF ; and return in to the caller
LOAD S2,(P1),ARG$BC ; adjust byte count by amount xferred
ADD S2,S1
STORE S2,(P1),ARG$BC ; set no. left to xfer
LOAD S2,(P3),C$BPW ; optimistically assume bytes/word still there
SOS 1 ; do last ibp special to handle byte
; ptr in initial form 440700,,xxxxxx
IDIV S1,S2 ; S1/no. full words,S2/residual bytes
LOAD T1,(P1),ARG$PT ; get the start ptr
ADD T1,S1 ; advance by full words
IBP T1 ; advance by bytes(always at least one)
SOJGE S2,.-1
STORE T1,(P1),ARG$PT ; set the updated ptr
FERTR1: LOAD S1,(P3),C$RC ; Get the result code of the transfer
CAIN S1,RC.DLY ; delayed ?
JRST FERNBR ; yes - give innocuous error response
CAIN S1,RC.REJ ; rejected ?
JRST ERT (D6REJ,FERRET) ; yes - return error
SETZ S1, ; it suc'd
STORE S1,(P1),ARG$RC ; return that also to the caller
; check termination conditions
LOAD TF,(P3),C$BXF ; get number of bytes transferred last
JUMPE TF,@.RETT ; null transfer implies done
LOAD TF,(P1),ARG$BC ; check no bytes left to xfer
JUMPGE TF,@.RETT ; done?
LOAD TF,(P1),ARG$FC ; partial suc - check operation type
CAIN TF,FC.RD ; data reads are continuous
JRST FERTR0 ; go around once more
$RETT ; Return with a good indication
FEERR: CAIE S1,C11IU% ; Was the 11 in use when we tried it?
JRST FEFATL ; No .. we got some other fatal error
FERNBR: SKIPA S1,[D6NBR] ; return non-fatal err
FEFATL: $CALL FATMAP ; INTERPRET CAL11. ERRORS
FERRET: STORE S1,(P1),ARG$RC ; Store error code for the caller to
$RETF ; see and return falsely.
; All return paths from FEI%O go through here.
FIORET: $SAVE <TF> ; Save result code
MOVX S1,C$SIZ ; Get size of block
MOVE S2,P3 ; Location of block
PJRST M%RMEM ; Release memory and return
FATMAP: $SAVE <S2,T1>
MOVE S2,[-FATERL,,FATERR] ; MAP CAL11. ERROR CODE IN S1 TO D60 CODE
FATMP0: HRRZ T1,(S2) ; SCAN TABLE FOR TRANSLATABLE ERRORS
CAMN T1,S1
JRST [HLRZ S1,(S2) ; SUC ! GET THE D60 ERROR CODE
$RETF] ; RETURN AND ERROR CONDITION
AOBJN S2,FATMP0
MOVEI S1,D6IOE ; UNTRANSLATABLE ERROR
$RETF
FATERR: D6PLD,,C11NP% ; THE MAPPER
D6FNI,,C11UF%
D6NSP,,C11ND%
D6NBR,,C11IU%
D6DNR,,C11NA%
D6BAD,,C11OR%
D6NBR,,C11FC%
D6DNR,,C11DN%
D6BAD,,C11FU%
FATERL=.-FATERR
> ;End if TOPS10
SUBTTL GLOBAL ROUTINE -- D60LOG, logging SYSERR info on a line
; Routine - D60LOG
;
; Function - To log SYSERR information about a line specified by the
; handle argument. To get this information, the line status (LINSTS)
; routine is called and it's buffer retrieved. The SYSERR header is
; built and the data copied. Then it is all shipped to the SYSERR data
; base by whatever mechanism the system supplies.
;
; Parameters - S1/device handle - only the port,line is used
;
; Returns - TRUE if all copasetic; appropriate code if line/port error
ENTRY D60LOG
D60LOG: DBGSTR <D60LOG>
$SAVE <S2,P1,P2,P3,P4>
$CALL SRCHAN ; check validity of handle
JUMPF ERT(D6NSH) ; complain
LOAD P1,(S2),H$PRT ; get the port number
LOAD P2,(S2),H$LIN ; get the line number
D60LO1: SKIPN LPAGE ; check if logging enabled
$CALL LOGENB ; no, do it
MOVE P4,S2 ; save handle
MOVE P3,LPAGE ; Get the address of buffer
MOVX S1,SEC%D6 ; DN60 line logging code
TOPS20< MOVX S2,<LS.BYT+3>/4> ; Number of words in entry (w/o header)
$CALL SYRHDR ; Make a SYSERR entry header
MOVE S2,P4 ; get the handel
$CALL LINSTS ; Get the line
JUMPF @.POPJ ; Failed ... the line is down
HRLM P1,.SYDAT(P3) ; Put port number
HRRM P2,.SYDAT(P3) ; and line number into data portion
HRLI S1,STSBUF ; Get address of status buffer
HRRI S1,.SYDAT+1(P3) ; Address of SYSERR data body
BLT S1,.SYDAT+1+<LS.BYT+3>/4(P3) ; Move it all
MOVE S1,P3 ; Get address of SYSERR entry
TOPS20< MOVX S2,.SYDAT+1+<LS.BYT+3>/4 ; Length of the total entry
SYERR ; Dump it to SYSERR data base
ERJMP .ERSJF
>
TOPS10< HRLI S1,.SYDAT+1+<LS.BYT+3>/4 ; Length of the total entry
DAEMON S1, ; do it
JRST .ERSJF ; failed
>
MOVE S2,P4 ; get the handle and
JRST LINCH1 ; Go check for status claiming line
; gone away.
LOGENB: $SAVE <S1> ; enable SYSERR logging
$CALL M%GPAG ; Get a page for logging
MOVEM S1,LPAGE
$RET ; logging now enabled
SUBTTL GLOBAL ROUTINE -- D60POL
; Routine - D60POL
;
; Function - D60LOG with port,line arg instead of handle
;
; Parameters - S1/port,,line
;
; Returns - same as D60LOG
ENTRY D60POL
D60POL: DBGSTR <D60POL>
$SAVE <S2,P1,P2,P3,P4>
HLRZ P1,S1 ; get the port number
HRRZ P2,S1 ; get the line number
MOVE S2,S1 ; make a PDD
SETZ S1,
$CALL PCKPDD
$CALL INIDMY ; create a handle
JUMPF RLSHAN ; can't open FE, go away
STORE P2,(S2),H$LIN
$CALL D60LO1 ; do the logging
MOVE S2,P4 ; retrieve the handle
JRST RLSHAN ; and flush it on the way out
SUBTTL LINCHK - check lines for upness/downess
; Routine - LINCHK
;
; Function - To poll a specific line, checking for a state transition.
; If the line has gone down, the line is put back into polling
; state and a node disable entry is made.
;
; Parameters - S2/device handle
;
; Returns - LINSTS results
LINCHK: $SAVE <S2,P1,P2,P3>
LOAD P1,(S2),H$PRT ; get the port number
LOAD P2,(S2),H$LIN ; get the line number
$CALL LINSTS ; Get the status
JUMPF @.POPJ ; Failed ... go away
LINCH1: LOAD S1,,SLFLG ; Get line flags
TXNE S1,SLDIP!SLLDC ; check disable in progress or complete
JRST RETLGA ; Yes .. line gone away
LOAD S1,,SLINF ; Get line info flags
TXNN S1,SLDSR ; Check DSR set flag
JRST RETDSR ; No DSR .. line down
$RETT ; Return
SUBTTL Line gone down SYSERR recording
; Routine - LINDWN
;
; Function - To make the SYSERR entry stating that the line has gone
; down.
;
; Parameters -
;
; S1/ sixbit node name
; P1/ RH = port number
; P2/ RH = line number
LINDWN: $SAVE <TF,S1,S2,P3> ; Save some registers
SKIPN P3,LPAGE ; Get address of logging page
$RET ; logging not enabled
PUSH P,S1 ; save the node name
MOVX S1,SEC%DE ; Line enable/disable entry
TOPS20< MOVX S2,NED.SH> ; Short entry
$CALL SYRHDR ; Make header for this entry
MOVX S1,.CNDIS ; Line disable
HRRZM S1,NED.CD(P3) ; Put in enable/disable code
POP P,NED.NM(P3) ; stuff the node name
HRLM P1,NED.ID(P3) ; Store port number
HRRM P2,NED.ID(P3) ; Store line number
MOVE S1,P3 ; Get address of entry
TOPS20< MOVX S2,NED.SH+.SYDAT ; Total length of entry
SYERR ; Put in ERROR.SYS file
ERJMP .ERSJF
>
TOPS10< HRLI S1,NED.SH+.SYDAT ; Total length of entry
DAEMON S1, ; stuffit
JRST .ERSJF ; impervious to stuffing
>
$RETT
; ROUTINE - LOGDWN
;
; FUNCTION - log line going away
;
; PARAMETERS -
; S1/ sixbit node name
; S2/ handle list entry
;
; RETURNS - eventually
LOGDWN: $SAVE <S2,P1,P2> ; log downness
LOAD P1,(S2),H$PRT ; get the port
LOAD P2,(S2),H$LIN ; get the line
$CALL LINDWN ; loggit
$RETT
SUBTTL Line come up SYSERR recording
; Routine - LINUP
;
; Function - To make the SYSERR entry stating that the line has come up.
;
; Parameters -
;
; S1/ sixbit node name
; P1/ RH = port number
; P2/ RH = line number
; STSBUF/ Current line status
LINUP: $SAVE <S2,P3> ; Save some registers
SKIPN P3,LPAGE ; Get address of logging page
$RET ; logging not enabled
PUSH P,S1 ; save the node name
MOVX S1,SEC%DE ; Line enable/disable entry
TOPS20< MOVX S2,NED.SZ> ; Length of entry
$CALL SYRHDR ; Make header for this entry
MOVX S1,.CNENB ; Line enable
HRRZM S1,NED.CD(P3) ; Put in enable/disable code
POP P,NED.NM(P3) ; stuff the node name
HRLM P1,NED.ID(P3) ; Store port number
HRRM P2,NED.ID(P3) ; Store line number
LOAD S1,,SLCSD ; Transfer clear to send delay
MOVEM S1,NED.CS(P3)
LOAD S1,,SLSWL ; Transfer silo warning level
MOVEM S1,NED.SW(P3)
LOAD S1,,SLBPM ; Transfer bytes per message
MOVEM S1,NED.BM(P3)
LOAD S1,,SLRPM ; Transfer records per message
MOVEM S1,NED.RM(P3)
MOVE S1,P3 ; Get address of entry
TOPS20< MOVX S2,NED.SZ+.SYDAT ; Total length of entry
SYERR ; Put in ERROR.SYS file
ERJMP .ERSJF
>
TOPS10< HRLI S1,NED.SZ+.SYDAT ; Total length of entry
DAEMON S1, ; crammittoit
JRST .ERSJF ; anticramming devices deployed
>
$RETT
.ERSJF: $WTOJ <SYSERR entry failure>,<D60JSY attempt to make SYSERR entry failed>,IBMOBJ
$RETT ;it's true
; ROUTINE - LOGUP
;
; FUNCTION - log line going up
;
; PARAMETERS - S1/sixbit node name
; S2/handle
;
; RETURNS - eventually
LOGUP: $SAVE <S1,S2,P1,P2> ; log upness
LOAD P1,(S2),H$PRT ; get the port
LOAD P2,(S2),H$LIN ; get the line
$CALL LINUP ; loggit
$RETT
SUBTTL SYSERR entry header creation
; Routine - SYRHDR
;
; Function - To create a SYSERR entry header containing the pertinent
; data.
;
; Parameters -
;
; S1/ SYSERR Event code
; S2/ Length of entry (without header) - TOPS20 only
; P3/ Address of SYSERR block
;
; Returns - hopefully
SYRHDR: STORE S1,(P3),SYCOD ; Store event code (SY%XXX)
TOPS10< MOVX S1,.DMERR ; get the DAEMON function for SYSERR entry
STORE S1,(P3),SYFCN ; insert with authority
>
TOPS20< STORE S2,(P3),SYLEN ; Store length of entry
MOVX S1,.SYDAT ; Get length of SYSERR entry header
STORE S1,(P3),SYHLN ; Store in header
MOVX S1,1 ; Get version of SYSERR header
STORE S1,(P3),SYVER ; Store in header
SETO S1, ; Turn on all the bits (only for one)
STORE S1,(P3),SYT20 ; Note that this entry made by TOPS-20
$CALL I%NOW ; Get current time and date
STORE S1,(P3),SYDAT ; Store time and date in entry
TIME ; Get current uptime
IDIV S1,[<^D1000*^D3600*^D24>/<1_^D18>] ; Convert to days,,fractions of days
STORE S1,(P3),SYUPT ; Store uptime in entry header
MOVE S1,[SIXBIT/APRID/] ; Get table name
SYSGT ; Get processor serial number
STORE S1,(P3),SYPSN ; Save processor serial number
>
$RETT
IFN <FTDBST>,<
SUBTTL DBGRSL - Print outgoing status
DBGRSL: SKIPN DBGSWT
JRST DBGEXT ;exit if either zero
POP P,DBGLST
OUTSTR @DBGLST
SETOM DBGERR
JUMPF DBGRFL ;if failed, go print error code
OUTSTR [ASCIZ |OK |]
$RET
DBGEXT: POP P,DBGLST
$RET
DBGRFL: $SAVE <TF,S1,S2>
MOVEM S1,DBGERR
MOVEI S2,^D12 ;max digits to print
SETZ TF,
DBGDLP: LSHC TF,3 ;get next octal digit
JUMPE TF,DBGNXT ;if leading zero, skip
PUSH P,TF ;save whole value
TDZ TF,[EXP 777777777770] ;clear all but low 3 bits
IORI TF,60 ;make ASCII
OUTCHR TF ;print
POP P,TF ;get whole code back
DBGNXT: SOJG S2,DBGDLP ;go do next digit
OUTCHR [EXP 40]
$RET
DBGSWT: z ;make non-zero to get debugging output
DBGLST: z ;address of text for last call
DBGERR: z ;-1 for success, error code for fail
>;end IFN <FTDBST>
SUBTTL Handle space mgt
HNDINI: SETZM HNDLST ; init handle space - none
$RET
SRCHAN: HRRZ S2,S1 ; check if S1 has a legitimate handle
VALHND: $SAVE S1 ; check if S2 has a legitimate handle
SKIPN S1,HNDLST ; get the list
JRST RETNSH ; empty - no handles possible
VALHN1: CAMN S1,S2 ; check this one
$RETT ; it suc's
MOVE S1,(S1) ; get the cdr
JUMPN S1,VALHN1
RETNSH: MOVX S1,D6NSH
$RETF
LFIRST: SKIPN S2,HNDLST ; find 1st handle
$RETF ; none yet assigned
$RETT
LNEXT: MOVE S2,(S2) ; advance to next handle
JUMPE S2,RETNSH ; end of the line
$RETT
FNDPDD: $SAVE T1 ; find handle with S1/PDD
SKIPN S2,HNDLST ; get the 1st handle
$RETF ; emptiness
FNDPD1: LOAD T1,(S2),H$PDD
CAMN S1,T1
$RETT ; this handle suc's
MOVE S2,(S2)
JUMPN S2,FNDPD1
$RETF
GETHND: PUSH P,S1 ; find a handle with S1/PDD
MOVEI S1,HNDLSZ
$CALL M%GMEM ; get the block
JUMPF GETHN1
MOVE S1,(P) ; get the PDD
STORE S1,(S2),H$PDD ; stuff the PDD
MOVE S1,HNDLST ; get the current list
MOVEM S1,(S2) ; cons them
MOVEM S2,HNDLST ; and stash the new list
GETHN1: POP P,S1 ; get the PDD back
$RET
REMHND: $SAVE <TF,S1> ; remove S2/handle from HNDLST
MOVEI S1,HNDLST
REMHN1: CAMN S2,(S1) ; check next cell
JRST REMHN2
MOVE S1,(S1)
JUMPN S1,REMHN1
$RET
REMHN2: PUSH P,S2
MOVE S2,(S2) ; get cdr of this handle
MOVEM S2,(S1) ; its gone
POP P,S2
MOVEI S1,HNDLSZ
JRST M%RMEM ; flush it altogether
SUBTTL Data area - global to this job
QPRT0: POINT 3,1(S2),20 ; Low order digit of port number
QPRT1: POINT 3,1(S2),13 ; High order digit of port number
FEDEVS: ASCIZ /FE/ ; Start of front end name
TOPS20<
PVTYP: BLOCK MAXDTE-DTEOFF+1 ; flag for version protocol
>
TOPS10 <
C11BLK: BLOCK C$SIZ ; Block for OPNFE DN60 checking
>;End if TOPS10
PTYPE: 0 ; processor type
SONFOB: SONFD ; Address of file descriptor
7 ; ASCII
TOPS20<
SONDIR: ASCIZ \D60:\
>;END IF TOPS20
TOPS10 <
SONFD: XWD 5,0 ; Length of FDB
SIXBIT /D60/ ; Device name
SGNNAM: EXP 0 ; Filename (station name)
SIXBIT /SON/ ; Extension (.SON or .SOF)
EXP 0 ; PPN
>;End if TOPS10
; object block for $WTOx fucntions
IBMOBJ: .OTIBM ; this is an IBM object
0 ; no unit
0 ; no device
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,1,0,0 ; 10,11,12(,13,14)
D6JVER:: EXP %%.D60 ; Cell containing version number
L:: ; mark end of D60JSY with short symbol
XLIST ; Suppress listing of literals
LIT
LIST
TOPS20<
D60PAT: BLOCK ^D511 ; force locals to another page
>
SUBTTL Data area - local to fork
LOCALS: ; This label must be first in local
; data base area.
POLEST:: 0 ; estimated optimal time for next poll
HNDLST:: 0 ; local handle list
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
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.
TOPS20 <
FEJFN: 0 ; JFN of the front end device FEn:
LSTDTE: 0 ; Last DTE that was selected
RCVHDR:: BLOCK 2 ; Receive header
XMTHDR:: BLOCK D6HWSZ ; Transmit header
XMSG: BLOCK ^o274/4+1 ; DDCMP Q flush buffer
RETRY: BLOCK 1 ; BOOT retry counter
PUTARG: ; TOPS-20 version 5 BOOT arg bloc
BTARG: BLOCK BT6SIZ ; BOOT JSYS argument block
RDSAVE: BLOCK 1 ; Save area for RD2020 arguments
RDSLEN: BLOCK 1 ; including the length
PROARG: BLOCK 2 ; arg block for .BTSTS
SONFD: 6,,0 ; Max words in file name
BLOCK 5 ; Buffer for file descriptor
>
STSBUF::BLOCK <STSMAX+3>/4 ; Status buffer for port,line or device
; status strings (8 bit bytes).
SONOPB: ; open block for signon device
.OPSGN,,0 ; dev,,unit
0 ; port,,line - inserted
0 ; line signature - inserted
; SYSERR logging data
LPAGE: BLOCK 1 ; Address of logging page
SONBUF: BLOCK ^D80/5 ; Buffer to read RJE string into
EXP 0 ; this will be an asciz string
ENDLOC==.-1 ; end of data local to a fork
END
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Begin:;
; Comment Start:;
; Word Abbrev Mode:1
; End: