Trailing-Edge
-
PDP-10 Archives
-
BB-J724B-SM_1982
-
sources/d60spd.mac
Click sources/d60spd.mac to
see without markup as text/plain
There are 24 other files named d60spd.mac in the archive. Click here to see a list.
; D60SPD - DN60 front end performance analysis program.
TWOSEG ;Two segment program
RELOC 400000 ;Start high
ASCIZ/
COPYRIGHT (C) 1977,1978,1979,1980,1981,1982
DIGITAL EQUIPMENT CORPORATION
/
; This software is furnished under a license and may be used
; and copied only in accordance with the terms of such license
; and with the inclusion of the above copyright notice. This
; software or any other copies thereof may not be provided or
; otherwise made available to any other person. No title to
; and ownership of the software is hereby transferred.
;
; The information in this software is subject to change
; without notice and should not be construed as a commitment
; by DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL assumes no responsibility for the use or reliability
; of its software on equipment which is not supplied by
; DIGITAL.
;
;edit history(belated)
; 4[003] 21-MAR-82 RLS GCO 4.2.1280
; in REQOUT, check for DS.ORN!DS.OPG rather than just waiting for DS.OPR
; to clear...it all happens too fast for signon device in hasp.
; 4[004] 26-APR-82 RLS GCO 4.2.1333
; fix command tables to set lpt record size to 132 instead of 80
; 4[005] 18-NOV-82 DEK GCO 4.2.1528
; Fix copyright
;Version Information
;
D60VER==4 ;Major version number
D60MIN==2 ;Minor version number
D60EDT==5 ;Edit level
D60WHO==0 ;Who last patched
;Assembly and Loading Instructions:
;
; If FTJSYS=-1 ;If assembling for use on a 20
;
; .LOAD D60SPD,C11SIM ;HELPER.REL must be on REL:[5,11]
;
; If FTJSYS=0 ;If assembling for use only on a 10
;
; .LOAD D60SPD ;HELPER.REL must be on REL:[5,11]
; .SSAVE D60SPD ;If on TOPS10
; .SAVE D60SPD ;If on TOPS20
.REQUIR REL:HELPER.REL ;Load my "HELPER"
SEARCH GALCNF
SEARCH JOBDAT,MACTEN,UUOSYM ;til this crockery is fixed
IFN FTJSYS<
SEARCH MONSYM
EXTERNAL PROTYP,PVTYP
EXTERNAL PROARG ;arg block for DN60 boot jsys
> ;IFN FTJSYS
SALL ;Suppress macro expansion
%%JOBD==%%JOBD ;Show JOBDAT version
%%MACT==%%MACT ;Show MACTEN version
%%UUOS==%%UUOS ;Show UUOSYM version
;Store Version Number in JOBVER
;
;IFE FTJSYS,<
LOC .JBVER
VRSN. D60
; >;IFE FTJSYS
..SEG== 1 ;Flag for UP-DOWN Macros
SUBTTL TOPS-20 version 5 DN60 protocol
;port enqueues are not necessary - BOOT will mediate use of port.
;one call will perform an entire io transaction similar to CAL11. uuo.
;if the error return is taken, BT6ERR will contain both a history of the
;transaction up to time of a fatal error(left half flags) as well a specific
;error flags(right half).
.BTD60==16 ;DN60 protocol operation - BOOT JSYS
.VND60==2 ;DN60 protocol type
;BTD60 ARG BLOCK
DEFST. (BT6DTE,0(T2),-1B35) ;DTE number
DEFST. (BT6ERR,1(T2),-1B35) ;returned error flags
.BT6ERR==1
;protocol flags
D6.BSY==1B0 ;port is busy - sign bitness is used in testing
D6.QHD==1B1 ;header has been queued
D6.HDD==1B2 ;to -11 done for header seen
D6.NDT==1B3 ;this is a no-data-transfer operation
D6.RED==1B4 ;this is a read data type operation
D6.QDT==1B5 ;data has been queued(for write fcn)
D6.DTD==1B6 ;to -11 done for write data seen
D6.RBL==1B7 ;to -10 doorbell for response header seen
D6.RDN==1B8 ;to -10 done for response header seen
D6.DBL==1B9 ;to -10 doorbell for read data seen
D6.DDN==1B10 ;to -10 done for read data seen
D6.FDN==1B11 ;to -10 done for read data was faked
;error flags
D6.BDP==1B30 ;bad data byte ptr
D6.ARD==1B31 ;11 attempted to send read data when
; when none was expected
D6.TRS==1B32 ;timed out waiting for response header
D6.TDT==1B33 ;timed out waiting for read data
D6.TPO==1B34 ;timed out waiting for port to be free
D6.NT6==1B35 ;not a DN60 front end
D6.SER==D6.BDP!D6.ARD!D6.TRS!D6.TDT!D6.TPO!D6.NT6 ;all errors
DEFST. (BT6HBC,2(T2),-1B17) ;DN60 header byte count
DEFST. (BT6HDR,2(T2),777777B35);DN60 header address(begins on word)
DEFST. (BT6DBC,3(T2),-1B35) ;data byte count
; positive => write data mode
; zero => no data transfer
; negative => read data mode
DEFST. (BT6PTR,4(T2),-1B35) ;data byte ptr
;the following are returned for timing analysis
DEFST. (BT6TMR,5(T2),-1B35) ;time of request
DEFST. (BT6TAS,6(T2),-1B35) ;TIME DTE ASSIGNED
DEFST. (BT6THQ,7(T2),-1B35) ;time header queued to 11
DEFST. (BT6TRD,10(T2),-1B35) ;time of -10 done for response header
DEFST. (BT6TDD,11(T2),-1B35) ;time of -10 done for data
DEFST. (BT6TFR,12(T2),-1B35) ;time finished request
BT6SIZ==13 ; length of boot block
;DN60 header definitions
DEFST. (D6FCN,XMTHDR+0,177777B15);xmitted function code
DEFST. (D6RSP,XMTHDR+0,377B7) ;returned response code
DEFST. (D6FCD,XMTHDR+0,377B15) ;returned function code
DEFST. (D6ADR,XMTHDR+0,177777B31);address for examine/deposit
DEFST. (D6DAT,XMTHDR+1,177777B15);data from examine/for deposit
DEFST. (D6LIN,XMTHDR+0,377B23) ;line number
DEFST. (D6DEV,XMTHDR+0,377B31) ;device code
DEFST. (D6CNT,XMTHDR+1,177777B15);requested byte count to transfer
;end of original header definitons
;begin extended header
DEFST. (D6AR3,XMTHDR+1,177777B31);reserved
DEFST. (D6DST,XMTHDR+2,37777777777B31);returned device status
DEFST. (D6LST,XMTHDR+3,37777777777B31);returned line status
D6HWSZ==4 ;number of 36 bit words in header
D6HBSZ==4*D6HWSZ ;number of 8 bit bytes in header
;Define a Macro to call the .NAME macro with the right args
; Define the .NAME Macro to be what you want, then call this Macro.
; it's used to generate D60SPD'S version correctly
DEFINE .CLNAM<
DEFINE .CLNM(LETTER,WHO)<
IRPC LETTER,<
IFE "A"-"'LETTER'"+D60MIN-1,<
STOPI
IFIDN <LETTER><@>,<
IFE D60WHO,< .NAME(\D60VER,,\D60EDT,)>
IFN D60WHO,< .NAME(\D60VER,,\D60EDT,-WHO)>>
IFDIF <LETTER><@>,<
IFE D60WHO,< .NAME(\D60VER,LETTER,\D60EDT,)>
IFN D60WHO,< .NAME(\D60VER,LETTER,\D60EDT,-WHO)>>>>>
IFGE D60MIN-^D26,< D60MIN==0
PRINTX %Minor version too large - ignored>
IFGE D60WHO-7,< D60MIN==
PRINTX %D60WHO is too large - ignored>
.CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\D60WHO)
>
;Now Define a .NAME Macro to make a Title
DEFINE .NAME(V,M,E,W)<
TITLE D60SPD DECsystem-10 Program to Measure DN60 Performance - ver V'M'('E')'W
>
;Now make a Title
;
.CLNAM
SUBTTL Default Values
ND PDSIZ,^D100 ;Default PDL size
ND PATSIZ,^D20 ;Patch size
ND EOFLOP,^D100 ;Number of times to loop waiting
; for EOF to set
ND DOLLOP,^D200 ;Number of times to accept a Delayed
; return in succession while doing
; Output
ND NLSTAT,^D15 ;Give header after this many LINES
ND NUMBUF,^D10 ;Number of ring buffers
ND INDL10,^D4095 ;Input buffer will accept this many
; (This could be increased)
; bytes on a DL10
ND INDTE,^D4095 ;Input buffer will accept this many
; bytes on a DTE20
ND OUTBYT,^D4095 ;Output buffer is this large
ND PORT,13 ;Largest port number we accept
ND DEBOUT,0 ;If non 0, instead of doing the
; CAL11. UUO, output the buffer
; to users TTY.
ND C11E4S,^D500 ;Number of MS to hiber on a CAL11.
; Error-4 before retrying.
ND REQOP,^D30 ;Times to request output permission
; before giving up.
ND MREQOP,^D10 ;Number of times to multiply
; REQOP by when in NOTYPEAHEAD mode
ND TREQOP,^D500 ;Number of MS to sleep between
; each try.
ND RPTTIM,^D10 ;Default number of seconds
; between each I/O statistics report
ND DOBTIM,^D1000 ;Number of milliseconds to HIBER while
; waiting for the "output buffers
; being dumped" to clear before
; checking again.
ND CHRMAX,^D74 ;Number of characters to buffer before
; doing an OUTSTR
ND FRCMAX,^D100 ;Size of character buffer for MACRO type
; commands - see FRCCMD and/or FRLIDV.
ND MAXUNT,^D5 ;Maximum number of units per device
ND SIGNDV,3 ;SIGNON device number
ND JP%SYS,0 ; release 5 symbol
ND LO.Q,2 ; low priority scheduler queue to run in
ND HI.Q,1 ; high priority scheduler queue to run in
SUBTTL Symbol Definitions
;Accumulator Assignments
F= 0 ;Flag Register
T1= 1 ;T1-T5 are utility ACS
T2= 2
T3= 3
T4= 4
T5= 5
P1= 6 ;P1-P4 are preserved ACS
P2= 7
P3= 10
P4= 11
C= 12 ;INPUT/OUTPUT character
B= 13 ;Utility byte pointer
U1= 15 ;Reserved for UUO handler
U2= 16 ;Reserved for UUO handler
P= 17 ;Pushdown Pointer
;I/O Device Channels
DEV== 1 ;INPUT/OUTPUT Device
AUTO== 2 ;AUTO Device
.ASSPC==40 ;Space
SUBTTL CAL11. UUO Definitions
;Functions
.C11DP==0 ;Deposit function
.C11EX==1 ;Examine function
.C11QU==2 ;Queue request function
.C11NM==3 ;Return name of program running
.C11UP==4 ;Return 0 if PDP11 is down
;Return 1 if PDP11 is up
;Error codes
C11NP%==1 ;Caller does not have POKE privileges
C11UF%==2 ;The function is undefined on this
; type of front end
C11ND%==3 ;Invalid DL10 port number
C11IU%==4 ;CAL11. facility in use, try again later
C11NA%==5 ;No answer from the front end after
; 1-2 seconds
C11TS%==6 ;Queue entry too short (DC76 only)
C11NE%==7 ;Not enough arguments
C11AI%==10 ;Examine/Deposit address was invalid
; (more than 16 bits or front end flagged
; it as invalid), or deposit data
; was more than 16 bits
C11OR%==11 ;In .C11QU, illegal function code,
; address check, illegal byte size, byte
; offset is outside buffer, or buffer
; is too large (requires more than
; 16 DL10 byte pointers)
;For .C11QU function
;
; MOVE AC,[XWD Length,Address]
; CAL11. AC,
; Error return
; Success return
;
;
;ADR: XWD Port number,.C11QU
; XWD Line number,Device number
; XWD Number of bytes,Function code
; XWD Length of buffer,Buffer address
; BYTE (12) Number of bytes per word (24) Position of first byte
; XWD Number of bytes transferred,Result code
;Definitions to access the "C11BLK"
;
DEFST. (C%PORT,C11BLK,-1B17) ;The Port number
DEFST. (C%LINE,C11BLK+1,-1B17) ;The Line number
DEFST. (C%DEV,C11BLK+1,777777) ;The Device number
DEFST. (C%NBYT,C11BLK+2,-1B17) ;The number of Bytes
DEFST. (C%FC,C11BLK+2,777777) ;The function Code
DEFST. (C%BUFS,C11BLK+3,-1B17) ;The Buffer size
DEFST. (C%BUFA,C11BLK+3,777777);The Buffer address
DEFST. (C%BPW,C11BLK+4,-1B11) ;The number of Bytes per Word
DEFST. (C%PFB,C11BLK+4,77777777);The position of the First Byte
DEFST. (C%BXFD,C11BLK+5,-1B17) ;The number of Bytes XFED
DEFST. (C%RC,C11BLK+5,777777) ;The Result code
;DN60 Definitions
;
FC.RD== 1 ;Read Data
FC.WD== 2 ;Write Data
FC.RDS==3 ;Read Device Status
FC.WDC==4 ;Write Device cmd
FC.RLS==5 ;Read Line Status
FC.WLC==6 ;Write line cmd
FC.R6S==7 ;Read DN60 Status
FC.W6C==10 ;Write DN60 cmd
FC.MAX==10 ;Maximum function code
;Result code definitions
;
RC.SUC==1 ;Operation successful
RC.DLY==2 ;Operation delayed
RC.REJ==3 ;Operation rejected, read status
;Device Command Definitions
;
DC.SC== 1 ;Set characteristics
; DC.???==2 ;Reserved
DC.DOB==3 ;Dump output buffers
DC.CIP==4 ;Clear input permission was requested
; DC.???==5 ;Reserved
DC.SCI==6 ;Set "interpret carriage control
; on input" ( be a printer )
DC.CCI==7 ;Clear "interpret carriage control
; on input"
DC.SCO==^D8 ;Set "interpret carriage control
; on output"
DC.CCO==^D9 ;Clear "interpret carriage control
; on output"
; DC.???==^D10 ;Reserved
; DC.???==^D11 ;Reserved
DC.SCC==^D12 ;Specify output component selection
DC.DCC==^D13 ;Don't do output component selection
DC.SLC==^D14 ;Set printer line counter
DC.CLC==^D15 ;Disable printer line counter overflow
; DC.???==^D16 ;Reserved
DC.SSC==^D17 ;Do space compression on output
DC.CSC==^D18 ;Don't do space compression on output
DC.S27==^D19 ;Use old protocol
DC.C27==^D20 ;Don't use old protocol
DC.ROP==^D21 ;Request output permission
DC.GIP==^D22 ;Grant input permission
DC.SOE==^D23 ;Signal output EOF
DC.COE==^D24 ;Clear output EOF complete
DC.SOA==^D25 ;Signal output abort
DC.COA==^D26 ;Clear output abort complete
DC.CIE==^D27 ;Clear input EOF complete
DC.SIA==^D28 ;Signal input abort
DC.CIA==^D29 ;Clear input abort complete
DC.SDH==^D30 ;Suspend device HASP
DC.UDH==^D31 ;Unsuspend device HASP
DC.SRS==^D32 ;Set record size
DC.LST==^D32 ;Last Command
;Line Command Definitions
;
LC.EL= 1 ;Enable the line
LC.DTR==2 ;Set DTR
LC.ABT==3 ;Abort all data transfers and hang up
LC.DIS==4 ;Disable the line
LC.CSD==5 ;Clear to send delay in jiffies
LC.WAR==6 ;Number of bytes in silo warning
; area
LC.STR==7 ;Set output transparency
LC.CTR==^D8 ;Clear output transparency
LC.TBL==^D9 ;Set transmission block length
LC.RPM==^D10 ;Set records per message
LC.SLS==^D11 ;Set line signature
LC.LST==^D11 ;Last Command
;Number of bytes returned when reading status
;
D6.BYT==^D79+1 ;DN60 Status
LS.BYT==^D69+1 ;Line Status
DS.BYT==^D13+1 ;Device Status
;
D6.LEN==1B35 ;LINE ACTIVE BIT
;
;Device Status Definitions as returned in
; AC(T1) from the call to "RDDVS"
;
DS.B31==1B4 ;(31) Reserved
DS.B30==1B5 ;(30) Reserved
DS.IPW==1B6 ;(29) Input permission was requested
DS.IEC==1B7 ;(28) Input EOF complete
DS.IAC==1B8 ;(27) Input abort complete
DS.IAS==1B9 ;(26) Input abort started
DS.IRN==1B10 ;(25) Input running
DS.IPG==1B11 ;(24) Input permission granted
DS.IPR==1B12 ;(23) Input permission requested
DS.OAC==1B13 ;(22) Output abort complete
DS.OAS==1B14 ;(21) Output abort started
DS.OEC==1B15 ;(20) Output EOF complete
DS.OES==1B16 ;(19) Output EOF signaled
DS.ORN==1B17 ;(18) Output running
DS.OPG==1B18 ;(17) Output permission granted
DS.OPR==1B19 ;(16) Output permission requested
DS.B15==1B20 ;(15) Reserved
DS.B14==1B21 ;(14) Reserved
DS.B13==1B22 ;(13) Reserved
DS.OBD==1B23 ;(12) Output buffers being dumped
DS.X27==1B24 ;(11) Old BSC protocol (2780)
DS.XPI==1B25 ;(10) Page counter interrupts enabled
DS.XPO==1B26 ;(9) Page counter has overflowed
DS.XCX==1B27 ;(8) Do compress/expand
DS.XCS==1B28 ;(7) Do component selection
DS.OTP==1B29 ;(6) Send output in transparent BSC
DS.OCC==1B30 ;(5) Interpret output carriage control
DS.ICC==1B31 ;(4) Interpret input carriage control
DS.B3== 1B32 ;(3) Reserved
DS.B2== 1B33 ;(2) Reserved
DS.B1== 1B34 ;(1) Reserved
DS.B0== 1B35 ;(0) Reserved
;Line Status Definitions as
; returned in AC(T1) from the call to "RDLNS"
;
; Right Half = Flags Byte
;
LF.TSP==1B33 ;(2) Transparency on
LF.PRI==1B34 ;(1) Primary BSC station
LF.SIM==1B35 ;(0) Simulate mode
;
; Left Half = Line Info Byte
;
LI.DSR==1B15 ;(2) Data Set Ready
LI.DTR==1B16 ;(1) Data Terminal Ready
LI.ENB==1B17 ;(0) Line is enabled
SUBTTL LUUO Definitions
;LUUO Definitions
;
; OP-CODE definitions
;
OPDEF TELL [001000,,0] ;Write ASCIZ string
OPDEF TELL6 [002000,,0] ;Write SIXBIT word
OPDEF CHR [003000,,0] ;Write immediate character
OPDEF RAD10 [004000,,0] ;Print decimal number
OPDEF RAD08 [005000,,0] ;Print octal number
OPDEF FLTPNT [006000,,0] ;Print floating point number
OPDEF TIME [007000,,0] ;Print time HH:MM:SS.SSS
; but fill in with 0's
OPDEF TIMENZ [010000,,0] ;Print time HH:MM:SS.SSS
; but don't fill in 0's
OPDEF SNOOZE [011000,,0] ;Sleep E millisec
;Destination of UUO is determined by AC field as follows:
;
USR== 1 ;Tell user
NAC== 2 ;Suppress action characters on TELL UUO
FRC== 4 ;Put character in FRCBUF for later decodeing
;Destination field bits right justified
;
UU.USR==1B35 ;user
UU.NAC==1B34 ;Don't suppress 6bit blanks
UU.FRC==1B33 ;Put character in FRCBUF for later decoding
UU.FRC==1B33 ;Output to FRCBUF for decoding
; internal type commands
;Flags (in Accumulator F)
F.RSCN==1B35 ;CHARACTER INPUT INHIBIT
F.IBRK==1B34 ;BREAK SEEN ON TTY INPUT
F.BUSY==1B33 ;I'M BUSY NOW
F.RES== 1B31 ;NOT STARTED
F.TRAN==1B30 ;TRANSPARENT MODE
F.STAT==1B29 ;WANT STATISTICS
F.HEAD==1B28 ;WANT STATISTICS HEADER
F.OUT== 1B27 ;OUTPUT
F.IN== 1B26 ;INPUT
F.DEV== 1B25 ;USE FILE ON A DEVICE FOR INPUT OR OUTPUT
F.FSTS==1B24 ;FORCE STATISTICS
F.RCVI==1B23 ;RECEIVED SOME INPUT
F.AOUT==1B22 ;1 = ABORT OUTPUT, 0 = ABORT INPUT
F.ABTI==1B20 ;1 = ABORT INPUT
F.ABTO==1B19 ;1 = ABORT OUTPUT
F.ABTW==1B18 ;1 = WAIT FOR ENTIRE ABORT SEQUENCE
; TO COMPLETE.
; 0 = JUST ISSUE THE ABORT COMMAND
F.KL10==1B17 ;1 = RUNNING ON A KL10
F.OABT==1B16 ;1 IF ABORT OUTPUT ABORT CMD DONE
F.IABT==1B15 ;1 IF ABORT INPUT ABORT CMD DONE
F.T20== 1B14 ;1 IF RUNNING ON TOPS20 0 IF
; RUNNING ON TOPS10
F.AEOF==1B13 ;EOF ON AUTO FILE SEEN
F.AUTO==1B12 ;PROCESSING AN AUTO FILE
F.FCOM==1B11 ;DOING A FORCED (INTERNAL) COMMAND
F.EOLC==1B10 ;/FCHAR IS .LT. 25
F.DOB== 1B9 ;AFTER EACH WRITE DATA DUMP THE
; OUTPUT BUFFERS
F.SIM== 1B8 ;1 IF SET SIM; 0 IF SET SUP
Subttl OPDEF's
OPDEF TRO [IORI] ;IORI is faster on a KL
OPDEF TRZ [ANDCMI] ;ANDCMI is faster on a KL
OPDEF TDO [IOR] ;IOR is faster on a KL
OPDEF TDZ [ANDCM] ;ANDCM is faster on a KL
SUBTTL Macro Definitions
;Switch Macro's
;
;MACRO'S USED IN THE GENERATION OF COMMAND TABLES AND
; THEIR CORRESPONDING DISPATCH AND DEFAULT VALUE TABLES.
;
;Definition of the arguments to Macro SWT
;
; NAM ;Name of the switch
; ADR ;Address to dispatch to, or
; ; to store a value in.
; CODE ; 0 = check switch has a colon before
; ; dispatching to ADR.
; ; 1 = store SIXBIT arg in ADR.
; ; 2 = store DECIMAL arg in ADR.
; ; 3 = store OCTAL arg in ADR.
; ; 4 = dispatch to ADR without checking
; ; for a colon.
; ; 5 = store SIXBIT arg in T1
; ; and dispatch to ADR.
; ; 6 = store DECIMAL arg in T1
; ; and dispatch to ADR.
; ; 7 = store OCTAL arg in T1
; ; and dispatch to ADR.
; ; 1X= print a CRLF when doing auto file
;
; DEFVAL ;Default value given to switch. ( optional )
;MACRO DEFINITION TO DEFINE "SWT" TO GENERATE SIXBIT SWITCH NAMES
;
DEFINE SWTNAM(TAG),<
DEFINE SWT(NAM,ADR,CODE,DEFVAL),<
SIXBIT \NAM\ ;NAM
>;END DEFINE SWT FOR SWTNAM
TAG'TAB: NAMES ;GENERATE THE TABLE OF SWITCH NAMES
.NM'TAG==.-TAG'TAB ;LENGTH OF TAG'TAB
>;END DEFINE SWTNAM
;MACRO DEFINITION TO DEFINE "SWT" TO GENERATE THE DISPATCH OR STORE ADDRESS
;
DEFINE SWTDSP(TAG),<
DEFINE SWT(NAM,ADR,CODE,DEFVAL),<
BYTE (4) CODE (14) 0 (18) ADR ;NAM
>;END DEFINE SWT FOR SWTDSP
TAG'DSP: NAMES ;GENERATE THE DISPATCH TABLE
>;END DEFINE SWTDSP
;MACRO DEFINITION TO DEFINE "SWT" TO GENERATE THE DEFAULT VALUE TABLE
;
DEFINE SWTDEF(TAG),<
DEFINE SWT(NAM,ADR,CODE,DEFVAL),<
IFN <CODE&3>,<
XWD DEFVAL,ADR ;NAM
>;END IFN <CODE&3>
IFE <CODE&3>,<
Z ;NO DEFAULT VALUE FOR NAM
>;END IFE <CODE&3>
>;END DEFINE SWT FOR SWTDEF
TAG'DEF: NAMES ;GENERATE THE DEFAULT VALUE TABLE
>;END DEFINE SWTDEF
;MACRO DEFINITION TO BUILD THE NAME, DISPATCH, AND DEFAULT VALUE TABLES
;
;Definition of the arguments to Macro BUILD
;
; TAG ;Prefix of the labels for each table
; ; this prefix must contain 3 or less
; ; characters.
; ; TAG'NAM is the label given for the table
; ; generated by the SWTNAM macro
; ;The length of each table will be represented
; ; by the symbol, .NM'TAG
; ; TAG'DSP is the label given for the dispatch
; ; table generated by the SWTDSP macro.
; ; TAG'DEF is the label given for the default
; ; value table generated by the SWTDEF macro.
;
; NAM ;If this argument is present macro SWTNAM
; ; will be invoked to generate the name table
; DSP ;If this argument is present, macro SWTDSP
; ; will be invoked to generate the dispatch table
; DEF ;If this argument is present, macro SWTDEF
; ; will be invoked to generate the default table
;
DEFINE BUILD(TAG,NAM,DSP,DEF),<
IFNB <NAM>,< SWT'NAM(TAG) ;BUILD NAME TABLE>
IFNB <DSP>,< SWT'DSP(TAG) ;BUILD THE DISPATCH TABLE>
IFNB <DEF>,< SWT'DEF(TAG) ;BUILD THE DEFAULT VALUE TABLE>
>;END DEFINE BUILD
;Error Macro Call
;
; 1st Arg TYP E = Print ?, W = Print %
E.Q== 1 ;0 = %, 1 = ?
E.NC== 2 ;0 = CRLF, 1 = NO CRLF
;
; 2nd Arg CRLF Y = Give CRLF at end, N = Don't give CRLF
;
; 3rd Arg CODE Unique 3 letter code to be tacked onto D60
;
; 4th Arg TXT Message to be printed after D60??? -
;
; 5th Arg WHERE Where to go after Error Call. There is a
; max of 31. Places to go. These places are
; placed on the PDL, so each place called must
; exit via a POPJ P,. The last arg in WHERE
; is the final destination, and before going
; to the final destination AC'S T0-T4 ARE
; restored.
;
DEFINE ERROR (TYP,CRLF,CODE,TXT,WHERE),<
XLIST
S..'CODE:!JRST [PUSHJ P,ERR
Z....Z==0
IFB <CODE>,<
PRINTX ?3 CHAR identifier argument missing in Error Macro call.
>;END CHECK FOR CODE
IFDIF <TYP> <E>,<
IFDIF <TYP> <W>,<
PRINTX ?Illegal .TYP. argument in D60'CODE Error Macro call.
>>;END CHECK FOR TYP
IFDIF <CRLF> <Y>,<
IFDIF <CRLF> <N>,<
PRINTX ?Illegal .CRLF. argument in D60'CODE Error Macro call.
>>;END CHECK FOR CRLF
IFIDN <TYP> <E>,< Z....Z==Z....Z!E.Q>
IFIDN <CRLF> <N>,< Z....Z==Z....Z!E.NC>
BYTE (5) Z..'CODE (13) Z....Z (18) [ASCIZ \TXT\]
Z..'CODE=0
IFB <WHERE>,<PRINTX ?Destination ARG missing for D60'CODE in Error Macro call.>
IRP WHERE,<
IFE Z..'CODE,< XWD ''CODE'',WHERE ;3 CHAR CODE,,FINAL DESTINATION>
IFN Z..'CODE,< XWD 0,WHERE>
IFG <Z..'CODE-37>,<PRINTX ?Too many places to go in D60'CODE'.>
Z..'CODE==Z..'CODE+1>]
LIST >;END DEFINE ERROR
;MACRO TO RELOC TO HISEG
;
DEFINE UP<
IFE ..SEG<XLIST
LIT
VAR
RELOC
..SEG==1
LIST
SALL
>>
;MACRO TO RELOC TO LOWSEG
;
DEFINE DOWN<
IFE ..SEG-1<XLIST
LIT
RELOC
..SEG==0
LIST
SALL
>>
;TURN OFF A BIT IN F
;
DEFINE OFF(BIT)<
TXZ F,BIT ;TURN OFF (BIT) IN F
>
;TURN ON A BIT IN F
;
DEFINE ON(BIT)<
TXO F,BIT ;TURN ON (BIT) IN F
>
SUBTTL The Message Macro
;CALL IS:
; MSG(CODE,TYPE,CRLF,BODY)
;
;WHERE
; CODE Is the three letter error code
; TYPE is one of:
; E Error (?)
; W Warning (%)
; M Message ([)
;
; CRLF is either (Y) to append a <CR> or (N)
; BODY is the message itself
;
;FIRST A MACRO TO GENERATE AN ASCIZ STRING WITH A CRLF TACKED ON
;
DEFINE ASCIC(STRING),<
XLIST
ASCIZ \STRING
\
LIST
SALL>
;DEFINE MACRO TO GENERATE ASCIZ STRING WITHOUT CRLF
;
DEFINE ASCIN(STRING),<
XLIST
ASCIZ \STRING\
LIST
SALL
>
;THE MSG MACRO LIVES ON THE NEXT PAGE BECAUSE OF IT'S SIZE
;NOW THE MSG MACRO
;
DEFINE MSG(CODE,TYPE,CRLF,BODY),<
XLIST
IFDIF <TYPE> <E>,<
IFDIF <TYPE> <W>,<
IFDIF <TYPE> <M>,<
PRINTX ?ILLEGAL .TYPE. ARGUMENT TO MSG MACRO - CODE
PASS2
END>>>
IFDIF <CRLF> <Y>,<
IFDIF <CRLF> <N>,<
PRINTX ?ILLEGAL .CRLF. ARGUMENT TO MSG MACRO - CODE
PASS2
END>>
IF1 <
IFDEF CODE'% ,<
PRINTX ?MULTIPLY DEFINED ERROR MNEMONIC - CODE
PASS2
END>>
CODE'%: BLOCK 0 ;;DEFINE THE STARTING LOCATION
IFIDN <TYPE> <E>,<
IFIDN <CRLF> <Y>,<
ASCIC(?D60'CODE' - 'BODY)
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \?D60'CODE' - 'BODY\
>>
IFIDN <TYPE> <W>,<
IFIDN <CRLF> <Y>,<
ASCIC(%D60'CODE' - 'BODY)
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \%D60'CODE' - 'BODY\
>>
IFIDN <TYPE> <M>,<
IFIDN <CRLF> <Y>,<
ASCIC([D60'CODE' - 'BODY])
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \[D60'CODE' - 'BODY\
>>
LIST
SALL
>
SUBTTL Device Control Cells
DOWN
; !=======================================================!
; ! DEVICE NAME !
; !-------------------------------------------------------!
; ! FILENAME !
; !-------------------------------------------------------!
; ! EXTENSION !
; !-------------------------------------------------------!
; ! PPN OR PATH POINTER !
; !-------------------------------------------------------!
; ! !
; / PATH BLOCK /
; / /
; / (8 WORDS) /
; ! !
; !-------------------------------------------------------!
; ! BUFFER RING HEADER !
; !-------------------------------------------------------!
; ! BUFFER BYTE POINTER !
; !-------------------------------------------------------!
; ! BUFFER BYTE COUNT !
; !=======================================================!
;Control Cell Indices
.CCDEV==0 ;DEVICE
.CCNAM==1 ;FILE NAME
.CCEXT==2 ;EXTENSION
.CCPPN==3 ;PPN OR XWD 0,ADR OF PATH
.CCPTH==4 ;PATH BLOCK
.CCEND==13 ;END OF FILESPEC BLOCK
.CCBHD==14 ;BUFFER RING HEADER
.CCBBP==15 ;BUFFER BYTE POINTER
.CCBBC==16 ;BUFFER BYTE COUNT
DEFINE DEVBUF(..DEV),<
..DEV'BRH: BLOCK 0
..DEV'BH: BLOCK 1
..DEV'BP: BLOCK 1
..DEV'BC: BLOCK 1
>
DEFINE DEVCEL(.DEV),<
DEV'.DEV: BLOCK 0
.DEV'DEV: BLOCK 1
.DEV'NAM: BLOCK 1
.DEV'EXT: BLOCK 1
.DEV'PPN: BLOCK 1
.DEV'PTH: BLOCK 10
DEVBUF(.DEV)
>
;NOW GENERATE THE DEVICE CONTROL CELLS
DEVBEG: BLOCK 0 ;BEGINNING OF DEVICE CONTROL CELLS
DEVCEL(DEV) ;FOR THE INPUT/OUTPUT DEVICE
DEVOPN: BLOCK 3 ;INPUT DEVICE OPEN BLOCK
DEVCEL (AUT) ;FOR THE AUTO DEVICE
AUTOPN: BLOCK 3 ;AUTO DEVICE OPEN BLOCK
DEVEND==.-1 ;END OF CONTROL CELLS
SUBTTL Commonly Used Byte Pointers
UP
P.UAC: POINT 4,.JBUUO,12 ;AC FIELD
P.UOP: POINT 9,.JBUUO,8 ;OP CODE
SUBTTL Beginning of the Program
UP
STARTE: TELL USR,@T1 ;GIVE THE ERROR MESSAGE
STARTZ: CLRBFI ;ERROR, SO CLEAR TTY BUF
IFE DEBOUT,<
IFN FTJSYS,<
PUSHJ P,RELJFN ;RELEASE JFN IF NECESSARY
>;END IFN FTJSYS
>;END IFE DEBOUT
START: RESET ;INIT THE WORLD
STORE (17,0,17,0) ;CLEAR AC'S 0-17
STORE (T1,FIRZRO,LSTZRO,0) ;CLEAR SOME LOCATIONS
MOVX T1,TTYIN ;POINT SCANNER TO
MOVEM T1,L.SCIN ; THE TTY:
MOVX T1,CONTTY ;
MOVEM T1,L.SCLN ;
MOVE P,[IOWD PDSIZ,PDLST] ;SETUP THE PDL
IFN FTJSYS,<
MOVX T1,.FHSLF ; set ourselves to be a system process
MOVX T2,<<HI.Q>B29+<LO.Q+1>+JP%SYS>; JP%SYS only works for release 5+
SPRIW ; do it
>
PUSHJ P,STRINI ;INIT STRING OUT CODE
IFE DEBOUT,<
IFN FTJSYS,<
PUSHJ P,RELJFN ;BE SURE JFN IS RELEASED
>;END IFN FTJSYS
>;END IFE DEBOUT
MOVE T1,[PUSHJ P,UUO0] ;WHAT TO DO ON AN LUUO
MOVEM T1,.JB41 ;LUUO DISPATCH ADDRESS
HRRZ T1,.JBFF ;GET FIRST FREE
; PUSHJ P,CORUUO ;SHRINK BACK TO ORIGINAL SIZE
JUMPPT (T1,NOTKL,NOTKL,NOTKL,KL10) ;FIND OUT WHAT TYPE
; OF CPU WERE RUNNING ON.
ERROR (W,Y,CPU,<Unknown type of CPU - assuming non KL>,<NOTKL>)
;
; HERE WHEN WE KNOW WE ARE ON A KL10
;
KL10: TXO F,F.KL10 ;SET KL10 BIT
NOTKL:
IFN FTJSYS,<
MOVX T3,%CNMNT ;FIND OUT WHAT TYPE
GETTAB T3, ; OF MONITOR WE'RE RUNNING ON
ERROR (E,Y,GTM,<GETTAB UUO failed getting type of monitor>,<ERREXT>)
LDB T3,[POINTR T3,CN%MNT] ;GET MONITOR CODE
CAXN T3,1 ;SEE IF TOPS10
JRST STARTC ;YES
CAXE T3,4 ;SEE IF TOPS20
ERROR (E,Y,UNM,<Unknown monitor type (^1)>,<ERREXT>)
ON F.T20 ;FLAG RUNNING ON TOPS20
IFE DEBOUT,<
PUSHJ P,RELJFN ;RELEASE JFN IF WE HAVE ONE
>;END IFE DEBOUT
JSYS 147 ;DO A TOPS20 STYLE RESET
JRST STARTD ;
>;END IFN FTJSYS
STARTC: MOVX T1,%CNTIC ;GET TICKS PER SECOND
GETTAB T1, ;GET 50 OR 60
MOVX T1,^D60 ;IF EVER FAIL ASSUME 60
MOVEM T1,JIFSEC ;REMEMBER TICKS PER SECOND
STARTD: SKIPN ONCE# ;Did we already output the header?
TELL USR,[ASCIC([ D60SPD Test program for DN62/DN65 IBM communications ])]
SETOM ONCE#
ON F.RES ;WE'RE RESET SINCE WE'RE STARTING
PUSHJ P,PROMPT ;GIVEM A START
PUSHJ P,OPER ;GO LOOK FOR A COMMAND
PUSHJ P,.SCEOL ;EAT REST OF INPUT
IFE DEBOUT,<
IFN FTJSYS,<
PUSHJ P,RELJFN ;RELEASE JFN IF WE HAVE ONE
>;END IFN FTJSYS
>;END IFE DEBOUT
JRST START
ERREXT: CLRBFI ;CLEAR TTY INPUT
IFE DEBOUT,<
IFN FTJSYS,<
PUSHJ P,RELJFN ;RELEASE ANY JFN
>;END IFN FTJSYS
>;END IFE DEBOUT
RESET ;CLEAN UP
IFN FTJSYS,<
TXNE F,F.T20 ;RUNNING ON TOPS20?
JSYS 147 ;DO A TOPS20 STYLE RESET
>;END IFN FTJSYS
EXIT ;EXIT CAUSE CAN'T RUN
SUBTTL Operator Commands -- Setup and Dispatch
;Here to process interactive commands
;
; Valid switch names are in table "COMTAB" and
; the corresponding dispatch address is in
; table "COMDSP".
; This routine prompts a " / " at the completion of
; a routine unless the busy flag (F.BUSY) is set
; and then the prompt will be a " ! ".
;
; CALL: PUSHJ P,OPER ;
; RETURN AT COMPLETION OF CMD ;
;
OPER: OFF F.IBRK ;TURN OFF BREAK FLAG
PUSHJ P,S$SIX ;GET A COMMAND
JRST OPER5 ;THERE ISN'T ONE?
JUMPE T1,OPER1 ;NULL COMMAND, CLEAN UP AND RETURN
MOVEM T1,L.CMD ;SAVE THE COMMAND
MOVX T2,COMTAB ;ADDRESS OF COMMAND TABLE
HRLI T2,-.NMCOM ;AND TABLE LENGTH
PUSHJ P,UNIQ6 ;GET A UNIQUE COMMAND
JRST OPER4 ;COMMAND NOT UNIQUE
TXNN F,F.FCOM ;FORCED COMMAND?
TXNN F,F.AUTO ;DOING AN AUTO FILE?
JRST OPER0 ;
LDB T2,[POINT 1,COMDSP(T1),0] ;GET BIT TO SEE IF WE NEED A CRLF
SKIPE T2 ;IF 1 WE NEED A CRLF
TELL USR,CRLF ;YES, GIVE A CRLF HERE SO
; COMMAND DOESN'T GET OVERPRINTED
OPER0: PUSHJ P,@COMDSP(T1) ;DISPATCH COMMAND
PJRST STARTE ;ERROR RETURN, MSG ADR IN T1
OPER1: PUSHJ P,.SCEOL ;EAT THE REST OF THE LINE
TXNN F,F.RES ;ARE WE RESET?
JRST OPER3 ;NO, CHECK FOR PAUSE
POPJ P, ;RETURN TO CALLER
OPER3: CHR USR,"!" ;TYPE AN EXCLAMATION POINT
POPJ P, ;AND RETURN
OPER4: TELL USR,ILC% ;ILLEGAL COMMAND
CAIA ;SKIP THE OTHER ERROR
OPER5: TELL USR,CER% ;COMMAND ERROR
JRST OPER1 ;AND CONTINUE
;COMMANDS AND COMMAND DISPATCH TABLE
DEFINE NAMES,<
SWT ABORT,ABTCOM,14
SWT AUTO,AUTCOM,4
SWT DDT,DDTCOM,14
SWT EOF,EOFCOM,14
SWT EXIT,EXTCOM,14
SWT HELP,HLPCOM,14
SWT INPUT,INCOM,4
SWT OUTPUT,OUTCOM,4
SWT PARAM,PRMCOM,14
SWT RESTAR,RSTCOM,14
SWT SET,SETCOM,4
SWT SLEEP,SLPCOM,4
SWT STATUS,STSCOM,4
SWT TIME,IOTIM,4
SWT NOTYPE,NOTCOM,4
SWT TYPEAH,TYPCOM,4
SWT WHAT,WHTCOM,14
>
;BUILD THE TABLE OF SWITCH NAMES AND THE DISPATCH TABLE
;
BUILD (COM,NAM,DSP) ;TABLES HAVE PREFIX OF 'COM'
SUBTTL Commands
;DDTCOM -- DDT COMMAND
;
; CALLS DDT IF LOADED
;
DDTCOM: PUSHJ P,.SCEOL ;EAT THE LINE OF INPUT
HRRZ T2,.JBDDT ;GET DDT ADDRESS
MOVX T1,DDT% ;NO DDT
JUMPE T2,CPOPJ ;GO TO IT IF THERE
TELL USR,[ASCIC([ Entering DDT ])]
PUSHJ P,(T2) ;NOW GO DO IT
PJRST CPOPJ1 ;GIVE A SKIP RETURN
GOBACK: POP P,(P) ;CLEAN OFF PDL
PJRST CPOPJ1 ;GIVE WIN RETURN
;HLPCOM -- HELP COMMAND
;
; CALLS HELPER TO TYPE OUT D60SPD.HLP
;
HLPCOM: MOVE 1,['D60SPD'] ;NAME OF HLP FILE
PUSHJ P,.HELPR## ;CALL THE HELPER AND RETURN
PJRST CPOPJ1 ;GIVE SKIP RETURN
;EXTCOM -- EXIT COMMAND
;
; COME HERE TO EXIT D60SPD. DOES A MONRT.
; TO EXIT AND IF A CONTINUE IS GIVEN, D60SPD
; IS RESTARTED FROM THE BEGINNING
;
EXTCOM: PUSHJ P,.SCEOL ;EAT UP THE LINE
TELL USR,[ASCIC([ D60SPD stop ])] ;BE SMART
MONRT. ;RETURN TO MONTIOR
TELL USR,[ASCIC([ Welcome back to D60SPD ])] ;BE A SMARTY
PJRST CPOPJ1 ;CONTINUE FROM WHERE WE LEFT
;INCOM -- INPUT COMMAND
;
; COMMAND TO DO INPUT FROM THE DN60
;
INCOM: OFF F.OUT ;INDICATE INPUT
ON F.IN ;
PJRST IOCOM ;GO TO INPUT-OUTPUT ROUTINE
;OUTCOM -- ROUTINE TO DO OUTPUT
;
; FOR OUTPUTTING TO THE DN60
;
OUTCOM: ON F.OUT ;FLAG OUTPUT
OFF F.IN ;
PJRST IOCOM ;GO TO INPUT-OUTPUT ROUTINE
;EOF -- EOF COMMAND
;
; COMMAND TO SEND AN EOF WHILE DOING OUTPUT
;
EOFCOM: OFF F.BUSY
JRST CPOPJ1
;RSTCOM -- ROUTINE TO RESTART THE PROGRAM
;
RSTCOM: PUSHJ P,.SCEOL ;EAT THE INPUT PENDING
PJRST START ;RESTART D60SPD
;TYPCOM -- ROUTINE TO ALLOW TYPE AHEAD
;
TYPCOM: SETZM TYPFLG ;CLEAR FLAG TO ALLOW TYPE AHEAD
PJRST CPOPJ1 ;GIVE SKIP RETURN
;NOTCOM -- ROUTINE TO DISALLOW TYPE AHEAD
;
NOTCOM: SETOM TYPFLG ;SET FLAG TO DISALLOW TYPE AHEAD
PJRST CPOPJ1 ;GIVE SKIP RETURN
;SLPCOM -- ROUTINE TO TAKE A SNOOZE FOR AWHILE
;
SLPCOM: PUSHJ P,GETSEC ;READ IN TIME TO SLEEP
SLPCO2: MOVE T2,T1 ;GET COPY OF TIME
CAXLE T2,^D60 ;MORE THAN 60?
MOVX T2,^D60 ;YES, DO 60 THIS TRY
SLEEP T2, ;GO SLEEP
SUBX T1,^D60 ;DECREASE BY 60 SEC
JUMPG T1,SLPCO2 ;SHALL WE SLEEP SOME MORE?
PJRST CPOPJ1 ;NOW RETURN THAT WE'RE AWAKE AGAIN
;AUTCOM -- AUTO COMMAND
;
; COMMAND TO PROCESS AN AUTO FILE
;
AUTCOM: TXNE F,F.AUTO ;DOING AN AUTO FILE ALREADY?
ERROR (W,Y,NAF,<Already processing an AUTO file>,<CPOPJ1>)
PUSHJ P,SAVSCN ;SAVE STATE OF SCANNERS
MOVX T1,AUTDEV ;POINT TO AUTO DEVICE BLOCK
PUSHJ P,CLRDEV ;CLEAR THE DEVICE CELLS
MOVSI T1,'DSK' ;DSK IS DEFAULT
MOVEM T1,AUTDEV ;SET DEFAULT
MOVE T1,[SIXBIT \D60SPD\] ;
MOVEM T1,AUTNAM ;SET DEFAULT FILE NAME
MOVSI T1,'ATO' ;
MOVEM T1,AUTEXT ;SET DEFAULT EXTENSION
MOVX T1,AUTDEV ;POINT TO THE AUTO DEVICE BLOCK
PUSHJ P,GETPTH ;SET THE DEFAULT PATH
MOVX T1,AUTDEV ;POINT TO THE AUTO DEVICE BLOCK
PUSHJ P,S$FILE ;GET THE FILE SPEC
PJRST STARTE ;REPORT THE ERROR
MOVX T1,AUTDEV ;POINT TO THE DEVICE CELL
MOVEM T1,FILSPC ; INCASE OF AN ERROR
MOVE T1,AUTDEV ;GET DEVICE
MOVEM T1,AUTOPN+1 ;PUT IN THE OPEN BLOCK
MOVX T1,AUTBH ;RING HEADER ADDRESS
MOVEM T1,AUTOPN+2 ;PUT IN THE OPEN BLOCK
OPEN AUTO,AUTOPN ;OPEN THE AUTO DEVICE
ERROR (E,N,AOE,<OPEN error for device >,<TYPDEV,TYPCRL,STARTZ>)
MOVE T1,AUTNAM ;GET FILE NAME
MOVE T2,AUTEXT ; AND EXTENSION
SETZ T3, ;
MOVX T4,AUTPTH ;POINT TO THE PATH
LOOKUP AUTO,T1 ;LOOKUP THE AUTO FILE
ERROR (E,N,ALE,<LOOKUP error for >,<TYPFLS,TYPCRL,STARTZ>)
MOVX T1,DSKIN ;POINT SCANNER
MOVEM T1,L.SCIN ;THE DSK
MOVX T1,DSKINC ;
MOVEM T1,L.SCLN ;
ON F.AUTO ;FLAG IN AN AUTO FILE
AUTCM2: PUSHJ P,OPER ;GO PROCESS THE COMMANDS IN
; THE AUTO FILE
TXNN F,F.AEOF ;END OF THE AUTO FILE?
JRST AUTCM2 ;NO, DO ANOTHER COMMAND
OFF F.AUTO!F.AEOF ;OUT OF THE AUTO FILE
PJRST CPOPJ1 ;GIVE SKIP RETURN TO CALLER
SUBTTL PARAMeter Command
;PRMCOM -- ROUTINE TO TYPE OUT THE PARAM BLOCK
;
; TYPES OUT THE PARAMETER BLOCK FOR THE CAL11 UUO
;
PRMCOM: MOVX T1,C11BLK ;POINT TO BLOCK
PUSHJ P,GETHAF ;GET PORT,,FUNCTION
TELL USR,CRLF
TELL USR,[ASCIC(Port:^1 C11F:^7)]
PUSHJ P,GETHAF ;GET LINE,,DEV
TELL USR,[ASCIC(Line:^6 Dev:^E)]
PUSHJ P,GETHAF ;GET #OF BYT,,FUNCTION CODE
TELL USR,[ASCIC(Bytes:^6 Funct:^E)]
PUSHJ P,GETHAF ;GET LENGTH,,BUF ADR
TELL USR,[ASCIC(Length:^6 BUFADR:^7)]
LDB T3,[POINT 12,(T1),11] ;GET # OF BYT PER WORD,,POSITON OF FIRST BYTE
LDB T4,[POINT 24,(T1),35] ;
TELL USR,[ASCIC(BPW:^6 PFB:^E)]
ADDX T1,1 ;SKIP LAST WORD
PUSHJ P,GETHAF ;GET NUMBER OF BYTES XFER,,RESULT
TELL USR,[ASCIC(BXFR:^6 Result:^E)]
TELL USR,CRLF
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
GETHAF: HLRZ T3,(T1) ;GET THE LH
HRRZ T4,(T1) ;GET THE RH
AOJA T1,CPOPJ ;POINT TO NEXT AND RETURN
SUBTTL WHAT Command
;WHTCOM -- ROUTINE TO TYPE OUT INFORMATION
;
; TYPES OUT THE PORT NUMBER, LINE NUMBER, AND DEVICE NUMBER
;
WHTCOM: MOVSI T1,-.NMWHT ;AOBJN POINTER
WHTCM2: HRRZ T3,WHTTAB(T1) ;GET PORT, OR LINE, OR DEVICE TXT
TELL USR,@T3 ;TELL THE USER THAT
XCT WHTGET(T1) ;GET THE NUMBER FROM C11BLK
; INTO T3
HRRES T3 ;EXTEND THE SIGN
HLRZ T4,WHTTAB(T1) ;GET TEXT TO PRINT IT
SKIPGE T3 ;SEE IF SELECTED (-1 MEANS NOT)
MOVX T4,[ASCIN(Not selected)] ;NOT SELECTED
TELL USR,@T4 ;TELL NUMBER OR NOT SELECTED
AOBJN T1,WHTCM2 ;DONE?
TELL USR,CRLF ;GIVE A CRLF
CHR USR," " ;GIVE A TAB
MOVX T1,[ASCIN(Idle)] ;ASSUME IDLE
TXNN F,F.IN!F.OUT ;MAYBE INPUT OR OUTPUT?
JRST WHTCM4 ;NO, WE'RE IDLE
MOVX T1,[ASCIN(Output)] ;TRY GUESSING OUTPUT
TXNN F,F.OUT ;GUESS RIGHT?
MOVX T1,[ASCIN(Input)] ;NO, ITS INPUT
WHTCM4: TELL USR,@T1 ;GIVE STATE WE'RE IN
TELL USR,CRLF ;
PJRST CPOPJ1 ;YES, EXIT
WHTTAB: XWD [ASCIN(^1)],[ASCIN(Port:)]
XWD [ASCIN(^6)],[ASCIN( Line:)]
XWD [ASCIN(^6)],[ASCIN( Device:)]
.NMWHT==.-WHTTAB
WHTGET: LOAD. (T3,C%PORT) ;GET PORT NUMBER
LOAD. (T3,C%LINE) ;GET LINE NUMBER
LOAD. (T3,C%DEV) ;GET DEVICE NUMBER
SUBTTL STATUS Command
;STSCOM -- STATUS COMMAND
;
; DOES "STATUS DN60 or PORT", "STATUS LINE", "STATUS DEVICE", OR "STATUS ALL"
;
STSCOM: PUSHJ P,SETSE1 ;SETUP PARAM BLOCK FOR SET CMD
TXNE F,F.IBRK ;SEE IF A BREAK
PJRST ALLSTS ;YES, GIVE SAME AS STATUS ALL
OFF F.STAT ;NO STATISTICS
PUSHJ P,S$SIX ;GET DN60, LINE, OR DEVICE (HOPE)
PJRST E.CER ;ERROR
JUMPE T1,ALLSTS ;GIVE ALL STATUS
MOVEM T1,L.CMD ;REMEMBER CMD INCASE OF ERROR
MOVE T2,[XWD -.NMSTS,STSTAB] ;POINT TO ACCEPTABLE SWITCHES
PUSHJ P,UNIQ6 ;SEE IF WE KNOW ABOUT THIS ONE
PJRST E.ILC ;BAD SWITCH
PJRST @STSDSP(T1) ;DISPATCH TO ROUTINE FOR THE SWITCH
DEFINE NAMES,<
SWT ALL,ALLSTS,0
SWT DN60,D60STS,4
SWT PORT,D60STS,4
SWT LINE,LINSTS,4
SWT DEVICE,DVSTS,4
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE FOR
; THE STATUS COMMAND.
;
BUILD (STS,NAM,DSP) ;TABLE LABELS HAVE A PREFIX OF 'STS'
SUBTTL STATUS ALL Command
;HERE IF STATUS ALL, TO PRINT THE DN60 STATUS,
; LINE STATUS, AND DEVICE STATUS
;
ALLSTS: MOVE P1,[XWD -.NMPLD,PLDTAB] ;POINT TO VALID SWITCHES
PUSHJ P,DOSWT ;PROCESS THE SWITCHES
POPJ P, ;ERROR RETURN WITH MSG ADR IN T1
PUSHJ P,D60ST1 ;DO DN60 STATUS
POPJ P, ;ERROR
TELL USR,CRLF ;GIVE A CRLF
PUSHJ P,LINST5 ;DO LINE STATUS
POPJ P, ;ERROR
PUSHJ P,RDLNS ;GET LINE STATUS
TXNN T1,LI.ENB ;IS LINE ENABLED?
PJRST CPOPJ1 ;NO, DON'T ATTEMPT DEV STATUS
PUSHJ P,DVSTS4 ;DO DEVICE STATUS
POPJ P, ;ERROR
PJRST CPOPJ1 ;DONE
SUBTTL STATUS DN60 or PORT Command
;HERE IF STATUS DN60:x or PORT:x
;
D60STS: PUSHJ P,DVPRT ;GET PORT NUMBER
PJRST E.CER ;ERROR
MOVE P1,[XWD -.NMPLD,PLDTAB] ;POINT TO LIST OF VALID SWITCHES
PUSHJ P,DOSWT ;GO PROCESS THEM
POPJ P, ;ERROR, MSG ADR IS IN T1
D60ST1: MOVE T1,[XWD D6.BYT,FC.R6S] ;BYTE COUNT,,FUNCTION
MOVEM T1,C11BLK+2 ;PUT IN PARAM BLOCK FOR CAL11. UUO
PUSHJ P,CHKPRT ;MAKE SURE PORT SETUP
POPJ P, ;ERROR WITH ERR MSG ADR IN T1
PUSHJ P,CAL11 ;GET THE DN60 STATUS
PUSHJ P,CONFUS ;NEVER HAPPEN
MOVE T2,[POINT 8,SETBLK] ;POINT TO RECEIVED STATUS
MOVEM T2,SETBYT ; A PREFIX OF 'SR
;
; TYPE DN60 VERSION NUMBER
;
PUSHJ P,GETWD ;GET MAJOR VERSION
TELL USR,[ASCIC(DN60 STATUS)]
TELL USR,[ASCIN(0-7 DN60 Version ^1)]
PUSHJ P,GETWD ;GET MINOR VERSION
JUMPE T3,D60ST3 ;NO MINOR IF 0
ADDX T3,"A"-1 ;MAKE INTO ASCII LETTER
OUTCHR T3 ;OUTPUT THE MINOR VERSION
D60ST3: PUSHJ P,GETWD ;GET EDIT NUMBER
TELL USR,[ASCIN((^1))]
PUSHJ P,GETWD ;GET WHO
SKIPE T3 ;NOTHING TO OUTPUT IF 0
TELL USR,[ASCIN(-^1)] ;
TELL USR,CRLF ;GIVE A CRLF
;
; TYPE WINDOW VERSION NUMBER
;
PUSHJ P,GETWD ;GET WINDOW VERSION
TELL USR,[ASCIC(8-9 Window Version ^1)]
;
; TYPE THE CURRENT NUMBER OF FREE CHUNKS
;
PUSHJ P,GETWD ;GET FREE CHUNKS
TELL USR,[ASCIC(10-11 Free Chunks ^6)]
;
; TYPE THE NUMBER OF SYNC LINES ON THIS DN60
;
PUSHJ P,GETWD ;GET LINES
MOVEM T3,NLINES ;save number of lines on port
TELL USR,[ASCIC(12-13 Lines ^6)]
;
; TYPE CHUNK DATA LENGTH SIZE IN BYTES
;
PUSHJ P,GETWD ;GET CHUNK SIZE IN BYTES
TELL USR,[ASCIC(14-15 Chunk data length in bytes ^6)]
;
; TYPE DN60 OPTIONS
;
PUSHJ P,GETWD ;GET BYTES 16-17
MOVE T1,[XWD -.D616T,D616T] ;POINT TO TABLE OF NAMES
; AND ITS LENGTH
TELL USR,[ASCIN(16-17 ^1)] ;
PUSHJ P,DCDBIT ;DECODE THE BITS INTO TEXT
;
; TYPE THE KMC11 MICROCODE VERSION NUMBER
;
MOVX P1,4 ;GOT TO LOOK A 4 WORDS
PUSH P,SETBYT ;REMEMBER CURRENT BYTE POINTER
SETZ P2, ;OR ALL PARTS OF VERSION HERE
; (ALL 0 = NO KMC11)
D60ST5: PUSHJ P,GETWD ;GET 2 BYTES OF VERSION INFO
IOR P2,T3 ;OR IN PART OF VERSION INFO
SOJG P1,D60ST5 ;DONE ALL VERSION INFO?
JUMPE P2,D60ST9 ;IF ZERO, DON'T PRINT KMC11 VER
POP P,SETBYT ;RESTORE BYTE POINTER
PUSHJ P,GETWD ;GET THE MAJOR VERSION NUMBER
TELL USR,[ASCIN(18-25 KMC11 Microcode Version ^1)]
PUSHJ P,GETWD ;GET THE MINOR VERSION NUMBER
JUMPE T3,D60ST7 ;JUMP IF MINOR VERSION IS 0
ADDX T3,"A"-1 ;MAKE MINOR VERSION A LETTER
CHR USR,@T3 ;PRINT THE MINOR VERSION
D60ST7: PUSHJ P,GETWD ;GET THE EDIT NUMBER
TELL USR,[ASCIN((^1))] ;PRINT THE EDIT NUMBER
PUSHJ P,GETWD ;GET WHO EDITED LAST
SKIPE T3 ;SKIP IF ZERO
TELL USR,[ASCIN(-^1)] ;PRINT WHO NUMBER
TELL USR,CRLF ;GIVE A CRLF
JRST D60S10 ;
D60ST9: POP P,(P) ;CLEAN STACK
D60S10: PUSHJ P,GETWD ;GET ERROR
JUMPE T3,[ MOVX T1,4 ;CHUCK 4 BYTES
PUSHJ P,GETBYT ;PITCH 4 BYTES
JRST D60S11 ] ;BACK TO MAINLINE
;IF 0 THEN NO ERROR, LINE, DEVICE
TELL USR,[ASCIC(26-27 Error Code ^1)]
PUSHJ P,GETWD ;GET LINE IN ERROR
TELL USR,[ASCIC(28-29 Line in error ^6)]
PUSHJ P,GETWD ;GET DEVICE IN ERROR
SKIPE T3 ;NO MESSAGE IF 0
TELL USR,[ASCIC(30-31 Device in error ^1)]
D60S11: MOVX P1,0 ; Start with line 0
MOVX P2,^D32 ; First byte number of map
D60S12: MOVX T1,4 ; Get next 2 words (16bit) of
PUSHJ P,GETBYT ; line activity
JUMPE T3,D60S16 ; If no activity on this line .. go on
MOVE T4,P2 ; Move the byte number
MOVEI T5,3(T4) ; Make the upper byte number
TELL USR,[ASCIC (^E-^M Line ^N active ^1)]
MOVE T1,T3 ; Save the line activity word
TXNE T1,100 ; Check for console input ready
TELL USR,[ASCIC ( Console input)]
TXNE T1,200 ; Check for console output ready
TELL USR,[ASCIC ( Console output)]
MOVSI P3,-3 ; AOBJN pointer (CDR,CDP,LPT)
D60S14: LDB T3,D6DVPT(P3) ; Get next byte of device activity
JUMPE T3,D60S15 ; Skip output if device type not active
MOVE T4,D6DEVT(P3) ; Point to the generic device type
TELL USR,@T4 ; and say that it is active
PUSHJ P,DCDPNC ; List the units of the device that are
TELL USR,[ASCIC ( active)] ; actually active.
D60S15: AOBJN P3,D60S14 ; Loop for all generic device types
D60S16: ADDX P1,1 ; Increment to next line number
ADDX P2,4 ; Increment to next block of bytes
CAMGE P1,NLINES ; Check for end of activity flags
JRST D60S12 ; No so go do next line
D60DNE: PJRST CPOPJ1 ; Give ok skip return
;MESSAGES FOR STATUS DN60 BYTES 16-17
;
D616T: XWD 0,[ASCIC( IBM 3780/2780)]
XWD 0,[ASCIC( HASP Multileaving)]
XWD 0,[ASCIC( IBM 3270)]
.D616T==.-D616T
D6DEVT: XWD 0,[ASCIN( Card Reader )]
XWD 0,[ASCIN( Line Printer )]
XWD 0,[ASCIN( Card Punch )]
D6DVPT: POINT 8,T1,27 ; Byte for card reader activity
POINT 8,T1,19 ; Byte for line printer activity
POINT 8,T1,11 ; Byte for card punch activity
SUBTTL STATUS LINE Command
;HERE IF STATUS LINE:x
;
LINSTS: PUSHJ P,DVLIN ;GET LINE NUMBER
PJRST E.CER ;ERROR
TXNE F,F.IBRK ;EOL?
JRST LINST5 ;YES, PROCEED
MOVE P1,[XWD -.NMPLD,PLDTAB] ;POINT TO LIST OF VALID SWITCHES
PUSHJ P,DOSWT ;GO PROCESS THEM
POPJ P, ;ERROR, MSG ADR IS IN T1
LINST5: PUSHJ P,CHKLIN ;MAKE SURE LINE AND PORT SETUP
POPJ P, ;ERROR WITH MSG ADR IN T1
PUSHJ P,RDLNS ;READ THE LINE STATUS
LOAD. (T3,C%PORT) ;GET PORT NUMBER
LOAD. (T4,C%LINE) ;GET LINE NUMBER
TELL USR,[ASCIC(DN60 PORT:^1 LINE:^7 STATUS)]
JUMPN T1,LINST6 ;GET ANYTHING BACK?
TELL USR,[ASCIC( LINE:^7 IS Disabled)]
PJRST CPOPJ1 ;GIVE WON RETURN
LINST6: MOVE T1,[POINT 8,SETBLK] ;POINTER TO RECEIVED STATUS
MOVEM T1,SETBYT ;POINT TO THE STATUS
;
; TYPE THE TERMINAL TYPE
;
ILDB T3,SETBYT ;GET TERMINAL TYPE
TELL USR,[ASCIN(0 ^6)]
MOVX T1,LS0T ;POINT TO TABLE OF NAMES
MOVX T2,.LS0T ; AND ITS LENGTH
PUSHJ P,DCDVAL ;PRINT OUT TERMINAL TYPE
; Type the flags word
LINST8: PUSHJ P,GETWD ; Get line flags
MOVE T1,[XWD -.LS1T,LS1T] ; Point to table of names
TELL USR,[ASCIN(1-2 ^1)]
PUSHJ P,DCDBIT ; Decode the bit info
; Type the line information byte
ILDB T3,SETBYT ; Get line info
MOVE T1,[XWD -.LS2T,LS2T] ; Point to table of names
TELL USR,[ASCIN(3 ^1)]
PUSHJ P,DCDBIT ; Decode the bit info
; Type bytes 4-61
MOVE P1,[XWD -.LSER,LSER] ;POINT TO ERROR MESSAGES
LINST9: MOVE P2,(P1) ;GET MSG ADDRESS
PUSHJ P,GETWD ;GET 2 BYTES WORTH
TLZN P2,-1 ;SKIP IF WE SHOULD PRINT 0'S
SKIPE T3 ;IS IT A ZERO?
TELL USR,@P2 ;PRINT THE MESSAGE
AOBJN P1,LINST9 ;DONE PRINTING ERROR STUFF?
;
; TYPE THE MAXIMUM TRANSMISSION BLOCK LENGTH
;
PUSHJ P,GETWD ;GET 16 BITS WORTH OF BLOCK LENGTH
TELL USR,[ASCIC(62-63 ^6 Max transmission block length)]
;
; TYPE THE MAXIMUM NUMBER OF RECORDS PER TRANSMISSION BLOCK
;
PUSHJ P,GETWD ;GET 16 BITS WORTH OF THE NUMBER OF RECORDS
TELL USR,[ASCIC(64-65 ^6 Max logical records per transmission block)]
;
; Type out line signature if any
;
PUSHJ P,GETWD ; Get line signature value
SKIPE T3 ; If none .. then ignore
TELL USR,[ASCIC(66-67 ^6 Line signature)]
;
; Type the line driver type
PUSHJ P,GETWD ; Get the line drive type value
TELL USR,[ASCIN(68-69 ^6)]
MOVX T1,LS61T ; Point to table of names
MOVX T2,.LS61T ; and it length
PUSHJ P,DCDVAL ; Print out line driver type
TELL USR,CRLF ;MAKE PRETTY
PJRST CPOPJ1 ; Ok, give skip return
; Messages for STATUS LINE:x byte 0 (terminal type)
LS0T: [ASCIC( Unknown terminal type)]
[ASCIC( IBM 3780)]
[ASCIC( IBM 2780)]
[ASCIC( IBM HASP multileaving)]
.LS0T==.-LS0T
; Messages for STATUS LINE:x bytes 1-2 (flags)
LS1T: XWD [ASCIC( Support)],[ASCIC( Simulate)]
XWD [ASCIC( Secondary BSC station)],[ASCIC( Primary BSC station)]
XWD 0,[ASCIC( signed on)]
XWD 0,[ASCIC( transparency on)]
XWD 0,[ASCIC( line disable in progress)]
XWD 0,[ASCIC( line enable in progress)]
XWD 0,[ASCIC( line abort in progress)]
XWD 0,[ASCIC( line is offline 2780/3780)]
XWD 0,[ASCIC( line disable complete)]
XWD 0,[ASCIC( disable done because of DTE failure)]
XWD 0,[ASCIC( line aborted by hardware failure)]
XWD 0,[ASCIC( communications established)]
.LS1T==.-LS1T
; Messages for STATUS LINE:x byte 3 (line info)
LS2T: XWD [ASCIC( Line disabled)],[ASCIC( Line enabled)]
XWD [ASCIC( DTR not set)],[ASCIC( DTR set)]
XWD [ASCIC( DSR not set)],[ASCIC( DSR set)]
.LS2T==.-LS2T
; Messages for STATUS LINE:x bytes 4-61
;
; Format of entry is:
; XWD -1 or 0,Address of message
; 0 indicates only print message if value is non zero
; -1 indicates always print the message
;
LSER: XWD 0,[ASCIC(4-5 ^6 DQ11/DUP11 error interrupts)]
XWD 0,[ASCIC(6-7 ^1 DQ11/DUP11 status register 1 at last error)]
XWD 0,[ASCIC(8-9 ^1 DQ11/DUP11 status register 2 at last error)]
XWD 0,[ASCIC(10-11 ^6 Times receiver wasn't fast enough)]
XWD 0,[ASCIC(12-13 ^6 Times transmitter wasn't fast enough)]
XWD 0,[ASCIC(14-15 ^6 CTS failures)]
XWD 0,[ASCIC(16-17 ^6 Messages sent and ACK'ed)]
XWD 0,[ASCIC(18-19 ^6 NAK's received (+wrong ACK after timeout))]
XWD 0,[ASCIC(20-21 ^6 Invalid responses to TTD)]
XWD 0,[ASCIC(22-23 ^6 Invalid responses to messages)]
XWD 0,[ASCIC(24-25 ^6 TTD's sent)]
XWD 0,[ASCIC(26-27 ^6 WACK's received in response to messages)]
XWD 0,[ASCIC(28-29 ^6 EOT's sent which abort the stream)]
XWD 0,[ASCIC(30-31 ^6 Invalid bids or responses to bids)]
XWD 0,[ASCIC(32-33 ^6 RVI's received while transmitting)]
XWD 0,[ASCIC(34-35 ^6 Messages received OK)]
XWD 0,[ASCIC(36-37 ^6 Bad BCC's)]
XWD 0,[ASCIC(38-39 ^6 NAK's sent in response to data messages)]
XWD 0,[ASCIC(40-41 ^6 WACK's sent)]
XWD 0,[ASCIC(42-43 ^6 TTD's received)]
XWD 0,[ASCIC(44-45 ^6 EOT's received which abort the stream)]
XWD 0,[ASCIC(46-47 ^6 Count of messages ignored)]
XWD 0,[ASCIC(48-49 ^6 Transparent msgs with an invalid char after DLE)]
XWD 0,[ASCIC(50-51 ^6 Attempts to change between Trans and Normal mode in a blocked msg)]
XWD 0,[ASCIC(52-53 ^6 Transmitter timeouts)]
XWD -1,[ASCIC(54-55 ^6 Clear to send delay in jiffies)]
XWD 0,[ASCIC(56-57 ^6 Count of silo overflows)]
XWD 0,[ASCIC(58-59 ^6 Depth of silo warning area)]
XWD 0,[ASCIC(60-61 ^6 Maximum silo warning area used)]
.LSER==.-LSER
; Messages for STATUS LINE:x bytes 66-67
LS61T: 0
XWD 0,[ASCIC( DQ11)]
XWD 0,[ASCIC( KMC11/DUP11)]
XWD 0,[ASCIC( DUP11 without a KMC11)]
.LS61T==.-LS61T
SUBTTL STATUS DEVICE Command
; Here for STATUS DEVICE:x
DVSTS: PUSHJ P,DVDEV ; Get device number
PJRST E.CER ; Error
TXNE F,F.IBRK ; Eol?
JRST DVSTS4 ; Yes, procede
MOVE P1,[XWD -.NMPLD,PLDTAB] ; Point to list of valid switches
PUSHJ P,DOSWT ; Go process them
POPJ P, ; Error, msg adr is in T1
DVSTS4: PUSHJ P,CHKDEV ; Make sure dev+line+port set
POPJ P, ; Error with msg adr in T1
PUSHJ P,RDDVS ; Read the device status
JFCL ; Don't care about abort
LOAD. (T3,C%PORT) ; Get port number
LOAD. (T4,C%LINE) ; Get line number
TELL USR,[ASCIN(DN60 PORT:^1 LINE:^7 )]
LOAD. (T3,C%DEV) ; Get device
TELL USR,[ASCIC(DEVICE:^6)]
MOVE T1,[POINT 8,SETBLK] ; Point to device status
MOVEM T1,SETBYT ; Save pointer
; Type the device type
ILDB T3,SETBYT ; Get device type
TELL USR,[ASCIN(0 ^6)]
MOVX T1,DS0T ; Point to table of device type names
MOVX T2,.DS0T ; and the length of that table
PUSHJ P,DCDVAL ; Print the device type
; Type the component selection code
ILDB T3,SETBYT ; Get component selection code
TELL USR,[ASCIC(1 ^1 Component code)]
; Type the printer line counter
PUSHJ P,GETWD ; Get 16 bits worth
TELL USR,[ASCIC(2-3 ^6 Printer line counter)]
; Type the device flags
MOVX T1,4 ; Get 4 bytes worth
PUSHJ P,GETBYT ; Get 'em
TELL USR,[ASCIN(4-7 ^1)]
MOVE T1,[XWD -.DS1T,DS1T] ; Point to table of names
PUSHJ P,DCDBIT ; Decode all the bits
; Device record size
PUSHJ P,GETWD ; Get 16 bits worth of record size
TELL USR,[ASCIC(8-9 ^6 Device record size)]
; Device line flags
PUSHJ P,GETWD ; Get 16 bits worth of flags
TELL USR,[ASCIC(10-11 ^1 Line flags)]
MOVE T1,[XWD -.DSLT,DSLT] ; Point to device line flag table
PUSHJ P,DCDBIT ; Go list out defined bits
; Line signature
PUSHJ P,GETWD ; Get 16 bits worth of signature
SKIPE T3 ; Check for anything there
TELL USR,[ASCIC(12-13 ^6 Line signature)]
PJRST CPOPJ1 ; Give ok skip return
DEFINE NAMES,<
SWT LINE,DVLIN,4
SWT PORT,DVPRT,4
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE FOR
; THE STATUS DEVICE COMMAND
;
BUILD (DVS,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'DVS'
;MESSAGES FOR STATUS DEVICE:x BYTE 0 (DEVICE TYPE)
;
DS0T: [ASCIC( Unknown device type)]
[ASCIC( Line Printer )]
[ASCIC( Card Punch )]
[ASCIC( Card Reader )]
[ASCIC( HASP Console Output )]
[ASCIC( HASP Console Input )]
.DS0T==.-DS0T
;MESSAGES FOR STATUS DEVICE:x BYTES 1-4 (FLAGS)
;
DS1T: [ASCIC( Reserved)]
[ASCIC( Reserved)]
[ASCIC( Reserved)]
[ASCIC( Input request waiting for EOF acknowledge)]
[ASCIC( Interpret input carriage control)]
[ASCIC( Interpret output carriage control)]
[ASCIC( Reserved)]
[ASCIC( Do component selection)]
[ASCIC( Do compress/expand)]
[ASCIC( Page counter has overflowed)]
[ASCIC( Page counter interrupts enabled)]
[ASCIC( IBM 3780 protocol)],,[ASCIC( Old BSC protocol)]
[ASCIC( Output buffers being dumped)]
[ASCIC( Permission being sent to HASP)]
[ASCIC( Output mode)],,[ASCIC( Input mode)]
[ASCIC( Output being dumped)]
[ASCIC( Output permission requested)]
[ASCIC( Output permission granted)]
[ASCIC( Output running)]
[ASCIC( Output EOF signaled)]
[ASCIC( Output EOF completed)]
[ASCIC( Output abort started)]
[ASCIC( Output abort completed)]
[ASCIC( Input permission requested)]
[ASCIC( Input permission granted)]
[ASCIC( Input running)]
[ASCIC( Input abort started)]
[ASCIC( Input abort completed)]
[ASCIC( Input EOF completed)]
[ASCIC( Input permission was requested)]
[ASCIC( Output permission requested of HASP)]
[ASCIC( Output suspended by HASP)]
.DS1T==.-DS1T
;MESSAGES FOR STATUS DEVICE:x BYTE 5 (COMPONENT SELECTION CODE)
;
DS5T: [ASCIC( Unknown component selection code)]
[ASCIC( Printer)]
[ASCIC( Punch)]
.DS5T==.-DS5T
; Messages for line flags
DSLT: 0 ; Simulate/support
0 ; Primary/secondary
0 ; Signed on
0 ; Transparent
0 ; Disable in progress
0 ; Line enable complete
0 ; Line abort complete
[ASCIC( Device offline)]
0 ; Line disable complete
0 ; Disable done by DTE failure
[ASCIC( Hardware abort on line)]
[ASCIC( Communications established)]
.DSLT==.-DSLT
SUBTTL INPUT and OUTPUT Commands
;HERE FROM "INCOM" OR "OUTCOM" TO DO
; INPUT OR OUTPUT. IF F.OUT IS SET IT INDICATES OUTPUT
;
IOCOM: ON F.BUSY ;WE'RE NOW BUSY
TXZE F,F.RES ;ARE WE ALREADY STARTED
JRST IOCOM1 ;NO
TXNE F,F.ABTW ;SEE IF WAITING FOR ABORT
PJRST ABTINP ;YES, SO TELL HIM THAT
ERROR (W,Y,STD,<Already doing I/O>,<CPOPJ1>)
IOCOM1: OFF F.IABT!F.OABT!F.DOB ;CLEAR ABORT BITS AS WE
; WILL RESET HERE
MOVE T1,.JBFF ;REMEMBER SO WE CAN SHRINK BACK
MOVEM T1,IOJBFF ;
MOVX T1,NLSTAT+1 ;FORCE A HEADER
MOVEM T1,STSCNT ;
MOVSI T1,-.NMIO ;MAKE AOBJN POINTER TO IODEF
IOCOML: HRRZ T2,IODEF(T1) ;GET ADDRESS TO STORE VALUE
JUMPE T2,IOCOMD ;NO PLACE TO STORE
HLRZ T3,IODEF(T1) ;GET THE DEFAULT VALUE
MOVEM T3,(T2) ;STORE THE DEFAULT VALUE
IOCOMD: AOBJN T1,IOCOML ;DONE?
SKIPGE T1,IOTIME ;GET REPORTING TIME
MOVX T1,RPTTIM*^D1000 ;NONE, SO USE A DEFAULT
MOVEM T1,IOTIME ;REMEMBER TIME TO REPORT
SETZM TOTCHR ;TOTAL CHARACTER OUTPUT
SETZM TOTLIN ;TOTAL LINES OUTPUT
SETZM TOTZRO ;TOTAL COUNT OF 0 COUNT ON
; A DELAYED RETURN
SETZM TOTCE4 ;TOTAL COUNT OF CAL11. ERROR 4'S
SETZM C11TIM ;TOTAL TIME SPENT IN THE CAL11. UUO
OUTCO1: TXNE F,F.IBRK ;EOL?
JRST OUTCO2 ;YES
CAIN C,"/" ;A SWITCH?
JRST OUTSWT ;YES
CAIE C," " ;SPACE?
PJRST E.CER ;NOT A SPACE OR A / SO ERROR
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES
JRST OUTCO2 ;EOL, SO GO AHEAD WITH DEFAULTS
CAIN C,"/" ;AFTER FLUSHING SPACES IS NEXT A SWITCH?
JRST OUTSWT ;YES, GO PROCESS THE SWITCHES
MOVX T1,DEVDEV ;DEVICE STORAGE CELLS
PUSHJ P,CLRDEV ;CLEAR DEVICE BLOCK
PUSHJ P,DEFDEV ;SET UP DEFAULTS
ON F.RSCN ;SO WE GET LAST CHAR AGAIN
PUSHJ P,S$FILE ;GET THE FILE-SPEC
POPJ P, ;ERROR RETURN WITH MSG ADR IN T1
TLNN T5,(SC.DIR+SC.DEV+SC.NAM+SC.EXT) ;SEE IF WE GENERATE OUTPUT
JRST OUTCO2 ;YES, MAKE OUR OWN
MOVX T1,DEVDEV ;POINT TO DEVICE CELLS
MOVEM T1,FILSPC ; INCASE OF ERROR
MOVE T1,DEVDEV ;GET THE DEVICE NAME
MOVEM T1,DEVOPN+1 ;PUT IN THE OPEN BLOCK
PUSHJ P,CDVINU ;SEE IF DEVICE IS IN USE
MOVX T1,DEVBH ;RING HEADER ADDRESS
TXNN F,F.OUT ;OUTPUT?
MOVSS T1 ;NO, INPUT SO PUT HEADER IN LH
MOVEM T1,DEVOPN+2 ;PUT IN THE OPEN BLOCK
OPEN DEV,DEVOPN ;OPEN THE DEVICE FOR INPUT
ERROR (E,N,OPN,<OPEN failure for device >,<TYPDEV,TYPCRL,STARTZ>)
MOVE T1,DEVNAM ;GET DEVICE NAME
MOVE T2,DEVEXT ; AND THE EXTENSION
SETZ T3, ;
MOVX T4,DEVPTH ;POINT TO PATH
TXNN F,F.OUT ;DOING OUTPUT?
JRST INP01 ;NO, INPUT SO DO AN ENTER
INBUF DEV,NUMBUF ;CREATE THE BUFFERS
LOOKUP DEV,T1 ;LOOKUP THE FILE
ERROR (E,N,LKE,<LOOKUP failure for file >,<TYPFLS,TYPCRL,STARTZ>)
JRST IOCOM3 ;
INP01: OUTBUF DEV,NUMBUF ;CREATE THE OUTPUT BUFFERS
ENTER DEV,T1 ;DO AN ENTER FOR THE FILE
ERROR (E,N,ENF,<ENTER failure for file >,<TYPFLS,TYPCRL,STARTZ>)
IOCOM3: ON F.DEV ;FLAG TO GET OUTPUT FROM A DEV
JRST OUTCO1 ;GET SWITCHES
OUTSWT: MOVE P1,[XWD -.NMIO,IOTAB] ;LIST OF SWITCHES FOR OUTPUT
PUSHJ P,DOSWT ;GO PROCESS THEM
POPJ P, ;ERROR, MSG ADR IS IN T1
OUTCO2: PUSHJ P,CHKDEV ;MAKE SURE DEV+LINE+PORT SETUP
POPJ P, ;ERROR WITH MSG IN T1
CHR USR,"!" ;INDICATE RUNNING
MOVE T1,IOBWRD ;GET BYTES PER WORD
LOAD. (T2,C%PORT) ;GET PORT NUMBER
MOVX T3,4 ;GET MIN NUMBER OF DTE BYTES
CAXGE T2,10 ;SEE IF ON A DTE PORT
MOVX T3,3 ;NO, DL10 SO SET MIN FOR THAT
CAML T1,T3 ;RANGE OF 3-6 FOR DL10
; OR 4-6 FOR DTE20
CAXLE T1,6 ;
ERROR (E,Y,INB,<Illegal number of bytes>,<STARTZ>)
IFE DEBOUT,<
PUSHJ P,CHKABT ;SEE IF ABORT SET, IF SO CLEAR IT
POPJ P, ;CAN'T CLEAR ABORT
PUSHJ P,RDLNS ;GET THE LINE STATUS
TXNN T1,LI.ENB ;SEE IF LINE IS ENABLED
ERROR (E,Y,ENB,<Line is not enabled>,<STARTZ>)
TXNE T1,LI.DSR ;SEE IF DSR
JRST OUTCO7 ;DSR IS THERE
TELL USR,[ASCIC([Waiting for DSR to set])]
OUTCO5: SNOOZE USR,^D1500 ;LOOK EVERY 1.5 SEC
PUSHJ P,RDLNS ;GET THE LINE STATUS AGAIN
TXNN T1,LI.DSR ;IS DSR THERE YET?
JRST OUTCO5 ;NOT YET, KEEP WAITING
TELL USR,[ASCIC([DSR set])]
>;END IFE DEBOUT
OUTCO7: SKIPN T2,IODEVT ;SEE IF A DEVICE TYPE SPECIFIED
JRST OUTCO3 ;NO DEVICE TYPE
MOVX T1,BYTE (8) DC.SC ;CMD:1
LSH T2,^D20 ;POSITION THE BYTE
IOR T1,T2 ;NOW CMD,DEVTYPE
MOVX T2,2 ;2 BYTES
PUSHJ P,WRTDVC ;DO THE DEV TYPE CMD
OUTCO3: PUSHJ P,CLRSTS ;CLEAR STATISTICS
PUSHJ P,BEGTIM ;RECORD CURRENT TIME
TXNN F,F.OUT ;DOING OUTPUT?
JRST DOINP ;NO, TAKE CARE OF INPUT
JRST DOOUT ;YES, GO DO IT
;HERE TO DO OUTPUT
;
DOOUT:
IFE DEBOUT,<
PUSHJ P,REQOUT ;REQUEST OUTPUT PERMISSION
POPJ P, ;GIVE ERROR RETURN WITH MSG ADR IN T1
>;END IFE DEBOUT
SKIPG T1,IOLCHR ;GET LAST CHARACTER
PJRST E.ICR ;OUT OF RANGE
CAXLE T1,177 ;SEE IF TOO BIG
PJRST E.ICR ;TOO BIG
SKIPG T2,IOFCHR ;GET FIRST CHARACTER
PJRST E.ICR ;OUT OF RANGE
CAXLE T2,177 ;SEE IF TOO BIG
PJRST E.ICR ;TOO BIG
OFF F.EOLC ;ASSUME WE DON'T HAVE TO COUNT
; EOL CHARACTERS
CAXG T2,24 ;SEE WHAT FIRST CHAR IS
ON F.EOLC ;MIGHT BE AN EOL SO SET FLAG
SUB T1,T2 ;CALCULATE NUMBER OF CHARS
JUMPL T1,E.ICR ;FIRST IS .GT. LAST
MOVNI T1,1(T1) ;NEGATIVE NUMBER OF 'EM
HRLZS T1 ;GET NUMBER IN THE (LH)
HRR T1,IOFCHR ;FIRST CHAR IN (RH)
MOVEM T1,CHRRNG ;SAVE LENGTH,,CHAR
MOVX T1,OUTBYT ;DEFAULT NUMBER OF BYTES FOR OUTPUT
SKIPN IONBYT ;USE THE DEFAULT?
MOVEM T1,IONBYT ;YES, 0 SAYS THAT
PUSHJ P,CREABF ;CREATE A BUFFER FOR THE DN60
SETZM CHARS ;START WITH 0 CHARS
PUSHJ P,MAKPNT ;MAKE A 10 BYTE POINTER TO THE BUFFER
MOVE P4,CHRRNG ;CHARACTER RANGE
MSTIME T1, ;GET PRESENT TIME OF DAY
MOVEM T1,STTIME ;REMEMBER THE START TIME
PUSHJ P,GETTIM ;GET MS OF UP TIME
MOVEM T1,STIMMS ;REMEMBER MS OF UP TIME
SETZ T1, ;0 SAYS GET OUR RUNTIME
RUNTIM T1, ;GET OUR CURRENT RUNTIME
MOVEM T1,BEGRTM ;REMEMBER SO WE CAN COMPUTE
; RUNTIME USED DURING I/O.
;HERE ON OUTPUT TO GENERATE A RIPPLE PATTERN
;
NEWLIN: PUSHJ P,CHKOPR ;SEE IF A COMMAND PENDING?
TXNE F,F.BUSY ;STILL BUSY?
JRST NEWL1 ;YES
CHRDON: TXNN F,F.DEV ;USING A DEV
RELEAS DEV, ;YES, RELEASE IT
DOOUTD: SETZ T1, ;0 SAYS GET OUT RUNTIME
RUNTIM T1, ;GET RUNTIME
MOVEM T1,ENDRTM ;REMEMBER SO WE CAN COMPUTE
; RUNTIME USED (ENDRTM-BEGRTM)
MSTIME T1, ;GET CURRENT TIME OF DAY
MOVEM T1,ENDTIM ; AND RECORD TIME OUTPUT FINISHED
PUSHJ P,GETTIM ;GET CURRENT UPTIME IN MS
MOVEM T1,ETIMMS ;GET ENDING MS UPTIME
OFF F.STAT ;NO MORE STATISTICS
PUSHJ P,XMTEOF ;SEND EOF TO DN60
PUSHJ P,CONFUS ;WILL NEVER HAPPEN FOR OUTPUT
TELL USR,OUTDON ;OUTPUT DONE
PUSHJ P,ENDSTS ;GIVE FINAL STATISTICS
PJRST IODONE ;YES, BEGIN EVERYTHING AGAIN
NEWL1: ON F.STAT ;SET HERE CAUSE IT CAN GET
; CLOBBERED
TXNE F,F.DEV ;GET OUTPUT FROM A DEVICE?
JRST DODOUT ;YES
MOVE P3,IOWIDE ;GET WIDTH
MOVEM P4,CHARSV ;SAVE STARTING CHAR
NEWCHR: TXNE F,F.EOLC ;SEE IF TO COUNT EOL'S
PUSHJ P,CHKEOL ;YES, SEE IF AN EOL CHAR
PUSHJ P,PUTCHR ;OUTPUT A CHARACTER
JRST DODOU3 ;EXCEEDED NUMBER OF CHARS
AOBJN P4,.+2 ;
MOVE P4,CHRRNG ;RESET CHARACTER
SOJG P3,NEWCHR ;LINE OUTPUT YET?
PUSHJ P,OCRLF ;YES, ADD CR AND A CARRIAGE CONTROL CHAR
PUSHJ P,CNTLIN ;COUNT THE LINE
MOVE P4,CHARSV ;
AOBJN P4,.+2 ;
MOVE P4,CHRRNG ;
JRST NEWLIN ;NO, DO ANOTHER LINE
;HERE TO READ FROM A DEVICE AND OUTPUT THAT DATA
;
DODOUT: PUSHJ P,GCHRDV ;GET A CHARACTER FROM THE DEVICE
JRST DODOU3 ;EOF ON DEVICE
PUSHJ P,CHKEOL ;COUNT THE LINE IF EOL CHAR
PUSHJ P,PUTCHR ;GIVE CHAR TO DN60
CAIA ;EXCEEDED NUMBER OF CHARS
JRST NEWLIN ;GET ANOTHER CHAR
RELEAS DEV, ;LET GO OF DEVICE WE'RE READING
; FROM
DODOU3: SKIPE T1,CHARS ;ANY CHARS PENDING IN BUFFER?
PUSHJ P,PUTCH1 ;GIVE TO DN60
JFCL ;CAUSE OF SKIP RETURN
SKIPN TOTCHR ;ANY CHARS AT ALL?
PJRST IODONE ;NO CHARS EVER TRIED!
ON F.FSTS ;FORCE STASTICS
PUSHJ P,CHKTIM ;OUTPUT STATISTICS
PUSHJ P,CONFUS ;SHOULD NEVER HAPPEN
JRST DOOUTD ;SEND THE EOF
;HERE TO DO INPUT
;
DOINP: PUSHJ P,REQIN ;SEE IF ANY INPUT
PUSHJ P,CONFUS ;NOT IMPLEMENTED
MOVX T1,INDL10 ;DEFAULT BUFFER SIZE IN BYTES FOR DL10 INPUT
LOAD. (T2,C%PORT) ;GET PORT NUMBER
CAXLE T2,7 ;SEE IF ON A DL10
MOVX T1,INDTE ;NO, SET BUFFER SIZE IN BYTES FOR A DTE
SKIPN IONBYT ;SEE IF TO USE THE DEFAULT
MOVEM T1,IONBYT ;YES, 0 SAYS THAT
PUSHJ P,CREABF ;CREATE A BUFFER FOR THE DN60
OFF F.RCVI ;RESET TO NO INPUT RECEIVED
DOINP1: PUSHJ P,CHKOPR ;SEE IF OPR WANTS SOMETHING
ON F.STAT ;WE WANT STATISTICS
;MUST BE TURNED ON AFTER CHKOPR
; CAUSE IT CAN GET ZONK'ED
HRL T1,IONBYT ;NUMBER OF BYTES
HRRI T1,FC.RD ;READ DATA
MOVEM T1,C11BLK+2 ;FOR CAL11
PUSHJ P,MAKPNT ;POINT TO BUFFER
MSTIME P1, ;GET CURRENT TIME
PUSHJ P,GETTIM ;GET CURRENT UPTIME IN MS
MOVE P3,T1 ;SAVE WHERE IT WON'T GET WIPED
SETZ P2, ;SO WE GET OUT RUNTIME
RUNTIM P2, ;
PUSHJ P,CAL11 ;SEE IF ANY DATA
JRST DOINP3 ;RESULT 2 OR 3
DOINP9: TXOE F,F.RCVI ;FLAG WE HAVE INPUT AND SKIP IF FIRST DATA
JRST DOINP4 ;ALREADY HAVE RECEIVED SOME DATA
MOVEM P1,STTIME ;TIME WE GOT SOME INPUT
MOVEM P2,BEGRTM ;REMEMBER THE RUNTIME WE RECEIVED DATA
MOVEM P3,STIMMS ;REMEMBER UPTIME INPUT STARTED AT
TELL USR,INSTRT ;RECEIVED SOME DATA
DOINP4: SKIPN IOTIME ;TIMING?
TXNE F,F.DEV ;NO, BUT SHOULD WE OUTPUT THE DATA?
CAIA ;TIMING AND/OR OUTPUT DATA TO A DEV
JRST DOINP1 ;NOT TIMING OR OUTPUTTING DATA
; SO BUT IN THE "BIT BUCKET".
PUSHJ P,MAKPNT ;POINTER TO DATA
LOAD. (T5,C%BXFD) ;GET BYTES TRANSFERRED
DOINP5: SOJL T5,DOINP1 ;GET SOME MORE DATA
ILDB P4,BUFPNT ;GET A BYTE OF DATA
SKIPN P4 ;SEE IF NULL
ERROR (W,Y,NUL,<Received a NULL>,<S..NUL+1>)
JUMPE P4,DOINP5 ;NULL?
PUSHJ P,CHKEOL ;COUNT THE LINE IF EOL CHAR
DOINP7: TXNE F,F.DEV ;OUTPUT TO A DEVICE?
PUSHJ P,PCHRDV ;OUTPUT THE CHAR
JRST DOINP5 ;LOOP FOR MORE
DOINP3: CAXN T1,RC.DLY ;DELAYED RESULT?
JRST DOINP6 ;YES, TRY AGAIN
CAXE T1,RC.REJ ;BETTER BE 3
PUSHJ P,CONFUS ;NEVER HAPPEN
OFF F.STAT ;NO MORE STATISTICS NOW
SETZ T1, ;GET OUR
RUNTIM T1, ; RUNTIME WHEN WE FINISHED
MOVEM T1,ENDRTM ; AND REMEMBER IT
MSTIME T1, ;CURRENT TIME
MOVEM T1,ENDTIME ;ALWAYS REMEMBER LAST TIME
PUSHJ P,GETTIM ;GET ENDING UPTIME IN MS
MOVEM T1,ETIMMS ;REMEMBER UPTIME INPUT ENDED
PUSHJ P,XMTEO1 ;SEE IF EOF
ERROR (E,Y,IAE,<INPUT Result 3 without EOF or ABORT>,<STARTZ>)
TXNN F,F.DEV ;OUTPUTTING TO A DEVICE?
JRST DOINP8 ;NO
CLOSE DEV, ;CLOSE FILE
GETSTS DEV,T3 ;GET STATUS BITS
TXNE T3,IO.IMP!IO.DER!IO.DTE!IO.BKT ;ANY ERRORS?
ERROR (E,Y,CLO,<CLOSE UUO error (^1)>,<STARTZ>) ;LOSE BIT
DOINP8: TELL USR,INDON ;TELL INPUT DONE
PUSHJ P,ENDSTS ;GIVE FINAL STATISTICS
PJRST IODONE ;ALL DONE
DOINP6: LOAD. (T1,C%BXFD) ;check if any data received
JUMPG T1,DOINP9 ;if so - pretend it suc'd
PUSHJ P,CHKTIM ;SEE IF TIME TO REPORT
JFCL
SNOOZE ^D433 ;GO SNOOZE
JRST DOINP1 ;TRY FOR MORE OUTPUT
;HERE WHEN ALL DONE INPUT OR OUTPUT
;
IODONE: ON F.RES ;FLAG RESET
MOVE T1,IOJBFF ;GET .JBFF WHEN WE STARTED I/O
MOVEM T1,.JBFF ;PUT JOBFF BACK
; PUSHJ P,CORUUO ;SHRINK BACK
PJRST CPOPJ1 ;GIVE SKIP RETURN
;LIST OF VALID SWITCHES TO INPUT/OUTPUT
;
DEFINE NAMES,<
SWT BUFSIZ,IOBSIZ,2,<0>; ;0 SAYS COMPUTE OWN BUFSIZ
SWT BYTPOS,IOBPOS,2,0
SWT BYTWRD,IOBWRD,2,5
SWT CCC,IOCCC,3,12
SWT DEVTYP,IODEVT,2,0
SWT DOB,IODOB,4
SWT NUMBYT,IONBYT,2,0
SWT NUMCHR,IONCHR,2,0
SWT OFFSET,IOOFFS,2,0
SWT OPAUSE,IOPAUS,2,0
SWT TIME,IOTIM,0
SWT WIDTH,IOWIDE,2,^D132
SWT FCHAR,IOFCHR,3,40
SWT LCHAR,IOLCHR,3,176
SWT DEVICE,DVDEV,0
SWT LINE,DVLIN,0
SWT PORT,DVPRT,0
>;END DEFINE NAMES
;BUILD TABLE OF NAMES, DISPATCH TABLE,
; AND THE DEFAULT TABLE FOR INPUT OR OUTPUT COMMANDS
;
BUILD (IO,NAM,DSP,DEF) ;TABLES WILL HAVE A PREFIX OF 'IO'
;HERE ON /TIME
;
IOTIM: PUSHJ P,GETSEC ;GET TIME
IMULX T1,^D1000 ;CONVERT SECONDS TO MILLISECONDS
MOVEM T1,IOTIME ;PUT IT WHERE IT WILL BE FOUND
PJRST CPOPJ1 ;GIVE SKIP RETURN
;HERE IS /DOB (DUMP OUTPUT BUFFERS)
;
IODOB: ON F.DOB ;FLAG WE WANT OUTPUT BUFFERS
; DUMPED AFTER EACH WRITE DATA
PJRST CPOPJ1 ;GIVE SKIP RETURN
SUBTTL SET Command
;SETCOM -- SET COMMAND
;
; DOES "SET LINE" OR "SET DEVICE" OR "SET SUPPORT" OR "SET SIMULATE"
;
SETCOM: OFF F.STAT ;NO STATISTICS
TXNE F,F.IBRK ;SEE IF A BREAK
PJRST E.CER ;YES, LOSE
MOVE T1,[XWD SETBLK,SETBLK+1] ;ZERO THE SETBLK
SETZM SETBLK ;ZONK THE FIRST
BLT T1,SETBLK+.LSETB-1 ;CLEAR THE REST OF IT
MOVE T1,[POINT 8,SETBLK] ;BYTE POINTER TO CAL11 BLOCK
; FOR THE SET COMMANDS
MOVEM T1,SETBYT ;STORE THE BYTE POINTER
SETZM SETCNT ;COUNT OF BYTES
MOVE T1,[XWD .LSETB,SETBLK] ;POINT TO THE DATA BLOCK
MOVEM T1,C11BLK+3 ;PUT IN PARAM BLOCK
MOVE T1,[BYTE(12)4(24)0] ;BYTE SIZE (8-BITS),POSITION OF FIRST
MOVEM T1,C11BLK+4 ;PUT IN PARAM BLOCK
PUSHJ P,S$SIX ;GET LINE OR DEVICE
SETCM1: PJRST E.CER ;THERE ISN'T ONE
JUMPE T1,E.CER ;NULL COMMAND
MOVEM T1,L.CMD ;REMEMBER THE COMMAND
MOVE T2,[XWD -.NMSET,SETTAB] ;COMMAND TABLE AND LENGTH
PUSHJ P,UNIQ6 ;SEE IF A MATCH
PJRST E.ILC ;COMMAND NOT UNIQUE
JRST @SETDSP(T1) ;DISPATCH TO COMMAND
PUSHJ P,CONFUS ;SHOULD NEVER HIT THIS
;SET COMMANDS
;
DEFINE NAMES,<
SWT DEVICE,SETDEV,4
SWT LINE,SETLIN,4
SWT PORT,SETPRT,4
SWT SIMULA,SETSIM,4
SWT EMULAT,SETSIM,4
SWT SUPPOR,SETSUP,4
SWT TERMIN,SETSUP,4
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE FOR
; THE SET COMMAND.
;
BUILD (SET,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'SET'
SUBTTL SET DEVICE Command
;HERE TO SET DEVICE
;
SETDEV: PUSHJ P,DVDEV ;GET DEVICE NUMBER
PJRST E.CER ;ERROR
JSP U1,GETCMD ;GET THE COMMAND "/CMD:X"
JUMPLE T1,E.CER ;0 IS ILLEGAL
CAXL T1,.NMDCM ;COMMAND IN RANGE?
PJRST E.CER ;NO
PUSHJ P,SETPUT ;PUT COMMAND IN SET DATA BUFFER
SKIPLE T1,DEVCMD(T1) ;GET POINTER TO SWITCHES
POPJ P, ;GIVE ERROR RETURN WITH MSG IN T1
SKIPN P1,T1 ;COPY TO P1
MOVE P1,[XWD -.NMPLD,PLDTAB] ;NO SWITCHES, SO ALLOW
; /PORT, /LINE, OR /DEVICE
PUSHJ P,DOSWT ;PROCESS THE SWITCHES
POPJ P, ;ERROR, MSG ADR IN T1
MOVX T1,FC.WDC ;WRITE DEVICE CMD
STOR. (T1,C%FC) ;STORE THE FUNCTION CODE
PUSHJ P,CHKDEV ;MAKE SURE DEV+LINE+PORT SETUP
POPJ P, ;NOT, SO ERROR WITH MSG ADR IN T1
PUSHJ P,CCMD11 ;DO THE SET
PUSHJ P,CONFUS ;NEVER HAPPEN
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
; THIS IS A TABLE OF THE VALID "CMD" NUMBERS FOR
; SET DEV:x/CMD:x. EACH COMMAND NUMBER HAS A ENTRY
; IN THIS TABLE IN ONE OF THE FOLLOWING 3 FORMS:
;
; 0 ;NO OTHER SWITCHES ASSOCIATED
; ; WITH THIS COMMAND.
;
; -LENGTH,,ADR ;POINT TO A LIST OF VALID SWITCHES
; ; FOR THIS COMMAND, AS BUILT BY
; ; THE "BUILD" MACRO.
;
; 0,,ADR ;ADR IS THE ADDRESS OF AN ERROR
; ; MESSAGE. THIS MIGHT BE USED FOR
; ; UNDEFINED OR RESERVED COMMANDS.
;
DEVCMD: 0
XWD -.NMD1,D1TAB ;(1) SET CHARACTERISTICS
RES% ;(2) RESERVED
0 ;(3) DUMP OUTPUT BUFFERS
0 ;(4) CLEAR INPUT PERMISSION WAS REQUESTED
RES% ;(5) RESERVED
0 ;(6) SET INTERPRET CARRIAGE CONTROL ON INPUT
0 ;(7) CLEAR INTERPRET CARRIAGE CONTROL ON INPUT
0 ;(8) SET INTERPRET CARRIAGE CONTROL ON OUTPUT
0 ;(9) CLEAR INTERPRET CARRIAGE CONTROL ON OUTPUT
0 ;(10) RESERVED
0 ;(11) RESERVED
XWD -.NMD12,D12TAB ;(12) SPECIFY OUTPUT COMPONENT SELECTION
0 ;(13) DON'T DO OUTPUT COMPONENT SELECTION
XWD -.NMD14,D14TAB ;(14) SET PRINTER PAGE COUNTER
0 ;(15) DISABLE PRINTER PAGE COUNTER OVERFLOW
RES% ;(16) RESERVED
0 ;(17) DO SPACE COMPRESSION
0 ;(18) DON'T DO SPACE COMPRESSION
0 ;(19) USE OLD BSC PROTOCOL (2780)
0 ;(20) DON'T USE OLD BSC PROTOCOL
0 ;(21) REQUEST OUTPUT PERMISSION
0 ;(22) GRANT INPUT PERMISSION
0 ;(23) SIGNAL OUTPUT EOF
0 ;(24) CLEAR OUTPUT EOF COMPLETE
0 ;(25) SIGNAL OUTPUT ABORT
0 ;(26) CLEAR OUTPUT ABORT COMPLETE
0 ;(27) CLEAR INPUT EOF COMPLETE
0 ;(28) SIGNAL INPUT ABORT
0 ;(29) CLEAR INPUT ABORT COMPLETE
0 ;(30) Suspend device HASP
0 ;(31) Unsuspend device HASP
XWD -.NMD32,D32TAB ;(32) Set record size
.NMDCM==.-DEVCMD
IFN <<.NMDCM-1>-DC.LST>,<PRINTX ?TABLE "DEVCMD" TOO SHORT>
;COMMANDS TO COMMAND 1
;
DEFINE NAMES,<
SWT DEVTYP,DP1BYT,7
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE FOR
; SET DEVICE:x/CMD:1
;
BUILD (D1,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'D1'.
;COMMANDS TO COMMAND 12
;
DEFINE NAMES,<
SWT COMPCD,DP1BYT,7
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET DEVICE:x/CMD:12.
;
BUILD (D12,NAM,DSP) ;THE TABLES WILL HAVE A PREFIX OF 'D12'.
;COMMANDS TO COMMAND 14
;
DEFINE NAMES,<
SWT PLC,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET DEVICE:x/CMD:14
;
BUILD (D14,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'D14'.
;COMMANDS TO COMMAND 16
;
DEFINE NAMES,<
SWT BUFSIZ,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET DEVICE:x/CMD:16
;
BUILD (D16,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'D16'
;COMMANDS TO COMMAND 32
;
DEFINE NAMES,<
SWT RECSIZ,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET DEVICE:x/CMD:32
;
BUILD (D32,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'D32'
SUBTTL SET LINE Command
;HERE TO SET LINE
;
SETLIN: PUSHJ P,DVLIN ;GET THE LINE NUMBER
PJRST E.CER ;ERROR
JSP U1,GETCMD ;GET THE COMMAND "CMD:X"
JUMPLE T1,E.CER ;0 IS ILLEGAL
CAXL T1,.NMLCM ;SEE IF COMMAND IS IN RANGE
PJRST E.CER ;COMMAND TO BIG
PUSHJ P,SETPUT ;PUT COMMAND BYTE IN BUFFER
SKIPLE T1,LINCMD(T1) ;GET POINTER TO SWITCHES
POPJ P, ;GIVE ERROR RETURN WITH MSG IN T1
SKIPN P1,T1 ;COPY TO P1
MOVE P1,[XWD -.NMPLD,PLDTAB] ;POINT TO LIST OF VALID SWITCHES
PUSHJ P,DOSWT ;GO PROCESS THEM
POPJ P, ;ERROR, MSG ADR IS IN T1
MOVX T1,FC.WLC ;WRITE LINE COMMAND
STOR. (T1,C%FC) ;STORE THE FUNCTION CODE
PUSHJ P,CHKLIN ;MAKE SURE LINE+PORT SETUP
POPJ P, ;NOT, SO ERROR WITH MSG ADR IN T1
PUSHJ P,CCMD11 ;DO THE SET
PUSHJ P,CONFUS ;SHOULD NEVER HAPPEN
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
; THIS IS A TABLE OF THE VALID "CMD" NUMBERS FOR
; SET LINE:x/CMD:x. EACH COMMAND NUMBER HAS A ENTRY
; IN THIS TABLE IN ONE OF THE FOLLOWING 3 FORMS:
;
; 0 ;NO OTHER SWITCHES ASSOCIATED
; ; WITH THIS COMMAND.
;
; -LENGTH,,ADR ;POINT TO A LIST OF VALID SWITCHES
; ; FOR THIS COMMAND, AS BUILT BY
; ; THE "BUILD" MACRO.
;
; 0,,ADR ;ADR IS THE ADDRESS OF AN ERROR
; ; MESSAGE. THIS MIGHT BE USED FOR
; ; UNDEFINED OR RESERVED COMMANDS.
;
LINCMD: 0
XWD -.NML1,L1TAB ;POINTS TO SWITCHES FOR LINE/CMD:1
XWD -.NML2,L2TAB ;POINTS TO SWITCHES FOR LINE/CMD:2
0 ;NO SWITCHES FOR LINE/CMD:3
0 ;NO SWITCHES FOR LINE/CMD:4
XWD -.NML5,L5TAB ;POINTS TO SWITCHES FOR LINE/CMD:5
XWD -.NML6,L6TAB ;POINTS TO SWITCHES FOR LINE/CMD:6
0 ;NO SWITCHES FOR LINE/CMD:7
0 ;NO SWITCHES FOR LINE/CMD:8
XWD -.NML9,L9TAB ;POINTS TO SWITCHES FOR LINE/CMD:9
XWD -.NML10,L10TAB ;POINTS TO SWITCHES FOR LINE/CMD:10
XWD -.NML11,L11TAB ; Points to switches for LINE/CMD:11
.NMLCM==.-LINCMD
IFN <<.NMLCM-1>-LC.LST>,<PRINTX ?TABLE "LINCMD" TOO SHORT>
;DEFINE SWITCHES FOR "SET LINE:X/CMD:1
;
DEFINE NAMES,<
SWT TERMIN,SLC1.T,0
SWT FLAGS,SLC1.F,0
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES THE DISPATCH TABLE
; FOR SET LINE:x/CMD:1
;
BUILD (L1,NAM,DSP) ;TABLE WILL HAVE A PREFIX OF 'L1'
;HERE FOR "SET LINE:X/CMD:1/TERM:X
;
SLC1.T: PUSHJ P,S$DEC ;GET TERMINAL TYPE
POPJ P, ;ERROR RETURN
DPB T1,[POINT 8,SETBLK,15] ;PUT IT IN THE SET DATA BLOCK
SLC1T1: MOVX T1,3 ;NUMBER OF BYTES FOR COMMAND
; (INCLUDE FOR /FLAGS:X)
STOR. (T1,C%NBYT) ;STORE NUMBER OF BYTES
PJRST CPOPJ1 ;GIVE SKIP RETURN
;HERE FOR "SET LINE:X/CMD:1/FLAGS:X
;
SLC1.F: PUSHJ P,S$DEC ;GET FLAGS VALUE
POPJ P, ;GIVE ERROR RETURN
DPB T1,[POINT 8,SETBLK,23] ;PUT IT IN THE SET DATA BLOCK
PJRST SLC1T1 ;GIVE COUNT AND SKIP RETURN
;DEFINE SWITCHES FOR "SET LINE:x/CMD:2
;
DEFINE NAMES,<
SWT FLAGS,SLC2FL,2
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:2
;
BUILD (L2,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L2'
;DEFINE SWITCHES FOR "SET LINE:x/CMD:5
;
DEFINE NAMES,<
SWT CSD,DP2BYT,6
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:5
;
BUILD (L5,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L5'
;DEFINE SWITCHES FOR "SET LINE:x/CMD:6
;
DEFINE NAMES,<
SWT SILWAR,DP2BYT,6
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:6
;
BUILD (L6,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L6'
;DEFINE SWITCHES FOR "SET LINE:x/CMD:9
;
DEFINE NAMES,<
SWT TBL,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:9
;
BUILD (L9,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L9'
;DEFINE SWITCHES FOR "SET LINE:x/CMD:10
;
DEFINE NAMES,<
SWT RPM,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:10
;
BUILD (L10,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L10'
;DEFINE SWITCHES FOR "SET LINE:x/CMD:11
;
DEFINE NAMES,<
SWT SIG,DP2BYT,6
>;END DEFINE
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET LINE:x/CMD:11
;
BUILD (L11,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'L11'
SUBTTL SET PORT Command
;HERE TO SET PORT
;
SETPRT: PUSHJ P,DVPRT ;GET PORT NUMBER
PJRST E.CER ;ERROR
MOVE P1,[XWD -.NMPRT,PRTTAB] ;TABLE OF VALID SWITCHES
PUSHJ P,DOSWT ;GO PROCESS THEM
POPJ P, ;ERROR, MSG ADR IS IN T1
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
DEFINE NAMES,<
SWT DEVICE,DVDEV,0
SWT LINE,DVLIN,0
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND DISPATCH TABLE
; FOR SET PORT:x/LINE:x/DEVICE:x
;
BUILD (PRT,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'PRT'
SUBTTL SET SUPPORT Command
;HERE TO SET SUPPORT
;
M.3780==1 ;TO INDICATE 3780 MODE
M.2780==2 ;TO INDICATE 2780 MODE
M.HASP==3 ;TO INDICATE HASP MODE
;
SETSIM: TXOA F,F.SIM ;FLAG SIMULATE MODE
SETSUP: OFF F.SIM ;FLAG SUPPORT MODE
OFF F.TRAN ;FLAG NOT TRANSPARENT MODE
SETZB T1,COMPCD ;ASSUME FOR 2780/3780
STOR. (T1,C%DEV) ;DEV 0 FOR 2780/3780
MOVEI T1,D3780 ;ASSUME 3780 AS DEFAULT
MOVEM T1,DEVTAB ;
MOVNI T1,M.3780 ;ASSUME 3780 MODE AS DEFAULT
MOVEM T1,SSMODE ;REMEMBER DEFAULT MODE
MOVE P1,[XWD -.NMMOD,MODTAB] ;VALID SWITCHES
PUSHJ P,DOSWT ;PROCESS SWITCHES
POPJ P, ;ERROR, MSG ADR IN T1
MOVMS P3,SSMODE ;GET A COPY OF SSMODE AND MAKE
; SURE ITS POSITIVE
MOVMS T1,COMPCD ;GET COMPONENT CODE
; AND MAKE SURE COMPONENT CODE IS POSITIVE
CAXE P3,M.HASP ;HASP MODE?
PJUMPN T1,E.CER ;/LPT/CIN/COUT/CDR/CDP/SIGNON IS
; ONLY LEGAL WITH /HASP
CAXE P3,M.HASP ;HASP MODE IS THE ONLY ONE
TXNN F,F.TRAN ;ALLOWED TRANSPARENCY
CAIA ;FOR TRANSPARENT MODE ON 2780/3780
JRST E.CER ;GIVE COMMAND ERROR
PUSHJ P,CHKDEV ;SEE IF PORT, LINE, AND DEV ARE SETUP
POPJ P, ;NO, SO ERROR WITH ERROR MSG ADR IN T1
PUSHJ P,RDLNS ;GET THE LINE STATUS
MOVE P4,T1 ;PRESERVE LINE STATUS
TXNE P4,LI.ENB ;check if line is enabled
TXNN P4,LI.DTR ;HAVE DTR?
JRST SESUPA ;NO, DO ENTIRE SEQUENCE
LDB T1,[POINT 8,SETBLK,7] ;GET TERMINAL TYPE INFO
CAME T1,P3 ;SAME AS COMMAND?
JRST SESUPA ;NO, DISABLE AND RE-ENABLE WITH NEW
TXNN F,F.SIM ;SIMULATE MODE (/SIM)?
JRST [ TXNN P4,LF.SIM ;NO, SUP BUT IS LINE IN SUP MODE?
JRST SESUPB ;YES, DON'T DISABLE
JRST SESUPA ] ;NO, DISABLE
TXNE P4,LF.SIM ;IS LINE SIMULATE MODE?
JRST SESUPB ;YES, DON'T DISABLE LINE
SESUPA: MOVX T2,<POINT 7,LICMDS> ;STRING TO DISABLE LINE
PUSHJ P,XLICMD ;DISABLE THE LINE
POPJ P, ;ERROR
SNOOZE ^D1000 ;GO SNOOZE FOR 1 SECOND
MOVX T2,<POINT 7,LICMEN> ;POINTER TO LINE ENABLE COMMAND
PUSHJ P,XLICMD ;ENABLE LINE
POPJ P, ;ERROR
SESUPB: MOVX T2,<POINT 7,LICMDO> ;POINTER TO LINE COMMANDS TO DO
PUSHJ P,XLICMD ;DO OTHER LINE COMMANDS
POPJ P, ;ERROR
MOVE T1,DEVTAB ;POINT CORRECT DEVICE SETUP TABLE
MOVX T2,<POINT 7,DVCMDO> ;POINT TO STRING OF DEVICE COMMANDS
MOVEI T3,[ASCIZ \Device\] ;DEVICE COMMAND
LOAD. (T4,C%DEV) ;GET DEVICE NUMBER
PUSHJ P,FRLIDV ;DO DEVICE COMMANDS
POPJ P, ;ERROR
TXNN F,F.TRAN ;WANT TRANSPARENT?
PJRST CPOPJ1 ;EXIT IF NON-TRANSPARENT
MOVX T2,<POINT 7,LICMTR> ;TRANSPARENT STRING
PJRST XLICMD ;ENABLE TRANSPARENCY
;ROUTINE TO DO LINE COMMANDS
;
; CALL: PUSHJ P,XLICMD ;T2 CONTAINS BYTE POINTER TO STRING
; ; OF LINE COMMANDS TO BE EXECUTED
; ;P3 CONTAINS M.3780, M.2780, OR M.HASP
; ERROR ;SHOULD NOT HAPPEN - BUT
; GOOD RETURN ;
;
XLICMD: MOVE T1,[ L3780 ;3780 TABLE
L2780 ;2780 TABLE
LHASP]-1(P3) ;HASP TABLE
MOVEI T3,[ASCIZ \Line\] ;LINE COMMAND
LOAD. (T4,C%LINE) ;GET LINE NUMBER
PJRST FRLIDV ;DO LINE COMMAND(S)
DEFINE NAMES,<
; SWT DEVICE,DVDEV,0
SWT LINE,DVLIN,0
SWT PORT,DVPRT,0
SWT 2780,SE2780,4
SWT 3780,SE3780,4
SWT HASP,SEHASP,4
SWT TRANSP,SETRAN,4
SWT NOTRAN,SENTRA,4
SWT CIN,SECIN,4
SWT COUT,SECOUT,4
SWT CDP,SECDP,4
SWT CDR,SECDR,4
SWT LPT,SELPT,4
SWT SIGNON,SESIGN,4
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH TABLE
; FOR SET SUPPORT OR SET SIMULATE COMMANDS
;
BUILD (MOD,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'MOD'.
; HERE IF /3780
;
; RETURN M.3780 IN SSMODE
;
SE3780: SKIPL SSMODE ;WRONG MODE SPECIFIED?
PJRST E.CER ;YES
MOVX T1,M.3780 ;PUT IN 3780 MODE
MOVEI T2,D3780 ;3780 DEVICE TABLE
JRST SE278A ;GIVE OK RETURN
; HERE IF /2780
;
; RETURN M.2780 IN SSMODE
;
SE2780: SKIPL SSMODE ;WRONG MODE SPECIFIED?
PJRST E.CER ;YES
MOVX T1,M.2780 ;PUT IN 2780 MODE
MOVEI T2,D2780 ;2780 DEVICE TABLE
SE278A: MOVX T3,0 ;DEVICE 0
STOR. (T3,C%DEV) ;DEVICE 0 FOR 2780/3780
JRST SEHAS1 ;GIVE OK RETURN
; HERE IF /HASP
;
; RETURN M.HASP IN SSMODE
;
SEHASP: SKIPL SSMODE ;WRONG MODE SPECIFIED?
PJRST E.CER ;YES
MOVX T3,4 ;DEFAULT DEVICE FOR HASP
LOAD. (T4,C%DEV) ;GET DEVICE NUMBER
SKIPN T4 ;HAVE A DEVICE NUMBER FOR HASP
STOR. (T3,C%DEV) ;NO, GIVE IT THE DEVAULT
MOVNI T1,224 ;DEFAULT COMPONENT CODE FOR HASP
MOVE T2,DEVTAB ;GET COPY OF DEVICE SETUP TABLE
SKIPE COMPCD ;ALREADY HAVE A COMPONENT CODE?
JRST SEHAS3 ;YES
MOVEI T2,DHLPT ;DEFAULT IS LPT
MOVEM T1,COMPCD ;NO, PLUG IN THE DEFAULT
SEHAS3: MOVX T1,M.HASP ;PUT IN HASP MODE
SEHAS1: MOVEM T1,SSMODE ; AND LEAVE WHERE WILL BE FOUND
MOVEM T2,DEVTAB ;SETUP POINTER TO DEVICE TABLE
PJRST CPOPJ1 ;GIVE OK RETURN
;
; HERE IF /TRANSPARENT OR /NONTRANSPARENT
;
SETRAN: TXOA F,F.TRAN ;PUT IN TRANSPARENT MODE
SENTRA: OFF F.TRAN ;PUT IN NON-TRANSPARENT MODE
PJRST CPOPJ1 ;GIVE OK RETURN
;HERE IF /CIN - CONSOLE INPUT
;
SECIN: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,221 ;CODE FOR CONSOLE INPUT IN SIMULATE MODE
TXNN F,F.SIM ;SIMULATE MODE?
MOVX T1,222 ;CODE FOR CONSOLE INPUT IN SUPPORT MODE
MOVEI T2,DHCIN ;POINT TO CONSOLE INPUT DEVICE TABLE
JRST SESIG1 ;GO STORE VALUE
;HERE IF /COUT - CONSOLE OUTPUT
;
SECOUT: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,222 ;CODE FOR CONSOLE OUTPUT IN SIMULATE MODE
TXNN F,F.SIM ;SIMULATE MODE?
MOVX T1,221 ;CODE FOR CONSOLE OUTPUT IN SUPPORT MODE
MOVEI T2,DHCOUT ;POINT TO CONSOLE OUTPUT DEVICE TABLE
JRST SESIG1 ;GO STORE VALUE
;HERE IF /CDP - CARD PUNCH
;
SECDP: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,225 ;CODE FOR CARD PUNCH
MOVEI T2,DHCDP ;POINT TO CDP DEVICE TABLE
JRST SELPT1 ;GO GET CDP NUMBER (IF ANY)
;HERE IF /CDR - CARD READER
;
SECDR: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,223 ;CODE FOR CARD READER
MOVEI T2,DHCDR ;POINT TO CDR DEVICE TABLE
JRST SELPT1 ;GO GET CDR NUMBER (IF ANY)
;HERE IF /LPT - LINE PRINTER
;
SELPT: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,224 ;CODE FOR LINE PRINTER
MOVEI T2,DHLPT ;POINT TO LPT DEVICE TABLE
SELPT1: MOVEM T1,COMPCD ;SAVE COMPONENT CODE
MOVEM T2,DEVTAB ;REMEMBER POINTER TO CORRECT DEV TABLE
CAIE C,":" ;A UNIT NUMBER COMING?
JRST SESIG2 ;NO
PUSHJ P,S$OCT ;GET UNIT NUMBER
POPJ P, ;NONE - LOSE
SKIPL T1 ;WITHIN
CAXLE T1,MAXUNT ; RANGE?
PJRST E.CER ;NO, ERROR
IMULX T1,20 ;MUL BY 20
ADDB T1,COMPCD ;PUT UNIT NUMBER IN ALSO
JRST SESIG2 ;GIVE GOOD RETURN
;HERE IF /SIGNON - SIGN ON
;
SESIGN: SKIPLE COMPCD ;ALREADY A COMPONENT CODE FROM ANOTHER
; SWITCH?
PJRST E.CER ;YES, ILLEGAL
MOVX T1,360 ;CODE FOR SIGNON
MOVEM T1,COMPCD ;REMEMBER THE COMPONENT CODE
MOVX T1,SIGNDV ;THE SIGNON DEVICE
MOVEI T2,DHSIGN ;POINT TO SIGNON DEVICE TABLE
JRST SESIG3 ;
SESIG1: MOVEM T1,COMPCD ;REMEMBER THE COMPONENT CODE
SESIG3: MOVEM T2,DEVTAB ;SAVE ADDRESS OF DEVICE TABLE SETUP
SESIG2: ANDX T1,7 ;KEEP ONLY DEV NUMBER
PJRST DVDEV1 ;STORE DEV # IN C11BLK
SUBTTL ABORT Command
;HERE TO ABORT INPUT OR OUTPUT
;
ABTCOM: TXNE F,F.ABTW ;SEE IF ALREADY WAITING FOR AN ABORT
ABTINP: ERROR (W,Y,ADA,<Already doing an ABORT>,<CPOPJ1>)
ABTCM1: OFF F.ABTI!F.ABTO!F.STAT ;CLEAR FLAGS
OFF F.ABTW ;ASSUME NO WAIT FOR ABORT TO COMPLETE
MOVE P1,[XWD -.NMABT,ABTTAB] ;VALID SWITCHES FOR ABORT
PUSHJ P,DOSWT ;PROCESS THE SWITCHES
POPJ P, ;GIVE THE ERROR MSG
PUSHJ P,CHKDEV ;MUST HAVE PORT, LINE, AND DEV
POPJ P, ;DON'T, SO GIVE ERROR
TXNN F,F.ABTW ;IN ABORT WAIT MODE?
JRST ABTCM0 ;NO
OFF F.RES ;SO WE PROMPT "!"
CHR USR,"!" ;PROMPT RUNNING
ABTCM0: TXNE F,F.ABTO!F.ABTI ; Check for either abort flag set
JRST ABTCM2 ; Yes so go process the abort(s)
TXNN F,F.IN!F.OUT ; Is either input or output being done?
ON F.ABTO!F.ABTI ; No .. so abort both directions
TXNE F,F.IN ; Is input being done?
ON F.ABTI ; Yes .. so abort input
TXNE F,F.OUT ; Is output being done?
ON F.ABTO ; Yes .. so abort output
ABTCM2: TXNN F,F.ABTO!F.ABTI ;SEE IF DONE YET?
JRST [ TXZE F,F.ABTW ;CLEAR WAIT BIT
OFF F.RES ;OUT OF RUN MODE
PJRST CPOPJ1 ] ;AND GIVE SKIP RETURN
SETCM T1,F ;COMPLEMENT FLAGS
TXNE T1,F.ABTI!F.ABTO!F.ABTW ;SEE IF ABORT OUTPUT AND INPUT
; AND IN WAIT STATE.
JRST ABTCM3 ;NO
PUSHJ P,SETOAB ;SET OUTPUT ABORT
PUSHJ P,SETIAB ;SET INPUT ABORT
ABTCM3: PUSHJ P,RDDVS ;GET CURRENT DEVICE STATUS
JFCL ;IGNORE THIS RETURN
TXZN F,F.ABTO ;SEE IF TO DO OUTPUT
JRST ABIN ;NO, DO INPUT
;HERE TO ABORT OUTPUT
;
ABOUT: TXNE T1,DS.OAC ;DO WE HAVE OUT ABORT COMPLETE?
JRST ABOUT3 ;YES, SO GO CLEAR IT
TXNE T1,DS.OAS ;HAS OUTPUT ABORT STARTED?
JRST ABOUT0 ;YES, GO WAIT FOR COMPLETE TO SET
PUSHJ P,SETOAB ;GO SET OUTPUT ABORT
ABOUT0: TXNN F,F.ABTW ;SEE IF TO WAIT FOR ABORT TO COMPLETE
JRST ABTCM2 ;DON'T WAIT
TELL USR,[ASCIC([Waiting for output abort complete to set])]
ABOUT1: SNOOZE USR,^D500 ;GO HIBER 500 MS
PUSHJ P,CKOABT ;SEE IF OUTPUT ABORT COMPLETE SET
JRST [ PUSHJ P,CKOEOF ;NO, CLEAR OUT EOF COMPLETE
PUSHJ P,CKIEOF ;CLEAR IN EOF COMPLETE
PUSHJ P,CLIABC ;CLEAR INPUT ABORT COMPLETE
JRST ABOUT1 ] ;GO WAIT FOR OUTPUT ABORT
; COMPLETE TO SET.
ON F.OABT ;FLAG ABORT DONE
ABOUT3: TXNE F,F.ABTW ;WAITING FOR COMPLETE?
PUSHJ P,CLOABC ;YES, CLEAR COMPLETE
JRST ABTCM2 ;GO SEE IF MORE TO DO
;HERE TO ABORT INPUT
;
ABIN: TXNE T1,DS.IAC ;SEE IF INPUT ABORT COMPLETE
JRST ABIN3 ;YES, GO CLEAR INPUT ABT COMPLETE
TXNE T1,DS.IAS ;HAS INPUT ABORT STARTED?
JRST ABIN0 ;YES, GO WAIT FOR COMPLETE TO SET
PUSHJ P,SETIAB ;GO SET INPUT ABORT
ABIN0: TXNN F,F.ABTW ;SEE IF TO WAIT FOR ABORT TO COMPLETE
JRST ABIN6 ;DON'T WAIT
TELL USR,[ASCIC([Waiting for input abort complete to set])]
ABIN1: SNOOZE USR,^D500 ;HIBER 500 MS
PUSHJ P,CKIABT ;SEE IF INPUT ABORT COMPLETE SET
JRST [ PUSHJ P,CKIEOF ;NO, CLEAR INPUT EOF COMPLETE
PUSHJ P,CKOEOF ;CLEAR OUTPUT EOF COMPLETE
PUSHJ P,CLOABC ;CLEAR OUTPUT ABORT COMPLETE
JRST ABIN1 ] ;GO WAIT FOR INPUT ABORT
; COMPLETE TO SET.
ON F.IABT ;FLAG INPUT ABORT DONE
ABIN3: TXNE F,F.ABTW ;WAITING FOR INPUT COMPLETE?
PUSHJ P,CLIABC ;YES, CLEAR INPUT COMPLETE
ABIN6: OFF F.ABTI ;DONE WITH INPUT
JRST ABTCM2 ;GO SEE IF MORE TO DO
;Switch table for the ABORT command
;
DEFINE NAMES,<
SWT ALL,ABTALL,4
SWT INPUT,ABTIN,4
SWT OUTPUT,ABTOUT,4
SWT WAIT,ABTWAT,4
SWT NOWAIT,ABTNWA,4
SWT PORT,DVPRT,0
SWT LINE,DVLIN,0
SWT DEVICE,DVDEV,0
>;END DEFINE NAMES FOR ABORT
;BUILD THE TABLE OF NAMES AND DISPATCH TABLE
; FOR ABORT/INPUT/OUTPUT
;
BUILD (ABT,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF ABT
; Here to set bits for both input and output aborts (ALL)
ABTALL: TXO F,F.ABTO!F.ABTI ; Set both input and output aborts
PJRST CPOPJ1 ; Sucessful return
;HERE TO SET BIT FOR OUTPUT ABORT
;
ABTOUT: TXOA F,F.ABTO ;SET FOR OUTPUT ABORT TO HAPPEN
;HERE TO SET BIT FOR INPUT ABORT
;
ABTIN: ON F.ABTI ;SET FOR INPUT ABORT TO HAPPEN
PJRST CPOPJ1 ;GIVE GOOD RETURN
;HERE TO SET BIT SO WE WAIT FOR ABORT SEQUENCE
; TO COMPLETE.
;
ABTWAT: TXOA F,F.ABTW ;SET THE WAIT BIT
;HERE TO CLEAR BIT SO JUST THE ABORT COMMAND IS ISSUED
;
ABTNWA: OFF F.ABTW ;CLEAR THE WAIT BIT
PJRST CPOPJ1 ;GIVE GOOD RETURN
;ROUTINES USED WITH THE ABORT COMMAND
;ROUTINE TO CLEAR INPUT EOF COMPLETE IF SET
;
; CALL: PUSHJ P,CKIEOF ;
; RETURN ;INPUT EOF COMPLETE NOT SET
; ; OR CLEARED
;
CKIEOF: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE
TXNN T1,DS.IEC ;INPUT EOF COMPLETE SET?
POPJ P, ;NO, RETURN TO CALLER
MOVX T1,BYTE (8) DC.CIE ;CLEAR INPUT
PUSHJ P,WRTDV1 ; EOF COMPLETE.
TELL USR,[ASCIC([Input EOF complete cleared])]
POPJ P, ;RETURN
;ROUTINE TO CLEAR OUTPUT EOF COMPLETE IF SET
;
; CALL: PUSHJ P,CKOEOF ;
; RETURN ;OUTPUT EOF COMPLETE NOT SET
; ; OR CLEARED
;
CKOEOF: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE
TXNN T1,DS.OEC ;OUTPUT EOF COMPLETE SET?
POPJ P, ;NO, RETURN TO CALLER
MOVX T1,BYTE (8) DC.COE ;CLEAR OUTPUT
PUSHJ P,WRTDV1 ; EOF COMPLETE.
TELL USR,[ASCIC([Output EOF complete cleared])]
POPJ P, ;RETURN
;ROUTINE TO CLEAR INPUT ABORT IF SET
;
; CALL: PUSHJ P,CKIABT ;
; RETURN ;IF INPUT ABORT COMPLETE NOT SET
; RETURN ;IF INPUT ABORT COMPLETE CLEARED
;
CKIABT: PUSHJ P,RDDVS ;GET CURRENT DEVICE STATUS
JFCL ;IGNORE
TXNN T1,DS.IAC ;INPUT ABORT COMPLETE?
POPJ P, ;NO, RETURN TO CALLER
TELL USR,[ASCIC([Input abort complete set])]
PJRST CPOPJ1 ;GIVE SKIP RETURN
;ROUTINE TO CLEAR OUTPUT ABORT IF SET
;
; CALL: PUSHJ P,CKOABT ;
; RETURN ;IF OUTPUT ABORT COMPLETE NOT SET
; RETURN ;IF OUTPUT ABORT COMPLETE CLEARED
;
CKOABT: PUSHJ P,RDDVS ;GET CURRENT DEVICE STATUS
JFCL ;IGNORE
TXNN T1,DS.OAC ;OUTPUT ABORT COMPLETE?
POPJ P, ;NO, RETURN TO CALLER
TELL USR,[ASCIC([Output abort complete set])]
PJRST CPOPJ1 ;GIVE SKIP RETURN
;ROUTINE TO CLEAR INPUT ABORT COMPLETE
;
; CALL: PUSHJ P,CLIABC ;
; RETURN ;WITH INPUT ABORT COMPLETE CLEARED
;
CLIABC: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE THIS
TXNN T1,DS.IAC ;IS INPUT ABORT COMPLETE SET?
POPJ P, ;NO, RETURN
TELL USR,[ASCIC([Clearing input abort complete])]
MOVX T1,BYTE (8) DC.CIA ;
PUSHJ P,WRTDV1 ;CLEAR INPUT ABORT COMPLETE
PUSHJ P,RDDVS ;GET STATUS
JFCL ;IGNORE
TXNE T1,DS.IAC!DS.IAS ;ANY INPUT ABORT BITS SET?
ERROR (E,Y,IAB,<Can't clear input abort complete>,<STARTZ>)
TELL USR,[ASCIC([Input abort complete cleared])]
POPJ P, ;RETURN
;ROUTINE TO CLEAR OUTPUT ABORT COMPLETE
;
; CALL: PUSHJ P,CLOABC ;
; RETURN ;WITH OUTPUT ABORT COMPLETE CLEARED
;
CLOABC: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE THIS
TXNN T1,DS.OAC ;IS OUTPUT ABORT COMPLETE SET?
POPJ P, ;NO, RETURN
TELL USR,[ASCIC([Clearing output abort complete])]
MOVX T1,BYTE (8) DC.COA ;
PUSHJ P,WRTDV1 ;CLEAR OUTPUT ABORT COMPLETE
PUSHJ P,RDDVS ;GET STATUS
JFCL ;IGNORE
TXNE T1,DS.OAC!DS.OAS ;ANY OUTPUT ABORT BITS SET?
JRST CLOAB2 ;YES, ERROR
TELL USR,[ASCIC([Output abort complete cleared])]
POPJ P, ;RETURN
CLOAB2: TELL USR,OAB% ;OUTPUT ABORT ERROR
PJRST STARTZ ;LOSE BIG
;ROUTINE TO SET OUTPUT ABORT
;
; CALL: PUSHJ P,SETOAB ;
; RETURN ;
;
SETOAB: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE THIS RETURN
TXNE T1,DS.OAC!DS.OAS ;OUTPUT ABORT COMPLETE OR STARTED?
POPJ P, ;YES, NO USE IN SETTING ABORT
TELL USR,[ASCIC([Setting output abort])]
MOVX T1,BYTE (8) DC.SOA ;SIGNAL OUT ABORT COMMAND
PJRST WRTDV1 ;GO ABORT OUTPUT
;ROUTINE TO SET INPUT ABORT
;
; CALL: PUSHJ P,SETIAB ;
; RETURN ;
;
SETIAB: PUSHJ P,RDDVS ;GET DEVICE STATUS
JFCL ;IGNORE THIS RETURN
TXNE T1,DS.IAC!DS.IAS ;INPUT ABORT COMPLETE OR STARTED?
POPJ P, ;YES, NO USE IN SETTING ABORT
TELL USR,[ASCIC([Setting input abort])]
MOVX T1,BYTE (8) DC.SIA ;SIGNAL IN ABORT COMMAND
PJRST WRTDV1 ;GO ABORT INPUT
SUBTTL Routines
;ROUTINE FOR SETTING UP THE PARAM BLOCK
; FOR READING AND WRITING DEVICE, LINE,
; AND DN60 STATUS
;
; CALL: PUSHJ P,SETSET ;T1 CONTAINS # OF BYTES, FUNCTION CODE
; RETURN
;
SETSET: MOVEM T1,C11BLK+2 ;STORE NUMBER OF BYTES, FUNCTION CODE
SETSE1: MOVE T1,[XWD .LSETB,SETBLK] ;ADDRESS OF BLOCK
MOVEM T1,C11BLK+3 ;FOR CAL11
MOVX T1,BYTE (12) 4 ;8 BIT BYTES
MOVEM T1,C11BLK+4 ;TELL CAL11 8 BIT BYTES
POPJ P, ;RETURN TO CALLER
;ROUTINE TO CLEAR "SETBLK"
;
; CALL: PUSHJ P,CLSETB ;
; RETURN ;ALWAYS
;
CLSETB: STORE (T1,SETBLK,SETBLK+.LSETB-1,0)
POPJ P, ;RETURN TO CALLER
;ROUTINE TO READ THE DEVICE STATUS
;
; CALL: PUSHJ P,RDDVS ;
; RETURN ;IF ABORT BITS SET
; ; T1 CONTAINS THE 4 FLAG BYTES
; RETURN ;T1 CONTAINS THE 4 FLAG BYTES
; ;T2 CONTAINS THE NUMBER OF BYTES
; ; TRANSFERRED
;
RDDVS: MOVE T1,[XWD DS.BYT,FC.RDS] ;# OF BYTES, FUNCTION
PUSHJ P,SETSET ;SETUP PARAM BLOCK
PUSHJ P,CLSETB ;CLEAR THE SETBLK
PUSHJ P,CAL11 ;GET THE DEVICE STATUS
PUSHJ P,CONFUS ;SHOULD NEVER HAPPEN
MOVE T1,[POINT 8,SETBLK+1] ;SET TO GET FLAG BYTES
MOVEM T1,SETBYT ;WHERE ROUTINE WILL FIND POINTER
MOVX T1,4 ;GET 4 BYTES
PUSHJ P,GETBYT ;GET THE 4 FLAG BYTES
LOAD. (T2,C%BXFD) ;GET NUMBER OF BYTES XFER'ED
MOVE T1,T3 ;GET TO RIGHT AC
TXNE T1,DS.IAC!DS.IAS!DS.OAC!DS.OAS ;SEE IF ABORT UP
POPJ P, ;GIVE NON SKIP RETURN CAUSE ABORT
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
;ROUTINE TO READ THE LINE STATUS
;
; CALL: PUSHJ P,RDLNS ;
; RETURN ;WITH STATUS IN SETBLK
; ; AND LINE INFO,,FLAGS IN T1
; ; AND NUMBER OF BYTES XFER'ED IN T2
;
RDLNS: MOVE T1,[XWD LS.BYT,FC.RLS] ;# BYTES, FUNCTION
PUSHJ P,SETSET ;SETUP PARAM BLOCK
PUSHJ P,CLSETB ;CLEAR SETBLK
PUSHJ P,CAL11 ;GET THE LINE STATUS
PUSHJ P,CONFUS ;SHOULD NEVER HAPPEN
LDB T1,[POINT 8,SETBLK,15] ;GET FLAGS
LDB T2,[POINT 8,SETBLK,31] ;GET LINE INFO
HRL T1,T2 ;PUT LINE INFO IN LH OF T1
LOAD. (T2,C%BXFD) ;GET NUMBER OF BYTES XFER'ED
POPJ P, ;RETURN TO CALLER
;ROUTINE TO WRITE THE DEVICE CMD
;
; CALL: PUSHJ P,WRTDVC ;T2 CONTAINS # OF BYTES
; ;T1 CONTAINS THE COMMAND
; CALL: PUSHJ P,WRTDV1 ;IF ONLY 1 BYTE (NO NEED TO SETUP T2)
; RETURN ;RETURN ALWAYS
;
WRTDV1: MOVX T2,1 ;ENTER HERE IF ONLY 1 BYTE
WRTDVC: MOVEM T1,SETBLK ;SETUP FOR CAL11
HRRI T1,FC.WDC ;WRITE DEV FUNCTION
HRL T1,T2 ;POSITIVE COUNT TO (LH)
WRTLDS: PUSHJ P,SETSET ;SETUP PARAM BLOCK
PUSHJ P,CCMD11 ;WRITE IT
PUSHJ P,CONFUS ;NEVER HAPPEN
POPJ P, ;RETURN TO CALLER
;ROUTINE TO WRITE THE LINE CMD
;
; CALL: PUSHJ P,WRTLNC ;T1 CONTAINS # OF BYTES
; ; SETBLK MUST BE SETUP
; RETURN ;RETURN ALWAYS
;
WRTLNC: MOVSS T1 ;COUNT IN LH
HRRI T1,FC.WLC ;WRITE LINE FUNCTION
JRST WRTLDS ;DO REST
;HERE TO FORCE A COMMAND FROM INTERNAL TEXT
;
; CALL: PUSHJ P,FRCCMD ;P1 CONTAINS [XWD -LENGTH,ADR OF BLOCK]
; RETURN ;IF ERROR
; RETURN ;IF OK
;
FRCCMD: ON F.FCOM ;SET FORCED COMMAND FLAG
PUSHJ P,SAVSCN ;SAVE STATE OF THE SCANNER
MOVX T1,STRIN ;ADDRESS OF STRING COMMAND INPUT ROUTINE
MOVEM T1,L.SCIN ;STORE FOR THE SCANNERS
FRCCM1: MOVE B,[POINT 7,FRCBUF] ;POINT TO WHERE COMMAND WILL BE PUT
MOVEM B,FRCPNT ; AND GOT FROM
MOVX T1,FRCMAX ;SIZE OF BUFFER
MOVEM T1,FRCCNT ;SAVE COUNT
HRRZ T1,(P1) ;GET THE ADDRESS
TELL USR,[ASCIN( )] ;LEADING TAB
TELL USR!FRC,@T1 ;PRINT THE COMMAND AS WE DO IT
PUSHJ P,S$SIX ;GET COMMAND
PUSHJ P,CONFUS ;NEVER HAPPEN
MOVEM T1,L.CMD ;REMEMBER THE COMMAND
MOVX T2,COMTAB ;TABLE OF COMMANDS
HRLI T2,-.NMCOM ;LENGTH
PUSH P,P1 ;SAVE THIS
PUSH P,F ; AND THIS
PUSHJ P,UNIQ6 ;SEE IF WE KNOW ABOUT IT
PUSHJ P,CONFUS ;WOW
OFF F.IBRK ;ZONK THIS
PUSHJ P,@COMDSP(T1) ;GO TO ROUTINE
JRST [ POP P,F ;
POP P,P1 ;
PJRST E.CER ] ;GIVE ERROR
POP P,F ;
POP P,P1 ;RESTORE
HLRZ T1,(P1) ;GET THE SLEEP TIME
SKIPE T1 ;IS THERE A SLEEP TIME?
SNOOZE @T1 ;YES, GO SNOOZE
AOBJN P1,FRCCM1 ;LOOP TILL ALL DONE
FRCEXT: OFF F.FCOM ;DONE WITH FORCED COMMAND
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
;HERE TO DO DEVICE/LINE COMMANDS BASED ON INFORMATION
; CONTAINED IN A TABLE
;
; CALL: PUSHJ P,FRLIDV ;T1 CONTAINS ADR TO TABLE
; ;T2 CONTAINS A 7-BIT BYTE POINTER TO
; ; A STRING WHICH INDICATES WHICH
; ; COMMAND(S) TO EXECUTED FROM THE TABLE
; ; THE TERMINATOR IN THE STRING IS
; ; A BYTE OF -1
; ;T3 CONTAINS ADDRESS OF ASCIZ
; ; \Line\ or \Device\
; ;T4 CONTAINS THE LINE OR DEVICE NUMBER
; RETURN ;UNLESS FATAL ERROR
;
FRLIDV: ON F.FCOM ;SET FORCED COMMAND FLAG
PUSHJ P,SAVE4 ;SAVE P1-P4
DMOVE P1,T1 ;GET TABLE AND BYTE POINTER
; IN P1 AND P2
DMOVE P3,T3 ;GET SIXBIT LINE OR DEV AND LINE/DEV NUMBER
; IN P3 AND P4
PUSHJ P,SAVSCN ;SAVE STATE OF THE SCANNER
MOVX T1,STRIN ;ADDRESS OF STRING COMMAND INPUT ROUTINE
MOVEM T1,L.SCIN ;STORE FOR THE SCANNERS
FRLID2: MOVE B,[POINT 7,FRCBUF] ;POINT TO WHERE THE COMMAND WILL BE PUT
MOVEM B,FRCPNT ; AND GOT FROM
MOVX T1,FRCMAX ;SIZE OF BUFFER
MOVEM T1,FRCCNT ;SAVE THE SIZE
ILDB T4,P2 ;GET THE COMMAND NUMBER
CAXN T4,177 ;END OF COMMANDS?
JRST FRCEXT ;YES,
MOVE T1,P1 ;GET ADDRESS OF TABLE
ADD T1,T4 ;POINT TO COMMAND IN TABLE
HRRZ T2,(T1) ;GET POINTER TO SIMULATE COMMAND
TXNN F,F.SIM ;BUT IS IT SIMULATE MODE
HLRZ T2,(T1) ;NO, GET POINTER FOR SUPPORT MODE
JUMPE T2,FRLID2 ;COMMAND TO BE DONE FOR THIS MODE?
MOVE T5,P4 ;GET LINE/DEVICE NUMBER
TELL USR!FRC,[ASCIN( Set )] ;SET COMMAND
TELL USR!FRC,@P3 ;Line or Device
TELL USR!FRC,[ASCIN(:^M/Cmd:^E)] ;NOW THE COMMAND NUMBER
CAIN T2,-1 ;ANY SWITCHES ASSOCIATED WITH THE COMMAND?
JRST FRLID6 ;NO
TELL USR!FRC,[ASCIN(/)] ;PRECEDE WITH / WHICH INDICATE A SWITCH
TELL USR!FRC,@T2 ;YES, PRINT THAT PART OF THE COMMAND
FRLID6: TELL USR!FRC,CRLF ;GIVE CRLF AT END OF COMMAND
PUSHJ P,S$SIX ;DECODE COMMAND
PUSHJ P,CONFUS ;WOW, ILLEGAL COMMAND INTERNALLY
MOVEM T1,L.CMD ;COMMAND NAME
MOVX T2,COMTAB ;TABLE OF COMMANDS
HRLI T2,-.NMCOM ;LENGTH
PUSHJ P,UNIQ6 ;SEE IF WE KNOW ABOUT IT
PUSHJ P,CONFUS ;WOW
PUSH P,F ;SAVE SOME AC'S
OFF F.IBRK ;ZONK THIS BIT
PUSH P,[FRLID7] ;WHERE TO RETURN TO
PUSHJ P,SAVE4 ;SAVE P1-P4
JRST @COMDSP(T1) ;GO TO ROUTINE
FRLID7: JRST [ POP P,F ;ERROR RETURN, RESTORE F
PJRST E.CER ] ;GIVE ERROR
POP P,F ;OK RETURN, RESTORE F
JRST FRLID2 ;GO DO NEXT DEV/LINE COMMAND
;HERE TO SEE IF THE NEXT COMMAND IS "CMD:X"
;
GETCMD: CAIE C,"/" ;MUST HAVE A /
PJRST [ TXNE F,F.IBRK ;BREAK CHAR SEEN?
PJRST CPOPJ1 ;YES, GET OUT NOW
CAIE C," " ;A SPACE?
PJRST E.CER ;LOSE
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES
PJRST CPOPJ1 ;JUST LET SET LINE:X OR SET DEV:X WORK
JRST GETCMD ] ;NOT EOL SO LOOP
PUSHJ P,S$SIX ;GET THE COMMAND
PJRST E.CER ;LOSE BIG
JUMPE T1,E.CER ;ALSO LOSE IF NULL
MOVEM T1,L.CMD ;REMEMBER IT
HRROI T2,[ SIXBIT \CMD\] ;HOW IT IS SPELLED
PUSHJ P,UNIQ6 ;SEE IF CMD OR ABBREV
PJRST E.ILC ;NOT UNIQUE
CAIE C,":" ;MUST HAVE COLON
PJRST E.CER ;NO, SO LOSE
PUSHJ P,S$DEC ;GET THE COMMAND NUMBER
PJRST E.CER ;NOT A NUMBER
PJRST (U1) ;RETURN TO CALLER WITH
; THE COMMAND NUMBER IN T1
;ROUTINE TO PROCESS SWITCHES
;
; CALL: PUSHJ P,DOSWT ;P1 CONTAINS -LENGTH,,SWITCH TABLE
; ERROR ;T1 CONTAINS ERROR MESSAGE ADDRESS
; SUCCESS ;P3 MAY CONTAIN INFO FROM A SWITCH
;
; SEE THE SECTION IN MACRO DEFINITIONS TITLED "SWITCH MACROS"
; ON HOW THE TABLES ARE LAID OUT AND IN WHICH ORDER THEY ARE
; GENERATED.
;
DOSWT: CAIE C," " ;WAS BREAK A SPACE?
JRST DOSWT4 ;NO, IT SHOULD BE A "/" THEN
PUSHJ P,.SCFLS ;YES, FLUSH LEADING SPACES
PJRST CPOPJ1 ;EOL
DOSWT4: TXNE F,F.IBRK ;AT EOL?
PJRST CPOPJ1 ;YES
CAIE C,"/" ;EXPECTING A SWITCH
PJRST E.CER ;NOT ONE SO LOSE BIG
PUSHJ P,S$SIX ;GET THE SWITCH NAME
PJRST E.CER ;NO NAME
JUMPE T1,E.CER ;NULL NO GOOD EITHER
MOVEM T1,L.CMD ;REMEMBER INCASE OF ERROR
MOVE T2,P1 ;LENGTH,,SWITCH TABLE
PUSH P,T3 ;SAVE COUNT OF CHARACTERS
PUSHJ P,UNIQ6 ;SEE IF SWITCH EXISTS
JRST [ POP P,T3 ;RESTORE CHARACTER COUNT
JUMPN T1,E.AMB ;IF MORE THAN ONE MATCH LOSE
MOVE T1,L.CMD ;GET THE SWITCH NAME
MOVE T2,[XWD -.NMPLD,PLDTAB] ;POINT TO PORT,LINE,DEVICE
PUSHJ P,UNIQ6 ;SEE IF IT MIGHT BE
; /PORT,/LINE,/DEVICE
PJRST E.ILC ;NO, LOSE THEN.
MOVX P2,PLDTAB+.NMPLD ;POINT TO DISPATCH TABLE
JRST DOSWTX ] ;GO PROCESS THE SWITCH
POP P,T3 ;RESTORE CHARACTER COUNT
HLRO P2,P1 ;MAKE DISPATCH ADR
MOVNS P2 ;MAKE POSITIVE LENGTH
ADDI P2,(P1) ;ADD IN SWT TAB ADR
DOSWTX: ADDI P2,(T1) ;SWITCH INDEX VALUE
LDB T2,[POINT 3,(P2),3] ;GET FLAGS
;0 = DISPATCH ADR
; 1= SIXBIT, 2 = DECIMAL, 3 = OCTAL
CAXN T2,4 ;SEE IF DISPATCH WITH NO VALUE
JRST DOSWTD ;YES
CAIE C,":" ;SWITCH MUST HAVE A VALUE
ERROR (E,Y,VRS,<Value missing for switch /^0>,<STARTZ>)
ANDI T2,3 ;
JUMPN T2,DOSWT1 ;JUMP IF NOT DISPATCH
DOSWTD: PUSHJ P,@(P2) ;DISPATCH TO ROUTINE FOR SWITCH
PJRST E.CER ;ERROR
JRST DOSWT ;PROCESS NEXT SWITCH
DOSWT1: PUSHJ P,@[ S$SIX
S$DEC
S$OCT ]-1(T2) ;GET VALUE
PJRST E.CER ;LOSE
LDB T2,[POINT 3,(P2),3] ;GET FLAGS
TXNN T2,1B33 ;DISPATCH?
JRST DOSWT2 ;NO
PUSHJ P,@(P2) ;DISPATCH WITH VALUE IN T1
PJRST E.CER ;ERROR
JRST DOSWT ;DO NEXT SWITCH
DOSWT2: HRRZ T2,(P2) ;GET ADDRESS WHERE TO STORE IT
; (THIS IS DONE INCASE @ SET)
MOVEM T1,(T2) ;STORE THE VALUE
JRST DOSWT ;LOOK FOR ANOTHER SWITCH
SETPUT: IDPB T1,SETBYT ;PUT BYTE IN SET DATA BLOCK
AOS T2,SETCNT ;COUNT THE BYTE
STOR. (T2,C%NBYT) ;STORE NUMBER OF BYTES
POPJ P, ;RETURN TO CALLER
SUBTTL Routines to Get or Put data from or to a device
;SUBROUTINE TO GET A CHAR FROM A RING BUFFER
;
; CALL: PUSHJ P,GCHRDV ;CHAR IN AC(P4)
; RETURN ;IF EOF
; RETURN ;CHAR IN AC(P4)
;
GCHRDV: SOSGE DEVBC ;DECREMENT THE BYTE COUNT
JRST GCHRD1 ;BUFFER EMPTY, GET ANOTHER ONE
ILDB P4,DEVBP ;GET A CHARACTER
JUMPE P4,GCHRDV ;IF NULL, DISCARD IT
PJRST CPOPJ1 ;SKIP RETURN WITH CHAR IN P4
GCHRD1: IN DEV, ;GET A BUFFER
JRST GCHRDV ;NO ERROR, SO GET A CHAR FROM IT
STATZ DEV,74B23 ;SEE IF ERROR
JRST DVEERR ;DEVICE ERROR
CLOSE DEV, ;DO THE CLOSE
RELEASE DEV, ;AND THE RELEASE
POPJ P, ;NON SKIP CAUSE OF EOF
;SUBROUTINE TO PUT A BYTE OF DATA ON A DEVICE
;
; CALL: PUSHJ P,PCHRDV ;
; RETURN ;
;
PCHRDV: SOSG DEVBC ;ADVANCE BYTE COUNTER
JRST PCHRD2 ;BUFFER FULL OR FIRST CALL
PCHRD1: IDPB P4,DEVBP ;PUT BYTE IN THE BUFFER
POPJ P, ;RETURN TO CALLER
PCHRD2: OUT DEV, ;OUTPUT THE BUFFER
JRST PCHRD1 ;NO ERROR
DVEERR: ERROR (E,Y,DVE,<Error on device ^B:>,<STARTZ>)
SUBTTL EOF handling routine for the DN60
;SUBROUTINE TO DO OUTPUT EOF
;
; CALL: PUSHJ P,XMTEOF ;
; RETURN ;IF INPUT AND NO EOF OR ABORT
; RETURN ;WHEN EOF COMPLETE
;
XMTEOF: MSTIME T1, ;GET TIME WE SENT EOF
MOVEM T1,EFTIME ;REMEMBER THAT TIME
MOVX T1,BYTE (8) DC.SOE ;EOF COMMAND
PUSHJ P,WRTDV1 ;TELL DN60 - SIGNAL OUTPUT EOF
MOVX P1,EOFLOP ;ONLY GO THROUGH LOOP THIS MANY TIMES
TELL USR,OEF% ;TELL OUTPUT EOF SET
XMTEO1: PUSHJ P,RDDVS ;READ THE DEVICE STATUS
PUSHJ P,CKAB ;SEE IF OUTPUT OR INPUT
MOVX T2,DS.OEC ;OUT EOF COMPLETE
TXNN F,F.OUT ;OUTPUT?
MOVX T2,DS.IEC ;NO, INPUT EOF COMPLETE
IFE DEBOUT,<
TDNE T1,T2 ;SEE IF EOF COMPLETE
>;END IFE DEBOUT
JRST XMTEO2 ;IT IS, SO NOW CLEAR IT
SNOOZE ^D500 ;GO SNOOZE 500 MS
TXNN F,F.OUT ;DOING OUTPUT?
POPJ P, ;NO, INPUT SO RETURN
PUSHJ P,CHKOPR ;SEE IF OPR WANTS SOMETHING
SOJG P1,XMTEO1 ;COUNT DOWN
ERROR (E,Y,EFT,<Time out while waiting for EOF complete>,<STARTZ>)
XMTEO2: MOVX T1,BYTE (8) DC.COE ;CLEAR EOF
TXNN F,F.OUT ;OUTPUT?
MOVX T1,BYTE (8) DC.CIE ;INPUT CLEAR EOF
PUSHJ P,WRTDV1 ;TELL DN60 TO CLEAR EOF
PUSHJ P,RDDVS ;GET THE DN60 STATUS
PUSHJ P,CKAB ;SEE IF IN OR OUT ABORT
MOVX T2,DS.OEC ;OUTPUT CLEAR EOF
TXNN F,F.OUT ;DOING OUTPUT?
MOVX T2,DS.IEC ;NO ITS INPUT CLEAR EOF
TDNE T1,T2 ;MAKE SURE EOF CLEARED
ERROR (E,Y,EFS,<EOF set after issuing clear EOF>,<STARTZ>)
PJRST CPOPJ1 ;SKIP RETURN
CKAB: MOVE T2,[JSP T3,CKOAB] ;
TXNN F,F.OUT ;SEE IF OUTPUT
MOVE T2,[JSP T3,CKIAB] ;NO, INPUT
XCT T2 ;CHECK FOR ABORT
POPJ P, ;NONE THERE
;HERE IF ABORT SET
;
ABTSET: TELL USR,A60%
PJRST STARTZ ;LOSE CAUSE ABORT UP
;HERE TO REQUEST OUTPUT PERMISSION
;
; CALL: PUSHJ P,REQOUT ;
; RETURN ;IF PERMISSION NOT GRANTED
; RETURN ;WITH OUTPUT PERMISSION GRANTED
;
REQOUT: PUSHJ P,RDDVS ;GET OUT DEV STATUS
JSP T3,CKOAB ;SEE IF OUTPUT ABORT
TXNE T1,DS.ORN!DS.OPG ;SEE IF OUTPUT RUNNING OR
; PERMISSION WAS GRANTED
PJRST CPOPJ1 ;YES, SO DON'T REQUEST IT
PUSHJ P,SAVE1 ;SAVE P1
MOVX P1,REQOP ;NUMBER OF TIMES BEFORE GIVING UP
SKIPE TYPFLG ;NOTYPE AHEAD?
IMULX P1,MREQOP ;YES, INCREASE BY THIS MUCH
TELL USR,[ASCIC([ Output permission requested ])]
REQOU1: MOVX T1,BYTE (8) DC.ROP ;REQUEST OUTPUT PERMISSION
PUSHJ P,WRTDV1 ;REQUEST OUT PERMISSION
REQOU2: PUSHJ P,RDDVS ;READ THE DEVICE STATUS
JSP T3,CKOAB ;ABORT, BUT SEE IF OUTPUT ABORT
TXNN T1,DS.ORN!DS.OPG
TXNN T1,DS.OPR ;SEE IF REQ OUT PERMISSION CLR'ED
JRST REQOU4 ;IT CLEARED
SNOOZE USR,^D300 ;SNOOZE AND CHECK OPR
JRST REQOU2 ;LOOK AGAIN TO SEE IF REQ OUT PER CLR'ED
REQOU4: TXNE T1,DS.OPG ;SEE IF OUT PERMISSION GRANTED
JRST REQOU6 ;IT IS
MOVX T1,ONG% ;OUTPUT PERMISSION WASN'T GRANTED
SOJL P1,CPOPJ ;GIVE UP
SNOOZE USR,TREQOP ;SLEEP
JRST REQOU1 ;TRY AGAIN
POPJ P, ;IT ISN'T
;
REQOU6: TELL USR,[ASCIC([ Output permission granted ])]
PJRST CPOPJ1 ;GIVE OK SKIP RETURN
;SUBROUTINE TO SEE IF OUTPUT ABORT BITS UP IN AC(T1)
;
; CALL: JSP T3,CKOAB ;T1 CONTAINS STATUS FROM
; ; CALL TO RDDVS
; RETURN ;IF OUTPUT ABORT BITS NOT SET
;
CKOAB: TXNE T1,DS.OAC!DS.OAS ;SEE IF ANY OUT ABORT BITS SET
PJRST ABTSET ;YES, COMPLAIN
PJRST (T3) ;NO, RETURN TO CALLER
;HERE TO SEE IF INPUT PERMISSION IS BEING REQUESTED
;
; CALL: PUSHJ P,REQIN ;
; HALT ;INCASE OF LATTER NON SKIPS
; RETURN ;DATA CAN NOW BE READ
;
REQIN: TELL USR,[ASCIC([ Waiting for an Input request ])]
REQIN1: PUSHJ P,RDDVS ;GET THE DEVICE STATUS
JSP T3,CKIAB ;SEE IN INPUT ABORT
TXNE T1,DS.IPR!DS.IPG!DS.IRN ;SEE IF INPUT PERMISSION REQUESTED
JRST REQIN3 ;YUP
SNOOZE USR,^D350 ;SNOOZE AND CHECK OPR
JRST REQIN1 ;LOOK AGAIN FOR INPUT REQUEST
REQIN3: TXNE T1,DS.IPG!DS.IRN ;check if already granted or running
JRST REQI5A
TELL USR,[ASCIC([ Input permission requested ])]
MOVX T1,BYTE (8) DC.GIP ;GRANT INPUT PERMISSION
PUSHJ P,WRTDV1 ;GRANT THE INPUT PERMISSION
TELL USR,[ASCIC([ Input permission granted ])]
REQIN5: PUSHJ P,RDDVS ;GET THE DEVICE STATUS
JSP T3,CKIAB ;SEE IF INPUT ABORT
REQI5A: TXNE T1,DS.IPG ;SEE IF INPUT PERMISSION GRANTED
;has cleared yet
JRST REQIN7 ;NOT YET
TXNE T1,DS.IEC!DS.IRN ;SEE IF EOF OR RUNNING
JRST CPOPJ1 ;YES, SO GO DO INPUT
JRST REQIN ;no, wait for an input request
REQIN7: SNOOZE USR,^D1000 ;SNOOZE AND CHECK OPR
JRST REQIN5 ;
;SUBROUTINE TO SEE IF ANY INPUT ABORT BITS SET IN AC(T1)
;
; CALL JSP T3,CKIAB ;T1 CONTAINS STATUS FROM
; ; CALL TO "RDDVS"
; RETURN ;IF NO INPUT ABORT BITS SET
;
CKIAB: TXNE T1,DS.IAS!DS.IAC ;ANY INPUT ABORT BITS SET?
PJRST ABTSET ;YES, LOSE
PJRST (T3) ;RETURN TO CALLER
;SUBROUTINE TO OUTPUT A CR + CARRIAGE CONTROL
;
; CALL: PUSHJ P,OCRLF ;
; RETURN ;IF EXCEEDED MAX CHARS
; RETURN ;IF DONE
;
OCRLF: MOVX P4,15 ;CR
PUSHJ P,PUTCHR ;PUT CHAR IN THE BUFFER
POPJ P, ;EXCEEDED NUMBER OF CHARS
MOVE P4,IOCCC ;THE CARRIAGE CONTROL CHAR
AOS LINES ;COUNT THE LINE
AOS TOTLIN ; AND TOTAL LINES
PUSHJ P,PUTCHR ;PUT IN BUFFER
POPJ P, ;MAX CHARS EXCEEDED
PJRST CPOPJ1 ;DONE
;SUBROUTINE TO PUT A BYTE IN THE DN60 BUFFER
; AND DO THE CALL11 IF THE BUFFER IS FILLED
;
; CALL: PUSHJ P,PUTCHR ;CHARACTER IN P4
; RETURN ;IF MAX CHARS EXCEEDED
; RETURN ;IF PUT IN BUFFER
;
PUTCHR: SKIPE T1,IONCHR ;SEE IF LIMIT ON CHARS?
JRST [ MOVE T1,TOTCHR ;GET TOTAL OUTPUT BY CAL11
ADD T1,CHARS ;PLUS NUMBER PENDING
CAML T1,IONCHR ;EXCEEDED MAX CHARS?
POPJ P, ;YES
JRST PUTCH0 ] ;NO
PUTCH0: AOS T1,CHARS ;COUNT THE CHARACTER
IDPB P4,BUFPNT ;PUT CHARACTER IN THE BUFFER
CAMGE T1,IONBYT ;SEE IF BUFFER FILLED
PJRST CPOPJ1 ;NO, GIVE SKIP RETURN
PUTCH1: HRLS T1 ;GET COUNT IN LH
HRRI T1,FC.WD ;WRITE DATA FUNCTION
MOVEM T1,C11BLK+2 ;PUT IN PARAM BLOCK FOR CALL11
PUSHJ P,CAL11 ;OUTPUT THE BUFFER
PUSHJ P,CONFUS ;SHOULD NEVER HAPPEN
TXNN F,F.DOB ;DUMP OUTPUT BUFFERS?
JRST PUTCH2 ;NO
PUSH P,C11BLK+0 ;SAVE THE ENTIRE C11BLK TO BE SURE
PUSH P,C11BLK+1 ;
PUSH P,C11BLK+2 ;
PUSH P,C11BLK+3 ;
PUSH P,C11BLK+4 ;
PUSH P,C11BLK+5 ;
MOVX T1,BYTE (8) DC.DOB ;DUMP THE OUTPUT BUFFERS
PUSHJ P,WRTDV1 ;GO DO IT
PUTCH3: PUSHJ P,RDDVS ;READ THE DEVICE STATUS
PUSHJ P,CKAB ;ABORT HAPPENED
TXNN T1,DS.OBD ;SEE IF THE BUFFERS ARE DUMPED YET
JRST PUTCH4 ;ALL DONE
SNOOZE USR,DOBTIM ;TAKE A SNOOZE
JRST PUTCH3 ;WAIT FOR IT TO CLEAR
PUTCH4: POP P,C11BLK+5 ;RESTORE C11BLK
POP P,C11BLK+4 ;
POP P,C11BLK+3 ;
POP P,C11BLK+2 ;
POP P,C11BLK+1 ;
POP P,C11BLK+0 ;
PUTCH2: SKIPN T1,IOPAUS ;GET PAUSE TIME IF ANY
JRST PUTCH5 ;NO PAUSE TIME
HIBER T1, ;GO PAUSE
JFCL ;OH WELL
PUTCH5: SETZM CHARS ;START WITH ZERO CHARACTERS
PUSHJ P,MAKPNT ;MAKE A BYTE POINTER
PJRST CPOPJ1 ; AND GIVE SKIP RETURN
;SUBROUTINE TO CLEAR THE STATISTICS CELLS
;
; CALL: PUSH P, CLRSTS ;
; RETURN ;
;
CLRSTS: SETZM LINES ;0 LINES
SETZM BUFOUT ;0 BUFFERS OUT
SETZM BUFDLY ;0 BUFFERS DELAYED
SETZM BUFCOM ;0 BUFFERS COMPLETED
SETZM CHRCNT ;0 WHERE CHARS GET COUNTED
SETZM C11E4 ;CAL11 4 ERRORS
SETZM ZROCNT ;COUNT OF 0 COUNT ON A DELAYED
; RETURN.
POPJ P, ;RETURN
;SUBROUTINE TO COUNT "TOTLIN" AND "LINES"
; IF A EOL CHARACTER IN P4 (12-14 OR 20-24)
;
; CALL: PUSHJ P,CHKEOL ;P4 CONTAINS THE CHARACTER
;
CHKEOL: CAXG P4,24 ;IS IT BIGGER THAT 24?
CAXGE P4,12 ;NO, IS IT LESS THAT 12?
POPJ P, ;NOT 12-24
CAXG P4,17 ;IS IT BIGGER THAN 17?
CAXGE P4,15 ;NO, IS IT LESS THAN 15?
JRST CNTLIN ;ITS 12-14 OR 20-24
POPJ P, ;NOT A EOL CHAR
CNTLIN: AOS LINES ;COUNT LINE
AOS TOTLIN ;COUNT TOTAL LINES
POPJ P, ;RETURN TO THE CALLER
SUBTTL Device Cell Routines
;SUBROUTINE TO CLEAR DEVICE STORAGE CELLS
;
; CALL: PUSHJ P,CLRDEV ;T1 POINTS TO FIRST CELL
; RETURN
;
CLRDEV: MOVSI T2,.CCDEV(T1) ;SOURCE ADDRESS
HRRI T2,.CCDEV+1(T1) ;DEST ADDRESS
SETZM .CCDEV(T1) ;ZAP THE FIRST ONE
BLT T2,.CCEND(T1) ;ZAP THE REST OF 'EM
POPJ P, ;RETURN
;SUBROUTINE TO SETUP DEFAULT VALUES IN THE
;DEVICE STORAGE CELLS
;
; CALL: PUSHJ P,DEFDEV ;T1 POINTS TO FIRST CELL
; RETURN
;
DEFDEV: MOVSI T2,'DSK' ;DSK IF DEFAULT DEVICE
MOVEM T2,.CCDEV(T1) ;
MOVE T2,[SIXBIT \D60SPD\] ;D60SPD IS THE DEFAULT FILE NAME
MOVEM T2,.CCNAM(T1) ;
HRLZI T2,'JOB' ;DEFAULT EXTENSION IS
TXNN F,F.OUT ;DOING OUTPUT?
HRLZI T2,(SIXBIT \IN\) ;NO, INPUT SO "IN" IS DEFAULT EXT
MOVEM T2,.CCEXT(T1) ; "OUT"
PJRST GETPTH ;GET USERS PATH AND PUT IN AS
; THE DEFAULT.
;ROUTINE TO READ THE USERS PATH AND PLACE IT
; IN THE DEVICE CELLS
;
; CALL: PUSHJ P,GETPTH ;T1 POINTS TO BEGINNING OF DEVICE CELLS
;
GETPTH: SETOM PTHBLK ;OWN JOB,,FUNCTION CODE -1
MOVE T3,[XWD .PTMAX,PTHBLK] ;
PATH. T3, ;GET USERS PATH
ERROR (E,Y,PTH,<PATH. UUO failure (^1)>,<STARTZ>)
MOVE T3,PTHBLK+.PTPPN ;GET THE PPN
MOVEM T3,.CCPTH+.PTPPN(T1) ;PUT IN DEVICE CELLS
SETZ T2, ;SFD COUNTER
GETPT2: SKIPN T3,PTHBLK+.PTSFD(T2) ;SEE IF AN SFD
JRST GETPT4 ;DONE
MOVEM T3,.CCPTH+.PTSFD(T1) ;PUT SFD NAME IN DEVICE CELL BLOCK
ADDX T2,1 ;POINT TO NEXT SFD
AOJA T1,GETPT2 ;LOOK FOR ANOTHER SFD
GETPT4: MOVEM T3,.CCPPN(T1) ;PUT SFD COUNT IN DEVICE CELL BLOCK
POPJ P, ;RETURN TO CALLER
;SUBROUTINE TO CHECK TO SEE IF THE DEVICE IS
; IN USE.
;
; CALL: PUSHJ P,CDVINU ;T1 CONTAINS THE DEVICE NAME
; RETURN ;IF NOT IN USE
;
CDVINU: MOVE T3,T1 ;GET THE DEVICE NAME
DEVTYP T3, ;GET BITS ABOUT THE DEVICE
POPJ P, ;UUO NOT IMPLEMENTED SO
; LET OPEN FIND OUT.
SKIPN T3 ;IF 0, DEVICE NOT KNOWN
ERROR (E,Y,NSD,<No such device as ^B:>,<STARTZ>)
TXNE T3,TY.AVL ;SEE IF AVAILABLE
POPJ P, ;YES, RETURN TO CALLER
LSH T3,-^D9 ;POSITION JOB NUMBER
ANDI T3,777 ;KEEP JOB NUMBER
MOVX T4,.GTPRG ;GET PROGRAM NAME
HRL T4,T3 ; NEED JOB NUMBER
GETTAB T4, ;GET JOB NAME
SETZ T4, ;ERROR SO GIVE NUL NAME
TELL USR,DIU% ;COMPLAIN ABOUT DEVICE IN USE
MOVX T4,.GTNM1 ;GET 1ST PART OF USER NAME
HRL T4,T3 ;NEED JOB NUMBER
GETTAB T4, ;GET FIRST PART
SETZ T4, ;0 IF ERROR
TELL USR,[ASCIN( User:^I)]
MOVX T4,.GTNM2 ;GET 2ND PART
HRL T4,T3 ;NEED JOB NUMBER
GETTAB T4, ;GET IT
SETZ T4, ;0 IF ERROR
TELL USR,[ASCIN(^I)] ;
MOVX T4,.GTPPN ;GET PPN
HRL T4,T3 ;NEED JOB NUMBER
GETTAB T4, ;GET PPN OF USER WHOS USING THE DEV
SETZ T4, ;GIVE 0 IF WE LOSE HERE
HLRZ T3,T4 ;GET PROJECT NUMBER
HRRZS T4 ;KEEP ONLY PROGRAMMER NUMBER
TELL USR,[ASCIC< [^1,^7]>] ;
PJRST STARTZ ; AND GIVE UP.
SUBTTL DN60 Buffer creation routine
;SUBROUTINE TO CREATE THE BUFFER FOR THE DN60
;
; CALL: PUSHJ P,CREABF ;
; RETURN ;WITH BUFFER CREATED
;
CREABF: HRRZ T1,.JBFF ;GET FIRST FREE LOC WE CAN USE
TXZE T1,777 ;MAKE A PAGE BOUNDRY IF NOT ONE
ADDX T1,1000 ;HAD TO TRIM SO POINT TO NEXT PAGE
ADD T1,IOOFFS ;ADD IN THE OFFSET
STOR. (T1,C%BUFA) ;PUT BUFFER ADDRESS IN C11BLK FOR CAL11
HRRZM T1,BUFADR ;PUT HERE CASE WE NEED IT FOR DEBUGGING
SKIPG T2,IOBSIZ ;BUFFER SIZE IN WORDS
PUSHJ P,[ MOVE T2,IOBPOS ;COMPUTE
ADD T2,IONBYT ; THE
SUBX T2,1 ; SIZE OF
IDIV T2,IOBWRD ; THE
ADDX T2,1 ; BUFFER
POPJ P, ] ;RETURN
STOR. (T2,C%BUFS) ;PUT IN THE BUFFER SIZE
ADD T1,T2 ;LAST ADDRESS IN BUFFER
MOVEM T1,.JBFF ;UPDATE FIRST FREE
SUBX T1,1 ;POINT TO LAST USED
HRLM T1,BUFADR ;STORE LAST CASE WE NEED IT FOR DEBUGGING
CAMG T1,.JBREL ;NEED MORE CORE?
POPJ P, ;NO, WE HAVE ENOUGH
PJRST CORUUO ;GET MORE CORE
SUBTTL Routine to make a PDP-10 Byte pointer
;SUBROUTINE TO MAKE A BYTE POINTER TO THE DN60 BUFFER
;
;CALL: PUSHJ P,MAKPNT ;
; RETURN
;
MAKPNT: MOVE T4,IOBWRD ;BYTES PER WORD FOR INDEX INTO BYTE SIZE
TXNN F,F.KL10 ;RUNNING ON A KL10?
JRST MAKPKI ;NO, MUST BE ANOTHER TYPE OF PDP10
LOAD. (T2,C%BUFA) ;GET ADDRESS OF THE BUFFER
HLL T2,BYTTAB-3(T4) ;GET BYTE POINTER
MOVE T1,IOBPOS ;GET COUNT IN HERE
ADJBP T1,T2 ;POINT TO THE CORRECT BYTE
JRST MAKPN1 ;GO FINISH UP
MAKPKI: MOVE T1,IOBPOS ;GET BYTE POSITION
IDIV T1,IOBWRD ;DIVIDE BY BYTES IN A WORD
;T1 = POSITION IN BUFFER
;T2 = POSITION IN WORD
HRRZ T3,BYTTAB-3(T4) ;GET BYTE SIZE
IMUL T2,T3 ;MAKE "P" FIELD FOR BYTE POINTER
MOVX T4,^D36 ;
SUB T4,T2 ;MAKE THE "P" FIELD
LSH T4,^D30 ;POSITION CORRECTLY
IOR T1,T4 ;BUILD THE POINTER
LSH T3,^D24 ;POSITION THE S FIELD
IOR T1,T3 ;PUT S FIELD IN POINTER
LOAD. (T4,C%BUFA) ;GET ADDRESS OF BUFFER
ADD T1,T4 ;POINT TO DATA IN THE BUFFER
MAKPN1: MOVEM T1,BUFPNT ;STORE THE POINTER
HRLZ T2,IOBWRD ;GET BYTES PER WORD
LSH T2,6 ;POSITION CORRECTLY
IOR T2,IOBPOS ;PUT FIRST BYTE POSITION IN
MOVEM T2,C11BLK+4 ;FOR CAL11
POPJ P, ;RETURN TO CALLER
;TABLE WHICH CONTAINS IN THE (LH) A BYTE POINTER
; WHICH IS USED IF KL10 AND IN THE (RH) THE BYTE
; SIZE FOR OTHER THAN KL10.
;
BYTTAB: POINT 12,^D12 ;3 BYTES PER WORD
POINT 8,^D8 ;4 BYTES PER WORD
POINT 7,^D7 ;5 BYTES PER WORD
POINT 6,^D6 ;6 BYTES PER WORD
SUBTTL Routines to decode bits or a value and type the message
;SUBROUTINE TO DECODE BITS INTO A TYPEOUT
;
; CALL: PUSHJ P,DCDBIT ;T1 = -TABLE LENGTH,,TABLE ADDRESS
; ;T3 = BITS TO DECODE
; RETURN
;
; FORMAT OF THE TABLE:
;
; ADR OF MSG IF BIT IS OFF,,ADR OF MSG IF BIT IS ON
;
DCDBIT: JUMPN T3,DCDBI0 ;IF NO BITS JUST GIVE A CRLF
TELL USR,CRLF ;GIVE THE CRLF
POPJ P, ;AND RETURN TO THE CALLER
DCDBI0: SETO T5, ;SET FLAG
MOVX T4,1 ;FOR CHECKING EACH BIT
DCDBI1: HLRZ T2,(T1) ;GET FOR BIT OFF
TDZE T3,T4 ;IS THE BIT OFF?
HRRZ T2,(T1) ;NO, ITS ON
JUMPE T2,DCDBI2 ;WAS THERE A MESSAGE?
SKIPN T5 ;DO WE NEED AN EXTRA TAB?
CHR USR," " ;YES
SETZ T5, ;NEED EXTRA TABS AFTER FIRST
TELL USR,@T2 ;PRINT THE MESSAGE
DCDBI2: LSH T4,1 ;FOR NEXT CHECK
AOBJN T1,DCDBI1 ;DONE?
DCDBI3: JUMPE T3,CPOPJ ;IF 0 THEN DONE
TDZE T3,T4 ;BIT SET?
TELL USR,D60NO ;DON'T KNOW
LSH T4,1 ;FOR NEXT CHECK
JRST DCDBI3 ;LOOP FOR MORE
;ROUTINE TO DECODE A INDEX VALUE INTO A TYPOUT
;
;CALL: PUSHJ P,DCDVAL ;T1 = TABLE ADDRESS
; ;T2 = +TABLE LENGTH
; ;T3 = VALUE TO DECODE
; RETURN
;
DCDVAL: CAMGE T3,T2 ;SEE IF IN TABLE
JRST DCDVA1 ;YES
TELL USR,D60NO ;NOT THERE
POPJ P, ;
DCDVA1: ADD T1,T3 ;POINT TO RIGHT MESSAGE
MOVE T1,(T1) ;GET MSG ADDRESS
TELL USR,@T1 ;AND GIVE IT TO USER
POPJ P, ;RETURN TO CALLER
;ROUTINE TO DECODE A BYTE OF BITS AND PRINT
; A STRING OF NUMBERS WITH COMMAS BETWEEN THEM
; eg: 1,2,4,5,7
;
; Call: PUSHJ P,DCDPNC ;T3 = BITS TO DECODE INTO NUMBER STRING
; RETURN ;ALWAYS
;
DCDPNC: MOVX T5,0 ;START WITH 0
DCDPN1: LSHC T3,-1 ;SHIFT BITS INTO T4
JUMPL T4,DCDPN3 ;JUMP IF A BIT WAS SET
JUMPE T3,CPOPJ ;GET OUT IF NO MORE BITS
JRST DCDPN5 ;MORE BITS, BUT LAST WAS A 0
DCDPN3: RAD08 USR,T5 ;PRINT NUMBER
JUMPE T3,CPOPJ ;DON'T PRINT COMMA IF END
CHR USR,54 ;PRINT A COMMA
DCDPN5: ADDX T5,1 ;INCREMENT COUNTER
; THAT GETS PRINTED
JRST DCDPN1 ;LOOP FOR MORE BITS
;ROUTINE TO GET 2 BYTES FROM SETBLK
;
; CALL: PUSHJ P,GETWD ;
; RETURN ;T3 HAS THE 2 BYTES
;
GETWD: MOVX T1,2 ;GET 2 BYTES WORTH
PJRST GETBYT ;GET 'EM AND RETURN TO CALLER
;ROUTINE TO GET 1 BYTES FROM SETBLK
;
; CALL: PUSHJ P,GET1BY ;
; RETURN ;T3 HAS THE 1 BYTE
;
GET1BY: MOVX T1,1 ;GET 1 BYTE WORTH
PJRST GETBYT ;GET 'EM AND RETURN TO CALLER
;ROUTINE TO GET 1-4 BYTES FROM "SETBLK"
;
; CALL: PUSHJ P,GETBYT ;T1 CONTAINS NUMBER OF BYTES
; ;"SETBYT" HAS POINTER IN IT
; RETURN ;T3 HAS THE BYTES IN IT
;
GETBYT: SETZB T3,T2 ;0 RESULT WORD AND SHIFT WORD
SKIPLE T1 ;MUST BE 1-4
CAXLE T1,4 ;CAN'T GET ANY MORE THAN 4
PUSHJ P,CONFUS ;SHOULD NEVER HIT THIS
GETBY1: ILDB T4,SETBYT ;GET 8 BITS WORTH
LSH T4,(T2) ;SHIFT INTO POSITION
IOR T3,T4 ;FORM RESULT
ADDX T2,^D8 ;FOR NEXT SHIFT
SOJG T1,GETBY1 ;ALL DONE?
POPJ P, ;YES, RETURN TO CALLER WITH
; DATA IN T3.
;ROUTINE TO DEPOSIT BYTES IN T1 INTO "SETBLK"
;
; CALL: PUSHJ P,DP1BYT ;TO DEPOSIT 1 BYTE
; PUSHJ P,DP2BYT ;TO DEPOSIT 2 BYTE
; SKIP RETURN ;ALWAYS
;
DP2BYT: LDB T2,[POINT 8,T1,27] ;GET HIGH BYTE
DPB T2,[POINT 8,SETBLK,23] ;WHERE 11 WILL FIND IT
SKIPA T3,[ 3 ] ;COUNT FOR THIS COMMAND
DP1BYT: MOVX T3,2 ;COUNT FOR THIS COMMAND
DPB T1,[POINT 8,SETBLK,15] ;WHERE 11 WILL FIND IT
STOR. (T3,C%NBYT) ;PUT COUNT IN C11BLK
PJRST CPOPJ1 ;GIVE SKIP RETURN
;SUBROUTINE TO MAKE SURE LINE AND DEVICE AND PORT ARE SETUP
;
; CALL: PUSHJ P,CHKDEV ;
; RETURN ;IF NOT SETUP
; RETURN ;IF SETUP
;
CHKDEV: MOVX T1,DNM% ;DEVICE NUMBER MISSING MSG
HRRE T2,C11BLK+1 ;GET DEVICE
PJUMPL T2,CPOPJ ;GIVE ERROR RETURN
CHKLIN: MOVX T1,LNM% ;LINE NUMBER MISSING MSG
SKIPGE C11BLK+1 ;SEE IF LINE SETUP
POPJ P, ;ERROR RETURN
CHKPRT: MOVX T1,PNM% ;DEVICE NUMBER MISSING MSG
SKIPGE C11BLK ;SEE IF PORT SETUP
POPJ P, ;NOT, SO ERROR RETURN
PJRST CPOPJ1 ;SKIP RETURN
;SUBROUTINE TO CLEAR ABORT COMPLETE IF SET
;
; CALL: PUSHJ P,CHKABT ;
; RETURN ;T1 POINTS TO ERROR MESSAGE
; RETURN ;IF ABORT CLEAR OR WAS CLEARED
;
CHKABT: PUSHJ P,SAVE1 ;SAVE A PRECIOUS ONE
CHKAB1: MOVX P1,^D10 ;LOOP COUNT
CHKAB2: SOJL P1,CHKAB4 ;JUMP IF TIME OUT
PUSHJ P,RDDVS ;GET THE DEVICE STATUS
SKIPA T1 ;ABORT IS SET
PJRST CPOPJ1 ;ABORT CLEAR SO SKIP RETURN
MOVX T2,DS.OAC!DS.OAS ;OUT ABORT BITS
TXNN F,F.OUT ;DOING OUTPUT THOUGH?
MOVX T2,DS.IAS!DS.IAC ;NO, INPUT
TDNN T1,T2 ;SEE IF INTERESTING BITS SET
PJRST CPOPJ1 ;NO, SO GIVE OK RETURN
PUSH P,T1 ;REMEMBER ABORT BITS
SNOOZE ^D20 ;SHORT SNOOZE
POP P,T1 ;GET BACK T1
MOVX T2,DS.OAC ;OUT ABORT COMPLETE
TXNN F,F.OUT ;BUT DOING OUTPUT
MOVX T2,DS.IAC ;NO, INPUT
TDNN T1,T2 ;ABORT COMPLETE UP?
JRST CHKAB2 ;NO, WAIT FOR IT TO SET
MOVSI T1,( BYTE (8) DC.COA) ;CLEAR ABORT COMPLETE CMD
TXNN F,F.OUT ;SEE IF OUT
MOVSI T1,( BYTE (8) DC.CIA) ;CLEAR INPUT ABORT COMPLETE
PUSHJ P,WRTDV1 ;NOW CLEAR ABORT COMPLETE
JRST CHKAB1 ;MAKE SURE IT CLEARED
CHKAB4: MOVX T1,A60% ;ABORT ERROR MESSAGE
POPJ P, ;GIVE ERROR RETURN
SUBTTL Routine to output Statistics if time to
;SUBROUTINE TO PRINT OUT STATISTICS IF NECESSARY
;
; CALL: PUSHJ P,CHKTIM ;
; RETURN ;IF TIME NOT UP
; RETURN ;IF TIME UP
;
CHKTIM: TXNN F,F.STAT ;MAKE SURE WE LEGALLY HERE
PUSHJ P,CONFUS ;BOO, SHOULD NEVER HAPPEN
SKIPN IOTIME ;TIME 0?
JRST CPOPJ1 ;YES, DON'T WANT STATISTICS
MSTIME T1, ;GET CURRENT TIME
SUB T1,BEGIN ;HOW LONG SINCE WE STARTED
SKIPGE T1 ;SEE IF WENT PAST MIDNIGHT
ADD T1,MIDNIT ;YES, ADD IN NUMBER OF MS IN 24 HOURS
TXZE F,F.FSTS ;FORCE STATISTICS
JRST CHKTI1 ;YES
CAMGE T1,IOTIME ;IS OUR TIME UP?
POPJ P, ;NOT YET
CHKTI1: MOVEM T1,ACTIME ;REMEMBER THE ACTUAL TIME
MOVE T1,CHRCNT ;GET NUMBER CHARACTERS INPUT/OUTPUT
IMULX T1,^D1000 ;TIMES 1 SECOND
IDIV T1,ACTIME ;DIVIDE BY ACTUAL TIME
MOVEM T1,CHRSEC ;CHAR/SEC
TXNN F,F.IN ;IF DOING INPUT OR
TXNE F,F.DEV ; OUTPUTTING FROM A DEV GIVE ACTUAL LINES
JRST [ MOVE T1,LINES ;NUMBER OF LINES OUTPUT OR INPUT
IMULX T1,^D<1000*60> ;1 MINUTE
IDIV T1,ACTIME ;ACTUAL TIME
JRST CHKTI2 ] ;
IMULX T1,^D60 ;CHAR/MIN
MOVE T4,IOWIDE ;WIDTH
IDIVI T1,2(T4) ;DIVIDE BY WIDTH + CR+LF
CHKTI2: MOVEM T1,LINMIN ;LINE/MIN
PUSHJ P,TYPSTS ;TYPE THE STATISTICS
PJRST CPOPJ1 ;GIVE SKIP RETURN
;SUBROUTINE TO PRINT THE STATISTICS
;
; CALL: PUSHJ P,TYPSTS ;
; RETURN ;
;
TYPSTS: PUSHJ P,BEGTIM ;RECORD THE TIME NOW
AOS T1,STSCNT ;SEE IF WE
CAXGE T1,NLSTAT ; NEED A HEADER
JRST TYPST1 ;NO
SETZM STSCNT ;RESET LINE COUNTER
; TELL USR,[ASCIC(Time Lines Chars Chars BUFTRY BUFDLY BUFCOM C11E4)]
; TELL USR,[ASCIC( Min Sec)]
TELL USR,[ASCIC(Time Total Chars Chars BUFTRY BUFDLY BUFCOM C11E4)]
TELL USR,[ASCIC( Chars Sec)]
TYPST1: MOVE T3,ACTIME ;GET TIME SINCE LAST REPORT
CAXGE T3,^D<1000*60> ;1 MINUTE OR MORE?
JRST TYPST0 ;NO
IDIVX T3,^D1000 ;GET RID OF THE FRACTION
IMULX T3,^D1000 ;GONE
TYPST0: TIMENZ USR,T3 ;PRINT ACTUAL TIME (NO ZERO FILL)
; TELL USR,[ASCIC( ^9 ^A ^8 ^3 ^5 ^4 ^F)]
TELL USR,[ASCIC( ^O ^A ^8 ^3 ^5 ^4 ^F)]
PJRST CLRSTS ;SINCE WE TYPED THEM, NOW CLEAR THEM
;SUBROUTINE TO OUTPUT SOME FINAL STATISTICS
;
ENDSTS: SKIPN IOTIME ;TIME 0?
POPJ P, ;
PUSHJ P,SAVE4 ;SAVE THE P'S
; TIME USR,STTIME ;GIVE STARTING TIME
; TELL USR,[ASCIC( Beginning time)]
; TIME USR,ENDTIME ;GIVE ENDING TIME
; TELL USR,[ASCIC( Ending time)]
MOVE T1,ETIMMS ;GET ENDING TIME
SUB T1,STIMMS ;FIGURE ELAPSED TIME
MOVE P4,T1 ;SAVE ELAPSED TIME
TELL USR,[ASCIN( = an elapsed time of )]
TIME USR,T1 ;GIVE ELAPSED TIME
TELL USR,CRLF ;
;
; TAKE CARE OF CHARACTERS NOW
;
RAD10 USR,TOTCHR ;TELL TOTAL CHARACTERS
TELL USR,[ASCIN( Total characters = )]
FLTR T1,TOTCHR ;TOTAL CHARACTERS
MOVE T2,[EXP ^D1000.] ;
FMPR T1,T2 ;CHR/SEC = CHRS*1000/TIME
MOVE P3,T1 ;SAVE CHRS*1000 FOR LATER USE
FLTR T2,P4 ;
FDVR T1,T2 ;FIGURE CHR/SEC
PUSHJ P,RND100 ;ROUND OFF
FLTPNT USR,T1 ;GIVE THE CHR/SEC
TELL USR,[ASCIC( Char/sec)]
;
; TAKE CARE OF LINES
;
COMMENT &
RAD10 USR,TOTLIN ;TELL TOTAL LINES
TELL USR,[ASCIN( Total lines = )]
FLTR T1,TOTLIN ;GET TOTAL LINES
MOVE T2,[EXP ^D60000.] ;MS IN 1 MIN 60 * 1000
FMPR T1,T2 ;LINES * 1 MINUTE
FLTR T2,P4 ;ACTUAL TIME
FDVR T1,T2 ;(LINES * 1 MIN)/ACTUAL TIME
PUSHJ P,RND100 ;TRY TO ROUND OFF
FLTPNT USR,T1 ;GIVE LINES/MIN
TELL USR,[ASCIC( Lines/min)]
&
;
; NOW TAKE CARE OF BUFFERS OUT, SENT, DELAYED
;
RAD10 USR,TOTBOU ;TELL TOTAL BUFFER TRIED
TELL USR,[ASCIC( Total buffers tried)]
RAD10 USR,TOTBCM ;TELL TOTAL SENT
TELL USR,[ASCIC( Total buffers completed)]
RAD10 USR,TOTBDY ;TELL TOTAL DELAYED
TELL USR,[ASCIC( Total buffers delayed)]
RAD10 USR,TOTCE4 ;TELL TOTAL CAL11.UUO ERROR 4's
TELL USR,[ASCIC( Total CAL11. UUO error 4's)]
FLTR T1,TOTCHR ;display avg chraracters per buffer try
FLTR T2,TOTBOU
FDVR T1,T2
PUSHJ P,RND100 ;round to integer
FLTPNT USR,T1 ;type it
TELL USR,[ASCIC( - average characters per buffer tried)]
RAD10 USR,TOTZRO ;display total delay-zero count attempts
TELL USR,[ASCIC( total buffer attempts with zero bytes transferred)]
;
; TELL RUNTIME USED
;
MOVE T1,ENDRTM ;GET ENDING RUNTIME
SUB T1,BEGRTM ;FIGURE THE TOTAL RUNTIME USED
TIME USR,T1 ;TELL IT
TELL USR,[ASCIN( CPU time used = )]
FLTR T2,T1 ;CPU TIME USED
MOVE T1,P3 ;CHRS*1000
FDVR T1,T2 ;FIGURE CHRS PER CPU SECOND
PUSHJ P,RND100 ;TRY TO ROUND OFF
FLTPNT USR,T1 ;
TELL USR,[ASCIC( Chars/CPU sec)]
POPJ P, ;ALL DONE
;ROUTINE TO TYPE THE PROMPT
;
PROMPT: TXNN F,F.T20 ;TOPS20?
JRST [ CHR USR,"/" ;NO, TOPS10
POPJ P, ] ;
TELL USR,[ASCIN(D60SPD>)] ;TOPS20 STYLE
POPJ P, ;
;ROUTINE TO GET/GIVE-BACK CORE
;
; CALL: PUSHJ P,CORUUO ;T1 CONTAINS ADDRESS
; RETURN ;UNLESS ERROR
;
CORUUO: CORE T1, ;GET OR GIVE BACK
ERROR (E,Y,COR,<CORE UUO failed>,<STARTZ>)
POPJ P, ;RETURN TO THE CALLER
;ROUTINE TO READ IN THE TIME FROM A COMMAND
;
; CALL: PUSHJ P,GETSEC ;
; RETURN ;T1 CONTAINS NUMBER OF SECONDS
;
GETSEC: PUSHJ P,S$TIM ;GET LENGTH OF TIME TO SNOOZE
ERROR (E,Y,TIM,<Incorrect time in command>,<STARTZ>)
SKIPE T1,L.HRS ;GET NUMBER OF HOURS
IMULX T1,^D<60*60> ;CONVERT TO SECONDS
SKIPE T2,L.MIN ;GET NUMBER OF MINUTES
IMULX T1,^D60 ;CONVER TO SECONDS
ADD T1,T2 ;COMBINE HRS AND MINS
ADD T1,L.SEC ; AND SECONDS
POPJ P, ;RETURN WITH NUMBER OF SEC IN T1
SUBTTL Some typeout routines
;ROUTINE TO TYPE A "TAB"
;
; CALL: PUSHJ P,TYPTAB ;
; RETURN ;
;
TYPTAB: CHR USR," " ;TYPE A TAB
POPJ P, ;RETURN TO CALLER
;ROUTINE TO TYPE A CRLF
;
; CALL: PUSHJ P,TYPCRL ;
; RETURN ;
;
TYPCRL: TELL USR,CRLF ;CRLF
POPJ P, ;
;ROUTINE TO TYPE OUT A FILE-SPEC
;
; CALL: PUSHJ P,TYPFS ;T1 POINTS TO THE DEVICE CELL
; RETURN ;
;
TYPFLS: MOVE T1,FILSPC ;GET ADDRESS OF DEVICE CELLS
TYPFS: PUSHJ P,TYPDV ;TYPE THE DEVICE NAME
TELL6 USR,.CCNAM(T1) ;PRINT THE FILE NAME
CHR USR,"." ;
HLLZ T2,.CCEXT(T1) ;GET THE EXTENSION
TELL6 USR,T2 ;PRINT THE EXTENSION
TYPPTH: ADDX T1,.CCPTH ;POINT TO THE PATH
HLRZ T3,.PTPPN(T1) ;GET PROJECT NUMBER
HRRZ T4,.PTPPN(T1) ;GET PROGRAMMER NUMBER
PJUMPE T4,CPOPJ ;IF NO PROGRAMMER THEN DON'T
; TRY ANY MORE
TELL USR,[ASCIN<[^1,^7>] ;PRINT THE PPN
TYPFS1: SKIPN T2,(T1) ;GET NUMBER OF SFD'S
JRST TYPFS3 ;DONE
TYPFS2: SKIPN T3,.PTPPN+1(T1) ;GET SFD NAME
JRST TYPFS3 ;DONE
CHR USR,"," ;
TELL6 USR,T3 ;TYPE SFD NAME
ADDX T1,1 ;POINT TO NEXT SFD NAME
SOJG T2,TYPFS2 ;TRY ANOTHER SFD
TYPFS3: CHR USR,"]" ;FINISH
POPJ P, ;RETURN TO CALLER
;ROUTINE TO TYPE THE DEVICE NAME
;
TYPDEV: MOVE T1,FILSPC ;GET ADDRESS OF DEVICE CELLS
TYPDV: TELL6 USR,.CCDEV(T1) ;PRINT THE DEVICE NAME
CHR USR,":" ;
POPJ P, ;
;SUBROUTINE TO ROUND OFF
;
; CALL: PUSHJ P,RND100 ;T1 CONTAINS THE NUMBER
; RETURN ;T1 CONTAINS THE ROUNDED NUMBER
;
RND100: MOVE T2,[EXP ^D100.] ;
FMPR T1,T2 ;*100
FIXR T1,T1 ;MAKE AN INTEGER
FLTR T1,T1 ;MAKE FP
FDVR T1,T2 ;MAKE THE ROUNDED NUMBER
POPJ P, ;RETURN TO THE CALLER
;SUBROUTINE TO HIBER FOR A WHILE
;
; CALL: PUSHJ P,SLP ;T1 CONTAINS MILLSEC TO SLEEP
; RETURN ;
;
SLP: HRLI T1,(HB.RWJ) ;HIBER CODE
MOVX T2,1 ;FOR HIBER FAILURE
HIBER T1, ;NAP
SLEEP T2, ;SLEEP
POPJ P, ;RETURN
;ROUTINE TO RECORD THE TIME
;
; CALL: PUSHJ P,BEGTIM ;
; RETURN ;WITH TIME IN " BEGIN "
;
BEGTIM: MSTIME T1, ;GET CURRENT TIME
MOVEM T1,BEGIN ;AND REMEMBER IT
POPJ P, ;RETURN TO CALLER
;ROUTINE TO GET THE UPTIME IN MILLISECONDS
;
; CALL: PUSHJ P,GETTIM ;
; RETURN ;T1 CONTAINS UPTIME IN MS
;
GETTIM:
IFN FTJSYS,<
TXNE F,F.T20 ;TOPS20?
JRST GETTI2 ;YES
>;END IFN FTJSYS
MOVE T1,[XWD 136,.GTCNF] ;7.01 UPTIME
GETTAB T1, ;GET UPTIME IN JIFFIES
CAIA ;FAILED, SO GET CPU0 UPTIME
JRST GETTI1 ;COMPUTE MS
MOVX T1,%CVUPT ;GET CPU0 UPTIME
GETTAB T1, ; IN JIFFIES
PUSHJ P,CONFUS ;SHOULD NEVER HIT THIS
GETTI1: IMULX T1,^D1000 ;CONVERT TO
IDIV T1,JIFSEC ; MILLISECONDS
POPJ P, ;RETURN MS IN T1
IFN FTJSYS,<
GETTI2: JSYS 14 ;(TIME) GET UPTIME IN MS
POPJ P, ;RETURN MS IN T1 (T2 IS SMASHED)
>;END IFN FTJSYS
;ROUTINE TO SEE IF OPERATOR WANTS SOMETHING
;
; CALL: PUSHJ P,CHKOPR ;
; RETURN ;ALWAYS UNLESS A FATAL ERROR
;
CHKOPR: SKIPN TYPFLG ;ALLOW TYPE AHEAD?
SKPINL ;LINE OF INPUT THERE?
POPJ P, ;NO, CONTINUE
PUSHJ P,SAVE4 ;SAVE P1,P2,P3, AND P4
PUSHJ P,SAVSCN ;SAVE STATE OF SCANNER
MOVX T1,TTYIN ;POINT SCANNER TO
MOVEM T1,L.SCIN ; THE TTY
MOVX T1,CONTTY ;
MOVEM T1,L.SCLN ;
MOVE T1,[XWD C11BLK,SPARAM