Trailing-Edge
-
PDP-10 Archives
-
BB-4172H-BM
-
language-sources/cdrive.mac
There are 37 other files named cdrive.mac in the archive. Click here to see a list.
TITLE CDRIVE - Multiple Card Reader Spooler
;
;
ASCIZ /
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
1978,1979,1980,1981,1982
/
; 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.
SEARCH GLXMAC,ORNMAC,QSRMAC
PROLOG (CDRIVE)
.DIRECT FLBLST
IF1,<
TOPS10 <PRINTX Assembling Galaxy-10 Card Reader Spooler>
TOPS20 <PRINTX Assembling Galaxy-20 Card Reader Spooler>
>
SALL
;VERSION INFORMATION
RDRVER==1
RDRMIN==0
RDREDT==111
RDRWHO==0
%RDR==<BYTE (3)RDRWHO (9)RDRVER (6)RDRMIN (18)RDREDT>
LOC 137
EXP %RDR
RELOC
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR cdrive
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. SETUP REMOTE STATION PARAMETERS........................... 3
; 3. DN60 parameters........................................... 4
; 4. Revision History.......................................... 5
; 5. CARD READER DATA BASE..................................... 6
; 6. Macros.................................................... 7
; 7. LOCAL, DN200, & DN60 BYTE DEFINITIONS..................... 8
; 8. CARD READER DATA BASE..................................... 9
; 9. Random Impure Storage..................................... 11
; 10. Resident JOB Database..................................... 11
; 11. GLXLIB IB AND HELLO MESSAGE STRUCTURES.................... 12
; 12. CDRIVE - Multiple card reader spooler..................... 13
; 13. Idle Loop................................................. 14
; 14. CHKTIM - ROUTINE TO SEE IF ITS TIME TO SCHEDULE A STREAM.. 15
; 15. OACCAN - Operator CANCEL request.......................... 16
; 16. OACPAU - Operator PAUSE Request........................... 16
; 17. OACCON - Operator CONTINUE Request........................ 16
; 18. OACSHT - ROUTINE TO VALIDATE THE READER SHUTDOWN STATUS... 16
; 19. Operator Action Request/Response.......................... 17
; 20. RDINIT - ROUTINE TO INITIALIZE SOME READER CONSTANTS...... 18
; 21. DOJOB - ROUTINE TO PROCESS THE CARD READERS............... 19
; 22. DSCHD -- Deschedule process............................... 20
; 23. FIXPDL -- Fix PDL routine................................. 21
; 24. PRORDR--READER INPUT PROCESSING........................... 22
; 25. INCARD - ROUTINE TO READ CARDS FROM THE CARD READER....... 23
; 26. INPGET -- OPEN the input device......................... 24
; 27. GENFIL - ROUTINE TO GENERATE THE SPOOL FILENAME........... 25
; 28. INPREL - ROUTINE TO RELEASE A CARD READER................. 26
; 29. Interrupt Module.......................................... 27
; 30. INTIPC - IPCF INTERRUPT PROCESSING ROUTINE................ 29
; 31. CHKQUE - ROUTINE TO CHECK FOR IMCOMMING MESSAGES.......... 30
; 32. - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS. 31
; 33. SETUP/SHUTDOWN Message.................................... 32
; 34. QSRNWA - ROUTINE TO PROCESS NODE-WENT-AWAY MESSAGES....... 34
; 35. SHUTDN - ROUTINE TO SHUT DOWN A LINE-PRINTER.............. 35
; 36. RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR 35
; 37. FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE..... 36
; 38. UPDTST - ROUTINE TO SEND READER STATUS INFORMATION TO QUASAR 37
; 39. SNDQSR - ROUTINE TO SEND A MESSAGE TO QUASAR.............. 38
; 40. IDLE LOOP................................................. 39
; 41. CHKFRK - ROUTINE TO PROCESS INFERIOR FORK TERMINATION..... 40
; 42. RDINIT - ROUTINE TO INITIALIZE READER CONSTANTS........... 41
; 43. INPGET - ROUTINE TO SETUP THE READER FORK................. 42
; 44. OACPAU - ROUTINE TO STOP A READER......................... 44
; 45. OACCON - ROUTINE TO CONTINUE A READER..................... 44
; 46. OACCAN - ROUTINE TO CANCEL THE CURRENT JOB ON THE READER.. 44
; 47. OACSHT - ROUTINE TO SHUTDOWN THE CARD READER.............. 44
; 48. INTERRUPT ROUTINES........................................ 45
; 49. INPREL - ROUTINE TO RELEASE A CARD READER................ 46
; 50. SPOOLER - CARD READER SPOOLER FORK ROUTINE START ADDRESS.. 47
; 51. MAINRT - ROUTINE TO INPUT AND PROCESS CARDS............... 48
; 52. GENFIL - ROUTINE TO GENERATE A SPOOL FILENAME............. 49
; 53. CHKOFL - ROUTINE TO CHECK LOCAL/REMOTE OFFLINE STATUS..... 49
; 54. CHKSTS - ROUTINE TO PROCESS THE DIFFERENT STATUS INTERRUPTS 50
; 55. GETDDT - ROUTINE TO LOAD DDT IF WE ARE DEBUGGING.......... 50
; 56. SENDIT - ROUTINE TO SEND IPCF MESSAGES TO QUASAR.......... 51
; 57. SNDSTS - ROUTINE TO SEND READER STATUS UPDATES TO QUASAR.. 52
; 58. SETINT - ROUTINE TO SETUP PROCESS INTERRUPTS.............. 53
; 59. INTERRUPT ROUTINES........................................ 54
; 60. LOCAL/REMOTE I/O SUBROUTINES.............................. 55
; 61. DN200 I/O SUPPORT ROUTINES................................ 57
; 62. TOPS10 DN60 INTERFACE ROUTINES............................ 58
; 63. DN60 I/O SUPPORT ROUTINES................................. 59
; 64. D60SU - DN60 success routine to fix counts................ 60
; 65. D60ER - Process DN60 errors............................... 61
; 66. READER - ROUTINE TO PROCESS THE INPUT CARDS............... 64
; 67. PADJBP -- Positive ADJBP.................................. 65
; 68. $CARD - ROUTINE TO PROCESS $ CARDS........................ 66
; 69. JOBCRD - ROUTINE TO PROCESS A JOB CARD.................... 67
; 70. EOJCRD - ROUTINE TO PROCESS $EOJ CARDS.................... 68
; 71. SITCRD - ROUTINE TO PROCESS $SITGO CARDS.................. 69
; 72. ENDCRD - ROUTINE TO PROCESS END-OF-FILE CARDS............. 70
; 73. COMMAND - ROUTINE TO PROCESS THE $$ COMMAND FOR OPR....... 70
; 74. I60OPR Routine to get operator messages.................. 71
; 75. OPRCMD - ROUTINE TO GENERATE AN OPR COMMAND MESSAGE....... 72
; 76. GETFIL - ROUTINE TO CREATE AN OUTPUT SPOOL FILE........... 73
; 77. OUTCRD - ROUTINE TO OUTPUT A CARD......................... 74
; 78. CREATE - ROUTINE TO GENERATE A CREATE MESSAGE FOR QUASAR.. 75
SUBTTL SETUP REMOTE STATION PARAMETERS
TOPS20 <
;IF WE HAVE RJE SUPPORT, GET JSYS SIMULATION PACKAGE
FTRMTE==FTRJE!FTDN60 ;SEE IF ANY REMOTES GEN'D
IFN FTRJE,<.REQUIRE NURD.REL> ;GET DN200 I/O PACKAGE
> ;END TOPS20 CONDITIONAL
TOPS10< FTRMTE==-1 > ;DEFAULT TO RJE ON THE -10
SUBTTL DN60 parameters
IFN FTDN60,<
SEARCH D60UNV ;GET DN60 UNIVERSAL
.Z.==$ER1ST ;SET STARTING VALUE
DEFINE ERRS(CODE,TEXT),<XLIST
CODE==.Z. ;;DEFINE THE ERROR CODE
EXP [ASCIZ\TEXT\] ;;DEFINE THE TEXT FOR IT
.Z.==.Z.+1 ;;BUMP ERROR CODE COUNTER
LIST>
D60TXT: D60ERR TEXT ;DEFINE THE ERROR TEXT
DEFINE X(ERR,TXT),<XLIST
ER'ERR: ASCIZ\TXT\
LIST>
X (CFE,<Can't condition DN60 front-end>)
X (O6R,<Can't open remote DN60 reader>)
X (OHC,<Can't open HASP console>)
X (IDE,<DN60 Input Device Error>)
X (CRR,<Can't Release DN60 Reader>)
X (CRC,<Can't Release DN60 Console>)
X (CDL,<Can't Disable DN60 Line>)
X (CDE,<DN60 Console input error>)
> ;End FTDN60 conditional
SUBTTL Revision History
COMMENT \
1 Add Symbols CRDNBR, CRDSIZ. Change the processing routines
to use them.
2 Add SNDSTS routine to send QUASAR current device status information
3 Change IB to new format and add PIB.
4 Delete routine DISPAT. Add DN200 support.
5 Add Status update messages capability
6 Major revision to support DN200 and DN60 readers
7 Fixup minor bugs caused by revision 6
10 Add routine OACSHT for defered reader shutdown.
Make a lot of minor cosmetic modifications.
11 Fix major bugs caused by introduction of DN60 support
12 Add the operator command processor for DN60 remote stations
13 For DN60 card readers, after sleeping for 3 seconds following
an offline condition, when we wake up clear the offline flag
so that we perform another scheduling pass.
14 Change the IPCF send/recieve quotas from max to 20.
15 Change the DN60 open code to support the new port/line handles.
16 Fix a bug which would enable -20 CDRIVE to miss an IPCF interrupt
17 Fix a bug so that the correct error text is displayed on fork
termination
20 Delete the Send/Receive Quotas from the PIB.
21 Make a check for Non-Existant Readers in the Tops20 Open Routine.
22 Delete the call to F%FCHN and use the stream number as the channel
number (TOPS10 Only)
23 Fix a Bug - Move the code to close the spool file to CREATE.
24 Add DN60 line conditioning support.
25 Don't interrupt the superior when re-initing the reader for device EOF.
26 At last, finish up DN60 changes. Delete DB entry .RDCND and replace
it with .RDSUP in which we will now store the SETUP message.
Change the calling parms for D60CND to use the SETUP message
instead of .RDCND
Change all references to .RDCND to .RDSUP
27 Add support for Node-Went-Away message.
30 Fix a bug affecting the -10 only. In SETUP, SETZM the FLAG word
after setting up the card reader data base.
31 Change 'Cancelled' to 'Canceled'
32 Move search for DN60 symbols to FTDN60 conditional
33 Rewrite the INCARD routine so the the 'Input Done' status bit gets
set before the IN UUO is done, and gets cleared if the UUO succeeds.
RELEASE 4.1 LOADTEST STARTS HERE
34 Add support for 'data missed' errors
35 Add SITGO support
36 Add DN60 support for TOPS10
37 Fix interrupt code to handle node offline interrupt correctly.
40 Add prototype node handling for DN60.
41 Add variable to keep last DN60 error
42 Interchange the release of the reader with the QUASAR notification
to prevent confusion on QUASAR's part
43 Misc: $STOP if lousy error message from D60SIN
DSCHD for 1 sec if too many device errors so stream
will wake up to shutdown.
Cause successful opening of DN60 to send status message
Allow an infinite number of D6NBR returns if no job card
44 Add code to do the DN60 console input for HASP
45 Performance and nice stuff for the DN60
Disable the line as part of the DN60 close. Only allow
a limited number of NBR errors to occur during
the close cycle.
Cause NBR errors during a job to only sleep for 2 seconds
(SHSLPT)
Increase all other sleep times to 10 octal secs. to limit
overhead (LGSLPT)
Make it so that 1 bad error from D60ER is a fatal error
and cause for shutdown.
46 Initialize JOBSTW for a DN60 stream
47 Fix I60OPR to calculate next count for D60SIN correctly, expand
size of CMDBUF.
50 Make the prototype node stuff really work.
51 Clear input blocked bit before calling OACREQ in INCARD.
52 Calculate the size of a stream's data base using the actual current
size instead of guessing.
53 Make EOF work correctly by testing and clearing the IO.EOF bit
in INCARD and by closing the input file.
54 Continue to make EOF work by incrementing card count in CRDEOF
after creating fake EOF card.
55 Replace ADJBP with routine to fake it so it works
on a KI in READER
56 Change $WTO to $WTOJ on "n cards spooled message"
57 1-22-81 In reading $ cards, if no match, do not reject the card.
60 Remove require for d60jsy and place in cdrive.cmd so we can get
symbols for the d60jsy code
61 3/12/81 Implement image mode correctly for remote readers on TOPS10
by treating remote readers and local readers the same in PRORDR.
Force RDSCHD to be set on exit of an IPCF message processing routine.
62 4/14/81 Lots of changes to clean up and place on the 20
Make STREAM an AC (AC12).
Remove .RDUNT since it is not used (and was set incorrectly)
Remove OUTDDE since it is not referenced.
63 5/12/81 Force the right connections to the DN60 stuff including
fixing DSCHD, moving some code from $open to gtfj.6, removing
GETHSP and the reference to it, and fixing up the returns from SIN.6.
Remove TOPS20 references to SCHEDL, using only RDSHCD for scheduling.
Make setting the stream's ACs done in a routine SETACS so T10 can
do it after INPGET and T20 can do it before.
At the end of CHKQUE loop until no more messages.
Remove symbol GOODBY since it is not used.
Don't sleep special for DN60 reader at main.1 (T20)
64 5/14/81 Add .RNSTW and change CDINTR and INPOFF so we can poll
remote off-line card readers.
65 5/16/81 Set STREAM in SETACS.
Use operator resp. wait as a status type.
Only set for status update in CDINTR if we really need it.
In routine CREATE (t10) do 2 things:
1. Move the release of the IFN until after the FD is copied
into the QUASAR message.
2. Get the real FD from GLXLIB so physical structure is used.
66 5/26/81 Change REJECT + 1 to cause fake job decks to be created instead
of quietly flushing cards.
Fix the DSCHD code for TOPS-20.
67 6/15/81 Change the way we setup stream AC's incase an interrupt
occurs with out P being set up.
70 8/20/81 Do some work to support DN60. Add routine FIXPRO to
set the prototype node name correctly (at different places for
T10 and T20). Return true from SIN.6 if got an OK error.
Make use of .RDSTP consistant and use it also as a flag to
avoid recursive or redundant error messages.
71 8/26/81 Fix missing instructions in CHKQUE. Flush if not from OPR
or QUASAR
72 9/4/81 Try not to get rid of inferior fork only if both
debugging and an error has occured in the inferior.
Shut down the process even if we are online.
73 9/9/81 Always do D60INI if it is possible to do IBMCOM, as
part of initialization @CDRIVE.
Make the reader always idle except when reading a job.
Make OPRCMD delete trailing blanks from remote operator commands.
74 9/16/81 Finish up the previous edit. Fix a typo in OPRCMD
and also check for carriage return instead of line feed.
75 9/17/81 Need to split routine SETINT. The problem is to
activate interrupts before opening but not to activate the
online/offline channel until after OPEN by adding COMINT.
Add IBM statistics message (IBMSTM) and routine (IBMSTS).
76 9/18/81 Remove all references to .RDREJ and all of the reject
code since it is not used any more.
Add handling for abort from IBM stream.
77 9/21/81 In INTERR, only get and set error code if none has
been generated previously and save only the error code.
Make ERJMP INTERR into ERCAL INTERR.
Handle ABORT in I60OPR. Change $CALL D60ER to $D60ER ERCDE.
Clear the error after the call (D60ER) if the error was ok.
Set S2 that was clobbered by the call to IBMSTS.
100 11/1/81 On T10 do D60INI only at startup. On T20 do it once per fork.
Fix it so the data base has the proto name in the actual slot only
for the response to setup message. This makes all other starting
messages from cdrive have the actual node name. On T20, force a
disable of the line with the routine KILL.
101 11/10/81 Try to make status more consistant. Remove .RNSTW and use
.RDOFL instead. Add routine GSTS which gets the status. This is
because on the 20 the status can be send by either the superior or
inferior fork and they use different memory for the send. Now both
status sends can use the same status determination.
Try also to make shutdowns more consistant. In CHKF.1, only
clean up inferior if shutdown is set only if the fork has also halted.
Everytime we change JOBCD bit in FLAG, save it also in .RDREG so
superior fork will know it for job status messages. (on the 10,
it helps none but nor does it hurt)
102 11/24/81 Since whether we are in a job changes the state (from idle
to reading and back) cause a status update everytime we change JOBCD.
103 12/2/81 Need to send message to ORION if D60SIN failed since the
operator is not really there anymore.
104 12/4/81 Need to set .RDSHT in KILL but only for T10. NOTE: .RDSHT
means different things in the different versions. See definition.
Want to set NENBR large since we really don't want to stop but do
want to maintain threshold counter to guarantee exit when in error.
105 1/4/82 Update copyrights, clarify $WTOR response.
106 3/22/82 Clear the card count after flushing a job. GCO 4.2.1292
107 5/24/82 If we get a bad signon card, reset the line and try again
@OPEN.6+10 or so. GCO 4.2.1348
110 6/8/82 Set the flag AC in OACRSP so returning to CHKQUE will let
the correct things happen. GCO 4.2.1376
111 11/9/82 Fix copyright statement and RELOC. GCO 4.2.1528
\ ;End of Revision History
SUBTTL CARD READER DATA BASE
FILEMK==17777 ;MASK FIELD FOR FILE NAME SPEC
IBYT60==7 ;INPUT DN60 BYTES ARE ASCII
OBYT60==7 ;OUTPT DN60 BYTES ARE ASCII
IBYTSZ==^D18 ;INPUT LOCAL/DN200 BYTES ARE 16 BITS
OBYTSZ==^D18 ;OUTPT LOCAL/DN200 BYTES ARE 18 BITS
D60RCL==^D82 ;DN60 RECORD LENGTH = 80 + <CRLF>
LOCRCL==^D80 ;LOCAL/DN200 RECORD LENGTH = 80
PAGESZ==1000 ;Page size
MAXRDR==^D15 ;MAXIMUM NUMBER OF READERS
PDSIZE==^D200 ;PDL SIZE
MSBSIZ==30 ;MESSAGE BUFFER SIZE
;AC USAGE
STREAM==12 ;Identifies current stream data base
;NOTE WELL! This precludes the use
; of P4
M==13 ;INCOMMING IPCF MESSAGE ADDRESS
RDR==14 ;RDR DATA BASE
AP==15 ;POINTER TO BYTE TRANSLATION TABLE
FLAG==16 ;AC 16 HOLD FLAGS
;STREAM STATUS BITS
JOBCD==1B1 ;JOB CARD READ AND JOB SETUP
INTRPT==1B2 ;READER IS CONNECTED TO INTRPT SYSTEM
ABORT==1B3 ;STREAM ABORT BIT.
CD20==1B6 ;READER LINE IS CD20
EOF==1B8 ;AN EOF CONDITION OCCURED
SYSPRM IOX4,20,IOX4 ;EOF error #
SYSPRM IOX5,21,IOX5 ;I/O device/data error
SYSPRM OPNX8,22,OPNX8 ;Device not on line error
SYSPRM FDSIZE,FDMSIZ,10 ;SPOOL FILE FD SIZE
SYSPRM CRDNBR,5,5 ;NBR OF CARDS TO BE PROCESSED AT A TIME
SYSPRM BUFSIZ,<<CRDNBR*LOCRCL>/2>,<<<CRDNBR+1>*LOCRCL>/2> ;BUFFER SIZE
SYSPRM SERFLG,0,0 ;SYSERR flag -- 0=no entries made
SYSPRM ERTCNT,4,4 ;Error threshold count for DN60
SYSPRM NENBR,777777,777777 ;# of errors allowed for NBR
;Arbitrary large since we really don't
; want to stop.
SYSPRM NEDOL,100,100 ;# of errors allowed for DOL
SYSPRM LGSLPT,10,10 ;Long sleep time (no job or bad error)
SYSPRM SHSLPT,2,2 ;Short sleep time (when in a job)
SYSPRM CMDLN,33,33 ;Number of words in console command buf.
DEFINE GETBYT(AC,PTR),<ILDB AC,PTR
XLIST
ANDI AC,7777
LIST
> ;END GETBYT
SUBTTL Macros
; Macro to deschedule a stream
;
DEFINE $DSCHD(FLAGS),<
PUSHJ P,DSCHD
XLIST
JUMP [EXP FLAGS]
LIST
SALL
> ;END DEFINE $DSCHD
; Macro to process DN60 errors
;
DEFINE $D60ER(ADD),<
PUSHJ P,D60ER
XLIST
JUMP ADD
LIST
SALL
> ;END DEFINE $D60ER
SUBTTL LOCAL, DN200, & DN60 BYTE DEFINITIONS
LOC 0
JIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'J'
JIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'j'
OIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'O'
OIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'o'
BIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'B'
BIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'b'
DIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'D'
DIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'd'
EIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'E'
EIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'e'
SIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'S'
SIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 's'
IIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'I'
IIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'i'
TIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'T'
TIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 't'
GIMGUC:! BLOCK 1 ;UPPER CASE CHARACTER 'G'
GIMGLC:! BLOCK 1 ;LOWER CASE CHARACTER 'g'
$IMAGE:! BLOCK 1 ;CHARACTER '$'
BLANK:! BLOCK 1 ;CHARACTER ' '
ENDIMG:! BLOCK 1 ;END OF JOB CHARACTER
IMGLEN:! ;BLOCK LENGTH
RELOC
;DEFINE THE CHARACTER CODES FOR LOCAL AND DN200
LOC200: $BUILD IMGLEN
$SET(JIMGUC,,2400) ;IMAGE MODE 'J'
$SET(JIMGLC,,6400) ;IMAGE MODE 'j'
$SET(OIMGUC,,2010) ;IMAGE MODE 'O'
$SET(OIMGLC,,6010) ;IMAGE MODE 'o'
$SET(BIMGUC,,4200) ;IMAGE MODE 'B'
$SET(BIMGLC,,5200) ;IMAGE MODE 'b'
$SET(DIMGUC,,4040) ;IMAGE MODE 'D'
$SET(DIMGLC,,5040) ;IMAGE MODE 'd'
$SET(EIMGUC,,4020) ;IMAGE MODE 'E'
$SET(EIMGLC,,5020) ;IMAGE MODE 'e'
$SET(SIMGUC,,1200) ;ASCII MODE 'S'
$SET(SIMGLC,,3200) ;ASCII MODE 's'
$SET(IIMGUC,,4001) ;ASCII MODE 'I'
$SET(IIMGLC,,5001) ;ASCII MODE 'i'
$SET(TIMGUC,,1100) ;ASCII MODE 'T'
$SET(TIMGLC,,3100) ;ASCII MODE 't'
$SET(GIMGUC,,4004) ;ASCII MODE 'G'
$SET(GIMGLC,,5004) ;ASCII MODE 'g'
$SET($IMAGE,,2102) ;IMAGE MODE '$'
$SET(BLANK,,00000) ;IMAGE MODE ' '
$SET(ENDIMG,,7417) ;IMAGE MODE FOR END OF JOB
$EOB
;DEFINE THE CHARACTER CODES FOR THE DN60
CHAR60: $BUILD IMGLEN
$SET(JIMGUC,,112) ;ASCII MODE 'J'
$SET(JIMGLC,,152) ;ASCII MODE 'j'
$SET(OIMGUC,,117) ;ASCII MODE 'O'
$SET(OIMGLC,,157) ;ASCII MODE 'o'
$SET(BIMGUC,,102) ;ASCII MODE 'B'
$SET(BIMGLC,,142) ;ASCII MODE 'b'
$SET(DIMGUC,,104) ;ASCII MODE 'D'
$SET(DIMGLC,,144) ;ASCII MODE 'd'
$SET(EIMGUC,,105) ;ASCII MODE 'E'
$SET(EIMGLC,,145) ;ASCII MODE 'e'
$SET(SIMGUC,,123) ;ASCII MODE 'S'
$SET(SIMGLC,,163) ;ASCII MODE 's'
$SET(IIMGUC,,111) ;ASCII MODE 'I'
$SET(IIMGLC,,151) ;ASCII MODE 'i'
$SET(TIMGUC,,124) ;ASCII MODE 'T'
$SET(TIMGLC,,164) ;ASCII MODE 't'
$SET(GIMGUC,,107) ;ASCII MODE 'G'
$SET(GIMGLC,,147) ;ASCII MODE 'g'
$SET($IMAGE,,44) ;ASCII MODE '$'
$SET(BLANK,,40) ;ASCII MODE ' '
$SET(ENDIMG,,177) ;ASCII MODE FOR END OF JOB
$EOB
SUBTTL CARD READER DATA BASE
PHASE 0
.RDIPT:! BLOCK 1 ;CARD BUFFER BYTE POINTER
.RDOPT:! BLOCK 1 ;OUTPUT BUFFER POINTER
.RDCAD:! BLOCK 1 ;CARD ADDRESS WITHIN INPUT BUFFER
.RDNBR:! BLOCK 1 ;NUMBER OF CARDS IN THE BUFFER.
.RDSTR:! BLOCK 1 ;READER STREAM NUMBER
.RDBFR:! BLOCK 1 ;READER BUFFER ADDRESS.
.RDSTA:! BLOCK 1 ;DEVICE STATUS WORD
.RDTIM:! BLOCK 1 ;JOB START TIME
.RDINI:! BLOCK 1 ;END RDR INITIALIZATION FLAG
.RDSUP:! BLOCK SUP.SZ ;DEVICE SETUP MESSAGE
.RDREM:! BLOCK 1 ;0=LOCAL,-1=DN200 REMOTE,+1=DN60 REMOTE
IFN FTDN60,<
.RDOPB:! BLOCK OP$SIZ ;DN60 DEVICE OPEN BLOCK
.RTNBR:! BLOCK 1 ;Threshold for NBR errors
.RTDOL:! BLOCK 1 ;Threshold for DOL errors
.RDLER:! BLOCK 1 ;Last DN60 error
.RDCPT:! BLOCK 1 ;Console byte pointer to in mess.
; 0 means there is no hasp console
.RDCCT:! BLOCK 1 ;Console count for D60SIN
.RDCMD:! BLOCK CMDLN ;Command input buffer for DN60
> ;End FTDN60 conditional
.RDPNN:! BLOCK 1 ;Prototype node name
; (contains real node name until
; setup response is complete)
.RDFLG:! BLOCK 1 ;FLAG WORD FOR DN60
.RDN60:! BLOCK 1 ;HASP CONSOLE INPUT JFN
.RDECT:! BLOCK 1 ;DEVICE ERROR COUNT
.RDIBZ:! BLOCK 1 ;INPUT BYTE SIZE WE'RE PROCESSING
.RDOBZ:! BLOCK 1 ;OUTPT BYTE SIZE WE'RE PROCESSING
.RDRCL:! BLOCK 1 ;RECORD SIZE WE ARE PROCESSSING
.RDREG:! BLOCK 20 ;STREAM AC SAVE AREA
.RDPDL:! BLOCK PDSIZE ;STREAM CONTEXT PDL.
.RDIOA:! BLOCK 1 ;INTERRUPT RETURN ADDRESS.
.CARDS:! BLOCK BUFSIZ ;BUFFER AREA
.RDFD:! BLOCK FDSIZE ;FILE DESCRIPTOR FOR SPOOL FILE
.RDFOB:! BLOCK 4 ;FILE OPEN BLOCK FOR GLXFIL
.RDIFN:! BLOCK 1 ;GALAXY IFN FOR SPOOL FILE.
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
.RDJBT:! BLOCK 1 ;COUNT OF CARDS IN DECK
.RDJBC:! BLOCK 1 ;COUNT OF TOTAL JOB CARDS FOUND
.RDEOJ:! BLOCK 1 ;COUNT OF TOTAL EOJ CARDS
.RDEND:! BLOCK 1 ;COUNT OF TOTAL END CARDS
.RDIPC:! BLOCK 1 ;IPCF MESSAGES SENT
.RDSHT:! BLOCK 1 ;SHUTDOWN FLAG -1=SHUTDOWN THE READER
;On the 20 this is only set if the
; shutdown is due to operator request.
;On the 10 this is set to indicate
; shutdown in progress and must be set
; for cleanup of stream to complete.
.RDMSG:! BLOCK MSBSIZ ;IPCF MESSAGE BUFFER
.RDRSP:! BLOCK 2 ;OPERATOR RESPONSE
.RDOFL:! BLOCK 1 ;ONLINE/OFFLINE FLAG (0=ON, -1=OFF)
;On T10, does not cause blocking
; of stream
.RDWKT:! BLOCK 1 ;STREAM WAKE UP TIME (UDT)
.RDCHN:! BLOCK 1 ;CDR CHANNEL #
.RDSTS:! BLOCK 1 ;FLAG -1=SEND STATUS UPDT MSG
TOPS10 <
.RDBLK:! BLOCK 3 ;TOPS-10 OPEN BLOCK.
.RDIOB:! BLOCK 0 ;CDR BUFFER CONTROL BLOCK.
.RDBUF:! BLOCK 1 ;CDR BUFFER ADDRESS
.RDBPT:! BLOCK 1 ;CDR BYTE POINTER.
.RDBCT:! BLOCK 1 ;CDR BUFFER LENGTH
.RDUDX:! BLOCK 1 ;CARD READER UDX
.RDDEV:! BLOCK 1 ;CARD READER DEVICE NUMBER
.RDSTP:! BLOCK 1 ;DN60 INPUT ERROR CODE
;-1 = Generate no further msg.
; --already given
; 0 = No error set
;+n = 'n' is error code
> ;END TOPS10 CONDITIONAL
TOPS20 <
.RDHND:! BLOCK 1 ;INFERIOR PROCESS HANDLE
.RDRFD:! BLOCK 5 ;READER FILE DESCRIPTOR
.RDSTP:! BLOCK 10 ;ERROR MESSAGE BUFFER
;The first word has the same
;meaning as .RDSTP on T10
.RDSAB:! BLOCK SAB.SZ ;IPCF SAB BLOCK
.RDCAN:! BLOCK 1 ;CANCEL FLAG -1=CANCEL CURRENT JOB
> ;END TOPS20 CONDITIONAL
DBEND:! ;End of defined reader data base
DEPHASE
DBSIZE=<DBEND+PAGESZ>/PAGESZ+1 ;Calculate number of pages
; needed for a stream database assuming
; cardreader buffer 1 page in size
BUFBEG=<DBEND/PAGESZ+1>*PAGESZ ;Calculate beginning of input buffer
; placing it at the beginning of a
; page
SUBTTL Random Impure Storage
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
RDSCHD: BLOCK 1 ;SCHEDULING FLAG: NON-ZER0 = SCHEDULE, 0 = DON'T
SAB: BLOCK SAB.SZ ;A SEND ARGUMENT BLOCK
MSGBLK: BLOCK MSBSIZ ;A BLOCK TO BUILD MESSAGES IN.
BYTPTR: BLOCK 1 ;BYTE POINTER FOR $TEXT ROUTINE
SCHEDL: BLOCK 1 ;STREAM SCHEDULING DATA
CNTSTA: BLOCK 1 ;NUMBER OF THE CENTRAL STATION
RUTINE: BLOCK 1 ;MESSAGE PROCESSING ROUTINE ADDRESS.
NOSAVE: BLOCK 1 ;INDICATOR 0=SAVE FLAG BITS, -1=DONT.
FILENM: BLOCK 1 ;READER SPOOL FILE HASH CODE
FILEXT: 0,,1 ;READER SPOOL FILE EXTENSION
SPOOL: BLOCK 1 ;SPOOL STRUCTURE PPN
PRGSTA: BLOCK 1 ;SPOOLER START ADDRESS (PAGE NUMBER)
RDRSIZ: BLOCK 1 ;SPOOLER LENGTH IN PAGES
TRMFRK: BLOCK 1 ;FORK TERMINATION FLAG
FRKINI: BLOCK 1 ;END FORK INITIALIZATION FLAG
SLEEPT: BLOCK 1 ;SECONDS TO SLEEP
IMESS: BLOCK 1 ;Flag to indicate if any IPCF messages held
;-1 indicates IPCF message to be released
EMSG: BLOCK 1 ;Error message temp storage (D60ER)
SUBTTL Resident JOB Database
JOBPAG: BLOCK MAXRDR ;ADDRESS OF A TWO PAGE BLOCK
JOBOBA: BLOCK MAXRDR ;TABLE OF OBJECT BLOCK ADDRESSES
JOBSTW: BLOCK MAXRDR ;JOB STATUS WORD
JOBOBJ: BLOCK OBJ.SZ*MAXRDR ;LIST OF SETUP OBJECTS
JOBWAC: BLOCK MAXRDR ;WTOR ACK CODES
SUBTTL GLXLIB IB AND HELLO MESSAGE STRUCTURES
TOPS10 <INTVEC==VECTOR>
TOPS20 <INTVEC==:LEVTAB,,CHNTAB>
IB: $BUILD IB.SZ ;
$SET (IB.PRG,,%%.MOD) ;PROGRAM 'CDRIVE'
$SET (IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$SET (IB.PIB,,PIB) ;SET UP PIB ADDRESS
$SET (IB.INT,,INTVEC) ;SETUP INTERRUPT VECTOR ADDRESS
$EOB ;
PIB: $BUILD PB.MNS ;
$SET (PB.HDR,PB.LEN,PB.MNS) ;PIB LENGTH,,0
$SET (PB.FLG,IP.PSI,1) ;PSI ON
$SET (PB.INT,IP.CHN,0) ;INTERRUPT CHANNEL
$SET (PB.SYS,IP.MNP,^D20) ;MAX NUMBER OF PIDS
$EOB ;
HELLO: $BUILD HEL.SZ
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'CDRIVE'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJ TYPES
$SET(HEL.NO,HENMAX,MAXRDR) ;MAX NUMBER OF JOBS
$SET(HEL.OB,,.OTRDR) ;RDR OBJECT TYPE
$EOB
; The following is the message that is send to QUASAR to indicate
; activity using the DN60-IBMCOM
IFN FTIBMS,<
IBMSTM: $BUILD (MSHSIZ+1) ;Header plus status
;word
$SET (.MSTYP,MS.CNT,MSHSIZ+1) ;Length of message
$SET (.MSTYP,MS.TYP,.QOIBM) ;IBMCOM statistics is
;message type
$EOB ;Everything else is
;zero
; This message is used to notify ORION that the link has failed.
; ORION can then invalidate the operator for that node and the
; system operators will get all following error messages.
NWAMSG: $BUILD .OHDRS+ARG.DA+OBJ.SZ
$SET(.MSTYP,MS.CNT,.OHDRS+ARG.DA+OBJ.SZ)
$SET(.MSTYP,MS.TYP,.QONWA)
$SET(.OARGC,,1)
$SET(.OHDRS+ARG.HD,AR.LEN,OBJ.SZ+1)
$SET(.OHDRS+ARG.HD,AR.TYP,.OROBJ)
$EOB
> ;End of FTIBMS
;SCHEDULER FLAGS
PSF%ID==1B1 ;INPUT DONE WAIT
PSF%DO==1B2 ;DEVICE IS OFF-LINE
PSF%ST==1B3 ;STOPPED BY OPERATOR
PSF%SH==1B4 ;SHUT DOWN A CARD READER
PSF%OR==1B5 ;OPERATOR RESPONSE WAIT
PSF%WT==1B6 ;DESCHEDULE FOR 5 SECONDS
SUBTTL CDRIVE - Multiple card reader spooler.
CDRIVE: RESET ;AS USUAL.
MOVE P,[IOWD PDSIZE,PDL] ;SET UP THE STACK.
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
PUSHJ P,I%INIT ;SET UP THE WORLD.
PUSHJ P,RDINIT ;GO SETUP READER CONSTANTS
PUSHJ P,INTINI ;SET UP THE INTERRUPT SYSTEM.
PUSHJ P,I%ION ;TURN ON INTERRUPTS.
PUSHJ P,I%NOW ;GET THE DATE/TIME
MOVEM S1,FILENM ;SAVE IT AS THE SPOOL FILE HASH CODE
TOPS10 <
IFN FTDN60,<
MOVEI S1,SERFLG ;Indicate need for SYSERR
$CALL D60INI## ;Initialize the DN60 database
> ; End of FTDN60 conditional
> ; End of TOPS10 conditional
MOVEI S1,HELLO ;GET ADDRESS OF HELLO MESSAGE.
MOVEI S2,HEL.SZ ;GET LENGTH OF HELLO IN S2
PUSHJ P,SNDQSR ;SAY HI TO QUASAR.
MOVSI P1,-MAXRDR ;SET UP STREAM COUNTER.
JRST MAIN ;GO TO SCHEDULING LOOP
SUBTTL Idle Loop
TOPS10 <
MAIN: SKIPN JOBPAG(P1) ;IS THE STREAM ACTIVE ???
JRST MAIN.2 ;NO,,GET THE NEXT STREAM.
HRRZM P1,STREAM ;RUNNABLE STREAM!!!
MOVE RDR,JOBPAG(P1) ;YES, GET JOB PAGE
SKIPE .RDSTS(RDR) ;WANT TO SEND STATUS INFO ???
PUSHJ P,UPDTST ;GO UPDATE AND SEND STATUS INFORMATION
PUSHJ P,CHKTIM ;CHECK FOR A WAKEUP TIME
JUMPF MAIN.2 ;Go if need to wait some more
SKIPE JOBSTW(P1) ;IS THE STREAM WAITING ???
JRST MAIN.2 ;YES,,GET THE NEXT STREAM.
MOVEM P1,SCHEDL ;SAVE THE SCHEDULING STREAM.
MOVSI 0,.RDREG+1(RDR) ;Setup first source address
HRRI 0,1 ;Setup first destination for BLT
BLT 0,17 ;Get the AC's
MOVE S1,.RDNBR(RDR) ;GET # OF CARDS IN TEMP BUFFER
CAIL S1,CRDNBR ;HAVE WE READ ENOUGH ???
PUSHJ P,READER ;YES,,GO PROCESS THE CARDS
SKIPE .RDSHT(RDR) ;IS A SHUTDOWN SCHEDULED ???
TXNE FLAG,JOBCD ;YES,,ARE WE PROCESSING A JOB ???
$RETT ;NEED MORE CARDS,, GO GET'EM !!!
MOVX S1,%RSUDE ;DEVICE HAS GONE AWAY
PUSHJ P,SHUTIT ;TIME TO SHUTDOWN,,SO DO IT !!!
MAIN.1: MOVE P1,SCHEDL ;GET THE LAST SCHEDULED STREAM.
MAIN.2: AOBJN P1,MAIN ;LOOP BACK FOR SOME MORE.
PUSHJ P,CHKQUE ;CHECK FOR INCOMMING MESSAGES.
MOVE S1,SLEEPT ;GET THE TIME TO SLEEP
SKIPN RDSCHD ;WANT ANOTHER SCHEDULING PASS ???
PUSHJ P,I%SLP ;ELSE,,GO WAIT
MAIN.3: SETZM SLEEPT ;ZAP THE SLEEP TIME
SETZM RDSCHD ;CLEAR SCHEDULING FLAG
MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
MOVSI P1,-MAXRDR ;GET LOOP AC.
JRST MAIN ;KEEP ON PROCESSING.
SENDIT: JRST SNDQSR ;SLIGHT CROCK FOR -10/-20 COMPATABILITY
SNDOPR: JRST OPRMSG ;HERE ALSO
SUBTTL CHKTIM - ROUTINE TO SEE IF ITS TIME TO SCHEDULE A STREAM
;CALL: RDR/ The stream DB Address
;
;RET: True if stream can be scheduled now (timewise)
; False if stream needs to wait
CHKTIM: PUSHJ P,I%NOW ;GET THE CURRENT TIME
MOVE S2,S1 ;GET THE UDT IN S2
MOVE S1,.RDWKT(RDR) ;GET THE STREAM WAKEUP TIME
SUB S1,S2 ;GET TIME LEFT IN JIFFIES
IDIVI S1,3 ;GET NUMBER OF SECONDS
SKIPG S1 ;Any seconds left?
$RETT ;no time left -- return true
SKIPE SLEEPT ;IS A TIME SET ???
CAMG S1,SLEEPT ;CURRENT TIME LESS THE SET TIME ???
MOVEM S1,SLEEPT ;YES,,SAVE THE LOWER VALUE
$RETF ;RETURN False
SUBTTL OACCAN - Operator CANCEL request.
OACCAN: TXZE FLAG,JOBCD ;TELL READER WE ARE LEAVING.
$ACK (Current Job Aborted,,@JOBOBA(STREAM),.MSCOD(M))
MOVE S2,JOBPAG(STREAM) ;Get data base page address
SETOM .RDSTS(S2) ;Send status
$RETT
SUBTTL OACPAU - Operator PAUSE Request
OACPAU: MOVX S2,PSF%ST ;GET THE STOPPED BITS
IORM S2,JOBSTW(STREAM) ;LITE THE STOPPED BITS.
MOVE S2,JOBPAG(STREAM) ;GET THE DATA BASE PAGE ADDRESS
SETOM .RDSTS(S2) ;SEND STATUS BACK TO QUASAR
$ACK (Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
$RETT ;AND RETURN.
SUBTTL OACCON - Operator CONTINUE Request
OACCON: MOVX S2,PSF%ST ;GET THE STOPPED BITS.
ANDCAM S2,JOBSTW(STREAM) ;DE-LITE THE STOPPED BITS.
MOVE S2,JOBPAG(STREAM) ;GET THE DATA BASE PAGE ADDRESS
SETOM .RDSTS(S2) ;SEND STATUS BACK TO QUASAR
$ACK (Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPR
$RETT ;AND RETURN.
SUBTTL OACSHT - ROUTINE TO VALIDATE THE READER SHUTDOWN STATUS
OACSHT: TXNN FLAG,JOBCD ;ARE WE PROCESSING A JOB ???
$RETT ;NO,,THEN SHUTDOWN IS OK.
SETOM .RDSHT(RDR) ;YES,,LITE DEFERED SHUTDOWN FLAG
$RETF ;AND RETURN (NO SHUTDOWN)
SUBTTL Operator Action Request/Response
; Operator Action Request
; Call: S1/ address of table of legal responses
; .RDMSG/ text to send to the operator
;
; TRUE return: S1/ index into table
; FALSE return: never, waits for a correct response
;
OACREQ:
PUSHJ P,.SAVE1 ;Save P1
MOVE P1,S1 ;Copy table address
$CALL I%NOW ;Get the date/time
MOVEM S1,JOBWAC(STREAM) ;Store as WTOR ACK code
SETOM .RDSTS(RDR) ;Say we want status update
OREQ.1: $WTOR (<Reader error>,<^T/.RDMSG(RDR)/>,@JOBOBA(STREAM),JOBWAC(STREAM))
$DSCHD (PSF%OR) ;Deschedule stream
MOVE S1,P1 ;Point to response table
HRROI S2,.RDRSP(RDR) ;Point to operator response
$CALL S%TBLK ;Scan the table for a match
TXNE S2,TL%NOM ;Got one ?
JRST OREQ.1 ;Nope - try again
$RETT ;Return with table index in S1
; Operator Action Response
; Call: M/ IPCF page address
;
; TRUE return: .RDRSP(RDR) set up
; FALSE return: never
;
OACRSP: MOVE S2,.MSCOD(M) ;Point to ACK code
MOVSI S1,-MAXRDR ;Make an AOBJN pointer
CAME S2,JOBWAC(S1) ;ACK codes match ?
AOBJN S1,.-1 ;No - try another
JUMPGE S1,.RETT ;Flush junk messages
MOVX S2,PSF%OR ;Get operator response bit
ANDCAM S2,JOBSTW(S1) ;Clear it
MOVE RDR,JOBPAG(S1) ;Get stream relocation address
MOVE FLAG,.RDREG+FLAG(RDR) ;Set the flag AC so it can be used
DMOVE S1,.OHDRS+ARG.DA(M) ;Pick up operator response
DMOVEM S1,.RDRSP(RDR) ;Store in a safe place
$RETT ;Return
SUBTTL RDINIT - ROUTINE TO INITIALIZE SOME READER CONSTANTS
RDINIT: PUSHJ P,I%HOST ;GET OUR SITE ID
MOVEM S2,CNTSTA ;SAVE AS OUR CENTRAL SITE NUMBER
MOVX S1,%LDQUE ;GET THE GETTAB PPN CODE
GETTAB S1, ;GET THE SPOOL PPN
$STOP (CGS,Cannot Get Spool File PPN)
MOVEM S1,SPOOL ;SAVE IT
MOVSI S1,.STSPL ;ISSUE 'SETUUO' TO
SETUUO S1, ; CLEAR SPOOLING BITS
JFCL ;IGNORE THE ERROR
$RETT ;RETURN
SUBTTL DOJOB - ROUTINE TO PROCESS THE CARD READERS.
DOJOB: HRLZ S1,.RDOBZ(RDR) ;GET THE OUTPUT BYTE SIZE
LSH S1,6 ;POSITION IT
ADD S1,[POINT 0,.CARDS(RDR)] ;MAKE THE BYTE POINTER
MOVEM S1,.RDOPT(RDR) ;AND SAVE IT.
MOVE S1,SPOOL ;GET THE SPOOL PPN
MOVEM S1,.RDFD+.FDPPN(RDR) ;SAVE IT
MOVX S1,FSSSTR ;GET THE SPOOL STRUCTURE NAME
MOVEM S1,.RDFD+.FDSTR(RDR) ;SAVE IT
MOVEI S1,FDSIZE ;GET THE FD SIZE
STORE S1,.RDFD+.FDLEN(RDR),FD.LEN ;SAVE IT
MOVEI S1,.RDFD(RDR) ;GET THE FD ADDRESS
MOVEM S1,.RDFOB+FOB.FD(RDR) ;SAVE IT
MOVE S1,.RDOBZ(RDR) ;GET THE BYTE SIZE
STORE S1,.RDFOB+FOB.CW(RDR),FB.BSZ ;SAVE IT
MOVEI S1,1 ;GET A BIT
STORE S1,.RDFOB+FOB.CW(RDR),FB.NFO ;WANT 'NEW FILE ONLY'
CARDS: PUSHJ P,INCARD ;GET SOME CARDS
JUMPF CRDEOF ;NO MORE,,FINISH UP.
PUSHJ P,PRORDR ;GO PROCESS THE DATA CARDS.
JRST CARDS ;AND GET SOME MORE.
CRDEOF: MOVE S1,ENDIMG(AP) ;GET THE EOF CARD BITS
IDPB S1,.RDOPT(RDR) ;PUT IT IN THE BUFFER
AOS .RDNBR(RDR) ;Add the "EOF" card to the count
TXO FLAG,EOF ;TURN ON EOF INDICATOR
PUSHJ P,READER ;GO FINISH UP THIS FILE
JRST CARDS ;GO LOOK FOR MORE CARDS.
>;end of TOPS10
SUBTTL DSCHD -- Deschedule process
; The purpose of this routine is to provide a generalized blocking
; mechanism. It differs from the old DSCHD in that it will block
; whether in stream context or not. (for TOPS-10)
; DSCHD is called by the $DSCHD macro where the call is:
; $DSCHD (flags) where flags are flags and/or a number of seconds
; to sleep
; ASSUMPTIONS. . .
; 1. STREAM is the correct stream number
; 2. If not in stream context, it is assumed that RDR contains the
; address of the jobpage. This has a side problem. If RDR indicates
; a jobpage of an already existing stream with a context and
; the stream is in the overhead context, the old stream context
; will be destroyed which must be avoided by the caller.
; 3. If called with an IPCF message currently in use, it is assumed
; that the user has everything needed from the message and the
; message will be released. This assumption is necessary to
; prevent another message being received before the old message
; is released.
; 4. If not in stream context, push the routine FIXPDL on the stack
; to restore the stream's stack to the overhead stack.
; All registers are preserved in the JOBPAG.
; Only AC's S1, S2 and T1 are touched before jumping to MAIN.
; parameters:
; RDR / Address of the current jobpage (if not, expect a stopcd)
DSCHD:
TOPS10 <
;Save the AC's in any case
MOVEM 0,.RDREG(RDR) ;Save AC0
MOVEI 0,.RDREG+1(RDR) ;Place to put AC1
HRLI 0,1 ;Setup the BLT pointer
BLT 0,.RDREG+17(RDR) ;Save the AC's
;Take care of the flags passed
HRRZ S2,0(P) ;Get address of JUMP [FLAGS]
HLLZ S1,@0(S2) ;Get the flags
HRRZ S2,@0(S2) ;Get the sleep time
IORM S1,JOBSTW(STREAM) ;set only the flags
JUMPE S2,DSCH.D ;No sleep time to worry about
SKIPE SLEEPT ;Is a time to sleep set?
CAMG S2,SLEEPT ;Current amount less than the set time?
MOVEM S2,SLEEPT ;Yes,, save the lower value
$CALL I%NOW ;Get the current time
IMULI S2,3 ;Seconds to jiffies
ADD S1,S2 ;Build wake-up time
MOVEM S1,.RDWKT(RDR) ;Save the wake-up time
;Check to see our current context
DSCH.D: HRRZ S1,P ;Get current address of PDL
CAIL S1,.RDPDL(RDR) ;Less than beginning of current PDL
CAILE S1,PDSIZE+.RDPDL(RDR) ;or Greater than end?
SKIPA ;No -- not in context
JRST DSCH.Z ;Yes - already in stream context
;Since we have to make a stream context, we must do the following:
; 1. Release any IPCF messages
; 2. Save PDL and AC17
AOSN IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release it
PUSH P,[EXP FIXPDL] ;Remember to restore overhead PDL
MOVEI S1,.RDPDL(RDR) ;Get stream's PDL location
HRLI S1,PDL ;Get beginning of PDL
HRRZ T1,P ;Get current PDL pointer
SUBI T1,PDL ;Find current length
ADDI T1,.RDPDL(RDR) ;Add stream's base
HRR P,T1 ;Set new pointer
BLT S1,(T1) ;Save PDL
MOVEM P,.RDREG+P(RDR) ;Save new PDL pointer
JRST MAIN.3 ;Return to restart main loop
DSCH.Z: MOVE P,[IOWD PDSIZE,PDL] ;Reset stack pointer
JRST MAIN.1 ;Return to main loop
> ;End of TOPS10
TOPS20<
PUSH P,S1 ;Save a reg.
HRRZ S1,-1(P) ;Get address of the flag word
HRRZ S1,@0(S1) ;Get the sleep time
$CALL I%SLP ;Sleep awhile
POP P,S1 ;Restore the reg
$RET
> ;End of TOPS20
SUBTTL FIXPDL -- Fix PDL routine
TOPS10<
;The purpose of this subroutine is to return the pseudo stream
;context back to overhead context. (See DSCHD)
FIXPDL: MOVEI S1,PDL ;Get overhead PDL
HRLI S1,.RDPDL(RDR) ;Get beginning of stream's PDL
HRRZ S2,P ;Get current pointer
SUBI S2,.RDPDL(RDR) ;Find the current length
ADDI S2,PDL ;Add the base of the PDL
HRR P,S2 ;Set the new pointer
BLT S1,(S2) ;Restore PDL
MOVE S1,.RDREG+S1 ;Restore S1
MOVE S2,.RDREG+S2 ;Restore S2
$RET ;Continue on
> ; End of TOPS10
SUBTTL PRORDR--READER INPUT PROCESSING
TOPS10 <
PRORDR: SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
$RETT ;YES,,NOTHING TO DO !!!!!!
TXNE FLAG,CD20 ;IS THIS A CD20 LINE ???
JRST PROR.4 ;YES,,DO IT DIFFERENTLY
HLLZ P1,.RDBPT(RDR) ;SAVE READERS BYTE SIZE.
MOVEI S1,1400 ;GEN A 12 BIT BYTE SIZE.
HRLM S1,.RDBPT(RDR) ;CREATE A NEW BYTE POINTER.
AOS .RDBPT(RDR) ;POINT TO ACTUAL DATA.
PROR.1: LDB T1,.RDBPT(RDR) ;PICK UP A LOCAL BYTE.
JUMPE T1,PROR.2 ;IF A BLANK,,SKIP THIS.
LDB S1,[POINT 7,T1,33] ;GET CDR COLS 1-7.
LSH S1,35 ;LEFT JUSTIFY THOSE BITS.
JFFO S1,.+2 ;GET # OF LEADING 0 BITS.
JRST PROR.2 ;NOTHING THERE,,SO SKIP THIS
ADDI S2,1 ;ADD 1 TO 0 BIT COUNT.
LSH S1,1(S2) ;SHIFT THEM OUT + 1.
SKIPE S1 ;IF S1=0, THEN NO READER ERROR.
ADDI S2,10 ;ELSE TURN ON ERROR BIT.
LSH S2,^D12 ;SHIFT TO CORRECT BIT POSITION.
ADD T1,S2 ;MERGE INTO CORRECTED WORD.
PROR.2: IDPB T1,.RDOPT(RDR) ;AND SAVE THE RESULTING 18 BIT BYTE.
AOS .RDBPT(RDR) ; ADD 1 TO INPUT ADDRESS.
SOSLE .RDBCT(RDR) ;SUBTRACT 1 FROM BYTE COUNT
JRST PROR.1 ;AND GO PROCESS THE NEXT BYTE.
HLLM P1,.RDBPT(RDR) ;RESTORE ORIGIONAL BYTE SIZE.
PROR.3: AOS S1,.RDNBR(RDR) ;BUMP THE NUMBER OF CARDS BY 1
CAIL S1,CRDNBR ;HAVE WE TRANSLATED ENOUGH YET ???
PUSHJ P,READER ;YES,,GO PROCESS THEM
POPJ P, ;RETURN TO MAIN PROGRAM
PROR.4: MOVE T1,.RDRCL(RDR) ;GET THE BYTE COUNT
HRRZ T2,.RDBPT(RDR) ;GET THE INPUT BUFFER ADDRESS
ADD T2,[POINT 16,1] ;CREATE THE BYTE POINTER
PROR.5: ILDB S1,T2 ;GET AN INPUT BYTE
IDPB S1,.RDOPT(RDR) ;PUT IT OUT
SOJG T1,PROR.5 ;MORE??,,KEEP PROCESSING
JRST PROR.3 ;GO FINISH UP
SUBTTL INCARD - ROUTINE TO READ CARDS FROM THE CARD READER.
;NOTE: The 'Input-Blocked' bit is set here in order to avoid
; a race condition which would allow CDRIVE to miss the
; 'Input Done' Interrupt. In particular, this avoids
; the problem of getting the 'Input Done' interrupt
; before CDRIVE has set the 'Input Blocked' bit when
; descheduling the stream. This situation would cause
; the stream to block forever, waiting for an interrupt
; which it had already recieved.
INCARD: SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
JRST $IN60 ;YES,,GO GET SOME CARDS
MOVX S2,PSF%ID ;GET THE 'INPUT BLOCKED' BIT
IORM S2,JOBSTW(STREAM) ;WAIT FOR INPUT DONE INTERRUPT
MOVE S1,.RDCHN(RDR) ;GET THE READERS CHANNEL.
TLO S1,(IN 0,0) ;CREATE AN INPUT UUO.
XCT S1 ;READ SOME DATA CARDS.
JRST [ANDCAM S2,JOBSTW(STREAM) ;CLEAR THE INPUT BLOCKED BIT
$RETT ] ;AND RETURN
INERR: MOVE S1,.RDCHN(RDR) ;GET THE CHANNEL NUMBER.
IOR S1,[GETSTS .RDSTA(RDR)] ;CREATE A GETSTS UUO.
XCT S1 ;GET THE DEVICE STSTUS.
MOVE S1,.RDSTA(RDR) ;LOAD IT HERE ALSO.
TXNE S1,IO.ERR+IO.EOF ;WAS THERE AN ERROR OR EOF?
JRST INER.1 ;YES,,GO PROCESS IT.
$DSCHD(0) ;BLOCK FOR INPUT DONE. (See Above)
JRST INCARD ;AND GO TRY AGAIN
INER.1: MOVE S2,S1 ;Copy the error bits to update status
TRZ S2,IO.ERR+IO.EOF ;Bits to clear
HRLI S2,(SETSTS 0,0) ;Create SETSTS UUO
ADD S2,.RDCHN(RDR) ;Add the channel number
XCT S2 ;Clear the error bits in status word
TXNE S1,IO.EOF ;WAS THE ERROR EOF ???
JRST [HRLI S2,(CLOSE 0,0) ;Need to close
ADD S2,.RDCHN(RDR) ;Add the channel number
XCT S2 ;Close to clear the eof
$RETF ] ;Return telling about EOF
TXNN S1,IO.DER ;DATA MISSED ERROR ?
JRST INCARD ;NOPE - Just go try again
$TEXT (<-1,,.RDMSG(RDR)>,<^T/DMETXT/^0>)
MOVX S2,PSF%ID ;Want to turn off the input blocked bit
ANDCAM S2,JOBSTW(STREAM) ; so the job can be scheduled after
; the operator response.
MOVEI S1,DMETAB ;POINT TO OPERATOR RESPONSE TABLE
PUSHJ P,OACREQ ;REQUEST OPERATOR ACTION
JRST INCARD ;RETRY THE READ.
DMETXT: ASCIZ |Data missed error. Put last card in hopper and
Type 'RESPOND <number> PROCEED' to continue reading cards|
DMETAB: $STAB
KEYTAB (0,PROCEED)
$ETAB
SUBTTL INPGET -- OPEN the input device
INPGET: SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
JRST [PUSHJ P,$OPEN ;YES,,GO OPEN IT UP
JUMPT OUTSOK ;WIN,,RETURN
MOVX S1,%RSUNA ;Not available right now
$RETF ] ;Already sent error message in OPEN.6
SETOM .RDCHN(RDR) ;INDICATE NO OUTPUT CHANNEL YET.
PUSHJ P,GENDEV ;CREATE THE PHYSICAL DEVICE NAME.
MOVEM S1,.RDDEV(RDR) ;AND SAVE IT
MOVX T1,UU.AIO+UU.SOE+IO.SIM+IO.SYN+.IOIMG ;GET OPEN FLAG BITS.
MOVE T2,.RDDEV(RDR) ;OUTPUT DEVICE NAME
MOVEI T3,.RDIOB(RDR) ;BUFFER HEADER
MOVE S1,STREAM ;USE OUR STREAM NUMBER AS THE CHANNEL #
LSH S1,^D23 ;SHIFT IT TO ITS PROPER POSITION.
IOR S1,[OPEN T1] ;MAKE IT AN INSTRUCTION
XCT S1 ;AND EXECUTE IT
JRST OUTDNA ;LOSE GIVE ERROR
MOVE S2,STREAM ;AND STREAM NUMBER
LSH S2,^D23 ;CONVERT TO A CHANNEL NUMBER
MOVEM S2,.RDCHN(RDR) ;SAVE IT FOR LATER
SETZM JOBSTW(STREAM) ;CLEAR THE STREAM STATUS BITS.
MOVEI T1,.DFHCW ;GET READER HARDWARD CHARACTERISTICS
MOVE T2,.RDDEV(RDR) ;FOR THIS READER
MOVE S1,[2,,T1] ;SET UP DEVOP. PARAMETER LIST
DEVOP. S1, ;GET CHARACTERISTICS...
$STOP (CGC,Cannot Get Reader Hardware Characteristics)
LOAD S2,S1,DF.CLS ;GET THE LINE TYPE
CAXN S2,.DFS20 ;IS IT A CD20 LINE ???
TXO FLAG,CD20 ;YES,,SET IT.
MOVE S1,.RDBFR(RDR) ;GET THE READERS BUFFER ADDRESS.
EXCH S1,.JBFF ;MAKE IT OUT END ADDRESS.
MOVE S2,.RDCHN(RDR) ;GET THE CHANNEL NUMBER
IOR S2,[INBUF CRDNBR] ;MAKE AN INSTRUCTION
XCT S2 ;AND CREATE 'CRDNBR' BUFFERS
MOVEM S1,.JBFF ;RESTORE JOBFF
JRST OUTSOK ;AND CONTINUE ON
GENDEV: MOVE T1,JOBOBA(STREAM) ;PICK UP OBJECT BLOCK ADDRESS.
MOVE S1,OBJ.ND(T1) ;PICK UP THE NODE NUMBER.
IDIVI S1,10 ;SPLIT IT IN HALF.
IMULI S1,100 ;SHIFT LEFT 2 DIGITS.
ADD S1,S2 ;ADD SECOND NODE DIGIT.
IMULI S1,100 ;SHIFT LEFT ANOTHER 2 DIGITS.
ADD S1,OBJ.UN(T1) ;ADD THE UNIT NUMBER.
ADD S1,[SIXBIT/CDR000/] ;CREATE THE PHYSICAL DEVICE NAME.
POPJ P, ;RETURN. . . . .
SUBTTL GENFIL - ROUTINE TO GENERATE THE SPOOL FILENAME
GENFIL: PUSH P,T1 ;SAVE T1
MOVE S1,[POINT 6,.RDFD+.FDNAM(RDR)] ;BYTE PTR FOR FILENAME
MOVEM S1,BYTPTR ;SAVE IT.
$TEXT (CV26BT,<RD^D4L0/FILENM,FILEMK/>) ;CREATE THE SPOOL FILE NAME
AOS FILENM ;CREATE ANOTHER
SETZM .RDFD+.FDEXT(RDR) ;ZERO THE FILENAME EXT.
MOVE S1,FILEXT ;GET THE EXTENSION NUMBER
IDIVI S1,100 ;GET THE THIRD DIGIT
ADDI S1,20 ;MAKE IT SIXBIT.
LSH S1,6 ;SHIFT IT OVER
IDIVI S2,10 ;GET SECOND AND FIRST DIGITS
ADDI S2,20 ;MAKE IT SIXBIT
ADDI T1,20 ;HERE ALSO
ADD S1,S2 ;PUT INTO S1
LSH S1,6 ;SHIFT IT OVER
ADD S1,T1 ;ADD FIRST DIGIT
HRLZM S1,.RDFD+.FDEXT(RDR) ;SAVE IT AS FILE EXT
POP P,T1 ;RETSORE T1
$RETT ;AND RETURN
CV26BT: SUBI S1,40 ;CONVERT TO SIXBIT
ANDI S1,77 ;JUST USE LAST 2 DIGITS
IDPB S1,BYTPTR ;SAVE THE BYTE
$RETT ;AND RETURN
OUTSOK: PUSHJ P,INTCNL ;CONNECT UP THE READER
TXO FLAG,INTRPT ;TURN ON CONNECTED FLAG
$WTO (Started,,@JOBOBA(STREAM)) ;TELL OPERATOR WE'RE STARTED
MOVX S1,%RSUOK ;LOAD THE CODE
$RETT ;AND RETURN
OUTDNA: $WTO (Not available right now,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
MOVX S1,%RSUNA ;NOT AVAILABLE RIGHT NOW
$RETF ;AND RETURN
SUBTTL INPREL - ROUTINE TO RELEASE A CARD READER
INPREL: TXZE FLAG,INTRPT ;ARE WE CONNECT TO THE INTRPT SYSTEM ??
PUSHJ P,INTDCL ;REMOVE THE READER FROM THE INTRPT SYS
SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
JRST $CLOSE ;YES,,CLOSE IT DOWN
SKIPGE S1,.RDCHN(RDR) ;DID WE INIT A CHANNEL ???
$RETT ;NO,,JUST RETURN
LSH S1,-^D23 ;GET THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
POPJ P, ;IGNORE ERRORS
POPJ P, ;RETURN IF NORMAL
SUBTTL Interrupt Module
; INTINI INITIALIZE INTERRUPT SYSTEM
; INTCNL CONNECT THE CARD READER
; INTDCL DISCONNECT THE CARD READER
; INTIPC INTERRUPT ROUTINE -- IPCF
;INTERRUPT SYSTEM DATABASE
VECTOR: BLOCK 0 ;BEGINNING OF INTERRUPT VECTOR
VECIPC: BLOCK 4 ;IPCF INTERRUPT BLOCK
VECDEV: BLOCK 4*MAXRDR ;DEVICE INTERRUPT BLK
ENDVEC==.-1 ;END OF INTERRUPT VECTOR
DEFINE CDINHD(Z),<
XLIST
$BGINT 1,
MOVEI S1,Z
MOVEI S2,VECDEV+<4*Z>
JRST CDINTR
CDHDSZ==4
LIST
> ;END DEFINE CDINHD
INTINI: MOVEI S1,INTIPC ;GET ADDRESS OF IPCF INT RTN
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
Z==0
REPEAT MAXRDR,<XLIST
MOVEI S1,INTDEV+<CDHDSZ*Z> ;GET ADDRESS OF RDR HEADER
MOVEM S1,VECDEV+<4*Z>+.PSVNP ;STORE IN THE VECTOR
Z==Z+1
LIST
> ;END REPEAT MAXRDR
POPJ P, ;AND RETURN
INTDCL: SKIPA S1,[PS.FRC+T1] ;REMOVE CONDITION USINGS ARGS IN T1
INTCNL: MOVX S1,PS.FAC+T1 ;ADD CONDITION USING ARGS IN T1
SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
$RETT ;YES,,NO INTERRUPTS !!!
MOVE T1,.RDCHN(RDR) ;USE CHANNEL AS CONDTION
LSH T1,-^D23 ;MAKE IT RIGHT !!!
MOVE T2,STREAM ;GET STREAM NUMBER
IMULI T2,4 ;GET BLOCK OFFSET
ADDI T2,VECDEV-VECTOR ;GET OFFSET FROM BEGINNING
HRLZS T2 ;GET OFFSET,,0
HRRI T2,PS.RID+PS.RDO+PS.ROL ;AND CONDITIONS
SETZ T3, ;ZERO T3
PISYS. S1, ;TO THE INTERRUPT SYSTEM
$STOP (CAD,CANNOT ADD/DELETE READER TO/FROM INTERRUPT SYSTEM)
POPJ P, ;AND RETURN
;Here on device interrupts on the -10. This routine consists of multiple
; interrupt headers (one for each stream) which load S1 and S2 and
; call the main interrupt body, CDINTR. Note that on the -10, while
; it is assumed that 'input done' and 'on-line' interrupts can happen
; anytime and anywhere, it is also assumed that 'device off-line'
; interrupts ONLY HAPPEN IN THE STREAM CONTEXT.
; The previous assumption is incorrect. A node gone away message
; can occur at any time but continue since CDRIVE will
; get a shutdown message from QUASAR for that reader
INTDEV: Z==0
REPEAT MAXRDR,<
CDINHD(Z)
Z==Z+1 >
CDINTR: MOVE RDR,JOBPAG(S1) ;GET THE JOB PARAMETER PAGE
HRRZ T1,.PSVFL(S2) ;GET I/O REASON FLAGS
ANDCAM T1,.PSVFL(S2) ;AND CLEAR THEM
TXNE T1,PS.ROL ;Is it online?
JRST [SETOM .RDSTS(RDR) ;Yes, want status update
MOVX T2,PSF%DO+PSF%ID ;Clear offline and input done
SETZM .RDOFL(RDR) ;Say we are online
JRST CDIN.0] ;Continue on
SETZ T2, ;CLEAR AN AC
TXNE T1,PS.RID ;IS IT INPUT DONE?
TXO T2,PSF%ID ;YES, GET SCHEDULER BIT
CDIN.0: ANDCAM T2,JOBSTW(S1) ;CLEAR THE SCHEDULER FLAGS
TXNE T1,PS.RDO ;IS IT DEVICE OFF-LINE?
TXNE T1,PS.ROL ;Yes, IF BOTH OFFLINE AND ONLINE,
$DEBRK ;DISMISS THE INTERRUPT.
MOVX T2,PSF%DO ;GET OFF-LINE BIT.
SKIPN .RDREM(RDR) ;Is this a remote reader?
JRST CDIN.1 ;No, skip this
MOVE T1,.PSVIS(S2) ;Get the file attributes
TXC T1,IO.ERR ;If all error bits are lit, we have
TXNN T1,IO.ERR ;node offline message -- DO WE?
JRST [IORM T2,JOBSTW(S1) ;Yes, set the bit and not sched again
SETOM .RDSTS(RDR) ; might not be in stream context
$DEBRK] ; and want to wait for shutdown
SKIPA ;Don't set blocking offline...
;Do it in INPOFF
CDIN.1: IORM T2,JOBSTW(S1) ;Set the offline bit for local
MOVEI T1,INPOFF ;LOAD RESTART ADDRESS
EXCH T1,.PSVOP(S2) ;STORE FOR DEBRK AND GET OLD ADRESS
MOVEM T1,.RDIOA(RDR) ;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
INTDON: $DEBRK ;DISMISS THE INTERRUPT.
INPOFF: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
SKIPE .RDOFL(RDR) ;Were we previously offline?
JRST INPO.2 ;Yes, skip this and go to sleep
SETOM .RDSTS(RDR) ;Want status update
SKIPE .RDNBR(RDR) ;ANYTHING IN THE BUFFERS ???
PUSHJ P,READER ;GO PROCESS THE BUFFERS
TXNE FLAG,JOBCD ;ARE WE PROCESSING A JOB ???
$WTO (Offline,,@JOBOBA(STREAM)) ;TELL THE OPERATOR RDR IS OFFLINE.
SKIPE .RDREM(RDR) ;Is this a remote?
JRST [SETOM .RDOFL(RDR) ;Yes, set it offline not to block
JRST INPO.2] ;Go sleep but not forever
$DSCHD(0) ;WAIT FOR ONLINE INTERRUPT.
INPO.1: POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
JRST @.RDIOA(RDR) ;CONTINUE PROCESSING.
INPO.2: $DSCHD (LGSLPT) ;Sleep for awhile
JRST INPO.1 ;Go and try again
SUBTTL INTIPC - IPCF INTERRUPT PROCESSING ROUTINE
INTIPC: $BGINT 1, ;SETUP FOR INTERRUPT
PUSHJ P,C%INTR ;FLAG THE INTERRUPT
$DEBRK ;RETURN
> ;END OF TOPS-10 CONDITIONAL CODE
SUBTTL CHKQUE - ROUTINE TO CHECK FOR INCOMING MESSAGES.
CHKQUE: PUSHJ P,C%RECV ;RECEIVE A MESSAGE
JUMPF .POPJ ;RETURN,,NOTHING THERE.
SETOM IMESS ;Have a message
LOAD S2,MDB.SI(S1) ;GET SPECIAL INDEX WORD
TXNN S2,SI.FLG ;IS THERE AN INDEX THERE?
JRST CHKQ.5 ;NO, IGNORE IT
ANDX S2,SI.IDX ;AND OUT THE INDEX
CAIE S2,SP.OPR ;IS IT FROM OPR?
CAIN S2,SP.QSR ;IS IT FROM QUASAR?
SKIPA ;Yes, continue on
JRST CHKQ.5 ;No, flush it
LOAD S1,MDB.MS(S1),MD.ADR ;GET THE MESSAGE ADDRESS
MOVEM S1,RDSCHD ;SAVE IT AWAY
MOVE M,S1 ;SAVE THE MESSAGE ADDRESS HERE TOO
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
MOVSI S1,-NMSGT ;MAKE AOBJN POINTER FOR MSG TYPES
CHKQ.3: HRRZ T1,MSGTAB(S1) ;GET A MESSAGE TYPE
CAMN S2,T1 ;MATCH?
JRST CHKQ.4 ;YES, WIN
AOBJN S1,CHKQ.3 ;NO, LOOP
JRST CHKQ.5 ;NO,, go release the message
CHKQ.4: HLRZ T2,MSGTAB(S1) ;PICK UP THE PROCESSING ROUTINE ADDRESS.
MOVEM T2,RUTINE ;SAVE THE ROUTINE ADDRESS.
SETZM NOSAVE ;RESET THE FLAG SAVE FLAG WORD.
PUSHJ P,CHKOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF CHKQ.5 ;INVALID OBJECT,,FLUSH THE MESSAGE
PUSHJ P,@RUTINE ;DISPATCH THE MESSAGE PROCESSOR.
SKIPN NOSAVE ;DO WE WANT TO SAVE THE FLAGS ???
MOVEM FLAG,.RDREG+FLAG(RDR) ;YES,,SAVE THE STATUS BITS.
SKIPN RDSCHD ;Do we remember the message address?
SETOM RDSCHD ;No, force the scheduler anyway
CHKQ.5: AOSN IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release the message
JRST CHKQUE ;Go see if any more
MSGTAB: XWD .RETT,.QORCK ;REQUEST-FOR-CHECKPOINT
XWD SETUP,.QOSUP ;SETUP/SHUTDOWN
XWD OACCON,.OMCON ;OPERATOR CONTINUE REQUEST.
XWD OACCAN,.OMCAN ;OPERATOR CANCEL REQUEST.
XWD OACPAU,.OMPAU ;OPERATOR PAUSE/STOP REQUEST.
TOPS10< XWD OACRSP,.OMRSP> ;OPERATOR WTOR RESPONSE.
XWD QSRNWA,.QONWA ;NODE-WENT-AWAY PROCESSOR
NMSGT==.-MSGTAB
SUBTTL - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.
CHKOBJ: CAIE T1,.OMRSP ;IS THIS AN OPR RESPONSE MESSAGE ???
CAIN T1,.QOSUP ; OR IS THIS A SETUP/SHUTDOWN MESSAGE ??
$RETT ;YES,,RETURN.
CAXN T1,.QORCK ;IS THIS A REQUEST FOR CHECKPOINT ???
$RETF ;YES,,IGNORE IT
LOAD S2,.OHDRS+ARG.HD(M),AR.TYP ;PICK UP THE MSG BLK TYPE.
CAIE S2,.OROBJ ;IS IT THE OBJ BLK ???
$STOP (NFB,FIRST BLOCK IN MESSAGE NOT THE OBJECT BLOCK)
MOVEI S1,.OHDRS+ARG.DA(M) ;POINT TO THE OBJECT BLOCK.
PJRST FNDOBJ ;RETURN THROUGH 'FNDOBJ'
SUBTTL SETUP/SHUTDOWN Message
SETUP: LOAD S1,SUP.FL(M) ;GET THE FLAGS
TXNE S1,SUFSHT ;IS IT A SHUTDOWN?
JRST SHUTDN ;IF SO,,SHUT IT DOWN !!!
SETZ T2, ;CLEAR A LOOP REG
SETU.1: SKIPN JOBPAG(T2) ;A FREE STREAM?
JRST SETU.2 ;YES!!
CAIGE T2,MAXRDR-1 ;NO, LOOP THRU THEM ALL?
AOJA T2,SETU.1 ;NO, KEEP GOING
$STOP(TMS,Too many setups)
SETU.2: MOVEM T2,STREAM ;SAVE THE STREAM NUMBER
;Get some pages for stream data base
MOVEI S1,DBSIZE ;NUMBER OF PAGES NEEDED
PUSHJ P,M%AQNP ;GET THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,JOBPAG(T2) ;AND SAVE IT
MOVE RDR,S1 ;PUT IT IN RDR
;Set some locations in the stream data base
SETZM FLAG ;CLEAR THE READER FLAG WORD
MOVEM T2,.RDSTR(RDR) ;SAVE THE STREAM NUMBER
MOVEI S1,BUFBEG(RDR) ;RDR BUFFER ADDRESS or END ADDRESS
MOVEM S1,.RDBFR(RDR) ;STORE IT
MOVE S2,T2 ;COPY OVER THE STREAM NUMBER
IMULI T2,OBJ.SZ ;GET OFFSET OF OBJECT BLOCK
ADDI T2,JOBOBJ ;ADD IN THE BASE
MOVEM T2,JOBOBA(S2) ;STORE OBJECT ADDRESS
MOVE S2,T2 ;GET DESTINATION OF BLT INTO S2
HRLI S2,SUP.TY(M) ;MAKE A BLT POINTER
BLT S2,OBJ.SZ-1(T2) ;BLT THE OBJECT BLOCK
HRL S2,M ;GET THE SETUP MESSAGE ADDRESS
HRRI S2,.RDSUP(RDR) ;WHERE WE WANT IT PUT
BLT S2,.RDSUP+SUP.SZ-1(RDR) ;SAVE THE SETUP MESSAGE IN THE DATA BASE
SETZM .RDREM(RDR) ;ASSUME THAT IT IS LOCAL OR DN200
MOVEI AP,LOC200 ;SINCE LOCAL,,GET LOCAL/DN200 BYTE TABLE
MOVX S1,IBYTSZ ;SINCE LOCAL,,GET INPUT BYTE SIZE
MOVEM S1,.RDIBZ(RDR) ; AND SAVE IT FOR LATER
MOVX S1,OBYTSZ ;SINCE LOCAL,,GET OUTPT BYTE SIZE
MOVEM S1,.RDOBZ(RDR) ; AND SAVE IT FOR LATER
MOVX S1,LOCRCL ;GET LOCAL/DN200 RECORD LENGTH
MOVEM S1,.RDRCL(RDR) ; AND SAVE IT FOR LATER
MOVE S1,SUP.NO(M) ;GET THIS GUYS NODE NAME
CAMN S1,CNTSTA ;IS IT REALLY LOCAL ???
JRST SETU.3 ;YES,,SKIP THIS REMOTE STUFF
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SKIPN SUP.CN(M) ;IS THIS A DN60 REMOTE ???
JRST [SETOM .RDREM(RDR) ;NO,,MUST BE DN200 - SET DN200 FLAG
JRST SETU.3 ] ;AND CONTINUE PROCESSING
MOVEI S1,1 ;GET A 1 (DN60 FLAG)
MOVEM S1,.RDREM(RDR) ;MAKE THIS A DN60 REMOTE
MOVE S1,SUP.ST(M) ;GET THE DN60 FLAG WORD
MOVEM S1,.RDFLG(RDR) ;SAVE IT FOR LATER
MOVEI AP,CHAR60 ;GET DN60 BYTE TRANSLATION TABLE
MOVX S1,IBYT60 ;GET DN60 INPUT BYTE SIZE
MOVEM S1,.RDIBZ(RDR) ;AND SAVE IT
MOVX S1,OBYT60 ;GET DN60 OUTPUT BYTE SIZE
MOVEM S1,.RDOBZ(RDR) ;AND SAVE IT
MOVX S1,D60RCL ;GET DN60 RECORD LENGTH
MOVEM S1,.RDRCL(RDR) ;AND SAVE IT
SETU.3: MOVEM AP,.RDREG+AP(RDR) ;SAVE AP FOR PROCESSING
TOPS20< $CALL SETACS ;Now is the time for TOPS20 >
PUSHJ P,INPGET ;GET THE INPUT DEVICE.
CAIE S1,%RSUOK ;ALL IS OK?
JRST [$CALL SHUTUP ;Just do a quick shutdown
JRST SETU.5] ;go to end
TOPS10<
IFN FTDN60,<
SKIPLE .RDREM(RDR) ;DN60?
$CALL FIXPRO ;Yes, fix the data base
> ;End of FTDN60
PUSHJ P,RSETUP ;SEND THE RESPONSE TO SETUP MSG.
IFN FTDN60,<
SKIPLE .RDREM(RDR) ;DN60?
$CALL FIXPRO ;Yes, fix the data base back
> ;End of FTDN60
$CALL SETACS ;Now is the time for TOPS10
> ; End of TOPS10
SETU.5: $RETT ;RETURN
;Set up the stream's data base with the PDL and AC's
; Must be done after INPGET for TOPS10 since a DSCHED can clobber the AC's
; Must be done before INPGET for TOPS20 since the ACs are needed in inferior
SETACS: MOVEI S1,.RDPDL-1(RDR) ;SET UP THE STREAM CONTEXT
HRLI S1,-PDSIZE ;STACK POINTER.
PUSH S1,[EXP DOJOB] ;LETS START AT THE RIGHT SPOT.
MOVEM S1,.RDREG+P(RDR) ;SAVE THE STREAM STACK POINTER.
MOVEM RDR,.RDREG+RDR(RDR) ;SAVE RDR AWAY
MOVEM STREAM,.RDREG+STREAM(RDR) ;Save the stream also
$RET
SUBTTL QSRNWA - ROUTINE TO PROCESS NODE-WENT-AWAY MESSAGES
QSRNWA: MOVX S1,%RSUNA ;GET NOT AVAILABLE RIGHT NOW STATUS
$CALL SHUTUP ;Go shutdown the stream
$RETT ;RETURN
IFN FTDN60,<
SUBTTL FIXPRO - Routine to fix proto node data base
; The purpose of this routine is exchange the prototype name with the
;actual name in the reader data base for DN60 card readers. This
;should happen twice, once before sending response to setup
;and once after sending the response to setup. This is because QUASAR
;needs to know the prototype name since we are only now telling it the
;actual name with the message. But we only want it changed at the
;response message because all other messages should have the correct name.
;It is a routine because T10 and T20 send the response to setup
;message at different times.
;Assumes that STREAM is correct. Uses S1 and S2 and restores them
;Returns without setting TF
FIXPRO: $SAVE <S1,S2>
MOVE S1,JOBOBA(STREAM) ;Get object block address
MOVE S2,OBJ.ND(S1) ;Get prototype node name
EXCH S2,.RDPNN(RDR) ;Save it, Get node name
MOVEM S2,OBJ.ND(S1) ;Save it
$RET ;Always return
> ; End of FTDN60
SUBTTL SHUTDN - ROUTINE TO SHUT DOWN A LINE-PRINTER
SHUTDN: MOVEI S1,SUP.TY(M) ;GET THE OBJECT BLOCK ADDRESS
PUSHJ P,FNDOBJ ;GO FIND IT
JUMPF .RETF ;NOT THERE,,RETURN
PUSHJ P,OACSHT ;GO SEE IF ITS OK TO SHUT IT DOWN
JUMPF .RETT ;NO,,RETURN NOW
MOVX S1,%RSUDE ;Get 'Does not exist'
SHUTUP: TDZA P1,P1 ;SET CDRIVE CONTEXT INDICATOR
SHUTIT: SETOM P1 ;SET STREAM CONTEXT INDICATOR
PUSH P,S1 ;Save arg. for telling quasar
$CALL INPREL ;GO RELEASE THE READER
POP P,S1 ;Restore arg. for telling quasar
$CALL RSETUP ;Tell QUASAR
MOVE S2,RDR ;GET THE JOBPAG ADDRESS
ADR2PG S2 ;CONVERT TO A PAGE NUMBER
MOVX S1,DBSIZE ;LOAD THE NUMBER OF PAGES
TOPS10< SKIPE P1 ;STREAM CONTEXT ???
MOVE P,[IOWD PDSIZE,PDL] ;YES,,RESET THE STACK POINTER.
> ; End of TOPS10
PUSHJ P,M%RLNP ;RETURN THEM
PUSHJ P,M%CLNC ;GET RID OF UNWANTED PAGES.
SETZM JOBPAG(STREAM) ;CLEAR THE PAGE WORD
SETOM NOSAVE ;WE DONT WANT STREAM FLAG BITS SAVED.
TOPS10< JUMPN P1,MAIN.3 ;STREAM CONTEXT,,RETURN TO SCHEDULER >
$RETT ;ELSE RETURN
SUBTTL RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG TO QUASAR
RSETUP: MOVE T2,S1 ;SAVE THE SETUP CONDITION CODE.
MOVEI S1,RSU.SZ ;GET MESSAGE LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS OF THE BLOCK
PUSHJ P,.ZCHNK ;ZERO IT OUT
MOVEI T1,MSGBLK ;GET THE BLOCK ADDRESS
MOVX S1,RSU.SZ ;GET MESSAGE SIZE
STORE S1,.MSTYP(T1),MS.CNT ;STORE IT
MOVX S1,.QORSU ;GET FUNCTION CODE
STORE S1,.MSTYP(T1),MS.TYP ;STORE IT
MOVS S1,JOBOBA(STREAM) ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SZ-1(T1) ;AND MOVE THE OBJECT BLOCK
STORE T2,RSU.CO(T1) ;STORE TH CODE
MOVE S1,JOBPAG(STREAM) ;Get the page
MOVE S1,.RDPNN(S1) ;Get the prototype node name (if one)
MOVEM S1,RSU.PN(T1) ;Save it in the response message
MOVE S1,T1 ;GET THE MESSAGE ADDRESS.
MOVEI S2,RSU.SZ ;GET THE MESSAGE LENGTH.
PUSHJ P,SNDQSR ;AND SEND THE MESSAGE
$RETT ;RETURN.
SUBTTL FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
MOVE T2,.ROBAT(S1) ;GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
SETZ T4, ;CLEAR AN INDEX REGISTER
FNDO.1: MOVE S2,T4 ;GET THE INDEX
IMULI S2,3 ;MULTIPLY BY OBJECT BLCK SIZE
CAMN T1,JOBOBJ+OBJ.TY(S2) ;COMPARE
CAME T2,JOBOBJ+OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+OBJ.ND(S2) ;COMPARE
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: ADDI T4,1 ;INCREMENT
CAIGE T4,MAXRDR ;THE END OF THE LINE?
JRST FNDO.1 ;OK, LOOP
$RETF ;NOT FOUND,,RETURN NO GOOD !!
FNDO.3: MOVEM T4,STREAM ;SAVE STREAM NUMBER
SKIPN RDR,JOBPAG(T4) ;GET ADDRESS OF DATA
$RETF ;FOUND,,BUT NOT REALLY THERE,,TOO BAD
MOVE FLAG,.RDREG+FLAG(RDR) ;GET HIS 'FLAGS'
$RETT ;AND RETURN
SUBTTL UPDTST - ROUTINE TO SEND READER STATUS INFORMATION TO QUASAR
;CALL: PUSHJ P,UPDTST
;
;RETURN: ALWAYS TRUE +1
UPDTST: MOVEI S1,MSGBLK ;GET THE SOON TO BE MSG BLOCK ADDRESS
MOVE S2,JOBPAG(STREAM) ;GET THE DATA BASE PAGE ADDRESS
SETZM .RDSTS(S2) ;CLEAR STATUS MSG FLAG WORD
HRLZ S2,JOBOBA(STREAM) ;GET THE STREAM'S OBJ BLOCK ADDRESS
HRRI S2,STU.RB(S1) ;GET THE DESTINATION ADDRESS
BLT S2,STU.RB+OBJ.SZ-1(S1) ;COPY THE OBJ BLK OVER
SETZM .MSCOD(S1) ;NO ACK CODE
SETZM .MSFLG(S1) ;NO FLAG BITS
$CALL GSTS ;Get the status
MOVEI S1,MSGBLK ;Get the message block address again
STORE S2,STU.CD(S1) ;SAVE THE STATUS CODE
MOVX S2,.QOSTU ;GET THE MESSAGE TYPE
STORE S2,.MSTYP(S1),MS.TYP ;SAVE IT IN THE MSG
MOVX S2,STU.SZ ;GET THE MSG LENGTH
STORE S2,.MSTYP(S1),MS.CNT ;SAVE IT IN THE MSG
PJRST SNDQSR ;SEND IT OFF TO QUASAR
SUBTTL GSTS - Routine to get the status of a stream
;This is a routine since the status must be obtained either
;by the superior fork (always for T10) or by the inferior fork
;for sending the status message.
;CALL: RDR contains the address of stream
;Returns: S2 / Status
GSTS: MOVX S2,%IDLE ;Default to idle
MOVE S1,FLAG+.RDREG(RDR) ;Get the flag word for the
;stream
TXNN S1,JOBCD ;In a job?
JRST [MOVE S1,JOBSTW ;No, offline doesn't matter
JRST GSTS.1] ;Skip offline checks
MOVX S2,%READN ;Yes in a job, we should be reading
SKIPE .RDOFL(RDR) ;Are we offline?
MOVX S2,%OFLNE ;Yes.
MOVE S1,JOBSTW(STREAM) ;GET THE JOB STATUS BITS
TXNE S1,PSF%DO ;ARE WE OFFLINE ???
MOVX S2,%OFLNE ;YES,,THEN WE ARE REALLY OFFLINE
GSTS.1: TXNE S1,PSF%ST ;ARE WE STOPPED BY THE OPERATOR
MOVX S2,%STOPD ;YES,,THEN SAY SO
TXNE S1,PSF%OR ;Are we waiting for OPR response?
MOVX S2,%OREWT ;Then say so.
$RET ;And return
SUBTTL SNDQSR - ROUTINE TO SEND A MESSAGE TO QUASAR.
;CALL: S1/ The message address
; S2/ The message length
;
;RET: TRUE if sent successfully
; Stopcode 'QSF' if the send fails
;
OPRMSG: TDZA TF,TF ;FLAG SEND ORION ENTRY POINT
SNDQSR: SETOM TF ;FLAG SEND QUASAR ENTRY POINT
MOVEM S1,SAB+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVEM S2,SAB+SAB.LN ;SAVE THE MESSAGE LENGTH
MOVX S1,SP.QSR ;GET QUASAR FLAG
SKIPN TF ;UNLESS WE WANT TO THEN TO THE OPERATOR
MOVX S1,SP.OPR ; THEN GET OPERATOR INDEX
TXO S1,SI.FLG ;SET SPECIAL INDEX FLAG
STORE S1,SAB+SAB.SI ;AND STORE IT
SETZM SAB+SAB.PD ;CLEAR THE PID WORD
MOVEI S1,SAB.SZ ;LOAD THE SIZE
MOVEI S2,SAB ;AND THE ADDRESS
PUSHJ P,C%SEND ;SEND THE MESSAGE
JUMPT .RETT ;AND RETURN
$STOP(QSF,Send to QUASAR FAILED)
TOPS20 <
SUBTTL IDLE LOOP
MAIN: SETZM RDSCHD ;SLEEP AFTER THIS PASS
PUSHJ P,CHKQUE ;GO CHECK THE MESSAGE QUEUE
PUSHJ P,CHKFRK ;GO CHECK FOR FORK TERMINATION
SKIPE RDSCHD ;DO WE WANT A SCHEDULING PASS ???
JRST MAIN ;YES,,GO CHECK AGAIN
SETZM S1 ;SLEEP TILL WE'RE NEEDED
PUSHJ P,I%SLP ;NO,,GO TO SLEEEEEEEEEEEPPPPP
JRST MAIN ;GO CHECK TO MESSAGE QUEUE
SUBTTL CHKFRK - ROUTINE TO PROCESS INFERIOR FORK TERMINATION
CHKFRK: SKIPN TRMFRK ;DID ANY FORK GO AWAY ???
JRST CHKF.4 ;NO,,GO CHECK FOR FORK INITIALIZATION
SETOM RDSCHD ;SCHEDULE ANOTHER PASS
SETZM TRMFRK ;ZERO FORK TERMINATION FLAG
MOVSI P1,-MAXRDR ;MAKE AN AOBJN AC
CHKF.1: SKIPN RDR,JOBPAG(P1) ;IS THIS STREAM ACTIVE ???
JRST CHKF.3 ;NO,,TRY THE NEXT ONE
MOVE S1,.RDHND(RDR) ;GET THE PROCESS HANDLE
RFSTS ;GET THE FORK STATUS
ERJMP CHKF.A ;IGNORE ANY ERRORS
TXZ S1,RF%FRZ ;CLEAR THE FROZEN FORK BIT
HLRZ S1,S1 ;MOVE LEFT TO RIGHT AND ZERO LEFT
CAIE S1,.RFHLT ;IS THIS FORK HALTED ???
CAIN S1,.RFFPT ;HERE TOO !
SKIPA ;YES TO EITHER,,CONTINUE ON
JRST CHKF.3 ;ELSE TRY NEXT FORK
SKIPE .RDSHT(RDR) ;DID THIS READER SHUTDOWN ???
JRST CHKF.2 ;YES,,SHUT IT DOWN
SKIPGE .RDSTP(RDR) ;Do we need to find error?
JRST [$WTO (<^B/@JOBOBA(P1)/ Terminated>,,,<$WTFLG(WT.SJI)>)
JRST CHKF.A]
HRROI S1,.RDSTP(RDR) ;POINT TO ERROR BUFFER
HRLOI S2,@.RDHND(RDR) ;ELSE GET FORK HANDLE,,-1
SKIPE .RDSTP(RDR) ;IS THERE ANY ERROR CODE ???
HRR S2,.RDSTP(RDR) ;YES,,GET FORK HANDLE,,ERROR CODE
MOVE T1,[-^D49,,0] ;GET -LENGTH,,0
ERSTR ;CONVERT ERROR TO A STRING
ERJMP .+2 ;IGNORE THIS ERROR
ERJMP .+1 ;AND THIS ONE
$WTO (<^B/@JOBOBA(P1)/ Terminated>,<Reason: ^T/.RDSTP(RDR)/>,,<$WTFLG(WT.SJI)>)
; Here if in error
CHKF.A: SKIPE DEBUGW ;Are we debugging?
JRST CHKF.3 ;Yes, both that and in error,
;do not delete the fork.
CHKF.2: SETZM .RDSTP(RDR) ;Clear the error
HRRZM P1,STREAM ;SAVE THE STREAM NUMBER
MOVX S1,%RSUDE ;Device doesn't exist
PUSHJ P,SHUTUP ;Shut down the fork
CHKF.3: AOBJN P1,CHKF.1 ;GO CHECK THE NEXT FORK
;Here to Check to see if any fork is finished initialization.
CHKF.4: SKIPN FRKINI ;ANY FORK END ITS INITIALIZATION ???
$RETT ;NO,,JUST RETURN
SETOM RDSCHD ;YES,,SCHEDULE ANOTHER PASS
SETZM FRKINI ;ZERO FORK TERMINATION FLAG
MOVSI P1,-MAXRDR ;MAKE AN AOBJN AC
CHKF.5: SKIPE RDR,JOBPAG(P1) ;IS THIS READER SETUP ???
SKIPN .RDINI(RDR) ;YES,,INITIALIZATION FLAG LIT ???
JRST CHKF.6 ;NO,,TRY NEXT
HRRZM P1,STREAM ;SAVE OUR STREAM NUMBER
SETZM .RDINI(RDR) ;CLEAR THE INITIALIZATION FLAG
MOVX S1,%RSUOK ;GET RESPONSE TO SETUP CODE (OK)
IFN FTDN60,<
SKIPLE .RDREM(RDR) ;DN60?
$CALL FIXPRO ;Yes, fix the data base
> ;End of FTDN60
PUSHJ P,RSETUP ;SEND THE RESPONSE TO SETUP MESSAGE
IFN FTDN60,<
SKIPLE .RDREM(RDR) ;DN60?
$CALL FIXPRO ;Yes, fix the data base back
> ;End of FTDN60
CHKF.6: AOBJN P1,CHKF.5 ;GO CHECK THE NEXT RDR
$RETT ;RETURN WHEN DONE
SUBTTL RDINIT - ROUTINE TO INITIALIZE READER CONSTANTS
RDINIT: PUSHJ P,I%HOST ;GET OUR HOST NAME
MOVEM S1,CNTSTA ;SAVE THE SIXBIT NODE NAME
SKIPE 135 ;ARE WE DEBUGGING
SKIPN 116 ;AND ARE SYMBOLS DEFINED ???
JRST RDIN.1 ;NO TO EITHER,,SKIP THIS
HLRO S1,116 ;GET AOBJN LENGTH
MOVMS S1 ;GET ABSOLUTE VALUE
HRRZ S2,116 ;GET SYMBOL TABLE START ADDRESS
ADDI S1,-1(S2) ;CALC SYMBOL TABLE LENGTH
SKIPA ;SKIP OVER NORMAL CALC
RDIN.1: HLRZ S1,.JBSA## ;GET THE PROGRAM END ADDRESS
ADDI S1,777 ;ROUND IT OFF
ADR2PG S1 ;MAKE IT A PAGE NUMBER
MOVEM S1,RDRSIZ ;SAVE IT
$RETT ;RETURN
SUBTTL INPGET - ROUTINE TO SETUP THE READER FORK
INPGET: MOVE S1,JOBOBA(STREAM) ;GET THE OBJECT BLOCK ADDRESS
SKIPN .RDREM(RDR) ;IS THIS A LOCAL READER ???
$TEXT (<-1,,.RDRFD(RDR)>,<PCDR^O/OBJ.UN(S1)/:^0>) ;YES,,GEN DEV NAME
SKIPGE .RDREM(RDR) ;OR IS IT A REMOTE READER ???
$TEXT (<-1,,.RDRFD(RDR)>,<^W/OBJ.ND(S1)/::PCDR^O/OBJ.UN(S1)/:^0>)
MOVX S1,<CR%CAP+CR%ACS> ;SUPERIOR CAPS AND AC'S
MOVEI S2,.RDREG(RDR) ;AC LOAD BUFFER
CFORK ;CREATE A SPOOLER
ERJMP FRKERR ;ON ERROR,,GO PROCESS IT
MOVEM S1,.RDHND(RDR) ;SAVE THE INFERIOR HANDLE
MOVSI S1,.FHSLF ;GET MY HANDLE
HRLZ S2,.RDHND(RDR) ;GET THE SPOOLER HANDLE
HRR T1,RDRSIZ ;GET THE LENGTH IN PAGES
HRLI T1,(PM%RWX!PM%CNT) ;COUNT+READ+EXECUTE
PMAP ;MAP THE PAGES
ERJMP PMPERR ;ON ERROR,,GO PROCESS IT
MOVE S1,RDR ;GET THE DATA BASE ADDRESS
ADR2PG S1 ;CONVERT IT TO A PAGE NUMBER
MOVE S2,S1 ;SAVE IT IN S2
HRLI S1,.FHSLF ;GET MY HANDLE
HRL S2,.RDHND(RDR) ;GET THE SPOOLER HANDLE
HRRI T1,DBSIZE ;GET THE PAGE COUNT
HRLI T1,(PM%RWX!PM%CNT) ;R,W,E + COUNT
PMAP ;MAP THE DATA BASE
ERJMP PMPERR ;ON ERROR,,GO PROCESS IT
MOVE S1,.RDHND(RDR) ;GET THE SPOOLER HANDLE
MOVEI S2,DOJOB ;GET THE START ADDRESS
SFORK ;START THE SPOOLER
ERJMP FRKERR ;ON ERROR,,PROCESS IT
MOVX S1,%RSUOK
$RETT ;AND RETURN
FRKERR: $WTO (Cant create a Fork,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
MOVX S1,%RSUDE ;GET THE ERROR CODE
$RETT ;AND RETURN
PMPERR: $WTO (Cant PMAP Spooler Pages,,@JOBOBA(STREAM)) ;TELL THE OPERATOR
MOVX S1,%RSUDE ;GET THE ERROR CODE
$RETT ;AND RETURN
SUBTTL OACPAU - ROUTINE TO STOP A READER
OACPAU: MOVE S1,.RDHND(RDR) ;GET THE SPOOLER HANDLE
FFORK ;FREEZE THE FORK
ERJMP OACC.1 ;IF AN ERROR,,PROCESS IT
$ACK (Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
MOVX S2,PSF%ST ;GET 'STOPPED' BIT
IORM S2,JOBSTW(STREAM) ;SET IT
PUSHJ P,UPDTST ;SEND A STATUS MESSAGE
$RETT ;AND RETURN
OACC.1: $ACK (Cannot Be Stopped,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
$RETT ;AND RETURN
SUBTTL OACCON - ROUTINE TO CONTINUE A READER
OACCON: MOVE S1,.RDHND(RDR) ;GET THE SPOOLER HANDLE
RFORK ;RESTART THE SPOOLER
ERJMP OACC.2 ;IF AN ERROR,,GO PROCESS
$ACK (Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
MOVX S2,PSF%ST ;GET THE 'STOPPED' BIT
ANDCAM S2,JOBSTW(STREAM) ;CLEAR IT
MOVE S1,.RDHND(RDR) ;GET THE FORKS HANDLE
MOVX S2,<1B1> ;WANT CHANNEL 1
IIC ;TELL FORK TO SEND STATUS
$RETT ;AND RETURN
OACC.2: $ACK (Cannot Be Continued,,@JOBOBA(STREAM),.MSCOD(M)) ;TELL THE OPERATOR
$RETT ;AND RETURN
SUBTTL OACCAN - ROUTINE TO CANCEL THE CURRENT JOB ON THE READER
OACCAN: MOVE S1,.RDHND(RDR) ;GET THE FORKS HANDLE
MOVX S2,<1B2> ;GET CHANNEL 2
IIC ;TELL THE FORK TO CANCEL THE JOB
$RETT ;AND RETURN
SUBTTL OACSHT - ROUTINE TO SHUTDOWN THE CARD READER
OACSHT: MOVE S1,.RDHND(RDR) ;GET THE FORKS HANDLE
MOVX S2,<1B3> ;GET CHANNEL 3
IIC ;TELL THE FORK TO SHUTDOWN
ERJMP .RETT ;ON AN ERROR,,RETURN OK
$RETF ;AND RETURN
SUBTTL INTERRUPT ROUTINES
LEVTAB: EXP LEV1PC ;INTRPT LEVEL 1 PC ADDRESS
EXP LEV2PC ;INTRPT LEVEL 2 PC ADDRESS
EXP LEV3PC ;INTRPT LEVEL 3 PC ADDRESS
CHNTAB: XWD 1,INTIPC ;IPCF INTERRUPT ON CHANNEL 0
XWD 1,INTFKI ;FORK INITIALIZATION END INTERRUPT
BLOCK ^D34 ;INFERIOR PROCESS TERM ON CHNL 19
;ALL OTHER CHANNELS 0
LEV1PC: BLOCK 1 ;LEVEL 1 INTERRUPT PC
LEV2PC: BLOCK 1 ;LEVEL 2 INTERRUPT PC
LEV3PC: BLOCK 1 ;LEVEL 3 INTERRUPT PC
INTINI: MOVE S1,[1,,ENDFRK] ;SET UP INFERIOR FORK TERM PARMS
MOVEM S1,CHNTAB+.ICIFT ; IN THE CHANNEL TABLE
MOVX S1,.FHSLF ;GET MY HANDLE
MOVX S2,1B0+1B1+1B19 ;GET CHNL 0 (IPCF)+CHNL 19 (FORK TERM)
AIC ;ACTIVATE CHANNEL 0 AND 1 AND 19
$RETT ;RETURN
INTIPC: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
PUSHJ P,C%INTR ;FLAG THE IPCF INTERRUPT
$DEBRK ;AND LEAVE INTERRUPT LEVEL
ENDFRK: $BGINT 1, ;INTIALIZE INTERRUPT LEVEL
SETOM TRMFRK ;INDICATE WE DID THIS
$DEBRK ;AND LEAVE INTERRUPT LEVEL
INTFKI: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
SETOM FRKINI ;FLAG THE INTERRUPT
$DEBRK ;AND LEAVE INTERRUPT LEVEL
SUBTTL INPREL - ROUTINE TO RELEASE A CARD READER
INPREL: MOVE S1,.RDHND(RDR) ;GET THE SPOOLER HANDLE
KFORK ;KILL THE FORK
ERJMP .+1 ;IGNORE ANY ERRORS
$RETT ;AND RETURN
SUBTTL SPOOLER - CARD READER SPOOLER FORK ROUTINE START ADDRESS
RDRIB: $BUILD IB.SZ ;
$SET (IB.PRG,,%%.MOD) ;PROGRAM 'CDRIVE'
$SET (IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$SET (IB.PIB,,RDRPIB) ;SET UP PIB ADDRESS
$SET(IB.INT,,<LEVTBL,,CHNTBL>) ;SETUP INTERRUPT VECTOR
$EOB ;
RDRPIB: $BUILD PB.MNS ;
$SET (PB.HDR,PB.LEN,PB.MNS) ;
$EOB ;
DOJOB: MOVEI S1,IB.SZ ;GET THE IB SIZE
MOVEI S2,RDRIB ;GET THE IB ADDRESS
PUSHJ P,I%INIT ;GO MAP THE LIBRARY
SKIPE 135 ;ARE WE DEBUGGING ???
PUSHJ P,GETDDT ;YES,,GO LOAD DDT AND WAIT
MOVEI S1,.RDFD(RDR) ;GET THE FD ADDRESS
MOVEM S1,.RDFOB+FOB.FD(RDR) ;SAVE IT IN THE FOB
MOVE S1,.RDOBZ(RDR) ;GET THE OUTPUT BYTE SIZE
STORE S1,.RDFOB+FOB.CW(RDR),FB.BSZ ;SAVE IT IN THE FOB
MOVEI S1,1 ;GET A BIT
STORE S1,.RDFOB+FOB.CW(RDR),FB.NFO ;WANT 'NEW FILE ONLY' !!
MOVX S1,.FHSLF ;GET MY HANDLE
RPCAP ;GET MY CAPABILITIES
ERCAL INTERR ;STOP ON AN ERROR
MOVE T1,S2 ;WANT ALL AVAILABLE CAPABILITIES
MOVX S1,.FHSLF ;GET MY HANDLE
EPCAP ;ENABLE ALL CAPABILITIES
ERCAL INTERR ;STOP ON AN ERROR
IFN FTDN60,<
MOVEI S1,SERFLG ;Indicate need for SYSERR
SKIPLE .RDREM(RDR) ;Is this one a DN60?
$CALL D60INI## ;Yes, initialize the DN60 database
> ; End of FTDN60 conditional
PUSHJ P,OPENIT ;GO OPEN THE READER
MOVE S1,.RDSTR(RDR) ;GET THE STREAM NUMBER
$WTO (Started,,@JOBOBA(S1)) ;TELL THE OPERATOR
;SETUP THE UPDATE STATUS MESSAGE (ONCE ONLY)
MOVE S1,[STU.SZ,,.QOSTU] ;GET STATUS MSG LENGTH,,TYPE
MOVEM S1,.RDMSG+.MSTYP(RDR) ;SAVE IT
MOVE S1,.RDSTR(RDR) ;GET OUR STREAM NUMBER
HRLZ S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
HRRI S1,.RDMSG+STU.RB(RDR) ;GET THE DESTINATION ADDRESS
BLT S1,.RDMSG+STU.RB+OBJ.SZ-1(RDR) ;COPY THE OBJ BLK OVER
SETOM .RDSTS(RDR) ;LETS TRY IT FIRST CHANCE WE GET
MOVEI S1,ERTCNT ;GET A MAX ERROR COUNT
MOVEM S1,.RDECT(RDR) ;SAVE IT JUST IN CASE WE NEED IT
JRST MAINRT ;GO PROCESS
SUBTTL MAINRT - ROUTINE TO INPUT AND PROCESS CARDS
MAINRT: MOVE S1,.RDCHN(RDR) ;GET THE JFN
HRLZ S2,.RDIBZ(RDR) ;GET THE INPUT BYTE SIZE
LSH S2,6 ;POSITION IT
ADD S2,[POINT 0,.CARDS(RDR)] ;CREATE THE BYTE POINTER
MOVE T1,[EXP -CRDNBR] ;GET THE NUMBER OF CARDS TO READ
IMUL T1,.RDRCL(RDR) ;MULTIPLY BY RECORD LENGTH
PUSHJ P,$SIN ;GET A BATCH OF CARDS
JUMPT MAIN.1 ;WE WIN,,SO CONTINUE
MOVE P1,S2 ;SAVE THE OUTPUT BYTE POINTER
MOVE P2,T1 ;SAVE THE BYTE COUNT
PUSHJ P,$GTSTS ;GO SET THE READER STATUS
PUSHJ P,$GETER ;READ THE ERROR STATUS BITS
MOVE T1,P2 ;RESTORE THE NUMBER OF BYTES READ
CAXE S1,OPNX8 ;IS IT DEVICE OFFLINE ???
CAXN S1,IOX5 ; OR WAS IT AN I/O ERROR ???
JRST MAIN.1 ;YES,,GO PROCESS IT
CAXE S1,IOX4 ;WAS IT EOF ???
PJRST INTERR ;NO,,THEN A FATAL ERROR
TXO FLAG,EOF ;INDICATE AN EOF CONDITION OCCURED
PUSHJ P,RESDEV ;ON EOF,,GO CLOSE AND RE-OPEN THE RDR
MOVE S1,ENDIMG(AP) ;GET AN EOF BYTE
IDPB S1,P1 ;MAKE AN EOF CARD
MOVE T1,P2 ;GET THE NUMBER OF BYTES READ
ADD T1,.RDRCL(RDR) ;ADD 1 MORE CARD LENGTH
MAIN.1: MOVE S1,.RDRCL(RDR) ;GET THE RECORD LENGTH
IMULI S1,CRDNBR ;CALC # OF BYTES TO BE READ
ADD T1,S1 ;CALC # OF BYTES READ
IDIV T1,.RDRCL(RDR) ;CALC # OF CARDS READ
MOVEM T1,.RDNBR(RDR) ;SAVE IT
SKIPE T1 ;NO CARDS,,DONT PROCESS
PUSHJ P,READER ;GO PROCESS THE CARDS
SKIPG .RDREM(RDR) ;IS THIS A DN60 READER ???
PUSHJ P,CHKOFL ;NO,,GO CHECK FOR OFFLINE'NESS
PUSHJ P,CHKSTS ;GO CHECK OUR STATUS
SETZM S1 ;SLEEP TILL WE'RE NEEDED
SKIPE .RDOFL(RDR) ;IS THE READER OFFLINE ???
PUSHJ P,I%SLP ;YES,,JUST SLEEEEEEP
JRST MAINRT ;ELSE,,GO PROCESS SOME MORE CARDS
SUBTTL GENFIL - ROUTINE TO GENERATE A SPOOL FILENAME
GENFIL: MOVEI S1,.RDFD(RDR) ;GET THE FD ADDRESS
MOVEI S2,10 ;GET THE FD LENGTH
STORE S2,.FDLEN(S1),FD.LEN ;SAVE IT IN THE FD
AOS S2,FILENM ;BUMP HASH COUNT BY 1,,PUT IN S2
$TEXT (<-1,,.FDSTG(S1)>,<^T/SPL/RD^D4L0/S2,FILEMK/-^D3R0/FILEXT/>)
$RETT ;AND RETURN
RESDEV: SKIPLE .RDREM(RDR) ;IS THIS A DN60 DEVICE ???
$RETT ;YES,,RETURN
MOVE S1,.RDCHN(RDR) ;GET THE JFN
TXO S1,CZ%ABT ;ABORT ANY INPUT PROCESSING
PUSHJ P,$CLOSF ;CLOSE THE READER DOWN
JUMPF OPNERR ;NO,,STOP ON AN ERROR
;FALL INTO READER OPEN CODE
OPENIT: $CALL SETINT ;Set up the interrupts
MOVX S1,GJ%SHT+GJ%PHY ;SHORT JFN+PHYSICAL UNIT
HRROI S2,.RDRFD(RDR) ;GET THE DEVICE ADDRESS
PUSHJ P,$GTJFN ;GET A JFN
JUMPF OPNERR ;STOP ON AN ERROR
MOVEM S1,.RDCHN(RDR) ;SAVE THE JFN
MOVX S2,^D16B5+10B9+OF%RD+OF%HER+OF%OFL ;16 BIT BYTES+IMAGE MODE+
PUSHJ P,$OPENF ;OPEN THE READER
JUMPF OPNERR ;STOP ON AN ERROR
$CALL COMINT ;Turn on reader interrupt
PUSHJ P,$GTSTS ;GO GET THE READER STATUS
MOVE S1,.RDSTA(RDR) ;GET THE DEVICE STATUS BITS
TXNE S1,MO%FNX ;DOES THE DEVICE REALLY EXIST ???
JRST [MOVX S1,DIAGX8 ;NO,,GET 'DEVICE DOESN'T EXIST' CODE
MOVEM S1,.RDSTP(RDR) ;SAVE IT IN OUR DATA BASE
HALTF ] ;WE'RE DONE FOR !!!
TXNE FLAG,EOF ;HERE BECAUSE OF DEVICE EOF ???
$RETT ;YES,,JUST RETURN
SETOM .RDINI(RDR) ;FLAG END OF INITIALIZATION
MOVX S1,.FHSUP ;WANT SUPERIOR PROCESS
MOVX S2,<1B1> ;GET CHANNEL
IIC ;TELL SUPERIOR TO SEND RSP MSG TO QUASAR
ERCAL OPNERR ;CAN'T,,OH WELL !!!
$RETT ;OK,,RETURN
SPL: ASCIZ/PS:<SPOOL>/
SUBTTL CHKOFL - ROUTINE TO CHECK LOCAL/REMOTE OFFLINE STATUS
CHKOFL: SKIPN .RDOFL(RDR) ;ARE WE OFFLINE ???
$RETT ;NO,,JUST RETURN
MOVE S1,.RDSTR(RDR) ;GET OUR STREAM NUMBER
TXNE FLAG,JOBCD ;DO WE HAVE A JOB CARD ???
$WTO (Offline,,@JOBOBA(S1)) ;TELL THE OPERATOR ITS OFFLINE
$RETT ;AND RETURN
SUBTTL CHKSTS - ROUTINE TO PROCESS THE DIFFERENT STATUS INTERRUPTS
CHKSTS:
; PUSHJ P,GETHSP ;GO READ THE HASP CONSOLE (IF NEEDED)
; Now done as part of SIN.6
SKIPE .RDSTS(RDR) ;DO WE WANT TO SEND A STATUS UPDATE ??
PUSHJ P,SNDSTS ;YES,,DO IT
SKIPN .RDCAN(RDR) ;DO WE WANT TO CANCEL THIS GUY ???
JRST CHKS.1 ;NO,,CONTINUE ON
SETZM .RDCAN(RDR) ;CLEAR THE CANCEL FLAG
TXZ FLAG,JOBCD ;CLEAR THE JOBCARD FLAG
MOVEM FLAG,FLAG+.RDREG(RDR) ;Let the superior know
SETOM .RDSTS(RDR) ;Say we want status update
MOVE S1,.RDSTR(RDR) ;GET THE STREAM NUMBER
$WTOJ (Current Job Canceled,,@JOBOBA(S1)) ;TELL THE OPERATOR
CHKS.1: SKIPE .RDSHT(RDR) ;DO WE WANT TO SHUT DOWN?
TXNE FLAG,JOBCD ;ARE WE PROCESSING A JOB ???
$RETT ;NO or YES,,RETURN
MOVE S1,.RDCHN(RDR) ;Get JFN
$CALL $CLOSF ;Close the reader
HALTF ;KILL THE FORK
SUBTTL GETDDT - ROUTINE TO LOAD DDT IF WE ARE DEBUGGING
GETDDT: MOVX S1,GJ%OLD+GJ%SHT ;OLD FILE+SHORT JFN
HRROI S2,[ASCIZ/SYS:SDDT.EXE/] ;WANT DDT IN HERE TOO
GTJFN ;GET DDT'S JFN
ERCAL INTERR ;CANT,,TOO BAD !!
HRLI S1,.FHSLF ;GET MY HANDLE
GET ;LOAD DDT
ERCAL INTERR ;CANT LOAD IT,,TOO BAD !!
MOVE S1,116 ;GET CONTENTS OF .JBSYM
HRRZ S2,770001 ;GET ADDRESS OF WHERE TO PUT IT
MOVEM S1,0(S2) ;POINT DDT AT MY SYMBOL TABLE
JRST 770000 ;AND ENTER DDT
GO: $RETT ;RETURN
SUBTTL SENDIT - ROUTINE TO SEND IPCF MESSAGES TO QUASAR
;CALL: S1/ THE MESSAGE ADDRESS
; S2/ THE MESSAGE LENGTH
;
;RET: TRUE ALWAYS
SNDOPR: TDZA TF ;ZAP ENTRY FLAG WORD AND SKIP
SENDIT: SETOM TF ;SET ENTRY FLAG WORD AND CONTINUE
MOVEM S1,.RDSAB+SAB.MS(RDR) ;SAVE THE MESSAGE ADDRESS
MOVEM S2,.RDSAB+SAB.LN(RDR) ;SAVE THE MESSAGE LENGTH
MOVX S1,SP.QSR ;GET QUASAR'S SPECIAL INDEX
SKIPN TF ;CHECK ENTRY FLAG; IS IT OPR ENTRY POINT
MOVX S1,SP.OPR ;YES,,GET ORIONS SPECIAL INDEX
TXO S1,SI.FLG ;SET SPECIAL INDEX FLAG
MOVEM S1,.RDSAB+SAB.SI(RDR) ;SAVE THE RECIEVERS ID
SETZM .RDSAB+SAB.PD(RDR) ;CLEAR THE PID WORD
MOVEI S1,PIB ;GET SUPERIORS PIB ADDRESS
MOVEM S1,.RDSAB+SAB.PB(RDR) ;SAVE IT FOR 'IN BEHALF OF' SEND
MOVEI S1,SAB.SZ ;GET THE SAB LENGTH
MOVEI S2,.RDSAB(RDR) ;GET THE SAB ADDRESS
PUSHJ P,C%SEND ;SEND IT TO QUASAR
JUMPT .RETT ;RETURN IF OK
$CALL INTERR ;Else log the error and do not return
SUBTTL SNDSTS - ROUTINE TO SEND READER STATUS UPDATES TO QUASAR
SNDSTS: SETZM .RDSTS(RDR) ;CLEAR SEND STATUS FLAG
$CALL GSTS ;Get the status
STORE S2,.RDMSG+STU.CD(RDR) ;SAVE THE READER STATUS
MOVEI S1,.RDMSG(RDR) ;GET THE MESSAGE ADDRESS
MOVEI S2,STU.SZ ;GET THE MESSAGE LENGTH
PUSHJ P,SENDIT ;SEND IT TO QUASAR
$RETT ;AND RETURN
SUBTTL SETINT - ROUTINE TO SETUP PROCESS INTERRUPTS
;INTERRUPT DATA BASE
LEVTBL: EXP LVL1PC ;INTRPT LEVEL 1 PC ADDRESS
EXP LVL2PC ;INTRPT LEVEL 2 PC ADDRESS
EXP LVL3PC ;INTRPT LEVEL 3 PC ADDRESS
CHNTBL: XWD 1,CDRINT ;ONLINE/OFFLINE ON CHANNEL 0
XWD 1,STSINT ;UPDATE STATUS INTRPTS ON CHANL 1
XWD 1,CANINT ;CANCEL JOB INTRPTS ON CHANL 2
XWD 1,SHTINT ;SHUTDOWN READER INTRPTS ON CHANL 3
BLOCK ^D35 ;ALL OTHER CHANNELS 0
LVL1PC: BLOCK 1 ;LEVEL 1 INTRPT PC
LVL2PC: BLOCK 1 ;LEVEL 2 INTRPT PC
LVL3PC: BLOCK 1 ;LEVEL 3 INTRPT PC
SETINT: MOVX S1,.FHSLF ;GET THE PROCESS HANDLE
SETOM S2 ;DISABLE ALL 36 CHANNELS
DIC ;LETERRIP
ERCAL INTERR ;ON ERROR,,HALT
CIS ;CLEAR THE INTERRUPT SYSTEM
MOVX S1,.FHSLF ;GET MY PROCESS HANDLE
MOVE S2,[LEVTBL,,CHNTBL] ;GET PRTY LEVEL,,CHANNEL
SIR ;SETUP THE MONITOR INTRPT TABLE ADDRS
ERCAL INTERR ;ON ERROR,,HALT
MOVX S1,.FHSLF ;GET MY PROCESS HANDLE
EIR ;ENABLE THE INTERRUPT SYSTEM
ERCAL INTERR ;ON ERROR,,HALT
MOVX S1,.FHSLF ;Get my process handle
MOVX S2,1B1+1B2+1B3 ;Activate all channels but
;online/offline channel
AIC ;Activate the channels
ERCAL INTERR ;On error, HALT
$RET ;Just return
COMINT:
; This routine completes the interrupt system for the inferior fork.
; It adds the ONLINE/OFFLINE channel.
IFN FTDN60,<
SKIPLE .RDREM(RDR) ;Is it DN60?
$RET ;Yes, nothing further to do
> ; End of FTDN60
; Place ONLINE/OFFLINE on channel 0
MOVE S1,.RDCHN(RDR) ;GET THE JFN
MOVX S2,.MOPSI ;FUNCTION: ADD TO INTRPT SYSTEM
MOVEI T1,T2 ;ARGUMENT BLOCK ADDRESS
MOVEI T2,3 ; "" "" LENGTH
MOVEI T3,0 ;INTERRUPTS ON CHANNEL 0
MOVX T4,MO%MSG ;NO MESSAGE
PUSHJ P,$MTOPR ;ADD TO THE INTERRUPT SYSTEM
JUMPF INTERR ;ON AN ERROR,,STOP
; Now add the channel to the interrupt system
MOVX S1,.FHSLF ;GET MY PROCESS HANDLE
MOVX S2,1B0 ;Only channel 0
AIC ;Activate channel 0
ERCAL INTERR ;ON ERROR,,HALT
$RET ;RETURN
INTERR:
OPNERR: SKIPE .RDSTP(RDR) ;Previous error generated?
JRST INTE.1 ;Yes, skip this
MOVX S1,.FHSLF ;GET MY HANDLE
SETZM S2 ;CLEAR S2 (RESULT)
GETER ;GET THE LAST ERROR CODE
HRRZM S2,.RDSTP(RDR) ;Save only the error code
INTE.1: HALTF ;END IT ALL
SUBTTL INTERRUPT ROUTINES
;READER ONLINE/OFFLINE INTERRUPT ROUTINE
CDRINT: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
SETOM .RDSTS(RDR) ;WANT A STATUS UPDATE MSG SENT
MOVE S1,.RDCHN(RDR) ;GET THE JFN
MOVX S2,.MORST ;READ DEVICE STATUS FUNCTION
MOVEI T1,T2 ;ARGUMENT BLOCK ADDRESS
MOVEI T2,2 ;ARGUMENT BLOCK LENGTH
SETZ T3, ;DEVICE STATUS
PUSHJ P,$MTOPR ;GET THE READER STATUS
MOVEM T3,.RDSTA(RDR) ;SAVE THE DEVICE STATUS BITS
SETZM .RDOFL(RDR) ;ASSUME WE ARE ON-LINE !!!
TXNE T3,MO%OL ;IS THE READER OFFLINE ???
SETOM .RDOFL(RDR) ;IF OFFLINE,,SAY SO.
SKIPE .RDREM(RDR) ;IF REMOTE,,
JRST CDRI.1 ; THEN SKIP THIS LOCAL STUFF
MOVEI S1,.RETT ;GET OFFLINE EXIT ADDRESS
SKIPE .RDIOA(RDR) ;WERE WE I/O ACTIVE ???
MOVEM S1,LVL1PC ;YES,,SAVE IT FOR DEBRK
CDRI.1: SETZM .RDIOA(RDR) ;CLEAR I/O ACTIVE
$DEBRK ;DISMISS THE INTERRUPT.
;UPDATE READER STATUS INTERRUPT ROUTINE
STSINT: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
SETOM .RDSTS(RDR) ;SAY WE WANT A STATUS UPDATE MSG SENT
$DEBRK ;LEAVE INTERRUPT LEVEL
;JOB CANCEL INTERRUPT ROUTINE
CANINT: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
SETOM .RDCAN(RDR) ;SAY WE WANT TO CANCEL THE CURRENT JOB
$DEBRK ;LEAVE INTERRUPT LEVEL
;CARD READER SHUTDOWN INTERRUPT ROUTINE
SHTINT: $BGINT 1, ;INITIALIZE INTERRUPT LEVEL
SETOM .RDSHT(RDR) ;SAY WE WANT TO SHUT DOWN
$DEBRK ;LEAVE INTERRUPT LEVEL
SUBTTL LOCAL/REMOTE I/O SUBROUTINES
$GTSTS: SKIPLE .RDREM(RDR) ;IS THIS A LOCAL OR DN200 CDR ???
$RETT ;NO, SO DN60, SO RETURN
MOVX S1,.FHSLF ;YES,,GET MY HANDLE
MOVX S2,<1B0> ;WANT CHANNEL 0
IIC ;FORCE INTERRUPT ON ONLINE/OFFLINE CHNL
ERJMP .+1 ;IGNORE ANY ERROR
$RETT ;AND RETURN
$GETER: SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS THIS A DN200 READER ???
JRST GETE.2 ;YES,,MUST BE DN200
JRST GETE.6 ] ;NO,,MUST BE DN60
MOVX S1,.FHSLF ;GET MY HANDLE
GETER ;GET THE LAST ERROR CODE
HRRZ S1,S2 ;PUT IT INTO S1
$RETT ;AND RETURN
$SIN: SETOM .RDIOA(RDR) ;MARK I/O ACTIVE
SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS IT THE DN200 READER ???
JRST SIN.2 ;YES,,GO PROCESS IT
JRST SIN.6 ] ;NO,,MUST BE DN60 READER
SKIPE .RDOFL(RDR) ;IS THE READER OFFLINE ???
JRST SIN.T ;YES,,JUST RETURN
SIN ;FINALLY READ THE DATA
ERJMP SIN.F ;RETURN FALSE ON AN ERROR
SIN.T: SETZM .RDIOA(RDR) ;CLEAR I/O ACTIVE
$RETT ;AND RETURN
SIN.F: SETZM .RDIOA(RDR) ;CLEAR I/O ACTIVE
$RETF ;AND RETURN
$OPENF: SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS IT THE DN200 READER ???
JRST OPEN.2 ;YES,,GO PROCESS IT
JRST OPEN.6 ] ;NO,,MUST BE DN60 READER
OPENF ;OPEN THE CARD READER
ERJMP .RETF ;ON AN ERROR,,RETURN WITH ERROR
$RETT ;ELSE JUST RETURN
$MTOPR: SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS IT THE DN200 READER ???
JRST MTOP.2 ;YES,,GO PROCESS IT
JRST .RETT ] ;NO,,MUST BE DN60 READER (NO MTOPR)
MTOPR ;LOCAL,,ISSUE MTOPR NORMALLY
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
$RETT ;RETURN OK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
$GTJFN: SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS IT THE DN200 READER ???
JRST GTJF.2 ;YES,,GO PROCESS IT
JRST GTJF.6 ] ;NO,,MUST BE DN60 READER (NO MTOPR)
GTJFN ;LOCAL,,ISSUE GTJFN NORMALLY
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE RETURN OK
$CLOSF: SKIPE .RDREM(RDR) ;IS THIS A REMOTE READER ???
JRST [SKIPG .RDREM(RDR) ;YES,,IS IT THE DN200 READER ???
JRST CLOS.2 ;YES,,GO PROCESS IT
JRST CLOS.6 ] ;NO,,MUST BE DN60 READER (NO MTOPR)
CLOSF ;LOCAL,,ISSUE CLOSF NORMALLY
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE RETURN OK
SUBTTL DN200 I/O SUPPORT ROUTINES
IFN FTRJE,<
GETE.2: MOVE S1,.RDCHN(RDR) ;GET THE JFN
MOVX S2,.MORST ;GET READ DEVICE STATUS FUNCTION
MOVEI T1,T2 ;GET ARG BLOCK ADDRESS
MOVEI T2,2 ;GET BLOCK LENGTH
SETZM T3 ;CLEAR ANSWER WORD
PUSHJ P,UMTOPR## ;ISSUE THE MTOPR
ERCAL INTERR ;NO GOOD,,FORGET IT
TXNE T3,MO%OL+MO%HEM+MO%SCK+MO%PCK+MO%RCK+MO%SER
MOVX S1,IOX5 ;ANY OF THE ABOVE,,SET I/O ERROR
TXNE T3,MO%EOF ;HARDWARE EOF ???
MOVX S1,IOX4 ;YES,,MAKE IT EOF
$RETT
SIN.2: SKIPE .RDOFL(RDR) ;IS THE READER OFFLINE ???
JRST SIN.T ;YES,,JUST RETURN
PUSHJ P,USIN## ;READ CARDS THROUGH NURD
ERJMP SIN.F ;RETURN FALSE ON AN ERROR
JRST SIN.T ;ELSE RETURN TRUE
OPEN.2: PUSHJ P,UOPENF## ;OPEN THE CARD READER THROUGH NURD
ERJMP .RETF ;CANT,,THATS AN ERROR
$RETT ;OK,,JUST RETURN
MTOP.2: PUSHJ P,UMTOPR## ;MAKE CALL VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE RETURN OK
GTJF.2: PUSHJ P,UGTJFN## ;GET A JFN VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE RETURN OK
CLOS.2: PUSHJ P,UCLOSF## ;CLOSE DOWN VIA NURD
ERJMP .RETF ;NO GOOD,,SAY SO
$RETT ;ELSE RETURN OK
>
IFE FTRJE,<
GETE.2:
SIN.2:
OPEN.2:
MTOP.2:
GTJF.2:
CLOS.2:
MOVX S1,DIAGX8 ;GET 'DEVICE DOES NOT EXIST'
MOVEM S1,.RDSTP(RDR) ;SAVE IT
MOVE S1,.RDSTR(RDR) ;GET OUR STREAM NUMBER
$WTO (DN200 Remote not Supported,,@JOBOBA(S1)) ;TELL OPERATOR
HALTF ;END IT ALL
>
> ;END OF TOPS-20 CONDITIONAL CODE
SUBTTL TOPS10 DN60 INTERFACE ROUTINES
TOPS10 <
$OPEN: $CALL GTJF.6 ;do the initialization stuff
$CALL OPEN.6 ;Open the card reader
$RET ;Return keeping same condition
$CLOSE: PJRST CLOS.6 ;SHUT US DOWN
$IN60: MOVE S1,.RDCHN(RDR) ;GET THE JFN
HRLZ S2,.RDIBZ(RDR) ;GET THE INPUT BYTE SIZE
LSH S2,6 ;POSITION IT
ADD S2,[POINT 0,.CARDS(RDR)] ;CREATE THE BYTE POINTER
MOVE T1,[EXP -CRDNBR] ;GET THE NUMBER OF CARDS TO READ
IMUL T1,.RDRCL(RDR) ;MULTIPLY BY RECORD LENGTH
PUSHJ P,SIN.6 ;GET SOME CARDS
MOVE S1,.RDRCL(RDR) ;GET THE RECORD LENGTH
IMULI S1,CRDNBR ;CALC # OF BYTES TO BE READ
ADD T1,S1 ;CALC # OF BYTES READ
IDIV T1,.RDRCL(RDR) ;CALC # OF CARDS READ
MOVEM T1,.RDNBR(RDR) ;SAVE IT
SKIPE T1 ;NO CARDS,,DONT PROCESS
PUSHJ P,READER ;GO PROCESS THE CARDS
SKIPE S1,.RDSTP(RDR) ;GET THE LAST ERROR CODE
CAXE S1,IOX4 ;WAS THE ERROR EOF ???
SKIPA ;NO GOOD ERROR,,SKIP
$RETF ;EOF,,RETURN
JRST $IN60 ;TRY FOR SOME MORE CARDS
> ;END TOPS10
SUBTTL DN60 I/O SUPPORT ROUTINES
IFN FTDN60,<
SIN.6: SETZM .RDSTP(RDR) ;CLEAR LAST ERROR CODE
SKIPE .RDCPT(RDR) ;Hasp console?
$CALL I60OPR ;Yes - check for characters
PUSHJ P,D60SIN## ;TRY TO READ SOME CARDS
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes, do it
JUMPT [$CALL D60SU ;Process success
MOVEI S1,ERTCNT ;Get error threshold count
MOVEM S1,.RDECT(RDR) ;Set it
$RETT] ;and return true
CAILE S1,D6HEAD ;Check for legit error code
CAIL S1,D6TAIL ;because D60SIN isn't always friendly
$STOP (LEM,<Lousy error message from D60SIN>) ;durn
$D60ER(ERIDE) ;Process the error
CAIN S1,D6EOF ;Was it EOF error?
$RETF ;Yes, return failure so higher level
; detects the EOF
$RETIT ;If good error, just return
$CALL KILL ;Kill this, and don't return on T20
TOPS10<
TXZ FLAG,JOBCD ;Don't care if we have a job since
; we can't continue...
; This forces the shutdown!
SETOM .RDSTS(RDR) ;Say we want status update
$DSCHD (1) ;NOW and we shouldn't return
> ; End of TOPS10
TOPS20 <
GETE.6: MOVE S1,.RDSTP(RDR) ;GET THE LAST ERROR CODE
$RETT ;AND RETURN
> ;End of TOPS20
GTJF.6: $CALL D60SU ;Initialize the counts
SETZM JOBSTW(STREAM) ;Clear the status entry
MOVEI S1,ERTCNT ;GET ERROR THRESHHOLD COUNT
MOVEM S1,.RDECT(RDR) ;SET IT
SETZM S1 ;NO JFN FOR DN60
$RETT ;RETURN OK
CLOS.6: MOVEI S1,20 ;Get a threshold for closing
; to force the end of this code
MOVEM S1,.RTNBR(RDR) ; in our lifetime
SKIPG S1,.RDCHN(RDR) ;GET JUST THE JFN
JRST CLO6.1 ;No handle to release
$CALL D60RLS## ;Try to release
JUMPF [$D60ER(ERCRR) ;Process the error
JUMPT CLOS.6 ;If good error try again
JRST CLO6.1] ;Otherwise continue still bad
CLO6.1: SKIPG S1,.RDN60(RDR) ;Get the console handle
JRST CLO6.2 ;No handle to release
$CALL D60RLS## ;Try to release
JUMPF [$D60ER(ERCRC) ;Process the error
JUMPT CLO6.1 ;If good error try again
JRST CLO6.2] ;Otherwise continue still bad
CLO6.2: MOVEI S1,.RDSUP(RDR) ;Get address of setup message
MOVE S1,SUP.CN(S1) ;Get Port,,Line
$CALL D60DIS## ;Disable the line
JUMPF [$D60ER(ERCDL) ;Process the error
JUMPT CLO6.2 ;Go try again
JRST CLO6.3] ;otherwise continue still bad
CLO6.3: $RETT ;AND RETURN
KILL: $CALL CLOS.6 ;Close things down
TOPS10< SETOM .RDSHT(RDR) ;Tell main loop we are closing down
$RETF
> ; End of TOPS10
TOPS20< HALTF>
SUBTTL D60SU - DN60 success routine to fix counts
;purpose: To maintain counters etc. relating to a successful
; DN60 return
; Parameters: RDR / Address of current jobpage
D60SU: $SAVE <S1> ;Save some registers
MOVEI S1,NENBR ;# of allowed NBR errors
MOVEM S1,.RTNBR(RDR) ;Initialize counter
MOVEI S1,NEDOL ;# of allowed DOL errors
MOVEM S1,.RTDOL(RDR) ;Initialize counter
SKIPN .RDOFL(RDR) ;Were we offline before this?
$RETT ;No - just return
SETZM .RDOFL(RDR) ;Clear off-line flag
SETOM .RDSTS(RDR) ;say we want status update
$RETT ;Return
SUBTTL D60ER - Process DN60 errors
; The purpose of this routine is to process DN60 errors that deal with
; LPT device (operator console are processed as part of the routine
; OPRCHK). The following actions are taken:
; 1. Determine if error is "good" i.e. D6DOL or D6NBR
; 2. If good error has overflowed threshold, then it is a bad error
; 3. If good, DSCHD and then return true
; -- Bad error --
; 4. Output error message if requested
; 5. Return false
; Parameters:
; S1 / Last DN60 error
; (P) / Error message address
; Called by $D60ER macro
; $D60ER (msg)
; Where msg is either error message address or
; 0 for no error to be output
;Save the error code
D60ER: MOVEM S1,.RDLER(RDR)
;NBR error?
CAIE S1,D6NBR ;Non-blocking return?
JRST D60E.0 ;no, go process other
TXNN FLAG,JOBCD ;Are we in a job?
JRST D60E.7 ;No - quit, ignoring the error
SOSG .RTNBR(RDR) ;Out of errors?
JRST D60E.4 ;Yes - process bad error
$DSCHD (SHSLPT) ;Do a short sleep
JRST D60E.8 ;Return good with no further sleeping
;DOL error?
D60E.0: CAIE S1,D6DOL ;Device off-line error?
JRST D60E.1 ;no - go try something else
SOSLE .RTDOL(RDR) ;Out of errors?
JRST D60E.7 ;No - quit good
;EOF error?
D60E.1: CAIE S1,D6EOF ;EOF?
JRST D60E.3 ;No, go try something else
D60E.2: MOVX TF,IOX4 ;Get EOF error code
MOVEM TF,.RDSTP(RDR) ;Save it for later
JRST D60E.8 ;Quit good without wait
;Abort error?
D60E.3: CAIE S1,D6IAB ;Abort error?
JRST D60E.4 ;No, go process bad
TXO FLAG,ABORT ;Set the abort flag
JRST D60E.2 ;Go set EOF and continue
;Bad error
D60E.4: SETOM .RDSTS(RDR) ;Say we want status update
SETOM .RDOFL(RDR) ;Say offline
MOVEM T1,EMSG ;Save T1 a second
HRRZ T1,@0(P) ;Get error message address
SKIPN T1 ;Want error message output?
JRST [MOVE T1,EMSG ;No - Restore T1
JRST D60E.6] ;and return
EXCH T1,EMSG ;Save error message
$SAVE <S2,T1> ;Get a couple free registers
MOVE T1,EMSG ;Get error message again
CAIE T1,ERIDE ;Is it an error during input?
JRST D60E.5 ;No, skip the ORION message
; Since we have fatal error, tell ORION so that further errors go to
; all operators
MOVE S1,.RDSTR(RDR) ;Get our stream number
MOVE S1,JOBOBA(S1) ;Get the object block
MOVE S1,OBJ.ND(S1) ;Get the node name
MOVEM S1,NWAMSG+.OHDRS+ARG.DA+OBJ.ND ;Save the node name/number
MOVEI S1,NWAMSG ;Get the message address
MOVEI S2,.OHDRS+ARG.DA+OBJ.SZ ;Get the message length
$CALL SNDOPR ;Send it off
MOVE S1,.RDLER(RDR) ;Get back the error
D60E.5: SUBI S1,$ER1ST ;Set DN60 error message
$WTO (<^T/0(T1)/>,<^T/@D60TXT(S1)/>,@JOBOBA(STREAM)) ;Yes tell opr
SETOM .RDSTP(RDR) ;Generate no further error message
D60E.6: $RETF
D60E.7: $DSCHD (LGSLPT) ;Quit for awhile
D60E.8: $RETT ;Return true
;DN60 LINE CONDITIONING AND DEVICE OPENING ROUTINE
; T2 is set early and is used as index into JOBOBA
;Condition the line
OPEN.6: SETOM .RDCHN(RDR) ;NO CHANNEL YET
SETOM .RDN60(RDR) ;NO OPR CONSOLE YET
MOVE T2,.RDSTR(RDR) ;GET OUR STREAM NUMBER
MOVEI S1,.RDSUP(RDR) ;POINT TO OUR SETUP MESSAGE
PUSHJ P,D60CND## ;CONDITION THE FRONT END
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes, do it
JUMPT [$CALL D60SU ;process good
JRST OPN.6A] ;Go continue
CAIN S1,D6SON ;Is this just a bad signon card?
JRST [$CALL CLO6.2 ;Yes, disable the line
JRST OPEN.6] ;and go try again
$D60ER (ERCFE) ;Go process the error
JUMPF KILL ;Quit if bad error
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes -- quit
JRST OPEN.6 ;Go try again
;Set up line data base info
OPN.6A: MOVE S2,JOBOBA(T2) ;GET OUT OBJECT BLOCK ADDRESS
EXCH S1,OBJ.ND(S2) ;Save the actual node name,
; (returned by D60CND)
; get the proto node name
MOVEM S1,.RDPNN(RDR) ;Save the proto node name
; in proto location till
; response to setup
MOVE S1,OBJ.UN(S2) ;GET OUR UNIT NUMBER
STORE S1,.RDOPB(RDR),OP$UNT ;SAVE THE UNIT NUMBER IN OPEN BLOCK
$CALL CHKNOD ;Check out the signing on node
;name
JUMPF KILL ;Bad news
MOVX S1,.OPCDR ;WANT 'CDR' DEVICE
STORE S1,.RDOPB(RDR),OP$TYP ;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
LOAD S1,.RDSUP+SUP.CN(RDR),CN$PRT ;GET THE PORT NUMBER
STORE S1,.RDOPB(RDR),OP$PRT ;SAVE IT IN THE OPEN BLOCK
LOAD S1,.RDSUP+SUP.CN(RDR),CN$LIN ;GET THE LINE NUMBER
STORE S1,.RDOPB(RDR),OP$LIN ;SAVE IT IN THE OPEN BLOCK
LOAD S1,.RDSUP+SUP.CN(RDR),CN$SIG ;GET THE LINE SIGNATURE
STORE S1,.RDOPB(RDR),OP$SIG ;SAVE IT IN THE OPEN BLOCK
;Open the remote "card reader"
OPN.6B: HRROI S1,-OP$SIZ ;GET THE NEGATIVE BLOCK LENGTH
MOVEI S2,.RDOPB(RDR) ;GET THE PARM BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE READER
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes, do it
JUMPT [$CALL D60SU ;process good
JRST OPN.6C] ;Go continue
$D60ER (ERO6R) ;Go process the error
JUMPF KILL ;Quit if bad error
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes -- quit
JRST OPN.6B ;Go try again
;Open succeeded, clean-up
OPN.6C: MOVEM S1,.RDCHN(RDR) ;SAVE THE CDR HANDLE
SETZM .RDCPT(RDR) ;Default is no hasp
LOAD S1,.RDFLG(RDR),NT.TYP ;GET THE REMOTE TYPE
CAXE S1,DF.HSP ;IS IT HASP ???
JRST OPN.6E ;Go clean up
;We have a HASP line, need to open the operator console
HRLZI S1,.OPCIN ;YES,,GET OPR CONSOLE ID
STORE S1,.RDOPB(RDR),OP$DEV ;SAVE IT IN THE OPEN BLOCK
OPN.6D: HRROI S1,-OP$SIZ ;GET THE NEGATIVE BLOCK LENGTH
MOVEI S2,.RDOPB(RDR) ;GET THE BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE OPERATORS CONSOLE
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes, do it
JUMPT [$CALL D60SU ;process good
MOVEM S1,.RDN60(RDR) ;Save OPR console handle
MOVE S1,[POINT 7,0] ;Pointer to begin. of in buff.
HRRI S1,.RDCMD(RDR) ;Make pointer absolute
MOVEM S1,.RDCPT(RDR) ;Save it
MOVE S1,[EXP -CMDLN*5];Get -length of buffer in bytes
MOVEM S1,.RDCCT(RDR) ;Save it
JRST OPN.6E] ;Go clean-up and return
$D60ER (EROHC) ;Go process the error
JUMPF KILL ;Quit if bad error
SKIPE .RDSHT(RDR) ;Shutdown?
JRST KILL ;Yes -- quit
JRST OPN.6D ;Go try again
OPN.6E: SETOM .RDSTS(RDR) ;Cause a status message to be sent
$RETT ;Return true
SUBTTL CHKNOD - Routine to check for duplicate node names
;The purpose of this routine is to check for duplicate node names.
;This can happen particularly in IBMCOM if the same node tries to sign
;on twice to two different prototype nodes (different port,line #).
;The mechanism is to check the other objects in CDRIVE's data base to
;determine if this is a node that already exists and if so, disallow
;this one. This code makes some assumptions. If more than one CDRIVE
;process exists, this will not catch the problem because objects
;signed on the other node are unknown. On the 20, due to
;multiforking, if both forks with the same node name try to signon
;simultaneously there is a possible race where this test will fail
;because of how the node names are stored in the data base (see
;FIXPRO). In either of these cases, the error will at least be
;detected by QUASAR.
;Call: S2 / Address of the object block being examined
;Returns:
; FALSE if duplicate exists after notifying operator.
CHKNOD: $SAVE P1 ;Get a work ac
MOVE S2,OBJ.ND(S2) ;Get the actual node name
;signing on
MOVSI P1,-MAXRDR ;Prepare to loop through the
;objects
CHKN.1: HRRZ S1,P1 ;Get stream being examined
CAMN S1,STREAM ;Is it our current?
JRST CHKN.5 ;Yes, skip this
SKIPN S1,JOBOBA(P1) ;Things set up?
JRST CHKN.5 ;No, skip this one
MOVE S1,OBJ.ND(S1) ;Get this one's node name
CAMN S1,S2 ;Is it equal to the new one?
JRST CHKN.6 ;Yes, trouble in river city
CHKN.5: AOBJN P1,CHKN.1 ;Go for another
$RETT ;Made it this far, everything
;must be O.K.
;Here if duplicate node names, send nasty message and return false.
CHKN.6: $WTO (<Refusing signon>,<Node ^N/S2/ tried to signon twice>)
SETOM .RDSTP(RDR) ;Generate no further error
;messages
$RETF ;Quit bad
;ROUTINE TO READ THE HASP OPERATORS CONSOLE
TOPS20 <
REPEAT 0,<
GETHSP: SKIPG S1,.RDN60(RDR) ;IS THERE A OPR CONSOLE CHANNEL
$RETT ;NO,,RETURN NOW
MOVE S2,[POINT 7,.CARDS(RDR)] ;GET THE INPUT BUFFER BYTE POINTER
HRROI T1,-^D140 ;GET A LARGE BYTE COUNT
PUSHJ P,D60SIN## ;READ THE HASP OPERATORS CONSOLE
SKIPF ;IF THE READ FAILED
CAMN S2,[POINT 7,.CARDS(RDR)] ; OR NO DATA WAS READ
$RETT ; THEN JUST RETURN
MOVE S1,[POINT 7,.CARDS(RDR)] ;GET OUR INPUT BYTE POINTER BACK
PUSHJ P,OPRCMD ;GO PROCESS THE OPERATOR COMMAND
$RETT ;AND RETURN
> ;End of REPEAT 0
> ;End of TOPS20
> ;End of IFN FTDN60
IFE FTDN60,<
GETE.6:
SIN.6:
OPEN.6:
GTJF.6:
CLOS.6:
GETHSP:
MOVX S1,DIAGX8 ;GET 'DEVICE DOES NOT EXIST'
MOVEM S1,.RDSTP(RDR) ;SAVE IT
MOVE S1,.RDSTR(RDR) ;GET OUR STREAM NUMBER
$WTO (DN60 Type Remote not Supported,,@JOBOBA(S1)) ;TELL OPERATOR
TOPS20< HALTF > ;AND END IT HERE !!!
TOPS10< $RETF > ;RETURN FALSE
>
SUBTTL READER - ROUTINE TO PROCESS THE INPUT CARDS.
READER: SKIPN .RDNBR(RDR) ;ARE THERE ANY CARDS THERE ???
JRST READ.4 ;NO,,JUST RETURN
PUSHJ P,.SAVE1 ;YES,,SAVE P1
HRLZ P1,.RDOBZ(RDR) ;GET THE CORRECT BYTE SIZE
LSH P1,6 ;POSITION SIZE FOR BYTE POINTER
ADD P1,[POINT 0,.CARDS(RDR)] ;COMBINE THE BYTE PTR & BYTE SIZE
MOVEM P1,.RDIPT(RDR) ;SAVE IT THE FIRST TIME THROUTH
READ.2: GETBYT S1,P1 ;GET A BYTE
HRRI S2,@P1 ;GET THE CARD STARTING ADDRESS
MOVEM S2,.RDCAD(RDR) ;SAVE IT FOR LATER
CAMN S1,$IMAGE(AP) ;IS IT A $ SIGN ???
JRST $CARD ;YES,,GO PROCESS IT
CAMN S1,ENDIMG(AP) ;IS IT AN EOF CARD ???
JRST ENDCRD ;YES,,GO PROCESS IT.
TXNN FLAG,JOBCD ;IS THERE A JOB SETUP ???
JRST REJECT ;NO,,REJECT THE CARD.
PUSHJ P,OUTCRD ;ELSE PUT OUT THE CARD.
READ.3: MOVE S1,.RDRCL(RDR) ;GET THE RECORD LENGTH IN BYTES
; ADJBP S1,.RDIPT(RDR) ;POINT TO THE NEXT CARD -- KL/KS only
; The following two lines replace the previous line so CDRIVE is transportable.
MOVE S2,.RDIPT(RDR) ;Get the pointer
$CALL PADJBP ;Do the ADJBP
MOVE P1,S1 ;Put result in the right place
MOVEM P1,.RDIPT(RDR) ;SAVE THE POINTER FOR LATER
SOSLE .RDNBR(RDR) ;SUB 1 FROM CARD COUNT
JRST READ.2 ;MORE,,CONTINUE
READ.4: SETZM .RDNBR(RDR) ;ZERO THE NUMBER OF CARDS COUNTER
HRLZ S1,.RDOBZ(RDR) ;GET THE OUTPUT BYTE SIZE
LSH S1,6 ;POSITION IT
ADD S1,[POINT 0,.CARDS(RDR)] ;MAKE IT A BYTE POINTER
MOVEM S1,.RDOPT(RDR) ;AND SAVE IT
$RETT ;RETURN.
SUBTTL PADJBP -- Positive ADJBP
COMMENT \
This routine fakes the ADJBP instruction for use in programs
that must be run on a KI but only if the adjustment is positive.
The other type could be added later. S1 is to contain the adjustment
and S2 is to contain the pointer to be adjusted.
Returns false if the adjustment is invalid (negative)
otherwise returns the adjusted pointer in S1 with S2 undefined.
\
MSKSTR (BYSIZE,,77B11)
PADJBP: SKIPGE S1 ;Legit adjustment?
$RETF ;No
$SAVE <P1,P2> ;Save work ac's
LOAD P2,S2,BYSIZE ;Get the bytesize
MOVEI P1,^D36 ;Number of bits /word
IDIV P1,P2 ;Get # of bytes /word
MOVE P2,S2 ;save the pointer a sec.
IDIV S1,P1 ;Calc the # of words to adjust
; Remainder in S2 (Bytes to adjust)
ADD S1,P2 ;Add ptr to the # of words to adjust
JUMPE S2,PADJ.1 ;jump if no bytes to adjust
PADJ.0: IBP S1 ;Incremental adjustment
SOJG S2,PADJ.0 ;Check to do again
PADJ.1: $RETT
SUBTTL $CARD - ROUTINE TO PROCESS $ CARDS
$CARD: GETBYT S1,P1 ;GET A BYTE
CAME S1,JIMGUC(AP) ;IS IT A 'J' ??
CAMN S1,JIMGLC(AP) ;IS IT 'j' ???
JRST JOBCRD ;YES TO EITHER,,PROCESS JOB CARD.
CAME S1,EIMGUC(AP) ;IS IT A 'E' ???
CAMN S1,EIMGLC(AP) ;IS IT A 'e' ???
JRST EOJCRD ;YES TO EITHER,,PROCESS EOJ CARD.
CAME S1,SIMGUC(AP) ;IS IT A 'S' ??
CAMN S1,SIMGLC(AP) ;IS IT 's' ???
JRST SITCRD ;YES TO EITHER,,PROCESS STIGO CARD.
CAMN S1,$IMAGE(AP) ;IS IT A COMMAND ??? ($$??)
JRST COMMAND ;YES,,GO PROCESS IT.
$CARD1: TXNN FLAG,JOBCD ;IS THERE A JOB SETUP ???
JRST REJECT ;NO,,REJECT IT.
$CARD2: PUSHJ P,OUTCRD ;ELSE WRITE IT OUT
JRST READ.3 ;AND CONTINUE
REJECT: TXZN FLAG,EOF ;REJECTING AN EOF GENERATED CARD ???
JRST JOBC.2 ;No, Go set up the fake job for rejects
JRST READ.3 ;AND GO PROCESS IT.
SUBTTL JOBCRD - ROUTINE TO PROCESS A JOB CARD.
JOBCRD: GETBYT S1,P1 ;GET A BYTE.
CAME S1,OIMGUC(AP) ;IS IT A 'O' ???
CAMN S1,OIMGLC(AP) ;IS IT A 'o' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD1 ;Let SPRINT handle it
GETBYT S1,P1 ;GET THE NEXT BYTE.
CAME S1,BIMGUC(AP) ;IS IT A 'B' ???
CAMN S1,BIMGLC(AP) ;IS IT A 'b' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD1 ;Let SPRINT handle it
JOBC.1: GETBYT S1,P1 ;GET THE NEXT BYTE.
CAME S1,BLANK(AP) ;IS IT A BLANK ???
JRST $CARD1 ;No, let SPRINT handle it
AOS .RDJBC(RDR) ;BUMP JOB COUNT BY 1.
JOBC.2: TXNE FLAG,JOBCD ;IS THE JOBCARD BIT ON ???
PUSHJ P,CREATE ;GO SEND CREATE MSG FOR THE LAST JOB.
TXO FLAG,JOBCD ;TURN ON THE JOB CARD BIT.
MOVEM FLAG,FLAG+.RDREG(RDR) ;Make sure we let everyone know
SETOM .RDSTS(RDR) ;Say we want status update
MOVEI S1,ERTCNT ;GET AN ERROR COUNT OF 4
MOVEM S1,.RDECT(RDR) ;SAVE IT FOR LATER
PUSHJ P,I%NOW ;GET THE TIME.
MOVEM S1,.RDTIM(RDR) ;SAVE AS JOB START TIME
MOVE S1,.RDSTR(RDR) ;GET THE STREAM NUMBER
PUSHJ P,GETFIL ;GO SETUP THE OUTPUT SPOOL FILE
JRST $CARD2 ;Go put it out
SUBTTL EOJCRD - ROUTINE TO PROCESS $EOJ CARDS.
EOJCRD: TXNN FLAG,JOBCD ;IS THERE A JOB SETUP ???
JRST REJECT ;NO,,REJECT THIS CARD.
GETBYT S1,P1 ;GET THE NEXT BYTE
CAME S1,OIMGUC(AP) ;IS IT A 'O' ???
CAMN S1,OIMGLC(AP) ;IS IT A 'o' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD2 ;Dump the card out and continue
GETBYT S1,P1 ;GET THE NEXT BYTE.
CAME S1,JIMGUC(AP) ;IS IT A 'J' ???
CAMN S1,JIMGLC(AP) ;IS IT A 'j' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD2 ;Dump the card out and continue
GETBYT S1,P1 ;GET THE NEXT BYTE
CAME S1,BLANK(AP) ;IS IT A BLANK ???
JRST $CARD2 ;No, dump the card out and continue
AOS .RDEOJ(RDR) ;BUMP END OF JOB COUNT BY 1
PUSHJ P,OUTCRD ;PUT IT OUT
PUSHJ P,CREATE ;SEND THE CREATE MSG OFF
JRST READ.3 ;AND CONTINUE PROCESSING
SUBTTL SITCRD - ROUTINE TO PROCESS $SITGO CARDS.
SITCRD: GETBYT S1,P1 ;GET A BYTE.
CAME S1,IIMGUC(AP) ;IS IT A 'I' ???
CAMN S1,IIMGLC(AP) ;IS IT A 'i' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD1 ;Let SPRINT handle it
GETBYT S1,P1 ;GET A BYTE.
CAME S1,TIMGUC(AP) ;IS IT A 'T' ???
CAMN S1,TIMGLC(AP) ;IS IT A 't' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD1 ;Let SPRINT handle it
GETBYT S1,P1 ;GET A BYTE.
CAME S1,GIMGUC(AP) ;IS IT A 'G' ???
CAMN S1,GIMGLC(AP) ;IS IT A 'g' ???
SKIPA ;YES,,KEEP ON GOING
JRST $CARD1 ;Let SPRINT handle it
GETBYT S1,P1 ;GET A BYTE.
CAME S1,OIMGUC(AP) ;IS IT A 'O' ???
CAMN S1,OIMGLC(AP) ;IS IT A 'o' ???
JRST JOBC.1 ;ALL'S WELL - ENTER $JOB CARD CODE
JRST $CARD1 ;Let SPRINT handle it
SUBTTL ENDCRD - ROUTINE TO PROCESS END-OF-FILE CARDS
ENDCRD: AOS .RDEND(RDR) ;BUMP END CARD COUNT BY 1
TXNN FLAG,JOBCD ;IS THERE A JOB SETUP ???
JRST REJECT ;NO,,REJECT THIS CARD
PUSHJ P,CREATE ;GO SEND A CREATE MSG
JRST READ.3 ;AND GO GET THE NEXT CARD
SUBTTL COMMAND - ROUTINE TO PROCESS THE $$ COMMAND FOR OPR
COMMAND: TXNE FLAG,JOBCD ;ARE WE IN A JOB ???
JRST $CARD2 ;Yes, just output the card
SKIPG .RDREM(RDR) ;IS THIS A DN60 REMOTE STATION ???
JRST $CARD1 ;No, let SPRINT handle it
MOVE S1,P1 ;GET THE CARD BYTE POINTER
PUSHJ P,OPRCMD ;GO PROCESS THE CARD
JRST READ.3 ;AND CONTINUE ON
SUBTTL I60OPR Routine to get operator messages
; The purpose of this routine is to get any characters that are available
; from the console device. If during this process, a LF is found, then
; the record is sent to OPRCMD to be processed. At the end of the processing
; the record is shifted so the next command is always at the beginning
; of the buffer.
; Note: This routine saves all acs.
IFN FTDN60,<
I60OPR: $SAVE <S1,S2,T1,T2> ;Save everything
MOVE S1,.RDN60(RDR) ;Get handle of console
MOVE S2,.RDCPT(RDR) ;Get console pointer
MOVE T1,.RDCCT(RDR) ;Get console byte count
$CALL D60SIN ;Get some console stuff
JUMPT I60.1 ;Go process characters
CAIN S1,D6NBR ;Is it a NBR return?
JRST I60.1 ;Yes - Don't care about DN60 errors
CAIN S1,D6IAB ;Is it aborted?
JRST [MOVE S1,[POINT 7,0] ;Yes, reset the buffers
;Pointer to begin. of in buff.
HRRI S1,.RDCMD(RDR) ;Make pointer absolute
MOVEM S1,.RDCPT(RDR) ;Save it
MOVE S1,[EXP -CMDLN*5];Get -length of buffer in bytes
MOVEM S1,.RDCCT(RDR) ;Save it
JRST I60.6] ;Go to return
$D60ER (ERCDE) ;Go process errors
SKIPF ;Bad error?
SETZM .RDSTP(RDR) ;No, clear the error
I60.1: CAMN S2,.RDCPT(RDR) ;Checking pointers - Any chars?
JRST I60.4 ;No - go to return
ILDB T2,.RDCPT(RDR) ;Get the next byte
CAIE T2,12 ;Do we have a line feed?
JRST I60.1 ;No - Go try to get another
PUSH P,S2 ;Save S2 a sec.
MOVE S1,[POINT 7,0] ;Point to begin of buffer
HRRI S1,.RDCMD(RDR) ;Make pointer absolute
$CALL OPRCMD ;Process the operator message
POP P,S2 ;Restore S2
; Now need to move the remaining characters to the beginning of the
; buffer, adjusting pointers and count along the way.
MOVNI T1,CMDLN*5 ;assume we can fill entire buffer
MOVE S1,[POINT 7,0] ;Point to begin of buffer
HRRI S1,.RDCMD(RDR) ;Make pointer absolute
I60.2: CAMN S2,.RDCPT(RDR) ;Are the pointers alike (finished?)
JRST I60.3 ;Yes, go to return
ILDB T2,.RDCPT(RDR) ;Get the next byte
IDPB T2,S1 ;Save the next byte
AOS T1 ;Adjust the count by decrementing
; (negative count) for every character
; still in buffer (i.e. moved down).
JRST I60.2 ;Loop on more characters
;End of loop, clean up by updating the pointers.
I60.3: MOVE S2,S1 ;Save the new local pointer
MOVE S1,[POINT 7,0] ;Get the new old pointer
HRRI S1,.RDCMD(RDR) ;Make pointer absolute
MOVEM S1,.RDCPT(RDR) ;Save it
JRST I60.1 ;Go see if any more chars or commands.
I60.4: JUMPL T1,I60.5 ;if we have a good count, exit
MOVNI T1,CMDLN*5 ;else reset count
MOVE S1,[POINT 7,0] ; and byte
HRRI S1,.RDCMD(RDR) ; counter
MOVEM S1,.RDCPT(RDR) ;this throws away crufty (too long) message
I60.5: MOVEM T1,.RDCCT(RDR) ;Save the new count
I60.6: $RET
SUBTTL OPRCMD - ROUTINE TO GENERATE AN OPR COMMAND MESSAGE
;CALL: S1/ Byte Pointer to the Operator message terminated by a CRLF
;
;RET: True Always
OPRCMD: $SAVE <T1,P1,P2> ;Need to save T1 also due to
;fear of the unknown
STKVAR <BEGMSG> ;To save beginning of message
;to calculate length later
MOVE P1,S1 ;SAVE THE INPUT BYTE POINTER ALSO
PUSHJ P,M%GPAG ;GET A PAGE FOR THE MESSAGE
MOVEM S1,BEGMSG ;Save the beginning of msg.
MOVE P2,S1 ;HERE ALSO
; Build the header of the message
MOVX S1,.OMD60 ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(P2),MS.TYP ;SAVE IT IN THE MESSAGE
MOVEI S1,3 ;GET THE ARGUMENT BLOCK COUNT
MOVEM S1,.OARGC(P2) ;SAVE IT IN THE MESSAGE
; Build the first argument block (Node block for QUASAR validation)
MOVEI P2,.OHDRS(P2) ;GET THE FIRST BLOCK ADDRESS
MOVE S1,[2,,.ORNOD] ;GET THE FIRST BLOCK HEADER
MOVEM S1,ARG.HD(P2) ;SAVE IT IN THE MESSAGE
MOVE S1,.RDSTR(RDR) ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
MOVE S1,OBJ.ND(S1) ;GET OUR NODE NAME IN SIXBIT
MOVEM S1,ARG.DA(P2) ;SAVE IT IN THE MESSAGE
; Build the second argument block (DN60 block of data)
ADDI P2,2 ;POINT TO THE NEXT BLOCK
MOVE S1,[3,,.ORD60] ;GET THE NEXT BLOCK HEADER
MOVEM S1,ARG.HD(P2) ;SAVE IT IN THE MESSAGE
LOAD S1,.RDSUP+SUP.CN(RDR),CN$PRT ;GET THE PORT NUMBER
HRLM S1,ARG.DA(P2) ;SAVE IT IN THE MSG DATA BLOCK
LOAD S1,.RDSUP+SUP.CN(RDR),CN$LIN ;GET THE LINE NUMBER
HRRM S1,ARG.DA(P2) ;SAVE IT IN THE MSG DATA BLOCK
LOAD S1,.RDFLG(RDR) ;GET THE FLAG BITS
MOVEM S1,ARG.DA+1(RDR) ;SAVE IT IN THE MSG DATA BLOCK
; Build the third argument block (text argument)
ADDI P2,3 ;POINT TO THE NEXT BLOCK
MOVX S1,.CMTXT ;GET THE BLOCK TYPE
MOVEM S1,ARG.HD(P2) ;SAVE IT IN THE MESSAGE
MOVE S1,[POINT 7,ARG.DA(P2)] ;GET THE OUTPUT BYTE POINTER
SETZM T1 ;Have found no trailing spaces
;so far
OPRC.1: ILDB S2,P1 ;GET A TEXT BYTE
CAIN S2,40 ;Is is a space?
JRST [SKIPN T1 ;Yes, have trailing one set?
MOVE T1,S1 ;No, set it here
JRST OPRC.2] ;Continue on
CAIN S2,15 ;Is is a carriage return?
JRST OPRC.3 ;Yes, get out of loop and
;complete argument
SETZM T1 ;Set have no trailing spaces
OPRC.2: IDPB S2,S1 ;Save the byte in the message
JRST OPRC.1 ;Go for the next one
OPRC.3: SKIPE T1 ;Any set trailing space?
MOVE S1,T1 ;Yes, set for it
IDPB S2,S1 ;Save the carriage return
ILDB S2,P1 ;Get the line feed that should
;be there
IDPB S2,S1 ;Save the line feed
; Now calculate the lengths for both the total message and for the
; text argument portion of the message.
MOVEI S1,@S1 ;GET THE ENDING ADDRESS
MOVE S2,BEGMSG ;Get starting address of message
SUBI S1,-1(S2) ;CALC THE TOTAL MESSAGE LENGTH
STORE S1,.MSTYP(S2),MS.CNT ;SAVE THE MESSAGE LENGTH
SUBI S1,^D10 ;CALC THE LENGTH OF THE TEXT BLOCK
STORE S1,ARG.HD+^D10(S2),AR.LEN ;SAVE IT IN THE MESSAGE
; Send a IBMCOM stats message if needed
IFN FTIBMS,<
MOVEI S1,%TCNI ;Get the stats code for
;console message
$CALL IBMSTS ;Tell QUASAR
MOVE S2,BEGMSG ;Restore S2
> ; End of FTIBMS
; Send the message
LOAD S1,.MSTYP(S2),MS.CNT ;GET THE MESSAGE LENGTH IN S1
EXCH S1,S2 ;GET ADDRESS IN S1 AND LENGTH IN S2
PUSHJ P,SNDOPR ;SEND THE MESSAGE OFF
$RETT ;AND RETURN
> ;END DN60 CONDITIONAL
IFE FTDN60,<
OPRCMD: $RETT > ;JUST RETURN
SUBTTL GETFIL - ROUTINE TO CREATE AN OUTPUT SPOOL FILE
GETFIL: PUSHJ P,GENFIL ;GO GENERATE THE SPOOL FILENAME
MOVEI S1,2 ;GET FOB SIZE
MOVEI S2,.RDFOB(RDR) ;GET FOB ADDRESS
PUSHJ P,F%OOPN ;OPEN THE SPOOL FILE
JUMPT GETF.1 ;IF OK,,CONTINUE ON
CAIE S1,ERFAE$ ;IS THE ERROR 'FILE-ALREADY-EXISTS' ?
$STOP(COS,CANNOT OPEN SPOOL FILE) ;NO,,THEN ITS A FATAL ERROR
MOVE S1,FILENM ;GET THE FILE NAME HASH CODE
ANDI S1,FILEMK ;GET THE GOOD PART
CAIG S1,17500 ;IS IT LESS THEN 8000 (DECIMAL) ??
JRST GETFIL ;YES,,TRY THE NEXT FILE NAME
SETZM FILENM ;CREATE A NEW HASH CODE
AOS FILEXT ;AND A NEW EXTENSION
JRST GETF.1 ;AND TRY AGAIN
GETF.1: MOVEM S1,.RDIFN(RDR) ;SAVE THE IFN
$RETT ;AND RETURN
SUBTTL OUTCRD - ROUTINE TO OUTPUT A CARD.
OUTCRD: AOS .RDJBT(RDR) ;BUMP JOB CARD COUNT BY 1
SKIPLE .RDREM(RDR) ;IS IT LOCAL OR DN200 ???
JRST OUTD60 ;NO,,MUST BE DN60 !!!
MOVE S1,.RDIFN(RDR) ;GET THE SPOOL FILE IFN
HRL S2,.RDRCL(RDR) ;GET THE RECORD LENGTH
HRR S2,.RDCAD(RDR) ;GET THE CARD ADDRESS.
PUSHJ P,F%OBUF ;WRITE OUT THE CARD
JUMPT .RETT ;IF OK,,RETURN
$STOP(EWS,ERROR WRITING SPOOL FILE)
OUTD60: PUSHJ P,.SAVE2 ;SAVE P1 & P2 FOR A MINUTE
MOVE P1,.RDIPT(RDR) ;GET THE RECORD POINTER
MOVE P2,.RDRCL(RDR) ;GET THE RECORD LENGTH IN BYTES
OUTD.1: MOVE S1,.RDIFN(RDR) ;GET THE SPOOL FILE IFN
ILDB S2,P1 ;GET A BYTE
PUSHJ P,F%OBYT ;PUT IT OUT
JUMPF S..EWS ;CANT,,FORGET IT !!!
SOJG P2,OUTD.1 ;CONTINUE TILL DONE
$RETT ;AND RETURN
SUBTTL CREATE - ROUTINE TO GENERATE A CREATE MESSAGE FOR QUASAR
CREATE:
IFN FTDN60,<
TXNN FLAG,ABORT ;Aborting?
JRST CREA.1 ;No, continue on
$CALL IBMABO ;Yes, go process it
$RETT
CREA.1:
> ; End of FTDN60
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
PUSHJ P,M%ACQP ;ACQUIRE PAGE FOR MESSAGE TO QUASAR
PG2ADR S1 ;CONVERT PAGE NUMBER TO ADDRESS
MOVEM S1,P1 ;SAVE IN MES (AC FOR EQ ENTRY)
MOVEI S1,<EQHSIZ+FPMSIZ+FDSIZE> ;SIZE OF FULL MESSAGE
STORE S1,.MSTYP(P1),MS.CNT ;SAVE IN HEADER FOR SIZE
MOVEI S1,.QOCRE ;CREATE INDICATOR TYPE
STORE S1,.MSTYP(P1),MS.TYP ;PLACE TYPE IN HEADER
MOVEI S1,%%.QSR ;QUASAR VERSION NUMBER
STORE S1,.EQLEN(P1),EQ.VRS ;SAVE VERSION NUMBER IN EQ
MOVEI S1,EQHSIZ ;EQ HEADER SIZE
STORE S1,.EQLEN(P1),EQ.LOH ;LENGTH OF HEADER FIELD
MOVX S1,<.OTBIN> ;BATCH INPUT QUEUE (SPRINT)
STORE S1,.EQROB+.ROBTY(P1) ;SAVE IN OBJECT TYPE
MOVE S1,CNTSTA ;GET THIS NODES ID
MOVEM S1,.EQROB+.ROBND(P1) ;SAVE NODE IN MESSAGE
MOVEI S1,1 ;NUMBER OF FILES IN REQUEST
STORE S1,.EQSPC(P1),EQ.NUM ;STORE IN EQ
MOVEI S1,FPMSIZ ;SIZE OF THE FP
STORE S1,<EQHSIZ+.FPLEN>(P1),FP.LEN ;FP HEADER SIZE
MOVE S1,.RDIFN(RDR) ;Get the file IFN
SETOM S2 ;We want the exact FD to tell QUASAR
$CALL F%FD ;Go get it
HRLZS S1 ;Push address into left half
HRRI S1,<EQHSIZ+FPMSIZ>(P1) ;DESTINATION ADDRESS into right half
BLT S1,<EQHSIZ+FPMSIZ+FDSIZE-1>(P1) ;MOVE THE FD
; Now we are through with the IFN, we can release the file
MOVE S1,.RDIFN(RDR) ;GET THE FILE IFN
PUSHJ P,F%REL ;RELEASE THE IFN AND CLOSE THE FILE.
SKIPT ;IF OK,,CONTINUE
$STOP(CCS,CANNOT CLOSE SPOOL FILE) ;ELSE COMMIT SUICIDE
MOVEI S2,EQHSIZ(P1) ;GET THE FP ADDRESS IN S2
MOVEI S1,.RDRCL(RDR) ;GET CARD SIZE OF DATA
STORE S1,.FPINF(S2),FP.RCL ;SAVE THE RECORD LENGTH
MOVEI S1,.FPFAI ;GET THE AUGMENTED IMAGE MODE BITS
SKIPLE .RDREM(RDR) ;UNLESS THIS IS A DN60 READER
MOVEI S1,.FPFSA ; THEN MAKE IT ASCII MODE
STORE S1,.FPINF(S2),FP.RCF ;SAVE THE RECORD FORMAT
MOVE S1,.RDJBT(RDR) ;CARD COUNT FOR JOB
STORE S1,.FPRCD(S2) ;SAVE THE NUMBER OF RECORDS
MOVEI S1,1 ;GET A ONE.....
STORE S1,.FPINF(S2),FP.SPL ;LITE THE SPOOLED FILE BIT
STORE S1,.FPINF(S2),FP.PCR ;SET PHYSICAL CARD READER BIT
STOLIM S1,.EQLIM(P1),CJOB ;ALSO 1 JOB PER FILE (FOR NOW)
MOVE S1,.RDTIM(RDR) ;GET START TIME OF JOB
STOLIM S1,.EQLIM(P1),CTIM ;SAVE START TIME OF JOB
MOVE S1,.RDSTR(RDR) ;GET THE STREAM NUMBER
MOVE S2,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
MOVE S2,OBJ.ND(S2) ;GET OUR NODE NAME
STOLIM S2,.EQLIM(P1),CNOD ;SAVE AS THE DESTINATION NODE
$WTOJ (<1 Job: ^D/.RDJBT(RDR)/ Cards Spooled>,,@JOBOBA(S1))
AOS .RDIPC(RDR) ;COUNT OF MESSAGES SENT
TXZ FLAG,JOBCD ;TURN OFF THE JOB CARD BIT
MOVEM FLAG,FLAG+.RDREG(RDR) ;Remember so everyone will know
SETOM .RDSTS(RDR) ;Say we want status update
SETZM .RDJBT(RDR) ;ZERO THE JOB CARD COUNT
; Call the IBMCOM stats routine if needed.
IFN FTIBMS,<
SKIPLE .RDREM(RDR) ;Is it IBMCOM job?
JRST [MOVEI S1,%TINP ;Yes, get the STAT code
$CALL IBMSTS ;Send it off
JRST .+1] ;Continue on
> ; End of FTIBMS
; Continue on and send the CREATE message
MOVE S1,P1 ;PUT THE MSG ADDRESS INTO S1.
MOVEI S2,1000 ;PUT THE LENGTH IN S2.
PJRST SENDIT ;GO SEND IT OFF AND RETURN
SUBTTL IBMABO - Routine to handle IBMCOM abort
; The purpose of this routine is to handle the abort of an IBM reader stream
; abort. There are three steps necessary:
; Notify the operator of the abort
; Clear the current output file
; Finally clear the abort state
; This routine is currently called only by CREATE routine.
; Parameters: none
; Uses:
; S1,
; Returns without setting TF
IBMABO:
IFN FTDN60,<
; Send the notification to the operator
$WTO (<Input aborted, ^D/.RDJBT(RDR)/ cards flushed>)
; Clear the current output file
MOVE S1,.RDIFN(RDR) ;Get the IFN for the current file
$CALL F%RREL ;Release and close it
;Ignore any errors
SETZM .RDJBT(RDR) ;Clear number of cards
; Clear the abort state and the JOB state
TXZ FLAG,ABORT+JOBCD ;Do it
MOVEM FLAG,FLAG+.RDREG(RDR) ;Remember it
SETOM .RDSTS(RDR) ;Say we want status update
> ; End FTDN60
$RET
SUBTTL IBMSTS - Routine to send IBMCOM statistics message
; Given the statistics code in S1, this routine sends the message to
; QUASAR.
; Parameters:
; S1 / Code type
; Uses:
; S1, S2 and any ACs used by the send to QUASAR routine.
; Returns after QUASAR send routine without changing TF
; Simply returns if statistics are not wanted.
IBMSTS:
IFN FTIBMS,<
MOVEM S1,IBMSTM+MSHSIZ ;Save the statistics code in
;the message
MOVEI S1,IBMSTM ;Get the address of message
MOVEI S2,MSHSIZ+1 ;And the length
$CALL SENDIT ;Send it off to QUASAR
> ;End of FTIBMS
$RET ;Pass any errors up
END CDRIVE