From 084d79d3c5932be32969afd1c78f64ac44dff717 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 2 Nov 2016 10:08:29 +0100 Subject: [PATCH] DDT source code. --- src/sysen1/ddt.1546 | 17833 +++++++++++++++++++++++++++++++++++++++++ src/syseng/datime.73 | 1136 +++ src/syseng/lsrtns.69 | 1033 +++ src/syseng/msgs.47 | 244 + 4 files changed, 20246 insertions(+) create mode 100755 src/sysen1/ddt.1546 create mode 100755 src/syseng/datime.73 create mode 100755 src/syseng/lsrtns.69 create mode 100755 src/syseng/msgs.47 diff --git a/src/sysen1/ddt.1546 b/src/sysen1/ddt.1546 new file mode 100755 index 00000000..31aaff4f --- /dev/null +++ b/src/sysen1/ddt.1546 @@ -0,0 +1,17833 @@ +.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,,] +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>,, 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 *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* + + +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 ----. + +;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 $U. NOT CHANGED BY :LOGIN. +GENJFL: -1 ;NONZERO => : ACTS LIKE :NEW . 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 FOR WHICH + 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 . + +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 + + +;;; 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 + +mchtab: irp machine,,[AI,ML,MC,MD,MX,DM] +sixbit /machine/ +termin +mchcnt==:.-mchtab ;# ITS's + +;;; 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 + 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 -bf + jrst ddt.3 ;entry for $U + jrst ddt.4 ;entry for $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:; +;; 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:; + 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 + MOVSI B,'DSK ;SET THE DEV. TO DSK. + +;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 ;$= USES RADIX . + 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 / ;$$= +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 IS A NO-OP WHEN EXECUTED. +KTAG: CALL RTOKEN ;SKIP THE TAG + JRST GSNLRT + +;:JUMP IN A VALRET OR EXECUTE FILE SETS THE READ POINTER TO AFTER +;THE MATCHING :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 +;$( ..... $) +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 +;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 ... 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 + 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: + 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 +krun: setzm lrunsw ;note we're not hacking long HCL + caia +;;; :LRUN ^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 or :CWD + 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* + 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