.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