; -*-MIDAS-*- .SYMTAB 4001.,4500. TITLE PEEK ; Tasteful ITS system status display ; ************************************************** ; ******** WARNING! The squeamish and those ******** ; ******** who are prone to heart attacks ******** ; ******** read beyond this point at their ******** ; ******** own risk. ******** ; ************************************************** IFNDEF GUNCTL,GUNCTL==1 ;1 means users who do not have directories ; may not gun or detach anyone but themselves. IFNDEF CRAWLP,CRAWLP==1 ; 1 - Use CRAWL, FLY, etc; else just RUN IFNDEF 340P,340P==0 ; 1 to still include obsolete 340 code IFNDEF MUDP,MUDP==0 ; 1 to include kludge for MUDDLE that might ; randomly PCLSR any job. Set this to 1 and your ; name is mud. -Alan F=0 A=1 B=2 C=3 D=4 U=5 ;USER INDEX (MOSTLY) T=6 ;SUPER TEMPORARY X=7 U1=10 ; Ux's used at UUOH level U2=11 U3=12 OBUFP=13 ; Output buf byte pointer ODEV=14 ; Output Dev type - 0 THROUGH %OMMAX-1 I1=15 ; Ix's used only at TSINT level I2=16 P=17 IF1 .INSRT SYSTEM;FSDEFS > IFN MUDP,[ ; Muddle definitions UUOLOC==41 PVEC54==1367 ;This is the address of something or other in Muddle PVEC55==1567 ;So is this, for Muddle 55 ] ;DEFINITIONS OF OFFSETS INTO JOB DEVICES %JOBDV==77 %JDEV==100 %JFN1==101 %JFN2==102 %JSNM==103 %JACC==104 %JMODE==105 %JCUNM==106 %JCJNM==107 %JFLEN==110 %JBTSZ==111 ;BYTE SIZE PURPGB==:3 ; PEEK pure code starts at user page 3 SYSHGH==:200 ; # of system pages to map in, starting at abs page 0 (128K) ;SYSA==1 ; ITS ac "A" - this isn't used though. ;SYSP==15 ; ITS ac "P" - ditto, what were these for anyway... SYSSYM==774000-2 ; Location of ITS symbol table, from Exec DDT. DEFINE SYSCAL A,B .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN CALL==: RET==: CALRET==:JRST ;USER UUO'S (MUST RUN FROM PUOMIN TO 37) ALIGN=37000,, ;SPACE TO COLUMN E BUT OUTPUT AT LEAST AC SPACES 6TYPE=36000,, ;OUTPUT C(E) AS SIXBIT XTYPE=35000,, ;OUTPUT IN SIXBIT THE BLOCK STARTING AT E UNTIL AN "!" IS ENCOUNTERED SQPR=34000,, ;OUTPUT C(E) AS SQUOZE SYM CTYPE=33000,, ;OUTPUT CHARACTER WHOSE ASCII VALUE IS E 6XTYPE=32000,, ;OUTPUT C(E) AS SIXBIT BUT STOP ON A SPACE VALRET=31000,, ;DOES .VALUE, SEE UVALRET ONUM=30000,, ;OCTAL PRINT C(E) IN A FIELD AT LEAST AC COLUMNS WIDE DNUM=27000,, ;DECIMAL " ATYPE=26000,, ;OUTPUT BLOCK OF ASCII STARTING AT E, STOPPING ON A ZERO SONUM=25000,, ;SIGNED OCTAL PRINT AS IN ONUM DWRD=24000,, ;ADD C(E) TO IMAGE MODE DISPLAY LIST (SEE UDWRD, HIST) DPCT=23000,, ;ALWAYS PRINT DECIMAL (FOR %'S) PUOMIN=23 ;SYMBOLIC IO CHANNELS TYOC==1 TYIC==2 DISC==3 DISWC==4 ;IMAGE MODE LPTC==5 DIRC==6 IFN MUDP, JOBI==7 IMXC==10 USRI==11 ; For inferior to map crash dumps into USRO==12 NTYO==14 IFNDEF OBUFL,OBUFL==40 ;SIZE OF OUTPUT BUF IFNDEF PDLL,PDLL==100 ;LENGTH OF PDL. DEFINE TYPE &STR& ATYPE [ASCIZ STR] TERMIN DEFINE CONC A,B A!B!TERMIN DEFINE DBP X ;DECREMENT BYTE POINTER ADD X,[060000,,0] .SEE RUBOUT ;THIS IS VERY SPECIALIZED TO SIXBIT INPUT ROUTINE JUMPGE X,.+3 SOS X HRLI X,010600 TERMIN DEFINE MM,B MOVE A,[SIXBIT B] TERMIN DEFINE INFORM A,B IF1,[PRINTX \A = B \]TERMIN DEFINE TOUT AC IDPB AC,OBUFP ;DEPOSIT CHARACTER CAMN OBUFP,[010700,,OBUF+OBUFL-1] ;SKIP IF BUF NOT FULL PUSHJ P,OBLOCK ;OUTPUT FULL BUF TERMIN ; Output device definitions - ODEV holds one of these values %ODTTY==:0 ; Output to plain printing TTY (default) %ODDPT==:1 ; Datapoint-type display %OD340==:2 ; DEC 340 display (obsolete, alas) %ODLPT==:3 ; Output to "LPT" (disk file) %ODWID==:4 ; Wide display terminal %ODWIT==:5 ; Wide printing terminal %ODMAX==:6 ; # of output device types DEFINE ODEVER X IFN .-%ODMAX-X,.ERR TABLE X INDEXED BY ODEV HAS WRONG LENGTH. TERMIN SUBTTL Purification macros copied from MC:KSC;IVORY > comment | Definitions for purifying and relocating variables into impure low core. BVAR and EVAR should bracket each group of variables, which by definition are impure. LVAR may be used for single-line variable definitions. PURPGB specifies PAGE NUMBER beginning pure code; VARBEG specifies ADDRESS beginning variable (impure) code. VARCHK is a macro which should be called at the end of the program to ensure that pure and impure storage areas do not overlap, and to put MIDAS variables (foo', .scalar foo, etc) in the impure area. It may be called more than at various places throughout the program, and each time will define PURPGE to be the first page unused by pure core. TMPLOC ,{text} will assemble specified text at and restore the loc counter automatically. To purify, use something like: MOVE A,[,,purpgb] .CALL [SETZ ? 'CORBLK ? 1000,,%CBNDR 1000,,%JSELF ? A ? SETZI %JSELF] | ifndef purpgb, purpgb==1 ; 1st pure page normally 1; single impure at 0. ifndef varbeg, varbeg==100 ; Variables normally start at location 100 ; Initialize internal syms for B/EVAR %%pbeg==2000*purpgb ; Loc of 1st pure wd %%pend==%%pbeg ; Used to remember pure loc while assembling variables. %%vend==varbeg ; Current first unused loc for vars %%vflg==0 ; 1 when assembling into var area, 0 otherwise. loc %%pbeg ; Start assembling into pure! define bvar ifn %%vflg,.err BVAR inside BVAR! .m"%%vflg==1 .m"%%pend==. loc %%vend termin define evar ife %%vflg,.err EVAR without BVAR! .m"%%vflg==0 .m"%%vend==. loc %%pend termin define lvar -line bvar line evar termin ifndef tmploc,{ define tmploc val,?arg %%%tlc==. loc val arg loc %%%tlc termin } define errmac a,b,c,d,e,f .err a!b!c!d!e!f termin define varchk lvar variables ; Do this first; LVAR will set %%PEND properly .m"purpge==<%%pend+1777>/2000 ifg varbeg-%%pbeg,{ifl .-varbeg,{ errmac [Pure overflow! ]\<.-varbeg>,[ words needed, increase VARBEG to ]\.,[?] } } ifle varbeg-%%pbeg,{ifl %%pbeg-%%vend,{ errmac [Impure overflow! ]\<%%vend-%%pbeg>,[ words needed, increase PURPGB to ]\<<1777+%%vend>/2000>,[?] } } termin SUBTTL Impure code and variables TMPLOC 41,{ JSR UUOH ;TRANSFER TO USER UUO ROUTINE JSR TSINT ;TRANSFER TO INTERRUPT ROUTINE } BVAR ; Start of impure code! UUOH: 0 ;UUO HANDLER LDB U1,[331100,,40] ;PICK UP OP CODE FROM 40 CAIGE U1,PUOMIN ;SKIP IF LEGAL .VALUE ;ILLEGAL HRRZ U2,40 ;GET EFFECTIVE ADDRESS OF UUO JRST @UUOTAB-PUOMIN(U1) ;DISPATCH TO UUO ROUTINE TSINT: 0 0 JRST INTPUR ; Jump to pure code TTYOP: 0 ;HOLDS TTYOPT WORD OF TTY, USED TO DISTINGUISH ARDS-LIKE ;DISPLAYS FROM GOOD ONES. SPNDD: 0 ;JUSTIFICATION FLAG: -1=>JUSTIFICATION COMPLETED, OTHERWISE COUNT OF SPACES NEEDED TMPTCL: 0 ;INITIAL COLUMN NUMBER OF FIELD NAMEHK: 0 NAMESW: 0 ONAMSW: 0 LNAMES: 0 NAMEBP: 0 NAMCOM: 0 USRMEM: 0 USRTIM: 0 USRJTM: 0 MMUSFL: 0 .SEE HL4A NEGF: 0 ;-1=> SIGNED OUTPUT, 0=> UNSIGNED NEGF2: 0 ;-1=>PRINT MINUS SIGN, 0=> DON'T UNUMQ: 0 CRASHF: 0 ; 0 if PEEKing at a running ITS (normal state) ; else spec for PEEKing at a crash dump. MODE: %MDNRM ; Current Mode - type of info to display (index into MDTAB) RUUFLG: 0 ; Current Argument flag, -1 if arg furnished to mode RUUIND: 0 ; Current Argument (always -1 if RUUFLG is 0) LMODE: 0 ; Last MODE LRUUFL: 0 ; Last RUUFLG LRUUIN: 0 ; Last RUUIND UUIND: 0 ; New RUUIND being collected at typein int level CRSFIL: BLOCK 4 ; Holds filename of crash dump being examined, if any SPCCNT: 0 ;NUMBER OF TYPED-AHEAD SPACES (NOT FOLLOWED BY ANYTHING ELSE). TOPFLG: 0 ;-1 MEANS SECOND TWO LINES HAVE BEEN PRINTED MORFLG: 0 VSZ: 0 JHFLAG: 0 ; -1 if in J mode (single job display) DSKZER: 0 ;ABORT ON CONTROL-@ DSKCON: -1 ;HANG ON OUTPUT CHANNELS IN C MODE HSTEXP: -1 ;EXPAND HOST NAMES HLPFLG: 0 ;-1 if each command should display help HSZ: 55. ORADIX: 10. ERRDVF: 0 CONST: 4,,4 CONST2: -2,,A MUDFLG: 0 CURUNM: 0 GUNFLG: 0 RNDFLG: 0 RONLY: 0 ;-1 FOR R MODE/ +1 FOR 0J MODE HACK EONLY: -1 ;-1 NORMALLY / SQUOZE SYMBOL NAME ELSE EINST: 0 ;INSTRUCTION FOR E MODE EWORD: 0 ;WORD SO FAR FOR E MODE ESW: 0 SQUOZR: 0 SHRTOT: 0 VPOS: 0 FTCTYP: 0 V2: 0 V3: 0 V4: 0 GNORDT: 0 ;GUN OR DETACH LPCHPT: -1 TTOWNR: -1 ;IN ULOOK, -1 IFF OWNERSHIP OF TREE'S TTY PASSES DOWN THROUGH THIS JOB. ;IGNORES THE QUESTION OF WHETHER TREE HAS A TTY. DDXFIL: .BAI,,(SIXBIT /.../) SIXBIT /.FILE./ SIXBIT /(DIR)/ IFN 340P,[ DISF: SIXBIT / DIS.PEEK.>/ LPBLK: BLOCK 6 ; Args to .LTPEN UUO DISNOT: 0 ;IF ZERO, TRY TO USE 340 ;IF NON ZERO, DON'T ] ;340P ; Network Metering (For "+" mode) ; (Note: Each meter also needs to be mentioned at NXTAB.) ; Each entry in the meter table contains: MT$LOC==0 ; Instruction to get the meter value. MT$OLD==1 ; Previous value of the meter. MT$TIM==2 ; Time when the meter was last updated. MT$DSC==3 ; Pointer to description for the meter. MT$NAM==4 ; 6bit name of meter variable MT$L==5 DEFINE METER NAME,&DESC MOVE A,@!NAME 0 0 [ASCIZ DESC] SIXBIT "NAME" TERMIN MTRTAB: METER IMCT1, /IMP: Output starts from MP/ METER IMCT2, /IMP: Input done interrupts/ METER IMCT3, /IMP: Output Done interrupts/ METER IMNBLK, /IMP: msgs blocked for RFNM wait/ IFN 0, METER IMPNIH, /Times input held up/ METER IMNIPI, /IP: Datagrams rcvd/ METER IMNIPO, /IP: Datagrams sent/ METER CHNIPI, /IP: Datagrams in from Chaosnet/ METER CHNIPO, /IP: Fragments out to Chaosnet/ METER IMNIPR, /IP: RFNMs received/ METER IMNIPF, /IP: Datagrams flushed/ METER IMNIP7, /IP: Dest Host Dead msgs rcvd/ METER IMNIP8, /IP: Error msgs rcvd/ METER IMNIP9, /IP: Incomplete Xmsn msgs rcvd/ IFN 0, METER IMNWIG, /Words ignored by Ignore state/ METER CHNPI, /CHAOS: Packets input (really to 10)/ METER CHNPO, /CHAOS: Packets output (all causes)/ METER CHNPF, /CHAOS: Packets forwarded/ METER CHNSTS, /CHAOS: STS packets output/ METER CHNSNS, /CHAOS: SNS packets output/ METER CHNRTR, /CHAOS: Retransmitted packets output/ METER CHNPFL, /CHAOS: Packets discarded (fwd loop)/ METER CHNPD, /CHAOS: Packets discarded (duplicates)/ METER CHNABT, /CHAOS: Transmit aborts/ METER CHNCRC, /CHAOS: CRC errors before reading/ METER CHNCR2, /CHAOS: CRC errors after reading/ METER CHNWLE, /CHAOS: Bit length not 0 mod 16/ METER CHNPLE, /CHAOS: Length disagrees with header/ METER CHNLOS, /CHAOS: Lost due to receiver busy/ METER CHNSPZ, /CHAOS: Times bit counter spazzed/ NMTRS==<.-MTRTAB>/MT$L LINEPOS: 0 ;CHARACTER COUNT ON LINE PAGEPOS: 0 ;LINE COUNT ON PAGE NVLNS: 0 ;# VERT LINES IN TTY DISPLAY MODE NHLNS: 0 ;# HORZ CHAR POS " " " " ;MAX NUM OF LINES ON PAGE FOR EACH DEV MPAGEP: ,,-1 ;TTY ;=2**18-1 . ;GE 41. ; 340 DISPLAY ,,-1 ;LPT ;=2**18-1 . ;WIDE DISPLAY ,,-1 ;WIDE TTY ODEVER MPAGEP DOZE: 20. NSNAM: 0 XCHFLG: 0 TDATIM: SIXBIT * / / : : !* NMMPGS: 0 ; # MMP PGS SET FOR NMMPES: 0 ; # words in MMP (NMMPGS*2000) UCPLC: 0 ;COUNT IN UCPRL UCPLOS: 0 ; UCPRL lossage count while tracing circ mem pntrs UDISP: -1 ;-1 => SHOW ALL TREES IN ULOOK. ELSE IT IS EITHER IDX OF TREE TO SHOW ;(IF GUNFLG SET) OR XUNAME/UNAME OF TREES TO SHOW (OTHERWISE). NETQF: 0 SCHHT1: 0 OVHTIM: -1 ;GE 0 IS TIME OVERHEAD METERS WERE COPIED INTO RHIST HSTSIN: -1 ;GE 0 IF HOSTS3 FILE MAPPED IN PAT: PATCH: BLOCK 16 ;PATCH SPACE JCLBUF: BLOCK 20. ;SPACE FOR COMMAND STRING FROM SUPERIOR. JCLBFE: JCLBP: 0 ;BYTE POINTER FOR READING THAT STRING. PDL: BLOCK PDLL ;PUSH DOWN LIST OBUF: BLOCK OBUFL ;OUTPUT BUFFER LUIDTB==:200 ; Max # of jobs PEEK can hack, must be greater than ITS MAXJ! UIDTAB: BLOCK LUIDTB ; Holds user indices (U values) for jobs ULOOK finds. UIDCNT: 0 ; # of entries SUBTTL System symbol value tables ITSNAM: 0 ; Holds ITS machine name PEEK initialized for (sixbit) ITSVER: 0 ; Holds ITS version number, ditto (sixbit) SYMPTR: 0 ; If doing autopsy, holds aobjn ptr to copied ITS sym table DEFINE SYMS LIST 0 ; Will hold AOBJN to table %%%SB==. IRPS FOOBAR,,[LIST] FOOBAR: 0 SQUOZE 0,FOOBAR TERMIN %%%SE==. LOC %%%SB-1 -<%%%SE-%%%SB>/2,,%%%SB LOC %%%SE TERMIN ;FULL WORD FLWDT: JFCL SYMS [LUBLK:NCT:NUNITS:NUTIC:NUTOC:NQCHN:SSCHDB:TSYSM:MAXJ: NQS:NFSTTY:NSTTYS:MURUSR:TOBL:DIRCHN:LUIOP:PGIHTL:SWPHTL:LOVHTB: %IOTBK:%IOTOT:RCHQSK:TCPRCH: %QAEFR:%QAEFW:%QACTH:%QAFUL:%QADEL:%QAACC:%QAPAR:%QAWOV: %QMUDR:%QMMDR:%QMTTR:%QMUDW:%QMMDW:%QMTTW: NINDX:%CFOFF:%CFSTS:%CFCLS:%CFSTY:%SWOUT:%SWLOD:%SWSB:%SWBEM:%SWDSO: NIPGW:IPKSNA:IPKSNC:NSUBNT:MYCHAD: ITSVRS:TTYVRS:DSKVRS: SYSMLN: XBL:%NMTRS:NIPUQ:NIPF:NPKB: PK.FLG:PK.IP:PK.TCP:PK.L:%PKPIL:%PKODN:%PKNOF:%PKFLS:%PKRTR: ;PK.TIM: PK.HSP:PK.HST:%NTRCE:PKTTRC:] ;PK.TIM: ;No longer used: IMPSTL:IMNWIG: ;+SYSBEG NXTAB: ADDI A,SYSBEG SYMS [QDATE:TIMOFF:SHUTDN: SYSCN:AUSOPG:CUSER:DEVTAB:EDEVS:LOUTIM: MEMFR:MMPNP:MEMPNT:MTUSR:NCBCOM: NPGSWO:NULTIM:PSWOUS: QIRRCV:RNABLU:SILNG:SOLNG:SCHHB:SWPOPR: SWRCE:TIME:TRUMM:UMASTER:UREALT:USRHI:USRRCE:SYSDBG: PRVUSR:LOSRCE:IDLRCE:SLOADU: IMPUP:IMCT1:IMCT2:IMCT3: IMNIPI:IMNIPF:IMNIPO:IMNIPR:IMNIP7:IMNIP8:IMNIP9:IMNBLK: USER:BUGPC:SYSMPT:SYSMBF: CHNPI:CHNPO:CHNPF:CHNSTS:CHNSNS:CHNRTR:CHNPFL:CHNPD: CHNABT:CHNCRC:CHNCR2:CHNWLE:CHNPLE:CHNLOS:CHNSPZ: CHTTBF:CHFRBF:CHQRFC:CHQLSN:CHNIPI:CHNIPO: TCPUP:PKBNT:PKBNF:OVHTB2: PKEQHF:IPOUTQ:IPOBLQ:PKETBL:] ;No longer used: DISUSR:LPTUSR:NVDUSR:PDPUSR:PLTUSR:PTPUSR:PTRUSR:TABUSR: ; MSUSER:MSREAD:MSRED2:MSWRIT:MSWRT2:IMPBPQ: ; IMNOSH:IMNISH:IMPNPE:IMNSRF:IMNSRC:IMNRFN:IMPNIH: ;+SYSBEG(C) CXTAB: ADD A,[SYSBEG(C)] SYMS [AC0S:DCHSTB:IOCHST:IOCHNM:IOTTB:DRFNTB: DSKLST:UDSYSN:UUDPP: MEMBLT:MMMPG:MMSWP: PARERR: QUSR:QUDPR:QUDFPR:QSMPRP:QSMDN: QSBYTE:QMPBSZ:QDSKN:QFBLNO:QSCRW:QSRAC:STYSTS:OPRSXB:CALSXB:CLSTB: JBDEV:QSFT:QPKID: BUGACS: XBUSER:XBSTAT:XBSTAU:XBCLSU:XBPORT:XBHOST:XBINBS:XBINPS:XBORTL:XBORTC: XBRWND:XBSAVW:MTRCNT:MTRNAM: CHSUSR:CHSSTA:CHSNBF:CHSNOS:CHSFRN:CHSACK:CHSPKN:CHSWIN:CHSIBP:CHSOBP: IPGWTN:IPGWTG:IPGWTI:IPGWTM:SBNRUT: PGIHTB:SWPHTB:OVHTB1: IPUQHD:IPFDPE:XBITQH:XBORTQ:XBOCOS:] ;No longer used: DG2:DRTM:EUPOS:UDIR:UDIRO:UGOAL:ULCTM:UTASS:UTBFS: ; UTTNO:UTUSR:UMNTR:MPXBUF: ; IMSOC1:IMSOC2:IMSOC3:IMSOC4:IMSOC5:IMSOC6:IMSOC7:IMSOC8: ;+SYSBEG(U) USERT: ADD A,[SYSBEG(U)] SYMS [APRC:FLSINS:HUSRAD:IFPIR:IOTLSR:JNAME:JTMU:LUBTM:MSKST: MSKST2:NMPGS:NSWPGS:PICLR:PIRQC:RPCL:SUEXIT:SUPPRO:SUUOH: SV40:TTYTBL:UPGCP:TRNLST:TRNLS1:UNAME:TTSTSV:UPC:USIPRQ:USTP:XUNAME: USWSCD:USWPRI:USWST:USYSN1:USYSNM:UTMPTR:UTRNTM:LSCALL:QSNUD:QSNLCN: TRUNTM:UUAC:IDF1:IDF2:UWRKST:USVWRK:USWTIM:] ;+SYSBEG(T) TXTAB: ADD A,[SYSBEG(T)] SYMS [TOBEP:TOOP:TTYSTS:TTYCOM:TCTYP:TTYTYP:TCMXV:TCMXH:TTYOPT: TOIP:TOBBP:TTYST1:TTYST2:TTITM:IMPHTN:TRCTBL: RCHDRD:RCHDR1:RCHDR2:] ;value,,SYSBEG+MEMBLT(C) - note ITS symbol MUR is a byte-pointer LH. ; what PEEK is doing here is setting up MUR as a byte-pointer ; into the ITS MEMBLT mem mgt table (1 entry per physical page) MBTAB: PUSHJ P,[ HRLZ A,A ? ADD A,MEMBLT ? POPJ P,] SYMS [MUR:] MEMTB: REPEAT 40,CONC SIXBIT/CODE,\.RPCNT,/ ;SIXBIT NAMES INDEXED BY MUR CODE (POSSIBLY -340) RHIST: ;THIS STORAGE USED FOR MEM HISTOGRAM MODE AND FOR TRANSLATE TABLE MODE. LOC RHIST+500 RHISTL==<.-RHIST> EVAR ; End of impure code! MURTBS: DEFINE MURTYP SQZ,SXB SQUOZE 0,SQZ SIXBIT /SXB/ TERMIN MURTYP MUEX,EXEC MURTYP MUIOB,IOBUF MURTYP MUFR,FREE MURTYP MUINP,PROCES MURTYP MUMGB,MAGBUF MURTYP MUMMP,MMP MURTYP MUDISB,DISPLA MURTYP MUFRT,SFREE MURTYP MU23B,DSKBUF MURTYP MU23UD,DSKUDR MURTYP MU23MD,DSKMFD MURTYP MU23TT,DSKTUT MURTYP MU23LS,DIRCPY MURTYP MUHOLE,HOLE MURTYP MUDDT,EXDDT MURTYP MUNET,NETWRK MURTYP MUPKT,NETPKT MURTYP MUSWPG,SWAPG MURTYP MUCHA,CHAOS NMURTY==<.-MURTBS>/2 SUBTTL Memory management and map initialization ; PEEK memory allocation ; 0-HUSED PEEK code (some pages pure) ; UMAPG System randomly-mapped page ; DSKPG System Disk buffer (nC mode) ; - 1 empty page to fence DSKPG in ; PGFHST Network host table file ; PGFSYM Crash file symbol table ; - ; 200-377 Mapped into system PGFPUR==:PURPGB ; Another name for 1st PEEK pure code page IFNDEF PGFSYS,PGFSYS==:200 ; PEEK page # to start mapping system into. IFL 400-,.ERR PGFSYS or SYSHGH too big SYSBEG==:PGFSYS*2000 NHSTPG==90. ;Number of pages for host table NMMPPG==8 ;Maximum pages in MMP on any system NSYMPG==30 ;Maximum size of system symbol table ; Page pointer variables -<# pages>,,<1st page #> PGAPUR: -,,PGFPUR ; Start of pure code PGAUMP: -1,,UMAPG ; System randomly-mapped page PGADSK: -1,,DSKPG ; System disk buffer page (nC mode) PGAHST: -NHSTPG,,PGFHST ; Network host table file pages PGAMMP: -NMMPPG,,PGFHST+NHSTPG ; System MMP pages PGASYM: -NSYMPG,,PGFHST ; Crash file symbol table (overlays host table) PGASYS: -SYSHGH,,PGFSYS ; System absolute memory pages IF2, IFG PGFHST+NHSTPG+NMMPPG-PGFSYS, .ERR Core allocation overlaps REPURF: .VALUE [ASCIZ\:New system version; must repurify. Take paws off keys and wait.   p\] JRST PURIFY DEBUG: 0 ;-1 => Debugging, so dont purify or dump. ; PURIFY - Initialize as pure procedure PURIFY: MOVEI P,PDL-1 SKIPE DEBUG JRST PURIF2 MOVE A,PGAPUR ; Purify this section of core SYSCAL CORBLK,[MOVEI %CBNDR ? MOVEI %JSELF ? A ? MOVEI %JSELF] .LOSE 1000 PURIF2: CALL INISYS SKIPN DEBUG .VALUE [ASCIZ /:PDUMP DSK:SYS;TS PEEK GOG/] .VALUE [ASCIZ /: Ready  /] JRST GO ; INISYS - Initialize mapping into system, including all symbols. INISYS: MOVE A,PGASYS SKIPN B,CRASHF ; If not looking at crash-dump file, MOVEI B,%JSABS ; we map from running ITS. SETZ C, SYSCAL CORBLK,[MOVEI %CBRED+%CBNDR ? MOVEI %JSELF ; Get us read-access A ; For pages spec'd by PGASYS B ; From job spec (normally system) C] ; starting at page 0 .LOSE 1000 .OPEN TYOC,[%TJDIS+.BAO,,'TTY] ; Open TTY in display mode, block out .LOSE 1000 MOVE OBUFP,[440700,,OBUF] ; Must set up TTY output for EVALL. SETZM ODEV ; Use default %ODTTY type. PUSHJ P,EVALL PUSHJ P,CRR PUSHJ P,BUFOUT RET DEFINE UMOVE AC,(ADDR) MOVEI U1,ADDR ; Get address MOVEI U2,(U1) TRZ U2,1777 ; Get 1st addr in page CAME U2,UMAPTO ; Page already mapped in? CALL UMAPIN ; No, must get it ANDI U1,1777 MOVE AC,(U1) TERMIN ; UMAPIN - Map in page specified by address in U2. .SCALAR UMAPTO UMAPIN: LSH U2,-10. ; Get page # of source SKIPN U3,CRASHF MOVEI U3,%JSABS SYSCAL CORBLK,[MOVEI %CBRED+%CBNDR ? MOVEI %JSELF MOVEI UMAPG ; Get us a read-access page here U3 ; From this job's U2] ; page. JRST [ SYSCAL CORBLK,[MOVEI %CBNDR ; If fail, just get MOVEI %JSELF ; a page of zeros. MOVEI UMAPG MOVEI %JSNEW] .LOSE %LSSYS JRST .+1] LSH U2,10. MOVEM U2,UMAPTO RET ; Like UMOVE, except for job in U DEFINE JMOVE AC,(ADDR) MOVEI U1,ADDR ; Get address PUSHJ P,JMAPIN MOVE AC,(U1) TERMIN JMAPIN: MOVEI U2,(U1) ; Another copy of address in U2 ANDI U1,1777 ; Leave only offset in U1 TRZ U2,1777 ; Get 1st addr in page in RH HRLI U2,(U) ; Put job index in LH CAMN U2,UMAPTO ; Map already set up? POPJ P, ; Yes: exit MOVEM U2,UMAPTO ; Remember this for next time MOVEI U2,(U) IDIV U2,LUBLK ; U2: job number LDB U3,[121000,,UMAPTO] ; U3: page number SKIPN CRASHF ; Can't work if crash dump... SYSCAL CORBLK,[MOVEI %CBRED+%CBNDR MOVEI %JSELF ? MOVEI UMAPG MOVEI %JSNUM(U2) ? MOVEI (U3)] SKIPA RET SYSCAL CORBLK,[MOVEI %CBNDR ; If fail, just get a page of zeros. MOVEI %JSELF ? MOVEI UMAPG MOVEI %JSNEW] .LOSE %LSSYS RET ; EVALL - .EVAL all system symbols necessary for PEEKing EVALL: ; First grovel over all standard symbol-map tables. IRP TABLE,,[FLWDT,NXTAB,CXTAB,USERT,TXTAB,MBTAB] MOVEI D,TABLE CALL EVALTB TERMIN ; Special hack for initializing MUR type table MOVE D,[-NMURTY,,MURTBS] ; Get AOBJN to initializer table EVALL2: MOVE A,(D) ; Get SQUOZE symbol CALL XEVAL ; Find its value JRST EVALL3 ; Undefined? Barf. CAIL A,340 ; Bring old high codes within range SUBI A,340 CAIL A,0 CAIL A,40 JRST EVALL3 ; Value out of range? Barf. MOVE B,1(D) ; Get sixbit name for this MUR type MOVEM B,MEMTB(A) ; Stick it into lookup table AOJA D,EVALL4 EVALL3: SQPR (D) ; MUR lossage, barf about it. CTYPE "? EVALL4: AOBJN D,EVALL2 ; Now finally get the version # for this ITS. SKIPE CRASHF JRST EVALL5 ; Hmm, must extract from crash dump. SYSCAL SSTATU,[ REPEAT 5,MOVEM A MOVEM ITSNAM ; Get machine name MOVEM ITSVER] ; Get ITS version number .LOSE 1000 RET EVALL5: ; Maybe someday ITS will be fixed to have these symbols defined. MOVE A,[SQUOZE 0,/ITSVER/] CALL XEVAL ; Extract version # from crash dump. SETZ A, MOVEM A,ITSVER MOVE A,[SQUOZE 0,/ITSMCH/] CALL XEVAL SETZ A, MOVEM A,ITSNAM ADD A,ITSVER JUMPN A,APOPJ ; If either is set, assume we're OK. MOVE A,[SQUOZE 0,/ASSTAT/] CALL XEVAL ; Prepare for truly heroic kludge RET ; Barf, this has gone far enough. UMOVE B,13(A) ; Get pair of instructions from ASSTAT code UMOVE C,14(A) ; (Gasp, choke, glug) UMOVE A,(B) ; First one's E is machine name MOVEM A,ITSNAM UMOVE A,(C) ; Second one's E is version number MOVEM A,ITSVER RET ; EVALTB - .EVAL a complete symbol-map table. ; D/ addr of table. 1st wd is instr to XCT to convert each value, ; 2nd wd is AOBJN to table proper. EVALTB: MOVE C,(D) ; Get conversion instruction SKIPL D,1(D) ; Get AOBJN to symbol/value pairs RET EVALT2: MOVE A,1(D) ; Get SQUOZE symbol CALL XEVAL ; Evaluate it JRST [ SQPR A ; Undefined sym, barf. CTYPE "? CALL BUFOUT ; Give user something to watch while waiting. SETZ A, ; Use value of zero JRST .+2] ; Skip over the conversion XCT. XCT C ; Got it, convert the value! MOVEM A,(D) ; Store ADDI D,1 AOBJN D,EVALT2 RET ; MMPINI - Initialize MMP map table ; Clobbers A,B,C MMPINI: MOVE A,@MMPNP ; Find # pages we need for MMP MOVEM A,NMMPGS ; Get # pages in MMP table LSH A,10. MOVEM A,NMMPES ; Also store # words (for fast index checks) MOVN C,NMMPGS HRLZS C HRRZ A,PGAMMP ; Find 1st page # for MMP MMPIN2: MOVE B,@MMMPG ; Get system page # for this MMP page (idx C!) SYSCAL CORBLK,[MOVEI %CBRED+%CBNDR ? MOVEI %JSELF ; Get us read-access A ; For this page MOVEI %JSABS ; From system (absolute) B] ; at this abs page # .LOSE 1000 ADDI A,1 AOBJN C,MMPIN2 ; Loop through the MMP table. RET SUBTTL Crash dump support routines ; UINIT - Gobbles filename argument from JCL (if none, defaults to ; DSK:CRASH;ITS >) and sets up everything for PEEKing at the ; corpse. ; A/ BP to ASCIZ crash-dump filename UINIT: ; First tries to hack argument as filename and open DISC. SYSCAL SOPEN,[[.BII,,DISC] ? A] .LOSE %LSSYS SYSCAL RFNAME,[MOVEI DISC ; Record filename we got REPEAT 4,[ ? MOVEM CRSFIL+.RPCNT ]] .LOSE %LSSYS .VALUE [ASCIZ /: Loading crash dump... P/] ; Now load up the crash dump file into an inferior. CALL UCREAT ; Load up and snarf syms if possible MOVEI A,USRI ; Now set up job spec for PEEKing at. MOVEM A,CRASHF CALL INISYS ; Initialize system map and pointers ; Now set up various miscellaneous stuff for PEEK. MOVEI A,%MDCRS ; Set initial mode to special hack for dumps. MOVEM A,MODE SETZM RUUFLG ; Say no argument SETOM RUUIND MOVEI A,-1 MOVEM A,DOZE ; Set up infinite sleep time RET ; UCREAT - Given crash dump file open on disk channel DISC, ; creates inferior on chans USRI/USRO and loads up the dump. UCREAT: MOVE T,[SIXBIT /CRASH/] SYSCAL OPEN,[[.BIO,,USRO] ? ['USR,,0] ? [0] ? T ? %CLERR,,U1] JRST [ CAIN U1,%ENSMD ; Job exists? AOJA T,.-1 ; Yes, try again. .LOSE %LSSYS] SYSCAL OPEN,[[.BII,,USRI] ? ['USR,,0] ? [0] ? T ? %CLERR,,U1] .LOSE %LSSYS SYSCAL LOAD,[MOVEI USRI ? MOVEI DISC] .LOSE %LSSYS SYSCAL FILLEN,[MOVEI DISC ? MOVEM A] ; Find length of file .LOSE %LSSYS SYSCAL RFPNTR,[MOVEI DISC ? MOVEM B] ; Find current loc in file .LOSE %LSSYS SUB A,B ; Find # words left to read ADDI A,1777 LSH A,-10. ; Find # pages we need to get for symtab MOVNS A HRLZS A CAMG A,PGASYM ; We better not be asking for too much .VALUE [ASCIZ /: Symbol table of crash dump is too big!!  /] HRR A,PGASYM SYSCAL CORBLK,[MOVEI %CBNDR ; Get fresh pages to hold symtab MOVEI %JSELF A MOVEI %JSNEW] .LOSE %LSSYS ; Now start reading symtab in from disk. HRRZ C,PGASYM LSH C,10. ; Get address to copy to MOVEI D,(C) ; Save in D (will become final AOBJN) HRROI B,A .IOT DISC,B ; Flush the start addr CAIG A, .VALUE [ASCIZ /: Bad start addr in file?  /] UCRET3: HRROI B,A ; Get AOBJN for sym block .IOT DISC,B JUMPL B,UCRET4 JUMPGE A,UCRET4 ; If positive, done. TRZ A,-1 ; Ensure RH zero ADD D,A ; Add into total count HLL C,A ; Make C an AOBJN to place to write .IOT DISC,C ; Read in the stuff JUMPGE C,UCRET3 ; So much for that block, get next. TRZ C,-1 MOVMS C ; Get <# wds not read>,,0 ADD D,C ; Adjust final aobjn accordingly UCRET4: MOVEM D,SYMPTR ; All done! Store AOBJN ptr to copied symtab. SETOM HSTSIN ; Overlays host table .CLOSE DISC, RET XEVAL: SKIPE CRASHF JRST UEVAL .EVAL A, RET AOS (P) RET ; UEVAL - Simulation of .EVAL for use when mapping a crash dump. ; A/ squoze symbol ; Returns .+1 if failed ; Returns .+2 ; A/ symbol value ; Clobbers B UEVAL: PUSH P,C TLZ A,740000 ; Flush flags SKIPE C,SYMPTR ; Do we already have symtab in our core? JRST UEVAL4 ; Yes, hack fast internal lookup. UMOVE C,SYSSYM ; Pick up AOBJN ptr to symtab from exec DDT UEVAL2: UMOVE B,(C) ; Get sym from table AOBJP C,UEVAL9 ; Bump pointer to point at value TLNN B,200000 ; Skip if delete input (flag prevents match) TLZE B,740000 ; Flush flags and cause loss if all 0 (prog name) CAME A,B ; Compare AOBJN C,UEVAL2 JUMPGE C,UEVAL9 ; Fail if counted out UMOVE A,(C) ; Get value UEVAL8: AOS -1(P) UEVAL9: POP P,C RET UEVAL4: MOVE B,(C) ; Get sym from table AOBJP C,UEVAL9 ; Bump pointer to point at value TLNN B,200000 ; Skip if delete input (flag prevents match) TLZE B,740000 ; Flush flags and cause loss if all 0 (prog name) CAME A,B ; Compare AOBJN C,UEVAL4 JUMPGE C,UEVAL9 ; Fail if counted out MOVE A,(C) ; Get value JRST UEVAL8 SUBTTL PEEK startup GO: MOVEI P,PDL-1 ;INITIALIZE PUSH DOWN LIST SETOM UUIND ;CLEAR COMMAND ARGUMENT ; Initialize JCL if any SETZM JCLBP ;FIRST, ASSUME THERE'S NO COMMAND STRING. .SUSET [.ROPTIO,,A] TLNN A,%OPCMD JRST GO20 SETZM JCLBUF ; There is one; get it from superior. MOVE A,[JCLBUF,,JCLBUF+1] BLT A,JCLBFE-1 .BREAK 12,[5,,JCLBUF] MOVE A,[440700,,JCLBUF] ; Set up to scan the JCL GO15: MOVE C,A ; Save BP ILDB B,A CAIE B,^I CAIN B,40 ; IGNORE LEADING SPACES IN IT. JRST GO15 CAIN B,^M JRST GO19 ; End of JCL CAIE B, CAIN B,^C JRST GO19 ; End of JCL SKIPN JCLBP ; Regular char, if BP to beginning isn't already set, MOVEM C,JCLBP ; Then set it up! JRST GO15 GO19: SETZ B, DPB B,A ; Deposit zero byte to ensure ASCIZ! ; Note JCLBP is 0 if nothing but whitespace in string. ; Now initialize mapping into system GO20: SKIPE A,JCLBP ; First check JCL for crash-dump command JRST [ ILDB B,A ; Check 1st char CAIE B,"< JRST .+1 ; Nope CALL UINIT ; Aha!! Go hack dump file, BP in A to filename SETZM JCLBP ; Say no JCL left. JRST GO30] ; Not hacking crash file, see if system already mapped SYSCAL SSTATU,[ REPEAT 5,MOVEM A MOVEM A ; Get machine name MOVEM B] ; Get ITS version number .LOSE 1000 SKIPE ITSNAM SKIPN ITSVER JRST REPURF ; No, not initialized at all. CAMN A,ITSNAM ; Compare machine name CAME B,ITSVER ; and version number JRST REPURF ; Not initialized for current system CAMN A,[SIXBIT /DM/] ; Special hack - on DM, JRST GO25 ; default mode is 'J' instead of 'N' IFN 0,[ .SUSET [.RXUNAME,,A] ;WHO ARE WE MOVSI B,-UNMTLN ;AOBJN PTR TO PEOPLE WHO WANT J MODE INITUN: CAMN A,UNMTAB(B) ;DOES HE WANT J MODE? JRST GO25 ; YES, GIVE IT TO HIM! AOBJN B,INITUN ;KEEP ON TRYING JRST GO30 ] ;IFN 0 .SUSET [.RXJNAM,,A] CAME A,[SIXBIT /PJ/] ; PJ gets default mode "J" like on DM. JRST GO30 GO25: MOVEI A,%MDJHK ; Set default to J mode MOVEM A,MODE .SUSET [.RUIND,,RUUIND] ; can get user's U from ITS. GO30: INITY: MOVEI P,PDL-1 ;INITIALIZE PUSH DOWN LIST MOVE OBUFP,[440700,,OBUF] ;SET UP OUTPUT BUF POINTER .SUSET [.SMASK,,[%PILTP\%PIIOC\%PITYI]] ;SET MASK TO TYPE IN AND LIGHT PEN INTERRUPTS .SUSET [.SPICL,,[-1]] ;ENABLE ABOVE INTERRUPTS ; Try opening TTY input, "DDT" mode (don't echo CR, LF, TAB) .OPEN TYIC,[10+.UII,,'TTY] JFCL ; Ignore failure SETZM ODEV ; Initialize output device to printing TTY .OPEN TYOC,[%TJDIS+.BAO,,'TTY] ; Try to open TTY output JRST INIT20 ; Fail, try 340 display .OPEN NTYO,[.UAO,,'TTY] ; Another chan for unit-mode output JFCL IFN 340P,[ .STATUS TYIC,A ;SEE IF IT IS A 340 DISPLAY CONSOLE TRNN A,200000 SETOM DISNOT ;NOT AT 340 ] ;340P SYSCAL CNSGET,[MOVEI TYOC ? MOVEM A ? MOVEM HSZ MOVEM A ? MOVEM A ? MOVEM TTYOP] .LOSE %LSSYS SYSCAL RSSIZE,[MOVEI TYOC ? MOVEM NVLNS ? MOVEM NHLNS] .LOSE %LSSYS MOVE A,HSZ SUBI A,30. MOVEM A,HSZ MOVE A,TTYOP ;IS TTY AN ERASABLE DISPLAY? TLNN A,%TOERS JRST INIT20 ;NO, TRY 340 IF TTY IS NEAR IT, ELSE USE PRINTING TTY MODE. SETDIS: MOVEI ODEV,%ODDPT ;SET OUT MODE TO "DISPLAY TTY" .SUSET [.RTTY,,T] MOVE A,@TCMXV MOVEM A,VSZ .CALL TTYGET .LOSE 1000 TLZ C,%TSMOR ;ALWAYS **MORE** ON DISPLAY TTYS .CALL TTYSET .LOSE 1000 MOVE A,[-1,,[ASCIC/C/]] ;CLEAR SCREEN .IOT TYOC,A MOVE A,NHLNS CAIL A,79. ;Worth an occasional (rare) overflow for more info MOVEI ODEV,%ODWID ;WIDE DISPLAY MOVE A,NVLNS SOS A MOVEM A,MPAGEP(ODEV) JRST INIT30 ;AVOID 340 DISPLAY INIT20: MOVE A,NHLNS CAIL A,79. ;Worth occasional (rare) line overflow for useful info MOVEI ODEV,%ODWIT ; Wide TTY IFN 340P,[ PUSHJ P,ODIS ;TRY FOR 340 DISPLAY JRST INIT30 ;LOSE MOVEI ODEV,%OD340 ;SET OUT DEV TO 340 ] ;340P INIT30: CAIE ODEV,%ODTTY ; If output is to printing TTY, CAIN ODEV,%ODWIT JRST [MOVEI A,400000 ; use a very long sleep. MOVEM A,DOZE JRST .+1] .SUSET [.SMSK2,,[1_NTYO+1_TYOC]] SUBTTL PEEK Main Loop ;;;;;;;;;;; MAIN BODY OF PROGRAM, PEEK LOOPS TO HERE AFTER SLEEPING BEG: MOVE A,@MMPNP CAME A,NMMPGS CALL MMPINI ;# OF MMP PAGES HAS INCREASED, PARTIAL RE-INIT NEEDED. SKIPN JCLBP ;FIRST, ARE THERE ANY CHARS OF COMMAND STRING YET UNPROCESSED? JRST BEG0 ILDB I1,JCLBP ;YES; HANDLE ONE. JUMPE I1,BEG0A ;TERMINATOR => INDICATE JCL STRING ENTIRELY HANDLED. .LISTEN A, ;WAIT FOR OUTPUT TO FINISH BEFORE MAYBE CLOBBERING IT. JUMPN A,BEG0A ;PENDING INPUT IS MORE INPORTANT THAN THE JCL - USER HAS CHANGED HIS MIND. PUSHJ P,TSINTO ;PROCESS ALL OTHER CHARS AS IF WERE TTY INPUT. JRST BEG BEG0A: SKIPGE NAMESW PUSHJ P,TSSEM1 ;HACK THE COMMAND NOW SETZM JCLBP BEG0: SKIPE NAMESW JRST PUTPKX .LISTEN A, JUMPE A,BEG1 .SUSET [.SPICL,,[0]] MOVEI A,BEG MOVEM A,TSINT+1 JRST TSINTI BEG1: SETZM TOPFLG MOVEI P,PDL-1 ;SET UP P MOVE OBUFP,[440700,,OBUF] ;SET UP OUTPUT BUF POINTER SETZM LINEPOS ;CLEAR LINE AND PAGE POSITION SETZM PAGEPOS HRRZ A,MODE CAIN A,%MD1LN JRST BEG1LN XCT BEGT(ODEV) ; Initialize depending on output dev SKIPE A,CRASHF JRST [ MOVEI B,[ASCIZ /DEAD /] CAIN A,%JSABS MOVEI B,[ASCIZ /LIVE /] ATYPE (B) JRST .+1] 6XTYPE ITSNAM ATYPE [ASCIZ / ITS /] 6TYPE ITSVER ATYPE [ASCIZ /Peek /] 6TYPE [.FNAM2] CALL PDTIME ; Output date and time ATYPE [ASCIZ / Up time =/] SETZM TMPTCL ;STARTS OUTPUT 1 SPACE FROM CURRENT POSITION MOVE A,@TIME ;GET TIME SYS UP IN 1/30'S IDIVI A,30. ;CONVERT TO SECS PUSHJ P,TMPT ;OUTPUT HH:MM:SS PUSHJ P,CRR BEG1LN: HRRZ D,MODE ;GET MODE IFN 0,[ SKIPGE XCHFLG JRST [ CAIN D,%MDMPX ; Mplxrs open, skip if should be off JRST .+1 ; Still on, OK. .CLOSE IMXC, ; We were interrupted out of mplxr mode SETZM XCHFLG ; to another mode, so turn mplxrs off. JRST .+1] ];IFN 0 CAIE D,%MDOVH SETOM OVHTIM ;Allow for RHIST to get clobbered MOVE A,MDTAB(D) ; Get mode dispatch table entry TLNE A,(%MFERO) ; If desired, output topmost "errors" line CALL TOPERR HLRZ D,(A) ; See if command help is present and wanted SKIPE HLPFLG CAIE D,(SKIP) JRST BEG8 ATYPE @(A) CALL CRR BEG8: CALL (A) ; Execute routine for mode! MOVE D,MODE MOVE A,MDTAB(D) TLNE A,(%MFGUN) ; If mode was a variety of gun/detach, JRST PUTPKG ; Skip over some cleanup stuff. BEG9: ; Fall through to wrap up .CLOSE DIRC, ; Close out dir channel if open MOVEI A,1 MOVEM A,ESW SETZM JHFLAG SETZM RONLY MOVE A,NAMESW CAME A,[-2] JRST [ SKIPG A SETZM NAMESW MOVEM A,LNAMES JRST .+1] SETZM RNDFLG SETZM GUNFLG CAIA PUTPKX: MOVE OBUFP,[440700,,OBUF] ;SET UP OUTPUT BUF POINTER PUTPKG: ; Fall through to sleep XCT OMENDT(ODEV) ;TERMINATE MESSAGE PUSHJ P,BUFOUT ;TERMINATE CHAR OUTPUT SKIPN OMSLPT(ODEV) SKIPN B,JCLBP ;ON PRINTING DEVICES, AVOID SLEEPING IF JCL COMMANDS YET UNPROCESSED. JRST ASLEE1 ILDB B,B CAIN B,^C ;BUT IF REMAINING JCL IS JUST THE TERMINATOR, FLUSH IT RIGHT AWAY AND DO SLEEP. SETZM JCLBP SKIPE JCLBP JRST BEG ASLEE1: SKIPLE SPCCNT ;IF USER TYPED AHEAD A SPACE, DON'T SLEEP. JRST [ SOS SPCCNT ; Count space as eaten. JRST BEG] ; Okay, we're gonna sleep! MOVE A,DOZE ; Get delay in seconds IMULI A,30. ; Convert to 30'ths SKIPE CRASHF ; If hacking crash dump, JRST ASLEE2 ; relative time is sufficient. MOVE B,@TIME ; Else try for absolute sleep; get sys time (30ths) ADD A,B ; Get absolute system time to sleep until IDIVI A,15. IMULI A,15. ; Truncate to nearest half sec ADDI A,9 ; Set phase relative to slow clock (magic num, <14.&>0) MOVNS A ; Neg for absolute sleep feature ASLEE2: .SLEEP A, ; ZZ ZZ ZZ JRST BEG ; Sleep done, back to start of main loop! SUBTTL Command dispatch table ;DISPATCH TABLE TO ROUTINES FOR DIFFERENT MODES ; Flags: %MFERO==SETZ ; Output errors on 2nd line %MFGUN==100000,,0 ; Hack gun/detach after mode (a crock, this) %MFINV==040000,,0 ; "Invisible" mode command, not documented by "?" DEFINE MODEF CHAR,(RTN,FLAGS),&HELP %%%SV==. FLAGS+RTN ; ,, OFFSET 0 IF1 LOC .-1 ? [ASCIZ HELP] IF2 [ LOC MDHTAB+%%%SV [ASCIZ HELP] LOC MDTAB2+%%%SV CHAR LOC MDTAB+%%%SV+1 ] OFFSET -MDTAB TERMIN ; Dispatch table for PEEK display modes. The order of entries in ; this table is the order in which "?" will display the command list. MDTAB: OFFSET -. MODEF "?,EXPL,, "This. 1? enables help before each command." %MDNET::MODEF "A,NETWRK,, "Arpanet connections (1A: buffer info, 2A pkt trace if available)" %MDBAK::MODEF "B,MDBACK,, "Back (to previous mode)" MODEF "C,DISK,%MFERO, "Channel/buffer (channel#)" MODEF "D,DDXR,, "Directory (channel#)" MODEF "E,EPEEK,, "Eval & test job var (use ;Evar)" %MD1LN::MODEF "F,1PEEK,, "Fast 1-line (job#)" %MDSCH::MODEF "G,NORMAL,, "Swap variables" MODEF "H,MEML,%MFERO, "Histogram of mem usage" IFN 0,[ %MDMPX::MODEF "I,MPXR,, "IMX??" ];IFN 0 %MDJHK::MODEF "J,JHACK,, "Joint S+C+A (job#)" %MDCHA::MODEF "K,KAOS,, "Chaosnet connections" MODEF "L,LINES,, "tty Lines (job#)" MODEF "M,MHIST,%MFERO, "Memory (job#)" %MDNRM::MODEF "N,NORMAL,%MFERO, "Normal" MODEF "O,OSHACK,, "Output (tty#)" MODEF "R,RNABLE,%MFERO, "Running jobs" %MDS:: MODEF "S,SPEEK,, "Single Tree (job#)" MODEF "T,TRANPK,, "Translations" IFN 0, MODEF "U,UTPEEK,%MFERO, "Utape??" MODEF "V,DOUSER,, "job Variables (job#)" ; ULOOK checks MODE to hack this one (swap vars) MODEF "W,WROUTE,, "Internet, Chaosnet routing tables (1W is Chaos only)" MODEF "X,GUNNER,%MFGUN+%MFINV, "Gun down tree" MODEF "Y,DETACH,%MFGUN+%MFINV, "Detach tree" MODEF "*,NORMAL,%MFERO+%MFINV, "Hung jobs(???)" MODEF "%,SCHH,, "Scheduler History" MODEF "$,SWPH,, "Swapper History" MODEF "!,PAGH,, "Page-in History" MODEF "+,IMPMTR,, "Network meters" %MDOVH::MODEF "~,OVHMTR,, "System overhead meters" MODEF "",SYSMSG,, "System message buffer" %MDCRS::MODEF "<,CRASH,%MFINV, |Crash dump autopsy (JCL: "< filename")| MAXMODE:: OFFSET 0 MDTAB2: BLOCK MAXMODE ; Holds command chars that invoke mode MDHTAB: BLOCK MAXMODE ; Holds ptrs to ASCIZ description strings MDBACK: .VALUE [ASCIZ /:Should not execute back/] SUBTTL Misc command loop support ; TOPERR - Print topmost line showing system errors if any ; Mustn't clobber A TOPERR: MOVE T,@QIRRCV MOVEI C,0 MOVE D,@PARERR MOVEI C,1 MOVE B,@PARERR ADD T,D ADD T,B JUMPE T,CPOPJ TYPE "ERRS:" SKIPE @QIRRCV JRST [ TYPE " DSK(IRRECOV) =" DNUM 4,@QIRRCV JRST .+1] JUMPN D,[TYPE " CORPAR =!" DNUM 4,D JRST .+1] JUMPE B,CRR TYPE " CORNXM =!" DNUM 4,B JRST CRR ; Execute table for start of a mode display BEGT: PUSHJ P,CRR ;TTY PUSHJ P,TTYDPT ;DATAPOINT CALL [ MOVEI A,^T ? IDPB A,OBUFP ? RET] ;340 PUSHJ P,CRR ;LPT PUSHJ P,TTYDPT ;WIDE DISPLAY PUSHJ P,CRR ;WIDE TTY ODEVER BEGT TTYDPT: MOVEI A,^P IDPB A,OBUFP MOVE A,TTYOP ;IF ARDS CLEAR USING ^PC TLNN A,%TOERS SKIPA A,["C] ;MAKE CHAR "C" FOR ^PC MOVEI A,"T ;DATAPOINTS HOME UP AND CLEAR TOP LINE. IDPB A,OBUFP MOVEI A,^P IDPB A,OBUFP MOVEI A,"] IDPB A,OBUFP POPJ P, IFN 340P,[ ODIS: SKIPE DISNOT POPJ P, MOVEI A,.BAO ;SET DISPLAY FILE NAME BLOCK HRLM A,DISF ;TO ASCII BLOCK OUTPUT .OPEN DISC,DISF ;TRY TO OPEN DIS DIVICE POPJ P, ;FAILURE EXIT MOVEI A,.BIO ;SET DIS FIL NAM BLK HRLM A,DISF ;TO IMAGE BLK OUT .OPEN DISWC,DISF ;TRY TO OPEN DIS DEVICE JRST ODIS2 ;FAILURE (SOMEOME MUST HAVE JUST TAKEN DIS AWAY) MOVSI A,(SETZ) ;TURN ON MOVEM A,LPBLK ;SIGN BIT .LTPEN LPBLK ;INITIALIZE LIGHT PEN IN RIGHT "MODE" AOS (P) ;INCREMENT RETURN ADDRESS POPJ P, ODIS2: .CLOSE DISC, ;CLOSE OUT ASCII CHANNEL POPJ P, ;FAILURE EXIT ] ;340P ; Execute table for end of a mode display OMENDT: PUSHJ P,CRR2 ;TTY ;2 CR/LF'S CALL GEEND ;DATAPOINT IFN 340P,CALL DISEND ; 340 display .ELSE JFCL CTYPE ^L ;LPT CALL GEEND ;WIDE DISPLAY CALL CRR2 ;WIDE TTY ;2 CR/LF'S ODEVER OMENDT OMSLPT: 0 1 1 0 1 0 ODEVER OMSLPT GEEND: MOVE A,MPAGEP(ODEV) ;GE TERMINATION CAMLE A,PAGEPOS ;IF HAVEN'T WRAPPED AROUND YET, ATYPE [ASCIZ/E/] ;CLEAR REST OF SCREEN. RET IFN 340P,[ DISEND: PUSH P,MPAGEP(ODEV) MOVEI A,2 ADDB A,MPAGEP(ODEV) PUSHJ P,VALIGN ;CLEAR UNUSED PART OF SCREEN ;STRING GOES ON BOTTOM OF SCREEN MOVSI A,-MAXMODE CAIA DISND2: ALIGN 3, ;PLUG IN 3 SPACES MOVE B,MDTAB2(A) ;GET CHAR CTYPE 40(B) ;OUTPUT CHAR AS ASCII AOBJN A,DISND2 ;LOOP POP P,MPAGEP(ODEV) RET ;MOVE DOWN PAGE UNTIL AT LINE NUMBER IN A VALIGN: SUB A,PAGEPOS JUMPLE A,CPOPJ PUSHJ P,CRR SOJA A,.-2 ] ;340P SUBTTL UUO Routines ;UUO DISPATCH TABLE UUOTAB: UDPCT UDWRD USONUM UATYPE UDNUM UONUM UVALRET U6XTYPE UCTYPE USQPR UXTYPE U6TYPE UALIGN ;ALIGN AC,E ;SPACE TO COLUMN E OUTPUTTING AT LEAST AC SPACES UALIGN: LDB U1,[270400,,40] ;PICK UP UUO'S AC FIELD MOVEI U3,40 SOJL U1,UALIG2 ;JUMP IF NO MIN NUM OF SPACES UALIG1: AOS LINEPOS ;INCREMENT LINE POSITION TOUT U3 ;OUTPUT SPACE SOJGE U1,UALIG1 ;LOOP TILL MIN SPACES OUT UALIG2: CAMLE U2,LINEPOS ;SKIP IF LINE POSITION = EFF ADR JRST UALIG1 ;MORE SPACES JRST 2,@UUOH ;EXIT AND RESTORE FLAGS ;6TYPE E ;OUTPUT (E) AS SIXBIT U6TYPE: MOVSI U1,-6 ;INITIALIZE LOOP, 6 CHARS HRLI U2,440600 ;BYTE POINTER FOR HIGH 6 BITS OF E U6TYP2: ILDB U3,U2 ;GET CHAR (6 BITS) ADDI U3,40 ;CONVERT TO ASCII TOUT U3 ;OUTPUT AOBJN U1,U6TYP2 ;LOOP MOVEI U1,6 ADDM U1,LINEPOS ;INCREMENT LINE POSITION BY 6 UEXIT: JRST 2,@UUOH ;EXIT AND RESTORE FLAGS ;ATYPE E ;OUTPUT C(E), C(E+1),... AS ASCII, STOPPING AT ZERO OR FF UATYP2: AOSA LINEPOS ;INCREMENT LINE POSITION AND SKIP UATYPE: HRLI U2,440700 ;ENTRY, BYTE POINTER TO TOP 7 BITS OF C(E) UATYP3: ILDB U3,U2 ;GET CHAR JUMPE U3,UEXIT ;EXIT IF ZERO CAIN U3,14 JRST UEXIT ;EXIT IF FORM FEED TOUT U3 ;OUTPUT CAILE U3,15 ;SKIP IF MAY BE NON-PRINTING CHAR JRST UATYP2 ;REGULAR CHAR CAIN U3,15 JRST UACR ;CARRIAGE RETURN CAIE U3,12 JRST UATYP2 ;REGUALR CHAR AOS PAGEPOS ;LINE FEED, INCREMENT PAGE POSITION JRST UATYP3 UACR: SETZM LINEPOS ;RESET TO BEG OF LINE JRST UATYP3 ;XTYPE E ;OUTPUT IN 6BIT STARTING AT E UNTIL AN "!" IS ENCOUNTERED UXTYPE: HRLI U2,440600 ;ENTRY, BYTE POINTER TO TOP 6 BITS OF C(E) UXTYP2: ILDB U3,U2 ;GET CHAR CAIN U3,'! ;SKIP UNLESS "!" JRST 2,@UUOH ;EXIT AND RESTORE FLAGS ADDI U3,40 ;CONVERT TO ASCII TOUT U3 ;OUTPUT AOS LINEPOS ;INCREMENT LINE POSITION JRST UXTYP2 ;LOOP ;CTYPE E ;OUTPUT ASCII CHAR WHOSE VALUE IS E UCTYPE: TOUT U2 ;OUTPUT CHAR CAIE U2,^B CAIN U2,^E JRST 2,@UUOH AOS LINEPOS ;INCREMENT LINE POSITION JRST 2,@UUOH ;EXIT AND RESTORE FLAGS ;6XTYPE E ;OUTPUT C(E) AS 6BIT W/ TRAILING SPACES SUPPRESSED. U6XTYPE: MOVE U2,(U2) ;GET THE WORD OF SIXBIT U6XTY2: MOVEI U1,0 LSHC U1,6 ;GET THE NEXT CHARACTER ADDI U1,40 ;MAKE INTO ASCII AOS LINEPOS TOUT U1 ;OUTPUT IT JUMPN U2,U6XTY2 ;IF MORE NON SPACES, KEEP GOING. JRST 2,@UUOH ;EXIT AND RESTORE FLAGS UVALRET: .RESET TYOC, ;RESET TTY OUTPUT BUF (IN SYSTEM) .SUSET [.RJNAM,,U1] CAMN U1,[SIXBIT/HACTRN/] JRST [ HRROI U3,[ASCIC/C/] CAIE ODEV,%ODWID ;IF ON DISPLAY TERMINAL, CAIN ODEV,%ODDPT XCT ODEVT(ODEV) ;CLEAR SCREEN BEFORE LOGGING OUT. .LOGOUT .VALUE] .VALUE (U2) ;TRANSMIT E FROM UUO TO DDT .DISMISS [BEG] ;RESTART PEEK IF DDT RETURNS USQPR: MOVE U1,(U2) TLZ U1,740000 USPQR2: IDIV U1,[50*50*50*50*50] ADDI U1,260-1 CAILE U1,271 ADDI U1,301-272 CAILE U1,332 SUBI U1,334-244 CAIN U1,243 MOVEI U1,256 TOUT U1 MOVE U1,U2 IMULI U1,50 JUMPN U1,USPQR2 JRST 2,@UUOH ;ONUM AC,E ;UNSIGNED OCT PRINT C(E), RIGHT JUSTIFIED IN FIELD AT LEAST AC WIDE UONUM: MOVEI U3,10 ;SET RADIX 8. SETZM NEGF ;SET TO UNSIGNED OUTPUT UONUM2: SETZM NEGF2 ;SET TO NOT PRINT "-" LDB U1,[270400,,40] ;GET AC FROM 40 MOVE U2,(U2) ;PUT C(E) IN U2 HRRM U3,UNUMQ ;PLANT RADIX PUSHJ P,UNUMP ;PRINT OUTPUT JRST 2,@UUOH ;EXIT AND RESTORE FLAGS UNUMP: SOS U1 ;DECREMENT FIELD WIDTH JUMPL U2,UNUMPN ;C(E) NEG UNUMQ1: IDIVI U2,@UNUMQ UNUMQ2: HRLM U3,(P) ;PUT REMAINDER IN STACK OVER FLAGS SKIPE U2 ;SKIP IF REMAINING QUOTIENT IS ZERO PUSHJ P,UNUMP ;RECURSE ON QUOTIENT JUMPG U1,UNUMS ;ALL OF C(E) PRINT-OUT COMPUTED, PAD WITH SPACES AS REQUIRED UNUMP2: AOSN NEGF2 ;SKIP UNLESS "-" TO BE PRINTED JRST UNUMMM ;PRINT MINUS HLRZ U3,(P) ;PICK UP DIGIT ADDI U3,"0 ;CONVER TO ASCII TOUT U3 ;OUTPUT AOS LINEPOS ;INCREMENT LINE POSITION POPJ P, ;C(E) NEGATIVE UNUMPN: SKIPE NEGF ;SKIP IF UNSIGNED OUTPUT JRST UNUMN2 ;SIGNED OUTPUT LSHC U2,-43 ;PUT BOTTOM 35 BITS IN BOTTOM OF U3 LSH U3,-1 ;AND SIGN BIT AT BOTTOM OF U2 (DOUBLE PRECISION INTEGER FORMAT) DIVI U2,@UNUMQ ;DIVIDE OFF DIGIT JRST UNUMQ2 ;SIGNED OUTPUT OF NEGATIVE UNUMN2: SETOM NEGF2 ;SET FLAG TO PRINT "-" MOVNS U2 ;MAKE NUM PSOITIVE SOJA U1,UNUMQ1 ;DECREMENT FIELD WIDTH ANTICIPATING MINUS SIGN ;PRINT MINUS SIGN UNUMMM: MOVEI U3,"- ;OUTPUT TOUT U3 ;A "-" AOS LINEPOS ;INCREMENT LINE POSITION JRST UNUMP2 ;FILL BEGINNING OF FIELD WITH SPACES UNUMS: MOVEI U3,40 UNUMS2: TOUT U3 ;OUTPUT A SPACE AOS LINEPOS ;INCREMENT LINE POSITION SOJG U1,UNUMS2 ;LOOP TILL ENOUGH SPACES JRST UNUMP2 ;DPCT AC,E UDPCT: MOVEI U3,10. SETOM NEGF JRST UONUM2 ;DNUM AC,E ;SIGNED DEC OUTPUT RIGHT JUSTIFIED IN FIELD AT LEAST AC WIDE ;SONUM AC,E ;SIGNED OCT ETC. UDNUM: SKIPA U3,ORADIX ;RADIX OF 10. USONUM: MOVEI U3,10 ;RADIX OF 8 SETOM NEGF ;SET TO SIGNED OUTPUT JRST UONUM2 UDWRD: PUSH OBUFP,(U2) ;PUT UUO C(E) IN OUTPUT BUF CAME OBUFP,[OBUFL,,OBUF+OBUFL-1] ;SKIP IF BUF FULL JRST 2,@UUOH ;EXIT AND RESTORE FLAGS MOVE U3,[-OBUFL,,OBUF] ;SET UP FOR IOT .IOT DISWC,U3 ;OUTPUT BUF TO DIS IN IMAGE MODE MOVEI OBUFP,OBUF-1 ;INITIALIZE BUF POINTER JRST 2,@UUOH ;EXIT AND RESTORE FLAGS ;OUTPUT FULL BUFFER (SEE TOUT MACRO) OBLOCK: PUSH P,U3 ;PRESERVE U3 MOVE U3,[-OBUFL,,OBUF] ;SET UP IOT COUNT XCT ODEVT(ODEV) ;EXECUTE APROPRIATE IOT POP P,U3 ;RESTORE U3 MOVE OBUFP,[440700,,OBUF] ;INITIALIZE CHAR POINTER TO START OF NOW FREE BUF POPJ P, ;OUTPUT INSTRUCTIONS FOR VARIOUS DEVICES ODEVT: .IOT TYOC,U3 ;0=TTY .IOT TYOC,U3 ;1=DATAPOINT .IOT DISC,U3 ;2=340 .IOT LPTC,U3 ;3=LPT .IOT TYOC,U3 ;WIDE DISPLAY .IOT TYOC,U3 ;WIDE TTY ODEVER ODEVT ; BUFOUT - Terminate character output, force out output buffer. ; Called from various routines, NOT from UUO handler. ; Clobbers U1,U3 BUFOUT: HLRZ U1,OBUFP CAIE U1,010700 ;IS CURRENT ACTIVE WORD IN BUFFER FULL? JRST [ MOVEI U1,^C IDPB U1,OBUFP ;NO, INSERT AN EOF JRST BUFOUT] ;YES, LAST WORD HAS BEEN FILLED OUT MOVEI U3,OBUF SUB U3,OBUFP SOS U3 HRLS U3 HRRI U3,OBUF XCT ODEVT(ODEV) ;OUTPUT ALL OF BUF THAT IS ACTIVE MOVE OBUFP,[440700,,OBUF] ; Reset output buffer ptr POPJ P, SUBTTL Network Host name/number output rtns ;PRINT HOST NUMBER (OR INDEX) IN A, WIDTH IN B OHOST: SKIPN IMPHTN ;NEW SYSTEM? JRST OHOST0 PUSH P,B PUSH P,T MOVE T,A MOVE A,@IMPHTN ;GET NEW-FORMAT HOST# INDEXED FROM T POP P,T POP P,B OHOST0: SKIPN HSTEXP ;EXPAND? JRST OHLOS1 ;NO OHOST2: PUSH P,X PUSH P,U PUSH P,D PUSH P,C PUSH P,B PUSH P,A PUSHJ P,GTHOST SKIPGE HSTSIN JRST OHLOS0 ;;;; HSTSRC(B:host#) => A:TIP_flag,,name_p, D:site_p MOVE B,(P) ;HOST# PUSHJ P,NETWRK"HSTSRC ;A -> NAME, D -> SITE JRST OHLOS0 ;NOT FOUND HRRZ B,MODE CAIN B,%MDCHA JRST [ MOVE A,(P) ;CHAOSNET DISPLAYS SHORT NAMES PUSHJ P,NETWRK"HSTSIX JRST OHLOS0 6XTYPE A JRST OHOST3 ] ATYPE (A) ;FOUND, TYPE IT OHOST3: POP P,A POP P,B POP P,C POP P,D POP P,U POP P,X POPJ P, OHLOS0: POP P,A POP P,B POP P,C POP P,D POP P,U POP P,X ; Expects HOSTS3 format OHLOS1: HLRZ D,A ;Extract network number TRZ D,77 ;Isolate NW$BYT bits CAIE D,(NETWRK"NW%CHS) JUMPN D,TYPINA ;Jump if internet address TLZ A,777700 ;CLEAR POSSIBLE NETWORK NUMBER MOVE D,[ONUM A] DPB B,[270600,,D] XCT D POPJ P, OHOSTK: ANDI A,177777 ; Chaos addresses have only 16 bits MOVEI B,4 ;FIELD WIDTH SKIPN HSTEXP ;EXPAND? JRST OHLOS1 ;NO IOR A,[NETWRK"NW%CHS] ;INSERT CORRECT NETWORK NUMBER JRST OHOST2 GTHOST: SKIPL HSTSIN ;GOT HOST FILE? POPJ P, ;YES .IOPUSH DIRC, ;NO, TRY TO GET IT HRRZ A,PGAHST ; Get page # to map host file into MOVEI B,DIRC PUSHJ P,NETWRK"HSTMAP CAIA SETZM HSTSIN ;Got it .IOPOP DIRC, POPJ P, SUBTTL Interrupt Handler INTPUR: SKIPE MORFLG JRST MORON TSINT0: SKIPGE I1,TSINT JRST TSINTP TSINT1: TRZE I1,%PIIOC .DISMIS TSINT+1 IFN 340P,[ TRZ I1,1 JUMPN I1,TSINTL ];340P MOVEI I1,TYIC .ITYIC I1, .DISMIS TSINT+1 TSINTI: .IOT TYIC,I1 TSINTJ: PUSHJ P,TSINTQ .DISMISS TSINT+1 HRRZ I1,TSINT+1 ;SKIP RETURN IF LOST (ILLEGAL CHAR) CAIN I1,AHANG+1 ;FIX UP POINTER IF HANGING PUSHJ P,TSINTH .DISMISS TSINT+1 TSINT2: .RESET TYOC, CAIE I1,"Q CAIN I1,"P .IOT NTYO,I1 CAIE I1,^B CAIN I1,^E .IOT NTYO,I1 IFN 340P,[ CAIE I1,^Y CAIN I1,^N .IOT NTYO,I1 ];340P CAIN I1,"Q JRST [.LOGOUT .BREAK 16,160000] ;PER AS SUGGESTION CAIN I1,"P PUSHJ P,PROCED CAIN I1,^C PUSHJ P,PROCED CAIN I1,^G JRST [SETZM NAMESW POPJ P,] CAIN I1,^B JRST LPTON CAIN I1,^E JRST LPTOFF IFN 340P,[ CAIN I1,^Y JRST DISON CAIN I1,^N JRST DISOFF ];340P CAIN I1,177 JRST TSRET2 TSINNM: MOVSI I2,-MAXMOD CAME I1,MDTAB2(I2) AOBJN I2,.-1 HRRZ A,I2 CAIN A,%MDBAK JRST TSINT5 MOVE A,RUUFLG MOVEM A,LRUUFL SETZM JHFLAG SETZM RUUFLG MOVE A,RUUIND MOVEM A,LRUUIND SETOM RUUIND SKIPGE A,UUIND JRST TSINT4 SETOM RUUFLG MOVEM A,RUUIND TSINT4: SETOM UUIND CAILE I2,0 .IOT NTYO,[^G] CAIG I2,0 JRST [SKIPL NAMESW .IOT NTYO,I1 JRST .+1] CAILE I2,0 JRST [AOS (P) POPJ P,] MOVE A,MODE MOVEM A,LMODE MOVEM I2,MODE TSRET2: .DISMISS [BEG1] TSINT5: MOVE A,LMODE ;RESTORE TO PREVIOUS MODE EXCH A,MODE MOVEM A,LMODE MOVE A,LRUUIN EXCH A,RUUIND MOVEM A,LRUUIN SKIPL A,LRUUFL SETOM RUUIND ; Make sure that arg is -1 if no arg specified. EXCH A,RUUFLG MOVEM A,LRUUFL JRST TSRET2 PROCED: CAIE ODEV,%ODWID ; If wide display CAIGE ODEV,%OD340 ; or %ODTTY or %ODDPT JRST [VALRET [ASCIZ /J/] ; then do this, whatever it is. POPJ P,] VALRET [ASCIZ /:PROCED /] ;RETURN TO DDT TO RESTART PEEK POPJ P, TSINDK: SETCMM DSKZER SKIPE DSKZER .IOT NTYO,["1] .IOT NTYO,["@] POPJ P, TSINDC: SETCMM DSKCON SKIPE DSKCON .IOT NTYO,["1] .IOT NTYO,["&] POPJ P, TSINHS: SETCMM HSTEXP SKIPE HSTEXP .IOT NTYO,["1] .IOT NTYO,["=] POPJ P, TSINRX: MOVE A,ORADIX TRC A,2 PUSH P,A TRNE A,2 JRST [PUSHJ P,OCTA JRST TSINR1] PUSHJ P,DECA TSINR1: .IOT NTYO,["#] POP P,A MOVEM A,ORADIX POPJ P, TSINTZ: SKIPGE A,UUIND ;ARG SUPPLIED TO Z COMMAND ?? POPJ P, MOVEM A,DOZE ;TIME FOR SLEEPING SETOM UUIND ;SET "NO ARG TYPED" FLAG .IOT NTYO,["Z] ;SO USER KNOWS HE'S HEARD POPJ P, IFN 340P,[ TSINTL: TRNN I1,100000 .LOSE 1000 SETZM LPBLK .LTPEN LPBLK SKIPN LPBLK+1 ;NUMBER OF TIMES SEEN JRST TSINTX HLRZ I2,LPBLK ;Y HRRZ I1,LPBLK ;X CAIL I2,300 JRST TSINL1 IDIVI I1,12.*4 ;LIGHT-PEN HIT IN LOWER (MODE) AREA CAME I1,MODE CAILE I1,MAXMOD ];340P TSINTX: .DISMISS TSINT+1 ;Skipped into from TSINTL above PUSH P,A HRRZ A,I1 CAIN A,%MDBAK JRST TSINX1 MOVE A,MODE MOVEM A,LMODE MOVEM I1,MODE TSINX2: POP P,A .DISMISS [BEG] TSINX1: MOVE A,LMODE EXCH A,MODE MOVEM A,LMODE JRST TSINX2 IFN 340P,[ TSINL1: SUBI I1,12. ;LIGHT-PEN HIT IN UPPER (USER) AREA IDIVI I1,12.*8 MOVEM I1,LPBLK+1 HLRZ I1,LPBLK SUBI I1,1700 MOVNS I1 IDIVI I1,18. SOS I1 IMULI I1,6 ADD I1,LPBLK+1 MOVE I2,MODE SKIPL LPCHPT JRST TSINTX MOVEM I1,LPCHPT .DISMISS [BEG] ];340P TSINTQ: SETZM JCLBP ;ANY TYPEIN EXCEPT **MORE**-PROCEDING RUBOUT FLUSHES ;UNPROCESSED JCL. TSINTO: CAIN I1,%TXTOP+"H MOVEI I1,"? ;Help key should work!! CAILE I1, 140 ;LOWER CASE CAN GET IN FROM JCL CAILE I1, 172 CAIA SUBI I1, 40 SKIPGE GUNFLG JRST GUNNEM SKIPE NAMESW JRST TSNAME TSINAG: CAIN I1,"; JRST TSSEMI CAIN I1,177 JRST RUBNUM CAIN I1,40 ;SPACE INCREMENTS COUNT OF SPACES JRST [ aos spccnt HRRZ I1,TSINT+1 ;IF SLEEPING WAITING FOR A CHARACTER, CAIE I1,DSKHNG+1 CAIN I1,AHANG+1 JRST TSINTH CAIE I1,ASLEE2 ;IF WE CAME FROM SLEEPING RET SOS SPCCNT ;COUNT THIS SPACE AS EATEN. AOS TSINT+1 ;DO HACK TO REDISPLAY. RET] SETZM SPCCNT ;ANYTHING ELSE ZEROES COUNT OF SPACES. CAIN I1,^Z JRST [.CALL [SETZ ? SIXBIT /RELOAD/ ? SETZ] .LOGOUT JRST .+1] CAIN I1,"@ JRST TSINDK CAIN I1,"Z JRST TSINTZ CAIN I1,"# JRST TSINRX CAIN I1,"= JRST TSINHS CAIN I1,"& JRST TSINDC CAIN I1,12. JRST TSINCL CAIN I1,". JRST TSFOO CAIL I1,"0 CAILE I1,"9 JRST TSINT2 SKIPGE I2,UUIND SETZ I2, ASH I2,3 .IOT NTYO,I1 ;OUTPUT NUMBER IMMEDIATE ADDI I2,-"0(I1) JRST TSFOO1 TSFOO: SKIPGE I2,LNAMES JRST [SETOM NAMESW SETOM ONAMSW POPJ P,] SETZM NAMESW MOVE I2,RUUIND TSFOO1: MOVEM I2,UUIND POPJ P, TSSEMI: SETZM NAMEHK ;CLEAR FLAGS SETZM NAMCOM MOVE I2,[440600,,NAMEHK] MOVEM I2,NAMEBP ;AND BP MOVEI I1,1 MOVEM I1,NAMESW ;SET THE 'IN SEMI MODE' FLAG (+1) POPJ P, TSSEM1: .IOT NTYO,I1 TSSEM2: MOVE I1,NAMESW CAME I1,[-2] ;HAVE WE GOT A NAME YET? POPJ P, ;NO KEEP GOING SETOM NAMESW MOVE I1,NAMCOM ;GET BACK THE COMMAND CAIN I1,"E JRST TSEFND TSSEM3: SETZM ONAMSW JRST TSINNM ;AND DO THE RIGHT THING ; SPECIAL E MODE HACK FOR GETTING SYMBOL NAME TSEFND: MOVE I2,[CAME A,@EONLY] SKIPLE ESW MOVEM I2,EINST SOSGE ESW JRST TSSEM3 SETZM EONLY SETZM EWORD SETZM SQUOZR ;SLOT FOR SQUOZE'S NAME MOVE I1,NAMEHK TSELP: SETZ I2, ;FOR NEXT CHARACTER ROTC I1,6 ;CHARACTER MOVED INTO RH OF I1 JUMPE I2,TSEDON ;DONE CAIL I2,'0 ;IS IT NUMERIC? CAILE I2,'9 JRST TSENNM SUBI I2,'0-1 ;SQUOZIFY THE NUMBER JRST SQUEEZ TSENNM: CAIL I2,'A ;IS IT A LETTER? CAILE I2,'Z JRST TSENAN SUBI I2,'A-11. ;SQUOZIFY THE LETTER JRST SQUEEZ TSENAN: MOVEI I2,37. ;GET SPECIAL CHARACTERS CAIN I2,'. AOJ I2, CAIN I2,'$ ADDI I2,2 CAIN I2,'% ADDI I2,3 CAIN I2,37. JRST TSEILL ;NON-SQUOZE CHARACTER SQUEEZ: EXCH I1,SQUOZR ;DO THE SQUOZING IMULI I1,40. ADD I1,I2 EXCH I1,SQUOZR AOS I2,EONLY CAIE I2,6 JRST TSELP JRST TSEWIN TSEDON: MOVE I2,EONLY CAIE I2,6 JRST [SETZ I2, JRST SQUEEZ] TSEWIN: MOVE I1,USERT+1 ; Get AOBJN ptr to mapped symbol/val pairs TSEDLP: MOVE I2,1(I1) ;SEE IF WE HAVE THE SYMBOL CAMN I2,SQUOZR JRST [MOVE I2,(I1) MOVEM I2,EONLY MOVNI I1,2 MOVEM I1,NAMESW SETZM NAMEHK MOVE I2,[440600,,NAMEHK] MOVEM I2,NAMEBP ;AND BP POPJ P,] ADDI I1,1 AOBJN I1,TSEDLP ;FALL OUT IF NO SYMBOL SKIPA A,[ASCIZ /?U?/] TSEILL: MOVE A,[ASCIZ /?CH?/] PUSHJ P,NAMA SETOM EONLY SETZM NAMESW POPJ P, TSNAME: CAIN I1,177 ;RUBOUT? JRST RUBOUT SKIPE ONAMSW JRST TSLNAM SKIPN NAMCOM ;COMMAND SET? JRST [.IOT NTYO,[";] CAMN I1,"; POPJ P, ;NO SEMI COMMANDS, PLEASE MOVEM I1,NAMCOM ;NO. MAKE THIS THE COMMAND .IOT NTYO,I1 POPJ P,] CAIE I1,40 ;END COMMAND ON SEPARATOR CAIN I1,^I JRST TSSEM1 CAIE I1,^M CAIN I1,^J JRST TSSEM1 SKIPL EONLY JRST TSNAM2 TSNAM1: MOVE I2,NAMEHK TRNE I2,77 ;6 CHARACTERS IN WORD? POPJ P, ;YES. IGNORE OTHERS CAIL I1,40 .IOT NTYO,I1 ;PRINT CHARACTER IF LEGAL MOVNI I2,2 MOVEM I2,NAMESW ;SET NAMESW TO -2 TO INDICATE NAME COMING SUBI I1,40 ;TO SIXBIT JUMPL I1,CPOPJ ;NO ILLEGAL CHARS IDPB I1,NAMEBP ;PUT IT IN HACK WORD POPJ P, TSNAM2: SETZ I2, CAIN I1,"> MOVE I2,[CAMG A,@EONLY] CAIN I1,"< MOVE I2,[CAML A,@EONLY] CAIN I1,"# MOVE I2,[CAMN A,@EONLY] CAIN I1,"& MOVE I2,[PUSHJ P,EAND] CAIN I1,54 JRST [SKIPL EWORD JRST [MOVSI I2,400000 IORM I2,EWORD JRST TSNAM3] HRRZ I2,NAMEHK HRRM I2,EWORD SETZM NAMEHK JRST TSNAM3] SKIPE I2 JRST [MOVEM I2,EINST JRST TSNAM3] CAIL I1,"0 CAILE I1,"9 JRST TSNAM1 MOVE I2,NAMEHK LSH I2,3 ADDI I2,(I1)-"0 MOVEM I2,NAMEHK MOVNI I2,2 MOVEM I2,NAMESW TSNAM3: .IOT NTYO,I1 POPJ P, TSLNAM: MOVEM I1,NAMCOM .IOT NTYO,[";] .IOT NTYO,I1 .IOT NTYO,[" ] PUSH P,I1 MOVE I2,[440600,,NAMEHK] TSLNLP: ILDB I1,I2 JUMPE I1,TSLNM1 ADDI I1,40 .IOT NTYO,I1 TRNN I2,760000 JRST TSLNLP TSLNM1: .IOT NTYO,[" ] POP P,I1 JRST TSSEM3 RUBOUT: HLRZ I1,NAMEBP CAIE I1,10600 CAIN I1,440600 ;FLUSH THIS MODE AT START OF WORD JRST [SETZM NAMESW .DISMIS [BEG1]] MOVE I1,NAMEBP LDB I2,I1 ;GET THE RUBBED OUT CHARACTER ADDI I2,40 ;TO ASCII .IOT NTYO,I2 ;PRINT IT SETZ I2, DPB I2,I1 ;DEPOSIT A ZERO DBP I1 ;DECREMENT THE BP MOVEM I1,NAMEBP ;AND SAVE IT POPJ P, RUBNUM: SKIPGE I1,UUIND .DISMIS [BEG1] LSHC I1,-3 ;RUBOUT A NUMERICAL ARGUMENT MOVEM I1,UUIND LSH I2,-41 ADDI I2,"0 .IOT NTYO,I2 SKIPN UUIND SETOM UUIND POPJ P, TSINCL: MOVE I2,[-1,,[ASCIC /C/]] .IOT TYOC,I2 SUB P,[1,,1] .DISMISS [BEG] TSINTH: AOS TSINT+1 AOS TSINT+1 POPJ P, ;INTERRUPT AT BOTTOM OF PAGE. TSINTP: IRPC X,,--More-- .IOT NTYO,["X] TERMIN SOSL SPCCNT ;ANY SPACES TYPED AHEAD => CONTINUE. JRST TSINTR SETZM SPCCNT .IOT TYIC,I1 ;ELSE WAIT FOR CHARACTER. CAIE I1,40 ;SPACE SAYS CONTINUE JRST TSINTJ ;ANYTHING ELSE HAS NORMAL EFFECT. TSINTR: .IOT NTYO,[^M] .IOT NTYO,[^J] AOS PAGEPOS .DISMISS TSINT+1 MORON: .CALL TTYGET ;TURN ON MORE INTERRUPT AGAIN .LOSE 1000 TLZ C,%TSMOR .CALL TTYSET .LOSE 1000 SETZM MORFLG JRST TSINT0 SUBTTL I/O Control - ^B, ^E, ^Y, ^N ; ^B LPTON: .OPEN LPTC,[.BAO,,'DSK SIXBIT /.PEEK./ SIXBIT />/] JRST LPTOFF IFN 340P,[ CAIN ODEV,%OD340 JRST [ .CLOSE DISC, .CLOSE DISWC, JRST .+1] ] ;340P HRROI I1,[.BYTE 7 ? ^L ? ^M ? ^M ? ^M ? ^M] .IOT LPTC,I1 MOVEI ODEV,%ODLPT JRST TSRET2 ; ^E LPTOFF: .CLOSE LPTC, TSRET3: .RESET TYOC, .DISMISS [INITY] IFN 340P,[ ; ^Y DISON: SETZM DISNOT PUSHJ P,ODIS JRST DISOFF CAIN ODEV,%ODLPT .CLOSE LPTC, MOVEI ODEV,%OD340 JRST TSRET2 ; ^N DISOFF: SETOM DISNOT .CLOSE DISC, .CLOSE DISWC, JRST TSRET3 ];340P SUBTTL "?" Command - Show command list EXPL: ATYPE [ASCIZ "Modes: "] MOVE A,RUUIND SKIPE RUUFLG MOVEM A,HLPFLG MOVSI A,-MAXMODE EXPL10: MOVE B,MDTAB(A) ; Get flags for mode TLNE B,(%MFINV) ; If it's invisible, JRST EXPL40 ; Ignore it. CTYPE 40 CTYPE 40 CTYPE @MDTAB2(A) ; Output mode command char CTYPE 40 CTYPE 40 ATYPE @MDHTAB(A) ; Output mode description string CALL CRR EXPL40: AOBJN A,EXPL10 ATYPE EXPLN2 RET EXPLN2: ASCIZ \IO Control: ^B Output to .PEEK. > ^Y Use 340 ^E Stop output to .PEEK. > ^N Stop 340 Etc: P Proceed Q Quit Z Set doze time . Current argument # Toggle radix (8/10) @ Toggle ^@ abort in C mode & Toggle output hang in C mode = Toggle host name expansion ; SIXBIT name input mode \ SUBTTL Mode "<" - Crash dump autopsy ; Note that currently this mode can only be initialized by JCL. ; If command is given while PEEKing a live system, it no-ops. CRASH: SKIPE A,CRASHF CAIN A,%JSABS JRST [TYPE "Cannot do autopsy of running system." CALL CRR TYPE "PEEK is mapping ITS " SKIPGE RUUIND ; Any argument given? JRST [ SETZM CRASHF ; No, use normal map. TYPE "normally." CALRET CRR] MOVEI A,%JSABS ; Arg given, test crash-dump code MOVEM A,CRASHF ; on live system! TYPE "with crash-dump code as a test." CALRET CRR] TYPE "Autopsy of crash dump " 6XTYPE CRSFIL CTYPE ": 6XTYPE CRSFIL+3 CTYPE "; 6XTYPE CRSFIL+1 CTYPE 40 6XTYPE CRSFIL+2 CALL CRR TYPE "Sources: ITS " 6XTYPE ITSVRS TYPE ", TS3TTY " 6XTYPE TTYVRS TYPE ", DISK " 6XTYPE DSKVRS CALL CRR MOVE A,@SYSMPT CALL SYSMS1 TYPE "BUGPC/ " MOVE B,@BUGPC CALL OCTHLF TYPE " USER/ " SONUM @USER SKIPGE U,@USER JRST NULJB MOVE A,U IDIV A,LUBLK TYPE " " ONUM A CTYPE 40 6TYPE @UNAME CTYPE 40 6TYPE @JNAME NULJB: CALL CRR MOVSI C,-16. BGACLP: MOVEI T,(C) ONUM 2,T TYPE "/ " ONUM @BUGACS CALL CRR AOBJN C,BGACLP ; Should try to trace lossage path better, show PDL, maybe other ; generally interesting stuff. RET SUBTTL Mode """ - System message buffer ; SYSMBF: Buffer of 8-word entries. ; SYSMPT: Pointer to last entry printed. Take this modulo length of buffer. ; SYSMLN: Log[2] of number of entries in buffer. ; Each 8-word entry has the format: ; 0: ,, ; 1: ; ... ; 6: ; 7: