mirror of
https://github.com/PDP-10/its.git
synced 2026-04-25 03:45:11 +00:00
6c1180aa52
Instead, use ITSNMS table. - MAGFRM doesn't need to check machine name. - But still knows about MC's config... - Look up hosts in ITSNMS table instead of a hardwired one, and use all of the ITSNMS for *.
17894 lines
490 KiB
Plaintext
Executable File
17894 lines
490 KiB
Plaintext
Executable File
.SYMTAB 7001.,5000. ;-*- MIDAS -*-
|
||
|
||
TITLE DDT
|
||
|
||
IFNDEF NSSPGS,NSSPGS==25 ;# PAGES FOR SYSTEM SYM TAB
|
||
; WARNING!! DDT really screws up when NSSPGS is too small, or if anything
|
||
; goes wrong with the initial system mapping. This should be fixed someday!!
|
||
|
||
IFNDEF NDSPGS,NDSPGS==10 ;# PAGES FOR DDT SYM TAB
|
||
IFNDEF NUSPGS,NUSPGS==3 ;# PAGES FOR DEFAULT SYMS THAT SYSTEM SUPPLIES.
|
||
IFNDEF JPDLL,JPDLL==8 ;LENGTH OF $J RING BUFFER.
|
||
IFNDEF RADNUM,RADNUM==8 ;DEFAULT IS 8 RAID REGISTERS.
|
||
IFNDEF DBGBFL,DBGBFL==20 ;LENGTH OF DEBUG INFO BUFFER.
|
||
|
||
NLEVS==7 ;LENGTH OF RING BUFFER OF .
|
||
LWTLNG==8 ;LENGTH OF RING OF $Q
|
||
NINFP==8 ;MAX NUM INF PROCEDURES
|
||
NBP==10 ;NUMBER OF BREAK POINTS
|
||
SNLLEN==10 ;NUMBER OF FILE DIRECTORIES TO REMEMBER
|
||
LPDL==300 ;MAX LENGTH PUSH DOWN LIST
|
||
FTBLNG==60. ;FROB TABLE INCREMENT LENGTH (MUST BE EVEN)
|
||
GSCLNG==20. ;$Q*5= MAX # CHARS / FROB.
|
||
FDRCL==100 ;LENGTH OF FDRC BUFFER.
|
||
NARGS==3 ;# ARGS OPERATOR CAN HAVE.
|
||
4BLKNM==10 ;NUM. 4-WD LIST ELEMENTS.
|
||
UNDFRS==4 ;2* MAX # UNDEF REFS IN EXPRESSION.
|
||
TYOBFL==20 ;# WORDS IN TTY OUTPUT BUFFER.
|
||
|
||
vpage==200 ;temporary page
|
||
vpagad=vpage_10.
|
||
uprpag==201 ;page for .BREAK 12,[..rpur,,<addr>]
|
||
upradr==uprpag_10.
|
||
|
||
ipage==210 ;Start of INQUIR's space
|
||
iplen==20 ;20 pages reserved for INQUIR database
|
||
|
||
F=0 ;FLAGS
|
||
P=1 ;PUSH DOWN
|
||
A=2 ;POINTERS TO TABLES, CORE, ETC.
|
||
B=3
|
||
C=4 ;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
|
||
D=5 ;TRANSFER DATA
|
||
W1=6
|
||
W2=7
|
||
U=10 ;DDT'S USER INDEX FOR CURRENT INF PROCEDURE
|
||
W3=11
|
||
I1=12
|
||
I2=13
|
||
I3=14
|
||
I4=15
|
||
W4=16 ;ALWAYS POINTS TO TOP OF FROB STACK.
|
||
|
||
.XCREF A,B,C,D,P,U
|
||
|
||
CALL=PUSHJ P,
|
||
RET=POPJ P,
|
||
SAVE=PUSH P,
|
||
REST=POP P,
|
||
|
||
;LEFT HALF FLAGS
|
||
|
||
FL==1,,525252
|
||
FLQ==1 ;RANDOM TEMPORARY IN COMMANDS
|
||
FLC==40 ;RANDOM TEMPORARY IN COMMANDS
|
||
FLLT==20 ;0 FOR $P, 1 FOR ^P, ETC.
|
||
FLNNUL==1 ;NOT NULL
|
||
FLPNT==2 ;POINT
|
||
FLNEGE==4 ;NEGATIVE EXPONENT
|
||
FLRO==10 ;REGISTER OPEN
|
||
FLLET==20 ;LETTER
|
||
FLUNRD==100 ;SET => RE-READ 1 CHAR IN RCH.
|
||
FLRUB==200 ;RUB OUT
|
||
FLCTLL==1000 ;SET IF RE-READING CHARS FOR ^L.
|
||
FLDEV==2000 ;SET IF FILENAME READER READING ONLY DEV & SNAME.
|
||
FLST==4000 ;$$! MODE
|
||
FLSTOP==10000 ;SET AT INT. LEVEL TO SAY CURRENT JOB WANTS TO INT., STOP .HANGING.
|
||
|
||
|
||
;TS SYMBOLS
|
||
|
||
TYIC==1
|
||
TYOC==2
|
||
USRI==3
|
||
USRO==4
|
||
UTIC==5
|
||
UTOC==6
|
||
LPTC==7
|
||
FDRC==10
|
||
COMC==11
|
||
ERRC==12
|
||
PDP6C==13 ;KEEPS PDP6 OPEN IF HAVE IT BUT NOT CURRENT JOB.
|
||
LSRC==14 ;For accessing the INQUIR database
|
||
TYIFC==15 ;FULL CHAR SET INPUT FOR .ITYIC
|
||
dirhc==16 ;channel on which HSNAME directory is kept open
|
||
|
||
STB==,,-1 ;BLOCK TYPES OF SYMBOL TABLE INFORMATION.
|
||
STBDEF==0 ;BLOCK OF SYMBOL DEFINITIONS: SQUOZE NAME ? VALUE
|
||
STBUND==1 ;BLOCK OF UNDEFINED SYMBOL REFERENCES, AS IN WHAT UNDEFL(U)
|
||
;POINTS AT.
|
||
STBFIL==2 ;4 WORDS OF DEV, FN1, FN2, SNAME OF FILE TO LOOK FOR SYM TAB IN
|
||
STBINF==3 ;RANDOM INFO COMPOSED OF SUB-BLOCKS. EACH SUB-BLOCK IS
|
||
;-<# WDS>,,<TYPE> FOLLOWED BY DATA WORDS. SUBBLOCK TYPE 1
|
||
;CONTAINS THESE WORDS: XUNAME OF ASSEMBLY, DISK FORMAT DATE OF
|
||
;ASSEMBLY, and DEV-FN1-FN2-SNAME OF SOURCE FILE.
|
||
|
||
APR==0 ;DEFINE MOST COMMON PDP10 DEVICE CODES, SO WE CAN
|
||
PI==4 ;PUT THEM IN OUR SYMBOL TABLE.
|
||
PTP==100
|
||
PTR==104
|
||
TTY==120
|
||
LPT==124
|
||
DIS==130
|
||
|
||
ERLOSS=50000,, ;INTERNAL ERROR, TYPE VARIOUS LOCATIONS AND @EFFECTIVE ADDRESS.
|
||
;THIS IS UUO THAT GOES THRU SYSTEM SO WON'T CLOBBER .JPC.
|
||
7NRTYP=31000,, ;7TYPE THEN GSNLRT
|
||
ERSTRT=32000,, ;STRING RETURN ERROR MESSAGE
|
||
7TYPE=33000,,
|
||
CTYPE=34000,, ;TYPE EFF ADR AS CHAR
|
||
STRT=35000,,
|
||
OPNER=36000,,
|
||
TERR=37000,,
|
||
|
||
MINUUO==31
|
||
|
||
DEFINE TSOPEN A,B
|
||
IFSN A,FDRC,[ .OPEN A,B
|
||
OPNER B]
|
||
IFSE A,FDRC,[ PUSHJ P,FDRCOP
|
||
B
|
||
OPNER FDRCO]
|
||
TERMIN
|
||
|
||
DEFINE TSCALL A
|
||
.CALL A
|
||
ERLOSS
|
||
TERMIN
|
||
|
||
DEFINE TSCLO A
|
||
.CALL A
|
||
OPNER A
|
||
TERMIN
|
||
|
||
NIOCHN==20 ;NUMBER OF ITS I/O CHANNELS.
|
||
BUSRC==100000 ;USER-CONTROLLED BIT IN .USTP VARIABLE.
|
||
|
||
SNFUSER==60 ;FOREIGN USER SYSTEM DEVICE CODE (.STATUS)
|
||
|
||
OPNLBP==220600 ;B.P. TO OPEN-LOSS CODE FIELD IN .STATUS'S VALUE.
|
||
|
||
%PICL1==1 ;BIT IN HAKINT FOR RQ'ING REPRINTING OF :SEND.
|
||
%pidir==40000,,0 ;bit in HAKINT for RQ'int mail checking
|
||
|
||
DEFINE INFORM A,B
|
||
IF1,[PRINTX \A = B
|
||
\]TERMIN
|
||
|
||
DEFINE INSIRP A,B
|
||
IRPS FOO,,[B]
|
||
A,FOO
|
||
TERMIN TERMIN
|
||
|
||
DEFINE SYSCLE A,B
|
||
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
|
||
ERLOSS
|
||
TERMIN
|
||
|
||
DEFINE SYSCAL A,B
|
||
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
|
||
TERMIN
|
||
|
||
define calblk a,b
|
||
setz ? sixbit /A/ ? b ((setz))
|
||
termin
|
||
|
||
DEFINE SYSCLO A,B
|
||
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
|
||
OPNER @.-1
|
||
TERMIN
|
||
|
||
;RIGHT HALF FLAGS
|
||
R.==525252
|
||
R.OUT==4 ;OPDECODER FLAGS
|
||
|
||
R.NAF==200 ;NEGATIVE ADDRESSES PERMISSABLE
|
||
R.BPLF==2 ;BPLOC REF AS ADDR
|
||
R.OLOADF==10 ;SET => :OLOAD, CLEAR FOR $L.
|
||
|
||
NAF==R.NAF ? BPLF==R.BPLF ? OLOADF==R.OLOADF
|
||
|
||
;FLAGS IN SQUOZE SYMBOL.
|
||
%SY==1,,537777 ;BIT TYPEOUT MASK.
|
||
|
||
%SYHKL==400000 ;1 => HALF-KILLED.
|
||
%SYKIL==200000 ;1 => FULLY KILLED (IGNORE ALWAYS).
|
||
%SYLCL==100000 ;1 => LOCAL SYMBOL. EXCEPT FOR PROGRAM NAMES & BLOCK NAMES,
|
||
%SYGBL==040000 ;1 => GLOBAL SYMBOL. EITHER %SYGBL OR %SYLCL SHOULD BE ON.
|
||
|
||
%SYFLG==740000 ;ALL THE FLAG BITS. ALL 0 => PROGRAM NAME OR BLOCK NAME.
|
||
|
||
;ERROR COMMENTS
|
||
|
||
;TMJ=TOO MANY JOBS
|
||
;INT=RIGHT HALF INTERUPT
|
||
;CKS=CHECK SUM ERROR
|
||
;BIN=IOC ENCOUNTERED ON LOAD
|
||
;CFT=CAN'T FLUSH TTY
|
||
;JOB=NO CURRENT JOB
|
||
;UNF=UNFLAPPABLE (UDISMOUNT FAILED)
|
||
;DSN=DISOWN LOST
|
||
;LOGIN=YOU ARE NOT LOGGED IN
|
||
;PUR=TRIED TO WRITE IN READ ONLY CORE
|
||
|
||
|
||
LOC 41
|
||
JSR UUOH
|
||
|
||
FORTY: 0
|
||
JSR SUUOH ;HANDLE RETRUNABLE UUOS (THEY'RE ALL ERRORS)
|
||
-TSINTL,,TSINT ;INTERRUPT TABLE POINTER.
|
||
lockw: 0 ;lock chain pointer
|
||
-crtlng,,crtab ;critical routines table
|
||
0 ? 0 ? 0
|
||
STBDDT ;WHEN DON'T HAVE SYMS, DO @52$$/ ^Y
|
||
VERSUN::
|
||
VRSADR: .FNAM2 ;VERSIO NUMBER TO APPEAR IN DDTBUG DUMP FILES.
|
||
|
||
;DDT'S USER VARIABLES, USUALLY INDEX OF U.
|
||
USRS:
|
||
UUNAME: 0
|
||
UJNAME: 0
|
||
INTBIT: 0 ;INTERRUPT BIT IF INFERIOR, 0 IF FOREIGN, SIGN BIT IF PHONY INFERIOR (SYS, PDP6).
|
||
URANDM: 0 ;RANDOM WORD, WITH FIELDS AS FOLLOWS:
|
||
$URBPT==000400 ;0 => NORMAL; NOT 0 => WE ARE PROCEEDING FROM A BPT,
|
||
;AND THIS FIELD IS THE BPT NUMBER. PREVENTS THAT BPT
|
||
;FROM BREAKING THE NEXT TIME IT IS HIT.
|
||
%urdps==1000 ;Deposit OK. See N2ACR
|
||
%urctx==200 ;Job has been ^X'd, and hasn't yet returned.
|
||
%urfrn==400 ;Job is a foreign job, do not reown!
|
||
%urusr==160 ;mask of bits that user can read and write.
|
||
%urmal==100 ;set => no mail arrivals announced while this job is running
|
||
%urfrz==40 ;set => no output permission for other jobs while this job runs
|
||
%urgag==20 ;set => no unsolicited typeouts while this job is running.
|
||
$urgag==040100 ;Byte Pointer to %URGAG
|
||
|
||
UINT: 0 ;#0 => JOB INT'D DDT, IS WAITING TO RETURN.
|
||
UPI0: 0 ;THE 1ST WD INTS THAT STOPPED THE JOB & CALLED DDT.
|
||
UPI1: 0 ;THE 2ND WD INTS THAT DID SO.
|
||
PPC: 0 ;PROGRAM COUNTER
|
||
XECPC: 0 ;PC SAVE ON $X OR $G.
|
||
UINTWD: 0 ;-5 => STOPPED BY SYSTEM CALL WHEN .UTRAP SET
|
||
;-4 => STOPPED BY ..PERMIT=0.
|
||
;-3 => STOPPED BY A MAR THAT ABORTED THE INSN (KA'S ONLY) (SIC)
|
||
;-2 => MULTI-STEPPING RETURN ($^N OR ^N)
|
||
;-1=>STOP ON RANDOM INT
|
||
;0=> RUNNING (OR WAITING TO RETURN, IF UINT NOT 0)
|
||
;1 - 8 => STOPPED BY THAT NUMBERED BREAKPOINT
|
||
;16 => .BREAK 16,
|
||
;21 => LOADED, NOT YET STARTED
|
||
|
||
XINTWD: 0 ;SAVE UINTWD ON $X
|
||
JTIME: 0 ;SEE FNJOB
|
||
UIND: 0 ;JOB NUMBER (IN SYSTEM)
|
||
USTYPE: 0 ;TYPE OF MULTI-STEPPING TO DO IN THIS JOB (BITS USTYPB - USTYPZ)
|
||
BPBEG:: ;HERE THROUGH BPEND ZEROED BY ^K'ING.
|
||
MARADR: 0 ;MAR SETTING (FOR TURNING BACK ON WHEN TRIPPIING TURNS IT OFF)
|
||
MARXCT: 0 ;-> ASCII STRING IN JOB'S CORE, TO USE AS DDT CMDS WHEN MAR TRIPPED.
|
||
MARCON: 0 ;CONDITIONAL MAR INSTRUCTION.
|
||
NBPTB: 0 ;-1 ON CONDITIONAL BPT BREAK 0 NORMAL
|
||
BPCPC: 0 ;PC SAVE ON CONDITIONAL BPT
|
||
CBPPS: 0 ;RH UINT (SAVE BPT #) LH EFFECTIVE ADDRESS OF INSTRUCTION FOR PROCEED
|
||
INCNT: 0 ;COUNT FOR LIMITED PROCEED
|
||
OIPCHK: 0 ;$$^N STOP ADDRESS
|
||
USCNT: 0 ;# TIMES TO MULTI-STEP, NEG => FOREVER.
|
||
BTADR: 0 ;ADDR OF TEMP. BPT. PAIR (0 => NONE). LH < 20 => IT IS ADDR OF PDL
|
||
BTPDL: 0 ;IF LH OF BTADR <20, THIS IS CONTENTS TO LOOK FOR IN PDL.
|
||
BTINS: 0 ? 0 ;THESE HOLD INSNS REPLACED BY THE TEMP BPTS.
|
||
BPINFL: 0 ;4.9 - BPTS INSERTED, 1.N - AUTO-PROC BPT N.
|
||
B1ADR: 0 ;ADDRESS OF BPT(RH) LOC TO PRINT OUT (LH)
|
||
BPCON: 0 ;CONDITIONAL BPT INSTRUCTION
|
||
B1CNT: 0 ;PROCEED COUNT
|
||
B1INS: 0 ;INSTRUCTION REPLACED BY .BREAK
|
||
BPL==B1INS-B1ADR+1
|
||
BLOCK <NBP-1>*BPL
|
||
BPEND::
|
||
STARTA: 0 ;0, OR JRST TO START ADDR.
|
||
LIMIT: 0 ;LOW-DEFAULT-SEARCH-LIMIT,,HIGH-DEFAULT-LIMIT.
|
||
PERMIT: 0 ;-1 => CAN EXECUTE VALRET STRINGS
|
||
SYSUUO: -1 ;0 => USE .UTRAP TO STOP AT SYSTEM CALLS.
|
||
PATCHL: 0 .SEE PATOPN ;IF PATCHING, PATCHED-FROM,,PATCH-AREA, ELSE 0.
|
||
LITCNT: 0 .SEE N2ARPR ;<# OF LAST DEFINED LITERAL>,,<# OF LAST ASKED-FOR LITERAL>
|
||
TPERCE: 0 ;$% TYPEOUT MODE FOR THIS JOB.
|
||
TAMPER: 0 ;$& MODE.
|
||
TDOLLA: 0 ;$$ (ALT-DOLLAR) MODE.
|
||
TPRIME: 0 ;$' MODE.
|
||
TDQUOT: 0 ;$" MODE.
|
||
TNMSGN: 0 ;$# MODE.
|
||
SAFE: 0 ;-1 => OBJECT BEFORE KILLING THIS JOB AT USER'S REQUEST.
|
||
USPARE: 0 ;THIS VARIABLE IS A SPARE, FOR PATCHING.
|
||
UFNAMD: 0 ;LOADED FILE'S DEV, ETC.
|
||
UFNAM1: 0
|
||
UFNAM2: 0
|
||
UFNAMS: 0
|
||
UFILE: 0 ;$L, $Y, ETC. FILE.
|
||
UFILE1: 0
|
||
UFILE2: 0
|
||
UFILES: 0
|
||
UFLSYS: 0 ;SET IF DEV. SHOULD BE CLOBBERED TO DSK BY $Y.
|
||
UHACK: 0 ;.BREAK 12, HACKS
|
||
UIACK: 0 ;.BREAK 16, HACKS
|
||
UCHBUF: 0 ;AOBJN -> COMMAND (:JCL) BUFFER. (IN SYM TAB SPACE)
|
||
BININF: 0 ;AOBJN -> RANDOM INFO LOADED AND DUMPED.
|
||
UNDEFL: 0 ;AOBJN -> LIST OF UNDEF SYM ENTRIES (IN SYMTAB SPACE)
|
||
RADAOB: 0 ;AOBJN -> STORAGE FOR DISPLAY PROCESSOR DATA.
|
||
PRGM: 0 ;SYMTAB TAIL -> HEADER OF CURRENT BLOCK.
|
||
JOBSYM: 0 ;LEAVE JOBSYM LAST
|
||
USRLNG==.-USRS
|
||
BLOCK USRLNG*<NINFP-1>
|
||
|
||
|
||
USREND=NINFP*USRLNG ;1ST USR-IDX NOT ALLOWED IN U.
|
||
L==USRLNG ;AS IN ITS
|
||
INFORM [Storage per Luser]\USRLNG
|
||
|
||
SUUOHA: 0
|
||
SUUOHD: 0
|
||
|
||
SUUOH: 0 ;HANDLE ERLOSS AND SYSTEM-RETURNED UUOS.
|
||
.SUSET [.RJPC,,UUOJPC]
|
||
jrst suuohp ;Go hack this UUO in the PURE area
|
||
|
||
UUOH: 0 ;save real local uuos.
|
||
jrst uuohp ;Go hack the UUO in pure space
|
||
UERFLN: SIXBIT / ERR/
|
||
2
|
||
UERFLC: .
|
||
|
||
uopaca: 0 ;saved A for OPNER's
|
||
uopacd: 0 ;saved D for OPNER's
|
||
|
||
;USED IN --MORE-- PROCESSING.
|
||
MORONP: 0 ;-1 => **MORE** TURNED OFF.
|
||
MORMSG: 0 ;NONZERO => -> SPECIAL MSG TO USE INSTEAD "FLUSHED"
|
||
MORFLG: 0 ;-1=> READ FROM TTY ONLY DESPITE INPTR
|
||
MORNRO: 0 ;-1 => RUBOUT WON'T FLUSH AFTER NEXT --MORE--.
|
||
MORNHU: 0 ;-1 => NEXT **MORE** WON'T BE FOLLOWED BY HOME-UP.
|
||
MORRET: 0 ;PC AT CALL TO MORINI.
|
||
MORPRP: 0 ;0 IF NO --MORE-- PROC., ELSE P AT CALL TO MORINI.
|
||
MOREXP: 0 ;-1 IF EXPLICITLY CAUSING A --MORE-- OR --<ANYTHING ELSE>--.
|
||
|
||
;LOW-LEVEL INPUT PROC. VARS.
|
||
INNCTL: 0 ;-1 => IGNORE ^B, ETC. IN FILES & VALRETS.
|
||
INPDL: 0 ;0, OR -> HEAD OF INPUT SOURCE PDL.
|
||
INPTR: 0 ;0 => INPUT FROM TTY.
|
||
;<0 => INPUT FROM COMC.
|
||
;>0 => IT IS B.P. TO VALRET STRING, INVAOB IS AOBJN -> WHOLE STRING.
|
||
LIMBO: 0 ;MOST RECENTLY READ CHARACTER.
|
||
INVAOB: 0 ;IF INPTR POSITIVE, THIS IS AOBJN -> VALRET STRING.
|
||
UNRCHF: 0 ;-1 => RE-READ LIMBO.
|
||
UNECHF: 0 ;IF UNRCHF -1, THIS -1 => RE-ECHO IT, TOO.
|
||
TTYUNR: -1 ;POS. => IT IS CHAR TO BE RE-READ WHEN INPUT FROM
|
||
;TTY (NOT FILE OR VALRET STRING) IS DESIRED.
|
||
|
||
INIOPS: 0 ;-1 => A CMD FILE HAS BEEN INPUSHED BUT NOT .IOPUSHED.
|
||
TOKTRM: 0 ;SET BY RTOKEN IFF TOKEN ENDED WITH ^M OR ^J.
|
||
ratflg: 0 ;-1 => @ and % terminate RTOKEN
|
||
|
||
IFILE: SIXBIT/DSK @ BIN/
|
||
0 ;ALTERNATE DEFAULT FOR $L.
|
||
|
||
CU: -1 ;CURRENT JOB'S IDX, OR -1 IF NO CURRENT JOB.
|
||
NJ1: @ ;COUNT USED FOR DETERMINING MOST RECENT JOB (SEE FNJOB)
|
||
NJ2: @ ;COUNT USED FOR DETERMINING LEAST RECENT JOB (")
|
||
UCHNLO: 0 ;0 => NO USER OPEN, OR THIS JOB IS SYS.
|
||
;+ => FOREIGN USER (INCLUDING SELF).
|
||
;-1 => INFERIOR OR PDP6
|
||
SIXCTR: 0 ;NUMBER OF JOBS THAT ARE THE PDP6.
|
||
SYSSW: 0 ;SET IF JOB IS SYS.
|
||
DDTSW: 0 ;SET IF THIS JOB IS SELF.
|
||
SYSDPS: 0
|
||
SYSSTB: 0 ;SET IF HAVE SYS SYM TAB ABS PGS.
|
||
DEBUGP: -1 ;SET IF DEBUGGING DDT.
|
||
RUNFLG: 0 ;-1 => DDT HAS BEEN RUN.
|
||
|
||
$X=34
|
||
|
||
ALARMV: 0 ;0 => ALARM CLEAR. ELSE TIME ALARM WILL OR SHOULD HAVE
|
||
;TRIPPED, IN 60THS, ASSUMING SYSTEM STARTED AT T=0.
|
||
ALARMW: 0 ;TIME SINCE SYSTEM STARTUP FOR THE NEXT
|
||
;PRINTING OF HAKKAH'S RANDOM TYPEOUTS, OR 0.
|
||
;DDT SHOULD BE AWAITING A REALTIME INT IFF EITHER OF THESE ISN'T 0.
|
||
|
||
MONMDL: 0 ;TEMP. MONIT MODE (SET FROM MONMOD AT EACH ENTRY
|
||
;TO MAIN LOOP; TURNED OFF IF THE PHONY : IS RUBBED OUT,
|
||
;THUS TEMPORARILY LEAVING MONIT MODE.
|
||
|
||
NOMSGF: 1 ;ZERO => DEFER ALL UNSOLICITED MSGS (EXCEPT SYSTEM DOWN WITHIN 15 MIN).
|
||
GAGF: 1 ;ZERO => GAGGED AGAINST :SENDS.
|
||
TW2FL: 0 ;TEMP. USED BY ^P AND $^P TO DISTINGUISH THEMSELVES.
|
||
;0 FOR ^P, 1 FOR $^P, -1 FOR $$^P. (See TW1FL, below)
|
||
|
||
|
||
SETBEG:: ;User options (things allowable for the user to set) begin here
|
||
|
||
DIRDIR: 0 ;-1 => $$^F (without numeric arg) uses arg for new PFILES.
|
||
|
||
DIRFN1: SIXBIT /NAME1/ ;Table of $$^F DIR: search options.
|
||
DIRFN2: SIXBIT /UP/
|
||
SIXBIT /FIRST/ ;$$1^F finds FN1
|
||
0 ; can make sense to store FN2 as PFILE1
|
||
SIXBIT /SECOND/ ;$$2^F finds FN2
|
||
SIXBIT /BIN/
|
||
SIXBIT /CDATE/ ;$$3^F ascending in creation age
|
||
SIXBIT /DOWN/
|
||
SIXBIT /SIZE/ ;$$4^F descending in size
|
||
SIXBIT /DOWN/
|
||
SIXBIT /NOT/ ;$$5^F not backed up
|
||
SIXBIT /DUMPED/
|
||
SIXBIT /ONLY/ ;$$6^F just link pointers
|
||
SIXBIT /LINKS/
|
||
DIRFNN==7. ;Total number of DIR: hacking slots.
|
||
|
||
NDROP: BLOCK DIRFNN
|
||
NDRDEV: REPEAT DIRFNN, <'DSK>,,PFILE
|
||
NDRDIR: REPEAT DIRFNN, MSNAM,,PFILES
|
||
NDRFN1: REPEAT DIRFNN, PFILE1
|
||
NDRFN2: REPEAT DIRFNN, PFILE2
|
||
|
||
MONMOD: 0 ;-1 => MONIT MODE (GENERATE COLONS FOR USER)
|
||
|
||
MSK: -1 ? ,-1 ? -1,, ? 0 17, ? (17) ? 777000,, ? -1 ? -1 ;MASKS FOR $W, $N.
|
||
|
||
UNPURF: -1 ;NONZERO => AUTOMATIC UNPURIFY ON DEPOSIT IN INFERIOR.
|
||
|
||
MSTYPE: USTYPU+USTYPB+USTYPP
|
||
;DEFAULT USTYPE VAR. FOR NEWLY CREATED JOBS.
|
||
|
||
DOZTIM: 1 ;# SECONDS TO WAIT EACH MULTI-STEP IF USTYPZ SET.
|
||
|
||
SENDRP: -2 ;# 60.'THS OF SECOND BETWEEN REPETITIONS OF :SENDS, ETC.
|
||
;0 => DON'T REPEAT (EXCEPT ON RETURN TO DDT)
|
||
;-1 => DON'T PRINT UNTIL RETURN TO DDT.
|
||
|
||
BELCNT: 5 ;DEFAULT NUMBER OF BELLS WHEN DDT GRABS TTY
|
||
|
||
CLOBRF: -1 ;-1 => FOO^K WHEN JOB FOO EXISTS QUERIES THE USER.
|
||
;ZEROED BY <NAME>$U. NOT CHANGED BY :LOGIN.
|
||
GENJFL: -1 ;NONZERO => :<PRGM> ACTS LIKE :NEW <PRGM>. 0 => LIKE ^K.
|
||
|
||
PCPNTF: 0 ;NONZERO => WHEN NEXT INSN TO BE EXECUTED IS PRINTED,
|
||
;ALSO OPEN THE AC AND EFF ADDR IT REFERENCES.
|
||
|
||
ckqflg: -1 ;-1 => read thru cr for ":FOO"
|
||
;before trying to open TS FOO.
|
||
;0 => Error out when getting the space after a command which is
|
||
;not found
|
||
;1 => Beep but do not error on getting the space after
|
||
;non-existant command
|
||
|
||
NFVRBS: -1 ; -1 => Makes NFDIR searching be verbose.
|
||
; 0 => Do not print directory name used for command.
|
||
|
||
delwarn:1 ; 0 => no warnings.
|
||
; 1 => "(Delete File)" warning on ^O.
|
||
; 2 => warnings on a few other 1-char file commands.
|
||
; 3 => Warn of impending lossage with LINKF and LINKNF commands
|
||
|
||
MORWARN:1 ;0 => NO WARNINGS FOR --MORE--'S; 1 => SAY "(SPACE=YES, RUBOUT=NO)".
|
||
|
||
confrm: 1 ;0 => No confirmation required for $$^X, $U and $^X
|
||
|
||
masscp: 0 ;non-zero => $$^X. kills all jobs
|
||
|
||
linkp: 0 ;>0 => $^O links files link :LINKNF, <0 => like :LINKF
|
||
|
||
TWAITF: -1 ;-1 => %TBINT BIT OF NEW JOBS IS SET; 0 => IT IS CLEARED.
|
||
|
||
TW1FL: 0 ;0 => ^P CLEARS %TBWAT ALLOWING DTTY INTERRUPTS,
|
||
;WHILE $^P SETS %TBWAT PREVENTING SUCH INTS.
|
||
;-1 INTERCHANGES ^P AND $^P.
|
||
|
||
PROMPT: CTYPE "* ;PROMPT-INSTRUCTION, IN CASE USER WANTS TO CLOBBER IT.
|
||
rprmpt: 7type [asciz /A[DDT]/] ;prompt given on return to DDT
|
||
|
||
sndflg: 0 ;nonzero means :SEND should run program "SEND"
|
||
|
||
omailf: 0 ;zero means :prmail should offer to delete, negative means
|
||
;rename to OMAIL, and positive to never delete or rename
|
||
|
||
pmlflg: 0 ;nonzero means $^A should act like :PRMAIL (i.e. ask whether
|
||
;or not to delete your mail)
|
||
|
||
PRMMCH: 0 ;-1 => INCLUDE THE MACHINE'S NAME (AI, ML, ETC) IN THE PROMPT.
|
||
|
||
c.zprt: -1 ;zero if wish simple [DDT] on ^Z and ^_D
|
||
|
||
OCOFL: -1 ;-1 => NON-REQUESTED (HAKKAH) TYPEOUTS CAN GO THROUGH COM MODE.
|
||
|
||
SMLINS: MOVE ;# OF LINES OF A :SEND TO PRINT OUT BEFORE SAYING --MORE--
|
||
;OR (N MORE LINES).
|
||
|
||
SYMOFS: 100 ;LARGEST ALLOWED <N> FOR WHICH <SYM>+<N> MAY BE PRINTED OUT.
|
||
|
||
BYERUN: 0 ;-1 => RUN :BYE AT LOGOUT TIME.
|
||
|
||
DPSTOK: 0 ;-1 => $$^R OK on non-SYS jobs
|
||
|
||
JSTOPT: 0 ;Job Status display (%PIJST handler) options.
|
||
;The RH says what kind of info we like.
|
||
; -1 => Muzzled -- just dismiss.
|
||
; 0 => If DDT has TTY, about DDT state.
|
||
; 1 => If DDT has TTY, about ITS state.
|
||
; 2 => About ITS state always.
|
||
%JS==:1,,525252 ;The LH bits detail the info's format:
|
||
%JSSYM==:400000 ;Autoload syms for symbolic typeout (ha ha)
|
||
%JSRAD==:200000 ;Show 1st RAID in place of UPC.
|
||
%JSTRA==:100000 ;Show job tree trace to target.
|
||
|
||
SETEND:: ;End of user-setable locations
|
||
|
||
INTACS: BLOCK 16.
|
||
INTJPC: 0
|
||
|
||
;STUFF RELATING TO TYPEOUT MODES IS ON THIS PAGE.
|
||
|
||
;USED BY OP-CODE CONVERSION RTNS.
|
||
PNTR: INST
|
||
CHP: 0
|
||
TXT: BLOCK 2
|
||
|
||
SAVPDL: 0
|
||
|
||
INST: 0
|
||
TEM: 0
|
||
TEM1: 0
|
||
|
||
N2ACCS: 0 ;LAST SYMBOL TYPED BY SPT SAVED HERE FOR $$^C.
|
||
SPTS: JRST TOUT
|
||
TOCTEM: 0 ;HOLDS RADIX DURING TOC.
|
||
|
||
TYPMOD:: ;BEGINNING OF INFO THAT DEFINES THE CURRENT TYPEOUT MODE.
|
||
|
||
SATPC: 0 .SEE SATP ;MOST RECENT $T MASK.
|
||
|
||
BITPAT: 0 ;PATTERN FOR MAIN BIT TYPEOUT MODE.
|
||
BITPA1: 0 ;PATTERN FOR ALTERNATE BIT TYPEOUT MODE.
|
||
BITSYM: 0 ;SYMBOL PREFIX FOR MAIN BIT TYPEOUT MODE.
|
||
BITSY1: 0 ;SYMBOL PREFIX FOR ALTERNATE BIT TYPEOUT MODE.
|
||
|
||
;CURRENT MODE
|
||
SCH: -1,,PIN ;MAIN TYPEOUT MODE - PIN,HLFW,TFLOT,SATP,ITEXO,PIN,FTOC
|
||
AR: PADR ;ADDRESS TYPEOUT MODE (PADR OR PADA)
|
||
ODF: 10 ;RADIX.
|
||
BITF: 0 ;-1 => BIT MODE IS SELECTED.
|
||
|
||
TYPMOE:: TYPMOL==.-TYPMOD
|
||
|
||
SCHM: -1,,PIN ;PERMANENT MODE
|
||
ARM: PADR
|
||
ODFM: 10
|
||
BITFM: 0
|
||
|
||
SCHMM: -1,,TFLOT ;MODE TO RETYPE IN
|
||
ARMM: PADR
|
||
ODFMM: 10
|
||
BITFMM: 0
|
||
|
||
RAIDFL: -1 ;NONZERO => AUTOMAITCALLY DISPLAY RAID REGISTERS WHEN JOB RETURN.
|
||
RADSIZ: RADNUM ;# OR RAID REGISTERS TO ALLOCATE TO EACH JOB.
|
||
RADTOP: 1 ;NONZERO => AUTOMATIC RAIDFLG DISPLAY IS AT SCREEN TOP, NOT AT CURSOR.
|
||
RADING: 0 ;-1 WHILE DISPLAYING RAID REGS.
|
||
RADCLR: 0 ;-1 IF HAVE DONE A CLEAR-SCREEN OR --MORE-- SINCE LAST RAID REG DISPLAY.
|
||
|
||
NOTTY: 0 ;-1 => WE DON'T REALLY HAVE A TTY TO USE, SINCE "TTY:" WAS TRANSLATED
|
||
;TO SOME OTHER SORT OF DEVICE.
|
||
DDTTY: -1 ;-1 =>TTY IN DDT
|
||
TTYSTL: 0 ;-1 => HAVE TTY BUT IT'S STOLEN FROM INFERIOR, SHOULD GIVE IT BACK SOON.
|
||
;-1 OR POSITIVE => OCO (IN TTYCOM) HAS BEEN BOUND ON, AND SHOULD
|
||
;BE UNBOUND TO OLD VALUE IN TTYSCM SOON.
|
||
RSTDEL: 0 ;SET BY RETURNING JOB => DON'T .RESET TYIC, OR PUSH INPUT STREAM.
|
||
TTNRST: 0 ;SET BY RUBOUT ERROR OR ^D => DON'T .RESET TYIC,
|
||
|
||
STOPWT: 0 ;-1 => DDT MAIN PROGRAM LEVEL IS WAITING FOR CURRENT JOB
|
||
;TO INTERRUPT AND SET FLSTOP.
|
||
|
||
TEM3: 0
|
||
XCRFSW: 0 ;-1 => DON'T TYPE CRLF WHEN PROCEEDING
|
||
|
||
NALTXF: 0 ;-1 WHILE DOING $X INSIDE DDT ITSELF - PREVENTS DDT BUG FILES
|
||
;FROM BEING WRITTEN IF LOSER EXECUTES A LOSING INSTRUCTION.
|
||
|
||
;:MSGS STUFF
|
||
MSGDAT: 0 ;DATE S.T. EARLIER MSGS AREN'T TYPED.
|
||
MSGLDT: 0 ;BEFORE 1ST FILE, -1; ELSE DATE OF LAST FILE STARTED.
|
||
MSGTDT: 0 ;TODAY'S DATE AND TIME (IN :MSGS)
|
||
MSGLOG: 0 ;SET AT ENTRY TO AUTOMATIC :MSGS AT LOGIN.
|
||
msgloc: 0 ;location of our MSGS database entry.
|
||
|
||
msgdip: 0 ; pointer to DISTRIB field if found
|
||
|
||
msgpag==:340 ;first page to map MSGS file into
|
||
msglen==:20 ;up to 20 pages are allocated!
|
||
|
||
MSGF3: 'DSK,,
|
||
0?0
|
||
MSGSNM: SIXBIT /.MSGS./ ;F.D. TO LOOK IN
|
||
|
||
XBLK.==25
|
||
CBPB==26
|
||
BPBLK==31
|
||
XBLK$X==34
|
||
XBLK$Q=37
|
||
|
||
26SAV: 0 ;COND B.P. INSN
|
||
.BREAK 16,110000
|
||
.BREAK 16,310000
|
||
31SAV: 0 ;PROCEED FROM BPT THAT SHOULDN'T BREAK.
|
||
JRST
|
||
JRST
|
||
34SAV: 0 ;$X
|
||
.BREAK 16,500000
|
||
.BREAK 16,700000
|
||
|
||
clirpc: 0 ;number of :SENDS not yet printed for last time.
|
||
clirpx: 0 ;number of :SENDs received since last at DDT
|
||
|
||
clufn1: 0 ;user being sent to <UNAME>.
|
||
|
||
malits: 0 ;0 or ITS to hack for mail
|
||
;;;The next 3 words are indexed off w1 and must be in this order!
|
||
bugdev: 'COM,,
|
||
clidev: sixbit /CLI/ ;device to do CLI on (CLI, MCCLI, etc.)
|
||
'DSK,,
|
||
|
||
bufbeg: 0 ;Beginning of the message buffer
|
||
CLUXUN: 0 ;XUNAME OF USER BEING :SENT TO, IN CASE HE LOGS OUT.
|
||
|
||
NCTLTA: 0 ;ARG TO ^T, ^U PUT HERE.
|
||
NCTLTF: BLOCK 9 ;USED FOR FILENAMES BY ^T, ^U.
|
||
|
||
ERROPN: 'ERR,,
|
||
3
|
||
0 ;STATUS WORD
|
||
|
||
HOLPPX: POP D,.(D) ;USED BY HOLE
|
||
|
||
NLTNWX: JUMPE\JUMPN I1,NALTN5
|
||
|
||
NCOMNM: 0 ;0, OR NAME OF :-CMD NOW IN PROGRESS.
|
||
XRWI: 0 ;-1 => SKIP AND RETURN ON MPV,
|
||
;UNPURIFY ON PUR (ONLY IF UNPURF SET), ASSUMES ADDR IN A.
|
||
|
||
UUOJPC: 0 ;.JPC SAVED ON ERLOSS OR BAD UUO.
|
||
|
||
NCOLSB: 0 ;B SAVED AT NCOL FOR DEBUGGING
|
||
NCOLSC: 0 ;C
|
||
NCOLSD: 0 ;D
|
||
|
||
DBGBFR: BLOCK DBGBFL ;DEBUGGING BUFFER. RIGHT NOW, OPERATORS EXECUTED
|
||
DBGBFP: DBGBFR ;ARE PUSHED ONTO IT FIRST.
|
||
|
||
TQUITR: 0 ;NONZERO => DON'T QUIT NOW.
|
||
TQUITW: -1 ;NONNEG => ^G SEEN WHEN TQUITR SET.
|
||
|
||
dskful: 0 ;The IOC error just gotten by HAKCLI was due to disk full
|
||
|
||
EFIELP: 0 ;RESTORE P ON PDL OVERFLOW IN EFIELD.
|
||
ERRSTP: 0 ;RESTORE P ON ERROR UUOS (EXCEPT ^D, ^G, ERLOSS)
|
||
ERRSTL: [ERLOSS];RESTORE PC. ERROR BEFORE IT'S OK IS DDT BUG.
|
||
|
||
ERRNPP: 0 ;LAST P RESTORED ON ERROR.
|
||
ERRNPC: 0 ;LAST PC RESTORED ON ERROR.
|
||
ERROPP: 0 ;P BEFORE LAST RESTORATION OF P ON ERROR.
|
||
FLSNPP: 0 ;LAST P RESTORED BY MORE-FLUSHING.
|
||
FLSOPP: 0 ;P BEFORE LAST RESTORATION DUE TO MORE-FLUSHING.
|
||
|
||
fdrcls: 0 ;non-zero iff we don't want CTLF1 and friends to close FDRC
|
||
;on EOF
|
||
CTLDFL: 0 ;-1 => ^D HAS BEEN SEEN AT INT LVL, SEARCHES SHOULD STOP.
|
||
CTLZFL: 0 ;-1 => ^Z SEEN AT INT LVL - ASSUME USER INTENDED IT FOR
|
||
;SOME INFERIOR, SO STOP INFERIOR AT NEXT OPPORTUNITY
|
||
;(CLEARED WHEN DDT NEEDS TTY INPUT)
|
||
|
||
VPAGCT: -1 ;>= 0 => HAVE FRESH PAGE AT VPAGE.
|
||
SYSSML: 0 ;-1 + PAGE # OF LOWEST ABS PAGE OF ITS SYMBOLS WE HAVE MAPPED.
|
||
HCLOB: 0 ;-1 => HACTRN HAS BEEN DEPOSITED IN.
|
||
HHACK: -1 ;location of last deposit, if hactrn has been deposited in
|
||
;other than legitimately
|
||
|
||
mchcnt==:40 ;# ITS's
|
||
mchtab: block mchcnt
|
||
|
||
;;; Switches for entry by PWORD program at starting address plus offset
|
||
;;; (offset <5)
|
||
pwordp: 0 ; -1 -> entered at DDT + offset
|
||
initp: -1 ; -1 -> run init if logged in at startup
|
||
; set 0 for even offfsets from DDT
|
||
|
||
VPATCH: block 20 ;Always 20 words of impure free, at least
|
||
|
||
INFORM [Top of low impure]\.-1
|
||
|
||
.=<.+1777>/2000*2000 ;TO PAGE BNDRY
|
||
LIMPUR:: ;REAL TOP OF LOW IMPURE PAGES.
|
||
|
||
SYSSMP==./2000
|
||
BLOCK NSSPGS*2000 ;SYS SYM TAB ABS PGS GO HERE.
|
||
SYSSYM==.-2000
|
||
SYSAOB==.-2 ;DDT-2, AOBJN -> SYS SYM TAB (IN SYS ADDRESS SPACE)
|
||
|
||
BLOCK NDSPGS*2000 ;DDT SYM TAB GOES HERE IN PURE PGS.
|
||
STBDE:
|
||
|
||
STBSPG==./2000 ;# OF 1ST OF 2 PAGES FOR USYMS AND CALLS.
|
||
BLOCK NUSPGS*2000
|
||
|
||
MINPUR==<.+1777>/2000
|
||
|
||
uuohp: save a
|
||
SAVE D
|
||
NUUOPS==2
|
||
LDB D,[331100,,40]
|
||
CAIGE D,40
|
||
CAIGE D,MINUUO
|
||
CAIA ;SKIP IF INVALID UUO.
|
||
JRST UUOH1
|
||
.SUSET [.RJPC,,UUOJPC]
|
||
MOVE A,40
|
||
MOVEM A,FORTY ;MAKE THE LDB D, IN SUUOHP DO THE RIGHT THING.
|
||
REST D
|
||
REST A
|
||
HRROS SUUOH ;MARK THIS LOSSAGE AS DUE TO A USER-UUO SO THAT
|
||
JRST SUUOHP ;PERSON ANALYZING CRASH WON'T THINK SUUOH HAS ADDR OF LOSSAGE.
|
||
|
||
UUOH1: SKIPGE UUOTAB-MINUUO(D)
|
||
UUOH2: PUSHJ P,ERTTY ;MAKE TTY OK TO USE FOR ERR MSG.
|
||
JRST @UUOTAB-MINUUO(D)
|
||
|
||
suuohp: movem a,suuoha
|
||
MOVEM D,SUUOHD ;DON'T CLOBBER A PDL SLOT.
|
||
SKIPE DEBUGP
|
||
.VALUE
|
||
LDB D,[331100,,FORTY]
|
||
CAIN D,ERLOSS_-33
|
||
JRST UERLOS
|
||
JRST UUOH3
|
||
|
||
|
||
$$OVLY==1
|
||
$$ULNM==0
|
||
$$ULNP==0
|
||
$$UNAM==0
|
||
$$HSNM==1
|
||
|
||
lsrtns"E==d+1 ;gotta have it (sigh)
|
||
datime"E==d+1 ;(double sigh)
|
||
|
||
.insrt syseng;lsrtns >
|
||
|
||
.insrt syseng;msgs >
|
||
|
||
$$OUT==1 ;We want the date output routines
|
||
.insrt syseng;datime >
|
||
|
||
crtab: ;Critical routines table for :MSGS database
|
||
msgs"critic
|
||
crtlng==.-crtab
|
||
|
||
|
||
;;; Try to map in the Inquire database. Skips if mapped.
|
||
|
||
maplsr: movei a,lsrc ;channel for LSRTNS to hack
|
||
push p,b
|
||
move b,[-iplen,,ipage] ;AOBJN ptr to pages for LSRTNS to hack
|
||
call lsrtns"lsrmap
|
||
jrst [ pop p,b
|
||
ret ]
|
||
pop p,b
|
||
aos (p)
|
||
ret
|
||
|
||
unmapl: move b,[-iplen,,ipage]
|
||
syscal corblk,[%climm,,0 ;delete the pages
|
||
%climm,,%jself
|
||
b]
|
||
erloss ; huh? can't delete them?
|
||
.close lsrc,
|
||
ret
|
||
|
||
;;; GETHSN takes the XUNAME in C, returns HSNAME in C.
|
||
;;; GETHS0 is similar but takes XUNAME in B and ITS name in C
|
||
|
||
geths0: push p,a
|
||
push p,b
|
||
push p,d
|
||
call maplsr ;Map in the Inquire database.
|
||
jrst [ move c,b ; If can't, just pretend HSNAME=XUNAME.
|
||
jrst geths9 ]
|
||
jrst geths1
|
||
|
||
gethsn: push p,a
|
||
push p,b
|
||
push p,d
|
||
call maplsr ;Map in the INQUIR database.
|
||
jrst geths9 ; If can't, just pretend HSNAME=XUNAME.
|
||
move b,c ;get the XUNAME in B
|
||
setz c, ;0 means local site
|
||
geths1: push p,b ;Remember the XUNAME for later
|
||
movei a,lsrc ;channel for INQUIR database
|
||
movei d,fdrc ;channel to hack for directory opens
|
||
call lsrtns"lsrunm ;map in the LSRTNS entry
|
||
jrst [setz b, ; no entry, note by clearing B
|
||
jrst .+2]
|
||
aos -4(p) ;skip since there's an INQUIR entry
|
||
pop p,a ;Get our XUNAME
|
||
call lsrtns"lsrhsn ;collect the HSNAME
|
||
jfcl ; Might have been Device Not Available
|
||
move c,d ;Get our answer
|
||
.close fdrc, ;no more channels open
|
||
call unmapl ;unmap the INQUIR database
|
||
geths9: pop p,d ;restore the world
|
||
pop p,b
|
||
pop p,a
|
||
ret
|
||
|
||
;; OPMAIL clobbers A, takes the XUNAME to look for in B, and either 0 in C
|
||
;; or an ITS to over-ride the one specified in INQUIR. It will return
|
||
;; the HSNAME in A, the XUNAME in B, and the ITS name in C
|
||
|
||
opmail: push p,d ;Don't clobber D
|
||
push p,c ;remember the ITS name we were given
|
||
push p,b ;save XUNAME for later
|
||
call maplsr ;map in the database
|
||
jfcl ; Eh? Were gonna lose quick - here goes...
|
||
movei a,lsrc
|
||
movei d,fdrc
|
||
call lsrtns"lsrunm ;find this person in INQUIR
|
||
jrst [setz b, ; Remember that there was no INQUIR entry
|
||
jrst inqmal] ;and get his HSNAME from INQUIR
|
||
jumpn c,inqmal ;If we were given an explicit ITS, look only there
|
||
movei a,lsrtns"i$neta ;check out the network address field
|
||
call lsrtns"lsritm ;dig it out!
|
||
jrst inqmal
|
||
movem a,netabp ;remember where this info is
|
||
move d,a ;D gets the BP to the NET Adress
|
||
call read6 ;read a token
|
||
jrst inqmal
|
||
caie c,"% ;Did he terminate in an % or @?
|
||
cain c,"@
|
||
jrst [call getits ;yes, use this for the XUNAME
|
||
jrst inqmal ;somehow this is garbage!
|
||
jrst inqml0] ;OK, NOW we got the site
|
||
call mchokp ;Is this a valid ITS?
|
||
jrst [ call notits ; Tell him about forwarded mail
|
||
jrst inqmal] ; and don't fuck with the machine name
|
||
inqml0: movem a,-1(p) ;salt machine name away
|
||
|
||
inqmal: move a,(p) ;remember our XUNAME
|
||
movei d,fdrc ;channel to open the directory on
|
||
move c,-1(p) ;remember our ITS
|
||
skipn c ;is it unspecified?
|
||
move c,itsnam ; Use current
|
||
movem c,-1(p) ;and salt this improved version away
|
||
call lsrtns"lsrhsn ;get the HSNAME
|
||
jrst [ skipn ddtty ;If we've got the TTY, tell him he lost
|
||
7type [asciz /(Net or INQUIR error)
|
||
/] ; Eh??? Tell the user.
|
||
move a,(p) ;use our XUNAME as the HSNAME
|
||
jrst inqml5]
|
||
aos -3(p) ; Skip return
|
||
move a,d ;collect the HSNAME
|
||
inqml5: call unmapl
|
||
inqml6: pop p,b ;and the XUNAME
|
||
pop p,c ;recover the ITS name
|
||
pop p,d ;remember D (unchanged)
|
||
ret
|
||
|
||
|
||
read6: setz a,
|
||
push p,b
|
||
move b,[440600,,a]
|
||
6readl: ildb c,d
|
||
cain c,40
|
||
jrst 6readl ; spaces are ignored.
|
||
cain c,"% ; % is a terminator
|
||
jrst mpopj1
|
||
caie c,"@ ; @, comma are terminators
|
||
cain c,",
|
||
jrst mpopj1
|
||
cain c,^Q ; let ^Q quote a character.
|
||
ildb c,d
|
||
caige c,40
|
||
jrst mpopj1 ; control chars terminate even if ^Q'd
|
||
cail c,140
|
||
subi c,40
|
||
subi c,40
|
||
tlne b,770000
|
||
idpb c,b
|
||
jrst 6readl
|
||
|
||
mpopj1: pop p,b
|
||
skipe a ;unless this is a null entry
|
||
aos (p)
|
||
popj p,
|
||
|
||
|
||
;; person said FOO@BAR
|
||
|
||
getits: push p,a ;remember the FOO part
|
||
pushj p,read6 ;get more of it
|
||
setz a, ; not there! Fail return
|
||
jumpe a,popaj ;if null, same as not there
|
||
call mchokp ;is this a known machine?
|
||
jrst gtitsx ;If not an ITS, same as not there!
|
||
move c,a ;That was the ITS name
|
||
movei a,lsrc
|
||
pop p,b ;recover our XUNAME
|
||
movem b,-1(p) ;and set the XUNAME saved on the stack
|
||
call lsrtns"lsrunm ;Find the new frobule
|
||
setz b, ; No INQUIR entry for that XUNAME
|
||
move a,c
|
||
jrst popj1
|
||
|
||
gtitsx: pop p,a
|
||
move a,-2(p) ;use whatever ITS was specified!
|
||
jrst notits ;Tell him the mail goes off of ITS
|
||
|
||
;;; Expects BP to net address in NETABP, prints same with message
|
||
notits: 7type [asciz /A(This person's mail is forwarded to /]
|
||
notit1: ildb d,netabp ;get a char
|
||
jumpe d,[ 7type [asciz /)
|
||
/] ; if that's the end, that's all, so finish the line
|
||
popj p,]
|
||
call tout ;type the char
|
||
jrst notit1 ;and get the next
|
||
|
||
;;; canonicalize and check the machine name. (Handles MIT-MC and MC)
|
||
;;; Takes machine in A, returns canonicalized machine in A
|
||
|
||
mchokp: camn b,[sixbit /DSK/] ;= machine we're on
|
||
jrst [move a,itsnam ? jrst popj1]
|
||
push p,b
|
||
ldb b,[143000,,a] ;get the MIT- of MIT-xx
|
||
camn b,[sixbit / MIT-/] ;Was it in that form?
|
||
jrst [ ldb a,[001400,,a] ;Get the xx part
|
||
lsh a,30 ;put it in it's place
|
||
jrst .+1]
|
||
call mchok0 ;is this a real machine?
|
||
caia
|
||
bret: aos -1(p)
|
||
pop p,b
|
||
popj p, ;no more nexts, bad!
|
||
|
||
mchok0: camn a,[sixbit /DSK/] ;is this the local machine?
|
||
jrst [ move a,itsnam ? jrst popj1] ;then use that instead
|
||
movsi b,-mchcnt ;for all the machines
|
||
mchok1: camn a,mchtab(b) ;is it this one?
|
||
jrst popj1 ; yes, it's OK
|
||
skipe mchtab(b)
|
||
aobjn b,mchok1 ;no, try next
|
||
ret
|
||
|
||
;;; GTMAIL takes in A the FN2, B a XUNAME, an ITS name in C, or 0 meaning
|
||
;;; wherever his mail would normally be found, and opens on FDRC the mail file
|
||
;;; for that user. If it fails, it will not skip, and return a .CALL type error
|
||
;;; code in D. It will also return the HSNAME in A, the XUNAME in B, and the
|
||
;;; ITS name in C.
|
||
|
||
gtmail: movem a,tfile+2 ;save the fn2 of the file we're after
|
||
call opmail ;Find the mail to look at
|
||
camn b,xuname ;is this the same XUNAME and
|
||
came c,itsnam ; is this from this machine?
|
||
caia ; no, gotta tell the user
|
||
jrst gtmal9 ; yes, don't bother telling user.
|
||
gtmal5: 7type [asciz /A(Checking mail from /]
|
||
movem b,tfile+1
|
||
camn c,itsnam ;Is it from this ITS?
|
||
movsi c,'DSK ; yes, use DSK instead
|
||
movem c,tfile
|
||
move b,a ;B has gotta be the SNAME
|
||
movei a,tfile ;print out the filenames
|
||
call lfile0
|
||
move a,b ;recover A from it's hiding place in B
|
||
move b,tfile+1 ;recover B from it's hiding place in TFILE
|
||
move c,tfile ;recover C from it's hiding place in TFILE
|
||
ctype ") ;balance!
|
||
call terpri ;new line!
|
||
call tyofrc ;force out the message so he knows why he's waiting
|
||
gtmal9: syscal open,[%clbit,,.bii ? %climm,,fdrc ? c ? b ? tfile+2 ? a
|
||
%clerr,,d]
|
||
caia ; no skip
|
||
aos (p) ; found it, skip return
|
||
jumpe d,cpopj ;no error, we win!
|
||
caie d,%ensfl ;Was it that the file wasn't there?
|
||
opner @gtmal9 ; No, bad lossage, tell him.
|
||
ret
|
||
|
||
DDT: jrst ddt.0 ;entry for DDT^K and for systems without
|
||
;pwords.
|
||
jrst ddt.1 ;entry for :LOGIN form
|
||
jrst ddt.2 ;entry for :LOGIN <user> -bf
|
||
jrst ddt.3 ;entry for <user>$U
|
||
jrst ddt.4 ;entry for <user>$0U
|
||
|
||
|
||
ddt.0: SKIPE RUNFLG
|
||
JRST DD1B ;NOT FIRST START.
|
||
SETOM RUNFLG ;FIRST, INITIALIZE.
|
||
JRST DDT2
|
||
|
||
ddt.4: setzm initp ;note that we don't want the init run
|
||
ddt.3: setzm clobrf ;set up for sophistcated users
|
||
setzm morwarn
|
||
setom c.zprt ;Sophisticated users understand PDP-10 instr
|
||
jrst ddt.1 ;go start up
|
||
|
||
ddt.2: setzm initp ;note we don't want init file run
|
||
ddt.1: .suset [.runame,,runame] ;get our uname
|
||
setzm logdin ;notice that we are already logged in
|
||
setom pwordp ;and that we were started via PWORD
|
||
jrst ddt.0 ;and go do what DDT does!
|
||
|
||
;CHECK FOR POSSIBILITY THAT OUR UNAME HAS CHANGED, AND HANDLE IT IF IT DID.
|
||
;CLOBBERS B.
|
||
DDTUNM: .SUSET [.RUNAM,,B] ;IF UNAME HAS CHANGED SINCE LAST LOOKED,
|
||
CAMN B,RUNAME ;TELL THE USER, AND UPDATE INTERNAL VARS.
|
||
RET
|
||
SAVE C
|
||
SAVE D
|
||
MOVE D,B
|
||
CALL NUTYP2 ;TYPE OUT THE NEW UNAME.
|
||
CALL DDTUN1 ;REALIZE THAT UNAME HAS CHANGED.
|
||
REST D
|
||
JRST POPCJ
|
||
|
||
NUTYP2: CTYPE 40 ;UNAME HAS CHANGED, SAY SO.
|
||
PUSHJ P,SIXTYP
|
||
CTYPE 33
|
||
MOVEI D,"U
|
||
JRST TOUT
|
||
|
||
;COPY SYSTEM'S VERSION OF UNAME INTO DDT'S VERSION.
|
||
;CLOBBERS B, D.
|
||
DDTUN1: .SUSET [.RUNAM,,C] ;LOOK AT CURRENT UNAME, AND UPDATE VARS FROM IT
|
||
.suset [.rxuname,,xuname]
|
||
MOVEM C,RUNAME ;UPDATE ALL DDT'S MEMORIES OF THE UNAME.
|
||
HLRZ B,C ;SET LOGDIN ACC. TO WHETHER WE ARE LOGGED IN.
|
||
CAIE B,-1
|
||
SETZM LOGDIN
|
||
SAVE C
|
||
SAVE U
|
||
SETZB U,D ;NOW, IF OUR UNAME CHANGED, OUR INFERIORS' DID TOO.
|
||
DDTUN7: SKIPE UUNAME(U) ;LOOK AT JOBS WE KNOW AND FIND THEIR CURRENT NAMES.
|
||
SKIPN UJNAME(U)
|
||
JRST DDTUN8 ;(DON'T LOOK AT UNUSED JOB SLOTS).
|
||
SKIPGE INTBIT(U) ;FOR PHONY INFERIORS (SYS, PDP6)
|
||
JRST [ MOVE C,RUNAME
|
||
MOVEM C,UUNAME(U) ;WE KNOW THE UNAME IS SUPPOSED TO CHANGE.
|
||
JRST DDTUN8]
|
||
move b,uind(u) ;get the user index for this job
|
||
syscal OPEN,[ %clbit,,.bii\10 ;open without reowning
|
||
%climm,,fdrc ? [sixbit /USR/]
|
||
%climm,,%jsnum(b) ;open by job number
|
||
%climm,,0] ;with JNAME=0
|
||
jrst ddtun8 ;job nonexistent?? throw up hands.
|
||
move c,[-4,,[ sixbit /UNAME/ ? movem uuname(u) ;get the new UNAME
|
||
sixbit /JNAME/ ? movem ujname(u)]] ;and the new JNAME
|
||
syscle USRVAR,[ %climm,,fdrc ? c]
|
||
|
||
DDTUN8: ADDI U,USRLNG
|
||
CAIGE U,USREND ;LOOK AT ALL JOB SLOTS.
|
||
JRST DDTUN7
|
||
REST U
|
||
JRST POPCJ
|
||
|
||
; Given (in C) the actual LOGIN-NAME, caluclate the XUNAME.
|
||
; Assumes you've just come in from PWORD, and if the XUNAME is
|
||
; different from the UNAME, don't change it, but do set the HSNAME.
|
||
; (The XUNAME can be different when the user said FOOBAR and got FOOBA0)
|
||
|
||
ddtunp: camn c,xuname ; is the XUNAME different?
|
||
jrst ddtun0 ; no, do the last-digist checking
|
||
move c,xuname ; get our real XUNAME
|
||
movem c,tuname ; TUNAME starts out normal
|
||
movem c,sndflt ; that's our SENDS default too!
|
||
call gethsn ; get the HSNAME to use
|
||
jfcl ; Don't care if it's the default or not
|
||
movem c,hsname ; just use it as our home directory
|
||
.suset [.shsname,,c] ; both internally and in the system
|
||
movem c,thsnam ; including for the temporary one
|
||
jrst ddtmsp ; put the MSNAME where it goes, too.
|
||
|
||
;GIVEN (IN C) THE ACTUAL OR DESIRED LOGIN-NAME, CALCULATE THE XUNAME
|
||
;FROM IT BY PERHAPS FLUSHING TRAILING DIGIT, AND SET IT UP;
|
||
;ALSO SET THE MSNAME AND SOME OTHER SNAMES FROM THE XUNAME.
|
||
|
||
;ALSO, Set the HSNAME!
|
||
|
||
;CLOBBERS B, C, D.
|
||
ddtun0: push p,c ;if there is an init file for the real uname,
|
||
call gethsn ;If RJL1 has no HSNAME entry,
|
||
jrst ddtun9 ; then go compute winning one
|
||
|
||
pop p,b
|
||
movem b,xuname ;this UNAME is your "real" name
|
||
;so after RJL1$U, XUNAME is still RJL1, not RJL
|
||
movem b,tuname
|
||
movem b,sndflt ;Make our ^A default our XUNAME
|
||
movem c,hsname
|
||
movem c,thsname
|
||
.suset [.shsname,,hsname]
|
||
jrst ddtmsp ;and hack the HSNAME
|
||
|
||
ddtun9: setz b, ;b <- 6*< # chars @ end uname, flushed so far>
|
||
move c,(p) ;-1(p) will have real uname.
|
||
save c ;(p) has result of flushing any trailing digit
|
||
syscal OPEN,[ %climm,,fdrc ? ['DSK,,] ? ['.FILE.] ? [SIXBIT /(DIR)/]
|
||
(p)]
|
||
caia
|
||
jrst ddtun2 ;found a name that corresponds to a DSK dir?
|
||
ddtun5: lsh c,(b) ;look at next char from the end
|
||
andi c,77
|
||
movei d,(c) ;remember the character
|
||
JUMPE C,DDTUN4 ;IF A SPACE, KEEP GOING FORWARD PAST IT.
|
||
CAIL C,'0
|
||
CAILE C,'9
|
||
JRST DDTUN3 ;NON-DIGIT => CAN'T IGNORE IT; GIVE UP.
|
||
DDTUN4: SUBI B,6 ;LAST CHAR IS SPACE OR DIGIT; FLUSH IT.
|
||
CAMG B,[-44]
|
||
JRST DDTUN3 ;ENTIRE UNAME IS SPACES & DIGITS?? HOPELESS!
|
||
MOVNS B
|
||
LSH C,-6(B)
|
||
MOVNS B
|
||
ANDCAB C,(P) ;FLUSH THAT DIGIT FROM THE END OF THE UNAME,
|
||
jumpe d,ddtun5 ;and try again, if that wasn't a non-blank
|
||
call gethsn ;was non-blank, see if real user
|
||
jrst [ move c,(p) ; Recover the name so far
|
||
jrst ddtun5] ; and try again
|
||
call ddtunh ;save the HSNAME where it belongs
|
||
move c,(p) ;recover the XUNAME
|
||
call ddtxun ;and salt that away where people care
|
||
rest c ;and clean up the stack and exit
|
||
rest b
|
||
ret
|
||
|
||
DDTUN3: REST C ;COME HERE TO GIVE UP ON ATTEMPT TO FLUSH
|
||
REST C ;TRAILING DIGITS; USE REAL UNAME UNMODIFIED.
|
||
JRST DDTUN6
|
||
|
||
ddtunx: .suset [.rxuname,,c] ;get the system provided XUNAME
|
||
jrst ddtun6 ;otherwise like DDTUN6
|
||
|
||
|
||
ddtxun: movem c,xuname ;the XUNAME is your "real" name
|
||
;so after FOO1$U, xuname is FOO.
|
||
movem c,tuname
|
||
movem c,sndflt ;Make our ^A default our XUNAME
|
||
.suset [.sxunam,,c]
|
||
ret
|
||
|
||
DDTUN2: REST C ;COME HERE ON SUCCESSFUL TRUNCATION;
|
||
REST B ;USE TRUNCATED UNAME (NOW IN C).
|
||
DDTUN6: call ddtxun ;save away our XUNAME where it belongs
|
||
call gethsn ;Convert XUNAME to HSNAME
|
||
jfcl ; don't care at this point if default or not
|
||
ddtunh: movem c,hsname ;set home dir
|
||
movem c,thsnam
|
||
syscal USRVAR,[ %climm,,%jself ? [sixbit /HSNAME/] ? c]
|
||
jfcl
|
||
jrst ddtmsn
|
||
|
||
;; DDTMSP prints out what the home directory is, if it's not the same as
|
||
;; the XUNAME, and sets up the MSNAME
|
||
|
||
ddtmsp: move c,xuname ; check the XUNAME
|
||
camn c,hsname ; do we have a directory of our own?
|
||
jrst ddtmsn ; Yes, don't say anything!
|
||
|
||
7type [asciz /A[Home dir=/]
|
||
move d,hsname
|
||
call sixtyp ;tell the user what his home directory is
|
||
7type [asciz /]
|
||
/]
|
||
call tyofrc
|
||
move c,hsname ; recover the directory name again
|
||
|
||
;SET UP MSNAME FROM SIXBIT WORD IN C.
|
||
DDTMSN: MOVEM C,MSNAM
|
||
IRPS X,,PFILE XFILEF WFILE IFILE FFILE opndev
|
||
MOVEM C,X+3
|
||
TERMIN
|
||
MOVEM C,LSNAM
|
||
AOSN B,C ;IF NOT ______,
|
||
POPJ P,
|
||
SOJA B,NFDIR1 ;PUT IN SNAME SEARCH LIST.
|
||
|
||
SSTATB: calblk SSTATU,[
|
||
%CLOUT,,D ;DIETIM
|
||
%CLOUT,,A ;SYSDBG
|
||
%CLOUT,,TEM ;SUSRS
|
||
%CLOUT,,TEM2 ;MEM ERRS
|
||
%CLOUT,,TEM3 ;TIME
|
||
%clout,,itsnam] ;SIXBIT OF AI OR ML or MC or.
|
||
|
||
ddtdbm: asciz /ITS being debugged!
|
||
/
|
||
|
||
;PRINT A SYSTEM-GOING-DOWN MESSAGE.
|
||
DDTGDM: SAVE D
|
||
MOVE D,ITSNAM ;TYPE NAME OF MACHINE - AI, ML OR DM.
|
||
CALL SIXTYP
|
||
REST D
|
||
7TYPE [ASCIZ / ITS going down in /]
|
||
IDIVI D,30.
|
||
PUSHJ P,TMPT
|
||
CALL CRF
|
||
pushj p,fdrcop ;open the file
|
||
[sixbit /SYS DOWN MAIL/]
|
||
popj p, ; No file
|
||
call ctlf1 ;print it out
|
||
jrst terpri ;newline
|
||
|
||
MAXSHR: 61 ;page # from SYS:TS MACSYM to share with
|
||
;to count MACSYMA's. Should be different than
|
||
;the one PFTHMG uses!
|
||
KSSTAT: PUSH P,[NLTL2]
|
||
KSSTA1: call terpri
|
||
TSCALL SSTATB
|
||
SKIPE A
|
||
7TYPE DDTDBM
|
||
JUMPL D,KSSTA2 ;NEGATIVE=>FOREVER
|
||
PUSHJ P,DDTGDM
|
||
KSSTA2: MOVE A,TEM
|
||
MOVE D,LOGDIN
|
||
AOSN D
|
||
AOS A ;YOU'RE NOT LOGGED BUT SHOULD COUNT
|
||
caig a,1 ;you're the only one?
|
||
jrst [7type [asciz /You're all alone, Fair share = /]
|
||
jrst kssta3]
|
||
PUSHJ P,G9PNT
|
||
7TYPE [ASCIZ / Lusers, Fair Share = /]
|
||
kssta3: MOVE A,SLOADU ;GET VALUE OF SLOADU IN SYSTEM SYM TAB.
|
||
CALL FETCHA ;READ SLOADU OUT OF SYSTEM.
|
||
SETZ D,
|
||
MOVEI A,10000.
|
||
IDIVM A,D
|
||
MOVEI W1,10.
|
||
MOVEM W1,TOCTEM
|
||
CALL TOCA ;DECIMAL PRINT 10000/SLOADU, NO PERIOD.
|
||
CTYPE "%
|
||
movsi a,(sixbit /MC/)
|
||
came a,itsnam ;Is this on MC?
|
||
jrst kssta4 ; No, no MACSYMA's anyway! Don't do the OPEN
|
||
syscal open,[ %clbit,,.uii ? %climm,,fdrc ? [sixbit /SYS/]
|
||
[sixbit /TS/] ? [sixbit /MACSYM/]]
|
||
jrst kssta4 ;Not there???
|
||
syscal corblk,[ %climm,,%cbndr ? %climm,,%jself ? %climm,,ipage
|
||
%climm,,fdrc ? maxshr] ;Map in the
|
||
;page
|
||
jrst kssta4 ; Eh? Punt!
|
||
syscal cortyp,[ %climm,,ipage ? %clout,,a ? %clout,,a ? %clout,,a
|
||
%clout,,a] ;RH(A) gets 1+# of MACSYMA's
|
||
jrst kssta4 ; Eh? Punt!!
|
||
syscal corblk,[ %climm,,0 ? %climm,,%jself ? %climm,,ipage] ;Delete
|
||
erloss ;the page
|
||
.close fdrc,
|
||
movei a,-1(a) ;A gets # of MACSYMA's
|
||
jumpe a,[ 7type [asciz / No MACSYMAs./]
|
||
jrst kssta4]
|
||
7type [asciz /, /]
|
||
call g9pnt ;Print the # of MACSYMA's
|
||
7type [asciz / MACSYMA/]
|
||
sose a ;unless singular
|
||
ctype "s ; make it plural
|
||
ctype ".
|
||
|
||
kssta4: SKIPN A,TEM2
|
||
POPJ P,
|
||
call terpri
|
||
CALL G9PNT
|
||
7TYPE [ASCIZ / memory errors in /]
|
||
MOVE A,TEM3
|
||
IDIV A,[10800.] ;GET NUM HOURS SYS UP, TIMES 10.
|
||
IDIVI A,10.
|
||
SAVE B ;SAVE TENTHS OF HOURS.
|
||
CALL G9PNT ;PRINT # HOURS, A DOT, AND # OF TENTHS.
|
||
REST D
|
||
CTYPE "0(D)
|
||
7TYPE [ASCIZ / hours./]
|
||
RET
|
||
|
||
|
||
;:VERSIO COMMAND - PRINT VERSIO NUMBERS OF DDT AND ITS,
|
||
;AND PRINT TTY #, UNAME AND JNAME.
|
||
KVERSI: PUSH P,[NLTL2]
|
||
KVERS1: call terpri ;be sure to start on a fresh line
|
||
TSCALL SSTATB ;GET NAME OF SYSTEM (AI OR ML)
|
||
MOVE D,ITSNAM
|
||
CAMN D,[SIXBIT/DM/]
|
||
SETOM ESSYM ;ON DM, EVAL SYMS IN E&S SYM TAB.
|
||
PUSHJ P,SIXTYP ;PRINT IT.
|
||
STRT [SIXBIT / ITS./]
|
||
.RSYSI D,
|
||
PUSHJ P,SIXTYP
|
||
7TYPE [ASCIZ /. DDT./]
|
||
MOVE D,VERSUN
|
||
PUSHJ P,SIXTYP
|
||
CTYPE ".
|
||
CALL CRF
|
||
MOVE D,LOGDIN
|
||
AOJE D,KVERS2
|
||
MOVE D,RUNAME
|
||
7TYPE [ASCIZ/USR:/] ;NOW PRINT UNAME AND JNAME OF DDT.
|
||
CALL SIXTYP
|
||
CALL TSPC
|
||
.SUSET [.RJNAM,,D]
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ/, /]
|
||
KVERS2: 7TYPE [ASCIZ/TTY /]
|
||
MOVE A,TTYNUM
|
||
JRST G8PNT ;PRINT TTY NUMBER IN OCTAL.
|
||
|
||
; COLON-COMMAND TABLE; ENTRIES LOOK LIKE
|
||
; SIXBIT/COMMAND/
|
||
; [ASCIZ/DESCRIPTION/],,ROUTINE
|
||
|
||
DEFINE NCTABE A,B
|
||
SIXBIT/A/
|
||
B+IFB B,A
|
||
TERMIN
|
||
|
||
;IF YOU CHANGE THESE COMMANDS, BE SURE YOU CHANGE .INFO.;DDT :CMNDS
|
||
;(AS WELL AS DDTORD >)
|
||
|
||
NCTAB: NCTABE 6TYPE,K6TYPE
|
||
NCTABE 8TYPE,K8TYPE
|
||
NCTABE ALARM,,
|
||
NCTABE ALSO,KALSO
|
||
NCTABE ASSIGN,KASSIGN,
|
||
NCTABE ATB,KATB
|
||
NCTABE ATTACH,KATTACH,
|
||
NCTABE CHUNAM,KCHUNA,
|
||
NCTABE CLEAR,KCLEAR,
|
||
NCTABE CONTIN,KCONTIN,
|
||
NCTABE COPY,KCOPYD,
|
||
NCTABE COPYD,KCOPYD
|
||
NCTABE COPYN,KCOPYN
|
||
NCTABE CORBLK,KCORBL
|
||
NCTABE CORPRT,KCORPRT
|
||
NCTABE CORTYP,KCORTYP
|
||
NCTABE CWD,KCWD
|
||
NCTABE DATPRT,KDATPRT
|
||
NCTABE DATWRD,KDATWRD
|
||
NCTABE DDTMOD,KDDTMOD,
|
||
NCTABE DDTSYM,KDDTSYM,
|
||
NCTABE DELETE,KDELETE,
|
||
NCTABE DESIGN,KDESIGN,
|
||
NCTABE DETACH,KDETACH,
|
||
NCTABE DISOWN,KDISOWN,
|
||
NCTABE ELSE,KELSE
|
||
NCTABE ERR,KERR,
|
||
NCTABE EXISTS,KEXISTS,
|
||
NCTABE FJOB,KFJOB
|
||
NCTABE FLAP,KFLAP,
|
||
NCTABE FORGET,KFORGET
|
||
NCTABE GAG,KGAG,
|
||
NCTABE GENJOB,KGENJOB,
|
||
NCTABE GO,KGO,
|
||
NCTABE GZP,KGZP,
|
||
NCTABE HELP,KHELP,
|
||
NCTABE IF,KIF,
|
||
NCTABE INFLS,,
|
||
NCTABE IOPEN,KIOPEN
|
||
NCTABE ICHAN,KICHAN
|
||
NCTABE INPOP,KINPOP,
|
||
NCTABE INPUSH,KINPUS,
|
||
NCTABE INTEST,KINTEST,
|
||
NCTABE INTPRT,KINTPRT,
|
||
NCTABE JCL,KJCL,
|
||
NCTABE JCLPRT,KJCLPRT
|
||
NCTABE JOB,KJOB,
|
||
NCTABE JOBP,KJOBP
|
||
NCTABE JUMP,KJUMP
|
||
NCTABE KILL,KKILL,
|
||
NCTABE LFILE,KLFILE,
|
||
NCTABE LINK,LINK,
|
||
NCTABE LINKF,LINKF,
|
||
NCTABE LINKN,KLINKN
|
||
NCTABE LISTB,KLSTB,
|
||
NCTABE LISTF,,
|
||
NCTABE LISTJ,KLSTJ,
|
||
NCTABE LISTP,KLSTP,
|
||
NCTABE LISTS,SLIST
|
||
NCTABE LISTU,KLSTU,
|
||
NCTABE LJCL,KLJCL
|
||
NCTABE LOAD,KLOAD,
|
||
NCTABE LOGIN,KLOGIN,
|
||
NCTABE LOGOUT,,
|
||
NCTABE LRUN,KLRUN
|
||
NCTABE MAILNT,KMAILNT
|
||
NCTABE MASSAC,,
|
||
NCTABE MONMOD,KMONMOD,
|
||
NCTABE MORE,KMORE,
|
||
NCTABE MOVE,KMOVE
|
||
NCTABE MSGS,,
|
||
NCTABE NEW,KNEW
|
||
NCTABE NEWTTY,KNEWTTY,
|
||
NCTABE NFDIR,KNFDIR,
|
||
NCTABE NOMSG,KNOMSG,
|
||
NCTABE OFDIR,KOFDIR,
|
||
NCTABE OLOAD,KOLOAD,
|
||
NCTABE OMAIL,MAIL,
|
||
NCTABE OMAILA,MAILA,
|
||
NCTABE OMSG,KOMSG
|
||
NCTABE OSEND,OSEND
|
||
NCTABE OUTTES,KOUTTES,
|
||
NCTABE PDUMP,KPDUMP,
|
||
NCTABE PDUMPI,PDUMPI,
|
||
NCTABE PMDATE,KPMDATE
|
||
NCTABE PRGM,KPRGM,
|
||
NCTABE PRINT,KPRINT,
|
||
NCTABE PRMAIL,KPRMAIL,
|
||
NCTABE PRSEND,KPRSEND
|
||
NCTABE PROCED,NCTLP
|
||
NCTABE PROCEE,NCTLP,
|
||
NCTABE RAIDFL,KRAIDF
|
||
NCTABE RAIDRP,KRAIDR
|
||
NCTABE RATE,KRATE
|
||
NCTABE REAP,KREAP
|
||
NCTABE RENAME,KRENAME,
|
||
NCTABE RETRY,KRETRY
|
||
NCTABE RUN,KRUN
|
||
NCTABE SELF,KSELF
|
||
NCTABE SEND,SEND,
|
||
NCTABE SFAUTH,KSFAUT
|
||
NCTABE SFDATE,,
|
||
NCTABE SMDATE,KSMDATE
|
||
NCTABE SFDUMP,KSFDUM
|
||
NCTABE SFREAP,KSFREA
|
||
NCTABE SHOUT,KSHOUT,
|
||
NCTABE SL,KSYMLO
|
||
NCTABE SLEEP,KSLEEP,
|
||
NCTABE SLIST,,
|
||
NCTABE SNARF,KSNARF,
|
||
NCTABE SSTATU,KSSTATU,
|
||
NCTABE START,KSTART,
|
||
NCTABE SYMLOD,KSYMLOD,
|
||
NCTABE SYMADD,KSYMADD,
|
||
NCTABE SYMTYP,KSYMTYP,
|
||
NCTABE TAG,KTAG
|
||
NCTABE TERPRI,KTERPRI
|
||
NCTABE TPL,KTPL,
|
||
NCTABE TPLN,KTPLN,
|
||
NCTABE UINIT,KUINIT,
|
||
NCTABE UJOB,KUJOB
|
||
NCTABE UNPURE,KUNPURE,
|
||
NCTABE V,KV,
|
||
NCTABE VERSIO,KVERSIO,
|
||
NCTABE VK,KVK,
|
||
NCTABE VP,KVP,
|
||
NCTABE WALBEG,KWALBEG,
|
||
NCTABE WALEND,KWALEND,
|
||
NCTABE WALLP,KWALLP,
|
||
NCTABE XFILE,,
|
||
NCTABE ?,QSN,
|
||
NLCOM==.-NCTAB
|
||
|
||
BLOCK 4 ;FOR PATCHING
|
||
|
||
|
||
RRFLB: MOVEI C,UFILE(U) ;USE $L FILENAME.
|
||
JUMPL U,QJERR
|
||
; drops through to RRFL1
|
||
|
||
;; CALL THESE ONLY AFTER CALLING GSOA, UNLESS IN A COLON-CMD.
|
||
;; SET GSONUM IFF SHOULDN'T RE-READ PREVIOUS CHAR.
|
||
;; SET GSDNUM IFF SHOULD CLOBBER ^K-DEFAULTED SYS: OR SYS1; TO DSK:<MSNAME>;
|
||
;; GSENUM USED AS A FILENAME COUNTER.
|
||
;; GSFNUM SET WHEN DEVICE IS SPEC'D, TO PREVENT CLOBBERAGE TO DSK BY ";".
|
||
;; FLAG FLDEV SET READS DEV & SNAME ONLY (FOR :LISTF)
|
||
;; ON RETURN, FLNEGE IS SET IFF SNAME WAS EXPLICITLY SPEC'D.
|
||
|
||
RRFL1: TLZA F,FLDEV
|
||
RRFL4: TLO F,FLDEV ;JUST READ IN DEV & SNAME.
|
||
TLZ F,FLNEGE
|
||
PUSH P,B ;FILENAME ADDRESS IN C.
|
||
PUSHJ P,RFL9
|
||
CAIN C,NCTLTF ;DON'T SET ^F DIR IN ^T, ^U.
|
||
JRST POPBJ
|
||
SKIPN A,3(C)
|
||
MOVE A,LSNAM ;IF SNAME WASN'T SPEC'D EVER, USE DEFAULT.
|
||
MOVEM A,LSNAM
|
||
MOVEM A,3(C)
|
||
.SUSET [.SSNAM,,LSNAM] ;GET SET FOR OPENING.
|
||
CAIE C,PFILE
|
||
JRST RRFL5
|
||
MOVEM A,FFILES
|
||
MOVE D,(C) ;WHEN DIRECTORY OF PFILE IS SET, SET IT FOR ^F TOO.
|
||
MOVEM D,FFILE
|
||
JRST RRFL5
|
||
|
||
RRFL3: SAVE B
|
||
RRFL5: MOVSI B,-SNLLEN ;ADD SNAME TO SNLIS1.
|
||
MOVE D,A
|
||
RRFL2: EXCH A,SNLIS1+1(B)
|
||
CAME A,D ;FLUSH EXISTING OCCURRENCE.
|
||
AOBJN B,RRFL2
|
||
POPBJ: POP P,B
|
||
POPJ P,
|
||
|
||
RFL9: PUSH P,C
|
||
MOVE A,GSCHRP
|
||
HRRZ B,GSCHRA
|
||
SKIPN GSONUM ;UNLESS CALLER SAID SHOULDN'T,
|
||
CAIN B,(A)
|
||
JRST RFL0 ;OR NO CHARS READ YET,
|
||
TLO F,FLUNRD ;RE-READ PREV. CHAR. IN CASE $ OR CR.
|
||
|
||
;DROPS THROUGH.
|
||
|
||
;DROPS THROUGH.
|
||
;READ IN A LINE AND PROCESS IT.
|
||
RFL0: MOVEI B,RFLFN1-1 ;SAVE DEFAULT FN1, FN2 FOR ^X, ^Y.
|
||
MOVE C,(P)
|
||
PUSH B,1(C)
|
||
PUSH B,2(C)
|
||
SETZM GSFNUM ;DEVICE HASN'T BEEN SPEC'D.
|
||
SETZM GSENUM ;NEXT NAME WILL BE FN1.
|
||
MOVE B,GSDNUM
|
||
PUSHJ P,RLINEX ;READ UP TO CR OR ALTMD.
|
||
JUMPE B,RFL1 ;IF SHOULD CLOBBER SYS: TO DSK:,
|
||
AOSE UFLSYS(U) ;DID ^K DEFAULT THE NAME?
|
||
JRST RFL1
|
||
MOVSI B,'DSK ;YES, RESET TO DSK:<MSNAME>;
|
||
MOVEM B,UFILE(U) ;SO USER WON'T ACCIDENTALLY DUMP ON SYS:
|
||
MOVE B,MSNAM
|
||
MOVEM B,UFILES(U)
|
||
RFL1: PUSHJ P,RTOKEN ;READ 1 NAME.
|
||
MOVE C,(P)
|
||
PUSHJ P,RFLTN1 ;EVERYTHING ELSE STORES PRECEDING NAME NORMALLY.
|
||
CAIE D,^Y
|
||
CAIN D,^X ;^X, ^Y THEN STORE ONE OF THE DEFAULT NAMES.
|
||
JRST RFLCTX
|
||
CAIE D,",
|
||
CAIN D,^M ;THESE END ENTIRE SPEC.
|
||
JRST POPCJ
|
||
CAIN D,33 ;ALTMODE - TYPE FILE SPEC'D, ASK FOR MORE.
|
||
JRST RFLALT
|
||
JRST RFL1 ;ELSE JUST GET ANOTHER NAME.
|
||
|
||
;HANDLE THE NAME IN B
|
||
RFLTN1: CAIN D,":
|
||
JRST RFLNC ;TERMINATED BY : => IT IS DEV NAME.
|
||
CAIN D,";
|
||
JRST RFLNSC ;BY ; => IT IS SNAME.
|
||
RFLTND: JUMPE B,CPOPJ ;DO NOTHING WITH NULL NAME.
|
||
AOS A,GSENUM ;ELSE STORE IT AS NEXT NAME IN NORMAL SEQUENCE.
|
||
TLNE F,FLDEV ;(BUT IF WE'RE JUST READING A DEV AND SNAME,
|
||
JRST RFLNSC ;STORE IT AS THE SNAME)
|
||
RFLSND: JUMPE B,CPOPJ ;STORE A NAME AT A SPECIAL PLACE.
|
||
CAIN A,4
|
||
TLO F,FLNEGE
|
||
XCT RFLTAB-1(A) ;THE PLACE IDX SHOULD BE IN D.
|
||
CAIE C,UFILE(U) ;IF STOREING INTO $L DEFAULT,
|
||
RET ;(NOTE RFLTAB MAY SKIP TO HERE)
|
||
MOVEI C,IFILE
|
||
XCT RFLTAB-1(A) ;STORE INTO ALTERNATE ALSO.
|
||
MOVEI C,UFILE(U)
|
||
POPJ P,
|
||
|
||
RFLTAB: MOVEM B,1(C) ;STORE THE FN1
|
||
MOVEM B,2(C) ;STORE THE FN2
|
||
CALL RFLTDV ;STORE THE DEV
|
||
MOVEM B,3(C) ;STORE THE SNAME.
|
||
SOSA B,GSENUM
|
||
|
||
RFLTDV: MOVEM B,(C)
|
||
SETOM GSFNUM
|
||
CAIN C,UFILE(U)
|
||
SETZM UFLSYS(U)
|
||
RET
|
||
|
||
RFLCTX: MOVE B,RFLFN1-^X(D) ;GET DEFAULT FN1 OR FN2.
|
||
PUSHJ P,RFLTND ;STORE IT IN NORMAL SEQUENCE.
|
||
JRST RFL1
|
||
|
||
;SET THE SNAME, MAYBE DEFAULT DEV. TO DSK.
|
||
RFLNSC: MOVEI A,4 ;TELL RFLSND TO STORE SNAME.
|
||
PUSHJ P,RFLSND
|
||
SKIPE GSFNUM ;IF THE DEVICE WASN'T EXPLICITLY SPEC'D,
|
||
POPJ P,
|
||
LDB B,[301400,,(C)]
|
||
CAIE B,(SIXBIT / * /)
|
||
CAIN B,' DK ;AND DOESN'T USE THE SNAME,
|
||
POPJ P,
|
||
CAIE B,' AI
|
||
CAIN B,' ML
|
||
POPJ P,
|
||
CAIE B,' CL
|
||
CAIN B,' PK
|
||
POPJ P,
|
||
CAIE B,' P0
|
||
CAIN B,' D0
|
||
RET
|
||
CAIE B,' MC
|
||
CAIN B,' DM
|
||
RET
|
||
CAIE B,' MX
|
||
CAIN B,' MD
|
||
RET
|
||
CAIE B,' KS
|
||
CAIN B,' KL
|
||
RET
|
||
cain b,' DN ;DNRF
|
||
ret
|
||
;; Check if it's another ITS
|
||
move a,b
|
||
lsh a,6
|
||
pushj p,mchok0
|
||
MOVSI B,'DSK ;SET THE DEV. TO DSK.
|
||
ret
|
||
|
||
;COLON, SET DEV.
|
||
RFLNC: MOVEI A,3
|
||
JRST RFLSND
|
||
|
||
RFLALT: SKIPN B,3(C)
|
||
MOVE B,LSNAM ;GET THE SNAME TO BE USED.
|
||
MOVEI A,(C)
|
||
CALL CRF
|
||
SAVE C
|
||
CALL LFILE0 ;PRINT THE FILE SPEC'D.
|
||
REST C
|
||
CALL LCT
|
||
CALL GSOT
|
||
JRST RFL0
|
||
|
||
RLINEC: MOVEI D,200000 ;READ LINE, STOPPING ON CR OR ^C OR ^_
|
||
HRLM D,(P)
|
||
JRST RLINE1
|
||
|
||
RLINEX: MOVEI D,400000 ;READ LINE, STOPPING ON ALTMODE OR CR.
|
||
HRLM D,(P)
|
||
JRST RLINE1
|
||
|
||
;FORCE RUBOUT-PROC. TILL END OF LINE
|
||
RLINE: HRRZS (P) ;DON'T STOP ON ALTMODE.
|
||
RLINE1: PUSH P,F ;SAVE FLUNRD.
|
||
PUSHJ P,GSOC
|
||
PUSH P,GSCHRP
|
||
RLINE2: JSP W2,RCH
|
||
CAIN D,^M
|
||
JRST RLINE0 ;ALWAYS STOP ON CR.
|
||
MOVE W2,-2(P)
|
||
CAIE D,^C
|
||
CAIN D,^_
|
||
TLNN W2,200000 ;MAYBE STOP ON ^C OR ^_
|
||
CAIA
|
||
JRST RLINE0
|
||
SKIPGE -2(P)
|
||
CAIE D,33
|
||
JRST RLINE2 ;MAYBE STOP ON ALTMODE.
|
||
RLINE0: MOVE D,GSCHRP
|
||
MOVEM D,GSCHRQ ;RE-PROCESS CHARS.
|
||
POP P,GSCHRP ;STARTING WHERE WERE AT CALL.
|
||
POP P,D
|
||
TLZE D,FLUNRD
|
||
TLO F,FLUNRD
|
||
TLO F,FLRUB
|
||
JRST GSOD ;UN-GSOC.
|
||
|
||
|
||
;Read 6BIT name into B, get machine in A, handling rubouts normally.
|
||
;handles FOO@MC or FOO%MC.
|
||
;Returns terminating character in D.
|
||
|
||
rmtoke: setom ratflg ;note we want @ and % to terminate tokens
|
||
rmtok0: call rtoken ;read the token
|
||
skipn toktrm ;if no CR typed
|
||
jumpe b,rmtok0 ;and nothing read, keep reading
|
||
caie d,"@
|
||
cain d,"%
|
||
jrst rmtok1
|
||
setzm ratflg
|
||
ret
|
||
|
||
rmtok1: push p,b ;remember the user we got
|
||
rmtok2: call rtoken ;get the machine we want
|
||
move a,b ;machine goes in A
|
||
pop p,b ;recover the user
|
||
setzm ratflg
|
||
ret
|
||
|
||
;READ 6BIT NAME INTO B, CLEAR A, HANDLING RUBOUTS NORMALLY.
|
||
;returns terminating char in D
|
||
|
||
RTOKEN: PUSHJ P,GSOC ;TEMPORARY FAILURE-POINT FOR RUBOUT.
|
||
CLEARB A,B
|
||
MOVE C,[440600,,B]
|
||
|
||
RTOK2: JSP W2,RCH ;READ CHAR, GO TO RTOK2 LOOP.
|
||
CAIN D,^Z ;If we read a ^Z
|
||
JRST NCTLD ; cancel all (like ^D).
|
||
CAIN D,^S
|
||
JRST RTOK2
|
||
caie d,"@ ;these indicate mail/send on other machine sometimes
|
||
cain d,"%
|
||
jrst [skipe ratflg ;are we terminating on these?
|
||
jrst rtokx2 ; yes!
|
||
jrst rtok3] ;nope
|
||
rtok3: caie d,^J
|
||
CAIN D,^M ;THESE TERMINATE & SET TOKTRM.
|
||
JRST RTOKX1
|
||
CAIE D,":
|
||
CAIN D,"; ;THESE TERMINATE, CLEAR TOKTRM.
|
||
JRST RTOKX2
|
||
CAIE D,^X
|
||
CAIN D,^Y
|
||
JRST RTOKX2
|
||
CAIE D,33
|
||
CAIN D,^I
|
||
JRST RTOKX2
|
||
CAIE D,"
|
||
CAIN D,",
|
||
JRST RTOKX2
|
||
CAIN D,^Q ;^Q QUOTES CHAR.
|
||
JSP W2,RCH
|
||
CAIL D,140
|
||
SUBI D,40 ;UPPER CASE _ LOWER CASE.
|
||
SUBI D,40
|
||
TLNE C,770000 ;PUT 6BIT CHR IN WD UNLESS WD FULL.
|
||
IDPB D,C
|
||
JRST RTOK2
|
||
|
||
RTOKX1: SETOM TOKTRM
|
||
TDZA A,A
|
||
RTOKX2: SETZB A,TOKTRM
|
||
JRST GSOD ;UNDO CALL TO GSOC.
|
||
|
||
|
||
;read in an expression, doing syllable-rubout, reads into A, sylable type in B
|
||
;skips unless rub back out of ronum.
|
||
ronum: skipe toktrm ;if already saw a ^M, arrange to
|
||
setom unrchf ;return null but will skip.
|
||
pushj p,gtval
|
||
tlne c,4 ;xcted by GTVAL
|
||
popj p, ;fail if rub back out of GTVAL.
|
||
move a,arg1 ;pick up the value
|
||
move b,arg1+1 ;and it's type
|
||
jrst cpopj1 ;and skip return
|
||
|
||
;READ CHAR FROM INPUT, OR REPROCESS CHAR. CALL WITH JSP W2,
|
||
;CHARACTER RETURNED IN D. CLOBBERS A.
|
||
RCH: PUSHJ P,SLRPIN ;GET CHAR
|
||
CAIN D,^D
|
||
JRST NCTLD ;^D - CANCEL ALL.
|
||
CAIN D,^L ;^L - RETYPE CHARS READ SO FAR.
|
||
JRST SLRPCL
|
||
CAIE D,177
|
||
JRST (W2)
|
||
SLRPDL: MOVE A,GSCHRP ;GOT A RUB OUT
|
||
PUSHJ P,DBP
|
||
SLRPD0: CAMN A,GSOCRP ;IF PAST GSOC CALL'S PTR,
|
||
JRST SLRPD1 ;FLUSH GSOC, USE GSOA'S FAILURE POINT.
|
||
LDB D,A
|
||
CALL RUBCHR ;RUB THE CHARACTER IN D OUT ON THE SCREEN.
|
||
SLRPD3: PUSHJ P,DBP ;FLUSH THE CHAR BEING RUBBED (OR THE ^L, IF HERE FROM SLRPC2).
|
||
SLRPD4: MOVEM A,GSCHRQ
|
||
TLO F,FLRUB
|
||
PUSHJ P,GSOB ;INIT BUFFER FETCHING.
|
||
JRST SLRPD2 ;RETURN TO AFTER CALL TO GSOA OR GSOC.
|
||
|
||
;; Come here to flush from non-GSOC-rubout-processed stuff.
|
||
rubflo: skipe bughed ;if we've flushed the original input with a header
|
||
call slrpfx ; redisplay everything
|
||
rubfls: move a,gschrp
|
||
SLRPD1: PUSHJ P,GSOD ;UN-GSOC.
|
||
HRRZ C,GSCHRA
|
||
CAIE C,(A)
|
||
JRST SLRPD0 ;NOT AT BUFFER BEG.,RETRY.
|
||
SOS GSOCRT ;ALL RUBBED, RETURN AFTER GSOA NON-SKIPPING, WITH 177 IN D.
|
||
SLRPD2: MOVE P,GSOCPP ;RESTORE P AT CALL TO GSOC OR GSOA,
|
||
JRST @GSOCRT ;RETURN (NORMALLY SKIPPING).
|
||
|
||
slrpcl: call slrpff ;do redisplay stuff
|
||
slrpc2: pushj p,gsod ;make sure start from very beginning.
|
||
move a,gschrp ;flush the ^L from the buffer,
|
||
tlo f,flctll
|
||
jrst slrpd3 ;go back up and abort back to re-process
|
||
|
||
slrpfx: call terpri ;always terpri if we've flushed the header
|
||
jrst slrpf0
|
||
slrpff: skipn getty ;on datapt, screen was cleared by echo
|
||
call terpri ;printing tty, crlf instead.
|
||
slrpf0: SETOM RADCLR
|
||
CALL RADDTC ;REDISPLAY THE RAID REGISTERS IF APPROPRIATE.
|
||
CALL GSOPOS ;GSOVPS AND GSOHPS GET CURRENT CURSOR POSITION.
|
||
MOVE I1,FLDTBP
|
||
ADD I1,[1,,] ;PTR TO NEXT FROB TO TYPE.
|
||
SLRPC0: CAML I1,W4
|
||
JRST SLRPC1 ;AFTER ALL THE FROBS, TYPE CHARS IN BUFFER.
|
||
MOVE A,1(I1) ;ELSE RETYPE THE NEXT FROB
|
||
MOVE C,2(I1) ;(IN ORDER TYPED IN)
|
||
ADD I1,[2,,2]
|
||
SUB I1,FLDTBP ;(IN CASE FLD TAB MOVES)
|
||
SAVE I1
|
||
PUSHJ P,GFROBP
|
||
REST I1
|
||
ADD I1,FLDTBP
|
||
JRST SLRPC0
|
||
|
||
SLRPC1:REPEAT NARGS,[
|
||
MOVE A,ARG1+2*.RPCNT ;GET THE NEXT ARG, PRINT IT.
|
||
SKIPN C,ARG1+1+2*.RPCNT
|
||
popj p, ;NULL ARG => NO MORE ARGS.
|
||
IFN .RPCNT,7TYPE [ASCIZ/, /]
|
||
PUSHJ P,GFROBP
|
||
]
|
||
ret
|
||
|
||
;; retype the contents of the GSOC buffer (for sake of BGREAD redisplay
|
||
;; processing, until the two schemems are combined)
|
||
|
||
gsocff: push p,a
|
||
push p,d
|
||
push p,c
|
||
push p,w1
|
||
push p,b
|
||
call slrpff ;type any saved up frobs (like ":")
|
||
move a,gschra
|
||
hrli a,010700 ;A <= pointer to start of GSOC buffer
|
||
gsocf0: camn a,gschrp ;Is this the end of the buffer?
|
||
jrst gsocf1
|
||
ildb d,a ;get a character
|
||
call toutec ;and type it
|
||
jrst gsocf0
|
||
gsocf1: pop p,b
|
||
pop p,w1
|
||
pop p,c
|
||
pop p,d
|
||
pop p,a
|
||
ret
|
||
|
||
|
||
;assuming that D holds the char on the screen before the cursor,
|
||
;erase it or echo it. may set FLCTLL meaning must retype whole line.
|
||
|
||
rubchr: skipn erase ;erasable?
|
||
jrst toutec ; on others, must just echo the rubbed character.
|
||
|
||
caie d,33
|
||
cail D,40
|
||
cain d,177 ;rubout and ctl chars can't be erased except by
|
||
jrst slrpd5 ; retyping whole syl.
|
||
7type [asciz /X/] ;other chars, just erase 1 backward.
|
||
RET
|
||
|
||
SLRPD5: MOVEI D,^P ;IF CAN'T USE ^PX, MUST RETYPE WHOLE SYL.
|
||
CALL TYOFI1 ;SO RESTORE THE HPOS REMEMBERED (BY GSOA) FROM START OF SYL.
|
||
MOVEI D,"H
|
||
CALL TYOFI1
|
||
MOVE D,GSOHPS
|
||
ADDI D,10
|
||
CALL TYOFI1
|
||
move b,ttyopt ;get info on what our TTY can do
|
||
TLNN B,%TOMVU ;RESTORE VPOS TOO IF THAT WORKS ON THIS TTY.
|
||
JRST SLRPD7
|
||
MOVEI D,^P
|
||
CALL TYOFI1
|
||
MOVEI D,"V
|
||
CALL TYOFI1
|
||
MOVE D,GSOVPS
|
||
ADDI D,10
|
||
CALL TYOFI1
|
||
slrpd7: skipe erase
|
||
7type [asciz /L/] ;clear rest of 1st line if that's possible.
|
||
tlo f,flctll ;then re-read and re-type rest of syllable.
|
||
ret
|
||
|
||
;READ CHAR OF FROB, LIKE RCH BUT DON'T CHECK FOR ^L, ^D, RUBOUT.
|
||
SLRPIN: TLZE F,FLUNRD ;MAYBE RE-READ PREVIOUS CHAR, DON'T ECHO IF ^L'ING.
|
||
JRST [LDB D,GSCHRP ? RET]
|
||
TLNE F,FLRUB
|
||
JRST SLRPIM
|
||
SKIPL GTMALT ;IF $< LEFT SOME CHARS, READ THEM.
|
||
JRST SLRPI2
|
||
CALL IN
|
||
SKIPN UNRCHF ;IF CHAR WE JUST READ WAS A REPROCESSED CHAR THAT
|
||
SKIPN UNECHF ;SHOULDN'T RE-ECHO, DON'T DO THE SPECIAL ECHOING STUFF
|
||
CAILE D,^J ;FOR TAB AND LF. (SAVES SOME TIME AND COSTS NO MORE)
|
||
JRST SLRPI4
|
||
CAIN D,^J
|
||
JRST SLRPI5
|
||
CAIE D,^I ;WE HAVE TABS AND LF'S SET UP NOT TO ECHO
|
||
JRST SLRPI4
|
||
SLRPI5: HRRZ A,GSORET ;BUT IN FACT, WE WANT TO ECHO THEM EXCEPT WHEN THEY
|
||
CAIN A,ALTAM1
|
||
JRST SLRPI4
|
||
CAIE A,GTFRPC ;APPEAR AS SYLLABLES IN THEMSELVES.
|
||
CALL TOUT ;WHEN WE ECHO THEM, LPT THEM TOO.
|
||
SLRPI4: HLRE A,GSCHRA
|
||
MOVNI A,3(A)
|
||
ADD A,GSCHRA ;RH HAS ADDR JUST BELOW END OF FROB CHARACTER BUFFER.
|
||
HRLI A,010700
|
||
CAMN A,GSCHRP ;IS BUFFER ALMOST FULL?
|
||
CALL SLRPJN ;YES, EXTEND IT.
|
||
SLRPIQ: IDPB D,GSCHRP
|
||
POPJ P,
|
||
|
||
SLRPIM: MOVE A,GSCHRP ;COME HERE IF RE-PROCESSING AFTER RUBOUT.
|
||
CAMN A,GSCHRQ ;IF NO MORE STUFF TO REPROCESS, START REALLY READING AGAIN.
|
||
JRST [TLZ F,FLRUB\FLCTLL ? JRST SLRPIN]
|
||
ILDB D,GSCHRP ;ELSE RE-READ & RETURN NEXT CHAR.
|
||
TLNN F,FLCTLL ;IF RE-READING FOR ^L,
|
||
RET
|
||
TOUTEC: CAIN D,^M ;RE-ECHO THE CHAR - NOTE ^M ECHOES AS CRLF.
|
||
JRST CRF
|
||
JRST TOUT
|
||
|
||
SLRPI2: MOVEI D,33
|
||
SOSL GTMALT
|
||
JRST SLRPI4
|
||
AOS GTMALT
|
||
MOVE A,GTPNTR
|
||
ILDB D,A
|
||
TLNN A,770000
|
||
SETOM GTMALT
|
||
ADDI D,"0
|
||
MOVEM A,GTPNTR
|
||
JRST SLRPI4
|
||
|
||
SLRPJN: INSIRP PUSH P,W1 A C D GSCHRA
|
||
HLRE W1,GSCHRA
|
||
MOVNI W1,1(W1) ;CURRENT LENGTH - 1
|
||
ADDM W1,(P) ;ADDRESS OF LAST WORD OF TABLE
|
||
HRRZS (P) ;THAT IS THE PLACE TO ADD MORE WORDS TO THE TABLE.
|
||
MOVEI W1,(P) ;SUPPLY THAT ADDRESS, IN WORD ON STACK, AS ARG TO HOLE
|
||
MOVSI A,-20. ;GET 20. WORDS.
|
||
CALL HOLE0
|
||
MOVSI A,-20.
|
||
ADDM A,GSCHRA ;UPDATE AOBJN TO TABLE, SINCE TABLE IS BIGGER NOW.
|
||
INSIRP POP P,D D C A
|
||
JRST POPW1J
|
||
|
||
;INITIALIZE RUBOUT PROCESSING, SET UP FAILURE-POINT AFTER CALL.
|
||
;FAILS BACK SKIPPING AFTER RUBOUT,
|
||
;NON-SKIPPING IF RUBOUT WITH NO CHARS IN BUFFER.
|
||
GSOA: SKIPN A,NCOMNM ;IF RUBOUT BUFFER NOW HOLDS NAME
|
||
JRST GSOA1
|
||
MOVEM A,-1(W4) ;OF A :-CMD BEING EXECUTED,
|
||
MOVEI A,NCOMPT ;REPLACE THE : ON THE FROB STACK WITH A FROB
|
||
MOVEM A,(W4) ;THAT WILL RUB OUT AS : AND THE CMD NAME.
|
||
SETZM NCOMNM ;DON'T DO THAT TWICE FOR SAME COMMAND.
|
||
GSOA1: TLZ F,FLRUB+FLCTLL
|
||
AOS (P) ;SKIP ARG (=RET. ON ALL RUBBED.).
|
||
HRRZ A,GSCHRA
|
||
HRLI A,010700 ;B.P. TO END OF 1ST WDD OF FROB CHARACTER BUFFER.
|
||
MOVEM A,GSOCRP
|
||
PUSHJ P,GSOB
|
||
POP P,GSORET ;SAVE RET. ADDR.,
|
||
MOVEM P,GSOPDP ;FOR REST. ON RUBOUT.
|
||
PUSH P,GSORET
|
||
|
||
;SET UP TEMPORARY FAILURE POINT FOR RUBBING OUT NOT PAST
|
||
;WHERE WE WERE AT CALL.
|
||
GSOC: POP P,GSOCRT
|
||
MOVEM P,GSOCPP
|
||
MOVE A,GSCHRP
|
||
MOVEM A,GSOCRP
|
||
CALL GSOPOS ;GSOVPS AND GSOHPS GET CURRENT CURSOR POSITION.
|
||
JRST @GSOCRT
|
||
|
||
;INIT. RUBOOUT PROC BUFFER.
|
||
GSOB: SETZM TOKTRM
|
||
MOVE A,GSOCRP
|
||
MOVEM A,GSCHRP
|
||
GSOB1: SETZM GSONUM
|
||
MOVE A,[GSONUM,,GSONUM+1]
|
||
BLT A,GSFNUC
|
||
POPJ P,
|
||
|
||
GSOPOS: CALL TYOFRC ;DON'T TRY TO READ POS WITH TYPEOUT STILL IN BUFFER.
|
||
MOVE A,GSOVPS ;REMEMBER PREVIOUS "POS OF START OF SYL" IN GSOOVP, GSOOHP
|
||
MOVEM A,GSOOVP ;IN CASE THIS IS A GSOC, SO THAT GSOD CAN GET THEM BACK.
|
||
MOVE A,GSOHPS
|
||
MOVEM A,GSOOHP
|
||
.SUSET [.RTTY,,A]
|
||
JUMPL A,GSOPO1 ;DON'T HANG UP IF NO TTY.
|
||
SKIPE TTYFLG ;IF NOT TYPING ON OR READING FROM TTY,
|
||
SKIPN INPTR ;AVOID TRYING TO USE IT (SO WE WIN IF DON'T HAVE TTY).
|
||
SYSCAL RCPOS,[%CLIMM,,TYOC ? %CLOUT,,A]
|
||
GSOPO1: SETZ A,
|
||
HLRZM A,GSOVPS ;SAVE CURSOR POS IN GSOVPS, GSOHPS
|
||
HRRZM A,GSOHPS
|
||
RET
|
||
|
||
;UNDO A CALL TO GSOC.
|
||
GSOD: PUSH P,A
|
||
HRRZ A,GSCHRA
|
||
HRLI A,010700 ;B.P. TO END OF 1ST WDD OF FROB CHARACTER BUFFER.
|
||
MOVEM A,GSOCRP
|
||
MOVE A,GSOOVP
|
||
MOVEM A,GSOVPS
|
||
MOVE A,GSOOHP
|
||
MOVEM A,GSOHPS
|
||
MOVE A,GSORET
|
||
MOVEM A,GSOCRT
|
||
MOVE A,GSOPDP
|
||
MOVEM A,GSOCPP
|
||
POPAJ: POP P,A
|
||
POPJ P,
|
||
|
||
;TYPE " ", THEN GSOA (CANCEL IF RUB BACK.)
|
||
GSOT: POP P,GSOTRT'
|
||
PUSHJ P,TSPC
|
||
PUSHJ P,GSOA
|
||
JRST NRBERR
|
||
TLNE F,FLCTLL ;ECHO SPACE FOR ^L.
|
||
PUSHJ P,TSPC
|
||
MOVE B,(W4)
|
||
MOVE A,-1(W4)
|
||
JRST @GSOTRT
|
||
|
||
IFN 0,[
|
||
FROB: FORMAT AS FOLLOWS:
|
||
EACH FROB IS 2 WDS.
|
||
BOTH 0 => NULL FROB.
|
||
1ST WD IS VALUE, 2ND WD DECODED TO GIVE TYPE.
|
||
2ND WD: SIGN BIT ON => OPERATOR, 1ST WD IS INFIX ARG.
|
||
BIT 4.8 (O.IFX) => INFIX ARG WAS GIVEN.
|
||
BIT 4.7 (O.IFXD) => IT WAS DECIMAL, NOT OCTAL.
|
||
BIT 4.6 (O.2ALT) => OP HAD EXACTLY 2 ALTMODES.
|
||
BIT 4.5 (O.1ALT) => OP HAD EXACTLY 1 ALTMODE.
|
||
BITS 3.1-3.7 => CHARACTER NAME OF OPERATOR.
|
||
RH => ADDRESS OF WD SAYING WHAT TO DO WITH OPERATOR.
|
||
THIS WORD IS USUALLY IN ONE OF THE DISPATCH TABLES
|
||
(OPTAB0, OPTAB1, OPTAB2) BUT NEED NOT BE.
|
||
ITS FORMAT IS DOCUMENTED BEFORE OPTAB0.
|
||
|
||
SIGN BIT OF 2ND WD OFF => THIS FROB IS SYLLABLE,
|
||
1ST WD USUALLY HAS VALUE (BUT SEE SYMBOL)
|
||
BITS 4.6-4.8 GIVE SYLLABLE TYPE (FOR RUBBING IT OUT)
|
||
0 => SPECIAL SYLLABLE, RH HAS RTN TO RETYPE SYLL IF RUBBED.
|
||
1 => OCTAL NUMBER.
|
||
2 => DECIMAL NUMBER.
|
||
3 => FLOATING POINT NUMBER.
|
||
4 => SYMBOL. 3 KINDS:
|
||
BITS 1.1-4.5 OF 2ND WD ALL 0 =>
|
||
UNEVALUATED, 1ST WD HAS SQUOZE.
|
||
BITS 3.1-4.5 ALL 0, RH NOT 0 =>
|
||
EVALUATED FUNNY SYMBOL, RH HAS FUNNYNESS,
|
||
1ST WD HAS ABSOLUTE PART OF VALUE.
|
||
ELSE BITS 1.1-4.5 HAVE SQUOZE, 1ST WD HAS VALUE.
|
||
SYMBOLS ARE TYPED IN AS UNEVALUATED SYMBOLS,
|
||
BECOME EVALUATED WHEN ANOTHER OP. IS READ UNLESS OP
|
||
SAYS "INHIBIT EVAL".
|
||
IF AN UNEVALUATED SYMBOL REMAINS UNTIL EFIELD,
|
||
IT GENERATES AN UNDEF SYM REF.
|
||
|
||
]
|
||
|
||
;SYLLABLE TYPES, GO IN LH OF 2ND WD.
|
||
SYL==1,,437777
|
||
SYLOCT==40000
|
||
SYLDEC==100000
|
||
SYLFLT==140000
|
||
SYLSYM==200000
|
||
|
||
;OPERATOR FLAGS.
|
||
|
||
O.==1,,527600
|
||
O.1ALT==10000 ;1 ALTMODE OPERATOR.
|
||
O.2ALT==20000 ;2 ALTMODE OPERATOR.
|
||
O.IFXD==100000 ;DECIMAL INFIX NUMBER.
|
||
O.IFX==200000 ;ANY INFIX NUMBER.
|
||
O.OP==400000 ;1 => THIS IS AN OPERATOR.
|
||
|
||
dd1a: call terpri
|
||
DD1B: MOVE D,[SCHM,,SCH]
|
||
BLT D,BITF
|
||
DD2: MOVE P,[(-LPDL)PS]
|
||
MOVE W4,FLDTBP
|
||
ADD W4,[1,,] ;1ST WD OF FLDTAB UNUSED FOR FLDPUT'S SAKE.
|
||
MOVEM W4,FLDSTR
|
||
SETZM FLDTRM
|
||
SETZM NCOMNM ;NO :-COMMAND IN PROGRESS.
|
||
SETZM RELCP1 ;NO SPECIAL PTR IN SYMTAB SPACE TO RELOCATE.
|
||
GBFQJ: MOVEM P,ERRSTP ;SET UP PDL AN PC
|
||
MOVEI B,GFLDER ;TO RESTORE ON ERRORS.
|
||
MOVEM B,ERRSTL
|
||
AND F,[FLRO\FLST,,]
|
||
SETZM ABCNT
|
||
SETOM GTMALT
|
||
GFLDER: MOVE D,MONMOD ;RESET TEMP. MONIT MODE TO PERM.
|
||
SKIPN FLDTRM ;IF WE ARE IN THE OUTER LEVEL
|
||
MOVEM D,MONMDL ;(THAT IS, NOT WITHIN GTVAL)
|
||
GFLD1: SETZM UNDEFF ;SAY WE AREN'T JUST AFTER READING AN UNDEFINED SYMBOL.
|
||
GFLD1U: ;COME HERE AFTER READING AN UNDEFINED SYMBOL; SQUOZE IN UNDEFF.
|
||
PUSHJ P,EVARGF ;NO LONGER HAVE ARGS EVALLED.
|
||
SETZM UNDFRP ;NO UNDEF REFS NOT HANDLED.
|
||
JUMPL U,GFLD1B
|
||
CAME U,CU ;COMPLAIN IF U ISN'T CU OR CU ISN'T VALID.
|
||
ERLOSS
|
||
MOVE A,U
|
||
IDIVI A,USRLNG
|
||
CAIGE U,USREND
|
||
JUMPE B,GFLD1D
|
||
SETOM CU
|
||
ERLOSS
|
||
GFLD1D: HLRE A,JOBSYM(U) ;DEBUGGING CHECK: IF WE HAVE A CURRENT JOB,
|
||
MOVNS A
|
||
ADD A,JOBSYM(U) ;CHECK THAT END OF SYMBOL TABLE ISN'T ABOVE SYMTOP.
|
||
ANDI A,-1
|
||
CAMG A,SYMTOP
|
||
JRST GFLD1B
|
||
MOVE A,JOBSYM(U) ;SAVE OLD VALUE FOR DEBUGGING.
|
||
HRRZ B,SYMTOP
|
||
HRRZM B,JOBSYM(U) ;IF IT IS, AT LEAST MAKE SURE WE WON'T TRIP THIS CHECK INFINITELY MANY TIMES,
|
||
HRRZM B,PRGM(U)
|
||
ERLOSS ;THEN RECORD THE LOSSAGE.
|
||
GFLD1B: SKIPN A,TYOUNI
|
||
JRST GFLD1C
|
||
SETZM TYOUNI ;TYOUNI SHOULD BE 0 EXCEPT DURING --MORE-- PROCESSING.
|
||
ERLOSS
|
||
|
||
GFLD1C: MOVS A,LITCNT(U)
|
||
TLNE F,FLRO
|
||
JRST GFLD1E ;IF NO LOCATION OPEN, AND
|
||
CAME A,LITCNT(U) ;IF A LITERAL IS PENDING (LAST DEFINED NEQ LAST ASKED FOR),
|
||
SKIPE PATCHL(U) ;AND WE'RE NOT INSIDE A PATCH OR LITERAL NOW, GO DEFINE ONE
|
||
CAIA
|
||
CALL LITFIN ;PENDING LITERAL. WE RETURN INSIDE IT, TO READ CMDS TO DEPOSIT IT.
|
||
GFLD1E: SKIPN MONMDL ;IF LOOPING IN MONIT MODE,
|
||
JRST GFLD1M
|
||
MOVE A,W4
|
||
SUB A,[1,,]
|
||
CALL RTYIC ;POP VALRET OR XFILE IF NO CHARS LEFT.
|
||
CAME A,FLDTBP ;MONIT MODE OFF IF SOMETHING IN FROB TABLE
|
||
JRST GFLD1M ;OR IF WITHIN VALRET OR XFILE.
|
||
MOVEI D,":
|
||
MOVEM D,LIMBO ;STICK A COLON IN FRONT OF THE INPUT STREAM.
|
||
SETOM UNRCHF
|
||
SETOM UNECHF ;TYPE IT OUT WHEN READ.
|
||
GFLD1M: PUSHJ P,GTFROB
|
||
TLZ F,FLNNUL\FLPNT
|
||
CAIN D,177
|
||
JRST GFRUB
|
||
GFLD1A: JUMPE B,GFLD1
|
||
JUMPL B,GFLD3 ;JUMP IF OPERATOR
|
||
GFLD4: PUSHJ P,FLDPUT ;PUT AWAY
|
||
JUMPGE B,GFLD1 ;NOT AN OPERATOR OR FLUSHED BY FLDPUT
|
||
|
||
;DROPS THROUGH
|
||
|
||
;DROPS THROUGH
|
||
;AN OPERATOR HAS JUST BEEN READ IN, AND PUSHED BY FLDPUT.
|
||
MOVE W3,C ;OPERATOR
|
||
SETZB C,D ;FOR ADDI A-B HACKS
|
||
TLNN W3,50000 ;IF TO BE EXECUTED, OR SET SCH, POP OFF STACK.
|
||
JRST GFLD2A
|
||
POP W4,B
|
||
POP W4,A
|
||
GFLD2A: TLNE W3,20000
|
||
CAMN W4,FLDSTR ;NOTHING ELSE IN FLDTAB TEST
|
||
JRST GFLD2B
|
||
POP W4,D
|
||
POP W4,C
|
||
TLNN W3,40
|
||
JRST GFLD2B
|
||
PUSHJ P,NBITE ;MAKE SYM SIXBIT
|
||
GFLD2B: TLNN W3,200
|
||
JRST GFLD2C
|
||
PUSH P,W3
|
||
PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
PUSHJ P,EVARGS
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POP P,W3
|
||
GFLD2C: TLNN W3,100 ;MAYBE CHECK FOR INFERIOR OR (INF. OR SELF).
|
||
JRST GFLD2D
|
||
TLNE W3,2
|
||
SKIPN DDTSW
|
||
PUSHJ P,QIJERR
|
||
GFLD2D: SAVE A
|
||
TLNE W3,400
|
||
PUSHJ P,PLUNK1 ;MAYBE DEPOSIT OPERATOR'S ARGUMENT.
|
||
REST A
|
||
SKIPE UNDFRP ;IF HAD UNDEF REFS AND DIDN'T CALL PLUNK1,
|
||
NUNDER: ERSTRT [SIXBIT/ILGL UNDEF SYM?/]
|
||
TLNE W3,40000 ;$S, $$S, $C, ETC.?
|
||
CALL NSETX ;YES, SET SCH FROM RH(W3)
|
||
TLNN W3,10000 ;SKIP IF EXECUTE BIT ON
|
||
JRST GFLD1
|
||
PUSH W4,A ;PUT OP TO EXECUTE BACK ON STACK
|
||
PUSH W4,B ;SO ^L WITHIN OP. WILL TYPE IT OUT.
|
||
MOVEI W2,gferr
|
||
MOVEM W2,ERRSTL ;BUT SHOULD REMOVE IT IF ERROR IN OP.
|
||
PUSHJ P,(W3) ;EXECUTE THE OPERATOR,
|
||
GFLDE1: SUB W4,[2,,2] ;THEN REMOVE IT FROM STACK.
|
||
MOVEI W2,GFLDER ;(COMPLICATED INTERACTIONS WITH NCOL)
|
||
MOVEM W2,ERRSTL ;ALREADY GONE, ERRORS SHOULDN'T REMOVE IT.
|
||
SETZM NCOMNM ;NO LONGER HAVE : OF :-CMD ON TOP OF FROB STACK.
|
||
SETZM UNDFRP ;NO UNDEF REFS ANY MORE
|
||
SAVE A
|
||
CALL EVARGF ;NO ARGS ANY MORE.
|
||
REST A
|
||
JRST GFLD1A ;GO PUSH THE FROB (IF ANY) RETURNED BY OP.
|
||
|
||
gferr: setz b,
|
||
jrst gflde1
|
||
|
||
GFLD3: MOVE C,(B)
|
||
TLNE C,10
|
||
JRST GFLD6
|
||
SKIPE FLDTRM
|
||
SKIPL C
|
||
SKIPA
|
||
JRST GFLD7
|
||
TRNE C,-1
|
||
JRST GFLD4
|
||
GFLD5: CALL DBGPSH
|
||
MOVEM B,@DBGBFP
|
||
7TYPE [ASCII / OP/]
|
||
|
||
GFLD6: SKIPL C
|
||
AOS ABCNT ;<
|
||
SKIPGE C
|
||
SOS ABCNT ;>
|
||
SKIPGE ABCNT
|
||
SKIPN FLDTRM
|
||
JRST GFLD4
|
||
GFLD7: PUSHJ P,FLDPUT
|
||
JUMPGE B,GFLD1
|
||
SUB W4,[2,,2]
|
||
POPJ P,
|
||
|
||
GTVAL: PUSH P,FLDSTR
|
||
PUSH P,FLDTRM
|
||
PUSH P,ABCNT
|
||
PUSH P,W4
|
||
PUSH P,F
|
||
PUSH P,ERRSTP ;GBFQJ WILL USE THESE.
|
||
PUSH P,ERRSTL
|
||
NGVP==.-GTVAL
|
||
MOVN D,FLDTBP ;MAKE SAVED FLDTAB PTRS BE RELATIVE
|
||
ADDM D,-3(P) ;SINCE FLDTAB CAN MOVE AND EXPAND.
|
||
ADDM D,-6(P)
|
||
SETOM FLDTRM
|
||
MOVEM W4,FLDSTR
|
||
GTVAL1: PUSHJ P,GBFQJ
|
||
XCT @-NGVP(P)
|
||
JRST GTVAL2
|
||
CAIN D,177
|
||
JRST GTVAL3
|
||
MOVE C,B
|
||
CALL GFROBP
|
||
PUSHJ P,NXERR
|
||
JRST GTVAL1
|
||
|
||
GTVAL3: SOS -NGVP(P)
|
||
GTVAL2: PUSHJ P,EVARGS
|
||
POP P,ERRSTL
|
||
POP P,ERRSTP
|
||
SKIPE UNDFRP ;UNDEF REFS ILLEGAL IN GTVAL.
|
||
JRST NUNDER
|
||
POP P,F
|
||
MOVE W4,FLDTBP
|
||
ADDM W4,(P)
|
||
ADDM W4,-3(P)
|
||
POP P,W4
|
||
POP P,ABCNT
|
||
POP P,FLDTRM
|
||
POP P,FLDSTR
|
||
JRST CPOPJ2
|
||
|
||
;INCREMENT THE DEBUG RING BUFFER POINTER. TO PUSH A WORD, DO
|
||
;CALL DBGPSH ? MOVEM AC,@DBGBFP
|
||
DBGPSH: SAVE A
|
||
AOS A,DBGBFP
|
||
CAIN A,DBGBFP
|
||
SUBI A,DBGBFL
|
||
MOVEM A,DBGBFP
|
||
JRST POPAJ
|
||
|
||
;PUSH FROB IN A,B ONTO FROB TABLE.
|
||
;IF OPERATOR, RETURN DISPATCH WORD IN C.
|
||
;DOESN'T CLOBBER B. CAN RETURN TO GFLD1U INSTEAD OF TO CALLER.
|
||
FLDPUT: AOBJN W4,FLDPT7 ;PUSH A ON FROB STACK,
|
||
MOVEI W1,FLDTBP ;NO ROOM => EXPAND IT.
|
||
SAVE A
|
||
MOVSI A,-FTBLNG
|
||
CALL HOLE0
|
||
MOVN A,[FTBLNG,,FTBLNG]
|
||
ADD W4,A
|
||
ADDM A,FLDSTR ;UPDATE POINTERS IN FROB TABLE.
|
||
REST A
|
||
FLDPT7: MOVEM A,(W4)
|
||
PUSH W4,B
|
||
JUMPGE B,FLDPT0 ;UNLESS THIS FROB IS OP. WITH EVAL-INHIBIT,
|
||
MOVE C,(B)
|
||
TLNE C,200000
|
||
POPJ P, ;EVAL INHIBIT
|
||
FLDPT0: LDB A,[400400,,-2(W4)] ;IF PREV. FROB IS UNEVALUATED SYMBOL,
|
||
CAIE A,4
|
||
POPJ P,
|
||
LDB A,[4000,,-2(W4)]
|
||
JUMPN A,CPOPJ
|
||
MOVE A,-3(W4)
|
||
DPB A,[4000,,-2(W4)] ;EVALUATE IT.
|
||
MOVEM A,SYM
|
||
CAMN A,[SQUOZE 0,.] ;SYMBOL "." IS EVALUATED SPECIALLY.
|
||
JRST FLDPT5
|
||
PUSH P,C
|
||
PUSHJ P,SEVL
|
||
JRST FLDPT2
|
||
HLRZ B,FNYLOC ;GET FUNNYNESS OF SYM, SET BY EVAL.
|
||
JUMPE B,FLDPT1 ;IF SYM IS FUNNY,
|
||
DPB B,[4000,,-2(W4)] ;REPLACE NAME BY FUNNYNESS.
|
||
FLDPT1: MOVEM D,-3(W4)
|
||
MOVE B,(W4) ;ALLOW EVAL TO CLOBBER B.
|
||
POPCJ: POP P,C
|
||
POPJ P,
|
||
|
||
;COME HERE WHEN A SYMBOL BEING EVALLED IS UNDEFINED.
|
||
FLDPT4: 7TYPE [ASCIZ /?U/]
|
||
SUB W4,[4,,4]
|
||
MOVEI B,0
|
||
MOVEI A,GFLD1U ;RETURN TO GFLD1U, TO AVOID ZEROING UNDEFF.
|
||
MOVEM A,-1(P)
|
||
MOVE A,SYM
|
||
MOVEM A,UNDEFF ;SET FLAG SO THAT FOLLOWING "?" DOES SPECIAL THINGS.
|
||
REST C
|
||
CAME A,[SQUOZE 0,LOGON]
|
||
CAMN A,[SQUOZE 0,LOGIN]
|
||
7NRTYP [ASCIZ /Use :LOGIN (you must type the colon)./]
|
||
came a,[squoze 0,logout] ;is he losing?
|
||
camn a,[squoze 0,logoff] ; Is he REALLY losing?
|
||
7nrtyp [asciz /Use :LOGOUT (you must type the colon)./]
|
||
CAME A,[SQUOZE 0,HELP]
|
||
RET
|
||
JRST KHELP
|
||
|
||
FLDPT5: MOVE D,[O.OP+".,,[1000,,FLDPT6]]
|
||
MOVEM D,-2(W4) ;REPLACE "." BY AN OPERATOR WITH SAME NAME
|
||
SETZM -3(W4) ;NO INFIX ARG. OPERATOR WILL JRST FLDPT6
|
||
POPJ P, ;FROM EFIELD.
|
||
|
||
FLDPT6: HLLZ D,LLOC ;GET FUNNYNESS OF OPEN LOCATION,
|
||
IORM D,FNYLOC ;STICK IN WITH FUNNYNESS OF OTHER SYMS.
|
||
HRRZ C,LLOC ;GET ACTUAL ADDRESS OPEN,
|
||
JRST EFOCTJ ;RETURN OCTAL NUM. TO EFIELD.
|
||
|
||
FLDPT2: PUSHJ P,OPLK2
|
||
JRST FLDPT4
|
||
JRST FLDPT1
|
||
JRST FLDPT1
|
||
|
||
;RUB OUT PREVIOUS SYLL.
|
||
GFRUB: CAMN W4,FLDSTR
|
||
JRST GFRUB3
|
||
POP W4,C
|
||
POP W4,A
|
||
PUSHJ P,GFROBP
|
||
JRST GFLD1
|
||
|
||
GFRUB3: SKIPN FLDTRM ;TRYING TO RUB WHEN NO FROBS BUFFERED,
|
||
JRST NRBERR ;AT TOP LEVEL TYPE ??, TRY AGAIN;
|
||
JRST GSNLRT ;DURING GTVAL, RETURN A NULL SYL.
|
||
|
||
;PRINT A FROB IN A,C.
|
||
GFROBP: JUMPGE C,GFRUB1 ;JUMP IF NOT OPERATOR
|
||
LDB B,[360200,,C] ;GET NUM OF ALTS
|
||
JUMPE B,GFRUB2
|
||
CTYPE 33 ;TYPE ALT
|
||
SOJG B,.-1
|
||
GFRUB2: TLNN C,200000
|
||
JRST GFRUB4
|
||
TLNN C,100000
|
||
PUSHJ P,G8PNT
|
||
TLNE C,100000
|
||
PUSHJ P,G9PNT
|
||
GFRUB4: LDB D,[220700,,C]
|
||
PUSHJ P,TOUT
|
||
TLNE C,40000
|
||
PUSHJ P,TOUT
|
||
POPJ P,
|
||
|
||
GFRUB1: MOVE D,A ;PUT VALUE OF SYLL IN D FOR TYPEOUT ROUTINE.
|
||
LDB B,[400300,,C]
|
||
PUSH P,C
|
||
PUSH P,[POPCJ]
|
||
XCT GFRUBT(B)
|
||
MOVEM D,(P) ;DIDN'T JUMP => ILLEGAL FROB TYPE.
|
||
ERLOSS 1(P)
|
||
|
||
GFRUBT: JUMPN C,(C)
|
||
JRST G8PNT
|
||
JRST G9PNT
|
||
JRST TFLOT
|
||
JRST GSPNT
|
||
REPEAT 3,JFCL
|
||
|
||
TMSQ: ;SQUOZE TYPEOUT MODE.
|
||
D5PNT: MOVEI C,0
|
||
G5PNT: CTYPE 33
|
||
PUSH P,D
|
||
LDB A,[400400,,D]
|
||
LSH A,2
|
||
PUSHJ P,G8PNT
|
||
POP P,D
|
||
CTYPE "&
|
||
JRST GSPNT1
|
||
|
||
GSPNT: TLNN C,37777
|
||
TRNN C,-1
|
||
JRST GSPNT1
|
||
HRLI D,(C) ;EVALUATED FUNNY SYMBOL.
|
||
JRST PAD
|
||
|
||
GSPNT1: MOVE B,CJTOUT
|
||
MOVEM B,SPTS
|
||
TLZ D,%SYFLG
|
||
TDNN C,[37777,,-1]
|
||
JRST SPT1
|
||
LDB D,[4000,,C]
|
||
JRST SPT1
|
||
|
||
TMA: ;ASCII TYPEOUT MODE. ALSO, RUB OUT ASCII SYL.
|
||
D7PNT: MOVE C,D
|
||
CTYPE 33 ;ALTMODE
|
||
MOVEI D,"0 ;0 OR 1 DEPENDING ON LOW BIT OF WD
|
||
TRZE C,1
|
||
IORI D,1
|
||
CALL TOUT
|
||
CTYPE ""
|
||
G7PNT2: SETZ D,
|
||
ROTC C,7 ;GET NEXT CHAR.
|
||
CAIE D,"^ ;UPARROW AND ^Q MUST BE QUOTED.
|
||
CAIN D,^Q
|
||
JRST [CTYPE ^Q ? JRST G7PNT4]
|
||
CAIE D,177 ;RUBOUT PRINTS AS UPARROW-QUESTIONMARK.
|
||
CAIGE D,40
|
||
JRST G7PNT3 ;CTL CHARS TREATED SPECIALLY.
|
||
G7PNT4: PUSHJ P,TOUT
|
||
JUMPE C,G7PNT1 ;OMIT TRAILING ^@'S.
|
||
JRST G7PNT2
|
||
|
||
G7PNT3: CTYPE "^
|
||
XORI D,100
|
||
JRST G7PNT4
|
||
|
||
TM6: ;SIXBIT TYPEOUT MODE, ALSO RUBOUT 6BIT SYL.
|
||
D6PNT: 7TYPE [ASCIZ/1'/]
|
||
PUSHJ P,SIXTYP
|
||
G7PNT1: MOVEI D,33
|
||
JRST TOUT
|
||
|
||
;EVALUATE ARGUMENTS
|
||
EVARGS: PUSH P,ERRSTP ;EFIELD WILL SET THESE UP.
|
||
PUSH P,ERRSTL
|
||
SETZM PSTATE ;NOT INSIDE BRACKETS OR PARENS.
|
||
SETZM FNYLOC ;REINIT ACCUMULATION.
|
||
SETZM UNDFRP ;NO UNDEF REFS IN THE ARGS YET.
|
||
PUSHJ P,EVARGF ;FLUSH THE OLD ARGS.
|
||
MOVEI W3,W3
|
||
MOVEM W3,RELCP1 ;RELOCATE W3 (IN CASE HAKKAH MOVES FROB TAB)
|
||
MOVE W3,FLDSTR
|
||
EVARG1: PUSHJ P,VEARG
|
||
JUMPE B,EVARG3
|
||
MOVNI C,NARGS*2-2
|
||
EVARG2: SKIPE ARG1+1+NARGS*2-2(C)
|
||
AOJLE C,[AOJA C,EVARG2]
|
||
JUMPG C,EVARG4
|
||
MOVEM A,ARG1+NARGS*2-2(C)
|
||
MOVEM B,ARG1+1+NARGS*2-2(C)
|
||
JRST EVARG1
|
||
|
||
EVARG4: MOVE C,[ARG1+2,,ARG1]
|
||
BLT C,ARG1+1+NARGS*2-4
|
||
MOVEM A,ARG1+NARGS*2-2
|
||
MOVEM B,ARG1+1+NARGS*2-2
|
||
JRST EVARG1
|
||
|
||
EVARG3: MOVE W4,FLDSTR
|
||
MOVSI A,600000 ;CLEAR UNUSED FUNNYNESS BITS.
|
||
ANDM A,FNYLOC
|
||
POP P,ERRSTL
|
||
POP P,ERRSTP
|
||
SETZM RELCP1 ;W3 SHOULD NO LONGER BE RELOCATED.
|
||
POPJ P,
|
||
|
||
EVARGF: SETZM ARG1
|
||
MOVE A,[ARG1,,ARG1+1]
|
||
BLT A,ARG1+2*NARGS-1
|
||
POPJ P,
|
||
|
||
;EVALUATE SINGLE ARGUMENT
|
||
;SP 1 3
|
||
;COMMA 2 4
|
||
;I2 HOLDS 0 BEFORE 1ST FIELD;
|
||
;1 BEFORE 2ND, IF 1ST ENDED IN SPACE;
|
||
;2 BEFORE 2ND, IF 1ST ENDED IN COMMA;
|
||
;3 AFTER 2ND FIELD.
|
||
VEARG: SETZM VALUE
|
||
SETZB I2,VALUE+1
|
||
SETZM PVALUE
|
||
SETZM VALUEQ
|
||
SETOM VALUER
|
||
VEARG1: CAML W3,W4 ;IF NO FROBS LEFT, NO ARG.
|
||
JRST GSNLRT
|
||
SKIPL A,2(W3) ;IF 1ST FROB IS OPERATOR,
|
||
JRST VEARG2
|
||
MOVE A,(A) ;IF IT'S A SPACE,
|
||
CAME A,[100000,,1]
|
||
JRST VEARG2
|
||
ADD W3,[2,,2] ;SKIP IT AND TRY AGAIN.
|
||
JRST VEARG1
|
||
|
||
vearg2: setzm undefp
|
||
MOVEM I2,STATE
|
||
save errstp ;Since EFIELD doesn't do this itself
|
||
save errstl ;we do it for it!
|
||
PUSHJ P,EFIELD ;GET FIELD VALUE
|
||
SKIPA D,[100000,,3]
|
||
MOVE D,(D)
|
||
rest errstl
|
||
rest errstp
|
||
MOVE I2,STATE
|
||
JUMPN I2,VEARG4 ;JUMP IF NOT THE 1ST FIELD.
|
||
IORM A,VALUE
|
||
PUSHJ P,VERGNM
|
||
MOVEI I2,2 ;2 => COMMA
|
||
TRNN D,1
|
||
JRST VEARG8
|
||
HRRZ B,D
|
||
CAIN B,3
|
||
JRST [ SKIPN VALUE+1
|
||
JRST VERG8A
|
||
SKIPN VALUE ;FIELD TERMINATOR; IF ONLY 1 FIELD AND WAS 0,
|
||
HLLZS VALUER ;IT SPECIFIES THE ADDRESS FIELD.
|
||
JRST VERG8A]
|
||
MOVEI I2,1 ;1 => SPACE
|
||
setzm undefp ;undefineds are legal before a space
|
||
MOVSI B,777000 ;A ZERO BEFORE A SPACE IS CONSIDERED TO SET THE OP-CODE
|
||
SKIPN VALUE
|
||
ANDCAM B,VALUER
|
||
VEARG8: HRRZ B,D
|
||
CAIG B,2
|
||
JRST VEARG2 ;FIELD TERM
|
||
|
||
VERG8A: MOVE A,PVALUE
|
||
MOVEI B,0
|
||
MOVSS A
|
||
ROTC A,18.
|
||
ADD A,VALUE
|
||
ADD B,VALUE
|
||
HRR A,B
|
||
MOVE D,UNDFRP ;IF THERE ARE ANY UNDEFINED SYMBOLS IN THE VALUE,
|
||
VERG3A: JUMPLE D,VERG3B ;COUNT EACH ONE AS SPECIFYING (FOR $>'S SAKE)
|
||
HLRZ B,UNDFRL-1(D) ;THE HALFWORD IT IS SUPPOSED TO GO IN.
|
||
SKIPN B
|
||
HLLZS VALUEQ
|
||
SKIPE B
|
||
HRRZS VALUEQ
|
||
SUBI D,2
|
||
JRST VERG3A
|
||
|
||
VERG3B: MOVE B,VALUER ;THOSE FIELDS THAT HAVE BEEN SPEC'D IN THE ARGUMENT,
|
||
ANDM B,VALUEQ ;IGNORE IN THE DEFAULTS FROM THE $> IF ANY.
|
||
TLNN A,700000 ;GET THE OPCODE FROM THE NEW VALUE
|
||
SKIPA B,VALUEQ ;OR IF NONE THERE, FROM THE OLD.
|
||
MOVE B,A
|
||
TLC B,7^5 ;IF WE ARE HACKING AN I/O INSN, USE A DIFFERENT SET OF FIELDS.
|
||
MOVEI D,7^5
|
||
SKIPE KS10IO
|
||
MOVEI D,777^3
|
||
TLNN B,(D) ;SKIP IF NOT KA I/O INSTRUCTION
|
||
SKIPA B,[-5,,5]
|
||
MOVSI B,-5 ;NOW LOOK AT EACH FIELD OF THE WORD, AND DEFAULT
|
||
VEARG3: MOVE D,VEARG7(B) ;ANY FIELD WHICH WE DON'T KNOW TO HAVE BEEN SPEC'D
|
||
AND D,VALUEQ ;TO THE "OLD" VALUE IN VALUEQ, SET BY $> IF THERE WAS ONE.
|
||
TDNN A,VEARG7(B)
|
||
IOR A,D ;ANY NONZERO FIELD WE KNOW WAS SPEC'D.
|
||
AOBJN B,VEARG3 ;IN A FIELD IS OTHERWISE DETERMINED TO HAVE BEEN SPEC'D,
|
||
MOVEM A,VALUE ; THE FIELD IN VALUEQ IS ZEROED.
|
||
SKIPN B,VALUE+1 ;WORD TERM
|
||
MOVSI B,SYLOCT
|
||
MOVEM B,VALUE+1
|
||
POPJ P,
|
||
|
||
VEARG7: 777000,,;OP CODE
|
||
0 17,0 ;AC FIELD
|
||
@ ;INDIRECT BIT
|
||
(17) ;INDEX FIELD
|
||
,,-1 ;ADDRESS
|
||
;FIELDS FOR I/O INSNS
|
||
700340,,;OP CODE
|
||
77400,, ;DEVICE
|
||
@ ;INDIRECT BIT
|
||
(17) ;INDEX FIELD
|
||
,,-1 ;ADDRESS FIELD
|
||
|
||
;COME HERE FOR FIELD OTHER THEN 1ST. VALUE IS IN A, TYPE IN B.
|
||
VEARG4: CAIN I2,3
|
||
JRST VEARG5 ;NOT 2ND FIELD EITHER => ADD TO RH.
|
||
CAME D,[100000,,2]
|
||
JRST VERG5B ;JUMP FOR SECOND FIELD AND NOT FOLLOWED BY COMMA.
|
||
CAIE I2,1 ;SKIP IF "FOO A,"; DON'T SKIP IF "FOO,A," OR "FOO,,".
|
||
JRST VEARG6
|
||
skipe undefp
|
||
jrst nunde1
|
||
SETCM I4,VALUE
|
||
CALL VERG5D ;PUT VALUE OF THIS FIELD IN RIGHT PART OF WORD.
|
||
ADDM A,VALUE
|
||
JRST VERG5A
|
||
|
||
nunde1: move w4,fldstr ;First clear off the FROB stack
|
||
jrst nunder ;and then give the error
|
||
|
||
;GIVEN THE 1'S COMPLEMENT OF AN INSN IN I4, PUT THE VALUE IN A,B INTO THE
|
||
;AC FIELD OR THE DEVICE CODE FIELD ACCORDING TO WHETHER THE INSN IS AN I/O INSN.
|
||
;IF B INDICATES EXPLICITLY SPEC'D FIELD, SET VALUER TO REMEMBER THAT.
|
||
;LEAVES VALUE (SHIFTED APPRO.) IN A. CLOBBERS I4.
|
||
|
||
VERG5D: SKIPN KS10IO
|
||
TLZA I4,77000 ;KA/KL HAVE MORE I/O INSTRUCTIONS
|
||
TLC I4,77000 ;KS HAS APR, PI ONLY IN KA FORMAT
|
||
TLNN I4,777000
|
||
JRST VERG5F
|
||
ANDI A,17
|
||
LSH A,27
|
||
SKIPE B
|
||
DPB A,[270400,,VALUER] ;AC FIELD EXPLICITLY SPEC'D; PREFER SPEC'D ONE
|
||
RET ;EVEN IF IT'S 0, IN CASE OF $>'ING.
|
||
|
||
VERG5F: LDB I4,[900,,A] ;IO INST
|
||
ANDI I4,774
|
||
AND A,[077400,,]
|
||
LSH I4,30
|
||
IORB A,I4 ;WIN FOR DEVICE CODES
|
||
SKIPE B
|
||
DPB A,[320700,,VALUER]
|
||
RET
|
||
|
||
;2ND FIELD, NOT FOLLOWED BY COMMA.
|
||
VERG5B: CAIE I2,2
|
||
JRST VEARG5 ;"A FOO" - "A" DOESN'T GO IN AC FIELD.
|
||
SETCM I4,VALUEQ ;"A,FOO" FORMAT.
|
||
EXCH A,VALUE ;SAVING FOO, GET A AND SHIFT IT TO RIGHT PLACE IN WORD.
|
||
EXCH B,VALUE+1
|
||
CALL VERG5D
|
||
EXCH A,VALUE ;STORE IT BACK AND GET FOO AGAIN.
|
||
EXCH B,VALUE+1
|
||
;COME HERE FOR FIELD OTHER THAN 1ST, TO ADD TO RH OF WORD.
|
||
VEARG5: setzm undefp ;undefineds are legal here
|
||
SKIPE B ;EXPLICIT "0" GOING INTO R.H. OVERRIDES $> DEFAULT.
|
||
HLLZS VALUER
|
||
HRRZS A
|
||
ADD A,VALUE
|
||
HRRM A,VALUE
|
||
VERG5A: PUSHJ P,VERGNM
|
||
VERG6A: MOVEI I2,3
|
||
JRST VEARG8
|
||
|
||
VEARG6: JUMPN B,VEARG5 ;"FOO,," FORMAT
|
||
setzm undefp ;say undefineds are legal here
|
||
MOVSI A,400000 ;SAY ALL UNDEF REFS ARE SWAPPED REFS.
|
||
MOVE B,UNDFRP
|
||
SOJL B,.+3
|
||
IORM A,UNDFRL(B)
|
||
SOJG B,.-2
|
||
HRLZS A,VALUE ;PUT 1ST FIELD INTO LH.
|
||
SKIPE VALUE+1
|
||
HRRZS VALUER ;MAKE "0,,$>" CLEAR THE L.H.
|
||
JRST VERG6A
|
||
|
||
VERGNM: PUSH P,D
|
||
MOVE D,VALUE+1
|
||
PUSHJ P,NMODE
|
||
POP P,D
|
||
MOVEM B,VALUE+1
|
||
POPJ P,
|
||
|
||
;EVALUATE FIELD
|
||
;RETURN SKIPPING WITH RESULT IN A & B AND
|
||
;WITH FIELD TERMINATOR IN D
|
||
;OR NOT SKIPPING IF HIT END OF FROBS
|
||
EFIELD: PUSH P,[-1]
|
||
TLZ F,FLNNUL\FLPNT\FLLET
|
||
SKIPN PSTATE
|
||
MOVEM P,EFIELP ;P TO RESTORE ON PDL OVERFLOW DUE TO NESTED OPERATORS.
|
||
JRST EFLD3
|
||
;FLLET=END OF WORLD
|
||
|
||
EFLD2: ADD W3,[2,,2]
|
||
EFLD3: MOVEI C,EFLD2 ;SET UP ERROR RETURN
|
||
MOVEM C,ERRSTL ;FOR EXECUTE-DURING-EVAL OPERATORS.
|
||
MOVEM P,ERRSTP
|
||
CAML W3,W4
|
||
JRST EFLDEW ;END OF WORLD
|
||
MOVE C,1(W3)
|
||
MOVE D,2(W3) ;GET FROB
|
||
EFLD4: JUMPGE D,EFLDNO ;NOT AN OPERATOR, PUSH ON STACK.
|
||
MOVE I4,(D)
|
||
TLNE I4,1000
|
||
JRST (I4) ;EXECUTE DURING EVAL
|
||
TLNE I4,100000
|
||
JRST EFLDE ;END OF FIELD
|
||
TLO F,FLNNUL
|
||
LDB I2,[340200,,I4] ;GET PRIORITY
|
||
SKIPN I2
|
||
ERLOSS 2(P) ;UUOH WILL PUSH A, THEN D.
|
||
SKIPGE (P)
|
||
JRST EFLD8 ;THIS IS PREFIX
|
||
MOVE B,-2(P)
|
||
AOJE B,EFLD8 ;THIS IS FIRST OPR
|
||
EFLDEA: SOS B
|
||
MOVE I4,(B)
|
||
LDB I3,[340200,,I4]
|
||
SKIPL -3(P) ;IF PREV. OP. WAS PREFIX OR HIGHER PRIOR,
|
||
CAMG I2,I3
|
||
JRST EFLD8Z ;EXECUTE IT, REPLACE BY VALUE.
|
||
EFLD8: CAML P,[-20,,]
|
||
JRST NPDLER
|
||
PUSH P,D ;PUSH THIS OP IN ANY CASE.
|
||
JRST EFLD2
|
||
|
||
EFLD8Z: POP P,D ;POP 2ND ARG.
|
||
POP P,C
|
||
POP P,I2 ;OP. TO EXECUTE.
|
||
SKIPGE (P) ;IF PREFIX, DUMMY UP 1ST ARG,
|
||
JRST EFLD8P
|
||
POP P,B ;ELSE POP ACTUAL 1ST ARG.
|
||
POP P,A
|
||
EFLD9P: PUSHJ P,(I4) ;ACUALLY EXECUTE AN OPERATOR
|
||
PUSH P,A ;REPLACE OP. AND ARGS BY VALUE.
|
||
PUSH P,B
|
||
JRST EFLD3
|
||
|
||
EFLDE: TLNN F,FLNNUL
|
||
CAME I4,[100000,,1]
|
||
JRST EFLDE1
|
||
JRST EFLD2 ;LEADING SPACE FLUSHER
|
||
|
||
EFLD8P: MOVE A,[0 ? 1 ? -1]-1(I3)
|
||
MOVEI B,1
|
||
TLNN I2,30000 ;SKIP IF FLOAT
|
||
JRST EFLD9P
|
||
TLC A,232000
|
||
FADR A,A
|
||
JRST EFLD9P
|
||
|
||
EFLDNO: TLO F,FLNNUL ;NOT AN OP - FIELD NOT NULL.
|
||
SKIPL (P) ;PREVIOUS WASN'T OP => CONSEC. ARGS, ERROR.
|
||
JRST EFLNOS
|
||
CAML P,[-20,,]
|
||
JRST NPDLER
|
||
SAVE C ;ELSE JUST PUSH THIS ARG.
|
||
SAVE D
|
||
CAMN D,[SYLSYM,,]
|
||
JRST EFLDN1 ;J IF UNEVALUATED SYMBOL.
|
||
HLRZ I4,D ;CHECK FOR FUNNY SYMBOLS.
|
||
HRLZI D,(D)
|
||
CAIN I4,SYLSYM
|
||
IORM D,FNYLOC ;ACCUMULATE FUNNYNESS OF ALL SYMS IN ARGS.
|
||
JRST EFLD2
|
||
|
||
EFLDN1: setom undefp ;Say we just encountered an undefined.
|
||
SETZM -1(P) ;UNEVALUATED SYMBOL HAS VALUE 0,
|
||
MOVEI D,2
|
||
ADD D,UNDFRP
|
||
CAILE D,UNDFRS
|
||
JRST NUNDER ;(TOO MANY UNDEF SYMS IN 1 ARG)
|
||
MOVEM D,UNDFRP ;CREATE AN UNDEF REF FOR THE SYMBOL.
|
||
MOVEM C,UNDFRL-2(D)
|
||
SETZM UNDFRL-1(D) ;SAY NORMAL REF, NOT SWAPPED.
|
||
JRST EFLD2
|
||
|
||
EFLNOS: 7TYPE [ASCII / NOS/]
|
||
MOVE D,[O.OP+"+,,OPTAB0+"+-1] ;+
|
||
JRST EFLD4
|
||
|
||
EFLDEW: TLO F,FLLET
|
||
EFLDE1: TLNN F,FLNNUL
|
||
JRST EFLDE2 ;NULL
|
||
MOVNI I2,1 ;EFLDEA WILL LOOK AT THIS .
|
||
SKIPL B,(P)
|
||
JRST EFLDE5
|
||
AOJE B,EFLDXX ;NOTHING ON STACK
|
||
SAVE [0]
|
||
SAVE [1]
|
||
EFLDE5: MOVE B,-2(P)
|
||
AOJE B,EFLDE8
|
||
JRST EFLDEA
|
||
|
||
EFLDXX: SKIPN B
|
||
EFLDE2: SETZB A,B
|
||
SUB P,[1,,1] ;FLUSH THE -1 PUSHED AT EFIELD.
|
||
TLNE F,FLLET ;IF RAN OUT OF SYLLS, RETURN.
|
||
POPJ P,
|
||
ADD W3,[2,,2] ;ELSE PASS BY THE FIELD-TERMINATOR.
|
||
JRST CPOPJ1
|
||
|
||
EFLDE8: POP P,B
|
||
POP P,A
|
||
JRST EFLDXX
|
||
|
||
NPDLER: MOVE P,EFIELP
|
||
MOVEM P,ERRSTP
|
||
ERSTRT [SIXBIT/PDL OVERFLOW - OPERATORS TOO NESTED?/]
|
||
|
||
;PARENTHESIS AND ANGEL BRAKET ROUTINES
|
||
|
||
NLPARN: SKIPA A,[2] ;(
|
||
NLANGB: MOVEI A,1 ;<
|
||
CAML P,[-20,,]
|
||
JRST NPDLER
|
||
SAVE PSTATE
|
||
MOVEM A,PSTATE
|
||
SAVE PVALUE
|
||
SAVE VALUE
|
||
SAVE VALUE+1
|
||
SAVE STATE
|
||
SAVE VALUER
|
||
SAVE F
|
||
TLZ F,FLPNT\FLLET\FLNNUL
|
||
ADD W3,[2,,2]
|
||
push p,undfrp ;remember how many undefineds?
|
||
call vearg ;get value within
|
||
pop p,d ;get how many undefineds we did have
|
||
came d,undfrp ;any undefineds?
|
||
call undflp ; yes, flip them!
|
||
MOVE C,VALUE
|
||
MOVE D,VALUE+1
|
||
REST F
|
||
REST VALUER
|
||
REST STATE
|
||
REST VALUE+1
|
||
REST VALUE
|
||
REST PVALUE
|
||
HRRZ B,PSTATE
|
||
MOVE A,C ;PARENS WITH ZERO INSIDE ARE REGARDED AS SPECIFYING
|
||
IORI A,-2(B)
|
||
SKIPN A ;THE INDEX FIELD.
|
||
DPB A,[220400,,VALUER]
|
||
SKIPL A,PSTATE
|
||
7TYPE NLCLSE-1(A) ;ERROR IF NO CLOSE SUPPLIED
|
||
REST PSTATE
|
||
TRNN A,2
|
||
JRST NLNGB2 ;<>
|
||
SKIPGE A,(P) ;()
|
||
AOJN A,NLPOP ;JUMP IF PRECEDED BY ARITH OP
|
||
LSHC B,18.
|
||
ADD C,PVALUE
|
||
HLLM C,PVALUE
|
||
ADD B,PVALUE
|
||
HRRM B,PVALUE
|
||
JRST EFLD3
|
||
|
||
;; Flip which half any undefineds appear in.
|
||
;; D has index (1 based) of first one not to flip
|
||
|
||
undflp: movsi c,400000 ;bit to toggle
|
||
move b,undfrp ;get where things are to now
|
||
subi d,(b) ;get -<# of undefineds to flip>
|
||
jumpge d,cpopj ;safety check!
|
||
undfl1: xorm c,undfrl(b) ;flip
|
||
sos b ;previous entry
|
||
aojl d,undfl1 ;end of loop?
|
||
ret
|
||
|
||
|
||
NLPOP: MOVSS C
|
||
NLNGB2: SUB W3,[2,,2]
|
||
JRST EFLD4
|
||
|
||
NLCLSE: ASCII / >/
|
||
ASCII / )/
|
||
|
||
NRPARN: SKIPA A,[2] ;)
|
||
NRANGB: MOVEI A,1 ;>
|
||
HRRZ B,PSTATE
|
||
CAME A,B
|
||
7TYPE NRNMTC-1(A) ;ERROR ON UN-MATCHED CLOSE
|
||
HRROM B,PSTATE
|
||
MOVE D,[410000+" -1,,OPTAB1+" -1] ;$SP
|
||
JRST EFLD4
|
||
|
||
NRNMTC: ASCII / </
|
||
ASCII / (/
|
||
|
||
;READ A FROB INTO A,B.
|
||
;RETURN LAST CHAR. READ IN D.
|
||
;(WILL BE RUBOUT IFF TRYING TO RUB PREVIOUS FROB)
|
||
GTFROB: PUSHJ P,GSOA ;INIT. PROC, SET UP RET. ADDR.
|
||
JRST GSNLRT ;(RETN HERE IF WHOLE SYLL RUBBED)
|
||
GTFRPC: TLZ F,FLNNUL\FLPNT\FLLET\FLNEGE
|
||
;DETERMINE IF FROB TO BE READ IS SYL OR OP
|
||
JSP W2,RCH
|
||
CAIL D,140
|
||
SUBI D,40 ;LOWER CASE TO UPPER.
|
||
CAIL D,"0
|
||
CAILE D,"9
|
||
JRST FRBTY2
|
||
JRST SLRPND
|
||
|
||
FRBTY2: CAIL D,"A
|
||
CAILE D,"Z
|
||
JRST FRBTY4
|
||
JRST SLRPND
|
||
|
||
FRBTY4: CAIE D,".
|
||
CAIN D,"$
|
||
JRST SLRPND
|
||
CAIN D,"%
|
||
JRST SLRPND
|
||
MOVEI W2,GOPND
|
||
JRST GOPND
|
||
|
||
GSDECJ: SKIPA B,[SYLDEC,,]
|
||
GSOCTJ: MOVSI B,SYLOCT
|
||
POPJ P,
|
||
|
||
GSEVLJ: TLZA B,-1 ;JSP B,GSEVLJ TO RETURN TYPE-0 SYLL.
|
||
GSNLRT: SETZB A,B ;GET SYL NULL RETURN
|
||
POPJ P,
|
||
|
||
GSFLTJ:
|
||
FMODE: MOVSI B,SYLFLT
|
||
POPJ P,
|
||
|
||
DBP: ADD A,[70000,,] ;DECREMENT BYTE POINTER (7 BIT)
|
||
TLNE A,400000
|
||
ADD A,[347777,,-1]
|
||
POPJ P,
|
||
|
||
|
||
;COME HERE WITH 1ST CHAR IF IS SYLLABLE.
|
||
SLRPND: JSP W2,SLRPN2
|
||
|
||
;PROCESS 1 CHAR OF SYLLABLE.
|
||
SLRPN2: CAIL D,140
|
||
SUBI D,40 ;LOWER CASE TO UPPER.
|
||
CAIL D,"0
|
||
CAILE D,"9
|
||
JRST SLRNNM ;JUMP IF NOT DIGIT
|
||
TLO F,FLNNUL ;NOT NULL
|
||
PUSHJ P,GASSOD
|
||
MOVE A,GSFNUM ;ASSEMBLE FLOATING
|
||
MOVEI B,-"0(D)
|
||
TLO B,232000
|
||
FADR B,B
|
||
TLNE F,FLPNT
|
||
JRST SLRFN2 ;JUMP IF AFTER POINT
|
||
FMPR A,[10.0]
|
||
SLRFN3: FADR A,B
|
||
MOVEM A,GSFNUM
|
||
SUBI D,"0-1 ;CONVERT TO SQUOZE DIGIT
|
||
SLRSYM: PUSHJ P,SYMPUT
|
||
JSP W2,RCH
|
||
JRST SLRPN2
|
||
|
||
GASSOD: MOVE A,GSONUM ;ASSEMBLE OCTAL
|
||
LSH A,3
|
||
ADDI A,-"0(D)
|
||
MOVEM A,GSONUM
|
||
MOVE A,GSDNUM ;ASSEMBLE DECIMAL
|
||
IMULI A,10.
|
||
ADDI A,-"0(D)
|
||
MOVEM A,GSDNUM
|
||
POPJ P,
|
||
|
||
;PUT SQUOZE IN SYM
|
||
SYMPUT: MOVE A,GSSSYM
|
||
CAML A,[1*50*50*50*50*50]
|
||
POPJ P, ;ALREADY A FULL SYMBOL
|
||
IMULI A,50
|
||
ADD A,D
|
||
MOVEM A,GSSSYM
|
||
POPJ P,
|
||
|
||
;FLOATING AFTER POINT
|
||
SLRFN2: AOS C,GSFNUC
|
||
FDVR B,[10.0]
|
||
SOJG C,.-1
|
||
JRST SLRFN3
|
||
|
||
;NOT A DIGIT
|
||
SLRNNM: CAIL D,"A
|
||
CAILE D,"Z
|
||
JRST SLRNLT ;JUMP ON NOT LETTER
|
||
SLRLET: TLNE F,FLLET
|
||
JRST SLRLE2
|
||
CAIN D,"E
|
||
JRST SLRPE
|
||
SLRLE2: SUBI D,"A-13
|
||
SKIPA
|
||
SLR$%: ADDI D,46-"$
|
||
TLO F,FLLET\FLNNUL
|
||
JRST SLRSYM
|
||
|
||
;NOT A LETTER
|
||
SLRNLT: CAIE D,"$
|
||
CAIN D,"%
|
||
JRST SLR$%
|
||
CAIN D,".
|
||
JRST SLR.
|
||
SLRNNN: SETOM UNRCHF
|
||
TLNN F,FLNNUL\FLPNT
|
||
JRST GSNLRT
|
||
TLNE F,FLLET
|
||
JRST GSYLET
|
||
TLNE F,FLPNT
|
||
JRST GSYDFN
|
||
MOVE A,GSONUM
|
||
JRST GSOCTJ
|
||
|
||
SLR.: TLOE F,FLPNT
|
||
TLO F,FLLET ;A LETTER IF NOT ONLY ONE
|
||
TLZ F,FLNNUL ;TO TELL IF DEC OR FLOAT
|
||
MOVEI D,45 ;SQUOZE
|
||
JRST SLRSYM
|
||
|
||
GSYLET: MOVSI B,SYLSYM
|
||
SKIPE A,GSSSYM ;SKIPE IN CASE $0&=, ETC.
|
||
GSYLE2: CAML A,[1*50*50*50*50*50]
|
||
POPJ P,
|
||
IMULI A,50
|
||
JRST GSYLE2
|
||
|
||
GSYDFN: MOVE C,GSSSYM ;IF WAS JUST ., IS SYM.
|
||
CAIN C,45
|
||
JRST GSYLET
|
||
MOVE A,GSDNUM
|
||
TLNN F,FLNNUL ;ELSE MAY BE DECIMAL NUM.
|
||
JRST GSDECJ
|
||
MOVE A,GSFNUM ;OR MAY BE FLOATING.
|
||
JRST GSFLTJ
|
||
|
||
;E FORMAT
|
||
SLRPE: TLZN F,FLPNT
|
||
JRST SLRLE2
|
||
SUBI D,"A-13
|
||
PUSHJ P,SYMPUT
|
||
SLRPEL: JSP W2,RCH
|
||
CAIL D,140
|
||
SUBI D,40
|
||
CAIN D,"+
|
||
JRST SLRPEM
|
||
CAIN D,"-
|
||
JRST SLRPE1
|
||
CAIL D,"0
|
||
CAILE D,"9
|
||
JRST SLRENN
|
||
TLO F,FLLET
|
||
MOVE A,GSENUM
|
||
IMULI A,10.
|
||
ADDI A,-"0(D)
|
||
MOVEM A,GSENUM
|
||
SUBI D,"0-1
|
||
PUSHJ P,SYMPUT
|
||
JRST SLRPEL
|
||
|
||
SLRPEM: TLNE F,FLLET
|
||
JRST SLREM2
|
||
JRST SLRPEL
|
||
|
||
SLRPE1: TLNE F,FLLET
|
||
JRST SLREM2
|
||
TLC F,FLNEGE
|
||
JRST SLRPEL
|
||
|
||
SLRENN: CAIL D,"A
|
||
CAILE D,"Z
|
||
JRST SLREN2
|
||
TLO F,FLLET
|
||
JRST SLRLET
|
||
|
||
SLREN2: CAIE D,"$
|
||
CAIN D,"%
|
||
JRST SLRNLT
|
||
CAIN D,".
|
||
JRST SLRPE.
|
||
SLREM2: SETOM UNRCHF
|
||
MOVE A,GSFNUM
|
||
MOVE C,GSENUM
|
||
ANDI C,77
|
||
TLNE F,FLNEGE
|
||
JRST SLRPE4
|
||
SLRPE2: SOJL C,GSFLTJ
|
||
FMPR A,[10.0]
|
||
JRST SLRPE2
|
||
|
||
SLRPE4: SOJL C,GSFLTJ
|
||
FDVR A,[10.0]
|
||
JRST SLRPE4
|
||
|
||
SLRPE.: TLOE F,FLPNT
|
||
JRST SLRNLT
|
||
MOVEI D,45
|
||
PUSHJ P,SYMPUT
|
||
JRST SLRPEL
|
||
|
||
;READ AN OPERATOR, RETURN IT IN A,B
|
||
;W2 CONTAINS GOPND, WHICH PROCESSES 1 CHAR. RCH RETURNS TO IT.
|
||
;COME IN WITH THE 1ST CHAR FROM FRBTYP.
|
||
|
||
GOPND: CAIN D,33
|
||
JRST GOPALT
|
||
CAIL D,"0
|
||
CAILE D,"9
|
||
JRST GOPNNM
|
||
TLO F,FLLET
|
||
PUSHJ P,GASSOD
|
||
JRST RCH
|
||
|
||
GOPALT: AOS A,GSENUM
|
||
CAILE A,2
|
||
SOS GSENUM
|
||
JRST RCH
|
||
|
||
GOPPNT: TLNN F,FLLET
|
||
JRST GOPNN2 ;$., $$.
|
||
TLC F,FLPNT
|
||
JRST RCH
|
||
|
||
GOPNNM: CAIN D,".
|
||
JRST GOPPNT
|
||
GOPNN2: CAIL D,140
|
||
SUBI D,40
|
||
MOVEM D,GSFNUM
|
||
MOVE A,GSONUM
|
||
TLNE F,FLPNT
|
||
MOVE A,GSDNUM
|
||
MOVSI B,O.OP ;OP
|
||
TLNE F,FLLET
|
||
TLO B,O.IFX ;NUM PRESENT
|
||
TLNE F,FLPNT
|
||
TLO B,O.IFXD ;DECIMAL
|
||
MOVE C,GSENUM
|
||
DPB C,[360200,,B] ;ALTS
|
||
MOVE D,GSFNUM
|
||
PUSHJ P,FIXOPC
|
||
HRRI B,@GOPBT1(C)
|
||
MOVE C,GSFNUM
|
||
DPB C,[220700,,B] ;CHAR
|
||
POPJ P,
|
||
|
||
FIXOPC: CAIL D,33 ;FLUSH IMPOSSIBLE OP CHARS
|
||
SOS D
|
||
CAIL D,"0-1
|
||
SUBI D,"9-"0+1
|
||
POPJ P,
|
||
|
||
GOPBT1: OPTAB0(D)
|
||
OPTAB1(D)
|
||
OPTAB2(D)
|
||
|
||
ATSIGN: MOVSI A,(@) ;@
|
||
XORM A,VALUE
|
||
ANDCAM A,VALUER ;SPEC'D INDIRECT BIT OVERRIDES OLD ($>) REGARDLESS OF VALUES.
|
||
ATSIG1: TLO F,FLNNUL
|
||
JRST EFLD2
|
||
|
||
NQMK: SKIPGE CU ;?
|
||
JRST KHELP ;NO JOB; NORMAL FUNCTIONS ARE IMPOSSIBLE, SO GIVE USER HELP.
|
||
SKIPE UNDEFF ;RIGHT AFTER A ?U? ERROR =>
|
||
JRST NQMK2 ;MAKE AN UNDEF. REF. TO THE ERRONEOUS SYMBOL.
|
||
HRRI B,[201000,,EFLD2] ;THESE BITS ARE SUCH AS FOUND IN OPTAB0, ETC.
|
||
MOVE C,FLDTBP ;ARE WE FOLLOWING AN OPERATOR, OR THE 1ST FROB?
|
||
ADD C,[3,,2]
|
||
CAME C,W4
|
||
SKIPGE -2(W4)
|
||
HRRI B,[10200,,NQMK1] ;YES: WE MEAN "BIT TYPEOUT OF ARG OR $Q".
|
||
RET ;OTHERWISE, WE MEAN "PRECEDING IS UNDEFINED SYMBOL REF"
|
||
;WHICH IS HANDLED BY PROTECTING SYMBOL FROM EVALUATION
|
||
;(WHICH WOULD SAY ?U?), AND BEING IGNORED AT EVAL TIME.
|
||
NQMK1: HRROI C,TMH ;"?" COMES BACK HERE AFTER EVALLING ARGS; RETYPE IN $?$H MODE.
|
||
SAVE BITF
|
||
SETOM BITF
|
||
CALL NSEM2
|
||
REST BITF
|
||
RET
|
||
|
||
NQMK2: MOVE A,UNDEFF ;CREATE AN UNEVALUATED SYMBOL TO RETURN, JUST LIKE
|
||
MOVSI B,SYLSYM ;THE ONE THAT CAUSED THE ?U? ERROR.
|
||
SETOM UNRCHF ;MAKE THE "?" BE REPROCESSED AFTER THAT SYMBOL, TO
|
||
RET ;PROTECT IT FROM EVALUATION.
|
||
|
||
NSIGN: ADDI C,TNMSGN-TAMPER ;#, GET ADDR OF MODE IN CASE SHOULD TYPE OUT,
|
||
SKIPA B,[SETZ ("#) [6000,,NSIGN1]]
|
||
NAMAND: HRRI B,[6000,,NAMAN1] ;&
|
||
ADDI C,TAMPER-TDQUOT
|
||
MOVE A,FLDTBP
|
||
ADD A,[3,,2]
|
||
CAME A,W4 ;NOT 1ST FROB =>
|
||
RET ;TURN INTO ARITH. OP.
|
||
NDQ: ADDI C,TDQUOT-TPRIME ;" RETYPE IN $" MODE.
|
||
NPRM: ADDI C,TPRIME ;' RETYPE IN $' MODE.
|
||
HRLI C,-2 ;GO INDIRECT THRU USER VAR IN RH(C).
|
||
JRST NSEM2 ;GET ARG AND TYPE IT.
|
||
|
||
NALTEQ: TLNN B,O.IFX ;$=
|
||
JRST FEQL ;$= WITHOUT INFIX ARG IS FLOATING-POINT.
|
||
CAIG A,1
|
||
JRST NAERR
|
||
SAVE ODF ;$<N>= USES RADIX <N>.
|
||
MOVEM A,ODF
|
||
HRROI C,FTOC ;AND PRINTS AS A NUMBER.
|
||
CALL NSEM2
|
||
REST ODF
|
||
RET
|
||
|
||
NEQL: TRC C,FTOC#PIN ;=
|
||
NLFTA: TRC C,PIN#TFLOT ;_
|
||
FEQL: EQVI C,#TFLOT ;$= THIS SETS SIGN OF C.
|
||
JRST NSEM2 ;GET ARG, SET $Q, CALL (C), RETURN NULL.
|
||
|
||
;$< AND $$< SET GTMALT, ETC. AS A SIGNAL TO SLRPIN
|
||
;TO READ SOME ALT'S AND THE INFIX ARG (IN OCTAL)
|
||
;BEFORE READING ANYTHING FROM THE TTY OR FILE OR VALRET, ETC.
|
||
ALTLES: PUSHJ P,GTVAL
|
||
TLNE C,10
|
||
JRST ALTLE4
|
||
MOVEI D,1 ;CAUSE 1 ALTMODE TO BE READ.
|
||
JRST ALTLE2
|
||
|
||
A2LES: PUSHJ P,GTVAL
|
||
TLNE C,10
|
||
JRST ALTLE4
|
||
MOVEI D,2 ;READ 2 ALTMODES.
|
||
ALTLE2: MOVEM D,GTMALT
|
||
MOVE A,ARG1
|
||
MOVEM A,GTFTEM ;HERE GOES ARG FOR SLRPIN TO READ.
|
||
MOVE A,[440300,,GTFTEM]
|
||
ILDB D,A
|
||
TLNE A,770000
|
||
JUMPE D,.-2
|
||
ADD A,[30000,,]
|
||
MOVEM A,GTPNTR ;SLRPIN GETS OCTAL DIGITS FROM THIS BP.
|
||
POPJ P,
|
||
|
||
ALTLE4: 7TYPE [ASCIZ /</]
|
||
POPJ P,
|
||
|
||
ALTEQ: MOVSI W3,-<NARGS*2> ;$$=
|
||
ALTEQ2: SKIPN C,ARG1+1(W3)
|
||
JRST NLTL4
|
||
MOVE A,ARG1(W3)
|
||
CALL GFROBP
|
||
PUSHJ P,CRF
|
||
AOBJN W3,.+1
|
||
AOBJN W3,ALTEQ2
|
||
JRST NLTL4
|
||
|
||
LWTPUT: PUSH P,B
|
||
|
||
MOVE B,LWTP ;SET $Q FROM D .
|
||
ADDI B,2
|
||
CAIL B,LWTTAB+2*LWTLNG
|
||
MOVEI B,LWTTAB
|
||
|
||
MOVEM D,(B)
|
||
MOVEM D,LWT
|
||
MOVSI D,SYLOCT
|
||
MOVEM D,1(B)
|
||
MOVEM D,LWT+1
|
||
MOVE D,LWT
|
||
|
||
MOVEM B,LWTP
|
||
JRST POPBJ
|
||
|
||
GARGDQ: MOVE D,LWT ;GET ARG OR $Q IN D.
|
||
SKIPE ARG1+1
|
||
MOVE D,ARG1
|
||
POPJ P,
|
||
|
||
NSEMIC: ; ";" - RETYPE IN LAST MODE SPECIFIED (EVEN IF SINCE RESET)
|
||
|
||
INSIRP PUSH P,SCH AR ODF BITF BITPAT BITPA1 BITSYM BITSY1
|
||
|
||
call nasemi ;was call NSEM2, but that leads to attempts to read from
|
||
;(non-existant) inferior. SYSBIN;DDT BIN for 657 does
|
||
;call nasemi, and I believe it to be correct
|
||
|
||
INSIRP POP P,BITSY1 BITSYM BITPA1 BITPAT BITF ODF AR SCH
|
||
RET
|
||
|
||
|
||
|
||
N2ASEM: MOVE A,[SCHMM,,SCHM] ;$$;
|
||
BLT A,BITFM
|
||
NASEMI: MOVE A,[SCHMM,,SCH] ;$;
|
||
BLT A,BITF
|
||
MOVE C,SCHMM ;GET ADR OF TYPEOUT RTN.
|
||
jrst nsem2
|
||
|
||
NSEM3: PUSHJ P,LWTPUT
|
||
CALL PVAL2 ;(THIS RTN MAY SKIP TO AVOID TYPING SPACES)
|
||
LCTGNR: 7TYPE [ASCIZ/ /]
|
||
JRST GSNLRT
|
||
|
||
;OUTPUT $Q OR NUMERIC ARG IN CURRENT MODE,
|
||
;DECREMENTING TTYFLG BY ONE, SO WE PRINT EVEN INSIDE ONE LEVEL OF ^W.
|
||
NSEM2: SAVE TTYFLG
|
||
SKIPE TTYFLG
|
||
SOS TTYFLG
|
||
CALL GARGDQ
|
||
CALL LWTPUT
|
||
CALL PVAL2
|
||
REST TTYFLG
|
||
JRST LCTGNR
|
||
|
||
NCART: TLZ F,FLST ;^M (CR)
|
||
MOVE D,[SCHM,,SCH]
|
||
BLT D,BITF
|
||
jrst gsnlrt
|
||
|
||
;POP THE . RING BUFFER IF O.1ALT IS SET IN B.
|
||
;INFIX ARG (IN A) SAYS HOW MANY TIMES TO POP IT (0 => POP ONCE).
|
||
PLUNK2: TLNN B,O.1ALT
|
||
RET
|
||
PLUNK3: SAVE A
|
||
MOVE A,PLCR
|
||
MOVE D,LOCBF(A)
|
||
SOSGE A
|
||
MOVEI A,NLEVS-1
|
||
MOVEM A,PLCR
|
||
MOVEM D,LLOC
|
||
REST A
|
||
SOJG A,PLUNK3
|
||
POPJ P,
|
||
|
||
;DEPOSIT THE ARG, IF ANY, IN THE OPEN REGISTER, IF ANY.
|
||
;CLOSES THE REGISTER IN ANY CASE.
|
||
PLUNK1: MOVEM F,PLUNKF ;[ ;(^] MUST KNOW IF ANY LOC. HAD BEEN OPEN)
|
||
TLZE F,FLRO
|
||
SKIPN ARG1+1
|
||
JRST CPOPJ
|
||
MOVE D,ARG1
|
||
PUSHJ P,LWTPUT ;SET $Q TO VALUE BEING STORED,
|
||
MOVE A,LLOCO
|
||
PUSHJ P,DEPRMV ;UPDATE UNDEF SYM REFS FOR LOCATION,
|
||
MOVE D,LWT ;(DEPRMV CLOBBERED D)
|
||
JRST DEPF ;THEN STORE IN IT.
|
||
|
||
NTAB3: PUSHJ P,GARGDQ
|
||
TLNE B,O.1ALT
|
||
MOVSS D ;$TAB
|
||
TLNN B,O.2ALT ;$$TAB => DO EFFEC. ADDR. CALC.
|
||
JRST NTAB5
|
||
PUSHJ P,EASETU ;AC'S UGH BLETCH
|
||
PUSHJ P,NEFECC ;SOLVE IT
|
||
MOVE D,I1 ;GET RESULT
|
||
NTAB5: HLL D,FNYLOC ;LH OF D GETS FUNNYNESS OF LOC. TO OPEN.
|
||
POPJ P,
|
||
|
||
NACM: PUSHJ P,PLUNK2 ;$^M, POP . RING BUFFER.
|
||
SKIPA D,LLOC
|
||
NNL2: PUSHJ P,CRF
|
||
UBRKNL: PUSHJ P,PLOC ;SET . AND LOCATION OPEN.
|
||
PUSHJ P,PAD
|
||
TLNN F,FLST
|
||
CTYPE "/
|
||
TLNE F,FLST
|
||
7TYPE [ASCIZ /!/]
|
||
JRST NTAB2A
|
||
|
||
NTAB: PUSHJ P,NTAB3 ;DEP ARG, CALC. ADDR TO OPEN.
|
||
JRST NNL2 ;GO OPEN IT.
|
||
|
||
;BEFORE CALLING, DISPATCHER CALLED PLUNK TO STORE ARG.
|
||
NNL: PUSHJ P,PLUNK2 ;^J, $^J. IF IS $^J, POP . RING BUFFER.
|
||
MOVE D,LLOC ;GET POINT, INCREM BUT DON'T CHANGE LH.
|
||
HRRI D,1(D)
|
||
JRST NNL1 ;GO CR, PRINT ADDR & CONTENTS.
|
||
|
||
NUPA: PUSHJ P,PLUNK2
|
||
MOVE D,LLOC ;UPARROW - SIMILAR BUT DECREMENT.
|
||
HRRI D,-1(D) ;NOTE LH HAS FUNNYNESS (.USET OR DDT REF).
|
||
NNL1: MOVEM D,LLOC ;CLOBBER RING BUFFER TOP SO WON'T PUSH.
|
||
JRST NNL2
|
||
|
||
; \, $\, $$\
|
||
NBKSL: PUSHJ P,NTAB3 ;DEP. ARG, CALC. ADDR TO OPEN.
|
||
MOVEM D,LLOCO ;OPEN BUT DON'T SET POINT .
|
||
NTAB2A: HRROI C,POPJ1 ;IN $$! MODE, DON'T TYPE VALUE OR SPACES.
|
||
TLNN F,FLST
|
||
MOVE C,SCH ;ELSE TYPE IN CURRENT MODE.
|
||
JRST NTAB2
|
||
|
||
NLBRAK: MOVEI C,FTOC-PIN ;[, $[, $$[ ;NOTE THESE BRKTS MATCH
|
||
NRBRAK: ADDI C,PIN ;], $], $$]
|
||
TLO C,-1 ;INDICATE THIS TYPEOUT MODE IS DDT RTN.
|
||
JRST NLRBK2 ;WILL TYPE OUT IN MODE IN C.
|
||
|
||
A2XCL: TLO F,FLST ;$$!, SUPPRESS TYPEOUT.
|
||
TLZ B,O.2ALT ;(SO NTAB3 WON'T DO EFFEC ADDR CALC.)
|
||
HRROI C,POPJ1 ;"TYPEOUT MODE" WON'T TYPE ANYTHIING.
|
||
JRST NLRBK2
|
||
|
||
NSLASH: TLZ F,FLST ;/, $/, $$/
|
||
MOVE C,SCH ;TYPE OUT IN CURRENT MODE.
|
||
NLRBK2: PUSHJ P,NTAB3 ;CALC ADDR TO OPEN.
|
||
PUSHJ P,PLOC ;SET . .
|
||
;GET, MAYBE PRINT CONTENTS OF LOC. WHOSE ADDR IS IN LLOCO.
|
||
NTAB2: PUSHJ P,LCT
|
||
MOVE A,LLOCO
|
||
TLZ F,FLRO
|
||
PUSHJ P,FETCHF ;FUNNY FETCH SINCE MAY HAVE OPENED USET REF, ETC.
|
||
7NRTYP [ASCIZ/?? /]
|
||
TLO F,FLRO
|
||
JRST NSEM3 ;SET $Q, CALL (C) TO PRINT VALUE.
|
||
|
||
;PUSH CONTENTS OF D ONTO . RING BUFFER.
|
||
PLOC: MOVEM D,LLOCO
|
||
CAMN D,LLOC
|
||
POPJ P,
|
||
AOS A,PLCR ;ADVANCE RING POINTER
|
||
CAIL A,NLEVS
|
||
SETZB A,PLCR
|
||
EXCH D,LLOC
|
||
MOVEM D,LOCBF(A)
|
||
MOVE D,LLOC
|
||
POPJ P,
|
||
|
||
NALTQ: TLNE D,O.IFX ;$Q
|
||
JRST NALTQN ;JUMP IF NUM SUPPLIED
|
||
NALT0Q: MOVEI A,LWT
|
||
NALTQ1: MOVE C,(A)
|
||
TLNE D,O.2ALT
|
||
MOVSS C ;$$Q - SWAP THE VALUE.
|
||
MOVE D,1(A)
|
||
JRST EFLDNO
|
||
|
||
NALTQN: JUMPE C,NALT0Q
|
||
JUMPL C,NXERR
|
||
CAILE C,10
|
||
JRST NXERR
|
||
MOVE A,LWTP
|
||
NALTQ2: SUBI A,2
|
||
CAIGE A,LWTTAB
|
||
MOVEI A,LWTTAB+2*LWTLNG-2
|
||
SOJG C,NALTQ2
|
||
JRST NALTQ1
|
||
|
||
;$. - JOB'S PC. EXECUTED DURING EVFLD.
|
||
NALT.: PUSHJ P,QJERR
|
||
MOVE C,PPC(U)
|
||
SKIPE UINTWD(U) ;AN INFERIOR THAT'S STOPPED? IF SO, DDT HAS THE PC.
|
||
SKIPG INTBIT(U)
|
||
SKIPGE INTBIT(U) ;ON PDP6, DON'T TRY TO DO THE .USETS.
|
||
JRST EFOCTJ
|
||
MOVE A,[-2,,NALT.B]
|
||
.USET USRI,A ;ASSUME RUNNING.
|
||
TLNN C,10000 ;RUNNING IN EXEC MODE?
|
||
SOS C,B
|
||
EFOCTJ: MOVSI D,SYLOCT
|
||
JRST EFLDNO ;GO PUSH VALUE ON STACK.
|
||
|
||
NALT.B: .RUPC,,C
|
||
.RUUOH,,B
|
||
|
||
ALTGRT: MOVE A,LWT ;$> - SET UP $Q AS THE "OLD" VALUE IN THE
|
||
MOVEM A,VALUEQ ;CURRENT EVALUATION. THE "OLD" VALUE IS USED TO
|
||
JRST ATSIG1 ;DEFAULT ANY UNSPECIFIED FIELDS OF THE WORD.
|
||
|
||
NSIGN1: TDCA A,C ;#
|
||
NSTAR: IMUL A,C ;*
|
||
NMODE: CAME B,D ;COMPUTE DOMINANT MODE.
|
||
JRST APAT5 ;MODES DIFFER, DEFAULT TO INSN.
|
||
POPJ P,
|
||
|
||
NAMAN1: AND A,C ;&
|
||
JRST NMODE
|
||
|
||
NPLUS: ADD A,C ;+
|
||
JRST NMODE
|
||
|
||
NMINUS: SUB A,C ;-
|
||
JRST NMODE
|
||
|
||
n.or: ior a,c ;^_
|
||
popj p,
|
||
|
||
NEXCLM: PUSH P,B ;!
|
||
IDIV A,C
|
||
POP P,B
|
||
JRST NMODE
|
||
|
||
FPLUS: FADR A,C ;$+
|
||
JRST FMODE
|
||
|
||
FMINUS: FSBR A,C ;$-
|
||
JRST FMODE
|
||
|
||
FEXCLM: FDVR A,C ;$!
|
||
JRST FMODE
|
||
|
||
NSHIFT: LSH A,(C) ;$_
|
||
JRST NMODE
|
||
|
||
FSTAR: FMPR A,C ;$*
|
||
JRST FMODE
|
||
|
||
NFSC: FSC A,(C) ;$$_
|
||
JRST FMODE
|
||
|
||
ALTPCN: ADDI C,TPERCE-TAMPER ;$%
|
||
ALTMPN: ADDI C,TAMPER-TDOLLA ;$&
|
||
ALTDLN: ADDI C,TDOLLA-TPRIME ;$$ (ALT-DOLLAR)
|
||
ALTPMN: ADDI C,TPRIME-TDQUOT ;$'
|
||
ALTDQN: ADDI C,TDQUOT-TNMSGN ;$"
|
||
ALTNMN: ADDI C,TNMSGN ;$#
|
||
HRLI C,-2 ;USE MODE WHICH WILL INDIRECT THRU THAT USER VAR.
|
||
CAIA
|
||
NSETX: HRROI C,(W3) ;W3 HAS ADDR OF TYPEOUT RTN IN DDT.
|
||
NSET0: MOVEI A,0
|
||
NSET: MOVEM C,SCH(A)
|
||
MOVEM C,SCHMM(A)
|
||
MOVE D,SCH
|
||
MOVEM D,SCHMM ;IF I DO $O OR $A IN $S MODE, THE ; MODE SHOULD BE SET TO $S.
|
||
MOVE D,AR
|
||
CAILE A,1 ;SAME FOR $O IN $A MODE.
|
||
MOVEM D,ARMM
|
||
TLNN B,O.2ALT ;SKIP IF $$ - SET PERMANENT MODE TOO.
|
||
JRST GSNLRT
|
||
MOVEM C,SCHM(A)
|
||
JRST LCTGNR
|
||
|
||
NALTD: ADDI C,2 ;$D, $$D
|
||
NALTO: ADDI C,8 ;$O, $$O
|
||
MOVEI A,2
|
||
JRST NSET
|
||
|
||
NALTR: TLNE B,O.IFX
|
||
JRST NALTR2
|
||
TRC C,PADR#TOC ;$R, $$R
|
||
NALTA: TRC C,TOC ;$A, $$A
|
||
SETZM BITF
|
||
SETZM BITFMM ;TURN OFF BIT MODE.
|
||
TLNE B,O.2ALT
|
||
SETZM BITFM
|
||
MOVEI A,1
|
||
JRST NSET
|
||
|
||
NALTT: TLNN B,O.IFX ;$T, $$T
|
||
JRST NALTT2 ;JUMP IF NO NUM SUPPLIED
|
||
JUMPL A,NALTT1 ;INFIX ARG NEGATIVE => IT IS MASK.
|
||
CAILE A,36.
|
||
JRST NAERR ;ELSE SHOULD BE BYTE SIZE.
|
||
JUMPE A,ERR
|
||
CAIN A,35. ;THE CODE BELOW FAILS IN THIS CASE.
|
||
JRST [HRROI A,-2 ? JRST NALTT1]
|
||
MOVNS A ;NEGATE, WILL SHIFT RIGHT.
|
||
NALTT0: TLC C,4^5 ;CHANGE HIGH BIT,
|
||
ASHC C,(A) ;GENERATE 1 BYTE OF THAT BIT,
|
||
TLZ D,4^5 ;ASHC SET D'S SIGN.
|
||
JUMPE D,NALTT0 ;KEEP GOING TILL HAVE DONE >36. BITS,
|
||
JUMPGE C,NALTT0 ;AND HIGH BIT IS 1.
|
||
LSH D,1
|
||
LSHC C,1 ;GET ALL 36. BITS IN C.
|
||
MOVE A,C
|
||
NALTT1: MOVEM A,SATPC
|
||
NALTT2: HRROI C,SATP
|
||
JRST NSET0
|
||
|
||
NALTR2: SOJLE A,NAERR ;$NR, $$NR
|
||
AOS C,A
|
||
MOVEI A,2
|
||
JRST NSET
|
||
|
||
;HANDLE $? AND $$? - SET BIT TYPEOUT MODE.
|
||
NAQMK: SETOM BITF
|
||
TLNE B,O.IFX
|
||
JUMPE A,NAQMK0
|
||
NAQMK3: JUMPE D,NAQMK1 ;FOLLOWING NOTHING - NO ARG.
|
||
JUMPL D,NAQMK4 ;FOLLOWING AN OPERATOR - REPUSH THAT OPERATOR, AND NO ARG.
|
||
LDB W1,[400300,,D] ;WE ARE SPECIFYING A WHOLE NEW BIT MODE
|
||
CAIN W1,SYLSYM_-14. ;(IE, A NEW SYMBOL PREFIX)
|
||
TLNN D,37777 ;SO FIND THE SQUOZE - IT IS IN DIFFERENT PLACES
|
||
JRST NAQMK2 ;IN EVALUATED AND UNEVALUATED SYMS
|
||
LDB C,[4000,,D]
|
||
NAQMK2: MOVE D,BITSYM ;WHEN A NEW PREFIX IS SPEC'D,
|
||
MOVEM D,BITSY1 ;THE OLD ONE BECOMES ALTERNATE, AND NEW ON IS MAIN.
|
||
MOVE D,BITPAT
|
||
MOVEM D,BITPA1
|
||
MOVEM C,BITSYM
|
||
TLNE B,O.IFX ;WHAT BIT MASK TO USE? MAYBE IT IS SPEC'D WITH
|
||
JUMPN A,NAQMK5 ;A NONZERO INFIX ARGUMENT
|
||
MOVE D,BITSYM
|
||
SAVE B ;OTHERWISE IT MAY BE THE VALUE OF THE PREFIX SYMBOL,
|
||
CALL SEVLD
|
||
SKIPA D,BITSYM ;OR THE VALUE OF THE SYMBOL WHOSE NAME IS "..B"
|
||
JRST NAQMK7
|
||
IDIVI D,50*50*50 ;FOLLOWED BY THE PREFIX SYMBOL,
|
||
ADD D,[SQUOZE 0,..B]
|
||
CALL SEVLD
|
||
MOVE D,[525252,,525252] ;OR THE DEFAULT.
|
||
NAQMK7: MOVEM D,BITPAT
|
||
REST B
|
||
JRST NAQMK6
|
||
|
||
NAQMK4: EXCH C,-1(W4)
|
||
EXCH D,(W4)
|
||
PUSH W4,C
|
||
PUSH W4,D
|
||
NAQMK1: TLNE B,O.IFX ;WE HAD NO PREFIX ARG, BUT MAYBE HAVE INFIX ARG TO SET BITPAT.
|
||
JUMPN A,NAQMK5
|
||
|
||
;TEMPORARY MODE IS NOW JUST RIGHT; SET THE ";" MODE, AND MAYBE THE PERMANENT MODE.
|
||
NAQMK6: SETOM BITFMM
|
||
TLNN B,O.2ALT
|
||
JRST GSNLRT
|
||
SETOM BITFM
|
||
JRST LCTGNR
|
||
|
||
NAQMK5: MOVEM A,BITPAT
|
||
JRST NAQMK6
|
||
|
||
NAQMK0: MOVE W1,BITPAT
|
||
EXCH W1,BITPA1
|
||
MOVEM W1,BITPAT
|
||
MOVE W1,BITSYM
|
||
EXCH W1,BITSY1
|
||
MOVEM W1,BITSYM
|
||
JRST NAQMK3
|
||
|
||
ALTDQ: TLNN B,O.IFX ;$", $N", $$", $$N"
|
||
JRST ALTDQN ;NO NUM
|
||
PUSHJ P,GSOA ;INIT RUBOUT PROC. OF ASCII CHARS.
|
||
JRST ALTDQX ;IF RUB OUT ALL, RETYPE THE OP.
|
||
MOVE C,-1(W4) ;START THE VALUE OUT WITH LOW BIT TAKEN
|
||
ANDI C,1 ;FROM THE INFIX ARG'S VALUE.
|
||
MOVEM C,GSSSYM
|
||
MOVE C,[440700,,GSSSYM]
|
||
ALTDQ2: JSP W2,RCH ;GET NEXT CHAR (BUT MIGHT BE ^ OR ^Q)
|
||
CAIN D,33
|
||
JRST ALTDQR ;ALTMODE ENDS THE ARG.
|
||
TLNN C,760000
|
||
JRST ALTDQ4 ;NO ROOM IN WD, IGNORE CHAR OR DO LINEFEED.
|
||
CALL ALTDQ5 ;HAVE ROOM; LET ^ AND ^Q QUOTE NEXT CHAR.
|
||
IDPB D,C
|
||
JRST ALTDQ2
|
||
|
||
ALTDQI: JSP W2,RCH
|
||
ALTDQ5: CAIN D,^Q ;^Q => READ ANOTHER CHAR, DON'T ALTER.
|
||
JRST [TLNE F,FLRUB ;ALLOW RUBOUT OF ^Q
|
||
TLNE F,FLCTLL ;PROVIDED ANOTHER CHAR WAS TYPED & RUBBED.
|
||
JRST SLRPIN
|
||
RET]
|
||
CAIE D,"^ ;^ => MAKE A CTRL CHAR.
|
||
RET ;ELSE NOT QUOTED.
|
||
JSP W2,RCH
|
||
CAIL D,140 ;CONVERT FIRST TO UPPERCASE
|
||
SUBI D,40
|
||
XORI D,100 ;THEN TO CTL CHAR, S.T. ^? BECOMES RUBOUT.
|
||
POPJ P,
|
||
|
||
ALTPRR: SKIPA B,[D6PNT]
|
||
ALTDQR: MOVEI B,D7PNT
|
||
MOVE A,GSSSYM
|
||
POPJ P,
|
||
|
||
ALTDQ4: MOVE B,(W4)
|
||
TLNE B,O.2ALT
|
||
JRST ALTDQP ;$$1", DO LINEFEED.
|
||
CALL ALTDQ5 ;IGNORE CHAR AND ANY CHAR IT QUOTES.
|
||
JRST ALTDQ2
|
||
|
||
ALTDQP: CTYPE 33
|
||
PUSH P,B
|
||
MOVE A,GSSSYM
|
||
MOVSI B,SYLOCT
|
||
SETOM UNRCHF
|
||
SETOM UNECHF
|
||
MOVEM A,ARG1
|
||
MOVEM B,ARG1+1
|
||
PUSHJ P,PLUNK1
|
||
PUSHJ P,NNL
|
||
PUSHJ P,ALTDQX ;RETYPE $$1" OR $$1' .
|
||
CALL EVARGF ;FLUSH THE ARG (THE WORD ALREADY STORED) SO ^L DISPLAYS OK.
|
||
POP P,B
|
||
MOVE A,GSORET ;RETURN TO CALL TO GSOA.
|
||
JRST -2(A)
|
||
|
||
;COME HERE FROM AN OPERATOR THAT READS STUFF, WHEN GSOA DOESN'T SKIP.
|
||
ALTDQX: MOVE A,-1(W4) ;OP. BEING EXECUTED IS ON TOP OF FROB STACK.
|
||
MOVE C,(W4)
|
||
PUSHJ P,GFROBP
|
||
JRST GSNLRT
|
||
|
||
ALTPRM: TLNN B,O.IFX ;$', $N', $$', $$N'
|
||
JRST ALTPMN ;NO NUM
|
||
PUSHJ P,GSOA ;INIT. RUBOUT PROC. OF 6BIT CHARS.
|
||
JRST ALTDQX
|
||
SETZM GSSSYM
|
||
MOVE C,[440600,,GSSSYM]
|
||
ALTPR2: JSP W2,RCH
|
||
CAIL D,140 ;LOWER CASE TO UPPER.
|
||
SUBI D,40
|
||
SUBI D,40 ;STOP ON NON-6BIT CHAR, DON'T REREAD IT.
|
||
JUMPL D,ALTPRR
|
||
TLNN C,770000
|
||
JRST ALTPR4
|
||
IDPB D,C
|
||
JRST ALTPR2
|
||
|
||
ALTPR4: TLNN B,O.2ALT
|
||
JRST ALTPR2 ;ONLY ONE ALT
|
||
JRST ALTDQP ;TWO, STORE THIS WD, RETURN TO ALTPR1.
|
||
|
||
ALTNM: TLNN B,O.IFX ;$#, $N#, $$#, $$N#.
|
||
JRST ALTNMN ;NO NUMBER => SET TYPE OUT MODE.
|
||
PUSHJ P,GSOA ;INIT RUBOUT PROC
|
||
JRST ALTDQX ;RETYPE "$1#" IF READ RUBOUT.
|
||
PUSHJ P,ALTDQI ;READ CHAR, LET ^ AND ^Q QUOTE.
|
||
MOVEI A,(D)
|
||
JSP B,GSEVLJ ;WILL CALL AT .+1 TO RETYPE IF RUBBED.
|
||
|
||
;$# TYPEOUT ROUTINE. VALUE OF SYLL IN D.
|
||
TMCH: SAVE D
|
||
TRZ D,177 ;PRINT OUT ALL BUT LOW 7 BITS SYMBOLICALLY,
|
||
JUMPE D,TMCH0
|
||
CALL PIN
|
||
CALL TSPC
|
||
TMCH0: REST D ;THEN LOW 7 BITS AS CHARACTER.
|
||
7TYPE [ASCIZ/1#/]
|
||
ANDI D,177
|
||
CAIE D,^Q
|
||
CAIN D,"^ ;^Q AND UPARROW MUST BE QUOTED.
|
||
JRST [CTYPE ^Q ? JRST TOUT]
|
||
CAIN D,177
|
||
JRST TMCH1 ;PRINT RUBOUT AS ^?
|
||
CAIL D,"
|
||
JRST TOUT ;NOT CTL CHAR, JUST TYPE.
|
||
TMCH1: CTYPE "^ ;ELSE QUOTE WITH ^.
|
||
XORI D,100
|
||
JRST TOUT
|
||
|
||
ALTAMP: TLNN B,O.IFX ;$&, $N&, $$&
|
||
JRST ALTMPN ;NO NUM
|
||
PUSHJ P,GSOA ;INIT. RUBOUT PROC.
|
||
JRST ALTDQX
|
||
ALTAM1: TLO F,FLLET+FLNNUL ;MAKE SURE READ AS SYMBOL,
|
||
TLZ F,FLPNT+FLNEGE
|
||
JSP W2,RCH ;SLRPND EXPECTS 1ST CHAR IN D.
|
||
CALL SLRPND ;READ THE NAME (AS SQUOZE, IN A)
|
||
MOVEI B,D5PNT
|
||
MOVE C,-1(W4) ;GET BACK THE INFIX ARG FOR SQUOZE FLAGS.
|
||
LSH C,-2
|
||
LSH C,32.
|
||
IOR A,C
|
||
POPJ P,
|
||
|
||
;:TAG <TAG> IS A NO-OP WHEN EXECUTED.
|
||
KTAG: CALL RTOKEN ;SKIP THE TAG
|
||
JRST GSNLRT
|
||
|
||
;:JUMP <TAG> IN A VALRET OR EXECUTE FILE SETS THE READ POINTER TO AFTER
|
||
;THE MATCHING :TAG <TAG>.
|
||
KJUMP: CALL RTOKEN ;READ THE TAG.
|
||
JUMPE B,KJUMP ;SKIP OVER ANY SPACES BEFORE THE TAG.
|
||
SKIPN INPTR
|
||
CALL INPOP ;IF :JUMP TYPED ON TTY, TRY POPPNG OUT TO VALRET OR FILE
|
||
SKIPN INPTR ;IF WE CAN'T FIND ONE, THE :JUMP IS RIDICULOUS.
|
||
ERSTRT [SIXBIT /CAN'T :JUMP ON THE TTY?/]
|
||
SKIPG INPTR ;NOW GO TO BEGINNING OF FILE IF IT'S THAT
|
||
.ACCESS COMC,[0]
|
||
HRRZ A,INVAOB
|
||
ADD A,[<010700,,>-1]
|
||
SKIPL INPTR ;OR TO BEGINNING OF VALRET IF IT'S THAT.
|
||
MOVEM A,INPTR
|
||
SETOM INNCTL ;NOW SEARCH FOR THE :TAG. IGNORE ^V, ^W, ETC NOW.
|
||
KJUMP1: CALL KGOIN ;READ THE NEXT CHARACTER.
|
||
KJUMP2: CAIE D,":
|
||
JRST KJUMP1 ;SEARCH FOR COLON FOLLOWED BY T, A, G AND SPACE.
|
||
IRPC X,,[TAG ]
|
||
CALL KGOIN
|
||
CAIE D,"X
|
||
JRST KJUMP2
|
||
TERMIN
|
||
MOVE A,[440600,,B] ;NOW COMPARE THIS :TAG'S TAG WITH THE :JUMP'S TAG.
|
||
KJUMP3: CALL KGOIN ;READ NEXT CHAR FROM EACH OF THEM.
|
||
ILDB C,A
|
||
CAIG D,40 ;REACHED END OF :JUMP ARG => WE EITHER WIN OR LOSE RIGHT AWAY.
|
||
JRST KJUMP4
|
||
ADDI C,40
|
||
CAME D,C
|
||
JRST KJUMP2 ;CHARS DON'T MATCH => FIND THE NEXT :TAG.
|
||
JRST KJUMP3 ;THEY DO MATCH => KEEP ON COMPARING.
|
||
|
||
KJUMP4: JUMPN C,KJUMP1 ;END OF :TAG ARG AND NOT END OF :JUMP ARG => MISMATCH.
|
||
SETZM INNCTL ;END OF BOTH => THEY MATCH. RESUME EXECUTION
|
||
JRST GSNLRT ;AFTER THE :TAG ARG.
|
||
|
||
;READ CHAR FROM CURRENT VALRET OR FILE, AND ERR AT END OF IT.
|
||
KGOIN: CALL IN2B
|
||
SKIPG INPTR
|
||
CAIE D,^C
|
||
SKIPN D
|
||
ERSTRT [SIXBIT /UNDEFINED :JUMP TAG?/]
|
||
CAIL D,140
|
||
SUBI D,40
|
||
RET
|
||
|
||
;:IF <COND-NAME> <ARG>
|
||
;$( ..... $)
|
||
KIF: CALL RTOKEN ;READ CONDITION NAME.
|
||
JUMPE B,KIF
|
||
MOVSI A,-KIFTBL ;SEARCH TABLE FOR IT.
|
||
KIF1: CAMN B,KIFTB1(A)
|
||
JRST KIF2 ;FOUND.
|
||
AOBJN A,KIF1
|
||
ERSTRT [SIXBIT/CONDITION?/]
|
||
|
||
KIF2: MOVEM A,-1(W4) ;ARRANGE TO RETYPE :IF AND CONDITION
|
||
MOVEI A,KIFRB ;ON RUBOUT OR ^L.
|
||
MOVEM A,(W4) ;(CAN ALSO RETRIEVE KIFTB1 IDX FROM -1(W4))
|
||
SETZM NCOMNM ;DON'T LET GSOA CLOBBER WHAT WE JUST DID.
|
||
KIF4: CALL RONUM ;READ ARG.
|
||
JRST ALTDQX ;RUBBED BACK OUT OF ARG.
|
||
JUMPE B,KIF4 ;READ NOTHING => TRY AGAIN.
|
||
MOVE C,-1(W4) ;GET KIFTB1 IDX OF CONDITION.
|
||
SETOM SUCCES
|
||
XCT KIFTB2(C) ;TEST CONDITION, ARG IN A.
|
||
JRST GSNLRT ;CONDITION TRUE.
|
||
KIFLOS: SETZB A,SUCCES ;A USED AS PAREN COUNTER (CONDITION FALSE)
|
||
SETOM INNCTL ;IGNORE ^V, ETC. IN FALSE CONDIT.
|
||
KIF3: CALL RIN
|
||
JRST KIF3 ;IGNORE RUBOUT.
|
||
CAIN D,"(
|
||
AOJA A,KIF3 ;( => INCREM. COUNT.
|
||
CAIE D,")
|
||
JRST KIF3
|
||
SOJG A,KIF3 ;) => DECREM.
|
||
SETZM INNCTL
|
||
JRST GSNLRT ;THE ) THAT MATCHES THE 1ST (, DONE.
|
||
|
||
KIFRB: 7TYPE [ASCIZ/:IF /] ;GFROBP CALLS HERE, FROM ALTDQX.
|
||
MOVE D,KIFTB1(D) ;D HAS 1ST WD OF SYL.
|
||
CALL SIXTYP
|
||
JRST TSPC
|
||
|
||
KIFMOR: CALL MORFL1 ;DO A **MORE** AND GET RESPONSE.
|
||
AOS (P) ;USER FLUSHED, MAKE COND. FAIL.
|
||
RET
|
||
|
||
KIFTB1:
|
||
IRPS X,,E N L G LE GE MORE
|
||
SIXBIT/X/
|
||
TERMIN
|
||
KIFTBL==.-KIFTB1
|
||
|
||
KIFTB2:
|
||
IRPS X,,N E GE LE G L
|
||
SKIP!X A
|
||
TERMIN
|
||
CALL KIFMOR
|
||
IFN .-KIFTB2-KIFTBL,.ERR
|
||
|
||
;:ELSE SUCCEEDS IF PREV. CONDITIONAL FAILED. :ALSO SUCCEEDS IF IT SUCCEEDED.
|
||
KALSO: SKIPA B,SUCCES
|
||
KELSE: SETCM B,SUCCES
|
||
SETOM SUCCES ;:ELSE AFTER A :ELSE SUCCEEDS IF THE PREV. :ELSE FAILED.
|
||
JUMPL B,GSNLRT
|
||
JRST KIFLOS
|
||
|
||
;$) EXECUTED IMPLIES IT IS THE END OF A SUCCESSFUL CONDITIONAL, SO MAKE SURE FOLLOWING
|
||
;CONDITIONAL KNOWS THAT (REGARDLESS OF WHAT CONDITIONALS INSIDE THE $( - $) DID).
|
||
NARPRN: SETOM SUCCES
|
||
JRST GSNLRT
|
||
|
||
;:DDTSYM FOO EVALUATES FOO IN DDT SYM TAB.
|
||
KDDTSY: CALL GTFROB ;READ SYMBOL (AS FROB, UNEVALUATED SYMBOL)
|
||
JUMPE B,ALTDQX ;PASS SPACES.
|
||
CAME B,[SYLSYM,,] ;NOT SYMBOL, DON'T EVAL.
|
||
JRST GSDDTJ
|
||
MOVEM A,SYM
|
||
MOVE A,STBDDT
|
||
CALL SLUP
|
||
2,,SEVLB1 ;DDT SYM TAB HAS BLOCK STR.
|
||
7TYPE [ASCIZ/?U/]
|
||
MOVE A,1(A) ;FOUND, RETURN THE VALUE.
|
||
GSDDTJ: MOVE B,[SYLSYM,,4^5] ;RETURN DDT REF.
|
||
RET
|
||
|
||
;:SYMTYP <SYMBOL>
|
||
;VALUE IS 0 IF SYMBOL UNDEFINED, ELSE
|
||
;BIT 4.9 => HALF KILLED, BIT 4.8 => INITIAL SYM,
|
||
;BIT 4.7 => DEFINED BUT NOT IN CURRENT BLOCK OR CONTAINING BLOCK,
|
||
;BIT 4.6 => DDT-REFERENCE, BIT 4.5 => .USET VARIABLE.
|
||
;RH HAS ADDR OF STE IN DDT (WON'T BE VALID IF MOVE SYM TAB)
|
||
;RH WILL BE 0 FOR AN INSTRUCTION NAME. (4.8 WILL BE ON)
|
||
KSYMTY: CALL GTFROB ;READ SYMBOL NAME.
|
||
JUMPE B,ALTDQX
|
||
CAME B,[SYLSYM,,]
|
||
RET ;NOT SYMBOL, RETURN.
|
||
MOVEM A,SYM
|
||
CALL SEVL ;TRY TO EVAL.
|
||
JRST KSYMT3
|
||
ANDI A,-1
|
||
MOVEI B,2 ;ASSUME INITIAL, SET WHAT WILL BE BIT 4.8.
|
||
CAIGE A,DDTEND
|
||
CAIGE A,STBSPG*2000
|
||
TRZ B,2 ;NOT INITIAL.
|
||
IOR B,FNYLOC ;FUNNYNESS WILL GO IN BITS 4.5,4.6.
|
||
ROT B,-3
|
||
KSYMT4: MOVE D,(A) ;SEE IF HALF-KILLED.
|
||
TLNE D,%SYHKL
|
||
TLO B,4^5 ;SIGN SET IF YES.
|
||
HLL A,B ;ALSO HAVE ADDR OF STE IN RH.
|
||
JRST GSOCTJ
|
||
|
||
KSYMT3: CALL OPLK2 ;NOT FOUND IN CURRENT BLOCK, TRY OP CODES AND OTHER BLOCKS.
|
||
JRST [SETZ A, ? JRST GSOCTJ] ;NOT DEFINED.
|
||
JRST [MOVSI B,1^5 ? JRST KSYMT4] ;FOUND IN OTHER BLOCK.
|
||
MOVSI A,2^5 ;OP CODE, SAY IS INITIAL.
|
||
JRST GSOCTJ
|
||
|
||
NALTM: SKIPN ARG1+1
|
||
JRST NALTM2
|
||
MOVE D,ARG1
|
||
MOVEM D,MSK(A)
|
||
JRST LCTGNR
|
||
|
||
NALTM2: ADDI A,MSK ;NO ARG - RETURN THE FUNNY LOCATION OF THE MASK (IN DDT)
|
||
JRST GSDDTJ ;RETURN EVALUATED FUNNY SYMBOL.
|
||
|
||
NALTEW: MOVEI A,-1
|
||
NALTW: SKIPA D,[JUMPN I1,]
|
||
NALTN: MOVSI D,(JUMPE I1,)
|
||
TDNN A,[-10] ;INFIX ARG > 7 => IT IS IMMEDIATE MASK;
|
||
MOVE A,MSK(A) ;ELSE IT IS INDEX INTO TABLE OF MASKS.
|
||
MOVEM A,MSKUSE' ;SAVE VALUE OF MASK TO USE FOR THIS SEARCH.
|
||
HLLM D,NLTNWX
|
||
PUSHJ P,NAENW ;GET "ARGS"
|
||
SETCAM A,WRD'
|
||
NALTN2: PUSHJ P,GCBLKP ;GET BLOCK TO READ
|
||
JRST KLSTUX ;LIKE NLTL2 BUT FLUSHES THE MORINI! THIS IS ESENTIAL!
|
||
NALTN4: MOVE I1,(A)
|
||
EQV I1,WRD
|
||
AND I1,MSKUSE
|
||
XCT NLTNWX ;SKIP UNLESS SATISFIES CONDITION.
|
||
PUSHJ P,ENWPNT ;PRINT VALUE, SET $Q, TEST FOR END OF SCREEN.
|
||
NALTN5: AOBJN A,NALTN4
|
||
PUSHJ P,OUTTST ;SKIP IF OUTPUT IS GOING ANYWHERE.
|
||
JRST KLSTUX ;IT ISN'T, QUIT SEARCHING.
|
||
JRST NALTN2
|
||
|
||
NALTE: HRROI C,PES ;NO ARG => SET E&S TYPEOUT MODE.
|
||
SKIPN ARG1+1
|
||
JRST NSET0
|
||
SKIPN SYSSW
|
||
SKIPE DDTSW
|
||
JRST NALTEW
|
||
PUSHJ P,NAENW
|
||
HRRZM A,WRD
|
||
PUSHJ P,EASETU
|
||
NALTE2: PUSHJ P,GCBLKP
|
||
JRST KLSTUX
|
||
SAVE D
|
||
NALTE4: MOVE D,(A) ;GET NEXT WORD AND DO ADDRESS CALCULATION.
|
||
PUSHJ P,NEFECC
|
||
CAMN I1,WRD
|
||
PUSHJ P,ENWPNT ;IF ADDRESS MATCHES ARG, PRINT THIS LOCATION.
|
||
NALTE5: TLNE A,177
|
||
JRST NALTE6
|
||
CALL OUTTST ;EVERY 128 WORDS, CHECK FOR ^W OR ^E.
|
||
JRST [ REST D ;AND STOP IF OUTPUT BEING DISCARDED.
|
||
JRST KLSTUX]
|
||
NALTE6: AOBJN A,NALTE4 ;SEARCH THROUGH THIS BLOCK OF MEMORY
|
||
REST D
|
||
JRST NALTE2 ;THEN MAP IN THE NEXT ONE.
|
||
|
||
GCBLKP: PUSHJ P,GCBLKR
|
||
POPJ P,
|
||
SUB B,A
|
||
SETCA B, ;NEGATE AND SUBTRACT ONE
|
||
HRL A,B
|
||
JRST CPOPJ1
|
||
|
||
;CALL ENWPNT TO PRINT OUT A LOCATION IN A SEARCH. CAN POP1J IF OUTPUT FLUSHED.
|
||
;ASSUMES A HAS AOBJN POINTER IN DDT ADDRESS SPACE AND C HAS ADDR OF START OF THIS BLOCK
|
||
;IN THE SUBJOB'S ADDRESS SPACE.
|
||
ENWPNT: PUSH P,D
|
||
MOVE D,C
|
||
SOS D
|
||
PUSH P,C
|
||
HRRZ C,A
|
||
CAIL C,AC0
|
||
CAILE C,AC0+17
|
||
SKIPA
|
||
SUBI C,AC0 ;WIN FOR ACS
|
||
DPB C,[1200,,D] ;GET REAL ADR IN D
|
||
MOVE C,(A) ;GET CONTENTS
|
||
PUSH P,A ;SAVE AOBJN POINTER
|
||
ANDI D,-1
|
||
SAVE D ;SAVE ADDRESS OF LOCATION.
|
||
SAVE C
|
||
PUSHJ P,PAD
|
||
7TYPE [ASCIZ \/ \]
|
||
POP P,D
|
||
PUSHJ P,ENWPAT
|
||
CALL CRF
|
||
SKIPN TTYFLG
|
||
CALL TYOFRC ;FORCE OUT TYO.
|
||
SKIPN TTYFLG
|
||
.LISTEN D, ;WAIT FOR TYPEOUT TO FINISH.
|
||
REST D ;NOW THAT WE'VE TYPED OUT, ANY **MORE** HAS ALREADY HAPPENED.
|
||
CALL PLOC ;TYPEOUT OF THIS LOCATION WASN'T FLUSHED, SO OK TO SET POINT.
|
||
AOSN CTLDFL ;^D HAS INTERRUPTED => STOP.
|
||
JRST POP4N4
|
||
POP P,A
|
||
POPCDJ: POP P,C
|
||
POP P,D
|
||
POPJ P,
|
||
|
||
POPAN2: POP P,A
|
||
JRST NLTL2
|
||
|
||
POP4N4: SUB P,[4,,4]
|
||
CALL MORFL2
|
||
JRST NLTL4
|
||
|
||
ENWPAT: PUSHJ P,LWTPUT
|
||
JRST PVAL
|
||
|
||
;COMPUTE EFFECTIVE ADDRESS FROM ARG IN D.
|
||
;RESULT GOES IN I1. CONTENTS OF ACS ARE TAKEN FROM AC0, ETC.,
|
||
;USE EASETU TO SET THEM UP FOR CURRENTLY SELECTED JOB.
|
||
NEFECC: SAVE D
|
||
SAVE A
|
||
SAVE B
|
||
MOVEI I1,14
|
||
MOVEM I1,TEM
|
||
NEFEC2: LDB B,[220400,,D]
|
||
JUMPE B,NEFEC3
|
||
MOVE B,AC0(B)
|
||
ADD B,D
|
||
HRR D,B
|
||
NEFEC3: HRRM D,TEM2
|
||
TLNN D,20
|
||
JRST NEFEC6
|
||
HRR A,D
|
||
SOSE TEM
|
||
PUSHJ P,RFETCH
|
||
JRST NEFEC6
|
||
JRST NEFEC2
|
||
|
||
NEFEC6: HRRZ I1,TEM2
|
||
REST B
|
||
JRST POPADJ
|
||
|
||
EASETU: CALL QJERR
|
||
.ACCESS USRI,[0] ;READ JOB'S ACS SO WE CAN DO EFFECTIVE ADDRESS CALC.
|
||
MOVE A,[-20,,AC0]
|
||
.IOT USRI,A
|
||
POPJ P,
|
||
|
||
;GOBBLE ARGS TO $E, $N OR $W.
|
||
;COMPUTE BOUNDS OF SEARCH AND WHAT TO SEARCH FOR.
|
||
;RETURNS LOW LIM. IN C, HIGH LIM. IN D, OBJECT OF SEARCH IN A.
|
||
NAENW: JUMPL U,QJERR
|
||
HLRZ C,LIMIT(U)
|
||
SKIPE ARG1+3
|
||
HRRZ C,ARG1 ;GET 1ST ARG IF 2ND EXISTS, ELSE DEFAULT LOW LIM.
|
||
HRRZ D,LIMIT(U)
|
||
HLRZ A,ARG1
|
||
SKIPE A
|
||
SKIPN ARG1+3 ;GET LH OF 1ST ARG, IF NONZERO AND THERE'S A 2ND ARG;
|
||
CAIA ;ELSE BE CONTENT WITH THE DEFAULT (..LIMIT)
|
||
MOVE D,A
|
||
SKIPE ARG1+5
|
||
HRRZ D,ARG1+2 ;GET 2ND ARG IF 3RD EXISTS, ELSE LH(1ST) OR ..LIMIT
|
||
CAMLE C,D
|
||
JRST NAERR ;LOW LIM > HIGH LIM?
|
||
SKIPE SYSSW
|
||
JRST NAENW1
|
||
.USET USRI,[.RMEMT,,A]
|
||
CAIGE A,20 ;SEARCH THROUGH AC'S EVEN IF THERE'S NO CORE.
|
||
MOVEI A,20
|
||
CAIG A,(D) ;DON'T LOOK BEYOND MEM TOP (SAVES WORK)
|
||
SOS D,A
|
||
NAENW1: SAVE D
|
||
CALL MORINI
|
||
JRST POP2N4
|
||
REST D
|
||
MOVE A,LWT ;GET $Q OR LAST ARG IN A
|
||
SKIPE ARG1+1
|
||
MOVE A,ARG1
|
||
SKIPE ARG1+3
|
||
MOVE A,ARG1+2
|
||
SKIPE ARG1+5
|
||
MOVE A,ARG1+4
|
||
JRST CRF
|
||
|
||
POP2N4: SUB P,[2,,2]
|
||
JRST NLTL4
|
||
|
||
GCBLKR: TDZA B,B ;GET BLOCK
|
||
GCBLKW: MOVSI B,400
|
||
GCBLK0: CAMLE C,D
|
||
JRST VPAGR1 ;NO MORE WDS TO DO, DONE.
|
||
SKIPGE FNYLOC
|
||
JRST GCBLK1
|
||
SKIPE SYSSW
|
||
JRST GCBLKS
|
||
CAIG C,17
|
||
JRST GCBLKA ;ACS
|
||
GCBLK1: LDB A,[121000,,C]
|
||
SKIPGE FNYLOC
|
||
IORI A,400000+VPAGE_9 ;SEARCHING THROUGH DDT.
|
||
SKIPL FNYLOC
|
||
IOR A,[2000+USRI,,400000+VPAGE_9]
|
||
IOR A,B
|
||
GCBLK3: .CBLK A,
|
||
JRST GCBLK2
|
||
LDB A,[1200,,C]
|
||
TRO A,400000
|
||
TRZ C,1777
|
||
ADDI C,2000
|
||
CAMLE C,D
|
||
JRST GCBLK4
|
||
MOVEI B,401777
|
||
JRST CPOPJ1
|
||
|
||
GCBLKS: JUMPN B,NXERR ;SYS
|
||
CAIG D,20
|
||
JRST NXERR
|
||
CAIGE C,20
|
||
MOVEI C,20
|
||
LDB A,[121100,,C]
|
||
IOR A,[1000,,400000+VPAGE_9]
|
||
JRST GCBLK3
|
||
|
||
GCBLK2: TRZ C,1777
|
||
ADDI C,2000
|
||
JRST GCBLK0
|
||
|
||
GCBLK4: LDB B,[1200,,D]
|
||
TRO B,400000
|
||
JRST CPOPJ1
|
||
|
||
GCBLKA: PUSHJ P,EASETU ;ACS UGH BLETCH
|
||
MOVEI A,AC0
|
||
ADD A,C
|
||
MOVEI C,20
|
||
MOVE B,D
|
||
CAILE D,17
|
||
MOVEI B,17
|
||
ADDI B,AC0
|
||
JRST CPOPJ1
|
||
|
||
;$$Z - FILL ALL OR A SPECIFIED RANGE OF CORE WITH ZERO OR A SPECIFIED CONSANT.
|
||
N2ALTZ: CALL QI6JERR ;JOB MUST BE OUR INFERIOR OR THE PDP6, TO ZERO IT.
|
||
SKIPN SAFE(U)
|
||
JRST N2LTZ1
|
||
7TYPE [ASCIZ /--Zero Protected Job--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
N2LTZ1: CALL N2AZ1 ;GET LOW LIMIT IN C, HIGH LIMIT IN D.
|
||
CAMLE C,D
|
||
JRST NAERR ;LOW > HIGH?
|
||
MOVE I1,ARG1+4 ;GET ZERO OR THIRD ARG IF SUPPLIED
|
||
N2LTZ2: PUSHJ P,GCBLKW
|
||
JRST NLTL2
|
||
MOVEM I1,(A)
|
||
HRLS A
|
||
AOS A
|
||
BLT A,(B)
|
||
CAIE C,20
|
||
JRST N2LTZ2
|
||
.ACCES USRO,[0] ;WIN FOR ACS
|
||
MOVE A,[-20,,AC0]
|
||
.IOT USRO,A
|
||
JRST N2LTZ2
|
||
|
||
N2AZ1: HRRZ C,ARG1 ;GET 0 OR 1ST ARG IF ANY.
|
||
.USET USRI,[.RMEMT,,A]
|
||
SOS D,A ;GET HIGHEST LEGAL LOC.,
|
||
SKIPE ARG1+3
|
||
HRRZ D,ARG1+2 ;OR 2ND ARG IF ANY.
|
||
RET
|
||
|
||
NCOL: MOVEM B,NCOLSB ;SAVE B, C, D FOR DEBUGGING.
|
||
MOVEM C,NCOLSC
|
||
MOVEM D,NCOLSD
|
||
JUMPE D,NCOM ;:, $:, $$:. CHECK FOR COLON-COMMAND.
|
||
CAME D,[SYLSYM,,]
|
||
JRST NCOL2
|
||
TLNE B,O.1ALT+O.2ALT ;CHECK FOR $:, $$:.
|
||
JRST NACOL
|
||
JUMPL U,JERR ;DEFINE SYM, MUST HAVE JOB.
|
||
PUSH P,C
|
||
SUB W4,[2,,2] ;POP THE COLON OFF FROB TABLE.
|
||
MOVEI D,GFLD1 ;ERRORS SHOULDN'T RE-POP IT.
|
||
MOVEM D,ERRSTL
|
||
PUSHJ P,EVARGS
|
||
POP P,SYM
|
||
MOVE D,LLOCO
|
||
SKIPE ARG1+1 ;DON'T ALLOW DEFINING A SYMBOL TO A VALUE
|
||
MOVE D,FNYLOC ;WHICH IS A DDT ADDRESS OR .USET VARIABLE.
|
||
TLNE D,-1
|
||
JRST ERR
|
||
SKIPE ARG1+1
|
||
MOVE D,ARG1
|
||
PUSHJ P,DEFIN
|
||
PUSHJ P,LCT
|
||
JRST ERR6 ;NORMAL RETURN WOULD ASSUME FROB TAB UNCHANGED.
|
||
|
||
NCOL2: EXCH C,-1(W4)
|
||
EXCH D,(W4)
|
||
PUSH W4,C
|
||
PUSH W4,D
|
||
|
||
;HANDLE :-COMMANDS, COME AFTER RFEADING ":".
|
||
;FLC - WAS $: OR $^K, LOAD SYMS.
|
||
;FLLET - DEV OR SNAME SPEC'D - DON'T TRY USUAL DIRS.
|
||
;EITHER ONE -> DON'T USE BUILT-IN COMMANDS EXCEPT ":NEW".
|
||
NCOM: PUSHJ P,GSOA ;COME BACK HERE ON RUBOUT.
|
||
JRST [ SETZM MONMDL ;: RUBBED, LEAVE MONIT MODE FOR A WHILE.
|
||
MOVEI D,":
|
||
CALL RUBCHR ;ERASE CHAR FROM SCREEN (OR ECHO ON PRINTING TTY)
|
||
JRST GSNLRT]
|
||
SETZM XCRFSW ;PREVENT :SENDD <RUB><RUB> ... FROM LEAVING XCRFSW SET.
|
||
SETOM REOWNF ;REOWNF < 0 => IF JOB EXISTS, LOAD OVER IT.
|
||
SOS REOWNF ;AND -2 IMPLIES SAY "--CLOBBER EXISTING JOB--" EVEN IF ..CLOBRF IS 0.
|
||
SKIPE GENJFL
|
||
HRRZM P,REOWNF ;REOWNF > 0 => IF JOB EXISTS, MAKE ANOTHER JOB.
|
||
TLZ F,FLQ ;SAY BUILT-IN COMMANDS ARE PERMITTED.
|
||
JRST NCOM4
|
||
|
||
KRETRY: SETOM REOWNF ;:RETRY => PREFER TO CLOBBER.
|
||
CAIA
|
||
KNEW: HRRZM P,REOWNF ;:NEW => MAKE NEW JOB RATHER THAN CLOBBER.
|
||
TLO F,FLQ ;SUPPRESS BUILT-IN COMMANDS; :NEW DUMP SHOULD LOAD TS DUMP.
|
||
NCOM4: MOVE B,(W4)
|
||
TLZ F,FLC+FLLET
|
||
TLNE B,O.1ALT
|
||
TLO F,FLC
|
||
PUSHJ P,NCOMI ;INIT. DEV, SNAME, FLLET.
|
||
NCOM1: PUSHJ P,RTOKEN ;B_COMMAND NAME (6BIT).
|
||
CAIN D,33 ;IF NO TOKEN, JUST ALTMODE,
|
||
JUMPE B,NCOMC ;READ COMMENT.
|
||
SKIPL TOKTRM
|
||
JUMPE B,NCOM1 ;IF NULL, AND NOT ^M, GET ANOTHER.
|
||
JUMPE B,NLTL4 ;NULL COMMAND
|
||
CAIN D,": ;COLON - SET DEV, INHIBIT BUILT-IN COMMANDS.
|
||
JRST [MOVEM B,SFILE ? JRST NCOM0]
|
||
CAIN D,"; ;SEMICOLON SIMILAR BUT SET SNAME.
|
||
JRST NCOMS
|
||
MOVEM B,NCOMNM ;REMEMBER NAME OF :-COMMAND.
|
||
MOVE D,(W4)
|
||
CAME B,['NEW,,] ;$: DOESN'T INHIBIT :NEW LIKE OTHER BUILT-INS.
|
||
CAMN B,[SIXBIT /RETRY/]
|
||
TLNE F,FLLET+FLQ ;:FOO;NEW AND :NEW NEW SHOULD RUN TS NEW.
|
||
TLNN F,FLC+FLLET+FLQ ;BUILT IN CMDS INHIBITED -> GO LOAD FILE..
|
||
TLNE D,O.2ALT ;$$: ALSO INHIBITS THEM (EVEN :NEW!).
|
||
JRST NCOM3
|
||
call nclook ;look up the command in the table
|
||
caia ; Didn't find it, must be a program
|
||
jrst ncl2 ; found it, dispatch.
|
||
|
||
NCOM3: MOVEM B,SYSN2 ;DUMMY UP "NAME^K".
|
||
SETOM XCRFSW ;AN EXTRA CRLF WOULD LOOK BAD AFTER :FOO <CR>
|
||
JRST ACTRLK
|
||
|
||
;;; look for a command in the command table, takes command in B,
|
||
;;; returns offset in NCTAB in A
|
||
|
||
nclook: camn b,nctab(a)
|
||
jrst popj1 ; found the command, skip return
|
||
caige a,nlcom-2
|
||
aoja a,[aoja a,nclook]
|
||
ret ;Didn't find the command, fail return
|
||
|
||
NCL2: HRRZ D,NCTAB+1(A) ;BUILT-IN COMMAND.
|
||
SETZ A, ;TELL THE COMMAND ITS "INFIX ARGUMENT" WAS 0.
|
||
JRST (D)
|
||
|
||
NCOMS: MOVEM B,SFILE+3
|
||
NCOM0: TLO F,FLLET
|
||
JRST NCOM1
|
||
|
||
NCOMPT: CTYPE ": ;RTN TO RETYPE A :-CMD'S NAME
|
||
PUSHJ P,SIXTYP ;IF THE COMMAND IS RUBBED AS A SYLLABLE
|
||
JRST TSPC ;(EG AFTER THE COMMAND CALLED GSOA,
|
||
;WHICH WILL REPLACE THE : ON THE FROB STACK
|
||
;WITH A SYLLABLE THAT WILL COME HERE TO BE RETYPED)
|
||
|
||
KMONMO: SETOM MONMOD ;:MONMOD, ENTER MONIT MODE.
|
||
SETOM MONMDL
|
||
JRST NLTL4
|
||
|
||
KDDTMO: SETZM MONMOD ;LEAVE MONIT MODE.
|
||
SETZM MONMDL
|
||
JRST NLTL4
|
||
|
||
NCOMI: MOVEI D,'DSK
|
||
HRLZM D,SFILE
|
||
MOVE D,MSNAM ;DEFAULT IS DSK:<MSNAME>
|
||
MOVEM D,SFILE+3
|
||
TLZ F,FLLET ;BUT CAN TRY SYS; AND SNLIST.
|
||
POPJ P,
|
||
|
||
NCOMC: JSP W2,RCH ;COMMENT CONTINUES THRU NEXT ALTMODE.
|
||
CAIN D,33
|
||
JRST NCOM1
|
||
JRST NCOMC
|
||
|
||
;; :JCLPRT -- print JCL of the current job
|
||
kjclprt:
|
||
call terpri ;fresh line
|
||
skipl a,uchbuf(u) ;get the JCL pointer
|
||
jrst [ 7type [asciz /[No JCL]/] ;tell him there's none
|
||
jrst nltl4]
|
||
7type (a) ;type it
|
||
jrst nltl4 ;prompt and return
|
||
|
||
;:JCL
|
||
KJCL: PUSHJ P,QIJERR ;MUST HAVE INFERIOR OPEN TO RECEIVE .BREAK .
|
||
SKIPN TOKTRM
|
||
PUSHJ P,RLINEC ;ELSE READ IN COMMAND,
|
||
PUSH P,[NLTL4]
|
||
|
||
;RLINE MUST HAVE BEEN CALLED BEFORE CALLING JCL .
|
||
;SET JOB'S COMMAND BUFFER.
|
||
JCL: MOVEI W1,UCHBUF(U)
|
||
CALL JCL0 ;READ IN THE STRING, SET UCHBUF.
|
||
JCL3: .USET USRI,[.SUSTP,,[-1]]
|
||
.USET USRI,[.ROPTIO,,A]
|
||
TLO A,OPTCMD+OPTBRK+OPTDDT ;SET JOB'S OPTBRK AND OPTDDT BITS,
|
||
SKIPL UCHBUF(U)
|
||
TLZ A,OPTCMD ;SET OPTCMD BIT IFF HAVE COMMAND FOR IT.
|
||
.USET USRI,[.SOPTIO,,A]
|
||
TSTOPX: SKIPN UINT(U) ;UNSTOP A TEMPORARILY STOPPED JOB.
|
||
SKIPE UINTWD(U)
|
||
RET ;(BUT NOT PERMANENTLY STOPPED OR WAITING JOBS)
|
||
SKIPG INTBIT(U) ;(AND NOT ON NON-INFERIOR JOBS WHICH WE CAN'T UNSTOP)
|
||
RET
|
||
SKIPN UHACK(U) ;(OR JOBS WAITING FOR HAKKAH)
|
||
.USET USRI,[.SUSTP,,[0]]
|
||
RET
|
||
|
||
;W1 HAS ADDR OF AOBJN PTR,
|
||
;READ A LINE INTO SYMTAB SPACE, PUT AOBJN TO IT THERE.
|
||
JCL0: PUSH P,W1
|
||
PUSHJ P,ELEC0 ;FLUSH EXISTING COMMAND BUFFER.
|
||
SKIPE TOKTRM ;IF ":JCL^M", LEAVE IT CLEAR.
|
||
JRST POPW1J
|
||
HRRZ B,GSCHRP ;GET PTR RE-READING FROM,
|
||
HRRZ D,GSCHRQ ;AND PTR TO END,
|
||
SUBI D,-1(B) ;MAX NUM. WDS WILL NEED TO HOLD COMMAND.
|
||
PUSHJ P,ALLOC ;GET THAT MANY IN SYMTAB SPACE,
|
||
MOVEM A,@(P)
|
||
MOVEI B,(A) ;MAKE B.P. INTO OBJECT JUST ALLOCATED.
|
||
HRLI B,440700
|
||
JCL2: PUSHJ P,SLRPIN ;THEN READ CHARS AND STUFF INTO SPACE OBTAINED.
|
||
IDPB D,B
|
||
CAIE D,^_
|
||
CAIN D,^C ;UNTIL THE CR OR ^C.
|
||
JRST JCL4
|
||
CAIE D,^M
|
||
JRST JCL2
|
||
JCL4: LDB D,[360600,,B] ;ZERO OUT REST OF UNFILLED WORD.
|
||
DPB D,[300600,,B]
|
||
TLZ B,770000
|
||
SETZ D,
|
||
DPB D,B
|
||
HRRZ D,@(P) ;AND IF THERE ARE MORE WORDS IN THE SPACE ALLOCATED,
|
||
HLRE A,@(P)
|
||
SUB D,A ;ZERO THE FIRST OF THEM, TOO.
|
||
CAIE D,1(B)
|
||
SETZM 1(B)
|
||
JRST POPW1J
|
||
|
||
;; Long JCL
|
||
kljcl: call qijerr ;must have a real inferior to hack JCL
|
||
call kljcl0 ;read in the JCL now
|
||
jrst nltl4 ; prompt and return, we were aborted
|
||
call kljcl1
|
||
jrst nltl4 ;prompt and exit
|
||
|
||
;; KLJCL1 takes the contents of the VPAGAD buffer and sticks it in the jobs
|
||
;; JCL buffer.
|
||
|
||
kljcl1: movei d,vpagad
|
||
move c,jclend ;recall the end of the buffer
|
||
subi d,(c) ;-<# of words of JCL to hack>
|
||
hrlzi a,(d) ;A <= -<# of words to jack>,,0
|
||
push p,d ;save -<# of words of JCL>
|
||
push p,a ;save -<# of words of JCL>,,0
|
||
movei w1,uchbuf(u) ;AOBJN ptr for this job's JCL
|
||
call elec0 ;flush any JCL that used to be there
|
||
movei w1,uchbuf(u) ;AOBJN ptr for this job's JCL
|
||
move d,symtop ;make sure there's a pointer in there
|
||
movem d,(w1) ;null ptrs have the same content as SYMTOP
|
||
pop p,a ;get -<# of words of space>,,0 for HOLE0
|
||
call hole0 ;allocate the space
|
||
pop p,c ;restore -<# of words of JCL>
|
||
movns c ;<# of words of JCL>
|
||
hrlzi d,vpagad ;From the beginning of the bufffer
|
||
hrr d,uchbuf(u) ;ptr to the space its going into
|
||
addi c,(d) ;C -> last word to transfer into
|
||
blt d,(c) ;perform the transfer
|
||
call vpagrt ;return the buffer page
|
||
jrst jcl3 ;and tell the job there's JCL
|
||
|
||
;;; KLJCL0 reads in a VPAGAD buffer full of stuff
|
||
kljcl0: call vpaget ;get a buffer page
|
||
move c,[010700,,vpagad-1] ;start out at the beginning of the buffer
|
||
movem c,bufbeg ;and allow rubouts all the way back to here
|
||
call bgread ;read the JCL
|
||
popj p, ; Aborted (via ^Z)
|
||
call bugrdx ;Deposit our terminating character
|
||
setz d, ;Pad the string with nulls
|
||
repeat 5,[? came c,[010700,,vpagad+1777] ? idpb d,c ]
|
||
movem c,jclend ;remember the end pointer of our JCL
|
||
jrst popj1 ;skip return, we got something
|
||
|
||
;;; :RUN <program> <JCL>
|
||
krun: setzm lrunsw ;note we're not hacking long HCL
|
||
caia
|
||
;;; :LRUN <program> <long-JCL>^C
|
||
klrun: setom lrunsw
|
||
call rtoken ;read in a 6bit name
|
||
save ttyflg ;remember flag state for later
|
||
sosge ttyflg ;turn on the flag one level
|
||
setzm ttyflg ; if over-on, just turn it on
|
||
push p,[[ rest ttyflg ? ret]] ;put on a frob to restore the stack
|
||
call nclook ;look for the command
|
||
caia ; not found, must be a program
|
||
jrst ncl2 ; found a built-in, let it do it's thing
|
||
movem b,sysn2 ;that's the JNAME to use
|
||
setom insist ;we don't need the file yet, don't error yet
|
||
skipn ckqflg ;if CKQFLG is zero
|
||
hrrzm p,insist ; We barf now anyway
|
||
skipl ckqflg ;If we want early checking of file
|
||
call fndcmd ; Find the file to use
|
||
skipe lrunsw ;otherwise
|
||
jrst klrun0 ; try to read long JCL, return here if win
|
||
skipe toktrm ;did he already end his input?
|
||
jrst klrun1 ; then there's no JCL
|
||
skipn lrunsw ;if we're not reading long JCL
|
||
call rlinec ;read in the line to get JCL from
|
||
klrun1: skipn insist ;if we failed the first time,
|
||
opner ctlho ; barf now.
|
||
hrrzm p,insist ;we need the file for real now, barf if lost
|
||
skipge ckqflg ;if we didn't already do it,
|
||
call fndcmd ; Find the file to use
|
||
setom reownf ;REOWNF gets -2 unless ..GENJFL is non-zero
|
||
skipn genjfl ;unless GENJFL is set meaning to "GENJOB"
|
||
sos reownf ; in which case it gets -1 to just clobber
|
||
skipn lrunsw ;if we're not reading long JCL
|
||
jrst klrunx ; do things the old way
|
||
klrun9: call ctlh4 ;create the job
|
||
call kljcl1 ; Get the JCL for the job the long way
|
||
jrst ctlh8 ;run the job
|
||
|
||
klrunx: call ctlh4 ;create the job
|
||
call jcl ; get the JCL for it, one line only
|
||
jrst ctlh8 ;run the job
|
||
|
||
klrun0: call kljcl0 ; read in the JCL to use
|
||
jrst [ caie d,^Z ; Abort or rubout?
|
||
jrst rubfls ; over-rubout, fail back to the readin
|
||
jrst nltl4] ; He aborted it
|
||
jrst klrun1 ;all is normal, back to hacking
|
||
|
||
|
||
NGDEV: JUMPE D,CPOPJ ;CONVERT SYL IN C,D TO DEVICE NAME.
|
||
CAIN D,D6PNT
|
||
JRST NGDEV4 ;SIXBIT SYL, USE SIXBIT AS DEV NAME.
|
||
SKIPL C
|
||
CAILE C,10
|
||
JRST NGDEV4 ;NOT NUMBER FROM 0 TO 8 => USE VALUE.
|
||
SKIPN C
|
||
SKIPA C,['DSK] ;0 => DSK, N =>UTN.
|
||
ADDI C,'UT0
|
||
HRLZS C
|
||
NGDEV4: MOVE D,C ;RETURN FULL WD IN C, 1ST 3 CHARS IN RH OF D.
|
||
RET
|
||
|
||
NBITE: JUMPL D,NBITE2 ;IT'S AN OPERATOR, PUSH BACK ON FROB STACK.
|
||
CAME D,[SYLSYM,,]
|
||
RET
|
||
SAVE A
|
||
MOVEM C,SYM ;SYMBOL, CONVERT NAME TO 6BIT, RETURN 6BIT SYL.
|
||
MOVEI W1,SYM
|
||
MOVE C,[404040,,404040] ;FILL WITH WHAT WILL BE SPACES.
|
||
MOVE D,[IDPB D,A] ;THIS WILL GO IN SPTS
|
||
MOVE A,[440600,,C]
|
||
CALL .SPT
|
||
MOVEI D,D6PNT ;RETURN 6BIT SYL.
|
||
XOR C,[404040,,404040] ;.SPT DIDN'T SUBI 40 FROM ASCII CHARS.
|
||
JRST POPAJ
|
||
|
||
NBITE2: PUSH W4,C ;OPERATOR, REPUSH
|
||
PUSH W4,D
|
||
SETZB C,D
|
||
RET
|
||
|
||
kcwd0: call rtoken ; :CWD <msname> or :CWD<cr>
|
||
skipn toktrm ; unless terminated
|
||
jumpe b,kcwd0 ; More blankness, keep reading
|
||
move c,b ;get the result in C
|
||
jrst n2acs ;and set the MSNAME appropriately.
|
||
|
||
kcwd: skipn toktrm ;has the carraige return already been typed?
|
||
jrst kcwd0 ; no, gotta read the frob
|
||
setz c, ;start out with no arg!
|
||
n2acs: skipn c ;null or zero arg?
|
||
move c,hsname ; yes, use the HSNAME
|
||
call ddtmsn ;for $$^S, set msname.
|
||
move a,lsnam
|
||
call rrfl3 ;put sname in snlis1 .
|
||
.suset [.ssname,,msnam] ;For the sake of the wholine
|
||
jrst nltl2
|
||
|
||
NACS: jumpn d,nacs1 ;$^S with arg set TUNAME and THSNAM
|
||
move c,xuname ;$^S, WITHOUT ARG RESTORES TUNAME TO XUNAME.
|
||
movem c,tuname
|
||
move c,hsname
|
||
movem c,thsnam
|
||
jrst nltl2
|
||
|
||
nacs1: movem c,tuname ;remember this as the temporary name
|
||
call gethsn ;get the HSNAME for it
|
||
jfcl
|
||
movem c,thsnam ;and remember it
|
||
jrst nltl2
|
||
|
||
|
||
NCTLS: JUMPE D,NLTL2 ;^S, SET JOB'S
|
||
SKIPGE UCHNLO ;DON'T USET UNLESS INFERIOR.
|
||
.USET USRI,[.SSNAM,,C]
|
||
JRST NLTL2
|
||
|
||
;BREAKPOINT ROUTINES
|
||
;(BPLF=>BPT NON VALUE COMMAND)
|
||
|
||
NALTB: SKIPE ARG1+1
|
||
JRST NBPS1
|
||
TLNE B,O.IFX
|
||
JRST NBPS2 ;$NB, $$NB
|
||
TLNN B,O.2ALT
|
||
JRST NBPS6
|
||
CALL NALTBS ;STOP JOB IF RUNNING, REMOVE BPTS IF IN.
|
||
MOVEI D,B1ADR+1(U) ;$$B
|
||
HRLI D,-1(D) ;FLUSH ALL BPTS
|
||
SETZM B1ADR(U)
|
||
BLT D,BPEND-1(U)
|
||
HLLZS D,BPINFL(U) ;CLEAR ALL AUTO-PROCEED BITS.
|
||
MOVE D,UINTWD(U)
|
||
CAIG D,15 ;IF JOB IS STOPPED AT A BREAKPOINT, FORGET THAT FACT.
|
||
SKIPG D ;OTHERWISE, IF USER SETS ANOTHER BPT WITH SAME NUMBER AS
|
||
JRST NALTBX ;THE ONE TH JOB HIT, WE WON'T STOP AT IT WHEN WE PROCEED.
|
||
SETOM UINTWD(U)
|
||
NALTBX: SKIPGE (P) ;IF BPTS HAD BEEN IN, PUT BACK IN.
|
||
CALL INSRTB
|
||
CALL TSTOPX ;IF HAD BEEN RUNNING, RESTART.
|
||
JRST LCTGNR
|
||
|
||
NBPS1: MOVE D,ARG1
|
||
TLNN B,O.IFX
|
||
JRST NBPS3
|
||
JUMPE A,NBPSF ;N$0B ;FLUSH BPT AT N.
|
||
TRO F,BPLF ;N$MB ;ADD BPT M
|
||
NBPS2: CAIL A,1 ;ENTER HERE FOR $$NB, FLUSH BPT N
|
||
CAILE A,11 ;ALLOW $9B FOR HACKS IN USER AREA
|
||
JRST NAERR
|
||
NBPS7: IMULI A,BPL
|
||
ADDI A,B1ADR-BPL(U)
|
||
TRZN F,BPLF
|
||
JRST GSDDTJ
|
||
CAIN A,STARTA(U) ;MAKE FOO$9B WORK TO SET START ADDRESS WITHOUT
|
||
JRST [ MOVEM D,STARTA(U) ;ANY OF THE BREAKPOINT-INSERTION HAIR.
|
||
JRST LCTGNR]
|
||
NBPS5: CALL NALTBS ;TEMPORARILY STOP JOB & REMOVE BPTS.
|
||
JUMPE D,NBPS9
|
||
SAVE A ;INSERTING, CHECK FOR DUPLICATE
|
||
CALL NBPS4
|
||
CAIN C,(D)
|
||
MOVEM A,(P) ;USE SAME SLOT
|
||
SAVE D
|
||
MOVEI A,(D) ;READ CONTENTS OF PLACE TO PUT BREAKPOINT,
|
||
CALL RFETCH
|
||
JRST NXERR
|
||
CALL DEP ;STORE BACK TO UNPURIFY OR TYPE PUR?
|
||
REST D ;-> PLACE TO PUT BPT.
|
||
REST A ;-> BREAKPOINT SLOT.
|
||
NBPS9: MOVEM D,(A)
|
||
SETZM 1(A)
|
||
SETZM 2(A)
|
||
SUBI A,B1ADR(U)
|
||
SAVE B
|
||
IDIVI A,BPL
|
||
MOVE B,UINTWD(U)
|
||
CAIN B,1(A) ;IF BPT BEING FLUSHED OR RESET WAS THE REASON JOB IS STOPPED,
|
||
SETOM UINTWD(U) ;FORGET THAT FACT.
|
||
REST B
|
||
CALL BUTOP1
|
||
JRST NALTBX
|
||
|
||
NBPS6: MOVE A,UINTWD(U) ;$B
|
||
CAIL A,1 ;FLUSH CURRENT BPT
|
||
CAILE A,10
|
||
JRST NXERR
|
||
MOVEI D,0
|
||
TRO F,BPLF
|
||
JRST NBPS7
|
||
|
||
NBPS3: CALL NBPS4 ;N$B, N$$B
|
||
SKIPN C
|
||
JRST NBPS5
|
||
ERSTRT [SIXBIT/TOO MANY BPTS?/]
|
||
|
||
;NOTE: NALTBS SETS THE WORD ON THE PDL UNDER THE RETURN ADDRESS!
|
||
NALTBS: SAVE D
|
||
SAVE A
|
||
HLLZ D,BPINFL(U)
|
||
HLLM D,-3(P) ;REMEMBER WHETHER BPTS ARE INSERTED (FOR NALTBX)
|
||
SKIPG INTBIT(U) ;IF JOB ISN'T OUR INFERIOR, DON'T TRY TO STOP IT
|
||
JRST POPADJ
|
||
.USET USRI,[.SUSTP,,[-1]] ;STOP JOB WHILE MUNG IT.
|
||
CALL REMOVB ;REMOVE BPTS IF IN.
|
||
JRST POPADJ
|
||
|
||
NBPS4: MOVEI A,B1ADR(U)
|
||
NBPS4A: HRRZ C,(A)
|
||
XCT @(P)
|
||
JRST CPOPJ1 ;WIN
|
||
ADDI A,BPL
|
||
CAIGE A,BPEND(U)
|
||
JRST NBPS4A
|
||
JRST CPOPJ2 ;LOSE
|
||
|
||
NBPSF: PUSHJ P,NBPS4 ;N$0B, FLUSH BPT AT N (WHICH IS IN D)
|
||
CAIN C,(D) ;THIS INSN XCT'D BY NBPS4.
|
||
CAIA ;FOUND BPT AT N.
|
||
JRST NXERR ;NONE.
|
||
SETZ D, ;FOUND THE BPT; GO CLEAR IT.
|
||
JRST NBPS5
|
||
|
||
KLSTB: PUSH P,U
|
||
KLSTB0: MOVE A,(P) ;(P) HAS USR IDX + BPL*<NUM OF NEXT BPT>
|
||
MOVE D,B1ADR(A)
|
||
JUMPE D,KLSTB1 ;THIS BPT NOT IN USE.
|
||
PUSHJ P,CRF
|
||
SUBI A,(U)
|
||
IDIVI A,BPL ;NUM OF BPT
|
||
CTYPE "1(A)
|
||
7TYPE [ASCIZ/ /]
|
||
PUSHJ P,HLFW ;PRINT ADDR TO OPEN,,ADDR OF BPT.
|
||
MOVE A,(P)
|
||
MOVE D,BPCON(A)
|
||
CTYPE ^I
|
||
PUSHJ P,PIN ;PRINT CONDITIONAL BREAK INSN.
|
||
MOVE A,(P)
|
||
MOVE D,B1CNT(A) ;PROCEED COUNT
|
||
CTYPE ^I
|
||
PUSHJ P,FTOC
|
||
KLSTB1: MOVEI A,BPL
|
||
ADDB A,(P) ;ADVANCE TO NEXT BPT.
|
||
CAIGE A,NBP*BPL(U)
|
||
JRST KLSTB0
|
||
JRST POPAN2 ;FLUSH TOP WD OF PDL, JRST NLTL2
|
||
|
||
NALTI: SETZM MARCON(U)
|
||
SETZM MARXCT(U)
|
||
SKIPN D,ARG1+1 ;$I
|
||
JRST NALTI2 ;NO ARG => FLUSH MAR.
|
||
HRRZ D,ARG1
|
||
TLO D,3
|
||
TLNE B,200000
|
||
HRL D,A ;USE INFIX NUM ARG
|
||
TLO D,4
|
||
TLNE D,777770
|
||
JRST NAERR
|
||
NALTI2: syscall usrvar,[movei usri ? [sixbit /MARA/] ? move d]
|
||
jumpn d,[erstrt [sixbit "NO MAR?"]]
|
||
MOVEM D,MARADR(U)
|
||
JRST NLTL2
|
||
|
||
;;; :datprt <time word> prints the date as a time word
|
||
kdatprt:
|
||
call ronum ;read in a number
|
||
jrst altdqx ; rubbed out, abort
|
||
skipn b ;if we didn't get anything
|
||
move a,lwt ; use Q
|
||
|
||
move d,[440700,,fdrctb] ;get Byte pointer to FDRC buffer (should be
|
||
; unused at MP level)
|
||
call datime"twdasc ;send it down to the buffer
|
||
7type fdrctb ;and print it out
|
||
jrst lctgnr ;print spaces and return
|
||
|
||
;;; For now, value is the date word corresponding to the date read in, and
|
||
;;; expects to be terminated with a CR, so doesn't work too well in expressions
|
||
;;; Should eventually be made to work in expressions.
|
||
|
||
kdatwrd:
|
||
call rdatew ;read in the date word into D
|
||
move a,d ;return it
|
||
movsi b,syloct ;Dunno why
|
||
ret ;and that's it, I think
|
||
|
||
;:CORBLK PURE <ADDR> MAKES <ADDR>'S PAGE PURE.
|
||
;OTHER ALTERNATIVES ARE "NONE", "FRESH", "IMPURE".
|
||
KCORBL: SKIPN DDTSW ;:UNPURE LEGAL ON INFERIOR OR SELF.
|
||
PUSHJ P,QIJERR
|
||
CALL RTOKEN ;READ CONDITION NAME.
|
||
JUMPE B,KCORBL
|
||
MOVSI A,-KCORTL ;SEARCH TABLE FOR IT.
|
||
KCORB1: CAMN B,KCORBS(A)
|
||
JRST KCORB2 ;FOUND.
|
||
AOBJN A,KCORB1
|
||
ERSTRT [SIXBIT/CORBLK SUBCOMMAND?/]
|
||
|
||
KCORB2: MOVEM A,-1(W4) ;ARRANGE TO RETYPE :CORBLK AND CONDITION
|
||
MOVEI A,KCORRB ;ON RUBOUT OR ^L.
|
||
MOVEM A,(W4) ;(CAN ALSO RETRIEVE KCORBX IDX FROM -1(W4))
|
||
SETZM NCOMNM ;DON'T LET GSOA CLOBBER WHAT WE JUST DID.
|
||
KCORB4: CALL RONUM ;READ ARG.
|
||
JRST ALTDQX ;RUBBED BACK OUT OF ARG.
|
||
JUMPE B,KCORB4 ;READ NOTHING => TRY AGAIN.
|
||
MOVE W1,-1(W4) ;GET KIFTB1 IDX OF CONDITION.
|
||
MOVEI C,USRI ;UNLESS SUBCOMMAND ALTERS THIS, GET PAGE FROM SAME JOB
|
||
MOVEI D,%CBNDW ;AND GET WRITE PERMISSION.
|
||
XCT KCORBX(W1) ;DISPATCH ON THE SUBCOMMAND AND LET IT CHANGE THEM.
|
||
;"IMPURE" GOES OFF TO :UNPURE NOW.
|
||
LSH A,-10. ;CONVERT ADDRESS TO PAGE NUMBER.
|
||
SYSCLO CORBLK,[D ? %CLIMM,,USRI ? A ? C ? A]
|
||
JRST NLTL4
|
||
|
||
KCORRB: 7TYPE [ASCIZ/:CORBLK /] ;GFROBP CALLS HERE, FROM ALTDQX.
|
||
MOVE D,KCORBS(D) ;D HAS 1ST WD OF SYL.
|
||
CALL SIXTYP
|
||
JRST TSPC
|
||
|
||
;TABLES OF :CORBLK SUBCOMMANDS AND HOW TO HANDLE THEM.
|
||
KCORBS:
|
||
IRPS X,,PURE IMPURE NONE FRESH
|
||
SIXBIT /X/
|
||
TERMIN
|
||
KCORTL==.-KCORBS
|
||
|
||
KCORBX: MOVEI D,%CBNDR
|
||
JRST UNPUR5
|
||
MOVEI D,0
|
||
MOVEI C,%JSNEW
|
||
|
||
;; :CORTYP <addr> gives info about type of page <addr> is on
|
||
|
||
kcortyp:
|
||
jumpl u,njerr ;must have a job to do CORTYP on
|
||
call ronum ;read address
|
||
jrst altdqx ; rubbed out, flush
|
||
jumpe b,kcortyp ;read nothing, try again
|
||
7type pagmsg
|
||
andi a,-1 ;Ignore LH
|
||
lsh a,-10. ;convert address to page number
|
||
move d,a
|
||
call g8pnt
|
||
move b,uind(u)
|
||
.call typblk ;Collect the info on the page in A
|
||
erloss
|
||
skipn a ;does the page even exist?
|
||
jrst [7type [asciz / (Non-existant)/]
|
||
jrst nltl4] ;prompt and return
|
||
call kcort0 ;describe the page, since it exists.
|
||
jrst nltl4 ;prompt and return
|
||
|
||
kcort0: skipe b ;Is this an absolute page?
|
||
jrst kcort1 ; no, give relevant info on user page
|
||
|
||
7type [asciz /, System page # /]
|
||
move a,c ;absolute page #
|
||
call g8pnt ;print it
|
||
popj p, ;that's it, return
|
||
|
||
kcort1: tlne a,%cbwrt
|
||
7type [asciz /, Impure/]
|
||
tlnn a,%cbwrt
|
||
7type [asciz /, Pure/]
|
||
tlne a,%cbpub
|
||
7type [asciz /, Public/]
|
||
tlne a,%cblok
|
||
7type [asciz /, Locked/]
|
||
|
||
jumpl b,kcort2 ;if second val is positive, page is shared
|
||
7type [asciz /, Shared /]
|
||
move a,d
|
||
andi a,-1 ;RH is # of sharers
|
||
push p,d ;don't lose the sign bit to G9PNT
|
||
call g9pnt
|
||
pop p,d ;recover our arg
|
||
7type [asciz / times/]
|
||
|
||
kcort2: 7type [asciz /, Swapped /]
|
||
jumpge d,[7type [asciz /OUT/] ? popj p,] ;If positive, it's
|
||
;swapped
|
||
7type [asciz /IN/]
|
||
popj p,
|
||
|
||
|
||
typblk: setz ? sixbit /CORTYP/ ? %climm,,%jsnum(b) ? %climm,,(a)
|
||
%clout,,a ? %clout,,b ? %clout,,c ? setz+<%clout,,d>
|
||
|
||
pagmsg: asciz /APage # /
|
||
|
||
kcorprt: movsi a,-400 ;page counter
|
||
kcorp1: push p,a ;save the page count
|
||
move b,uind(u) ;get user index of job
|
||
.call typblk ;get the info
|
||
erloss
|
||
jumpe a,kcorp9 ;if non-existant, don't print anything
|
||
7type pagmsg ;tell what page #
|
||
push p,a ;save the type info
|
||
hrrz a,-1(p) ;get the page #
|
||
push p,d ;save D from the clutches of G8PNT
|
||
call g8pnt ;print the page #
|
||
pop p,d ;recover D
|
||
pop p,a ;recover the type info
|
||
call kcort0 ;print the info on the page
|
||
kcorp9: pop p,a ;recover the page count
|
||
aobjn a,kcorp1 ;and on to the next page
|
||
jrst nltl4 ;prompt and exit
|
||
|
||
|
||
;$$^M - UNPURIFY OPEN LOCATION IF ANY, THEN STORE ARG.
|
||
;NOTE THAT THIS OPERATOR DOES NOT EVAL ARGS.
|
||
|
||
N2ACM: TLNN F,FLRO ;DON'T UNPURIFY IF NO LOCATION OPEN.
|
||
JRST N2ACM1
|
||
MOVE A,LLOCO ;GET ADDR OF OPEN LOCATION, UNPURIFY PAGE.
|
||
PUSHJ P,UNPUR0
|
||
N2ACM1: HRROI B,[50600,,GSNLRT]
|
||
RET ;RETURN AN OPERATOR THAT WILL EVAL ARGS,
|
||
;DEPOSIT ITS ARG, AND DO NOTHING ELSE.
|
||
|
||
KUNPUR:
|
||
UNPURE: SKIPN DDTSW ;:UNPURE LEGAL ON INFERIOR OR SELF.
|
||
PUSHJ P,QIJERR
|
||
PUSHJ P,RONUM ;READ ADDRESS OF LOC. TO UNPURIFY.
|
||
JRST ALTDQX ;(TO RUB OUT THE :UNPURE)
|
||
JUMPE B,UNPUR2 ;NO ARG => UNPURIFY ALL BUT ABS PAGES.
|
||
UNPUR5: PUSH P,[NLTL4]
|
||
|
||
;UNPURIFY THE PAGE THE ADDRESS IN A LIES IN.
|
||
UNPUR0: PUSHJ P,VPAGET ;GET FRESH PAGE TO COPY THAT PAGE INTO.
|
||
ANDI A,-2000 ;GET ADDR OF START OF PAGE,
|
||
.ACCES USRI,A
|
||
MOVE B,[-2000,,VPAGAD]
|
||
SAVE XRWI
|
||
SETOM XRWI ;.IOT SHOULD SKIP IF IT GETS AN MPV.
|
||
.IOT USRI,B ;COPY OLD PAGE INTO FRESH PAGE.
|
||
JRST UNPUR4 ;NO MPV?
|
||
ERSTRT [SIXBIT/MPV?/]
|
||
|
||
UNPUR4: REST XRWI
|
||
LSH A,-10.
|
||
SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,USRI ? A
|
||
%CLIMM,,%JSELF ? %CLIMM,,VPAGE]
|
||
JRST ERR ;STICK THE COPY IN PLACE OF OLD PAGE.
|
||
JRST VPAGRT ;LET GO OF THE COPY.
|
||
|
||
UNPUR2: .USET USRI,[.RMEMT,,D]
|
||
SETZ A, ;A -> 1ST WD OF NEXT PAGE TO HANDLE.
|
||
UNPUR3: CAML A,D
|
||
JRST NLTL4 ;ALL PAGES HANDLED.
|
||
PUSHJ P,UNPUR1 ;UNPURIFY THIS PAGE IF NEC.
|
||
JFCL
|
||
ADDI A,2000
|
||
JRST UNPUR3 ;GO ON TO CHECK NEXT PAGEOS
|
||
|
||
;A HAS ADDR, UNPURIFY PAGE THAT ADDR LIES IN
|
||
;IF PAGE IS READ-ONLY OR SHARED, AND IS NOT ABSOLUTE.
|
||
;SKIP-RETURNS IF DID NOT UNPURIFY.
|
||
UNPUR1: PUSH P,A
|
||
LDB B,[121000,,A] ;GET PAGE NUM,
|
||
SYSCLE CORTYP,[%CLIMM,,USRI ? B ? %CLOUT,,B ? %CLOUT,,A ? %CLOUT,,C ? %CLOUT,,C]
|
||
POP P,A
|
||
ANDI C,-1
|
||
JUMPE C,POPJ1 ;NO PAGE OR ABS PAGE, DO NOTHING.
|
||
SOJG C,UNPUR0 ;SHARED PAGE, UNPURIFY.
|
||
JUMPG B,UNPUR0 ;READ-ONLY, UNPURIFY.
|
||
JRST POPJ1
|
||
|
||
APAT: PUSHJ P,APATCK ;CHECK WHETHER CAN PATCH THIS JOB.
|
||
CALL PATOPN ;SET PATCHL TO LOCATION PATCHED,,PATCH AREA.
|
||
PUSHJ P,FETCH ;GET CONTENTS OF LOC OPEN
|
||
JRST NPERR
|
||
PUSH P,D
|
||
HRRZ D,PATCHL(U) ;GET LOCATION OF START OF PATCH
|
||
PUSHJ P,NNL2
|
||
MOVE D,(P)
|
||
PUSHJ P,ENWPAT ;SET $Q AND PRINT.
|
||
POP P,A
|
||
APAT5: JSP B,GSEVLJ ;RETURN SYLL WHICH WILL RUB
|
||
CTYPE "< ;OUT AS AN INSTRUCTION
|
||
PUSHJ P,PIN
|
||
MOVEI D,"> ;BETWEEN ANGLE BRACKETS.
|
||
JRST TOUT
|
||
|
||
NPERR: SETZM PATCHL(U) ;SAY NO PATCH IN PROGRESS, AND CAUSE ERROR.
|
||
AEPAT: CALL PATADJ ;ADJUST PATCH END ADDR ACCORDING TO ARG AND WHETHER LOC IS OPEN.
|
||
PUSH P,B
|
||
TLZN B,O.1ALT+O.2ALT ;[[ FOR $^] AND $$^] STORE THE INSN THE PATCH
|
||
JRST AEPAT1
|
||
HLRZ A,PATCHL(U) ;WILL REPLACE,THEN LINEFEED.
|
||
PUSHJ P,FETCH
|
||
JRST NXERR
|
||
PUSHJ P,PDEP
|
||
AEPAT1: HLRZ D,PATCHL(U) ;GET PLACE PATCH WAS MADE FROM.
|
||
MOVE B,(P)
|
||
TLNE B,O.2ALT ;[ ;EXCEPT FOR $$^],
|
||
JRST AEPAT6
|
||
PUSHJ P,AEPAT3 ;PUT IN SOME JUMPA'S BACK TO THAT PLACE.
|
||
PUSHJ P,AEPAT3
|
||
AEPAT6: HLRZ D,PATCHL(U) ;GET PLACE PATCHED FROM, MINUS 1
|
||
MOVEI D,-1(D)
|
||
EXCH D,LLOC ;SET IT UP AS ".", SO CAN LINEFEED INTO PLACE PATCHED FROM.
|
||
AOS D
|
||
EXCH D,PATCHL(U)
|
||
HRLI D,(JUMPA 3,) ;GET A JUMPA TO POINT TO THE PATCH, WITH AN AC FIELD
|
||
POP P,B
|
||
TLZE B,O.1ALT
|
||
HRLI D,(JUMPA 2,) ;SAYING HOW THE PATCH WAS ENDED, AS A SIGNAL TO AUPAT.
|
||
TLZE B,O.2ALT
|
||
HRLI D,(JUMPA 4,) ;$$^] USES CODE 4 => UNPATCHING IS IMPOSSIBLE.
|
||
PUSHJ P,PDEP
|
||
HRRZ D,PATCHL(U)
|
||
;END A PATCH. D HAS NEW VALUE FOR "PATCH".
|
||
PATCLS: MOVE C,[SQUOZE 0,PATCH]
|
||
MOVEM C,SYM
|
||
PUSHJ P,DEFIN
|
||
SETZM PATCHL(U) ;NO LONGER PATCHING.
|
||
JRST NLTL2
|
||
|
||
PATADJ: SKIPN PATCHL(U)
|
||
JRST NXERR ;ERROR IF NO PATCH STARTED.
|
||
PUSHJ P,APATCK ;ERROR IF CAN'T WRITE THIS JOB.
|
||
SKIPE ARG1+1 ;IF HAVE ARG, PATCH ENDS WITH THE LOC. JUST CLOSED.
|
||
JRST CPOPJ
|
||
MOVE D,LLOC
|
||
SUBI D,1
|
||
MOVE A,PLUNKF ;IF A LOC. HAD BEEN OPEN, PATCH ENDED BEFORE IT.
|
||
TLNE A,FLRO ;IF NO LOC. HAD BEEN OPEN, PATCH ENDS WITH LOCATION ".".
|
||
HRRM D,LLOC ;LLOC POINTS AT LAST WORD OF PATCH. "PATCH:" OR 1ST JUMPA
|
||
RET ;GOES IN THE FOLLOWING WORD.
|
||
|
||
AUPAT: PUSHJ P,APATCK ;ERROR IF CAN'T PATCH THIS JOB.
|
||
TLNN F,FLRO ;^^
|
||
JRST NXERR
|
||
MOVE A,LLOCO
|
||
PUSHJ P,FETCH
|
||
JRST NXERR
|
||
MOVE A,D
|
||
TLC D,(JUMPA 2,)
|
||
TLNN D,-1
|
||
JRST AUNPA1
|
||
TLC D,(<JUMPA 2,>#<JUMPA 4,>)
|
||
TLNN D,-1
|
||
ERSTRT [SIXBIT /CAN'T UNPATCH AFTER $$^]?/]
|
||
AUNPA2: PUSHJ P,FETCH
|
||
JRST NXERR
|
||
PUSH P,[NLTL2]
|
||
PUSH P,D
|
||
JRST PDEPU
|
||
|
||
AUNPA1: MOVEI W1,50.
|
||
AUNPA3: PUSHJ P,FETCH
|
||
JRST NXERR
|
||
TLC D,(JUMPA 1,)
|
||
TLNN D,-1
|
||
SOJA A,AUNPA2
|
||
SOJL W1,NXERR
|
||
AOJA A,AUNPA3
|
||
|
||
;FIND WHERE THE PATCH AREA STARTS AND SET PATCHL(U) TO
|
||
;LOCATION PATCHED,,PATCH AREA
|
||
PATOPN: MOVE D,[SQUOZE 0,PATCH]
|
||
PUSHJ P,SEVLD
|
||
SKIPA D,[SQUOZE 0,PAT]
|
||
JRST PATOP1
|
||
PUSHJ P,SEVLD
|
||
MOVEI D,50
|
||
PATOP1: HRRZM D,PATCHL(U) ;LOOK UP PATCH, SET RH OF PATCHL(U).
|
||
MOVE A,LLOC ;GET LOCATION OPEN NOW
|
||
HRLM A,PATCHL(U) ;SAVE LOC. PATCHED FROM.
|
||
RET
|
||
|
||
AEPAT3: MOVEI D,1(D)
|
||
HRLI D,(JUMPA 1,)
|
||
PDEP: PUSH P,D
|
||
SETZ B, ;NNL LOOKS AT B.
|
||
PUSHJ P,NNL ;LINE FEED
|
||
MOVE D,(P)
|
||
PDEPU: PUSHJ P,ENWPAT
|
||
HRRZ A,LLOC
|
||
PUSHJ P,DEPRMV ;UPDATE UNDEF SYM REFS FOR LOCATION,
|
||
REST D
|
||
JRST DEP ;STORE IN IT.
|
||
|
||
;$$( - START A LITERAL. USE THE $$( IN A WORD AS IF IT WERE A SYMBOL.
|
||
;DDT WILL PRINT OUT THE NAME OF A TAG THAT IDEFNTIFIES THE LITERAL.
|
||
;AS SOON AS IT CAN SAFELY DO SO, IT WILL OPEN THE PATCH AREA AND
|
||
;ALLOW YOU TO TYPE IN THE CONTENTS OF THE LITERAL.
|
||
N2ALPR: CALL APATCK
|
||
AOS A,LITCNT(U)
|
||
CALL LITSYM ;GENSYM A NAME FOR THE CONSTANT.
|
||
MOVSI C,SYLSYM
|
||
SAVE D ;MAKE IT LOOK LIKE UNEVAL'D SYM TO PRINT IT.
|
||
CALL GSPNT
|
||
CTYPE ")
|
||
REST A ;AND RETURN IT AS UNEVAL'D SYM IN PLACE OF THE $$(.
|
||
MOVSI B,SYLSYM
|
||
MOVEI D,"?
|
||
MOVEM D,LIMBO ;MAKE SURE A "?" FOLLOWS IT SO IT WILL BE AN UNDEF SYM REF.
|
||
SETOM UNRCHF
|
||
RET
|
||
|
||
;COME HERE, WHEN THERE ARE PENDING LITERALS AND WE ARE NOT INSIDE
|
||
;A LITERAL OR A PATCH, TO START THE NEXT PENDING LITERAL.
|
||
LITFIN: PUSHJ P,APATCK ;CHECK WHETHER CAN PATCH THIS JOB.
|
||
CALL PATOPN ;FIND START OF PATCH AREA AND SET PATCHL TO .,,PATCH
|
||
MOVSI D,1
|
||
ADDB D,LITCNT(U)
|
||
HLRZ A,D ;COMPUTE THE NAME WHICH WAS USED FOR THE NEXT PENDING LITERAL
|
||
CALL LITSYM
|
||
MOVEM D,SYM
|
||
HRRZ D,PATCHL(U)
|
||
CALL DEFIN ;DEFINE IT TO BE AT CURRENT START OF PATCH AREA.
|
||
MOVEI W1,SYM
|
||
CALL SPT ;TYPE THE SYMBOL AS THE NAME OF THE WORD NOW BEING OPENED.
|
||
CTYPE "/
|
||
HRRZ D,PATCHL(U)
|
||
CALL PLOC ;SET POINT THERE,
|
||
JRST NTAB2A ;OPEN THAT WORD, THE CONTENTS.
|
||
|
||
;GIVEN A NUMBER NNN IN A, RETURN THE SQUOZE FOR "$LTNNN" IN D.
|
||
LITSYM: CALL SQZ3D
|
||
ADD D,[SQUOZE 0,$LT]
|
||
RET
|
||
|
||
;$$) - END A LITERAL DEFINITION.
|
||
N2ARPR: CALL PATADJ ;SET LLOC TO . OR .-1 ACCORDING TO WHETHER HAD ARG, ETC.
|
||
HRRZ D,LLOC
|
||
HLRZ C,PATCHL(U)
|
||
MOVEM C,LLOC ;(RESTORE . TO VALUE IT HAD WHEN THIS LITERAL WAS LITFIN'D).
|
||
AOJA D,PATCLS ;THEN REDEFINE PAT TO THERE AND SAY NOT INSIDE A PATCH.
|
||
|
||
KVP: SETOM XCRFSW ;:VP - SAY SHOULDN'T TYPE CRLF WHEN PROCEED.
|
||
PUSH P,[PROCDT] ;GO PROCEED AFTER TURN ON TYPEOUT.
|
||
CAIA
|
||
KVK: PUSH P,[NLTL2] ;:VK - GO CRLF AND MAYBE * AFTER TURN ON.
|
||
CAIA
|
||
KV: PUSH P,[LCTGNR] ;:V
|
||
SKIPE INPTR ;TYPED IN ON TTY, TURN ON TYPEOUT.
|
||
SOSGE TTYFLG ;ELSE JUST CANCEL 1 ^W
|
||
SETZM TTYFLG
|
||
POPJ P,
|
||
|
||
; :? -- LIST NAMES OF ALL :-COMMANDS, WITH SHORT DESCRIPTIONS.
|
||
QSN: SYSCLO OPEN,[[2,,FDRC] ? ['DSK,,] ? ['DDT,,]
|
||
[SIXBIT/:CMNDS/] ? ['.INFO.]]
|
||
CALL FDRCO1 ;INITIALIZE FDRC BUFFER FOR FDRCI
|
||
JRST OPRINT ;TYPE OUT THE FILE.
|
||
|
||
KSLEEP: CALL RONUM
|
||
JRST ALTDQX ;RETYPE ":SLEEP " IF RUB OUT OF RONUM.
|
||
SKIPN B
|
||
MOVEI A,15.
|
||
CALL TYOFRC
|
||
CALL HAKKAM ;PROCESS HAKKAH RQ'S, SAY TSINT CAN CALL HAKKAH.
|
||
.SLEEP A,
|
||
SETZM HAKOK ;TSINT CAN'T CALL HAKKAH ANYMORE.
|
||
JRST NLTL4
|
||
|
||
KGAG: PUSHJ P,RONUM
|
||
JRST ALTDQX ;IF RUB BACK OUT OF RONUM, TYPE ":GAG "
|
||
JUMPE B,NXERR
|
||
MOVEM A,GAGF
|
||
KGAG1: MOVE A,GAGF ;PREVENT :SENDS IFF GAGGED OR NOMSG'D.
|
||
IMUL A,NOMSGF ;THAT IS, EITHER GAGF OR NOMSGF IS 0.
|
||
SKIPE A
|
||
.SUSET [.SIMASK,,[%PICLI]]
|
||
SKIPN A
|
||
.SUSET [.SAMASK,,[%PICLI]]
|
||
JRST NLTL4
|
||
|
||
KNOMSG: CALL RONUM ;TURN OFF UNSOLICITED TYPEOUTS SUCH AS
|
||
JRST ALTDQX ;:SENDS, ALARM, SYS GOING DOWN
|
||
MOVEM A,NOMSGF
|
||
SKIPN NOMSGF ;IF THE ARG IS ZERO.
|
||
JRST KGAG1
|
||
SETOM HAKTYP ;WHEN THEY'RE TURNED BACK ON,
|
||
SETOM HAKRQ ;PRINT ANY PENDING MESSAGES.
|
||
JRST KGAG1
|
||
|
||
;; :MAILNT 0 turns off mail notification, :MAILNT 1 turns it on with first-line
|
||
;; printing, and -1 without first-line printing
|
||
kmailnt:
|
||
call ronum ;read a number
|
||
jrst altdqx ; rubbed out!
|
||
movem a,mailnt ;note if we want to know when we get mail, or not
|
||
skipn mailnt ;if the arg is zero.
|
||
jrst hakml1 ; turn off the feature
|
||
syscle OPEN,[ %climm,,dirhc ? [sixbit /DIRHNG/] ? %climm,,0 ? %climm,,0
|
||
hsname] ; get an interrupt on writing on our HSNAME dir
|
||
.suset [.simsk2,,[1_dirhc]] ;enable these interrupts
|
||
syscal rqdate,[ %clout,,mailtm] ;note time of last mail
|
||
setom mailtm
|
||
call malckq ;check for mail now
|
||
.close fdrc, ;no need for the file
|
||
jrst nltl4 ;all done, prompt
|
||
|
||
hakml1: .suset [.samsk2,,[1_dirhc]] ;disable interrupts
|
||
.close dirhc, ;close the channel
|
||
jrst nltl4 ;that's it, return and prompt
|
||
|
||
|
||
;OP TYPES (IN RH(W1)): MSG = 1 SEND = 0
|
||
;MAIL, BUG, MAILA, BUGA, 4.9 SET, AND -1 IN RH.
|
||
;BIT 3.1 ON => MAIL OR BUG, OFF => MAILA OR BUGA.
|
||
;BIT 3.2 ON => MAIL OR MAILA, OFF => BUG OR BUGA.
|
||
;IF BIT 3.2 OFF, BIT 3.3 OFF => DON'T MAIL TO SYS.
|
||
;IF OP=0 (SEND), BIT 3.4 ON => SHOUT, OFF => SEND.
|
||
;(NOTE THAT BUG AND BUGA NO LONGER EXIST, AND MAIL AND MAILA ARE
|
||
; NOW REALLY CALLED OMAIL AND OMAILA. :MAIL NOW RUNS A PROGRAM.
|
||
; :MAILA DOES NOT EXIST).
|
||
|
||
mail: hrloi w1,400003 ;op. type is MAIL
|
||
jrst mail1
|
||
|
||
kshout: movsi w1,10 ;op type is SHOUT
|
||
call sndset ;Set up the buffer, complete with "Message From"
|
||
move a,[440700,,[asciz /Everybody: /]]
|
||
call bugcop ;put "Everybody:" and a terpri into the buffer
|
||
movem c,bufbeg ;remember this as the begining of the buffer
|
||
jrst bgred0 ;gobble the rest of the message
|
||
|
||
send: skipn sndflg ;do we use QSEND instead of send?
|
||
jrst osend ; no, do our own variety
|
||
move b,[sixbit /SEND/]
|
||
movem b,sysn2 ;fake a :SEND not a DDT command
|
||
setom xcrfsw ;an extra crlf would look bad after :SEND FOO<cr>
|
||
jrst actrlk
|
||
|
||
sndhlx: call sndhl1 ;give him help
|
||
ret
|
||
|
||
osend: setz w1, ;op. type is send.
|
||
send0: call buglog ;maybe say (LOGIN?)
|
||
movei a,sndhl1 ;routine to call to provide help
|
||
movem a,hlprtn
|
||
send01: call rmtoke ;read user @ machine.
|
||
camn b,[sixbit /?/] ;is he wanting help?
|
||
jrst [ call sndhl1 ;give him help
|
||
7type [asciz /A:SEND /]
|
||
call tyofrc ;be sure he sees the output
|
||
jrst send01]
|
||
setz c,
|
||
came a,itsnam ;If same machine,
|
||
skipn a ; or if no @ machine
|
||
movsi c,'CLI ; use CLI device
|
||
jumpn c,sendx ;otherwise
|
||
move c,[sixbit / CLI /]
|
||
add c,a
|
||
sendx: movem c,clidev ;use MLCLI device
|
||
movem b,clufn1 ;remember who we're sending to.
|
||
movem a,malits ;Remember if any machine specified
|
||
call bugsnd ;detect attempt to send to user who can't receive
|
||
jrst sendm ;and change to mail instead using qmail.
|
||
call sndset ;set up the buffer for a send
|
||
movem c,bufbeg ;remember this as the start of the buffer
|
||
jrst bgred0 ;gobble down a message
|
||
|
||
;;; create and set up the buffer with the "Message from" line
|
||
|
||
sndset: call vpaget ;get the buffer page to hack
|
||
move a,[[asciz /<2F>Message from /],,vpagad]
|
||
blt a,vpagad+2 ;Set up the message beginning in the buffer
|
||
move c,[010700,,vpagad+2] ;Start pointing from there
|
||
call msgnam ;put this user's UNAME in the buffer
|
||
call bugspc ;space over one
|
||
call sndtim ;put the time in the buffer
|
||
move a,[440700,,[asciz /]
|
||
/]]
|
||
call bugcop
|
||
setom tyisnd ;tell TYI and friends to let ^V and ^W through
|
||
ret
|
||
|
||
;; copy from pointer to asciz string in A down ptr in C. Clobbers B
|
||
|
||
bugcop: ildb b,a ;grab a char
|
||
jumpe b,cpopj ;end of the string?
|
||
idpb b,c ;nope, send it along
|
||
jrst bugcop
|
||
|
||
maila: hrloi w1,400002 ;op. type is MAILA
|
||
mail1: call buglog ;Maybe say (LOGIN?)
|
||
call rmtoke ;read <user>@<machine>
|
||
movem b,clufn1 ;remember who we're sending to.
|
||
movem a,malits ;Remember if any machine specified
|
||
setom unrchf ;put char terminating user name in mail.
|
||
call vpaget ;get a fresh page to buffer the message.
|
||
move c,[010700,,vpagad-1]
|
||
|
||
mail2: movem c,bufbeg ;Remember this
|
||
call msgnam ;put this user's UNAME in buffer.
|
||
call bugdat
|
||
movei a,40 ;separate the frobs by a space
|
||
idpb a,c
|
||
call bugtim
|
||
movei a,^M ;terpri now
|
||
idpb a,c
|
||
movei a,^J
|
||
idpb a,c
|
||
bgred0: setom buggsc ;note we don't want the :SEND FOO printed
|
||
call bgread
|
||
jrst [call vpagrt ? jrst nltl4] ;flush buffer and re-prompt
|
||
jrst bugdon ;Send the message!
|
||
|
||
;;; BGREAD is the multiple-line edited reading routine
|
||
bgread: setom tyisnd ;tell TYI that we want ^V and ^W to come through
|
||
setzm bughed ;we haven't seen a header yet...
|
||
setom tthelp ;let [HELP] through
|
||
|
||
call rin ;get a character
|
||
jrst rubfls ; rubout! Abort back to last fail point
|
||
|
||
cain d,^Q ;Quote?
|
||
jrst bgquot
|
||
|
||
cain d,"? ;does he want help?
|
||
skipn morwarn ; If he's a winner, he probably was just typing ?
|
||
caia ; no help
|
||
jrst sndhlp ; yes, give him help
|
||
|
||
skipn toktrm ;ended in space, and
|
||
caie d,^M ; now we get a [RETURN] ?
|
||
jrst bugrd2 ; no, just use the character as is, else get new one
|
||
|
||
bugrd: call rin ;now read in the message.
|
||
jrst bugrub ;rin doesn't skip iff rubout.
|
||
bugrd2: cain d,^Q ;Quote?
|
||
jrst bgquot
|
||
caie d,^_
|
||
cain d,^C
|
||
jrst bugxt2 ;^_ or ^C => end of message.
|
||
cain d,^Z
|
||
jrst bugxit ;save the text!
|
||
cain d,^L
|
||
jrst bugff ;^L => retype buffer's contents.
|
||
cain d,^W
|
||
jrst hakwrd ;^W => Kill word
|
||
cain d,^U
|
||
jrst killin ;^U => Kill line
|
||
cain d,^R
|
||
jrst bugprl ;^R => Reprint line
|
||
cain d,^K
|
||
jrst bugvt ;^K => Reprint buffer without clear-screen
|
||
cain d,^T
|
||
jrst bugtog ;^T => Switch last two characters
|
||
cain d,%txtop+"H ;[HELP] ?
|
||
jrst sndhlp ; yes, give help
|
||
skipe a,rubsav ;is there stuff to save?
|
||
call kilcpy ; Yes, copy it to the kill buffer
|
||
setzm rubsav ;ordinary char, flush any saved rubout position
|
||
cain d,^Y
|
||
jrst rbundo ;^Y => Undo last deletions
|
||
|
||
bugrd1: call bugrdx ;normally, characters just go into the buffer
|
||
jrst bugrd
|
||
|
||
bugrdx: movei b,(c)
|
||
cain b,vpagad+1777
|
||
jrst [ 7type bufful
|
||
jrst bugrd]
|
||
IDPB D,C ;OTHER CHARS GO INTO BUFFER.
|
||
CAIE D,^I
|
||
CAIN D,^J ;SYSTEM DOESN'T ECHO ^I, ^J
|
||
PUSHJ P,TOUT ;SO ECHO THEM NOW.
|
||
CAIE D,^M
|
||
ret
|
||
MOVEI D,^J ;AFTER ^M, PUT IN A ^J.
|
||
IDPB D,C
|
||
ret
|
||
|
||
bgquot: ctype ": ;Prompt for a character
|
||
call rin ;read in a character
|
||
movei d,177 ; Rubout is a rubout!
|
||
cain d,%txtop+"H ;Help?
|
||
jrst sndhlp ; Yes, can't insert non-ascii into the buffer!
|
||
caie d,^L ;Unless it's a ^L,
|
||
jrst bugrd1 ; just insert the character
|
||
call bugrdx ;^L's get inserted, but since they also cleared the
|
||
jrst bugff ;screen, we must retype as well
|
||
|
||
bufful: asciz / (BUFFER FULL) /
|
||
|
||
bugtog: camn c,bufbeg ;if it's at the beginning of the buffer
|
||
jrst bugrd ; do nothing
|
||
ldb d,c
|
||
move a,c ;copy our Byte Pointer
|
||
call bugbka ;previous char
|
||
ldb b,a ;now we have the characters involved
|
||
dpb b,c ;first in second spot
|
||
dpb d,a ;second in first spot
|
||
skipe erase ;if we can erase the ^T and old chars
|
||
7type [ asciz /XXXX/] ;do so
|
||
push p,b ;remember the second character
|
||
call tout ;type the characters
|
||
pop p,d ;in their new order
|
||
call tout
|
||
jrst bugrd ;and on with the shew!
|
||
|
||
sndhlp: call sndhl1 ;give the help
|
||
setom bughed ;pretend we saw the header
|
||
jrst bgprl0 ;retype the line and gobble more characters
|
||
|
||
sndhl1: call terpri
|
||
syscal open,[ %clbit,,.bai ? %climm,,fdrc ? [sixbit /DSK/]
|
||
[sixbit /DDT/] ? [sixbit /:SEND/] ? [sixbit /.INFO./]]
|
||
jrst [ 7type [asciz /Help file missing, sorry./]
|
||
jrst bgprl0] ; Retype the line and continue
|
||
call fdrco1 ;initialize buffering
|
||
call ctlf1 ;print the file
|
||
call tyofrc ;be sure he sees the output!
|
||
ret
|
||
|
||
bugxit: move a,bufbeg ;start of buffer
|
||
camn a,c ;are we at the start of the buffer?
|
||
jrst nltl2 ; yes, nothing to save!
|
||
call kilcop ;copy the buffer into the kill buffer
|
||
setzm rubsav
|
||
7type [asciz /A(Message copied into kill buffer)
|
||
/]
|
||
|
||
movei d,^Z ;note we exited with a ^Z
|
||
caia
|
||
bugxt2: aos (p) ; skip return for successful BUGREAD
|
||
setzm rubsav ;No more saved rubout position
|
||
setzm tyisnd ;^V and ^W go back to normal now
|
||
setzm tthelp ;[HELP] gets turned into a ? again
|
||
setzm buggsc ;next time we won't ignore GSOC buffer unless set again
|
||
setzm hlprtn ;SEND helper no longer useful
|
||
popj p,
|
||
|
||
|
||
;; KILCOP copies into the kill buffer
|
||
;; it takes the Byte pointer to copy from in A, the end Byte pointer in C,
|
||
;; and clobbers A and B.
|
||
;; KILCPY copies between the Byte pointer in C and the Byte Pointer in RUBSAV
|
||
;; into the kill buffer.
|
||
|
||
kilbln==10 ;block size of kill buffer
|
||
|
||
kilcpy: move a,c ;
|
||
save c ;we'll use the saved end as our C
|
||
save d
|
||
move c,rubsav
|
||
call kilcop ;save it away
|
||
rest d
|
||
rest c
|
||
ret
|
||
|
||
kilcop: move b,klbbeg ;find the start of the kill buffer
|
||
kilcp1: camn a,c ;unless we're at the end
|
||
ret
|
||
camn b,klbend ;is it the end of the buffer?
|
||
call kilhol ; yes, get more space
|
||
ildb d,a ;move the character
|
||
idpb d,b ;into the kill-buffer
|
||
movem b,klbipt ;remember how far we've gotten!
|
||
jrst kilcp1
|
||
|
||
kilhol: save a
|
||
save c ;HOLE0 would clobber C
|
||
save w1
|
||
save klbbeg ;these 3 don't move
|
||
save klbipt
|
||
movsi a,-kilbln ;allocate kilbln more words
|
||
movei w1,kilbpt
|
||
call hole0 ;make more room
|
||
rest klbipt
|
||
rest klbbeg
|
||
rest w1
|
||
rest c
|
||
rest a
|
||
ret
|
||
|
||
bugrub: camn c,bufbeg ;If we try to rub out past the beginning
|
||
jrst rubfls ; handle that by aborting back to last GSOA point
|
||
ldb d,c ;get the char
|
||
call bugrb1 ;rub out a character
|
||
jrst bugrd ;and on with the show!
|
||
|
||
;;bugrb1 handles doing the rubout of any character
|
||
bugrb1: call bugbak ;back up the pointer
|
||
cain d,^J ;LF ?
|
||
jrst brublf ; Check it for stray, then hack EOL
|
||
skipn erase ;Erasable?
|
||
jrst toutec ; on others, must just echo the rubbed character.
|
||
|
||
cain d,^I ;Tab?
|
||
jrst hakln1 ; Tab's we gotta re-type the line
|
||
cain d,33 ;altmode?
|
||
jrst ntsail ; Not sail, so just ^PX
|
||
cail d,40 ;Control?
|
||
cain d,177 ; rubout
|
||
jrst mbsail ; Might be sail, check it out
|
||
|
||
ntsail: 7type [asciz /X/] ;flush it from the screen
|
||
ret ;and that's that
|
||
|
||
bugbak: add c,[70000,,] ;back up the buffer pointer.
|
||
jumpge c,cpopj
|
||
sub c,[430000,,1]
|
||
ret
|
||
|
||
bugbka: add a,[70000,,] ;back up the buffer pointer.
|
||
jumpge a,cpopj
|
||
sub a,[430000,,1]
|
||
ret
|
||
|
||
mbsail: syscal ttyget,[%climm,,tyoc ? %clout,,b ? %clout,,b ? %clout,,ttysts]
|
||
erloss ;Gotta find out the CURRENT state of sailification
|
||
move b,ttysts
|
||
tlne b,%tssai ;Do sail chars exist?
|
||
jrst hakln1 ; Yes, retype line to be sure to get it right
|
||
7type [asciz /XX/] ;No, just rubout two char positions
|
||
ret ;and it's gone!
|
||
|
||
hakln1: skipe erase
|
||
7type [asciz /HL/] ;yes, start on this
|
||
skipn erase ;line, otherwise
|
||
call crf ; terpri
|
||
hakln0: call fndlin ;find beginning of this line
|
||
call bugff1 ;and redisplay this line
|
||
ret ;and that's it!
|
||
|
||
hakwrd: skipn rubsav ;unless there's already a saved position
|
||
movem c,rubsav ;restore this one
|
||
skipe erase ;if it's erasable
|
||
7type [asciz /XX/] ;rubout out the ^W
|
||
caia ;and enter the loop in the middle!
|
||
hakwd1: call bugrb1 ;rub it out
|
||
camn c,bufbeg ;if we're at the beginning
|
||
jrst bugrd ; that's it, just read!
|
||
ldb d,c ;check the previous char
|
||
call alphap ;is it alphabetic?
|
||
jrst hakwd1 ; no, keep hacking
|
||
|
||
hakwd2: call bugbak ;back up the pointer
|
||
skipe erase ;if it's erasable
|
||
7type [asciz /B/] ;alphapbetic, back over it
|
||
camn c,bufbeg ;if we're at the beginning
|
||
jrst hakwd9 ; that's it, just read!
|
||
ldb d,c ;is this alphabetic?
|
||
call alphap
|
||
caia ; Not alphabetic...
|
||
jrst hakwd2 ;keep looking for one that's not
|
||
|
||
hakwd9: skipe erase ;if it's erasable
|
||
7type [asciz /L/] ;flush the whole word at once!
|
||
skipn erase ;otherwise
|
||
jrst bgprl0 ; print the rest of this line
|
||
jrst bugrd ;and return to reading!
|
||
|
||
alphap: caie d,"' ;' is part of words too
|
||
cain d,"| ; a funny "alphabetic", nice for typeing LISP atoms
|
||
jrst popj1
|
||
caig d,"z ;if it's > "z, it can't be
|
||
caige d,"0 ; similarly it can't be less than a digit
|
||
ret
|
||
caige d,"a ;If it's > "a, it must be OK
|
||
caig d,"9 ; similarly, if it's a digit
|
||
jrst popj1
|
||
cail d,"A ;If i'ts less than a letter
|
||
caile d,"Z ; or greater
|
||
ret ; it isn't alphabetic
|
||
jrst popj1 ;otherwise, it is.
|
||
|
||
killin: skipn rubsav ;unless there's already a saved position
|
||
movem c,rubsav ; remember this one
|
||
camn c,bufbeg ;if we're already at the beginning
|
||
jrst kiln9 ; then just flush the character (if possible)
|
||
ldb d,c ;check the preceeding character
|
||
call bugbak ;and back over it
|
||
cain d,^J ;LF ?
|
||
call brublf ; yes, make it go away
|
||
call fndlin ;find the beginning of this line
|
||
move c,a ;and make that our real position
|
||
skipe erase ;If it's erasable
|
||
7type [asciz /HL/] ;clear the line
|
||
skipn erase ;otherwise
|
||
call crf ;can't clear, pretend by going to a fresh line
|
||
jrst bugrd ;and continue reading
|
||
|
||
kiln9: skipe erase ;if it's erasible
|
||
7type [asciz /XX/] ;just wipe out the chars
|
||
skipn erase ;otherwise
|
||
call terpri ; just get a fresh line
|
||
jrst bugrd ;and continue reading
|
||
|
||
;; hack a LF. Check to see if the preceeding char is a CR, if so, flush it
|
||
;; too.
|
||
|
||
brublf: skipe erase ;if it's erasable
|
||
7type [asciz /SHLR/] ;Kill any cruft on this line
|
||
skipn erase ;too. This can happen if the cursor isn't where you
|
||
call terpri ;expect, or after typing a ^U that is echoed at the
|
||
;beginning of the line.
|
||
ldb d,c ;get preceeding character
|
||
cain d,^M ;Is it a legitimate TERPRI?
|
||
jrst brubcr ; yes, hack that
|
||
7type [asciz /UL/] ;No, just move back up, if possible
|
||
ret ;and that's it
|
||
|
||
brubcr: call bugbak ;back up over the CR as well
|
||
move b,ttyopt ;can this move up?
|
||
tlne b,%tomvu ;if so,
|
||
7type [asciz /UHL/] ;move up to beginning of previous line
|
||
tlnn b,%tomvu ;otherwise
|
||
7type [asciz /A/] ;just be sure to start on a fresh line
|
||
jrst hakln0 ;and retype the line
|
||
|
||
|
||
;; FNDLIN returns in A a Byte Pointer to the beginning of this line
|
||
fndlin: move a,c ;copy the Byte pointer
|
||
fndln0: ldb d,a ;check a char
|
||
call bugbka ;back up A
|
||
cain a,bufbeg ;Is it to the beginning of the buffer?
|
||
ret ; yes, that's the beginning of this line
|
||
caie d,^J ;is it a LF?
|
||
jrst fndln0 ; no, try the next one
|
||
ldb d,a ;yes, check for a CR
|
||
caie d,^M ;is it a real live terpri?
|
||
jrst fndln0 ; no, keep hunting
|
||
ibp a ;yes, point after the LF
|
||
ret ;and that's it!
|
||
|
||
;;; Reprint the current line on a ^R
|
||
bugprl: skipe erase ;if erasible
|
||
7type [asciz /HL/]
|
||
skipn erase ;otherwise terpri
|
||
bgprl0: call terpri ;Can't get away with it, just terpri instead
|
||
call fndlin ;find the beginning of the line
|
||
call bugff1 ;and type out from there
|
||
jrst bugrd
|
||
|
||
rbundo: skipe erase ;can this TTY be erased?
|
||
jrst [ 7type [asciz /XX/] ;it's ^PX'able
|
||
jrst rbund1] ;so we take the easier way out
|
||
call fndlin ;otherwise we retype the line
|
||
call terpri ;on a fresh one
|
||
call bugff1 ;so we avoid the echoed ^Y
|
||
|
||
rbund1: skipe rubsav ;if there is a saved position
|
||
jrst [ move a,c ; remember where we started from
|
||
move c,rubsav ; simply unsave it
|
||
setzm rubsav ; clear it out
|
||
call bugff1 ; display between here and there
|
||
jrst bugrd] ; and continue reading
|
||
move a,klbbeg ;start at the beginning of the kill buffer
|
||
camn a,klbipt ;is there no kill data?
|
||
jrst [ ctype 7 ; nope, beep at him!
|
||
jrst bugrd] ; and on with the show.
|
||
rbund5: camn a,klbipt ;are we at the end?
|
||
jrst bugrd ;yes, back to reading
|
||
ildb d,a ;get it
|
||
call tout ;type it
|
||
movei b,(c) ;check our output pointer
|
||
cain b,vpagad+1777 ;are we at the end?
|
||
jrst [ 7type bufful ; yes, complain
|
||
jrst bugrd] ; and back to reading
|
||
idpb d,c ;put the character in the buffer
|
||
jrst rbund5 ;and hack the next character.
|
||
|
||
bugvt: 7type [asciz /XXA/] ;flush ^K, so we mightn't need new line
|
||
;^L clears the screen, so ^K must add a TERPRI
|
||
bugff: setom bughed ;Note that we've printed the header
|
||
skipn buggsc ;do we have stuff from before this processing that
|
||
call gsocff ; wants to be displayed?
|
||
move a,[010700,,vpagad-1] ;Start at the beginning of the buffer
|
||
skipn getty ;and terpri first if this is is a paper TTY
|
||
call terpri
|
||
call bugff1 ;redisplay it up to the end
|
||
jrst bugrd ;and read some more
|
||
|
||
bugff1: skipn bughed ;have we never seen the header?
|
||
came a,bufbeg ; and is it the first line?
|
||
caia ; one of them not true
|
||
jrst [ skipn erase ;Is this a display?
|
||
jrst .+1 ; No, so assume it's still visible.
|
||
move a,ttyopt ;Both true
|
||
tlne a,%tomvu ;if the terminal can move up
|
||
skipn toktrm ; And the :SEND was terminated with CR
|
||
caia
|
||
7type [asciz /UL/] ; Then move up to that line
|
||
move a,[010700,,vpagad-1]
|
||
setom bughed ; had to have seen it now
|
||
jrst .+1]
|
||
camn a,c ;If this is at the beginning don't do a thing
|
||
ret
|
||
ildb d,a ;check out the first character
|
||
camn a,[350700,,vpagad] ;If this is the first char of the buffer
|
||
caie d,177 ; and if it's not a rubout
|
||
call tout ; type it
|
||
bugff2: camn a,c ;When we get to the real input pointer
|
||
ret ; we're all done
|
||
ildb d,a
|
||
call tout ;else retype the next.
|
||
jrst bugff2
|
||
|
||
BUGDON: PUSH P,[NLTL2] ;WHEN FINISHED, TYPE STAR
|
||
PUSH P,[VPAGRT] ;AFTER FREEING BUFFER PAGE.
|
||
TLNE W1,10
|
||
JRST KSHOU1 ;SHOUT IS SPECIAL.
|
||
;KSHOUT CALLS BACK HERE. THIS ROUTINE MAY SKIP IFF W1 INDICATES OPERATION IS "SHOUT".
|
||
BUGDO2: CAMN C,[010700,,VPAGAD-1]
|
||
JUMPLE W1,BUGCLS ;(NULL SENDS WOULD HANG TARGET DDT)
|
||
BUGDO3: MOVE B,[1,,UTOC]
|
||
SETZM FDRCIP
|
||
JUMPL W1,BUGDM ;FOR MAIL, MUST FIGURE OUT WHICH DEVICE TO WRITE ON.
|
||
.CALL BUGOPO ;OPEN OUTPUT FILE.
|
||
JRST BUGDO4 ;DECODE FAILURE REASON, MAYBE TRY AGAIN.
|
||
BUGDO1: MOVE A,[010700,,VPAGAD-1]
|
||
bugout: save a ;remember the starting address
|
||
call charad ;Get character address
|
||
move d,b ;remember this
|
||
move a,c ;calculate the final address
|
||
call charad
|
||
sub b,d ;and get final count
|
||
rest a ;B has count, A has Byte Pointer to start
|
||
syscle SIOT,[%climm,,utoc ? a ? b] ;so send out the characters!
|
||
|
||
BUGCLS: JUMPGE W1,BUGCL1 ;FOR MAIL, MAILA, BUG, BUGA,
|
||
.IOT UTOC,[^_] ;FOLLOW THE MSG BY A ^_ AND A CRLF.
|
||
TLNE W1,1 ;FOR MAIL AND BUG (NOT MAILA), PUT CRLF AFTER THE ^_
|
||
CALL BUGA3 ;(FOR MAILA, ASSUME THERE ALREADY IS ONE).
|
||
PUSHJ P,BUGCPY ;COPY OVER REST OF MAIL.
|
||
SYSCAL RENMWO,[%CLIMM,,UTOC ? CLUFN1 ? ['MAIL_14]]
|
||
JFCL
|
||
BUGCL1: .CLOSE UTOC,
|
||
.CLOSE FDRC,
|
||
popj p,
|
||
|
||
|
||
|
||
|
||
BUGDO4: .STATUS UTOC,D ;COME HERE ON FAILURE OPENING CLI:
|
||
LDB D,[OPNLBP,,D]
|
||
CAIE D,%EFLDR ;IF THIS FAILURE IS ONE OF THOSE LIKELY TO BE TEMPORARY,
|
||
CAIN D,%ENAFL
|
||
CAIA ;WAIT A WHILE AND TRY AGAIN.
|
||
JRST [ ;IF IT IS PROBABLY PERMANENT,
|
||
CAME W1,[10,,] ;IF NOT SHOUTING, TURN INTO :MAIL.
|
||
JRST SNDMAL
|
||
JRST POPJ1] ;IF SHOUTING, GIVE UP ON THIS GUY. SKIP-RET FROM BUGDO2.
|
||
MOVEI D,60.
|
||
.SLEEP D,
|
||
JRST BUGDO3
|
||
|
||
;HANDLE CASE THAT USER LOGS OUT OR GAGS WHILE A :SEND TO HIM IS BEING TYPED IN.
|
||
SNDMAL: HLRE D,CLUFN1
|
||
AOSN D
|
||
ERSTRT [SIXBIT/TARGET VANISHED?/]
|
||
7TYPE [ASCIZ/ (Mail)/]
|
||
SYSCLO OPEN,[[.UAO,,UTOC] ? ['DSK,,] ? [SIXBIT/MAIL/] ? [SIXBIT/>/] ? ['.MAIL.]]
|
||
SAVE C
|
||
SAVE TOUTXQ ;WRITE A FILE .MAIL.;MAIL > THAT LOOKS LIKE
|
||
MOVE D,[.IOT UTOC,D] ;FROM:R"<SENDER>
|
||
MOVEM D,TOUTXQ ;CLAIMED-FROM:<XUNAME>
|
||
7TYPE [ASCIZ/FROM:Q"/] ;FROM-JOB:HACTRN (OR WHATEVER).
|
||
MOVE D,RUNAME ;TO:"<TARGET>
|
||
CALL SIXTYP ;TEXT;-1
|
||
MOVE D,XUNAME ;<TEXT OF MESSAGE>
|
||
CAMN D,RUNAME
|
||
JRST SNDMA1
|
||
7TYPE [ASCIZ /
|
||
CLAIMED-FROM:/]
|
||
CALL SIXTYP
|
||
SNDMA1: 7TYPE [ASCIZ /
|
||
FROM-JOB:/]
|
||
.SUSET [.RJNAME,,D]
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ/
|
||
TO:"/]
|
||
SKIPN D,CLUXUN
|
||
MOVE D,CLUFN1
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ/
|
||
TEXT;-1
|
||
/]
|
||
REST TOUTXQ
|
||
REST C
|
||
move a,bufbeg ;start at the beginning of user text
|
||
jrst bugout ;and output the buffer
|
||
|
||
;HANDLE A :SEND TO SOMEONE WHO IS NOT INITIALLY PRESENT ON-LINE.
|
||
SENDM: HLRE D,CLUFN1 ;DON'T CHANGE TO :MAIL IF TARGET NAME
|
||
AOSN D ;STARTS WITH "___".
|
||
ERSTRT [SIXBIT/NOT ON-LINE?/]
|
||
7TYPE [ASCIZ/(Mail) /]
|
||
CALL GSOD ;RE-PROCESS THE STRING "SEND FOO ", AS IF AFTER A RUBOUT,
|
||
HRRZ A,GSCHRA ;EXCEPT REPLACE "SEND" BY "MAIL", SO TS MAIL WILL RUN.
|
||
MOVE B,[ASCII/MAIL /]
|
||
MOVEM B,1(A) ;ALSO DEPOSIT IN THE USER'S XUNAME, IF KNOWN, IN PLACE OF THE UNAME
|
||
HRLI A,010700 ;SINCE WHILE YOU MIGHT SEND TO THE UNAME YOU WANT TO MAIL TO XUNAME.
|
||
aos a
|
||
MOVEM A,GSCHRP
|
||
SAVE TOUTXQ ;SET UP TOUTXQ TO MAKE TYPEOUT DEPOSIT IN THE COMMAND STRING BUFFER.
|
||
MOVE A,[IDPB D,GSCHRP]
|
||
MOVEM A,TOUTXQ
|
||
SKIPN D,CLUXUN
|
||
MOVE D,CLUFN1
|
||
CALL SIXTYP ;TYPE THE XUNAME AND A SPACE INTO THE BUFFER.
|
||
CALL TSPC
|
||
REST TOUTXQ
|
||
MOVE A,GSCHRP ;NOW GO REPROCESS THAT COMMAND.
|
||
JRST SLRPD4
|
||
|
||
BUGCPY: SKIPN FDRCIP ;COPY OLD FILE IF IT'S OPEN.
|
||
POPJ P,
|
||
BUGCP1: CALL FDRCI ;READ 1 CHAR FROM BUFFERED FDRC.
|
||
RET ;EOF MEANS ENTIRE INPUT FILE HAS BEEN COPIED.
|
||
CAIN D,^L ;IGNORE ^L'S IN OLD FILE.
|
||
JRST BUGCP1
|
||
.IOT UTOC,D
|
||
JRST BUGCP1
|
||
|
||
;OPEN THE DESIRED FILE FOR COMMAND TYPE IN W1,
|
||
;THE NAMES ARE CORRECT FOR THE OUTPUT OPEN AT BUGDO3.
|
||
;B SHOULD HAVE <MODE>,,<CHANNEL>.
|
||
BUGOPO: SETZ ? SIXBIT/OPEN/
|
||
B ? bugdev+1(W1)
|
||
CLUFN1 ? ['_MAIL'_ ? 'HACTRN ? '>_36]+1(W1)
|
||
SETZ ['.MSGS.] ;(SNAME USED ONLY IF DEV IS DSK)
|
||
|
||
;COME HERE FROM BUGDON, FOR MAIL.
|
||
bugdm: move b,clufn1 ;for this user
|
||
push p,c ;C has final pointer, can't clobber it
|
||
move c,malits ;on the ITS specified, if any....
|
||
call opmail ;find out where his mail lives.
|
||
sysclo open,[[.uao,,utoc] ? c ? [sixbit/_MAIL_/] ? [sixbit /OUTPUT/]
|
||
a]
|
||
bugopn: syscal open,[ %clbit,,.bai ? %climm,,fdrc ? c ? b ? [sixbit /MAIL/] ? a
|
||
%clerr,,d]
|
||
jrst [ caie d,%ensfl ; No such file?
|
||
opner @bugopn ; No, it's something worse, might lose
|
||
; data if we proceed
|
||
pop p,c ; Reccover our final pointer
|
||
jrst bugdo1] ; No such file is OK.
|
||
pop p,c ;recover our final pointer
|
||
call fdrco1 ;initialize the input buffer
|
||
tlnn w1,1 ;and it's MAILA, read and copy part of the old file.
|
||
call buga0
|
||
jrst bugdo1
|
||
|
||
;COME HERE FOR :SHOUT, AFTER READING IN THE MESSAGE.
|
||
;SCAN THROUGH THE TTY FILE DIRECTORY FINDING ALL THE USERS,
|
||
;AND SEND TO EACH ONE.
|
||
KSHOU1: .OPEN FDRC,['TTY ? '.FILE. ? '(DIR')_6]
|
||
JRST KSHOU1 ;FAILS => MUST BE DO DIR. CHANNELS AVAIL.
|
||
MOVE I1,[10,,'USR] ;SET UP TO DO .OPEN I1 LATER.
|
||
MOVE I3,['HACTRN] ;UNAMES WILL BE CONSTRUCTED IN I2.
|
||
.IOT FDRC,D
|
||
CAIE D,"T ;FIND THE "TTY USER JOB ..." LINE.
|
||
JRST .-2
|
||
;HERE TO PROCESS NEXT LINE OF DIRECTORY. NOTE THIS SKIPS THE FIRST, IRRELEVANT LINE.
|
||
KSHOU2: .IOT FDRC,D ;FIND START OF NEXT LINE.
|
||
CAIN D,^L
|
||
RET
|
||
CAIE D,^J
|
||
JRST KSHOU2
|
||
.IOT FDRC,D
|
||
CAIN D,^L
|
||
RET ;LINE FOLLOWED BY FF => WHOLE DIR HAS BEEN HANDLED.
|
||
CAIE D,"T ;LINE DOESN'T START WITH "T" => EITHER IT IS
|
||
JRST KSHOU2 ;A DEVICE, NOT A CONSOLE, OR IT IS ONE OF THE TWO
|
||
;UNINTERESTING LINES AT THE BOTTOM.
|
||
.IOT FDRC,D ;IT'S AN INTERESTING LINE, SO SKIP
|
||
.IOT FDRC,D ;THE REST OF THE TTY NUMBER.
|
||
.IOT FDRC,D
|
||
MOVE A,[440600,,I2]
|
||
KSHOU3: .IOT FDRC,D ;BUILD THE UNAME AS SIXBIT IN I2.
|
||
IDPB D,A
|
||
TLNE A,770000 ;READ EXACTLY 6 CHARS.
|
||
JRST KSHOU3
|
||
XOR I2,[404040,,404040] ;FINISH CONVERTING ASCII TO 6BIT.
|
||
CAMN I2,RUNAME ;DON'T SEND TO SELF - THAT'S DANGEROUS.
|
||
JRST KSHOU2
|
||
.IOPUS FDRC,
|
||
.OPEN FDRC,I1
|
||
JRST KSHOU4 ;USER HAS NO HACTRN => GIVE UP ON HIM.
|
||
.USET FDRC,[.RMASK,,A]
|
||
TRNN A,%PICLI
|
||
JRST KSHOU4 ;USER IS GAGGED => GIVE UP ON HIM.
|
||
MOVEM I2,CLUFN1
|
||
CALL BUGDO2 ;OTHERWISE, SEND IT TO HIM.
|
||
CAIA ;SUCEEDED.
|
||
JRST KSHOU5 ;FAILED TO OPEN CLI:
|
||
CALL KSHOU6 ;TYPE HIS NAME SO USER CAN FOLLOW PROGRESS.
|
||
KSHOU4: CALL TYOFRC
|
||
.IOPOP FDRC, ;LOOK FOR NEXT GUY TO SEND IT TO.
|
||
JRST KSHOU2
|
||
|
||
KSHOU5: CTYPE "(
|
||
CALL KSHOU6
|
||
7TYPE [ASCIZ/failed) /]
|
||
JRST KSHOU4
|
||
|
||
;PRINT 6BIT WORD IN CLUFN1 AND SPACE, AND FORCE OUT. CLOBBERS D.
|
||
KSHOU6: SAVE C
|
||
MOVE D,CLUFN1
|
||
CALL SIXTYP
|
||
CALL TSPC
|
||
JRST POPCJ
|
||
|
||
;FOR BUGA, MAILA, READ THRU OLD FILE TILL END OF PREVIOUS NOTE,
|
||
;COPYING INTO NEW FILE. DON'T COPY THE ^_ AFTER THE NOTE.
|
||
BUGA1: CAIN B,40 ;WAS THIS ENTRY THE RIGHT ONE?
|
||
JRST BUGA3 ;YES, RETURN, PUTTING IN A CRLF (BETWEEN NEW MSG AND OLD).
|
||
.IOT UTOC,[^_] ;NO, COPY THE ^_
|
||
BUGA0: MOVE A,[010700,,VPAGAD-1] ;THE ACTUAL ENTRY POINT.
|
||
SETO B, ;DON'T KNOW WHETHER NEXT NOTE'S THE ONE.
|
||
BUGA2: CALL FDRCI
|
||
JRST [ SETZM FDRCIP ;EOF MEANS DON'T TRY, LATER, TO COPY THE REST.
|
||
RET]
|
||
CAIN D,^_ ;NOTE ENDS BEFORE SENDER'S NAME =>
|
||
JRST BUGA1 ;PASS IT BY.
|
||
CAIN D,^L
|
||
JRST BUGA2 ;IGNORE ^L IN MAIL FILES.
|
||
.IOT UTOC,D ;ELSE COPY THE CHAR INTO OUTPUT FILE,
|
||
JUMPE B,BUGA2 ;THIS NOT THE ONE => JUST COPY IT.
|
||
CAIE D,^M
|
||
CAIN D,^J ;JUST COPY CR AND LF - THEY DON'T AFFECT THE DECISION.
|
||
JRST BUGA2
|
||
CAIN B,40
|
||
JRST BUGA2 ;THIS CERTAINLY THE NOTE => COPY IT.
|
||
CAMN A,C ;OUR UNAME SHORTER THAN THEIRS => NOT THE ONE.
|
||
JRST BUGA2
|
||
ILDB B,A ;ELSE COMPARE THE NEXT CHARS OF EACH.
|
||
CAIE B,(D)
|
||
SETZ B, ;MISMATCH => THIS ISN'T THE NOTE.
|
||
JRST BUGA2
|
||
|
||
BUGA3: .IOT UTOC,[^M] ;PUT A CRLF INTO THE OUTPUT MAIL FILE
|
||
.IOT UTOC,[^J]
|
||
RET
|
||
|
||
|
||
;:MSG <TOPIC> <MESSAGE> ^C.
|
||
KOMSG: .RDATE D,
|
||
AOJE D,NDATER ;MSGS FILE MUST HAVE A DATE.
|
||
MOVEI W1,1 ;OP. TYPE IS 1 FOR MSG.
|
||
JRST MAIL1
|
||
|
||
;skip unless this is a :SEND to a user who is gagged or not logged in.
|
||
|
||
bugsnd: jumpn w1,popj1 ;do nothing if not send.
|
||
skipn a
|
||
move a,ITSNAM
|
||
call mchokp
|
||
jfcl
|
||
setzm cluxun ;xuname corresponding to the uname is not known.
|
||
move d,a
|
||
add d,[sixbit / USR /]
|
||
camn a,itsnam ;if this is the same ITS
|
||
movsi d,(sixbit /USR/) ;just use USR instead
|
||
syscal OPEN,[ %clbit,,.uii\40 ;open as foreign only
|
||
%climm,,fdrc ? d ? clufn1 ? [sixbit /HACTRN/]]
|
||
ret ;he has no hactrn.
|
||
came a,itsnam ; if we aren't on the same machine, assume
|
||
jrst popj1 ; OK, since we can't check for gaggedness
|
||
.USET FDRC,[.RXUNAM,,CLUXUN]
|
||
MOVE D,CLUFN1 ;:SEND TO SELF MUST MAIL;
|
||
CAMN D,RUNAME ;OTHERWISE MIGHT HANG DDT.
|
||
RET
|
||
.USET FDRC,[.RMASK,,D]
|
||
TRNE D,%PICLI ;SKIP IFF HE'S GAGGED.
|
||
AOS (P)
|
||
RET
|
||
|
||
BUGLOG: MOVE D,LOGDIN
|
||
AOJN D,CPOPJ ;J IF USER LOGGED IN.
|
||
7NRTYP [ASCIZ/(Login?) /]
|
||
|
||
VPAGET: AOSE VPAGCT ;1 MORE RQ FOR VPAGE.
|
||
RET
|
||
SYSCLO CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF
|
||
%CLIMM,,VPAGE ? %CLIMM,,%JSNEW]
|
||
RET ;MUST ACTUALLY GET IT FOR 1ST RQ.
|
||
|
||
VPAGRT: SOSL VPAGCT ;1 LESS RQ FOR VPAGE.
|
||
POPJ P,
|
||
VPAGR1: SYSCLE CORBLK,[%CLIMM,, ? %CLIMM,,%JSELF ? %CLIMM,,VPAGE]
|
||
POPJ P, ;FLUSH IT IF NO RQS LEFT.
|
||
|
||
MSGNAM: MOVE A,XUNAME ;PUT THIS USER'S UNAME IN BUFFER.
|
||
TRNN W1,-1
|
||
MOVE A,RUNAME ;(USE REAL UNAME FOR :SEND)
|
||
JSP W3,6TO7
|
||
IDPB B,C
|
||
move a,[440700,,[asciz / at /]] ;put in the host of origin, so if
|
||
movei b,(w1) ;is this maybe :OMAIL?
|
||
skipe b ;if so, use ITS-FORMAT frob so :MAILNT 1 can win on it
|
||
move a,[440700,,[asciz /@/]]
|
||
call bugcop ;this mail is copied to another host, it will be clear
|
||
;where it came from.
|
||
MOVE A,ITSNAM
|
||
JSP W3,6TO7
|
||
IDPB B,C
|
||
JRST BUGSPC
|
||
|
||
BUGDAT: .RDATE B, ;PUT DATE IN BUFFER.
|
||
ROT B,12. ;SHIFT TO MONTH,DAY,YEAR
|
||
MOVEI W3,"/ ;SEPARATE NUMBERS WITH "/".
|
||
MOVEI D,0
|
||
JRST BUGTL1
|
||
|
||
BUGTIM: .RTIME B, ;PUT TIME IN BUFFER.
|
||
MOVEI W3,":
|
||
MOVEI D,0
|
||
BUGTL1: MOVEI A,0
|
||
ROTC A,6
|
||
ADDI A,40
|
||
IDPB A,C
|
||
jumpe b,cpopj
|
||
MOVE A,W3
|
||
TRNE D,1
|
||
IDPB A,C
|
||
AOJA D,BUGTL1
|
||
|
||
sndtim: .rtime b, ;put time in buffer in human-format
|
||
setz a, ;clear out A
|
||
rotc a,14 ;Get the hours
|
||
move w3,[440700,,[asciz /am/]] ;Assume morning
|
||
cail a,(sixbit / 12/) ;unless afternoon
|
||
move w3,[440700,,[asciz /pm/]]
|
||
caile a,(sixbit / 12/) ;If it's after 12:59
|
||
jrst [subi a,100 ; convert it. Subtract the 10
|
||
ldb d,[000600,,a] ;get the second digit
|
||
caige d,'2 ;Is it less than 2?
|
||
subi a,000070 ;Must perform a borrow type operation
|
||
cail d,'2 ;otherwise
|
||
subi a,2 ; can just decrement by 2
|
||
jrst .+1]
|
||
cain a,(sixbit / 00/) ;If it's in the first hour of the day
|
||
movei a,(sixbit / 12/) ;call it 12:xx
|
||
ldb d,[060600,,a] ;Get the first digit
|
||
addi d,40 ;convert to ascii
|
||
caie d,"0 ;unless it's 0
|
||
idpb d,c ; Send that digit down
|
||
andi a,77 ;isolate the second digit
|
||
addi a,40 ;and convert to ascii
|
||
idpb a,c ;and send it down
|
||
movei a,": ;Send down the ":"
|
||
idpb a,c
|
||
setz a, ;clear out A again
|
||
rotc a,6 ;get the 10's of minutes
|
||
addi a,40 ;convert to ascii
|
||
idpb a,c ;and send it out
|
||
setz a,
|
||
rotc a,6 ;get the minutes.
|
||
addi a,40 ;convert to ascii
|
||
idpb a,c ;send out the minutes digit
|
||
move a,w3 ;get the Byte Pointer to the AM/PM string
|
||
jrst bugcop ;and send it out
|
||
|
||
BUGSPC: MOVEI A,40 ;PUT A SPACE IN THE BUFFER.
|
||
IDPB A,C
|
||
POPJ P,
|
||
|
||
6TO7: MOVEI B,0
|
||
ROTC A,6
|
||
ADDI B,40
|
||
XCT (W3)
|
||
JUMPN A,6TO7
|
||
JRST 1(W3)
|
||
|
||
|
||
;;; Magic for converting ascii byte pointers into character addresses
|
||
;;; for purposes of arithmetic. When a Byte pointer is multiplied by
|
||
;;; 5, via MULI, the first AC gets either -5 (in the case of the Byte Pointer
|
||
;;; being 440700,,<address>) or a number from 0 to 4 depending on the position
|
||
;;; of the Byte pointer in the word. The second AC gets the low 21. bits as
|
||
;;; the character address of the beginning of the word.
|
||
|
||
;;; Character addresses are defined to start at 0 for 440700,,0 (010700,,-1)
|
||
;;; and continue linearly through 4,,777777 for 100700,,777777
|
||
|
||
;;; This table is the magic correction factor for the various positions of a
|
||
;;; byte pointer
|
||
|
||
644300,,0 ;-5 case
|
||
0 ? 0 ? 0 ? 0 ;no other negatives possible
|
||
chrmtb: 054277,,-5 ;010700,, case
|
||
104277,,-4 ;100700,, case
|
||
134277,,-3 ;170700,, case
|
||
164277,,-2 ;260700,, case
|
||
214277,,-1 ;350700,, case
|
||
|
||
;;; converts Byte Pointer in A to Character Address. Clobbers A and B, returns
|
||
;;; result in B. Assumes the Byte pointer is not indexed or indirect.
|
||
charad: muli a,5
|
||
sub b,chrmtb(a)
|
||
camn b,[5,,0] ;case that's supposed to be zero?
|
||
setz b, ; Make it zero
|
||
ret
|
||
|
||
;:ERR <ARG> DECODE <ARG> AS IO-STATUS WORD.
|
||
;:ERR<CR> DECODE MOST RECENT ERROR IN CURRENT JOB.
|
||
KERR: SKIPE TOKTRM
|
||
JRST KERR3 ;NO ARG => DECODE MOST RECENTLY ERRING CHANNEL.
|
||
CALL RONUM ;ELSE EVAL THE ARG.
|
||
JRST ALTDQX ;RETURN HERE IF ARG IS "RUBOUT".
|
||
CAIL A,NIOCHN
|
||
JRST KERR2 ;ARG IS BIG => IT'S A STATUS WORD.
|
||
JRST KERR4 ;ARG IS SMALL => IT'S A CHANNEL NUMBER.
|
||
|
||
KERR3: CALL QJERR
|
||
.USET USRI,[.RBCHN,,A]
|
||
KERR4: CALL QJERR
|
||
HRLZI D,.RIOS(A)
|
||
HRRI D,A
|
||
.USET USRI,D
|
||
KERR2: MOVEM A,ERROPN+2
|
||
PUSHJ P,FDRCOP
|
||
ERROPN
|
||
JRST .-2
|
||
JRST CTLF3
|
||
|
||
;DEFINITIONS FOR :MSGS
|
||
|
||
UNFN1==0 ;COPIED FROM ITS, NEAR QSKO
|
||
UNFN2==1
|
||
UNRNDM==2
|
||
UNDATE==3
|
||
UNLINK==1
|
||
UNIGFL==200064 ;BITS IN RH OF UNRNDM, SET => FILE INACCESSABLE.
|
||
LUNBLK==5 ;LENGTH OF NAME-BLOCK.
|
||
|
||
; :MSGS COMMAND - PRINT MESSAGES SINCE COMMAND LAST GIVEN.
|
||
; :MSGS KWD1, KWD2, ... PRINTS MESSAGES WHOSE DISTRIB: FIELDS INCLUDE
|
||
; AT LEAST ONE OF THE SPECIFIED KEYWORDS.
|
||
;IF MSGLOG IS SET, WE ARE DOING AN AUTOMATIC :MSGS, AS PART OF A :INTEST.
|
||
;KEYWORDS READ ARE PUSHED ON STACK, FOLLOWED BY POINTER TO STACK AS
|
||
;IT WAS BEFORE 1ST KEYWORD PUSHED. IF NO KEYWORDS SPEC'D, THIS MACHINE'S NAME
|
||
;IS USED AS THE DEFAULT; IN THAT CASE TOKTRM IS LEFT -1, BUT IT IS ZEROED
|
||
;IF THERE ARE SPECIFIED KEYWORDS.
|
||
|
||
MSGS: SETZM MSGLOG
|
||
MSGSL: HLRE D,LOGDIN
|
||
AOJE D,LOGQ
|
||
SAVE P ;SAVE POINTER TO LAST THING BELOW OUR ARGS
|
||
SKIPE TOKTRM ;:MSGS<CR> => DON'T TRY TO READ ANYTHING,
|
||
JRST MSGSR2
|
||
CALL RLINE ;ELSE READ A LINE AHEAD AND PROCESS IT...
|
||
MSGSR1: CALL RTOKEN ;READ AN ARG (A SIXBIT WORD) AND PUSH IT IF NOT BLANK.
|
||
JUMPE B,MSGSR2
|
||
EXCH B,(P) ;WE "PUSH" IT UNDERNEATH THE SAVED STACK POINTER.
|
||
SAVE B
|
||
MSGSR2: SKIPN TOKTRM ;LOOP AROUND TILL CR IS REACHED.
|
||
JRST MSGSR1
|
||
MOVE B,ITSNAM ;CONS UP "*AI" OR "*ML" OR ...
|
||
LSH B,-6
|
||
TLO B,(SIXBIT/*/)
|
||
REST D
|
||
CAME D,P
|
||
SETZM TOKTRM
|
||
CAMN D,P ;NOW, IF THERE WERE NO ARGS PUSHED,
|
||
SAVE B ;PUSH THE "*AI", ETC. AS A DEFAULT.
|
||
SAVE D ;(UNDERNEATH THE SAVED STACK POINTER, OF COURSE)
|
||
.RTIME D,
|
||
AOJE D,NDATER
|
||
SETOM SRFLAG
|
||
call msgget ;get the entry (address in A and MSGLOC)
|
||
skipn c,msgs"me$mdt(a) ;no data in entry?
|
||
jrst msgs2
|
||
|
||
MSGS8: MOVEM C,MSGDAT ;PRINT A FILE IFF MORE RECENT THAN MSGDAT.
|
||
SETOM MSGLDT ;NO FILES TYPED YET.
|
||
SYSCLE RQDATE,[%CLOUT,,MSGTDT] ;READ IN TODAY'S DATE.
|
||
;READ IN THE .MSGS. (OR WHATEVER SNAME) DIRECTORY.
|
||
.SUSET [.SSNAM,,MSGSNM]
|
||
CALL VPAGET ;GET FRESH PAGE AT VPAGE.
|
||
.OPEN FDRC,MSGF2 ;OPEN DIR. IN IMAGE BLOCK MODE.
|
||
CAIA
|
||
JRST MSGS1 ;SUCCESS.
|
||
AOSE MSGLOG ;FAILURE - JUST RETURN IF LOGGING IN.
|
||
OPNER MSGF2 ;ERROR IF EXPLICIT COMMAND.
|
||
MSGS2F: REST D
|
||
MOVE P,D
|
||
JRST GSNLRT
|
||
|
||
MSGS1: MOVE D,[-2000,,VPAGAD]
|
||
.IOT FDRC,D ;READ THE WHOLE DIR.
|
||
.CLOSE FDRC,
|
||
MOVEI A,VPAGAD
|
||
ADD A,VPAGAD+1 ;ADDR. OF 1ST NAME-ENTRY.
|
||
MOVEI B,VPAGAD+2000 ;ADDR AFTER LAST.
|
||
MOVSI C,400000 ;DON'T INCLUDE ACCESS DATE IN SORT KEY.
|
||
CALL SORT
|
||
MOVEI A,VPAGAD-LUNBLK
|
||
ADD A,VPAGAD+1
|
||
JRST MSGSNF
|
||
|
||
; CALL SDIST
|
||
; Search for "DISTRIB: " field in message from FDRC, possibly skipping
|
||
; unfortunate "Recieved:" fields. Skip if found.
|
||
sdst2: call fdrci ; Search for start of new line
|
||
popj p,
|
||
caie d,^J
|
||
jrst sdst2
|
||
sdist: move d,fdrcip ; Save this so we can find the start
|
||
movem d,msgdip ; of the DISTRIB easily
|
||
call fdrci
|
||
popj p,
|
||
caie d,"R ; Perhaps "Recieved:"
|
||
cain d,"r ; "recieved:" also possible I guess...
|
||
jrst sdst2 ; OK before the "DISTRIB: "
|
||
;; See that rest of line is "DISTRIB: ", if not, give up.
|
||
irp ch,,["D,"I,"S,"T,"R,"I,"B,72]
|
||
cain d,ch
|
||
call fdrci
|
||
popj p,
|
||
termin
|
||
cain d,40 ; Final space?
|
||
aos (p) ; Yes, skip
|
||
popj p,
|
||
|
||
;COME HERE TO LOOK AT THE NEXT FILE AND DECIDE WHETHER TO PRINT IT.
|
||
;A POINTS INTO THE DIRECTORY, AT THE PREVIOUS FILE.
|
||
MSGSNF: ADDI A,LUNBLK ;LOOK AT NEXT FILE.
|
||
CAIL A,VPAGAD+2000
|
||
JRST MSGSX ;IF ALL SEEN.
|
||
SKIPN D,UNFN1(A)
|
||
JRST MSGSNF ;IGNORE IF FN1 BLANK.
|
||
MOVEM D,MSGF3+1 ;SAVE FN1 FOR OPEN.
|
||
SKIPN D,UNFN2(A)
|
||
JRST MSGSNF
|
||
MOVEM D,MSGF3+2
|
||
LDB D,[360600,,MSGF3+1]
|
||
CAIN D,'_ ;IGNORE FILE IF FN1 STARTS WITH _.
|
||
JRST MSGSNF
|
||
MOVE D,UNRNDM(A)
|
||
TLNE D,UNLINK\UNIGFL
|
||
JRST MSGSNF ;IGNORE LINKS AND INACCESSABLE FILES.
|
||
MOVE C,UNDATE(A)
|
||
CAMG C,MSGDAT
|
||
JRST MSGSNF ;IF PRINTED MESSAGES SINCE WAS CREATED, SKIP.
|
||
CALL FDRCOP
|
||
MSGF3
|
||
JRST MSGSNF
|
||
call sdist ; Search for "DISTRIB: "
|
||
jrst [ move d,[440700,,fdrctb]
|
||
movem d,fdrcip
|
||
jrst msgsd1 ]
|
||
MSGSD3: MOVE B,[404040,,404040]
|
||
MOVE C,[440600,,B] ;READ IN 1 SIXBIT WORD FROM THE FILE.
|
||
MSGSD5: CALL FDRCI
|
||
JRST MSGSNF
|
||
CAIL D,140
|
||
SUBI D,40
|
||
CAIE D,",
|
||
CAIG D,40
|
||
JRST MSGSD4
|
||
TLNE C,770000
|
||
IDPB D,C
|
||
JRST MSGSD5
|
||
|
||
MSGSD4: XOR B,[404040,,404040]
|
||
JUMPE B,MSGSD6 ;IGNORE NULL WORDS.
|
||
MOVE W1,P ;NOW COMPARE THE WORD AGAINST THE ARGS ON THE STACK.
|
||
POP W1,C ;GET THE POINTER TO BENEATH THE ARGS, FOR END TEST
|
||
MSGSD7: CAMN B,(W1) ;POP 1 ARG AND COMPARE
|
||
JRST MSGSDW ;MATCH => IGNORE REST OF DISTRIB: LINE, AND PRINT MESSAGE
|
||
POP W1,W2
|
||
CAMN W2,[SIXBIT/*/]
|
||
JRST MSGSDW ;KEYWORD * MATCHES ANYTHING
|
||
CAME W1,C
|
||
JRST MSGSD7
|
||
MSGSD6: CAIL D,40 ;THIS WORD LOSES. IF NOT AT END OF LINE, READ ANOTHER.
|
||
JRST MSGSD3
|
||
;THE WHOLE DISTRIB: LOSES - DON'T PRINT THIS FILE.
|
||
CALL MSGEXP ;EVEN THOUGH WE WON'T PRINT IT, DELETE IT IF OLD ENOUGH.
|
||
JFCL
|
||
JRST MSGSNF
|
||
|
||
;COME HERE IF THE FILE'S DISTRIB: SAYS WE SHOULD PRINT IT.
|
||
MSGSDW: CALL MSGEXP ;DON'T PRINT, AND MAYBE EVEN DELETE FILE, IF EXPIRED.
|
||
JRST MSGSNF
|
||
CALL MSGIL ;NOT EXPIRED; SKIP PAST THE "EXPIRES:" LINE.
|
||
JRST MSGSNF ;NOTHING ELSE LEFT?
|
||
JRST MSGSD1 ;PRINT THE FILE.
|
||
|
||
;TEST FILE ON FDRC FOR HAVING EXPIRED. SKIP IF IT HASN'T.
|
||
|
||
MSGEXP: CALL MSGIL ;SKIP THE REST OF THE "DISTRIB:" LINE.
|
||
JRST MSGEXD ;NO MORE IN FILE => SAY IT LOSES.
|
||
MOVEI W1,40
|
||
CALL MSGI1 ;SKIP PAST "EXPIRES: ".
|
||
JRST MSGEXD ;NO SPACE FINDABLE?
|
||
MOVE W1,[CALL [ CALL FDRCI
|
||
MOVEI D,^C
|
||
RET]]
|
||
CALL RDATE ;READ THE EXPIRATION DATE.
|
||
CAML C,MSGTDT ;EXPIRED BEFORE NOW?
|
||
JRST POPJ1 ;NO, FILE SHOULD BE PRINTED.
|
||
MSGEXD: RET ;YES, DON'T PRINT.
|
||
|
||
;IGNORE ONE LINE FROM THE FILE ON FDRC.
|
||
;SKIP NORMALLY; DON'T SKIP IF EOF OR END OF PAGE REACHED.
|
||
MSGIL: MOVEI W1,^J
|
||
MSGI1: CALL FDRCI ;IGNORE UP TO THE CHAR IN W1.
|
||
RET
|
||
CAIN D,^L
|
||
RET
|
||
CAIE D,(W1)
|
||
JRST MSGI1
|
||
JRST POPJ1
|
||
|
||
msgget: move a,xuname
|
||
movei b,lsrc
|
||
move c,[-msglen,,msgpag]
|
||
call msgs"usrget
|
||
movei a,dummy ; Lost, use a dummy
|
||
movem a,msgloc ;remember where our entry is
|
||
popj p,
|
||
|
||
.scalar dummy(2)
|
||
|
||
;COME HERE WHEN WE HAVE DECIDED WITH CERTAINTY THAT THE OPEN FILE NEEDS PRINTING.
|
||
;ASK THE USER --MSGS--.
|
||
MSGSD1: SKIPGE MSGLDT ;HERE FOR MSG WITH NO DISTRIB ENTRY,
|
||
CALL CRF ;OR FOR A MSG WHOSE DISTRIB IS OK (AFTER SKIPPING IT)
|
||
setom mornro ;SO RUBOUT WON'T FLUSH.
|
||
MOVEI W1,MORDMS ;TYPE "DEFERRED" INSTEAD OF "FLUSHED"
|
||
MOVEM W1,MORMSG
|
||
7TYPE [ASCIZ/--MSGS--/]
|
||
CALL MORFL4 ;READ CHAR, MAYBE FLUSH.
|
||
JRST MSGSX1
|
||
MSGSA1: MOVE D,UNDATE(A)
|
||
MOVEM D,MSGLDT ;THIS FILE'S DATE IS DATE OF LAST STARTED.
|
||
MOVE D,MSGF3+1 ;PRINT THE FILE'S NAME.
|
||
CALL SIXTYP
|
||
CTYPE 40
|
||
MOVE D,MSGF3+2
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ/:
|
||
/]
|
||
MOVE D,[440700,,FDRCTB]
|
||
SKIPN TOKTRM ;IF THIS :MSGS HAD EXPLICIT ARGUMENTS,
|
||
CAMN D,FDRCIP ;AND THIS MESSAGE HAD A DISTRIB: SKIPPED OVER,
|
||
JRST MSGSA2
|
||
SAVE FDRCIP
|
||
move d,msgdip
|
||
MOVEM D,FDRCIP ;MOVE BACK TO THE DISTRIB: AND PRINT IT,
|
||
CALL MSGSPL ;IN ADITION TO NORMAL 1ST LINE OF TEXT.
|
||
ERSTRT ; WE ALREADY KNOW FILE DOESN'T END IN THE DISTRIB:
|
||
REST FDRCIP ;MOVE FWD AGAIN TO START OF TEXT.
|
||
MSGSA2: CALL MSGSPL ;PRINT 1ST LINE OF MESSAGE'S TEXT.
|
||
JRST MSGS5 ;GET HERE IF EOF INSIDE THAT LINE.
|
||
JRST MSGSA9 ;THERE'S MORE => PRINT --MORE-- AND PRINT THE REST.
|
||
|
||
;CALL TO PRINT 1 LINE OF FILE OPEN ON FDRC, USING FDRCI. SKIPS IF NO EOF.
|
||
MSGSPL: CALL FDRCI
|
||
RET
|
||
CAIN D,^J ;A LF ENDS THE LINE. DOESN'T PRINT, BUT PRECEDING
|
||
JRST POPJ1 ;CR PRINTED AS CRLF, SO CRLF WINS.
|
||
CTYPE (D)
|
||
CAIN D,^M ;MAKE STRAY CR PRINT AS CRLF, BUT NOT END THE LINE.
|
||
CTYPE ^J
|
||
CAIN D,^L ;^L OR ^C MEANS STOP PRINTING, IN AN ANNOUNCEMENT.
|
||
RET
|
||
JRST MSGSPL
|
||
|
||
;FINISHED PRINTING 1ST LINE OF FILE.
|
||
MSGSA9: SAVE A
|
||
PUSHJ P,MORINI ;INIT. --MORE-- PROC.
|
||
JRST MSGSA3 ;RETURN TO THIS INSN ON FLUSHING.
|
||
CALL FDRCI ;ANY MORE CHARS LEFT?
|
||
JRST MSGSA3 ;NO, FINISHED WITH FILE.
|
||
CALL TYOFRC
|
||
SETOM MORNHU
|
||
.SUSET [.SIIFPI,,[1_TYOC]]
|
||
SKIPGE MORNHU
|
||
.HANG
|
||
PUSHJ P,CTLF7 ;PRINT CONTENTS OF FILE.
|
||
POP P,A
|
||
MSGS5: SETZM SILNT
|
||
PUSHJ P,CRF ;IF FINISHED WHOLE 1ST PAGE.
|
||
MSGS4: SKIPE GETTY ;(DON'T BLATHER ON PRINTING CONSOLE)
|
||
7TYPE [ASCIZ/ END MESSAGE
|
||
/]
|
||
JRST MSGSNF ;PRINT ANOTHER.
|
||
|
||
MSGSA3: REST A ;GET POINTER INTO DIR (CLOBBER BY FLUSHING **MORE**)
|
||
CALL MORFL2 ;TURN OFF MORPRP.
|
||
JRST MSGS5 ;JUST END THIS FILE.
|
||
|
||
;COME HERE WHEN --MSGS-- IS FLUSHED.
|
||
MSGSX1: SKIPGE D,MSGLDT ;IF HAVE SEEN NO MESSAGES,
|
||
JRST MSGSX3 ;DON'T UPDATE DATE.
|
||
caia
|
||
|
||
msgsx: move d,msgtdt ;get today's date & time.
|
||
move c,msgloc ;get address of our entry in database
|
||
movem d,msgs"me$mdt(c) ;set the message date entry
|
||
|
||
msgsx3: call msgs"unmap ;release the pages
|
||
jfcl
|
||
.close fdrc, ;close the channel when done!
|
||
CALL VPAGRT ;RETURN PAGE USED FOR .MSGS. DIR.
|
||
REST D ;FLUSH THE SAVED ARGS FROM THE STACK.
|
||
MOVE P,D
|
||
JRST NLTL2
|
||
|
||
;come here at start of :MSGS if user has no data on file yet.
|
||
msgs2:
|
||
ifn 1,[ syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? xuname
|
||
[sixbit /MSGS/] ? hsname]
|
||
caia
|
||
jrst msgs2y ;found a file
|
||
syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? [sixbit /_MSGS_/]
|
||
xuname ? hsname]
|
||
caia
|
||
jrst msgs2y
|
||
syscal OPEN,[ %climm,,fdrc ? [sixbit /DSK/] ? [sixbit /_MSGS_/]
|
||
xuname ? [sixbit /_MSGS_/]]
|
||
caia
|
||
jrst msgs2y
|
||
] ; End IFN 1,
|
||
|
||
setz c,
|
||
SKIPL MSGLOG ;IF EXPLICIT :MSGS COMMAND & NO DATE
|
||
JRST MSGS8 ;FILE, SHOW ALL MSGS AND CREATE FILE.
|
||
7TYPE [ASCIZ/
|
||
To see system messages, do ":MSGS<CR>"
|
||
/]
|
||
JRST MSGS2F
|
||
|
||
ifn 1,[
|
||
msgs2y: tscall msgc1 ;Get the file date in C
|
||
move a,msgloc ;recover the location of our database entry
|
||
movem c,msgs"me$mdt(a) ;save the date for posterity
|
||
syscal delewo,[%climm,,fdrc] ;Flush the file
|
||
erloss
|
||
.close fdrc,
|
||
jrst msgs8
|
||
] ;end ifn 1,
|
||
|
||
MSGF2: SIXBIT/ &DSK.FILE.(DIR)/
|
||
|
||
MSGC1: calblk RFDATE,[
|
||
%climm,,FDRC
|
||
%clout,,C]
|
||
|
||
SWPS==LUNBLK
|
||
|
||
;SORT THE .MSGS. DIRECTORY
|
||
;A POINTS TO FIRST ENTRY
|
||
;B POINTS TO LAST ENTRY + 1
|
||
;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON
|
||
|
||
SORT: HRLM B,(P) ;SAVE UPPER BOUND
|
||
CAIL A,-SWPS(B)
|
||
JRST SORT7 ;ONE OR ZERO ENTRIES
|
||
PUSH P,A ;SAVE LOWER BOUND
|
||
SORT3: TDNN C,UNDATE(A) ;BIT SET IN LOWER ENTRY?
|
||
JRST SORT4 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
|
||
SUBI B,SWPS ;YES, NOW BACK UP UPPER POINT
|
||
TDNE C,UNDATE(B) ;BIT CLEAR IN UPPER ENTRY?
|
||
JRST SORT5 ;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN
|
||
REPEAT SWPS,[ ;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES
|
||
MOVE D,.RPCNT(A)
|
||
EXCH D,.RPCNT(B)
|
||
MOVEM D,.RPCNT(A)
|
||
]
|
||
SORT4: ADDI A,SWPS ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
|
||
SORT5: CAME A,B ;ANY MORE ENTRIES LEFT?
|
||
JRST SORT3 ;YES, GO PROCESS THEM
|
||
;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
|
||
ROT C,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
|
||
POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT
|
||
JUMPL C,SORT6 ;JUMP IF NO MORE KEY TO SORT ON
|
||
PUSHJ P,SORT ;SORT BOTTOM PART OF TABLE
|
||
HLRZ B,(P) ;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE)
|
||
PUSHJ P,SORT ;SORT TOP PART OF TABLE
|
||
SORT6: ROT C,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C"
|
||
SORT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED
|
||
POPJ P,
|
||
|
||
; :HELP COMMAND
|
||
KHELP: call terpri ;^PA
|
||
7TYPE KHELP1
|
||
JRST NLTL2
|
||
|
||
KHELP1: ASCIZ & You are typing at "DDT", the top level command interpreter/debugger
|
||
of the "ITS" time sharing system.
|
||
Type control-S to abort output from DDT.
|
||
DDT commands start with a colon and are usually terminated
|
||
by a carriage return. Type :? <CR> to list them.
|
||
Type :LOGIN <your name> to log in. If you are new on the system,
|
||
do :INQUIR<cr> to tell the system who <your name> really is.
|
||
To list a file directory, type :LISTF <directory name><CR>.
|
||
To print a file, type :PRINT <file name><CR>. The directory
|
||
".INFO." has many files documenting system programs.
|
||
If a command is not recognized, it is tried as the name of
|
||
a system program to run. :LUSER <CR> runs a program that will
|
||
request help for you. :INFO <CR> runs a documentation perusal
|
||
program.
|
||
Type control-Z to return to DDT after running a program
|
||
(Some return to DDT by themselves when done, printing ":KILL").
|
||
For full documentation on DDT, do :PRINT .INFO.;DDT DOC<CR>.&
|
||
|
||
|
||
;TYPE NAMES OF SYMBOLS.
|
||
SLIST: JUMPL U,JERR
|
||
CALL MORINI
|
||
JRST NLTL2 ;(RETURN HERE IF FLUSH A **MORE**)
|
||
MOVE W1,SYSAOB ;FOR SYS JOB, GET AOBJN -> SYS SYM TAB
|
||
SUBI W1,772000-SYSSYM ;CHANGE ADDR IN SYSTEM TO ADDR IN DDT
|
||
SKIPN SYSSW
|
||
MOVE W1,JOBSYM(U)
|
||
MOVEI I2,9. ;I2 COUNTS NUM. SYMS LEFT ON THIS LINE.
|
||
SLIST2: JUMPGE W1,KLSTUX ;DONE?
|
||
MOVE A,(W1)
|
||
TLNE A,%SYKIL ;DON'T LIST FULLY KILLED SYMS.
|
||
JRST SLIST3
|
||
TLNE A,%SYFLG ;BLOCK OR PROGRAM
|
||
SOJGE I2,SLIST1 ;OR FILLED UP THIS LINE =>
|
||
CALL CRF ;GO TO NEXT LINE.
|
||
MOVEI I2,8. ;# SYMS THIS LINE AFTER THIS SYM.
|
||
SLIST1: TLNE A,%SYFLG ;INDENT ALL BUT BLOCK NAMES.
|
||
CALL TSPC
|
||
PUSHJ P,SPT ;SQUOZE SYMBOL PRINT
|
||
MOVEI D,^I
|
||
SKIPE I2 ;DON'T TAB AFTER LAST SYM ON LINE.
|
||
PUSHJ P,TOUT
|
||
SLIST3: ADD W1,[2,,2]
|
||
JRST SLIST2
|
||
|
||
KMORE: SETZM TTYFLG ;MORFL1 REQUIRES THAT TTY OUTPUT BE ON.
|
||
PUSHJ P,RLINE ;READ (AND ECHO) MESSAGE.
|
||
PUSHJ P,MORFL1 ;READ CHAR, MAYBE FLUSH.
|
||
JRST [PUSHJ P,INPOP
|
||
JRST GSNLRT] ;FLUSHED => END VALRET OR XFILE.
|
||
JRST NLTL5 ;ELSE CONTINUE.
|
||
|
||
KCLEAR: PUSHJ P,FORMFA
|
||
JRST GSNLRT
|
||
|
||
;UUO DISPATCH. SIGN SET => CALL ERTTY BEFORE DISPATCH.
|
||
UUOTAB: U7NRTY
|
||
SETZ UERSTRT ;ERSTRT
|
||
U7TYP
|
||
UCTYPE
|
||
USTRT
|
||
SETZ UOPNER
|
||
SETZ UTERR
|
||
|
||
UTERR: HRLZ I1,40 ;TERR - DUMMY UP AN ERSTRT.
|
||
IORI I1,'?_14 ;PUT IN A ? TO STOP ERSTRT.
|
||
ERSTRT I1
|
||
|
||
UUOH3: AOSN NALTXF ;ILUUOS $X'D SHOULDN'T WRITE "DDTBUG" FILES.
|
||
JRST ERR
|
||
UERLOS: .SUSET [.RBCHN,,A]
|
||
LSH A,27
|
||
IOR A,[.STATUS ERRSTA]
|
||
XCT A
|
||
MOVE A,UERLSU ;READ IN MANY RANDOM USER VARS TO GO IN BUG FILE.
|
||
.SUSET A
|
||
SETZM HAKOK ;DON'T ALLOW HAKKAH TO MESS US UP.
|
||
SYSCAL OPEN,[[7,,ERRC] ? ['DSK,,] ? ['DDTBUG] ? ['>_14,,] ? DBGDIR]
|
||
ERSTRT [SIXBIT /DDT BUG, AND CAN'T WRITE DATA FILE?/]
|
||
MOVE A,SUUOHA
|
||
MOVSI D,-B
|
||
.IOT ERRC,D ;WRITE WORDS 0 THROUGH A.
|
||
MOVE D,SUUOHD ;THEN RESTORE D AND WRITE A+1 THROUGH LIMPUR,
|
||
MOVE A,[B-LIMPUR,,B]
|
||
.IOT ERRC,A
|
||
MOVE A,[-2000,,HIMPUR]
|
||
.IOT ERRC,A ;THEN WRITE MOST INTERESTING PART OF HIGH IMPURE.
|
||
.CLOSE ERRC,
|
||
CALL TQUIT0 ;MAKE SURE WE RETURN ALL THE WAY TO TOP LEVEL.
|
||
ERSTRT [SIXBIT /DDT BUG: PLEASE DO :BUG DDT DESCRIBING CIRCUMSTANCES./]
|
||
|
||
UERLSU: -UERLSL,,.+1
|
||
.RDF1,,ERRDF1
|
||
.RDF2,,ERRDF2
|
||
.RPIRQ,,ERRPIR
|
||
.RIFPI,,ERRIFP
|
||
.RPICL,,ERRPIC
|
||
.RAPRC,,ERRAPR
|
||
.RTTY,,ERRTTY
|
||
.RBCHN,,ERRBCH
|
||
.RJNAM,,ERRJNA
|
||
.RMPVA,,ERRMPV
|
||
UERLSL==.-UERLSU-1
|
||
|
||
DBGDIR: SIXBIT/CRASH/ ;DIRECTORY FOR WRITING BUG FILES
|
||
DBGFN2: SIXBIT />/
|
||
|
||
|
||
;ROUTINE TO READ IN A DDT BUG FILE.
|
||
;DO DDT$J $L SYSBIN; DBGHAK$G TO READ IN DDTBUG >
|
||
DBGHAK: SYSCAL OPEN,[[.BII,,ERRC] ? ['DSK,,] ? ['DDTBUG] ? DBGFN2 ?DBGDIR]
|
||
.VALUE
|
||
.CORE 1+PURIFT_-12
|
||
.VALUE
|
||
MOVSI A,-LIMPUR
|
||
MOVEM A,PURIFT
|
||
MOVE A,[-2000,,HIMPUR]
|
||
MOVEM A,PURIFT+1
|
||
.IOT ERRC,PURIFT
|
||
.IOT ERRC,PURIFT+1
|
||
.CLOSE ERRC,
|
||
MOVEM A,PURIFT
|
||
MOVE A,VRSADR
|
||
CAME A,[.FNAM2]
|
||
.VALUE [ASCIZ /: Wrong DDT version
|
||
/]
|
||
MOVE A,PURIFT
|
||
.BREAK 16,100000
|
||
|
||
;OPNER UUO COMES HERE. EA SHOULD -> A 3-WORD .OPEN BLOCK
|
||
;OR A NEW-STYLE OPEN BLOCK.
|
||
;This works for things in A, B, C, or D, but not for things in the stack,
|
||
;or indexing via A. The current state is a kludge, but one that works.
|
||
;I should re-write sometime instead of leaving this kludge in place.
|
||
|
||
UOPNER: HRRZ A,40
|
||
AOSN SRFLAG ;IF ROUTINE WANTED SNAME RESTORED
|
||
.SUSET [.SSNAM,,LSNAM] ;DO IT TO IT
|
||
MOVE D,(A)
|
||
CAMN D,[SETZ]
|
||
JRST UOPNR6
|
||
.SUSET [.RSNAM,,B]
|
||
PUSHJ P,LFILE0
|
||
JRST UOPNR3
|
||
|
||
UOPNR6: move d,(p) ;on top of P should be D
|
||
movem d,uopacd
|
||
move d,-1(p) ;below it should be A
|
||
movem d,uopaca ;so remember it for later
|
||
MOVE D,1(A) ;OPNER AFTER .CALL, DECODE IT.
|
||
CAMN D,[SIXBIT/OPEN/]
|
||
JRST UOPNRO ;OPEN - PRINT FILENAMES.
|
||
CAME D,[SIXBIT /DELETE/]
|
||
CAMN D,[SIXBIT /RENAME/]
|
||
JRST UOPNRR
|
||
CALL SIXTYP ;OTHER NEW SYS CALL: PRINT NAME OF CALL,
|
||
CTYPE ":
|
||
JRST UOPNR3 ;AND THE ERR-DEVICE MESSAGE (EG "NO CORE AVAILABLE")
|
||
|
||
UOPNRR: SUBI A,1
|
||
UOPNRO: MOVEI A,3(A) ;A-> ARG -> DEV. NAM.
|
||
ldb d,[330300,,(a)] ;check the op code field.
|
||
skipe d ;if this isn't 0, assume we maybe have a control arg
|
||
aos a ; or something, so skip it. Assume only one.
|
||
pop p,D ;d may hold an arg to open.
|
||
|
||
PUSHJ P,UOPNL ;PRINT 4 (OR 3) ARGS STARTING THERE.
|
||
UOPNR3: 7TYPE [ASCIZ/ - /]
|
||
.SUSET [.RBCHN,,UERFLC]
|
||
.OPEN ERRC,UERFLN
|
||
JRST UOPNR5
|
||
UOPNR2: .IOT ERRC,D
|
||
JUMPL D,UOPNR4
|
||
CAIGE D,40
|
||
JRST UOPNR4
|
||
PUSHJ P,TOUT
|
||
JRST UOPNR2
|
||
|
||
UOPNR5: 7TYPE [ASCIZ /CAN'T READ SYSTEM'S ERROR MESSAGE?/]
|
||
UOPNR4: .CLOSE ERRC,
|
||
CALL CRF
|
||
CALL %RESET
|
||
JRST ERR6
|
||
|
||
uoparg: cain d,d ;is it to come from D?
|
||
movei d,uopacd ;yes, substitute the saved D
|
||
cain d,a ;is it to come from A?
|
||
movei d,uopaca ;yes, substitute
|
||
move d,(d) ;get the final contents
|
||
ret
|
||
|
||
UOPNL: PUSH P,C
|
||
PUSH P,D
|
||
movei d,@(a) ;get loc of name in 1st arg,
|
||
call uoparg ;and get the arg
|
||
call sixtyp ;and type it
|
||
7TYPE [ASCIZ/: /] ;IT IS DEVICE NAME.
|
||
MOVE D,(P) ;@3(A) MAY USE THESE ACS.
|
||
MOVE C,-1(P)
|
||
SKIPL 2(A) ;Unless only 3 args
|
||
jrst [movei d,@3(a) ;get the address, and
|
||
call uoparg ;get the arg
|
||
jumpe d,.+1 ;If null arg, better get SNAME
|
||
jrst .+2] ; otherwise that's it, continue
|
||
.SUSET [.RSNAM,,D] ;OR DEFAULT IF NONE SPEC'D.
|
||
PUSHJ P,SIXTYP
|
||
7TYPE [ASCIZ/; /]
|
||
UOPNL0: MOVE D,(P)
|
||
MOVE C,-1(P)
|
||
movei d,@1(a)
|
||
call uoparg ;get the arg
|
||
PUSHJ P,SIXTYP ;PRINT FN1 & FN2.
|
||
PUSHJ P,TSPC
|
||
POP P,D
|
||
POP P,C
|
||
movei d,@2(a)
|
||
call uoparg ;get the arg
|
||
JRST SIXTYP
|
||
|
||
ERR: ERSTRT [SIXBIT/?/]
|
||
LOGQ: ERSTRT [SIXBIT/LOGIN?/]
|
||
|
||
UERSTR: MOVEI A,ERR5 ;STRING RETURN ERROR
|
||
HRRM A,UUOH ;RETURN TO ERR5
|
||
PUSHJ P,TSPC
|
||
|
||
USTRT: PUSH P,UUOH
|
||
MOVE A,40
|
||
HRLI A,440600
|
||
UUOH11: ILDB D,A
|
||
ADDI D,40
|
||
PUSHJ P,TOUT
|
||
CAIN D,"?
|
||
JRST UUOXIT
|
||
CAIE D,".
|
||
JRST UUOH11
|
||
UUOXIT: POP P,UUOH
|
||
REST D
|
||
REST A
|
||
JRST 2,@UUOH
|
||
|
||
ERR5: PUSHJ P,%RESET ;ALL ERRORS COME THRU HERE.
|
||
PUSHJ P,TSPC
|
||
ERR6: MOVEM P,ERROPP
|
||
MOVE P,ERRSTP ;RESTORE PDL AND PC
|
||
MOVEM P,ERRNPP
|
||
MOVE A,ERRSTL
|
||
MOVEM A,ERRNPC
|
||
JRST @ERRSTL ;TO THE ERROR-RETURN LOCATION.
|
||
|
||
%RESET: TRZ F,-1
|
||
TRNN P,-40
|
||
ERLOSS
|
||
syscle UNLOCK,[%climm,,%jself] ;unlock any database locks we have on
|
||
CALL VPAGR1 ;CLEAR OUT VPAGE
|
||
SETOM VPAGCT
|
||
.CLOSE FDRC,
|
||
.CLOSE ERRC,
|
||
.CLOSE UTIC,
|
||
.CLOSE UTOC,
|
||
.close lsrc,
|
||
PUSHJ P,INRST ;RESET TTY, PUSH VALRET OR XFILE
|
||
SETOM MORONP
|
||
SYSCLE USRVAR,[MOVEI %JSELF ? [SIXBIT /TTY/] ? MOVEI ? [TLO %TBINF]]
|
||
IRPS XX,,[SILNT MORPRP MORNRO MORMSG HAKIOP VALCOM TQUITR rubsav tthelp bughed
|
||
U7TCTN RSTDEL HAKOK HAKING HAKINT TOUTXQ INTING XCRFSW RADING tyisnd ctlsfl
|
||
INNCTL XRWI CTLDFL TYOUNI PVALFL NALTXF STOPWT MOREXP fdrcls ratflg buggsc
|
||
hlprtn clirpx clirpc ]
|
||
SETZM XX
|
||
TERMIN
|
||
MOVE U,CU
|
||
AOSN FRNDEL ;IF WE'RE LOOKING AT FOREIGN JOB THAT WENT AWAY,
|
||
CALL MRDR ;DON'T KEEP THINKING IT EXISTS.
|
||
SKIPGE U,CU
|
||
CALL NOJOB2 ;IF NO CURRENT JOB, MAKE ALL VARS AGREE ON THAT.
|
||
AOSN SRFLAG
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
.SUSET [.SAMASK,,[1^5,,]]
|
||
.SUSET [.SDF1,,[0]]
|
||
.SUSET [.SDF2,,[0]]
|
||
SKIPL TQUITW ;IF WANTED QUIT BUT HAD BEEN NON-QUITTING,
|
||
JRST TQUIT ;QUIT NOW.
|
||
POPJ P,
|
||
|
||
U7NRTY: PUSHJ P,U7TY0
|
||
AOSN SRFLAG
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
SUB P,[NUUOPS,,NUUOPS]
|
||
JRST GSNLRT
|
||
|
||
U7TYP: PUSH P,UUOH
|
||
PUSHJ P,U7TY0
|
||
JRST UUOXIT
|
||
|
||
U7TY0: MOVE A,40
|
||
U7TY2: PUSH P,LPTFLG ;SUBROUTINE TO TYPE ASCIZ ARG.
|
||
PUSH P,U7TCTN'
|
||
SETZM U7TCTN ;HAVEN'T SEEN ^N IN ARG.
|
||
HRLI A,440700
|
||
U7TY1: ILDB D,A
|
||
JUMPE D,U7TYC
|
||
IRPC X,,CENSVDF
|
||
CAIN D,^X
|
||
JRST U7TY!X
|
||
TERMIN ;HANDLE SPECIAL CTL CHARS.
|
||
PUSHJ P,TOUT
|
||
JRST U7TY1
|
||
|
||
U7TYV: SETZM TTYFLG
|
||
JRST U7TY1
|
||
|
||
U7TYD: MOVEI A,ERR6 ;^D - LIKE ^F BUT RET. TO ERRSET, NOT CALLER.
|
||
MOVEM A,-2(P)
|
||
U7TYF: MOVEI A,[ASCIZ/? /] ;^F - RESET THINGS LIKE ERSTRT.
|
||
PUSHJ P,U7TY2
|
||
PUSHJ P,%RESET
|
||
U7TYC: POP P,U7TCTN
|
||
POP P,LPTFLG
|
||
POPJ P,
|
||
|
||
U7TYN: SETOM U7TCTN
|
||
U7TYE: AOS LPTFLG
|
||
JRST U7TY1
|
||
|
||
U7TYS: SETZM SILNT
|
||
JRST U7TY1
|
||
|
||
;ROUTINE FOR CTYPE UUO - PRINT EFF. ADDR. AS AN ASCII CHARACTER.
|
||
UCTYPE: PUSH P,UUOH
|
||
HRRZ D,40
|
||
SKIPN DDTTY
|
||
ERLOSS
|
||
PUSHJ P,TOUT
|
||
JRST UUOXIT
|
||
|
||
; CALL FDRCOP ? FILEBLOCKADDR OPENS THAT FILE ON FDRC IN ASCII BLOCK INPUT.
|
||
;ALSO INITAILIZES THE FDRC BUFFER. SKIPS IF SUCCESSFULE.
|
||
FDRCOP: SAVE C ;FDRC OPEN
|
||
MOVE C,@-1(P)
|
||
AOS -1(P)
|
||
MOVEI C,@C
|
||
.CALL FDRCO
|
||
JRST POPCJ
|
||
AOS -1(P)
|
||
REST C
|
||
FDRCO1: SAVE A ;NOW, TO INITIALIZE BUFFERING,
|
||
SETZM FDRCND
|
||
MOVE A,[-1-FDRCL,,FDRCTB]
|
||
CALL FDRCO4 ;READ IN, NOT EXPECTING THERE TO BE ANY LOOK-AHEAD YET.
|
||
JRST POPAJ
|
||
|
||
;HERE TO REFILL BUFFER WHEN WE HAVE AWORD OF LOOK-AHEAD IN FDRCTE.
|
||
FDRCO3: MOVE A,FDRCTE ;COPY LAST TIME'S LOOK-AHEAD WORD TO BEGINNING OF BFR,
|
||
MOVEM A,FDRCTB ;AND TRY TO FILL THE REST, INCLUDING A NEW WORD OF LOOK-AHEAD.
|
||
MOVE A,[-FDRCL,,FDRCTB+1]
|
||
FDRCO4: .IOT FDRC,A
|
||
ANDI A,-1
|
||
CAIN A,FDRCTE+1 ;IF WE GOT ALL WE ASKED FOR, SET FDRCEP TO LAST CHAR OF
|
||
JRST [ MOVE A,[010700,,FDRCTE-1] ;NEXT-TO-LAST WD, LEAVING LAST WD AS LOOK-AHEAD.
|
||
JRST FDRCO6]
|
||
SAVE B
|
||
SETOM FDRCND
|
||
HRLI A,350700 ;OTHERWISE, POINT AT CHAR AFTER LAST ONE READ IN.
|
||
FDRCO5: ADD A,[070000,,]
|
||
SKIPGE A ;AND BACK UP TILL WE FIND SOMETHING THAT ISN'T PADDING.
|
||
SUB A,[430000,,1]
|
||
CAMN A,[010700,,FDRCTB-1]
|
||
JRST FDRCO7
|
||
LDB B,A
|
||
CAIE B,^C
|
||
CAIN B,^@
|
||
JRST FDRCO5
|
||
FDRCO7: REST B ;THAT IS THE LAST CHARACTER "REALLY THERE." MAKE FDRCEP SAY SO.
|
||
FDRCO6: MOVEM A,FDRCEP
|
||
fdrco8: move a,[010700,,fdrctb-1] ;start the pointer at the beginning
|
||
MOVEM A,FDRCIP
|
||
RET
|
||
|
||
FDRCI1: SKIPGE FDRCND
|
||
RET
|
||
SAVE A ;HERE FROM FDRCI WHEN BUFFER IS EMPTY.
|
||
CALL FDRCO3 ;REFILL IT.
|
||
REST A
|
||
|
||
;READ 1 CHAR FROM BLOCK-MODE FDRC.
|
||
FDRCI: MOVE D,FDRCIP ;UNLESS PTR IS AT END OF BUFFER,
|
||
CAMN D,FDRCEP
|
||
JRST FDRCI1
|
||
ILDB D,FDRCIP
|
||
JRST POPJ1
|
||
|
||
shfdrx: irps x,,morprp mormsg mornhu mornro
|
||
save x
|
||
setzm x
|
||
termin
|
||
|
||
;PUSH FDRC, ITS BUFFER AND POINTERS. CALL WITH JSP I4, .
|
||
SHFDRC: .IOPUSH FDRC,
|
||
HRLI D,FDRCTB
|
||
HRR D,P
|
||
AOS D
|
||
ADD P,[FDRCSE-FDRCTB,,FDRCSE-FDRCTB]
|
||
SKIPL P
|
||
ERLOSS I4 ;PDL OV.
|
||
BLT D,(P)
|
||
JRST (I4)
|
||
|
||
;UNDO A SHFDRC. CALL WITH JSP I4, .
|
||
OPFDRC: .IOPOP FDRC,
|
||
HRRZ D,P
|
||
SUBI D,FDRCSE-1-FDRCTB
|
||
HRLS D
|
||
HRRI D,FDRCTB
|
||
BLT D,FDRCSE-1
|
||
SUB P,[FDRCSE-FDRCTB,,FDRCSE-FDRCTB]
|
||
JRST (I4)
|
||
|
||
QIJERR: SKIPGE INTBIT(U) ;ERROR UNLESS REAL INFERIOR OPEN (NOT PDP6).
|
||
JRST JERR
|
||
QI6JER: SKIPGE UCHNLO ;ERROR UNLESS INFERIOR OR PDP6 OPEN.
|
||
QOJERR: SKIPE DDTSW ;ERROR UNLESS ORDINARY JOB (NOT SYS OR SELF)
|
||
JRST JERR
|
||
QJERR: SKIPE UCHNLO ;ERROR UNLESS REAL JOB (NOT SYS) OPEN.
|
||
POPJ P,
|
||
JERR: SKIPE UCHNLO
|
||
JERRI: ERSTRT [SIXBIT/JOB NOT INFERIOR?/]
|
||
MOVE D,LOGDIN
|
||
AOJE D,LOGQ ;COMPLAIN ABOUT NOT BEING LOGGED IN BEFORE ABOUT JOB
|
||
njerr: TERR (SIXBIT /JOB/)
|
||
|
||
;; error if can't write current job's core.
|
||
|
||
apatck: jumpl u,njerr ;must have a a job
|
||
move a,urandm(u) ;check out the patch-enable
|
||
trne a,%urdps ;is this job enabled?
|
||
ret ; yes!
|
||
skipn ddtsw ;can patch self.
|
||
skipg uchnlo ;sys and inferiors.
|
||
ret
|
||
jrst qijerr ;otherwise must have real inferior
|
||
|
||
QRERR: SKIPE UINTWD(U) ;ERROR IF JOB RUNNING.
|
||
POPJ P,
|
||
NRERR: SKIPE UINT(U)
|
||
ERSTRT [SIXBIT /JOB INTERRUPTING?/]
|
||
ERSTRT [SIXBIT/JOB RUNNING?/]
|
||
|
||
NRBERR: SETOM TTNRST ;RUBOUT WITH NOTHING TO RUB COMES HERE.
|
||
NXERR: 7NRTYP [ASCII /?/]
|
||
|
||
NSERR: ERSTRT [SIXBIT/JOB NEVER STARTED?/]
|
||
|
||
NCTLD: SETOM TTNRST ;^D - DON'T FLUSH USR'S TYPEIN.
|
||
setzm tyisnd ;restore ^V and ^W to normal
|
||
CALL TQUIT1 ;RETURN TO VERY TOP, NOT TO ERRSET.
|
||
TERR 'XXX
|
||
|
||
NODATE: ASCIZ /
|
||
(ITS does not know the date, so messages cannot be reviewed right now.)
|
||
/
|
||
NDATER: 7TYPE NODATE
|
||
7TYPE [ASCIZ//] ;SIGNAL AN ERROR.
|
||
|
||
NJGERR: CALL MRDR2 ;$J'D TO JOB THAT WENT AWAY, FORGET ABOUT IT.
|
||
.CLOSE USRI,
|
||
NJGER1: ERSTRT [SIXBIT/JOB GONE?/]
|
||
|
||
NSJERR: ERSTRT [SIXBIT/NO SUCH JOB?/]
|
||
|
||
NAERR: 7NRTYP [ASCII/ ARG/]
|
||
|
||
NGOERR: ERSTRT [SIXBIT/NO START ADDR?/]
|
||
|
||
N2AJ3: 7NRTYP [ASCII/ JOB ALREADY EXISTS/]
|
||
|
||
|
||
NLTL2: MOVEI D,^M
|
||
CALL LPTR
|
||
MOVEI D,^J
|
||
CALL LPTR
|
||
|
||
NLTL4: call pprin ;print the prompt
|
||
NLTL5: AOSN SRFLAG ;RESTORE SNAME IF WAS PUSHED.
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
TLZ F,FLRO
|
||
JRST GSNLRT
|
||
|
||
pprin: call tyofrc ;Be sure all typeout has already happened
|
||
;If it happens in HAKKAH, no --MORE--'s!!
|
||
skipe hakint ;If there are HAKKAH interrupts
|
||
setom hakrq ;Be sure there's a request!
|
||
skipe hakrq
|
||
setom haktyp ;Be sure to print any messages from HAKKAH
|
||
call hakkan
|
||
7type [asciz/A/]
|
||
MOVE D,ITSNAM
|
||
SKIPE PRMMCH ;IF USER HAS RQ'D IT, INCLUDE MACHINE NAME IN PROMPT.
|
||
CALL SIXTYP
|
||
SKIPN MONMDL ;DON'T PROMPT IN MONIT MODE, SINCE COLON SERVES AS ONE.
|
||
XCT PROMPT ;PUT PROMPT INSN IN IMPURE PAGE FOR EASE OF PATCHING.
|
||
popj p,
|
||
|
||
|
||
RIN: PUSHJ P,IN ;TIN:?
|
||
CAIN D,^D
|
||
JRST NCTLD
|
||
CAIE D,177
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
IN4: SETZM MORFLG
|
||
MOVE D,LIMBO
|
||
AOSN UNECHF ;IF ECHO DESIRED,
|
||
CALL IN2D ;THEN MAYBE ECHO IT
|
||
CALL TYI3B ;IGNORE ^B, ETC.
|
||
JRST IN
|
||
POPJ P, ;OTHERWISE JUST RETURN
|
||
|
||
|
||
;1) INPUT CHARACTER
|
||
;2) CHECK FOR , ,
|
||
;3) MAYBE PRINT AND LPT IT
|
||
;4) CHECK FOR ,
|
||
|
||
LISTN: PUSH P,D
|
||
PUSHJ P,TYI
|
||
JRST POPDJ
|
||
SETOM UNRCHF ;FOUND A CHAR OTHER THAN ^V, ETC: MUST RE-READ IT.
|
||
POPDJ1: AOS -1(P)
|
||
POPDJ: POP P,D
|
||
POPJ P,
|
||
|
||
IN3: PUSHJ P,INPOP ;COME HERE ON END OF VALRET OR CMD FILE.
|
||
|
||
;READ A CHAR FROM INPUT SOURCE.
|
||
IN: CALL TYOFRC ;FORCE OUT TTY BUFFER.
|
||
SKIPGE MORFLG ;IF READING ANSWER TO --MORE--, USE PEEKED-AT CHARACTER
|
||
SKIPN INPTR ;ONLY IF IT CAME FROM THE TTY. OTHERWISE, USE THE PEEKED-AT CHAR.
|
||
CAIA
|
||
JRST IN7
|
||
AOSN UNRCHF
|
||
JRST IN4
|
||
IN7: AOSN MORFLG ;IF READING ANSWER TO --MORE--, ALWAYS READ FROM TTY.
|
||
JRST IN5
|
||
SKIPGE HAKRQ ;IF ANY HAKKAH RQS PENDING, PROCESSTHEM.
|
||
CALL HAKKAH
|
||
SKIPE INPTR
|
||
JRST IN2
|
||
IN5: CALL TYI3
|
||
JRST IN5 ;CHAR WAS ^V, ETC.
|
||
SKIPN MORFLG ;IF READING CHAR AFTER --MORE--,
|
||
RET ;DON'T LPT IT.
|
||
IN6: CALL ECHOT ;WALLPAPER THE CHAR AS IT ECHOED.
|
||
CALL LPTR ;(ARG TO ECHOT)
|
||
RET
|
||
|
||
TYI: CALL TYOFRC ;.LISTEN IS SUPPOSED TO FORCE OUTPUT.
|
||
.LISTEN D,
|
||
JUMPE D,CPOPJ
|
||
TYI3: CALL HAKKAM ;DO HAKKAH RQ'S, SAY DO ANY MORE WHEN QUEUED.
|
||
SETZM CTLZFL
|
||
SKIPL D,TTYUNR
|
||
JRST TYI4
|
||
SYSCAL IOT,[TYIC2 ? D]
|
||
.VALUE
|
||
TYI4: SKIPE METAP
|
||
JRST [TRZ D,%TXTOP+%TXSUP ;CLEAR TOP AND SUPER
|
||
TRZE D,%TXCTL ;IF CONTROL BIT SET,
|
||
TRZ D,140 ;CONVERT TO ASCII.
|
||
TRZN D,%TXMTA
|
||
JRST .+1
|
||
MOVEM D,TTYUNR ;META BIT SET, SAVE CHAR FOR LATER.
|
||
MOVEI D,33 ;RETURN ALTMODE.
|
||
JRST TYI5]
|
||
SETOM TTYUNR
|
||
TYI5: setzm hakok ;defer HAKKAH rq's again.
|
||
skipe echop
|
||
pushj p,echo ;Echo character.
|
||
skipn tthelp ;If [HELP] isn't desired
|
||
caie d,%txtop+"H ; help key becomes question mark
|
||
caia
|
||
jrst [ skipe hlprtn ; is there a help routine?
|
||
jrst [ call @hlprtn ; yes, call it
|
||
jrst tyi3] ; and get another character
|
||
movei d,"? ; no help routine, pretend we got a ?
|
||
jrst .+1]
|
||
|
||
movem d,limbo
|
||
cain d,^s ;un-silence when read ^S.
|
||
jrst [ setzm silnt ;was silenced at int. level.
|
||
skipe ctlsfl ;is control-S supposed to abort?
|
||
movei d,^D ; Yes, so turn it into a control-D
|
||
jrst .+1]
|
||
cain d,^Z ;Is this a control-Z
|
||
skipn ctlsfl ; and is it supposed to abort?
|
||
caia ; no
|
||
movei d,^D ; yes, turn it into a ^D
|
||
jumpe d,cpopj ;ignore nulls.
|
||
caie d,^B
|
||
cain d,^E
|
||
popj p,
|
||
skipe tyisnd ;if we're hacking sends etc
|
||
jrst popj1 ; then ^V and ^W are OK.
|
||
caie d,^V ;ignore ^V, ^W,
|
||
cain d,^W
|
||
popj p,
|
||
jrst popj1
|
||
|
||
echo: caie d,^I ;TAB and LF don't echo.
|
||
cain d,^J
|
||
popj p,
|
||
cain d,^L ;FF clears screen.
|
||
jrst formfa
|
||
caie d,177 ;Rubout doesn't echo.
|
||
.iot tyoc,d
|
||
popj p,
|
||
|
||
;IF THE CHAR IN D IS ^V, ^W, ^B, ^E OR ^S, PROCESS IT AND DON'T SKIP.
|
||
;OTHERWISE SKIP.
|
||
TYI3B: cain d,^B
|
||
jrst tyi3bb
|
||
cain d,^E
|
||
jrst tyi3be
|
||
skipe tyisnd ;if in the middle of a send
|
||
jrst popj1 ; then it's not special
|
||
cain d,^W
|
||
jrst tyi3bw
|
||
cain d,^V
|
||
jrst tyi3bv
|
||
jrst popj1
|
||
|
||
;^B - MAYBE TURN ON LPT OUTPUT (WON'T OPEN LPT)
|
||
TYI3BB: SOSL LPTFLG ;FROM FILE, SOS LPTFLG UNLESS 0,
|
||
SKIPE INTING
|
||
SETZM LPTFLG ;FROM TTY, SET TO 0.
|
||
RET
|
||
|
||
;^V - MAYBE TURN ON TTY OUTPUT.
|
||
TYI3BV: SOSL TTYFLG ;FROM FILE OR VALRET, JUST COUNTER ONE ^W.
|
||
SKIPE INTING
|
||
SETZM TTYFLG ;FROM TTY, CANCEL ALL ^W'S.
|
||
POPJ P,
|
||
|
||
TYI3BE: AOSA LPTFLG ;^E - TURN OFF OUTPUT TO LPT (BUT DON'T CLOSE)
|
||
TYI3BW: AOS TTYFLG ;^W - TURN OFF OUTPUT TO TTY.
|
||
POPJ P,
|
||
|
||
KINPUS: CALL INPUSH ;:INPUSH COMMAND
|
||
JRST NLTL2
|
||
|
||
;SAVE CURRENT INPUT SOURCES, START INPUT FROM TTY.
|
||
;CALLED FROM :XFILE AND VALRET CODE.
|
||
INPUSH: PUSHJ P,RTYIC ;POP CURRENT SOURCE IF IT'S AT EOF.
|
||
JFCL
|
||
SKIPN D,4BLKF
|
||
ERSTRT [SIXBIT*VALRETS OR XFILES NESTED TOO DEEP?*]
|
||
MOVE A,(D) ;REMOVE 1ST FREE 4BLK FROM FREE LIST.
|
||
MOVEM A,4BLKF
|
||
SKIPGE INPTR ;IF INPUSHING CMD FILE,
|
||
SETOM INIOPS ;DEFER .IOPUSH TILL NEED COMC AGAIN.
|
||
SETZ A,
|
||
AOSN UNRCHF
|
||
TLO A,400000 ;COMPRESS LIMBO, UNRCHF, UNECHF INTO 1 WD.
|
||
AOSN UNECHF
|
||
TLO A,200000
|
||
IORM A,LIMBO
|
||
MOVEI A,(D)
|
||
HRLI A,INPDL
|
||
BLT A,3(D) ;SAVE STATUS OF INPUT SOURCE IN THE 4BLK
|
||
MOVEM D,INPDL ;WHICH NOW IS TOP OF INPUT STACK.
|
||
SETZM INPTR ;SET CURRENT SOURCE TO TTY:
|
||
POPJ P,
|
||
|
||
INFLS: PUSH P,[NLTL2] ;:INFLS COMMAND.
|
||
INFLS1: PUSHJ P,INPOP ;KEEP POPPING TILL STACK EMPTY.
|
||
SKIPE INPDL
|
||
JRST INFLS1
|
||
JRST INPOP ;& ONCE MORE TO BE SURE.
|
||
|
||
KINPOP: SKIPE TOKTRM ;:INPOP COMMAND.
|
||
JRST [ CALL INPOP ;:INPOP^M - POP INPUT RIGHT NOW.
|
||
JRST NLTL4]
|
||
;:INPOP <LINE> - POP AFTER EXECUTING <LINE>.
|
||
SKIPG INPTR ;IF CURRENT SOURCE ISN'T VALRET,
|
||
SETZM INVAOB ;RANDOMNESS IN INVAOB MIGHT CONFUSE RELOC.
|
||
PUSHJ P,RLINE ;READ IN A LINE, PREPARE TO RE-READ IT.
|
||
MOVEI W1,INVAOB
|
||
PUSHJ P,JCL0 ;READ INTO SYMTAB SPACE, INVAOB GETS AOBJN -> IT.
|
||
HRRZ A,INVAOB
|
||
HRLI A,10700 ;SET UP B.P. TO IT, MUST BE POSITIVE.
|
||
SOS A
|
||
MOVEM A,INPTR ;CLOBBER CURRENT SOURCE WITH IT.
|
||
JRST NLTL4 ;WILL READ THAT LINE, THEN POP.
|
||
|
||
;TERMINATE A VALRET OR CMD FILE, POP TO OUTER INPUT SOURCE.
|
||
INPOP: PUSH P,A
|
||
SKIPGE A,INPTR ;IF SOURCE IS CMD FILE, CLOSE IT.
|
||
JRST [.CLOSE COMC, ? JRST INPOP0]
|
||
JUMPE A,INPOP0
|
||
PUSH P,W1 ;VALRET STRING: RELEASE STRING'S STORAGE.
|
||
MOVEI W1,INVAOB
|
||
PUSHJ P,ELEC0
|
||
POP P,W1
|
||
INPOP0: SETZM INPTR ;SET SOURCE TO TTY.
|
||
SETZM UNRCHF
|
||
SETZM UNECHF
|
||
SKIPN D,INPDL ;IF NO SOURCE ON PDL, LEAVE IT THAT WAY.
|
||
JRST POPAJ
|
||
MOVEI A,INPDL
|
||
HRLI A,(D)
|
||
BLT A,INVAOB ;SET CURRENT SOURCE FROM SAVED ONE.
|
||
HLLZ A,LIMBO ;UNPACK UNRCHF, UNECHF FROM LIMBO.
|
||
HRRZS LIMBO
|
||
TLNE A,400000
|
||
SETOM UNRCHF
|
||
TLNE A,200000
|
||
SETOM UNECHF
|
||
EXCH D,4BLKF ;AND FREE THE PDL BLOCK.
|
||
EXCH D,@4BLKF
|
||
SKIPL INPTR ;IF POPPING INTO CMD FILE,
|
||
JRST POPAJ
|
||
AOSE INIOPS ;.IOPOP INLESS WAS NEVER PUSHED.
|
||
.IOPOP COMC,
|
||
JRST POPAJ
|
||
|
||
;RESET THE CURRENT INPUT STREAM.
|
||
INRST: AOSE TTNRST ;FOR RUBOUT AND ^D, DON'T FLUSH TYPEIN.
|
||
.RESET TYIC,
|
||
PUSHJ P,ERTTY1 ;TURN ON TTY, TYPE ^V IF WAS OFF.
|
||
PUSHJ P,RTYIC ;IF CURRENT SOURCE IS AT EOF,
|
||
JFCL ;RTYIC WILL POP IT. (SAVE INPDL SPACE).
|
||
SKIPN INPTR ;IF INPUT NOT FROM TTY,
|
||
RET
|
||
SKIPE 4BLKF ;PUSH INPUT IF ROOM IN INPDL,
|
||
JRST [7TYPE [ASCIZ/:INPUSH /] ? JRST INPUSH]
|
||
PUSHJ P,INFLS1 ;ELSE FLUSH ALL INPUT & TELL USER.
|
||
JSP A,U7TY2
|
||
ASCII /INPDL OVERFLOW - PDL RESET/
|
||
|
||
; CALL ECHOT
|
||
; CALL TYPEOUT-RTN
|
||
;OUTPUT CHAR IN D VIA THAT RTN, AS IT WOULD ECHO.
|
||
ECHOT: CAIE D,^I
|
||
CAIN D,^J
|
||
JRST POPJ1 ;THESE DON'T ECHO.
|
||
CAIE D,^M
|
||
RET ;OTHERS ECHO AS THEY'RE OUTPUT.
|
||
XCT @(P) ;^M EHCOES AS ^M
|
||
MOVEI D,^J
|
||
XCT @(P) ;FOLLOWED BY ^J.
|
||
MOVEI D,^M ;DON'T CLOBBER D.
|
||
JRST POPJ1
|
||
|
||
IN2B: SKIPG INPTR ;INPTR -1 FOR CMD FILE,
|
||
.IOT COMC,D
|
||
SKIPL INPTR ;FOR VALRET, IS BYTE POINTER
|
||
ILDB D,INPTR
|
||
ANDI D,177 ;MASK TO 7 BITS
|
||
EXCH D,LIMBO
|
||
CAIE D,^M ;IF PREV. CHAR WAS ^M,
|
||
JRST IN2C
|
||
MOVE D,LIMBO
|
||
CAIN D,^J ;IGNORE ^J AFTER ^M.
|
||
JRST IN2B
|
||
IN2C: MOVE D,LIMBO
|
||
CAIN D,^L ;IGNORE FORMFEED.
|
||
JRST IN2B
|
||
POPJ P,
|
||
|
||
IN2: PUSHJ P,IN2B ;READ 1 CHAR FROM FILE OR VALRET STRING.
|
||
SKIPG INPTR ;IF IN XCT FILE, ^C TERMINATES.
|
||
CAIE D,^C
|
||
SKIPN LIMBO ;^@ TERMINATES FILES AND VALRETS.
|
||
JRST IN3
|
||
SKIPE INNCTL
|
||
JRST IN2D ;DON'T CHECK FOR ^B ETC IN FALSE CONDIT.
|
||
PUSHJ P,TYI3B ;SET OR CLEAR VARIOUS FLAGS
|
||
JRST IN2 ;CHAR READ WAS ^V, ETC, TRY AGAIN.
|
||
IN2D: CALL ECHOT ;IF CHAR SHOULD ECHO,
|
||
CALL TOUT ;SIMULATE THAT.
|
||
JRST TYOFRC
|
||
|
||
;PEEK AT A CHARACTER FROM THE INPUT FILE OR VALRET STRING AND SKIP,
|
||
;OR DON'T SKIP IF GETTING CHARS. FROM TTY
|
||
RTYIC: SKIPN INPTR ;IF GETTING CHARACTERS FROM TTY,
|
||
POPJ P, ;THEN JUST RETURN
|
||
SKIPGE UNRCHF ;IF CHARACTER SAVED,
|
||
JRST RTYIC2 ;THEN USE IT (LEAVE UNRCHF ALONE)
|
||
PUSHJ P,IN2B ;ACTUALLY GET THE CHAR.
|
||
CAIE D,3 ;IF NOT CONTROL C,
|
||
JUMPN D,RTYIC3 ;AND NOT ZERO, THEN USE IT, SET UNRCHF, AND SKIP-RETURN
|
||
JRST INPOP ;END IT, DON'T LOOK AT NEXT ONE.
|
||
|
||
RTYIC2: MOVE D,LIMBO ;RECOVER CHARACTER
|
||
JRST CPOPJ1 ;SKIP-RETURN
|
||
|
||
RTYIC3: SETOM UNRCHF ;TELL INPUT ROUTINE TO USE IT
|
||
SETOM UNECHF ;TELL INPUT ROUTINE TO ECHO IT
|
||
JRST CPOPJ1
|
||
|
||
TYO1: SKIPE LPTOPN ;COME IF TTY OUTPUT OFF,
|
||
SKIPE LPTFLG ;IS LPT OUTPUT ON AND LPT OPEN?
|
||
SKIPN MORPRP ;NO, FLUSH IF MORE-PROCCING.
|
||
RET
|
||
SKIPE TYOUNI ;IF WE ARE TYPING A **MORE**,
|
||
RET ;DON'T FLUSH THE TYPEOUT - WOULD LEAVE INTS DEFERRED, ETC.
|
||
TYOFLS: MOVEM P,FLSOPP
|
||
MOVE P,MORPRP ;RESTORE PDL AND PC TO
|
||
MOVEM P,FLSNPP
|
||
SETZM MORPRP
|
||
JRST @MORRET ;VALUES SET UP BY MORINI.
|
||
|
||
LPTR: SKIPE LPTOPN ;OUTPUT CHAR IN D TO LPT IF OPEN & ON.
|
||
SKIPE LPTFLG
|
||
RET
|
||
.IOT LPTC,D
|
||
POPJ P,
|
||
|
||
LCT: 7TYPE [ASCIZ / /]
|
||
POPJ P,
|
||
|
||
;; type out a word as sixbit without any 1'...' stuff, for init files
|
||
k6type: call getnum ;get a number to hack
|
||
save ttyflg ;we're going to let this go through even if TTY is off
|
||
sosge ttyflg ;(only if it's off once)
|
||
setzm ttyflg ; If it was already on, don't let go negative
|
||
move d,a ;get the arg in right place for SIXTYP
|
||
skipn ttyflg ;unless it was off more than once
|
||
call sixtyp ; type it, with no space
|
||
rest ttyflg ;restore the flag to it's old state
|
||
jrst nltl2 ;return and prompt.
|
||
|
||
getnum: call ronum ;read in the number to type
|
||
jrst altdqx ; rubbed out, abort
|
||
skipn b ;if we weren't given anything
|
||
move a,lwt ; use Q instead
|
||
ret
|
||
|
||
;; temporary hack, type a word as 8bit bytes ascii!
|
||
k8type: call getnum ;get a number to type
|
||
call terpri
|
||
move b,[441000,,A] ;pointer into A
|
||
repeat 4,[
|
||
ildb d,b ;get a character
|
||
trne d,200 ;extra bit on?
|
||
ctype "~ ; yes, indicate it
|
||
trnn d,200 ;otherwise
|
||
ctype 40 ; keep alignment
|
||
ctype (d)] ;type the character
|
||
ctype ^I ;tab over
|
||
jrst gsnlrt ;and that's all!
|
||
|
||
;; New line on the TTY if needed. For init files.
|
||
kterpri:
|
||
save ttyflg
|
||
sosge ttyflg ;let this go through even if TTY is off
|
||
setzm ttyflg
|
||
skipn ttyflg
|
||
call terpri ; and terpri
|
||
rest ttyflg ;restore the flag to it's old state
|
||
jrst nltl2 ;return and prompt (prompting only if TTY is on!)
|
||
|
||
terpri: save d
|
||
save u7tctn ;don't clobber, but
|
||
setom u7tctn ;it would best to allow ^P codes
|
||
movei d,^P
|
||
call tout
|
||
movei d,"A
|
||
call tout
|
||
rest u7tctn ;unclobber
|
||
jrst popdj
|
||
|
||
;; type an unconditional carriage return
|
||
CRF: PUSH P,D
|
||
MOVEI D,^M
|
||
PUSHJ P,TOUT
|
||
MOVEI D,^J
|
||
PUSHJ P,TOUT
|
||
JRST POPDJ
|
||
|
||
;; MBYFF does a clear-to-EOF-and-home if too near the bottom of the
|
||
;; screen to trigger a --MORE--
|
||
|
||
mbyff: tscall pcpntr ;get the current vpos
|
||
hlrzs d
|
||
sub d,ttymxv ;get - # of lines from bottom
|
||
camge d,[-7] ;if it's far enough to cause a --MORE--
|
||
ret ; don't clear the screen
|
||
7type [asciz /ETL/] ;Otherwise wind our way around to the top
|
||
ret
|
||
|
||
FORMF: SKIPE SCROLL ;CLEAR SCREEN IF NON-SCROLLING DPY, ELSE CRLF.
|
||
JRST CRF
|
||
FORMFA: 7TYPE [ASCIZ/C/] ;SIMILAR, BUT CLEAR SCREEN EVEN IF IN SCROLL MODE.
|
||
SETOM RADCLR ;THIS CLEARS OUT THE RAID REGISTERS.
|
||
RET
|
||
|
||
;;; TOUT takes a character in D, and types it.
|
||
|
||
TSPC: MOVEI D,40 ;TYPE A SPACE
|
||
TOUT: SKIPE TOUTXQ ;OUTPUT THE CHARACTER IN A, TO WHEREVER OUTPUT IS GOING
|
||
JRST [ XCT TOUTXQ ? RET] ;USE THE SPECIAL OUTPUT ROUTINE IF ANY.
|
||
SKIPE MORPRP ;IF DOING --MORE-- PROC,
|
||
CALL HAKKAN ;PROCESS QUEUED HAKKAH RQ'S IF ANY.
|
||
CALL LPTR ;OUTPUT CHAR TO LPT IF APPRO.
|
||
SKIPN SILNT ;IS OUTPUT BEING SENT TO TTY?
|
||
SKIPE TTYFLG
|
||
JRST TYO1 ;NO; SEE IF OUTPUT IS GOING ANYWHERE AT ALL.
|
||
SKIPE U7TCTN ;IN A 7TYPE, AFTER A ^N, CURSOR CTL CODES ARE ALLOWED.
|
||
JRST TYOFI1
|
||
;OUTPUT CHAR. IN A TO THE TTY.
|
||
TYO2: CAIN D,^P ;FOR ^P, TO AVOID CURSOR CTL,
|
||
JRST [ CALL TYOFI1 ;OUTPUT "^PP" WHICH MEANS "SEND A ^P".
|
||
MOVEI D,"P
|
||
CALL TYOFI1
|
||
MOVEI D,^P
|
||
RET]
|
||
TYOFI1: SKIPE TYOUNI ;UNIT MODE TYPEOUT NEEDED? (BECAUSE WE ARE WITHIN MORINT)
|
||
JRST TYOFI2
|
||
SOSGE TYOCNT
|
||
CALL TYOFR0 ;NO SPACE => EMPTY BUFFER AND RETURN TO TYOFI1.
|
||
IDPB D,TYOPNT
|
||
RET
|
||
|
||
TYOFI2: SKIPN SILNT
|
||
TYOFR3: SYSCAL IOT,[%CLIMM,,TYOC ? D ? %CLBIT,,%TJMOR]
|
||
JFCL
|
||
RET
|
||
|
||
;EMPTY OUT THE TTY OUTPUT BUFFER, AND RETURN TO THE INSN
|
||
;BEFORE THE CALL. ASSUME TYOCNT HAS BEEN SOS'D ONCE TOO MANY.
|
||
TYOFR0: SOS (P)
|
||
SOS (P)
|
||
AOS TYOCNT
|
||
TYOFRC: SKIPE DDTTY ;PREVENT HANGING UP ON IOT IN HERE
|
||
SKIPE TYOUNI ;IF OUTPUTTING IN UNIT MODE, DON'T NEED TO FORCE.
|
||
RET
|
||
SAVE A ;EMPTY THE TTY OUTPUT BUFFER.
|
||
MOVN A,TYOCNT
|
||
ADDI A,TYOBFL*5 ;# CHARS NOW IN BUFFER.
|
||
JUMPE A,POPAJ
|
||
SAVE B
|
||
MOVE B,[440700,,TYOBUF]
|
||
SKIPN SILNT
|
||
TYOFR2: SYSCAL SIOT,[%CLIMM,,TYOC ? B ? A]
|
||
JFCL
|
||
REST B
|
||
TYOFR1: MOVEI A,TYOBFL*5 ;RE-INIT ALL BUFFER INFO.
|
||
MOVEM A,TYOCNT
|
||
MOVE A,[010700,,TYOBUF-1]
|
||
MOVEM A,TYOPNT
|
||
JRST POPAJ
|
||
|
||
POPW1J: POP P,W1
|
||
POPJ P,
|
||
|
||
;CALL MORINI ;WHEN STARTING TO TYPE A FILE, ETC.
|
||
; RETURN HERE WHEN FLUSH WITH STACK RESTORED.
|
||
;RETURN HERE IMMEDIATELY.
|
||
MORINI: POP P,D ;RET. ADDR.
|
||
MOVEM D,MORRET ;SAVE IN CASE FLUSHED.
|
||
MOVEM P,MORPRP ;RESTORE P, TOO.
|
||
JRST 1(D) ;SKIP IN-CASE-FLUSHED INSN.
|
||
|
||
;SEARCHES CALL HERE. NO SKIP => SEARCH SHOULD BE TERMINATED.
|
||
OUTTST: AOSN CTLDFL ;IF ^D HAS BEEN SEEN AT INT. LVL, STOP.
|
||
RET
|
||
SKIPE LPTOPN ;IF OUTPUT IS GOING NOWHERE, STOP.
|
||
SKIPE LPTFLG
|
||
CAIA
|
||
JRST POPJ1
|
||
SKIPN SILNT
|
||
SKIPE TTYFLG
|
||
RET
|
||
JRST POPJ1
|
||
|
||
;;;Logging in.
|
||
|
||
NALTU: JUMPN D,NALTU2 ;Check for U prefix arg (a uname).
|
||
SKIPN CONFRM ;If missing, means reload this user.
|
||
JRST NALTU1 ;Only require confirmation if user wants it.
|
||
PUSHJ P,RIN ;Read confirmation character.
|
||
JRST ALTDQX ; If rubout, retype the U.
|
||
CAIE D,". ;Confirmed?
|
||
JRST NXERR ; No, abort.
|
||
NALTU1: CALL LOGOU3 ;If running jobs, let user change his mind.
|
||
JRST NLTL2
|
||
RELOAD: SYSCAL RELOAD,[%CLIMM,,-1]
|
||
.VALUE ; Reload fails if not top level.
|
||
ERLOSS ;RELOAD doesn't return.
|
||
|
||
NALTU2: TLNE B,O.IFX ;Infix arg (CSTACY1U)?
|
||
JUMPN A,[CALL RTYIC ; Yes, turn TTY on and eliminates any empty
|
||
JFCL ; valrets/xfiles from the stack.
|
||
SETZM TTYFLG
|
||
JRST KLOGI1] ; Does not indicate we are a winner.
|
||
SETZM CLOBRF ;Normally, U implies a sophisticated user.
|
||
SETZM MORWARN
|
||
SETOM C.ZPRT
|
||
JRST KLOGI1
|
||
|
||
KLOGIN: PUSHJ P,RTOKEN ;:LOGIN needs to read uname.
|
||
JUMPE B,KLOGIN ;If none, try again.
|
||
MOVE C,B ;C gets desired uname.
|
||
KLOGI1: SKIPE LOGDIN ;Logged in already?
|
||
JRST KLOGI2 ; No, so can try.
|
||
7TYPE [ASCIZ /
|
||
Already logged in as "/]
|
||
MOVE D,RUNAME ;Complain if already logged in.
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ /"/]
|
||
|
||
KLOGI2: CALL MASACL ;Noisily massacre any jobs.
|
||
SAVE C ;Stash uname on stack.
|
||
CALL DDTUN0 ;Compute the xuname and hsname.
|
||
REST C ;Recover uname.
|
||
SYSCAL LOGIN,[C ? TRMNAM ? XUNAME ? %CLERR,,A] ;Try to login.
|
||
CAIA
|
||
JRST KLOGI6
|
||
CAIN A,%EBDFN ;Trying to log in as ___xxx or something?
|
||
7TYPE [ASCIZ "Illegal UNAME"]
|
||
CAIN A,%ENSMD ;Inferiors around?
|
||
ERLOSS ; Should have already been killed.
|
||
CAIN A,%EROJB ;Already logged in?
|
||
ERLOSS ; LOGDIN must be confused.
|
||
CAIN A,%ETOP ;Not top level?
|
||
7TYPE [ASCIZ "Not top level"]
|
||
CAIE A,%EEXFL ;Uname already in use?
|
||
ERLOSS ; No - some unknown failure mode.
|
||
MOVE B,[440600,,C] ;Try to uniquify the uname.
|
||
KLOGI3: ILDB D,B ;Get char from it.
|
||
JUMPE D,KLOGI4 ;Look for a blank to make into a number.
|
||
TLNE B,770000 ;Check all six chars.
|
||
JRST KLOGI3 ;If no blanks, clobber the 6th character.
|
||
KLOGI4: MOVEI D,'0 ;CSTACY will become CSTAC0.
|
||
KLOGI5: DPB D,B ;Permute the uname.
|
||
SYSCAL LOGIN,[C ? TRMNAM ? XUNAME ? %CLERR,,A] ;Try again.
|
||
JRST [ CAIE A,%EEXFL ; We expect only this error.
|
||
JRST NXERR ; Otherwise just barf mysteriously.
|
||
AOJA D,KLOGI5 ] ; Keep AOS'ing until login succeeds.
|
||
MOVE D,C ;Print out uname we finally succeeded with.
|
||
CALL NUTYP2
|
||
KLOGI6: .SUSET [.SHSNAME,,HSNAME] ;Fix vars LOGIN call screwed up.
|
||
CALL DDTUN1 ;Take note that uname has changed.
|
||
MOVE D,MSNAM
|
||
CAMN D,XUNAME ;If MSNAME set by DDTUNM to other than real uname
|
||
JRST [ CALL KINTAC ; Now offer to attach a detached tree, etc.
|
||
ERLOSS ; Shouldn't fail?
|
||
JRST .+1 ] ;Continue.
|
||
MOVE B,(W4)
|
||
TLNE B,O.IFX
|
||
SKIPE -1(W4) ;If this is not NAME$0U, look for init file.
|
||
JRST KINTE3
|
||
;For 0U, do the default things as if no init file.
|
||
KLOGI7: MOVE B,XUNAME
|
||
MOVE C,ITSNAM ;Tell PRMLOP to only look on this ITS!
|
||
call prmlop ;try to open mail file on dsk or com.
|
||
JRST KLOGI8 ;FAILED.
|
||
;WIN - A HAS "DSK" OR "COM",
|
||
;USED BY PRML2 TO DELETE AND RENAME.
|
||
MOVEI D,MORDMS ;TYPE "POSTPONED" INSTEAD OF "FLUSHED"
|
||
MOVEM D,MORMSG ;IF USER FLUSHES THE --MAIL--.
|
||
7TYPE [ASCIZ/--Mail--/]
|
||
CALL MORFL4 ;ASK USER WHETHER HE WANTS TO SEE THE MAIL.
|
||
JRST KLOGI8
|
||
CALL PRML2
|
||
KLOGI8: .CLOSE FDRC, ;IN CASE PRMLOP SUCCEEDED BUT USER FLUSHED.
|
||
SETOM MSGLOG
|
||
SETOM TOKTRM ;PREVENT AN ATTEMPT TO READ ARGS FOR THE :MSGS.
|
||
JRST MSGSL
|
||
|
||
MORDMS: ASCIZ/Postponed/
|
||
|
||
|
||
;:CHUNAM <UNAME> - CHANGE UNAME TO <UNAME>.
|
||
KCHUNAM:MOVE D,LOGDIN
|
||
AOJE D,LOGQ ;If not logged in yet, use "LOGIN".
|
||
move d,itsnam
|
||
camn d,[sixbit/mc/]
|
||
jrst [move d,[sixbit/rms/]
|
||
came d,xuname
|
||
jrst .+1 ;nope
|
||
; 7type [asciz/ACHUNAM not permited to RMS@MC/]
|
||
7type [asciz/ACHUNAM Invalid/]
|
||
jrst nltl4]
|
||
CALL RTOKEN ;Read desired new UNAME.
|
||
JUMPE B,.-1
|
||
MOVE C,B ;C gets UNAME.
|
||
7TYPE [ASCIZ /--Massacre and Reset--/]
|
||
MOVEI D,[ASCIZ/Rescued
|
||
/]
|
||
MOVEM D,MORMSG
|
||
CALL MORFL1
|
||
JRST NLTL4
|
||
CALL LOGOU3 ;Maybe kill running jobs?
|
||
JRST ERR ; Not confirmed.
|
||
CALL MASACL ;Massacre all jobs.
|
||
SETZM BYERUN ;Don't run the BYE program.
|
||
CALL KOUTT2 ;Flush SENDS and OMAIL files as if logging out.
|
||
.SUSET [.SUNAM,,C] ;Must be toplevel else will ILUUO.
|
||
KCHUN1: .SUSET [.SXUNAM,,C] ;Interrupt rtns look for KCHUN1 as saved PC.
|
||
CALL DDTUN0 ;Compute our XUNAME from the new UNAME.
|
||
SYSCLE TRANCL,[[600000,,-1]] ;Flush all translations.
|
||
SYSCAL CNSGET,[%CLIMM,,TYIC ? %CLOUT,,A ? %CLOUT,,B ? %CLOUT,,C
|
||
%CLOUT,,D ? %CLOUT,,W1]
|
||
JRST RELOAD
|
||
TLZ W1,%TOCLC+%TOROL+%TOSA1
|
||
TLO W1,%TOMOR
|
||
TLZ D,%TCQRY+%TCRFS+%TCOCO+%TCICO
|
||
SYSCLO CNSSET,[%CLIMM,,TYIC ? A ? B ? C ? D ? W1]
|
||
JRST RELOAD ;Go reload ourselves.
|
||
|
||
|
||
;IF THERE ARE ANY JOBS, KILL THEM AND TYPE ":MASSACRE"
|
||
MASACL: SAVE C
|
||
SKIPA C,[-NINFP,,]
|
||
MASAC5: ADDI C,USRLNG-1
|
||
SKIPN UUNAME(C)
|
||
AOBJN C,MASAC5
|
||
JUMPGE C,MASAC8 ;NO JOBS TO KILL - DON'T FRIGHTEN USER.
|
||
7TYPE [ASCIZ/:MASSACRE /]
|
||
CALL MASAC1 ;FOUND AT LEAST 1 JOB - KILL ALL, AND TELL USER.
|
||
MASAC8: MOVSI C,400000
|
||
MASAC6: .UTRAN C ;NOW FIND ALL FORGOTTEN JOBS AND KILL THEM.
|
||
JRST MASAC7 ;TRY EACH INT BIT TO SEE IF A JOB HAS IT.
|
||
SYSCAL OPEN,[%CLIMM,,FDRC ? ['USR,,] ? C+1 ? C+2]
|
||
ERLOSS
|
||
.UCLOSE FDRC,
|
||
JFCL
|
||
MASAC7: LSH C,-1
|
||
TRZ C,-1
|
||
JUMPN C,MASAC6
|
||
JRST POPCJ
|
||
|
||
|
||
;:INTEST COMMAND.
|
||
KINTES: CALL KINTAC ;FIRST, OFFER TO ATTACH ANY HEALTHY DETACHED JOB.
|
||
ERLOSS
|
||
KINTE1: move c,xuname ;calculate MSNAME, SNAME, HSNAME from XUNAME
|
||
movem c,xfilef+1 ;Set the FN1 of the XFILE default
|
||
call gethsn ;get the HSNAME
|
||
jfcl
|
||
movem c,hsname
|
||
.suset [.shsname,,c]
|
||
movem c,msnam
|
||
movem c,lsnam
|
||
movem c,xfilef+3 ;set the directory to get XFILE's from
|
||
.suset [.ssnam,,c]
|
||
SKIPE INPTR ;:INTEST INSIDE VALRET OR FILE DOES THE "NORMAL" STUFF
|
||
JRST KLOGI7 ; :PRMAIL AND :MSGS.
|
||
KINTE3: MOVE C,[SIXBIT /LOGIN/]
|
||
CALL KINTE2 ;TRY TO OPEN INIT FILE ON FDRC.
|
||
JRST KLOGI7 ;NO INIT FILE, TRY TO PRINT MAIL AND MSGS.
|
||
|
||
move d,xuname ;there's an init file. but if <xuname> # <uname>,
|
||
camn d,runame ;ask the user before using the init file.
|
||
jrst xfile1
|
||
syscle RFNAME,[%climm,,fdrc ? %clout,,c ? %clout,,w1 ? %clout,,c
|
||
%clout,,d] ;get the
|
||
came w1,[sixbit /*/] ; if it's the naive init, don't even ask!
|
||
jrst kinte4 ; (i.e. is it USERS1;* LOGIN ?)
|
||
came d,[sixbit /GUEST1/]
|
||
camn d,[sixbit /USERS1/]
|
||
jrst xfile1
|
||
kinte4: 7TYPE [ASCIZ/--Init--/]
|
||
CALL MORFL1
|
||
JRST [ .CLOSE FDRC, ;HE DOESN'T WANT HIS INIT FILE; DON'T WASTE DISK CHANNEL.
|
||
JRST NLTL2]
|
||
JRST XFILE1 ;USER SAYS YES; USE THE INIT FILE.
|
||
|
||
;LOOK FOR INIT FILE (C HAS LOGIN) OR EXIT FILE (C HAS LOGOUT).
|
||
|
||
kinte2: syscal open,[%climm,,fdrc ? ['DSK,,]
|
||
xuname ? c ? hsname] ;try <hsname>;xuname DDT
|
||
caia
|
||
jrst popj1 ;That's it!
|
||
syscal open,[%climm,,fdrc ;Not there, try HSNAME;* DDT
|
||
['DSK,,]
|
||
[sixbit /*/] ? c ? hsname]
|
||
ret ; no init at all!
|
||
jrst popj1 ;init file! (Even if it IS the default!)
|
||
|
||
|
||
;IF THERE IS A HEALTHY DETACHED JOB BELONGING TO THIS USER,
|
||
;OFFER TO ATTACH IT, AND DO SO IF THE USER SAYS YES (SPACE).
|
||
;OTHERWISE, KINTAC RETURNS SKIPPING.
|
||
KINTAC: MOVE C,['HACTRN]
|
||
SETZB D,A
|
||
KINTAL: SYSCAL OPEN,[[10,,FDRC] ? ['USR,,] ? RUNAME ? C]
|
||
JRST KINTA1
|
||
.USET FDRC,[.RAPRC,,B]
|
||
JUMPGE B,KINTA1
|
||
ADDI D,1 ;RH(D) GETS COUNT OF RUNNING DETACHED TREES WE HAVE.
|
||
.USET FDRC,[.RUSTP,,B]
|
||
TLNN B,BUSRC ;IS THIS ONE RUNNABLE?
|
||
SKIPA A,C ;YES, A GETS JNAME OF HIGHEST-NAMED RUNNING ONE
|
||
ADD D,[<1,,>-1] ;NO, LH(D) COUNTS THE STOPPED DETACHED TREES.
|
||
KINTA1: ADDI C,1
|
||
CAME C,['HACTRT]
|
||
JRST KINTAL
|
||
TLZE D,-1 ;ARE THERE ANY STOPPED DETACHED TREES?
|
||
7TYPE [ASCIZ /You have at least one dead detached tree.
|
||
/]
|
||
JUMPE D,POPJ1 ;ANY RUNNING DETACHED TREES?
|
||
.SUSET [.RSUPPR,,B] ;YES => OFFER TO ATTACH ONE, IF WE'RE TOP LEVEL.
|
||
TSOPEN TYIC,[['TTY ? 0]]
|
||
JUMPGE B,[7TYPE [ASCIZ /You have one or more attachable trees
|
||
/]
|
||
JRST POPJ1]
|
||
MOVEI B,[ASCIZ /--Attach Your Detached Tree--/]
|
||
CAIE D,1
|
||
MOVEI B,[ASCIZ /You have several attachable detached trees.
|
||
--Attach A Detached Tree--/]
|
||
7TYPE (B)
|
||
MOVEI D,[ASCIZ/Left Detached
|
||
/]
|
||
MOVEM D,MORMSG
|
||
CALL MORFL1
|
||
JRST POPJ1 ;COME HERE IF THE USER FLUSHED THE QUERY; ELSE
|
||
SETZ C, ;TRY TO ATTACH. A HAS THE JNAME.
|
||
MOVE D,A
|
||
SAVE D
|
||
CALL NJTYP2 ;SAY WHICH JOB WE ARE TRYING TO ATTACH.
|
||
REST D
|
||
SETZM REOWNF
|
||
movei a,%urfrn ;if it used to be a foreign-only job, undo that
|
||
andcam urandm(u) ;by clearing the magic bit that prevents reowning
|
||
CALL OUSRNL ;OPEN AND REOWN IT,
|
||
SKIPE UINT(U) ;AND UNLESS IT HAS STOPPED SINCE WE LOOKED,
|
||
JRST [ CALL MRDR
|
||
7NRTYP [ASCIZ /Oops! Couldn't attach it?/]]
|
||
JRST KATTAC ;GO :ATTACH TO IT.
|
||
|
||
kprmai: skipn toktrm
|
||
jrst prml6
|
||
kprma2: move a,[sixbit /MAIL/] ;looking for MAIL files
|
||
move b,xuname ;looking for OUR mail
|
||
move c,itsnam ;look only on this ITS
|
||
call gtmail ;open the mail file
|
||
jrst prml5 ; no mail!
|
||
call fdrco1 ;initialize buffering
|
||
prml2: save a
|
||
setom fdrcls ;actually print them, but don't close FDRC
|
||
call ctlf1a
|
||
rest a
|
||
skipn fdrcls ;If FDRCLS is 0, a --MORE-- was flushed during typout
|
||
jrst nltl2 ; so don't bother him any more
|
||
skiple omailf ;Does he never want it deleted?
|
||
jrst prml4 ; Don't offer
|
||
skipe omailf ;does he want it renamed?
|
||
jrst [syscal DELETE,[ [sixbit /DSK/] ? xuname ? [sixbit /OMAIL/]
|
||
hsname]
|
||
jfcl
|
||
syscal RENMWO,[ %climm,,fdrc ? xuname ? [sixbit /OMAIL/]]
|
||
jrst prml4
|
||
jrst prml4]
|
||
prmtyp: 7type [asciz /ADelete this mail? (Y or N) /]
|
||
call tyofrc
|
||
call tyi3 ;get a character
|
||
jfcl
|
||
cail d,140 ;is the lowercase?
|
||
subi d,40 ; yes, uppercasify
|
||
cain d,"N ;did he say no?
|
||
jrst [ 7type [asciz /AMail Saved.
|
||
/]
|
||
jrst prml4]
|
||
caie d,"Y ;did ye say yes?
|
||
jrst prmtyp ; no, neither yes nor no, must be confused.
|
||
syscal delewo,[%climm,,fdrc] ;delete it!
|
||
jfcl
|
||
7type [asciz /ADeleted.
|
||
/]
|
||
prml4: .close utic, ;close the channel
|
||
.close fdrc, ;close the channel
|
||
setzm fdrcls
|
||
jrst nltl2
|
||
|
||
PRML5: call terpri
|
||
SKIPE GETTY
|
||
7TYPE [ASCIZ /No Mail/]
|
||
JRST nltl2
|
||
|
||
ifn 0,[ ;Old way, with MAIL files on COMMON; or <user>;
|
||
PRMLO: SETZ ? SIXBIT/OPEN/
|
||
%CLBIT,,.bai
|
||
%CLIMM,,FDRC
|
||
a ? d ? mlfl ? setz d
|
||
|
||
] ; End IFN 0, -- Old way, with MAIL files on COMMON; or <user>;
|
||
|
||
|
||
; PRMLRO (for RMAIL/BABYL) and PRMLOP (for MAIL).
|
||
;Try to open mail file for user with name in d. skip if succeed.
|
||
;Return in a the device for the new mail file (whether succeed or not).
|
||
;clobbers b. If file is opened, the fdrc buffer is set up.
|
||
;C is expected to contain the ITS to look on, initially or 0 meaning whichever
|
||
;is right for the user in D.
|
||
|
||
prmlro: move a,[sixbit /RMAIL/] ;Initialize to read RMAIL, not MAIL.
|
||
call gtmail
|
||
jrst [ move a,[sixbit /BABYL/]
|
||
call gtmail ;Maybe the user likes BABYL instead.
|
||
ret
|
||
jrst .+1]
|
||
aos (p)
|
||
jrst fdrco1
|
||
|
||
prmlop: move a,[sixbit /MAIL/] ;initialize to read MAIL, not RMAIL
|
||
IFN 0,[ ;The old way, with MAIL on COMMON or <user>;
|
||
prmlo1: movem a,mlfl
|
||
movsi a,'DSK ;try DSK first
|
||
.call prmlo ;try it
|
||
CAIA
|
||
JRST PRML7 ;DSK:USER;USER MAIL FOUND.
|
||
.STATUS FDRC,B ;NOT FOUND; IF DISK DIR EXISTS,
|
||
LDB B,[OPNLBP,,B]
|
||
movsi a,'COM ;NO DISK DIR, OR NOT TRYING DISK, => TRY COM
|
||
.CALL PRMLO
|
||
JRST PRML8 ;NO OLD MAIL FILE =>
|
||
PRML7: AOS (P)
|
||
JRST FDRCO1
|
||
|
||
PRML8: CAIE B,%ENSDR ;USE DISK UNLESS DISK DIR DOESN'T EXIST.
|
||
movsi a,'DSK
|
||
RET
|
||
] ;END IFN 0 -- End of old way of having mail files on COMMON or <user>
|
||
|
||
ifn 1,[ ;New way, with mail files on <hsname>;
|
||
prmlo1: call gtmail ;open the mail file
|
||
ret ; not found, just return
|
||
aos (p) ;Found it, skip return
|
||
jrst fdrco1
|
||
] ; End IFN 1, -- end of new way of having mail files on <HSNAME>;<xuname> mail
|
||
|
||
prml6: call rmtoke ;read FOO@MC type spec
|
||
prml6a: jumpe b,kprmai ;If no user was specified, do :PRMAIL<cr>
|
||
skipn toktrm ;if there was no cr echoed, output one
|
||
call crf ;so things look nice.
|
||
move c,a ;wants machine in C
|
||
move a,[sixbit /MAIL/] ;and FN2 in A
|
||
call prmlo1 ;look for that user's mail
|
||
jrst prml5 ; not there, tell him so.
|
||
call ctlf1 ;found it => print it.
|
||
jrst nltl2 ;that's it!
|
||
|
||
kprsen: skipe toktrm ;null arg (a cr) means self.
|
||
move b,runame
|
||
setz a, ;assume no @MC found
|
||
skipn toktrm
|
||
call rmtoke ;otherwise read name and maybe machine for sends to
|
||
;read
|
||
skipn a ;no device?
|
||
movsi a,'DSK ; use DSK
|
||
kprse0: call terpri ;Type a CRLF if needed
|
||
kprseo: syscal OPEN,[[.bai,,fdrc] ? a ? b ? [sixbit /SENDS/]
|
||
[sixbit /.TEMP./] ? %clerr,,d]
|
||
jrst kprse1 ; Maybe we got the wrong directory?
|
||
|
||
kprse2: call mbyff ;FF if too near bottom to trigger a --MORE--
|
||
CALL FDRCO1 ;SET UP FDRC BUFFER FOR FDRCI.
|
||
CALL CTLF1
|
||
JRST NLTL2
|
||
|
||
KPRSE1: cain d,%ensfl ;no such file?
|
||
jrst kprse3 ; must have been right filenames
|
||
caie d,%ensdr ;no such directory?
|
||
opner @kprseo ; no, must have been some kind of lossage. Inform
|
||
syscal OPEN,[[.bai,,fdrc] ? a ? b ? [sixbit /SENDS/]
|
||
[sixbit /COMMON/]]
|
||
caia
|
||
jrst kprse2 ;aha! Machine doesn't use .TEMP.;
|
||
|
||
kprse3: SKIPE GETTY
|
||
7TYPE [ASCIZ /No Sends/]
|
||
JRST NLTL2
|
||
|
||
|
||
;;; <USER>^A prints <USER>'s sends
|
||
nctla: move b,c ;Normally, we get an uname as a prefix
|
||
move a,c ;A for MCHOKP's sake
|
||
call mchokp ;Is it an ITS?
|
||
movsi a,'DSK ; No, get from DSK:
|
||
came a,[sixbit /DSK/] ;Was that just DSK?
|
||
move b,sndflt ; No, we got machine instead, so use old uname
|
||
skipn c ;0^A means get ourself
|
||
move b,runame ; So do that
|
||
skipn d ;No argument?
|
||
move b,sndflt ; Use the default
|
||
movem b,sndflt ;Remember what send file
|
||
call terpri
|
||
came a,[sixbit /DSK/] ;Is it DSK?
|
||
camn a,itsnam ; Or this ITS?
|
||
caia
|
||
jrst ctlapr ; Neither, must print
|
||
camn b,runame ;is it ourself?
|
||
jrst kprse0 ; Yes, don't bother printing
|
||
ctlapr: 7type [asciz /(Getting SENDS for /]
|
||
move d,b ;Get the name to print
|
||
call sixtyp ;print it
|
||
came a,[sixbit /DSK/] ;Is it DSK?
|
||
camn a,itsnam ; Or this ITS?
|
||
jrst ctlapx ; Yes, no need to specify where
|
||
movei d,"@ ;Tell him where it's coming from
|
||
call tout
|
||
move d,a ;Get the ITS name to print
|
||
call sixtyp ;print it
|
||
ctlapx: ctype ") ;Balance the parens
|
||
jrst kprse0 ;and print the messages
|
||
|
||
;;; <USER>$^A prints <USER>'s mail
|
||
naca: call naca0 ;get the right user in B
|
||
came b,xuname ;if it wasn't us,
|
||
jrst naca1 ;just print it.
|
||
skipe pmlflg ;be like :PRMAIL?
|
||
jrst [call crf ;be pretty
|
||
jrst kprma2] ;print my mail.
|
||
naca1: call prmlop ;open a MAIL file
|
||
jrst prml5 ; Print out NO MAIL message
|
||
|
||
nacapr: call mbyff ;clear screen if too near bottom
|
||
call terpri ;prettify, new line
|
||
call ctlf1 ;actually print it out!
|
||
jrst nltl2
|
||
|
||
;;; <USER>$$^A reads USER's RMAIL or OMAIL
|
||
n2aca: call naca0 ;get the right user in B
|
||
call prmlro ;open the RMAIL file
|
||
jrst prml5 ; nope, don't print yet!
|
||
jrst nacapr ;print it out
|
||
|
||
naca0: move a,c ;MCHOK0 expects in A
|
||
move b,c ;Assume that we were give the XUNAME instead of device
|
||
skipn c ;0$^A means get our own
|
||
move b,xuname ; use our XUNAME instead
|
||
save b ;MCHOK0 clobbers B
|
||
skipe d ;if no arg was given
|
||
call mchok0 ; or the arg wasn't an ITS name
|
||
jrst [ setz c, ; get from whichever machine is right
|
||
rest b ;Use our original arg as the XUNAME
|
||
jrst naca01]
|
||
rest b ;Clean up the stack. This is thrown away now.
|
||
caia ; If it was an ITS, or...
|
||
naca01: skipn d ; If we had no argument
|
||
move b,sndflt ; use the default
|
||
skipn d ;If no explicit arg
|
||
move c,sndits ; use the same ITS as before
|
||
movem b,sndflt ;set the default for next time
|
||
movem c,sndits
|
||
move d,b ;we return our result in D
|
||
ret ;return
|
||
|
||
|
||
;:ATTACH - DELETE SELF LEAVING CURRENT JOB AS TOP LEVEL.
|
||
KATTAC: CALL QIJERR
|
||
SKIPN UINT(U)
|
||
SKIPE UINTWD(U)
|
||
ERSTRT [SIXBIT/NOT RUNNING?/]
|
||
CALL TTYLEV
|
||
SYSCAL ATTACH,[%CLIMM,,USRI]
|
||
JRST NTOPERR
|
||
JRST KATTA1
|
||
|
||
KOUTTE: SAVE [GSNLRT] ;:OUTTEST COMMAND.
|
||
KOUTT1: save ttyflg ;Turn tty on for asking silly
|
||
setzm ttyflg ; questions.
|
||
CALL ALRWRN ;NOTIFY USER OF ANY PENDING ALARM.
|
||
CALL SAFETY ;IF ANY INFERIORS ARE PROTECTED, GET CONFIRMATION.
|
||
CALL LOGOU3 ;IF INFERIORS RUNNING, GET CONFIRMATION.
|
||
JRST ERR
|
||
rest ttyflg ;Put tty back as it was.
|
||
SKIPE GETTY
|
||
CALL FORMFA ;CLEAR SCREEN ON DISPLAYS, EVEN IN SCROLL MODE.
|
||
KOUTT2: SYSCAL DELETE,[['DSK,,] ? RUNAME ? [SIXBIT/SENDS/] ? cladir]
|
||
JFCL
|
||
SKIPN BYERUN ;IF USER WANTS TO RUN :BYE, DO THAT
|
||
RET
|
||
CALL INPUSH ;BY SETTING UP COMMANDS TO DO IT (AND THEN FINISH LOGGING OUT).
|
||
MOVE D,[010700,,[ASCIZ /:BYE
|
||
1U/]-1]
|
||
MOVEM D,INPTR
|
||
RET
|
||
|
||
LOGOUT: MOVE C,[SIXBIT /LOGOUT/]
|
||
TLNE B,O.IFX ;$$1U => LOGOUT, DOING NEITHER INIT FILE NOR DEFAULT ACTIONS.
|
||
jrst [jumpn a,katta1
|
||
setzm byerun
|
||
call koutt1 ;perform default actions
|
||
jrst katta1]
|
||
|
||
;;This call to SAFETY seems spurious since all other paths go through
|
||
;;KOUTTE which calls SAFETY itself. Additionally this prevents users from
|
||
;;testing things like this in their LOGOUT files. -Alan 7/9/84
|
||
;; CALL SAFETY ;LETS NOT FORGET PROTECTED JOBS... (MARC - 3/25/79)
|
||
CALL KINTE2 ;ELSE LOOK FOR THE EXIT FILE.
|
||
CAIA
|
||
JRST LOGOU4 ;THERE IS ONE; XFILE IT AND THEN LOG OUT.
|
||
CALL KOUTT1 ;OTHERWISE PERFORM DEFAULT ACTIONS (=:OUTTEST).
|
||
SKIPE BYERUN ;IF BYERUN IS SET, THAT SET UP SOME COMMANDS, SO GO DO THEM.
|
||
JRST GSNLRT ;THEY INCLUDE A $$1U TO FINISH LOGGING OUT.
|
||
KATTA1: CALL TYOFRC
|
||
.LOGOUT 1, ;GOOD BYE
|
||
NTOPER: ERSTRT [SIXBIT/NOT TOP LEVEL?/]
|
||
|
||
LOGOU4: CALL INPUSH ;XFILE THE EXIT FILE, BUT, UNDER IT ON THE INPUT STACK,
|
||
MOVE D,[10700,,[ASCIZ/1U/]-1]
|
||
MOVEM D,INPTR ;ARRANGE FOR A LOGOUT TO BE EXECUTED AFTER THE EXIT FILE.
|
||
JRST XFILE1
|
||
|
||
LOGOU3: MOVSI A,NINFP ;LOOK AT ALL INFERIORS.
|
||
LOGOU1: SKIPLE INTBIT(A) ;NOT IN USE OR FOREIGN, OK.
|
||
SKIPE UINTWD(A)
|
||
JRST LOGOU2
|
||
MOVE C,UINT(U)
|
||
JUMPN C,LOGOU2 ;JOB TRYING TO RETURN => OK TO KILL IT.
|
||
MOVE D,UIACK(U)
|
||
TRNE D,60000 ;JOB TRYING TO COMMIT SUICIDE => CERTAINLY OK.
|
||
JRST LOGOU2
|
||
7TYPE [ASCIZ/--Kill Running Inferiors--/]
|
||
CALL MORFL1 ;READ FROM TTY, SKIP IF SPACE,
|
||
RET ;NOT SPACE, "FLUSHED" TYPED BY MORFL1.
|
||
JRST POPJ1 ;HE REALLY WANTS TO GO AHEAD.
|
||
|
||
LOGOU2: ADDI A,USRLNG-1
|
||
AOBJN A,LOGOU1
|
||
JRST POPJ1 ;NO RUNNING INFERIORS.
|
||
|
||
KDETAC: MOVE D,LOGDIN
|
||
AOJE D,LOGQ ;ILLEGAL UNLESS LOGGED IN.
|
||
save ttyflg ; Bind TTYFLG so that user is sure to see
|
||
setzm ttyflg ; the message.
|
||
CALL ALRWRN ;WARN USER OF ANY PENDING ALARM.
|
||
rest ttyflg
|
||
.CLOSE TYOC, ;FORCE RE-OPEN WHEN NEXT USE TTY.
|
||
SYSCLE DETACH,[%CLIMM,,-1]
|
||
JRST NLTL2 ;TYPE "*"; WILL CAUSE IOCERR WHICH WILL REOPEN TTY
|
||
;BUT THAT WILL CAUSE DTTY INTERRUPT WHICH WILL
|
||
;DETECT CHANGED UNAME.
|
||
|
||
ALRWRN: SKIPN ALARMV
|
||
RET
|
||
7TYPE [ASCIZ /--Despite Pending :Alarm--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
RET
|
||
|
||
KOFDIR:
|
||
OFDIR: SKIPE TOKTRM
|
||
JRST OFDIR4 ;J IF JUST :OFDIR^M.
|
||
PUSHJ P,RLINE
|
||
OFDIR0: SKIPE TOKTRM ;IF MORE NAMES, HANDLE ONE.
|
||
JRST NLTL2
|
||
PUSHJ P,OFDIR1
|
||
JRST OFDIR0
|
||
|
||
OFDIR1: PUSHJ P,RTOKEN ;READ NEXT NAME.
|
||
JUMPE B,CPOPJ
|
||
OFDIR5: MOVSI C,-SNLLEN ;PTR FOR FETCHING FROM SNLIST.
|
||
MOVSI A,-SNLLEN ;PTR FOR STORING BACK.
|
||
OFDIR2: MOVE D,SNLIST+1(C)
|
||
CAMN B,D
|
||
JRST OFDIR3
|
||
MOVEM D,SNLIST+1(A) ;NOT THE ONE TO DELETE - RE-STORE IT.
|
||
AOBJP A,CPOPJ
|
||
OFDIR3: AOBJN C,OFDIR2
|
||
SETZM SNLIST+1(C)
|
||
AOBJN C,.-1 ;FILL SNLIST WITH 0'S AT END.
|
||
POPJ P,
|
||
|
||
OFDIR4: SETOM SFDIR ;TURN OFF SEARCH FEATURE.
|
||
MOVSI A,-SNLLEN
|
||
SETZM SNLIST+1(A)
|
||
AOBJN A,.-1 ;CLEAR SNLIST.
|
||
JRST NLTL2
|
||
|
||
KNFDIR:
|
||
NFDIR: SETZM SFDIR ;TURN ON SEARCH.
|
||
SKIPE TOKTRM
|
||
JRST NLTL2
|
||
PUSHJ P,RLINE
|
||
NFDIR0: SKIPE TOKTRM
|
||
JRST NLTL2
|
||
CALL RTOKEN ;READ NAME,
|
||
CALL NFDIR1 ;PUT IT IN SNLIST.
|
||
JRST NFDIR0
|
||
|
||
NFDIR1: JUMPE B,CPOPJ
|
||
CALL OFDIR5 ;DELETE FROM SNLIST,
|
||
MOVSI D,1-SNLLEN ;ADD TO FRONT,
|
||
EXCH B,SNLIST+1(D) ;MOVE REST DOWN.
|
||
AOBJN D,.-1
|
||
RET
|
||
|
||
;THIS IS THE DIRECTORY-SEARCHING FILE OPEN ROUTINE.
|
||
;B should point to a vector containing the DEVICE, FN1 and FN2, as sixbit whole
|
||
;words. DDT's current sname should be the one to try first.
|
||
;it is tried, followed by all the SNAMEs in the two search lists.
|
||
;FLOCK skips if the file is successfully opened.
|
||
;In that case, SNLIST contains the SNAME that worked.
|
||
;the .SNAME variable is always restored to its original value.
|
||
|
||
FLOCK: .SUSET [.RSNAM,,SNLIST]
|
||
SETOM SRFLAG
|
||
MOVE A,[.SSNAM,,SNLIST]
|
||
MOVEM A,INSNAM
|
||
FLO2: .SUSET INSNAM ;TRY THIS DIRECTORY
|
||
.CALL FLOCKO
|
||
JRST FLO4
|
||
HRRZ D,INSNAM
|
||
MOVE D,(D) ;REALLY WANTS WHAT POINTS TO
|
||
AOS (P)
|
||
CAMN D,SNLIST
|
||
JRST FLO5
|
||
MOVEM D,SNLIST ;IF SKIP RETURN, SNLIST HAS SNAME USED.
|
||
SKIPN NFVRBS ;If use wants us to be quiet,
|
||
JRST FLO3 ; do not tell about changed directories.
|
||
PUSHJ P,SIXTYP ;Else loser changed directory, tell him.
|
||
CTYPE ";
|
||
PUSHJ P,CRF
|
||
FLO3: SETZM SRFLAG
|
||
JRST CPOPJ
|
||
|
||
FLO4: MOVE D,(B)
|
||
CAME D,['DSK,,] ;SEARCH-LIST FEATURE ENABLED ONLY FOR DSK,
|
||
CAMN D,ITSNAM ;OR FOR AN EQUIVALENT OF DSK.
|
||
SKIPE SFDIR ;TRY SEARCH CROCK?
|
||
POPJ P, ;FAILED, NO SKIP
|
||
PUSHJ P,FLOERR ;UNLESS FILE NOT FOUND, REALLY AN ERROR.
|
||
OPNER FLOCKO
|
||
AOS INSNAM
|
||
HRRZ D,INSNAM
|
||
SKIPE (D) ;IF MORE IN THIS TBL, TRY THEM.
|
||
JRST FLO2
|
||
CAIG D,SNLIS1 ;IF WERE SEARCHING 1ST, TRY 2ND.
|
||
JRST FLO6
|
||
FLO5: .SUSET [.SSNAM,,LSNAM]
|
||
SETZM SRFLAG
|
||
POPJ P, ;FAIL, NO SKIP
|
||
|
||
FLO6: MOVEI D,SNLIS1
|
||
HRRM D,INSNAM
|
||
JRST FLO4
|
||
|
||
SMFLCK: MOVS A,UFILE(U)
|
||
CAIN A,(SIXBIT /TTY/)
|
||
TERR (SIXBIT /DEV/)
|
||
RET
|
||
|
||
FLOERR: .STATUS UTIC,A
|
||
LDB A,[OPNLBP,,A]
|
||
CAIE A,%ENSDR ;BAD SNAME?
|
||
CAIN A,%ENSFL ;FILE NOT FOUND?
|
||
JRST CPOPJ1
|
||
RET ;ALL OTHERS ARE REALLY BAD.
|
||
|
||
FLOCKO: SETZ ? SIXBIT/OPEN/
|
||
[6,,UTIC]
|
||
(B)
|
||
1(B)
|
||
SETZ 2(B)
|
||
|
||
;$$J AND JNAME$$J COMMANDS HERE.
|
||
N2AJ: JUMPE D,N2AJ1
|
||
PUSHJ P,QIJERR ;N$$J
|
||
CAMN C,[SIXBIT/PDP6/]
|
||
JRST NAERR
|
||
CAME C,[SIXBIT /PDP10/]
|
||
CAMN C,[SIXBIT /SYS/]
|
||
JRST NAERR ;NOT SYS
|
||
CAMN C,UJNAME(U)
|
||
JRST NLTL2 ;DON'T BARF AT RENAMING JOB TO SAME NAME AS NOW.
|
||
MOVE A,[10,,(SIXBIT/USR/)]
|
||
MOVE B,UUNAME(U) ;TRY OPEN NEW NAME AS FOREIGN USR.
|
||
.OPEN FDRC,A
|
||
CAIA
|
||
JRST N2AJ3
|
||
.USET USRI,[.SJNAME,,C] ;SET NAME
|
||
.USET USRI,[.SXJNAM,,C]
|
||
N2AJ2: MOVEM C,UJNAME (U) ;DOCUMENT
|
||
JRST NLTL2
|
||
|
||
N2AJ1: JUMPL U,QJERR ;LOSERS THAT TYPE $$J WITH NO JOBS
|
||
PUSHJ P,LCT ;$$J
|
||
PUSHJ P,KLSTJ4
|
||
JRST NLTL2
|
||
|
||
;OPEN A JOB BY NAME
|
||
|
||
KJOB: SKIPE TOKTRM ;:JOB
|
||
JRST ALTJ9
|
||
PUSHJ P,RTOKEN
|
||
MOVE D,B
|
||
JRST NALTJ1
|
||
|
||
|
||
;; :JOBP FOO does a :JOB FOO iff it would succeed
|
||
|
||
kjobp: skipe toktrm ;Did we terminate?
|
||
jrst kjob1 ; yes, must be no job specified, see if there are jobs
|
||
call rtoken ;Try reading a name
|
||
jumpe b,kjobp ;no job name yet, keep trying for one
|
||
move d,b ;JOBPIK expects jname to find in D
|
||
setzm reownf ;don't offer to clobber if disowned, just do it!
|
||
call jobpik ;see if the job exists
|
||
jumpn d,[ move u,cu ; It failed? go back to our current job
|
||
move a,d ; our return value is JOBPIK's return value
|
||
call pprin ;return it as an octal frob
|
||
jrst gsoctj] ;and be sure to prompt
|
||
setom cu ;say no current job in case OPUSR fails
|
||
call opusr ;open the job
|
||
jrst [ call fnjob ;find SOME job
|
||
movei a,1 ; note that we didn't succeed
|
||
jrst gsoctj] ;and return 1 as an octal frob
|
||
setz a, ;we succeeded, return zero
|
||
call pprin ;as an octal value
|
||
jrst gsoctj ;and prompt
|
||
|
||
kjob1: setom cu ;if we have a job, be sure to get it back
|
||
call fnjob ;J
|
||
seto a, ;assume no jobs
|
||
skipl cu ;Is there a job?
|
||
setz a, ; yes, so return success
|
||
jrst gsoctj ;That's all. prompting was done by FNJOB
|
||
|
||
|
||
KUJOB: CALL RTOKEN ;:UJOB
|
||
JUMPE B,KUJOB
|
||
SAVE B
|
||
CALL RTOKEN
|
||
JUMPE B,.-1
|
||
MOVE D,B
|
||
REST C
|
||
JRST KUJOB1
|
||
|
||
;;; :FJOB <jname> or :FJOB <UNAME> <JNAME>, access job, guarenteeing not
|
||
;;; to reown it.
|
||
|
||
kfjob: call rtoken ;<jname> or <uname>
|
||
jumpe b,kfjob ;null, try again
|
||
push p,b ;remember the first arg
|
||
skipe toktrm ;is that the end?
|
||
jrst kfjobj ; yes, must have just been the jname
|
||
kfjob1: call rtoken ;get the JNAME
|
||
skipe toktrm ;is that the end?
|
||
jumpe b,kfjobj ; yes, and we didn't get a second arg, hack JNAME
|
||
jumpe b,kfjob1 ;not the end yet, but null? Keep trying
|
||
move c,(p) ;first arg was the UNAME, get it
|
||
move d,b ;and our just-read arg was the JNAME
|
||
kfjob2: movni a,4 ;-4 REOWNF means to make it non-reownable
|
||
movem a,reownf ;so OUSRNL won't open it as inferior
|
||
jumpe c,[ push p,d ;remember the JNAME we're hacking
|
||
call jobpik ;try to find any job with that JNAME
|
||
pop p,a ;recover the JNAME
|
||
exch a,d ;A gets reason for failure, D gets JNAME again
|
||
jumpl a,njger1 ;job just vanished, that's an error
|
||
jumpg a,kfjob3 ;didn't find it, try maybe detached job
|
||
jrst kfjob9] ;found it, go hack it
|
||
kfjob3: syscal open,[ %clbit,,10\.bii ? %climm,,fdrc ? [sixbit /USR/] ? c ? d]
|
||
jrst kfjobf
|
||
.uset fdrc,[.rsuppro,,a] ;check out the user index of it's superior
|
||
.close fdrc, ;don't need it open any more...
|
||
camn a,ruind ;Is this an inferior?
|
||
jrst [ 7type [asciz /A[Already an inferior!!]
|
||
/]
|
||
call njtyp ;let him know he's still got the same job
|
||
pop p,c ; clear our first arg off the stack
|
||
jrst nltl4] ;propmt and return, don't error out an XFILE
|
||
call ousrnl ;select and open the job
|
||
kfjob9: pop p,c ;recover our first argument
|
||
skipn c ;if we didn't explicitly specify the UNAME
|
||
call njtyp ; type the job name opened
|
||
jrst nltl4 ;and prompt and exit
|
||
|
||
;; Job is not found, report failure and clean up
|
||
|
||
kfjobf: 7type [asciz /A[No such job!!]
|
||
/]
|
||
skipge cu ;Did we have a job?
|
||
jrst [ call nojob
|
||
pop p,c ; Clean up the stack
|
||
jrst nltl4] ; all done
|
||
call njtyp ;let him know he's still got the same job
|
||
call opusr ;And reselect it
|
||
jfcl
|
||
pop p,c ; clear our first arg off the stack
|
||
jrst nltl4 ;prompt, return, don't error (for XFILE's)
|
||
|
||
;; just got the JNAME only, use our UNAME
|
||
kfjobj: setz c, ;0 UNAME, use JOBPIK to find the job
|
||
move d,(p) ;recover our first arg as JNAME
|
||
setzm (p) ;and pretend we didn't get a first arg
|
||
jrst kfjob2 ;and hack the rest
|
||
|
||
;; J or <job>J
|
||
NALTJ: JUMPE D,ALTJ9 ;$J JUMP IF NO ARG.
|
||
JUMPE C,NAERR
|
||
MOVE D,C
|
||
NALTJ1: SETZ C,
|
||
KUJOB1: PUSHJ P,OUSR
|
||
JRST NLTL2
|
||
|
||
OUSR: SETZM REOWNF ;MAKE SURE WE GET A "!" FOR A NEW JOB.
|
||
CALL OUSRNL
|
||
SKIPE UINT(U)
|
||
JRST UBRK0
|
||
RET
|
||
|
||
;OPEN JOB WITH NAMES IN C AND D. UNAME = 0 => CREATE INFERIOR UNLESS
|
||
;JOB WITH MATCHING JNAME ALREADY KNOWN TO DDT.
|
||
OUSRNL: CALL DDTUNM ;MAKE SURE WE KNOW OUR UNAME.
|
||
SKIPGE U,CU ;START SCANNING JOB SLOTS AFTER CURRENT JOB, OR FROM 0.
|
||
MOVEI U,USREND-USRLNG ;SO IF >1 JOB WITH THIS JNAME, FIND THEM 1 BY 1
|
||
MOVE B,U ;REMEMBER WHERE WE START SO KNOW WHEN TO STOP.
|
||
SETO W1, ;SAY NO FREE SLOT FOUND.
|
||
OUSR2: ADDI U,USRLNG ;ADVANCE TO NEXT JOB
|
||
CAIN U,USREND
|
||
SETZ U,
|
||
CAME D,UJNAME(U) ;DOES THIS JOB HAVE DESIRED JNAME?
|
||
JRST OUSR5 ;NOT WHAT WE'RE LOOKING FOR.
|
||
CAME C,UUNAME(U) ;HAS IT THE DESIRED UNAME?
|
||
JUMPN C,OUSR5 ;NO, NO GOOD UNLESS ANY UNAME IS OK.
|
||
MOVN A,REOWNF
|
||
CAIE A,3 ;FOR FOO^K
|
||
CAIN A,2 ;OR :FOO (ONLY WHEN ..GENJFL/0 CAN IT GET HERE)
|
||
SKIPN CLOBRF ;IF THIS FEATURE ENABLED,
|
||
CAIA ;REOWNF=4 can get here
|
||
CALL OUSR4E ;IF ABOUT TO CLOBBER A JOB, QUERY ABOUT IT.
|
||
cain a,4 ;Is this a :FJOB FOO
|
||
jrst [ movei a,%urfrn ;the magic bit that prevents reowning
|
||
iorm a,urandm(u) ;turn it on in the URANDM word
|
||
jrst ousr21] ;and continue with our :UJOB
|
||
|
||
ousr21: JUMPN C,OUSR2B ;IF UNAME WASN'T EXPLICITLY SPEC'D (NOT :UJOB)
|
||
MOVE A,UUNAME(U)
|
||
CAME A,RUNAME ;AND ISN'T THE SAME AS OURS,
|
||
CALL NJTYP ;INFORM USER.
|
||
OUSR2B: CALL OUSR2A ;IF JOB DOESN'T EXIST, IT WAS DELETED BY ITS OWNER.
|
||
JRST NJGERR
|
||
CALL OPUSR ;FOUND JOB SUPPOSEDLY WHAT WE WANT.
|
||
JRST NJGER1
|
||
RET
|
||
|
||
OUSR5: CAML U,W1 ;ALREADY SAW A LOWER-NUMBERED FREE SLOT =>
|
||
JUMPGE W1,OUSR6 ;DON'T NEED THIS ONE.
|
||
SKIPN UJNAME(U) ;IF WE FIND FREE SLOT, REMEMBER IT.
|
||
MOVEI W1,(U)
|
||
OUSR6: CAME U,B ;ALL CHECKED YET?
|
||
JRST OUSR2 ;NO, KEEP TRYING
|
||
SKIPGE U,W1 ;YES, IF FOUND FREE SLOT, USE IT TO CREATE.
|
||
ERSTRT [SIXBIT /8 JOBS ALREADY?/] .SEE NINFP ;WILL RELOAD U.
|
||
JRST OUSR4
|
||
|
||
;HERE WHEN MUST SELECT A JOB NOT ALREADY KNOWN. U HAS INDEX TO USE FOR IT.
|
||
;C HAS UNAME, AND D HAS JNAME.
|
||
OUSR4: CAMN D,['SYS,,]
|
||
SKIPE C ;IF TRYING TO HACK OUR OWN INFERIOR NAMED "SYS",
|
||
JRST OUSR8
|
||
MOVSI B,400000 ;SAY IT'S A PHONY INFERIOR (AFFECTS OPUSR).
|
||
MOVEM B,INTBIT(U)
|
||
OUSR8: SKIPN C ;UNAME OF 0 SPEC'D => OK TO CREATE, AND USE OUR UNAME.
|
||
MOVE C,RUNAME
|
||
MOVEM C,UUNAME(U) ;SET UP UNAME AND JNAME FOR NEW JOB
|
||
MOVEM D,UJNAME(U)
|
||
MOVEM D,UFILE1(U)
|
||
setzm urandm(u) ;normally, URANDM is zero, but...
|
||
movei d,%urfrn ;the magic bit to prevent reowning
|
||
movn c,reownf ;check REOWNF for what kind of create this is
|
||
cain c,4 ;if -4, this is a :FJOB and we don't want to reown
|
||
movem d,urandm(u) ;so set the magic bit in URANDM to prevent it
|
||
MOVE D,MSNAM
|
||
MOVEM D,UFILES(U)
|
||
MOVSI D,'DSK
|
||
MOVEM D,UFILE(U)
|
||
MOVEI D,(SIXBIT/BIN/)
|
||
MOVSM D,UFILE2(U) ;SET UP LOADING FILE NAMES.
|
||
SETOB D,PERMIT(U) ;DON'T STOP BEFORE VALRET STRINGS
|
||
SETOM SYSUUO(U) ;DON'T STOP BEFORE SYSTEM CALLS.
|
||
HRRZM D,LIMIT(U) ;DEFAULT SEARCH LIMITS ALL OF ADDR SPACE.
|
||
MOVE D,MSTYPE ;INIT. THE JOB'S MULTI-STEP BITS.
|
||
MOVEM D,USTYPE(U)
|
||
MOVE D,SYMTOP
|
||
MOVEM D,BININF(U) ;NO INFO ON WHO ASSEMBLED WHEN, ETC., IN THIS JOB.
|
||
MOVEM D,UNDEFL(U) ;NO UNDEF SYM REFS THIS JOB.
|
||
MOVEM D,JOBSYM(U) ;NO SYMBOLS.
|
||
MOVEM D,PRGM(U)
|
||
SETZM UINT(U) ;CLEAR INT WORD
|
||
MOVEI D,TPERCE(U)
|
||
HRLI D,MPERCE ;INIT. THE JOB'S TYPEOUT MODES.
|
||
BLT D,TNMSGN(U)
|
||
SAVE [0] ;FIND OUT WHETHER THE JOB ALREADY EXISTS
|
||
MOVE A,[10,,USRI]
|
||
.CALL OPNUSR
|
||
SETOM (P)
|
||
PUSHJ P,OPUSR ;OPEN JOB
|
||
JRST NSJERR
|
||
MOVN C,REOWNF
|
||
cain c,4 ;:FJOB should also tell it's a new job
|
||
ctype "!
|
||
CAIE C,3
|
||
SKIPN REOWNF ;FOR $J, ^K AND ^H,
|
||
CTYPE "! ; INDICATE THAT THIS IS NEW JOB
|
||
CALL TYOFRC
|
||
REST C ;C IS NEGATIVE IF JOB IS NEWLY CREATED.
|
||
SKIPE SYSSW ;DON'T CHECK WHETHER SYSTEM RUNNING.
|
||
JRST [MOVEI D,200000 ? MOVEM D,LIMIT(U) ? RET]
|
||
MOVE D,UJNAME(U)
|
||
CAME D,[SIXBIT/PDP6/]
|
||
CAMN D,[SIXBIT/PDP10/]
|
||
JRST [ AOS SIXCTR
|
||
MOVE A,[.BII,,PDP6C]
|
||
.CALL OPNUSR ;KEEP OPEN ON PDP6C SO NOONE ELSE CAN STEAL IT.
|
||
JFCL ;SINCE WON'T BE OPEN ON USRI AFTER $J.
|
||
JRST CPOPJ]
|
||
MOVEI D,21
|
||
MOVEM D,UINTWD(U) ;INDICATE JOB NOT YET STARTED
|
||
CALL OUSR4F
|
||
OUSR4C: SKIPLE INTBIT(U)
|
||
CALL JCL3 ;ALSO SET OPTBRK BIT, CLEAR OPTCMD.
|
||
SKIPN DDTSW
|
||
RET ;EXIT IF NOT OPENING SELF
|
||
MOVE D,STBDDT ;SELF - SYM TAB IS DDT SYM TAB.
|
||
MOVEM D,JOBSYM(U)
|
||
MOVEM D,PRGM(U)
|
||
RET
|
||
|
||
;TAKE USR IN U; SKIP IF SPEC'D JOB EXISTS. CLOBBERS A,D.
|
||
OUSR2A: MOVE D,UJNAME(U)
|
||
CAMN D,['SYS,,]
|
||
JRST POPJ1 ;SYS JOB CONSIDERED TO EXIST.
|
||
MOVE A,[10,,USRI]
|
||
.CALL OPNUSR ;TRY TO OPEN AS FOREIGN JOB.
|
||
RET
|
||
JRST POPJ1
|
||
|
||
;CLOBBERS D. C SHOULD HAVE -1 IF JOB IS NEWLY CREATED.
|
||
;ANALYZE THE JOB AND SET UP ITS STATE APPROPRIATELY;
|
||
;ALSO PRINT "REOWNED" IF NECESSARY, AND INIT SOME VARS IF NEC.
|
||
OUSR4F: .USET USRI,[.RUSTP,,D] ;PICK UP STOP WORD
|
||
TLNE D,100000 ;SKIP IF JOB RUNNING
|
||
JRST OUSR4B ;JOB STOPPED
|
||
SETZM UINTWD(U) ;INDICATE JOB RUNNING
|
||
JRST OUSR4D
|
||
|
||
OUSR4B: .USET USRI,[.RUPC,,D] ;GET JOB'S PC
|
||
MOVEM D,PPC(U) ;AND REMEMBER IT.
|
||
CAME D,[10000,,0] ;IF JOB HAS BEEN RUN, SAY IT RETURNED
|
||
SETOM UINTWD(U) ;(OTHERWISE UINTWD WILL STILL SAY "NEVER STARTED")
|
||
JUMPL C,OUSR4A ;NEWLY CREATED JOB, SET SNAME TO MSNAME.
|
||
OUSR4D: SKIPG INTBIT(U) ;IF OUR INFERIOR NOW, MUST HAVE BEEN DISOWNED.
|
||
RET
|
||
7TYPE [ASCIZ/: Reowned
|
||
/]
|
||
syscal usrvar,[%climm,,usri ? %climm,,.roption ? %climm,,0
|
||
[tlo %opddt\%opbrk]] ;turn on those bits
|
||
jfcl
|
||
|
||
SKIPN D,UINTWD(U) ;IF WE SHOULD BELIEVE IT'S RUNNING,
|
||
HRROS BPINFL(U) ;WE SHOULD ALSO BELIEVE ITS BREAKPOINTS ARE IN IT.
|
||
CAIN D,21
|
||
JRST OUSR4E
|
||
MOVEM D,UINT(U)
|
||
SETZM UINTWD(U)
|
||
OUSR4E: SKIPN REOWNF ;IF DOING FOO^K OR :FOO,
|
||
RET
|
||
7TYPE [ASCIZ/--Clobber Existing Job--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
RET
|
||
|
||
OUSR4A: .USET USRO,[.SSNAM,,MSNAM] ;NEW JOB: INIT ITS SNAME.
|
||
SKIPGE D,TWAITF ;ALSO INIT TTYTBL ACCORDING TO TWAITF.
|
||
MOVSI D,%TBINT
|
||
.USET USRO,[.STTY,,D]
|
||
RET
|
||
|
||
;HERE TO RESELECT THE JOB IN U. JOB NEED NOT EXIST YET,
|
||
;BUT UJNAME AND UUNAME MUST BE SET UP. UIND(U) ASSUMED TO BE NONZERO IF OLD
|
||
;JOB. Skips if successful
|
||
|
||
OPUSR: JUMPL U,JERR ;COMPLAIN IF ILLEGAL JOB
|
||
CALL NOJOB1 ;INDICATE NO JOB OPEN IN CASE OPUSR BOMBS.
|
||
AOS D,NJ1 ;GET NEXT JTIME VALUE
|
||
MOVEM D,JTIME(U) ;INDICATE THIS JOB MOST RECENT
|
||
HRRZ D,JPDLP ;PUSH THIS JOB'S IDX ON THE PDL OF SELECTED JOBS.
|
||
CAIN D,JPDLE-1
|
||
SUBI D,JPDLL
|
||
HRRM D,JPDLP
|
||
IDPB U,JPDLP
|
||
MOVE D,JPDLC ;SAY THERE'S ONE MORE JOB IN IT, UNLESS IT'S FULL
|
||
CAIE D,JPDLL-1 ;IN WHICH CASE ADDING ONE FLUSHES THE BOTTOM ONE.
|
||
AOS JPDLC
|
||
ANDI U,-1
|
||
MOVS D,UJNAME(U)
|
||
CAIN D,'SYS ;IS THIS A PHONY INFERIOR "SYS" JOB?
|
||
SKIPL INTBIT(U)
|
||
CAIA
|
||
JRST OPUSRS ;IF SO, DON'T ACTUALLY TRY TO OPEN IT.
|
||
MOVE A,[.BII,,USRI]
|
||
move b,urandm(u) ;check out this job's foreign status
|
||
trne b,%urfrn ;Is this supposed to remain a foriegn job?
|
||
tlo a,10 ; set the bit to not reown
|
||
.CALL OPNUSR ;OPEN JOB FOR INPUT.
|
||
JRST OPUSR5 ;LOSE
|
||
.USET USRI,[.RUIND,,D]
|
||
camn d,ruind ;compare his user index with ours
|
||
setom ddtsw ;job's usr idx = ours => it is us (or pdp6; see OPUSRB)
|
||
MOVE C,UIND(U) ;OLD VALUE OF UIND IS 0 IFF JOB IS NEW.
|
||
MOVEM D,UIND(U) ;REMEMBER JOB'S IDX (NONZERO, EXCEPT FOR SYS SYS).
|
||
MOVE D,UJNAME(U)
|
||
CAME D,[SIXBIT/PDP6/] ;DON'T TRY .RUNAME OR .RJNAME ON PDP6; THEY LOSE.
|
||
CAMN D,[SIXBIT/PDP10/]
|
||
JRST [MOVSI C,400000 ;MARK THE PDP6 AS A "PHONY INFERIOR".
|
||
MOVEM C,INTBIT(U)
|
||
MOVE A,[.BIO,,USRO]
|
||
TSCLO OPNUSR
|
||
JRST OPUSRB]
|
||
.USET USRI,[.RUNAM,,B]
|
||
.USET USRI,[.RJNAM,,D] ;HAVE JOB NAMES CHANGED (EG BECAUSE OF REOWNING)?
|
||
CAMN B,UUNAME(U)
|
||
CAME D,UJNAME(U)
|
||
JRST OPUSRU ;YES, TRY AGAIN TO OPEN, WITH NEW NAMES.
|
||
opusrx: move a,urandm(u) ;check out if this is supposed to remain foriegn
|
||
trne a,%urfrn ;Is it?
|
||
jrst opusr6 ; yes, pretend we couldn't open for output
|
||
MOVE A,[.BIO,,USRO]
|
||
.CALL OPNUSR ;OPEN JOB AGAIN, FOR OUTPUT.
|
||
JRST OPUSR6 ;WIN ON INPUT & LOSS ON OUTPUT => FOREIGN USER
|
||
.USET USRI,[.RINTB,,D] ;PICK UP INTERRUPT BIT, AND SAVE IN INTBIT
|
||
EXCH D,INTBIT(U) ;GET OLD VALUE OF INTBIT
|
||
JUMPG D,OPUSRB ;IF IT'S 0, JOB WAS A FOREIGN JOB (OR IS NEW)
|
||
JUMPE C,OPUSRB ;IF IT'S NOT NEW, MUST HAVE JUST BEEN RE-OWNED.
|
||
CALL OUSR4F ;SO PRINT "REOWNED" IF NEC., ETC.
|
||
OPUSRB: SETZM DDTSW ;CAN OUTPUT TO IT, SO IT CAN'T BE SELF.
|
||
;(STUPID ITS GIVES OUR IDX AS PDP6'S IDX,
|
||
;THIS IS THE ONLY WAY TO INSURE DON'T THINK 6 IS SELF)
|
||
SETOM UCHNLO ;INDICATE BOTH CHANNELS OPEN
|
||
OPUSRA: MOVEM U,CU ;JOB ALL SET UP, DON'T CLOSE ON ERROR.
|
||
JRST POPJ1
|
||
|
||
;HERE WHEN FAIL TO OPEN JOB FOR WRITING; OPEN FOR READING ALREADY WON.
|
||
OPUSR6: CTYPE "#
|
||
MOVEI D,-1
|
||
MOVEM D,UCHNLO
|
||
SETZM INTBIT(U)
|
||
JRST OPUSRA
|
||
|
||
;ATTACHING DISOWNED JOB WHICH GOT RENAMED IN PROCESS.
|
||
;NEW UNAME IN B, NEW JNAME IN D.
|
||
OPUSRU: MOVEM B,UUNAME(U)
|
||
MOVEM D,UJNAME(U) ;STORE NEW NAMES.
|
||
MOVE D,B
|
||
CALL NJTYP1 ;TYPE NEW NAMES.
|
||
JRST OPUSRX
|
||
|
||
;COME HERE WHEN OPUSR'S INPUT OPEN FAILS.
|
||
OPUSR5: SAVE UUNAME(U) ;USER TRYING TO OPEN JOB THAT DOESN'T EXIST
|
||
CALL MRDR2 ;DELETE THE JOB SLOT.
|
||
REST D ;IF WERE TRYING TO OPEN FOREIGN JOB,
|
||
CAME D,RUNAME ;NO SURPRISE THAT JOB DOESN'T EXIST.
|
||
RET
|
||
.STATUS USRI,D
|
||
LDB D,[OPNLBP,,D]
|
||
CAIE D,%ENACR
|
||
CAIN D,%EFLDV
|
||
ERSTRT [SIXBIT /SYSTEM FULL?/]
|
||
ERSTRT [SIXBIT /INFERIOR-CREATION FAILED?/]
|
||
|
||
OPUSRS: SETOM SYSSW ;SET SYS JOB FLAG
|
||
SETZM UINTWD(U)
|
||
JRST OPUSRA
|
||
|
||
NOJOB: SETO U, ;CAUSE THERE TO BE NO CURRENT JOB.
|
||
NOJOB1: SETOM CU ;SIMILAR BUT REMEMBER WHICH JOB WAS OPEN.
|
||
NOJOB2: .CLOSE USRI, ;MAKE THAT BE TRUE.
|
||
NOJOB3: SETZM UCHNLO ;NO USER CHANNEL OPEN,
|
||
.CLOSE USRO,
|
||
SETZM DDTSW ;NOT LOOKING AT SELF OR SYS.
|
||
SETZM SYSSW
|
||
RET
|
||
|
||
OPNUSR: SETZ
|
||
SIXBIT /OPEN/
|
||
A ;Mode,,Channel
|
||
[SIXBIT /USR/]
|
||
UUNAME(U)
|
||
UJNAME(U)
|
||
SETZ ['FOO]
|
||
|
||
;COME HERE FOR $J WITH NO ARG.
|
||
ALTJ9: TLNE B,O.IFX
|
||
JRST JPOP ;$1J => POP THE JOB PDL
|
||
|
||
fnjob: call fnjob6 ;select a new job.
|
||
skipe uint(u) ;if it's interrupting, let it return.
|
||
jrst ubrk0
|
||
jrst nltl2
|
||
|
||
;MAKE A REASONABLY USEFUL CHOICE OF A JOB TO SELECT.
|
||
FNJOB6: CALL DDTUNM
|
||
SKIPE UINT(U)
|
||
JUMPGE U,FNJOB7 ;CURRENT JOB CAN INT. IF IT WANTS TO.
|
||
SETZ U,
|
||
FNJOB1: SKIPE UINT(U) ;ELSE GIVE ALL OTHER JOBS A CHANCE.
|
||
JRST FNJOB7
|
||
ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JRST FNJOB1
|
||
SOS D,NJ2 ;NO JOB WANTS TO INT; FIND MOST RECENTLY PREVIOUSLY SELECTED.
|
||
SKIPL U,CU ;IF HAD A CURRENT JOB REMEMBER WHEN IT WAS CURRENT.
|
||
MOVEM D,JTIME(U) ;AND MAKE THIS ONE LOOK LEAST RECENT INSTEAD OF MOST.
|
||
SETZB A,B
|
||
FNJOB4: CAML A,JTIME(B) ;LOOK FOR LESS RECENT.
|
||
JRST FNJOB5
|
||
MOVE A,JTIME(B)
|
||
MOVE U,B
|
||
FNJOB5: ADDI B,USRLNG
|
||
CAIGE B,USREND
|
||
JRST FNJOB4
|
||
JUMPLE A,NOJOB ;NO JOB FOUND.
|
||
|
||
FNJOB7: CALL NJTYP ;SAY WE'RE HACKING THAT JOB.
|
||
CALL OUSR2A ;SKIP IF JOB STILL EXISTS.
|
||
JRST FNJOB3 ;JOB HAS VANISHED, DELETE ITS SLOT.
|
||
SETZM REOWNF
|
||
SETZM SILNT
|
||
CALL OPUSR ;TYPE NEW JNAME AND OPEN.
|
||
JRST FNJOB2 ;CAN'T OPEN, OPUSR DELETED THE SLOT.
|
||
RET
|
||
|
||
FNJOB3: CALL MRDR2
|
||
FNJOB2: 7TYPE [ASCIZ/:KILL /]
|
||
JRST FNJOB6
|
||
|
||
JPOP1: MOVEI A,1 ;HERE TO POP JOB SELECTION PDL ONCE.
|
||
|
||
;POP THE JOB SELECTION PDL TO FIND A JOB TO SELECT NEXT.
|
||
;A HAS NUMBER OF TIMES TO POP. WE EXIT TO NLTL2.
|
||
JPOP: CALL DDTUNM
|
||
SKIPN JPDLC
|
||
TERR 'JOB ;NO JOB ON PDL?
|
||
HRRZ D,JPDLP
|
||
SUBI D,1 ;DECREMENT THE PDL POINTER
|
||
CAIGE D,JPDLB ;RING IT AROUND IF BELOW BEGINNING OF PDL NOW
|
||
ADDI D,JPDLL
|
||
HRRM D,JPDLP
|
||
SOS JPDLC ;ONE JOB HAS BEEN POPPED.
|
||
SOJG A,JPOP ;FOR $<N>J, POP <N> TIMES.
|
||
HRRZ U,(D) ;GET JOB NOW THE TOP OF THE PDL.
|
||
JUMPL U,[ CALL NOJOB ;IF "NO JOB" IS ON THE TOP OF PDL,
|
||
JRST NLTL2] ;SELECT NO JOB.
|
||
SKIPN UUNAME(U)
|
||
JRST NJGER1 ;THAT SLOT IS EMPTY => BARF.
|
||
SAVE JPDLP ;WHEN WE SELECT THE JOB, IT WILL BE RE-PUSHED,
|
||
SAVE JPDLC ;SO PREPARE TO UN-RE-PUSH IT.
|
||
SAVE U
|
||
CALL FNJOB7 ;TRY TO SELECT THAT JOB.
|
||
REST A
|
||
CAME A,U ;THAT WASN'T THE ONE WE GOT => THE ONE WE WANTED
|
||
JRST QJERR ;HAS BEEN KILLED; ERROR.
|
||
REST JPDLC
|
||
REST JPDLP
|
||
JRST NLTL2
|
||
|
||
NACX: JUMPN D,NACX1 ;JUMP IF IT'S <JOB>$^X.
|
||
skipn confrm ;do we want confirmation?
|
||
jrst kkill ; no, so don't ask!
|
||
PUSHJ P,RIN ;$^X. - KILL CURRENT JOB.
|
||
JRST ALTDQX
|
||
CAIE D,". ;MUST BE FOLLOWED BY A PERIOD.
|
||
JRST NXERR
|
||
KKILL: JUMPL U,JERR ;:KILL COMES HERE.
|
||
SAVE A
|
||
SAVE B
|
||
SKIPE SAFE(U) ;QUERY THE USER IF THIS JOB IS PROTECTED.
|
||
CALL SAFET1
|
||
PUSHJ P,MRDR
|
||
REST B
|
||
REST A
|
||
JRST ALTJ9 ;NOW DO $J OR $<N>J.
|
||
|
||
|
||
;;; JOBPIK takes a JNAME in D, and tries to find a job with that JNAME.
|
||
;;; it will reown if needed, etc. It returns with 0 in D if it succeeded,
|
||
;;; -1 if the job had been there and vanished, and 1 if it doesn't exist
|
||
;;; at all
|
||
|
||
jobpik: save c ;restore C
|
||
call ddtunm ;make sure we know our uname.
|
||
skipge u,cu ;start scanning job slots after current job, or from 0.
|
||
movei u,usrend-usrlng ;so if >1 job with this jname, find them 1 by 1
|
||
move b,u ;remember where we start so know when to stop.
|
||
rest c ;restore C
|
||
jrst jobpk3 ;don't advance over current job first time!
|
||
jobpk2: addi u,usrlng ;advance to next job
|
||
cain u,usrend ;is the end of ring?
|
||
setz u, ; yes, start at beginning
|
||
cain b,(u) ;Is this back to starting point?
|
||
jrst jobpk4 ; Yep, try seeing if it is disowned etc.
|
||
jobpk3: came d,ujname(u) ;does this job have desired jname?
|
||
jrst jobpk2 ; no, so hack the next instead
|
||
call njtyp ;inform user.
|
||
call ousr2a ;if job doesn't exist, it was deleted by its owner.
|
||
jrst [ call mrdr2 ; flush the info on this job
|
||
seto d,
|
||
ret]
|
||
setz d, ;note that we won
|
||
ret
|
||
|
||
jobpk4: syscal open,[%clbit,,10 ? %climm,,usri ? [sixbit /USR/] ? %climm,,0
|
||
d]
|
||
jrst [ movei d,1 ; no such job, note the fact
|
||
ret] ; and return
|
||
setz c, ;our UNAME
|
||
call ousrnl ;open the frob
|
||
setz d, ;note that we were successful
|
||
ret
|
||
|
||
NACX1: JUMPE C,NAERR
|
||
MOVE D,C
|
||
save u ;gotta remember U for later
|
||
setzm reownf ;don't offer to clobber if reowned, just DO it
|
||
call jobpik ;select the job we are supposed to kill
|
||
jumpl d,njger1 ;did job just vanish?
|
||
jumpn d,[7type [asciz / [No Such Job]A/]
|
||
jrst nacx4]
|
||
SKIPE SAFE(U)
|
||
7TYPE [ASCIZ / (protected job) /]
|
||
7TYPE [ASCIZ /--Kill--/]
|
||
CALL MORFL1
|
||
JRST NACX4 ;USER SAYS NO => POP BACK TO OLD CURRENT JOB.
|
||
syscal open,[%clbit,,.uii ? %climm,,usri
|
||
[sixbit /USR/]
|
||
uuname(u)
|
||
ujname(u)]
|
||
jrst [7type [asciz /Job gone!/]
|
||
jrst nacx4]
|
||
CALL MRDR ;ELSE KILL THE SPECIFIED ONE
|
||
nacx4: rest u
|
||
call nojob1 ;Say there's no current job.
|
||
jrst fnjob ;and get us a new (or our old) current job)
|
||
|
||
;DELETE JOB SLOT <- U, .UCLOSING TH JOB. CLOBBERS A,D,W1,I1
|
||
MRDR: MOVE D,UJNAME(U) ;GETTING RID OF PDP6?
|
||
CAME D,[SIXBIT/PDP6/]
|
||
CAMN D,[SIXBIT/PDP10/]
|
||
SOSE SIXCTR
|
||
CAIA
|
||
.CLOSE PDP6C, ;CLOSE ALL CHANNELS IT'S ON.
|
||
.STATUS USRI,D
|
||
SKIPE D ;IF REALLY HAVE A JOB, DELETE IT.
|
||
.UCLOS USRI,
|
||
MRDR2: MOVS I1,UJNAME(U)
|
||
CAIN I1,'SYS
|
||
SETZM SYSDPS
|
||
MOVEI W1,UCHBUF(U) ;FREE THE JOB'S COMMAND BUFFER.
|
||
PUSHJ P,ELEC0
|
||
MOVEI W1,BININF(U) ;FREE THE JOB'S BIN FILE'S RANDOM INFO.
|
||
PUSHJ P,ELEC0
|
||
MOVEI W1,UNDEFL(U) ;FREE THE UNDEF SYM REF LIST.
|
||
PUSHJ P,ELEC0
|
||
MOVEI W1,RADAOB(U) ;FREE THE RAID REGISTERS.
|
||
CALL ELEC0
|
||
CALL ELECTRON ;FREE THE SYMBOL TABLE.
|
||
SKIPE HAKING ;IF .BREAK 16,20000, DON'T CHANGE
|
||
JRST MRDR3
|
||
CALL NOJOB3 ;INFO ON CURRENT JOB, ELSE SAY NONE.
|
||
SETOM CU
|
||
MRDR3: SETZM UUNAME(U)
|
||
MOVSI D,UUNAME(U)
|
||
HRRI D,UUNAME+1(U)
|
||
BLT D,JOBSYM-1(U)
|
||
RET
|
||
|
||
;IF THERE ARE ANY PROTECTED JOBS, QUERY THE USER AND ERR OUT IF HE FLUSHES.
|
||
SAFETY: MOVSI A,-NINFP
|
||
SAFET0: SKIPE SAFE(A)
|
||
JRST SAFET1
|
||
ADDI A,USRLNG-1
|
||
AOBJN A,SAFET0
|
||
RET
|
||
|
||
SAFET1: 7TYPE [ASCIZ /--Kill Protected Job--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
RET
|
||
|
||
MASSAC: SAVE [NLTL2] ;:MASSACRE COMMAND - KILL ALL JOBS.
|
||
MASAC1: CALL SAFETY
|
||
SETZ U,
|
||
MASAC2: SKIPN D,UJNAME(U)
|
||
JRST MASACX
|
||
move a,urandm(u) ;check the do-not-reown bit
|
||
trne a,%urfrn ;Is this to remain a foreign job?
|
||
jrst [ call mrdr2 ; yes, so flush our knowledge of it w/o killing
|
||
jrst masacx] ;and hack the next job
|
||
MOVE A,[.BII,,USRI]
|
||
CAME D,[SIXBIT /SYS/]
|
||
.CALL OPNUSR
|
||
JFCL
|
||
call mrdr
|
||
MASACX: ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JRST MASAC2
|
||
JRST NOJOB
|
||
|
||
MASAC4: CALL NOJOB
|
||
JRST NLTL2
|
||
|
||
KFORGET: ;:FORGET
|
||
SKIPGE UCHNLO ;IF THIS IS A REAL INFERIOR,
|
||
SKIPG INTBIT(U)
|
||
JRST KDISO2
|
||
CALL KDISO1 ;PREPARE THE JOB (REMOVE BPTS, UPDATE PC).
|
||
JRST KDISO2 ;THEN JUST FLUSH ITS SLOT. IT REMAINS AN INFERIOR, UNKNOWN.
|
||
|
||
KDISOW: CALL KDISO1 ;$$^K OR :DISOWN. PREPARE THE JOB (REMOVE BPTS, UPDATE PC).
|
||
SYSCLO DISOWN,[%CLIMM,,USRI ? %CLBIT,,(A)]
|
||
KDISO2: PUSHJ P,MRDR2
|
||
JRST FNJOB
|
||
|
||
KDISO1: PUSHJ P,QIJERR ;PREPARE THE CURRENT JOB FOR BEING ABANDONED BY DDT.
|
||
.USET USRI,[.SUSTP,,[-1]]
|
||
.USET USRI,[.ROPTIO,,D]
|
||
tlz d,%opddt\%opcmd\%opbrk ;tell job it no longer has a DDT over it
|
||
.USET USRI,[.SOPTIO,,D]
|
||
SAVE A ;PRESERVE INFIX ARGUMENT, FOR CTL BITS OF THE DISOWN.
|
||
CALL REMOVB
|
||
CALL TSTOPX
|
||
MOVE D,PPC(U) ;MAKE SURE JOB'S .UPC VARIABLE IS UP TO DATE,
|
||
SKIPE UINTWD(U) ;BUT DON'T CLOBBER A RUNNING JOB.
|
||
.USET USRO,[.SUPC,,D]
|
||
JRST POPAJ
|
||
|
||
NCTLC: 7NRTYP [ASCIZ /
|
||
/] ;^C
|
||
|
||
N2ACR: SKIPN SYSSW ;$$^R
|
||
jrst n2acr0 ; Not the system?
|
||
SETOM SYSDPS
|
||
jrst n2acr9
|
||
|
||
n2acr0: skipn dpstok ;Feature enabled?
|
||
jrst n2acr9 ; nope
|
||
skipe intbit(U) ;Is it foreign?
|
||
jrst n2acr9 ; no, either SYS (special) or our own (OK anyway!)
|
||
movei d,%URDPS
|
||
iorm d,urandm(u) ;turn on winnage
|
||
n2acr9: 7NRTYP [ASCIZ/ OP? /]
|
||
|
||
NJTYP: move d,urandm(u) ;check if this is a foreign-only job
|
||
trne d,%urfrn ;foreign?
|
||
jrst njtyp0 ; yes, do the :UJOB whether same UNAME or not
|
||
MOVE D,UUNAME(U)
|
||
CAME D,RUNAME
|
||
JRST NJTYP1
|
||
PUSHJ P,TSPC
|
||
MOVE D,UJNAME(U) ;TYPE JNAME OF CUR JOB AND "$J"
|
||
NJTYP2: PUSHJ P,SIXTYP
|
||
CTYPE 33
|
||
MOVEI D,"J
|
||
JRST TOUT
|
||
|
||
njtyp0: 7type [asciz / :FJOB /]
|
||
jrst njtyp4
|
||
njtyp1: move d,urandm(u) ;check if this is a foreign-only job
|
||
trne d,%urfrn ;is the magic bit on?
|
||
jrst njtyp0 ; Yes, you got this job by :FJOB FOO instead of :UJOB
|
||
7type [asciz / :UJOB /]
|
||
njtyp4: move d,uuname(u)
|
||
CALL SIXTYP
|
||
CALL TSPC
|
||
MOVE D,UJNAME(U)
|
||
CALL SIXTYP
|
||
JRST TSPC
|
||
|
||
SIXTYP: MOVE C,D ;PRINT C(D) AS SIXBIT STOPPING WHEN ZERO
|
||
SIXTP2: MOVEI D,0
|
||
ROTC C,6
|
||
ADDI D,40
|
||
CALL TOUT ;MUSN'T USE CTYPE SINCE CALLED FROM UERLOS.
|
||
JUMPN C,SIXTP2
|
||
POPJ P,
|
||
|
||
; :SELF is like HACTRNJ, but always gets the DDT being executed in no matter
|
||
; what the JNAME
|
||
|
||
KSELF: move d,(w4)
|
||
.suset [.rjname,,c]
|
||
jrst naltj ;<jname>J
|
||
|
||
constants
|
||
|
||
;:SNARF <JOB> - ASSUMES THAT THE CURRENT JOB HAS AN
|
||
;INFERIOR NAMED <JOB>, DISOWNS IT FROM THE INFERIOR AND THEN
|
||
;OWNS IT DIRECTLY. CLOBBERS LOCATIONS 26-36 OF THE INFERIOR.
|
||
KSNARF: JUMPL U,JERR ;NO JOB OPEN.
|
||
CALL QIJERR ;NOT INFERIOR => ERROR.
|
||
CALL RTOKEN ;READ <JOB NAME> AS SIXBIT IN B.
|
||
JUMPE B,.-1
|
||
SYSCAL OPEN,[[10+.BII,,FDRC] ? ['USR,,] ? RUNAME ? B]
|
||
JRST NSJERR ;COMPLAIN IF WE CAN'T FIND SUCH A JOB,
|
||
.USET FDRC,[.RSUPPRO,,D]
|
||
CAME D,UIND(U) ;OR IT'S NOT AN INFERIOR OF THE SELECTED JOB.
|
||
JRST NSJERR
|
||
.CLOSE FDRC,
|
||
SAVE B
|
||
CALL NCTLX ;MAKE SURE FATAL INTS GET HANDLED.
|
||
MOVE D,(P) ;DEPOSIT <JOB> IN 36
|
||
MOVEI A,36
|
||
CALL RDEP
|
||
TERR
|
||
.ACCES USRO,[26]
|
||
MOVE A,[-7,,KSNAR1]
|
||
.IOT USRO,A ;PUT IN THE INFERIOR CODE TO DISOWN.
|
||
HRROI A,RUNAME ;PUT UNAME IN 35
|
||
.IOT USRO,A
|
||
.USET USRI,[.RPICLR,,A]
|
||
SAVE A ;REMEMBER AND SET .PICLR
|
||
.USET USRI,[.SPICLR,,[0]] ;SO DISOWNING WON'T STOP.
|
||
.USET USRI,[.RPIRQC,,A]
|
||
SAVE A ;ALSO REMEMBER AND CLEAR FATAL INTERRUPTS.
|
||
.USET USRI,[.SAPIRQC,,A]
|
||
MOVEI A,26
|
||
EXCH A,PPC(U) ;START HIM AT 26, RESETTING HIS PC
|
||
MOVEM A,XECPC(U);WHEN HE RETURNS WITH $X RETURN.
|
||
SETOM XINTWD(U)
|
||
push p,urandm(u) ;remember the way it was
|
||
movei a,%urctx ;note that we're expecing an interrupt
|
||
iorm a,urandm(u)
|
||
call procdx ;run him without TTY
|
||
pop p,urandm(u)
|
||
REST A
|
||
.USET USRI,[.SIPIRQC,,A]
|
||
REST A
|
||
.USET USRI,[.SPICLR,,A]
|
||
MOVE D,UIACK(U)
|
||
TRNE D,200000 ;DID HE RETURN SUCCESS?
|
||
JRST [REST D ? JRST NALTJ1] ;YES, GO $J <JOB>.
|
||
ERSTRT [SIXBIT/COULDN'T OPEN JOB?/]
|
||
|
||
KSNAR1: JFCL ;(26)
|
||
.OPEN 0,34 ;(27) OPEN <JOB>.
|
||
.BREAK 16,400000 ;(30) FAIL, CAUSE ERR MSG.
|
||
.DISOWN 0, ;(31) DISOWN <JOB>.
|
||
JFCL ;(32)
|
||
.BREAK 16,600000 ;(33) RETURN SUCCESS.
|
||
1,,'USR ;(34) FILENAME BLOCK. MAKE SURE OPEN WILL FAIL IF NOT INFERIOR.
|
||
;(35) WILL GET UNAME
|
||
;(36) WILL GET JNAME.
|
||
|
||
;$$V ROUTINE.
|
||
KLSTJ: call terpri
|
||
SETZ U,
|
||
KLSTJ2: SKIPE UUNAME(U)
|
||
SKIPN D,UJNAME(U)
|
||
JRST KLSTJ1
|
||
MOVEI D,"
|
||
CAMN U,CU
|
||
MOVEI D,"*
|
||
PUSHJ P,TOUT
|
||
PUSHJ P,TSPC
|
||
CALL KLSTJ4
|
||
PUSHJ P,CRF
|
||
KLSTJ1: ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JRST KLSTJ2
|
||
MOVE U,CU
|
||
JRST NLTL4
|
||
|
||
KLSTJ4: SKIPE INTBIT(U)
|
||
JRST KLSTJ3
|
||
MOVE D,UUNAME(U)
|
||
PUSHJ P,SIXTYP
|
||
PUSHJ P,TSPC
|
||
KLSTJ3: MOVE D,UJNAME(U)
|
||
PUSHJ P,SIXTYP
|
||
PUSHJ P,TSPC
|
||
MOVE D,UINTWD(U)
|
||
CAIN D,21
|
||
JRST KLSTJM
|
||
JUMPL D,KLSTJP
|
||
JUMPE D,KLSTJR
|
||
CAIL D,9
|
||
JRST KLSTJP ;AFTER .BREAK 16, AND TEMP BPTS, TYPE P.
|
||
PUSHJ P,TOC
|
||
MOVEI D,"B
|
||
KLSTJT: PUSHJ P,TOUT
|
||
PUSHJ P,TSPC
|
||
HRRZ A,UIND(U)
|
||
JRST G8PNT
|
||
|
||
KLSTJM: MOVEI D,"-
|
||
JRST KLSTJT
|
||
|
||
KLSTJR: MOVEI D,"W
|
||
SKIPN UINT(U)
|
||
MOVEI D,"R
|
||
JRST KLSTJT
|
||
|
||
KLSTJP: MOVEI D,"P
|
||
JRST KLSTJT
|
||
|
||
KLFILE: PUSHJ P,QJERR ;:LFILE -- MUST HAVE JOB.
|
||
PUSHJ P,TSPC ;TYPE SPACE, THEN NAME OF LOADED FILE.
|
||
SKIPN D,UFNAMD(U)
|
||
7NRTYP [ASCIZ /No File Loaded
|
||
/]
|
||
MOVEI A,UFNAMD(U)
|
||
call lfile ;print the filenames
|
||
jrst nltl2 ;prompt and return
|
||
|
||
;print name of file in block <- A
|
||
lfile: move b,3(a) ;get the SNAME in B for historical reasons
|
||
|
||
;PRINT NAME OF FILE IN BLOCK <- A, SNAME IN B.
|
||
LFILE0: SKIPN D,(A)
|
||
JRST LFILE1
|
||
CAMN D,['NET,,]
|
||
JRST LFILN ;IF DEVICE IS NET:, THE FILENAMES ARE SOCKET
|
||
;NUMBERS.
|
||
came d,[sixbit /CHAOS/] ;For both CHAOS:
|
||
camn d,[sixbit /TCP/] ;and TCP:
|
||
jrst lflhst ;we perform hair.
|
||
PUSHJ P,SIXTYQ
|
||
CTYPE ":
|
||
CTYPE "
|
||
LFILE1: SKIPN D,B
|
||
JRST LFILE2
|
||
PUSHJ P,SIXTYQ
|
||
CTYPE ";
|
||
CTYPE "
|
||
LFILE2: SKIPN D,1(A)
|
||
POPJ P,
|
||
PUSHJ P,SIXTYQ
|
||
CTYPE 40
|
||
MOVE D,2(A)
|
||
SIXTYQ: MOVE C,D ;PRINT C(D) AS SIXBIT STOPPING WHEN ZERO
|
||
SIXTP1: MOVEI D,0
|
||
ROTC C,6
|
||
ADDI D,40
|
||
CAIE D,":
|
||
CAIN D,";
|
||
CTYPE ^Q
|
||
CAIE D,40
|
||
CAIN D,",
|
||
CTYPE ^Q
|
||
CALL TOUT ;MUSN'T USE CTYPE SINCE CALLED FROM UERLOS.
|
||
JUMPN C,SIXTP1
|
||
RET
|
||
|
||
|
||
;;;For CHAOS: and TCP: names: SNAME is HOST number, FN1 is local
|
||
;;;port/index, FN2 is foreign port/index.
|
||
LFLHST: pushj p,sixtyq
|
||
save w1
|
||
save a
|
||
7type [asciz /: Host /]
|
||
move a,3(a)
|
||
call g8pnt
|
||
7type [asciz /, Local /]
|
||
move a,(p)
|
||
move a,1(a)
|
||
call g8pnt
|
||
7type [asciz /, Foreign /]
|
||
rest a
|
||
move a,2(a)
|
||
call g8pnt
|
||
7type [asciz /
|
||
/]
|
||
jrst popw1j
|
||
|
||
LFILN: SAVE W1 ;HERE FOR :LFILE IF DEVICE IS NET:.
|
||
SAVE A
|
||
SAVE B
|
||
7TYPE [ASCIZ /NET: loc soc = /]
|
||
MOVE A,1(A) ;"FN1" IS LOAL SOCKET.
|
||
CALL G8PNT
|
||
7TYPE [ASCIZ /, host = /]
|
||
REST A ;"SNAME" LOW 8 BITS IS HOST NUMBER.
|
||
ANDI A,377
|
||
CALL G8PNT
|
||
7TYPE [ASCIZ /, frn soc = /]
|
||
REST A
|
||
MOVE A,2(A) ;"FN2" IS FOREIGN SOCKET.
|
||
CALL G8PNT
|
||
7TYPE [ASCIZ /
|
||
/]
|
||
JRST POPW1J
|
||
|
||
;ON THIS PAGE ARE HANDLED THE SPECIAL QUIRKY FEATURES OF ^H AND ^K:
|
||
;$^K LOADINNG SYMBOLS INTO EXISTING JOB, AND ^H PROCEDING AN EXISTING JOB.
|
||
|
||
CTLK: MOVNI W1,3 ;^K - (MAYBE QUERY AND) CLOBBER EXISTING JOB.
|
||
MOVEM W1,REOWNF
|
||
CAIA
|
||
;^H - PROCEED AN EXISTING JOB
|
||
CTLH: SETZM REOWNF
|
||
SETOM TOKTRM ;DON'T READ LINE LATER FOR JCL.
|
||
MOVEM C,SYSN2
|
||
TLZ F,FLC+FLLET
|
||
TLNE B,O.1ALT ;$^H AND $^K LOAD SYMBOLS.
|
||
TLO F,FLC
|
||
PUSHJ P,NCOMI ;INIIALIZE DEVICE AND SNAME TO DEFAULTS (DSK:<MSNAME>;)
|
||
SKIPN REOWNF
|
||
JRST CTLH2 ;JUMP IF ^H.
|
||
SKIPE SYSN2
|
||
JRST ACTRLK ;SKIP IF ^K WITH NON-NULL PREFIX ARGUMENT.
|
||
TLNN B,O.1ALT ;^K AND $^K WITH NO ARGUMENT COME HERE.
|
||
JRST NXERR ;^K WITH NO ARG IS MEANINGLESS.
|
||
PUSHJ P,QJERR ;$^K - SAME AS :SL<CR>.
|
||
MOVEI D,^M ;MAKE LAST CHAR BE ^M TO END
|
||
DPB D,GSCHRP ;THE FILESPEC CSMI WILL READ.
|
||
call terpri
|
||
SETZM GSONUM ;PREVENT ANY INFIX ARG (AS IN $1^K) FROM SCREWING :SL.
|
||
SETZM GSDNUM
|
||
JRST CSMI ;NOW GO DO ":SL^M"
|
||
|
||
;COME HERE FOR ^H, WITH OR WITHOUT ARGUMENT. EITHER SELECT AND CONTINUE
|
||
;AN EXISTING JOB, OR EXIT TO CREATE AND LOAD A NEW ONE.
|
||
|
||
CTLH2: IRP X,,[40,"^,"H]
|
||
MOVEI D,X
|
||
CALL LPTR
|
||
TERMIN ;ECHO SPACE AND ^H TO WALLPAPER FILE.
|
||
MOVE D,TTYOPT
|
||
TLNE D,%TOMVB ;AND SAME FOR THE TTY, BUT SOME TTY'S ECHO ^H
|
||
jrst [tlnn d,%tosa1 ;AS UPARROW-H; THEY DON'T NEED ANYTHING DONE.
|
||
7type [asciz /F^H/] ;So echo according to whether
|
||
tlne d,%tosa1 ;it has SAIL graphics or not
|
||
7type [asciz /F H/] ;to get the right kind of uparrow
|
||
jrst .+1]
|
||
SKIPN D,SYSN2 ;PUT JNAME IN D FOR OUSRNL.
|
||
JRST [ CALL FNJOB6 ;^H WITH NO ARG SELECTS ANOTHER JOB,
|
||
JUMPL U,JERR ;NO JOB?
|
||
JRST CTLH0]
|
||
SYSCAL OPEN,[[10,,FDRC] ? ['USR,,] ? RUNAME ? SYSN2] ;DOES JOB EXIST?
|
||
jrst actrlk ;NO; ACT LIKE ^K; CREATE AND LOAD IT.
|
||
.CLOSE FDRC, ;YES; JUST $P OR $G IT.
|
||
CALL DDTUNM ;MAKE SURE WE KNOW OUR UNAME.
|
||
MOVE C,RUNAME ;INSIST ON OUR OWN UNAME; IF NOT FOUND, CREATE A JOB.
|
||
setzm reownf ;don't offer to clobber if reowned, just DO it
|
||
call jobpik ;first select that job
|
||
jumpl d,njger1 ;If job used to exist but vanished, barf
|
||
jumpn d,actrlk ;Not found somehow, create and load it.
|
||
call opusr
|
||
jrst njgerr ;Shouldn't happen, but...
|
||
CTLH0: CALL QIJERR
|
||
SKIPN D,UINT(U)
|
||
MOVE D,UINTWD(U) ;IF JOB IS STOPPED AT A BREAKPOINT,
|
||
CAIL D,1
|
||
CAILE D,8
|
||
CAIA
|
||
AOSA PPC(U) ;JUST PRINT STATUS. AOS PC NOW SINCE UBRK0A WILL SOS IT.
|
||
SKIPGE UPI0(U) ;IF AFTER A .VALUE, PRINT STATUS, AND DO SOS PC.
|
||
JRST UBRK0A ;DON'T $P; JUST PRINT STATUS.
|
||
push p,u ;remember which job it is
|
||
SKIPE UINT(U) ;JOB INTERRUPTING => LET IT RETURN SO WE CAN $P IT.
|
||
CALL UBRK0
|
||
pop p,d ;remember which job it was
|
||
caie d,(u) ;Is this the same job as before?
|
||
jrst njger1 ; No, tell him it's gone and abort.
|
||
MOVE D,UINTWD(U)
|
||
CAIE D,21 ;IF JOB ALREADY HAD BEEN RUN,
|
||
JRST [ 7TYPE [ASCIZ /P/] ;JUST PROCEED IT.
|
||
JRST NALTP]
|
||
7TYPE [ASCIZ /G/]
|
||
JRST CTLH8 ;ELSE JUST START IT.
|
||
|
||
;HERE WE HANDLE FOO^H, FOO^K, :FOO ...<CR>, :NEW FOO ...<CR>, :RETRY FOO ... <CR>.
|
||
;REOWNF IS 0 FOR ^H, -3 FOR ^K, -1 FOR :RETRY, AND >0 FOR :NEW.
|
||
;FOR :FOO, REOWNF IS >0 IF GENJFL IS SET, OR -2 IF GENJFL IS 0.
|
||
;SYSN2 HOLDS THE NAME OF THE PROGRAM ("FOO").
|
||
;FLC => LOAD SYMBOLS. FLLET => USER HAS SPECIFIED DEVICE OR SNAME EXPLICITLY.
|
||
ACTRLK: MOVS D,SYSN2
|
||
CAIE D,(SIXBIT/>/)
|
||
CAIN D,(SIXBIT/</)
|
||
ERSTRT [SIXBIT /RUN PROGRAM < OR >?/]
|
||
TLNE F,FLLET ;UNLESS DEV OR SNAME SPEC'D
|
||
JRST CTLH1
|
||
CAME D,[(SIXBIT/PDP6/)]
|
||
CAMN D,['TRNHAC] ;CHECK FOR SPECIAL JNAMES FOR WHICH ^K AND $J ARE THE SAME.
|
||
JRST CTLH3
|
||
CAMN D,[(SIXBIT/PDP10/)]
|
||
JRST CTLH3
|
||
CAIE D,'SYS
|
||
JRST CTLH1 ;GO GET JOB&FILE
|
||
CTLH3: SETZB C,REOWNF
|
||
CAIE D,'SYS ;FOR SYS, MUST USE UNAME=0 TO GET PHONY INFERIOR.
|
||
MOVE C,RUNAME ;FOR OTHERS, THING TO DO IS INSIST ON OUR UNAME.
|
||
MOVE D,SYSN2
|
||
PUSHJ P,OUSRNL
|
||
JRST NLTL2
|
||
|
||
;try to find the program to be loaded.
|
||
fndcmd: move b,hsname ;Try loading from our HSNAME first
|
||
tlnn f,fllet ;but if dev or SNAME spec'd, try no other
|
||
movem b,sfiles
|
||
.call ctlho
|
||
caia ; failed, try next
|
||
ret ; won!
|
||
tlnn f,fllet ;if dev or sname spec'd, try no other.
|
||
pushj p,floerr ; or if bad error,
|
||
opner ctlho
|
||
movei b,'SYS ;Next try the SYS; directory
|
||
hrlzm b,sfiles
|
||
.call ctlho ;msname failed - try SYS
|
||
caia
|
||
ret
|
||
call floerr
|
||
opner ctlho
|
||
movei b,(sixbit /1/)
|
||
hrrm b,sfiles ;turn it into SYS1
|
||
.call ctlho
|
||
caia
|
||
ret
|
||
call floerr
|
||
opner ctlho
|
||
movei b,(sixbit /2/) ;Try SYS2 next
|
||
hrrm b,sfiles ;turn it into SYS2
|
||
.call ctlho
|
||
caia
|
||
ret
|
||
call floerr
|
||
opner ctlho
|
||
movei b,(sixbit /3/) ;Try SYS3 next
|
||
hrrm b,sfiles ;turn it into SYS3
|
||
.call ctlho
|
||
caia
|
||
ret
|
||
call floerr
|
||
opner ctlho
|
||
movei b,sfile ;B gets filename block for FLOCK to use
|
||
.suset [.ssname,,msnam] ;Look on our MSNAME first
|
||
call flock ;and look all over creation for that file
|
||
jrst ctlher
|
||
movs b,snlist ;if not found it on SYS,
|
||
movsm b,sfiles ;set default sname to one found on.
|
||
ret
|
||
|
||
ctlher: movei d,'SYS ;print SYS: in error msgs, not DSK.
|
||
hrlzm d,sfile
|
||
aose insist ;If we are insisting on getting a file
|
||
opner ctlho ; Give an error since we didn't find one
|
||
ctype 7 ;otherwise beep
|
||
ret ;and return with insist being zero
|
||
|
||
|
||
|
||
ctlh1: skipl ckqflg ;If it's -1 or 0, barf if the file isn't found
|
||
jrst ctlh7
|
||
skipn toktrm ;if ^K, or ^H, or CR already seen, don't read a line.
|
||
call rlinec
|
||
hrrzm p,insist ;barf immediately if file not found
|
||
call fndcmd ;find the file with the commands
|
||
jrst ctlh6 ;
|
||
|
||
ctlh7: hrrzm p,insist ;barf when we can't find the file
|
||
skipe ckqflg ;but if CKQFLG > 0, don't barf until we've read JCL
|
||
setom insist ; INSIST = -1 means don't barf, just zero INSIST
|
||
call fndcmd ;Find the file with the commands
|
||
skipn toktrm ;Unless this is ^H or ^K, or CR already seen
|
||
call rlinec ; read JCL after :filename .
|
||
skipn insist ;if INSIST is zero
|
||
opner ctlho ; Then an FNDCMD lost, barf now
|
||
ctlh6: call ctlh4 ;load the file and gobble the JCL
|
||
call jcl ; Read JCL normally
|
||
|
||
ctlh8: setz b, ;make sure $G routine thinks it has no args.
|
||
jrst naltg ;start the job.
|
||
|
||
;; CALL CTLH4
|
||
;; <JCL reading routine>
|
||
;; runs a job with JNAME from SYSN2.
|
||
;; clobbers AC's with reckless abandon
|
||
|
||
ctlh4: hlre d,logdin
|
||
aosn d
|
||
7type [asciz /(Please Log In)
|
||
/]
|
||
|
||
call ddtunm
|
||
move d,sysn2
|
||
SKIPLE REOWNF ;FOR ":FOO", COMPUTE AN UNUSED JNAME.
|
||
CALL GENJOB
|
||
MOVE C,RUNAME
|
||
CALL OUSRNL ;SELECT/CREATE THE JOB, AND QUERY FOR --CLOBBER...--?
|
||
CALL QIJERR ;COMPLAIN IF NOT OUR INFERIOR.
|
||
MOVE D,SYSN2
|
||
.USET USRI,[.SXJNAM,,D]
|
||
CAMN D,UJNAME(U) ;IF JNAME NOT SAME AS PROGRAM NAME,
|
||
JRST CTLH5
|
||
CALL NJTYP ;SAY WHAT THE JNAME IS.
|
||
CALL CRF
|
||
CTLH5: MOVEI B,UFILE(U) ;COPY NAME OF FILE READ INTO $L DEFAULT.
|
||
HRLI B,SFILE
|
||
BLT B,UFILES(U)
|
||
SETZM UFLSYS(U)
|
||
TLNN F,FLLET ;BUT IF DEFAULTED TO SYS: OR SYS1;,
|
||
SETOM UFLSYS(U) ;CHANGE IT TO DSK: BEFORE $Y.
|
||
SKIPL UCHNLO ;ERROR IF JOB OPEN IS NOT OUR INFERIOR.
|
||
JRST JERR
|
||
xct @(p) ;call our JCL getting function
|
||
MOVEI D,BPBEG+1(U)
|
||
HRLI D,-1(D) ;CLEAR OUT ALL BREAKPOINTS, AND THE MAR.
|
||
SETZM BPBEG(U)
|
||
BLT D,BPEND-1(U)
|
||
SETOM PERMIT(U) ;ALLOW .VALUE'S AND SYSTEM CALLS IN GENERAL.
|
||
SETOM SYSUUO(U)
|
||
SYSCALL USRVAR,[MOVEI USRO ? [SIXBIT /MARA/] ? MOVEI 0]
|
||
JFCL ; So maybe this is a KS10...
|
||
CALL ALOAD
|
||
.USET USRO,[.SXUNAM,,TUNAME]
|
||
.USET USRO,[.SHSNAM,,THSNAM]
|
||
MOVE D,XUNAME ;reset the temporary XUNAME
|
||
MOVEM D,TUNAME
|
||
move d,hsname ;reset the HSNAME too.
|
||
movem d,thsnam
|
||
.suset [.ssnam,,lsnam]
|
||
setzm srflag
|
||
jrst popj1 ;return, skiping our argument
|
||
|
||
ctlho: calblk OPEN,[ %clbit,,.bii ? %climm,,utic ? sfile ? sfile+1 ? sfile+2
|
||
sfile+3]
|
||
|
||
;ASSUMING D HAS DESIRED OR PRESENT JNAME OF JOB,
|
||
;"AOS" IT UNTIL IT IS NOT THE NAME OF ANY EXISTING JOB.
|
||
GENJOB: SETZ C, ;HAVEN'T FOUND CHAR TO AOS YET.
|
||
.IOPUS USRI,
|
||
CALL GENJO3
|
||
.IOPOP USRI,
|
||
RET
|
||
|
||
GENJO3: SYSCAL OPEN,[[10,,USRI] ? ['USR,,] ? RUNAME ? D]
|
||
RET ;THIS NAME IS GOOD.
|
||
JUMPN C,[AOJA A,GENJO2] ;ALREADY KNOW WHERE TO AOS => DO SO.
|
||
MOVE C,[440600,,D]
|
||
GENJO1: ILDB A,C ;LOOK FOR FIRST BLANK
|
||
TLNE C,770000 ;OR LAST CHAR OF WORD.
|
||
JUMPN A,GENJO1
|
||
MOVEI A,'0 ;FIRST, TRY SETTING TO 0.
|
||
GENJO2: DPB A,C
|
||
JRST GENJO3
|
||
|
||
;RENAME THE CURRENT JOB AS A GENSYM.
|
||
KGENJOB:MOVE D,UJNAME(U)
|
||
CALL GENJOB
|
||
MOVE C,D
|
||
JRST N2AJ
|
||
|
||
NCTLU: TRZA B,-1 ;^U, $^U, $$^U .
|
||
NCTLT: HRRI B,1 ;^T, $^T, $$^T .
|
||
SAVE B
|
||
MOVEM C,NCTLTA ;SAVE ARG (AIO)
|
||
CALL WARN
|
||
XCT (B)[7TYPE [ASCIZ / (Remove Translation)/]
|
||
7TYPE [ASCIZ / (Make Translation)/]]
|
||
CALL GSOT
|
||
MOVEI C,NCTLTF
|
||
MOVSI D,'*_14 ;SET FILENAMES TO *.
|
||
MOVEM D,NCTLTF+1
|
||
MOVEM D,NCTLTF+2
|
||
MOVEM D,NCTLTF+3
|
||
MOVEM D,NCTLTF
|
||
PUSHJ P,RRFL1 ;READ 1ST NAME.
|
||
MOVE D,[NCTLTF,,NCTLTF+5]
|
||
BLT D,NCTLTF+8 ;COPY TO BLOCK FOR .CALL .
|
||
MOVE B,(P)
|
||
TRNN B,1 ;^U => ONLY ONE NAME TO READ.
|
||
JRST NCTLU1
|
||
PUSHJ P,LINK2
|
||
7TYPE [ASCIZ/Into: /] ;PROMPT FOR ANOTHER LINE IF NEC.
|
||
MOVEI C,NCTLTF
|
||
PUSHJ P,RRFL1
|
||
NCTLU1: MOVEI A,USRI ;START CONSTRUCTING 1ST ARG.
|
||
REST B
|
||
TLNE B,O.1ALT
|
||
MOVEI A,-1 ;$^T => ON SELF.
|
||
TLNE B,O.1ALT+O.2ALT
|
||
TLO A,200000 ;1 OR 2 ALTS => INFERS ALSO.
|
||
MOVE C,[440600,,NCTLTA]
|
||
NCTLU2: ILDB D,C ;LOOK FOR A, I, O IN ARG.
|
||
JUMPE D,NCTLU3
|
||
SETZ W1,
|
||
IRPS X,,A J I O,Y,,400000 200000 1 2
|
||
CAIN D,'X
|
||
MOVEI W1,Y
|
||
TERMIN ;CHECK FOR MEANINGFUL CHARS.
|
||
JUMPE W1,NAERR
|
||
TLO A,(W1)
|
||
JRST NCTLU2
|
||
|
||
NCTLU3: TLCE A,3 ;IF NEITHER I NOR O SPECIFIED, ASSUME BOTH.
|
||
TLC A,3
|
||
MOVE C,[SIXBIT/TRANDLTRANAD/](B)
|
||
.CALL NCTLUB
|
||
JRST ERR
|
||
JRST NLTL4
|
||
|
||
NCTLUB: SETZ?SIXBIT/CALL/
|
||
C ;EITHER TRANDL OR TRANAD
|
||
A ;SAYS WHICH TRANSL LIST TO USE
|
||
[-4,,NCTLTF+5] ;1ST (OR ONLY) NAMES
|
||
SETZ [-4,,NCTLTF] ;2ND SET ( USED ONLY BY TRANAD)
|
||
|
||
;:LISTF <DIRECTORY-SPEC> <CR>
|
||
LISTF: MOVEI C,PFILE
|
||
PUSHJ P,RRFL4 ;READ IN DEV & SNAME ONLY.
|
||
JRST NCTLF1
|
||
|
||
NCTLF: SKIPN C ;0^F MEANS SWITCH TO MSNAME.
|
||
MOVE C,MSNAM
|
||
JUMPE D,NCTLF5 ;NO ARG => USE DEFAULT DIRECTORY.
|
||
SETOM SRFLAG
|
||
.SUSET [.SSNAM,,C]
|
||
.OPEN FDRC,[SIXBIT/ DSK.FILE.(DIR)/]
|
||
JRST NCTLF2
|
||
NCTLF3: SETZM SRFLAG
|
||
MOVEM C,FFILES
|
||
MOVEM C,LSNAM
|
||
MOVE A,C
|
||
CALL RRFL3 ;PUT THIS SNAME ON THE SNAME SEARCH LIST.
|
||
MOVSI D,'DSK
|
||
CTLF0: MOVEM D,FFILE ;PRINT DIR OF DEV IN RH(D), SNAME IN LSNAM.
|
||
;;I'm not sure why the following check is here. I found a similar
|
||
;;check in the code following NCTLF2 that was using a different
|
||
;;table of devices. I changed it to use the same table
|
||
;;that this one does. As far as I can tell, however, the following
|
||
;;check never does anything useful, and it is the other check that
|
||
;;is the effective one. -Alan 2/7/84
|
||
movsi c,-nodfln
|
||
nctlf8: camn d,nodflt(c);Is this something that doesn't set the :PRINT defaults
|
||
jrst nctlf1 ; Yes, don't set them
|
||
aobjn c,nctlf8 ;No, check next one
|
||
;; BV: check if it is xxTTY or xxDIR for some ITS name xx
|
||
move a,d
|
||
lsh a,12.
|
||
push p,b ;touched by mchok0, used below
|
||
caie a,'TTY
|
||
cain a,'DIR
|
||
jrst [ ldb a,[.bp (777700),d]
|
||
call mchok0
|
||
jrst .+1
|
||
pop p,b
|
||
jrst nctlf1 ]
|
||
pop p,b
|
||
TLNN B,O.1ALT ;$^F DOESN'T SET DEFAULTS EITHER.
|
||
CALL NCTLF4 ;OTHERWISE SET :PRINT DEFAULTS.
|
||
NCTLF1: MOVEI C,FFILE ;C MUST BE SET UP FOR OPNER (IN TSCALL)
|
||
TSOPEN FDRC,FFILE
|
||
JRST OPRINT
|
||
|
||
;; BV: generic check above for MCTTY,AITTY,MLTTY,MXTTY,MDTTY,KSTTY,KLTTY,MCDIR,AIDIR,MLDIR,MXDIR,MDDIR,KSDIR,KLDIR
|
||
nodflt: irp x,,[TTY,T,D,DIR,DVR,DVS,GLP,LP7,LP8,LP9,LR7,7LP,7LR,TPL,CHAOS,CHA,COR,CLO,CLU,CLI,CLA]
|
||
sixbit /x/
|
||
termin
|
||
block 5 ;For patching
|
||
nodfln==.-nodflt
|
||
|
||
NCTLF2: MOVE D,C
|
||
.STATUS FDRC,A ;COME HERE WHEN ^F'S DIRECTORY OPEN FAILS.
|
||
LDB A,[OPNLBP,,A]
|
||
CAIE A,%ENSDR ;IF NON-EX-SNAME, TRY USING ARG AS DEVICE.
|
||
JRST NCTLF3 ;LOSES FOR OTHER REASON => ARG IS AN SNAME, DESPITE LOSS.
|
||
SYSCAL OPEN,[[2,,FDRC] ? D ? ['.FILE.] ? [SIXBIT/(DIR)/] ? FFILES ? %CLERR,,A]
|
||
CAIE A,%ENSDV
|
||
CAIA
|
||
JRST NCTLF3 ;DEVICE GETS NON-EX-DEVICE ERROR => TREAT ARG AS SNAME.
|
||
;TRY THE SNAME AGAIN, SO IT WILL GO IN FFILES & IN ERR MESSAGE.
|
||
MOVE C,FFILES ;DEVICE EXISTS, SO MAKE IT THE DEFAULT,
|
||
MOVEM C,LSNAM ;AND MAKE THE SNAME WE USED THE DEFAULT.
|
||
MOVEM D,FFILE
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
SETZM SRFLAG
|
||
SKIPE A ;IF WE FAILED IN OPENING THE DEVICE (EVEN THOUGH IT EXISTS)
|
||
OPNER FFILE ;GIVE USER THE APPROPRIATE ERROR MESSAGE.
|
||
CALL FDRCO1 ;SET UP FOR ILDB'ING FROM THE CHANNEL ALREADY OPEN
|
||
movsi c,-nodfln ;See comment at CTLF0+1
|
||
nctlf9: camn d,nodflt(c) ;Certain devices don't set the ^R defaults.
|
||
jrst oprint
|
||
aobjn c,nctlf9
|
||
TLNN B,O.1ALT ;$^F DOESN'T SET DEFAULTS EITHER.
|
||
CALL NCTLF4 ;OTHERWISE SET :PRINT DEFAULTS.
|
||
JRST OPRINT ;THEN PRINT THE DIRECTORY.
|
||
|
||
NCTLF5: MOVE C,FFILES
|
||
MOVEM C,LSNAM
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
JRST NCTLF1
|
||
|
||
;;;<arg>$$<Narg> is a hairy directory lister.
|
||
|
||
n2acf: setzi i1, ;Narg defaults to zero.
|
||
tlne b,o.ifx
|
||
move i1,gsdnum
|
||
cail i1,dirfnn ;If Narg is too big, use zero.
|
||
setzi i1,
|
||
skipe a,ndrop(i1) ;Super hairy case?
|
||
jrst ndrhak
|
||
lsh i1,1 ;Compute index into table.
|
||
skipe dirdir ;Wierd kludge: If flag set,
|
||
jumpn d,[ ; and arg explicitly given,
|
||
tlne b,o.ifx ; and Narg explicitly not given,
|
||
jrst .+1 ; then arg is new SNAME.
|
||
skipn c ;0 => HSNAME
|
||
move c,hsname
|
||
movem c,pfiles
|
||
jrst n2acf1] ;Proceed as if no arg given.
|
||
jumpn d,[ ;Was arg given?
|
||
skipn dirfn2(i1) ;If PFILE1 would have been used,
|
||
movem c,pfile1 ; remember arg there for next time.
|
||
jrst n2acf2]
|
||
n2acf1: skipn c,dirfn2(i1) ;Use DIRFN2 as arg,
|
||
move c,pfile1 ; or PFILE1 if that contained zero.
|
||
n2acf2: hlr d,pfile
|
||
hrli d,'DIR
|
||
sysclo open,[[.bai,,fdrc] ? d ? dirfn1(i1) ? c ? pfiles]
|
||
jrst kprin1
|
||
|
||
;;;Super hairy directory lister:
|
||
;;;Narg is used as an index into 5 tables: NDRDEV, NDRDIR, NDRFN1, NDRFN2,
|
||
;;;and NDROP. Each word in NDROP is divided into four 9-bit opcodes. Each
|
||
;;;opcode controls the interpretation of one of the corresponding words
|
||
;;;found in the other tables as follows:
|
||
;;;
|
||
;;; 4.9 - 4.1 controls NDRDEV (device)
|
||
;;; 3.9 - 3.1 controls NDRDIR (directory)
|
||
;;; 2.9 - 2.1 controls NDRFN1 (first file name)
|
||
;;; 1.9 - 1.1 controls NDRFN2 (second file name)
|
||
;;;
|
||
;;;The nine bits in each opcode are interpreted the same for each table.
|
||
;;;After performing the operations specified by the opcodes, the resulting
|
||
;;;four words are used as a filename to be opened, and printed on the
|
||
;;;user's terminal.
|
||
;;;
|
||
;;;If all four opcodes are zero, then we perform the old behavior of $$^F
|
||
;;;and never even come here at all.
|
||
;;;
|
||
;;;The 9-bit opcode is interpreted as follows:
|
||
;;;
|
||
;;; %2FIND "Indirect bit". Right half of word is to be taken as the
|
||
;;; address of the word to return. Otherwise the word itself is
|
||
;;; returned.
|
||
;;; %2FWBK If %2FIND is set, this bit gives permission to write back into
|
||
;;; the word addressed by the right half, so that if no
|
||
;;; argument is given next time, the same thing will happen.
|
||
;;; %2FARG Any argument given applies to this operand.
|
||
;;; %2F0L If %2FIND is set, and an argument of 0 was given, then the
|
||
;;; sixbit word addressed by the \left/ half of the word is to
|
||
;;; be used. This happens even if %2FARG is not set.
|
||
;;; (MSNAM,,PFILES is useful here.)
|
||
;;; %2F0LI Similar to %2F0L, except the left half is directly taken to
|
||
;;; be three sixbit characters. (<'DSK>,,PFILE is useful here.)
|
||
;;; %2FDIR "DIR" is to be prefixed to the final result. If %2FWBK is
|
||
;;; also set, the prefixing is done BEFORE writing the result back.
|
||
;;; %2FR2F After everything, initialize ^F default for this component
|
||
;;; from the corresponding ^R default. Only works for device
|
||
;;; and directory components.
|
||
|
||
%2FIND==:1_0
|
||
%2FWBK==:1_1
|
||
%2FARG==:1_2
|
||
%2F0L==:1_3
|
||
%2F0LI==:1_4
|
||
%2FDIR==:1_5
|
||
%2FR2F==:1_6
|
||
|
||
ndrhak: move b,ndrfn2(i1)
|
||
pushj p,ndrop1
|
||
lsh a,-9
|
||
move b,ndrfn1(i1)
|
||
pushj p,ndrop1
|
||
lsh a,-9
|
||
move b,ndrdir(i1)
|
||
pushj p,ndrop1
|
||
move b,pfiles
|
||
trne a,%2FR2F
|
||
movem b,ffiles
|
||
lsh a,-9
|
||
move b,ndrdev(i1)
|
||
pushj p,ndrop1
|
||
move b,pfile
|
||
trne a,%2FR2F
|
||
movem b,ffile
|
||
pop p,a ;Can't keep 'em on the PDL cause of
|
||
pop p,d ; error UUO.
|
||
pop p,b
|
||
pop p,c
|
||
sysclo open,[[.bai,,fdrc] ? a ? b ? c ? d]
|
||
jrst kprin1
|
||
|
||
ndrop1: trnn a,%2FIND ;%2FIND => indirect
|
||
jrst ndrop8
|
||
skipe d ;If argument was not given,
|
||
trnn a,%2FARG ; or it doesn't apply,
|
||
skipa i2,(b) ; pick up word.
|
||
move i2,c ;Else argument.
|
||
trne a,%2F0L+%2F0LI ;If %2F0L or %2F0L set,
|
||
jumpn d,[ ; and arg given,
|
||
jumpn c,.+1 ; and it is 0.
|
||
hlrz i2,b ;left half into I2
|
||
trnn a,%2F0LI ;%2F0LI => immediate 3 chars.
|
||
skipa i2,(i2) ;%2F0L => address of 6 chars.
|
||
hrlz i2,i2
|
||
jrst .+1]
|
||
trne a,%2FWBK ;If %2FWBK set,
|
||
movem i2,(b) ; store it back.
|
||
trnn a,%2FDIR ;%2FDIR => DIR prefix hack
|
||
jrst ndrop9
|
||
hlr i2,i2
|
||
hrli i2,'DIR
|
||
jrst ndrop9
|
||
|
||
ndrop8: skipe d ;If argument not given,
|
||
trnn a,%2FARG ; or it doesn't apply,
|
||
skipa i2,b ; use word.
|
||
move i2,c ;Else use argument.
|
||
ndrop9: exch i2,(p)
|
||
jrst (i2)
|
||
|
||
|
||
NCTLR: CALL WARN
|
||
7TYPE [ASCIZ / (Print File)/]
|
||
CALL GSOT
|
||
KPRINT: CALL FDROPN
|
||
KPRIN1: CALL FDRCO1 ;FILL UP THE FDRC BUFFER.
|
||
OPRINT: PUSHJ P,CTLF4
|
||
JRST NLTL2
|
||
|
||
CTLF4: PUSHJ P,FORMF
|
||
CTLF1: setzm fdrcls ;we want to close FDRC after this
|
||
ctlf1a: PUSHJ P,MORINI
|
||
jrst ctlf2a ;on flushing xct this.
|
||
CTLF3: CALL FDRCI
|
||
JRST CTLF2
|
||
CTLF7: CAIN D,^L
|
||
JRST CTLF6
|
||
CAIN D,^M
|
||
JRST CTLF5
|
||
CALL TOUT
|
||
JRST CTLF3
|
||
|
||
CTLF6: CALL FDRCI ;^L: IS THERE ANYTHING AFTER?
|
||
JRST CTLF2
|
||
CTYPE ^L ;YES, OUTPUT ^L
|
||
JRST CTLF7 ;AND THE CHAR THAT FOLLOWED IT, ALREADY READ.
|
||
|
||
CTLF5: CALL FDRCI
|
||
JRST CTLF2
|
||
CAIN D,^J ;IF THE CR IS NOT STRAY, PRINT THE CRLF.
|
||
JRST [ CALL CRF
|
||
JRST CTLF3]
|
||
7TYPE [ASCIZ /H/] ;IF THE CR IS STRAY, ACHIEVE EFFECT USING A ^P CODE,
|
||
SAVE D
|
||
MOVEI D,^M ;BUT TO WALL PAPER FILE GIVE A REAL LIVE STRAY CR.
|
||
CALL LPTR
|
||
REST D ;THEN GO HANDLE WHAT FOLLOWED THE CR.
|
||
JRST CTLF7
|
||
|
||
ctlf2a: setzm fdrcls ;Note that we flushed the output
|
||
CTLF2: CALL MORFL2 ;UNDO CALL TO MORINI.
|
||
skipn fdrcls ;if we want FDRC closed,
|
||
.CLOSE FDRC, ; close it
|
||
JRST GSNLRT
|
||
|
||
;:LINKN <FROM>,<TO> - IS WILLING TO DELETE AN OLD FILE NAMED <FROM>.
|
||
KLINKN: call linkwn
|
||
linkn0: MOVEI C,PFILE
|
||
CALL RRFL1 ;READ IN <FROM> WITHOUT ERRING IF IT IS OPENABLE.
|
||
JRST LINK1
|
||
|
||
linkwn: MOVE D,DELWARN
|
||
CAILE D,2 ;is DELWARN 3 or more? Must be a loser!
|
||
7NRTYP [ASCIZ /
|
||
That is the wrong command for talking to another user/]
|
||
ret
|
||
|
||
;:LINK <FROM>,<TO>
|
||
LINK:
|
||
MOVE D,DELWARN
|
||
CAILE D,2 ;is DELWARN 3 or more? Must be a loser!
|
||
7TYPE [ASCIZ /(Create link-file (NOT talk to people)) /]
|
||
linkf: MOVEI C,PFILE
|
||
CALL LINK5 ;READ FROM-NAME, MAKE SURE NO FILE NOW HAS THAT NAME.
|
||
LINK1: JSP A,LINKPF ;PUSH THE CURRENT PFILE.
|
||
MOVE A,[PFILE,,NCTLTF]
|
||
BLT A,NCTLTF+2
|
||
PUSHJ P,LINK2 ;WARN IF MUST READ ANOTHER LINE.
|
||
7TYPE [ASCIZ/To: /]
|
||
PUSHJ P,RRFL1 ;READ TO- FILE.
|
||
LINK4: SYSCLO TRANS,[PFILE ? PFILE+1 ? PFILE+2 ? PFILE+3
|
||
%CLOUT,,B ? %CLOUT,,NCTLTF+3 ? %CLOUT,,NCTLTF+4 ? %CLOUT,,NCTLTF+5]
|
||
SETZ A,
|
||
CAMN B,ITSNAM ;DEVICE AI: OK ONLY ON AI MACHINE, ETC.
|
||
MOVE A,NCTLTF+5
|
||
CAMN B,[SIXBIT/SYS/]
|
||
MOVE A,B ;PHONY DISK DEVS TURN INTO SNAMES.
|
||
CAMN B,['COM,,]
|
||
MOVE A,['COMMON]
|
||
CAMN B,['TPL,,]
|
||
MOVE A,['.LPTR.]
|
||
CAMN B,['DSK,,]
|
||
MOVE A,NCTLTF+5
|
||
JSP D,LINKPP ;POP THE PUSHED FILENAMES BACK INTO PFILE.
|
||
JUMPE A,[MOVS A,NCTLTF ;LINK FROM TPL TO NON-DSK?
|
||
CAIN A,'TPL
|
||
JRST LINK7 ;COPY INSTEAD.
|
||
CAMN B,NCTLTF
|
||
JRST LINK3
|
||
JSP W2,LINK6 ;LINK FROM ANYTHING ELSE TO NON-DISK => ERROR.
|
||
ASCIZ/ - LINK TO NON-DISK/]
|
||
MOVEM A,NCTLTF+5
|
||
LINK3: SYSCLO MLINK,[NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? LSNAM
|
||
NCTLTF+3 ? NCTLTF+4 ? NCTLTF+5 ? %CLERR,,D]
|
||
.CLOSE FDRC,
|
||
JRST NLTL4
|
||
|
||
;HERE IF CAN'T MAKE LINK FROM TPL:; COPY FILE TO TPL INSTEAD.
|
||
;B STILL HAS DEV NAME RETURNED BY "TRANS" SYSTEM CALL AT LINK4.
|
||
LINK7: SYSCLO OPEN,[[.BAI,,FDRC] ? B ? NCTLTF+3 ? NCTLTF+4 ? NCTLTF+5]
|
||
.OPEN UTOC,[.BAO,,'TPL]
|
||
OPNER @.-1
|
||
JRST KCOPY0
|
||
|
||
LINKPF: REPEAT 4,SAVE PFILE+.RPCNT ;PUSH THE FILENAMES IN PFILE. CALL WITH JSP A,.
|
||
JRST (A)
|
||
|
||
LINKPP: REST C ;POP BACK INTO PFILE. CALL WITH JSP D,.
|
||
MOVEM C,LSNAM ;NOW THAT WE HAVE READ IN THE LINK TARGET NAME,
|
||
MOVEM C,FFILES
|
||
MOVEM C,PFILE+3 ;RESTORE THE SAVED FILENAMES AS THE CURRENT DEFAULTS.
|
||
.SUSET [.SSNAM,,LSNAM]
|
||
REST PFILE+2
|
||
REST PFILE+1
|
||
REST PFILE
|
||
MOVE C,PFILE
|
||
MOVEM C,FFILE
|
||
JRST (D)
|
||
|
||
; CALL LINK2
|
||
; 7TYPE [ASCIZ/PROMPT/]
|
||
;IF AT END OF A TYPED-IN LINE, EXECUTE THE PROMPT INSTRUCTION,
|
||
;AND INITIALIZE FOR READIN OF A ANOTHER LINE.
|
||
;C SHOULD CONTAIN PFILE; ALL OTHER ACS ARE CLOBBERED.
|
||
LINK2: SETOM GSONUM ;SAY DON'T RE-READ PREVIOUS CHAR. IN RRFL1.
|
||
SKIPL TOKTRM ;IF USED UP LINE,
|
||
JRST CPOPJ1
|
||
SETZM TOKTRM ;FORCE TO READ ANOTHER.
|
||
POP P,LINKRT' ;CAN'T POP AFTER GSOA.
|
||
PUSHJ P,GSOA
|
||
JRST NRBERR
|
||
TLNN F,FLCTLL
|
||
TLNN F,FLRUB
|
||
XCT @LINKRT ;DO CALLER'S ACTION THE FIRST TIME, AND FOR ^L, NOT FOR RUBOUT.
|
||
MOVE A,LINKRT
|
||
MOVEI C,PFILE
|
||
JRST 1(A) ;RET. TO CALLER.
|
||
|
||
;READ FILE SPEC, ERROR IF FILE EXISTS.
|
||
;C SHOULD POINT TO FILENAME BLOCK.
|
||
LINK5: PUSHJ P,RRFL1 ;READ IN "FROM" FILE.
|
||
MOVSI A,'>_14
|
||
CAME A,1(C) ;IF EITHER FILENAME IS >,
|
||
CAMN A,2(C) ;THE FILE "DOESN'T EXIST"
|
||
RET ;(EG WRITING THAT NAME WON'T CLOBBER ANYTHING)
|
||
.CALL FDRCO
|
||
RET ;CAN'T OPEN, SO OK.
|
||
.CLOSE FDRC,
|
||
JSP W2,LINK6
|
||
ASCIZ/ - File Exists/
|
||
|
||
;INTERNALLY GENERATED FILE ERROR MESSAGE: WITH FILENAMES IN PFILE, DO
|
||
; JSP W2,LINK6
|
||
; ASCIZ /MESSAGE/
|
||
LINK6: MOVE B,PFILE+3 ;GET SNAME,
|
||
MOVEI A,PFILE ;ADDR OF BLOCK,
|
||
PUSHJ P,LFILE0 ;PRINT FILE'S NAME.
|
||
7TYPE (W2) ;PRINT THE ERROR MESSAGE.
|
||
JRST UOPNR4
|
||
|
||
;CALL WARN ? 7TYPE WARNING PRINTS THE WARNING AND CAUSES AN ALTMODE TO BE READ
|
||
;AS THE NEXT CHARACTER, IF DELWARN > 1.
|
||
WARN: MOVE D,DELWARN
|
||
SOJLE D,POPJ1
|
||
WARN1: MOVEI D,33
|
||
MOVEM D,LIMBO
|
||
SETOM UNRCHF
|
||
SETOM UNECHF
|
||
RET
|
||
|
||
;READ IN FILE NAMES AND OPEN ON FDRC.
|
||
FDROPN: MOVEI C,PFILE
|
||
CALL RRFL1
|
||
TSCLO FDRCO
|
||
RET
|
||
|
||
fdrco: calblk OPEN,[ %clbit,,.bai ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]
|
||
fdrcou: calblk OPEN,[ %clbit,,.bai\10 ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]
|
||
fdrcol: calblk OPEN,[ %clbit,,.bai\20 ? %climm,,fdrc ? (c) ? 1(c) ? 2(c)]
|
||
|
||
|
||
opfls: 7nrtyp [asciz / OP? /]
|
||
NCTLO: jumpg d,opfls
|
||
SKIPN D,DELWARN
|
||
JRST NCTLO1 ;THIS IS $^O, OR DELWARN=0, => NO WARNING.
|
||
cail d,3 ;dangerously ignorant person?
|
||
jrst opfls ; Don't let him do this
|
||
TLNE B,O.2ALT
|
||
JRST NCTLO3 ;$$^O (RENAME) => CHECK FOR DELWARN=2.
|
||
CALL WARN1
|
||
7TYPE [ASCIZ/ (Delete File)/]
|
||
setom ctlsfl ;make ^S flush this
|
||
NCTLO1: PUSHJ P,GSOT ;TYPE " ", INIT RUBOUT PROC.
|
||
SKIPA B,(W4)
|
||
KRENAM: TLO B,O.2ALT ;SET 2-ALTMODE FLAG.
|
||
KDELET: MOVEI C,PFILE
|
||
PUSHJ P,RRFL1 ;READ 1ST FILE NAME.
|
||
setzm ctlsfl ;make ^S normal again
|
||
MOVE A,[PFILE,,NCTLTF]
|
||
BLT A,NCTLTF+4 ;COPY FN1, FN2 INTO BLOCK.
|
||
TLNN B,O.2ALT ;IF RENAME,
|
||
JRST KDELE1
|
||
PUSHJ P,LINK2 ;READ NAME TO RENAME AS.
|
||
7TYPE [ASCIZ/To: /] ;PROMPT IF NO COMMA.
|
||
CALL LINK5 ;READ FILESPEC, ERROR IF FILE EXISTS.
|
||
MOVE A,NCTLTF
|
||
MOVE B,NCTLTF+3
|
||
CAMN A,PFILE ;DEVICE AND SNAME MUST BE THE SAME IN OLD FILENAMES AND NEW FILENAMS.
|
||
CAME B,PFILE+3
|
||
JRST [ JSP W2,LINK6
|
||
ASCIZ / -- CAN'T RENAME TO A DIFFERENT DIRECTORY/]
|
||
SYSCLO RENAME,[
|
||
NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3
|
||
PFILE+1 ? PFILE+2]
|
||
JRST NLTL4
|
||
|
||
KDELE1: SYSCLO DELETE,[NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3]
|
||
JRST NLTL4
|
||
|
||
NCTLO3: CALL WARN ;FOR $$^O, PRINT WARNING ONLY IF DELWARN > 1.
|
||
7TYPE [ASCIZ / (Rename File)/]
|
||
JRST NCTLO1
|
||
|
||
;:TPL, :TPLN -- MAKE LINK FROM TPL TO SPEC'D FILE.
|
||
KTPLN: TDZA B,B ;:TPLN - OK IF FILE DOESN'T EXIST.
|
||
KTPL: SETO B, ;:TPL - FILE MUST BE OPENABLE NOW.
|
||
MOVEI C,PFILE ;USE :PRINT DEFAULTS.
|
||
PUSHJ P,RRFL1 ;READ FILE NAMES.
|
||
JUMPE B,KTPL1
|
||
TSCLO FDRCO ;:TPL, TRY TO OPEN FILE.
|
||
KTPL1: ; This opens with gensymmed filenames if the machine has a -real-
|
||
; TPL device. We supply the input filenames in case it doesn't:
|
||
sysclo open,[[.bao,,fdrc] ? [sixbit /TPL/] ? move 1(c) ? move 2(c)]
|
||
MOVE A,[FDRC,,NCTLTF]
|
||
.RCHST A, ;FIND OUT WHAT THE GENSYM WAS.
|
||
HRRZ A,NCTLTF
|
||
CAIE A,'DSK ;IF TPL: ISN'T REALLY ON DSK:,
|
||
JRST [ .IOPUS FDRC, ;CAN'T LINK FROM IT, SO COPY TO IT INSTEAD.
|
||
.IOPOP UTOC,
|
||
MOVEI C,PFILE
|
||
TSCLO FDRCO
|
||
JRST KCOPY0]
|
||
MOVSI A,'TPL ;MAKE LINK FROM TPL WITH THAT NAME.
|
||
MOVEM A,NCTLTF
|
||
.CLOSE FDRC,
|
||
JSP A,LINKPF ;PUSH PFILE NAMES ON STACK.
|
||
JRST LINK4
|
||
|
||
XFILE: MOVEI C,XFILEF
|
||
PUSHJ P,RRFL1
|
||
SYSCLO OPEN,[%CLIMM,,FDRC ;IF CAN'T OPEN, FAIL NOW
|
||
XFILEF ? XFILEF+1 ? XFILEF+2]
|
||
XFILE1: PUSHJ P,INPUSH
|
||
AOSN INIOPS ;IF SOURCE PUSHED WAS ALSO CMD FILE...
|
||
.IOPUSH COMC,
|
||
.IOPUSH FDRC,
|
||
.IOPOP COMC,
|
||
SETOM INPTR ;INDICATE READING CMD FILE.
|
||
JRST GSNLRT
|
||
|
||
; :WALLP - TURNS ON "LINE PRINTER" OUTPUT TO SPECIFIED FILE
|
||
|
||
KWALBE: ;ALSO :WALBEG.
|
||
KWALLP: MOVE A,LOGDIN ;GET REAL USER NAME,
|
||
AOJE A,LOGQ ;IF NOT LOGGED IN THEN COMPLAIN
|
||
MOVEI C,WFILE ;GET PNTR TO FILE NAMES
|
||
PUSHJ P,RRFL1 ;READ IN FILE DESCRIPTION
|
||
SETZM LPTOPN ;(IN CASE THE OPEN FAILS)
|
||
SYSCLO OPEN,[[1,,LPTC] ? WFILE ? WFILE+1 ? WFILE+2]
|
||
SETOM LPTOPN ;SUCCESS, LPT IS OPEN.
|
||
SETZM LPTFLG ;TURN ON LPT OUTPUT.
|
||
JRST NLTL4
|
||
|
||
;:WALEND - CLOSE WALLPAPER FILE.
|
||
KWALEN: .CLOSE LPTC,
|
||
SETZM LPTOPN
|
||
JRST NLTL4
|
||
|
||
;:EXISTS <FILE> ZERO IFF FILE CAN BE OPENED.
|
||
KEXIST: MOVEI C,PFILE
|
||
CALL RRFL1 ;READ FILE NAMES.
|
||
move b,pfile ;get the device
|
||
movei d,fdrco ;Normally don't use 10 control bit
|
||
came b,[sixbit /USR/]
|
||
camn b,[sixbit /MLUSR/]
|
||
movei d,fdrcou ; but for USR: devices, must have it set
|
||
came b,[sixbit /MCUSR/]
|
||
camn b,[sixbit /AIUSR/]
|
||
movei d,fdrcou
|
||
came b,[sixbit /MXUSR/]
|
||
camn b,[sixbit /MDUSR/]
|
||
movei d,fdrcou
|
||
came b,[sixbit /KSUSR/]
|
||
camn b,[sixbit /KLUSR/]
|
||
movei d,fdrcou
|
||
setz a, ;assume can be opened
|
||
.call (d) ;call usring the right call block
|
||
call [.status fdrc,a ;failed, return status word.
|
||
skipn a
|
||
seto a, ;but make sure don't return 0.
|
||
ret]
|
||
.close fdrc,
|
||
jrst gsoctj ;return number.
|
||
|
||
KCOPYN: CALL FDROPN ;:COPYN <FILE1>,<FILE2>. READ AND OPEN FILE 1.
|
||
CALL KCOPYR ;READ IN NEW FILE NAMES AND OPEN FILE.
|
||
kcopy0: call copfil ;copy from FDRC to UTOC
|
||
SFDAT1: .CLOSE FDRC,
|
||
JRST NLTL4
|
||
|
||
;;; copy from FDRC to UTOC
|
||
copfil: call vpaget ;obtain a buffer
|
||
copfl1: move a,[-2000,,vpagad]
|
||
.IOT FDRC,A ;READ IN UP TO 1 K.
|
||
HRLOI B,-1-VPAGAD(A)
|
||
EQVI B,VPAGAD ;AOBJN -> WHAT WAS READ.
|
||
.IOT UTOC,B
|
||
JUMPGE A,copfl1 ;FILLED UP THE BUFFER => TRY AGAIN.
|
||
CALL VPAGRT ;EOF, RETURN BUFFER.
|
||
SYSCAL RENMWO,[%CLIMM,,UTOC
|
||
NCTLTF+1 ? NCTLTF+2]
|
||
JFCL
|
||
.CLOSE UTOC,
|
||
ret
|
||
|
||
;COPY, PRESERVING DATES AND USING REAL NAMES OF FROM-FILE AS DEFAULTS.
|
||
NACR: CALL WARN
|
||
7TYPE [ASCIZ / (Copy File)/]
|
||
CALL GSOT
|
||
KCOPYD: CALL FDROPN ;READ FILENAME INTO PFILE, AND OPEN THE FILE.
|
||
SKIPE TOKTRM ;IF USER MUST BE PROMPTED (BY LINK2),
|
||
CALL WARN1 ;UNREAD AN ALTMODE TO SHOW USER THE NEW DEFAULTS.
|
||
CALL KCOPYS ;READ IN TO-FILE NAMES AND OPEN ON UTOC.
|
||
SYSCAL RFDATE,[%CLIMM,,FDRC ? %CLOUT,,A]
|
||
JRST KCOPY0
|
||
SYSCAL SFDATE,[%CLIMM,,UTOC ? A]
|
||
JRST KCOPY0
|
||
syscal RAUTH,[%climm,,fdrc ? %clout,,a]
|
||
jrst kcopy0
|
||
syscal SAUTH,[%climm,,utoc ? a]
|
||
jrst kcopy0
|
||
JRST KCOPY0
|
||
|
||
;READ IN FILE NAME AND OPEN FILE. USE AS DEFAULTS REAL NAME OF FILE OPEN ON FDRC.
|
||
KCOPYS: JSP A,LINKPF
|
||
SYSCLE RFNAME,[%CLIMM,,FDRC REPEAT 4,[ ? %CLOUT,,PFILE+.RPCNT ] ]
|
||
CAIA
|
||
;SIMILAR; USE AS DEFAULTS THE NAMES IN PFILE, BUT DON'T CHANGE PFILE.
|
||
KCOPYR: JSP A,LINKPF ;PUSH PFILE.
|
||
CALL LINK2 ;PROMPT IF NECESSARY FOR NAME OF TO- FILE.
|
||
7TYPE [ASCIZ /To: /]
|
||
CALL RRFL1 ;READ <FILE2> INTO PFILE
|
||
MOVE A,[PFILE,,NCTLTF]
|
||
BLT A,NCTLTF+3 ;AND MOVE IT TO NCTLTF
|
||
JSP D,LINKPP ;POP <FILE1> INTO PFILE.
|
||
move a,nctltf
|
||
movsi d,-lrlnmdv
|
||
kcpyr9: camn a,rlnmdv(d)
|
||
jrst kcpyr8
|
||
aobjn d,kcpyr9
|
||
SYSCLO OPEN,[[.BAO,,UTOC]
|
||
NCTLTF ? [SIXBIT /_COPY_/] ? ['OUTPUT] ? NCTLTF+3]
|
||
RET
|
||
|
||
kcpyr8: sysclo open,[[.bao,,utoc]
|
||
nctltf ? nctltf+1 ? nctltf+2 ? nctltf+3]
|
||
ret
|
||
|
||
;;; Table of devices that really need to know output filenames at opening time.
|
||
rlnmdv: irp x,,[LP7,LP8,LP9,LR7,7LP,7LR,TPL,CLO,CLU,CLI,CLA,JOB,OJB,USR]
|
||
sixbit /x/
|
||
termin
|
||
block 5 ; For patching
|
||
lrlnmdv==:.-rlnmdv
|
||
|
||
kmove: call fdropn ;read filename into PFILE, and open the file.
|
||
skipe toktrm ;if user must be prompted (by LINK2),
|
||
call warn1 ;unread an altmode to show user the new defaults.
|
||
call kcopys ;read in to-file names and open on UTOC.
|
||
syscal rfdate,[%climm,,fdrc ? %clout,,a]
|
||
jrst kmove0
|
||
syscal SFDATE,[%climm,,utoc ? A]
|
||
jrst kmove0
|
||
syscal RAUTH,[%climm,,fdrc ? %clout,,a]
|
||
jrst kmove0
|
||
syscal SAUTH,[%climm,,utoc ? a]
|
||
jfcl
|
||
kmove0: call copfil ;copy the file over
|
||
syscal delewo,[%climm,,fdrc] ;delete the from file
|
||
jfcl
|
||
.close fdrc, ;close it up too.
|
||
jrst nltl4 ;and back to the command loop
|
||
|
||
;; Read a date word in D Clobbers with unknown abondon (I.e. I haven't
|
||
;; checked, and you should before depending on anything)
|
||
|
||
rdatew: CALL LINK2 ;PROMPT FOR DATE IF NONE.
|
||
7TYPE [ASCIZ/Date: /]
|
||
CALL RLINE
|
||
JSP W2,RCH ;SKIP LEADING BLANKS.
|
||
CAIN D,40
|
||
JRST .-2
|
||
CAIN D,"- ;"-" AS DATE MEANS SAY "DATE UNKNOWN"
|
||
JRST [ SETO D, ;WHICH IS A DATE FIELD OF -1.
|
||
ret]
|
||
TLO F,FLUNRD ;1ST NONBLANK NOT "-" => REREAD IT LOOKING FOR DIGIT.
|
||
MOVE W1,[JSP W2,RCH]
|
||
PUSHJ P,RDATE ;READ IN DATE,
|
||
MOVE D,C
|
||
ret
|
||
|
||
;SET FILE'S DATE.
|
||
SFDATE: CALL FDROPN ;READ FILENAMES AND OPEN FILE.
|
||
call rdatew
|
||
SFDAT2: JSP W1,KSREA1 ;EXECUTE THE FOLLOWING SYSTEM CALL, AND GIVE ERR MSG IF FAILS.
|
||
SYSCAL SFDATE,[%CLIMM,,FDRC ? D]
|
||
|
||
SFDATB: SETZ ? SIXBIT /SFDATE/
|
||
%CLIMM,,FDRC ? SETZ C
|
||
|
||
;READ A DATE USING READ-CHAR INSTRICTION IN W1. DATE RETURNED IN C.
|
||
;CHAR THAT TERMINATED THE DATE IS LEFT IN D.
|
||
RDATE: SETZ D,
|
||
SAVE D
|
||
CALL MSGNUM ;CREATION MONTH.
|
||
CAIN D,^M
|
||
SKIPE C ;IF MONTH IS 0 AND WAS TERMINATED BY CR, ASSUME DATE NULL
|
||
CAIA ;AND USE TODAY'S DATE.
|
||
JRST [SYSCLE RQDATE,[%CLOUT,,C]
|
||
JRST POP1J]
|
||
DPB C,[270400,,(P)]
|
||
CALL MSGNUM ;CREATION DAY.
|
||
DPB C,[220500,,(P)]
|
||
CAIE D,^M ;IF USER ISN'T SPEC'ING THE YEAR,
|
||
JRST RDATE1
|
||
SYSCLE RQDATE,[%CLOUT,,C]
|
||
LDB C,[330700,,C] ;USE TODAY'S YEAR.
|
||
JRST RDATE2
|
||
|
||
RDATE1: CALL MSGNUM ;CREATION YEAR.
|
||
RDATE2: DPB C,[330700,,(P)]
|
||
CALL MSGNUM ;HOUR.
|
||
IMULI C,3600.
|
||
ADDM C,(P)
|
||
CALL MSGNUM ;MINUTE.
|
||
IMULI C,60.
|
||
ADDM C,(P)
|
||
CALL MSGNUM ;SECOND
|
||
ADD C,(P)
|
||
ADDI C,(C) ;DOUBLE THE R.H.
|
||
POP1J: SUB P,[1,,1]
|
||
RET
|
||
|
||
;READ IN A DECIMAL NUMBER, STOPPING AT A NON-DIGIT.
|
||
;USE THE INSTRUCTION IN W1 TO READ 1 CHARACTER.
|
||
MSGNUM: SETZ C,
|
||
CAIN D,^M ;DON'T GO ON PAST CR.
|
||
RET
|
||
MSGNU1: XCT W1
|
||
CAIL D,"0
|
||
CAILE D,"9 ;TERMINATE ON NON-DIGIT.
|
||
RET
|
||
IMULI C,10.
|
||
ADDI C,-"0(D)
|
||
JRST MSGNU1
|
||
|
||
;; Set MSGS date ... I.e. cutoff date for reading messages
|
||
ksmdate:
|
||
call rdatew ;read in a date word
|
||
camn d,[-1] ;Unknown?
|
||
setz d, ; yes, use 0
|
||
save d
|
||
call msgget ;get the database entry
|
||
rest msgs"me$mdt(a) ;set the entry now
|
||
jrst nltl4 ;and return
|
||
|
||
;; Print the MSGS date
|
||
kpmdate:
|
||
call msgget ;get the database entry
|
||
move a,msgs"me$mdt(a) ;get the time
|
||
jumpe a,kmpdt1 ; Null, tell him so
|
||
move d,[440700,,fdrctb] ;use the FDRC buffer, should be free now
|
||
call datime"twdasc ;send the info into the buffer
|
||
7type fdrctb ;and type the stuff
|
||
jrst nltl2 ;and return
|
||
|
||
kmpdt1: 7type [asciz /AAll messages will be printed./]
|
||
jrst nltl2
|
||
|
||
KREAP: CALL FDROPN ;READ IN FILE NAME
|
||
JSP W1,KSREA1 ;GO EXECUTE THE SRDATE AND GIVE ERR MSG IF FAILS.
|
||
SYSCAL SRDATE,[%CLIMM,,FDRC ? [1041,,]] ;set to 1/01/01.
|
||
|
||
KSFREA: JSP W1,KSFRE1
|
||
SYSCAL SREAPB,[%CLIMM,,FDRC ? A]
|
||
|
||
KSFDUM: JSP W1,KSFRE1
|
||
SYSCAL SDMPBT,[%CLIMM,,FDRC ? A]
|
||
|
||
;DRIVER FOR :SFREAP AND :SFDUMP. W1 -> A SYSTEM CALL WHICH TAKES BIT VALUE IN A.
|
||
KSFRE1: SAVE W1 ;SAVE ADDRESS OF SYSTEM CALL.
|
||
CALL FDROPN ;READ FILE NAMES AND OPEN FILE
|
||
CALL LINK2
|
||
7TYPE [ASCIZ /(1 or 0): /]
|
||
CALL RLINE
|
||
JSP W2,RCH ;READ IN THE DESIRED BIT SETTING
|
||
MOVEI A,-"0(D)
|
||
REST W1
|
||
JRST KSREA1 ;GO DO THE WORK.
|
||
|
||
KSFAUT: MOVEI C,PFILE
|
||
CALL RRFL1
|
||
TSCLO FDRCOL
|
||
CALL LINK2
|
||
7TYPE [ASCIZ /Author: /]
|
||
CALL RLINE
|
||
CALL RTOKEN
|
||
JSP W1,KSREA1
|
||
SYSCAL SAUTH,[%CLIMM,,FDRC ? B]
|
||
|
||
KSREA1: MOVEI C,PFILE
|
||
XCT (W1)
|
||
OPNER FDRCO
|
||
JRST SFDAT1
|
||
|
||
KFLAP: CALL RDEV ;READ DEVICE (AS "UTN" OR "N")
|
||
SUBI D,'UT0 ;CONVERT DEV NAME TO UT #.
|
||
.UDISMT D,
|
||
ERSTRT [SIXBIT/UNFLAPPABLE?/]
|
||
JRST NLTL2
|
||
|
||
KASSIG: CALL RDEV ;ASSIGN DECTAPE
|
||
SUBI D,'UT0
|
||
.ASSIGN D,
|
||
JRST ERR
|
||
JRST NLTL2
|
||
|
||
KDESIG: CALL RDEV ;DEASSIGN DECTAPE
|
||
SUBI D,'UT0
|
||
.DESIGN D,
|
||
JRST ERR
|
||
JRST NLTL2
|
||
|
||
KUINIT: CALL RDEV ;CLEAR DECTAPE DIRECTORY.
|
||
SUBI D,'UT0
|
||
.UINIT D,
|
||
JRST ERR
|
||
JRST NLTL2
|
||
|
||
RDEV: SKIPE TOKTRM ;COMMAND ENDED WITH CR => USE DEFAULT DEV.
|
||
JRST [HLRZ D,FFILE ? POPJ P,]
|
||
CALL GTFROB ;READ A FROB (DEV NAME)
|
||
SETZM UNRCHF ;FLUSH THE CHARACTER THAT TERMINATED IT.
|
||
MOVE D,B
|
||
MOVE C,A
|
||
CALL NBITE
|
||
CALL NGDEV ;CONVERT NUMERIC ARG TO DEV NAME.
|
||
MOVEM D,FFILE
|
||
CALL NCTLF4
|
||
HLRZS D
|
||
RET
|
||
|
||
NCTLF4: MOVEM D,PFILE ;IF ARG, SET ^O, $L DIRS.
|
||
MOVE C,LSNAM
|
||
MOVEM C,PFILE+3
|
||
MOVEM C,IFILE+3
|
||
MOVEM D,IFILE
|
||
RET
|
||
|
||
;INTERRUPT VECTOR.
|
||
TSINT: SETZ P ;INT STACK ADDR.
|
||
%PIILO ? 0 ? 0 ? 0 ? ILOPR
|
||
%PIMPV ? 0 ? 0 ? 0 ? MPVBRK
|
||
%PIWRO ? 0 ? 0 ? 0 ? PURBR1
|
||
%PIATY ? 0 ? %PIATY ? 0 ? TTYINT
|
||
%PIIOC\%PIOOB ? 0 ? #%PIATY#%pimpv#%piwro#%piilo ? -1 ? TSIN0
|
||
#%PICLI#%PIJST ? #<1_TYOC>
|
||
#%PIIOC#%PIILO#%PIMPV#%PIWRO#%PIOOB#%PIATY ? -1 ? TSIN0
|
||
0 ? 1_TYOC ? 0 ? 0 ? MORINT
|
||
%picli ? 1_dirhc ? #%piaty#%pimpv#%piwro#%piilo#%piioc ? -1 ? tsin0
|
||
%PIJST ? 0 ? 0 ? 0 ? JSTINT
|
||
TSINTL==.-TSINT
|
||
block 5 ;for patching
|
||
|
||
;W1 HAS POINTER TO RETURN ADDR. ON STACK.
|
||
MORINT: SKIPN MOREXP ;--MSGS-- AND OTHER SUCH THINGS SHOULDN'T CAUSE A --MORE--.
|
||
SKIPE HAKING ;NEVER DO **MORE** WHILE WITHIN HAKKAH.
|
||
JRST UDISMX
|
||
SAVE UUOH
|
||
SAVE 40
|
||
SAVE A
|
||
SAVE D
|
||
SAVE W1
|
||
SYSCAL WHYINT,[%CLIMM,,TYOC ? %CLOUT,,A ? %CLOUT,,D]
|
||
JRST PURXT1
|
||
CAIE A,%WYTYO
|
||
JRST PURXT1
|
||
JUMPGE D,PURXT1
|
||
SKIPGE TYOUNI
|
||
ERLOSS
|
||
SETOM RADCLR ;RAID REGS ABOUT TO BE OVERWRITTEN.
|
||
SAVE TYOUNI ;WE'RE IN THE MIDDLE OF OUTPUTTING TYOBUF,
|
||
SETOM TYOUNI ;SO OUTPUT WE DO SHOULDN'T GO THROUGH TYOBUF.
|
||
SAVE [MORXIT]
|
||
MOVEI W1,-10.(P)
|
||
7TYPE [ASCIZ/--More--/]
|
||
|
||
MORIN2: skipn morwarn ;If user needs protection, tell him what to do now
|
||
jrst morin0 ; No protection needed
|
||
movei d,[ASCIZ / (Space=yes, CR=no)/]
|
||
skipl mornro ;Are we in :MSGS ?
|
||
movei d,[asciz / (Space=yes, Rubout=no)/]
|
||
7type (d) ;aid him with the appropriate message.
|
||
|
||
MORIN0: SYSCAL FINISH,[ %CLIMM,,TYOC]
|
||
JFCL
|
||
SETOM MORFLG
|
||
SAVE LIMBO
|
||
CALL IN ;READ CHAR FROM TTY.
|
||
REST LIMBO
|
||
aos mornro
|
||
cain d,^S ;if was ^S, unsilence since ^S won't be read.
|
||
jrst [ setzm silnt
|
||
skiple mornro ;unless after a --MSGS--,
|
||
jrst morinf ;^S flushes.
|
||
jrst morin0] ;after a --MSGS--, ^S is ignored.
|
||
AOS MORNHU
|
||
CAIN D,40
|
||
JRST MORIGO
|
||
CAIN D,177 ;RUBOUT MAY OR MAY NOT FLUSH.
|
||
jrst [skipe mornro ;if flag wasn't set, flush.
|
||
JRST MORINF
|
||
JRST MORIGO]
|
||
cain d,^M ;is it a RETURN
|
||
skipg mornro ; that is a response to a --MSGS--
|
||
movem d,ttyunr ;no, re-read the thing later
|
||
morinf: skipe tyouni
|
||
call orest1 ;flush output buffer up to current typeout, no .RESET
|
||
SKIPE MORPRP ;IF RETURN-ON-FLUSH SET UP,
|
||
JRST [7TYPE MORFMS ;MESSAGE IS ALWAYS "FLUSHED",
|
||
MOVEI A,TYOFLS
|
||
MOVEM A,(W1)
|
||
RET]
|
||
SKIPG D,MORMSG ;IF NO SPECIAL MESSAGE WAS SPEC'D,
|
||
MOVEI D,MORFMS ;USE "FLUSHED".
|
||
7TYPE (D)
|
||
SETOM MORMSG ;TELL MAIN PRGM USER FLUSHED.
|
||
RET
|
||
|
||
MORFMS: ASCIZ/Flushed/
|
||
|
||
MORIGO: SKIPE GETTY
|
||
SKIPE SCROLL ;NEVER HOME UP IN SCROLL MODE.
|
||
SETZM MORNHU
|
||
setzm mormsg ;Tell main program user didn't flush
|
||
skipn mornhu
|
||
jrst crf
|
||
move d,ttyopt
|
||
tlne d,%toers ;is this a losing terminal
|
||
skipg mornro ; or are we in :MSGS
|
||
jrst formfa ; Yes, clear the screen
|
||
7type [asciz /TL/] ;otherwise merely home-up and CLEOL
|
||
ret
|
||
|
||
MORXIT: REST TYOUNI
|
||
PURXT1: REST W1
|
||
REST D
|
||
REST A
|
||
REST 40
|
||
REST UUOH
|
||
JRST UDISMX
|
||
|
||
;CALL HERE TO UNSET ON-FLUSHED-RETURN.
|
||
MORFL2: SETZM MORPRP
|
||
RET
|
||
|
||
MORFL1: SETOM MORNHU
|
||
MORFL4: CALL TYOFRC
|
||
AOS MOREXP
|
||
SAVE A
|
||
SAVE D
|
||
SAVE W1
|
||
MOVEI W1,-3(P)
|
||
CALL MORIN2
|
||
REST W1
|
||
REST D
|
||
REST A
|
||
SOS MOREXP
|
||
MORFL5: SKIPL MORMSG
|
||
AOS (P) ;MORFL1 SKIPS IF DIDN'T FLUSH.
|
||
SETZM MORMSG
|
||
RET
|
||
|
||
|
||
;; General catch-all interrupt handler
|
||
|
||
TSIN0: MOVEM 17,INTACS+17
|
||
MOVEI 17,INTACS
|
||
BLT 17,INTACS+16
|
||
SKIPGE -6(P)
|
||
ERLOSS INTJPC
|
||
PUSH P,UUOH
|
||
PUSH P,40
|
||
SETOM INTING ;NOW WE ARE PI-IN-PROG, CAN'T DO HAKKAH.
|
||
MOVEI W1,-5(P) ;PDL ADDR OF PC TO DISMISS TO.
|
||
SKIPE I1,-4(W1) ;IF ANY 1ST WD INTS,
|
||
CALL OTHERI ;HANDLE THEM.
|
||
SKIPN I1,-3(W1) ;IF NO 2ND WD INTS,
|
||
JRST TSIN25 ;DONE.
|
||
TRZE I1,1_TYOC
|
||
.VALUE
|
||
TRZE I1,1_<TYIC>
|
||
PUSHJ P,TSINTT
|
||
TRZE I1,1_<COMC>
|
||
PUSHJ P,TSINTC
|
||
TRZE I1,1_USRI
|
||
CALL TSINF ;FOREIGN JOB VANISHED UNDER OUR EXAMINATION.
|
||
trze i1,1_dirhc ;a write on our HSNAME directory?
|
||
call dirint ; request HAKKAH to take a look
|
||
JUMPE I1,TSIN25
|
||
SETZB U,INTIOP ;USR CHNLS NOT PUSHED YET THIS INT.
|
||
TSIN2: TDZE I1,INTBIT(U)
|
||
JRST TSIN3
|
||
TSIN22: ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JUMPN I1,TSIN2
|
||
SKIPN INTIOP ;IF USR CHNLS WERE PUSHED, POP THEM.
|
||
JRST TSIN23
|
||
.IOPOP USRO,
|
||
.IOPOP USRI,
|
||
TSIN23: AND I1,[7777,,] ;INTERRUPTS FROM FORGOTTEN JOBS =>
|
||
IORM I1,JREMEM ;REMEMBER THEM ALL,
|
||
JUMPE I1,TSIN25 ;AND NOTIFY THE USER.
|
||
SETOM HAKRQ
|
||
SETOM HAKTYP
|
||
TSIN25: SETZM INTING ;ABOUT TO BE NO LONGER PI-IN-PROG.
|
||
MOVE U,CU ;;; HAKPRM ASSUMES THAT INTERRUPTS ON TYIC COME THRU HERE !!!
|
||
SKIPE UINT(U) ;IF CURRENT JOB IS WAITING TO RETURN TO DDT
|
||
SKIPL STOPWT ;AND DDT IS WAITING FOR IT,
|
||
JRST TSIN24
|
||
SETZM HAKOK ;DON'T CALL HAKKAH TILL IT HAS BEEN HANDLED,
|
||
MOVSI A,FLSTOP ;AND TELL DDT IT'S TIME TO WAKE UP.
|
||
IORM A,INTACS
|
||
TSIN24: REST 40
|
||
REST UUOH
|
||
MOVSI 17,INTACS
|
||
BLT 17,17
|
||
CLIBR1: SKIPE HAKOK ;IF MAIN PROG SAYS OK TO EXIT TO HAKKAH,
|
||
SKIPL HAKRQ ;AND IF SOMEBODY WANTS HAKKAH,
|
||
JRST UDISMX
|
||
SKIPE HAKING ;DON'T CALL HAKKAH RECURSIVELY.
|
||
JRST UDISMX
|
||
SETOM HAKING ;ELSE SAY ENTERING HAKKAH.
|
||
SUB P,[3,,3] ;FLUSH THE INTERRUPT DEBIUGGING INFO.
|
||
POP P,-4(P) ;PUT PC IN LOWEST OF WDS PUSHED BY INT,
|
||
SYSCLE DISMIS,[%CLIMM,,1(P) ? %CLIMM,,.+2] ;RESTORE DEFER WDS.
|
||
SUB P,[3,,3] ;FLUSH EXTRA WDS FROM STACK.
|
||
JRST HAKKAI ;PRETEND M.P. PUSHJ'D TO HAKKAH.
|
||
|
||
UDISMX: SYSCLE DISMIS,[P ? %CLBIT,,400000]
|
||
|
||
|
||
OTHERI: IORM I1,HAKINT ;SOME INTS JUST RQ ACTION AT HAKKAH LVL
|
||
TDNE I1,[%PIDBG+%PIRLT+%PIDWN+%PICLI]
|
||
SETOM HAKTYP
|
||
TDZE I1,[%PIDBG+%PIRLT+%PIDWN+%PICLI]
|
||
SETOM HAKRQ
|
||
TRZE I1,%PIIOC
|
||
CALL IOCBRK
|
||
CAIG I1,1
|
||
RET ;DISMISS UNLESS UNKNOWN INT.
|
||
|
||
dirint: push p,a ;need an AC
|
||
movsi a,(%pidir) ;request the action at HAKKAH lvl
|
||
iorm a,hakint
|
||
setom haktyp ;tell HAKKAH there's typing to be done
|
||
setom hakrq ;and that it should run
|
||
rest a
|
||
ret
|
||
|
||
BADINT: AOSN NALTXF ;RANDOM INT DUE TO LOSING INSN $X'D ISN'T A DDT BUG.
|
||
JRST ERR
|
||
ERLOSS (W1)
|
||
|
||
|
||
IOCBRK: AOSN LOADF ;IOC ERROR DURING LOADING => JUST SAY THE FILE IS BAD.
|
||
JRST FILENG
|
||
.suset [.rbchn,,i3] ;Get the bad channel
|
||
hrrz i2,(w1) ;Get the return address
|
||
caie i2,clioc0 ;Is this an ioc-error writing the SENDS file?
|
||
cain i2,clioc1 ;(only two places that do that)
|
||
jrst [aos (w1) ;Make the instruction point to the next loc
|
||
syscle STATUS,[i3 ? %clout,,i3] ;Get the channel status
|
||
ldb i3,[330500,,i3]
|
||
cain i3,11 ;Was it device full?
|
||
setom dskful ; yes, note the fact
|
||
ret] ; And return to caller
|
||
syscle rfname,[i3 ? repeat 4,[ ? %clout,,nctltf+.rpcnt ]]
|
||
CAIN I3,UTOC ;IOC ERROR ON FILE BEING WRITTEN => DELETE IT.
|
||
JRST IOCOUT
|
||
CAIE I3,TYIC ;IOC ERROR ON TTY CHANNEL => IF IT'S CHANNEL NOT OPEN,
|
||
CAIN I3,TYOC
|
||
CAIA
|
||
JRST IOCBK3
|
||
LSH I3,27
|
||
IOR I3,[.STATUS I4]
|
||
XCT I3
|
||
LDB I4,[330500,,I4]
|
||
CAIN I4,8
|
||
JRST IOCOPN ;JUST GO OPEN THE TTY AND RETRY.
|
||
JRST IOCBK3
|
||
|
||
;IOC ERROR WRITING AN OUTPUT FILE: DELETE IT AND THEN ERROR MESSAGE.
|
||
IOCOUT: SYSCAL DELEWO,[%CLIMM,,UTOC]
|
||
JFCL
|
||
IOCBK3: CAIA ;SKIP INTO THE OPNER. THE SYSCAL IS JUST AN ARG FOR THE OPNER.
|
||
SYSCLO OPEN,[I3 ? REPEAT 4,[ ? NCTLTF+.RPCNT ]]
|
||
|
||
;INTERRUPT FROM TRYING TO USE THE TTY WHEN DON'T HAVE IT.
|
||
TTYINT: INSIRP PUSH P,UUOH 40 A D W1 B C I4
|
||
CALL DDTUNM ;NOW CHECK FOR CHANGE IN UNAME DUE TO REOWNMENT.
|
||
REST I4
|
||
REST C
|
||
REST B
|
||
JRST PURXT1
|
||
|
||
;; This is available in case the luser types BACKNEXT-J to ITS.
|
||
|
||
; JSTINT looks at JSTOPT and prints out a wholine something like:
|
||
;
|
||
; 12:34:56 20 UNAME JNAME SNAME 500176 +DSKBI 5% 0:03:09.2 206K
|
||
; ^time ^status ^%runtime ^core size
|
||
; ^job # ^upc ^job runtime
|
||
; |
|
||
; + if syms, symbolic PC yuck yuck
|
||
|
||
; Normally, in order to type something out we queue it for HAKKAH MP
|
||
; level output, which obeys SENDRP and .DTTYs (keeps the inferior
|
||
; informed about the TTY and stuff.)
|
||
;
|
||
; Handling the %PIJST interrupt is a special case, because the user
|
||
; always wants the status display immediately, and does not want to
|
||
; perturb any TTY-owning inferior (with %PIATY interrupts, for example.)
|
||
;
|
||
; Here is some I/O code to just blast things at our console
|
||
; without any regard for whether we own it. This should not
|
||
; normally be used; it is intended for use by JSTINT.
|
||
|
||
;Type out ASCII.
|
||
DEFINE JS7TYP &STRING
|
||
MOVEI I1,<.LENGTH STRING>
|
||
MOVE I2,[440700,,[ASCII STRING]]
|
||
SYSCAL SIOT,[%CLIMM,,TYOC ? I2 ? I1]
|
||
ERLOSS
|
||
TERMIN
|
||
|
||
;Type out (and smash) the octal number in I1.
|
||
;too bad we don't right-justify this
|
||
JSOTYP: IDIVI I1,8 ;Figure first digit.
|
||
PUSH P,I2 ;Push remainder.
|
||
SKIPE I1 ;Done?
|
||
CALL JSOTYP ; No compute next one.
|
||
POP P,I1 ;Yes, take out in opposite order.
|
||
MOVEI I1,"0(I1) ;Make ASCII.
|
||
SYSCLE IOT,[%CLIMM,,TYOC ? I1] ;Type it.
|
||
RET
|
||
|
||
; Type a space, then type out A as word of sixbit. Bashes I1 and I2.
|
||
js6typ: movei i1,40
|
||
syscle iot,[%climm,,tyoc ? i1]
|
||
move i1,[440600,,a]
|
||
repeat 6,[ildb i2,i1
|
||
addi i2,40 ;make it ascii
|
||
syscle iot,[%climm,,tyoc ? i2]]
|
||
ret
|
||
|
||
; This code really should worry about using TYOC without first making sure
|
||
; someone at main program level isn't halfway through a ^P sequence.
|
||
|
||
JSTINT: INSIRP PUSH P,A b c d I1 I2 i3 i4
|
||
SKIPE NOTTY ;If the TTY was translated away
|
||
JRST JSTI99 ; ignore the command (do I like this?)
|
||
hrrz a,jstopt ;get option flag
|
||
cain a,-1 ;-1 means muzzle
|
||
jrst jsti99
|
||
js7typ "A" ;we always start on a fresh line
|
||
move i1,[440600,,a] ;and with the time
|
||
.rtime a,
|
||
repeat 2,[
|
||
repeat 2,[ildb i2,i1
|
||
addi i2,40 ;make it ascii
|
||
syscle iot,[%climm,,tyoc ? i2]]
|
||
movei i2,":
|
||
syscle iot,[%climm,,tyoc ? i2]]
|
||
repeat 2,[ildb i2,i1
|
||
addi i2,40 ;make it ascii
|
||
syscle iot,[%climm,,tyoc ? i2]]
|
||
movei i2,40
|
||
syscle iot,[%climm,,tyoc ? i2]
|
||
skipe ddtty ;Does some inferior have the TTY?
|
||
jrst [ hrrz a,jstopt
|
||
;; DDT might want to do something funny if waiting for
|
||
;; e.g., an MLDEV or ARC
|
||
jumpe a,jstjob
|
||
JS7TYP "This is an ITS status message.A"
|
||
JRST JSTI99 ]
|
||
jstjob: syscle ttyget,[movei tyoc
|
||
repeat 3,[ ? movem d]]
|
||
hrrz i1,d ;Get index of job controlling the TTY in D.
|
||
call jsotyp ;Print it.
|
||
move c,[-10,,[sixbit /uname/ ? movem a
|
||
sixbit /jname/ ? movem i3
|
||
sixbit /sname/ ? movem i4
|
||
sixbit /upc/ ? movem b]]
|
||
syscle usrvar,[movei i2,(d)%jsnum ? c]
|
||
call js6typ
|
||
move a,i3
|
||
call js6typ
|
||
move a,i4
|
||
call js6typ
|
||
movei i2,40
|
||
syscle iot,[%climm,,tyoc ? i2]
|
||
tlnn b,%pcusr ;user PC?
|
||
pushj p,[syscle usrvar,[movei i2,(d)%jsnum ? [sixbit /uuoh/]
|
||
movem b]
|
||
sos b
|
||
ret] ; nope, get get user's pc (sort of)
|
||
hrrz i1,b
|
||
jstppc: call jsotyp
|
||
js7typ "A"
|
||
JSTI99: INSIRP POP P,i4 i3 I2 I1 d c b A
|
||
JRST UDISMX ;Done
|
||
|
||
PURBR1: SKIPE TOUTXQ ;HANDLE WRITING IN READ-ONLY PAGE
|
||
ERLOSS
|
||
SAVE UUOH
|
||
SAVE 40
|
||
SAVE A
|
||
SAVE D
|
||
SAVE W1
|
||
SAVE B
|
||
SAVE C
|
||
SKIPGE XRWI ;ARE WE DOING A DEP OR RDEP?
|
||
SKIPN UNPURF ;AUTO-UNPURE WANTED?
|
||
JRST PURBR2 ;ONE OR OTHER WAS NO.
|
||
;LETS UNPURIFY, GET ADDR WERE DEPOSTING IN.
|
||
JUMPL A,PURBR3 ;WERE DEPOSITING IN ..DDT+MUMBLE.
|
||
PUSHJ P,UNPUR1 ;TRY TO UNPURIFY. (MAY FAIL & SKIP)
|
||
JRST [ SKIPN TTYFLG
|
||
SKIPN DDTTY
|
||
JRST PURXIT
|
||
7TYPE [ASCIZ/ :UNPURE /]
|
||
MOVE D,-4(P)
|
||
CALL TOC
|
||
CALL LCT
|
||
JRST PURXIT]
|
||
PURBR2: .SUSET [.RMPVA,,A]
|
||
CAIL A,STBDE-NDSPGS*2000 ;WERE WE WRITING IN DDT SYM TAB?
|
||
CAIL A,STBDE
|
||
JRST PURBR3
|
||
CALL UNPUR1 ;YES, UNPURIFY.
|
||
JRST PURXIT
|
||
PURBR3: TERR 'PUR
|
||
|
||
PURXIT: POP P,C
|
||
POP P,B
|
||
JRST PURXT1 ;POP MORE STUFF, AND DISMISS INT.
|
||
|
||
;ILOPR INT CAN COME FROM LOAD SYSTEM CALL (CAN IT ANY MORE)?
|
||
;OR FROM $$J, AS WELL AS FROM EXAMINE/DEPOSIT ROUTINES.
|
||
ILOPR: AOSN LOADF
|
||
JRST FILENG
|
||
SAVE I2
|
||
HRRZ I2,-4(P)
|
||
CAIN I2,N2AJ2-1 ;ILOPR IN .USET OF JNAME (FOO$$J WHEN FOO EXISTS) =>
|
||
JRST N2AJ3 ;JUST GIVE AN ERROR MESSAGE.
|
||
CAIN I2,KCHUN1-1
|
||
JRST ERR
|
||
REST I2
|
||
|
||
;MPV OR ILOPR INT: IF EXPECTED, MAKE THE LOSING INSN SKIP. OTHERWISE, IT'S A BUG.
|
||
MPVBRK: AOSE XRWI ;MAYBE EXPECTED BY EXAMINE OR DEPOSIT ROUTINE.
|
||
JRST BADINT
|
||
AOS -3(P)
|
||
AOS -3(P)
|
||
JRST UDISMX
|
||
|
||
TSINTT: SKIPA I3,[TYIFC]
|
||
TSINTC: MOVEI I3,COMC
|
||
MOVEI I4,(I3)
|
||
.ITYIC I3,
|
||
POPJ P,
|
||
ANDCMI I3,%TXSFT ;THROW AWAY SHIFT & SHIFT LOCK.
|
||
CAIN I3,^Z ;UNQUOTED CALL, OR ^Z ON NON-TV, CAUSES ^Z-INT
|
||
SETOM CTLZFL ;TO BE GIVEN TO INFERIOR AT NEXT OPPORTUNITY.
|
||
TRNE I3,100 ;CONVERT CHARACTER TO UPPERCASE
|
||
TRZ I3,40 ;SO LOWERCASE CONTROL CHARS DON'T LOSE.
|
||
TRZE I3,%TXCTL ;CANONICALIZE THE CHARACTER.
|
||
TRZ I3,100
|
||
ANDI I3,177+%TXTOP ;PRESERVE %TXTOP SO THAT FUNNY GRAPHICS HAVE NO SPECIAL EFFECT.
|
||
CAIN I3,^S ;MUST CHECK FOR ^S BEFORE TYI3B DOES.
|
||
JRST SILNCE
|
||
CAIN I3,^D
|
||
SETOM CTLDFL ;^D SETS A FLAG TO STOP SEARCHES.
|
||
MOVE D,I3
|
||
CAIE I4,COMC ;IF FROM TTY,
|
||
PUSHJ P,TYI3B ;CHECK FOR ^V, ^W, ^B, ^E.
|
||
JFCL
|
||
CAIE I3,^G
|
||
RET
|
||
CALL ORESET
|
||
TSINF1: MOVEI I3,TQUIT
|
||
SKIPN TQUITR ;IF WE AREN'T IN NON-QUITTING CODE,
|
||
JRST [MOVEM I3,(W1)
|
||
RET] ;QUIT WHEN DISMISS INTERRUPT.
|
||
AOSE TQUITW ;ELSE IF NOT THE 1ST ^G, DON'T GIVE MORE TIME.
|
||
RET
|
||
.SUSET [.SRTMR,,[200000]]
|
||
.SUSET [.SIMASK,,[%pirun]]
|
||
POPJ P, ;CAUSE "DDT BUG" MSG IF RUN 256 MSEC
|
||
;WITHOUT QUITTING.
|
||
|
||
TQUITX: SOSN TQUITR ;EXIT FROM NON-QUITTING CODE.
|
||
SKIPGE TQUITW ;WANTED TO QUIT?
|
||
RET ;(STILL NON-QUITTING OR DON'T WANT TO QUIT)
|
||
TQUIT: SETOM TQUITW ;NO LONGER TRYING TO QUIT.
|
||
PUSHJ P,TQUIT0 ;MUST RESET COMPLETELY.
|
||
ERSTRT [SIXBIT/QUIT?/]
|
||
|
||
TQUIT0: PUSHJ P,INFLS1 ;RESET LOCAL IOPDL
|
||
.IOPDL ;AND SYSTEM'S.
|
||
SETZM INIOPS
|
||
.CLOSE COMC,
|
||
TQUIT1: MOVEI D,DD2 ;RETURN TO ABSOLUTE TOP LEVEL
|
||
MOVEM D,ERRSTL ;RATHER THAN THE ERROR-RETURN.
|
||
REST D ;AND FLUSH THE PDL TO AVOID PDL OV PROBLEMS
|
||
MOVE P,[-LPDL,,PS] ;(EG SUPPOSE WE QUIT OUT OF TYPING THE ERROR
|
||
JRST (D) ;MESSAGE WHICH WILL FOLLOW THIS)
|
||
|
||
SILNCE: SETOM SILNT ;THROW AWAY TYPEOUT, AND TURN OFF TILL INPUT READ.
|
||
|
||
ORESET: .RESET TYOC, ;THROW AWAY AS MUCH TYPEOUT AS POSSIBLE.
|
||
orest1: SAVE A ;W1 SHOULD POINT A WORD HOLDING PC WE WILL RETURN TO.
|
||
HLRZ A,@(W1) ;IF HUNG AT TYOC IOT,
|
||
CAIN A,(.IOT TYOC,)
|
||
AOS (W1) ;DON'T RETURN TO OUTPUT IOT
|
||
HRRZ A,(W1)
|
||
CAIE A,TYOFR2
|
||
CAIN A,TYOFR3
|
||
AOS (W1)
|
||
JRST TYOFR1 ;THROW AWAY WHAT'S IN TYOBUF.
|
||
|
||
TSINF: .RESET TYOC,
|
||
7TYPE [ASCIZ/
|
||
Foreign Job Being Examined Vanished, /]
|
||
SETOM FRNDEL ;TELL %RESET TO DO A :KILL
|
||
JRST TSINF1 ;GO QUIT (AND THUS CALL %RESET)
|
||
|
||
KNEWTTY: SAVE [NLTL2] ;COMMAND TO REOPEN THE TTY.
|
||
IOCOPN: TSOPEN TYOC,[[21,,'TTY]]
|
||
TSOPEN TYIC,[['TTY ? 0]]
|
||
TSOPEN TYIFC,[[%TIFUL,,'TTY]]
|
||
.CALL TTYGYP
|
||
JRST IOCOP2 ;OPENING TTY: DIDN'T GET A TTY, MAYBE?
|
||
MOVEM I4,TTYTYP
|
||
.SUSET [.RTTY,,TTYNUM] ;GET NUMBER OF CONSOLE.
|
||
HRRZS TTYNUM
|
||
syscle cnsget,[%climm,,tyoc
|
||
%clout,,ttymxv
|
||
%clout,,ttymxh
|
||
%clout,,tctyp
|
||
%clout,,i4
|
||
%clout,,ttyopt]
|
||
move i4,[-6,,[ sixbit /OSPEED/ ? movem ospeed
|
||
sixbit /ISPEED/ ? movem ispeed
|
||
sixbit /SMARTS/ ? movem smarts]]
|
||
syscle ttyvar,[%climm,,tyoc ? i4] ;find out the speed of this TTY
|
||
setzm getty ;getty is nonzero iff tty is a display.
|
||
move i4,ttyopt
|
||
setzm erase
|
||
tlnn i4,%toers ;if the TTY is erasible
|
||
tlnn i4,%toovr ; or can't be overwritten,
|
||
setom erase ; ^PX and friends will win!
|
||
TLNE I4,%TOFCI ;CAN TTY DO FULL 12-BIT CHARACTER SET?
|
||
JRST [ AOS METAP ; META KEY WINS
|
||
AOS ECHOP ; DO ECHOING.
|
||
MOVEI I3,TYIFC
|
||
MOVEM I3,TYIC2
|
||
JRST .+1 ]
|
||
TLNE I4,%TOMVU
|
||
AOS GETTY
|
||
TLZ C,%TSSAI+%TSROL+%TSMOR
|
||
TLNE I4,%TOROL
|
||
TLO C,%TSROL ;GO INT O SCROLL MODE IF NEC.
|
||
SETZM SCROLL ;SETTING SCROLL IF SO.
|
||
TLNE I4,%TOROL
|
||
SETOM SCROLL
|
||
TLNE I4,%TOSA1
|
||
TLO C,%TSSAI ;ENTER SAIL MODE IF NEC.
|
||
TLNN I4,%TOMOR
|
||
TLO C,%TSMOR
|
||
SETOM NOERASE
|
||
TLNE I4,%TOMVU
|
||
TLNE I4,%TOERS
|
||
SETZM NOERASE ;NOERASE IS SET IF TTY IS A STORAGE TUBE.
|
||
MOVEM C,TTYSTS
|
||
SKIPE ECHOP ;Turn off echoing by ITS.
|
||
JRST [ MOVE C,[171717,,171717]
|
||
ANDM C,TTYST1
|
||
ANDM C,TTYST2
|
||
JRST .+1 ]
|
||
TSCALL TTYSB1
|
||
MOVE C,GETTY
|
||
MOVEM C,PCPNTF
|
||
MOVEM C,RAIDFL
|
||
JRST DDTUNM ;MAYBE WE WERE REOWNED AFTER :DETACH & NEW UNAME.
|
||
|
||
TTYSB1: SETZ ? 'TTYSET
|
||
%CLIMM,,TYOC
|
||
TTYST1
|
||
TTYST2
|
||
SETZ TTYSTS
|
||
|
||
TTYGYP: SETZ
|
||
SIXBIT /TTYGET/
|
||
[TYOC]
|
||
REPEAT 2,%CLOUT,,I4
|
||
%CLOUT,,C
|
||
402000,,I4
|
||
|
||
IOCOP2: .STATUS TYOC,C
|
||
LDB C,[OPNLBP,,C]
|
||
CAIE C,%EBDDV ;IS IT "WRONG TYPE DEVICE"?
|
||
ERLOSS
|
||
SETZM TTYTYP
|
||
SETZM TTYNUM
|
||
SETZM TCTYP
|
||
SETZB C,GETTY
|
||
SETZM TTYOPT
|
||
SETOM NOTTY
|
||
SETZM RAIDFL
|
||
SETZM PCPNTF
|
||
JRST DDTUNM
|
||
|
||
ALARMM: ASCIZ /AAlarm /
|
||
|
||
ALARM: tlo f,flq\flunrd ;flq => relative time, flunrd => re-read d.
|
||
jsp w2,rch
|
||
cain d,"
|
||
jrst .-2 ;ignore leading spaces
|
||
cain d,^M
|
||
JRST ALARMC ;:ALARM<CR> => CLEAR ALARM.
|
||
caie d,". ;:ALARM .+<TIME> => relative time.
|
||
tlz f,flq ;:ALARM <TIME> => absolute time.
|
||
MOVE W1,[JSP W2,RCH] ;MSGNUM does XCT W1 to read a char.
|
||
SETZ A, ;ACCUMULATE TIME OF ALARM IN A.
|
||
hrroi i1,-3 ; HH:MM:SS
|
||
ALARM1: SAVE A
|
||
movei w2,.+1 ;top of loop
|
||
cail d,"0 ;ignore non-digits except CR
|
||
caile d,"9
|
||
cain d,^M
|
||
skipa
|
||
jrst rch ;read char, return to top of loop
|
||
tlo f,flunrd ;re-read first digit
|
||
PUSHJ P,MSGNUM ;READ 1 DECIMAL NUM (BUT DON'T READ PAST CR).
|
||
REST A
|
||
IMULI A,60.
|
||
ADDI A,(C) ;PUT THIS BASE-60 DIGIT IN TIME.
|
||
aojl i1,alarm1
|
||
tlze f,flq
|
||
jrst alarm3 ; relative time, ready to use in A.
|
||
|
||
idivi a,24.*60.*60. ;absolute time, mod 24 hours
|
||
move a,b
|
||
.RTIME B, ; minus present time.
|
||
MOVE W1,[-6,,[0 ? 10. ? 6 ? 10. ? 6 ? 10.]]
|
||
MOVE I1,[440600,,B] ;BP IN CURRENT TIME (SIXBIT)
|
||
ALARM2: ILDB D,I1 ;NEXT DIGIT OF CURRENT TIME.
|
||
IMUL C,(W1) ;EACH DIGIT HAS ITS OWN RADIX.
|
||
ADDI C,-'0(D)
|
||
AOBJN W1,ALARM2
|
||
SUB A,C ;# SECONDS FROM NOW ALARM SHOULD RING.
|
||
SKIPG A
|
||
ADDI A,24.*60.*60.
|
||
|
||
alarm3: PUSH P,A
|
||
IMULI A,60.
|
||
.RDTIM B, ;COMPUTE TIMME IN 60'THS BETWWEEN TIME OF ALARM
|
||
LSH B,1 ;AND TIME SYSTEM WAS STARTED.
|
||
ADD A,B
|
||
EXCH A,ALARMV
|
||
CALL ALARM4 ;RQ A REALTIME INT THEN.
|
||
7TYPE ALARMM
|
||
SKIPE A
|
||
7type [asciz /re/]
|
||
7TYPE [ASCIZ /set for .+/]
|
||
POP P,D
|
||
pushj p,tmpa
|
||
JRST NLTL2
|
||
|
||
ALARMC: SETZM ALARMV
|
||
CALL ALARM4
|
||
7TYPE ALARMM
|
||
7TYPE [ASCIZ /Cleared/]
|
||
JRST NLTL2
|
||
|
||
;THERE ARE 2 POSSIBLE RQS FOR REALTIME INTS: ALARMV AND ALARMW.
|
||
;ASK ITS FOR A REALTIME INT AT WHICHEVER IS SOONER.
|
||
ALARM4: MOVE C,ALARMV
|
||
SKIPG ALARMW ;IF ALARMW IS 0, USE ALARMV
|
||
JRST ALARM5
|
||
JUMPLE C,.+2 ;ELSE IF ALARMV IS 0,
|
||
CAML C,ALARMW ;OR LATER THAN ALARMW,
|
||
MOVE C,ALARMW ;USE ALARMW
|
||
ALARM5: JUMPLE C,ALARM6 ;NO RQ => CLEAR REALTIME INTS.
|
||
.RDTIM B, ;ELSE COMPUTE TIME TO INT IN 60'THS,
|
||
LSH B,1
|
||
SUB C,B
|
||
CAIGE C,1 ;(IF INT SHOULD HAVE HAPPENED ALREADY,
|
||
MOVEI C,1 ;MAKE IT HAPPEN VERY SOON)
|
||
SKIPA B,[TRN C] ; same as skipa b,[%rlfls\%rlset,,c]
|
||
ALARM6: MOVSI B,400000
|
||
.REALT B,
|
||
RET
|
||
|
||
tmpa: setz c,
|
||
camge d,tmt1(c)
|
||
aos c
|
||
jrst tmp3
|
||
TMPT: MOVEI C,0
|
||
JUMPE D,CPOPJ
|
||
CAMGE D,TMT1(C)
|
||
AOJA C,.-1
|
||
TMP3: IDIV D,TMT1(C)
|
||
CTYPE "0(D)
|
||
MOVE D,W1
|
||
TRNN C,1
|
||
AOJA C,TMP3
|
||
CAIL C,5
|
||
POPJ P,
|
||
CTYPE ":
|
||
AOJA C,TMP3
|
||
|
||
TMT1: 36000.
|
||
3600.
|
||
600.
|
||
60.
|
||
10.
|
||
1
|
||
|
||
|
||
COMPLN: PUSHJ P,ERTTY
|
||
MOVEI D,8
|
||
MOVEM D,ODF ;SET CURRENT RADIX TO OCTAL
|
||
CMPLN2: PUSHJ P,TSPC
|
||
XCT @(P)
|
||
PUSHJ P,TOC
|
||
AOS (P)
|
||
MOVEI D,",
|
||
PUSHJ P,TOUT ;DON'T CHANGE TO A UUO, WILL CLOBBER 40, UUOH, ETC.
|
||
JRST CMPLN2
|
||
|
||
ERTTY: SETZM TTYSTL ;TTY NOW LEGITIMATELY DDT'S; SHOULDN'T TRY GIVING TTY BACK.
|
||
SYSCLE USRVAR,[MOVEI %JSELF ? [SIXBIT /TTY/] ? MOVEI ? [TLO %TBINF]]
|
||
.DTTY USRI,
|
||
JFCL
|
||
SETZM TOUTXQ ;TOUT SHOULD DO NORMAL TTY OUTPUT
|
||
SETOM DDTTY ;NOW DDT HAS TTY.
|
||
SKIPE TYOUNI ;IF WE ERRED OUT OF **MORE** PROC, FLUSH THE TTY OUT BFR.
|
||
CALL [ SAVE A ? JRST TYOFR1]
|
||
ERTTY1: SETZM MORPRP ;ELIMINATE ON-FLUSHED-RETURN.
|
||
SETZM SILNT
|
||
MOVE A,TTYFLG
|
||
SETZM TTYFLG ;TURN ON TTY OUTPUT.
|
||
JUMPE A,CPOPJ
|
||
PUSH P,D
|
||
MOVEI D,^V ;IF HAD BEEN OFF, TYPE "^V ".
|
||
PUSHJ P,TOUT
|
||
PUSHJ P,TSPC
|
||
JRST POPDJ
|
||
|
||
TSIN3: SKIPE INTIOP ;IF WE'VE PUSHED USR CHNLS, MUST RE-OPEN.
|
||
JRST TSIN3B
|
||
SKIPL HAKIOP ;IF HAKKAH PUSHED USR CHNLS
|
||
SKIPL UCHNLO ;OR IF THEY AREN'T OPEN YET, CAN'T USE THEM.
|
||
JRST TSIN3D
|
||
CAMN U,CU ;UNLESS INT FROM CURRENT USER,
|
||
JRST TSIN3C
|
||
TSIN3D: .IOPUSH USRI, ;MUST PUSH AND RE-OPEN.
|
||
.IOPUSH USRO,
|
||
SETOM INTIOP
|
||
TSIN3B: move a,urandm(u) ;check if we're supposedly foreign
|
||
trne a,%urfrn ;foreign?
|
||
erloss (u) ; Yes, we must have blown it somewhere
|
||
MOVE A,[.BII,,USRI]
|
||
.CALL OPNUSR
|
||
JRST TSIN22
|
||
MOVE A,[.BIO,,USRO]
|
||
.CALL OPNUSR
|
||
JRST TSIN22
|
||
TSIN3C: MOVE A,[-5,,[.RPIRQ,,I3
|
||
.RMASK,,W3
|
||
.RPICL,,W2
|
||
.RDF1,,I2
|
||
.ROPTI,,B]]
|
||
.USET USRI,A
|
||
ORCM I2,W2 ;DEFERRED INTS.
|
||
MOVE A,I2
|
||
ORCM A,W3 ;DEFERRED OR DISABLED INTS.
|
||
AND A,I3 ;DEFERRED OR DISABLED PENDING INTS.
|
||
AND A,BADBTS ;CLASS 1 OR 2 INTS.
|
||
MOVEM A,UPI0(U) ;COMMON FATAL INTS DETECTED ALREADY.
|
||
ANDCM I3,I2 ;PENDING UNDEFERRED INTS.
|
||
AND I3,W3 ;PENDING ENABLED UNDEFERRED INTS.
|
||
SETZM UPI1(U)
|
||
TRNN A,%PIB42 ;DON'T GROVEL OER HIS INT TABLE IF IT'S INVALID.
|
||
TLNN B,OPTINT ;IF JOB USES NEW INTS, MUST CHECK
|
||
JRST JBIOLD ;ENABLED UNDEFERRED INTS FOR THOSE
|
||
;NOT HANDLED BY THE INFERIOR.
|
||
MOVE B,[-4,,[ .R40AD,,A
|
||
.RIFPI,,I2
|
||
.RMSK2,,D
|
||
.RDF2,,C]]
|
||
.USET USRI,B
|
||
ORCM C,W2 ;DEFERRED 2ND WD INTS.
|
||
AND I2,D ;ENABLED PENDING 2ND WD INTS.
|
||
ANDCM I2,C ;ENABLED UNDEFERRED PENDING " .
|
||
SKIPN I2 ;IF NO ENABLED UNDEFERRED PENDING INTS
|
||
JUMPE I3,JBIOLD ;IN EITHER WD, NO NEED TO GO ON.
|
||
ADDI A,2 ;GET ADDR OF USER'S "42".
|
||
CALL RFETCH
|
||
JRST JBIOLD ;USER HAS A BADPI, GIVE UP.
|
||
MOVEI C,1(D) ;ADDR OF 1ST 5-WD ENTRY IN INT. TAB.
|
||
.ACCES USRI,C
|
||
AOBJN D,.+1 ;SKIP PAST THE INT PDL PTR ADDR.
|
||
SAVE XRWI
|
||
SETOM XRWI
|
||
JBINLP: MOVE C,[-5,,JBIBUF]
|
||
.IOT USRI,C ;READ ANOTHER INT. TAB. ENTRY.
|
||
CAIA
|
||
JRST JBINL1
|
||
ANDCM I3,JBIBUF ;THE INTS THIS ENTRY HANDLES SHOULDN'T
|
||
ANDCM I2,JBIBUF+1 ;BE HANDLED BY DDT, SO FORGET THEM.
|
||
ADD D,[4,,4]
|
||
AOBJN D,JBINLP ;HANDLE ALL INT TAB ENTRIES.
|
||
IORM I3,UPI0(U) ;INTS NOT HANDLED BY USER ARE FOR DDT.
|
||
MOVEM I2,UPI1(U)
|
||
JBINL1: REST XRWI
|
||
JBIOLD: MOVE I3,UPI0(U)
|
||
MOVE I2,UPI1(U)
|
||
MOVE A,[-4,,[ .SAPIR,,I3 ;CLEAR RQS FOR INTS DDT HANDLES.
|
||
.SAIFP,,I2
|
||
.RUPC,,I2
|
||
.RSV40,,I40]]
|
||
.USET USRI,A
|
||
MOVEM I2,IPC
|
||
MOVEM I2,PPC(U)
|
||
SKIPN UPI1(U) ;JUST ABOUT ALL FATAL INTS CAUSE STOP.
|
||
TDNE I3,[#%PIBRK#%PIVAL#%PI1PR#%PIMAR#%PITRP]
|
||
JRST JBISTP
|
||
TLNE I3,%PJTRP ;SYSUUO INTERRUPT => REPORT STOPPED BY SYSUUO.
|
||
JRST [ MOVNI I3,5
|
||
JRST JBIBTS]
|
||
TRNE I3,%PIBRK
|
||
JRST JBIBRK ;.BREAK => HANDLE IT.
|
||
TRNE I3,%PIVAL
|
||
JRST JBIVAL
|
||
TLNE I3,%PJDCL ;DEFERRED CALL MEANS STOP JOB BUT DON'T FLUSH INPUT.
|
||
JRST JBISNR
|
||
TRNN I3,%PIMAR
|
||
JRST 1PROC
|
||
SKIPN D,MARCON(U)
|
||
JRST JBISTP ;STOP ON UNCONDITIONAL MAR.
|
||
SETOM UINT(U)
|
||
JRST JBIBPC ;CONDITIONALIZED MAR: CHECK THE CONDITION.
|
||
|
||
JBIVAL: MOVE I3,I40
|
||
TRNN I3,-1 ;IF .VALUE 0, GENERATE "VALU0" INTERRUPT.
|
||
JRST [MOVE I3,[SETZ %PIVAL] ? XORM I3,UPI0(U) ? JRST JBISTP]
|
||
CAMN U,CU ;ELSE IF NOT FROM CURRENT JOB
|
||
SKIPE DDTTY ;OR DDT HAS TTY,
|
||
JRST JBISTP ;VALUE INTERRUPT WILL SOS PC, RETRY .VALUE.
|
||
CALL TSTPRM ;DOES ..PERMIT ALLOW JOB TO DO VALRETS?
|
||
JRST JBIPRM ;SIMILAR IF JOB CAN'T DO VALRETS.
|
||
HRRZM I3,VALCOM
|
||
JBISNR: SETOM RSTDEL ;CAN DO .VALUE NOW, DON'T .RESET TYIC,.
|
||
JBISTP: SETOM I3
|
||
JBIBTS: MOVEM I3,UINT(U)
|
||
JBIBPS: SKIPE STOPWT ;JOB STOPPED WHILE DDT WASN'T WAITING FOR IT =>
|
||
CAME U,CU
|
||
JRST JBINCR ;TELL HAKKAH TO INFORM USER.
|
||
SAVE TTYSTL ;$P'D JOB WANTS TO RETURN => TAKE BACK TTY IMMEDIATELY
|
||
CALL TTYRET ;SO THAT HE CAN ^G DDT IF IT IS HUNG UP IN HAKKAH.
|
||
REST TTYSTL ;TTY NO LONGER BELONGS TO THE INFERIOR, BUT
|
||
HRRZS TTYSTL ;DON'T FORGET TO RESTORE OCO.
|
||
JRST TSIN22 ;LOOP BACK OVER OTHER INFERIORS IN CASE THEY INTERRUPTED.
|
||
|
||
JBINCR: SETOM HAKTYP
|
||
SETOM HAKRQ
|
||
JRST TSIN22
|
||
|
||
;WHEN JOB WANTS TO SUICIDE OR WRITE IN DDT, TSTPRM SKIPS IF IT IS ALLOWED TO.
|
||
TSTPRM: SKIPLE PERMIT(U)
|
||
SOSA PERMIT(U)
|
||
SKIPE PERMIT(U)
|
||
AOS (P)
|
||
RET
|
||
|
||
JBIPRM: MOVNI I3,4 ;COME HERE TO STOP JOB IF TSTPRM FAILS TO SKIP.
|
||
JRST JBIBTS ;WE ASSUME %PIBRK OR %PIVAL IS ON IN UPI0, SO UBRK3 WILL SOS PC.
|
||
|
||
;COME HERE WHEN TEMP. BPT. HIT.
|
||
JBIBT: MOVEI A,%PIBRK ;CLEAR OUT THE .BREAK BIT SO THAT UBRK3
|
||
ANDCAM A,UPI0(U) ;WON'T RE-SOS PPC AFTER UBRKT DOES.
|
||
HLRZ A,BTADR(U)
|
||
CAIGE A,20 ;ARE THE TEMP BPTS WATCHING A PDL?
|
||
PUSHJ P,RFETCH ;YES, SEE WHERE POINTS NOW.
|
||
JRST JBIBTS ;NO, INT. DDT, PUT 15 OR 17 IN UINT.
|
||
MOVEI D,(D) ;COMPARE RH ONLY
|
||
CAMG D,BTPDL(U)
|
||
JRST JBIBTS ;PDL BACK TO SAME DEPTH AS WHEN BPTS SET.
|
||
MOVE W3,BTINS(U)
|
||
CAIN I3,17 ;NOT SAME DEPTH, PROCEED THRU BPT.
|
||
MOVE W3,BTINS+1(U)
|
||
JRST JBIBT1
|
||
|
||
1PROC: TRC I3,%PI1PR ;STOP JOB UNLESS 1-PROC INT, NO OTHERS.
|
||
JUMPN I3,JBISTP
|
||
SKIPN INCNT(U)
|
||
JRST 1PROC4 ;IF DIDN'T ^N.
|
||
MOVNI I3,2 ;IF WE STOP IT WILL BE WITH CODE "STEPPING-RETRN"
|
||
MOVEM I3,UINT(U)
|
||
SKIPN B,OIPCHK(U)
|
||
JRST 1PROC1
|
||
CAIE C,(B) ;$$^N -- CHECK PC.
|
||
CAIN C,1(B)
|
||
JRST 1PROC3
|
||
JRST 1PROC2
|
||
|
||
1PROC1: MOVE D,USTYPE(U)
|
||
TRNN D,USTYPY ;IN "CARE" MODE?
|
||
JRST 1PROC3
|
||
MOVEI A,41
|
||
CALL RFETCH ;YES, GET ADDR OF UUO HANDLER.
|
||
JRST 1PROC3
|
||
MOVEI A,(D)
|
||
CAIE A,-1(C) ;HAVE WE JUST ENTERED UUO HANDLER?
|
||
JRST 1PROC3
|
||
CALL RFETCH ;YES, SET OIPBIT OF SAVED PC (ASSUME JSR IN 41)
|
||
JRST 1PROC3
|
||
IOR D,OIPBIT
|
||
CALL RDEP
|
||
JRST 1PROC3
|
||
JRST GO ;PROCEED, RETURN WHEN USER'S UUOH JRSTF'S
|
||
|
||
1PROC3: SOSN INCNT(U) ;HAS ^N COUNT RUN OUT?
|
||
JRST [ HRRZ C,PPC(U) ;YES. ARE WE INSIDE A BREAKPOINT-PROCEED?
|
||
CALL GXBLKD
|
||
CAIE C,BPBLK+1(D) ;YES => GO 1 MORE INSN TO FINISH UP.
|
||
CAIN C,BPBLK+2(D)
|
||
JRST [AOS INCNT(U) ? JRST 1PROC2]
|
||
SETOM RSTDEL ;NO => STOP NOW.
|
||
JRST JBIBTS]
|
||
1PROC2: MOVE D,OIPBIT ;ELSE 1-PROC 1 MORE INSN.
|
||
IORM D,IPC
|
||
JRST GO
|
||
|
||
1PROC4: SKIPE I3,MARADR(U) ;IF THERE'S A MAR ON INSN FETCH, TURN IT
|
||
.USET USRI,[.SMARA,,I3] ; BACK ON (IN CASE WE ARE
|
||
; PROCEEDING FROM IT)
|
||
.USET USRI,[.ROPTIO,,I3]
|
||
TLO I3,OPTTRP ;IF WE ARE STOPPING BEFORE SYSTEM CALLS,
|
||
SKIPN SYSUUO(U) ;TURN IT BACK ON (").
|
||
.USET USRI,[.SOPTIO,,I3]
|
||
JRST GO
|
||
|
||
JBIBRK: MOVE I3,I40 ;HERE IF INFERIOR GOT A .BREAK INTERRUPT.
|
||
TLZ I3,(0 17,) ;THAT CAN BE DUE TO A .BREAK, OR TO A .LOGOUT <NONZERO>,
|
||
MOVE A,[.BREAK 16,160000]
|
||
CAMN I3,[.LOGOUT] ;WHICH SHOULD BE TREATED AS A .BREAK 16,160000 (SUICIDE).
|
||
MOVEM A,I40
|
||
LDB I3,[270400,,I40] ;DECODE THE .BREAK BY AC FIELD.
|
||
SETZM NBPTB(U)
|
||
JRST @JBIBTB(I3)
|
||
|
||
JBIBTB: JBISTP ;RANDOM INST., INTERRUPT DDT
|
||
REPEAT NBP,JBIBPT ;REGULAR BPT
|
||
REPEAT 11-NBP,JBISTP ;RANDOM
|
||
JBIB12
|
||
JBISTP
|
||
JBISTP
|
||
JBIBT ;TEMP. BPT. IN INSN+1
|
||
TSINXX ;$X RETURN, COND BPT RETURN, USER RQ.
|
||
JBIBT ;TEMP. BPT. IN INSN+2
|
||
|
||
;COME HERE TO HANDLE BREAKPOINTS.
|
||
JBIBPT: LDB A,[$URBPT,,URANDM(U)]
|
||
SETZ D,
|
||
DPB D,[$URBPT,,URANDM(U)]
|
||
MOVE D,I3
|
||
MOVEM I3,UINT(U)
|
||
IMULI I3,BPL
|
||
ADDI I3,-BPL(U)
|
||
CAIN A,(D)
|
||
JRST JBIBP1
|
||
SOSG B1CNT(I3)
|
||
JRST JBIBPS ;COUNT RAN OUT,BREAK TO DDT
|
||
SKIPE D,BPCON(I3)
|
||
JRST JBIBPC
|
||
JBIBP1: MOVE W3,B1INS(I3)
|
||
JBIBT1: HRR W3,I40
|
||
TLZ W3,37
|
||
JRST PROC ;PROCEED AND INTERPRET BPT INS
|
||
|
||
JBIBPC: HRRE I3,UINT(U)
|
||
MOVEM I3,CBPPS(U)
|
||
MOVE A,I40
|
||
HRLM A,CBPPS(U)
|
||
MOVEM D,26SAV
|
||
CALL GXBLKD
|
||
JFCL GXBLKL
|
||
ADDI D,CBPB
|
||
.ACCESS USRO,D
|
||
MOVEM D,PPC(U)
|
||
EXCH D,IPC
|
||
MOVEM D,BPCPC(U)
|
||
MOVE D,[-3,,26SAV]
|
||
.IOT USRO,D
|
||
JRST GO
|
||
|
||
;.BREAK 12, COMES HERE.
|
||
JBIB12: MOVE I3,I40
|
||
HRROM I3,UHACK(U) ;SAVE ITS EFFECTIVE ADDR. FOR HAKKAH.
|
||
SETOM HAKRQ
|
||
JRST TSIN22
|
||
|
||
;.BREAK 16, COMES HERE.
|
||
;2.9=$X RETURN, 2.8=EXTRA CR, 2.7=DON'T .RESET TYIC,
|
||
;2.6=:KILL, 2.5=DIE SILENTLY IF NOT CURRENT JOB.
|
||
;2.4 => COND. BPT RETURN. 2.3 => DON'T TYPE ANYTHING OR CLOSE OPEN LOC.
|
||
TSINXX: MOVE I3,I40
|
||
TRNE I3,10000
|
||
JRST TSBPC2 ;IF COND. BPT. RETURN, SPECIAL.
|
||
CALL TSTPRM ;ELSE IF THIS IS A SUICIDE, SEE IF JOB ALLOWED TO DO IT.
|
||
TRNN I3,60000
|
||
CAIA
|
||
JRST JBIPRM ;NO => JUST STOP.
|
||
SKIPGE UCHNLO
|
||
CAME U,CU ;IF FROM CURRENT JOB,
|
||
JRST TSINX1
|
||
SKIPE DDTTY ;IF DDT HAS TTY,
|
||
JRST TSINX2 ;LEAVE IT TILL $J OR $P.
|
||
TRNE I3,100000 ;ELSE CAN HANDLE NOW,
|
||
SETOM RSTDEL ;MAYBE SUPPRESS .RESET OF TYIC,.
|
||
TRZE I3,20000 ;IF WANTS TO DIE AT HAKKAH LEVEL,
|
||
TRO I3,40000 ;KILL IT IMMEDIATELY INSTEAD.
|
||
TSINX2: HRROM I3,UIACK(U)
|
||
MOVEI I3,16 ;INDICATE WAS .BREAK 16,.
|
||
MOVEM I3,UINT(U)
|
||
JRST JBIBPS
|
||
|
||
TSINX1: MOVE I3,I40 ;NOT CURRENT JOB.
|
||
TRNE I3,640000 ;CAN NOW HANDLE ONLY RETURNING,
|
||
JRST TSINX2 ;ELSE WAIT TILL THIS JOB BECOMES CURRENT.
|
||
TRNE I3,20000 ;KILL JOB IMMEDIATELY =>
|
||
JRST [SETOM HAKRQ ;TELL HAKKAH TO RUN,
|
||
MOVEM I3,UIACK(U) ;SAY JOB WANTS TO DIE,
|
||
JRST TSIN22] ;DON'T SET UINT.
|
||
SETOM UINT(U) ;JUST WANTS TO RETURN,
|
||
PUSHJ P,UBRKR ;REMOVE BPTS, ETC.
|
||
JRST TSIN22 ;DON'T REQUEST TO INTERRUPT DDT.
|
||
|
||
TSBPC2: TRNN I3,200000 ;COND BPT RETURN: DID IT SKIP?
|
||
JRST TSBPC1 ;J IF NOT.
|
||
MOVE D,BPCPC(U)
|
||
MOVEM D,IPC
|
||
MOVEM D,PPC(U)
|
||
HRRE I3,CBPPS(U)
|
||
SETOM NBPTB(U)
|
||
MOVEI D,%PIMAR ;IF THIS WAS A CONDITIONAL MAR,
|
||
SKIPGE I3
|
||
MOVEM D,UPI0(U) ;REMEMBER THAT THE MAR WAS HIT, AND DON'T BE CONFUSED BY .BREAK 16,.
|
||
JRST JBIBTS
|
||
|
||
TSBPC1: MOVE D,BPCPC(U)
|
||
MOVEM D,IPC
|
||
MOVEM D,PPC(U)
|
||
HRRE D,CBPPS(U)
|
||
JUMPL D,TSBPC4 ;J IF CONDITIONAL MAR.
|
||
IMULI D,BPL
|
||
ADDI D,-BPL(U)
|
||
MOVE W3,B1INS(D)
|
||
HLR W3,CBPPS(U)
|
||
TLZ W3,37
|
||
JRST PROC
|
||
|
||
TSBPC4: .USET USRI,[.RMARPC,,D]
|
||
CALL PCPNTM ;IF THE MAR DIDN'T ABORT THE INSN, TURN MAR BACK ON.
|
||
TLNE D,(@)
|
||
JRST GO
|
||
MOVE D,OIPBIT ;OTHERWISE, PROCEED 1 INSN AND THEN TURN ON MAR.
|
||
JRST TSBPC3
|
||
|
||
;COME HERE IF HIT BPT BUT SHOULDN'T STOP (COUNT NOT OUT, ETC)
|
||
;HAVE INSN TO SIMULATE IN W3, WITH ADDRESS CALC. ALREADY DONE.
|
||
PROC: MOVEI B,100
|
||
MOVE D,IPC ;SET UP THE TWO JRSTS IN 31SAV.
|
||
HRLI D,(JRST)
|
||
MOVEM D,31SAV+1
|
||
HRRI D,1(D)
|
||
MOVEM D,31SAV+2
|
||
PROC1: SOJLE B,JBISTP
|
||
LDB W2,[270400,,W3]
|
||
LDB D,[331100,,W3]
|
||
CAIN D,260
|
||
JRST IPUSHJ
|
||
CAIN D,264
|
||
JRST IJSR
|
||
CAIN D,265
|
||
JRST IJSP
|
||
CAIN D,266
|
||
JRST IJSA
|
||
CAIN D,256
|
||
JRST IXCT
|
||
TRNN D,700
|
||
JRST IUUO
|
||
PROCR: MOVEM W3,31SAV ;PUT INS IN 31,JRST INS+1 IN 32,JRST INS+2 IN 33
|
||
CALL GXBLKD
|
||
JFCL GXBLKL
|
||
ADDI D,BPBLK
|
||
HRRM D,IPC
|
||
.ACCESS USRO,D
|
||
MOVE D,[-3,,31SAV]
|
||
.IOT USRO,D
|
||
MOVE D,OIPBIT
|
||
SKIPLE INCNT(U)
|
||
TSBPC3: IORM D,IPC
|
||
GO: PUSHJ P,INSRTB
|
||
MOVE A,[-2,,PCSTP0] ;START LOSER BACK UP
|
||
.USET USRI,A
|
||
SETZM UINT(U)
|
||
JRST TSIN22 ;FINISHED HACKING THIS INFERIOR; SEE IF ANY OTHERS INTERRUPTED.
|
||
|
||
PCSTP0: .SUPC,,IPC
|
||
.SUSTP,,[0]
|
||
|
||
IJSP: TLCA W3,(MOVE#JSP)
|
||
IPUSHJ: TLC W3,(PUSH#PUSHJ)
|
||
HRRM W3,31SAV+1 ;TURN THE FIRST JRST INTO A JRST TO THE SUBROUTINE.
|
||
MOVE D,IPC ;THE SECOND JRST ISN'T NECESSARY, SO PUT OLD PC THERE
|
||
MOVEM D,31SAV+2
|
||
CALL GXBLKD ;AND XCT A MOVE OR A PUSH POINTING AT THAT PC.
|
||
HRRI W3,BPBLK+2(D)
|
||
JRST PROCR
|
||
|
||
;GET IN D THE ADDRESS OF THE 20-WORD XCT BLOCK IN THE INFERIOR,
|
||
;MINUS 20 (THE DEFAULT ADDRESS OF THAT BLOCK). VERIFY THAT THE MEMORY EXISTS.
|
||
;FOLLOW THE CALL WITH JFCL GXBLKL TO GO TO JBIBPS INSTEAD OF JUST ERRORING.
|
||
GXBLKD: .USET USRI,[.R40ADDR,,D]
|
||
HLRZS D
|
||
SKIPE D
|
||
MOVEI D,-20(D)
|
||
SAVE D
|
||
SAVE A
|
||
MOVEI A,20(D) ;TRY TO WRITE IN THE 1ST WORD OF THE BLOCK.
|
||
CALL RDEP
|
||
JRST GXBLK1
|
||
ADDI A,17
|
||
CALL RFETCH
|
||
JRST GXBLK1
|
||
CALL RDEP ;WRITE IN THE LAST WORD.
|
||
CAIA
|
||
JRST POPADJ
|
||
GXBLK1: MOVE A,@-2(P) ;XCT BLOCK DOESN'T EXIST. WHAT DO WE DO?
|
||
GXBLKL: CAME A,[JFCL GXBLKL]
|
||
ERSTRT [SIXBIT/NO CORE AT THE $X LOCATIONS?/]
|
||
7TYPE [ASCIZ /No core at the $X locations!/]
|
||
SKIPN UINT(U)
|
||
SETOM UINT(U) ;BE AWARE THAT THE JOB ISN'T BEING RESTARTED.
|
||
SUB P,[2,,2]
|
||
JRST JBIBPS
|
||
|
||
IJSR: MOVE D,IPC
|
||
HRRZ A,W3
|
||
IJSR1: PUSHJ P,RDEP
|
||
JRST JBISTP
|
||
HRLI W3,(JRST)
|
||
AOJA W3,PROCR
|
||
|
||
IJSA: HRRZ A,W2
|
||
PUSHJ P,RFETCH
|
||
JRST JBISTP
|
||
HRRZ A,W3
|
||
PUSHJ P,RDEP
|
||
JRST JBISTP
|
||
HRRZ A,W2
|
||
HRR D,IPC
|
||
HRL D,W3
|
||
JRST IJSR1
|
||
|
||
IXCT: HRRZ A,W3
|
||
IXCT1: PUSHJ P,RFETCH
|
||
JRST JBISTP
|
||
MOVE W3,D
|
||
MOVEI A,100
|
||
MOVEM A,TEM2
|
||
IXCT3: LDB A,[220400,,D]
|
||
JUMPE A,IXCT2
|
||
PUSHJ P,RFETCH
|
||
JRST JBISTP
|
||
ADDI W3,(D)
|
||
IXCT2: TLNE W3,20
|
||
JRST IXCTIN
|
||
TLZ W3,37
|
||
JRST PROC1
|
||
|
||
IXCTIN: SOSGE TEM2
|
||
JRST JBISTP
|
||
HRRZ A,W3
|
||
PUSHJ P,RFETCH
|
||
JRST JBISTP
|
||
DPB D,[2700,,W3]
|
||
MOVE D,W3
|
||
JRST IXCT3
|
||
|
||
IUUO: CAIN D,45
|
||
JRST IBPT
|
||
CAIL D,40
|
||
JRST PROCR ;USER UUO
|
||
MOVE D,W3
|
||
MOVEI A,40
|
||
PUSHJ P,RDEP
|
||
JRST JBISTP
|
||
MOVEI A,41
|
||
JRST IXCT1
|
||
IBPT: MOVEM W3,I40
|
||
JRST JBIBRK
|
||
|
||
;MAIN PROGRAM LEVEL CODE TO HANDLE .BREAK 12, REQUESTS, CLI INTS.
|
||
;MAY BE EXECUTED WHENEVER DDT IS READING INPUT, TYPING OR SLEEPING.
|
||
;INTERRUPT LEVEL SETOM'S HAKRQ TO SAY HAKKAH SHOULD BE CALLED.
|
||
;THE UHACK USER VARIABLE IF NONZERO SAYS THAT JOB WANTS SERVICE,
|
||
; RH HAS EFFECTIVE ADDRESS OF THE .BREAK 12, .
|
||
;UIACK USER VAR BIT 2.5 SAYS KILL THE JOB.
|
||
;HAKPRQ NONZERO IS ADDR OF A LOC. THAT WAS UNPURIFIED
|
||
;AUTOMATICALLY. A ":UNPURE <HAKPRQ>" MESSAGE IS NEEDED.
|
||
;HAKBLC IF >0 IS THE NUMBER OF RQ'S FOR BELLS TO BE TYPED
|
||
;DUE TO INTERRUPTS FROM INFERIORS THAT DIDN'T HAVE TTY.
|
||
;HAKINT BITS %PIDBG, %PIDWN, %PICL1 IF SET MEAN
|
||
;THAT THE RESPECTIVE INTS HAVE BEEN RECEIVED AND
|
||
;WANT STUFF TO BE TYPED OUT.
|
||
HAKKAM: SETOM HAKOK ;TSINT CAN EXIT TO HAKKAH.
|
||
HAKKAN: SKIPL HAKRQ ;DO HAKKAH IF ANY RQ'S QUEUED.
|
||
RET
|
||
HAKKAH: SKIPE TOUTXQ ;DON'T DO HAKKAH WHEN CAN'T TYPE OUT.
|
||
RET
|
||
SKIPN HAKING ;DON'T ALLOW RECURSIVE HAKKAH.
|
||
SKIPE INTING ;DON'T DO HAKKAH PI-IN-PROG.
|
||
RET ;(HAKRQ STILL -1 SO WILL CALL HERE AGAIN.)
|
||
HAKKAI: SKIPE TYOUNI
|
||
SKIPN NOERASE ;ON STORAGE TUBES, WE CAN'T TYPE STUFF INSIDE A --MORE--.
|
||
CAIA
|
||
RET
|
||
SETOM HAKING ;NOW WITHIN HAKKAH (IN CASE CALL HAKKAH)
|
||
SAVE A ;SAVE ACS A THRU 16.
|
||
MOVEI A,1(P)
|
||
HRLI A,B
|
||
ADD P,[14,,14]
|
||
SKIPL P ;P'S VALUE AFTER THE PUSHING.
|
||
ERLOSS
|
||
BLT A,(P)
|
||
SAVE UUOH
|
||
SAVE 40
|
||
SAVE TTYFLG ;WE MAY TEMPORARILY TURN ON TTY OUTPUT.
|
||
SAVE MORPRP ;DON'T LET HAKKAH EXIT TO M.P. DUE TO
|
||
SETZM MORPRP ;A FLUSHED MORE.
|
||
SETZM HAKRQ
|
||
SETZM TTYFLG ;ALL TYPEOUTS EXCEPT :UNPURE COME OUT EVEN IF TTY OFF.
|
||
skipn i3,hakint ;any ints rq'ing typeout?
|
||
jrst hakha8
|
||
trze i3,%picli ;First, are there any CLI's pending?
|
||
call hakcli ; yes, gobble down the message before doing anything
|
||
aos haktyp
|
||
hakai1: skipe haktyp ;if it's time for random typeouts, try them.
|
||
jrst hakham
|
||
|
||
MOVE U,CU
|
||
LDB A,[$URGAG,,URANDM(U)]
|
||
SKIPL U
|
||
SKIPE UINTWD(U)
|
||
setz a, ;a nonzero iff current job running and wants :NOMSG 0.
|
||
SKIPN A
|
||
SKIPN NOMSGF ;IN :NOMSG 0 MODE, EITHER FROM :NOMSG OR REQUESTED BY CURRENT JOB,
|
||
jrst [ sos haktyp
|
||
AND I3,[%PIDWN]
|
||
JUMPE I3,HAKHAM ;PRINT ONLY "SYS GOING DOWN" MESSAGES,
|
||
.DIETIM A,
|
||
JUMPL A,HAKHAM ;NOT "REVIVED" MESSAGES,
|
||
CAIL A,10.*60.*30.
|
||
JRST HAKHAM ;AND PRINT ONLY IF GOING DOWN WITHIN 10 MINUTES
|
||
call %save1 ;steal the tty if don't have it
|
||
CALL HAKDED ;PRINT,
|
||
ANDCAM I3,HAKINT ;SAY IT HAS BEEN HANDLED.
|
||
JRST HAKHAM]
|
||
jumpe i3,hakha8
|
||
skipl u ;no job? Can't be inhibited from printing mail
|
||
skipn uintwd(u) ;Job not running?
|
||
caia ; legit job that's running,
|
||
jrst hakai2 ; else skip over the rest of this checking
|
||
skipge ddtty ;is the TTY in DDT?
|
||
jrst hakai3 ; yes, so don't defer
|
||
skipge a,mailnt ;check out our notification flag
|
||
movns a ; take the absolute value thereof
|
||
cain a,2 ;if it's 2, we defer when in any inferior at all
|
||
jrst hakai4 ; so do that
|
||
move a,urandm(u) ;otherwise, check the URANDM word
|
||
trnn a,%urmal ;or it wants mail printing to be allowwed
|
||
jrst hakai3 ; then don't defer hacking this interrupt
|
||
hakai4: tdne i3,[%pidwn\%pidbg] ;if we have something to print anyway
|
||
jrst hakai2 ; then don't defer this
|
||
trne i3,%picl1 ;if we have SENDS
|
||
skipn clirpx ; and there's sends we haven't seen yet
|
||
caia
|
||
jrst hakai2 ; then don't defer this since we'll print anyway
|
||
tlz i3,(%pidir) ;don't handle the mail interrupt at this time
|
||
setom haktyp ; but note that there's something to do
|
||
hakai3: jumpe i3,hakha8 ;If there's no interrupts left, don't feep!
|
||
hakai2: tdnn i3,[%pidwn+%pidbg] ;If we're going to handle these
|
||
jrst hakai7 ; Then always do SEND's and mail
|
||
move a,sendrp
|
||
skipl ddtty ;Not at DDT level?
|
||
aose a ; And ..SENDRP/-1
|
||
caia
|
||
tdz i3,[%pidir+%picl1] ;Then don't handle SEND
|
||
|
||
hakai7: skipe getty ;if printing terminal
|
||
skipge ddtty ; or the TTY isn't stolen
|
||
andcam i3,hakint ;say these ints are now handled, don't repeat
|
||
|
||
tlne i3,(%pidir) ;if a write has been done to our file directory
|
||
call malhak ; check and see if maybe it was mail for us
|
||
tdnn i3,[#%pidir] ;if there are no other interrupts
|
||
jrst hakha8 ; then don't steal TTY and feep
|
||
tlze i3,%pjdbg ;if a %PIDBG has been received
|
||
call hakdbg ; print a message saying debugged or debugged-no-more
|
||
trze i3,%picl1 ;if we have messages to print, don't clear the bit
|
||
call cliprt ; print any messages that may need printing
|
||
trne i3,%pidwn ;clear %PIDWN's now since they get repeated by the
|
||
call hakded ; system.
|
||
HAKHA8: ANDCAM I3,HAKINT
|
||
skipn alarmv ;IF ALARM IS SET, SEE IF IT HAS TRIPPEDD.
|
||
jrst hakhau
|
||
call alarmh
|
||
hakhau: SETZ U, ;IF ANY JOBS ARE WAITING TO RETURN, SAY SO.
|
||
HAKHA9: SKIPE UINT(U)
|
||
CALL HAKJWT
|
||
ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JRST HAKHA9
|
||
SKIPE JREMEM ;REPORT ANY INTERRUPTS FROM :FORGOTTEN JOBS.
|
||
CALL HAKJRM
|
||
SKIPGE TTYSCM
|
||
JRST HAKHAN
|
||
SKIPE GETTY
|
||
SKIPL TTYSTL ;IF TTY IS DISPLAY BELONGING TO INFERIOR, & NOT IN COM MODE,
|
||
HAKHAN: SKIPGE ALARMV ;OR THERE'S AN ALARM,
|
||
JRST [CALL HAKWT0 ;TYPE THE MESSAGES AGAIN LATER.
|
||
JRST .+2]
|
||
SETZM ALARMW
|
||
CALL ALARM4
|
||
HAKHAM: SETZ U, ;PROCESS ANY PENDING .BREAK 12,'S.
|
||
HAKHA2: MOVE A,UIACK(U)
|
||
TRNN A,20000 ;IF JOB WANTS TO DIE,
|
||
SKIPE UHACK(U) ;OR DID A .BREAK 12,
|
||
PUSHJ P,HAKHAL ;HANDLE THIS JOB.
|
||
ADDI U,USRLNG
|
||
CAIGE U,USREND
|
||
JRST HAKHA2
|
||
SKIPL HAKIOP ;IF PUSHED USR CHNLS, POP THEM.
|
||
JRST HAKHA3
|
||
.IOPOP USRO,
|
||
.IOPOP USRI,
|
||
HAKHA3: SETZM HAKIOP
|
||
CALL TYOFRC ;IF USING BLOCK MODE TYPEOUT, FORCE IT OUT.
|
||
.LISTEN A, ;MAKE SURE INFERIOR DOESN'T SCREW THINGS BY .RESET OF TTY.
|
||
SETZM HAKING
|
||
REST MORPRP
|
||
REST A ;RESTORE TTYFLG, BUT DON'T WIPE OUT
|
||
ADDM A,TTYFLG ;ANY ^V OR ^W THAT INT'D DURING HAKKAH.
|
||
REST 40
|
||
REST UUOH
|
||
HRLZI 16,-14(P)
|
||
HRRI 16,A
|
||
BLT 16,16
|
||
SUB P,[15,,15]
|
||
SKIPGE HAKRQ ;IF MORE RQ'S MIGHT HAVE BEEN QUEUED,
|
||
JRST HAKKAH ;PROCESS THEM.
|
||
.SEE %SAVE1 ;WHICH STEALS THE TTY IF NEC.
|
||
%SAVEX: SKIPN TTYSTL
|
||
JRST %SAVE5
|
||
HLLZS TTYSTL
|
||
SKIPN NOTTY
|
||
SKIPN OCOFL
|
||
JRST %SAVE4
|
||
SYSCLE CNSSET,[%CLIMM,,TYIC ? [-1] ? [-1] ? [-1] ? TTYSCM] ;RESTORE STATE OF OCO.
|
||
%SAVE4:
|
||
SKIPL TTYSTL ;IN HAKKAH, RETURN TTY IF STOLEN.
|
||
JRST %SAVE5
|
||
AOSN CTLZFL ;IF USER TYPED ^Z WHILE DDT HAD STOLEN THE TTY,
|
||
.USET USRI,[.SIPIRQ,,[%pic.z]] ;PASS THE ^Z WHERE IT WAS MEANT TO GO.
|
||
SETZM TTYSTL ;TTY NO LONGER STOLEN.
|
||
SETZM DDTTY ;NO LONGER POSESSED.
|
||
.ATTY USRI,
|
||
JFCL
|
||
;;IF TTY BELONGS TO AN INFERIOR, MAYBE HE WANTS %TBINF OFF.
|
||
SAVE A
|
||
MOVE A,CU
|
||
MOVE A,URANDM(A)
|
||
TRNE A,%URFRZ
|
||
JRST POPAJ
|
||
REST A
|
||
;OTHERWISE, TURN %TBINF ON SO INFERIORS CAN TYPE OUT.
|
||
%SAVE5: SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLO %TBINF]]
|
||
RET
|
||
|
||
malck1: syscal OPEN,[ %clbit,,.bii ? %climm,,fdrc ? [sixbit /DSK/] ? xuname
|
||
[sixbit /MAIL/] ? hsname] ;open the mail file
|
||
ret ; not there? can't be what was written
|
||
syscle RFDATE,[ %climm,,fdrc ? %clout,,a] ;get the date on the file
|
||
jrst popj1
|
||
|
||
malckq: call malck1 ;open the mailfile and get the write-date into A
|
||
ret ; not there? can't be what was written, punt
|
||
camn a,mailtm ;did it come?
|
||
ret ; no, punt
|
||
movem a,mailtm ;remember last time mail gotten
|
||
skipe haking ;if in HAKKAH
|
||
call %save1 ; beep and get the TTY
|
||
skipg mailnt ;does he want the from info?
|
||
ret ; no, just wanted to feep at him, give up now
|
||
call fdrco1 ;init the buffering
|
||
save fdrcip ;Ptr to first line of the message.
|
||
move a,[440700,,[asciz /RECEIVED: /]]
|
||
call hakml5 ;Network headers might begin with Received lines.
|
||
caia
|
||
jrst [ rest a ? jrst hakml6 ]
|
||
rest fdrcip ;Try looking at the first line again.
|
||
move a,[440700,,[asciz /DATE: /]]
|
||
call hakml5 ;Network header might also begin with Date field.
|
||
caia ; comparison fails, must be ITS format
|
||
jrst hakml6 ; comparison win, network format
|
||
call fdrco8 ;re-start at the beginning of the buffer
|
||
7type malfrm ;mail from!
|
||
movei a,"@ ;FOO@MIT-AI, type up to the @
|
||
call hakmlt ;not inclusive
|
||
jrst hakml7 ; EOF or EOL
|
||
ctype "@ ;type the @
|
||
movei a,40 ;and now type up to the space
|
||
call hakmlt ;watching for EOF or EOL (bad format message!)
|
||
jrst hakml7 ; barf
|
||
call malfll ;flush a line
|
||
jrst hakml7 ; huh?
|
||
movei a,1 ;ITS header has one line seen already
|
||
call hakml8 ;Say how many more lines there are.
|
||
7type [asciz /
|
||
/]
|
||
ret ;Done, go close up.
|
||
|
||
;;; compare string in A with buffer. The stuff from the buffer is
|
||
;;; uppercasified before comparison, so the string pointed to by A had better
|
||
;;; be all upper-case.
|
||
|
||
hakml5: ildb c,a ;get a comparison character
|
||
jumpe c,popj1 ;all the way through, that's a match
|
||
call fdrci ;read in the character
|
||
ret
|
||
cail d,"a ;uppercasify
|
||
caile d,"z
|
||
caia
|
||
subi d,40
|
||
cain c,(d) ;match?
|
||
jrst hakml5 ; yes, keep comparing
|
||
ret
|
||
;;; parsing error!
|
||
hakml7: 7type [asciz /[Bad format message in mail file]/]
|
||
ret ;give up
|
||
|
||
;;; network format!
|
||
hakml6: setzm hakmct ;Count discarded header lines.
|
||
hakm61: call malfll ;Flush up to second line.
|
||
jrst [ move a,hakmct ;See how many lines parsed.
|
||
cail a,30. ;If already went through thirty
|
||
jrst hakml7 ; Parse runs out, probably bad format.
|
||
call fdrco1 ;Else re-fill the buffer.
|
||
jrst .+1 ] ;And look at the next line.
|
||
aos hakmct ;Count another header line hacked.
|
||
save fdrcip ;Remember this line in the buffer.
|
||
move a,[440700,,[asciz /FROM: /]]
|
||
call hakml5 ;If this is the FROM line.
|
||
caia ; we know who the sender is.
|
||
jrst [ rest a ? jrst hakm62 ]
|
||
rest fdrcip ;Else maybe it is a SENDER line.
|
||
move a,[440700,,[asciz /SENDER: /]]
|
||
call hakml5 ;Try that on for size.
|
||
jrst hakm61 ; Nope, skip this line and try the next one.
|
||
hakm62: 7type malfrm ;Got it. Type the "Mail from "
|
||
movei a,^M ;up to the end of the line should be the sender
|
||
call hakmlt
|
||
jrst hakml7 ; barf, how many ways are there to lose?
|
||
aos hakmct
|
||
move a,hakmct ;2 lines of network header have been parsed
|
||
call hakml8 ;Print out who it is from and length
|
||
skipn mailns
|
||
jrst hakm68
|
||
.acces fdrc,[0] ;Rewind the mailbox.
|
||
call fdrco1 ;Init the buffering.
|
||
setzm hakmct ;Now search for Subject line.
|
||
hakm63: aos hakmct ;Count header lines examined.
|
||
call malfll ;Flush to next line.
|
||
jrst [ cain d,^_ ; If end of message
|
||
jrst hakm68 ; give up.
|
||
move a,hakmct ; If end of buffer
|
||
cail a,30. ; and already checked 30 lines
|
||
jrst hakm68 ; give up.
|
||
call fdrco1 ; Else re-fill the buffer.
|
||
jrst .+1 ] ; And look at the next line.
|
||
move a,[440700,,[asciz /SUBJECT: /]]
|
||
call hakml5 ;Is this is the SUBJECT line?
|
||
jrst hakm63 ; No, try the next one.
|
||
7type [asciz / Re: /] ;Got it.
|
||
movei a,^M ;Up to the end of the line should be the subject.
|
||
call hakmlt ;Print it.
|
||
cai ; Eh?
|
||
hakm68: 7type [asciz /
|
||
/]
|
||
ret ;All done, go close up, etc.
|
||
|
||
|
||
;;; Type out how many lines in the message.
|
||
;;; A/ count of lines already skipped
|
||
hakml8: 7type [asciz / (/]
|
||
hakml9: call malfll ;print a line
|
||
aosa a ; we've got the count, go type it etc.
|
||
aoja a,hakml9 ;keep counting
|
||
call g9pnt
|
||
7type [asciz / lines)/]
|
||
ret
|
||
|
||
malhak: jsp i4,shfdrx ;save more-relates and FDRC-buffer stuff
|
||
call malckq ;check out the mail situation
|
||
.close fdrc, ;don't need the file anymore
|
||
opfdrx: jsp i4,opfdrc ;pop the FDRC buffer
|
||
insirp pop p,mornro mornhu mormsg morprp
|
||
ret
|
||
|
||
;; flush a line, ending on EOF or End-of-message, skipping otherwise
|
||
malfll: call fdrci ;get a char
|
||
ret ; eof
|
||
cain d,^_ ;EOM?
|
||
ret ; yes, return on that too
|
||
caie d,^J ;EOL?
|
||
jrst malfll ; not yet
|
||
jrst popj1 ;yes, skip return
|
||
|
||
malfrm: asciz /AMail from /
|
||
|
||
hakmlt: call fdrci ;gobble a char
|
||
ret
|
||
cain d,(a) ;is it the one we're looking for?
|
||
jrst popj1 ; yes, win
|
||
cain d,^_ ;EOM?
|
||
ret ; yes, fail return
|
||
call tout ;no, type it out, and
|
||
jrst hakmlt ;keep on trucking
|
||
|
||
|
||
HAKWT0: .RDTIM A, ;RQ A REALTIME INT 20 SEC FROM NOW,
|
||
LSH A,1
|
||
HAKWT1: ADD A,SENDRP
|
||
MOVEM A,ALARMW
|
||
SKIPG SENDRP ;..SEND HOLDS 0 => USER DOESN'T WANT REPETITION.
|
||
SETOM ALARMW
|
||
RET
|
||
|
||
HAKHAL: SKIPE UINTWD(U)
|
||
RET ;DON'T DO .BREAK 12, ON STOPPED JOB.
|
||
SKIPGE HAKIOP ;IF WE'VE PUSHED USR CHNLS, RE-OPEN.
|
||
JRST HAKHA4
|
||
SKIPL UCHNLO ;USR CHNLS NOT OPEN => CAN'T USE THEM.
|
||
JRST HAKHA7
|
||
CAMN U,CU ;ELSE IF NOT FOR CURRENT USR,
|
||
JRST HAKHA5
|
||
HAKHA7: SETOM HAKIOP ;PUSH AND RE-OPEN.
|
||
.IOPUSH USRI,
|
||
.IOPUSH USRO,
|
||
HAKHA4: move a,urandm(u) ;check if this isn't supposed to be an inferior
|
||
trne a,%urfrn
|
||
erloss (u) ; We blew it somewhere and reowned it!
|
||
MOVE A,[.BII,,USRI]
|
||
TSCALL OPNUSR
|
||
MOVE A,[.BIO,,USRO]
|
||
TSCALL OPNUSR
|
||
HAKHA5: MOVE A,UIACK(U)
|
||
TRNN A,20000 ;KILL THE JOB IF THAT'S WHAT IT WANTS.
|
||
JRST HAKHA6
|
||
CAME U,CU ;(BUT DON'T KILL CURRENT JOB HERE)
|
||
PUSHJ P,MRDR ;THIS ALSO CLEARS USER VARS, SYMS ETC.
|
||
POPJ P,
|
||
|
||
HAKHA6: HRRZ A,UHACK(U)
|
||
MOVEI C,0
|
||
PUSHJ P,RFETCH
|
||
JRST HAKERC
|
||
TLNN D,200000
|
||
JRST HAKONE
|
||
TLNN D,400000
|
||
JRST HAKERC
|
||
MOVE C,D
|
||
HAKNXT: HRRZ A,C
|
||
PUSHJ P,RFETCH
|
||
JRST HAKERC
|
||
HAKONE: SAVE C
|
||
HLRZ A,D
|
||
TRZ A,400000
|
||
JUMPE A,HAKERR
|
||
CAMLE A,HAKDSL
|
||
JRST HAKERR
|
||
HRRZ B,HAKDSP-1(A)
|
||
JUMPGE D,HAKON1
|
||
HLRZ B,HAKDSP-1(A) ;WRITING, USE LH OF DISP WD.,
|
||
CALL TSTPRM ;BARF IF JOB CAN'T WRITE IN DDT.
|
||
JRST HAKPRM
|
||
HAKON1: MOVEI A,(D)
|
||
JRST (B)
|
||
|
||
HAKDSP: WSTRT,,RSTRT
|
||
WLFILE,,RLFILE
|
||
HAKERR,,RSYML
|
||
WSYMV,,RSYMV
|
||
WSTR,,RSTR
|
||
HAWFIL,,HARFIL
|
||
HACY,,HA2ACY ;7 - ^Y OR $$^Y.
|
||
HAKERR,,HALK ;8. - CONVERT VALUE TO SYM & OFFSET.
|
||
HAKERR,,HAKERR ;9. - READ OR WRITE XUNAME (FLUSHED).
|
||
HAKERR,,HAKERR ;10. - READ OR WRITE JOB'S XJNAME (FLUSHED).
|
||
HAKERR,,HARLJB ;11. - READ USR IDX OF PREVIOUSLY SELECTED JOB.
|
||
HAWRND,,HARRND ;12. - READ OR WRITE WORD OF RANDOM INFO.
|
||
HAKPUR,,HAKPUR ;13. - Unpurify page of inferior.
|
||
HAKERR,,HAKHSN ;14. - Lookup HSNAME for a user
|
||
HAKERR,,HAKMAL ;15. - Lookup mail dir/xuname for a user
|
||
HAKDLG==.-HAKDSP
|
||
BLOCK 2 ;FOR PATCHING.
|
||
HAKDSL: HAKDLG
|
||
|
||
HALERR: SUB P,[1,,1]
|
||
HAKERR: REST C
|
||
HAKERC: CALL HAKWBK ;WRITE BACK POINTER IF BLOCK MODE.
|
||
.USET USRI,[.ROPTIO,,A]
|
||
TLNE A,OPTOPC ;IF JOB WANTS PC SOS'D, DO SO FOR IT.
|
||
SOS PPC(U)
|
||
MOVE A,[-4,,HAKBLK-1]
|
||
JRST HAKERT ;GIVE JOB AN ILOPR INTERRUPT & RESTART IT.
|
||
|
||
HAKPRM: REST C ;HERE IF JOB WANTS TO WRITE & ..PERMIT FORBIDS IT.
|
||
CALL HAKWBK ;WRITE BACK BLOCK-MODE AOBJN IF NEC.
|
||
SETZM UHACK(U) ;CLEAR THE JOB'S .BREAK 12 REQUESTS
|
||
MOVNI D,4
|
||
MOVEM D,UINT(U) ;SAY IT IS TRYING TO RETURN BECAUSE OF ..PERMIT.
|
||
SKIPN STOPWT
|
||
CAME U,CU ;IF IT CAN'T RETURN RIGHT AWAY,
|
||
JRST HAKPR1
|
||
SETOM HAKTYP ;MAKE HAKKAH LOOP AROUND AGAIN AND NOTIFY USER.
|
||
SETOM HAKRQ
|
||
HAKPR1: .SUSET [.SIIFPI,,[1_TYIC]] .SEE TSIN23 ;MAYBE SET FLSTOP.
|
||
RET
|
||
|
||
;IF BLOCK MODE, WRITE BACK AOBJN POINTER. IF UNIT MODE, DO NOTHING.
|
||
HAKWBK: JUMPGE C,CPOPJ
|
||
MOVE D,C
|
||
HRRZ A,UHACK(U)
|
||
PUSHJ P,RDEP
|
||
JFCL
|
||
RET
|
||
|
||
HARRND: MOVE D,URANDM(U)
|
||
AND D,[%URUSR]
|
||
JRST HAREAD
|
||
|
||
RSTRT: SKIPA D,STARTA(U)
|
||
RSYML: MOVE D,JOBSYM(U)
|
||
HAREAD: PUSHJ P,RDEP
|
||
JRST HAKERR
|
||
HAKWIN: REST C
|
||
JUMPE C,HAKXIW
|
||
AOBJN C,HAKNXT
|
||
MOVE D,C
|
||
HRRZ A,UHACK(U)
|
||
PUSHJ P,RDEP
|
||
JRST HAKERR
|
||
HAKXIW: PUSHJ P,INSRTB ;PUT BPTS IN UNLESS ALREADY IN.
|
||
SETZM UHACK(U)
|
||
SKIPE INCNT(U)
|
||
SKIPA A,[-3,,HAKBLK]
|
||
MOVE A,[-2,,HAKBLK+1]
|
||
HAKERT: SKIPL SYSUUO(U)
|
||
CALL OPTTRS
|
||
MOVE B,PPC(U)
|
||
.USET USRI,A
|
||
POPJ P,
|
||
|
||
OPTTRS: .USET USRI,[.ROPTIO,,B]
|
||
TLO B,%OPTRP
|
||
.USET USRO,[.SOPTIO,,B]
|
||
RET
|
||
|
||
.SIPIR,,[%PIILO]
|
||
HAKBLK: .SIPIR,,[%PI1PR]
|
||
.SUPC,,B
|
||
.SUSTP,,[0]
|
||
|
||
HARLJB: HRRZ D,JPDLP ;HERE TO GIVE USER THE INDEX OF THE PREVIOUSLY SELECTED JOB.
|
||
SOS D
|
||
CAIGE D,JPDLB
|
||
ADDI D,JPDLL
|
||
MOVE D,(D) ;D GETS DDT'S TABLE INDEX.
|
||
MOVE D,UIND(D) ;NOW GET SYSTEM JOB NUMBER.
|
||
JRST HAREAD
|
||
|
||
; Job wants to set the name of the file he was loaded from. Set both sets
|
||
; of names to oblige him.
|
||
WLFILE: SETZM UFLSYS(U) ; Don't let $Y change UFILE
|
||
IRPS X,,0 3 1 2
|
||
PUSHJ P,FETDH
|
||
MOVEM D,UFILE+X(U)
|
||
MOVEM D,UFNAMD+X(U)
|
||
AOS A
|
||
TERMIN
|
||
JRST HAKWIN
|
||
|
||
; Job wants to read the name of the file he was loaded from. If he wasn't
|
||
; actually loaded from anywhere just return the defaults.
|
||
RLFILE: SKIPN D,UFNAMD(U)
|
||
JRST RLFIL1
|
||
PUSHJ P,DEPNXT
|
||
IRPS X,,3 1 2
|
||
MOVE D,UFNAMD+X(U)
|
||
PUSHJ P,DEPNXT
|
||
TERMIN
|
||
JRST HAKWIN
|
||
|
||
RLFIL1:
|
||
IRPS X,,0 3 1 2
|
||
MOVE D,UFILE+X(U)
|
||
PUSHJ P,DEPNXT
|
||
TERMIN
|
||
JRST HAKWIN
|
||
|
||
DEPNXT: PUSHJ P,RDEP
|
||
JRST HALERR
|
||
AOJA A,CPOPJ
|
||
|
||
HARFIL:
|
||
IRPS X,,0 3 1 2
|
||
MOVE D,PFILE+X
|
||
PUSHJ P,DEPNXT
|
||
TERMIN
|
||
JRST HAKWIN
|
||
|
||
HAWFIL:
|
||
IRPS X,,0 3 1 2
|
||
PUSHJ P,FETDH
|
||
MOVEM D,PFILE+X
|
||
IFE X, MOVEM D,FFILE
|
||
IFE X-3,MOVEM D,FFILES
|
||
AOS A
|
||
TERMIN
|
||
JRST HAKWIN
|
||
|
||
FETDH: PUSHJ P,RFETCH
|
||
JRST HALERR
|
||
POPJ P,
|
||
|
||
HAWRND: CALL FETDH ;WRITE URANDM WORD (OR SUCH BITS AS USER IS ALLOWED TO WRITE).
|
||
XOR D,URANDM(U)
|
||
AND D,[%URUSR]
|
||
XORM D,URANDM(U)
|
||
JRST HAKWIN
|
||
|
||
WSTRT: PUSHJ P,FETDH
|
||
MOVEM D,STARTA(U)
|
||
JRST HAKWIN
|
||
|
||
HACY: CALL FETDH ;READ USER'S AOBJN PTR,
|
||
JRST NCTLY1 ;LOAD SYMS THRU IT.
|
||
|
||
HA2ACY: CALL FETDH ;GET THE AOBJN,
|
||
JRST N2ACY1 ;STORE THE SYMTAB.
|
||
|
||
HALK: CALL FETDH ;GET THE ARG,
|
||
SAVE D
|
||
SAVE A
|
||
CALL SLUK1 ;LOK UP IN SYM TAB.
|
||
JFCL ;MAY SKIP.
|
||
REST A
|
||
SKIPE D,W1 ;IF NO SYM, PUT 0 IN D, ELSE
|
||
MOVE D,(D) ;GET THE SQUOZE.
|
||
CALL DEPNXT ;THAT IS 1ST VALUE RETURNED.
|
||
REST D ;GET BACK THE ARG,
|
||
SKIPE W1 ;IF FOUND A SYMBOL,
|
||
SUB D,1(W1) ;REPLACE BY OFFSET.
|
||
CALL DEPNXT
|
||
JRST HAKWIN
|
||
|
||
RSYMV: JSP I4,%SYM
|
||
PUSH P,A
|
||
SAVE FNYLOC
|
||
CALL SEVL
|
||
CAIA
|
||
JRST RSYMV1
|
||
MOVE D,SYM ;READING VALUE OF "." RETURNS ADDR. OF OPEN LOCATION.
|
||
CAMN D,[SQUOZE 0,.]
|
||
JRST [ MOVE D,LLOC ? JRST RSYMV1]
|
||
CALL OPLK2
|
||
JRST SYMLOP
|
||
JFCL
|
||
RSYMV1: REST FNYLOC
|
||
POP P,A
|
||
PUSHJ P,RDEP
|
||
JRST SYMLOS
|
||
JRST SYMWIN
|
||
|
||
WSYMV: JSP I4,%SYM
|
||
PUSHJ P,RFETCH
|
||
JRST SYMLOS
|
||
PUSHJ P,DEFIN
|
||
SYMWIN: POP P,SYM
|
||
JRST HAKWIN
|
||
|
||
SYMLOP: REST FNYLOC
|
||
POP P,A
|
||
SYMLOS: SOS A
|
||
POP P,SYM
|
||
MOVEI D,0
|
||
PUSHJ P,RDEP
|
||
JRST HAKERR
|
||
JRST HAKWIN
|
||
|
||
%SYM: PUSHJ P,FETDH
|
||
AOS A
|
||
PUSH P,SYM
|
||
MOVEM D,SYM
|
||
JRST (I4)
|
||
|
||
RSTR: SKIPL I3,UCHBUF(U) ;GET AOBJN -> CMD BUFFER,
|
||
MOVEI I3,[0] ;OR -> 0 IF NONE.
|
||
RSTR2: MOVE D,(I3)
|
||
PUSHJ P,DEPNXT ;STORE THE NEXT WORD.
|
||
JUMPE D,HAKWIN ;STOP AFTER STORING A 0.
|
||
PUSHJ P,FETDH
|
||
JUMPN D,HAKWIN ;STOP BEFORE CLOBBERING A NON-0.
|
||
AOBJN I3,RSTR2
|
||
JRST HAKWIN
|
||
|
||
WSTR: MOVEI W1,UCHBUF(U)
|
||
PUSHJ P,ELEC0 ;FLUSH THE CMD BUFFER.
|
||
CALL JCL3 ;CLEAR OPTCMD BIT.
|
||
JRST HAKWIN
|
||
|
||
;; Unpurify the page that the effective address points to. Give an MPV
|
||
hakpur: syscal corblk,[ %climm,,%cbndw\%cbndr ? %climm,,%jself ? %climm,,uprpag
|
||
%climm,,%jsnew]
|
||
erstrt [sixbit /CORE?/] ; lost. Assume unable to get it
|
||
andi a,-2000 ;get addr of start of page,
|
||
.acces usri,a
|
||
move b,[-2000,,upradr]
|
||
save xrwi
|
||
setom xrwi ;.iot should skip if it gets an MPV.
|
||
.iot usri,b ;copy old page into fresh page.
|
||
caia ;no mpv?
|
||
jrst hakerr ;MPV, give an ILOPR
|
||
|
||
rest xrwi
|
||
lsh a,-10.
|
||
syscal corblk,[%climm,,%cbndw ? %climm,,usri ? a
|
||
%climm,,%jself ? %climm,,uprpag] ;replace old page with copy.
|
||
erloss
|
||
syscal corblk,[%climm,,0 ? %climm,,%jself ? %climm,,uprpag] ;flush it
|
||
erloss
|
||
jrst hakwin ;we won, continue!
|
||
|
||
hakmal: call rfetch ;get the ITS name (or 0) from the job
|
||
jrst hakerr
|
||
setz c, ;0 is ITS name if 0 is ITS name
|
||
jumpe d,hakml0 ;0 is OK as an ITS name
|
||
push p,a ;MCHOKP uses A for it's arg
|
||
move a,d ;get that arg now, the ITS name
|
||
call mchokp ;is it an OK machine?
|
||
jrst halerr ; nope, give him an error
|
||
move c,a ;OPMAIL expects ITS name in C, MCHOKP returned in A
|
||
pop p,a
|
||
hakml0: aos a ;next word has XUNAME to look up
|
||
call rfetch ;get the XUNAME from the job
|
||
jrst hakerr
|
||
jumpe d,hakerr ; 0 is illegal as an XUNAME
|
||
move b,d ;OPMAIL expects XUNAME in B, RFETCH returned in D
|
||
push p,a ;OPMAIL clobbers A
|
||
call opmail ;get the HSNAME
|
||
jfcl ; don't worry whether it was explicit
|
||
exch a,(p) ;Get address to store in, and save the HSNAME on stack.
|
||
sos a ;back to first word of pair
|
||
move d,c ;RDEP expects value in D, OPMAIL returned ITS in C
|
||
call rdep ;deposit result in inferior
|
||
jrst halerr ; must have been pure! Turkey...
|
||
move d,b ;RDEP expects value in D, OPMAIL returned XUNAME in B
|
||
aos a ;so put it in the second word
|
||
call rdep ;deposit result in inferior
|
||
jrst halerr ; must have been pure! Turkey...
|
||
pop p,d ;Recover HSNAME from the stack
|
||
aos a ;so put it in the third word
|
||
call rdep ;deposit result in inferior
|
||
jrst hakerr ; must have been pure! Turkey...
|
||
jrst hakwin ;Win!
|
||
|
||
;;; This code assumes that no LSRTNS hackery can be going on at the time.
|
||
;;; This should be the case if no LSRTNS hackery is done at interrupt level.
|
||
|
||
hakhsn: call rfetch ;get the ITS name (or 0) from the job
|
||
jrst hakerr
|
||
setz c, ;result 0 if we have 0 now
|
||
jumpe d,hakhs0 ;0 is OK for ITS name
|
||
save a ;need A for MCHOKP, so save the address
|
||
move a,d ;A <- ITS name (check to be sure)
|
||
call mchokp ;Is this a real ITS?
|
||
jrst halerr ; no, give ILOPR
|
||
move c,a ;GETHS0 expects ITS name in C, MCHOKP returned in D
|
||
rest a ;recover address
|
||
hakhs0: aos a ;next word has XUNAME to look up
|
||
call rfetch ;get the XUNAME from the job
|
||
jrst hakerr
|
||
move b,d ;GETHS0 expects XUNAME in B, RFETCH returned in D
|
||
push p,a ;GETHS0 clobbers A
|
||
.iopush fdrc, ;mustn't clobber the channel!
|
||
call geths0 ;get the HSNAME
|
||
jfcl ; don't worry whether it was explicit
|
||
.iopop fdrc, ;Restore the channel
|
||
pop p,a
|
||
move d,c ;RDEP expects value in D, GETHS0 returned HSNAME in C
|
||
call rdep ;deposit result in inferior
|
||
jrst hakerr ; must have been pure! Turkey...
|
||
jrst hakwin ;Win!
|
||
|
||
|
||
;HANDLE CLI INTERRUPT BY COPYING MESSAGE INTO <cladir>;<UNAME> SENDS
|
||
;AND REQUESTING THAT HAKKAH LEVEL TYPE THE MESSAGE OUT OF THE FILE.
|
||
;IF THE MESSAGE STARTS WITH A RUBOUT, THE USUAL PREFIX "MESSAGE FROM .."
|
||
;IS NOT CREATED.
|
||
|
||
HAKCLI: setzm dskful ;DSK not known to be full, yet at least
|
||
SAVE C
|
||
SAVE D
|
||
SAVE I4
|
||
save a
|
||
save b
|
||
SAVE TOUTXQ
|
||
JSP I4,SHFDRC ;PUSH FDRC AND FDRC BUFFER.
|
||
.IOPUS UTOC,
|
||
.suset [.sidf1,,[%picli]] ;turn off ints while checking for more CLI's
|
||
setom tquitr ;until we turn off flag saying we have some pending
|
||
;to avoid losing messages when the interrupt comes
|
||
;between the open failing and the clearing the bit.
|
||
|
||
CLIBRR: CALL FDRCOP ;READ THE CLA:
|
||
['CLA,,]
|
||
JRST CLIBRX ;NONE, GIVE UP.
|
||
HRRZ D,FDRCEP ;NOTHING IN THE FILE => GIVE UP.
|
||
CAIG D,FDRCTB+1
|
||
JRST CLIBRX
|
||
|
||
|
||
aos clirpc ;Count of messages to print each time
|
||
aos clirpx ;count of messages to print on return to DDT
|
||
|
||
move d,[call cliwrt] ;Since we must buffer rather than write to DSK:
|
||
movem d,toutxq ;output heading & senders name to CLI buffer.
|
||
move d,fdrctb ;save the UNAME
|
||
movem d,cliunm ;and JNAME of the sending job for tracing
|
||
move d,fdrctb+1 ;unwanted messages
|
||
movem d,clijnm
|
||
|
||
MOVEI C,2
|
||
ADDB C,FDRCIP ;SKIP OVER UNAME AND JNAME OF SENDER - DON'T READ THEM AS ASCII.
|
||
ILDB D,C ;IF 1ST CHAR OF MESSAGE IS RUBOUT, JUST SKIP IT.
|
||
CAIN D,177
|
||
JRST [ MOVEM C,FDRCIP
|
||
JRST CLIBR5]
|
||
;the following location named because MRC wants to
|
||
;patch it out!
|
||
|
||
clibr6: 7TYPE [ASCIZ/Message from /] ;OTHERWISE, MAKE USUAL HEADER WITH
|
||
MOVE D,FDRCTB ;NAME OF SENDING JOB.
|
||
PUSHJ P,SIXTYP ;PRINT SENDER'S UNAME & JNAME.
|
||
PUSHJ P,TSPC
|
||
MOVE D,FDRCTB+1
|
||
PUSHJ P,SIXTYP
|
||
PUSHJ P,CRF
|
||
|
||
clibr5: call fdrci ;Get a char
|
||
jrst clibr2 ; (no more!)
|
||
call cliwrt ;Write the char to our special buffer
|
||
cain d,^_ ;Control-underscore?
|
||
call cliwrt ; Double it up so we can detect them in messages
|
||
jrst clibr5 ;try next char
|
||
|
||
clibr2: 7type [asciz /
|
||
/] ;terminate the message
|
||
setzm toutxq ;and no more typeout to the CLI buffer
|
||
|
||
.suset [.sadf1,,[%picli]] ;interrupts, the critical code is past
|
||
setzm tquitr
|
||
|
||
sysclo OPEN,[[.uao,,utoc] ? ['DSK,,] ? ['_DDT..] ? [':SENDS] ? cladir]
|
||
move a,cliptr ;calculate the char address of the end of the messages
|
||
call charad
|
||
move c,b ;remember it for latter
|
||
move a,clibeg ;Now calculate the address of the beginning
|
||
call charad
|
||
sub c,b ;C gets # of chars in buffer
|
||
move d,clibeg ;D gets pointer to start of it all
|
||
clioc0: syscal siot,[ %climm,,utoc ? d ? c] ;And send the messages out!
|
||
jrst clierr ; IOC error, punt writing and just gripe
|
||
syscal open,[ %clbit,,.uai ? %climm,,fdrc ;open the old SENDS file
|
||
[sixbit /DSK/] ? runame ? [sixbit /SENDS/] ? cladir]
|
||
jrst clibr4 ;there is none yet, so no more to copy.
|
||
|
||
clibr8: move d,[440700,,FDRCTB] ;Pointer to buffer
|
||
movei c,fdrcl*5 ;# of chars that will fit in buffer
|
||
sysclo siot,[%climm,,fdrc ? d ? c]
|
||
movei i4,fdrcl*5 ;I4 gets chars in buffer
|
||
subi i4,(c) ;minus any left empty
|
||
move d,[440700,,fdrctb] ;and output the buffer
|
||
clioc1: syscal SIOT,[%climm,,utoc ? d ? i4]
|
||
jrst clierr ; IOC error, just complain & print
|
||
jumpe c,clibr8 ;and output next batch, if wasn't EOF
|
||
|
||
|
||
;here when have finished writing the new sends file.
|
||
|
||
clibr4: .suset [.sidf1,,[%picli]] ;If we allowed quits we'd lose a message;
|
||
setom tquitr ;if we allowed new CLI's we'd forget we got them.
|
||
|
||
syscal RENMWO,[%climm,,utoc ? runame ? [sixbit /SENDS/]]
|
||
jfcl ; shouldn't happen, but don't lose messages!
|
||
|
||
.close utoc,
|
||
jrst clibrr ;see if another message came in since the interrupt.
|
||
|
||
clierr: syscal delewo,[%climm,,utoc] ;flush the output file
|
||
jfcl
|
||
.close utoc,
|
||
call %save1 ;steal the TTY if not already stolen
|
||
skipe dskful ;Was disk full detected?
|
||
7type [asciz /A
|
||
[Disk full! Please delete any unnecessary files!]
|
||
/] ;Could be directory full or no channels, but....
|
||
setzm tquitr ;Quits are allowed now
|
||
7type [asciz /A
|
||
Unable to write SENDS file, held messages follow:
|
||
/]
|
||
jrst clier1 ;Don't flush buffer, and request later typeout of msgs
|
||
|
||
clibrx: movei d,%picli
|
||
andcam d,hakint ;No more CLI pending
|
||
|
||
hrr d,cliend ;end
|
||
hrrz a,clibeg ;beginning
|
||
push p,clibeg ;remember the beginning; ELEC0 will screw it up
|
||
subi d,(a) ;size
|
||
movns d ;-size
|
||
hrli a,(d) ;AOBJN ptr to CLI buffer
|
||
push p,a ;put it on the stack where we can point to it
|
||
movei w1,(p) ;w1 gets ptr to AOBJN ptr to CLI buffer
|
||
call elec0 ;make the CLI buffer go away
|
||
pop p,a ;clean up the stack
|
||
pop p,a ;recover the beginning
|
||
movem a,clibeg ;and start it all there
|
||
movem a,cliptr
|
||
movem a,cliend
|
||
|
||
;Come here after printing error message on disk full
|
||
|
||
clier1: movei d,%picl1 ;tell HAKKAH that there's CLI messages to print
|
||
iorm d,hakint
|
||
iorm d,i3
|
||
setom haktyp ;Say there's something to type.
|
||
|
||
.suset [.sadf1,,[%picli]] ;interrupts are OK now
|
||
setzm tquitr ;since the bit will be set and not cleared
|
||
|
||
.IOPOP UTOC,
|
||
JSP I4,OPFDRC
|
||
REST TOUTXQ
|
||
rest b
|
||
rest a
|
||
REST I4
|
||
REST D
|
||
REST C
|
||
ret ;All done.
|
||
|
||
;;; CLIWRT writes a character in D to the CLI buffer
|
||
|
||
cliwrt: push p,a
|
||
move a,cliptr ;get the pointer
|
||
camn a,cliend ;is it to the end yet?
|
||
call clibgt ; yes, make more room
|
||
idpb d,cliptr ;salt away the char.
|
||
pop p,a
|
||
ret
|
||
|
||
;; CLI buffer get...add CLISIZ more words to the CLI buffer
|
||
;; The CLI buffer is permanantly in existance (although maybe of zero size)
|
||
;; to allow for future improvement of queuing messages to be written to
|
||
;; disk.
|
||
;; What the saving of CLIBEG and friends is about is that we APPEND
|
||
;; to the existing buffer by forcing everything after to move.
|
||
|
||
clibgt: save d
|
||
save w1
|
||
hrrz a,cliend ;Use the beginning so as to be sure to relocate all
|
||
save cliptr ;hole0 will clobber hole0, maybe clibeg
|
||
save clibeg ;so prevent lossage
|
||
push p,a ;and put the AOBJN ptr on the stack for HOLE0 can hack
|
||
movei w1,(p) ;W1 -> AOBJN ptr to space
|
||
movsi a,-clisiz ;ask for CLISIZ more space
|
||
call hole0 ;ask for more space
|
||
pop p,a ;flush the temporary AOBJN ptr from the stack
|
||
rest clibeg
|
||
rest cliptr
|
||
rest w1
|
||
rest d
|
||
ret ;t-t-t-that's all, f-f-f-olks
|
||
|
||
IFN 0,[
|
||
;;; BFALOC takes a buffer-pointer in A and allocates additional space for that
|
||
;;; buffer (amount to grow by is stored in the buffer).
|
||
|
||
;;; To do: Define a BUFFER <increment>,[<no-relocate-on-grow>][relocate]
|
||
;;; Have it thread the buffers, and write code in RELOC which follows the
|
||
;;; threads for the buffers, and relocates those pointers.
|
||
;;; Maybe have it instead check for byte-pointers which are AFTER the current
|
||
;;; Byte Pointer, where "current" Byte Pointer is a slot in the buffer.
|
||
|
||
bfaloc: save c
|
||
save d
|
||
save w1
|
||
|
||
move c,%bfsav(a) ;Get an AOBJN ptr to buffer pointers not to be
|
||
;moved with the growth of the buffer
|
||
jumpge c,nobsv0 ;if none to be saved, just punt that part
|
||
hlre d,c ;get -<# of frobs to save>
|
||
movns d ;get positive #!
|
||
movei w1,1(p) ;get where to move them to.
|
||
hrli w1,(c) ;get from,,to
|
||
hrl d,d ;get size,,size
|
||
add p,d ;make room on the stack
|
||
skipl p ;check for PDL overflow
|
||
.suset [.sipirqc,,[%pipdl]] ;lost, give interrupt
|
||
blt w1,(p)
|
||
|
||
nobsv0: save a ;remember which buffer we hack!
|
||
|
||
move w1,%bfbpt(a) ;get the AOBJN ptr to the buffer's extent
|
||
movs a,%bfsiz(a) ;get <size to grow by>,,0
|
||
movns a ;get -<size to grow by>,,,0
|
||
call hole0 ;ask for more space
|
||
|
||
rest a ;recover which buffer we hack!
|
||
move c,%bfsav(a) ;get AOBJN ptr to frobs on the stack to pop
|
||
jumpge c,nobsv1 ;if none, nothing to remove from the stack
|
||
|
||
hlre d,c ;get -<# of frobs on the stack>
|
||
movns d ;get pos #!
|
||
hrl d,d ;get size,,size of block on PDL
|
||
hrlz w1,c ;prepare the AC for the BLT
|
||
hrr w1,p ;<block>,,<top of pdl>
|
||
addi w1,1(d) ;<block>,,<saved block>
|
||
movss w1 ;<saved block>,,<block>
|
||
addi c,-1(d) ;x,,<end of block>
|
||
blt w1,(c) ;move the saved block home
|
||
sub p,d ;done, pop the stack
|
||
|
||
nobsv1: rest w1
|
||
rest d
|
||
rest c
|
||
ret ;t-t-t-that's all, f-f-f-olks
|
||
]; End IFN 0,
|
||
|
||
;At HAKKAH level, print :SENDS received out of DSK:<cladir>;<uname> SENDS
|
||
;CLIRPC has the number of messages to be printed.
|
||
;CLIRPX has number of messages to be printed on return to DDT
|
||
|
||
|
||
cliprt: move c,sendrp ;check out if we really want to print now
|
||
aose c ;is SENDRP/-1 ?
|
||
jrst cliprg ; No, handle it now
|
||
skipl ddtty ;Unless DDT has the TTY already
|
||
ret ; Don't print anything now
|
||
cliprg: jsp i4,shfdrx ;save more-related stuff and FDRC buffer stuff
|
||
movn c,clirpx ;Total number of messages since left DDT
|
||
skipge ddtty ;If do not have the tty
|
||
skipge ttystl ; or have it only because stole it
|
||
movn c,clirpc ;then use number to print
|
||
jumpe c,cliptx ;if the count is zero, don't print any at all
|
||
|
||
call %save1 ;Steal the TTY if needed, and beep at him
|
||
|
||
move a,sendrp ;check out SENDRP
|
||
camn a,[-2] ;-2 means only print them once!
|
||
setzm clirpc ; so don't print again.
|
||
|
||
skipe getty ;never repeat a msg on a printing tty.
|
||
skipl ttystl ;if in ddt, printing for last time.
|
||
setzm clirpc
|
||
|
||
skipe getty ;Now do the same for the return-to-ddt message count
|
||
skipl ttystl ;if in ddt, printing for last time.
|
||
setzm clirpx
|
||
|
||
move a,clibeg ;start our output at the beginning of the buffer
|
||
movem a,cliopt
|
||
movei a,clired ;and start it out from the buffer
|
||
movem a,clisrc ;since there may be stuff there that hasn't made it to
|
||
;the file yet
|
||
|
||
move a,smlins ;how many lines before --MORE-- or (n More Lines)?
|
||
skipe getty
|
||
skipge ttyscm ;don't do --MORE-- on printing TTY's or in com mode.
|
||
hrloi a,377777
|
||
|
||
clipr1: call @clisrc ;Get a character of CLI messages, from whichever source
|
||
jrst cliprf
|
||
caie d,^_ ;^_ => end of one message.
|
||
jrst clipr3 ; nope, ordinary character
|
||
call @clisrc ;check it to be sure it's not ^_^_
|
||
jrst cliprf
|
||
caie d,^_ ;is it a double ^_?
|
||
aoja c,clipr2 ; no, it marks the end of the message, on to the next
|
||
;yes, double ^_, just continue with the loop
|
||
|
||
CLIPR3: CALL TOUT ;PRINT THE MESSAGE ON THE TTY.
|
||
CAIE D,^J
|
||
JRST CLIPR1
|
||
SOJG A,CLIPR1 ;COUNT OUT THE FIRST C(SMLINS) LINES.
|
||
SKIPL TTYSCM ;IN COM MODE => CAN'T READ ANYTHING.
|
||
SKIPGE TTYSTL ;THEN, IF IN DDT (THIS IS LAST APPEARANCE OF MSG),
|
||
JRST CLIPR5
|
||
7TYPE [ASCIZ/--More--/]
|
||
SETOM MORNHU
|
||
CALL MORFL4 ;ASK USER IF HE WANTS TO SEE THE REST.
|
||
JRST CLIPR4 ;NO => READ PAST THIS MESSAGE AND PRINT THE OTHERS IF APPRO.
|
||
HRLOI A,377777
|
||
JRST CLIPR1 ;YES => PRINT ALL REST OF THIS ONE WITHOUT --MORE--.
|
||
|
||
clipr4: call @clisrc ;skip to end of msg without printing, reading from
|
||
jrst cliprf ; whichever source is current
|
||
caie d,^_
|
||
jrst clipr4
|
||
call @clisrc ;check it to be sure it's not ^_^_
|
||
jrst cliprf
|
||
caie d,^_ ;is it a double ^_?
|
||
aoja c,clipr2 ; no, it marks the end of the message, on to the next
|
||
jrst clipr4 ;yes, double ^_, just loop
|
||
|
||
;COME HERE AFTER C(SMLINS) LINES, IF CAN'T READ INPUT.
|
||
;JUST TELL USER HOW MANY LINES ARE LEFT IN THE MESSAGE AND GO TO NEXT ONE.
|
||
;NOTE THAT A HOLDS 0.
|
||
clipr5: call @clisrc ;count # lines left in message in A. Read from
|
||
JRST [ MOVEI D,^C ; the current source
|
||
JRST CLIPR6]
|
||
CAIN D,^J
|
||
AOJA A,CLIPR5
|
||
CAIE D,^_
|
||
JRST CLIPR5
|
||
CLIPR6: SAVE D ;HERE AFTER COUNTING LINES OF ENTIRE MESSAGE.
|
||
CTYPE "(
|
||
CALL G9PNT ;DECIMAL PRINT ARG IN A.
|
||
7TYPE [ASCIZ/ More Lines)
|
||
/]
|
||
REST D ;NOW, HANDLE THE ^_ THAT ENDED THIS MESSAGE,
|
||
CAIN D,^C ;OR, IF EOF ENDED IT, STOP.
|
||
JRST CLIPRF
|
||
aos c ;count the message
|
||
|
||
;come here on ^_ -- should we print the next message too?
|
||
;note that D contains a look-ahead character
|
||
clipr2: move a,smlins
|
||
skipe getty ;if so, re-init the --MORE-- line counter.
|
||
skipge ttyscm ;don't do --MORE-- on printing tty's or in com mode.
|
||
hrloi a,377777
|
||
jumpl c,clipr3 ;if not at end, go type our buffered char and loop
|
||
cliprf: call terpri ;come here at eof, or end of last msg to be printed.
|
||
cliptx: jsp i4,opfdrc ;pop FDRC & buffer.
|
||
insirp pop p,mornro mornhu mormsg morprp
|
||
ret
|
||
|
||
;;; Call CLIRED to get the next character of the CLI buffer.
|
||
;;; At the end of the buffer, it will switch CLISRC to FDRCI, after opening
|
||
;;; and initializing the FDRCI buffer, etc.
|
||
|
||
clired: move a,cliopt ;get our pointer
|
||
came a,cliptr ;is this the end of our buffered messages?
|
||
jrst [ildb d,cliopt ? jrst popj1] ;No, give him his character
|
||
|
||
movei a,fdrci ;Take the rest of our input from the file
|
||
movem a,clisrc
|
||
|
||
syscal open,[ %clbit,,.bai ? %climm,,fdrc ;open the SENDS file
|
||
[sixbit /DSK/] ? runame ? [sixbit /SENDS/] ? cladir]
|
||
ret ; No file, that's EOF!
|
||
call fdrco1 ;and initialize the FDRC buffer and copy
|
||
jrst fdrci ;Get our input from the new source
|
||
|
||
;TELL USER THAT SOME JOB HAS INTERRUPTED.
|
||
HAKJWT: SKIPE STOPWT
|
||
CAME U,CU ;DON'T TELL THE USER ABOUT A JOB THAT'S GOING TO
|
||
CAIA ;HAVE A CHANCE TO RETURN RIGHT AWAY WITHOUT USER INTERVENTION.
|
||
RET
|
||
CALL %SAVE1 ;STEAL TTY IF NEC.
|
||
7TYPE [ASCIZ/Job /]
|
||
MOVE D,UJNAME(U)
|
||
CALL SIXTYP
|
||
MOVE D,UPI0(U)
|
||
SKIPN UPI1(U) ;MAYBE JOB MERELY GOT A DTTY INTERRUPT ..
|
||
CAME D,[%PITTY]
|
||
JRST HAKJW1
|
||
7NRTYP [ASCIZ/ wants the TTY
|
||
/]
|
||
|
||
HAKJW1: MOVE D,UIACK(U) ;IF HAKKAH WILL KILL JOB WHEN WE POPJ...
|
||
TRNE D,60000
|
||
7NRTYP [ASCIZ/ finished
|
||
/]
|
||
TRNE D,410000
|
||
JRST HAKJW2
|
||
MOVE D,UINT(U)
|
||
CAME D,[-2]
|
||
CAIL D,15
|
||
7NRTYP [ASCIZ/ returning
|
||
/]
|
||
HAKJW2: 7TYPE [ASCIZ/ interrupted: /]
|
||
MOVE C,UPI0(U) ;ELSE SAY WHAT INTS THE JOB GOT:
|
||
CALL INT0PR
|
||
MOVE C,UPI1(U)
|
||
CALL INT1PR
|
||
JRST CRF
|
||
|
||
;INFORM THE USER THAT FORGOTTEN JOBS HAVE INTERRUPTED.
|
||
;JREMEM HOLDS THEIR INTERRUPT BITS.
|
||
HAKJRM: CALL %SAVE1
|
||
MOVE W1,JREMEM ;GET THE SET OF INT. BITS.
|
||
HAKJR2: MOVN A,W1
|
||
AND A,W1 ;GET JUST ONE OF THEM,
|
||
ANDCM W1,A ;MARK IT AS HANDLED
|
||
SKIPE GETTY ;(MAYBE PERMANENTLY).
|
||
SKIPL TTYSTL
|
||
ANDCAM A,JREMEM
|
||
SAVE W1
|
||
.UTRAN A ;GET UNAME IN B, JNAME IN C.
|
||
JRST HAKJR1
|
||
7TYPE [ASCIZ /:Forgotten Job /]
|
||
MOVE D,C
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ / interrupting
|
||
/]
|
||
HAKJR1: REST W1
|
||
JUMPN W1,HAKJR2
|
||
RET
|
||
|
||
HAKDED: call %save1 ;steal the tty if don't have it
|
||
.DIETIM A,
|
||
JUMPL A,SYSDD2
|
||
CAIL A,60.*60. ;IF GOING DOWN IN <1 MIN,
|
||
TRZ I3,%PIDWN ;DON'T RETYPE THIS MSG.
|
||
JSP I4,SHFDRC
|
||
MOVE D,A
|
||
PUSHJ P,DDTGDM
|
||
JSP I4,OPFDRC
|
||
jrst terpri
|
||
|
||
SYSDD2: MOVE D,ITSNAM
|
||
CALL SIXTYP
|
||
7TYPE [ASCIZ / ITS revived!/]
|
||
jrst terpri
|
||
|
||
ALARMH: .RDTIM D,
|
||
LSH D,1 ;HAS THE ALARM'S TTIME COME YET?
|
||
CAMGE D,ALARMV
|
||
RET
|
||
CALL %SAVE1 ;YES, SAYY SO.
|
||
SETOM ALARMV ;ALARM STILL SET BUT INT NO LONGER WANTED.
|
||
7TYPE ALARMM
|
||
7TYPE [ASCIZ /
|
||
Type :ALARM<CR> to clear/]
|
||
JRST CRF
|
||
|
||
hakdbg: call %save1 ;steal the tty if don't have it
|
||
syscle sstatu,[%clout,,a ? %clout,,a] ;get SYSDBG
|
||
call terpri ;be sure to start on a fresh line
|
||
jumpe a,[7type [asciz /ITS not being debugged!!
|
||
/]
|
||
ret]
|
||
7type ddtdbm
|
||
ret
|
||
|
||
.SEE %SAVEX ;WHICH UNSTEALS THE TTY.
|
||
%SAVE1: skipe ttystl ;is the TTY already stolen?
|
||
ret ; yes, don't repeat the performance!
|
||
SYSCLE USRVAR,[ %CLIMM,,%JSELF ? ['TTY,,] ? 0
|
||
[TLZ %TBINF]] ;Prevent inferiors from typeing
|
||
SKIPE DDTTY ;IF DON'T HAVE TTY, STEAL IT.
|
||
JRST %SAVE2
|
||
.DTTY USRI,
|
||
JFCL
|
||
SETOM DDTTY ;HAVE TTY NOW.
|
||
SETOM TTYSTL ;SAY TTY IS STOLEN.
|
||
%SAVE2: SKIPE NOTTY
|
||
JRST %SAVE3
|
||
SYSCLE CNSGET,[%CLIMM,,TYIC ? REPEAT 4,[ ? %CLOUT,,TTYSCM]]
|
||
MOVE D,TTYSCM ;SAVE CURRENT SETTING OF %TCOCO
|
||
TLON D,%TCOCO ;AND TURN IT ON.
|
||
SKIPN OCOFL
|
||
JRST %SAVE3
|
||
HRRM P,TTYSTL ;INDICATE THAT OCO SHOULD BE RESTORED.
|
||
SYSCLE CNSSET,[%CLIMM,,TYIC ? [-1] ? [-1] ? [-1] ? D]
|
||
%save3: call terpri
|
||
SKIPE D,BELCNT
|
||
CTYPE ^G
|
||
SOJG D,.-1
|
||
RET
|
||
|
||
;SNARF A VALRET STRING FROM JOB THAT'S INTERRUPTING.
|
||
UBRKV: PUSHJ P,INPUSH ; PUSH INPUT SOURCE
|
||
.ACCESS USRI,VALCOM
|
||
SETZM VALCOM
|
||
HRRZ W1,SYMTOP ;READ VALRET STRING ABOVE SYM TABS.
|
||
UBRK2C: HRRZI D,(W1)
|
||
ADDI D,1777
|
||
ANDI D,-2000
|
||
CAIE D,(W1) ;IF NO SPACE THERE,
|
||
JRST UBRK2
|
||
ADDI D,2000
|
||
PUSHJ P,RELC ;GET ANOTHER K.
|
||
SKIPA D,[-2000] ;SAY HAVE 1 K SPACE.
|
||
UBRK2: SUBM W1,D ;D HAS SPACE FOR READING IN.
|
||
HRLI D,(W1)
|
||
MOVS D,D ;D HAS AOBJN -> SPACE.
|
||
SETOM XRWI
|
||
PUSH P,D
|
||
.IOT USRI,D
|
||
JRST UBRK2A ;NO MPV DURING .IOT.
|
||
SETZM (D) ;WAS MPV, PRETEND STRING ENDED NORMALLY WITH 0.
|
||
UBRK2A: POP P,D ;GET BACK PTR -> ENTIRE SPACE.
|
||
UBRK2B: MOVE A,(D) ;LOOK FOR A WORD ENDING WITH A ^@.
|
||
TRNE A,376
|
||
AOBJN D,UBRK2B ;ALSO STOP AFTER WHAT WAS READ IN.
|
||
JUMPGE D,[MOVEI W1,(D) ? JRST UBRK2C]
|
||
SETZM XRWI ;STRING WAS TERMINATED.
|
||
ADDI D,1
|
||
ANDI D,-1
|
||
SUB D,SYMTOP ;GET # WDS READ IN.
|
||
PUSHJ P,ALLOC ;OFFICIALLY ALLOCATE THOSE WDS,
|
||
MOVEM A,INVAOB ;SAVE PTR SO CAN FREE THEM LATER.
|
||
HRLI A,010700
|
||
SOS A
|
||
MOVEM A,INPTR ;SAVE B.P. (MUST BE POSITIVE)
|
||
RET
|
||
|
||
UBREAK: PUSHJ P,TTYRET ;CURRENT JOB INTERRUPTED WHEN IT HAD TTY.
|
||
UBRK0: PUSHJ P,UBRKR ;REMOVE BREAKPOINTS, OTHER ESSENTIALS.
|
||
SKIPE VALCOM ;IF JOB DID A HANDLEABLE .VALUE,
|
||
JRST [ SAVE [NLTL5]
|
||
JRST UBRKV] ;GO SNARF THE STRING.
|
||
UBRK0A: MOVE D,UINTWD(U)
|
||
CAIN D,16
|
||
JRST UBRK16 ;.BREAK 16, MAY NOT WANT CRF.
|
||
call terpri
|
||
CAMN D,[-2]
|
||
JRST UBRKS ;-2 == RETURN FROM STEPPING, SO KEEP STEPPING.
|
||
JUMPL D,UBRK3 ;RANDOM INTERRUPT
|
||
CAIE D,15 ;.BREAK 15, AND 17, TEMP BPTS.
|
||
CAIN D,17
|
||
JRST UBRKT
|
||
SETZM USCNT(U) ;STOP MULTI-STEPPING ON NON-STEPPING RETURN.
|
||
JRST UBRK4 ;JOB HIT BPT, GO PRINT STUFF.
|
||
|
||
UBRK16: SETZM USCNT(U)
|
||
MOVE D,UIACK(U) ;HERE IF JOB DID .BREAK 16,.
|
||
TRNN D,400000
|
||
JRST UBRK1A
|
||
MOVE A,XECPC(U)
|
||
HRRM A,PPC(U)
|
||
MOVE A,XINTWD(U)
|
||
MOVEM A,UINTWD(U)
|
||
UBRK1A: SAVE D
|
||
CALL RADDT1 ;DISPLAY RAID REGS IN SELECTED PLACE.
|
||
REST D
|
||
hrrz d,d ;clear left half, irrelevant
|
||
cain d,500001 ;If this is a :OPEN
|
||
jrst [ 7type [asciz /AFAILED: /]
|
||
movei a,opndev ;filename block
|
||
call lfile ;print the filenames
|
||
7type [asciz / - /]
|
||
hrrz a,opnchn ;get the channel
|
||
call kerr4 ;print the ERR device info on what went wrong
|
||
jrst nltl4] ;prompt and return
|
||
cain d,700001 ;if this is a :OPEN
|
||
jrst [ 7type [asciz /A[OPENED: /]
|
||
hrrz d,opnchn ;get the inferior's channel # to check
|
||
tscall infnam ;read in the inferior's channel's filenames
|
||
movei a,nctltf
|
||
call lfile ;print out those filenames
|
||
ctype "] ;type the closing bracket
|
||
jrst nltl4]
|
||
cain d,700000 ;If this is an $X return with skip
|
||
jrst [7type [asciz /A<SKIP>A/] ;tell the user nicely
|
||
jrst ubrk1b] ;And DON'T do the extra skip!
|
||
TRNN D,4000 ;UNLESS 2.3 "DON'T TYPE ANYTHING"...
|
||
CALL CRF
|
||
TRNE D,200000
|
||
CALL CRF
|
||
|
||
ubrk1b: TRNN D,60000
|
||
JRST [ TRNN D,4000 ;NO TYPOUT => DON'T CLOSE .
|
||
JRST NLTL4
|
||
JRST GSNLRT]
|
||
TRNN D,4000
|
||
7TYPE [ASCIZ /:KILL /]
|
||
JRST KKILL
|
||
|
||
UBRKR: SKIPN OIPCHK(U) ;DO THE ESSENTIAL THINGS TO RETURN CURRENT JOB TO DDT.
|
||
SETZM INCNT(U)
|
||
MOVEI D,0
|
||
EXCH D,UINT(U)
|
||
MOVEM D,UINTWD(U)
|
||
JRST REMOVB
|
||
|
||
;COME HERE IF JOB WAS STOPPED BY A BREAKPOINT.
|
||
UBRK4: SAVE D
|
||
CALL RADDTC ;DISPLAY THE RAID REGS AT SCREEN TOP, IF DESIRED.
|
||
REST D
|
||
.RDTIME C,
|
||
SAVE C ;(FOR DOZING DOZTIM SECONDS)
|
||
IMULI D,BPL ;BREAK POINT (D IS UINT+1)
|
||
ADDI D,B1ADR-BPL(U)
|
||
HRLI D,400000 ;INDICATE ADDR. IS FUNNY (A DDT-REF)
|
||
PUSH P,D
|
||
PUSHJ P,PAD ;PRINT $<N>B WHERE <N> IS BPT. NUM.
|
||
CTYPE ";
|
||
CALL PCPNTI ;LIST THE JOB'S PENDING NONFATAL INTERRUPTS.
|
||
CALL TSPC
|
||
SOS D,PPC(U) ;MAKE RESTART PC -> BPT'ED LOCATION.
|
||
ANDI D,-1
|
||
CALL PCPNT0 ;PRINT ADDR OF NEXT INSN, AND NEXT INSN.
|
||
REST A
|
||
HLRZ D,(A)
|
||
JUMPE D,UBRK5
|
||
CALL LCT ;IF THIS BPT IS SET TO OPEN SOME LOC.,
|
||
HLRZ D,(A)
|
||
CALL UBRKNL ;TYPE THE ADDRESS AND OPEN IT.
|
||
UBRK5: REST C ;GET TIME STARTED TYPING.
|
||
MOVE A,UINTWD(U)
|
||
MOVEI B,1
|
||
LSH B,-1(A)
|
||
TDNN B,BPINFL(U) ;AUTO-PROC BPT? ($$P)
|
||
JRST LCTGNR
|
||
MOVE B,UPI0(U)
|
||
TRNE B,%PI1PR ;DON'T AUTO-PROCEED IF WERE ^N'ING.
|
||
JRST LCTGNR
|
||
PUSHJ P,UBRK6 ;SLEEP A WHILE, SEE IF USER TYPED ANYTHING.
|
||
JRST PROCDT
|
||
ANDCAM B,BPINFL(U) ;TURN OFF AUTO-PROC AND STOP.
|
||
JRST LCTGNR
|
||
|
||
UBRK6: MOVE D,DOZTIM ;# SECS TO SLEEP.
|
||
MOVNS C ;GET -<TIME STARTED PRINTING>
|
||
UBRK7: CALL LISTN ;TYPED ANYTHING YET?
|
||
CAIA
|
||
JRST POPJ1 ;YES, STOP SLEEPING.
|
||
SOJL D,CPOPJ ;WAITED LONG ENOUGH => GO ON.
|
||
MOVNI A,30.
|
||
ADDB A,C
|
||
.SLEEP A, ;WAIT 1 MORE SEC.
|
||
JRST UBRK7
|
||
|
||
UBRK3: skipn hakint ;Are there HAKKAH interrupts?
|
||
jrst ubrk3x
|
||
setom hakrq ;Be sure they're requested (%PICL1 can hang around)
|
||
setom haktyp ;Say it's OK to type them
|
||
ubrk3x: SETZM USCNT(U) ;LEAVE MULTI-STEP MODE.
|
||
.uset usri,[.rftl1,,d] ;get the fatal interrupts
|
||
move a,d ;remember for later
|
||
tdne d,[#%pic.z#%pidcl] ;are there any non-^Z-type first word ints?
|
||
jrst ubrkp ; yes, must print
|
||
.uset usri,[.rftl2,,d] ;get the fatal second word ints (no handler)
|
||
jumpn d,ubrkp ;if there are any second word ints, we need printout
|
||
tlnn a,(%pidcl) ;If this is just an ordinary ^_D
|
||
skipn c.zprt ; or a ^Z we want to print "[DDT]" for
|
||
caia ; don't print the instruction
|
||
jrst ubrkp ; no, so print the instruction
|
||
;it must have been one of ^_D or ^Z
|
||
move d,urandm(u) ;check for returning ^X
|
||
trne d,%urctx ;is it both waiting for a ^X
|
||
trnn a,%pic.z ; And stopped by a ^Z?
|
||
caia ; no, one or the other not true, so don't print
|
||
jrst ubrkp ; yes, print!
|
||
move d,%urctx ;no longer returning from ^X, if we were
|
||
andcam d,urandm(u) ;so clear the bit saying we were
|
||
xct rprmpt ;execute return prompt, in impure for ease of patching
|
||
jrst nltl4 ;so just prod and go along.
|
||
|
||
|
||
ubrkp: SAVE [LCTGNR] ;get ready to print it
|
||
PCPNT1: movei d,%urctx ;So clear the bit saying we were
|
||
andcam d,urandm(u) ;no longer returning from ^X, if we were
|
||
CALL RADDTC ;IF WANT TO DISPLAY RAID REGS AT SCREEN TOP, DO SO NOW.
|
||
MOVE D,UPI0(U)
|
||
TLNE D,%PJLOS
|
||
CALL LOS ;HANDLE A .LOSS INTERRUPT.
|
||
MOVE D,UPI0(U)
|
||
TRNN D,%PIMAR ;WAS THE MAR HIT?
|
||
JRST PCPNT6
|
||
7TYPE [ASCIZ/MAR; /]
|
||
.USET USRI,[.RMARPC,,D] ;TRY TO GET THE PC.
|
||
SAVE D
|
||
ANDI D,-1
|
||
CALL PCPNT7 ;TYPE ADDR AND INSN.
|
||
CALL PCPNU ;OPEN ITS ADDRESSED LOCATIONS.
|
||
REST D
|
||
CALL PCPNTM ;IF D INDICATES MAR DIDN'T ABORT INSN, TURN MAR BACK ON.
|
||
MOVNI A,3
|
||
TLNN D,(@)
|
||
MOVEM A,UINTWD(U) ;OTHERWISE, ARRANGE TO GO 1 INSN, THEN TURN ON MAR.
|
||
MOVE D,MARXCT(U)
|
||
MOVEM D,VALCOM ;IF DESIRED, EXECUTE THE STRING OF DDT CMDS
|
||
SKIPE D
|
||
CALL UBRKV ;ASSOCIATED WITH MAR.
|
||
CALL CRF
|
||
PCPNT6: MOVE D,UPI0(U)
|
||
TRNE D,%PIIOC ;IOC ERRORS GET SPECIAL TREATMENT
|
||
CALL [ 7TYPE [ASCIZ /IOCERROR: /]
|
||
SETZ C,
|
||
CALL LOSFIL
|
||
JRST KERR3]
|
||
MOVN C,UINTWD(U)
|
||
CAIN C,4
|
||
7TYPE [ASCIZ /DDTWRITE; /]
|
||
MOVE C,UPI0(U)
|
||
ANDCM C,[%PILOS+%PIMAR+%PIVAL+%PIBRK+%PI1PR+%PIC.Z+%PIIOC+%pidcl]
|
||
CALL INT0PRT
|
||
MOVE C,UPI1(U)
|
||
CALL INT1PRT
|
||
CALL PCPNTI ;PRINT THE PENDING NONFATAL INTERRUPTS, C NONZERO IF ARE ANY.
|
||
IOR C,UPI0(U)
|
||
ANDCM C,[%PILOS+%PIMAR+%PIVAL+%PIBRK+%PI1PR+%PIC.Z+%PIIOC+%pidcl]
|
||
IOR C,UPI1(U)
|
||
SKIPE C ;IF ANY INTERRUPT NAMES WERE JUST PRINTED ON THIS LINE,
|
||
CTYPE 40 ;FOLLOW THEM WITH SPACE.
|
||
MOVE A,PPC(U)
|
||
MOVE D,UPI0(U)
|
||
.USET USRI,[.ROPTIO,,B]
|
||
TLNE B,OPTOPC
|
||
ANDI D,%PIBRK\%PIVAL
|
||
TDNE D,IMSKS1 ;ANY RANDOM ERROR => BACK UP THE PC.
|
||
SOS A,PPC(U)
|
||
MOVEI D,(A)
|
||
PUSHJ P,PCPNT5
|
||
HRRM D,PPC(U)
|
||
JRST PCPNT0
|
||
|
||
PCPNTM: MOVE A,MARADR(U)
|
||
TLNE D,(@) ;UNLESS WE STOPPED BEFORE THE MARRING INSN,
|
||
.USET USRI,[.SMARA,,A] ;MAR WAS TURNED OFF WHEN HIT.
|
||
RET
|
||
|
||
;;; This symbol is stupid -- it's only used in the one place above.
|
||
IMSKS1: 2341,,23640 ;THESE WANT TO BACK UP THE PC.
|
||
|
||
|
||
;CALL HERE TO HANDLE A .LOSE INTERRUPT IN AN INFERIOR. THE .LOSE
|
||
;SUPPLIES AN 18-BIT LOSSAGE CODE WHICH IS DECODED HERE.
|
||
;THE CODES HAVE MEANINGS DEFINED ONLY BY THIS ROUTINE. THEY ARE:
|
||
; 0 NON-SPECIFIC ERROR. MESSAGE IS JUST "ERROR;".
|
||
; 1 - 37. SPECIFIES A 1ST-WORD INTERRUPT BIT (1 + # OF
|
||
; ZEROS ABOVE THE BIT). DDT PRETENDS THAT THE JOB GOT
|
||
; THAT INTERRUPT AND IT WAS FATAL. DDT IGNORES THE QUESTION
|
||
; OF WHETHER THE JOB HAS ACTUALLY ENABLED THAT BIT.
|
||
; 1000 DDT DESCRIBES THE LAST SYSTEM CALL OR OPEN ERROR
|
||
; THAT THE INFERIOR GOT.
|
||
; 1000+N SIMILAR, BUT N IS USED AS THE ERROR CODE INSTEAD OF
|
||
; THE ACTUAL ONE.
|
||
; 1400 DDT DESCRIBES THE LAST SYSTEM CALL ERROR, AND GIVES THE
|
||
; NAME OF THE FILE OPEN ON THE CHANNEL THAT ERROR WAS ON.
|
||
; IF THE PC POINTS AT AN OPEN, THE FILENAMES BEING OPENED
|
||
; ARE DESCRIBED.
|
||
; 1400+N SIMILAR, BUT USES N INSTEAD OF THE ACTUAL ERROR CODE.
|
||
|
||
LOS: .USET USRI,[.RVAL,,D]
|
||
HLRZ A,D ;LH OF .VAL LEFT IN A (ADDR OF "LOSING INSN")
|
||
ANDI D,-1 ;D NOW HAS THE .LOSE CODE.
|
||
JUMPE D,LOSRND ;HERE HANDLE .LOSE 0
|
||
CAILE D,36.
|
||
JRST LOS1
|
||
MOVSI A,400000 ;HERE HANDLE .LOSE 1 THRU .LOSE 36.
|
||
MOVNS D
|
||
LSH A,1(D)
|
||
IORM A,UPI0(U)
|
||
RET
|
||
|
||
LOSRND: 7TYPE [ASCIZ /ERROR; /]
|
||
RET
|
||
|
||
LOS1: CAIL D,2000 ;IS THIS A 1000 CODE?
|
||
JRST LOSRND ;NO OTHERS ARE DEFINED YET.
|
||
7TYPE [ASCIZ /ERROR: /]
|
||
trz d,1000
|
||
CALL LOSINS ;DECODE THE INSN THAT "LOST".
|
||
TDZA C,C ;C=0 IF INSN ISN'T A .CALL OPEN, RENAME OR DELETE
|
||
SETO C, ;C=1 IF IT IS. A HAS ADDR OF SIXBIT NAME OF CALL.
|
||
TRZE D,400 ;IF USER WANTS, PRINT NAMES OF FILE BEING HACKED.
|
||
CALL LOSFIL
|
||
JUMPE D,KERR3 ;0 => DESCRIBE THE JOB'S LAST ERROR CODE.
|
||
HRLZ A,D
|
||
JRST KERR2 ;ANY OTHER CODE GETS DESCRIBED AS A SYSTEM ERROR CODE.
|
||
|
||
;EXAMINE THE "INSTRUCTION THAT LOST". IF IT IS A SYMBOLIC CALL, PRINT THE
|
||
;NAME OF THE CALL. IF IT IS A SYMBOLIC OPEN, RENAME, OR DELETE,
|
||
;SKIP RETURN LEAVING A POINTING AT THE WORD HOLDING THE CALL'S NAME,
|
||
;WITH SIGN(A) SET IFF CALL IS "OPEN".
|
||
LOSINS: SAVE D
|
||
CALL FETCH ;REMEMBER A HAS LH(.VAL) = ADDR OF INSN THAT LOST.
|
||
JRST POPDJ
|
||
HLRZ A,D ;GET JUST OPCODE AND AC FIELD OF INSN
|
||
ANDCMI A,(@(17))
|
||
CAIE A,(.CALL) ;WE DON'T YET UNDERSTAND ANYTHING BUT A .CALL 0,
|
||
JRST POPDJ
|
||
CALL EASETU
|
||
CALL NEFECC ;COMPUTE E.A. OF THE .CALL IN I1.
|
||
MOVEI A,1(I1)
|
||
CALL FETCH ;READ THE WORD THAT SHOULD HAVE THE CALL NAME IN SIXBIT.
|
||
JRST POPDJ
|
||
LOSIN1: SAVE D
|
||
CALL SIXTYP ;PRINT THE CALL NAME.
|
||
7TYPE [ASCIZ /: /]
|
||
REST D
|
||
camn d,[sixbit /sopen/]
|
||
jrst losin2
|
||
CAME D,[SIXBIT/OPEN/] ;DOES THE CALL HAVE ITS FILENAMES INSIDE IT?
|
||
CAMN D,[SIXBIT /RENAME/]
|
||
AOS -1(P) ;IF SO, LOSINS SKIPS; ADDR OF CALL NAME STILL IN A.
|
||
CAMN D,[SIXBIT /DELETE/]
|
||
LOSIN2: AOS -1(P)
|
||
CAMN D,[SIXBIT /OPEN/]
|
||
HRLI A,400000
|
||
CAME D,[SIXBIT /CALL/] ;OR "CALL" SYSTEM CALL (LIKE AN XCT INSN), TRACE THRU
|
||
JRST POPDJ
|
||
LOSIN3: ADDI A,1
|
||
CALL FETCH ;FETCH ADDR OF 1ST ARG (THE ACTUAL NAME OF THE CALL).
|
||
JRST POPDJ
|
||
TLNE D,400000 ;GIVE UP IF ONLY 0 OR 1 INPUT ARGS. (IF 1 ARG,
|
||
JRST POPDJ ;MIGHT BE BETTER TO PRINT IT, BUT SMALL LOSS).
|
||
TLNE D,6000 ;SKIP OVER ALL EXCEPT INPUT ARGS TO FIND 1ST INPUT ARG
|
||
JRST LOSIN3 ;WE LOSFIL WON'T MISS THEM ANYWAY.
|
||
SAVE A
|
||
CALL NEFECC ;PERFORM ADDR CALCULATION
|
||
MOVEI A,(I1)
|
||
CALL FETCH ;FETCH THE VALUE OF THE ARG. LOOP AROUND, USING IT AS
|
||
JRST POPADJ ;THE "NAME OF THE CALL". A IS INCREMENTED BY 1
|
||
REST A ;SO THAT LOSFIL WILL SKIP OVER THE ARG WE GOBBLED.
|
||
JRST LOSIN1
|
||
|
||
;read sname in DEV, FN1, FN2 into NCTLTF, for channel in D
|
||
infnam: calblk RFNAME,[%climm,,usri ? d
|
||
%clout,,nctltf ? %clout,,nctltf+1 ? %clout,,nctltf+2
|
||
%clout,,nctltf+3 ? %clout,,d]
|
||
|
||
;read sname in DEV, FN1, FN2 into NCTLTF, for channel in A and job in D
|
||
infnm1: calblk RFNAME,[d ? a
|
||
%clout,,nctltf ? %clout,,nctltf+1 ? %clout,,nctltf+2
|
||
%clout,,nctltf+3 ? %clout,,d]
|
||
|
||
;CALL HERE TO DESCRIBE THE FILE BEING HACKED BY THE "LOSING INSTRUCTION",
|
||
;IF DESIRED. IF C IS NONZERO, THE INSTRUCTION ITSELF CONTAINS THE FILENAMES
|
||
;(IT IS A SYMBOLIC OPEN, RENAME OR DELETE). OTHERWISE, USE RFNAME TO GET THEM.
|
||
|
||
LOSFIL: SAVE D
|
||
JUMPN C,LOSFO
|
||
.USET USRI,[.RBCHN,,D] ;READ # OF LOSING CHANNEL
|
||
tscall infnam ;read inferior's channel's filename
|
||
move b,nctltf+3 ;get SNAME in B for LFILE0 (ugh)
|
||
LOSF3: MOVEI A,NCTLTF
|
||
CALL LFILE0 ;PRINT THOSE FILENAMES.
|
||
7TYPE [ASCIZ / - /]
|
||
JRST POPDJ
|
||
|
||
;COME HERE FOR OPEN, RENAME, AND DELETE, TO DECODE THE FILENAMES SPECIFIED
|
||
;BY THE SYSTEM CALL. RH(A) POINTS TO THE WORD HOLDING THE SIXBIT CALL NAME.
|
||
;SIGN(A) IS SET FOR OPEN ONLY.
|
||
LOSFO: MOVEI C,0 ;0 => 1ST ARG WE FIND IS THE DEV NAME.
|
||
TLZE A,400000 ;SIGN(A) => THIS IS AN OPEN, SO SKIP THE 1ST ARG
|
||
SUBI C,1
|
||
MOVSI D,400000 ;DEFAULT THE FILENAMES THE WAY SYSTEM DOES,
|
||
MOVEM D,NCTLTF ;IN CASE THE SYSTEM CALL DOESN'T SPECIFY THEM.
|
||
MOVEM D,NCTLTF+1
|
||
MOVEM D,NCTLTF+2
|
||
.USET USRI,[.RSNAM,,B]
|
||
LOSFL: ADDI A,1
|
||
CALL FETCH ;FETCH THE NEXT ARGUMENT.
|
||
JRST LOSF3
|
||
TLNE D,6000 ;IF IT'S NOT AN INPUT ARG, IGNORE IT.
|
||
JRST LOSF1
|
||
SAVE D
|
||
SAVE A
|
||
CALL NEFECC ;COMPUTE ITS EFFECTIVE ADDRESS.
|
||
TLNN D,1000 ;IF ARG IS DIRECT, FETCH WORD ADDRESSED.
|
||
JRST [ HRRZ A,I1
|
||
CALL FETCH
|
||
JRST POPADJ
|
||
JRST LOSF2]
|
||
HRRZ D,I1 ;IF IMMEDIATE, GET THE ADDRESS.
|
||
LOSF2: REST A
|
||
XCT LOSFT1(C) ;PROCESS THE ARG ACCORDING TO ITS SEQUENCE #.
|
||
REST D ;IF C=3, LOSFT1 JUMPS TO LOSF3 VIA LOSF4.
|
||
AOS C
|
||
LOSF1: TLNN D,400000 ;IF THIS WASN'T THE LAST ARG, PROCESS MORE ARGS,
|
||
JRST LOSFL
|
||
JRST LOSF3 ;NOW WE HAVE THE FILENAMES STACHED, SO PRINT THEM.
|
||
|
||
JFCL ;IGNORE 1ST ARG OF AN OPEN (CHANNEL #).
|
||
LOSFT1: MOVEM D,NCTLTF ;1ST ARG (2ND IN OPEN) IS DEVICE NAME
|
||
MOVEM D,NCTLTF+1 ;2ND ARG (3RD IN OPEN) IS FN1.
|
||
MOVEM D,NCTLTF+2 ;3RD ARG (4TH IN OPEN) IS FN2.
|
||
JRST LOSF4 ;4TH ARG (5TH IN OPEN) IS SNAME, AND IGNORE THE REST.
|
||
|
||
LOSF4: MOVE B,D ;SNAME GOES IN B FOR LFILE0.
|
||
REST D ;ADJUST STACK TO PROPER LEVEL FOR LOSF3
|
||
JRST LOSF3 ;GO PRINT NAMES. NO NEED TO DECODE REMAINING ARGS.
|
||
|
||
;D HAS ADDR OF NEXT INSN TO BE EXECUTED BY INFERIOR.
|
||
;PRINT THE PC AND INSN, AND, IF DESIRED, OPEN THE AC AND MEMORY
|
||
;LOCATION OF THAT INSTRUCTION. ALSO TYPE RAID REGS IN OUTPUT STREAM
|
||
;IF THAT IS ENABLED.
|
||
PCPNT0: CALL PCPNT7 ;FIRST, PRINT PC AND NEXT INSTRUCTION.
|
||
ANDCM D,[0 @-1(17)]
|
||
CAME D,[.CALL] ;DON'T OPEN ANY LOCATIONS FOR A .CALL, SO :CALPRT WINS.
|
||
CALL PCPNU ;OPEN THE LOCATIONS IT USES, IF DESIRED.
|
||
SKIPN RAIDFL ;NOW, IF RAID REG DISPLAY WANTED,
|
||
RET
|
||
SKIPE GETTY
|
||
SKIPN RADTOP ;AND CAN'T OR SHOULDN'T DO IT AT TOP OF SCREEN,
|
||
JRST RADDIS ;DO IT.
|
||
SKIPE SCROLL
|
||
JRST RADDIS
|
||
RET
|
||
|
||
PCPNTR: SETZ ? SIXBIT/RCPOS/ ? %CLIMM,,TYOC ? SETZM D
|
||
|
||
;D HAS ADDR OF INSN; PRINT THAT ADDR, AND THE INSN, WITH
|
||
;">", ">>", OR ")" BETWEEN THEM. SETS $Q.
|
||
PCPNT7: SAVE D
|
||
PUSHJ P,PADR ;TYPE ADDR OF NEXT INSN.
|
||
CALL PCPNT3 ;TYPE > OR >> OR ).
|
||
REST A
|
||
CALL RFETCH ;GET THE INSN.
|
||
JRST ERR
|
||
CALL LWTPUT ;SET $Q TO INSN.
|
||
SAVE D
|
||
CALL PIN ;TYPE OUT THE INSN.
|
||
JRST POPDJ
|
||
|
||
PCPNT3: MOVEI D,2
|
||
CAMN D,UPI0(U)
|
||
JRST PCPNT2
|
||
MOVEI D,">
|
||
SKIPL NBPTB(U)
|
||
PUSHJ P,TOUT
|
||
JRST TOUT
|
||
|
||
PCPNT2: MOVEI D,")
|
||
PUSHJ P,TOUT
|
||
JRST LCT
|
||
|
||
;CORRECT THE PC IN D IF IT WAS LEFT IN THE MIDDLE OF BREAKPOINT PROCEED.
|
||
PCPNT5: .USET USRI,[.R40ADDR,,A]
|
||
HLRZS A
|
||
SKIPE A
|
||
SUBI A,20
|
||
CAIE D,BPBLK(A)
|
||
RET
|
||
MOVEI A,BPBLK+1
|
||
CALL RFETCH
|
||
RET
|
||
MOVEI D,-1(D)
|
||
RET
|
||
|
||
;LIST ALL THE JOB'S PENDING NONFATAL INTERRUPTS.
|
||
PCPNTI: .USET USRI,[.RIFPI,,D]
|
||
.USET USRI,[.RPIRQ,,C]
|
||
SKIPN C
|
||
JUMPE D,CPOPJ
|
||
CTYPE "(
|
||
SAVE D
|
||
CALL INT0PRT
|
||
REST C
|
||
CALL INT1PRT
|
||
CTYPE ")
|
||
MOVEI C,1
|
||
RET
|
||
|
||
;IF PCPNTF IS NONZERO, AND THE JOB WASN'T STOPPED BY A ^Z,
|
||
;OPEN THE LOCATIONS (MEM AND AC, AS APPROPRIATE) REFERENCED BY THE INSN IN $Q.
|
||
PCPNU: MOVEI D,2
|
||
SKIPE PCPNTF ;THEN, IF FEATURE IS ENABLED, AND JOB STOPPAGE
|
||
TDNE D,UPI0(U) ;IS NOT DUE TO A ^Z,
|
||
RET
|
||
CALL LCT ;GO AHEAD AND OPEN AC AND MEMORY LOCATION.
|
||
SAVE LWT ;REMEMBER THE INSN SO CAN FIND THE EFF. ADDR.
|
||
LDB A,[331100,,LWT] ;NOW GET THE OPCODE
|
||
IDIVI A,PCPNTP ;USE IT TO INDEX INTO PCPNTB, A VECTOR OF BYTES.
|
||
MOVE A,PCPNTB(A)
|
||
IMULI B,PCPNTS
|
||
LSH A,(B) ;SELECT APPROPRIATE BYTE OF TABLE.
|
||
LSH A,PCPNTS-36.
|
||
SAVE A ;REMEMBER IT TILL WHEN WE HACK THE EFF. ADDR.
|
||
LDB A,[331100,,LWT]
|
||
TRCE A,700
|
||
TRNN A,700
|
||
TRCA A,700 ;IS THIS INSN A UUO OR IO INSN?
|
||
JRST PCPNU1 ;NO.
|
||
CALL SQZ3D ;YES, CONVERT THE OPCODE TO SQUOZE
|
||
ADD D,[SQUOZE 0,..U] ;NOW WE HAVE ..Unnn
|
||
CALL SEVLD ;IF THAT SYM IS DEFINED,
|
||
JRST PCPNU1
|
||
ANDI D,1_PCPNTS-1 ;USE THE DEFINITION AS THE CODE FOR WHAT TO DO
|
||
MOVEM D,(P) ;INSTEAD OF WHAT WE GOT OUT OF PCPNTB.
|
||
PCPNU1: MOVE A,(P)
|
||
LDB D,[270400,,LWT]
|
||
SKIPN D ;IS THE AC FIELD 0?
|
||
ANDCMI A,2 ;THE 2 BIT OF PCPNTB SAYS OPEN AC UNLESS AC # IS 0.
|
||
TRNE A,3 ;THE 1 BIT SAYS OPEN AC IN ANY CASE.
|
||
CALL UBRKNL ;OPEN THE AC IF DESIRED
|
||
REST A
|
||
REST D
|
||
save a
|
||
save d
|
||
trne a,40 ;40 bit says open (ac)
|
||
jrst [ldb a,[270400,,lwt]
|
||
call fetchf ;get the contents of d
|
||
erloss ; can't happen!
|
||
hrrzi d,(d) ;only RH is address
|
||
call ubrknl ;print the stack location
|
||
jrst .+1]
|
||
rest d
|
||
rest a
|
||
TRNN A,4 ;4 BIT OF PCPNTB BYTE SAYS OPEN THE MEMORY LOCATION.
|
||
TLNE D,(0 @(17)) ;OTHERWISE, IF INDEXED OR INDIRECT, PRINT E.A.
|
||
CAIA ;SO IN EITHER CASE, MUST FIRST COMPUTE THE E.A.
|
||
RET
|
||
SAVE A
|
||
CALL EASETU ;BEFORE THAT, GET JOB'S ACS SO WE CAN FIND EFF. ADDR.
|
||
CALL NEFECC ;COMPUTE THE E.A. IN I1.
|
||
EXCH D,I1
|
||
REST A
|
||
TRNE A,4
|
||
JRST UBRKNL ;INSN REFERENCES MEMORY, SO OPEN THE E.A.
|
||
7TYPE [ASCIZ/E.A. _ /]
|
||
CALL LWTPUT ;SET $Q.
|
||
JRST PADR
|
||
|
||
;TABLE SAYING WHAT TO DO ABOUT EACH INSN VIS-A-VIS OPENING ITS AC
|
||
;AND MEMORY ADDRESS. EACH OP CODE HAS A 4-BIT BYTE.
|
||
;1 BIT => OPEN THE AC.
|
||
;2 BIT => OPEN THE AC UNLESS THE AC FIELD IS 0.
|
||
;4 BIT => OPEN THE MEMORY LOCATION.
|
||
;10 BIT => ADDRESS FIELD IS R.H. BITS, WHEN IN BIT TYPEOUT MODE.
|
||
;20 BIT => ADDRESS FIELD IS L.H. BITS.
|
||
;40 bit => Stack instruction, open the stack location
|
||
|
||
;HANDLE AN INSTRUCTION LIKE "AND" WHICH HAS DIRECT, IMMED., MEMORY AND BOTH.
|
||
DEFINE AIMB BITS
|
||
5 ? 1+BITS ? 5 ? 5
|
||
TERMIN
|
||
|
||
PCPNTS==6 ;6-BIT BYTES.
|
||
PCPNTP==36./PCPNTS ;6 PER WORD.
|
||
|
||
PCPNTB: .BYTE PCPNTS
|
||
REPEAT 40,5 ;USER UUOS: OPEN BOTH.
|
||
4 ;.IOT - OPEN MEMORY ONLY.
|
||
4 ;.OPEN - MEM ONLY.
|
||
1 ;.OPER'S - AC ONLY.
|
||
4 ;.CALL'S - MEM ONLY.
|
||
4 ;.USET - MEM ONLY.
|
||
4 ;.BREAK - MEM ONLY.
|
||
4 ;.STATUS - MEM ONLY.
|
||
4 ;.ACCESS - MEM ONLY.
|
||
REPEAT 30,5 ;USER UUO'S MEDIATED BY SYSTEM: 50 THROUGH 77.
|
||
5 ;100
|
||
5 ;101
|
||
4 ;102 LPM
|
||
4 ;103 XCTR
|
||
REPEAT 24,5 ;104-127 UNUSED.
|
||
5 ;UFA 130
|
||
5 ;DFN
|
||
1 ;FSC
|
||
4 ;IBP
|
||
5 ;ILDB
|
||
5 ;LDB
|
||
5 ;IDPB
|
||
5 ;DPB 137
|
||
REPEAT 40,5 ;FLOATING POINT 140-177
|
||
REPEAT 4,[ ;REPET OVER MOVE, MOVS, MOVN, MOVM 200-217
|
||
5 ;TO AC.
|
||
1+IFE .RPCNT,[10]+IFE .RPCNT-1,[20]
|
||
;IMMEDIATE; HANDLE MOVEI AND MOVSI SPECIALLY.
|
||
5 ;TO MEMORY.
|
||
6 ;TO SELF.
|
||
]
|
||
REPEAT 4,[ ;REPEAT OVER IMUL, MUL, IDIV, DIV 220-237
|
||
AIMB 0 ;TO AC, IMMED, TO MEM, TO BOTH.
|
||
]
|
||
REPEAT 10,1 ;SHIFTS, AND JFFO 240-247
|
||
5 ;EXCH 250
|
||
1 ;BLT
|
||
1 ;AOBJP
|
||
1 ;AOBJN
|
||
0 ;JRST
|
||
0 ;JFCL
|
||
4 ;XCT
|
||
5 ;UNUSED
|
||
0 ;PUSHJ 260
|
||
4 ;PUSH
|
||
44 ;POP
|
||
40 ;POPJ
|
||
0 ;JSR
|
||
1 ;JSP
|
||
1 ;JSA
|
||
1 ;JRA
|
||
AIMB 0 ;ADD ;270
|
||
AIMB 0 ;SUB
|
||
REPEAT 10,11 ;CAI... 300-307
|
||
REPEAT 10,5 ;CAM... 310-317
|
||
REPEAT 3,[ ;REPEAT OVER JUMP,SKIP; AOJ,AOS; SOJ,SOS. 320-377
|
||
REPEAT 10,1 ;JUMP, AOJ, SOJ.
|
||
REPEAT 10,6 ;SKIP, AOS, SOS.
|
||
]
|
||
1 ;SETZ 400
|
||
1 ;SETZI
|
||
4 ;SETZM
|
||
5 ;SETZB
|
||
AIMB 10 ;AND 404
|
||
AIMB 10 ;ANDCA 410
|
||
AIMB 10 ;SETM 414
|
||
AIMB 10 ;ANDCM 420
|
||
1 ;SETA 424
|
||
1 ;SETAI
|
||
5 ;SETAM
|
||
5 ;SETAB
|
||
AIMB 10 ;XOR 430
|
||
AIMB 10 ;OR 434
|
||
AIMB 10 ;ANDCB 440
|
||
AIMB 10 ;EQV 444
|
||
1 ;SETCA 450
|
||
1 ;SETCAI
|
||
5 ;SETCAM
|
||
5 ;SETCAB
|
||
AIMB ;ORCA 454
|
||
5 ;SETCM 460
|
||
11 ;SETCMI
|
||
4 ;SETCMM
|
||
5 ;SETCMB
|
||
AIMB 10 ;ORCM 464
|
||
AIMB 10 ;ORCB 470
|
||
1 ;SETO 474
|
||
1 ;SETOI
|
||
4 ;SETOM
|
||
5 ;SETOB
|
||
REPEAT 10,[ ;REPEAT OVER HLL, HRL, HLLZ, ..., HRLE. 500-537
|
||
5 ;TO AC.
|
||
1+IFN .RPCNT&1,20
|
||
;IMMEDIATE.
|
||
5 ;TO MEM.
|
||
6 ;TO SELF.
|
||
]
|
||
REPEAT 10,[ ;REPEAT OVER HRR, HLR, HRRZ, ..., HLRE. 540-577
|
||
5 ;TO AC.
|
||
1+IFE .RPCNT&1,10
|
||
;IMMEDIATE.
|
||
5 ;TO MEM.
|
||
6 ;TO SELF.
|
||
]
|
||
REPEAT 4,[ ;REPEAT OVER TRN, TRZ, TRC, TRO. 600-677.
|
||
REPEAT 10,11+IFN .RPCNT&1,10 ;THE TR AND TL VARIANTS.
|
||
REPEAT 10,5 ;THE TD AND TS VARIANTS.
|
||
]
|
||
;---WRONG FOR KS, BUT WHO CARES
|
||
REPEAT 100,4 ;I-O INSTRUCTIONS HAVE NO AC FIELD.
|
||
|
||
IFN .BYTC-1000,.ERR WRONG LENGTH TABLE.
|
||
|
||
.BYTE
|
||
|
||
KINTPR: SAVE [LCTGNR]
|
||
MOVE C,LWT ;:INTPRT - INTERPRET $Q AS 2ND INT. BITS.
|
||
TLNN C,400000
|
||
INT0PR: SKIPA W2,[INT0PE(D)]
|
||
INT1PR: MOVE W2,[INT1PE(D)]
|
||
INT1P0: JFFO C,INT1P1
|
||
RET
|
||
|
||
INT1P1: MOVSI W1,400000
|
||
MOVNI D,(D)
|
||
LSH W1,(D)
|
||
ANDCM C,W1
|
||
MOVE D,@W2
|
||
SAVE C
|
||
CALL SIXTYP
|
||
REST C
|
||
CTYPE ";
|
||
JRST INT1P0
|
||
|
||
;TABLE OF NAMES OF 1ST-WORD INTS.
|
||
INT0PT: SIXBIT /TYPEIN/
|
||
SIXBIT /^Z/
|
||
SIXBIT /BADPI/
|
||
SIXBIT /AROV/
|
||
SIXBIT /DPY/
|
||
SIXBIT /ILOPR/
|
||
SIXBIT /SYSDED/
|
||
SIXBIT /.VALUE/
|
||
SIXBIT /IOC/
|
||
SIXBIT /ILUAD/
|
||
SIXBIT /.BREAK/
|
||
SIXBIT /1PROC/
|
||
SIXBIT /SCLOCK/
|
||
SIXBIT /MPV/
|
||
SIXBIT /MAR/
|
||
SIXBIT /LTPEN/
|
||
SIXBIT /PDLOV/
|
||
SIXBIT /CLI/
|
||
SIXBIT /ERROR/
|
||
SIXBIT /SYSDBG/
|
||
SIXBIT /<3.3>/
|
||
SIXBIT /<3.4>/
|
||
SIXBIT /<3.5>/
|
||
SIXBIT /SYSUUO/
|
||
SIXBIT /PURINS/
|
||
SIXBIT /PURPG/
|
||
SIXBIT /ARFOV/
|
||
SIXBIT /PARERR/
|
||
SIXBIT /DTTY/
|
||
SIXBIT /ATTY/
|
||
SIXBIT /^_D/
|
||
SIXBIT /JBSTAT/
|
||
SIXBIT /NXIO/
|
||
SIXBIT /RUNTIM/
|
||
SIXBIT /REALTM/
|
||
INT0PE: SIXBIT /.VAL 0/
|
||
|
||
;TABLE OF NAMES OF 2ND-WORD INTS.
|
||
INT1PT: SIXBIT /IOCH0/
|
||
SIXBIT /IOCH1/
|
||
SIXBIT /IOCH2/
|
||
SIXBIT /IOCH3/
|
||
SIXBIT /IOCH4/
|
||
SIXBIT /IOCH5/
|
||
SIXBIT /IOCH6/
|
||
SIXBIT /IOCH7/
|
||
SIXBIT /IOCH10/
|
||
SIXBIT /IOCH11/
|
||
SIXBIT /IOCH12/
|
||
SIXBIT /IOCH13/
|
||
SIXBIT /IOCH14/
|
||
SIXBIT /IOCH15/
|
||
SIXBIT /IOCH16/
|
||
SIXBIT /IOCH17/
|
||
SIXBIT /<2.8>/
|
||
SIXBIT /<2.9>/
|
||
SIXBIT /INF0/
|
||
SIXBIT /INF1/
|
||
SIXBIT /INF2/
|
||
SIXBIT /INF3/
|
||
SIXBIT /INF4/
|
||
SIXBIT /INF5/
|
||
SIXBIT /INF6/
|
||
SIXBIT /INF7/
|
||
SIXBIT /<3.9>/
|
||
SIXBIT /<4.1>/
|
||
SIXBIT /<4.2>/
|
||
SIXBIT /<4.3>/
|
||
SIXBIT /<4.4>/
|
||
SIXBIT /<4.5>/
|
||
SIXBIT /<4.6>/
|
||
SIXBIT /<4.7>/
|
||
SIXBIT /<4.8>/
|
||
INT1PE: SIXBIT /<4.9>/
|
||
|
||
;COME HERE ON RETURNING JOB THAT HIT TEMP. BPT.
|
||
UBRKT: SETZM BTADR(U) ;GET RID OF TEMP BPTS WHEN HIT.
|
||
SOS PPC(U) ;POINT PC TO THE BPT'D INSN, NOT AFTER IT.
|
||
|
||
;COME HERE ON RETURN FROM 1-PROCEED.
|
||
UBRKS: MOVE I1,USTYPE(U)
|
||
UBRKS9: SETZM UPI0(U) ;DON'T SOS THE PC FOR 0^^.
|
||
SETZM UPI1(U)
|
||
HRRZ A,PPC(U) ;GET ADDR OF NEXT INSN TO DO,
|
||
TLNN I1,USTYP2 ;IF USER DID ^N, NOT ^^, DON'T CHECK FOR SETAI.
|
||
PUSHJ P,NACN2 ;GET IT, HANDLE XCT'S, PUT LH IN RH OF C, OPCODE IN B.
|
||
JRST UBRK3 ;CAN'T FETCH THE INSN.
|
||
TRZ C,37
|
||
CAIN C,(SETAI) ;SETAI INSN SAYS USE BPTS FOR A WHILE.
|
||
JRST UBRKS8
|
||
SKIPN USCNT(U)
|
||
JRST UBRK3 ;NO MORE STEPPING TO DO, JUST RETURN.
|
||
SKIPLE USCNT(U)
|
||
SOS USCNT(U) ;DECREMENT THE STEP COUNT UNLESS INDEFINITE.
|
||
CAIN C,(.VALUE)
|
||
TLO I1,USTYP0 ;SHOULD ALWAYS USE TEMP BPTS OVER .VALUE.
|
||
CAIE B,(PUSHJ)
|
||
CAIN B,(JSR)
|
||
JRST UBRKSC ;CHECK FOR SUBROUTINE CALLS.
|
||
CAIE B,(JSP)
|
||
CAIN B,(JSA)
|
||
JRST UBRKSC
|
||
CAIL B,4^4 ;CHECK FOR MONITOR CALLS.
|
||
CAIL B,5^4
|
||
CAIA
|
||
JRST [TLNN I1,USTYP1 ;UNLESS JUST STARTING TO STEP,
|
||
TRNN I1,USTYPM ;STOP ON MONITOR CALLS IF M FLAG.
|
||
JRST UBRKS1
|
||
JRST UBRK3]
|
||
CAIE B,(POPJ)
|
||
CAIN B,(JRA)
|
||
JRST [TLNN I1,USTYP1 ;UNLESS JUST STARTING TO STEP,
|
||
TRNN I1,USTYPR ;R FLAG => STOP BEFORE RETURNS.
|
||
JRST UBRKS1
|
||
JRST UBRK3]
|
||
TLNN I1,USTYP1
|
||
TRNN I1,USTYPJ ;IF SHOULD STOP BEFORE JUMPS,
|
||
JRST UBRKS0
|
||
CAIN B,(JFFO) ;CHECK FOR JUMPS.
|
||
JRST UBRK3
|
||
CAIG B,(SOJG) ;ELIMINATE MOST OF THE NON-JUMPS.
|
||
CAIGE B,(AOBJP)
|
||
JRST UBRKS0
|
||
CAIN C,(JFCL) ;NO-OP ISN'T A JUMP.
|
||
JRST UBRKS1
|
||
CAILE B,(JFCL)
|
||
CAIL B,(JUMPL)
|
||
CAILE B,(JUMPG)
|
||
CAIL B,(AOJL)
|
||
CAILE B,(AOJG)
|
||
CAIL B,(SOJL)
|
||
JRST UBRK3 ;A JUMP.
|
||
JRST UBRKS1 ;NOT A JUMP.
|
||
|
||
UBRKSC: TRNE I1,USTYPB ;MAYBE BPT SUBR CALLS.
|
||
TLO I1,USTYP0
|
||
TLNN I1,USTYP1 ;UNLESS THIS WILL BE 1ST STEP,
|
||
TRNN I1,USTYPC ;MAYBE STOP BEFORE THEM.
|
||
JRST UBRKS1
|
||
JRST UBRK3
|
||
|
||
UBRKS0: CAIL B,1^5 ;CHECK FOR UUOS.
|
||
JRST UBRKS1
|
||
TRNE I1,USTYPV ;MAYBE SHOULD BPT THEM,
|
||
TLO I1,USTYP0
|
||
TRNE I1,USTYPU ;MAYBE SHOULD TREAT THEM AS SUBR CALLS.
|
||
JRST UBRKSC
|
||
TLNE I1,USTYP1 ;UNLESS ABOUT TO DO 1ST STEP,
|
||
JRST UBRKS2
|
||
TRNE I1,USTYPW ;MAYBE SHOULD STOP ON THEM.
|
||
JRST UBRK3
|
||
UBRKS1: TRNE I1,USTYPP ;IF NOT PRINTING
|
||
TLNE I1,USTYP1 ;OR JUST STARTING TO STEP,
|
||
JRST UBRKS2 ;JUST GO PROCEED.
|
||
SKIPE DOZTIM ;IF SHOULD DOZE, GET TIME STARTED TO PRINT.
|
||
.RDTIME C,
|
||
PUSH P,I1
|
||
PUSH P,C
|
||
PUSHJ P,PCPNT1 ;DISPLAY RAID REGS, PRINT ADDR AND >> AND NEXT INSN.
|
||
POP P,C
|
||
POP P,I1
|
||
CALL UBRK6 ;WAIT A WHILE, SKIP IF CHAR TYPED IN.
|
||
JRST UBRKS2
|
||
SETZM USCNT(U)
|
||
JRST LCTGNR ;STOP STEPPING.
|
||
|
||
UBRKS2: SETZB A,ARG1+1 ;MAKE SURE GO ONLY 1 STEP.
|
||
JUMPL I1,NACN ;UBRKS SET 4^5 TO SAY USE BPTS.
|
||
MOVSI D,USTYP2 ;TURN THIS BIT OFF TO DISTINGUISH FROM ^N
|
||
ANDCAM D,USTYPE(U) ;TO MAKE SURE SETAI INSN HANDLED ON RETURN.
|
||
JRST NCTLN1 ;OTHERWISE NORMAL 1-PROC.
|
||
|
||
;MULTI-STEPPING THRU SETAI INSN
|
||
UBRKS8: CALL NEFECC ;CALC. EFFEC. ADDR OF INSN.
|
||
MOVEI A,(D)
|
||
CALL RFETCH ;READ WD INSN POINTS TO.
|
||
JRST UBRK3
|
||
JRST NACN1 ;PROCEED TO THAT ADDR INVISIBLY.
|
||
|
||
;<LETTERS>$^^ OR <ARG> <LETTERS>$^^
|
||
;SET STEPPING-TYPE FROM LETTERS AND START STEPPING.
|
||
NACUPA: MOVE I1,USTYPE(U)
|
||
PUSHJ P,NACUP0 ;HANDLE THE LETTERS, CHANGING I1.
|
||
HRRZM I1,USTYPE(U)
|
||
|
||
;^^ - BEGIN MULTI-STEPPING.
|
||
NCUPA: SKIPN UINTWD(U)
|
||
JRST NRERR ;CAN'T START STEPPING RUNNING PROGRAM.
|
||
MOVE I1,USTYPE(U)
|
||
TLO I1,USTYP1 ;DON'T PRINT 1ST INSN TO BE DONE.
|
||
TLZ I1,USTYP2 ;DO HANDLE SETAI.
|
||
SETOM USCNT(U) ;ASSUME NO ARG,INDEFINITE STEPPING.
|
||
MOVE A,ARG1
|
||
SKIPE ARG1+1 ;IF ARG, IT IS # TIMES TO STEP.
|
||
NCUPA1: MOVEM A,USCNT(U)
|
||
SKIPE USCNT(U) ;IF WILL PRINT AN INSN BEFORE ANY STEPPING,
|
||
TLNN I1,USTYP1
|
||
PUSHJ P,CRF ;PRINT IT ON NEXT LINE.
|
||
JRST UBRKS9 ;PRETEND JUST DID A STEP, GO DO ANOTHER.
|
||
|
||
;<LETTERS>$$^^ - CHANGE NEW-JOB-DEFAULT STEPPING TYPE.
|
||
;<LETTERS>$$0^^ - SET THIS JOB'S DEFAULT TO CHANGED NEW-JOB-DEFAULT.
|
||
N2ACUP: TLNE B,O.IFX
|
||
PUSHJ P,QIJERR ;$$0^^ NEEDS JOB.
|
||
MOVE I1,MSTYPE ;GET THE NEW-JOB-DEFAULT.
|
||
PUSHJ P,NACUP0 ;CHANGE ACC. TO LETTERS.
|
||
MOVE D,(W4) ;GET THE $$^^ OPERATOR'S BITS BACK.
|
||
TLNE D,O.IFX ;$$0^^ - SET THIS JOB'S DEFAULT.
|
||
HRRZM I1,USTYPE(U)
|
||
TLNN D,O.IFX ;$$^^ - SET THE NEW-JOB-DEFAULT.
|
||
HRRZM I1,MSTYPE
|
||
JRST LCTGNR
|
||
|
||
;ROUTINE TO HANDLE LETTERS (AS SIXBIT IN C)
|
||
;AND UPDATE THE STEPPING-TYPE BITS IN RH OF I1.
|
||
NACUP0: MOVE B,[440600,,C]
|
||
NACUP1: SETZ D, ;IF BP INCR'S INTO D, ILDB WILL FETCH 0.
|
||
ILDB D,B ;GET NEXT LETTER.
|
||
JUMPE D,CPOPJ ;DONE WHEN FINISH ALL LETTERS.
|
||
MOVSI A,1-NACUPL ;AOBJN -> TABLE
|
||
NACUP2: CAME D,NACUPT(A) ;SEARCH FOR THIS LETTER.
|
||
AOBJN A,[AOBJN A,NACUP2]
|
||
JUMPGE A,NACUP1 ;LETTER NOT FOUND, IGNORE IT.
|
||
TDZ I1,NACUPT+1(A)
|
||
TSO I1,NACUPT+1(A)
|
||
JRST NACUP1 ;GET NEXT LETTER.
|
||
|
||
|
||
IRPC X,,BCJMPRUVWY
|
||
USTYP!X==1_.IRPCN
|
||
TERMIN ;DEFINE RH. FLAGS.
|
||
|
||
USTYP0==4^5 ;TELLS UBRKS2 TO USE TEMP BPTS RATHER THAN 1-PROC.
|
||
USTYP1==2^5 ;SET AT UBRKS9 SAYS THIS IS 1ST STEP, DON'T STOP BEFORE INSN.
|
||
USTYP2==1^5 ;WHEN 1-PROC'ING, SET IF DUE TO ^N, CLEAR IF ^^.
|
||
|
||
|
||
NACUPT: ;LETTER ? BITS TO SET,,BITS TO CLEAR
|
||
'B ? USTYPB,,USTYPC ;USE BPTS OVER SUBR CALLS.
|
||
'C ? USTYPC,,USTYPB ;STOP BEFORE SUBR CALLS.
|
||
'D ? USTYPB+USTYPC ;STEP THRU SUBR CALLS.
|
||
'J ? USTYPJ,, ;STOP BEFORE ALL JUMPS.
|
||
'K ? USTYPJ ;DON'T.
|
||
'M ? USTYPM,, ;STOP BEFORE SYSTEM CALLS.
|
||
'N ? USTYPM ;STEP THRU SYSTEM CALLS.
|
||
'P ? USTYPP,, ;PRINT EACH INSN.
|
||
'Q ? USTYPP ;PRINT ONLY INSN STOP BEFORE.
|
||
'R ? USTYPR,, ;STOP BEFORE SUBROUTINE RETURNS.
|
||
'S ? USTYPR ;STEP SUBR RETURNS.
|
||
'U ? USTYPU,,USTYPV+USTYPW ;TREAT UUOS AS SUBR CALLS.
|
||
'V ? USTYPV,,USTYPU+USTYPW ;USE BPTS OVER UUOS.
|
||
'W ? USTYPW,,USTYPU+USTYPV ;STOP BEFORE UUOS.
|
||
'X ? USTYPU+USTYPV+USTYPW ;STEP THRU UUOS (INTO UUOH)
|
||
'Y ? USTYPY,, ;ENTER "CARE" MODE,
|
||
'Z ? USTYPY ;LEAVE IT.
|
||
NACUPL==.-NACUPT
|
||
|
||
;$^N - PROCEED WITH TEMP. BPTS AFTER NEXT INSN.
|
||
NACN: CALL NACNA ;A _ PLACE TO PUT 1ST TEMP. BPT.
|
||
JRST [ HRROM A,BTADR(U)
|
||
JRST NACN3]
|
||
NACN1: HRROM A,BTADR(U)
|
||
HRRZ A,PPC(U) ;PUT -1 IN LH TO ASSUME NO PDL TO CHECK.
|
||
SKIPN ARG1+1 ;NO PDL CHECK IF PREFIX ARG GIVEN.
|
||
PUSHJ P,NACN2 ;GET WHAT WILL BE NEXT INSN.
|
||
JRST PROCDC ;CAN'T GET IT, DON'T BOTHER WITH PDL STUFF.
|
||
LDB A,[270400,,D]
|
||
CAIE B,(PUSHJ)
|
||
JRST NACN3 ;NOT PUSHJ, ORDINARY.
|
||
HRLM A,BTADR(U) ;REMEMBER ADDR OF PDL PTR,
|
||
PUSHJ P,RFETCH
|
||
ERLOSS
|
||
HRRZM D,BTPDL(U) ;REMEMBER WHAT IT NOW PTS TO.
|
||
NACN3: MOVE B,(W4)
|
||
TLNE B,O.IFX ;IF WE DIDN'T HAVE AN INFIX ARGUMENT,
|
||
JRST PROCDC
|
||
HRRZ A,BTADR(U) ;LOOK FORWARD FROM INSN BEING STEPPED OVER
|
||
NACN4: CALL RFETCH ;FOR FIRST REASONABLE INSTRUCTION
|
||
JRST PROCDC
|
||
TLCE D,777000 ;("REASONABLE" MEANS OPCODE > 0 AND < 774)
|
||
TLNN D,774000
|
||
AOJA A,NACN4
|
||
HRRM A,BTADR(U) ;THAT'S THE PLACE TO PUT THE TEMP. BPT.
|
||
JRST PROCDC ;(NOTE THIS DOESN'T HAPPEN IF THERE'S A PREFIX ARG).
|
||
|
||
NACN2: PUSHJ P,RFETCH ;ASSUME A HAS ADDR OF INSN, FETCH IT.
|
||
POPJ P, ;FAIL IF CAN'T FETCH.
|
||
HLRZ C,D ;PUT LH OF INSN IN C.
|
||
MOVEI B,(C)
|
||
ANDI B,777000 ;IN B'S RH, PUT JUST THE OP-CODE.
|
||
CAIE B,(XCT) ;REPLACE XCT'S BY XCT'D INSNS.
|
||
JRST POPJ1
|
||
PUSHJ P,EASETU ;GET ACS FOR EFFECTIVE ADDR CALC.
|
||
PUSH P,I1
|
||
PUSHJ P,NEFECC ;GET ADDR OF XCT'D INSN,
|
||
MOVEI A,(I1) ;USE IT AS ADDR OF INSN,
|
||
POP P,I1
|
||
JRST NACN2 ;TRY AGAIN.
|
||
|
||
;COMPUTE PLACE TO STOP AT, FOR $^N AND $$^N COMMANDS.
|
||
;NO SKIP => DON'T DO SPECIAL PUSHJ STACK-LEVEL COMPARISON.
|
||
NACNA: call qrerr ;Get unhappy if the job is already running
|
||
MOVE D,UINTWD(U)
|
||
CAIN D,21 ;GET UNHAPPY IF JOB HASN'T BEEN RUN.
|
||
JRST NSERR
|
||
HRRZ D,PPC(U) ;DEFAULT IS $.+1
|
||
MOVEI D,1(D)
|
||
SKIPE ARG1+1 ;BUT PREFIX ARG OVERRIDES THAT.
|
||
MOVE D,ARG1
|
||
TDNN D,[#<0 17,>] ;IF NOTHING BUT AC FIELD,
|
||
LSH D,-5 ;MOVE IT TO IDX FIELD (IT IS PDL PTR)
|
||
TLNN D,(@(17)) ;IF INDEXED OR INDIRECT,
|
||
JRST [ AOS (P)
|
||
JRST NACNA1]
|
||
SAVE A
|
||
CALL EASETU ;(GET ACS FROM JOB, FOR NEFECC)
|
||
SAVE I1
|
||
CALL NEFECC ;COMPUTE EFFECTIVE ADDR, IN I1.
|
||
MOVEI A,(I1)
|
||
CALL RFETCH ;AND USE CONTENTS OF WD POINTED TO
|
||
JRST ERR
|
||
REST I1 ;AS THE ADDR OF PLACE TO STOP.
|
||
REST A ;((P)$^N GOES TILL AFTER NEXT POPJ)
|
||
NACNA1: ADD A,D
|
||
RET
|
||
|
||
;$$^N.
|
||
N2ACN: CALL NACNA
|
||
JFCL
|
||
SETZM INCNT(U)
|
||
AOS INCNT(U) ;MAKE SURE >0 SO WILL 1-PROC.
|
||
MOVEM A,OIPCHK(U) ;GO TILL GET THERE OR 1 AFTER.
|
||
JRST PROCDC
|
||
|
||
naco: jumpg d,opfls ;if we were given an arg, barf
|
||
skipn linkp ;do we want this command?
|
||
7NRTYP [ASCIZ/ OP? /]
|
||
call warn
|
||
7type [asciz / (Link File)/]
|
||
call gsot
|
||
skipl linkp ;does he want it to be LINKNF instead of LINKN?
|
||
jrst linkn0 ; yes
|
||
jrst linkf ; no
|
||
|
||
|
||
NCTLP: SETZM TW2FL ;^P
|
||
JRST NCTLP1
|
||
|
||
NACP: MOVEI A,1
|
||
MOVEM A,TW2FL ;$^P ;TW2FL DISTINGUISHES $^P FROM ^P.
|
||
JRST NCTLP1
|
||
|
||
N2ACP: SETOM TW2FL ;$$^P - RUN WITHOUT TTY, BUT ALLOWED TO TYPE OUT.
|
||
JRST NCTLP1
|
||
|
||
KCONTI:
|
||
NALTP: TLZA F,FLLT ;$P, $$P
|
||
NCTLP1: TLO F,FLLT ;$^P MERGES IN HERE.
|
||
CALL QIJERR ;FOR :CONTIN & :PROCEED, CHECK FOR INFERIOR (ALREADY DONE FOR $P & ^P).
|
||
SKIPN A,UINTWD(U) ;STOP JOB SO WON'T INT. AFTER WE CHECK.
|
||
.USET USRI,[.SUSTP,,[-1]]
|
||
SKIPE UINT(U)
|
||
JRST NALTP3 ;IF IT INTERRUPTED, LET IT RETURN.
|
||
NALTP2: SOS A
|
||
PUSHJ P,BUTOP1
|
||
PUSHJ P,GARGD1
|
||
JRST PROCDN
|
||
|
||
NALTP4: TLZ F,FLLT ;DUMMIED UP $P; IF REALLY PROCEED, MUST TELL USER.
|
||
NALTP3: SKIPN UPI1(U) ;JOB INTERRUPTED: IF IT WAS JUST TRYING TO USE TTY,
|
||
TLNE F,FLLT ;AND THIS IS $P, NOT ^P,
|
||
JRST UBRK0
|
||
MOVE D,UPI0(U)
|
||
TDNE D,[#%PITTY#%PIVAL]
|
||
JRST UBRK0 ;THEN SIMPLY GIVE IT TTY AND START IT AGAIN
|
||
CALL UBRK0 ;IN ORDER TO DO WHICH, WE MUST "RETURN IT TO DDT" FIRST.
|
||
7TYPE [ASCIZ/ P/]
|
||
MOVE A,UINTWD(U)
|
||
JRST NALTP2
|
||
|
||
GARGD1: SKIPLE D,ARG1
|
||
SKIPN ARG1+1
|
||
MOVEI D,1
|
||
POPJ P,
|
||
|
||
BUTOP1: MOVEI W2,1 ;SET OR CLR AUTO-PROC, BPT NUM IN A .
|
||
LSH W2,(A)
|
||
ANDCAM W2,BPINFL(U)
|
||
TLNE B,O.2ALT
|
||
IORM W2,BPINFL(U) ;$$
|
||
POPJ P,
|
||
|
||
NALTG: MOVE D,ARG1 ;$G, $$G
|
||
HRLI D,(JRST)
|
||
SKIPN ARG1+1
|
||
MOVE D,STARTA(U)
|
||
JUMPE D,NGOERR
|
||
SKIPN UINTWD(U)
|
||
JRST NRERR ;CAN'T START RUNNING PROGRAM.
|
||
SKIPL UNDEFL(U)
|
||
JRST NALTG1
|
||
7TYPE [ASCIZ /--Undefined Symbols--/]
|
||
CALL MORFL1 ;MAKE USER CONFIRM IF THERE UNFILLED FORWARD REFERENCES
|
||
JRST ERR
|
||
NALTG1: TLNE B,O.2ALT
|
||
MOVEM D,STARTA(U) ;$$
|
||
CALL SETPC ;SET THE PC, AND CLEAR SOME FLAGS.
|
||
MOVE I1,USTYPE(U)
|
||
TLNE B,O.IFX
|
||
JRST NCUPA1 ;$<N>G, GO MULTI-STEP.
|
||
JRST PROCDT ;ELSE JUST PROCEED.
|
||
|
||
;SET CURRENT JOB'S PC TO PROCEED AT FROM D.
|
||
SETPC: SAVE PPC(U)
|
||
REST XECPC(U) ;REMEMBER THE PC WE ARE ABOUT TO CLOBBER.
|
||
SAVE UINTWD(U) ;SAVE UINTWD OVER $X.
|
||
REST XINTWD(U)
|
||
SETOM UINTWD(U) ;MAKE SURE PROCDN WON'T DO ANYTHING FUNNY.
|
||
HRRM D,PPC(U) ;SET THE NEW PC.
|
||
MOVE D,OIPBIT
|
||
TLO D,%PCFPD ;CLEAR SOME FLAGS THAT MIGHT EMBARRASS US.
|
||
ANDCAM D,PPC(U)
|
||
RET
|
||
|
||
KGO:KSTART:
|
||
TLZA F,FLLT ;:GO, :START.
|
||
KGZP: TLO F,FLLT ;:GZP. IDENTICAL BUT DOESN'T GIVE TTY.
|
||
PUSHJ P,QIJERR
|
||
PUSHJ P,QRERR
|
||
PUSHJ P,RONUM
|
||
JRST ALTDQX ;(IF RUB PAST START OF RONUM)
|
||
JUMPN B,KGZP1
|
||
SKIPN A,STARTA(U)
|
||
JRST NGOERR
|
||
KGZP1: MOVE D,A
|
||
CALL SETPC
|
||
SETOM XCRFSW ;DON'T TYPE CRLF.
|
||
SETZM TW2FL ;:GXP IS LIKE ^P, NOT $^P.
|
||
JRST PROCD1
|
||
|
||
;; :ICHAN <chan> -- print filename and mode and such of <chan> in inferior
|
||
|
||
kichan: jumpl u,njerr ;gotta have some job or other!
|
||
call ronum ;fetch a number into A
|
||
jrst altdqx ; rubbed out, abort
|
||
caige a,20 ;is it a real channel number?
|
||
skipge a ; between 0 and 17?
|
||
jrst kicher ; no good, barf at him!
|
||
skipl d,ddtsw ;self? Then use -1 to mean self
|
||
movei d,usri ; no, we reference it by channel
|
||
|
||
tsclo infnm1 ;read the filenames of channel in A, job in D
|
||
push p,d ;save the status returned by the RFNAME
|
||
call terpri ;fresh line
|
||
skipn nctltf ;is there anything open?
|
||
jrst [ 7type [asciz /[Channel Closed]/]
|
||
pop p,d ; restore stack
|
||
jrst nltl4] ;prompt and exit
|
||
movei a,nctltf ;get set to print the file
|
||
call lfile ;print the filenames
|
||
pop p,d ;recover the filemode status
|
||
7type [asciz / (/]
|
||
trne d,7 ;are there any of the .UAO series on?
|
||
ctype ". ; yes, type the "." of that bunch
|
||
trnn d,.bai ;unit mode?
|
||
ctype "u
|
||
trze d,.bai ;block mode?
|
||
ctype "b
|
||
trnn d,.uii ;ascii mode?
|
||
ctype "a
|
||
trze d,.uii ;image mode?
|
||
ctype "i
|
||
trnn d,.uao ;input?
|
||
ctype "i
|
||
trze d,.uao ;output?
|
||
ctype "o
|
||
jumpe d,kichn1 ;if no other bits, close up now
|
||
ctype "\ ;or in more bits
|
||
move a,d ;G8PNT takes arg in A
|
||
call g8pnt ;print the rest of the bits
|
||
kichn1: ctype ") ;close up
|
||
jrst nltl4
|
||
|
||
sylhak: movsi b,syloct ;make sure it looks like an octal frob
|
||
call fldput ;save that number in the frob table
|
||
setz a,
|
||
move b,[setz+(o.1alt)+(",)+optab1+",-1] ;,
|
||
jrst fldput
|
||
|
||
kicher: 7type [asciz /ANot a channel number.
|
||
/]
|
||
;; :IOPEN <chan>,<mode>,<file> -- open file in current job on chan with mode
|
||
kiopen: call hgo2 ;misc. setup, error checking, etc.
|
||
kiopn1: call ronum ;read in a number
|
||
jrst altdqx ; rubbed out, abort
|
||
caige a,20 ;a channel number must be < 20
|
||
skipge a ; and >= 0
|
||
jrst kicher ; no good, barf at him!
|
||
hrrm a,opnchn ;that's the channel
|
||
call sylhak
|
||
call ronum ;read in a number
|
||
jrst altdqx ; rubbed out, abort
|
||
hrrm a,opnmod ;that's the mode
|
||
call sylhak
|
||
setzm arg1
|
||
setzm arg1+1
|
||
movei c,opndev ;filename block
|
||
call gsoa ;ugh, wrong thing but loses less badly
|
||
jrst kiopn1
|
||
tlz f,flunrd ;don't re-read the last char
|
||
call rrfl1 ;read a file name into our program block
|
||
sub w4,[10,,10] ;pop 4 frobs off the stack
|
||
call gxblkd ;check out the X locations for validity/existance
|
||
addi d,20 ;D <- location of superior-hacking block
|
||
.access usro,d
|
||
save d ;remember where we're starting
|
||
call setpc
|
||
movsi d,%pcpur ;on ai, prevent immediate purins error, no-op elsewhere
|
||
andcam d,ppc(u)
|
||
rest a ;get where we're going to put this stuff
|
||
|
||
;;; relocate each first item in each pair to point to each second item
|
||
|
||
irp x,,[[blk,prg],[dev,bdv],[fn1,bf1],[fn2,bf2],[snm,bsn]]
|
||
irp y,z,[x]
|
||
movei d,opn!y-opnprg(a)
|
||
hrrm d,opn!z
|
||
.istop
|
||
termin
|
||
termin
|
||
|
||
move d,[-prglen,,opnprg] ;transfer the whole program to open the file
|
||
.iot usro,d ;transfer!
|
||
jrst xec1c ;and start it up running!
|
||
|
||
NALTX: SKIPN ARG1+1 ;$X
|
||
JRST NAERR
|
||
SKIPL FNYLOC ;ARG FUNNY => XCT IN DDT.
|
||
SKIPE DDTSW
|
||
JRST NALTX1 ;CURRENT JOB SELF, JUST XCT.
|
||
MOVE D,ARG1
|
||
JRST HGO
|
||
|
||
NALTX1: PUSHJ P,CRF
|
||
SETOM HCLOB ;SAY HACTRN "CLOBBERED" IN CASE MYSTERIOUS BUGS ARISE.
|
||
SETOM NALTXF ;PREVENT BAD INSNS XCT'D FROM MAKING DDT BUG FILES.
|
||
XCT ARG1
|
||
CAIA
|
||
7type [asciz /<SKIP>/] ;IF INSN SKIPS, TELL USER.
|
||
CALL CRF
|
||
SETZM NALTXF
|
||
JRST NLTL2
|
||
|
||
nctlx: skipe d,uint(u) ; ^X -- job waiting => let it return.
|
||
jrst nctlx1
|
||
skipe d,uintwd(u) ;If job is already stopped
|
||
jrst [ movei a,%pic.z ;make it print as if at a control-Z
|
||
iorm a,upi0(u) ;by faking an interrupt
|
||
cain d,21 ; Has it never been started?
|
||
jrst nctlxx ;nope, tell him
|
||
hrrz d,ppc(u) ;get the PC
|
||
7type [asciz /A<Not Running> /]
|
||
call pcpnt0 ;and print out the instrucction
|
||
jrst lctgnr] ;and trailing spaces
|
||
movei a,%urctx ;Make note that this job is waiting to return
|
||
iorm a,urandm(u)
|
||
MOVE A,[-2,,[ .sustp,,[-1] ? .sipirq,,[2] ]]
|
||
.uset usri,a
|
||
jrst procdz
|
||
|
||
nctlxx: 7type [asciz /A<Not started>/]
|
||
jrst nltl2
|
||
|
||
NCTLX1: MOVE A,UIACK(U)
|
||
CAIN D,16 ;UNLESS THE JOB JUST DID A .BREAK 16,
|
||
TRNN A,60000 ;TO KILL ITSELF,
|
||
JRST UBRK0 ;SIMPLY LET IT RETURN.
|
||
SETOM UINT(U) ;ELSE CANCEL RECORD OF THE .BREAK,
|
||
SETZM UIACK(U) ;PCPNT WILL BACK UP THE PC.
|
||
JRST UBRK0
|
||
|
||
|
||
hgo2: call qijerr
|
||
call qrerr ;job shouldn't be running.
|
||
tlz f,fllt
|
||
aos xcrfsw
|
||
ret
|
||
|
||
HGO: MOVEM D,34SAV
|
||
MOVEI A,0 ;DO TYPE CR WHEN RETURN.
|
||
HGO1: DPB A,[130100,,34SAV+1] ;SAY WHTHER SHLD TYPE CR ON RETURN.
|
||
call hgo2 ;miscellaneous setup, check job not running, etc.
|
||
call gxblkd ;check for core in the X locations, etc.
|
||
addi d,xblk$x
|
||
.acces usro,d ;move 34SAV etc. into inferior.
|
||
call setpc
|
||
movsi d,%pcpur ;on ai, prevent immediate purins error, no-op elsewhere
|
||
andcam d,ppc(u)
|
||
MOVE D,[-3,,34SAV]
|
||
.IOT USRO,D
|
||
XEC1A: SKIPE D,MARADR(U)
|
||
.USET USRI,[.SMARA,,D]
|
||
SKIPL SYSUUO(U) ;TURN ON %OPTRP BIT IF STOP-ON-SYSTEM-CALL IN USE.
|
||
CALL OPTTRS
|
||
XEC1C: CALL INSRTB
|
||
XEC1B: SETZM UINTWD(U) ;NOW JOB IS "RUNNING".
|
||
MOVE D,PPC(U) ;SET ITS PC.
|
||
.USET USRI,[.SUPC,,D]
|
||
;COME HERE IF JOB ALREADY "RUNNING" (BUT IT SHOULD BE TEMPORARILY STOPPED)
|
||
PROCD4: TLNN F,FLLT ;GIVE IT TTY?
|
||
JRST PROCD2
|
||
.USET USRI,[.RTTY,,D] ;NO, JUST SET ITS TTYTBL BITS AND START IT AGAIN.
|
||
TLZ D,%TBOUT+%TBWAT ;FIRST APPROXIMATION => CLEAR BOTH; MAYBE CHANGE LATER.
|
||
SKIPGE A,TW2FL ;THIS IS 0 FOR ^P, 1 FOR $^P; TW1FL NORMALLY 0.
|
||
JRST [ TLO D,%TBOUT ;TW2FL -1 => $$^P, SO SET %TBOUT.
|
||
JRST PROCD5] ;ALSO SET %TBWAT TO AVOID INTS WHILE :SENDS RCV'D.
|
||
XOR A,TW1FL ;NORMALLY, $^P SETS %TBWAT AND ^P ZEROS IT.
|
||
TRNE A,1 ;TW1FL'S LOW BIT, IF 1, REVERSES THAT DECISION.
|
||
TLO D,%TBWAT
|
||
PROCD5: .USET USRI,[.STTY,,D]
|
||
.USET USRI,[.SUSTP,,[0]] ;TTYTBL ALTERED, SO RESTART JOB.
|
||
JRST NLTL2
|
||
|
||
PROCD2: AOS D,XCRFSW
|
||
CAIE D,1 ;IF SWITCH WASN'T SET,
|
||
call terpri ;then type CRLF
|
||
PUSHJ P,RTYIC ;GET CHAR FROM VALRET OR FILE
|
||
JRST PROCD3 ;NONE AVAILABLE
|
||
CAIE D,^V ;IF NEXT CHARACTER CONTROL V,
|
||
JRST PROCD3 ;...
|
||
SETZM UNRCHF ;FLUSH THE ^V,
|
||
SETZM UNECHF
|
||
SOSGE TTYFLG ;PERFORM ACTION OF ^V.
|
||
SETZM TTYFLG
|
||
PROCD3: CALL TTYLEV
|
||
procdz: TLZ F,FLSTOP
|
||
SETOM STOPWT ;TELL INT LEVEL TO SET FLSTOP IF CURRENT JOB RETURNS.
|
||
.USET USRI,[.SUSTP,,[0]]
|
||
CALL HAKKAM ;DO QUEUED RQ'S, DO NEW RQ'S FROM TSINT.
|
||
MOVSI A,FLSTOP
|
||
TDNN A,F ;WAKE UP WHEN TSINT SETS FLSTOP.
|
||
.HANG
|
||
SETZM HAKOK
|
||
SETZM STOPWT
|
||
skipge haktyp
|
||
SETOM HAKRQ
|
||
SKIPN ALARMW
|
||
JRST UBREAK
|
||
SETOM HAKTYP ;REPEAT ANY RANDOM TYPEOUTS
|
||
SETOM HAKRQ ;THAT HAPPENED WHILE JOB WAS RUNNING.
|
||
JRST UBREAK ;RETURN CURRENT JOB TO DDT.
|
||
|
||
;^N
|
||
procdx: setzm xcrfsw ;proceed, no CRLF, no "Not started" message
|
||
tlz f,fllt ;and give it the TTY
|
||
movei d,1 ;proceed once
|
||
call qijerr ;check it out, is it legit to hack this job?
|
||
move a,uintwd(u) ;see what's cooking with this job
|
||
jumpe a,procd4 ;thinks it's already running, hack it
|
||
jrst procdy ;and go!
|
||
|
||
NCTLN: call qrerr ;Get unhappy if the job is running!
|
||
MOVSI D,USTYP2
|
||
IORM D,USTYPE(U)
|
||
NCTLN1: SETZM OIPCHK(U) ;^N, $^N - LEAVE $$^N MODE.
|
||
PUSHJ P,GARGD1 ;GET ARG OR 1.
|
||
MOVEM D,INCNT(U) ;NUM. INSNS TO DO.
|
||
PROCDC: SETOM XCRFSW ;PROCEED ONCE, GIVING TTY, NO CRLF.
|
||
PROCDT: TLZ F,FLLT ;PROCEED ONCE, GIVING TTY.
|
||
;ANYONE WHO COMES HERE WITH FLLT=1 MUST SET UP TW2FL.
|
||
PROCD1: MOVEI D,1 ;ONCE, GIVING TTY IFF FLLT CLEAR.
|
||
PROCDN: AOS XCRFSW ;INCREMENT CRF SWITCH IN CASE OF ERROR
|
||
PUSHJ P,QIJERR
|
||
MOVE A,UINTWD(U)
|
||
JUMPE A,PROCD4 ;ALREADY RUNNING, MAYBE GIVE IT TTY.
|
||
CAIN A,21
|
||
JRST NSERR ;CAN'T $P IF NEVER STARTED.
|
||
procdy: camn a,[-4] ;if stopped by ..PERMIT=0, allow one DDT-WRITE
|
||
JRST [ SKIPN PERMIT(U) ;TO HAPPEN, BUT STOP THE NEXT ONE.
|
||
AOS PERMIT(U)
|
||
JRST XEC1C] ;AVOIDED REENABLING MAR SO DON'T GET MAR,DDTWRITE,MAR.
|
||
CAMN A,[-5] ;IF STOPPED BY SYSTEM CALL WHEN ..SCTRAP SET,
|
||
JRST [ .USET USRI,[.ROPTIO,,I3]
|
||
TLZ I3,OPTTRP ;TURN OFF SYSTEM CALL TRAPPING AND GO 1 INSN
|
||
.USET USRI,[.SOPTIO,,I3]
|
||
JRST .+1]
|
||
MOVE B,OIPBIT
|
||
CAME A,[-5]
|
||
CAMN A,[-3] ;-3 MEANS A MAR THAT ABORTED; GO 1 INSN, THEN TURN ON MAR.
|
||
JRST [IORM B,PPC(U) ;AVOID TURNING MAR BACK ON SO WE DON'T
|
||
JRST XEC1C] ;GET SEQUENCE MAR,MAR OR MAR,SCTRAP,MAR.
|
||
SKIPLE INCNT(U)
|
||
IORM B,PPC(U)
|
||
JUMPL A,XEC1A ;STOPPED BY RANDOM INT, START IT BACK UP
|
||
CAIL A,15 ;SIMILAR AFTER .BREAK 16,
|
||
JRST XEC1A
|
||
;BPT - WE'LL HIT IT AGAIN IMMEDIATELY,
|
||
DPB A,[$URBPT,,URANDM(U)] ;SO MAKE SURE IT DOESN'T BREAK THE 1ST TIME.
|
||
IMULI A,BPL
|
||
ADDI A,-BPL(U)
|
||
MOVEM D,B1CNT(A)
|
||
JRST XEC1C
|
||
|
||
;TAKE TTY AWAY FROM INFERIOR, NORMALLY (NOT DUE TO ERROR IN DDT).
|
||
;The job is checked for a ^_D interrupt; so UPI0(U) must be set up.
|
||
|
||
TTYRET: move a,upi0(u) ;check the interrupts for
|
||
tlne a,(%pidcl) ;a ^_D
|
||
setom ttnrst ; yes, so don't reset input!
|
||
move d,urandm(u)
|
||
trne d,%urctx ;If we're expecting a ^X-initiated ^Z
|
||
trnn a,%pic.z ; And we got one,
|
||
caia
|
||
setom ttnrst ; then don't reset input
|
||
SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLO %TBINF]]
|
||
SETZM TTYSTL ;TTY ISN'T STOLEN, SHOULDN'T RETURN IT.
|
||
SKIPN DDTTY ;RETURN TTY TO DDT
|
||
.DTTY USRI,
|
||
POPJ P,
|
||
SETOM DDTTY
|
||
|
||
AOSN RSTDEL ;UNLESS .BREAK 16, SAID NO, FLUSH INPUT.
|
||
POPJ P,
|
||
AOSE PVALFL ;DETECT ABNORMAL RETURNS FROM USER-DEFINED TYPEOUT MODES
|
||
JRST INRST
|
||
HRROI D,TMS ;AND WHEN ONE OCCURS, RESET SCH TO SYMBOLIC MODE
|
||
;TO PREVENT INFINITE LOOP TRYING TO CALL THE USER-DEFINED MODE
|
||
MOVEM D,SCH ;FROM PCPNT4.
|
||
JRST INRST
|
||
|
||
;ROUTINE TO GIVE TTY TO CURRENT INFERIOR.
|
||
TTYLEV: CALL TYOFRC ;FORCE OUT TYPEOUT FIRST.
|
||
.USET USRI,[.RTTY,,D]
|
||
TLC D,%TBWAT+%TBOUT
|
||
TLOE D,%TBWAT+%TBOUT
|
||
.USET USRI,[.STTY,,D]
|
||
AOSN CTLZFL ;IF USER HAS TYPED ^Z,
|
||
.USET USRI,[.SIPIRQ,,[2]] ;MAKE SURE IT ISN'T LOST BECAUSE TTY IS IN DDT.
|
||
.ATTY USRI, ;TTY LEAVES DDT.
|
||
TERR (SIXBIT /CFT/)
|
||
SETZM DDTTY
|
||
MOVE D,URANDM(U)
|
||
TRNN D,%URFRZ ;IF INFERIOR WANTS US TO, DENY ALL OTHER INFERIORS OUTPUT PERMISSION.
|
||
RET
|
||
SYSCLE USRVAR,[%CLIMM,,%JSELF ? ['TTY,,] ? 0 ? [TLZ %TBINF]]
|
||
RET
|
||
|
||
;INSERT BREAKPOINTS
|
||
|
||
INSRTB: SKIPGE BPINFL(U)
|
||
POPJ P, ;DON'T INSERT IF ALREADY IN.
|
||
HRROS BPINFL(U)
|
||
MOVEI B,B1ADR(U)
|
||
MOVEI W1,(.BREAK 1,)
|
||
INSRT1: PUSHJ P,INSRT0 ;INSERT 1 ORDINARY BPT.
|
||
JRST INSRT3 ;SUCCEEDED IN INSERTING.
|
||
SETZM (B) ;FAILED; GET RID OF THE BPT AND TELL THE USER.
|
||
7TYPE [ASCIZ / 0/]
|
||
LDB C,[.BP (0 17,),W1]
|
||
CTYPE "0(C)
|
||
CTYPE "B
|
||
INSRT3: MOVEM C,B1INS-B1ADR(B)
|
||
ADDI W1,(0 1,)
|
||
ADDI B,BPL
|
||
CAIE B,BPEND(U)
|
||
JRST INSRT1
|
||
MOVEI B,BTADR(U)
|
||
MOVEI W1,(.BREAK 15,)
|
||
PUSHJ P,INSRT0 ;INSERT 1ST TEMP BPT
|
||
JRST INSRT4
|
||
INSRT5: SETZM BTADR(U)
|
||
ERSTRT [SIXBIT/$^N CAN'T SET BPT?/]
|
||
|
||
INSRT4: MOVEM C,BTINS(U)
|
||
MOVEI W1,(.BREAK 17,)
|
||
PUSHJ P,INSRT2 ;INSERT THE SECOND.
|
||
CAIA
|
||
JRST INSRT5
|
||
MOVEM C,BTINS+1(U)
|
||
POPJ P,
|
||
|
||
;SKIPS IF FAILS.
|
||
INSRT2: AOSA A ;INSERT OR REMOVE AT WD AFTER PREV. BPT.
|
||
INSRT0: MOVE A,(B) ;DO IT AT ADDR IN WD <- B.
|
||
SKIPN (B)
|
||
RET
|
||
PUSHJ P,RFETCH ;GET WHAT'S THERE NOW.
|
||
JRST POPJ1 ;CAN'T FETCH OR BPT NOT SET.
|
||
MOVE C,D ;REMEMBER WHAT WAS THERE IN CASE INSERTING.
|
||
TLZ D,777740 ;CLEAR OUT OP CODE, AC FIELD,
|
||
TLO D,(W1) ;REPLACE WITH SAME FIELDS OF ARG.
|
||
PUSHJ P,RDEPCA
|
||
JRST POPJ1
|
||
POPJ P,
|
||
|
||
;REMOVE BREAKPOINTS
|
||
|
||
REMOVB: SKIPL BPINFL(U)
|
||
POPJ P, ;DON'T REMOVE UNLESS IN.
|
||
SETZ B,
|
||
DPB B,[$URBPT,,URANDM(U)]
|
||
HRRZS BPINFL(U)
|
||
MOVEI B,BTADR(U)
|
||
HLRZ W1,BTINS(U)
|
||
CALL REMOV9 ;REMOVE THE 1ST TEMPORARY BPT.
|
||
JFCL [ASCIZ /1st $^N bpt/]
|
||
HLRZ W1,BTINS+1(U)
|
||
CALL [ SAVE [REMOV8] ;REMOVE THE 2ND TEMP BPT.
|
||
JRST INSRT2] ;INSRT2 CAN SKIP INTO REMOV8!
|
||
JFCL [ASCIZ /2nd $^N bpt/]
|
||
MOVEI B,B1ADR(U)
|
||
REMOV1: MOVS W1,B1INS-B1ADR(B)
|
||
PUSHJ P,REMOV9
|
||
JFCL
|
||
ADDI B,BPL
|
||
CAIE B,BPEND(U)
|
||
JRST REMOV1
|
||
POPJ P,
|
||
|
||
;REMOVE A BREAKPOINT. B POINTS AT WORD HOLDING ADDRESS.
|
||
;W1 CONTAINS THE OLD INSTRUCTION.
|
||
;TYPES A WARNING IF THERE WAS NO BREAKPOINT THERE OR IF THERE WAS NO MEMORY.
|
||
;EITHER FOLLOW THE CALL WITH JFCL [ASCIZ/NAME OF BPT/]
|
||
; OR WITH JFCL 0 TO CAUSE THE BPT NUMBER TO BE CALCULATED FROM B.
|
||
REMOV9: PUSHJ P,INSRT0
|
||
REMOV8: CAIA
|
||
JRST REMOVL
|
||
LDB D,[.BP 777^9,C]
|
||
SKIPE (B) ;NO BPT SET => DON'T COMPLAIN. INSRT0 DID NOTHING.
|
||
CAIN D,.BREAK_-33
|
||
RET
|
||
MOVE D,C
|
||
CALL RDEPCA ;IF BPT WAS OVERWRITTEN, UNDO INSRTO'S CHANGES.
|
||
JFCL
|
||
REMOVL: CALL CRF
|
||
HRRZ C,@(P)
|
||
JUMPE C,REMOV2
|
||
7TYPE (C)
|
||
JRST REMOV3
|
||
|
||
REMOV2: 7TYPE [ASCIZ /Bpt #/]
|
||
MOVEI C,(B)
|
||
SUBI C,B1ADR(U)
|
||
IDIVI C,BPL
|
||
CTYPE "1(C)
|
||
REMOV3: 7TYPE [ASCIZ / Clobbered/]
|
||
RET
|
||
|
||
;;; DEP series deposits into job, expects address in A and value in D
|
||
|
||
DEPF: TLNE A,200000 ;A HAS ADDR, LH HAS FUNNYNESS.
|
||
JRST DEP2 ;DEP. INTO USET VARIABLE.
|
||
TLNE A,400000
|
||
JRST DEP5 ;DEP INTO DDT LOCATION.
|
||
DEPCLA: TLZ A,-1 ;DEP REQUIRES 0 IN LH OF A.
|
||
DEP: SKIPE SYSSW
|
||
JRST DEP0 ;IF JOB IS SYS.
|
||
SKIPE DDTSW
|
||
JRST DEP4 ;IF JOB IS SELF.
|
||
skiple uchnlo ;Is job foreign?
|
||
jrst dep7 ; yes, hack specially
|
||
dep8: PUSHJ P,QI6JERR ;ELSE IF ISN'T INFERIOR, CAN'T DEPOSIT.
|
||
PUSHJ P,RDEP
|
||
JRST NXERR
|
||
POPJ P,
|
||
|
||
|
||
dep7: move w1,urandm(u) ;Has he enabled this job?
|
||
trnn w1,%urdps
|
||
jrst dep8 ;unenabled
|
||
syscal usrmem,[%clbit,,400000 ? %climm,,usri ? a ? d] ;Do it
|
||
terr 'PUR
|
||
ret
|
||
|
||
DEP0: SKIPL SYSDPS
|
||
JRST ERR
|
||
PUSH P,C
|
||
MOVSI C,D
|
||
HRR C,A
|
||
.SETLOC C,
|
||
JRST POPCJ
|
||
|
||
DEP5: SAVE A
|
||
ANDI A,-1
|
||
CAIN A,PPC(U) ;IF DEPOSITING IN ..PPC, AND JOB IS STOPPED,
|
||
SKIPN UINTWD(U)
|
||
CAIA ;PUT IT IN "PROCEEDABLE" STATE.
|
||
SETOM UINTWD(U)
|
||
CAIE A,PERMIT(U)
|
||
JRST DEP5A
|
||
MOVN A,UINTWD(U) ;DEPOSITING IN ..PERMIT TAKES JOB OUT OF "TRAPPED ON ..PERMIT".
|
||
CAIN A,4
|
||
SETOM UINTWD(U)
|
||
JRST DEP5X
|
||
|
||
DEP5A: CAIN A,SYSUUO(U) ;IF DEPOSITING IN THE ..SYSUUO,
|
||
SKIPL UCHNLO ;OF A REAL INFERIOR,
|
||
JRST DEP5B
|
||
.USET USRI,[.ROPTIO,,A]
|
||
TLZ A,OPTTRP ;MAKE THE OPTTRP BIT REFLECT IT.
|
||
SKIPN D
|
||
TLO A,OPTTRP
|
||
.USET USRI,[.SOPTIO,,A]
|
||
MOVN A,UINTWD(U)
|
||
CAIN A,5 ;AND LEAVE THE "TRAPPED ON SYSUUO" STATE IF WE'RE IN IT.
|
||
SETOM UINTWD(U)
|
||
JRST DEP5X
|
||
|
||
DEP5B: CAIN A,XUNAME
|
||
.SUSET [.SXUNAME,,D]
|
||
CAIN A,HSNAME
|
||
.SUSET [.SHSNAM,,D]
|
||
DEP5X: REST A
|
||
DEP4: ANDI A,-1
|
||
cail a,setbeg ;if he's been poking around in his HACTRN
|
||
cail a,setend ; Where we haven't said it's OK
|
||
movem a,hhack ; Then say what he did
|
||
|
||
CAIL A,MINPUR_10. ;DEPOSITING INTO DDT'S PURE CODE => WARN MAINTAINERS.
|
||
CAIL A,NPUR_10.
|
||
CAIA
|
||
SETOM HCLOB
|
||
SETOM XRWI ;TELL PURBR1 TO UNPURIFY.
|
||
MOVEM D,(A)
|
||
CAIA ;SUCCESS.
|
||
JRST NXERR ;WAS MPV.
|
||
SETZM XRWI
|
||
RET
|
||
|
||
DEP2: SKIPE DDTSW ;IF DEPOSITING IN OWN .USET VAR,
|
||
TLO A,400000 ;MUST DO .SUSET, NOT .USET.
|
||
TLNN A,400000
|
||
CALL QIJERR
|
||
PUSH P,C
|
||
MOVE C,[SETZ D] ;SET VAR FROM D.
|
||
CALL [ SAVE C
|
||
JRST FETCH7]
|
||
JRST NXERR
|
||
JRST POPCJ
|
||
|
||
RDEPCA: TLZ A,-1
|
||
RDEP: PUSH P,C
|
||
PUSH P,XRWI
|
||
SETOM XRWI
|
||
.ACCESS USRO,A
|
||
HRROI C,D
|
||
.IOT USRO,C
|
||
RDEP2: AOS -2(P)
|
||
RDEP4: POP P,XRWI
|
||
JRST POPCJ
|
||
|
||
|
||
;FETCH FROM A POSSIBLY FUNNY LOCATION, FUNNYNESS IN LH OF A.
|
||
FETCHF: TLNE A,200000
|
||
JRST FETCH3 ;FETCH FROM USET VAR.
|
||
TLNE A,400000
|
||
JRST FETCHB ;FETCH FROM LOC. IN DDT.
|
||
|
||
;FETCH FROM ORDINARY (NON-FUNNY) LOCATION.
|
||
FETCH: SKIPE SYSSW
|
||
JRST FETCHA ;FETCH FROM SYS JOB.
|
||
SKIPE DDTSW
|
||
JRST FETCHB ;FETCH FROM SELF
|
||
PUSHJ P,QJERR
|
||
|
||
;FETCH FROM CURRENT JOB'S CORE. Skip unless MPV Return in D
|
||
|
||
RFETCH: PUSH P,C
|
||
PUSH P,XRWI
|
||
HRRZ C,A
|
||
.ACCESS USRI,C
|
||
HRROI C,D
|
||
SETOM XRWI ;SKIP ON MPV
|
||
.IOT USRI,C
|
||
JRST RDEP2 ;POP XRWI, C, SKIP.
|
||
JRST RDEP4 ;WAS NXM, DON'T SKIP.
|
||
|
||
FETCH3: PUSH P,C
|
||
SKIPN UCHNLO
|
||
JUMPGE A,POPCJ ;CAN'T DO USET REFS ON SYS.
|
||
MOVEI C,D ;READ INTO D.
|
||
FETCH7: TRNE A,400000 ;REJECT VARS THAT WOULD TURN READING INTO SETTING.
|
||
JRST POPCJ
|
||
TLO C,(A) ;SAY WHICH VAR TO READ OR SET.
|
||
SETOM XRWI
|
||
JUMPL A,[ ;SETTING VAR. IN DDT:
|
||
.SUSET C ;IF GET ILOPR, INT LVL WILL SKIP.
|
||
AOS -1(P)
|
||
SETZM XRWI
|
||
JRST POPCJ]
|
||
.USET USRI,C
|
||
AOS -1(P)
|
||
SETZM XRWI
|
||
JRST POPCJ
|
||
|
||
FETCHA: HRLZI D,(A)
|
||
HRRI D,D
|
||
SETOM XRWI
|
||
.GETLOC D,
|
||
AOS (P)
|
||
SETZM XRWI
|
||
RET
|
||
|
||
FETCHB: SETOM XRWI
|
||
MOVE D,(A)
|
||
AOS (P)
|
||
SETZM XRWI ;DON'T SKIP-RETURN IF MPV.
|
||
POPJ P,
|
||
|
||
|
||
pdumpi: movei c,nctltf ;NCTLTF is where we'll put our indirect filenames
|
||
hrli a,ufile(u) ;use the $L filenames for the default
|
||
skipn ufnamd(u) ;if there's a loaded file
|
||
hrli a,ufnamd(u) ;use that instead.
|
||
hrri a,nctltf ;for indirection, as well.
|
||
blt a,nctltf+3
|
||
call pdump1 ;Get the filenames to dump out to
|
||
skipe toktrm ;if user must be prompted (by link2),
|
||
call warn1 ;unread an altmode to show user the new defaults.
|
||
movei c,nctltf ;ask for more filenames
|
||
call link2 ;prompt if necessary for name of TO- file.
|
||
7type [asciz /(File with Symbols) /]
|
||
movei c,nctltf
|
||
setom gsdnum ;tell RRFL1 to clobber SYS: to DSK:
|
||
call rrfl1 ;read in the filenames
|
||
move a,nctltf ;check out to see if they are the same
|
||
move b,nctltf+1
|
||
camn a,ufile(u)
|
||
came b,ufile+1(u)
|
||
jrst ncrcer ; a difference was encountered, win!
|
||
move a,nctltf+2
|
||
move b,nctltf+3
|
||
camn a,ufile+2(u)
|
||
came b,ufile+3(u)
|
||
caia
|
||
7nrtyp [
|
||
asciz /ADon't write indirect symbol table pointers to self!A/]
|
||
|
||
ncrcer: call pdump2 ;dump out the file
|
||
call djblk ;write out the start address
|
||
skipl b,bininf(u) ;if there is BIN info, dump it.
|
||
jrst pdmpni ; non, don't bother.
|
||
movei a,stbinf ;dump the random bin file info.
|
||
call ndmps1
|
||
pdmpni: movei a,stbfil ;header for indirect symbol table
|
||
movsi b,-4 ;then output names of last file loaded
|
||
hrri b,nctltf ;temporary filenames are found here
|
||
call ndmps1 ;write the symbol-table block
|
||
call djblk ;write the start address again
|
||
jrst kpdum2 ;and finish up.
|
||
|
||
KPDUMP: CALL NDMPSC ;WARN IF ABOUT TO LOSE SYMBOLS.
|
||
call pdump1 ;get our info, open our output file
|
||
call pdump2 ;dump it
|
||
CALL NDMPS
|
||
KPDUM2: SYSCLO RENMWO,[%CLIMM,,UTOC ? UFILE1(U) ? UFILE2(U)]
|
||
SKIPGE (P)
|
||
CALL INSRTB
|
||
CALL TSTOPX
|
||
.CLOSE UTOC,
|
||
JRST NLTL4
|
||
|
||
pdump1: SETOM GSDNUM ;TELL RRFLB TO CLOBBER SYS: TO DSK:
|
||
PUSHJ P,RRFLB
|
||
TSCLO KPDUMO
|
||
CALL NALTBS ;STOP JOB AND REMOVE BPTS; SETS LH OF (P).
|
||
ret
|
||
|
||
;;; actually dump out the file
|
||
pdump2: setz a,
|
||
.call kpdum1
|
||
opner ufilo
|
||
ret
|
||
|
||
KPDUMO: SETZ ? SIXBIT/OPEN/
|
||
[7,,UTOC]
|
||
UFILE(U)
|
||
[SIXBIT/_DUMP_/]
|
||
['OUTPUT]
|
||
SETZ UFILES(U)
|
||
|
||
UFILO: SETZ ? SIXBIT/OPEN/
|
||
A
|
||
UFILE(U)
|
||
UFILE1(U)
|
||
UFILE2(U)
|
||
SETZ UFILES(U)
|
||
|
||
KPDUM1: SETZ ;USED FOR PURE DUMP
|
||
SIXBIT /PDUMP/
|
||
[USRI]
|
||
[UTOC]
|
||
400000,,A
|
||
|
||
NALTY: JUMPL U,QJERR
|
||
CALL WARN
|
||
7TYPE [ASCIZ / (Dump to File)/]
|
||
PUSHJ P,GSOT
|
||
KDUMP: SETOM GSDNUM
|
||
PUSHJ P,RRFLB ;:DUMP COMMAND.
|
||
TSCLO KPDUMO
|
||
MOVE B,(W4)
|
||
TLZ F,FLC
|
||
TLNE B,O.IFX ;$0Y => DUMP AS IMAGE.
|
||
jrst [TLO F,FLC ;Note that we want to dump as image
|
||
jrst .+2] ;and don't warn about symbols
|
||
CALL NDMPSC ; (ELSE) WARN IF ABOUT TO LOSE SYMBOLS.
|
||
CALL NALTBS ;STOP JOB AND REMOVE BPTS
|
||
PUSHJ P,NDMP ;DUMP THE JOB
|
||
JRST KPDUM2 ;IF NEC., RESTART AND INSERT BPTS.
|
||
|
||
NDMP: MOVE A,[JRST 1]
|
||
TLNN F,FLC ;NO JRST 1 IF DUMPING AS IMAGE.
|
||
PUSHJ P,NDMPA
|
||
CALL N2AZ1 ;GET LOW LIMIT IN C, HIGH IN D.
|
||
CAML D,C ;SKIP IF NO CORE TO DUMP.
|
||
NDMP2: PUSHJ P,GCBLKP
|
||
JRST NDMPS
|
||
TLNE F,FLC ;AS IMAGE => DUMP ALL INTO FILE.
|
||
JRST [.IOT UTOC,A ? JRST NDMP2]
|
||
SKIPN (A) ;LOOK FOR NON-ZERO
|
||
NDMP3: AOBJN A,.-1
|
||
JUMPGE A,NDMP2 ;GET NEXT BLOCK
|
||
HRRZM A,W1 ;SAVE START
|
||
CAIA ;DON'T CHECK 1ST WD FOR BEING ZERO.
|
||
;AVOIDS SCREW IN CASE SOME OTHER JOB CHANGES IT FROM
|
||
;NONZERO TO ZERO BETWEEN NDMP3 AND NDMP4.
|
||
SKIPE (A) ;LOOK FOR ZERO
|
||
NDMP4: AOBJN A,.-1
|
||
JUMPGE A,NDMP5 ;END, MAKE DUMP BLOCK
|
||
AOBJP A,NDMP7 ;NEXT WRD IS END
|
||
SKIPE (A) ;SEE IF ONLY ONE ZERO
|
||
JRST NDMP4
|
||
NDMP7: SUB A,[1,,1]
|
||
NDMP5: SUB A,[1,,1]
|
||
MOVEM A,W2 ;SAVE END
|
||
MOVE A,C
|
||
SOS A
|
||
HRRZ B,W1
|
||
CAIL B,AC0
|
||
CAILE B,AC0+17
|
||
SKIPA
|
||
SUBI B,AC0
|
||
DPB B,[1200,,A] ;GET TRUE ADDRESS
|
||
HRRZ B,W2
|
||
SUB B,W1
|
||
SETCA B,
|
||
HRL A,B
|
||
PUSHJ P,NDMPA
|
||
MOVE B,A
|
||
HRR A,W1
|
||
.IOT UTOC,A
|
||
MOVE A,B
|
||
HRR B,W1
|
||
NDMP6: ROT A,1
|
||
ADD A,(B)
|
||
AOBJN B,NDMP6
|
||
PUSHJ P,NDMPA
|
||
MOVE A,W2
|
||
JRST NDMP3
|
||
|
||
;WRITE OUT THE WORD IN A.
|
||
NDMPA: HRROI B,A
|
||
.IOT UTOC,B
|
||
POPJ P,
|
||
|
||
;WRITE OUT THE SYMBOL TABLES AND START ADDRESSES AS APPROPRIATE.
|
||
NDMPS: TLZE F,FLC ;DUMPING AS IMAGE => NO SYMS.
|
||
RET
|
||
PUSHJ P,DJBLK
|
||
MOVE B,BININF(U)
|
||
MOVEI A,STBINF ;DUMP THE RANDOM BIN FILE INFO.
|
||
CALL NDMPS1
|
||
MOVE B,SYSAOB ;IF SYS JOB, GET SYS SYMTAB PTR,
|
||
SUBI B,772000-SYSSYM
|
||
SKIPN SYSSW
|
||
MOVE B,JOBSYM(U) ;ELSE GET JOB'S SYMTAB PTR.
|
||
SKIPE UFNAM1(U) ;IF NO SYMS, BUT DO KNOW NAME OF LAST FILE LOADED,
|
||
JUMPGE B,NDMPSI ;DUMP AN "INDIRECT SYM TAB BLOCK" POINTING AT IT.
|
||
MOVEI A,STBDEF
|
||
CALL NDMPS1 ;OTHERWISE WRITE THE SYMTAB ITSELF.
|
||
MOVE B,UNDEFL(U) ;AFTER THE SYM TAB, DUMP THE UNDEF SYM TAB.
|
||
MOVEI A,STBUND ;UNDEF SYM TAB IS BLOCK TYPE 1
|
||
CALL NDMPS1
|
||
DJBLK: SKIPE A,STARTA(U)
|
||
HRLI A,(JRST) ;THIS MAKES SURE SIGN NOT SET AND LH NOT 0.
|
||
JRST NDMPA
|
||
|
||
NDMPSI: SKIPN UFNAMD(U)
|
||
JRST DJBLK ;SKIP THE INDIR. SYMTAB PTR IF THERE'S NO FILENAME TO POINT IT AT.
|
||
MOVE C,[-4,,STBFIL]
|
||
MOVE A,C ;OUTPUT A HEADER FOR THE INDIRECT SYM TAB BLOCK.
|
||
CALL NDMPA
|
||
MOVSI B,-4 ;THEN OUTPUT NAMES OF LAST FILE LOADED AS CONTENTS OF BLOCK,
|
||
HRRI B,UFNAMD(U)
|
||
CALL NDMPS2 ;AUTOMATICALLY COMPUTING CHECKSUM.
|
||
JRST DJBLK
|
||
|
||
;IF THE FILE WE ARE ABOUT TO DUMP WOULD CONTAIN AN
|
||
;INDIRECT SYMTAB POINTER TO ITSELF, WARN THE USER; IF HE SAYS "GO AHEAD",
|
||
;AVOID DUMPING THE LOOPING POINTER AND JUST DUMP NO SYMBOLS.
|
||
NDMPSC: SKIPGE JOBSYM(U) ;IF THE JOB HAS NO SYMBOLS,
|
||
RET
|
||
MOVE A,UFNAMD(U) ;AND THE NAMES OF THE LOADED FILE
|
||
MOVE B,UFNAM1(U) ;MATCH WHAT WE ARE DUMPING AS
|
||
CAMN A,UFILE(U)
|
||
CAME B,UFILE1(U)
|
||
RET
|
||
MOVE A,UFNAM2(U)
|
||
MOVE B,UFNAMS(U)
|
||
CAMN A,UFILE2(U)
|
||
CAME B,UFILES(U)
|
||
RET ;THEN ASK WHETHER TO GO AHEAD.
|
||
7TYPE [ASCIZ /--Symbols not loaded. Dump anyway--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
SETZM UFNAMD(U) ;AND IF SO, DUMP A FILE WITH NO SYMS INSTEAD OF A LOOPING ONE.
|
||
RET
|
||
|
||
;A HAS TYPE CODE, B HAS AOBJN TO DATA; DUMP A SYMBOL TABLE BLOCK.
|
||
NDMPS1: JUMPGE B,CPOPJ
|
||
HLL A,B
|
||
SAVE B
|
||
PUSHJ P,NDMPA ;OUTPUT -<BLOCK SIZE>,,<TYPE CODE>
|
||
REST B
|
||
MOVE C,A ;START OFF CHECKSUM WITH THE AOBJN WD.
|
||
NDMPS2: PUSHJ P,ALDRD1 ;COMPUTE CHECKSUM IN C OF WORDS IN RANGE <- B.
|
||
.IOT UTOC,B ;OUTPUT THE DATA
|
||
MOVE A,C
|
||
JRST NDMPA ;OUTPUT CHECKSUM.
|
||
|
||
KOLOAD: TRO F,OLOADF ;:OLOAD - FORCE SORT AND ASSUME NO PROGRAM SORTED YET.
|
||
JRST NALTL1
|
||
|
||
NALTL: MOVEI A,[ASCIZ / (Load Bin File)/]
|
||
TLNN B,O.IFX
|
||
JRST NALTL2
|
||
MOVEI A,[ASCIZ / (Load Core Image)/]
|
||
SKIPE -1(W4)
|
||
MOVEI A,[ASCIZ / (Load Without Symbols)/]
|
||
NALTL2: CALL WARN
|
||
7TYPE (A)
|
||
CALL GSOT ;$L - INIT READIN, TYPE SPACE.
|
||
NALTL1: TLNE B,O.2ALT
|
||
CALL [ MOVE D,UJNAME(U)
|
||
CAME D,[SIXBIT/PDP6/]
|
||
CAMN D,[SIXBIT/PDP10/]
|
||
RET ;$$L ALLOWED ON PDP6 EVEN THOUGH RUNNING.
|
||
JRST QRERR] ;CAN'T $$L IF RUNNING.
|
||
KLOAD: PUSHJ P,QI6JER
|
||
SAVE A
|
||
PUSHJ P,RRFLB ;GET FILE NAME TO LOAD. PASSES INFO TO KLOADO IN FLNEGE.
|
||
REST A
|
||
TLO F,FLQ+4^5 ;FLC ON => CAUSE LOADING OF SYMS.
|
||
TLZ F,FLC
|
||
TLNN B,O.2ALT
|
||
TLZ F,4^5 ;SIGN ON => $$L (DON'T RESET)
|
||
TLNN B,O.IFX
|
||
TLC F,FLQ+FLC ;FLQ ON => $0L.
|
||
SKIPE A ;$1L MEANS LOAD WITHOUT SYMBOLS.
|
||
TLZ F,FLQ
|
||
CALL KLOADO ;OPEN FILE TO LOAD, SEARCHING DIRECTORIES AS APPRO.
|
||
SKIPN UINT(U) ;IF CLOBRF IS SET, ASK FOR CONFIRMATION BEFORE LOADING A RUNNING JOB.
|
||
SKIPE UINTWD(U)
|
||
JRST KLOAD1
|
||
SKIPN CLOBRF
|
||
JRST KLOAD1
|
||
7TYPE [ASCIZ/--Reload Running Job--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
KLOAD1: CALL ALOAD1 ;THEN ACTUALLY LOAD FROM UTIC.
|
||
JRST NLTL4
|
||
|
||
;OPEN ON UTIC THE FILE SPEC'D IN UFILE(U), USING SNAME SEARCH LIST IF ENABLED AND FLNEGE=0.
|
||
KLOADO: CALL SMFLCK ;GIVE ERROR IF DEV IS TTY: (DON'T CLOBBER TTYSET)
|
||
TLNE F,FLNEGE
|
||
JRST NALTL4
|
||
MOVEI B,UFILE(U)
|
||
CALL FLOCK ;TRY SPEC'D NAMES ON VARIOUS DIRS, SKIP IF WIN.
|
||
JRST NALTL3 ;TRY ALTERNATE DEFAULT.
|
||
MOVE D,SNLIST
|
||
MOVEM D,LSNAM
|
||
MOVEM D,UFILES(U) ;DEFAULT SNAME IS DIR ACTUALLY FOUND ON.
|
||
JRST TYOFRC
|
||
|
||
NALTL3: .SUSET [.SSNAM,,IFILE+3]
|
||
MOVEI B,IFILE
|
||
CALL FLOCK
|
||
JRST NALTL4 ;ALTERNATE FAILED, GO GIVE ERROR.
|
||
MOVEI A,IFILE
|
||
MOVE B,IFILE+3
|
||
CAME B,SNLIST ;DON'T PRINT SNAME IF FLOCK DID.
|
||
SETZ B,
|
||
CALL LFILE0 ;PRINT ALTERNATE DEFAULT.
|
||
CALL CRF
|
||
|
||
MOVE D,SNLIST ;GET SNAME ACTUALLY USED.
|
||
MOVEM D,IFILE+3
|
||
MOVEM D,LSNAM
|
||
MOVEI A,UFILE(U)
|
||
HRLI A,IFILE ;COPY IT INTO NORMAL DEFAULT.
|
||
BLT A,UFILES(U)
|
||
SETZM UFLSYS(U)
|
||
JRST TYOFRC
|
||
|
||
NALTL4: .SUSET [.SSNAM,,LSNAM]
|
||
MOVE A,[.BII,,UTIC]
|
||
TSCLO UFILO
|
||
JRST TYOFRC ;ORIGINAL NAME GOT CREATED.
|
||
|
||
ALOAD: TLZ F,FLQ ;FROM ^K, NOT IMAGE LOAD.
|
||
ALOAD1: SKIPN SAFE(U)
|
||
JRST ALOAD3
|
||
7TYPE [ASCIZ /--Reload Protected Job--/]
|
||
CALL MORFL1
|
||
JRST ERR
|
||
ALOAD3: syscle rfname,[movei utic ? movem ufnamd(u) ? movem ufnam1(u)
|
||
movem ufnam2(u) ? movem ufnams(u)]
|
||
JUMPL F,ALD
|
||
TLZ F,FLRO
|
||
SETZM PATCHL(U)
|
||
MOVE A,UJNAME(U)
|
||
CAME A,[SIXBIT/PDP6/]
|
||
CAMN A,[SIXBIT/PDP10/]
|
||
JRST [ .RESET USRI,
|
||
JRST ALOAD2]
|
||
.USET USRI,[.RTTY,,A]
|
||
.RESET USRI,
|
||
.USET USRI,[.STTY,,A]
|
||
SYSCLE CORBLK,[%CLIMM,,0 ? %CLIMM,,USRI ? %CLIMM,,0]
|
||
;.RESET MAKES A PAGE 0 - FLUSH IT.
|
||
SETOM UINTWD(U) ;TELL JCL3 NOT TO RESTART THE JOB.
|
||
CALL JCL3 ;SET OPTBRK, MAYBE OPTCMD.
|
||
.USET USRO,[.SSNAM,,MSNAM] ;SET SYSTEM NAME TO WORKING DIRECTORY.
|
||
ALOAD2: HRRZS BPINFL(U) ;BPTS AREN'T IN NOW.
|
||
SETZM BTADR(U) ;NO TEMP BPT.
|
||
MOVEI D,21
|
||
MOVEM D,UINTWD(U)
|
||
PUSHJ P,ELECTRON
|
||
MOVEI W1,BININF(U)
|
||
PUSHJ P,ELEC0
|
||
MOVEI W1,UNDEFL(U)
|
||
PUSHJ P,ELEC0
|
||
SETZM LITCNT(U)
|
||
|
||
;HERE WE ARE FINISHE RESETTING THE JOB. DO THE ACTUAL LOAD.
|
||
ALD: SAVE [ALDXIT] ;MAKE SURE WE CLOSE UTIC WHEN FINISHED.
|
||
LDB D,[121000,,ARG1]
|
||
SUBI D,1 ;# OF LAST PAGE BELOW WHERE WE START LOADING (USUALLY -1)
|
||
MOVEM D,ALDPAG
|
||
TLNE F,FLQ ;FLQ => LOAD AS IMAGE.
|
||
JRST ALDIM
|
||
SKIPE ARG1 ;.CALL LOAD WON'T LOAD WITH OFFSET.
|
||
JRST ALDND
|
||
SETOM LOADF ;FOR LOAD FAILURE DETECTION
|
||
SYSCAL LOAD,[%CLIMM,,USRI ? %CLIMM,,UTIC ? 3000,,W1]
|
||
JRST [ SETZM LOADF
|
||
CAIN W1,%EBDDV ;IF LOAD FAILS WITH WRONG-TYPE-DEVICE,
|
||
JRST ALDND ;TRY DOING THE LOAD "BY HAND".
|
||
OPNER UFILO] ;ELSE COMPLAIN.
|
||
SETZM LOADF
|
||
PUSHJ P,GTWD
|
||
ALDJ: JUMPL A,ALDJ1 ;FOR :SL, DON'T SET START ADDR.
|
||
JUMPE B,ALDJ1 ;ZERO => NO START ADDRESS, SO DON'T CLOBBER.
|
||
HRRZM B,PPC(U)
|
||
MOVEM B,STARTA(U)
|
||
ALDJ1: TLNN F,FLC ;UNLESS USER HAS SAID NO, GO LOAD THE SYMBOLS.
|
||
RET
|
||
JRST ALDS
|
||
|
||
;LOADING BINARY FILES ($L) BUT NOT FROM A DISK
|
||
ALDND: PUSHJ P,GTWD
|
||
CAME B,[JRST 1] ;SKIP PAST THE SBLK LOADER, ETC.
|
||
JRST ALDND
|
||
MOVEI A,-1 ;INITIALLY, VPAGE IS EMPTY.
|
||
CALL ALD1A ;LOAD THE SBLKS OF PROGRAM. RETURN WITH START INSN IN B.
|
||
JRST ALDJ ;GO SET START ADDR AND MAYBE LOAD THE SYMBOL TABLE WHICH FOLLOWS.
|
||
|
||
;LOAD THE DATA FROM AN SBLK FILE OPEN ON UTIC. A SHOULD HOLD 0,,-1.
|
||
;IF A HAS -1,,-1 THEN THE DATA IS SKIPPED OVER AND DISCARDED.
|
||
;ON REACHING THE START INSTRUCTION (WHICH PRECEDES THE SYM TAB)
|
||
;RETURN WITH THE INSTRUCTION IN B.
|
||
ALD1A: SAVE A
|
||
ALD1: PUSHJ P,GTWD ;GET HEADER OF NEXT SBLK.
|
||
JUMPGE B,POPAJ ;NONNEGATIVE => IT IS START ADDR. WE ARE DONE.
|
||
MOVE C,B
|
||
ADD B,ARG1 ;ARG TO $L => SHIFT UP THAT MUCH IN CORE.
|
||
ALD2: LDB D,[121000,,B] ;WHAT PAGE LOADING INTO?
|
||
SKIPL (P) ;MAYBE WE ARE SKIPPING THRU FOR :SYMLOD
|
||
CAMN D,(P)
|
||
JRST ALD3 ;OR ALREADY HAVE THAT PAGE IN VPAGE.
|
||
MOVEI A,(B)
|
||
CAIGE A,20 ;MAYBE WE SHOULD LOAD THE ACS.
|
||
CALL ALDAC ;LOAD WHAT PART OF THIS BLOCK GOES IN THE ACS.
|
||
JUMPGE B,ALDND1 ;IF WHOLE THING WENT IN ACS, GET NEXT BLOCK.
|
||
;HERE WE MAP THE PAGE FROM THE INFERIOR. IF FAIL, TRY TO CREATE THE PAGE.
|
||
SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,VPAGE ? %CLIMM,,USRI ? D]
|
||
CALL ALDCOR
|
||
MOVEM D,(P) ;SAY NOW HAVE THAT PAGE.
|
||
ALD3: MOVE D,B ;SAVE REAL AOBJN,
|
||
TRZ B,-2000 ;MAKE B -> VPAGE, NOT ADDR IN INFERIOR.
|
||
IORI B,VPAGAD
|
||
MOVSI A,-VPAGAD-2000(B)
|
||
CAML A,B
|
||
HLL B,A ;DON'T GO BEYOND END OF THAT VPAGE.
|
||
PUSHJ P,ALDRD
|
||
HLRS B
|
||
HRLI B,-1(B)
|
||
SUBM D,B
|
||
JUMPL B,ALD2
|
||
ALDND1: PUSHJ P,GTWD
|
||
CAME C,B
|
||
CKSERR: ERSTRT [SIXBIT/CHECKSUM?/]
|
||
JRST ALD1
|
||
|
||
FILENG: TERR (SIXBIT/BIN/)
|
||
|
||
;MAKE THE INFERIOR'S PAGE WHOSE NUMBER IS IN D.
|
||
;RETURN TO INSN PRECEDING THE CALL.
|
||
ALDCOR: SAVE D
|
||
SAVE A
|
||
AOS A,ALDPAG ;IF LOADING ABOVE CORE WE'VE CREATED,
|
||
MOVEM D,ALDPAG ;WE MUST ALSO CREATE ALL PAGES IN BETWEEN.
|
||
SUBM A,D ;GET # PAGES WE MUST CREATE
|
||
HRLI A,-1(D) ;GET AOBJN TO PAGES WE MUST CREATE
|
||
SYSCLO CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,USRI ? A ? %CLIMM,,%JSNEW]
|
||
SOS -2(P)
|
||
SOS -2(P)
|
||
JRST POPADJ
|
||
|
||
ALDAC: SAVE W1 ;LOAD A BLOCK INTO THE ACS (AOBJN IN B)
|
||
MOVE W1,B
|
||
ALDACL: CALL GTWD ;TRANSFER ONE WORD
|
||
ROT C,1 ;UPDATING THE CHECKSUM IN C.
|
||
ADD C,B
|
||
MOVE D,B
|
||
HRRZ A,W1
|
||
CALL DEP
|
||
ADDI A,1 ;ADVANCE TO NEXT WORD. EXIT AFTER XFERRING THE WHOLE BLOCK
|
||
AOBJP W1,ALDACX
|
||
CAIE A,20 ;OR WHEN IT'S TIME TO LOAD A NON-AC.
|
||
JRST ALDACL
|
||
ALDACX: MOVE B,W1
|
||
REST W1
|
||
RET
|
||
|
||
ALDRD: MOVE A,B
|
||
PUSHJ P,GTWD1
|
||
ALDRD1: MOVE A,B
|
||
ALDRD2: ROT C,1
|
||
ADD C,(A)
|
||
AOBJN A,.-2
|
||
POPJ P,
|
||
|
||
GTWD: HRROI A,B
|
||
GTWD1: .IOT UTIC,A
|
||
JUMPL A,FILENG
|
||
POPJ P,
|
||
|
||
ALDIM: CALL VPAGET ;IMAGE LOAD, GET A FRESH PAGE TO USE AS A BUFFER.
|
||
.ACCESS USRO,ARG1 ;START AT 1ST ARG.
|
||
.USET USRI,[.RMEMT,,A]
|
||
LSH A,-10.
|
||
MOVEM A,ALDPAG ;DON'T TAKE TIME TO CORTYP ABOVE JOB'S ORIGINAL MEMT.
|
||
ALDIM1: MOVE A,[-2000,,VPAGAD]
|
||
LDB B,[.BP 1777,ARG1] ;DON'T READ SO MUCH THAT WE'D PASS A PAGE BOUNDARY
|
||
TSO A,B ;IN THE JOB.
|
||
.IOT UTIC,A ;READ UP TO 1 PAGE.
|
||
MOVEI D,-VPAGAD(A)
|
||
JUMPE D,ALDIM2 ;NO MORE LEFT IN FILE?
|
||
ADDB D,ARG1 ;GET ADDR OF 1ST WORD WE AREN'T ABOUT TO WRITE.
|
||
CAIG D,20 ;WRITING ONLY IN ACS => DON'T NEED TO CREATE CORE.
|
||
JRST ALDIM3
|
||
SUBI D,1
|
||
LSH D,-10.
|
||
CAML D,ALDPAG ;IF THIS PAGE IS ABOVE WHAT INFERIOR'S MEMT WAS,
|
||
JRST ALDIM4 ;WE KNOW WE NEED TO MAKE CORE.
|
||
SYSCLE CORTYP,[%CLIMM,,USRI ? D ? %CLOUT,,B]
|
||
JUMPL B,ALDIM3 ;IF THERE ISN'T A WRITEABLE PAGE THERE ALREADY, MAKE ONE.
|
||
ALDIM4: SYSCLO CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,USRI ? D ? %CLIMM,,%JSNEW]
|
||
ALDIM3: HRLOI B,-1-VPAGAD(A)
|
||
EQVI B,VPAGAD ;AOBJN -> WHAT WAS READ.
|
||
JUMPGE B,ALDIM2 ;NOTHING WAS READ, DONE.
|
||
.IOT USRO,B ;WRITE INTO INFERIOR.
|
||
JUMPGE A,ALDIM1 ;NO EOF => TRY FOR MORE.
|
||
ALDIM2: MOVE D,ARG1
|
||
CALL PLOC ;SET "." TO THE END OF THE DATA READ.
|
||
JRST VPAGRT
|
||
|
||
ALDXIT: .CLOSE UTIC,
|
||
RET
|
||
|
||
;LOAD THE SYMBOLS FOR THE FILE OPEN ON UTIC, ASSUMING UTIC IS POSITIONED AT THE SYM TAB.
|
||
ALDS: PUSH P,JOBSYM(U) ;(WILL WANT TO SEE LATER IF SYMTAB WAS ORIGINALLY EMPTY)
|
||
SETO W2, ;SET FLAG SAYING ABOUT TO CALL SLOD0 THE 1ST TIME.
|
||
ALDS0: PUSHJ P,GTWD ;NOW LOAD 1 SBLK -
|
||
SKIPL A,B ;GET -LENGTH,, AS ARG.
|
||
JRST ALDS2 ;NO MORE SYMS.
|
||
ANDI B,-1
|
||
CAIN B,STBUND ;DECODE BLOCK TYPE. IT MAY CONTAIN UNDEFINED SYMBOL REFERENCES,
|
||
JRST ALDSU
|
||
CAIN B,STBFIL ;THE NAME OF A FILE WHOSE SYMBOLS WE SHOULD LOAD,
|
||
JRST ALDSI
|
||
CAIN B,STBINF ;THE RANDOM BIN FILE INFO (WHO ASSEMBLED AND WHEN, ETC).
|
||
JRST ALDSBI
|
||
CAIE B,STBDEF ;OR SYMBOL DEFINITIONS.
|
||
JRST FILENG
|
||
MOVEI B,GTWD1
|
||
PUSHJ P,SLOD0 ;READ IN THOSE SYMS.
|
||
MOVE A,C ;GET AOBJN -> SPACE FILLED WITH SYMS READ.
|
||
HLLZS C ;PUT HEADER OF SBLK INTO CKSUM.
|
||
ALDS3: PUSHJ P,ALDRD2 ;CALCULATE CKSUM.
|
||
PUSHJ P,GTWD ;READ CHECKSUM.
|
||
CAME C,B
|
||
JRST CKSERR
|
||
JRST ALDS0
|
||
|
||
ALDSI: HRRI A,NCTLTF ;LOAD SYMBOLS FROM ANOTHER FILE.
|
||
CAME A,[-4,,NCTLTF] ;THERE SHOULD BE 4 WORDS OF FILENAMES IN THIS BLOCK.
|
||
JRST FILENG
|
||
CALL GTWD1 ;READ THEM IN, THEN IGNORE THE CHECKSUM.
|
||
CALL GTWD
|
||
CALL GTWD ;ANY BLOCKS IN THE FILE AFTER THIS ONE WILL BE IGNORED,
|
||
JUMPL B,FILENG ;SO ANY FILE THAT HAS THEM IS A LOSER.
|
||
SYSCLO OPEN,[ [.BII,,UTIC] ? NCTLTF ? NCTLTF+1 ? NCTLTF+2 ? NCTLTF+3]
|
||
;THEN OPEN THE FILE,
|
||
REST A ;THROW AWAY JOBSYM(U) PUSHED AT ALDS.
|
||
JRST CSMI2 ;DO A :SYMLOD OF THE FILE NOW OPEN.
|
||
|
||
ALDSU: MOVEI W1,UNDEFL(U) ;LOAD A BLOCK OF UNDEF. SYMBOL TABLE.
|
||
SAVE A
|
||
HRR A,UNDEFL(U) ;GET AOBJN TO THE NEW SPACE
|
||
movei b,stbund ;RH for checksum
|
||
JRST ALDSU1
|
||
|
||
ALDSBI: MOVEI W1,BININF(U)
|
||
SAVE A
|
||
HRR A,BININF(U)
|
||
movei b,stbinf ;RH for checksum
|
||
ALDSU1: EXCH A,(P)
|
||
CALL HOLE0 ;MAKE SPACE TO READ INTO
|
||
REST A
|
||
MOVE C,A
|
||
CALL GTWD1 ;READ THE DATA IN
|
||
MOVE A,C
|
||
hrri c,(b) ;RH goes into the checksum
|
||
JRST ALDS3 ;CHECK THE CHECKSUM AND READ MORE OF FILE.
|
||
|
||
ALDS2: POP P,A
|
||
TRNE F,OLOADF ;ALWAYS SORT FOR :OLOAD.
|
||
JRST SSRT
|
||
JUMPL A,SSRT ;IF MERGED FILE'S SYMS WITH OTHERS, MUST SORT.
|
||
JUMPGE W3,SSRT ;IF FILE DIDN'T HAVE SORTED SYMS, SORT.
|
||
JRST SGLOB ;ELSE SET PRGM -> GLOBAL BLOCK, DON'T SORT.
|
||
|
||
KSYMAD: TDZA B,B ;DON'T FLUSH CURRENT SYMS.
|
||
KSYMLO:
|
||
CSMI: MOVNI B,1
|
||
HRLM B,(P)
|
||
PUSHJ P,QOJERR ;CAN'T :SL IN SYS JOB OR SELF.
|
||
PUSHJ P,RRFLB
|
||
CALL KLOADO
|
||
SKIPGE (P)
|
||
CALL ELECTRON
|
||
MOVE A,[6,,UTIC]
|
||
TSCLO UFILO
|
||
SAVE [NLTL4]
|
||
SAVE [ALDXIT]
|
||
;HERE TO LOAD SYMBOLS FROM A FILE JUST OPENED. DOESN'T CLOSE IT.
|
||
CSMI2: PUSHJ P,VPAGET
|
||
PUSHJ P,GTWD
|
||
JUMPN B,CSMI4 ;SBLK (FIRST WORD 0=> FILE PLOADED)
|
||
MOVE B,[UTIC,,VPAGAD]
|
||
.RCHST B,
|
||
SKIPGE VPAGAD+4 ;ACCESS POINTER
|
||
ERSTRT [SIXBIT /PURE FILE NOT ON DISK?/]
|
||
MOVE B,[-400,,VPAGAD] ;READ THE PAGE DESCRIPTOR WDS.
|
||
.IOT UTIC,B
|
||
MOVSI B,-400
|
||
MOVEI W1,1 ;THE DESCRIPTORS TAKE 1 PAGE OF FILE.
|
||
CSMI5: SKIPLE VPAGAD(B) ;SOME DESCRIPTORS HAVE PAGES IN FILE.
|
||
AOJ W1,
|
||
AOBJN B,CSMI5
|
||
LSH W1,12 ;CONVERT # PAGES TO ACCESS POINTER
|
||
.ACCESS UTIC,W1 ;SKIP TO END OF PROGRAM
|
||
JRST CSMI3 ;NOW LOAD SYMBOLS (1ST WORD >0)
|
||
|
||
CSMI4: TDZA W1,W1 ;SKIP TO THE SYM TAB OF AN SBLK FILE, THE HARD WAY.
|
||
PUSHJ P,GTWD
|
||
CAME B,[JRST 1] ;FIRST, SKIP PAST THE SBLK LOADER IF ANY.
|
||
AOJA W1,.-2
|
||
CSMI3: MOVNI A,1 ;THEN, "LOAD" THE DATA, BUT INTO BIT BUCKET INSTEAD
|
||
CALL ALD1A ;OF INTO THE INFERIOR'S CORE.
|
||
CALL VPAGRT ;ALD1A RETURNS ON REACHING THE SYMBOL TABLE.
|
||
JRST ALDS
|
||
|
||
;<ARG>^Y - ARG IS AOBJN -> SYMS TO LOAD. $^Y FLUSHES EXISTING SYMS FIRST.
|
||
NCTLY: CALL QOJERR
|
||
TLNE B,O.1ALT
|
||
CALL ELECTRON
|
||
CALL GARGDQ ;GET ARG OR $Q IN D.
|
||
NCTLY1: JUMPGE D,NCTLYX ;DO NOTHING IF ADDING 0 SYMS.
|
||
HRRZ B,D ;GET ADDRESS OF BEGINNING OF AREA
|
||
.ACCESS USRI,B
|
||
MOVE A,D ;GIVE AOBJN TO SLOD.
|
||
PUSH P,[NCTLYX]
|
||
SAVE JOBSYM(U) ;ALDS2 WILL LOOK AT & POP THIS.
|
||
PUSH P,[ALDS2] ;MAYBE SORT SYM TAB AFTER LOADING.
|
||
JSP B,SLOD
|
||
SAVE XRWI
|
||
SETOM XRWI ;MAKE MPV'S ON THE USR-IOT BELOW CAUSE THE IOT TO SKIP.
|
||
.IOT USRI,A
|
||
CAIA
|
||
JRST ERR
|
||
REST XRWI
|
||
RET
|
||
|
||
n2acx: skipn masscp ;do we want this command?
|
||
7NRTYP [ASCIZ/ OP? /]
|
||
skipn confrm ;do we want confirmation?
|
||
jrst massac ; no, so don't ask!
|
||
PUSHJ P,RIN
|
||
JRST ALTDQX ;IF RUBOUT, RETYPE THE $U.
|
||
CAIE D,".
|
||
JRST NXERR
|
||
jrst massac ;kill them all
|
||
|
||
N2ACY: SKIPN ARG1+1 ;$$^Y
|
||
JRST NXERR
|
||
CALL QI6JERR ;JOB MUST BE INFERIOR OR PDP6 TO WRITE SYMTAB INTO IT.
|
||
MOVE A,ARG1
|
||
PUSHJ P,FETCH ;READ AOBJN POINTER.
|
||
JRST NXERR
|
||
N2ACY1: SAVE A
|
||
HLRE A,D ;GET LEFT HALF
|
||
MOVMS A ;LENGTH OF EXISTING TABLE.
|
||
ADDI A,(D) ;ADDR OF WD AFTER END OF TABLE.
|
||
HLRE D,JOBSYM(U)
|
||
ADD A,D ;START OF NEW SYM TAB.
|
||
JUMPLE A,NXERR ;NO ROOM?
|
||
.ACCESS USRO,A
|
||
MOVE D,JOBSYM(U)
|
||
SAVE XRWI
|
||
SETOM XRWI
|
||
.IOT USRO,D ;TRANSFER IT.
|
||
CAIA
|
||
TERR 'MPV
|
||
REST XRWI
|
||
MOVE D,A
|
||
HLL D,JOBSYM(U) ;NEW AOBJN POINTER.
|
||
REST A
|
||
PUSHJ P,DEP
|
||
NCTLYX: SKIPE HAKING
|
||
JRST HAKWIN
|
||
JRST NLTL2
|
||
|
||
;LOAD SYMS FROM ARBITRARY SOURCE.
|
||
;B HOLDS ADDR OF ROUTINE TO TAKE AOBJN IN A AND READ IN SYMS.
|
||
;LH OF A IS -<SIZE OF TABLE>
|
||
;CLOBBERS A,B,C,D,W1,W2,W3.
|
||
SLOD: SETO W2, ;ABOUT TO CALL SLOD0 THE 1ST TIME.
|
||
SLOD0: JUMPGE A,CPOPJ ;NOTHING TO ADD.
|
||
TLNE A,1
|
||
ERSTRT [SIXBIT /ODD LENGTH SYMBOL TABLE?/]
|
||
ANDCMI A,-1 ;MAKE SURE RH, CLEAR.
|
||
SAVE [0]
|
||
PUSH P,A
|
||
JUMPE W2,SLOD1 ;NOT 1ST TIME => DON'T INITIALIZE.
|
||
SKIPL JOBSYM(U)
|
||
PUSHJ P,SINIT ;CREATE GLOBAL BLOCK IF NONE.
|
||
HRRZ D,JOBSYM(U)
|
||
HLRE A,JOBSYM(U)
|
||
SUBM D,A ;GET ADDR OF WD AFTER SYMTAB.
|
||
MOVEM A,PRGM(U)
|
||
HRROI A,W2 ;READ 1ST 2 WDS OF SYM TAB.
|
||
PUSHJ P,(B)
|
||
HRROI A,W3
|
||
PUSHJ P,(B)
|
||
MOVE A,(P) ;GET -<SPACE NEEDED>,,
|
||
TLNE W2,%SYLCL ;1ST SYM LOCAL => NO BLOCK STR, PUT AT END.
|
||
JRST SLOD1
|
||
SLOD2: PUSHJ P,SGLOB ;BLOCK STRUCTURED, LOAD BEFORE GLOBAL BLOCK.
|
||
HRRZS PRGM(U)
|
||
JUMPGE W3,SLOD1
|
||
TLNN W2,%SYFLG
|
||
ADD A,[2,,] ;IF SYMTAB IS SORTED, OVERWRITE EXISTING GLOBAL HEADER
|
||
;TO MERGE OUR GLOBAL BLOCK WITH FILE'S.
|
||
MOVSI D,-2 ;UPDATE PRGM PROPERLY
|
||
MOVEM D,-1(P) ;NECESSARY IN CASE CALL SLOD0 2ND TIME.
|
||
|
||
SLOD1: PUSH P,B
|
||
MOVEI W1,PRGM(U)
|
||
SAVE A
|
||
SAVE JOBSYM(U)
|
||
CALL HOLE0 ;GET ROOM FOR SYMS.
|
||
REST JOBSYM(U)
|
||
REST A
|
||
ADDM A,JOBSYM(U)
|
||
POP P,B ;SYMBOL READIN RTN ADDR.
|
||
POP P,A ;-<# WDS OF SYMS>,,
|
||
REST D
|
||
ADDM D,PRGM(U)
|
||
HLL C,A ;AOBJN -> SPACE FOR THEM, LEAVE IN C FOR ALDS TO CALC. CKSUM.
|
||
MOVE A,C
|
||
JUMPE W2,(B) ;2ND TIME AND AFTER, JUST READ THEM.
|
||
MOVEM W2,(A) ;1ST TIME, STORE THE 1ST 2 WDS.
|
||
MOVEM W3,1(A)
|
||
TLNE W2,%SYFLG ;NOT BLOCK STRUCTURED =>
|
||
SETZ W3, ;TELL ALDS2 MUST SORT IN ANY CASE.
|
||
SETZ W2, ;NEXT TIME, DON'T INITIALIZE.
|
||
AOBJP A,.+1
|
||
AOBJN A,(B)
|
||
POPJ P, ;THOSE 1ST 2 WDS WERE ALL!
|
||
|
||
;SORT THE SYM TAB.
|
||
SSRT: SETZM PRGM(U) ;SAY HAVEN'T YET SEEN GLOBAL BLOCK.
|
||
PUSHJ P,SSBG ;BUBBLE ALL GLOBALS TO END.
|
||
SSRT9: MOVE A,JOBSYM(U)
|
||
SSRTB: JUMPGE A,SSRT2
|
||
MOVE D,(A)
|
||
TLNE D,%SYFLG ;IF NO BLOCK NAME,
|
||
JRST SSRT2 ;PUT GLOBAL BLOCK HERE.
|
||
MOVSI C,4^5 ;FOR :OLOAD, CLEAR SIGN SO WON'T
|
||
TRNE F,OLOADF ;THINK THE BLOCK ALREADY SORTED.
|
||
ANDCAM C,1(A)
|
||
HLRE C,1(A) ;THIS IS <0 IFF BLOCK WAS SORTED.
|
||
JUMPGE C,SSRT3 ;WASN'T SORTED => SORT IT.
|
||
CAMN D,[SQUOZE 0,GLOBAL] ;ALWAYS SORT GLOBAL BLOCK.
|
||
JRST [MOVEM A,PRGM(U) ? JRST SSRT3]
|
||
HRLI C,-1(C) ;DON'T SORT, JUST PASS
|
||
SUB A,C ;THE BLOCK BY, TRY NEXT.
|
||
JRST SSRTB
|
||
|
||
SSRT2: SKIPE PRGM(U) ;AT END: IF NO GLOBAL BLOCK, MAKE ONE.
|
||
JRST [TRZ F,OLOADF ? RET]
|
||
PUSHJ P,SSRTG
|
||
SSRT3: SKIPE PRGM(U)
|
||
SKIPA D,[%SYFLG,,] ;ONLY GLOBAL BLOCK CAN HAVE GLOBAL SYMS.
|
||
MOVSI D,%SYLCL ;OTHER BLOCKS CAN'T.
|
||
MOVE B,A
|
||
SSRT0: ADD B,[2,,2]
|
||
JUMPGE B,SSRT1 ;MOVE B UP AFTER END OF THIS BLOCK.
|
||
TDNE D,(B)
|
||
JRST SSRT0
|
||
|
||
SSRT1: MOVSI W2,4^5 ;SORT 1ST ON TOP BIT.
|
||
MOVE W1,[TDNE W2,1(A)] ;SORT ON BIT IN 2ND WD,
|
||
MOVE C,[TDNN W2,1(B)] ;PUT STE'S WITH BIT ON FIRST.
|
||
MOVEI W3,[HRLI W1,(TDNN W2,(A))
|
||
HRLI C,(TDNE W2,(B))
|
||
MOVEI W3,SSRTX ;REVERSE THAT LAST, ON THE REST OF THE BITS.
|
||
JRST SSRTX]
|
||
PUSH P,B ;SAVE NEXT BLOCK'S START ADDR.
|
||
ANDI A,-1
|
||
SKIPGE 1(A) ;IF THIS IS GLOBAL BLK BEING SORTED ANYWAY,
|
||
JRST SSRT4 ;DON'T CLOBBER ITS LEVEL.
|
||
AOS D,1(A)
|
||
CAIL D,-1 ;THIS IS PROGM NAME -> MAKE LEVEL 1,
|
||
SETZM 1(A)
|
||
AOS 1(A) ;ELSE 2+LEVEL OF BLOCK.
|
||
SSRT4: SUBM A,B
|
||
HRLM B,1(A) ;STORE -<SIZE OF BLOCK'S ENTRY>
|
||
HRRZ B,(P)
|
||
ADDI A,2 ;DON'T INCLUDE BLOCK NAME IN SORT.
|
||
PUSHJ P,SSRTX
|
||
POP P,A
|
||
JRST SSRTB ;SORT NEXT BLOCK.
|
||
|
||
;CREATE A GLOBAL BLOCK HEADER WHERE A POINTS,
|
||
;MAKE PRGM POINT THERE.
|
||
SSRTG: HRRZM A,PRGM(U) ;PLACE TO PUT IT.
|
||
PUSH P,A
|
||
MOVEI W1,PRGM(U)
|
||
MOVSI A,-2
|
||
ADDM A,JOBSYM(U)
|
||
PUSH P,JOBSYM(U)
|
||
PUSHJ P,HOLE0 ;MAKE SPACE.
|
||
POP P,JOBSYM(U)
|
||
POP P,A
|
||
SUB A,[2,,] ;SYMTAB TAIL -> GLOBAL BLOCK HEADER.
|
||
MOVEM A,PRGM(U)
|
||
MOVE D,[SQUOZE 0,GLOBAL]
|
||
MOVEM D,(A) ;PUT THE STUFF IN.
|
||
MOVSI D,-2
|
||
MOVEM D,1(A)
|
||
POPJ P,
|
||
|
||
SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
|
||
CAIL A,-2(B) ;ONLY 1 ENTRY, NOTHING TO DO.
|
||
JRST SSRTX7
|
||
PUSH P,A ;SAVE START.
|
||
SSRTX3: XCT W1
|
||
JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON.
|
||
SUBI B,2
|
||
XCT C ;MOVE DOWN TO LAST WITH BIT OFF.
|
||
JRST SSRTX5
|
||
REPEAT 2,[
|
||
MOVE D,.RPCNT(A) ;EXCHANGE THEM,
|
||
EXCH D,.RPCNT(B)
|
||
MOVEM D,.RPCNT(A)]
|
||
SSRTX4: ADDI A,2
|
||
SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT.
|
||
JRST SSRTX3 ;MORE IN THIS PASS.
|
||
ROT W2,-1 ;NEXT BIT DOWN.
|
||
POP P,A ;A -> START, B -> END OF 1ST HALF.
|
||
JUMPL W2,SSRTX6 ;ALL BITS IN WD DONE, STOP.
|
||
PUSHJ P,(W3) ;DO NEXT BIT ON 1ST HALF.
|
||
HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL.
|
||
PUSHJ P,(W3) ;DO SECOND HALF.
|
||
SSRTX6: ROT W2,1 ;LEAVE W2 AS FOUND IT.
|
||
SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED.
|
||
POPJ P,
|
||
|
||
;BUBBLE ALL GLOBAL SYMS TO END OF SYM TAB.
|
||
;WON'T CHANGE ORDER OF NON-GLOBAL SYMS, MAY MESS UP ORDER OF GLOBALS.
|
||
SSBG: MOVE A,JOBSYM(U) ;A -> 1ST OFF BUBBLE OF GLOBALS.
|
||
MOVE B,JOBSYM(U) ;B -> 1ST SYM AFTER BUBBLE.
|
||
SSBG0: JUMPGE B,CPOPJ ;ALL DONE IF BUBBLE AT END.
|
||
MOVE C,(B) ;ELS IS NEXT SYM GLOBAL?
|
||
TLNE C,%SYGBL
|
||
JRST SSBG1 ;YES => INCLUDE IT IN BUBBLE.
|
||
EXCH C,(A) ;NO => EXCHANGE WITH 1ST IN BUBBLE,
|
||
MOVEM C,(B) ;MOVING WHOLE BUBBLE UP 1 STE.
|
||
MOVE C,1(B)
|
||
EXCH C,1(A)
|
||
MOVEM C,1(B)
|
||
ADD A,[2,,2] ;BEGINNING AND END BOTH MOVE UP.
|
||
SSBG1: ADD B,[2,,2]
|
||
JRST SSBG0
|
||
|
||
;SET D AND PRGM(U) -> GLOBAL BLOCK'S HEADER.
|
||
;(OR = JOBSYM(U) IF SYMTAB EMPTY)
|
||
SGLOB: PUSH P,A
|
||
SKIPL D,JOBSYM(U)
|
||
JRST SGLOB1
|
||
SGLOB0: MOVE A,(D)
|
||
CAMN A,[SQUOZE 0,GLOBAL]
|
||
JRST SGLOB1 ;FOUND.
|
||
ADD D,[2,,2]
|
||
JRST SGLOB0
|
||
|
||
SGLOB1: MOVEM D,PRGM(U)
|
||
JRST POPAJ
|
||
|
||
;INITIALIZE SYM TAB WITH A GLOBAL BLOCK WITH NO SYMS.
|
||
SINIT: SKIPGE JOBSYM(U)
|
||
ERLOSS JOBSYM(U)
|
||
PUSH P,A
|
||
MOVE A,JOBSYM(U)
|
||
PUSHJ P,SSRTG
|
||
JRST POPAJ
|
||
|
||
;:PRGM, PRINT CURRENT PROGRAM NAME.
|
||
KPRGM: PUSHJ P,QJERR ;MUST HAVE JOB.
|
||
SKIPL W1,PRGM(U)
|
||
7NRTYP [ASCIZ/No Syms /]
|
||
PUSHJ P,SPT ;PRINT BLOCK'S NAME.
|
||
HRRZ D,1(W1) ;GET LEVEL.
|
||
SOJL D,LCTGNR ;IF BLOCK IS GLOBAL BLOCK.
|
||
SOJL D,[7NRTYP [ASCIZ/, Program /]]
|
||
7TYPE [ASCIZ/, Level /] ;A BLOCK IN PROGRAM.
|
||
PUSHJ P,TOC
|
||
JRST LCTGNR
|
||
|
||
;:LISTP - LIST STRUCTURE OF SYM. TAB.
|
||
KLSTP: PUSHJ P,QJERR
|
||
HLRE W1,JOBSYM(U) ;GET -LENGTH OF SYMTAB
|
||
JUMPGE W1,NLTL2 ;IF NO SYMS.
|
||
CALL MORINI
|
||
JRST NLTL2 ;STOP TYPING IF A **MORE** IS FLUSHED.
|
||
MOVNS W1
|
||
ADD W1,JOBSYM(U)
|
||
ANDI W1,-1 ;ADDR OF WD AFTER SYMTAB.
|
||
KLSTP1: CAMN W1,JOBSYM(U)
|
||
JRST KLSTUX ;GOT TO START OF SYMTAB, DONE.
|
||
SUB W1,[2,,2] ;MOVE BACK 1 SYM AT A TIME.
|
||
MOVE D,(W1)
|
||
TLNE D,%SYFLG
|
||
JRST KLSTP1 ;NOT BLOCK, KEEP GOING.
|
||
MOVE A,1(W1)
|
||
CAMN A,[-2,,1]
|
||
JRST KLSTP1 ;IGNORE PROGRAM NAMES WITH NO SYMS.
|
||
PUSHJ P,CRF ;EACH NAME ON SEPARATE LINE.
|
||
TRNE A,-2 ;FOR BLOCKS, USE <LEVEL>-1.
|
||
SUBI A,1 ;SO OUTERMOST BLOCK GETS 1 SPACE LIKE PROGRAM.
|
||
TLZA A,-1 ;GET <LEVEL> IN RH ALONE.
|
||
KLSTP2: PUSHJ P,TSPC ;TYPE LEVEL SPACES.
|
||
SOJGE A,KLSTP2
|
||
PUSHJ P,SPT ;THEN TYPE NAME OF BLOCK OR PROGRAM.
|
||
JRST KLSTP1
|
||
|
||
NACOL: PUSHJ P,QJERR
|
||
SKIPL A,JOBSYM(U) ;<BLOCK>$:, <BLOCK>$$:
|
||
JRST NACOLE
|
||
HLRE D,A
|
||
SUB A,D
|
||
ANDI A,-1 ;ADDR OF WD AFTER SYM TAB.
|
||
SETZ D, ;ASSUME IT'S $: AND AREN'T CHECKING LEVEL.
|
||
TLNN B,O.2ALT
|
||
JRST NACOL8
|
||
MOVE A,PRGM(U) ;REALLY IT'S $$:, LOOK FOR CURRENT BLOCK'S INFER.
|
||
MOVE D,1(A)
|
||
AOS D,
|
||
NACOL8: CAMN A,JOBSYM(U) ;CAN'T MOVE BACK PAST START.
|
||
NACOLE: ERSTRT [SIXBIT / U?/]
|
||
SUB A,[2,,2]
|
||
CAME C,(A)
|
||
JRST NACOL8 ;HAVEN'T FOUND THE BLOCK, WRONG NAME OR NOT BLOCK.
|
||
JUMPE D,NACOL6 ;RIGHT NAME, TESTING LEVEL?
|
||
HLL D,1(A) ;COMPARE ONLY THE RH'S.
|
||
CAME D,1(A)
|
||
JRST NACOL8 ;WE ARE AND IT DOESN'T MATCH.
|
||
NACOL6: MOVEM A,PRGM(U)
|
||
JRST LCTGNR
|
||
|
||
;;; How DDT's core allocator works:
|
||
;;; The basic idea is that there is a heap, objects in which are delimited by
|
||
;;; AOBJN ptrs into the area, and which may be grown or removed.
|
||
;;; Now the specifics:
|
||
;;;
|
||
;;; Pointers into SYMTAB space (the heap, remember?) are relocated when objects
|
||
;;; are moved, by the routine RELOC. There are two IRPS's in there denoting
|
||
;;; the locations of the pointers needing relocating. The first is the
|
||
;;; per-job items, (symbol-tables, JCL, etc.) the second is random global vars
|
||
;;; such as JCL, rubout processing, and the like.
|
||
;;;
|
||
;;; Initially such pointers (which don't have to be AOBJN ptrs,) should point
|
||
;;; to DDTEND. They will be re-located as things are allocated.
|
||
;;;
|
||
;;; Space is provided for these items by calling HOLE0 with
|
||
;;; -<# words to expand by>,,0 in A and the address of the AOBJN ptr to expand
|
||
;;; in W1. It isn't necessary that W1 point to an AOBJN ptr that's relocated
|
||
;;; by RELOC, you can have byte pointers relocated by RELOC and put an AOBJN
|
||
;;; ptr on the stack and have w1 point to that.
|
||
;;;
|
||
;;; Call ELEC0 to flush an object in SYMTAB space, with an AOBJN ptr in W1
|
||
;;; (It must be an AOBJN ptr this time)
|
||
|
||
;FLUSH THE CURRENT JOB'S SYMBOLS.
|
||
ELECTRON: HRRZ W1,JOBSYM(U)
|
||
CAIG W1,DDT ;DO NOTHING IF SELF OR SYSTEM.
|
||
RET
|
||
HRRZ D,SYMTOP
|
||
MOVEM D,PRGM(U)
|
||
MOVEI W1,JOBSYM(U)
|
||
|
||
;FLUSH AN OBJECT IN SYMTAB SPACE.
|
||
;W1 POINTS TO AOBJN PTR OBJECT, PTR CLOBBERED TO SYMTOP.
|
||
ELEC0: HLLZ D,(W1) ;-<CURRENT SIZE>,,
|
||
JUMPE D,CPOPJ ;NOTHING TO DO IF ALREADY 0 SIZE.
|
||
HRRZ A,(W1) ;CURRENT START.
|
||
HRLI A,(A)
|
||
SUB A,D ;END,,START
|
||
HLRES D
|
||
ADD D,SYMTOP ;NEW SYMTOP.
|
||
CAIE D,(A) ;DON'T TRY BLT OF 0 WDS.
|
||
BLT A,-1(D)
|
||
HRRZS (W1)
|
||
HRRZ A,SYMTOP
|
||
EXCH A,(W1) ;GET OLD START, OBJECT NOW EMPTY, -> TOP.
|
||
SUB D,SYMTOP ;GET -<OLD SIZE>.
|
||
|
||
;RELOCATE ALL POINTERS INTO SYMTAB SPACE
|
||
;WHEN PART OF IT IS SHIFTED.
|
||
;A HAS OLD START OF OBJECT THAT CHANGED SIZE,
|
||
;D HAS AMOUNT OF CHANGE.
|
||
RELOC: MOVSI W1,-NINFP
|
||
PUSH P,B
|
||
PUSH P,C
|
||
CALL RELC ;FIRST, TRY CHANGING .MEMT, SINCE THAT IS MOST LIKELY THING TO FAIL.
|
||
|
||
rel0: ;For each per-job item in SYMTAB space
|
||
irps x,,jobsym prgm uchbuf bininf undefl radaob
|
||
movei b,x(w1)
|
||
pushj p,rel3 ;relocate it
|
||
termin
|
||
addi w1,usrlng-1 ;Next job
|
||
aobjn w1,rel0 ;(until end)
|
||
|
||
MOVEI B,INPDL ;NOW RELOCATE VALRET STRING & ANY PUSHED VALRET STRINGS.
|
||
REL1: MOVEI B,1(B)
|
||
PUSHJ P,REL3
|
||
MOVEI B,2(B)
|
||
PUSHJ P,REL3
|
||
SKIPE B,-3(B)
|
||
JRST REL1
|
||
IRPS X,,FLDTBP FLDSTR W4 GSCHRP GSCHRQ GSOCRP GSCHRA CLIBEG CLIPTR CLIOPT CLIEND CLIBPT KILBPT KLBEND KLBBEG KLBIPT
|
||
MOVEI B,X
|
||
CALL REL3
|
||
TERMIN
|
||
SKIPE B,RELCP1 ;RELOC. SOME SPECIAL PTR (IF ANY)
|
||
CALL REL3
|
||
ADDM D,SYMTOP
|
||
HRRZS D,SYMTOP ;RELOCATE SYMTOP.
|
||
POPCBJ: POP P,C
|
||
JRST POPBJ
|
||
|
||
;; REL3 takes:
|
||
;; ADDRESS of ptr where relocation is happening in A
|
||
;; ADDRESS of 1 ptr to relocate in B
|
||
;; Amount to grow in D.
|
||
;; it adjusts the pointer if the address of the ptr to relocate is the
|
||
;; same as or larger than the one that changed size.
|
||
|
||
REL3: HRRZ C,(B) ;B HAS ADDR OF 1 PTR TO RELOCATE.
|
||
CAIGE C,(A) ;RELOC IT ONLY IF AFTER OBJECT THAT CHANGED SIZE.
|
||
POPJ P,
|
||
ADDI C,(D)
|
||
HRRM C,(B)
|
||
POPJ P,
|
||
|
||
|
||
|
||
HOLE0: PUSH P,W1 ;SAVE ADDR OF AOBJN PTR TO EXPAND.
|
||
HRRZ C,(W1) ;MAKE SURE AOBJN TO BE EXPANDED
|
||
CAMG C,SYMTOP ;POINTS INTO THE SYMTAB SPACE
|
||
CAIGE C,DDTEND
|
||
ERLOSS (W1)
|
||
HLRE C,(W1)
|
||
MOVNS C ;CURRENT SIZE.
|
||
ADD C,(W1) ;RH HAS 1+CURRENT LAST WD.
|
||
PUSH P,A
|
||
HLRES A
|
||
MOVNS A ;NUM. WDS TO EXPAND.
|
||
HRRZ D,A
|
||
PUSHJ P,RELC ;GET CORE BEFORE MOVE UP.
|
||
HLLZ W1,(P) ;W1 <-
|
||
ADDM W1,@-1(P)
|
||
HOLE1: HRRZ D,SYMTOP
|
||
SOS D
|
||
HRRM A,HOLPPX ;+#REGS NEW
|
||
MOVEI W1,(SETZ D) ;400000+SYMTOP-1 (AVOID PDL OV)
|
||
SUB W1,C
|
||
HRL D,W1 ;400000+#REGS TO MOVE-1,,SYMTOP-1
|
||
SKIPGE D
|
||
HOLPOP: XCT HOLPPX ;MOVE TOP OF SYM TAB UP BY LH(A)
|
||
JUMPL D,.-1
|
||
MOVEI D,(A)
|
||
POP P,A ;GET -<NUM WDS INCREASE> IN LH,
|
||
HRR A,@(P) ;ADDR OF CURRENT START IN RH.
|
||
PUSH P,@(P) ;SAVE THE UPDATED AOBJN PTR
|
||
PUSHJ P,RELOC ;SINCE RELOC WILL WRECK IT.
|
||
POP P,@-1(P)
|
||
JRST POPW1J
|
||
|
||
;ADJUST MEMORY BOUND OF SYTMAB SPACE PROPERLY WHEN SYMTOP IS TO CHANGE
|
||
;BY THE AMOUNT IN D.
|
||
RELC: INSIRP PUSH P,B C D
|
||
ADD D,SYMTOP
|
||
ADDI D,1777
|
||
LDB D,[121000,,D]
|
||
CAIL D,VPAGE-1
|
||
ERSTRT [SIXBIT/CORE?/]
|
||
MOVE C,NPAGES ;GET # 1ST PAGE SYMTAB SPACE DOESN'T HAVE,
|
||
MOVEM D,NPAGES ;REPLACE W # 1ST PAGE IT DOESN'T NEED,
|
||
MOVEI B,%CBNDW ;IF GROWING, ASK FOR WRITE,
|
||
CAML C,D
|
||
TDZA B,B ;SHRINKING, DELETE.
|
||
EXCH C,D
|
||
SUBM D,C ;D HAS 1ST PG TO MUNG, C -<# PGS TO MUNG>
|
||
HRLI D,(C) ;AOBJN -> PGS TO MUNG.
|
||
JUMPGE D,PDCBJ ;NO PGS TO MUNG => DO NOTHING.
|
||
SYSCLO CORBLK,[B ? %CLIMM,,%JSELF ? D ? %CLIMM,,%JSNEW]
|
||
PDCBJ: REST D
|
||
JRST POPCBJ
|
||
|
||
;ALLOCATE AN OBJECT AT TOP OF SYMTAB SPACE; #WDS IN D.
|
||
;RETURN AOBJN PTR TO OBJECT IN A.
|
||
ALLOC: MOVNI A,(D)
|
||
MOVSI A,(A)
|
||
HRR A,SYMTOP ;CONSTRUCT THE AOBJN
|
||
JRST RELOC ;WHICH IS JUST WHAT RELOC WANTS, TOO.
|
||
|
||
;DEFINE SYMBOL, SQUOZE IN SYM VALUE IN D.
|
||
;SETS GLOBAL BIT IN SYM. CLOBBERS A,C,D,W1.
|
||
DEFIN: LDB A,[4000,,SYM]
|
||
CAMN A,[SQUOZE 0,. ] ;DON'T ALLOW ".:".
|
||
JRST ERR
|
||
PUSHJ P,DEFUND ;HANDLE UNDEF REFS TO SYM.
|
||
SKIPE SYSSW
|
||
JRST DEFINS
|
||
PUSH P,B
|
||
SAVE SYM
|
||
MOVSI B,%SYFLG
|
||
ANDCAM B,SYM ;CLEAR FLAGS IN SYM.
|
||
PUSH P,D
|
||
SKIPL JOBSYM(U)
|
||
PUSHJ P,SINIT ;CREATE GLOBAL BLOCK IF NONE.
|
||
SAVE W2
|
||
SAVE C
|
||
MOVE A,PRGM(U) ;TRY TO FIND SYM IN CURRENT OR CONTAINING BLK.
|
||
CALL SLUP
|
||
0,,SEVLB1
|
||
SKIPA A,PRGM(U) ;NOT FOUND => DEFINE IN CURRENT BLOCK.
|
||
JRST DEF3
|
||
SKIPE DDTSW
|
||
JRST DEFIND ;CAN'T CALL HOLE0 ON DDT SYM TAB.
|
||
HLL A,1(A)
|
||
ADD A,[2,,2] ;GET AOBJN -> CURRENT BLOCK.
|
||
SAVE A
|
||
MOVSI A,-2
|
||
MOVEI W1,(P) ;MAKE SPACE AFTER THIS BLOCK'S SYMS.
|
||
ADDM A,JOBSYM(U) ;SYM TAB & BLOCK BOTH LONGER.
|
||
ADDM A,PRGM(U)
|
||
MOVE B,PRGM(U)
|
||
ADDM A,1(B)
|
||
PUSHJ P,HOLE0
|
||
MOVEI A,(C) ;GET ADDR OF SPACE JUST MADE.
|
||
DEF2: POP P,W1
|
||
DEF3: REST C
|
||
REST W2
|
||
POP P,1(A) ;PUT VALUE IN DEF.
|
||
REST D ;ORIGINAL VALUE OF SYM.
|
||
TLO D,%SYLCL
|
||
MOVEM D,(A) ;PUT NAME IN, IN CASE NEW SYMBOL.
|
||
DEF4: SUBI A,2
|
||
MOVE D,(A)
|
||
TLNE D,%SYFLG
|
||
JRST DEF4 ;FIND START OF BLOCK DEFINED IN.
|
||
MOVEI W1,(A)
|
||
SUB W1,JOBSYM(U)
|
||
HRLI W1,(W1)
|
||
ADD W1,JOBSYM(U) ;GET AOBJN -> TAIL AT THAT BLOCK,
|
||
HLL W1,1(W1)
|
||
ADD W1,[2,,2] ;AND AOBJN -> BLOCK.
|
||
PUSHJ P,SBUBL ;DO BUBBLE SORT OF THIS BLOCK.
|
||
JRST POPBJ
|
||
|
||
DEFIND: MOVN A,[2,,2] ;DEFINE SYM IN SELF.
|
||
ADDM A,JOBSYM(U)
|
||
ADDM A,STBDDT ;EXTEND DDT SYM TAB DOWNWARD.
|
||
ADDB A,PRGM(U)
|
||
MOVE B,2(A) ;MOVE THE GLOBAL HEADER DOWN 1 STE.
|
||
MOVEM B,(A)
|
||
MOVE B,3(A)
|
||
ADD B,[-2,,] ;1 MORE SYM IN THE GLOBAL BLOCK.
|
||
MOVEM B,1(A)
|
||
MOVEI A,2(A) ;PUT NEW SYM WHERE HEADER WAS.
|
||
JRST DEF3
|
||
|
||
DEFINS: SKIPN SYSDPS
|
||
JRST QIJERR
|
||
MOVEM D,SYM1
|
||
MOVSI D,%SYGBL
|
||
IORM D,SYM
|
||
MOVEI D,SYM
|
||
.REDEF D,
|
||
JRST NXERR
|
||
POPJ P,
|
||
|
||
;DO BUBBLE SORT OF PORTION OF SYMTAB THAT W1 POINTS TO.
|
||
;DO ONE PASS UP, ONE DOWN; ASSUME ONLY ONE ENTRY OUT OF ORDER.
|
||
;CLOBBER A-D AND W1.
|
||
SBUBL: MOVE B,[2,,2] ;INCREMENT FOR UPWARD PASS.
|
||
MOVE C,[JUMPL A,SBUBL1]
|
||
SUBI W1,2 ;(WILL INCREMENT BEFORE ACTING)
|
||
MOVE A,W1
|
||
PUSHJ P,SBUBL2
|
||
MOVNS B ;DECREMENT FOR DOWNWARD PASS.
|
||
MOVE C,[CAMN A,W1]
|
||
JRST SBUBL2
|
||
|
||
SBUBL1: MOVE D,1(A) ;CHECK NEXT PAIR OF ENTRIES.
|
||
CAMG D,3(A)
|
||
JRST SBUBL2 ;IN CORRECT ORDER.
|
||
EXCH D,3(A)
|
||
MOVEM D,1(A) ;WRONG ORDER, EXCHANGE.
|
||
MOVE D,(A)
|
||
EXCH D,2(A)
|
||
MOVEM D,(A)
|
||
SBUBL2: ADD A,B ;MOVE TO NEXT ENTRY.
|
||
XCT C ;TEST IF FINISHED.
|
||
POPJ P,
|
||
JRST SBUBL1 ;(NOT FINISHED)
|
||
|
||
NALTK: CAME D,[200000,,] ;$K, $$K
|
||
JRST NALTK2
|
||
N2ACC1: MOVEM B,(W4)
|
||
MOVEM C,SYM
|
||
PUSHJ P,SEVL
|
||
7NRTYP [ASCII / U/]
|
||
MOVE B,(W4) ;SEVL CLOBBERED B.
|
||
SKIPE SYSSW
|
||
JRST NALTK3
|
||
MOVEI D,%SYHKL_-16.
|
||
TLNE B,O.2ALT
|
||
MOVEI D,%SYKIL_-16.
|
||
DPB D,[420200,,(A)]
|
||
JRST LCTGNR
|
||
|
||
NALTK3: SKIPN SYSDPS
|
||
JRST JERR
|
||
MOVE D,1(A)
|
||
MOVE C,(A)
|
||
TLZ C,%SYLCL+%SYKIL
|
||
TLO C,%SYGBL+%SYHKL
|
||
TLNE B,O.2ALT
|
||
TLO C,%SYFLG
|
||
MOVEI B,C
|
||
.REDEF B,
|
||
JRST ERR
|
||
JRST LCTGNR
|
||
|
||
NALTK2: JUMPN D,NAERR
|
||
TLNN B,O.2ALT
|
||
JRST NXERR
|
||
PUSHJ P,ELECTRON
|
||
JRST NLTL2
|
||
|
||
N2ACC: MOVE C,N2ACCS ;$$^C,GET NAME OF LAST SYM TYPED OUT.
|
||
TLZ C,%SYFLG
|
||
TLZ B,O.2ALT ;TELL N2ACC1 SHOULD ONLY SEMI-KILL.
|
||
SKIPE N2ACC1
|
||
CALL N2ACC1
|
||
MOVE D,LWT
|
||
CALL PVAL
|
||
JRST LCTGNR
|
||
|
||
;LIST ALL UNDEF REFS IN CURRENT JOB.
|
||
KLSTU: JUMPL U,JERR
|
||
MOVE B,CJTOUT
|
||
MOVEM B,SPTS ;SPT1 WILL CALL TOUT WITH EACH CHAR.
|
||
SKIPGE B,UNDEFL(U) ;DON'T TYPE ANYTHING IF NO UNDEF REFS.
|
||
CALL MORINI ;STOP TYPING AND RETURN IF A **MORE** IS FLUSHED.
|
||
JRST NLTL2
|
||
KLSTU0: PUSHJ P,CRF ;HANDLE NEXT ONE,
|
||
MOVE D,(B)
|
||
PUSHJ P,SPT1 ;PRINT SYMBOL NAME,
|
||
PUSHJ P,LCT
|
||
SKIPGE D,1(B)
|
||
7TYPE [ASCIZ/S /] ;SAY SO IF SWAPPED REF.
|
||
ANDI D,-1
|
||
PUSH P,B
|
||
PUSHJ P,PAD ;TYPE LOCATION REF IS FOR.
|
||
POP P,B
|
||
AOBJN B,.+1
|
||
AOBJN B,KLSTU0
|
||
KLSTUX: CALL MORFL2 ;CLEAR MORPRP TO CANCEL THE MORINI.
|
||
JRST NLTL2
|
||
|
||
;WHEN DEFINING SYMBOL (SQUOZE IN SYM W/ FLAGS CLEAR, VALUE IN D)
|
||
;SATISFY ITS UNDEF REFS. CLOBBRS W1.
|
||
DEFUND: PUSH P,B
|
||
SKIPL B,UNDEFL(U)
|
||
JRST POPBJ ;NO UNDEF REFS IN JOB.
|
||
PUSH P,A
|
||
PUSH P,D
|
||
DEFU0: MOVE A,(B) ;IS THIS UNDEF REF
|
||
XOR A,SYM ;A REF FOR THIS SYMBOL?
|
||
TDNE A,[237777,,-1]
|
||
JRST DEFU2 ;NO, LOOK AT NEXT.
|
||
HRRZ A,1(B) ;GET ADDR. REF IS FOR.
|
||
PUSHJ P,FETCH
|
||
JRST DEFU1 ;CAN'T READ THAT LOC., FLUSH THE UNDEF REF.
|
||
SKIPGE 1(B) ;IF SWAPPED REF, SWAP THE SYMBOL.
|
||
MOVSS (P)
|
||
ADD D,(P) ;ADD SYM TO LOC'S CONTENTS,
|
||
SKIPGE 1(B)
|
||
MOVSS (P)
|
||
PUSHJ P,DEP ;STORE THE SUM BACK.
|
||
DEFU1: PUSHJ P,REMUN ;FLUSH THE SATISFIED UNDEF REF.
|
||
DEFU2: AOBJN B,.+1
|
||
AOBJN B,DEFU0
|
||
POP P,D
|
||
POPABJ: POP P,A
|
||
JRST POPBJ
|
||
|
||
;REMOVE THE UNDEFINED-SYMBOL ENTRY THAT B POINTS TO.
|
||
;LEAVE B POINTING TO THE ENTRY BEFORE THE ONE DELETED.
|
||
REMUN: PUSH P,B
|
||
HRRZ W1,SYMTOP ;IF IT'S THE LAST THING IN SYMTAB SPACE,
|
||
CAIN W1,2(B)
|
||
JRST REMUN1 ;THERE'S NOTHING ABOVE IT TO BLT DOWN.
|
||
HRLI B,2(B) ;ELSE BLT ALL ABOVE IT DOWN BY 2.
|
||
BLT B,-2(W1)
|
||
REMUN1: POP P,B
|
||
SUBI B,2
|
||
PUSH P,A
|
||
MOVE A,UNDEFL(U)
|
||
ADD A,[2,,] ;UNDEFL STARTS IN SAME PLACE BUT 1 LESS ENTRY.
|
||
MOVNI D,2 ;CHANGE IN SIZE IS -2.
|
||
PUSHJ P,RELOC ;RELOCATE ALL OBJECTS THAT WERE BLTED.
|
||
SKIPL A ;IF UNDEFL IS NOW EMPTY,
|
||
HRRZ A,SYMTOP ;MAKE IT BE AT TOP OF SPACE.
|
||
MOVEM A,UNDEFL(U)
|
||
JRST POPAJ
|
||
|
||
;UPDATE UNDEFINED SYMBOL REFS WHEN DEPOSITING IN LOCATION
|
||
;WHOSE ADDRESS IS IN A. CLOBBERS C,D,W1.
|
||
DEPRMV: PUSH P,B
|
||
TLNE A,-1 ;IF IT'S A FUNNY LOCATION, THERE CAN'T BE ANY UNDEF REFS IN IT
|
||
JRST DEPRM2 ;(AND DON'T LOOK, SINCE THERE MIGHT NOT BE A CURRENT JOB EITHER)
|
||
SKIPL B,UNDEFL(U)
|
||
JRST DEPRM1 ;J IF NO UNDEF SYM REFS.
|
||
DEPRM0: CAIE A,@1(B) ;ELSE REMOVE EACH UNDEF REF
|
||
JRST DEPRM1 ;FOR THE WORD BEING DEPOSITED IN.
|
||
PUSHJ P,REMUN
|
||
DEPRM1: AOBJN B,.+1
|
||
AOBJN B,DEPRM0
|
||
DEPRM2: SKIPN B,UNDFRP ;ANY UNDEFS IN QTY BEING DEPOSITED?
|
||
JRST POPBJ ;J IF NONE.
|
||
TLNE A,-1
|
||
JRST NUNDER ;UNDEF REFS NOT ALLOWED WHEN DEPOSITING IN FUNNY LOCATION.
|
||
PUSH P,A
|
||
MOVSI A,-2 ;ELSE GET ROOM FOR 1 UNDEF REF.
|
||
MOVEI W1,UNDEFL(U)
|
||
PUSHJ P,HOLE0
|
||
MOVE A,(P) ;GET BACK THE ADDRSS STORING IN.
|
||
MOVE B,UNDFRP
|
||
HLL A,UNDFRL-1(B)
|
||
MOVEM A,1(C) ;STORE TYPE AND ADDRESS OF UNDEF.
|
||
MOVE A,UNDFRL-2(B)
|
||
MOVEM A,(C) ;STORE SYMBOLN NAME.
|
||
POP P,A
|
||
SUBI B,2 ;REMOVE THE UNDEF SYM JUST HANDLED.
|
||
MOVEM B,UNDFRP
|
||
JRST DEPRM2 ;LOOK FOR ANY MORE UNDEF SYMS.
|
||
|
||
OPLK2: MOVE D,OPLK1
|
||
MOVEI W1,SYM
|
||
MOVE A,[(440700)TXT]
|
||
PUSHJ P,.SPT
|
||
OPLK1: IDPB D,A
|
||
|
||
;OPDECODER
|
||
|
||
OPEVAL: MOVEM P,SAVPDL
|
||
TRZA F,R.OUT
|
||
OPTYPE: TRO F,R.OUT
|
||
LSH D,-27.
|
||
MOVEM D,INST
|
||
MOVE D,[(440700)TXT]
|
||
MOVEM D,CHP
|
||
SETZB A,W1
|
||
MOVE W2,BTAB
|
||
DC1: ILDB D,W2
|
||
CAILE D,40
|
||
CAIL D,73
|
||
SOJGE A,DC1
|
||
JUMPG A,DC1
|
||
SUBI D,40
|
||
JUMPE D,DECX
|
||
JUMPG D,DC2
|
||
DPB D,[(340500)PNTR]
|
||
TRZ D,-4
|
||
AOS D
|
||
DPB D,[(300600)PNTR]
|
||
TRNN F,R.OUT
|
||
JRST DC6
|
||
LDB A,PNTR
|
||
JRST DC1
|
||
DC2: HRREI D,-33(D)
|
||
JUMPL D,DECT
|
||
MOVE W1,D
|
||
IDIVI W1,4
|
||
MOVE W2,BTAB(W2)
|
||
ADDI W2,(W1)
|
||
JRST DC1
|
||
|
||
BTAB: REPEAT 4,<44-11*.RPCNT>_12.+1100,,TBL
|
||
|
||
DECT: TRNE F,R.OUT
|
||
JRST O1CZ
|
||
ILDB W1,CHP
|
||
CAIE W1,133(D)
|
||
JRST LOSE
|
||
JRST DC1
|
||
|
||
DECX: TRNE F,R.OUT
|
||
POPJ P,
|
||
ILDB W1,CHP
|
||
JUMPE W1,DC7
|
||
LOSE: POP P,A
|
||
POP P,W2
|
||
POP P,PNTR
|
||
POP P,CHP
|
||
LOSE1: AOS A
|
||
DPB A,PNTR
|
||
LDB A,PNTR
|
||
JUMPN A,DC6AA
|
||
CAME P,SAVPDL
|
||
JRST LOSE
|
||
JUMPL U,CPOPJ
|
||
SKIPE SYSSW
|
||
POPJ P,
|
||
MOVE A,JOBSYM(U)
|
||
PUSHJ P,SLUP ;SEARCH EVERY BLOCK.
|
||
2,,SEVLB1
|
||
POPJ P, ;NOT FOUND.
|
||
MOVE D,1(A) ;GET THE VALUE.
|
||
SETZM FNYLOC
|
||
SKIPE HAKING ;OMIT THE REST IN .BREAK 12, .
|
||
JRST CPOPJ1
|
||
PUSH P,A
|
||
PUSH P,D
|
||
SAVE B ;REMEMBER PTR TO BLOCK FOUND IN.
|
||
LOSE6: EXCH A,B
|
||
PUSHJ P,[PUSH P,[SLUPR] ? JRST SEVLB2]
|
||
2,,SEVLB1 ;KEEP ON SEARCHING.
|
||
JRST LOSE3 ;NO MORE DEFINITIONS => UNIQUE.
|
||
MOVE D,1(A) ;FOUND ANOTHER DEF,
|
||
CAMN D,-1(P) ;DIFFERENT VALUE => VALUE NOT UNIQUE.
|
||
JRST LOSE6 ;SAME => KEEP LOOKING.
|
||
CTYPE ""
|
||
LOSE2: REST W1 ;MAKE BLOCK FOUND IN BE CURRENT,
|
||
MOVEM W1,PRGM(U)
|
||
PUSHJ P,SPT ;PRINT PRGM OR BLOCK'S NAME.
|
||
7TYPE [ASCIZ/:/]
|
||
POPDA1: POP P,D
|
||
POPAJ1: POP P,A
|
||
CPOPJ1: POPJ1: AOS (P)
|
||
CPOPJ: POPJ P,
|
||
|
||
LOSE3: CTYPE "'
|
||
JRST LOSE2
|
||
|
||
DC6: MOVEI A,0
|
||
DPB A,PNTR
|
||
DC6AA: CAMN P,SAVPDL
|
||
JRST DC6BB
|
||
LDB D,-2(P)
|
||
CAME D,(P)
|
||
JRST LOSE1
|
||
DC6BB: PUSH P,CHP
|
||
PUSH P,PNTR
|
||
PUSH P,W2
|
||
PUSH P,A
|
||
JRST DC1
|
||
|
||
DC7: MOVE P,SAVPDL
|
||
MOVE D,INST
|
||
LSH D,27.
|
||
POPJ2:
|
||
CPOPJ2: AOS (P)
|
||
JRST CPOPJ1
|
||
|
||
O1CZ: MOVEI D,133(D)
|
||
PUSHJ P,TOUT
|
||
JRST DC1
|
||
|
||
;********************************************************
|
||
|
||
TBL:
|
||
.BYTE 9
|
||
|
||
DEFINE HACK A
|
||
IRPS B,D,[A]
|
||
Z=="D
|
||
IFE Z-":,B==.BYTC
|
||
IFE Z-"/, B+73
|
||
IFE Z-"^, <B&70>_-1+B&7-1
|
||
IFE <Z-40>*<Z-15>,[
|
||
IRPC Q,,B
|
||
Z=="Q
|
||
IFE Z-".,Z=100
|
||
Z-40
|
||
TERMIN
|
||
]
|
||
TERMIN
|
||
TERMIN
|
||
|
||
|
||
;INITIAL DISPATCH
|
||
HACK [63^. YFLO/ YHAK/ YACCP/ YBOOLE/ H YHWT/ T YACBM/ . ]
|
||
|
||
;BYTE AND FLOATING INST
|
||
HACK [YFLO: 33^ YADJS/ YDPR/ YFXFL/ YBYTE/ FAD YA/ FSB YA/ FMP YA/ FDV YA:
|
||
21^ YLMB/ R 02^ YLMB/ YI/ YLMB/ YLMB: 02^ . YL:L. YM:M. YB:B.
|
||
YADJS: 21^ . 02^ . ADJSP. . .
|
||
YDPR: D 21^ F YDPRFL/ 02^ ADD. SUB. MUL. DIV.
|
||
YDPRFL: 02^ AD. SB. MP. DV.
|
||
YFXFL: 03^ DMOVE. DMOVN. FIX. EXTEND. DMOVEM. DMOVNM. FIXR. FLTR.
|
||
YBYTE: 03^ UF YPA/ DF YN/ FS YC/ IB YP: P. I YLD/ YLD: LD YB/ I YDP/ YDP: DP YB/]
|
||
|
||
;FWT, FIXED POINT ARITH, MISC.
|
||
HACK [YHAK: 33^ YMV/ YMV: MOV YMO/ YML/ YDV/ YSH/ YH1/ YJP/
|
||
21^ ADD YIMB/ SU YBIMB: B YIMB: 02^ . YI:I. YM/ YB/ YMO: 22^
|
||
YEIMS: E YIMS/ S YIMS/ N YIMS/ M YIMS: 02^ . YI/ YM/ YS: S.
|
||
YML: 21^ I YML1/ YML1: MUL YIMB/ YDV: 21^ I YDV1/ YDV1:
|
||
DI YDV2: V YIMB/ YH1: 03^ EXC YS3/ BL YT: T. YAO/ YAO: AOBJ
|
||
YAOB/ JRS YT/ JFC YL/ XC YT/ . YAOB: 01^ YP/ YN/
|
||
YJP: 03^ YPU/ YPU: PUSH YPUS/ YPO/ YPO: POP YPOP/ JSR.
|
||
JS YP/ JS YPA: A. JR YPA/ YPUS: 01^ YJ: J.. YPOP:
|
||
01^ . YJ/ YSH: 02^ A YS2/ ROT YS1/ L YS2: S YS3: H YS1/ 21^ JFFO. CIR YC/
|
||
YS1: 21^ . YC: C. ]
|
||
|
||
;ARITH COMP, SKIP, JUMP
|
||
HACK [YACCP: 42^ CA YCA1/ YSJ/ A YJS/ S YJS: O 31^
|
||
J YCOMP/ S YCOMP/ YCA1: 31^ I YCOMP/ M YCOMP/
|
||
YSJ: 31^ JUM YPSJ/ SKI YPSJ: P YCOMP:
|
||
03^ . YL/ YE: E. L YE/ YPA/ G YE/ YN: N. G. ]
|
||
|
||
;BOOLEAN
|
||
HACK [YBOOLE: 24^ YST/ YAN: AND YB2/ YAN/ YST/ YAN/ YST/
|
||
X YOR: OR YB2/ I YOR/ YAN/ EQ YDV2/ YST/ YOR/ YST/ YOR/ YOR/
|
||
YST: SET YB2: 24^ Z YIMB/ YIMB/ YCA: C YTA/ YTM: M YIMB/
|
||
YCM: C YTM/ YTA: A YIMB/ YIMB/ YIMB/ YCB: C YBIMB/ YIMB/ YCA/
|
||
YCA/ YCM/ YCM/ YCB/ O YIMB/ ]
|
||
|
||
;HALF WORDS
|
||
HACK [YHWT: 51^ YHW1/ 21^ R YHW2/ L YHW2: R YHW3/ YHW1:
|
||
21^ L YHW4/ R YHW4: L YHW3: 32^ YIMS/ Z YIMS/ O YIMS/
|
||
YEIMS/ ]
|
||
|
||
;TEST INST
|
||
HACK [YACBM: 31^ YAC1/ 01^ D YAC2/ S YAC2/ YAC1: 01^ R YAC2/ L
|
||
YAC2: 42^ N YEAN/ Z YEAN/ C YEAN/ O YEAN: 12^ . YE/ YPA/ YN/ ]
|
||
|
||
.BYTE
|
||
|
||
|
||
;EVAL SYM WITH NAME IN D.
|
||
;IF FOUND, SKIP, WITH ADDR OF STE IN A, VALUE IN D, FUNNINESS IN FNYLOC
|
||
;CLOBBERS LOTS OF ACS.
|
||
SEVLD: MOVEM D,SYM
|
||
SEVL: JUMPL U,SEVL1 ;NO JOB => JUST INITIAL SYM TABS.
|
||
SKIPE SYSSW
|
||
JRST SEVLS ;SYS JOB SPECIAL.
|
||
MOVE A,PRGM(U)
|
||
PUSHJ P,SLUP ;SEARCH CURRENT BLOCK AND CONTAINING.
|
||
0,,SEVLB1
|
||
SEVL1: SKIPA B,[-STBIOL,,STBIO] ;NOT FOUND, TRY ORDINARY INITIAL SYMS.
|
||
JRST SEVLW ;FOUND, SLUP SKIPPED 2.
|
||
PUSHJ P,SEVLB1
|
||
SKIPA B,STBSO ;TRY SYSTEM DEFAULT ORDINARY SYMS.
|
||
JRST SEVLW ;FOUND IN ORDINARY INITAIL SYMS.
|
||
PUSHJ P,SEVLB1
|
||
SKIPA B,[-STBESA,,STBES]
|
||
JRST SEVLW
|
||
SKIPE ESSYM ;TRY E&S SYMS IF ..ESSYM SET, EG DYNAMOD
|
||
CALL SEVLB1
|
||
SKIPA B,[-STBIFL,,STBIF] ;TRY INITIAL FUNNY SYMS.
|
||
JRST SEVLW
|
||
PUSHJ P,SEVLB1
|
||
SKIPA B,STBSF ;TRY SYSTEM DEFAULT FUNNY SYMS.
|
||
JRST SEVLF
|
||
PUSHJ P,SEVLB1
|
||
POPJ P, ;FOUND NOWHERE.
|
||
SEVLF: MOVE D,1(A) ;GET VALUE (FUNNINESS IN LH)
|
||
TLNN D,7^5 ;ALL BITS OFF => 4.8 IS DEFAULT.
|
||
TLO D,2^5
|
||
TLNE D,1^5 ;4.7 => REL. TO U.
|
||
JUMPL U,CPOPJ
|
||
TLZE D,1^5
|
||
ADDI D,(U)
|
||
MOVEM D,FNYLOC ;REMEMBER FUNNYNESS,
|
||
ANDI D,-1 ;BUT REMOVE FROM VALUE.
|
||
JRST POPJ1
|
||
|
||
SEVLS: MOVE B,SYSAOB ;GET AOBJN -> SYS SYMA.
|
||
SUBI B,772000-SYSSYM
|
||
PUSHJ P,SEVLB1 ;SYS SYM TAB JUST SYMS, NO BLOCKS.
|
||
JRST SEVL1
|
||
SEVLW: MOVE D,1(A) ;FOUND ORDINARY SYMBOL.
|
||
SETZM FNYLOC
|
||
JRST POPJ1
|
||
|
||
;CALL SEVLB1 TO SEARCH AREA <- AOBJN IN B.
|
||
SEVLB2: ADD B,[2,,2]
|
||
SEVLB1: JUMPGE B,CPOPJ
|
||
MOVE D,(B)
|
||
TLZ D,%SYFLG
|
||
CAME D,SYM
|
||
JRST SEVLB2
|
||
MOVE D,(B)
|
||
TLNE D,%SYKIL ;IGNORE IF DELETED.
|
||
JRST SEVLB2
|
||
EXCH A,B
|
||
JRST POPJ1
|
||
|
||
;PUSHJ P,SLUP ? FLAG,,RTN WITH SYMTAB TAIL -> BLOCK HEADER IN A.
|
||
;ALSO PUTS IN B AOBJN -> SYMS IN THAT BLOCK.
|
||
;FLAG=0 => CALL FOR EACH GOOD BLOCK, =1 => FOR EACH BAD BLOCK,
|
||
;=2 => FOR EACH BLOCK.
|
||
;THE GOOD BLOCKS ARE THE CURRENT BLOCK AND ALL CONTAINING BLOCKS.
|
||
;AN AOBJN -> TAIL OF SYMTAB STARTING AT BLOCK HEADER WILL BE
|
||
;IN B WHEN RTN IS CALLED (WITH A PUSHJ).
|
||
;IF RTN SKIPS, SLUP WILL GIVE UP AND SKIP 2.
|
||
;OTHERWISE, SLUP WILL RETURN SKIPPING 1 AT END OF SYMTAB.
|
||
|
||
SLUP0: MOVEI B,(A) ;B _ AOBJN -> SYMS IN BLOCK.
|
||
HLL B,1(A)
|
||
ADD B,[2,,2]
|
||
HRRZ C,@(P) ;GET ADR OF RTN, CALL IT.
|
||
PUSHJ P,(C)
|
||
SLUPR: CAIA
|
||
JRST POPJ2 ;IF RTN SKIPPED, SO DO WE.
|
||
SLUP1: HLRE B,1(A)
|
||
MOVNI B,(B)
|
||
HRLI B,(B) ;THIS PUTS IN A AN AOBJN ->
|
||
ADD A,B ;SYMTAB TAIL -> NEXT BLOCK.
|
||
SLUP3: JUMPGE A,POPJ1 ;NO MORE BLOCKS.
|
||
JUMPE W2,POPJ1 ;QUIT AFTER DOING GLOBAL BLOCK.
|
||
LDB B,[400400,,(A)]
|
||
JUMPN B,POPJ1 ;NOT BLOCK HEADER => IGNORE NTS DDT'S INITIAL SYMS.
|
||
HLRZ C,@(P) ;GET FLAG (0, 1, OR 2)
|
||
HRRZ B,1(A) ;NEXT BLOCK'S LEVEL.
|
||
CAMN A,PRGM(U)
|
||
JRST SLUP2 ;CURRENT BLOCK ALWAYS GOOD.
|
||
CAIN B,1 ;OTHER PROGRAMS & INNER BLOCKS NEVER GOOD.
|
||
JRST [MOVEI W2,1 ? JRST @SLUPF(C)]
|
||
CAIN B,2 ;OUTERMOST BLOCK OF GOOD PROGRAM IS GOOD.
|
||
JUMPL W2,SLUP2
|
||
CAIL B,(W2) ;SOMETHING AT LOWER LEVEL IS GOOD.
|
||
JRST @SLUPF(C)
|
||
SLUP2: MOVEI W2,(B) ;W2 HAS LEVEL OF LAST GOOD BLOCK.
|
||
CAIN W2,1 ;IF THIS IS PROGRAM NAME,
|
||
JRST [HLRZ B,1(A) ;IF NO SYMBOLS IN IT,
|
||
CAIE B,-2
|
||
JRST .+1
|
||
HRRZ B,3(A) ;IF THAT'S DUE TO BLOCK STRUCTURE,
|
||
CAIL B,2
|
||
SETO W2, ;NEXT GOOD BLOCK IS OUTERMOST IN PROGRAM.
|
||
JRST .+1]
|
||
JRST @SLUPT(C) ;THIS IS A GOOD BLOCK.
|
||
|
||
SLUPT: SLUP0
|
||
SLUPF: SLUP1
|
||
SLUP0
|
||
SLUP0
|
||
|
||
SLUP: MOVEI W2,1
|
||
JRST SLUP3
|
||
|
||
;LOOK FOR VALUE IN D. LEAVES D UNCHANGED.
|
||
;IF FIND SYMBOL WITH THAT VALUE, TYPE NAME & DON'T SKIP, W1 -> STE.
|
||
;ELSE SKIP, WITH STE ADDR OF BEST FOUND IN W1. (OR 0 IN W1 IF NONE FOUND)
|
||
;CLOBBERS A,B,C,I1
|
||
SLUK: SAVE [[JRST SPT ? JRST POPJ1]]
|
||
SLUK1: SETZM PBMASK
|
||
SLUK2: SETZ W1, ;NO BEST SO FAR YET.
|
||
JUMPL U,POPJ1 ;NO JOB => FAIL TO FIND IT.
|
||
SKIPE SYSSW
|
||
SKIPA A,SYSAOB ;SYS JOB=> COMPUTE "JOBSYM", ELSE
|
||
SKIPA A,PRGM(U) ;START LOOKING AT 1ST GOOD BLOCK.
|
||
SUBI A,772000-SYSSYM
|
||
PUSHJ P,SLUP
|
||
0,,SLUKBB ;BINARY-SEARCH EACH BLOCK.
|
||
SKIPA A,JOBSYM(U)
|
||
RET ;EXACT MATCH,RETURN NOT SKIPPING.
|
||
PUSHJ P,SLUP ;LOOK THRU BAD BLOCKS.
|
||
1,,SLUKBB
|
||
SKIPA B,STBSO
|
||
RET
|
||
SKIPE PBMASK ;CONSIDER SYSTEM ORDINARY SYMS ONLY IN BIT MODE,
|
||
CALL SLUKBB ;SINCE THEY'RE HALF-KILLED.
|
||
SKIPA B,[-STBIOL,,STBIO]
|
||
RET
|
||
SKIPE PBMASK ;CONSIDER INITIAL ORDINARY SYMS FOR SAKE OF .BREAK 12 CODES.
|
||
CALL SLUKBB ;AGAIN, THEY'RE NEEDED ONLY IN BIT TYPEOUT MODE
|
||
JRST POPJ1 ;NO EXACT MATCH, SKIP RETURN.
|
||
RET ;EXACT, DON'T SKIP.
|
||
|
||
;BINARY SEARCH IN VECTOR OF STE'S <- AOBJN IN B
|
||
;FOR VALUE IN D. CLOBBERS B,C,I1.
|
||
SLUKB: SETZM PBMASK
|
||
SLUKBB: AOJGE B,CPOPJ ;QUIT IF EMPTY; B -> 2ND WD OF STE.
|
||
HLRE C,B
|
||
HRLI B,C ;B IS INDEX OF C.
|
||
MOVNS I1,C
|
||
;B -> INSIDE AREA, IDX OF C.
|
||
;C = SIZE OF LAST STEP.
|
||
;I1 = # WDS LEFT IN PART OF AREA AFTER B.
|
||
;LEAVES B POINTING TO LAST (IN CORE) SYMBOL WHOSE VALUE IS .LE. DESIRED VALUE.
|
||
;THEN GOES TO SLUKB1.
|
||
SLUKB0: CAILE C,(I1) ;C_MAX(LAST STEP,SPACE LEFT)
|
||
MOVEI C,(I1)
|
||
CAIN C,2 ;ONLY 1 ENTRY TO SEARCH THRU => DONE.
|
||
SOJA B,SLUKB1 ;(UNDO EFFECT OF AOJGE AT SLUKB)
|
||
LSH C,-1 ;STEP = .5* SIZE OF STUFF TO SEARCH.
|
||
TRZE C,1 ;ROUND UP TO EVEN NUMBER.
|
||
ADDI C,2
|
||
CAMGE D,@B ;E.A. IS RH(B)+STEP.
|
||
JRST SLUKB0 ;THAT'S TOO FAR, DON'T MOVE B.
|
||
HRRI B,@B ;NOT TOO FAR, SET PTR THERE.
|
||
SUBI I1,(C) ;WE'RE CLOSER TO END NOW.
|
||
JRST SLUKB0
|
||
|
||
SLUKB3: REST D
|
||
SLUKB2: SUBI B,2
|
||
SLUKB1: MOVE C,(B) ;FOUND THAT VALUE,
|
||
SKIPN PBMASK ;IF BIT TYPEOUT MODE, HALFKILLED SYMBOLS ARE OK.
|
||
TLNN C,%SYHKL
|
||
TLNE C,%SYKIL
|
||
JRST SLUKB2 ;MOVE BACK TILL SYM THAT'S OK TO USE.
|
||
CAML D,1(B) ;(MAYBE ALL SYMS IN BLOCK ARE TOO LARGE)
|
||
TLNN C,%SYFLG
|
||
POPJ P, ;REACHED HEADER => NO SYM THIS BLOCK.
|
||
SLUKS3: MOVE C,1(B) ;GET THAT SYM'S VALUE.
|
||
CAIE W1, ;NO PREVIOUS BEST OR
|
||
CAMLE C,1(W1) ;BETTER THAN PREVIOUS BEST =>
|
||
MOVEI W1,(B) ;IT IS BEST.
|
||
CAME C,D ;EXACT MATCH?
|
||
RET
|
||
SKIPN PBMASK ;YES: IF NOT BIT TYPEOUT MODE, END SEARCH RIGHT HERE.
|
||
JRST POPJ1
|
||
HRRZ W1,B
|
||
MOVE C,(W1) ;BIT TYPEOUT MODE: DOES SYMBOL BEGIN WITH DESIRED PREFIX?
|
||
SUB C,PBSYM
|
||
TLZ C,%SYFLG
|
||
SAVE D
|
||
IDIV C,PBMASK
|
||
JUMPN C,SLUKB3 ;NO, KEEP LOOKING THRU SYMTAB.
|
||
JRST POPDJ1 ;YES, STOP SEARCH.
|
||
|
||
;TYPE ARG IN D SYMBOLICALLY. ($$S MODE)
|
||
;CLOBBERS JUST ABOUT ALL ACS.
|
||
TMS:
|
||
PIN: TLNN D,-1 ;JUST AN ADDRESS =>
|
||
JRST PAD ;PRINT AS SUCH.
|
||
PUSH P,D
|
||
MOVE I2,D
|
||
TLC I2,700000
|
||
SKIPN KS10IO
|
||
TLZ I2,77000 ;ON KS, ONLY APR, PI DEVICES USE I/O INSN FORMAT
|
||
TLNN I2,777000
|
||
JRST PINIO ;I-O INSN (MAYBE)
|
||
PUSHJ P,SLUK
|
||
JRST POPDJ ;FOUND SYMBOL WITH EXACTLY RIGHT VALUE.
|
||
TLNN D,777^3
|
||
JRST HLFWPD ;(OP CODE IS 0)
|
||
MOVSI I2,-3 ;TRY LOOKING FOR USER-DEF OP CODES.
|
||
LDB A,[331100,,D]
|
||
CAIN A,.CALL_-33 ;IF INSN IS A .CALL OR .OPER, DON'T USE A USER-DEFINED SYMBOL
|
||
MOVSI I2,-1 ;THAT ISN'T AS GOOD AS THE SYSTEM SYMBOL FOR IT.
|
||
CAIN A,.OPER_-33
|
||
MOVE I2,[-1,,1]
|
||
PIN0: JUMPE W1,PININI ;(CAN GIVE UP FAST)
|
||
MOVE D,(P)
|
||
AND D,PINTB0(I2) ;LOOK FOR SOME PART OF VALUE.
|
||
CAMLE D,1(W1) ;IF LARGEST < PREV. SEARCHED (WHICH WAS
|
||
JRST PIN1 ;LARGER) IS TOO SMALL, WON'T FIND THIS.
|
||
CAMN D,1(W1) ;MAYBE LAST TIME'S BEST IS WHAT WE WANT.
|
||
JRST PINUUO
|
||
PUSHJ P,SLUK
|
||
JRST PINUU1 ;FOUND USER INSN NAME.
|
||
PIN1: AOBJN I2,PIN0
|
||
PININI: MOVSI D,777000
|
||
AND D,(P) ;GET OP-CODE FIELD ONLY.
|
||
HLRZ A,D
|
||
CAIL A,4^4
|
||
CAIL A,5^4
|
||
CAIA
|
||
JRST PINMON ;THIS IS A SYSTEM CALL.
|
||
CAIN A,(ADJSP)
|
||
JRST PIN4
|
||
CAIE A,257000
|
||
CAIGE A,(DFAD)
|
||
JRST HLFWPD ;NOT AN INSTRUCTION.
|
||
CAIL A,7^5 ;I/O INSTRUCTIONS AREN'T KNOWN TO OPTYPE
|
||
JRST PINNEG
|
||
PIN4: CALL OPTYPE ;PRINT THE INSN NAME.
|
||
JRST PININS ;GO PRINT THE REST.
|
||
|
||
IFNDEF ADJSP,ADJSP==105000,,
|
||
IFNDEF DFAD,DFAD==110000,,
|
||
|
||
PINTB0: 777740,, ;FIRST TRY OPCODE & AC FIELD.
|
||
777037,,-1 ;THEN OPCODE & ADDRESS STUFF.
|
||
777000,, ;THEN JUST OPCODE.
|
||
|
||
;VALUE IS A SYSTEM CALL.
|
||
PINMON: CAIN A,(.CALL) ;IF A .CALL, INCLUDE AC FIELD.
|
||
JRST PINCAL
|
||
CAIE A,(.OPER) ;IF .OPER, INCLUDE ADDRESSING STUFF.
|
||
JRST PINMO1 ;OTHER SYSTEM CALLS, D HAS JUST OPCODE
|
||
HRLOI D,777037
|
||
PINMO2: AND D,(P)
|
||
PINMO1: SETZ W1,
|
||
MOVE B,STBSO ;SEARCH SYSTEM ORDINARY SYMS
|
||
PUSHJ P,SLUKB ;FOR NAME OF SYSTEM CALL.
|
||
CAIA
|
||
JRST PINUUO ;FOUND, TYPE IT AND THE REST.
|
||
MOVSI D,777000 ;.CALL OR .OPER WITH NO SPECIAL NAME,
|
||
JRST PINMO2 ;PRINT AS ".OPER ETC" OR ".CALL ETC".
|
||
|
||
PINCAL: MOVSI D,777740 ;HERE FOR .CALL N, - LOOK FOR SYSTEM SYMBOL CONTAINING
|
||
AND D,(P) ;BOTH THE .CALL AND THE N,.
|
||
SKIPE UCHNLO ;BUT IF .CALL 0, IF WE HAVE A JOB,
|
||
CAME D,[.CALL]
|
||
JRST PINMO2
|
||
7TYPE [ASCIZ /.CALL/] ;PARSE THE ARGUMENT BLOCK THE .CALL POINTS TO.
|
||
CALL [ SAVE -1(P)
|
||
JRST PININS] ;AFTER PRINTING THE INSN ITSELF AS ".CALL " PLUS ADDRESS FIELD.
|
||
CALL EASETU
|
||
MOVE D,(P)
|
||
CALL NEFECC ;GET E.A. OF THE .CALL INSN.
|
||
HRRZ A,I1
|
||
CALL RFETCH ;IS 1ST WORD OF ARG BLOCK A SETZ?
|
||
JRST POPDJ
|
||
CAME D,[SETZ]
|
||
JRST POPDJ ;JUST GIVE UP IF ARG BLOCK MALFORMED.
|
||
AOS A
|
||
CALL RFETCH
|
||
JRST POPDJ
|
||
7TYPE [ASCIZ / (/]
|
||
CALL SIXTYP ;TYPE THE NAME OF THE CALL, IN PARENS.
|
||
CTYPE ")
|
||
JRST POPDJ
|
||
|
||
PININ1: TLNE D,777000 ;CALL HERE TO PRINT SOMETHING AS AN INSN EVEN IF OP-CODE
|
||
JRST PIN
|
||
SAVE D ;IS MISSING (1,, PRINTS AS "(1)"). IF HANDED 0, WILL
|
||
SAVE D ;PRINT NOTHING, SO WATCH OUT.
|
||
JRST PININ2
|
||
|
||
PINUUO: PUSHJ P,SPT ;PRINT INSN'S NAME.
|
||
PINUU1: SKIPA A,1(W1) ;A_ THOSE BITS THAT INSN TOOK CARE OF.
|
||
PININS: MOVSI A,777000 ;(ASSUME THEY WERE OPCODE FIELD)
|
||
ANDCA A,(P) ;GET WHAT'S LEFT TO HANDLE.
|
||
JUMPE A,POPDJ
|
||
PUSH P,A
|
||
PUSHJ P,TSPC ;SPACE AFTER INSN NAME.
|
||
PININ2: LDB D,[270400,,A]
|
||
JUMPE D,PIN2
|
||
CALL PAD
|
||
;SIGN OF (P) WILL BE SET IFF GOT HERE FROM PES.
|
||
PINIO1: CTYPE ",
|
||
PIN2: MOVE D,(P)
|
||
TLZ D,777757 ;HAVE IND. BIT AND ADDR FIELD.
|
||
TLZE D,(@)
|
||
CTYPE "@ ;TYPE @ IF INDIRECT.
|
||
JUMPE D,PIN3 ;PRINT ADDR IF NOT 0.
|
||
TRO F,NAF ;ADDR FIELD MAY BE NEGATIVE.
|
||
HLRZ A,-1(P)
|
||
TRZ A,(0 17,(17))
|
||
PUSHJ P,[
|
||
ROT A,-11
|
||
TLZN A,<(@)>_11
|
||
CAIN A,JFFO_-33
|
||
JRST PINAD ;PRINT ADDR IN CURRENT MODE
|
||
CAIL A,240
|
||
CAILE A,247 ;BUT IF NON-INDIRECT SHIFT INSN,
|
||
JRST PINAD
|
||
JRST PADA0] ;PRINT NUMERICALLY.
|
||
TRZ F,NAF
|
||
PIN3: LDB D,[220400,,(P)]
|
||
SETO I1,
|
||
MOVE A,-1(P)
|
||
SKIPGE (P)
|
||
LDB I1,[410300,,A] ;E&S INSN => GET CLASS OF INSN,
|
||
CAIN I1,2 ;FOR CLASS 2 INSN,
|
||
TLNE A,17 ;TYPE IDX FIELD EVEN IF 0 UNLESS INCLUDED IN INSN.
|
||
JUMPE D,POPADJ ;PRINT INDEX FIELD IF NOT 0.
|
||
CTYPE "(
|
||
SAVE N2ACCS ;$$^C SHOULDN'T SEE SYMS IN INDEX FIELD.
|
||
CALL [ JUMPL I1,PAD ;PDP10 INSN => TYPE AS ADDRESS.
|
||
JRST PESIDX] ;E&S INSN => PRINT IDX SPECIALLY.
|
||
REST N2ACCS
|
||
CTYPE ")
|
||
POPADJ: POP P,A ;(NOTE THIS ISN'T WHAT A HAD AT CALL)
|
||
JRST POPDJ
|
||
|
||
;PRINT WHAT MIGHT BE AN IO INSTRUCTION.
|
||
PINIO: JUMPL U,PINIO4 ;NO JOB => SIMPLE TEST.
|
||
SKIPGE JOBSYM(U) ;SAME IF NO SYMS OR SYS JOB.
|
||
SKIPE SYSSW
|
||
JRST PINIO4
|
||
MOVE A,UJNAME(U)
|
||
CAME A,[SIXBIT/PDP10/]
|
||
CAMN A,[SIXBIT/PDP6/]
|
||
JRST PINIO4 ;PDP6 => IO INSNS OK.
|
||
LDB D,[320700,,(P)]
|
||
CAIE D,TTY/4 ;DEVICES TTY, DIS, PI, APR ALWAYS AS IO INSN.
|
||
CAIN D,DIS/4
|
||
JRST PINIO3
|
||
SOJLE D,PINIO3 ;(CHECK FOR 0,1 = APR,PI)
|
||
LDB A,[320700,,(P)]
|
||
LSH A,2 ;GET DEVICE CODE AND MULTIPLY BY 4
|
||
CALL SQZ3D ;CONVERT 3 DIGITS TO SQUOZE.
|
||
ADD D,[SQUOZE 0,..D] ;HAVE SQUOZE 0,..D!DEV
|
||
PUSHJ P,SEVLD
|
||
JRST PINNEG ;NOT DEF, DON'T PRINT AS IO INSN.
|
||
PINIO3: LDB D,[270300,,(P)]
|
||
LSH D,1 ;WHICH IO INSN IS IT?
|
||
MOVEI W1,PINIO9(D)
|
||
PUSHJ P,SPT ;PRINT INSN NAME.
|
||
PUSHJ P,TSPC
|
||
MOVSI D,77400
|
||
AND D,(P) ;GET DEVICE CODE.
|
||
JUMPE D,PINIO5 ;DEVICE 0, DON'T PRINT SYMBOLICALLY.
|
||
PUSHJ P,SLUK
|
||
JRST PINIO2 ;HAVE SYMBOL FOR IT.
|
||
PINIO5: MOVE B,[-STBIOL,,STBIO]
|
||
PUSHJ P,SLUKB ;LOOK FOR TTY,PTR,PI,DIS ETC.
|
||
JRST PINIO8
|
||
CALL SPT
|
||
JRST PINIO2 ;FOUND ONE OF THEM.
|
||
PINIO8: LSH D,-30
|
||
PUSHJ P,TOC ;ELSE TYPE IN OCTAL.
|
||
PINIO2: PUSH P,(P)
|
||
MOVSI D,4^5 ;SIGN OF (P) SHOULD BE CLEAR,
|
||
ANDCAM D,(P) ;ELSE PIN WILL PRINT IDX AS E&S CRAP.
|
||
JRST PINIO1
|
||
|
||
PINIO4: CAMGE D,[BLKI 740,] ;OLD SIMPLE TEST, PRINT AS IO INSN
|
||
JRST PINIO3 ;UNLESS LH IS SMALL NEGATIVE NUMBER.
|
||
PINNEG: MOVN D,(P) ;NOT TO PRINT AS IO INSN; HALFWORD OR NEG. NUMBER.
|
||
CAIL D,200000
|
||
JRST HLFWPD ;TOO LARGE FOR SMALL NEG NUM.
|
||
POP P,D
|
||
ANDI D,-1
|
||
JRST PADA1 ;GO TYPE "-", NEGATE AND PRINT RH.
|
||
|
||
;CONVERT 3 DIGITS IN A TO RIGHT-JUSTIFIED SQUOZE IN D. NO ZERO SUPPRESSION.
|
||
SQZ3D: PUSH P,C
|
||
LDB D,[.BP 700,A]
|
||
LDB C,[.BP 70,A]
|
||
IMULI D,50
|
||
ADDI D,51(C)
|
||
IMULI D,50
|
||
LDB C,[.BP 7,A]
|
||
ADDI D,1(C)
|
||
JRST POPCJ
|
||
|
||
;PRINT VALUE IN D IN CURRENT MODE.
|
||
;CLOBBERS ALL ACS.
|
||
PVAL: MOVE C,SCH ;GET CURRENT MODE.
|
||
PVAL2: HLRE A,C
|
||
AOJE A,(C) ;LH IS -1 => RH IS ADDR OF RTN IN DDT.
|
||
AOJN A,PVAL3
|
||
ADDI C,(U) ;LH -2 => RH SPECS USER VAR TO GO THRU.
|
||
SKIPGE U ;BUT IF NO JOB, USE CORRESP. MASTER VAR.
|
||
ADDI C,MAMPER-TAMPER+1
|
||
MOVE C,(C)
|
||
JRST PVAL2 ;USE THE MODE HELD THERE.
|
||
|
||
PVAL3: MOVEM C,34SAV ;ELSE IT'S INSN TO $X.
|
||
SAVE D
|
||
CALL GXBLKD
|
||
MOVEI A,XBLK$Q(D)
|
||
REST D
|
||
CALL RDEP ;SAVE VALUE TO TYPE OUT IN USER'S 37 (OR WHEREVER)
|
||
JRST PIN
|
||
SUBI A,XBLK$Q-XBLK.
|
||
MOVE D,LLOCO
|
||
CALL RDEP ;STORE VALUE OF . IN WORD 25 OR WHEREVER.
|
||
JRST PIN
|
||
SETOM PVALFL
|
||
SETOM XCRFSW
|
||
SAVE PPC(U)
|
||
SAVE UINTWD(U)
|
||
SAVE XECPC(U)
|
||
SAVE XINTWD(U)
|
||
SAVE UPI0(U)
|
||
MOVEI A,1 ;ARRANGE NOT TO CLOSE LOCATION WHEN
|
||
CALL HGO1 ;RETURN VIA .BREAK 16, IN 35 .
|
||
REST UPI0(U)
|
||
REST XINTWD(U)
|
||
REST XECPC(U)
|
||
REST UINTWD(U)
|
||
REST PPC(U)
|
||
RET
|
||
|
||
;PRINT ARG (IN D) IN HALFWORD MODE.
|
||
TMH:
|
||
HLFW: PUSH P,D
|
||
HLFWPD: HLRZ D,(P)
|
||
SETZM PBANGL
|
||
AOS PBANGL ;WE NEED <->'S AROUND (-)'S IN THE LEFT HALF.
|
||
CALL PADBL0 ;PRINT L.H., USING BIT MODE IF ENABLED.
|
||
HLFW1: 7TYPE [ASCIZ /,,/]
|
||
REST D
|
||
ANDI D,-1 ;NOW PRINT THE RH.
|
||
JRST PADBR
|
||
|
||
;PRINT THE R.H. OF AN INSTRUCTION. THE VALUE SHOULD BE IN D.
|
||
;THE OPCODE OF THE INSTRUCTION SHOULD BE IN A.
|
||
;USES BIT TYPEOUT MODE IF IT IS SELECTED AND THE OPCODE SPECIFIES IT;
|
||
;OTHERWISE, USES PAD. CLOBBERS ALL ACS (EXCEPT P, W4).
|
||
PINAD: IDIVI A,PCPNTP
|
||
MOVE A,PCPNTB(A)
|
||
IMULI B,PCPNTS
|
||
LSH A,(B)
|
||
LSH A,PCPNTS-36.
|
||
TRNE A,20 ;IF OPCODE SAYS ADDRESS FIELD IS L.H. BITS,
|
||
JRST PADBL ;TRY TO USE BIT MODE.
|
||
TRNE A,10 ;ALSO HACK R.H. BITS IF APPROPRIATE.
|
||
JRST PADBR
|
||
|
||
;PRINT AN ADDRESS (IN D) IN CURRENT MODE. CLOBBERS ALL ACS.
|
||
;NAF ON => IF NUMERIC, OK TO PRINT WITH MINUS SIGN. ALWAYS TURNS NAF OFF.
|
||
PAD: MOVE I2,F ;SAVE NAF AND TURN IT OFF.
|
||
TRZ F,NAF
|
||
TLNE D,-1
|
||
JRST PADF ;ADDR. IS FUNNY.
|
||
PAD1: MOVE A,AR
|
||
CAIE A,PADR ;CHECK FOR CLOBBERAGE OF AR.
|
||
CAIN A,TOC
|
||
JRST (A)
|
||
MOVEI A,PADR
|
||
MOVEM A,AR
|
||
ERLOSS
|
||
|
||
;PRINT THE VALUE IN D AS R.H. BITS IF POSSIBLE; OTHERWISE, AS AN ADDRESS.
|
||
PADBR: TRZ F,NAF
|
||
MOVEI I2,NAF
|
||
SKIPN BITF ;CAN'T USE BIT MODE IF USER HASN'T TURNED IT ON.
|
||
JRST PAD1
|
||
SETZM PBPARN ;BIT NAMES SHOULDN'T BE IN PARENS OR ANGLE BRACKETS.
|
||
MOVE A,BITSYM
|
||
SKIPL B,BITPAT ;DOES MAIN BIT MODE HAVE R.H. BITS?
|
||
TLNN B,1
|
||
JRST PADBR1 ;YES, USE IT.
|
||
MOVE A,BITSY1 ;NO, TRY THE ALTERNATE BIT MODE.
|
||
SKIPL B,BITPA1
|
||
TLNN B,1
|
||
JRST PADBR1
|
||
JRST PAD1
|
||
|
||
PADBR1: JUMPE B,PAD1 ;DON'T TRY TO USE BIT MODE IF NONE EXISTS.
|
||
MOVEM B,PBPAT
|
||
MOVEM A,PBSYM
|
||
JRST PBHWD
|
||
|
||
;PRINT THE VALUE IN D AS L.H. BITS, ASSUMING IT WILL APPEAR IN THE
|
||
;ADDRESS FIELD OF AN INSTRUCTION (IE WILL APPEAR IN A UNSWAPPED PLACE).
|
||
PADBL: SETZM PBANGL ;WE DON'T NEED TO USE ANGLE BRACKETS AROUND PARENS, IF WE USE PARENS.
|
||
PADBL0: TRZ F,NAF
|
||
MOVEI I2,NAF ;(IN CASE WE GIVE UP AND GO TO PAD1)
|
||
SKIPN BITF
|
||
JRST PAD1
|
||
SETZM PBPARN
|
||
MOVEI W1,BITSYM
|
||
CALL PADBL1 ;FIRST, CONSIDER MAIN BIT MODE.
|
||
JRST PADBR1 ;IT WON.
|
||
MOVEI W1,BITSY1
|
||
CALL PADBL1 ;ELSE, CONSIDER ALTERNATE BIT MODE.
|
||
JRST PADBR1 ;IT WON.
|
||
JRST PAD1
|
||
|
||
PADBL1: MOVE A,(W1)
|
||
SKIPGE B,BITPAT-BITSYM(W1)
|
||
JRST [ HLROS B
|
||
AOS PBPARN
|
||
RET]
|
||
TLNN B,1
|
||
AOS (P)
|
||
RET
|
||
|
||
PADR: JUMPE D,TOC2FK ;$R ADDRESS TYPEOUT RTN.
|
||
PUSHJ P,SLUK
|
||
POPJ P, ;EXACT MATCH FOUND.
|
||
JUMPE W1,PADA ;NOTHING FOUND => NUMERICALLY.
|
||
MOVE B,1(W1) ;VALUE OF BEST.
|
||
CAIGE B,60 ;SYM'S VALUE SMALL => DON'T USE.
|
||
JRST PADA
|
||
ADD B,SYMOFS
|
||
CAML D,B ;SYM'S VALUE TOO FAR BELOW => DON'T USE.
|
||
JRST PADA
|
||
PADR1: SUB D,1(W1) ;ADDR-<BEST FOUND>
|
||
PUSH P,D
|
||
PUSHJ P,SPT ;PRINT BEST SYM FOUND.
|
||
POP P,D
|
||
CTYPE "+
|
||
JRST TOC
|
||
|
||
PADA: TRNE I2,NAF ;USUALLY TYPE IN OCTAL,
|
||
PADA0: CAIGE D,-4000 ;UNLESS NAF WAS SET AND VALUE IS SMALL NEGATIVE NUM.
|
||
JRST TOC
|
||
PADA1: CTYPE "- ;IN THAT CASE, PRINT A NEGATIVE NUMBER.
|
||
XORI D,-1 ;NEGATE D'S RH.
|
||
AOJA D,TOC
|
||
|
||
PADF: TLNE D,177777 ;ADDR. IS FUNNY, ONLY TOP 2 FUNNYNESS BITS OK.
|
||
ERLOSS D ;(WILL PUSH A, THEN D)
|
||
TLNN D,200000 ;IF .USET NUMBER,
|
||
JRST PADF1
|
||
PADF0: TLZE D,400000 ;IF DDT-REF, HANDLE THAT SIMPLY.
|
||
7TYPE [ASCIZ/..DDT+/]
|
||
TLNN D,-1
|
||
JRST PADA ;IF THAT WAS ONLY FUNNYNESS, THE REST IS NORMAL ADDR.
|
||
PADF1: SETZ W1, ;SLUKB WILL NEED THIS.
|
||
TLZE D,200000
|
||
JRST PADU ;.USET REF => SEARCH SYSTEM FUNNY SYMS.
|
||
MOVE B,[-STBIFL,,STBIF] ;ELSE INITIAL FUNNY SYMSFOR DDT REF.
|
||
MOVEI A,(D)
|
||
JUMPL U,PADD1 ;NO JOB => CAN'T PRINT AS U-REL SYM.
|
||
CAIG A,JOBSYM(U) ;ELSE SEE IF IN RANGE FOR U-REL SYM.
|
||
CAIGE A,USRS(U)
|
||
JRST PADD1
|
||
SUBI D,(U) ;YES, GET OFFSET.
|
||
TLOA D,100000 ;LOOK FOR A SYM WITH U-REL SET.
|
||
PADU: MOVE B,STBSF
|
||
PUSHJ P,SLUKB
|
||
JRST PADR1 ;NOT EXACT => PRINT AS SYM+OFFSET.
|
||
JRST SPT
|
||
|
||
PADD1: PUSHJ P,SLUKB ;LOOK FOR NON-U-REL DDT REF.
|
||
JRST PADF0 ;NOT EXACT => PRINT AS ..DDT+ADDR.
|
||
JRST SPT
|
||
|
||
;THIS IS THE HEART OF BIT TYPEOUT MODE.
|
||
;EXPECTS VALUE TO PRINT IN RH(D), PATTERN IN PBPAT, PREFIX IN PBSYM.
|
||
PBHWD: SETZM PBFND
|
||
HRRZM D,PBVAL
|
||
MOVEI C,18.
|
||
MOVEM C,PBLMAR
|
||
MOVE A,PBSYM ;COMPUTE THE SQUOZE FOR THE TRAILING BLANKS IN PBSYM.
|
||
MOVEI C,1
|
||
PBSMSK: IDIVI A,50
|
||
JUMPN B,PBSMS1
|
||
IMULI C,50
|
||
JRST PBSMSK
|
||
|
||
PBSMS1: MOVEM C,PBMASK
|
||
|
||
;NOW, TRY THE NEXT SUBFIELD.
|
||
PBLOOP: MOVE A,PBPAT
|
||
LSH A,@PBLMAR ;MOVE DOWN TO START OF SUBFIELD.
|
||
MOVN C,PBLMAR
|
||
ASH A,(C) ;BY EXTENDING SIGN FROM THERE TO TOP OF WORD.
|
||
SKIPGE A
|
||
SETCA A, ;NORMALIZE TO POSITIVE, SINCE ONLY ALTERNATIONS MATTER.
|
||
JFFO A,PBLOO1 ;HOW MANY LEADING ZEROS?
|
||
MOVEI B,36. ;<=> HOW FAR DOWN IS END OF SUBFIELD?
|
||
PBLOO1: MOVSI D,400000
|
||
MOVNI W1,-1(B)
|
||
ASH D,(W1) ;MASK TO THIS SUBFIELD AND STUFF ABOVE IT.
|
||
LSH D,@PBLMAR
|
||
LSH D,(C)
|
||
MOVEM D,PBFELD
|
||
MOVEM B,PBLMAR ;REMEMBER HOW FAR TO START OF NEXT SUBFIELD AT END OF THIS ONE.
|
||
AND D,PBVAL
|
||
JUMPE D,PBLOST
|
||
CALL PBSLUK ;TRY LOOKING UP THE VALUE IN THIS SUBFIELD.
|
||
JRST PBLOO3
|
||
MOVN D,PBFELD
|
||
AND D,PBFELD ;GET LSB OF THIS FIELD
|
||
CAMN D,PBFELD ;IS THIS FIELD JUST 1 BIT? IF SO, GIVE UP ON IT NOW.
|
||
JRST PBLOST
|
||
CALL PBSLUK
|
||
JRST PBLOO2 ;THAT WINS - PRINT AS <N>*LOWBIT
|
||
MOVE D,PBFELD ;IF THERE'S A SYMBOL FOR THE WHOLE FIELD,
|
||
CALL PBSLUK
|
||
JRST PBLOO5 ;PRINT AS <QTY>&<FIELD-SYMBOL>
|
||
JRST PBLOST ;IT LOST - DON'T HACK THIS SUBFIELD.
|
||
|
||
PBSLUK: SKIPE PBPARN
|
||
HRLZS D
|
||
JRST SLUK2
|
||
|
||
PBLOO5: SKIPE PBFND ;PRINT AS <QTY>&<SYMBOL>
|
||
CTYPE "+
|
||
MOVE D,PBFELD
|
||
AND D,PBVAL ;GET THE QUANTITY.
|
||
SAVE W1
|
||
CALL TOC ;PRINT IT. W1 HAS ADDR OF SYMBOL.
|
||
REST W1
|
||
CTYPE "&
|
||
CALL PBOPE1 ;PRINT "(" OR "<", MAYBE.
|
||
JRST PBLOO4 ;AND THE SYMBOL.
|
||
|
||
PBLOO2: CALL PBOPEN ;PRINT "+" IF NEC, AND "(" IF NEC.
|
||
SKIPE PBPARN
|
||
HLRZS D
|
||
MOVE B,PBVAL
|
||
AND B,PBFELD
|
||
IDIVM B,D ;GET THE COEFFICIENT OF THE LOW BIT.
|
||
SAVE W1
|
||
CALL TOC ;PRINT IT
|
||
REST W1
|
||
CTYPE "* ;TIMES
|
||
JRST PBLOO4 ;THE SYMBOL FOR THE LOW BIT.
|
||
|
||
PBLOO3: CALL PBOPEN ;FOUND SYMBOL FOR VALUE IN FIELD - JUST PRINT IT
|
||
;WITH "+" OR "(" IN FRONT IF NEC.
|
||
PBLOO4: CALL SPT
|
||
MOVE D,PBFELD ;MARK THIS FIELD AS HANDLED - NO LONGER NEEDING HANDLING
|
||
IORM D,PBFND ;(IF NO SYMBOL FOUND, THIS ISN'T DONE)
|
||
PBLOST: MOVE C,PBLMAR ;KEEP GOING TILL REACH BOTTOM OF HALFWORD.
|
||
CAIE C,36.
|
||
JRST PBLOOP
|
||
SKIPE PBFND ;THEN, CLOSE ANY ")" OR ">" THAT PBOPEN PRINTED.
|
||
SKIPN PBPARN
|
||
JRST PBCLOS
|
||
CTYPE ")
|
||
SKIPE PBANGL
|
||
CTYPE ">
|
||
PBCLOS: MOVE D,PBVAL
|
||
ANDCM D,PBFND ;WHAT PART OF VALUE WASN'T HANDLED BY BIT MODE?
|
||
SKIPE PBFND
|
||
JUMPE D,CPOPJ
|
||
MOVEI I2,NAF ;IF THERE IS ANY, PRINT IT BY OTHER MEANS.
|
||
SKIPE PBFND
|
||
CTYPE "+
|
||
JRST PAD1
|
||
|
||
PBOPEN: SKIPE PBFND ;PRINT A "+" IF WE ALREADY PRINTED SOMETHING ELSE.
|
||
CTYPE "+
|
||
PBOPE1: SKIPN PBFND ;PRINT A "(" BEFORE THE FIRST THING, IF PBPARN IS NONZERO
|
||
SKIPN PBPARN
|
||
RET
|
||
SKIPE PBANGL ;AND PBANGL SAYS THAT PARENS NEED ANGLEBRACKETS AROUD THEM.
|
||
CTYPE "<
|
||
CTYPE "(
|
||
RET
|
||
|
||
TMT:
|
||
SATP: MOVE C,D ;WILL SHIFT HIGH BITS OF ARG INTO D TO TYPE OUT.
|
||
MOVE B,SATPC ;GET MASK (ALTERNATING BYTES OF 1'S AND 0'S)
|
||
MOVEI A,36. ;COUNT # BITS HANDLED.
|
||
SATP0: SETZ D, ;GET THE NEXT BYTE:
|
||
SATP1: ROTC C,1 ;GET NEXT BIT.
|
||
LSH B,1
|
||
SOJLE A,.+2 ;END OF WORD?
|
||
JUMPL B,SATP1 ;OR END OF WORD?
|
||
CALL FTOC ;YES, TYPE THE BYTE
|
||
CALL TSPC
|
||
SETCA B, ;MAKE SURE MASK AGAIN STARTS WITH 1-BIT.
|
||
JUMPG A,SATP0 ;BITS NOT HANDLED => MORE BYTES.
|
||
RET
|
||
|
||
;FLOATING POINT OUTPUT
|
||
|
||
TMF:
|
||
TFLOT: MOVE A,D
|
||
NFLOT: JUMPG A,TFL1
|
||
JUMPE A,FP1A
|
||
MOVNS A
|
||
CTYPE "-
|
||
TLZE A,400000
|
||
JRST FP1A
|
||
|
||
TFL1: MOVEI B,0
|
||
TLNN A,400
|
||
CTYPE "# ;NOT NORMALIZED
|
||
CAMGE A,FT01
|
||
JRST FP4
|
||
CAML A,FT8
|
||
AOJA B,FP4
|
||
FP1A:
|
||
FP3: SETZB C,TEM1 ;CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
|
||
MULI A,400
|
||
ASHC B,-243(A)
|
||
MOVE A,B
|
||
PUSHJ P,FP7
|
||
CTYPE ".
|
||
MOVNI A,10
|
||
ADD A,TEM1
|
||
MOVE W1,C
|
||
FP3A: MOVE D,W1
|
||
MULI D,12
|
||
PUSHJ P,FP7B
|
||
SKIPE W1
|
||
AOJL A,FP3A
|
||
POPJ P,
|
||
|
||
FP4: MOVNI C,6
|
||
MOVEI W2,0
|
||
FP4A: ADDI W2,1(W2)
|
||
XCT FCP(B)
|
||
SOSA W2
|
||
FMPR A,@FCP+1(B)
|
||
AOJN C,FP4A
|
||
PUSH P,EXPSGN(B)
|
||
PUSHJ P,FP3
|
||
MOVEI D,"E
|
||
PUSHJ P,TOUT
|
||
POP P,D
|
||
PUSHJ P,TOUT
|
||
MOVE A,W2
|
||
|
||
FP7: SKIPE A ;AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
|
||
AOS TEM1
|
||
IDIVI A,12
|
||
HRLM B,(P)
|
||
JUMPE A,FP7A1
|
||
PUSHJ P,FP7
|
||
|
||
FP7A1: HLRZ D,(P)
|
||
FP7B: ADDI D,"0
|
||
JRST TOUT
|
||
|
||
1.0^32.
|
||
1.0^16.
|
||
FT8: 1.0^8
|
||
1.0^4
|
||
1.0^2
|
||
1.0^1
|
||
FT: 1.0^0
|
||
1.0^-32.
|
||
1.0^-16.
|
||
1.0^-8
|
||
1.0^-4
|
||
1.0^-2
|
||
FT01: 1.0^-1
|
||
FT0=FT01+1
|
||
|
||
FCP: CAMLE A, FT0(C)
|
||
CAMGE A, FT(C)
|
||
0, FT0(C)
|
||
|
||
EXPSGN: "-
|
||
"+
|
||
|
||
G9PNT: SKIPA W1,[10.] ;DECIMAL TYPEOUT.
|
||
G8PNT: MOVEI W1,8 ;OCTAL.
|
||
SKIPA D,A
|
||
|
||
;;; TMP, FTOC, G8PNT, and G9PNT all clobber D and W1
|
||
|
||
TMC:
|
||
FTOC: ;CURRENT RADIX TYPEOUT.
|
||
TOC: HRRZ W1,ODF
|
||
MOVEM W1,TOCTEM
|
||
CAIN W1,12
|
||
JRST TOC4
|
||
TOCA: LSHC D,-43
|
||
LSH W1,-1 ;W1=D+1
|
||
TOC1: DIVI D,@TOCTEM
|
||
HRLM W1,0(P)
|
||
JUMPE D,TOC2
|
||
PUSHJ P,TOCA
|
||
TOC2: HLRZ D,0(P)
|
||
TOC2FK: ADDI D,"0
|
||
CJTOUT: JRST TOUT ;DOES POPJ TO TOC2 OR EXIT
|
||
|
||
TOC4: SKIPGE D
|
||
CTYPE "-
|
||
MOVMS D
|
||
PUSHJ P,TOCA
|
||
MOVEI D,".
|
||
JRST TOUT
|
||
|
||
SPT: MOVE D,CJTOUT
|
||
SAVE (W1) ;LEAVE NAME OF SYMBOL FOR $$^C.
|
||
REST N2ACCS
|
||
.SPT: MOVEM D,SPTS
|
||
MOVE D,0(W1) ;SYMBOL PRINT
|
||
TLZ D,740000
|
||
SPT1: SAVE W1
|
||
SPT3: IDIV D,[50*50*50*50*50]
|
||
PUSHJ P,SPT2
|
||
MOVE D,W1
|
||
IMULI D,50
|
||
JUMPN D,SPT3
|
||
JRST POPW1J
|
||
|
||
SPT2: ADDI D,260-1
|
||
CAILE D,271
|
||
ADDI D,301-272
|
||
CAILE D,332
|
||
SUBI D,334-244
|
||
CAIN D,243
|
||
MOVEI D,256
|
||
XCT SPTS
|
||
POPJ P,
|
||
|
||
PURIFY: SKIPE SYSSTB
|
||
.VALUE ;HAS BEEN RUN OR IS PURE.
|
||
JRST PURIF1
|
||
|
||
;RAID REGISTERS ARE THE DISPLAY FEATURE OF DDT.
|
||
;EACH JOB CAN HAVE RADNUM RAID REGISTERS, EACH OF WHICH REMEMBERS
|
||
;A LOCATION AND A TYPEOUT MODE FOR IT. WHEN THE JOB RETURNS TO DDT
|
||
;ALL OF THE RAID REGISTERS ARE DISPLAYED.
|
||
|
||
;THE RAID REGISTERS LIVE IN DYNAMICALLY ALLOCATED STORAGE POINTED
|
||
;TO BY RADAOB(U). THE SPACE FOR RADNUM OF THEM IS ALLOCATED WHEN THE
|
||
;FIRST ONE IS SET. RADAOB POINTS TO A VECTOR OF RADRGL-WORD BLOCKS,
|
||
;ONE FOR EACH REGISTER. THE FIRST WORD OF THE BLOCK CONTAINS THE ADDRESS,
|
||
;WHICH MAY BE INDEXED OR INDIRECT; IN ADDITION, IT MAY HAVE FNYLOC BITS
|
||
;IN THE TOP OF THE L.H. THE NEXT TYPMOL WORDS ARE A COPY OF THE TYPEOUT
|
||
;MODE AS STORED IN TYPMOD ... TYPMOE-1. THE LAST TWO WORDS HOLD
|
||
;INFO FOR RATE AND INVERSE-RATE TYPEOUT.
|
||
|
||
|
||
RADRGL==TYPMOL+5 ;LENGTH OF DATA FOR EACH RAID REG.
|
||
RADOVL==TYPMOL+1 ;RELATIVE IDX OF PREVIOUS VALUE, FOR RATE & ATB MODES.
|
||
RADOTM==TYPMOL+2 ;RELATIVE IDX OF TIME OF LAST EXAMINATION, FOR RATE & ATB.
|
||
RADOAD==TYPMOL+3 ;RELATIVE IDX OF E.A. OF LAST EXAMINATION.
|
||
RADOLD==TYPMOL+4 ;THIS WORD, IF NONZERO, SAYS THAT THIS RAID REG
|
||
;HAS BEEN DISPLAYED ALREADY, AND NEED NOT BE DISPLAYED AGAIN
|
||
;UNLESS IT CHANGES.
|
||
|
||
RADDTC: SKIPE GETTY ;RADDTC DISPLAYS RAID REGS AT SCREEN TOP,
|
||
SKIPN RAIDFL ;IFF THAT IS WANTED AND POSSIBLE.
|
||
RET ;OTHERWISE, IT IS A NO-OP.
|
||
SKIPN SCROLL
|
||
SKIPN RADTOP
|
||
RET
|
||
;DISPLAY THE RAID REGISTERS AT SCREEN TOP, NOT CHANGING THE CURSOR POS
|
||
;UNLESS IT'S IN THE REGION DISPLAYED IN.
|
||
RADDTP: SKIPN RADING
|
||
SKIPL A,RADAOB(U) ;FIRST, ARE ANY RAID REGS TURNED ON?
|
||
RET
|
||
MOVNI B,1
|
||
ADD A,[RADRGL,,RADRGL]
|
||
CAMN B,-RADRGL(A)
|
||
JUMPL A,.-2
|
||
JUMPGE A,CPOPJ ;NONE ARE ON, SO DON'T MESS WITH CURSOR.
|
||
7TYPE [ASCIZ/ /] ;SPACE, BACKSPACE; TRIGGERS --MORE-- BUT THAT'S ALL.
|
||
CALL TYOFRC
|
||
TSCLO PCPNTR
|
||
hlrzs d ;isolate the vertical position
|
||
SAVE D ;SAVE CURRENT CURSOR POSITION FIRST
|
||
7TYPE [ASCIZ /SZ/] ;HOME DOWN SO RADDIS'S CRLF WILL GO TO SCREEN TOP.
|
||
SETO D,
|
||
CALL RADDS4 ;THEN DISPLAY THE REGISTERS. -1 IN D SAYS WE'RE AT SCREEN TOP
|
||
CALL CRF
|
||
CALL TYOFRC
|
||
TSCLO PCPNTR
|
||
HLRZS D
|
||
REST C ;IS OUR REMEMBERED CURSOR POSITION INSIDE THE REGION THE
|
||
caml d,c
|
||
call crf
|
||
movei b,1(c) ;compensate for the 0-based indexing vs
|
||
;1-based size
|
||
caml b,ttymxv ;Were we at the bottom of the screen?
|
||
ret ;No, don't restore that position then!
|
||
camge d,c
|
||
7TYPE [ASCIZ /R/] ;IF NOT, RESTORE THAT POSITION.
|
||
RET
|
||
|
||
RADDT1: SKIPE RADTOP ;DISPLAY THE RAID REGS, EITHER AT TOP OR IN THE STREAM.
|
||
SKIPN GETTY
|
||
JRST RADDIS
|
||
SKIPE SCROLL
|
||
JRST RADDIS
|
||
JRST RADDTP
|
||
|
||
;DISPLAY THE CONTENTS OF THE RAID REGISTERS IN THE OUTPUT STREAM AT THE CURSOR.
|
||
;PRINTS A CRLF BEFORE EACH LINE, BUT NONE AT THE END.
|
||
RADDIS: SETZ D,
|
||
RADDS4: JUMPL U,GSNLRT
|
||
SKIPN RADING ;IF WE ARE ALREADY INSIDE RADDIS (EG USER TYPEOUT MODE LOST)
|
||
SKIPL B,RADAOB(U) ;THEN AVOID INFINITE RECURSIVE LOSSAGE.
|
||
JRST GSNLRT ;ALSO EXIT IF THERE ARE NO RAID REGS IN THIS JOB.
|
||
SETOM RADING
|
||
ADD P,[TYPMOL,,TYPMOL]
|
||
MOVEI A,1-TYPMOL(P)
|
||
HRLI A,TYPMOD ;PUSH THE CURRENT TYPEOUT MODE
|
||
BLT A,(P)
|
||
SAVE D ;-2(P) HAS -1 IFF WE ARE AT SCREEN TOP.
|
||
SAVE [1] ;-1(P) HAS # OF THIS RAID REG.
|
||
SAVE B ;(P) SAVES THE POINTER TO THIS RAID REG.
|
||
SKIPN SYSSW
|
||
CALL EASETU ;SET UP FOR EFFECTIVE ADDRESS COMPUTATIONS.
|
||
RADDSL: MOVE A,(B) ;HERE TO DISPLAY ONE RAID REGISTER.
|
||
MOVEM B,(P)
|
||
AOJE A,RADDS1 ;JUMP IF THIS ONE HAS NOTHING IN IT.
|
||
MOVSI A,1(B) ;THIS REGISTER'S IN USE; GET ITS TYPEOUT MODE AS CURRENT.
|
||
HRRI A,TYPMOD
|
||
BLT A,TYPMOE-1
|
||
MOVE D,(B) ;GET ITS ADDRESS.
|
||
HRRZ I1,D ;IF EXAMINING SYS JOB, "EFFECTIVE ADDR CALC" IS A NO-OP.
|
||
SKIPN SYSSW
|
||
CALL NEFECC ;COMPUTE EFFECTIVE ADDRESS FROM IT.
|
||
HLLZ D,(B) ;GET JUST THE FUNNY BITS
|
||
TLZ D,#7^5
|
||
IOR D,I1 ;MERGE IN THE EFFECTIVE ADDRESS
|
||
MOVEM D,LLOCO ;OPEN THAT LOCATION.
|
||
MOVE A,(B)
|
||
SKIPE RADCLR ;SCREEN CLEARED SINCE LAST RAID REG DISPLAY => MUST DISPLAY ALL.
|
||
JRST RADDS5
|
||
SKIPE RADOLD(B) ;IF THIS RAID REG HAS BEEN DISPLAYED SINCE LAST ALTERED,
|
||
CAME D,RADOAD(B) ;AND E.A. AND CONTENTS ARE THE SAME AS THEN,
|
||
JRST RADDS5
|
||
MOVE A,D
|
||
SKIPE -2(P) ;AND DISPLAY IS AT SCREEN TOP SO ALWAYS IN SAME PLACE,
|
||
CALL FETCH
|
||
JRST RADDS5
|
||
CAMN D,RADOVL(B)
|
||
JRST [ 7TYPE [ASCIZ /D/]
|
||
JRST RADDS1] ;THEN DON'T DISPLAY, JUST SKIP PAST THIS SCREEN LINE.
|
||
RADDS5: MOVE D,LLOCO
|
||
MOVEM D,RADOAD(B)
|
||
7TYPE [ASCIZ /
|
||
#/]
|
||
MOVE A,-1(P) ;PRINT "<CRLF> #<NUMBER> "
|
||
CALL G8PNT
|
||
CALL LCT
|
||
MOVE D,(B)
|
||
TLNN D,37 ;IF ADDRESS IS INDEXED OR INDIRECT,
|
||
JRST RADDS2
|
||
CALL PININ1 ;PRINT ORIGINAL QUANTITY THAT E.A. WAS GOT FROM
|
||
7TYPE [ASCIZ / -> /]
|
||
RADDS2: MOVE D,LLOCO
|
||
CALL PAD ;PRINT THE ADDRESS WE ARE OPENING.
|
||
CTYPE "/
|
||
HRROI C,FTOC
|
||
CALL NTAB2 ;AND THE CONTENTS AS A NUMBER
|
||
MOVE C,SCH
|
||
MOVE B,(P) ;GET RAID REG ADDR IN B, FOR RATE & ATB MODES.
|
||
CALL NTAB2 ;AND THE CONTENTS, IN THE SELECTED MODE.
|
||
MOVE B,(P)
|
||
SETOM RADOLD(B) ;SAY THIS RAID REG NOW ON SCREEN.
|
||
MOVE D,LWT
|
||
MOVEM D,RADOVL(B)
|
||
RADDS1: AOS -1(P)
|
||
MOVE B,[RADRGL,,RADRGL]
|
||
ADD B,(P) ;ADVANCE TO NEXT RAID REGISTER.
|
||
JUMPL B,RADDSL
|
||
SUB P,[3,,3]
|
||
MOVSI A,1-TYPMOL(P)
|
||
HRRI A,TYPMOD ;POP THE OLD CURRENT MODE
|
||
BLT A,TYPMOE-1
|
||
SUB P,[TYPMOL,,TYPMOL]
|
||
SETZM RADING
|
||
SETZM RADCLR ;NOW NOT TRUE THAT SCREEN WAS CLEARED SINCE LAST RAID REG DISPLAY.
|
||
JRST GSNLRT
|
||
|
||
;$V OF VARIOUS FORMS IS USED TO SET AND CLEAR RAID REGISTERS.
|
||
NALTV: JUMPL U,JERR
|
||
CALL RAD
|
||
NALTVX: CALL RADDT1
|
||
JRST NLTL2
|
||
|
||
RAD: MOVE D,ARG1 ;MERGE THE FUNNY BITS INTO THE ARG.
|
||
CAME D,[-1] ;PREVENT USER FROM ACCIDENTALLY CREATING AN ADDRESS THAT
|
||
TLZ D,#(@(17)) ;REFERS TO DDT OR A USET VAR.
|
||
IOR D,FNYLOC
|
||
MOVEM D,ARG1
|
||
TLNN B,O.IFX ;GO TO RAD1 IF NO INFIX ARG
|
||
JRST RAD1
|
||
JUMPE A,RAD0 ;TO RAD0 FOR $0V.
|
||
JUMPL A,NAERR ;$<-1>V ILLEGAL.
|
||
SAVE A ;M$NV AND $NV HERE.
|
||
CALL RADALC ;MAKE SURE THE STORAGE IS ALLOCATED, GET RADAOB IN A.
|
||
REST D
|
||
SUBI D,1
|
||
IMULI D,RADRGL
|
||
HRLI D,(D)
|
||
ADD A,D ;ADVANCE A TO POINT AT THE SELECTED RAID REGISTER
|
||
JUMPGE A,NAERR ;REGISTER # TOO LARGE?
|
||
SKIPN ARG1+1
|
||
JRST RADSMD ;$NV WITH NO ARG JUST SETS REGISTER'S TYPEOUT MODE.
|
||
;SET RAID REGISTER POINTED AT BY A: ADDRESS FROM 1ST ARGUMENT, TYPEOUT MODE FROM CURRENT.
|
||
RADSET: MOVE D,(A)
|
||
CAMN A,[-1] ;IF THIS RAID REG WAS FORMERLY NOT IN USE,
|
||
CALL RADUPD ;THEN ALL LATER ONES ARE MOVED DOWN ONE LINE, AND MUST BE REDISPLAYED.
|
||
MOVE D,ARG1
|
||
MOVEM D,(A)
|
||
RADSMD: MOVSI D,TYPMOD
|
||
HRRI D,1(A)
|
||
BLT D,TYPMOL(A)
|
||
SETZM RADOLD(A) ;EVEN IF ONLY CHANGING THE TYPEOUT MODE, MUST REDISPLAY THE RAID REG.
|
||
RET
|
||
|
||
;COME HERE FOR $0V AND N$0V
|
||
RAD0: SKIPE ARG1+1
|
||
JRST RADFLS ;<N>$0V => FLUSH A RAID REG SET AT <N>.
|
||
SKIPE RAIDFL ;$0V COMPLEMENTS RAIDFL.
|
||
SETOM RAIDFL
|
||
SETCMM RAIDFL
|
||
RET
|
||
|
||
;COME HERE FOR $V AND N$V
|
||
RAD1: SKIPN ARG1+1
|
||
SETOM RADCLR ;$V CAUSES A FULL REDISPLAY. AND THAT'S ALL IT DOES.
|
||
SKIPN ARG1+1
|
||
RET ;N$V SETS A REG AT N.
|
||
CALL RADFLS ;FLUSH ONE REGISTER SET THERE ALREADY, IF ANY
|
||
RAD1A: SETO D,
|
||
CALL RADSRC ;FIND A FREE REGISTER, MAKE A POINT TO IT.
|
||
ERSTRT [SIXBIT /ALL RAID REGS IN USE?/]
|
||
JRST RADSET ;GO PUT <N> AND CURRENT MODE IN IT.
|
||
|
||
;CLEAR THE RAID REGISTER (THE LOWEST NUMBERED, IF MORE THAN ONE EXIST)
|
||
;SET AT THE PLACE WHOSE ADDRESS IS IN ARG1. NO COMPLAINT IF NONE EXISTED.
|
||
RADFLS: SKIPL RADAOB(U)
|
||
RET
|
||
MOVE D,ARG1
|
||
CALL RADSRC
|
||
RET
|
||
SETOM (A)
|
||
;MARK ALL RAID REGS FOLLOWING THE ONE <- A AS IN NEED OF UPDATING.
|
||
;THIS MUST BE DONE WHEN A RAID REG GOES IN OR OUT OF USE.
|
||
RADUPD: SAVE A
|
||
RADUP1: JUMPGE A,POPAJ
|
||
ADD A,[RADRGL,,RADRGL]
|
||
SETZM RADOLD(A)
|
||
JRST RADUP1
|
||
|
||
;IF D HAS -1, SEARCH FOR A FREE RAID REG. OTHERWISE, SEARCH FOR ONE SET AT THE
|
||
;ADDRESS IN D. EITHER WAY, SKIP IF SUCCESSFUL, LEAVING ADDRESS OF THAT REGISTER IN A.
|
||
RADSRC: SAVE D
|
||
CALL RADALC
|
||
REST D
|
||
RADSR1: CAMN D,(A)
|
||
JRST POPJ1
|
||
ADD A,[RADRGL,,RADRGL]
|
||
JUMPL A,RADSR1
|
||
RET
|
||
|
||
;GET AOBJN PTR TO THIS JOB'S RAID REGS IN A, ALLOCATING STORAGE IF NECESSARY.
|
||
RADALC: SKIPGE A,RADAOB(U)
|
||
RET ;STORAGE ALLOCATED ALREADY => JUST RETURN PTR.
|
||
MOVEI D,RADRGL
|
||
IMUL D,RADSIZ
|
||
CALL ALLOC ;ELSE ALLCATE IT
|
||
MOVEM A,RADAOB(U)
|
||
SETOM (A) ;AND MARK EACH REGISTER AS NOT IN USE.
|
||
ADD A,[RADRGL,,RADRGL]
|
||
JUMPL A,.-2
|
||
JRST RADALC
|
||
|
||
|
||
;:RAIDFL -- THROW AWAY THE CURRENT JOB'S RAID REGISTERS (DEALLOCATE THE STORAGE)
|
||
KRAIDF: JUMPL U,JERR
|
||
MOVEI W1,RADAOB(U)
|
||
CALL ELEC0
|
||
JRST NLTL4
|
||
|
||
;:RAIDRP <N> -- DISPLAY THE RAID REGS EVERY <N> SECONDS.
|
||
KRAIDR: CALL RONUM
|
||
JRST ALTDQX
|
||
MOVEI D,5 ;DEFAULT THE ARGUMENT TO 5 SEC IF IT IS 0.
|
||
SKIPN ARG1
|
||
MOVEM D,ARG1
|
||
.RDTIME C, ;GET A BASE TIME TO SLEEP FROM. WE DON'T SLEEP <N> SECONDS,
|
||
MOVNS C ;WE SLEEP TILL <N> SECS AFTER PREVIOUS WAKEUP.
|
||
SETOM STOPWT ;SAY NO NEED FOR ANY "JOB FOO INTERRUPTED" MESSAGE
|
||
;FROM THIS JOB, SINCE WE WILL LET IT RETURN SOON.
|
||
KRAID1: SETZM HAKOK
|
||
SKIPE UINT(U)
|
||
JRST [ SETZM STOPWT
|
||
JRST UBRK0]
|
||
SAVE C
|
||
CALL RADDT1 ;DISPLAY RAID REGS AT DESIRED PLACE.
|
||
CALL TYOFRC
|
||
MOVE D,ARG1 ;GET TIME TO SLEEP, IN SECONDS
|
||
REST C ;AND BASE TIME - TIME WE STARTED THE LAST DISPLAY.
|
||
CALL HAKKAM
|
||
CALL UBRK7
|
||
JRST KRAID1 ;NO CHAR TYPED => REPEAT.
|
||
SETZM STOPWT
|
||
SETZM HAKOK
|
||
JRST NLTL2 ;CHAR WAS TYPED => RETURN.
|
||
|
||
;:RATE <X> SETS UP A RAID REGISTER SHOWING X'S RATE OF CHANGE
|
||
;(IN UNITS PER SECOND, WITH 3 DECIMAL PLACES).
|
||
;:ATB <X> SETS UP A RAID REGISTER SHOWING X'S INVERSE RATE OF CHANGE
|
||
;(AVG TIME BETWEEN CHANGES, IN SECONDS, WITH 3 DECIMAL PLACES).
|
||
KRATE: SKIPA A,[-1,,RADRAT] ;SET UP RAID REG DISPLAYING RATE OF CHANGE.
|
||
KATB: HRROI A,RADATB ;SET UP REG SHOWING INVERSE RATE (AVG TIME BETWEEN)
|
||
SAVE A
|
||
CALL RONUM ;READ ARGUMENT (SPEC'D ADDRESS) INTO ARG1.
|
||
JRST [ REST A ? JRST ALTDQX]
|
||
CALL RAD1A ;SET UP A RAID REG AT ADDRESS SPECIFIED.
|
||
SAVE A
|
||
MOVE A,ARG1 ;GET THE CONTENTS OF THAT ADDRESS,
|
||
CALL FETCHF
|
||
JFCL
|
||
REST A
|
||
MOVEM D,RADOVL(A) ;AND SET IT UP AS AN INITIAL VALUE,
|
||
.RDTIME D, ;SAYING WHEN WE DID SO.
|
||
MOVEM D,RADOTM(A)
|
||
REST 1+SCH-TYPMOD(A) ;SET TYPEOUT MODE TO BE "RATE" OR "ATB".
|
||
MOVEI D,10.
|
||
MOVEM D,1+ODF-TYPMOD(A) ;IT SHOULD PRINT AS A DECIMAL NUMBER.
|
||
JRST NALTVX ;GO REDISPLAY THE RAID REGS.
|
||
|
||
RADATB: CALL RADDS3 ;PRINT OUT AVG-TIME-BETWEEN. GET DELTA-T AND DELTA-X.
|
||
MOVMS C ;WIN FOR VARS THAT GET SMALLER,.
|
||
IMULI D,1000. ;EXPRESS DELTA-T IN 1/30 OF A MILLISEC
|
||
IDIVI D,30. ;EXPRESS IT IN STRAIGHT MILLISECONDS.
|
||
IDIV D,C ;GET MILLISEC PER EVENT.
|
||
CALL RADPRT
|
||
7NRTYP [ASCIZ / Sec/]
|
||
|
||
RADRAT: CALL RADDS3 ;PRINT OUT RATE: GET DELTA-T IN D, DELTA-X IN C.
|
||
JUMPGE C,RADRA1
|
||
CTYPE "-
|
||
MOVNS C
|
||
RADRA1: EXCH C,D
|
||
IMULI D,30000. ;MULTIPLY BY 1000. FIRST, SO WE DON'T LOSE FRACTION.
|
||
IDIV D,C ;(ALSO ACCOUNTS FOR TIME'S BEING IN 30'THS)
|
||
CALL RADPRT
|
||
7NRTYP [ASCIZ / Per Sec/]
|
||
|
||
;PRINT NUMBER IN D AS IF MULTIPLIED BY .001
|
||
RADPRT: IDIVI D,1000. ;NOW SEPARATE INTEGER AND FRACTION PARTS OF RATE.
|
||
SAVE W1
|
||
MOVE A,D
|
||
CALL G9PNT ;PRINT INTEGER AS DECIMAL.
|
||
REST D
|
||
IDIVI D,100.
|
||
CTYPE "0(D)
|
||
MOVE D,W1
|
||
IDIVI D,10.
|
||
CTYPE "0(D)
|
||
CTYPE "0(W1)
|
||
RET
|
||
|
||
;ASSUME B POINTS TO A RAID REG, AND ITS EXAMINED VALUE IS IN LWT.
|
||
;UPDATE RADOVL AND RADOTM IN THE RAID REG (PREVIOUS VALUE, AND TIME IT WAS THERE).
|
||
;RETURN DELTA-VALUE IN C, AND DELTA-T (IN 30'THS OF SECOND) IN D.
|
||
;CLEARS RADOAD(B) TO MAKE SURE THIS RAID REGISTER IS ALWAYS UPDATED.
|
||
;OTHERWISE RADDIS MIGHT WRONGLY THINK THAT IT "HADN'T CHANGED".
|
||
RADDS3: .RDTIME A, ;GET TIME NOW
|
||
MOVE D,A
|
||
SUB D,RADOTM(B) ;TIME INTERVAL SINCE LAST DISPLAYED.
|
||
MOVEM A,RADOTM(B) ;STORE THIS TIME AS TIME UPDATED LAST.
|
||
MOVE C,LWT
|
||
SUBM C,RADOVL(B) ;AMOUNT VARIABLE HAS CHANGED IN THAT MUCH TIME.
|
||
EXCH C,RADOVL(B) ;STORE NEW VALUE AS OLD VALUE FOR NEXT TIME.
|
||
SETOM RADOAD(B)
|
||
RET
|
||
|
||
CONSTANTS
|
||
comment | ;Here so M-.OPTAB will find documentation on OPTABn
|
||
OPTAB:: ;this tag is inside a comment
|
||
4.9=>TERMINATE GET VAL
|
||
4.8=>INHIBITE EVAL
|
||
4.7=>FIELD TERM.
|
||
4.6=>THIS SETS A PARTICULAR TYPEOUT MODE (IN RH OF DISPATCH)
|
||
4.5=>POP INTO C,D
|
||
4.4=>EXECUTE (AFTER POPPING INTO A,B)
|
||
4.2-3=>PRECEDENCE=>NUMERIC OPER
|
||
4.1=>EXECUTE DURING EVAL
|
||
3.9=>CALL PLUNK1
|
||
3.8=>EVARGS
|
||
3.7=>ERROR IF INFERIOR PROCEDURE NOT OPEN (SEE 3.2)
|
||
3.6=>IF 4.5 ON CALL NBITE
|
||
3.4=> < OR >
|
||
3.3=>NORMAL GET VAL TERMINATE
|
||
3.2 IF 3.7, HACTRN^K OK TOO.
|
||
1.1-2.9=ROUTINE
|
||
|
||
|
||
|
|
||
|
||
;; ZERO ALT MODES
|
||
OPTAB0: 0 ;^@
|
||
230040,,NCTLA ;^A
|
||
210000,,GSNLRT ;^B (SHOULDN'T GET PAST TYI)
|
||
210000,,NCTLC ;^C
|
||
210000,,NCTLD ;^D (SHOULDN'T GET PAST RCH)
|
||
210000,,GSNLRT ;^E (SHOULDN'T GET PAST TYI)
|
||
230040,,NCTLF ;^F
|
||
210000,,NXERR ;^G?
|
||
230040,,CTLH ;^H
|
||
010600,,NTAB ;^I
|
||
010600,,NNL ;^J
|
||
230040,,CTLK ;^K
|
||
0 ;^L (SHOULDN'T GET PAST RCH)
|
||
410604,,NCART ;^M
|
||
10300,,NCTLN ;^N
|
||
230000,,NCTLO ;^O
|
||
010300,,NCTLP ;^P
|
||
010600,,NUPA ;^Q
|
||
210000,,NCTLR ;^R
|
||
230040,,NCTLS ;^S
|
||
230142,,NCTLT ;^T
|
||
230142,,NCTLU ;^U
|
||
210000,,GSNLRT ;^V (SHOULDN'T GET PAST TYI)
|
||
210000,,GSNLRT ;^W (SHOULDN'T GET PAST TYI)
|
||
210100,,NCTLX ;^X
|
||
10200,,NCTLY ;^Y
|
||
230000,,NXERR ;^Z?
|
||
010600,,APAT ;^\
|
||
010600,,AEPAT ;[ ;^]
|
||
10300,,NCUPA ;^^
|
||
2000,,n.or ;^_ Inclusive OR
|
||
100000,,1 ;SP
|
||
4000,,NEXCLM ;!
|
||
10200,,NDQ ;"
|
||
10000,,NSIGN ;#
|
||
REPEAT 2,0 ;$, %
|
||
10000,,NAMAND ;&
|
||
10200,,NPRM ;'
|
||
1000,,NLPARN ;(
|
||
1000,,NRPARN ;)
|
||
4000,,NSTAR ;*
|
||
2000,,NPLUS ;+
|
||
100000,,2 ;,
|
||
2000,,NMINUS ;-
|
||
0 ;.
|
||
010200,,NSLASH ;/
|
||
230000,,NCOL ;:
|
||
10200,,NSEMIC ;;
|
||
1010,,NLANGB ;<
|
||
10200,,NEQL ;=
|
||
401014,,NRANGB ;>
|
||
210000,,NQMK ;?
|
||
1000,,ATSIGN ;@
|
||
REPEAT 26.,0 ;A, B, ..., Z
|
||
010200,,NLBRAK ;[
|
||
010600,,NBKSL ;\
|
||
010200,,NRBRAK ;]
|
||
010600,,NUPA ;^
|
||
10200,,NLFTA ;_
|
||
|
||
;ONE ALT MODE
|
||
OPTAB1: 0 ;$^@
|
||
230040,,NACA ;$^A
|
||
210000,,GSNLRT ;$^B
|
||
0 ;$^C
|
||
210000,,NCTLD ;$^D
|
||
210000,,GSNLRT ;$^E
|
||
230040,,NCTLF ;$^F
|
||
210000,,NXERR ;$^G?
|
||
230040,,CTLH ;$^H
|
||
010600,,NTAB ;$^I
|
||
010600,,NNL ;$^J
|
||
230040,,CTLK ;$^K
|
||
0 ;$^L
|
||
010600,,NACM ;$^M
|
||
10300,,NACN ;$^N
|
||
230000,,naco ;$^O
|
||
010300,,NACP ;$^P
|
||
010600,,NUPA ;$^Q
|
||
210000,,NACR ;$^R
|
||
230040,,NACS ;$^S
|
||
230040,,NCTLT ;$^T
|
||
230040,,NCTLU ;$^U
|
||
210000,,GSNLRT ;$^V
|
||
210000,,GSNLRT ;$^W
|
||
230040,,NACX ;$^X
|
||
10200,,NCTLY ;$^Y
|
||
230000,,NXERR ;$^Z?
|
||
0 ;$^\
|
||
010600,,AEPAT ;[ ;$^]
|
||
230340,,NACUPA ;$^^
|
||
0 ;$^_
|
||
100000,,3 ;$SP
|
||
4000,,FEXCLM ;$!
|
||
10000,,ALTDQ ;$"
|
||
10000,,ALTNM ;$#
|
||
210000,,ALTDLN ;$$
|
||
210000,,ALTPCN ;$%
|
||
10000,,ALTAMP ;$&
|
||
10000,,ALTPRM ;$'
|
||
210000,,GSNLRT ;$(
|
||
210000,,NARPRN ;$)
|
||
4000,,FSTAR ;$*
|
||
2000,,FPLUS ;$+
|
||
500004,,4 ;$,
|
||
2000,,FMINUS ;$-
|
||
1000,,NALT. ;$.
|
||
010200,,NSLASH ;$/
|
||
230000,,NCOL ;$:
|
||
10200,,NASEMI ;$;
|
||
210000,,ALTLES ;$<
|
||
10200,,NALTEQ ;$=
|
||
1000,,ALTGRT ;$>
|
||
230000,,NAQMK ;$?
|
||
0 ;$@
|
||
210000,,NALTA ;$A
|
||
10300,,NALTB ;$B
|
||
240000,,FTOC ;$C
|
||
210000,,NALTD ;$D
|
||
10200,,NALTE ;$E
|
||
240000,,TFLOT ;$F
|
||
010300,,NALTG ;$G
|
||
240000,,HLFW ;$H
|
||
10300,,NALTI ;$I
|
||
230040,,NALTJ ;$J
|
||
230000,,NALTK ;$K
|
||
10200,,NALTL ;$L
|
||
10200,,NALTM ;$M
|
||
10200,,NALTN ;$N
|
||
210000,,NALTO ;$O
|
||
010300,,NALTP ;$P
|
||
1000,,NALTQ ;$Q
|
||
210000,,NALTR ;$R
|
||
240000,,PIN ;$S
|
||
210000,,NALTT ;$T
|
||
630040,,NALTU ;$U
|
||
10200,,NALTV ;$V
|
||
10200,,NALTW ;$W
|
||
10200,,NALTX ;$X
|
||
10200,,NALTY ;$Y
|
||
0 ;$Z
|
||
010200,,NLBRAK ;$[
|
||
010600,,NBKSL ;$\
|
||
010200,,NRBRAK ;$]
|
||
010600,,NUPA ;$^
|
||
6000,,NSHIFT ;$_
|
||
|
||
;OPERATORS WITH TWO ALT MODES
|
||
OPTAB2: 0 ;$$^@
|
||
230040,,N2ACA ;$$^A
|
||
210000,,GSNLRT ;$$^B
|
||
210000,,N2ACC ;$$^C
|
||
210000,,NCTLD ;$$^D
|
||
210000,,GSNLRT ;$$^E
|
||
230040,,N2ACF ;$$^F
|
||
210000,,NXERR ;$$^G
|
||
10100,,KDISOW ;$$^H
|
||
010600,,NTAB ;$$TAB
|
||
0 ;$$^J
|
||
10100,,KDISOW ;$$^K
|
||
0 ;$$^L
|
||
10102,,N2ACM ;$$^M
|
||
10300,,N2ACN ;$$^N
|
||
230000,,NCTLO ;$$^O
|
||
010300,,N2ACP ;$$^P
|
||
0 ;$$^Q
|
||
10200,,N2ACR ;$$^R
|
||
230040,,N2ACS ;$$^S
|
||
230142,,NCTLT ;$$^T
|
||
230142,,NCTLU ;$$^U
|
||
210000,,GSNLRT ;$$^V
|
||
210000,,GSNLRT ;$$^W
|
||
210000,,n2acx ;$$^X
|
||
10200,,N2ACY ;$$^Y
|
||
230000,,NXERR ;$$^Z?
|
||
210000,,AUPAT ;$$^\
|
||
010600,,AEPAT ;[ ;$$^]
|
||
230040,,N2ACUP ;$$^^
|
||
0 ? 0 ;$$^_, $$SPACE
|
||
010200,,A2XCL ;$$!
|
||
10000,,ALTDQ ;$$"
|
||
10000,,ALTNM ;$$#
|
||
210000,,ALTDLN ;$$$
|
||
210000,,ALTPCN ;$$%
|
||
10000,,ALTAMP ;$$&
|
||
10000,,ALTPRM ;$$'
|
||
10000,,N2ALPR ;$$(
|
||
10600,,N2ARPR ;$$)
|
||
REPEAT 5,0
|
||
010200,,NSLASH ;$$/
|
||
230000,,NCOL ;$$:
|
||
10200,,N2ASEM ;$$;
|
||
210000,,A2LES ;$$<
|
||
10200,,ALTEQ ;$$=
|
||
0 ;$$>
|
||
230000,,NAQMK ;$$?
|
||
0 ;$$@
|
||
210000,,NALTA ;$$A
|
||
10300,,NALTB ;$$B
|
||
240000,,FTOC ;$$C
|
||
210000,,NALTD ;$$D
|
||
10200,,NALTE ;$$E (SET PERM. E&S TYPEOUT MODE)
|
||
240000,,TFLOT ;$$F
|
||
010300,,NALTG ;$$G
|
||
240000,,HLFW ;$$H
|
||
0 ;$$I
|
||
230040,,N2AJ ;$$J
|
||
230000,,NALTK ;$$K
|
||
10200,,NALTL ;$$L
|
||
0 ? 0 ;$$M, $$N
|
||
210000,,NALTO ;$$O
|
||
010300,,NALTP ;$$P
|
||
1000,,NALTQ ;$$Q
|
||
210000,,NALTR ;$$R
|
||
240000,,PIN ;$$S
|
||
210000,,NALTT ;$$T
|
||
010000,,LOGOUT ;$$U
|
||
10000,,KLSTJ ;$$V
|
||
0 ? 0 ;$$W, $$X
|
||
10200,,NALTY ;$$Y
|
||
10200,,N2ALTZ ;$$Z
|
||
010200,,NLBRAK ;$$[
|
||
010600,,NBKSL ;$$\
|
||
010200,,NRBRAK ;$$]
|
||
0 ;$$^
|
||
6000,,NFSC ;$$_
|
||
|
||
;ORDINIARY INITIAL SYMS.
|
||
STBIO:
|
||
PINIO9==STBIO+10 ;USED BY PINIO TO FIND NAMES OF IO INSNS
|
||
IRP A,,[CLEAR,CLEARI,CLEARM,CLEARB,BLKI,DATAI,BLKO,DATAO,CONO,CONI,CONSZ,CONSO]
|
||
SQUOZE 44,A
|
||
A
|
||
TERMIN
|
||
SQUOZE 4,APR ? 0
|
||
IRPS X,,START LFILE STP SYM JCL PFILE STB CONV XUNAME XJNAME LJB RND PURE HSNAME MAIL,Y,,[
|
||
.UAI .UAO .BAI .BAO .UII .UIO .BII .BIO]
|
||
IFNB Y,[
|
||
SQUOZE 44,Y
|
||
Y
|
||
]
|
||
SQUOZE 44,..R!X
|
||
.IRPCNT+1
|
||
TERMIN
|
||
SQUOZE 44,$X ? 34
|
||
IRPS X,,START LFILE UNUSD SYM JCL PFILE STB UNUSD UNUSD UNUSD UNUSD RND PURE UNUSD UNUSD
|
||
IFSN X,UNUSD,[
|
||
SQUOZE 44,..S!X
|
||
400000+.IRPCNT+1
|
||
]
|
||
TERMIN
|
||
IRPS X,,.R .S ..R ..S
|
||
SQUOZE 44,X
|
||
1,,-1
|
||
TERMIN ;$? PREFIXES FOR DECODING ARGS TO .SUSET.
|
||
IRP A,,[PI,PTP,PTR,TTY,LPT,DIS]
|
||
SQUOZE 4,A
|
||
A_<8*3>
|
||
TERMIN
|
||
SQUOZE 44,SXCT
|
||
106000,,
|
||
SQUOZE 44,ADJBP
|
||
IBP
|
||
STBIOL==.-STBIO
|
||
|
||
;INITIAL FUNNY SYMS.
|
||
STBIF: SQUOZE 4,..DDT
|
||
400000,,
|
||
SQUOZE 4,$M
|
||
SETZ MSK
|
||
|
||
;THESE LOCATIONS MUST BE IN ASCENDING ORDER IN DDT
|
||
;OR TYPEOUT WILL FAIL!
|
||
FOO==dirdir
|
||
IRPS X,,[dirdir dirfn1 dirfn2 ndrop ndrdev ndrdir ndrfn1 ndrfn2
|
||
MONMOD msk UNPURF MSTYPE DOZTIM SENDRP BELCNT CLOBRF GENJFL PCPNTF
|
||
ckqflg nfvrbs DELWARN MORWARN CONFRM MASSCP LINKP TWAITF PROMPT RPRMPT
|
||
SNDFLG PRMMCH C.ZPRT OCOFL SMLINS SYMOFS BYERUN BITPAT BITSYM SCH RAIDFL TMSQ
|
||
TMA TM6 TMCH TMS TMH TMT TMF TMC TME PFILE MPERCE MAMPER MDOLLA
|
||
MPRIME MDQUOT MNMSGN XUNAME HSNAME MSNAM LPTFLG TTYFLG ESSYM]
|
||
IF2 IFL X-FOO,.ERR FUNNY SYM "X" OUT OF ORDER
|
||
IF2 FOO==X
|
||
SQUOZE 4,..!X
|
||
SETZ X
|
||
TERMIN
|
||
;U-RELATIVE INITIAL SYMS. (NUMERICAL ORDER)
|
||
UIWD==UINTWD
|
||
IRP X,,[UUNAME,UJNAME,INTBIT,URANDM,UINT
|
||
UPI0,UPI1,PPC,XECPC,UIWD,XINTWD,JTIME,UIND
|
||
USTYPE,MARADR,MARXCT,MARCON
|
||
NBPTB,BPCPC,CBPPS,INCNT,OIPCHK,USCNT
|
||
BTADR,BTPDL,BTINS,BPINFL]
|
||
SQUOZE 4,..!X
|
||
500000,,X
|
||
TERMIN
|
||
|
||
IRPC X,,12345678
|
||
$!X!B=B1ADR+BPL*.IRPCN
|
||
SQUOZE 4,$!X!B
|
||
500000,,$!X!B
|
||
TERMIN
|
||
|
||
IRP X,,[STARTA,LIMIT,PERMIT,SYSUUO,PATCHL,LITCNT
|
||
TPERCE,TAMPER,TDOLLA,TPRIME,TDQUOT,TNMSGN
|
||
SAFE,USPARE,UFNAMD,UFILE,UHACK,UIACK,UCHBUF,BININF,UNDEFL,RADAOB,PRGM,JOBSYM]
|
||
SQUOZE 4,..!X
|
||
500000,,X
|
||
TERMIN
|
||
STBIFL==.-STBIF
|
||
|
||
PAT: PATCH: BLOCK 140
|
||
|
||
;E&S INSTRUCTION TYPEOUT OF VALUE IN D.
|
||
;ON LAST PAGE OF PURE SO WON'T SWAP IN UNLESS ESSYM SET
|
||
;(NORMALLY ONLY ON DM MACHINE)
|
||
TME:
|
||
PES: SAVE D
|
||
MOVE I2,[-PESTBL,,-1]
|
||
TRZ D,-1 ;GET JUST LH, SEARCH FOR THAT.
|
||
JRST PES3
|
||
|
||
PES0: JUMPE W1,PES2 ;NO SYM < PREV => NONE < NEXT EITHER.
|
||
MOVE D,PESTB(I2)
|
||
AND D,(P) ;MASK TO CERTAIN FIELDS (PESTB SAYS WHICH)
|
||
CAMLE D,1(W1) ;LARGER THAN LAST TIME'S BEST =>
|
||
JRST PES1 ;WOULD BE LARGER THAN THIS TIME'S BEST.
|
||
CAMN D,1(W1) ;EQUAL TO LAST TIME'S BEST =>
|
||
JRST PESFND ;LAST TIME'S BEST IS WHAT WE'D LOOK FOR.
|
||
PES3: SETZ W1,
|
||
MOVE B,[-STBESL,,STBES]
|
||
CALL SLUKB ;W1_ -> ES SYM WHOSE VAL IS CLOSEST TO C(D) BUT BELOW IT.
|
||
CAIA
|
||
JRST PESFND ;EXACT MATCH.
|
||
PES1: AOBJN I2,PES0 ;KEEP TRYING VARIOUS COMBINATIONS OF FIELDS.
|
||
PES2: HLRZ D,(P) ;PRINT LH OCTAL, RH AS ADDRESS.
|
||
CALL FTOC
|
||
JRST HLFW1
|
||
|
||
PESFND: CALL SPT ;PRINT THE INSN NAME, (<- W1)
|
||
MOVE A,1(W1) ;GET VALUE OF INSN,
|
||
ANDCA A,(P) ;GET PART OF ARG NOT IN INSN,
|
||
TLO A,400000 ;SET SIGN SO PIN3 WILL PRINT IDX SPECIALLY.
|
||
SAVE A
|
||
LDB I1,[410300,,-1(P)] ;GET CLASS OF E&S INSN.
|
||
MOVE B,(W1) ;GET FLAGS OF THE INSN (FOR AC FIELD TYPEOUT)
|
||
PESFN0: CALL TSPC
|
||
LDB D,[270400,,(P)] ;GET AC FIELD(OR 0 IF INSN INCLUDSE iT)
|
||
TLNN B,%SYLCL ;LOCAL FLAG SET IN INSN => IT DOESN'T INCLUDE AC FLD.
|
||
JUMPE D,PIN2 ;(GO PRINT @ AND ADDR AS FOR PDP10 INSNS)
|
||
LSH D,1 ;PESCDR, PESDPR ARE 2 WDS/ENTRY.
|
||
CAIE I1,3 ;CLASS 3 INSN => PRINT AC AS CDIR,
|
||
ADDI D,PESDPR-PESCDR ;ELSE AS DPR
|
||
MOVEI W1,PESCDR(D)
|
||
CALL SPT
|
||
JRST PINIO1 ;PRINT ",", THEN @ AND ADDR.
|
||
|
||
PESIDX: CAIN I1,3 ;I1 HAS INSN CLASS; PRINT C(D) AS IDX FIELD.
|
||
JRST FTOC ;CLASS 3 E&S INSN.
|
||
CAIE I1,2
|
||
JRST PESMD ;ORDINARY E&S INSN, AS MODE CHANGE.
|
||
LSH D,1 ;E&S CONDITIONAL INSN,
|
||
MOVEI W1,PESCND(D)
|
||
JRST SPT ;PRINT CONDITION NAME.
|
||
|
||
PESMD: MOVE A,D ;PRINT C(D) AS MODE-CHANGE.
|
||
MOVE W1,[-4,,PESMDT] ;AOBJN -> MODE NAMES & VALUES.
|
||
PESMD1: TDZN A,1(W1) ;CHECK WHETHER THIS MODE'S BIT IS ON.
|
||
AOJA W1,PESMD2
|
||
CALL SPT ;YES, PRINT ITS NAME.
|
||
JUMPE A,CPOPJ ;ALL BITS DONE?
|
||
CTYPE "+ ;NO, SEPARATE NAMES WITH +.
|
||
AOJ W1,
|
||
PESMD2: AOBJN W1,PESMD1
|
||
RET
|
||
|
||
;TABLE OF COMBINATIONS OF FIELDS INCLUDED IN E&S iNSNS.
|
||
;(IN DECREASING NUMERICAL ORDER SO EACH VALUE GIVEN
|
||
;TO SLUKB WILL BE SMALLER THAN THE PREVIOUS.)
|
||
PESTB: 777760,, ;INSN, AC, @.
|
||
777757,, ;INSN, AC, IDX.
|
||
777740,, ;INSN, AC.
|
||
777037,, ;INSN, @ IDX.
|
||
777020,, ;INSN, @.
|
||
777017,, ;INSN, IDX.
|
||
777000,, ;INSN.
|
||
760740,, ;PART OF INSN, AC.
|
||
760000,, ;PART OF INSN.
|
||
PESTBL==.-PESTB
|
||
|
||
CONSTA
|
||
|
||
STBES: ;E&S SYMBOLS. 1ST, THE INSNS, IN NUMERICAL ORDER:
|
||
;USE = TO HALFKILL, - TO FORCE TYPEOUT OF AC FIELD EVEN IF 0.
|
||
IRPS X,Y,[BOXSA 400000,BOXSR 401000,BOXA 402000,BOXR 405000
|
||
DOTSAA 412000,DOTSRA 413000,DOTSAR 414000,DOTSRR 415000
|
||
DRAWTA 422000,DRAWTR 425000,POLAA 432000,POLRA 433000,POLAR 434000,POLRR 435000
|
||
STARAA 442000,STARRA 443000,STARAR 444000,STARRR 445000
|
||
DRAWFA 452000,DRAWFR 455000,
|
||
SETPTA 462000,LINAA=462000,SETPTR 465000,LINRR=465000,LINAR 466000,LINRA 467000
|
||
POLIAA 532000,POLIRA 533000,POLIAR 534000,POLIRR 535000
|
||
LINIAA 562000,LINIRR 565000,LINIAR 566000,LINIRA 567000
|
||
NEWCRV 602020,DOTCRV 612020,DRACRV 622020,POLCRV 632020,SETCRV 662020
|
||
DOCHAR 700000
|
||
LI-0,XQTA 10,NOP 20,PROG 21,PEEL 22,RPT 24,XQT 30,JMP 100
|
||
LIS-20000,RJMP 20100,LIPSH-40000,PSH-40020,NWSTK 40140,
|
||
LIPSHM-60000,PSHM-60020,JMPPSH 60100,NWSTKM 60140
|
||
LIF-200000,JIF 200100,JIFDED 200117,LIFCL-210000,JIFCL 210100
|
||
LIFST-220000,JIFST 220100,IJNRCR 220110,IJNWCR 220111
|
||
IJPRCR 220130,IJPWCR 220131,LIFCM-230000,JIFCM 230100
|
||
LAL-240000,JAL 240100,LALCL-250000,CL 250020,JALCL 250100
|
||
LALST-260000,ST 260020,JALST 260100,STOP 260217,LALCM-270000,CM 270020,JALCM 270100
|
||
LOCLA-300000,LOCLR-301000,LOCLSA-302000,LOCLSR-303000,LOMM-304000
|
||
LOMMR-305000,LOMMP-306000,LOMDIR 307001,LOCB-314000,LOSBKL-316000,LOLITS 316301
|
||
STCL-320000,STMM-324000,NOMM 325020,POPMM-326020,STMDIR 327001
|
||
STCB-334000,STSBKL-336000,STKNOB=336000,STSWCH 336201
|
||
RTCLA-340020,RTCLR-341020,RTCLSA-342020,RTCLSR-343020
|
||
RTMM-344020,RTMMS-345020,RTMDIR 347021,RTCB-354020,RTSBKL-356020
|
||
SKCL-360020,SKMM-364020,SKMMS-365020,PUSHMM-366020,SKMDIR 367021
|
||
SKCB-374020,SKSBKL-376020]
|
||
IFE .IRPCN&1,[SQUOZE 4,X IFSE [Y]-,[(%SYLCL)] IFSE [Y]=,(%SYHKL)
|
||
]IFN .IRPCN&1,X,,
|
||
TERMIN
|
||
STBESL==.-STBES ;LENGTH OF INSN TABLE.
|
||
|
||
PESDPR: ;DEVICE REG NAMES.
|
||
IRPS X,,RAR WAR PC SP P1 P2 DSP UR RCR WCR DIR RSR SR MAR 16 17
|
||
SQUOZE 4,X ? .IRPCN
|
||
TERMIN
|
||
|
||
PESCND: ;CONDITION NAMES
|
||
IRPS X,,PF0 PF1 PF2 PF3 PF4 PF5 PF6 PF7 RCRN WCRN HITF AICF PF14 PF15 PF16 STOPF
|
||
SQUOZE 4,X ? .IRPCN
|
||
TERMIN
|
||
|
||
PESCDR: ;CDIR NAMES.
|
||
IRPS X,,[SAVELB SAVERT VIEWLB VIEWPT WINDLB WINDRT
|
||
INSTLB INSTRT NAME CDIR HITANG SELINT SAVE VIEW WIND INST]
|
||
SQUOZE 4,X ? .IRPCN
|
||
TERMIN
|
||
|
||
PESMDT: ;MODE CHANGE BITS.
|
||
IRPS X,,PROGM PEELM RPTM XQTM
|
||
SQUOZE 4,X ? 1_.IRPCN
|
||
TERMIN
|
||
STBESA==.-STBES
|
||
|
||
INFORM [Top of pure]\.-1
|
||
.=<.+1777>/2000*2000
|
||
NPUR==<.+1>/2000 ;PURE PAGE HACK
|
||
|
||
HIMPUR:: ;START OF HIGH IMPURE.
|
||
|
||
;^B, :WALLP FILE.
|
||
WFILE: 'DSK,,
|
||
SIXBIT /WALL PAPER/
|
||
0 ;SNAME GOES HERE
|
||
|
||
;:XFILE FILE.
|
||
XFILEF: SIXBIT/DSK FOO LOGIN/
|
||
0
|
||
|
||
;^K FILE.
|
||
SFILE: 'DSK,,
|
||
SIXBIT/TS/
|
||
SYSN2: 0
|
||
sfiles: 0 ;SNAME to look at goes here
|
||
|
||
;^F, :LISTF FILE.
|
||
FFILE: 'DSK,,
|
||
SIXBIT /.FILE.(DIR)/
|
||
FFILES: 0
|
||
|
||
;:PRINT FILE.
|
||
PFILE: 'DSK,,
|
||
PFILE1: SIXBIT /.FOO./
|
||
PFILE2: SIXBIT />/
|
||
PFILES: 0
|
||
|
||
|
||
opnprg: .call opnblk
|
||
.break 16,500001
|
||
.break 16,700001
|
||
opnblk: setz ? sixbit /OPEN/
|
||
opnmod: %clbit,,0 ;mode put here
|
||
opnchn: %climm,,0 ;channel put here
|
||
opnbdv: opndev
|
||
opnbf1: opnfn1
|
||
opnbf2: opnfn2
|
||
opnbsn: setz opnsnm
|
||
opndev: sixbit /DSK/
|
||
opnfn1: sixbit /.TEMP./
|
||
opnfn2: sixbit />/
|
||
opnsnm: sixbit /HUH?/
|
||
prglen==.-opnprg
|
||
|
||
mailtm: 0 ;Time last mail arrived
|
||
mailnt: 0 ;-1 => Note mail arrival with beeps
|
||
;-2 => Wait until we have the TTY for above
|
||
;0 => Mail notification OFF
|
||
;1 => Note mail arrival with beeps and one-line summary
|
||
;2 => Wait until we have the TTY for above
|
||
mailns: 0 ;-1 => show subjects in above summaries (experimantal)
|
||
sndflt: 0 ;send default
|
||
sndits: 0 ;ITS to look at in case of $^A and $$^A
|
||
netabp: 0 ;BP to net address (to print for forwarded mail)
|
||
|
||
cladir: sixbit /.TEMP./ ;directory for SENDS files
|
||
|
||
tfile: block 4
|
||
|
||
;TYPEOUT MODES TO INITIALIZE NEW JOBS, AND FOR USE IF NO JOB.
|
||
;ASSOCIATED RESP. WITH $%, $&, $$, $', $", $#.
|
||
MPERCE: -1,,PIN
|
||
MAMPER: -1,,TMSQ
|
||
MDOLLA: -1,,PIN
|
||
MPRIME: -1,,D6PNT
|
||
MDQUOT: -1,,D7PNT
|
||
MNMSGN: -1,,TMCH
|
||
|
||
PVALFL: 0 ;-1 WHILE INVOKING USER-DEFINED TYPEOUT MODE.
|
||
|
||
|
||
LOGDIN: -1 ;-1 IF NOT LOGGED IN; 0 IF LOGGED IN.
|
||
RUNAME: -1 ;REAL UNAME (WHAT DDT THINKS ITS .UNAME IS)
|
||
XUNAME: -1 ;WHO IS SUPPOSEDLY REALLY USING THIS TREE (WHOSE MAIL & MSGS & INIT FILE TO USE).
|
||
ruind: -1 ;our own user index
|
||
TUNAME: -1 ;TEMPORARY XUNAME - THING TO SET NEXT ^K'D PROGRAM'S XUNAME TO.
|
||
THSNAM: -1 ;Temporary HSNAME, corresponding to the TUNAME in effect
|
||
HSNAME: -1 ;HOME DIRECTORY (SAME AS .HSNAME); WHERE RMAIL FILE GOES.
|
||
MSNAM: 0 ;INITIAL SNAME FOR NEW JOBS, AND DDT'S WORKING DIRECTORY.
|
||
LSNAM: 0 ;DDT'S SUPPOSED SNAME.
|
||
SRFLAG: 0 ;-1 SAYS RESTORE REAL SNAME FROM LSNAM.
|
||
SFDIR: -1 ;0 => SEARCH SNAME LIST FOR $L, ^K.
|
||
INSNAM: 0 ;POINTER TO LIST BELOW (TEMP)
|
||
SNLIST: 0 ;FLOCK PUTS SNAME ACTUALLY FOUND ON IN HERE.
|
||
BLOCK SNLLEN
|
||
SNLIS1: BLOCK SNLLEN+2
|
||
|
||
GETTY: 0 ;NONZERO IF GRAPHICS TTY.
|
||
TYGTYP:
|
||
TTYTYP: 0 ;TTY'S TTYTYP WORD (FOR GETTING LINE SPEED).
|
||
TRMNAM: 0 ;TERMINAL NAME(SIXBIT), READ AT LOGIN IF REMOTE TTY.
|
||
TTYNUM: 0 ;NUMBER OF JOB'S CONSOLE.
|
||
TTYOPT: 0 ;TTY'S TTYOPT VARIABLE.
|
||
NOERAS: 0 ;-1 IF TTY IS A NONERASABLE DISPLAY (STORAGE TUBE).
|
||
ERASE: 0 ;-1 if ^PX and friends will win
|
||
TCTYP: 0 ;TTY'S TCTYP VARIABLE.
|
||
TTYMXV: 0 ;TTY's vertical size
|
||
TTYMXH: 0 ;TTY's horizontal size
|
||
OSPEED: 0 ;TTY's OSPEED variable
|
||
ISPEED: 0 ;TTY's ISPEED variable
|
||
SMARTS: 0 ;TTY's SMARTS variable
|
||
TTYST1: 232222,,222222
|
||
TTYST2: 230222,,220222
|
||
TTYSTS: 0 ;NORMAL TTYSTS; **MORE** ENABLED.
|
||
TTYSCM: 0 ;TTYCOM SAVED HERE TO RESTORE STATE OF OCO AT %SAVEX
|
||
SCROLL: 0 ;-1 IFF TTY IS IN SCROLL MODE.
|
||
ITSNAM: 0 ;NAME OF THIS MACHINE (AI OR ML)
|
||
SLOADU: 0 ;ADDRESS IN SYSTEM OF SLOADU VARIABLE.
|
||
SILNT: 0 ;-1 IF TYPEOUT SUPPRESSED BY ^S.
|
||
tthelp: 0 ;0 -=> [HELP] is translated into '?'
|
||
hlprtn: 0 ;if non-zero, is a help routine to provide help inresponse to
|
||
;[HELP]
|
||
tyisnd: 0 ;-1 if TYI3 should let ^V and ^W through
|
||
ctlsfl: 0 ;-1 if TYI should turn ^S and ^Z into ^D
|
||
rubsav: 0 ;0, or saved buffer location for ^Y to undo to in :SEND's
|
||
bughed: 0 ;in :SEND, we've shown the header.
|
||
jclend: 0 ;Byte Pointer to end of VPAGAD buffer
|
||
lrunsw: 0 ;non-zero if we're hacking long JCL (Meaninful to LRUN routine
|
||
; only!)
|
||
buggsc: -1 ;if zero, suppresses ^L printing GSOC buffer in BGREAD
|
||
LPTOPN: 0 ;NONZERO IFF WALLPAPER FILE IS OPEN.
|
||
LPTFLG: 0 ;0 IF WALLPAPER FILE OUTPUT ON,
|
||
;AOS'D BY ^E, SOS'D OR ZEROED BY ^E,
|
||
;IRRELEVANT IF LPTFLG HOLDS 0.
|
||
TTYFLG: 0 ;0 IF TTY ON (SOS'D OR ZEROED BY ^V, AOS'D BY ^W)
|
||
TOUTXQ: 0 ;IF NONZERO, TOUT XCTS THIS INSTEAD OF NORMAL TYPEOUT.
|
||
|
||
reownf: 0 ;-3 while handling ^K. -2 for a :FOO when ..GENJFL is 0.
|
||
;-1 for :RETRY FOO.
|
||
;0 during $J and ^H.
|
||
;>0 during :NEW FOO.
|
||
;-4 during a :FJOB
|
||
|
||
insist: 0 ;-1 => on error in FNDCMD, aos. Any other value errors out
|
||
;inside FNDCMD instead
|
||
LOADF: 0 ;-1 AT IOC ERROR ==> ERROR ON LOADING
|
||
ALDPAG: -1 ;THIS + 1 IS 1ST PAGE THAT WE HAVEN'T CREATED DURING LOADING.
|
||
|
||
FRNDEL: 0 ;-1 WHILE QUITTING CAUSE FRN JOB WENT AWAY WHILE CURRENT.
|
||
;TELLS %RESET TO :KILL SO FORGET ABOUT THE JOB.
|
||
|
||
I40: 0 ;TSINT USER'S SYS UUO.
|
||
IPC: 0 ;TSINT USER'S PC.
|
||
INTING: 0 ;-1 IF AT INT LEVEL.
|
||
INTIOP: 0 ;-1 IF TSIN3 HAS PUSHED USR CHNLS.
|
||
HAKIOP: 0 ;-1 IF HAKKAH HAS PUSHED USR CHNLS.
|
||
JBIBUF: BLOCK 5 ;1 5-WD ENTRY AT A TIME OF INFERIO'S INTERRUPT
|
||
;TABLE IS READ INTO THIS BLOCK.
|
||
;;; These used to be in pure space; this seems as good a place as any
|
||
BADBTS: 0 ;CLASS 1 AND 2 INTS (READ FROM SYSTEM AT STARTUP)
|
||
OIPBIT: 0 ;THE BIT IN THE PC THAT CAUSES 1-PROCEED ON THIS MACHINE.
|
||
KS10IO: 0 ;-1 => KS-10 I/O INSTRUCTIONS, 0 => KA/KI/KL
|
||
|
||
HAKOK: 0 ;-1 => TSINT CAN EXIT TO HAKKAH IF IT QUEUES A RQ.
|
||
HAKRQ: 0 ;-1 => THERE IS WORK FOR HAKKAH TO DO (.BREAK 12'S OR CLI INT)
|
||
HAKING: 0 ;-1 => HAKKAH IN PROGRESS, PREVENTS RECURSIVE HAKKAH.
|
||
HAKTYP: 0 ;-1 => PRINT THE "RANDOM TYPEOUTS" (:SENDS, ALARM, GOING DOWN)
|
||
HAKINT: 0 .SEE %PIDBG,%PIDWN,%PIRLT,%PICLI,%PICL1
|
||
;IF ANY OF THOSE INTS OCCURS, THE BIT IN THIS WD IS SET
|
||
;TO TELL HAKKAH TO HANDLE THE INT.
|
||
JREMEM: 0 ;INT BITS OF FORGOTTEN JOBS THAT ARE INTERRUPTING.
|
||
|
||
VALCOM: 0 ;IF NOT 0, HAS ADDR OF VALRET STRING WHICH CAN BE HANDLED IMMEDIATELY.
|
||
|
||
ESSYM: 0 ;-1 => SEVL SHOULD LOOK AT E&S SYMS.
|
||
|
||
STBSO: 0 ;AOBJN -> SYSTEM ORDINARY DEFAULT SYMS (IN STBSPG)
|
||
STBSF: 0 ;AOBJN -> SYSTEM FUNNY DEFAULT SYMS
|
||
SYMTOP: DDTEND ;-> AFTER ALL SYMBOLS.
|
||
NPAGES: <DDTEND+1777>/2000 ;# 1ST PAGE ABOVE SYMTAB SPACE.
|
||
STBDDT: STBDE ;PURIF3 MAKES THIS -> DDT SYMBOL TABLE.
|
||
RELCP1: 0 ;NONZERO => ADDR OF PTR INTO SYMTAB SPACE (TO RELOCATE IF NEC)
|
||
TEM2: 0
|
||
FNYLOC: 0 ;FUNNYNESS OF SYMS EVALLED ACCUMULATES HERE,
|
||
;400000,, => DDT REF; 200000,, => USET REF.
|
||
undefp: 0 ;set if an undefined is encountered, cleared if it is
|
||
;deterimined to be legal. If this is found set when processing
|
||
;a comma, time to barf about illegal U-turns
|
||
UNDFRP: 0 ;INDEX OF LAST USED IN UNDFRL.
|
||
UNDFRL: BLOCK UNDFRS ;HOLDS 2 UNDEF SYM REFS IN ARGS EVALLD.
|
||
UNDEFF: 0 ;NONZERO => IT IS SQUOZE OF SYM, WHICH A ?U? ERROR WAS JUST GIVEN ABOUT.
|
||
|
||
4BLK: 0 ;1ST WD OF 1ST 4BLK.
|
||
REPEAT 4BLKNM,[
|
||
0?0?0 ;LAST 3 WDS OF 4BLK.
|
||
.-4 ;START OF NEXT 4BLK (LAST TIME THROUGH, FREE LIST PTR)
|
||
]
|
||
4BLKF=.-1 ;FREE 4BLK LIST PTR.
|
||
|
||
AC0: BLOCK 20 ;JOB'S ACS PUT HERE FOR ADDRESS CALC. ETC.
|
||
|
||
PS: BLOCK LPDL+30 ;PDL ;LEAVE ROOM FOR PDL OV RTNS AND HAKKAH.
|
||
|
||
;BUFFERED TYPEOUT HACKERY.
|
||
TYOCNT: TYOBFL*5 ;# CHARS SPACE LEFT IN TYOBUF.
|
||
TYOPNT:010700,,TYOBUF-1 ;BP TO IDPB TYOBUF.
|
||
TYOBUF: BLOCK TYOBFL ;BUFFER FOR BLOCK MODE TTY OUTPUT.
|
||
TYOUNI: 0 ;-1 => USE UNIT MODE FOR TYPEOUT (SET BY MORE-PROCESSING
|
||
;ROUTINES THAT WANT TO TYPE OUT WHILE THERE IS MAIN-PRGM
|
||
;LEVEL STUFF SITTING IN TYOBUF).
|
||
|
||
;VARS FOR BIT TYPEOUT.
|
||
PBSYM: 0 ;SYMBOL PREFIX, IN SQUOZE
|
||
PBMASK: 0 ;50^<N>, WHERE <N> IS NUMBER OF BLANKS AT END OF PREFIX IN PBSYM.
|
||
PBPAT: 0 ;THE PATTERN - A $T-STYLE VALUE DIVIDING HALFWORD INTO SUBFIELDS.
|
||
PBVAL: 0 ;VALUE BEING PRINTED IN BIT MODE.
|
||
PBFND: 0 ;ACCUMULATES 1'S IN SUBFIELDS THAT GET HANDLED BYY BIT MODE.
|
||
PBLMAR: 0 ;# OF BITS FROM HIGH END TO NEXT SUBFIELD TO HANDLE.
|
||
PBFELD: 0 ;MASK TO THE SUBFIELD BEING HANDLED.
|
||
PBPARN: 0 ;NONZERO => BIT MODE SYMBOLS NEED PARENS AROUND THEM.
|
||
PBANGL: 0 ;SET WITH PBPARN => ANGLE BRACKETS MUST SURROUND THE PARENS.
|
||
|
||
;VARS READ IN FROM ITS BEFORE WRITING OUT A DDTBUG FILE.
|
||
ERRDF1: 0 ;.DF1
|
||
ERRDF2: 0 ;.DF2
|
||
ERRPIR: 0 ;.PIRQC
|
||
ERRIFP: 0 ;.IFPIR
|
||
ERRPIC: 0 ;.PICLR
|
||
ERRAPR: 0 ;.APRC
|
||
ERRTTY: 0 ;.TTY
|
||
ERRBCH: 0 ;LAST CHANNEL TO GET UNHAPPY.
|
||
ERRSTA: 0 ;STATUS OF THAT CHANNEL.
|
||
ERRJNA: 0 ;DDT'S JNAME.
|
||
ERRMPV: 0 ;LAST MPV/PUR INT FAULT PAGE'S FIRST ADDR.
|
||
|
||
GTPNTR: 0 ;THESE 3 WDS USED BY $<
|
||
GTFTEM: 0
|
||
GTMALT: 0
|
||
;FIRST 4 MUST BE IN ORDER
|
||
;USED FOR READING SYLS, CLEARED ON RUBOUT.
|
||
GSONUM: 0 ;OCTAL NUMBER
|
||
GSDNUM: 0 ;DECIMAL NUMBER
|
||
GSFNUM: 0 ;FLOATING
|
||
GSSSYM: 0 ;SQUOZE
|
||
GSENUM: 0 ;NUMBER OF ALTMODES
|
||
GSFNUC: 0
|
||
|
||
RFLFN1: 0 ;DEFAULT FN1, FN2 SAVED FOR ^X, ^Y BY RFL.
|
||
RFLFN2: 0
|
||
|
||
GSOCRT: 0 ;GO THERE ON READING RUBOUT.
|
||
GSOCPP: 0 ;RESTORE P ON RUBOUT.
|
||
GSOCRP: 0 ;RESTORE GSCHRP ON RUBOUT.
|
||
GSOVPS: 0 ;CURSOR POSITION OF CHAR GSOCRP POINTS AT.
|
||
GSOHPS: 0
|
||
GSOPDP: 0 ;RESTORE GSOCRT, GSOCPP FROM THESE 2 WDS
|
||
GSORET: 0 ;IF RUB BACK PAST GSOCRP .
|
||
GSOOVP: 0 ;CURSOR POSITION OF START OF SYLLABLE (CHAR GSCHRP POINTS AT).
|
||
GSOOHP: 0
|
||
GSCHRP: 010700,,DDTEND ;NORMALLY, BP FOR STUFFING BUFFER. IF REREADING, -> NEXT CHAR TO REREAD.
|
||
GSCHRQ: 0 ;WHEN RE-READING CHARS AFTER RUBOUT OR ^L, THIS IS WHERE TO STOP.
|
||
GSCHRA: DDTEND ;AOBJN PTR TO RUBOUT-PROCESSING CHARACTER BUFFER. FOR STORAGE ALLOCATOR.
|
||
|
||
hakmct: 0 ;Count of header lines examined in HAKML6.
|
||
|
||
cliunm: 0 ;UNAME of last CLI
|
||
clijnm: 0 ;JNAME of last CLI
|
||
|
||
clisiz==:20 ;# of words to add to buffer at a time.
|
||
clibeg: 010700,,ddtend ;buffer to use for SENDS until written to disk
|
||
cliptr: 010700,,ddtend ;pointer to current char in CLI buffer
|
||
cliopt: 010700,,ddtend ;pointer to stuff being output
|
||
cliend: 010700,,ddtend ;Byte ptr to end of CLI buffer
|
||
clibpt: ddtend ;AOBJN ptr to extent of buffer
|
||
|
||
clisrc: clired ;Routine to get next character of CLI frobule
|
||
|
||
;;; This is the buffer to hold killed text in :SEND's
|
||
klbbeg: 010700,,ddtend ;start of buffer
|
||
klbend: 010700,,ddtend ;end of buffer
|
||
klbipt: 010700,,ddtend ;kill buffer input pointer
|
||
kilbpt: ddtend ;AOBJN Pointer to extent of buffer
|
||
|
||
;this is the buffer used for reading files off of FDRC (:PRINT, ^F, etc).
|
||
;the following must be contiguous (they are BLT'ed onto the pdl)
|
||
fdrctb: block fdrcl
|
||
fdrcte: 0
|
||
fdrcip: 0 ;input byte pointer
|
||
fdrcep: 350700,, ;end byte pointer.
|
||
fdrcnd: 0 ;-1 => have reached EOF; buffer now has everything
|
||
fdrcse:: ;end of range pushed by SHFDRC
|
||
|
||
SYM: 0 ;ARGUMENT TO EVAL
|
||
SYM1: 0
|
||
FLDSTR: 0
|
||
FLDTBP: DDTEND ;AOBJN -> FROB TABLE (IN SYMTAB SPACE)
|
||
|
||
ARG1: BLOCK NARGS*2 ;ARGS PUT HERE BY EVARGS, 2 WDS PER.
|
||
VALUE: BLOCK 2
|
||
PVALUE: 0
|
||
VALUEQ: 0 ;THE "OLD" VALUE, USUALLY 0 BUT SET BY $>.
|
||
;USED BY VEARG TO DEFAULT UNSPECIFIED FIELDS.
|
||
VALUER: -1 ;1 IN THOSE BITS NOT EXPLICITLY SPEC'D IN EXPRESSION.
|
||
;VALUEQ IS MERGED INTO ULTIMATE VALUE MASKED BY VALUER.
|
||
ABCNT: 0
|
||
FLDTRM: 0
|
||
STATE: 0 ;WORD ASSEMBLY FROM FIELDS STATE
|
||
PSTATE: 0 ;PAREN/ANG BRAKET STATE
|
||
NBITET: 0
|
||
SUCCES: 0 ;-1 IF LAST :IF, :ELSE OR :ALSO WAS SUCCESSFUL.
|
||
|
||
LWT: BLOCK 2 ;$Q KEPT HERE (A SYLLABLE)
|
||
LWTP: LWTTAB ;$Q RING BUFFER POINTER
|
||
LWTTAB: BLOCK 2*LWTLNG ;$Q RING BUFFER, EACH ELT. IS A 2-WD SYLLABLE.
|
||
LLOC: 0 ;VALUE OF POINT. LH HAS FUNNYNESS.
|
||
LLOCO: 0 ;LAST LOCATION OPENED. " .
|
||
PLCR: 0 ;POINT RING BUFFER POINTER (IDX IN LOCBF)
|
||
LOCBF: BLOCK NLEVS ;POINT RING BUFFER, LH OF EACH WD A FUNNYNESS.
|
||
|
||
PLUNKF: 0 ;PLUNK1 SAVES F HERE FOR AEPAT.
|
||
|
||
;EVERY JOB SELECTED HAS ITS IDX (IN DDT) PUSHED ONTO JPDL. $1J POPS JPDL.
|
||
JPDLP: 004400,,JPDLB+1 ;POINTER INTO JPDL
|
||
JPDLB: BLOCK JPDLL
|
||
JPDLE::
|
||
JPDLC: 0 ;# OF VALID ENTRIES IN JPDL (BETWEEN 0 AND JPDLL)
|
||
METAP: 0 ;WINNING META KEY
|
||
TYIC2: TYIC ;INPUT CHANNEL FOR TYI
|
||
ECHOP: 0 ;DO ECHOING
|
||
|
||
VARIAB
|
||
DDTEND: INFORM [Start of SYMTAB space]\.-1
|
||
Constants
|
||
ifn <.-ddtend>,[printx \
|
||
Alright, who's the turkey using CONSTANTS in high impure?\]
|
||
|
||
;ONCE-ONLY INITIALIZATION CODE CLOBBERED BY SYMTAB SPACE.
|
||
DDT2: MOVE P,[(-LPDL)PS] ;COME HERE WHEN START DDT 1ST TIME.
|
||
SETZB F,UCHNLO ;INDICATE NO USER CHANNEL OPEN
|
||
MOVE U,CU ;NO JOB.
|
||
|
||
;;; I moved this here from PURIF3 because these are cpu-specific, and
|
||
;;; were breaking ^N on the KL -- Gumby 23 April 86:
|
||
IRPS CPUSYM,,BADBTS OIPBIT
|
||
MOVE A,[SQUOZE 0,CPUSYM]
|
||
.EVAL A,
|
||
.VALUE
|
||
MOVEM A,CPUSYM
|
||
TERMIN
|
||
MOVSS OIPBIT
|
||
MOVE A,[SQUOZE 0,KS10P]
|
||
.EVAL A,
|
||
MOVEI A,0
|
||
MOVNM A,KS10IO
|
||
|
||
SKIPN SYSSTB ;IF DON'D HAVE SYS AND DDT SYMS,
|
||
JSP W1,PURIF3 ;GET THEM.
|
||
CALL PURIF5
|
||
;; Gotta enable that all-important Light-pen interrupt! (%PILTP)
|
||
skipe debugp ;if debugging, don't catch illopr, iocerr.
|
||
skipa a,[%PIRLT\%PIATY\%PIWRO\%PIDBG\%PICLI\%PIPDL\%PILTP\%PIMPV\%PI1PR\%PIBRK\%PIOOB\%PIDWN\%PIB42\%PIC.Z\%pijst]
|
||
move a,[%PIRLT\%PIATY\%PIWRO\%PIDBG\%PICLI\%PIPDL\%PILTP\%PIMPV\%PI1PR\%PIBRK\%PIOOB\%PIIOC\%PIVAL\%PIDWN\%PIILO\%PIDIS\%PIB42\%PIC.Z\%pijst]
|
||
hrroi b,1_tyic+1_comc+1_usri+1_tyoc
|
||
move c,[-22,,[ SIXBIT /XUNAME/ ? MOVEM XUNAME
|
||
SIXBIT /40ADDR/ ? MOVEI FORTY
|
||
SIXBIT /TTY/ ? TLO %TBINF
|
||
SIXBIT /MASK/ ? MOVE A
|
||
SIXBIT /MSK2/ ? MOVE B
|
||
SIXBIT /PICLR/ ? SETOI
|
||
SIXBIT /UNAME/ ? MOVEM RUNAME
|
||
SIXBIT /UIND/ ? MOVEM RUIND
|
||
SIXBIT /OPTION/ ? TLO %OPINT\%OPOPC\%OPLOK\%OPLKF
|
||
]]
|
||
SYSCLE USRVAR,[MOVEI %JSELF ? C]
|
||
call ddtun1 ;read UNAME from system. Leaves it in C
|
||
|
||
;; get ITS table
|
||
move a,[-mchcnt,,mchtab]
|
||
move b,[sixbit /ITSNMS/]
|
||
.getsys a,
|
||
erloss
|
||
|
||
skipe pwordp ;If we were logged in by PWORD
|
||
call ddtunp ; Gotta figure our XUNAME, too.
|
||
skipn pwordp ;Otherwise
|
||
call ddtunx ; read xuname from system,
|
||
call iocopn ;OPEN TTY.
|
||
.suset [.rsuppro,,a] ;check, are we a HACTRN?
|
||
sosn a ;is it -1? (top level)
|
||
.suset [.sxjname,,[sixbit /HACTRN/]]
|
||
SETOM TTNRST ;TELL %RESET NOT TO FLUSH TTY INPUT.
|
||
CALL %RESET ;INIT MANY THINGS.
|
||
|
||
syscal open,[%climm,,fdrc ? [sixbit /DSK/] ;is .TEMP.; there?
|
||
[sixbit /.FILE./]
|
||
[sixbit /(DIR)/]
|
||
[sixbit /.TEMP./]]
|
||
jrst [move d,[sixbit /COMMON/] ; not there,
|
||
movem d,cladir ; so hack COMMON instead for SENDS
|
||
jrst .+2]
|
||
.close fdrc,
|
||
|
||
skipn pwordp ;unless we've been started by PWORD
|
||
CALL FORMF ; CLEAR SCREEN IF DISPLAY CONSOLE
|
||
|
||
MOVE D,[SQUOZE 0,SLOADU]
|
||
.EVAL D,
|
||
SETZ D,
|
||
MOVEM D,SLOADU ;GET ADDR OF SLOADU FROM SYSTEM.
|
||
tscall sstatb ;get the machine name and other info.
|
||
MOVSI I1,-2 ;DO WHAT FOLLOWS FOR STBSO, THEN STBSF.
|
||
DDT1: MOVE D,[SQUOZE 0,SYSYMB ? SQUOZE 0,SYSUSB](I1)
|
||
.EVAL D, ;GET ABS. ADDR OF START OF TABLE,
|
||
ERLOSS
|
||
MOVE C,[SQUOZE 0,SYSYME ? SQUOZE 0,SYSUSE](I1)
|
||
.EVAL C, ;GET ADDR OF LAST WD.
|
||
ERLOSS
|
||
SUBM D,C ;1-LENGTH OF TABLE.
|
||
HRLI D,-1(C) ;AOBJN -> TABLE.
|
||
MOVEM D,STBSO(I1)
|
||
AOBJN I1,DDT1
|
||
MOVE A,STBSO ;THE ORDINARY SYMS COME FIRST.
|
||
LDB D,[121000,,A] ;GET # OF ABS PAGE THE START IN.
|
||
MOVE C,[-NUSPGS,,STBSPG] ;GET THAT PAGE & NEXT INTO STBSPG AND NEXT.
|
||
SYSCLE CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? C ? %CLIMM,,%JSABS ? D]
|
||
MOVEI D,STBSPG
|
||
DPB D,[121000,,A] ;A HAS ADDR IN DDT'S ADDR. SPACE.
|
||
SUBM A,STBSO ;STBSO HAS AMT TO RELOCATE BY.
|
||
EXCH A,STBSO
|
||
ADDB A,STBSF ;RELOCATE STBSF AS WELL.
|
||
HLRE W1,STBSF
|
||
SUB A,W1 ;WHERE DOES THAT SYMTAB END?
|
||
ANDI A,-1
|
||
CAIL A,2000*<NUSPGS+STBSPG>
|
||
ERLOSS ;TOO FEW PAGES RESERVED FOR IT.
|
||
MOVEI W1,GSCHRA ;MAKE INITIAL AMOUNT OF SPACE IN RUBOUT-PROCESSING BUFFER.
|
||
MOVSI A,-10.
|
||
CALL HOLE0
|
||
skipe pwordp ;is this started by PWORD?
|
||
jrst ddt3 ; yes, don't print startup stuff
|
||
PUSHJ P,KVERS1 ;PRINT VERSION NOS., THEN SYSTEM STATUS.
|
||
PUSHJ P,KSSTA1
|
||
PUSHJ P,CRF
|
||
.RDATE A,
|
||
AOSN A
|
||
7TYPE NODATE
|
||
MOVE A,LOGDIN
|
||
AOJN A,DDT3 ;LOGGED IN, DO INIT FILE INSTEAD SYSTEM MAIL.
|
||
syscal STLGET,[%climm,,tyic ? %clout,,a] ;is it a STY?
|
||
jrst ddt1a ; No, go print the system mail
|
||
came a,[sixbit /SUPSER/] ; Is he coming in over the network?
|
||
camn a,[sixbit /TELSER/]
|
||
caia
|
||
jrst dd1b ; No, so don't repeat these messages
|
||
ddt1a: PUSHJ P,FDRCOP
|
||
[SIXBIT /SYS SYSTEMMAIL/] ;SEE IF THERE IS ANY SYSTEM MAIL
|
||
CAIA
|
||
PUSHJ P,CTLF1 ;YES, TYPE IT OUT
|
||
call terpri ;make sure we got a newline
|
||
MOVE A,TTYTYP
|
||
TRNE A,2^5 ;NOT PSEUDO-TTY =>
|
||
JRST DD1B
|
||
PUSHJ P,FDRCOP ;PRINT LOCAL MAIL ALSO.
|
||
[SIXBIT /SYS LOCAL MAIL/]
|
||
CAIA
|
||
PUSHJ P,CTLF1
|
||
call terpri ;make sure we got a newline
|
||
JRST DD1B
|
||
|
||
DDT3: skipe pwordp ;are we logged in by PWORD logger?
|
||
jrst ddt3.0 ; yes, don't reset flags
|
||
SETZM CLOBRF
|
||
SETZM MORWARN
|
||
ddt3.0: MOVEI A,DD1B
|
||
MOVEM A,ERRSTL ;(IN CASE GET ERROR, ETC)
|
||
CALL KINTAC
|
||
JRST DD1B
|
||
skipn initp ;run an init?
|
||
jrst [xct prompt
|
||
jrst dd1b]
|
||
|
||
MOVE C,[SIXBIT /LOGIN/]
|
||
CALL KINTE2 ;TRY TO OPEN INIT FILE ON FDRC.
|
||
JRST [skipe pwordp ; No INIT file, did we just log in?
|
||
call klogi7 ; yes, so try to read our mail
|
||
jrst DD1B] ; on with the world
|
||
skipe pwordp ;Are we logged in by PWORD logger?
|
||
jrst ddt3.3 ; yes, don't ask, run the init
|
||
7TYPE [ASCIZ/--Init--/]
|
||
CALL MORFL1 ;READ CHAR FROM TTY, SKIP IF SPACE.
|
||
JRST [ .CLOSE FDRC, ? JRST DD1A] ;NOT SPACE. "FLUSHED" WAS ALREADY TYPED.
|
||
ddt3.3: CALL XFILE1 ;GO PUSH INTO INIT FILE.
|
||
JRST DD1B
|
||
|
||
PURIF1: .VALUE [ASCIZ \B ..BTAD/0
|
||
P\]
|
||
JSP W1,PURIF3 ;GET SYS SYM TAB ABS PAGES.
|
||
MOVEI A,MINPUR+MINPUR_9+400000
|
||
PURIF2: .CBLK A, ;PURIFY DDT
|
||
.VALUE
|
||
ADDI A,1001
|
||
CAIE A,400000+NPUR_9+NPUR
|
||
JRST PURIF2
|
||
SETZM DEBUGP
|
||
.VALUE [ASCIZ/:Purified
|
||
/]
|
||
JRST DDT
|
||
|
||
; init of BADBTS and OIPBIT moved to DDT2
|
||
PURIF3: MOVE A,[1000,,400375+SYSSYM_-1]
|
||
PURIF4: .CBLK A, ;INSERT SYS SYM TAB AS ABS PGS
|
||
.VALUE
|
||
SUBI A,1001
|
||
LDB B,[1000,,A]
|
||
LDB C,[121000,,SYSSYM+1776]
|
||
CAMGE B,C
|
||
TRZ A,400000 ;DELETE THOSE PGS NOT NEEDED.
|
||
ifn limpur-2000, trne a,376000 ;don't delete page 1 or 0
|
||
ife limpur-2000, trne a,377000 ;don't delete page 0
|
||
JRST PURIF4
|
||
CAIGE C,SYSSMP
|
||
.VALUE
|
||
SUBI C,1
|
||
MOVEM C,SYSSML
|
||
.VALUE [ASCIZ /STBDDT P/] ;STORE SYMTAB IN DDT.
|
||
|
||
; LDB A,[121000,,STBDDT] ;SEE WHAT PAGE SYMS START IN.
|
||
; CAIGE A,STBDE/2000-NDSPGS
|
||
; .VALUE
|
||
; HRLOI B,NDSPGS-STBDE/2000-1(A)
|
||
; EQVI B,STBDE/2000-NDSPGS ;AOBJN -> PAGES NOT USED.
|
||
; SYSCAL CORBLK,[%CLIMM,, ? %CLIMM,,%JSELF ? B]
|
||
; .VALUE
|
||
; HRLI A,-STBDE/2000(A)
|
||
; SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A]
|
||
; .VALUE ; ^ PURIFY THE ONES USED.
|
||
|
||
;;; No, it is better to just purify the pages of zeros for the benefit of
|
||
;;; people like DCP who define a lot of new symbols in their init files:
|
||
move a,[-ndspgs,,stbde/2000-ndspgs]
|
||
syscall corblk,[movei %cbred ? movei %jself ? a]
|
||
.value
|
||
|
||
SETOM SYSSTB
|
||
JRST (W1)
|
||
|
||
;IF WE NOW NEED MORE SYS SYM TAB ABS PAGES THAN WE DID WHEN WE WERE PURIFIED,
|
||
;GET THE EXTRA ONES. SYSSML CONTAINS THE NUMBER OF THE PAGE BELOW THE LOWEST
|
||
;SYS SYM TAB PAGE WE ALREADY HAVE.
|
||
PURIF5: LDB A,[121000,,SYSSYM+1776]
|
||
PURIF6: MOVEI B,SYSSYM_-10.-375(A)
|
||
CAMLE A,SYSSML
|
||
RET
|
||
CAIGE B,SYSSMP ;ABOUT TO CLOBBER THE LOW IMPURE?
|
||
ERLOSS
|
||
SYSCAL CORBLK,[ %CLIMM,,%CBRED
|
||
%CLIMM,,%JSELF
|
||
%CLIMM,,(B)
|
||
%CLIMM,,%JSABS
|
||
%CLIMM,,(A)]
|
||
ERLOSS
|
||
AOJA A,PURIF6
|
||
|
||
CONSTA
|
||
INFORM [Top of PURIFY]\.-1
|
||
PURIFH::
|
||
PURIFT==2000+<.&-2000>
|
||
|
||
END DDT
|