; [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. ;D60JSY.MAC.59, 28-Jan-80 11:07:32, Edit by JENNESS ; [207] Remove superfluous LC.CTR command in D60CND ;, 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). ;D60JSY.MAC.55, 17-Dec-79 13:17:20, Edit by JENNESS ; [205] Change to a better 2020 test routine than checking serial number. ;D60JSY.MAC.6, 4-Dec-79 13:35:42, Edit by JENNESS ; [204] Fix up code to do proper termination signon validation ;D60JSY.MAC.3, 18-Oct-79 15:19:52, Edit by JENNESS ; [203] Decouple D60UNV from D60JSY because of QSRMAC deadly embrace. ;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. ;D60JSY.MAC.256, 7-Sep-79 10:19:19, Edit by JENNESS ; [201] Remove edit 175 .. the BOOT JSYS has been fixed. ;D60JSY.MAC.252, 4-Sep-79 15:29:44, Edit by JENNESS ; [200] Remove CONLY conditionals, remove QSRMAC symbol conflicts. ;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. ;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. ;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. ;D60JSY.MAC.247, 16-Jul-79 14:11:56, Edit by JENNESS ; [174] Add external HOOKing code, gives access to guts of this package. ;D60JSY.MAC.246, 11-Jul-79 16:17:53, Edit by JENNESS ; [173] Give D6DNU (DSR not up) on D60OPN call at appropriate times. ;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. ;D60JSY.MAC.240, 2-Jul-79 16:25:45, Edit by JENNESS ; [171] Fix another dumb bug in FEI%O for TOPS10. ;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. ;D60JSY.MAC.237, 29-Jun-79 13:22:48, Edit by JENNESS ; [167] Typo fix in FEI%O for TOPS10. ;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. ;D60JSY.MAC.235, 29-Jun-79 09:00:27, Edit by JENNESS ; [165] Fix REQOUT to relieve the lost output grant. ;D60JSY.MAC.233, 28-Jun-79 17:59:05, Edit by JENNESS ; [164] Fix to stop deadlock interaction between console and LPT under 3780. ;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. ;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. ;D60JSY.MAC.229, 25-Jun-79 09:33:46, Edit by JENNESS ; [161] Another fix in edit 153 when DTE is already selected. ;D60JSY.MAC.225, 21-Jun-79 10:41:06, Edit by JENNESS ; [160] Fix the horrible mess made when releasing devices on disabled lines. ;D60JSY.MAC.224, 21-Jun-79 08:53:45, Edit by JENNESS ; [157] Fix REQOUT to check for line gone away in DSRLP. ;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. ;D60JSY.MAC.223, 18-Jun-79 13:11:44, Edit by JENNESS ; [155] Change FEI%O for TOPS10 to use reentrant type C11BLKs. ;D60JSY.MAC.222, 15-Jun-79 16:44:48, Edit by JENNESS ; [154] Fix a glaring error in SRCPDD that has been there forever. ;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. ;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. ;D60JSY.MAC.211, 12-Jun-79 13:54:04, Edit by JENNESS ; [151] Add printx to output name, version and other sundries during assembly. ;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. ;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. ;D60JSY.MAC.208, 12-Jun-79 09:45:35, Edit by JENNESS ; [146] Move some more symbols into the D60JSY.UNV universal file. ;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. ;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. ;D60JSY.MAC.203, 7-Jun-79 17:20:51, Edit by JENNESS ; [143] Change in REQIN to reduce the possibility of a race. ;D60JSY.MAC.202, 7-Jun-79 15:33:57, Edit by JENNESS ; [142] Change status formats to reflect more frontend bullet proofing. ;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 ;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. ;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. ;D60JSY.MAC.194, 6-Jun-79 16:42:57, Edit by JENNESS ; [136] Fix a bug in the DSR wait loop in REQOUT. ;D60JSY.MAC.193, 6-Jun-79 09:32:56, Edit by JENNESS ; [135] Add IOWAIT argument to the SNOOZE macro for task descheduling. ;D60JSY.MAC.191, 4-Jun-79 09:21:51, Edit by JENNESS ; [134] Dump output buffers (in 11) if outputing to a console device. ;D60JSY.MAC.187, 1-Jun-79 10:58:38, Edit by JENNESS ; [133] Add code to handle new line hardware abort checking. ;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. ;D60JSY.MAC.183, 30-May-79 13:32:02, Edit by JENNESS ; [131] More fixes for device error handling and input/output deadlock. ;D60JSY.MAC.176, 25-May-79 16:23:21, Edit by JENNESS ; [130] Handle aborts caused by line disconnection. ;D60JSY.MAC.175, 24-May-79 15:14:16, Edit by JENNESS ; [127] Fix D60EOF and the line releasing code for 2780/3780. ;D60JSY.MAC.172, 23-May-79 15:21:46, Edit by JENNESS ; [126] Fix D60OPN to properly handle errors on the device commands. ;D60JSY.MAC.172, 23-May-79 15:21:22, Edit by JENNESS ; [125] Have found some more holes in the FE releasing. ;D60JSY.MAC.168, 21-May-79 11:41:31, Edit by JENNESS ; [124] More fixes for properly releasing FE devices. ;D60JSY.MAC.167, 21-May-79 09:38:50, Edit by JENNESS ; [123] Add structure block sizes in universal file. ;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. ;D60JSY.MAC.161, 17-May-79 18:11:01, Edit by JENNESS ; [121] Fix so FE is properly released if DTE select fails. ;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. ;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. ;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. ;D60JSY.MAC.152, 14-May-79 14:51:26, Edit by JENNESS ; [115] Add line signature code. ;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. ;D60JSY.MAC.145, 10-May-79 11:17:39, Edit by JENNESS ; [113] Change location of FELOG logging calls in FEI%O. ;D60JSY.MAC.144, 10-May-79 10:20:00, Edit by JENNESS ; [112] Add require for FELOG when FTDEBUG switch is turned on. ;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. ;D60JSY.MAC.141, 2-May-79 14:29:16, Edit by JENNESS ; [110] Another fix to stop input/output deadlocks on 2780/3780. ;D60JSY.MAC.140, 1-May-79 16:48:50, Edit by JENNESS ; [107] Increase retry counter for BOOT JSYS retry on input. ;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. ;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. ;D60JSY.MAC.133, 25-Apr-79 16:18:22, Edit by JENNESS ; [104] Put in error checks after device and line status calls. ;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. ;D60JSY.MAC.127, 25-Apr-79 08:25:46, Edit by JENNESS ; [102] Add device command in D60OPN to do space compression. ;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=: ; Set value of edit level/version ; Print information to log during compilation Define VOUTX ($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 ;