perm filename IMPSTA.OLD[S,NET] blob
sn#698984 filedate 1983-01-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 PDLLEN IIILIN DMLIN DDDLIN ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW BAL MAL NHBA NHMA HBA HMA BIIL MIIL
C00008 00003 DELAYP PDL HSTADR LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD FRSPTY FFLNK IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB PRJPRG JOBNAM PTYJOB TTYTAB PUPLDB PUPLSK PUPFSK PUPHST PUPMLK
C00022 00004 IMPSTA
C00024 00005 SNARF
C00026 00006 GETNET HDNODM IMPDDN
C00029 00007 NOTIDI NOTID1 NOTID2
C00030 00008 NOTID3 NXTLNK HSTSRH
C00032 00009 HSTSR0 HSTOUT DOLINK DOLNKX FORSKT
C00034 00010 DPYLS NOTCLS
C00036 00011 STADUN
C00037 00012 NODDB
C00039 00013 PUPSTA PUPLUK HAVPUP
C00040 00014 NENLNK ENLTYO
C00042 00015 LSNHST NXTENL
C00043 00016 PTYMAP PTYCHK PTYLUP PTYFND
C00045 00017 GETLOC NTELSR NXTPTY MSGEND CLREOF
C00047 00018 NODDDM DOIII DODM
C00049 00019 DELAY NODLAY DELAY1
C00050 00020 TERPRI DECOUT OCTOUT NUMOUT NUMOU1 NUMOU2 NUMOU3
C00051 00021 JOBOUT SIXOUT SIXOU1 TXTSTR ...LIT
C00052 ENDMK
C⊗;
;PDLLEN IIILIN DMLIN DDDLIN ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW BAL MAL NHBA NHMA HBA HMA BIIL MIIL
TITLE IMPSTAT
SUBTTL Definitions
; Mark Crispin, SU-AI, May 1981
X=1 ? Y=2 ? Z=3 ? L=4 ? I=5 ? N=6 ? DDB=7 ? J=10 ? T=11 ? A=12 ? B=13 ? C=14 ? P=17
PDLLEN==50. ; stack size
; GETLIN bits
IIILIN==400000,, ; terminal is a III
DMLIN== 040000,, ; terminal is a DM
DDDLIN==020000,, ; terminal is a DD
; APRENB bits
ILM== 020000 ; MPV occured
; Data Risc command word
DEFINE CW ?C1,B1,C2,B2,C3,B3
<<B1←28.>\<B2←20.>\<B3←12.>\<C1←9.>\<C2←6.>\<C3←3>\4>
TERMIN
; Data Risc command names
EXCT== 0 ; execute
FNCN== 1 ; function, usual value bytes
ALPHBG==6 ? ALPHA==46
CHNL== 2 ; channel select
COLM== 3 ; column select
HILIN== 4 ; set high 5 bits of line address
LOLIN== 5 ; set low 4 bits of line address
IMP== 400 ; IMP interface device code
; IMP status bits
RFCS== 200000,, ; RFC sent
RFCR== 100000,, ; RFC received
CLSS== 040000,, ; CLS sent
CLSR== 020000,, ; CLS received
; DDB stuff
DEVCHR==1 ; characteristics
DEVIOS==2 ; I/O status
INPW== 200000,, ; input wait
LNK0W==100000,, ; control link RFNM wait
BLOKW==040000,, ; RFNM wait
ALLW== 020000,, ; allocation wait
IO$INT==200000,, ; Interrupt waiting acknowedgement
IO$RFC==100000,, ; waiting for matching RFC
IO$END==040040,, ; End Pup seen
IO$ACK==020000,, ; output Ack wait
IO$SBB==001000,, ; in I/O wait
IO.BKT==040000 ; Mark/AMark seen
BAL== 14 ; bit allocation
MAL== 15 ; message allocation
NHBA== 16 ; nominal bit allocation
PUPRID==16 ; receive ID
NHMA== 17 ; nominal message allocation
PUPSID==17 ; send ID
HBA== 22 ; remote bit allocation
HMA== 23 ; remote message allocation
BIIL== 24 ; bits in input list
MIIL== 25 ; messages in input list
;DELAYP PDL HSTADR LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD FRSPTY FFLNK IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB PRJPRG JOBNAM PTYJOB TTYTAB PUPLDB PUPLSK PUPFSK PUPHST PUPMLK
SUBTTL Data area
DELAYP: BLOCK 1 ; -1 → don't delay
PDL: BLOCK PDLLEN ; stack
HSTADR: BLOCK 1 ; where host table begins
LINCNT: BLOCK 1 ; line count
HDABLK: BLOCK 13 ; terminal location block
HSIZE: BLOCK 1 ; horizontal size
SCREEN: BLOCK 1 ; display screen image pointer
; Display program stuff
COLPOS: CW COLM,2,HILIN,1,LOLIN,10 ; second column, second line
TXTOUT: CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA ; text output
DPHEAD: 200000,, ; double field mode
0 ; size
0
0 ; address of low order line select for DD
; Monitor pointers
FRSPTY: 0 ; TTY # of first PTY
FFLNK: 0 ; first free link
IMPDIE: 0 ; NCP locked out
IMPDEA: 0 ; NCP down
NMESIN: 0 ; messages in
NMESOU: 0 ; messages out
IMPDWY: 0 ; why IMP going down
IMPTDN: 0 ; when IMP going down
IMPTUP: 0 ; when IMP coming back up (usual lie)
; IMP table pointers indexed by IMP index
LNKTAB: 0 ; host-link number
LNKDDB: 0 ; address of DDB
IMPLS: 0 ; local socket number
IMPFS: 0 ; foreign socket number
IMPBS: 0 ; byte size
IMPSTB: 0 ; link status
; Pointers indexed by job number
PRJPRG: 0 ; PPN
JOBNAM: 0 ; program name
; Pointers indexed by PTY number
PTYJOB: 0 ; PTY mother
; Pointers indexed by TTY number
TTYTAB: 0 ; TTY DDB pointer
; Pup pointers
PUPLDB: 0 ; DDB
PUPLSK: 0 ; local socket number
PUPFSK: 0 ; foreign socket number
PUPHST: 0 ; host number
PUPMLK: 0 ; maximum number of links
;IMPSTA
SUBTTL Start of program
IMPSTA: JFCL
RESET
MOVE P,[PDL(-PDLLEN)]
; Map in host table
OPEN [17 ? 'DSK,, ? 0] ; get a disk channel
JRST 4,.-1
DMOVE [SIXBIT/HOSTS1BIN/] ? DMOVE 2,[0 ? 'HSTNET]
LOOKUP ; find file HOSTS1.BIN[HST,NET]
JRST 4,.-1
MOVE Y,JOBFF
MOVS Z ? MOVN ? ADDB JOBFF ; get address of highest addr we need
HRRM DPHEAD
MOVEM DPHEAD+3
AOS DPHEAD+3
CORE ; get more core from system maybe
JRST 4,.-1
HRRZ DPHEAD
ADDI 2
MOVEM SCREEN
MOVE Z ? HRRI -1(Y) ; compute IOWD to read host table in
SETZ X,
INPUT
MOVE (Y) ; get first word of host table
CAME ['HOSTS1]
JRST 4,.-1
MOVEM Y,HSTADR ; remember where host table begins
RELEAS
; Make sure we never lose with MPV
MOVEI [ MOVE JOBREL
ADDI 2000 ; another K of core, please
CORE
JRST 4,IMPSTA
LOCK
JRST GETNET] ; restart status
MOVEM JOBAPR
MOVEI ILM
APRENB
LOCK ; ensure fast response
; (continued on next page)
;SNARF
SUBTTL Get initial monitor information
; Map the monitor in
SNARF: MOVE [400,,220←5]
GETHI
JRST 4,.-1
; Snarf up some monitor symbols
MOVEI [.RSQZ 0,TCONLN ? 0]
.SYML
JRST 4,.-1
ADDI 1
MOVEM FRSPTY
IRPS SYM,,PUPLDB PUPLSK PUPFSK PUPHST PUPMLK
MOVEI [.RSQZ 0,SYM ? 0]
.SYML
JRST 4,.-1
MOVEM SYM
TERMIN
OPEN [0 ? 'IMP,, ? 0] ; need an IMP DDB to get a dump
JRST 4,.-1
MOVEI 5 ; magic dump of addresses
MTAPE
RELEAS
IRPS SYM,,IMPDIE IMPDEA NMESIN NMESOU IMPTDN IMPTUP IMPDWY FFLNK LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB
IFE .IRPCN&1,HLRM 1+<.IRPCN/2>,SYM
.ELSE HRRM 1+<.IRPCN/2>,SYM
TERMIN
; Get symbols with low core pointers
MOVEI 211 ; PRJPRG
PEEK
MOVEM PRJPRG
MOVEI 225 ; JOBNAM
PEEK
MOVEM JOBNAM
MOVEI 270 ; PTYJOB
PEEK
SUB FRSPTY
MOVEM PTYJOB
MOVEI 220 ; TTYTAB
PEEK
MOVEM TTYTAB
SETO L,
GETLIN L
CAMN L,[-1]
EXIT ; punt if detached
; Fool around with the page printer
HRROI [015000,,HSIZE]
TTYSET
PPSEL 1
DPYPOS -452 ; near botton of screen
DPYSIZ 3002 ; 3 glitches, 2 lines/glitch
; (continued on next page)
;GETNET HDNODM IMPDDN
SUBTTL Initialize display, IMP going down
GETNET: SETZB @SCREEN
ADJSP @SCREEN
AOS
BLT @JOBREL
MOVSI X,440700
ADD X,SCREEN
SETZM LINCNT
TLNN L,(DMLIN)
JRST HDNODM
MOVEI 177
IDPB X
MOVEI ↑W
IDPB X
HDNODM: MOVE A,IMPDWY
PEEK A,
JUMPE A,NOTIDI ; IMP isn't dying
JSP Y,TXTSTR
ASCIZ/ IMP going down at /
MOVE Y,IMPTDN
PEEK Y,
IDIVI Y,60.*60. ; minutes
IDIVI Y,60. ; Y←hours, Z←minutes
CAIL Y,24.
SUBI Y,24.
PUSH P,Z
IDIVI Y,10. ; ah, the joys of open coding!
MOVEI "0(Y)
IDPB X
MOVEI "0(Z)
IDPB X
MOVEI B,":
IDPB B,X
POP P,Y
IDIVI Y,10.
MOVEI "0(Y)
IDPB X
MOVEI "0(Z)
IDPB X
JSP Y,TXTSTR
ASCIZ/ until /
MOVE Y,IMPTUP
PEEK Y,
IDIVI Y,60.*60. ; minutes
IDIVI Y,60. ; Y←hours, Z←minutes
CAIL Y,24.
SUBI Y,24.
PUSH P,Z
IDIVI Y,10.
MOVEI "0(Y)
IDPB X
MOVEI "0(Z)
IDPB X
IDPB B,X
POP P,Y
IDIVI Y,10.
MOVEI "0(Y)
IDPB X
MOVEI "0(Z)
IDPB X
JSP Y,TXTSTR
ASCIZ/ for /
JUMPE A,[ JSP Y,TXTSTR
ASCIZ/panic restart/
JRST IMPDDN]
SOJE A,[JSP Y,TXTSTR
ASCIZ/scheduled hardware PM/
JRST IMPDDN]
SOJE A,[JSP Y,TXTSTR
ASCIZ/scheduled software reload/
JRST IMPDDN]
JSP Y,TXTSTR
ASCIZ/emergency restart/
IMPDDN: PUSHJ P,TERPRI
MOVEI <" >
IDPB X
PUSHJ P,TERPRI
; (continued on next page)
;NOTIDI NOTID1 NOTID2
; Header and link stuff: Index, host, foreign socket
NOTIDI: MOVE IMPDIE
PEEK
JUMPE NOTID1
JSP Y,TXTSTR
ASCIZ/ NCP locked out!/
PUSHJ P,TERPRI
NOTID1: MOVE IMPDEAD
PEEK
JUMPE NOTID2
JSP Y,TXTSTR
ASCIZ/ NCP dead!/
PUSHJ P,TERPRI
NOTID2: MOVE FFLNK
PEEK
JUMPN NOTID3
JSP Y,TXTSTR
ASCIZ/ Nobody is using the IMP!/
PUSHJ P,TERPRI
JRST PUPSTA
;NOTID3 NXTLNK HSTSRH
NOTID3: MOVEI I,1
JSP Y,TXTSTR
ASCIZ/Ix Host Link Foreign skt Lskt BS Stat Jb Usr Subsys Wait Allocs/
PUSHJ P,TERPRI
NXTLNK: MOVEI Y,-1(I)
MOVEI N,2
PUSHJ P,OCTOUT ; table index
MOVEI <" >
IDPB X
MOVE LNKTAB
ADDI -1(I)
PEEK
LDB [103000,,]
JUMPE [ JSP Y,TXTSTR ; listening, sorry!
ASCIZ/ /
JRST FORSKT]
MOVE A,HSTADR
MOVE A,7(A) ; NUMPTR
ADD A,HSTADR ; address of NUMBERS table
MOVE B,(A) ; get # of entries
MOVE C,1(A) ; and entry size
ADDI A,2 ; point at first entry
HSTSRH: MOVE Y,(A)
CAILE Y,377 ; old or new style?
JRST [ LDB Z,[001000,,Y] ; new style, get host number
LSH Y,-9. ; put IMP number in IMP format place
DPB Z,[201000,,Y]
JRST HSTSR0]
LDB Z,[060300,,Y] ; old style, get host number
ANDI Y,77
DPB Z,[200200,,Y] ; store host number in IMP format
; JRST HSTSR0
;HSTSR0 HSTOUT DOLINK DOLNKX FORSKT
HSTSR0: CAME Y ; found host?
JRST [ ADDI A,(C) ; point at next entry
SOJG B,HSTSRH
MOVE Y,LNKTAB
ADDI Y,-1(I)
PEEK Y,
LDB Y,[301000,,Y] ; get host number
MOVEI N,1. ; needs to be changed if more than 9 hosts
PUSHJ P,DECOUT ; on an IMP ever happens
MOVEI <"/>
IDPB X
MOVE Y,LNKTAB
ADDI Y,-1(I)
PEEK Y,
LDB Y,[102000,,Y] ; get IMP number
MOVEI N,2. ; this needs to be changed if more than
PUSHJ P,DECOUT ; 99 IMPs ever happens
JSP Y,TXTSTR
ASCIZ/ /
SETZ Z,
JRST DOLNKX]
HRRZ Y,1(A) ; NUMNAM
ADD Y,HSTADR
MOVEI Z,14. ; assume all hosts stop at 14 characters
TLOA Y,440700
HSTOUT: IDPB X
ILDB Y
JUMPE DOLINK
SOJA Z,HSTOUT
DOLINK: MOVEI <" >
DOLNKX: IDPB X
SOJGE Z,DOLINK ; fill out with spaces as necessary
MOVE Y,LNKTAB
ADDI Y,-1(I)
PEEK Y,
LDB Y,[001000,,Y]
MOVEI N,3
PUSHJ P,OCTOUT ; link number
MOVEI <" >
IDPB X
FORSKT: MOVE Y,IMPFS ; foreign socket number
ADDI Y,-1(I)
PEEK Y,
CAMN Y,[-1]
JRST [ JSP Y,TXTSTR
ASCIZ/ listening/
JRST DPYLS]
MOVEI N,11.
PUSHJ P,OCTOUT
; (continued on next page)
;DPYLS NOTCLS
; Local socket, byte size, state
DPYLS: MOVEI <" >
IDPB X
MOVE Y,IMPLS ; local socket number
ADDI Y,-1(I)
PEEK Y,
MOVEI N,4
PUSHJ P,OCTOUT
MOVEI <" >
IDPB X
MOVE Y,IMPBS ; byte size
ADDI Y,-1(I)
PEEK Y,
MOVEI N,2
PUSHJ P,DECOUT
MOVE IMPSTB
ADDI -1(I)
PEEK
TLNN (CLSS\CLSR)
JRST NOTCLS
TLNN (CLSS)
JRST [ JSP Y,TXTSTR
ASCIZ/ CLSR/
JRST STADUN]
TLNN (CLSR)
JRST [ JSP Y,TXTSTR
ASCIZ/ CLSS/
JRST STADUN]
JSP Y,TXTSTR
ASCIZ/ CLSD/
JRST STADUN
NOTCLS: TLNN (RFCS\RFCR)
JRST [ JSP Y,TXTSTR
ASCIZ/ LISN/
JRST STADUN]
TLNN (RFCS)
JRST [ JSP Y,TXTSTR
ASCIZ/ RFCR/
JRST STADUN]
TLNN (RFCR)
JRST [ JSP Y,TXTSTR
ASCIZ/ RFCS/
JRST STADUN]
JSP Y,TXTSTR
ASCIZ/ OPEN/
; JRST STADUN
;STADUN
; Start of DDB stuff
STADUN: MOVE DDB,LNKDDB
ADDI DDB,-1(I)
PEEK DDB,
JUMPE DDB,NODDB ; no DDB for this guy
MOVEI <" >
IDPB X
MOVEI J,347 ; PJOBN
PEEK J,
XOR J,[DDB,,620000]
LDB J,J
PUSHJ P,JOBOUT
MOVEI <" >
IDPB X
MOVE Y,400000-220000+DEVIOS(DDB)
TLNE Y,(INPW)
MOVEI "I
IDPB X
MOVEI <" >
TLNE Y,(LNK0W)
MOVEI "C
IDPB X
MOVEI <" >
TLNE Y,(BLOKW)
MOVEI "R
IDPB X
MOVEI <" >
TLNE Y,(ALLW)
MOVEI "A
IDPB X
MOVEI <" >
IDPB X
; (continued on next page)
;NODDB
; Allocations
MOVE IMPLS
ADDI -1(I)
PEEK
TRNN 1 ; send or receive?
JRST [ MOVE Y,400000-220000+HMA(DDB); receive; foreign message allocation
PUSHJ P,DECOUT
MOVEI "/
IDPB X
MOVE Y,400000-220000+HBA(DDB)
PUSHJ P,DECOUT
MOVE Y,400000-220000+MIIL(DDB); messages in input list
JUMPE Y,NODDB
MOVEI <" >
IDPB X
MOVEI "[
IDPB X
PUSHJ P,DECOUT
MOVEI "/
IDPB X
MOVE Y,400000-220000+BIIL(DDB); bits in input list
PUSHJ P,DECOUT
MOVEI "]
IDPB X
JRST NODDB]
MOVE Y,400000-220000+MAL(DDB) ; send socket; message allocation
PUSHJ P,DECOUT ; note N=-1 from last DECOUT call
MOVEI "/
IDPB X
MOVE Y,400000-220000+BAL(DDB) ; bit allocation
PUSHJ P,DECOUT
MOVEI <" >
IDPB X
NODDB: PUSHJ P,TERPRI
MOVE FFLNK
PEEK
CAMGE I,
AOJA I,NXTLNK
; (continued on next page)
;PUPSTA PUPLUK HAVPUP
SUBTTL Pup output
MOVEI <" > ; prevent crudding up screen
IDPB X
PUPSTA: MOVEI I,1 ; look for any Pup links
PUPLUK: MOVE DDB,PUPLDB ; any link here?
ADDI DDB,-1(I)
PEEK DDB,
JUMPN DDB,HAVPUP
CAME I,PUPMLK ; at last link?
AOJA I,PUPLUK ; no, try next
PUSHJ P,TERPRI
JSP Y,TXTSTR
ASCIZ/ Nobody is using the Ethernet!/
PUSHJ P,TERPRI
JRST PTYMAP
HAVPUP: PUSHJ P,TERPRI
JSP Y,TXTSTR
ASCIZ/Ix Jb Usr Subsys SendID ReceiveID State Local Skt Foreign Port/
PUSHJ P,TERPRI
JRST ENLTYO
;NENLNK ENLTYO
NENLNK: MOVE DDB,PUPLDB ; any link here?
ADDI DDB,-1(I)
PEEK DDB,
JUMPE DDB,NXTENL ; no link if no DDB
ENLTYO: MOVEI Y,-1(I) ; table index
MOVEI N,2
PUSHJ P,OCTOUT
MOVEI <" >
IDPB X
MOVEI J,347 ; PJOBN
PEEK J,
XOR J,[DDB,,620000]
LDB J,J
PUSHJ P,JOBOUT
MOVE Y,400000-220000+PUPSID(DDB)
MOVEI N,12.
PUSHJ P,OCTOUT
MOVE Y,400000-220000+PUPRID(DDB)
MOVEI N,12.
PUSHJ P,OCTOUT
MOVEI <" >
IDPB X
MOVE Y,400000-220000+DEVIOS(DDB)
MOVEI <" >
TLNE Y,(IO$INT)
MOVEI "I
IDPB X
MOVEI <" >
TLNE Y,(IO$RFC)
MOVEI "R
IDPB X
MOVEI <" >
TLNE Y,(IO$END)
MOVEI "E
IDPB X
MOVEI <" >
TLNE Y,(IO$ACK)
MOVEI "A
IDPB X
MOVEI <" >
TLNE Y,(IO$SBB)
MOVEI "W
IDPB X
MOVEI <" >
TRNE Y,IO.BKT
MOVEI "M
IDPB X
; (continued on next page)
;LSNHST NXTENL
MOVE Y,PUPLSK ; local socket
ADDI Y,-1(I)
PEEK Y,
MOVEI N,10. ; can be up to 9 digits
PUSHJ P,OCTOUT
MOVEI <" >
IDPB X
MOVE Y,PUPHST ; output host number
ADDI Y,-1(I)
PEEK Y,
JUMPL Y,[JSP Y,TXTSTR
ASCIZ/listening/
JRST LSNHST]
IDIVI Y,400 ; get network number
PUSH P,Z
SETZ N,
PUSHJ P,OCTOUT
MOVEI "#
IDPB X
POP P,Y
PUSHJ P,OCTOUT
MOVEI "#
IDPB X
MOVE Y,PUPFSK ; foreign socket
ADDI Y,-1(I)
PEEK Y,
PUSHJ P,OCTOUT
LSNHST: PUSHJ P,TERPRI
NXTENL: CAME I,PUPMLK ; try next link
AOJA I,NENLNK
; JRST PTYMAP
;PTYMAP PTYCHK PTYLUP PTYFND
SUBTTL PTY map
PTYMAP: MOVEI T,221
PEEK T,
LDB T,[001100,,T] ; number of PTY's
HRLOI T,-1(T)
EQV T,FRSPTY ; first PTY
PTYCHK: MOVE J,PTYJOB
ADDI J,(T)
PEEK J,
JUMPE J,[AOBJN T,PTYCHK
JRST MSGEND]
MOVEI <" >
IDPB X
PUSHJ P,TERPRI
JSP Y,TXTSTR
ASCIZ/PTY CJ Usr Subsys SJ Usr Subsys Location/
PUSHJ P,TERPRI
JRST PTYFND
PTYLUP: MOVE J,PTYJOB
ADDI J,(T)
PEEK J,
JUMPE J,NXTPTY
PTYFND: MOVEI N,3
PUSH P,J
MOVEI Y,(T)
PUSHJ P,OCTOUT
MOVEI <" >
IDPB X
PUSHJ P,JOBOUT
MOVE J,TTYTAB
ADDI J,(T)
PEEK J,
MOVEI 347 ; PJOBN
PEEK
ADD J,
PEEK J, ; TTY DDB's may be in upper 128K
MOVEI 347 ; PJOBN
PEEK
HRRI J
LDB J,
JUMPE J,[ JSP Y,TXTSTR
ASCIZ/ /
JRST GETLOC]
MOVEI <" >
IDPB X
PUSHJ P,JOBOUT
MOVEI <" >
IDPB X
; JRST GETLOC
;GETLOC NTELSR NXTPTY MSGEND CLREOF
GETLOC: POP P,A ; try for TELSER's 137 convention
HRROI B,137
MOVEI C,B
MOVEI A
JOBRD
JRST NTELSR
JUMPE B,NTELSR
TLNE B,-1
JRST NTELSR
HRLI B,-13
MOVEI C,HDABLK
JOBRD
JRST NTELSR
MOVE HDABLK
CAME ['TERMID]
JRST NTELSR
SKIPA Y,[440700,,HDABLK+1]
IDPB X
ILDB Y
JUMPN .-2
NTELSR: PUSHJ P,TERPRI
NXTPTY: AOBJN T,PTYLUP
MSGEND: MOVEI <" >
IDPB X
PUSHJ P,TERPRI
JSP Y,TXTSTR
ASCIZ/IMP CONI=/
EIOTM
CONI IMP,Y
JRST 2,@[.+1] ; better than LIOTM
MOVEI N,6
PUSHJ P,OCTOUT
JSP Y,TXTSTR
ASCIZ/, input messages=/
MOVE Y,NMESIN
PEEK Y,
PUSHJ P,DECOUT
JSP Y,TXTSTR
ASCIZ/, output messages=/
MOVE Y,NMESOU
PEEK Y,
PUSHJ P,DECOUT
PUSHJ P,TERPRI
MOVE Z,HSIZE
TLNE L,(DDDLIN\DMLIN)
CLREOF: CAMG Z,LINCNT
JRST NODDDM ; III or printing
MOVEI <" >
IDPB X
PUSHJ P,TERPRI
SOJA Z,CLREOF
; JRST NODDDM
;NODDDM DOIII DODM
SUBTTL Display it!
NODDDM: TLNN X,700000 ; if at word boundry
ADDI X,1
SETZM 1(X) ; HALT to stop program
MOVEI X,(X)
MOVEI 2(X)
SUBI @DPHEAD
MOVEM DPHEAD+1 ; save display program length
AOS (X)
CAME X,SCREEN
SOJA X,.-2
; Now output the accumulated text
TLNN L,(DDDLIN\IIILIN\DMLIN)
JRST [ OUTSTR @SCREEN
OUTSTR [ASCIZ/
/]
JRST DELAY]
JUMPL L,DOIII
TLNE L,(DMLIN)
JRST [ SETZM @DPHEAD
MOVE X,[.BYTE 7 ? 177 ? ↑L ? 140 ? 142]; cursor at third line
JRST DODM]
MOVE TXTOUT
MOVEM @DPHEAD
SKIPA X,COLPOS
DOIII: MOVE X,[.BYTE 11.,11.,3,3,2,2,4 ? -777 ? 640 ? 2 ? 2 ? 1 ? 2 ? 6]
DODM: MOVEM X,@DPHEAD+3
UPGIOT 1,DPHEAD ; display the text
; JRST DELAY
;DELAY NODLAY DELAY1
; Done, wait a while and go again
DELAY: SKIPE DELAYP
JRST NODLAY
MOVEI 20.
TLNE L,(DDDLIN\IIILIN)
MOVEI 1
TLNE L,(DMLIN)
MOVEI 5.
SLEEP
NODLAY: SNEAKS
JRST GETNET
ANDI 177
CAIN 175
JRST [INCHRW ? SETCMM DELAYP ? JRST GETNET] ; ALT toggles the delay flag
CAIN <" >
JRST [INCHRW ? INCHRW ? JRST GETNET] ; space holds us
CAIE ↑M
JRST DELAY1
INCHRW ; only eat CRLF's
INCHRW
DELAY1: HRROI [004000,,400\"N]
TTYSET
EXIT
;TERPRI DECOUT OCTOUT NUMOUT NUMOU1 NUMOU2 NUMOU3
SUBTTL Random stuff
TERPRI: JSP Y,TXTSTR
ASCIZ/
/
AOS LINCNT
TLNN L,(DMLIN)
POPJ P,
MOVEI 177
IDPB X
MOVEI ↑W
IDPB X
POPJ P,
; Octal/decimal output of Y. If N > 0, pad with spaces so it fits in N digits
DECOUT: SKIPA Z,[10.]
OCTOUT: MOVEI Z,8.
HRRM Z,NUMOUT ; I don't want to fry another AC
NUMOUT: IDIVI Y,
ADDI Z,"0
PUSH P,Z
SOJLE N,NUMOU1
JUMPN Y,NUMOU2
MOVEI Z,<" >
IDPB Z,X
SOJG N,.-1
JRST NUMOU3
NUMOU1: SKIPE Y
NUMOU2: PUSHJ P,NUMOUT
NUMOU3: POP P,Y
IDPB Y,X
POPJ P,
;JOBOUT SIXOUT SIXOU1 TXTSTR ...LIT
; Job number/PPN/name output
JOBOUT: MOVEI N,2
MOVEI Y,(J)
PUSHJ P,DECOUT
MOVEI <" >
IDPB X
MOVE Y,PRJPRG
ADDI Y,(J)
PEEK Y,
HRLZS Y
MOVEI N,3
PUSHJ P,SIXOU1
MOVEI <" >
IDPB X
MOVE Y,JOBNAM
ADDI Y,(J)
PEEK Y,
; JRST SIXOUT
; Sixbit output routine
SIXOUT: MOVEI N,6
SIXOU1: SETZ Z,
ROTC Y,6
ADDI Z,"A-'A
IDPB Z,X
SOJG N,SIXOUT+1
POPJ P,
; Output text string, called with JSP
TXTSTR: HRLI Y,440700
ILDB Y
JUMPE 1(Y)
IDPB X
JRST TXTSTR+1
...LIT: CONSTA
END IMPSTAT