Trailing-Edge
-
PDP-10 Archives
-
BB-V552A-SB_1983
-
d60spd.mac
There are 30 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
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
RELOC 400000 ;Start high
..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] ;WHERE TO SAVE THE PARAM BLOCK
BLT T1,SPEND ;SAVE THE WHOLE THING
PUSH P,F ;SAVE THIS (ONLY TO CHECK F.STAT)
PUSH P,T5 ;SAVE AC'S
PUSHJ P,OPER ;SEE WHAT HE WANTS
POP P,T5 ;
MOVE T1,[XWD SPARAM,C11BLK] ;RESTORE THE PARAM BLOCK
BLT T1,PAREND ;DO IT
POP P,T1 ;GET BACK F
TXNE T1,F.STAT ;WAS STATISTICS ON?
ON F.STAT ;YES, MAKE SURE ITS ON IN F
POPJ P, ;RETURN
SUBTTL ROUTINE TO DO LINE/DEVICE COMMANDS
; ROUTINE - CCMD11
;
; FUNCTION - TO CALL THE CAL11 ROUTINE TO EXECUTE A LINE/DEVICE
; COMMAND AND IF A DELAY OCCURS, TO RETRY FROM THE START
; UNTIL THE COMMAND COMPLETES
;
; CALLED THE SAME AS IF THE CAL11 ROUTINE WERE BEING CALLED.
CCMD11: MOVE T2,[C11BLK,,C11BSV]
BLT T2,C11BSV+5 ; SAVE CAL11. ARG BLOCK
MOVEI T2,5 ; RETRY COUNTER
MOVEM T2,CCRTRY# ; SAVE IT FOR FUTURE USE
CCM.1: PUSHJ P,CAL11 ; DO THE CAL11.
SKIPA
PJRST CPOPJ1 ; NORMAL RETURN
LOAD. (T2,C%RC) ; GET THE RESULT CODE
CAIE T2,RC.DLY ; CHECK FOR A DELAY
POPJ P, ; NO .. GIVE ERROR RETURN
SOSG CCRTRY# ; DECREMENT RETRY
ERROR (E,Y,CDF,<COMMAND DELAY FAILURE FOR COMMAND: ^2>,<STARTZ>)
SNOOZE ^D1000 ; SLEEP FOR A SECOND
MOVE T2,[C11BSV,,C11BLK]
BLT T2,C11BLK+5 ; RESTORE THE ARG BLOCK
JRST CCM.1 ; GO TRY IT AGAIN
SUBTTL CAL11. UUO Subroutine
;HERE TO DO THE CAL11. UUO
;
; CALL: PUSHJ P,CAL11 ;T1 CONTAINS THE FUNCTION CODE
; ;C11BLK MUST CONTAIN:
; ; PORT #,,.C11QU
; ; LINE #,,DEVICE #
; ; # OF BYTES,,(LOADED WITH CONTENTS OF T1)
; ; LENGTH,,START OF BUFFER
; ; BYTES PER WORD,POSITION OF FIRST BYTE
; RETURN ;IF READ AND RESULT 2 OR 3
; RETURN ;IF WRITE AND RESULT 1
; ; READ AND RESULT 1
; IF WRITE AND REJECT GIVE AN ERROR
WTCL11: SNOOZE USR,^D475 ;GO SNOOZE AND CHECK OPR
CAL11: LOAD. (T1,C%FC) ;GET FUNCTION
MOVEM T1,FUNCT ;SAVE INCASE OF ERROR
IFE DEBOUT,<
IFN FTJSYS,<
TXNN F,F.T20 ;RUNNING ON TOPS20?
JRST CAL11B ;NO, TOPS10
SKIPE JFN ;HAVE A JFN?
JRST CAL11B ;YES
PUSHJ P,GETJFN ;GO GET A JFN
PJRST STARTZ ;LOSE
>;END IFN FTJSYS
>;END IFE DEBOUT
CAL11B: MOVX T5,DOLLOP ;LOOP COUNT
CAL11L: TXNN F,F.STAT ;KEEPING STATISTICS
JRST CAL11A ;NO STATISTICS
TXNN F,F.IABT!F.OABT ;ABORT DONE?
JRST CAL11C ;NO
SETCM T3,F ;GET COMPLEMENT OF FLAGS
TXNN T3,F.OABT!F.OUT ;OUTPUT ABORT RUNNING OUTPUT
MOVX T1,OUA% ;OUTPUT ABORTED MESSAGE
TXNN T3,F.IABT!F.IN ;INPUT ABORT RUNNING INPUT?
MOVX T1,INA% ;INPUT ABORTED MESSAGE
PJRST STARTE ;GIVE MESSAGE AND RESTART
CAL11C: AOS BUFOUT ;YES, COUNT BUFFERS OUTPUT
AOS TOTBOU ;COUNT TOTAL BUFFER OUTPUT
CAL11A: MOVE T3,[XWD 6,C11BLK] ;POINT TO PARAM BLOCK FOR CAL11. UUO
SETZM C11BLK+5 ;ZERO THE RESULT
MSTIME T2, ;GET CURRENT TIME
IFE DEBOUT,<
IFN FTJSYS,<
TXNE F,F.T20 ;RUNNING ON TOPS20
JRST [ MOVE 1,[XWD 6,C11BLK] ;NEED CAL11 BLK HERE
MOVE 2,JFN ;NEED JFN HERE
PUSHJ P,CAL11$## ;CALL CAL11. UUO SIMULATOR
CAIA ;ERROR
JRST CAL11S ;OK RETURN
MOVE T3,T1 ;GET ERROR CODE IN T3
JRST CALERR ] ;PROCESS ERROR
>;END IFN FTJSYS
CAL11. T3, ;DO CAL11. UUO
JRST CALERR ;ERROR RETURN
CAL11S: MSTIME T1, ;GET TIME FINISHED THE CAL11.
SUB T1,T2 ;TIME SPENT IN THE CAL11.
SKIPGE T1 ;SEE IF PAST MIDNIGHT
ADD T1,MIDNIT ;YES, MAKE THE ADJUSTMENT
TXNE F,F.STAT ;KEEPING STATISTICS
ADDM T1,C11TIM ;REMEMBER TOTAL TIME SPENT
; IN THE CAL11. UUO.
LOAD. (T1,C%RC) ;GET THE RESULT CODE
CAXL T1,1 ;RANGE CHECK THE
CAXLE T1,3 ; RESULT CODE FOR (1-3)
ERROR (E,N,RCE,<Illegal result code (^6) returned >,<TYPFCM,STARTZ>)
>;END IFE DEBOUT
IFN DEBOUT,<
LOAD. (T1,C%FC) ;GET FUNCTION CODE
CAXLE T1,FC.WD ;READ OR WRITE DATA?
JRST CLDEB1 ;NO
PUSHJ P,MAKPNT ;POINT TO BUFFER OF DATA
LOAD. (T2,C%NBYT) ;GET BYTES IN IT
CLDEB: ILDB T1,BUFPNT ;GET A CHAR
OUTCHR T1 ;OUTPUT IT ON TTY
PUSH P,T2 ;SAVE COUNT
PUSHJ P,CHKOPR ;SEE IF OPR NEEDS SOMETHING
POP P,T2 ;RESTORE COUNT
SOJG T2,CLDEB ;BUFFER ALL OUT?
CLDEB1: LOAD. (T1,C%NBYT) ;
STOR. (T1,C%BXFD) ;MAKE XFED NUMBER WE SENT
MOVX T1,RC.SUC ;GIVE GOOD RESULT
>;END IFN DEBOUT
CAXE T1,RC.SUC ;SUCCESS?
JRST NOSUCC ;NOPE
MOVX T5,DOLLOP ;GOOD ONE, SO RESET LOOP COUNT
LOAD. (T1,C%BXFD) ;get last amt xferred
LOAD. (T2,C%FC) ;GET FUNCTION CODE
CAXN T2,FC.WD ;write data must complete
JRST [PUSHJ P,XFRUPD ;update the ptrs and byte count
LOAD. (T3,C%NBYT) ;xfer suc'd - check if done
JUMPG T3,CAL11 ;no - send some more
SETZ T1,
JRST CAL11W]
IFE DEBOUT,<
CAXE T2,FC.RLS ;READ LINE STATUS CAN GET
; A RESULT CODE OF 1 AND 0
; COUNT IF LINE IS DISABLED.
JUMPE T1,C11ZRO ;RESULT 1 AND 0 COUNT?
>;END IFE DEBOUT
CAL11W: TXNN F,F.STAT ;KEEPING STATISTICS?
JRST CPOPJ1 ;NO, GIVE SKIP RETURN
AOS BUFCOM ;COUNT BUFFERS COMPLETED
AOS TOTBCM ;COUNT TOTAL BUFFERS COMPLETED
NOSUC2: ADDM T1,TOTCHR ;COUNT TOTAL CHAR REALLY OUTPUT
ADDM T1,CHRCNT ;COUNT CHARS OUTPUT SINCE LAST REPORT
PUSHJ P,CHKTIM ;SEE IF TIME TO REPORT
JFCL ;
PJRST CPOPJ1 ;GIVE SKIP RETURN
XFRUPD: LOAD. (T1,C%BXFD) ;GET BYTES TRANSFERRED SO FAR
ADDM T1,C11BLK+4 ;ADD TO FIRST POSITION
LOAD. (T3,C%NBYT) ;GET BYTE COUNT
SUB T3,T1 ;DECREASE IT
STOR. (T3,C%NBYT) ;PUT BACK NEW BYTE COUNT
TXNN F,F.STAT ;KEEPING STATISTICS?
POPJ P,
ADDM T1,TOTCHR ;COUNT TOTAL CHAR REALLY OUTPUT
ADDM T1,CHRCNT ;COUNT CHARS OUTPUT SINCE LAST REPORT
POPJ P,
;HERE IF RESULT 2 OR 3
;
NOSUCC: LOAD. (T2,C%FC) ;GET FUNCTION CODE
CAXE T1,RC.DLY ;DELAYED RETURN?
JRST [ CAXE T2,FC.RD ;READ DATA?
JRST OPRRJE ;REJECTED
POPJ P, ] ;RESULT 3, FUNCTION READ DATA
TXNN F,F.STAT ;KEEPING STATISTICS?
JRST NOSUC1 ;NO STATISTICS
AOS BUFDLY ;COUNT NUMBER OF TIMES DELAYED
AOS TOTBDY ;COUNT TOTAL TIMES DELAYED
NOSUC1: LOAD. (T1,C%BXFD) ;get bytes transferred so far
CAXN T2,FC.RD ;check delayed read data
JRST NOSUC2 ;yes - treat as a success
CAIE T2,FC.WD ;write type function?
POPJ P, ;something else - delayed
PUSHJ P,XFRUPD ;update the xfer ptr and count
PUSHJ P,CHKTIM ;IN DELAYED LOOP, SO CHECK TIME
JFCL ;
LOAD. (T1,C%BXFD) ;COUNT WE RECEIVED FROM THE 11
JUMPN T1,WTCL11 ;IF RESULT NON 0 TRY AGAIN
AOS TOTZRO ;COUNT OF DELAYED AND 0
AOS ZROCNT ;COUNT OF DELAYED AND 0
SNOOZE USR,^D575 ;GO SNOOZE AND CHECK OPR
SOJG T5,CAL11L ;IF 0 RESULT AND COUNT NOT EXPIRED
; TRY AGAIN.
ERROR (W,Y,DOL,<Delayed output loop>,<CAL11B>)
OPRRJE: ERROR (E,Y,ORJ,<Function ^2 rejected>,<STARTZ>)
;HERE ON THE ERROR RETURN FROM THE CAL11. UUO
;
CALERR: CAXN T3,C11IU% ;IN USE ERROR?
JRST CALER1 ;YES
TELL USR,CEE% ;NO, A REAL LOSER
CAXGE T3,.NMC11 ;ERROR CODE KNOWN?
JRST CALER0 ;YES
IFN FTJSYS,<
TXNN F,F.T20 ;RUNNING OR TOPS20
>;END IFN FTJSYS
SETZ T3, ;TOPS10 SO MAKE IT ERROR 0
IFN FTJSYS,<
CAXL T3,.ERBAS ;TOPS20 JFN ERROR?
MOVX T3,.NMC11 ;YES, SO GET JFN ERROR MSG
>;END IFN FTJSYS
CALER0: MOVE T3,MSGC11(T3) ;GET ADDRESS OF MESSAGE
TELL USR,@T3 ;PRINT ERROR MESSAGE
TELL USR,CRLF ;NEXT LINE
CHR USR," " ;GIVE A TAB
PUSH P,T3 ;
PUSHJ P,TYPFCM ;TYPE FUNCTION CODE
POP P,T3 ;
IFN FTJSYS,<
TXNN F,F.T20 ;RUNNING ON TOPS20?
>;END IFN FTJSYS
PJRST STARTZ ;NO, RESTART
IFN FTJSYS,<
CAXGE T3,.ERBAS ;JSYS ERROR?
PJRST STARTZ ;NO
CHR USR," " ;TAB OVER
PUSHJ P,JSYMSG ;GIVE JSYS ERROR MESSAGE
PJRST STARTZ ; AND RESTART
>;END IFN FTJSYS
;HERE IF A CAL11. UUO ERROR 4 (UUO IN USE)
;
CALER1: TXNN F,F.STAT ;KEEPING STATISTICS?
JRST CALER2 ;COUNT TOTAL ERROR 4'S
AOS C11E4 ;COUNT THE INUSE ERROR
AOS TOTCE4 ;COUNT TOTAL INUSE ERRORS
CALER2: SNOOZE C11E4S ;SHORT SNOOZE TIME
JRST CAL11A ;TRY AGAIN
;HERE IF 0 COUNT AND RESULT CODE OF 1
;
C11ZRO: TELL USR,ZRO% ;COMPLAIN
CHR USR," " ;INDENT NEXT MESSAGE
PUSHJ P,TYPFCM ;LOSE BIG ON THIS ONE BECAUSE
PJRST STARTZ ; IF HE CAN'T TAKE ANY OR GIVE
; ANY HE SHOULD GIVE RESULT CODE
; OF 2.
;HERE TO TYPE THE FUNCTION CODE MESSAGE
;
TYPFCM: TELL USR,[ASCIN(for function (^2) )]
MOVE T3,FUNCT ;GET FUNCTION CODE
CAXL T3,.NMFUC ;KNOWN FUNCTION CODE?
SETZ T3, ;MAKE UNKNOWN
MOVE T3,FUNMSG(T3) ;GET ADDRESS OF MESSAGE
TELL USR,@T3 ;PRINT IT
POPJ P, ;RETURN TO CALLER
;SUBTTL AC Save Routines
;HERE TO SAVE P1
;
SAVE1: EXCH P1,(P) ;SAVE P1
MOVEM P1,1(P) ;STORE RETURN ADR
MOVE P1,(P) ;GET P1 BACK
PUSHJ P,@1(P) ;GO BACK TO PUSHJ P,SAVE1 + 1
CAIA ;IN CASE OF SKIP RETURN
AOS -1(P) ;GIVE SKIP RETURN
JRST RES1 ;RESTORE P1 AND RETURN
;HERE TO SAVE P1-P4
;
SAVE4: EXCH P1,(P) ;SAVE P1
PUSH P,P2 ; AND P2
PUSH P,P3 ; AND P3
PUSH P,P4 ; AND P4.
MOVEM P1,1(P) ;
MOVE P1,-3(P) ;GET P1 BACK
PUSHJ P,@1(P) ;GO BACK TO PUSHJ P,SAVE4 +1
CAIA ;IN CASE OF SKIP RETURN
AOS -4(P) ;GIVE SKIP RETURN
RES4: POP P,P4 ;RESTORE P4
RES3: POP P,P3 ; AND P3
RES2: POP P,P2 ; AND P2
P1POPJ:
RES1: POP P,P1 ; AND P1
POPJ P, ;
;HERE TO SAVE T1-T5
;
SAVET: EXCH T5,(P) ;SAVE T5 AND GET RETURN ADR
PUSH P,T4 ;SAVE T4
PUSH P,T3 ;SAVE T3
PUSH P,T2 ;SAVE T2
PUSH P,T1 ;SAVE T1
MOVEM T5,1(P) ;STORE RETURN ADDRESS
MOVE T5,-4(P) ;RESTORE T5
PUSHJ P,@1(P) ;RETURN TO CALLER OF SAVET
CAIA ;POPJ RETURN
AOS -5(P) ;SET SKIP RETURN
POP P,T1 ;RESTOR T1
POP P,T2 ;RESTOR T2
POP P,T3 ;RESTOR T3
POP P,T4 ;RESTOR T4
T5POPJ: POP P,T5 ;RESTOR T5
POPJ P, ;RETURN
;ROUTINE TO SAVE STATE OF THE SCANNERS
;
SAVSCN: PUSH P,L.SCIN ;
PUSH P,L.SCLN ;
PUSHJ P,@-2(P) ;RETURN TO PUSHJ P,SAVSCN+1
CAIA ;INCASE OF SKIP RETURN
AOS -3(P) ;+1 FOR SKIP RETURN
POP P,L.SCLN ;RESTORE SCANNERS
POP P,L.SCIN ;
POP P,(P) ;CHUCK PUSHJ P,SAVSCN
POPJ P, ;RETURN
IFN FTJSYS,<
;ROUTINE TO GET A JFN
;
; CALL: PUSHJ P,GETJFN ;PORT CONTAINS THE PORT NUMBER
; ERROR ;
; RETURN ;NO ERROR, "JFN" CONTAINS THE JFN
;
GETJFN: SKIPN PVTYP ;check protocol type
SKIPE JFN ;ALREADY HAVE A JFN?
PJRST CPOPJ1 ;YES, SKIP RETURN
PUSHJ P,SAVE1 ;MUST PRESERVE P1
SETZB P1,JFN ;CLEAR P1, NO JFN YET.
SKIPN APRNUM## ;Has the proccessor type been found yet
PUSHJ P,PRCTYP## ; No .. so go check it out
SKIPE KSFLG## ;Is it a 2020?
JRST STFE.2 ; Yes .. go flush Q's on line
MOVX P1,1 ;Start with FE1:
GETJF1: MOVE T1,[POINT 7,FEDEVS] ;POINTER WHERE STRING IS BUILT
MOVX T3,"F" ;BUILD NAME OF "FE" DEVICE
IDPB T3,T1 ;
MOVX T3,"E" ;
IDPB T3,T1 ;
LDB T2,[POINT 3,P1,32] ;
JUMPE T2,GETJF2 ;DONT STORE HIGH DIGIT IF ZERO
ADDX T2,"0" ;
IDPB T2,T1 ;STORE HIGH DIGIT OF UNIT NUMBER
GETJF2: LDB T2,[POINT 3,P1,35] ;
ADDX T2,"0" ;
IDPB T2,T1 ;STORE LOW DIGIT
MOVX T3,":" ;FOLLOWED BY COLON
IDPB T3,T1 ; TO SPECIFY DEVICE
SETZ T3, ;FOLLOWED BY A NULL
IDPB T3,T1 ; TO INDICATE END OF STRING
MOVX T1,GJ%OLD!GJ%SHT ;OLD FILE, SHORT FORM OF GTJFN
HRROI T2,FEDEVS ;POINT TO STRING
GTJFN ;GET A JFN
ERJMP GETJF3 ;TRY NEXT UNIT, IF APPROPRIATE
MOVEM T1,JFN ;REMEMBER JFN OF FE DEVICE
PUSHJ P,DOENQ ;ENQ
PUSHJ P,CONFUS ;
MOVE T1,JFN ;GET OUT JFN
MOVX T2,<^D8>B5!OF%RD!OF%WR ;READ, WRITE, 8 BITS
OPENF ;OPEN THE "FILE"
ERJMP GETJF4 ;TRY NEXT UNIT, IF APPROPRIATE
JRST SETFE2 ;
SETFE: SKIPE PVTYP ;check protocol type
JRST CPOPJ1
PUSHJ P,DOENQ ;ENQ
PUSHJ P,CONFUS ;CONFUSED
SETFE2: MOVE T1,JFN ;GET OUR JFN
MOVX T2,.MODTE ;FUNCTION TO SPECIFY WHICH F.E.
LOAD. (T3,C%PORT) ;GET PORT NUMBER
SUBX T3,10 ;MAKE IT DTE NUMBER
MTOPR ;SPECIFY THE FRONT END
ERJMP GETJF8 ;MTOPR FAILED
SETFE3: PUSHJ P,DEQ$## ;DEQ THE DEVICE
SETDQF: ERROR (E,Y,DQF,<DEQ failed>,<JSYMSG,STARTZ>)
PJRST CPOPJ1 ;GIVE SKIP RETURN
STFE.2: PUSHJ P,DOENQ ; Enq the line
PUSHJ P,CONFUS ; Failed to lock the DDCMP line
LOAD. (T1,C%PORT) ; Get port number
SUBX T1,10 ; Remove DTE number offset
HRROM T1,JFN ; Save line number as JFN
; PUSHJ P,FLSHFE## ; Flush the DDCMP line Q's
; JRST FLSF.1 ; Line flush failed
JRST SETFE3 ; Go dequeue the line
;
; HERE IF THE GTJFN FAILS
;
GETJF3: CAXE T1,GJFX29 ;DEVICE NOT AVAILABLE?
PJRST GETJF5 ;NO, SOMETHING'S WRONG.
AOJA P1,GETJF1 ;YES, TRY NEXT UNIT.
;
; HERE IF GETJFN GAVE WRONG ERROR RETURN
;
GETJF5: ERROR (E,Y,GGF,<GETJFN GTJFN failed>,<JSYMSG,RELJF2,STARTZ>)
;
; HERE IF THE OPENF FAILS
;
GETJF4: CAXE T1,OPNX9 ; Simultaneous access or
CAXN T1,OPNX7 ; device alread in use?
CAIA ; Yes .. move onto next FE device
PJRST GETJF6 ; No, something's wrong.
MOVE T1,JFN ; Release the jfn
RLJFN
ERJMP GETJF7 ; JSYS error
PUSHJ P,DEQ$## ; Let go
JRST SETDQF ; DEQ failed
AOJA P1,GETJF1 ; Get another JFN
;HERE WHEN OPENF RETURNS THE WRONG ERROR CODE
;
GETJF6: ERROR (E,Y,GOF,<GETJFN OPENF failed>,<JSYMSG,RELJF2,DEQ$##,STARTZ>)
; HERE WHEN RLJFN RETURNS AN ERROR CODE
;
GETJF7: ERROR (E,Y,GRF,<GETJFN RLJFN failed>,<JSYMSG,RELJF2,DEQ$##,STARTZ>)
; Here when the DDCMP line flush fails
FLSF.1: ERROR (E,Y,LFF,<DDCMP line Q flush failed>,<GETJF9>)
;HERE WHEN MTOPR FAILS
;
GETJF8: ERROR (E,Y,MTO,<MTOPR failed>,<GETJF9>)
GETJF9: PUSHJ P,JSYMSG ;GIVE ERROR MESSAGE
PUSHJ P,DEQ$## ;DEQUEUE
JRST SETDQF ;GIVE ERROR MESSAGE
POPJ P, ;GIVE ERROR RETURN
;
;
; SUBROUTINE TO RELEASE A JFN
;
; CALL: PUSHJ P,RELJFN ;"JFN" CONTAINS THE JFN
; RETURN ;IF JFN IS RELEASED
; ; "JFN" IS SET TO 0
;
RELJFN: SKIPN JFN ;IS THERE A JFN?
JRST RELJF2 ;NO, JUST RETURN.
PUSHJ P,DOENQ ;BE SURE WE HAVE THE -11
JRST RELJF1 ;ERROR
MOVE T1,JFN ;PUT JFN IN T1 FOR JSYS
; PUSHJ P,FLSHFE## ;Type the process and flush Q's if 2020
; JRST RELJF1 ; Error while flushing DDCMP Q's
SKIPE KSFLG## ;Check for 2020 processor
JRST RLJF.3 ; Yes .. go dequeue the port
CLOSF ;CLOSE AND RELEASE JFN
JRST RELJF1 ;ERROR
RLJF.3: PUSHJ P,DEQ$## ;RELEASE THE -11
JRST RELJF1 ;ERROR
JRST RELJF2 ;CLEAR JFN AND RETURN
; HERE IF ERROR
;
RELJF1: ERROR (E,Y,RJF,<RELJFN failed>,<JSYMSG,RELJF2,DEQ$##>)
;
; HERE TO EXIT FROM RELJFN
;
RELJF2: SETZM JFN ;CLEAR FLAG
POPJ P, ;AND RETURN
;
;
;HERE ON A JSYS ERROR
;
JSYMSG: PUSH P,T1 ;PRESERVE T1
PUSH P,T2 ; AND T2
CHR USR,"?" ;PRECEDE ERROR MSG WITH "?"
MOVE T1,[.PRIOU] ;
MOVE T2,[XWD .FHSLF,-1] ;
SETZ T3, ;
ERSTR ;GIVE THE LAST JSYS ERROR
JFCL ;IGNORE
JFCL ;IGNORE
TELL USR,CRLF ;FOLLOW WITH A CRLF
POP P,T2 ;RESTORE SAVE AC'S
PJRST T1POPJ ; AND RETURN
;HERE TO DO THE ENQ
;
DOENQ: PUSHJ P,SAVE1 ;SAVE P1
DOENQ1: MOVX P1,^D<20*30> ;WAIT UP TO 30 SECONDS
DOENQ2: SKIPE PVTYP ;check protocol type
JRST CPOPJ1
MOVX T1,C11BLK ;
PUSHJ P,ENQ$## ;ENQ
CAIA ;ERROR
PJRST CPOPJ1 ;GIVE SKIP RETURN
CAXE T1,ENQX6 ;INUSE ERROR?
ERROR (E,Y,ENQ,<ENQ failed>,<JSYMSG>)
SNOOZE ^D50 ;SLEEP 50 MS
SOJG P1,DOENQ2 ;TRY AGAIN
ERROR (E,Y,CGD,<ENQ loop>,<JSYMSG>)
DOWN
FEDEVS: BLOCK 3 ;BUILD FE DEVICE HERE
UP
>;END IFN FTJSYS
SUBTTL Here on some Error's
;HERE FOR SOME ERRORS
E.AMB: MOVX T1,AMB% ;AMBIGUOUS SWITCH
POPJ P, ;ERROR RETURN
E.CER: MOVX T1,CER% ;COMMAND ERROR
POPJ P, ;NON SKIP RETURN
E.ILC: MOVX T1,ILC% ;ILLEGAL COMMAND
POPJ P, ;NON SKIP RETURN
E.NYI: TELL USR,NYI% ;COMMAND NOT YET IMPLEMENTED
PJRST CPOPJ1 ;GIVE OK RETURN
E.ICR: MOVX T1,ICR% ;CHARACTER OUT OF RANGE
POPJ P, ;GIVE ERROR RETURN
E.OAB: MOVX T1,OAB% ;OUTPUT ABORT ERROR
POPJ P, ;GIVE ERROR RETURN
;HERE IF D60SPD IS CONFUSED
;
; CALL: PUSHJ P,CONFUS ;
;
CONFUS: POP P,T3 ;GET WHERE THE CONFUSION IS
HRRZI T3,-1(T3) ;DON'T WANT (LH) AND SUB 1 FROM THE (RH)
ERROR (E,Y,EGF,<D60SPD is confused at PC:^1>,<ERREXT>)
;HERE ON ERROR MACRO CALL
;
; CALL: PUSHJ P,ERR ;
; BYTE (5) NUMBER OF PLACES TO GO (13) ERROR CODE (18) ADDRESS OF MSG
; XWD SIXBIT ERROR CODE,WHERE TO GO
;
ERR: PUSHJ P,SAVET ;SAVE SOME OF THE T'S
MOVEM T3,ERR.T3 ;SAVE AC WE DESTROY BEFORE MESSAGE
MOVEM T2,ERR.T2 ;SAVE T2
MOVEM T1,ERR.T1 ;SAVE T1
HRRZ T3,-6(P) ;GET ADDRESS FOLLOWING PUSHJ
MOVEM T3,ERR.AD ;SAVE ADDRESS FOLLOWING PUSHJ
HLRZ T3,@ERR.AD ;GET ERROR CODE
TXNN T3,E.Q ;ERROR OR WARNING
SKIPA T3,["%"] ;WARNING
MOVX T3,"?" ;ERROR
CHR USR,@T3 ;TYPE ? OR %
TELL USR,[ASCIN(D60)] ;
HRRZ T3,ERR.AD ;GET ADDRESS FOLLOWING PUSHJ
ADDX T3,1 ;MAKE 2ND ADR FOLLOWING PUSHJ
HLLZ T3,(T3) ;GET SIXBIT ERROR CODE
HRRI T3,' - ' ;INCLUDE A " -"
TELL6 USR,T3 ;TYPE SIXBIT ERROR CODE
CHR USR," " ;GIVE A SPACE
HRRZ T3,@ERR.AD ;GET TEXT ADDRESS
EXCH T3,ERR.T3 ;GET BACK T3
TELL USR,@ERR.T3 ;GIVE THE ERROR MESSAGE
EXCH T3,ERR.T3 ;SAVE T3 AGAIN
HLRZ T3,@ERR.AD ;GET ERROR CODE
TXNN T3,E.NC ;GIVE A CRLF?
TELL USR,CRLF ;YES
LDB T3,[POINT 5,@ERR.AD,4] ;GET NUMBER OF PLACES TO GO
MOVE T2,T3 ;SAVE A COPY
ADD T2,ERR.AD ;POINT TO LAST PLACE TO GO
HRRZ T1,(T2) ;GET LAST ADDRESS
HRRM T1,-6(P) ;REPLACE ADDRESS FOLLOWING PUSHJ
ERR2: SUBX T2,1 ;DECREMENT PLACE POINTER
SOJLE T3,ERR4 ;ALL PLACES PUT ON PDL
PUSH P,(T2) ;PUT A PLACE ON THE PDL
JRST ERR2 ;GO ANOTHER ROUND
ERR4: MOVE T3,ERR.T3 ;RESTORE AC'S WE USED
MOVE T2,ERR.T2 ;
MOVE T1,ERR.T1 ;
POPJ P, ;
SUBTTL LUUO Handler
COMMENT /
;^;++
LUUO Handler
Output is done via LUUOs.
The format of the LUUOs is:
LUUO DEST,ADR
where LUUO is one of the following.
LUUO OP-CODE ACTION
TELL 1 Print the ASCIZ string starting
at ADR.
TELL6 2 Print the 6 Sixbit characters in ADR.
a
CHR 3 Print the number ADR as an ASCII
character.
RAD10 4 Print contents of ADR in decimal.
RAD08 5 Print contents of ADR in octal.
FLTPNT 6 Print contents of ADR in floating point.
TIME 7 Print contests of ADR as HH:MM:SS.SSS
(and fill in with 0's)
TIMENZ 10 Print contests of ADR as HH:MM:SS.SSS
(and don't fill in with 0's)
SNOOZE 11 Hiber the number of milliseconds in ADR.
;--;=
The DEST field specifies the destination of the
message. The destination may be:
OPR Send to the operator
One additional specification in the DEST field may
be NAC which inhibits the translation of Action Characters
on the TELL UUO.
;--
/
UP
;UUO0 -- LUUO HANDLER IS CALLED VIA PUSHJ IN .JB41, AND
; RETURNS WITH POPJ. UUO ROUTINES MAY USE ACS U1 AND
; U2 FREELY. UUO HANDLER IS RECURSIVE, BUT ANY UUO ROUTINE
; WHICH EXECUTES LUUOS MUST SAVE U1 AND U2 FIRST. THESE
; ARE SAVED BY CALLER INSTEAD OF CALLEE SINCE STAMP IS THE
; ONLY UUO WHICH USES IT.
UUO0: PUSH P,T1 ;WE NEED THREE MORE ACS
PUSH P,T2
PUSH P,T3
PUSH P,T4
UUO1: LDB U1,P.UOP ;GET OP-CODE
LDB U2,P.UAC ;GET AC FIELD (DESTINATION)
CAXLE U1,.NMUUO ;ONE THAT WE KNOW ABOUT?
JRST UUOERR ;ILLEGAL UUO
MOVE T1,.JBUUO ;GET LUUO
TLZE T1,(1B13) ;SEE IF @
HRRZ T1,(T1) ;GET THAT ADDRESS THEN
ANDI T1,-1 ;KEEP ONLY ADDRESS
CAIN T1,T1 ;IS THE EFFEC ADR T1?
MOVEI T1,-3(P) ;YES, POINT TO PSEUDO-T1
CAIN T1,T2 ;OR, IS IT T2?
MOVEI T1,-2(P) ;YES, POINT TO PSEUDO-T2
PUSHJ P,@UUODIS-1(U1) ;DISPATCH UUO
POP P,T4 ;RETURN TO HERE AND RESTORE T4
POP P,T3 ;
POP P,T2 ;
PJRST T1POPJ ;RESTORE T1 AND RETURN TO USER
UUOERR: TELL USR,ILU% ;FATAL ERROR
PJRST ABEND ;AND GO BYE-BYE
;UUO DISPATCH TABLE
UUODIS: EXP MSGOUT ;TELL UUO
EXP SIXOUT ;TELL6 UUO
EXP CHROUT ;CHR UUO
EXP DECOUT ;RAD10 UUO
EXP OCTOUT ;RAD08 UUO
EXP FLTOUT ;FLTPNT UUO
EXP TIME0 ;TIME UUO (ZERO FILL)
EXP TIME1 ;TIME UUO (NO ZERO FILL)
EXP DOZE ;SNOOZE UUO
.NMUUO==.-UUODIS
MSGOUT: HRLI T1,440700 ;POINTER TO ASCIZ STRING
MSGOU1: ILDB U1,T1 ;GET A CHARACTER
TXNE U2,UU.NAC ;INHIBIT ACTION CHARACTERS?
JRST MSGOU2 ;YES
CAIE U1,"^" ;ACTION CHARACTER?
JRST MSGOU2 ;NO
PUSHJ P,STROUF ;MAKE SURE STRING GOES OUT
PUSHJ P,ACTCHR ;YES GO PROCESS
;RETURNS HERE WITH NEXT PRINT CHAR
MSGOU2: JUMPE U1,STROUF ;NULL MEANS END-OF-STRING
PUSHJ P,STROUT ;PRINT THE CHARACTER
JRST MSGOU1 ;AND LOOP FOR NEXT CHARACTER
SIXOUT: MOVE T2,(T1) ;GET 6 BIT TEXT
SIXOU1: SETZ T1, ;ZERO WHERE LSHC PUTS CHAR
LSHC T1,6 ;GET 6 BIT CHAR FROM T2
ADDX T1,40 ;MAKE IT 7 BIT
MOVE U1,T1 ;NEED THE CHAR HERE
PUSHJ P,STROUT ;OUTPUT THE CHARACTER INTO A BUFFER
JUMPN T2,SIXOU1 ;ALL DONE?
PJRST STROUF ;YES, NOW OUTPUT THE BUFFER
OCTOUT: SKIPA U1,CPOPJ ;LOAD AN 8
DECOUT: MOVX U1,12 ;LOAD A 10
PUSH P,[STROUF] ;WHERE TO FINISH UP AT
; (THIS WILL CAUSE THE NUMBER TO BE PRINTED)
MOVE T1,(T1) ;GET NUMBER INTO T1
NUMOUT: IDIVI T1,(U1) ;DIVIDE BY RADIX
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;ARE WE DONE?
PUSHJ P,NUMOUT ;NO, RECURSE
HLRZ U1,(P) ;GET LAST CHARACTER
ADDX U1,"0" ;MAKE IT ASCII
JRST STROUT ;LOAD UP BUFFER BEFORE PRINTING
CHROUT: MOVE U1,T1 ;GET THE CHARACTER
CHROU1: TXNN U2,UU.USR ;TO USER?
CAIA ;DON'T GIVE TO USER
OUTCHR U1 ;NO, PRINT THE CHARACTER
CHROU2: TXNN U2,UU.FRC ;PUT IN FRCBUF?
POPJ P, ;NO, RETURN
IDPB U1,FRCPNT ;PUT IN FRCBUF
SOSG FRCCNT ;BUFFER FULL?
PUSHJ P,CONFUS ;YES, COMMAND TOO LONG OR CONFUSION EXISTS
POPJ P, ;RETURN
STROUT: IDPB U1,CHRPNT ;PUT CHARACTER IN "CHRBUF"
SOSLE CHRCOU ;BUFFER NOW FULL?
JRST CHROU2 ;NO, GO CHECK IF CHAR GOES ELSEWHERE
STROUF: SETZ U1, ;YES, PUT A NUL AFTER LAST CHAR
IDPB U1,CHRPNT ;PUT NUL IN FOR TERMINATOR
SKIPE CHRBUF ;ANY CHARS TO OUTPUT?
OUTSTR CHRBUF ;YES, OUTPUT A STRING OF THEM
STRINI: MOVX U1,CHRMAX ;SETUP THE COUNT
MOVEM U1,CHRCOU ; OF CHARS ALLOWED TO PUT IN BUFFER
MOVE U1,[POINT 7,CHRBUF] ;SETUP POINTER TO
MOVEM U1,CHRPNT ; THE CHARACTER BUFFER
SETZM CHRBUF ;ZERO FIRST WORD OF BUFFER
POPJ P, ;RETURN
;HERE TO OUTPUT A FLOATING POINT NUMBER
;
; THIS CODE WAS SWIPED FROM DDT 36(152) BY EGF AND HACKED UP
; TO USE THE EXISTING OUTPUT ROUTINES, AND THE AC'S WERE
; RE-DEFINED AS FOLLOWS:
;
; T1 = A
; T2 = B
; T3 = C
; P1 = T
; P2 = W1
; P3 = W2
;
FLTOUT: PUSHJ P,SAVE4 ;SAVE 4 OF THE P's
MOVE T1,(T1) ;GET THE NUMBER
JUMPGE T1,TFLOT1
MOVNS T1
CHR USR,"-"
TLZE T1,400000
JRST FP1A
TFLOT1: TLNN T1,400
PJRST [ RAD10 USR,T1
POPJ P, ]
MOVX T2,0
CAMGE T1,FT01
JRST FP4
CAML T1,FT8
AOJA T2,FP4
FP1A: MOVX T3,0
FP3: MULI T1,400
ASHC T2,-243(T1)
SETZM TEM1 ;INIT 8 DIGIT COUNTER
SKIPE T1,T2 ;DON'T TYPE A LEADING 0
PUSHJ P,FP7 ;PRINT INTEGER PART OF 8 DIGITS
CHR USR,"." ;PRINT DECIMAL POINT
MOVNI T1,10
ADD T1,TEM1
MOVE P2,T3
SETZ P4, ;(EGF) FLAG WE NEED A TRAILING 0
FP3A: MOVE P1,P2
;THE FOLLOWING CODE WAS ADDED SO TRAILING ZEROS
; WOULD NOT BE PRINTED OUT.
;
MOVX T4,1 ;
MOVN T3,T1 ;WHAT POWER TO RAISE 1 TO
IMULX T4,^D10 ;
SOJG T3,.-1 ;
MOVE T2,P1 ;GET WHATS LEFT TO PRINT
MUL T2,T4 ;
JUMPN T2,FPEGF ;SEE IF ONLY TRAILING ZEROS
SKIPN P4 ;SEE IF A TRAILING 0 NEEDED
CHR USR,"0" ;YUP
POPJ P, ;ALL DONE
FPEGF: SETO P4, ;FLAG NO TRAILING 0 NEEDED
;
;END OF CODE TO TAKE CARE OF TRAILING ZEROS
;
MULI P1,12
PUSHJ P,FP7B
SKIPE P2
AOJL T1,FP3A
POPJ P,
FP4: MOVNI T3,6
MOVX P3,0
FP4A: ASH P3,1
XCT FCP(T2)
JRST FP4B
FMPR T1,@FCP+1(T2)
IORI P3,1
FP4B: AOJN T3,FP4A
PUSH P,P3 ;SAVE EXPONENT
PUSH P,T2 ;SAVE INDEX FOR "E+" OR "E-"
PUSHJ P,FP3 ;PRINT OUT FFF.FFF PART OF NUMBER
POP P,T2 ;GET INDEX FOR "E+" OR "E-" BACK
MOVEI T2,FSGN(T2) ;ADDRESS OF "E+" OR "E-"
TELL USR,@T2 ;PRINT IT
POP P,T1 ;GET EXPONENT BACK
FP7: IDIVX T1,12 ;DECIMAL OUTPUT SUBROUTINE
MOVMS T2 ;MAKE POSITIVE
AOS TEM1
HRLM T2,(P)
JUMPE T1,FP7A1
PUSHJ P,FP7
FP7A1: HLRZ P1,(P)
FP7B: RAD10 USR,P1
POPJ P,
353473426555 ;1.0E32
266434157116 ;1.0E16
FT8: 233575360400 ;1.0E8
216470400000 ;1.0E4
207620000000 ;1.0E2
204500000000 ;1.0E1
FT: 201400000000 ;1.0E0
026637304365 ;1.0E-32
113715126246 ;1.0E-16
146527461671 ;1.0E-8
163643334273 ;1.0E-4
172507534122 ;1.0E-2
FT01: 175631463146 ;1.0E-1
FT0=FT01+1
FCP: CAMLE T1, FT0(T3)
CAMGE T1, FT(T3)
Z FT0(T3)
FSGN: ASCII .E-.
ASCII .E+.
DOWN
TEM1: BLOCK 1
UP
;:TIMSTP -- Routine to output the time.
;:
;:TIMESTAMP is of the form:
;: HH:MM:SS.SSS
;:
;&Where HH:MM:SS.SSS is the time
;&
TIME0: TDNN T4,T4 ;FLAG ZERO FILL
TIME1: SETO T4, ;FLAG NO ZERO FILL
MOVE T1,(T1) ;GET THE TIME
IDIV T1,[15567200] ;DIV BY #MS/HR =1000*60*60 (DEC)
SKIPE T4 ;SKIP IF ZERO FILL
JUMPE T1,NOHRS ;SEE IF ANY HOURS TO OUTPUT
CAXGE T1,^D10 ;GREATER THAN 10?
CHR USR,"0" ;NO, PAD IT
RAD10 USR,T1 ;PRINT THE HOURS
CHR USR,":" ;PUT IN A COLON
NOHRS: MOVE T1,T2 ;GET THE REMAINDER INTO T1
IDIVX T1,165140 ;DIV BY #MS/MIN =1000*60 (DEC)
SKIPE T4 ;SKIP IF ZERO FILL
JUMPE T1,NOMINS ;SEE IF ANY MINS TO OUTPUT
CAXGE T1,^D10 ;GREATER THAN 10?
CHR USR,"0" ;NO, PAD IT
RAD10 USR,T1 ;AND PRINT THE NUMBER
CHR USR,":" ;AND A COLON
NOMINS: MOVE T1,T2 ;GET REMAINDER INTO T1
IDIVX T1,^D1000 ;DIV BY #MS/SEC
CAXGE T1,^D10 ;CHECK FOR PADDING
CHR USR,"0" ;PAD IT
RAD10 USR,T1 ;PRINT SECS
SKIPE T4 ;ZERO SUPRESS
PJUMPE T2,CPOPJ ;YES, DON'T PRINT FRACTION
CHR USR,"." ;PRINT THE .
CAXGE T2,^D10 ;GREATER THAN 10?
CHR USR,"0" ;NO, PAD IT
CAXGE T2,^D100 ;GREATER THAN 100?
CHR USR,"0" ;NO, PAD IT
RAD10 USR,T2 ;PRINT NUMBER OF MS
POPJ P, ;AND RETURN
;;DOZE -- Routine to Hiber
;;
DOZE: HIBER T1, ;GO HIBER
JFCL ;OH WELL
TXNN U2,UU.USR ;CALL CHKOPR?
POPJ P, ;NO
PJRST CHKOPR ;SEE IF USER WANTS TO
;TRY A COMMAND?
;^;+ACTCHR -- Routine to handle Action Characters.
; Action Characters are any characters which follow an "^"
; in an ASCIZ string printed by a TELL UUO. They
; cause certain extra information to be printed out, or flip a bit
; to determine message length for the operator.
;-;#1
;CALL:
; PUSHJ P,ACTCHR
; RETURN HERE WITH NEXT PRINTABLE CHARACTER IN U1
;
;:Action Characters are:
;: ^0 PRINT "L.CMD" IN SIXBIT
;: ^1 PRINT "T3" IN OCTAL
;: ^2 PRINT "FUNCT" IN OCTAL
;: ^3 PRINT "BUFOUT" IN DECIMAL
;: ^4 PRINT "BUFCOM" IN DECIMAL
;: ^5 PRINT "BUFDLY" IN DECIMAL
;: ^6 PRINT "T3" IN DECIMAL
;: ^7 PRINT "T4" IN OCTAL
;: ^8 PRINT "CHRCNT" IN DECIMAL
;: ^9 PRINT "LINMIN" IN DECIMAL
;: ^A PRINT "CHRSEC" IN DECIMAL
;: ^B PRINT "DEVDEV" IN SIXBIT
;: ^C PRINT "DEVNAM" IN SIXBIX
;: ^D PRINT "DEVEXT" IN SIXBIT
;: ^E PRINT "T4" IN DECIMAL
;: ^F PRINT "C11E4" IN DECIMAL
;: ^G PRINT "T3" AS TIME
;: ^H PRINT "T3" IN SIXBIT
;: ^I PRINT "T4" IN SIXBIT
;: ^J PRINT "L.LINE" IN DECIMAL
;: ^K PRINT "D.DEV" IN DECIMAL
;: ^L PRINT "COMPCD" IN OCTAL
;: ^M PRINT "T5" IN DECIMAL
;: ^N PRINT "P1" IN DECIMAL
;: ^O PRINT "TOTCHR" IN DECIMAL
;#5
ACTCHR: ILDB U1,T1 ;GET ACTION CHARACTER
CAIL U1,"A" ;IS IT A LETTER?
SUBI U1,"A"-"9"-1 ;YES, MAKE LETTERS FOLLOW NUMBERS
SUBI U1,"0" ;MAKE A BINARY NUMBER
SKIPL U1 ;LESS THAN 0 IS ILLEGAL
CAXLE U1,.NMACT ;GREATER THAN ACTNUM IS ILLEGAL
JRST UUOERR ;TELL HIM
PUSH P,U2 ;SAVE U2
LSH U2,^D23 ;PUT DESTINATION IN AC FIELD
MOVE U1,ACTTBL(U1) ;GET THE SPECIAL ACTION
TLNE U1,700000 ;IT IS A UUO?
SKIPA U2,U1 ;NO, GOT OPERATION INTO U2
IOR U2,U1 ;YES, OR IN DESTINATION
XCT U2 ;DO THE ACTION
POP P,U2 ;RESTORE U2
ILDB U1,T1 ;GET THE NEXT CHARACTER
CAIN U1,"^" ;ANOTHER ACTION CHARACTER
JRST ACTCHR ;YES, LOOP AROUND
POPJ P, ;NO - RETURN
ACTTBL:
TELL6 L.CMD ;^0
RAD08 T3 ;^1
RAD08 FUNCT ;^2
RAD10 BUFOUT ;^3
RAD10 BUFCOM ;^4
RAD10 BUFDLY ;^5
RAD10 T3 ;^6
RAD08 T4 ;^7
RAD10 CHRCNT ;^8
RAD10 LINMIN ;^9
RAD10 CHRSEC ;^A
TELL6 DEVDEV ;^B
TELL6 DEVNAM ;^C
TELL6 DEVEXT ;^D
RAD10 T4 ;^E
RAD10 C11E4 ;^F
TIME T3 ;^G
TELL6 T3 ;^H
TELL6 T4 ;^I
RAD10 L.LINE ;^J
RAD10 D.DEV ;^K
RAD08 COMPCD ;^L
RAD10 T5 ;^M
RAD10 P1 ;^N
RAD10 TOTCHR ;^O
.NMACT==.-ACTTBL
SUBTTL Scanners
COMMENT /
;^;=
Scanners
All the scanners are called with location L.SCIN containing the
address of a get-a-character routine from the desired source of
input, and location L.SCLN containing the address of a get next
record routine.
It should be assumed that all scanners use T1 through T5, even
though some don't use all of them.
The scanners are:
S$DEC Return a decimal number
S$OCT Return an octal number
S$SIX Return a sixbit word
S$TIM Return a time specification
.SCDT Return a date-time specification
S$FILE Return a file-specification
Scanner utility routines are:
UNIQ6 Return index of unique table match
.SCFLS Flush leading spaces
.SCIN Get the next valid character
;--
/
;^;+S$OCT - S$DEC -- Octal and decimal number scanners.
; Returns scanned number in T1. Skip returns if at
; least one digit was found. Non-skip return is taken if the
; first character was not a digit. On a non-skip return, if
; T1 contains -1, then an end of line was seen while scanning
; for the first character.
;--
S$OCT: SKIPA T2,S$NUM1 ;LOAD AN 8
S$DEC: MOVX T2,12 ;LOAD A 10
S$NUM: CLEAR T1, ;CLEAR THE ACCUMULATOR
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES AND GET A CHAR
JRST S$NUM4 ;EOL, RETURN -1
CAIL C,"0" ;CHECK RANGE
CAILE C,"0"-1(T2)
S$NUM1: POPJ P,8 ;NOT IN RANGE
JRST S$NUM3 ;OK, SKIP INTO LOOP
S$NUM2: PUSHJ P,.SCIN ;GET A CHARACTER
PJRST CPOPJ1 ;EOL, RETURN.
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"0"-1(T2)
PJRST CPOPJ1 ;ITS NOT A NUMBER
S$NUM3: IMULI T1,(T2) ;SHIFT RADIX POINT OVER ONE
ADDI T1,-"0"(C) ;ADD IN THE NEXT DIGIT
JRST S$NUM2 ;AND LOOP AROUND FOR THE NEXT DIGIT
S$NUM4: SETO T1, ;LOAD A -1
POPJ P, ;AND TAKE ERROR RETURN
;+S$SIX -- Routine to scan off a sixbit word.
; Returns with T1 containing the first six alphanumeric
; characters from the input source, and T3 containing the number
; of characters returned. Returns next character in C.
;-;#2
;CALL:
; PUSHJ P,S$SIX
; RETURN HERE IF 1ST CHAR WAS NOT A-Z 0-9 OR SPACE
; RETURN HERE OTHERWISE
S$SIX: CLEARB T1,T3 ;T1 GETS RESULTS T3 GETS COUNT
MOVE T4,[POINT 6,T1] ;A BYTE POINTER FOR RESULTS
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES
PJRST CPOPJ1 ;EOL!
JRST S$SIX3 ;FALL INTO LOOP WITH 1ST CHAR
S$SIX1: PUSHJ P,.SCIN ;GET A CHARACTER
JRST S$SIX5 ;NO MORE
S$SIX3: CAXL C,141 ;CHECK FOR LOWER CASE
CAXLE C,172 ; ...
CAIA ;
SUBX C,40 ;MAKE IT UPPER CASE
CAIL C,"A" ;CHECK FOR ALPHA
CAILE C,"Z"
CAIA ;ITS NOT, TRY 0-9
JRST S$SIX4 ;GOT AN ALPHA
CAIL C,"0" ;TRY FOR NUMBERIC
CAILE C,"9"
JRST S$SIX5 ;NOT, RETURN
S$SIX4: SUBX C,40 ;MAKE IT 6BIT
PUSHJ P,S$SIX6 ;DEPOSIT IT
JRST S$SIX1 ;AND LOOP
S$SIX5: PJUMPE T3,CPOPJ ;NON-SKIP IF LOST ON 1ST CHAR
PJRST CPOPJ1 ;ELSE SKIP BACK
S$SIX6: TLNN T4,770000 ;GOT SIX ALREADY?
POPJ P, ;YUP DON'T DEPOSIT MORE
IDPB C,T4 ;ELSE, STORE CHAR
AOJA T3,CPOPJ ;INCR COUNT AND RETURN
UP
;+S$TIM -- Routine to return a Time Specification
;S$TIM scans a string of the form hh:mm:ss and returns
; L.HRS, L.MIN, L.SEC updated. No range checking
; is done so 120 may be used instead of 2:0.
;-;#2
;CALL:
; PUSHJ P,S$TIM
; RETURN HERE IF TOO MANY ARGS SPECIFIED (# IN T1)
; RETURN HERE OTHERWISE
S$TIM: CLEARM L.HRS ;CLEARM ANSWERS
CLEARM L.MIN ;BEFORE WE ASK THE QUESTIONS
CLEARM L.SEC
MOVX T5,L.SEC ;ADDRESS FOR LAST ARGUMENT
MOVNI T4,3 ;-VE NUMBER OF LEGAL ARGS
PUSHJ P,S$TML ;GO SCAN SOME
JUMPLE T4,CPOPJ1 ;WIN BIG
ADDX T4,3 ;CONVERT TO NUMBER OF ARGS
POPJ P, ;ANY NOTIFY THAT HE LOSES
S$TML: PUSHJ P,S$DEC ;GET A DECIMAL NUMBER
JFCL
HRLM T1,(P) ;SAVE IT ON THE STACK
AOJG T4,S$TL1 ;AOS COUNT AND AVOID RUNAWAY RECURSION
CAIN C,":" ;BREAK ON COLON?
PUSHJ P,S$TML ;YES, RECURSE
S$TL1: JUMPG T4,CPOPJ ;AUTOMATICALLY UNWIND IF TOO MANY ARGS
HLRZ T1,(P) ;GET AN ARGUMENT
MOVEM T1,(T5) ;SAVE IT
SOS T5 ;POINTER FOR NEXT ARG
POPJ P, ;AND UNWIND
DOWN
UP
;+S$FILE -- Routine to scan off a filespec.
; Call with T1 containing the address of the appropriate
; device control cells.
;
;If some part of the filespec is not given, the corresponding
; location is returned unchanged, so defaults can be
; filled in before calling.
;-;#3
;CALL:
; PUSHJ P,S$FILE
; RETURN HERE ON ERROR WITH T1 CONTAINING ADR OF ERROR MESSAGE
; RETURN HERE ON SUCCESS
; FILESPEC FLAGS KEPT IN T5
SC.DIR==1B0 ;DIRECTORY WAS FOUND
SC.DEV==1B1 ;DEVICE WAS FOUND
SC.NAM==1B2 ;NAME WAS FOUND
SC.EXT==1B3 ;EXTENSION WAS FOUND
S$FILE: HRRZ T5,T1 ;FOR FLAGS,,ADDRESS
CLEARM .CCPTH(T5) ;CLEAR THE FILE STATUS WORD
S$FIL1: PUSHJ P,S$SIX ;GET FIRST ATOM
JRST S$FIL2 ;NOT ALPHANUMERIC
JUMPE T1,CPOPJ1 ;EOL - SUCCESS RETURN
S$FIL2: CAIN C,":" ;DEVICE SPECIFIED?
JRST S$DEV ;YUP, GO DO IT
JUMPE T1,S$FIL3 ;NULL CANT BE FILENAME
TXOE T5,SC.NAM ;SET NAME FLAG AND SKIP IF 1ST ONE
JRST .SCFE1 ;TWO NAMES ARE ILLEGAL
MOVEM T1,.CCNAM(T5) ;STORE FILENAME
S$FIL3: CAIN C,"." ;EXTENSION COMING?
JRST S$EXT ;YES, DO IT!
CAIE C,"[" ;DIRECTORY SPEC COMING?
CAIN C,"<" ;ACCEPT EITHER DELIMETER
JRST S$DIR ;YES, GO GET IT
CAIN C," " ;A BLANK?
JRST S$FIL1 ;YES, TRY SOME MORE
PJRST CPOPJ1 ;NO, TAKE SUCCESS RETURN
S$DEV: JUMPE T1,.SCFE3 ;NULL DEVICE?
TXOE T5,SC.DEV ;SET DEV FLAG AND SKIP IF NOT DUPLICATE
JRST .SCFE4 ;DUPLICATE DEVICE
MOVEM T1,.CCDEV(T5) ;STORE DEVICE NAME
JRST S$FIL1 ;AND LOOP FOR MORE STUFF
S$EXT: TXOE T5,SC.EXT ;SET EXT FLAG AND SKIP IF 1ST ONE
JRST .SCFE2 ;NOT THE FIRST TIME!
PUSHJ P,S$SIX ;GET EXTENSION
JFCL ;NOT A VALID CHAR, STORE NULL
MOVEM T1,.CCEXT(T5) ;STORE THE EXTENSION
JRST S$FIL3 ;AND LOOP FOR MORE
S$DIR: TXOE T5,SC.DIR ;DO WE HAVE A DIRECTORY ALREADY?
JRST .SCFE8 ;YES, LOSE
MOVEI T1,.CCPTH(T5) ;LOAD ADDRESS OF PATH BLOCK
MOVEM T1,.CCPPN(T5) ;STORE IN PPN WORD
PUSHJ P,S$OCT ;GET AN OCTAL NUMBER
JFCL
JUMPN T1,S$DIR1 ;WE'VE GOT PROJ, GET PROG
CAIN C,"," ;SEE IF NULL PROJ NUMBER
JRST S$DIR1 ;IT IS, GET PROG NUMBER
CAIE C,"-" ;SEE IF DEFAULT DIRECTORY
JRST .SCFE5 ;IT ISN'T, ITS GARBAGE
PUSHJ P,.SCIN ;GET NEXT CHARACTER
JRST S$FIL1 ;EOL, LOOP FOR MORE FILSPEC STUFF
CAIN C,"," ;IS IT A COMMA
MOVX C,"-" ;YES, MAKE IT GARBAGE CHARACTER
JRST S$DIR2 ;AND MAKE SURE DIRECTORY IS CLOSED OFF
S$DIR1: HRLM T1,.CCPTH+2(T5) ;SAVE PROJECT NUMBWR
PUSHJ P,S$OCT ;GET PROG
JFCL
HRRM T1,.CCPTH+2(T5) ;SAVE PROGRAMMER NUMBER
S$DIR2: CAIE C,"]" ;THE END
CAIN C,">" ;ONE WAY OR ANOTHER
JRST S$DIR6 ;ZERO PAST LAST SFD
CAIE C,"," ;MORE TO COME?
JRST .SCFE5 ;NO, MORE GARBAGE
MOVEI P2,.CCPTH+3(T5) ;POINT TO FIRST SFD
S$DIR3: PUSHJ P,S$SIX ;GET SFD NAME
JRST .SCFE5 ;LOSE BIG
MOVEM T1,(P2) ;STORE IN PATH BLOCK
AOS .CCPTH(T5) ;INCREMENT 1ST WORD OF PATH BLOCK
CAIE C,"]" ;DONE YET?
CAIN C,">" ;OR THIS WAY
JRST S$DIR6 ;ZERO PAST LAST SFD TYPED IN
CAIE C,"," ;TERMINATED BY ","
JRST .SCFE5 ;NO, LOSE
MOVE T3,P2 ;GET CURRENT ADR
SUBI T3,.CCPTH(T5) ;SUBRACT BEGGINGING ADR
CAXGE T3,10 ;GREATER THAN MAX?
AOJA P2,S$DIR3 ;NO, WIN
JRST .SCFE7 ;YES, NESTING TO DEEP
S$DIR6: MOVE T1,.CCPTH(T5) ;GET SFD COUNT
CAXL T1,5 ;5 SFD'S?
JRST S$FIL1 ;GO BACK FOR MORE FILE SPEC
ADDI T1,.CCPTH+.PTSFD(T5);POINT 1 PAST LAST INPUT SFD
SETZM (T1) ;ZERO IT
SETZM 1(T1) ;ZERO NEXT
HRL T1,T1 ;MAKE A BLT
ADDX T1,1 ; POINTER
BLT T1,.CCEND(T5) ;ZERO PORTION NOT INPUT
JRST S$FIL1 ;GO BACK FOR MORE FILE SPEC
;ERROR ROUTINES FOR FILE-SPEC SCANNER
.SCFE1: MOVX T1,DFN%
POPJ P, ;LOAD ERROR MESSAGE ADR AND RETURN
.SCFE2: MOVX T1,DEX% ;ERROR MSG ADDRESS
POPJ P, ;RETURN
.SCFE3: MOVX T1,NDV% ;ERROR MSG ADDRESS
POPJ P, ;AND RETURN
.SCFE4: MOVX T1,DDV% ;ERROR MSG ADDRESS
POPJ P, ;AND RETURN
.SCFE5: MOVX T1,IDS% ;ERROR MSG ADDRESS
POPJ P,
.SCFE7: MOVX T1,SND% ;ERROR MESSAGE ADDRESS
POPJ P, ;AND GOTO FAIL RETURN
.SCFE8: MOVX T1,DDI% ;ERROR MESSAGE ADDRESS
POPJ P, ;AND RETURN
;UNIQ6 -- ROUTINE TO RETURN INDEX OF UNIQUE 6BIT MATCH
;
;CALL WITH T1 CONTAINING 6BIT WORD
; T2 CONTAINING XWD -TABLE LENGTH,TABLE ADR
; T3 CONTAINING NUMBER OF CHARACTERS INPUT
;
;CALL:
; PUSHJ P,UNIQ6
; RETURN HERE IF NO MATCH, OR NON-UNIQUE MATCH
; T1 IS ZERO IF NO MATCH, T1 IS -1 IF MORE THAN ONE
; RETURN HERE OTHERWISE WITH T1 CONTAINING INDEX
;
;ON NON-SKIP RETURN T1 STILL HAS 6BIT WORD.
UNIQ6: SKIPL T2 ;MAKE SURE LENGTH IS NEGATIVE
PUSHJ P,CONFUS ;ILLEGAL ARG IN T2
MOVE T3,MSKTBL-1(T3) ;GET MASK FOR CHARACTERS
MOVEM T3,UNIQ.A ;SAVE THE MASK
HRRZM T2,UNIQ.B ;SAVE START ADR OF TABLE
CLEAR T3, ;CLEAR UNIQUENESS BITS
UNIQ.1: MOVE T4,(T2) ;GET TABLE ENTRY
CAMN T1,T4 ;EXACT MATCH?
JRST UNIQ.3 ;YES, WIN!
TDZ T4,UNIQ.A ;MASK OUT CHARS NOT TYPED
CAME T1,T4 ;MATCH NOW?
JRST UNIQ.2 ;NO, LOOP AROUND FOR ENTIRE TABLE
TXOE T3,1 ;SET FIRST OCCURENCE
TXOA T3,2 ;IT WAS SET, SET SECOND OCCUR
HRLI T3,(T2) ;SAVE INDEX OF FIRST OCCUR
UNIQ.2: AOBJN T2,UNIQ.1 ;AND LOOP AROUND
TXNE T3,2 ;TWO OR MORE MATCHES?
JRST [ SETO T1, ;INDICATE MORE THAN 1 MATCH
POPJ P, ] ;GIVE ERROR RETURN
TXNN T3,1 ;DID WE GET ONE?
JRST [ SETZ T1, ;INDICATE NO MATCH
POPJ P, ] ;GIVE ERROR RETURN
MOVS T2,T3 ;GET INDEX INTO T2
UNIQ.3: HRRZ T1,T2 ;GET MATCH ADDRESS
SUB T1,UNIQ.B ;GET ABSOLUTE OFFSET
PJRST CPOPJ1 ;AND SKIP BACK
MSKTBL: 7777777777 ;1 CHARACTER
77777777 ;2 CHARACTERS
777777 ;3
7777 ;4
77 ;5
0 ;6
DOWN
UNIQ.A: BLOCK 1 ;FIRST TEMP
UNIQ.B: BLOCK 1 ;SECOND TEMP
UP
;USEFUL SCANNING ROUTINES
;.SCFLS -- ROUTINE TO FLUSH LEADING SPACES
;
;CALL:
; PUSHJ P,.SCFLS
; RETURN HERE IF END-OF-LINE WAS ENCOUNTERED
; RETURN HERE OTHERWISE WITH FIRST SIGNIFICANT CHAR IN C
.SCFLS: PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;END-OF-LINE
CAXN C,.ASSPC ;A SPACE?
JRST .SCFLS ;YES, LOOP
PJRST CPOPJ1 ;NO, RETURN
;.SCIN -- ROUTINE TO CALL THE GET A CHARACTER ROUTINE FOR THE
; SCANNERS. CHECKS FOR CONTINUATION CHARACTERS, COMMENTS ETC.
;
;CALL:
; PUSHJ P,.SCIN
; RETURN HERE ON END-OF-LINE
; RETURN HERE OTHERWISE WITH CHARACTER IN C
.SCIN: TXZE F,F.RSCN ;RESCANNING THIS CHAR?
PJRST CPOPJ1 ;YES, JUST RETURN
PUSHJ P,@L.SCIN ;CALL CALLER'S ROUTINE
POPJ P, ;EOL
CAIE C,"!" ;START COMMENT FIELD?
CAIN C,";" ;EITHER TYPE!!
POPJ P, ;YES, SAME AS EOL
CAIE C,"-" ;OR CONTINUATION MARK?
PJRST CPOPJ1 ;NO, SKIP BACK WITH CHARACTER
PUSH P,B ;SAVE BYTE POINTER
.SCIN1: PUSHJ P,@L.SCIN ;GET ANOTHER CHARACTER
JRST .SCIN2 ;EOL MEANS IT WAS A CONTINUATION
CAIE C,"!" ;SO DOES A COMMENT
CAIN C,";" ; EITHER TYPE OF COMMENT
JRST .SCIN2 ;SO GO GET IT
CAIN C," " ;IS IT A BLANK?
JRST .SCIN1 ;YES, LOOP FOR NON-BLANK
POP P,B ;ITS NOT A CONTINUATION
MOVX C,"-" ;SO RESTORE THE HYPHEN
PJRST CPOPJ1 ;AND RESTORE BP AND SKIP BACK
.SCIN2: POP P,B ;BRING STACK INTO PHASE
PUSHJ P,@L.SCLN ;GET NEXT RECORD
POPJ P, ;THATS THE END
JRST .SCIN ;NOPE, TRY AGAIN
;.SCEOL -- ROUTINE TO FLUSH TO EOL
;
;CALL:
; PUSHJ P,.SCEOL
; RETURN HERE AFTER FINDING EOL
;
.SCEOL: TXNE F,F.IBRK ;AT BREAK NOW?
POPJ P, ;YES, RETURN
PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;EOL, SO RETURN
JRST .SCEOL ;EAT THE LINE
SUBTTL TTY INPUT ROUTINES
;TTYIN -- ROUTINE TO RETURN ONE CHARACTER FROM THE TELETYPE IN AC C.
; IGNORES NULLS, CONVERTS TABS AND CR TO A SPACE, CONVERTS
; LOWER CASE TO UPPER CASE.
;
;CALL:
; PUSHJ P,TTYIN
; RETURN HERE IF THIS CHARACTER IS END-OF-LINE
; RETURN HERE OTHERWISE
TTYIN: INCHWL C ;GET A CHARACTER
JUMPE C,.-1 ;IGNORE A NULL
TTYINX: CAXE C,.CHTAB ;CONVERT TABS
CAXN C,.CHCRT ; AND CARRIAGE RETURNS
MOVX C,.ASSPC ;TO SPACE
CAXL C,141 ;SEE IF IT IS LOWER CASE
CAXLE C,172 ; LC RANGE IS 141-172
CAIA ;NOT LOWER CASE
SUBX C,40 ;IT IS, MAKE IT UC
CAXLE C,.CHESC ;GREATER THAN ESCAPE?
PJRST CPOPJ1 ;YES, RETURN WITH A SKIP
TTYIN1: PUSHJ P,ISBRK ;IS IT A BREAK?
POPJ P, ;YUP!
PJRST CPOPJ1 ;NO, SKIP BACK
;CONTTY -- TTY CONTINUATION ROUTINE
; CONTTY PRINTS "#" ON TTY, FLUSHES TILL END OF LINE, AND
; AND SKIPS BACK.
CONTTY: OUTCHR ["#"] ;PRINT A #
PUSHJ P,TTYBRK ;FLUSH A COMMENT IF NEXESSARY
OFF F.IBRK ;SET NO BREAK
PJRST CPOPJ1 ;AND SKIP BACK
DSKIN: PUSHJ P,GCHADV ;GET A CHARACTER INTO "C"
JRST DSKEOF ;EOF
JUMPE C,DSKIN ;CHUCK NULLS
PUSH P,U1 ;SAVE THIS CAUSE "GETCMD"
; RETURNS WITH IT
CHR USR,@C ;PRINT CHAR ON TTY
POP P,U1 ;RESTORE U1
JRST TTYINX ;ACT AS THOUGH IT CAME FROM A TTY
DSKEOF: ON F.AEOF!F.IBRK ;FLAG HIT EOF
POPJ P, ;GIVE NON SKIP RETURN
DSKINC: PUSHJ P,CONFUS ;CONTINUATION NOT IMPLEMENTED YET
GCHADV: SOSGE AUTBC ;DECREMENT THE BYTE COUNT
JRST GCHAD1 ;BUFFER EMPTY, GET ANOTHER ONE
ILDB C,AUTBP ;GET A CHARACTER
JUMPE C,GCHADV ;CHUCK NULLS
PJRST CPOPJ1 ;GIVE SKIP RETURN WITH A CHAR IN "C"
GCHAD1: IN AUTO, ;GET A BUFFER
JRST GCHADV ;GO TAKE A CHARACTER FROM IT
STATZ AUTO,74B23 ;SEE IF ERROR
ERROR (E,Y,ADE,<IN UUO error reading AUTO file>,<STARTZ>)
CLOSE AUTO, ;CLOSE IT
RELEAS AUTO, ; AND RELEASE IT
POPJ P, ;NON SKIP CAUSE OF EOF
;STRIN -- ROUTINE TO RETURN ONE CHARACTER FROM THE TEXT
; POINTED AT BY AC( B ).
;
; CALL: PUSHJ P,STRIN ;B POINTS TO AN ASCIZ TEXT
; RETURN HERE IF THIS CHARACTER IS END-OF-LINE
; RETURN HERE OTHERWISE
;
STRIN: ILDB C,B ;GET A CHARACTER
CAXE C,.CHTAB ;CONVERT TABS
CAXN C,.CHCRT ; AND CR
MOVX C,.ASSPC ;TO SPACE
CAXLE C,.CHESC ;GREATER THAN ESCAPE?
PJRST CPOPJ1 ;YES, GIVE SKIP RETURN
PUSHJ P,ISBRK ;IS IT A BREAK?
POPJ P, ;YUP!
PJRST CPOPJ1 ;NO, SKIP BACK
;ISBRK -- ROUTINE TO DETERMINE IF THE CHARACTER IN AC C IS A
; BREAK CHARACTER.
;
;CALL:
; PUSHJ P,ISBRK
; RETURN HERE IF IT IS A BREAK
; RETURN HERE OTHERWISE
ISBRK: PUSH P,T1 ;PRESERVE T1
MOVSI T1,-.NMBRK ;SETUP AOBJN POINTER
ISBRK1: CAMN C,BRKTBL(T1) ;COMPARE TO TABLE
JRST ISBRK2 ;IT MATCHES!!
AOBJN T1,ISBRK1 ;LOOP AROUND
POP P,T1 ;RESTORE T1
PJRST CPOPJ1 ;NOT A BREAK, SKIP BACK
ISBRK2: ON F.IBRK ;IT IS A BREAK!!
PJRST T1POPJ ;RETORE T1 AND RETURN
;BRKTBL -- TABLE OF BREAK CHARACTERS
BRKTBL: EXP .CHLFD ;LINE-FEED
EXP .CHESC ;ESCAPE
EXP .CHFFD ;FORM-FEED
EXP .CHVTB ;VERTICAL TAB
EXP .CHBEL ;BELL
EXP .CHCNZ ;CONTROL Z
EXP .CHCNC ;CONTROL C
.NMBRK==.-BRKTBL
;TTYBRK -- ROUTINE TO FLUSH THE TTY UNTIL EOL
;
;CALL:
; PUSHJ P,TTYBRK
; ALWAYS RETURN HERE
TTYBRK: TXNE F,F.IBRK ;GOT A BREAK ALREADY?
POPJ P, ;YES, RETURN
TTYBR1: INCHWL C ;GET A CHARACTER
PUSHJ P,ISBRK ;BREAK?
POPJ P, ;YES, RETURN
JRST TTYBR1 ;LOOP AROUND
;POPJ ROUTINES
;
CPOPJ1: AOSA (P) ;GIVE SKIP RETURN
T1POPJ: POP P,T1 ;RETORE T1
CPOPJ: POPJ P,8 ;RETURN TO CALLER
ABEND: EXIT ;FATAL ERROR SO EXIT
MIDNIT: EXP ^D<24*60*60*1000> ;NUMBER OF MS IN 24 HOURS
SUBTTL Messages
CRLF: ASCIZ \
\ ;CRLF
D60NO: ASCIC( Unknown to D60SPD)
OUTDON: ASCIC([ Output Complete ])
INSTRT: ASCIC([ Receiving Input ])
INDON: ASCIC([ Input Complete ])
MSG(A60,E,Y,Abort from DN60)
MSG(ADA,M,Y,Already doing an ABORT)
MSG(AMB,E,Y,Ambiguous switch)
MSG(CEE,E,N,CAL11. UUO error (^1) )
MSG(CER,E,Y,Command Error - Retype Line)
MSG(COR,E,Y,CORE UUO failure)
MSG(DDI,E,Y,Double Directory Illegal)
MSG(DDT,W,Y,DDT not loaded)
MSG(DDV,E,Y,Double Device Illegal)
MSG(DEX,E,Y,Double Extension Illegal)
MSG(DFN,E,Y,Double Filename Illegal)
MSG(DIU,E,Y,Device ^B: is in use by Job ^6 ^I)
MSG(DNM,E,Y,Device number unknown)
MSG(ICR,E,Y,Illegal character range)
MSG(IDS,E,Y,Illegal Directory Specification)
MSG(ILC,E,Y,"^0" is an Illegal Command)
MSG(ILU,E,Y,Illegal LUUO in D60SPD)
MSG(INA,E,Y,Input aborted)
MSG(LNM,E,Y,Line number unknown)
MSG(NDV,E,Y,Null Device Illegal)
MSG(NYI,W,Y,Switch not yet implemented)
MSG(OAB,E,Y,Can't clear output abort complete)
MSG(OEF,M,Y,Output EOF sent)
MSG(ONG,E,Y,Output permission wasn't granted)
MSG(OUA,E,Y,Output aborted)
MSG(PNM,E,Y,Port number unknown)
MSG(RES,W,Y,Reserved command)
MSG(SND,E,Y,SFD Nesting Too Deep)
MSG(ZRO,E,Y,Zero count and result code of 1)
;CAL11. UUO error messages
;
MSGC11: [ASCIN(Undefined function)]
[ASCIN(must have POKE privileges)]
[ASCIN(undefined function on this type of front end)]
[ASCIN(Invalid port number)]
[ASCIN(CAL11. UUO in use)]
[ASCIN(No answer from front end)]
[ASCIN(Queue entry too short)]
[ASCIN(Not enough arguments)]
[ASCIN(Invalid DEPOSIT/EXAMINE address or data)]
[ASCIN(Invalid .C11QU function)]
[ASCIN(DTESER couldn't get any free core)]
[ASCIN(Reload bit set or primary protocol down)]
[ASCIN(There will never be enough EVM)]
.NMC11==.-MSGC11
[ASCIN(JSYS Error)] ;MAKE JSYS ERROR ALWAYS ONE MORE
; THAN THE HIGHEST KNOWN CODEHT
;The Functions in Asciz
;
FUNMSG: [ASCIC(Undefined function)]
[ASCIC(Read Data)]
[ASCIC(Write Data)]
[ASCIC(Read Device Status)]
[ASCIC(Write Device Command)]
[ASCIC(Read Line Status)]
[ASCIC(Write Line Command)]
[ASCIC(Read DN60 Status)]
[ASCIC(Write DN60 Command)]
.NMFUC==.-FUNMSG
IFN <FC.MAX-.NMFUC+1>,<PRINTX ?TABLE "FUNMSG" INCORRECT.>
SUBTTL Line and Device Command tables for SET SUPPORT and SIMULATE
;Tables of Line/Device commands for /Set Support and /Set Simulate
; The format of the table is:
; XWD Address of Support command , Address of Simulate command
; 0 specifies the command is not to be executed and -1 indicates
; that there are NO switches associated with the command but that
; the command is to be executed.
;String of Device Commands which get executed
; a byte of -1 indicates termination of string
;
DVCMDO: BYTE (7) DC.COE,DC.CIE,DC.COA,DC.CIA,DC.SCI
BYTE (7) DC.CCI,DC.SCO,DC.CCO,DC.SCC,DC.DCC
BYTE (7) DC.SSC,DC.CSC,DC.S27,DC.C27,DC.SRS
BYTE (7) -1,0,0,0,0
;2780 Device Command table
;
D2780: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0,,-1 ;CMD 6 set interpret carriage control on input
-1,,0 ;CMD 7 clear interpret carriage control on input
-1,,0 ;CMD 8 set interpret carriage control on output
0,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:0)],,[ASCIN(COMPCD:0)] ; CMD 12 component code
-1,,-1 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
0 ;CMD 17 do space compression on output
-1,,-1 ;CMD 18 don't do space compression on output
-1,,-1 ;CMD 19 2780 protocol
0 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;3780 Device Command table
;
D3780: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0,,-1 ;CMD 6 set interpret carriage control on input
-1,,0 ;CMD 7 clear interpret carriage control on input
-1,,0 ;CMD 8 set interpret carriage control on output
0,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:0)],,[ASCIN(COMPCD:0)] ; CMD 12 component code
-1,,-1 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;HASP Signon table
;
DHSIGN: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0 ;CMD 6 set interpret carriage control on input
-1,,-1 ;CMD 7 clear interpret carriage control on input
0 ;CMD 8 set interpret carriage control on output
-1,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;HASP Console Out table
;
DHCOUT: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0 ;CMD 6 set interpret carriage control on input
-1,,-1 ;CMD 7 clear interpret carriage control on input
0 ;CMD 8 set interpret carriage control on output
-1,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;HASP Console In table
;
DHCIN: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0 ;CMD 6 set interpret carriage control on input
-1,,-1 ;CMD 7 clear interpret carriage control on input
0 ;CMD 8 set interpret carriage control on output
-1,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;HASP Card Reader table
;
DHCDR: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0 ;CMD 6 set interpret carriage control on input
-1,,-1 ;CMD 7 clear interpret carriage control on input
0 ;CMD 8 set interpret carriage control on output
-1,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
;HASP Line Printer table
;
DHLPT: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0,,-1 ;CMD 6 set interpret carriage control on input
-1,,0 ;CMD 7 clear interpret carriage control on input
-1,,0 ;CMD 8 set interpret carriage control on output
0,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:132)],,[ASCIN(RECSIZ:132)] ;CMD 32 set record size
;HASP Card Punch table
;
DHCDP: 0 ;NO CMD 0
0 ;CMD 1 set characteristics
0 ;CMD 2 reserved
0 ;CMD 3 dump output buffers
0 ;CMD 4 clear input permission was requested
0 ;CMD 5 reserved
0 ;CMD 6 set interpret carriage control on input
-1,,-1 ;CMD 7 clear interpret carriage control on input
0 ;CMD 8 set interpret carriage control on output
-1,,-1 ;CMD 9 clear interpret carriage control on output
0 ;CMD 10 reserved
0 ;CMD 11 reserved
[ASCIN(COMPCD:^L)],,[ASCIN(COMPCD:^L)] ; CMD 12 component code
0 ;CMD 13 don't do output component selection
0 ;CMD 14 set printer page counter
0 ;CMD 15 disable printer page counter
0 ;CMD 16 reserved
-1,,-1 ;CMD 17 do space compression on output
0 ;CMD 18 don't do space compression on output
0 ;CMD 19 2780 protocol
-1,,-1 ;CMD 20 don't do 2780 protocol (do 3780)
0 ;CMD 21 request output permission
0 ;CMD 22 grant input permission
0 ;CMD 23 signal output EOF
-1,,-1 ;CMD 24 clear output EOF complete
0 ;CMD 25 signal output abort
-1,,-1 ;CMD 26 clear output abort complete
-1,,-1 ;CMD 27 clear input EOF complete
0 ;CMD 28 signal input abort
-1,,-1 ;CMD 29 clear input abort complete
0 ;CMD 30 suspend device HASP
0 ;CMD 31 unsuspend device HASP
[ASCIN(RECSIZ:80)],,[ASCIN(RECSIZ:80)] ;CMD 32 set record size
LICMDS: BYTE (7) LC.DIS,-1,0,0,0 ;DISABLE LINE STRING
LICMEN: BYTE (7) LC.EL,-1,0,0,0 ;ENABLE LINE STRING
LICMDO: BYTE (7) LC.CSD,LC.CTR,LC.WAR,LC.TBL,LC.RPM ;OTHER LINE COMMANDS STRING
BYTE (7) LC.DTR,LC.SLS,-1,0,0
LICMTR: BYTE (7) LC.STR,-1,0,0,0 ;ENABLE TRANSPARENCY STRING
;2780 Line Command table
;
L2780: 0 ;CMD 0 non existent
[ASCIN(Terminal:2/Flags:2)],,[ASCIN(Terminal:2/Flags:1)] ;CMD 1 enable line and characteristics
-1,,-1 ;CMD 2 set DTR
-1,,-1 ;CMD 3 abort all transfers and hang up modem
-1,,-1 ;CMD 4 disable the line
[ASCIN(CSD:0)],,[ASCIN(CSD:0)] ;CMD 5 clear to send delay
[ASCIN(SILWAR:64)],,[ASCIN(SILWAR:64)] ;CMD 6 number of bytes in silo warning area
-1,,-1 ;CMD 7 set output in transparent mode
-1,,-1 ;CMD 8 clear output in transparent mode
[ASCIN(TBL:400)],,[ASCIN(TBL:400)] ;CMD 9 set transmission block length
[ASCIN(RPM:7)],,[ASCIN(RPM:7)] ;CMD 10 set records per message
[ASCIN(SIG:65535)],,[ASCIN(SIG:65535)] ;CMD 11 set line signature
;3780 Line Command table
L3780: 0 ;CMD 0 non existent
[ASCIN(Terminal:1/Flags:2)],,[ASCIN(Terminal:1/Flags:1)] ;CMD 1 enable line and characteristics
-1,,-1 ;CMD 2 set DTR
-1,,-1 ;CMD 3 abort all transfers and hang up modem
-1,,-1 ;CMD 4 disable the line
[ASCIN(CSD:0)],,[ASCIN(CSD:0)] ;CMD 5 clear to send delay
[ASCIN(SILWAR:64)],,[ASCIN(SILWAR:64)] ;CMD 6 number of bytes in silo warning area
-1,,-1 ;CMD 7 set output in transparent mode
-1,,-1 ;CMD 8 clear output in transparent mode
[ASCIN(TBL:512)],,[ASCIN(TBL:512)] ;CMD 9 set transmission block length
[ASCIN(RPM:0)],,[ASCIN(RPM:0)] ;CMD 10 set records per message
[ASCIN(SIG:65535)],,[ASCIN(SIG:65535)] ;CMD 11 set line signature
;HASP Line Command table
;
LHASP: 0 ;CMD 0 non existent
[ASCIN(Terminal:3/Flags:2)],,[ASCIN(Terminal:3/Flags:1)] ;CMD 1 enable line and characteristics
-1,,-1 ;CMD 2 set DTR
-1,,-1 ;CMD 3 abort all transfers and hang up modem
-1,,-1 ;CMD 4 disable the line
[ASCIN(CSD:0)],,[ASCIN(CSD:0)] ;CMD 5 clear to send delay
[ASCIN(SILWAR:64)],,[ASCIN(SILWAR:64)] ;CMD 6 number of bytes in silo warning area
-1,,-1 ;CMD 7 set output in transparent mode
-1,,-1 ;CMD 8 clear output in transparent mode
[ASCIN(TBL:400)],,[ASCIN(TBL:400)] ;CMD 9 set transmission block length
[ASCIN(RPM:0)],,[ASCIN(RPM:0)] ;CMD 10 set records per message
[ASCIN(SIG:65535)],,[ASCIN(SIG:65535)] ;CMD 11 set line signature
SUBTTL Switch tables
;DEFINE SWITCHES - /PORT:x, /LINE:x, /DEVICE:x
;
DEFINE NAMES,<
SWT PORT,DVPRT,0; ;/PORT
SWT LINE,DVLIN,0; ;/LINE
SWT DEVICE,DVDEV,0; ;/DEVICE
>;END DEFINE NAMES
;BUILD THE TABLE OF NAMES AND THE DISPATCH
; TABLE FOR COMMANDS USING /PORT, /LINE, AND /DEVICE
;
BUILD (PLD,NAM,DSP) ;TABLES WILL HAVE A PREFIX OF 'PLD'
;HERE IF /LINE
;
DVLIN: CAIE C,":" ;SEE IF VALUE COMING?
JRST [ SKIPGE C11BLK+1 ;SEE IF WE HAVE A VALUE
PJRST CPOPJ ;NO, LOSE THEN
JRST CPOPJ1 ] ;USE CURRENT LINE
PUSHJ P,S$DEC ;GET THE LINE NUMBER
JRST [ AOSN T1 ;EOL?
SKIPGE C11BLK+1 ;LINE NUMBER?
POPJ P, ;ERROR RETURN
PJRST CPOPJ1 ] ;GIVE GOOD RETURN
STOR. (T1,C%LINE) ;STORE THE LINE NUMBER
MOVEM T1,L.LINE ;REMEMBER LINE NUMBER FOR TYPEOUT
JRST CPOPJ1 ;GIVE WIN RETURN
;HERE IF /PORT
;
DVPRT: CAIE C,":" ;SEE IF PORT NUMBER
JRST [ SKIPGE C11BLK ;NO, DO WE KNOW THE PORT?
PJRST CPOPJ ;NO, THEN ERROR
PJRST CPOPJ1 ] ;YES, GOOD RETURN
PUSHJ P,S$OCT ;GET PORT NUMBER
JRST [ AOSN T1 ;EOL?
SKIPGE C11BLK ;YES, DO WE KNOW PORT?
POPJ P, ;NO, ERROR
PJRST CPOPJ1 ] ;YES
MOVX T2,0 ;LOWEST TOPS10 PORT NUMBER
IFN FTJSYS,<
PUSHJ P,PRCTYP ;determine processor type
SKIPGE KSFLG
JRST DVPRT0 ;DN22 - 0 is lowest
TXNE F,F.T20 ;BUT ARE WE ON TOPS20?
MOVX T2,10 ;LOWEST TOPS20 PORT NUMBER
>;END IFN FTJSYS
DVPRT0: CAML T1,T2 ;MAKE SURE RANGE OF 0-13
CAXLE T1,PORT ;FOR TOPS10 OR 10-13 FOR TOPS20
POPJ P, ;OUT OF RANGE SO ERROR
IFN FTJSYS,<
LOAD. (T2,C%PORT) ;GET LAST PORT NUMBER
>;END IFN FTJSYS
STOR. (T1,C%PORT) ;REMEMBER THE PORT
IFN FTJSYS,<
TXNN F,F.T20 ;RUNNING ON TOPS20?
>;END IFN FTJSYS
PJRST CPOPJ1 ;TOPS10, SKIP RETURN
IFN FTJSYS,<
IFE DEBOUT,<
PUSHJ P,PROTYP ;determine protocol running on this fe
SKIPN PVTYP ;check protocol type
SKIPE JFN ;DO WE HAVE A JFN?
JRST DVPRT2 ;YES, DON'T GET ANOTHER
PUSHJ P,GETJFN ;GET THE JFN
PJRST STARTZ ;LOSE CAUSE WE NEED A JFN
PJRST CPOPJ1 ;GIVE SKIP RETURN
DVPRT2: CAMN T1,T2 ;PORT NUMBER CHANGE?
PJRST CPOPJ1 ;NO,
PUSHJ P,SETFE ;DO MTOPR
PJRST STARTZ ;INCASE OF ERROR
>;END IFE DEBOUT
PJRST CPOPJ1 ;GIVE SKIP RETURN
>;END IFN FTJSYS
;HERE IF /DEVICE
;
DVDEV: CAIE C,":" ;DEVICE NUMBER COMING?
JRST [ HRRE T1,C11BLK+1 ;NO, GET DEVICE NUMBER WE KNOW
JUMPL T1,CPOPJ ;DEVICE NUMBER NOT KNOWN
JRST CPOPJ1 ] ;USE DEVICE NUMBER WE KNOW
PUSHJ P,S$DEC ;GET DEVICE NUMBER FROM USER
PJRST [ HRRE T2,C11BLK+1 ;SEE IF WE KNOW DEV #
AOSN T1 ;SEE IF EOL
SKIPGE T2 ;KNOW DEV NUMBER?
POPJ P, ;EOL + DEV NUMBER UNKNOWN
JRST CPOPJ1 ] ;ASSUME WE HAVE PORT + LINE
DVDEV1: STOR. (T1,C%DEV) ;REMEMBER THE DEVICE NUMBER
MOVEM T1,D.DEV ;REMEMBER THE DEVICE NUMBER FOR PRINTOUT
PJRST CPOPJ1 ;GIVE SKIP RETURN
SUBTTL Low Segment Storage
DOWN
C11BLK: XWD -1,.C11QU ;DL10 PORT #,,.C11QU (2)
XWD -1,-1 ;LINE,,DEVICE
XWD -1,-1 ;# OF BYTES,,FUNCTION CODE
XWD -1,-1 ;LENGTH,,START OF BUFFER
BYTE(12)-1(24)-1 ;BYTES PER WORD,,POSITION OF FIRST BYTE
XWD -1,-1 ;NUMBER OF BYTES TRANSFERRED,,RESULT CODE
PARLNG==.-C11BLK
PAREND==.-1
;C11BLK BLOCK GETS SAVED HERE
;
SPARAM: BLOCK PARLNG
SPEND==.-1
C11BSV: BLOCK 6 ;BLOCK FOR DEVICE/LINE COMMAND
; SAVING
SETBYT: BLOCK 1 ;BYTE POINTER TO SETBLK
SETCNT: BLOCK 1 ;COUNT OF BYTES PUT IN SETBLK
XX==D6.BYT ;ASSUME THIS IS THE LARGEST
IFG <LS.BYT-XX>,< XX=LS.BYT> ;SEE IF LS.BYT IS LARGER
IFG <DS.BYT-XX>,< XX=DS.BYT> ;SEE IF DS.BYT IS LARGER
SETBLK: BLOCK <XX/4>+2 ;DATA BLOCK FOR SET AND STATUS COMMANDS
.LSETB==.-SETBLK
IFN FTJSYS,<
;TOPS20 JFN FOR FE DEVICE
;
JFN: Z ;TOPS20 JFN FOR FE DEVICE
>;END IFN FTJSYS
D.DEV: BLOCK 1 ;DEVICE NUMBER FOR TYPEOUT
L.LINE: BLOCK 1 ;LINE NUMBER FOR TYPEOUT
COMPCD: BLOCK 1 ;COMPONENT CODE
DEVTAB: BLOCK 1 ;POINTER TO DEVICE TABLE
IOTIME: -1 ;TIME TO REPORT
; -1 INDICATES GIVE DEFAULT AT
; AT OUTPUT/INPUT TIME
TYPFLG: Z ;FLAG TO INDICATE WHETHER TO
; ALLOW TYPE AHEAD.
; 0 = YES, -1 = NO
FIRZRO: ;FROM HERE THROUGH LSTZRO GET ZERO'ED
SLC2FL: BLOCK 1 ;FLAGS FOR CMD:2
ACTIME: BLOCK 1 ;ACTUAL TIME OF OUTPUT
BEGIN: BLOCK 1 ;TIME WE BEGAN OPERATION
BEGRTM: BLOCK 1 ;BEGINNING RUNTIME
BUFADR: BLOCK 1 ;LAST ADR,,FIRST ADR - HERE ONLY FOR DEBUGGING
BUFCOM: BLOCK 1 ;NUMBER OF BUFFERS COMPLETED
BUFDLY: BLOCK 1 ;NUMBER OF TIMES DELAYED
BUFOUT: BLOCK 1 ;COUNT OF ALL BUFFERS
BUFPNT: BLOCK 1 ;POINTER TO DN60 BUFFER
C11E4: BLOCK 1 ;NUMBER OF TIMES WE WON ERROR-4
C11TIM: BLOCK 1 ;TIME SPENT IN THE CAL11 UUO DURING I/O
CHARS: BLOCK 1 ;CHARACTER COUNTER
CHARSV: BLOCK 1 ;CHARACTER SAVE LOCATION
CHRCNT: BLOCK 1 ;COUNT CHARS HERE FOR CHAR/SEC REPORT
CHRRNG: BLOCK 1 ;LENGTH,,CHARACTER
CHRSEC: BLOCK 1 ;CHARACTERS A SECOND
EFTIME: BLOCK 1 ;TIME WE SENT EOF
ENDRTM: BLOCK 1 ;ENDING RUNTIME
ENDTIM: BLOCK 1 ;TIME INPUT/OUTPUT COMPLETED
ERR.AD: BLOCK 1 ;SAVE ERROR ADDRESS HERE
ERR.T1: BLOCK 1 ;SAVE T1 HERE DURING ERR
ERR.T2: BLOCK 1 ;SAVE T2 HERE DURING ERROR
ERR.T3: BLOCK 1 ;SAVE T3 HERE DURING ERR
ETIMMS: BLOCK 1 ;ENDING UPTIME IN MS
FILSPC: BLOCK 1 ;POINTER TO DEVICE CELLS
; USED FOR ERROR REPORTING
FUNCT: BLOCK 1 ;CURRENT FUNCTION
IOJBFF: BLOCK 1 ;REMEMBER .JBFF WHEN
JIFSEC: BLOCK 1 ;NUMBER OF JIFFIES IN A SEC
; STARTING I/O COMMAND
L.CMD: BLOCK 1 ;CURRENT OPR COMMAND
L.HRS: BLOCK 1 ;HOURS
L.MIN: BLOCK 1 ;MINUTES
L.SEC: BLOCK 1 ;SECONDS
L.SCIN: BLOCK 1 ;ADDRESS OF INPUT ROUTINE FOR SCANNERS
L.SCLN: BLOCK 1 ;ADDRESS OF NEXT RECORD ROUTINE FOR SCANNERS
LINES: BLOCK 1 ;INCREMENTED FOR EACH LINE
LINMIN: BLOCK 1 ;LINES A MINUTE
PDLST: BLOCK PDSIZ+1 ;THE PUSH DOWN LIST
PTHBLK: BLOCK .PTMAX ;PUT USER PATH HERE
SSMODE: BLOCK 1 ;ARGUMENT GETS RETURNED
; HERE FROM SET SUP OR SIM/2780/3780/HASP
STIMMS: BLOCK 1 ;STARTING UPTIME IN MS
STSCNT: BLOCK 1 ;STATUS LINE COUNTER
STTIME: BLOCK 1 ;START TIME FOR OUTPUT
TOTBCM: BLOCK 1 ;TOTAL BUFFERS COMPLETED
TOTBDY: BLOCK 1 ;TOTAL BUFFERS DELAYED
TOTBOU: BLOCK 1 ;TOTAL BUFFERS OUTPUT
TOTCE4: BLOCK 1 ;TOTAL CAL11 ERROR 4'S
TOTCHR: BLOCK 1 ;TOTAL CHARACTERS
TOTLIN: BLOCK 1 ;TOTAL LINES
TOTZRO: BLOCK 1 ;TOTAL TIMES RECEIVED
ZROCNT: BLOCK 1 ;TIMES EW RECEIVED ZERO
; COUNT ON A DELAYED RETURN.
; ZERO COUNT ON A DELAYED RETURN
CHRBUF: BLOCK <<CHRMAX+1>/5>+1 ;STORE A STRING OF CHARS HERE FOR
; "OUTSTR" AND INSURE AT LEAST 1
; EXTRA WORD FOR TERMINATOR BYTE
CHRPNT: BLOCK 1 ;POINTER TO CHRBUF
CHRCOU: BLOCK 1 ;COUNTER FOR CHRBUF
FRCBUF: BLOCK <<FRCMAX+1>/5>+1 ;STORE A STRING OF CHARS
; HERE FOR THE MACRO COMMANDS
FRCCNT: BLOCK 1 ;COUNTER
FRCPNT: BLOCK 1 ;BYTE POINTER TO FRCBUF
IOBSIZ: BLOCK 1 ;BUFFER SIZE
IOBPOS: BLOCK 1 ;BYTE POSITION
IOBWRD: BLOCK 1 ;BYTES PER WORD
IOCCC: BLOCK 1 ;CARRIAGE CONTROL CHAR
IODEVT: BLOCK 1 ;DEVICE TYPE
IONBYT: BLOCK 1 ;NUMBER OF BYTES
IONCHR: BLOCK 1 ;MAX NUMBER OF CHARS TO OUTPUT
; 0 = NO LIMIT
IOOFFS: BLOCK 1 ;BUFFER OFFSET
IOPAUS: BLOCK 1 ;TIME IN MS TO PAUSE AFTER
; OUTPUTTING A BUFFER
IOWIDE: BLOCK 1 ;WIDTH OF LINE
IOFCHR: BLOCK 1 ;FIRST CHARACTER
IOLCHR: BLOCK 1 ;LAST CHARACTER
NLINES: BLOCK 1 ;number of lines on current port
LSTZRO==.-1
IFN PATSIZ,<
PATCH:
PAT: BLOCK PATSIZ ;PATCH AREA
>;END IFN PATSIZ
END START