;NDDT.MAC.2 12-Jul-81 22:18:13, Edit by CSMITH ;Make CR DEClike - have it just close the open location unless preceded by $ ;Use TIN code from DEC ddt ;Make $$? be ;? [also makes $? be ;? for now] ;add GFAD,GFSB,GFMP,GFDV to op table. restore TOPS-10 uuos too. ;make ^T use fork runtime instead of job runtime. Doesn't account for ; time usage of mult subforks well, but does exclude NDDT & sup fork time ;move start address down so can use UDDT on NDDT ;add ^Z synonym for ;h ;add xmovei,xhlli, extend mnemonics. rehash jsys stuff to be smaller & faster ;add calli and ttcall mnemonics ;save symbol ptr to right after entry vector so can find it ;make ^N type inst as inst, ignoring typeout mode. Use typeout mode for ; operands. Make ^N type changed ACs like $J does, too. ;*** to do *** ; $: ; ;M DESTROYS PREV CORE IMAGE ;ADD HOUK'S $O ;have searches put locs onto $ stack ;./ in a breakpoint or ^N (esp ^N) should do $./, but NO LOC SHOULD BE OPEN BY ; DEFAULT ;$F changes modes; shouldn't ;$X ;extended addressing ;D and G flout ;have $X type operands after execution; have it always open the inst word ; with ]. Like dec ddt ;$X: erjmp, ercal, jfcl ;type on ^N-type $X, change $$ to ;extend instruction operands & typein mnemonics ;calli mnemonics & call instruction ;get PC right in stuff dealing with ^N; eg ^T, address brk ;prevent U error on mult def sym ;make ^N always type operand as inst, ignoring prevailing typeout mode ;NDDT.MAC;6 19-Mar-81 14:39:03, Edit by MMCM ;FIX TENEX ASSEMBLY ;NDDT.MAC.180, 1-Nov-80 18:32:00, Edit by TAA ; Update JSYS table ;NDDT.MAC.179, 24-Sep-80 21:00:32, Edit by MT ; If error string not found for ;?, say so and show number ;NDDT.MAC.178, 17-Aug-80 02:36:49, Edit by MT ; Put ERJMPs after STIWs so can be used under batch (with no ^C cap) ;NDDT.MAC.175, 11-May-80 16:15:56, Edit by MT ; Make file commands require confirmation ; Change $B to delete current bpt, $$B deletes all ;NDDT.MAC.173, 15-Apr-80 00:33:35, Edit by MT ; Fondle TIW ;NDDT.MAC.172, 14-Apr-80 21:19:47, Edit by MT ; Made some typeouts prettier ; Fixes in fork handling for release 4 ; Changed around reason table so it knows about quota exceeded ;NDDT.MAC.170, 14-Apr-80 16:22:36, Edit by MT ; Made ;R work ;NDDT.MAC.169, 9-Apr-80 14:08:45, Edit by MT ; Leave LH(1) 0 in RFSTS calls for Rel4 ;NDDT.MAC.168, 8-Apr-80 17:31:40, Edit by MT ; Don't SETNM to weird things ;NDDT.MAC.167, 10-Mar-80 17:28:40, Edit by MT ; Updated JSYS table ;NDDT.MAC.166, 9-Mar-80 20:15:12, Edit by MT ; Don't lose when opening cells in nonexistant pages ;NDDT.MAC.165, 7-Mar-80 03:14:36, Edit by MT ; Don't lose in ;J if JFN is unassigned ;NDDT.MAC.164, 5-Mar-80 16:36:12, Edit by MT ; take care of ^[ and altmoded equivalents ;NDDT.MAC.163, 4-Mar-80 00:30:33, Edit by MT ; Try looking for PAT.. of PATCH not found ; Take care of $^[ and $$^[ properly ; DEP will always try to unprotect page if neccessary ; Bug fixes in 8 and 9 bit text typeout ;IDDT.MAC 9-June-78 Edit by HIC ; Finish adding ^N single stepping mode to look like ITS DDT. ; Add $. which returns the current PC. ; Default escape character is now ^D ;IDDT.MAC.35, 19-Apr-78 22:57:40, Edit by MMCM ; Fix up CR after LF lossage for rel 3 ;IDDT.MAC.34, 27-Dec-77 23:19:23, Edit by MMCM ; Added address break command ($$U) and related trap stuff ;IDDT.MAC.33, 14-Aug-77 22:11:13, Edit by MMCM ; Changes for Tops20 Jsys traps calling sequence ;IDDT.MAC.32, 19-Mar-77 06:51:30, Edit by MMCM ; Fixed multiple single stepping aobjn's ; Fixed ;;U and tag: incompatibility ;IDDT.MAC.30, 7-Mar-77 01:25:48, Edit by MMCM ; Changed to use Tops20 editting conventions ;IDDT.MAC.29, 26-Feb-77 01:15:03, Edit by MMCM ; Added KL opcodes ;IDDT.MAC.28, 15-Feb-77 15:39:35, Edit by MMCM ; Added tops20 jsys's and fixed up single stepping after breakpoint. ;IDDT.MAC;109 8-Jan-77 21:05:30 EDIT BY MMCM ; Added $Y single stepping ;IDDT.MAC;108 7-Jan-77 02:47:02 EDIT BY MMCM ; Added $J single stepping, fancy editting (delch); ; Made levtab, etc. typeout symbolic ;IDDT.MAC;108 6-Jan-77 00:53:23 EDIT BY MMCM ; Added various isi bug fixes and ;;jobstat and ;interrupt status ;IDDT.MAC;46 1-Dec-76 13:59:29 EDIT BY PLUMMER ;IDDT.MAC;45 1-Dec-76 12:11:24 EDIT BY PLUMMER ;IDDT.MAC;44 1-Dec-76 11:35:30 EDIT BY PLUMMER ; FIX CHKA3A TO AVOID CHACING @ PTRS ALL THE WAY INTO FILE ; FIX 0$NB TO WORK. ;IDDT.MAC;43 8-Nov-76 17:59:38 EDIT BY PLUMMER ; FIX UP / SO / AFER EXAMINE OF CELL WITH 1B5 ON WORKS ;IDDT.MAC;42 13-Sep-76 17:01:18 EDIT BY PLUMMER ; $9T MODE FOR BCPL STRINGS AND $8T FOR NETBUFS ETC ; GIVE PROPER ERRORS IF BPTS CANNOT BE INSERTED OR REMOVED ; CONVERT TO KL20 PMAP AND TTY STUFF ; BIG CHANGES TO CHKADR ;IDDT.MAC;41 6-Jul-76 11:57:23 EDIT BY PLUMMER ; FIX PRFRK TO SAVE W OVER CALLS TO FSTAT ;IDDT.MAC;38 16-Jun-76 12:03:58 EDIT BY PLUMMER ; TURN ON FORKSTAT CODE ;IDDT.MAC;35 11-Jun-76 16:00:12 EDIT BY PLUMMER ;IDDT.MAC;34 11-Jun-76 15:52:22 EDIT BY PLUMMER ; REPAIRS TO FORK STAT, ^T, INOUT, BREAKPOINT SETTER ; MAKE N;;F BE FORK SELECTION. ;F TOTAL FORKSTAT, N;F SPECIFIC FORKSTAT ;IDDT.MAC;33 10-Jun-76 14:44:53 EDIT BY PLUMMER ; FIX UP FORKSTAT ;IDDT.MAC;32 9-Jun-76 14:37:04 EDIT BY PLUMMER ;IDDT.MAC;23 9-Jun-76 14:01:44 EDIT BY PLUMMER ; REVISE THE HFK: CASE AGAIN ;IDDT.MAC;22 9-Jun-76 12:57:37 EDIT BY PLUMMER ; INIT MAIN STACK AT SPLICD ENTRY SO THAT CALL SETTRP WILL WORK ;IDDT.MAC;21 9-Jun-76 11:51:22 EDIT BY PLUMMER ;IDDT.MAC;20 8-Jun-76 17:48:59 EDIT BY PLUMMER ; ;;U COMMAND TO COPY IDDT SYMTAB TO USER SPACE AND THEN DO A ;U ; ;Y ETC SET $X LOCATION FROM DEFINITION OF PAT.. ; ;;U DEFINES PAT.. FROM VALUE IN $X TO PRESERVE PATCHES ;IDDT.MAC;17 4-Jun-76 12:13:15 EDIT BY PLUMMER ; FIX UUO INTERPRETER, ADD INTERPRETER FOR USER JSYS'S ;IDDT.MAC;16 3-Jun-76 23:38:52 EDIT BY PLUMMER ; CHANGE SEQUENCE SAVING LOGIC IN SLASH ;IDDT.MAC;12 3-Jun-76 13:45:04 EDIT BY PLUMMER ; NEWFRK: MOVE FFORK AFTER CALL SETTRP TIL JSYS TRAP BUG FIXED ;IDDT.MAC;11 3-Jun-76 10:24:11 EDIT BY PLUMMER ; SOUP IN ALL OF TOMLINSON'S MULTI-FORK CODE ;IDDT.MAC;7 2-Jun-76 14:56:59 EDIT BY PLUMMER ; ;JFN STATUS COMMAND ;IDDT.MAC;3 2-Jun-76 12:01:34 EDIT BY PLUMMER ; UPDATE JSYS TABLE ; ^T TYPES GROUP LOAD INSTEAD OF LOAD AV. ; ^T AND ;V VIEW CELL LOGIC ; JSYS INSTRUCTION TYPER EVALUATES EFFECTIVE ADDRESS ; ;A COMMAND ; FIX INTERPRETATION OF PUSHJ AND POV ; USE DEBRK .+1 RATHER THAN CIS AT ENTRIES ; FIX THE HANDLING OF INTERRUPTS FROM HALTED FORKS ;IDDT.MAC;31 1-APR-74 16:06:45 EDIT BY PLUMMER ; FIX THE ^T "RUNNING AT ?" BUG ;IDDT.MAC;30 21-MAR-74 12:36:28 EDIT BY PLUMMER ;IDDT.MAC;29 20-MAR-74 13:12:54 EDIT BY PLUMMER ; ADD "LOCKED BY USER" TYPEOUT TO ;A ;IDDT.MAC;28 20-MAR-74 12:37:50 EDIT BY PLUMMER ;IDDT.MAC;27 19-MAR-74 00:19:33 EDIT BY PLUMMER ; FIX ;S (MISSING INSTR DUE TO NEW ;? CODE) ; TEXT INPUT INTERRUPTIBLE ; DONT FLUSH BPT'S AFTER ^C REENTER OUT OF USER PROG. ; JSYS DEFS FOR JSYS TRAP INSTRS ; ADD ^T ROUTINE ;IDDT.MAC;22 12-MAR-74 00:30:11 EDIT BY PLUMMER ; $$Z FIXED (AGAIN) ; $P AFTER HALTF, HFORK CONTINUES PROGRAM (AGAIN) ;IDDT.MAC;21 11-MAR-74 23:59:16 EDIT BY PLUMMER ;? COMMAND ; FIX ;M ; ADD VERSION NUMBER STUFF ;IDDT.MAC;17 23-AUG-73 10:58:55 EDIT BY PLUMMER ;IDDT.MAC;16 23-AUG-73 01:23:56 EDIT BY PLUMMER ;IDDT.MAC;15 23-AUG-73 00:34:42 EDIT BY PLUMMER ; $X ETC, PUSHES THE BREAK INSTRUCTION ; PDL OVF DURING PUSHJ INTERPRET DOES IIC ON USER'S POV CHN ; FLUSH SFORKS ; FLUSH SYMP POINTER TO LOCATION CONTAINING SYMPTR ; POLISH FLOATING FRACTION GATHERING ;IDDT.MAC;13 14-AUG-73 12:03:15 EDIT BY PLUMMER ; RUBOUT DOES CIS ; CIS'S RATHER THAN DEBRK TO .+1 ; FORK TERMINATION NO LONGER AN INTERRUPT ; FIX FLOATING INPUT BUG IN "POWER" ;IDDT.MAC;12 3-JUN-73 20:39:35 EDIT BY PLUMMER ;IDDT.MAC;11 1-JUN-73 00:04:40 EDIT BY PLUMMER ; FIX FLSSYM -- HRL'S SHOULD HAVE BEEN HRLI'S ;IDDT.MAC;10 17-APR-73 10:46:42 EDIT BY PLUMMER ; GET SYMS IF NONE BEFORE AT INIT3 ; JOBSYM INITIALLY 0 IN LEFT HALF NOW ;IDDT.MAC;9 13-APR-73 11:11:08 EDIT BY PLUMMER ; REPAIR ESCAPE CHR DETECTION IN GETC ; ADD CIS AT INTERRUPT OUT OF USER ;IDDT.MAC;8 11-APR-73 15:35:39 EDIT BY PLUMMER ; FIX $$B ; FIX AUTO PROCEED SO THAT IT SEES INTERRUPTS ;IDDT.MAC;7 10-APR-73 22:30:19 EDIT BY PLUMMER ;IDDT.MAC;6 10-APR-73 13:38:34 EDIT BY PLUMMER ;IDDT.MAC;5 4-APR-73 01:09:59 EDIT BY PLUMMER ;IDDT.MAC;4 4-APR-73 00:23:33 EDIT BY PLUMMER ;IDDT.MAC;3 4-APR-73 00:10:12 EDIT BY PLUMMER ; CLEANUP START/REENTER/SPLICD ENTRIES ;IDDT.MAC;2 3-APR-73 23:53:32 EDIT BY PLUMMER ; ^A FEATURE FOR ATOMS ; REPAIR SEARCHS ; REPAIR BPT INSERT/REMOVE ; FLUSH TEST AND COMPARE MACROS, FIX EA CALC ON $P ; DO ATI IN ;E ROUTINE ; ALLOW ;E TO TYPE IN ESCAPE CHR ; REMOVE EXTRA INSTRUCTIONS AT TBRK ; USE SIN FOR ;O ; USE SOUT FOR ;W ; FIX ;O AND ;W TYPEOUTS ;<2SOURCES>IDDT.MAC;290 8-MAR-73 10:29:42 EDIT BY PLUMMER ;<2SOURCES>IDDT.MAC;289 7-MAR-73 23:06:11 EDIT BY PLUMMER ; REARRANGE CALLS TO TEXT TYPERS IN FILE COMMANDS ; MORE PATCH MODE STUFF ;<2SOURCES>IDDT.MAC;288 7-MAR-73 21:31:08 EDIT BY PLUMMER ; RUBDVOUT'S TYPED IN WHILE IN IDDT BEHAVE LIKE THE ESCAPE CHR ;<2SOURCES>IDDT.MAC;287 7-MAR-73 15:23:34 EDIT BY PLUMMER ;<2SOURCES>IDDT.MAC;285 5-MAR-73 22:49:06 EDIT BY PLUMMER ; PATCH MODE STUFF STARTED ;<2SOURCES>IDDT.MAC;279 1-MAR-73 13:40:55 EDIT BY PLUMMER ; "GETJFN" ROUTINE THAT ALLOWS ESCAPE CHAR TO BE TYPED IN ; ALLOW ^C ETC FOR ESCAPE CHR ; REMOVED OLD FLAG "SBF" -- NOT USED ;<2SOURCES>IDDT.MAC;277 28-FEB-73 17:41:08 EDIT BY PLUMMER ; SWITCH BACK TO ONLY ONE INTERRUPT CHR (MOBY CHANGE) ;<2SOURCES>IDDT.MAC;274 27-FEB-73 22:32:11 EDIT BY PLUMMER ; FLUSH UNCOMMON DEF A AC'S B AND C ;<2SOURCES>IDDT.MAC;273 23-FEB-73 17:15:55 EDIT BY PLUMMER ; RE-DID THE CFIBF/CFOBF AT INTERRUPT SITUATION ;<2SOURCES>IDDT.MAC;272 21-FEB-73 17:16:46 EDIT BY PLUMMER ; ;R CLEARS SEMI FLAGS, FORKSTAT CALLS TYPE, MOVE PATCH SPACE ; CHANGE RELOC'S, SAY "IDDT" UPON HALTF ETC FROM USER ; RUBOUT FROM USER AND ERRORS CLEAR TYPE-AHEAD ;<2SOURCES>IDDT.MAC;271 20-FEB-73 22:19:47 EDIT BY PLUMMER ; "." HANDLED PROPERLY WHEN INSIDE IDDT ; /, [, ], !, AND \ DON'T SAVE OLD SEQUENCE ; $X MOVED TO LOCATION 20 ;<2SOURCES>IDDT.MAC;267 19-FEB-73 14:36:58 EDIT BY PLUMMER ; GET SYMS AFTER ANY KIND A ENTRY ; READY FOR BPT'S TO REPORT AS STATUS 6 ; BACK TO OLD "SETUP" FOR $$Z ; FLUSH "ZLOW" PARAMETER ; SWITCH TO CALL AND RET ;<2SOURCES>IDDT.MAC;266 6-FEB-73 00:00:19 EDIT BY PLUMMER ; FIX $$Z ;<2SOURCES>IDDT.MAC;265 1-FEB-73 23:38:39 EDIT BY PLUMMER ; ADDED SEMICOLON SPACE COMMAND -- LIKE OLD ; ;<2SOURCES>IDDT.MAC;264 17-JAN-73 18:09:46 EDIT BY PLUMMER ; CHANGE DEPOSIT TO REMEMBER RIGHT ACCESS ; ADRSPC UNMAPS USER PAGE ;<2SOURCES>IDDT.MAC;263 14-JAN-73 21:55:27 EDIT BY PLUMMER ; HALTF, HFORK ARE PROCEDABLE ; CHANGE COC WORDS ; FIXED SWITCHING BETWEEN USER AND IDDT ; IDDT CHANGES ACCESS OF USER'S PAGE SO BPT'S ETC. NEVER FAIL ; TO GO IN OR COME OUT ;<2SOURCES>IDDT.MAC;259 14-JAN-73 17:37:35 EDIT BY PLUMMER ;<2SOURCES>IDDT.MAC;257 14-JAN-73 16:26:55 EDIT BY PLUMMER ; ADDR;S COMMAND ; PROVISIONS MADE FOR "SPLICED" ENTRY FROM EXEC ;<2SOURCES>IDDT.MAC;251 9-JAN-73 14:41:50 EDIT BY PLUMMER ; UPDATE JSYS TABLE TO STENEX.MAC;42 ;<2SOURCES>IDDT.MAC;250 9-JAN-73 12:44:51 EDIT BY PLUMMER ; SEMICOLON DISPATCH INSTALLED ; XCT CHASER FIXED ;<2SOURCES>IDDT.MAC;249 27-DEC-72 16:05:13 EDIT BY PLUMMER ; FIXED / WITHOUT ARG ;<2SOURCES>IDDT.MAC;248 4-DEC-72 11:52:05 EDIT BY PLUMMER ; FILE LOGIC DEFAULTING CLEANED UP ;<2SOURCES>IDDT.MAC;245 19-OCT-72 11:00:27 EDIT BY PLUMMER ;IDDT.MAC;17 26-SEP-72 11:10:06 EDIT BY PLUMMER ; W, E, N SEARCHES TAKE COUNT 105$3W stopes on the 3rd find ; $$nZ fills core with n (assumed 0 if not given) ;IDDT.MAC;13 13-SEP-72 13:39:40 EDIT BY PLUMMER ; OPCODE TABLE EXPLAINATION CLEANED UP ; OLD TABLE DISCARDED ;IDDT.MAC;12 13-SEP-72 11:58:43 EDIT BY PLUMMER ; JSYS TABLE UPDATED ; ^S COMMAND TO STORE SYMBOLS ; NEW $$Y TO READ NEW STYLE SYMBOL FILES ; DEFAULT EXTENTIONS FOR FILE COMMANDS ;IDDT.MAC;8 12-SEP-72 17:47:54 EDIT BY PLUMMER ; SYMBOL FILE COMMAND ;IDDT.MAC;3 11-SEP-72 23:26:13 EDIT BY PLUMMER ; ENTRY VECTOR STUFF CLEANED UP (USES 0-LENGTH FEATURE) ; HALT, HALTF ARE SILENT RETURNS TO IDDT ;IDDT.MAC;2 11-SEP-72 22:19:55 EDIT BY PLUMMER ; SAVE/RESTORE USER'S TTY TAB SETTINGS ; SAVE BREAKS-IN-PROGRESS WORD IN $I+3 ; LEFT AND RIGHT HALF SYMBOL FIXUPS ; AUTOMATIC $: AT STARTUP ; ALLOW TAGS WITH OPCODE NAMES ; ? COMMAND IMPROVED ;<2SOURCES>IDDT.MAC;243 25-AUG-72 17:52:06 EDIT BY PLUMMER ; SMACRO ASSEMBLY ; MOVED FROM 667000 TO 740000 ;<2SOURCES>IDDT.MAC;242 26-JUL-72 19:51:00 EDIT BY PLUMMER ; FIX JSYS EVAL TITLE NDDT SUBTTL W.W.PLUMMER, NOVEMBER 71 ;CKS SEARCH CPUNUM KA10F==0 ;CKS KI10F==0 ;CKS KL20F==1 ;CKS MIT==0 ;CKS SEARCH MONSYM HOME==700000 ;WHERE NDDT LIVES BLAST: MOVEI 4,770- MOVE 2,[400000,,-1] SETOM 1 SETZ 3, ;WATCH OUT FOR KL20 AOS 2 PMAP SOJN 4,.-2 MOVE 0,[LOW,,HOME] BLT 0,DDTEND-1 HRLZ 0,116 HRRI 0,DDTEND HLRE 1,116 MOVEI 2,DDTEND-1 SUB 2,1 BLT 0,0(2) MOVEI 0,DDTEND HLL 0,116 MOVEM 0,116 MOVEM 0,@770001 MOVEM 0,X116 HRROI 1,[ASCIZ \Output NDDT to \] PSOUT HRLOI 1,(GJ%FOU!GJ%MSG!GJ%FNS!GJ%SHT!GJ%CFM) MOVE 2,[.PRIIN,,.PRIOU] GTJFN 0 MOVEM 1,JFN MOVEI 1,400000 MOVE 2,[3,,EVEC] SEVEC MOVE 0,[PROTO,,1] BLT 0,16 JRST 4 PROTO: -1 ;1 400000-1,,-1 ;2 0 ;3 AOS 2 ;4 PMAP ;5 CAME 2,16 ;6 JRST 4 ;7 HRR 1,JFN ;10 HRLI 1,400000 ;11 MOVE 2,15 ;12 SSAVE ;13 JRST INIT ;14 -1000,,560000 ;15 400000,,-1 ;16 LIT ;DEFINE ACCUMULATORS T1==1 T2==2 T3==3 T4==4 F=0 ;FLAGS R= ;POINTERS TO TABLES, CORE, ETC. S=3 ;USED IN EVAL, FP1, FP4 W=4 ;CONTAINS DISPATCH ADDRESS, USED IN FP1A, FP4 T=5 ;TRANSFER DATA W1=T+1 W2=7 SCH=10 ;MODE CONTROL SWITCH FOR OUTPUT - CONTENT TYPER AR=SCH+1 ;MODE CONTROL SWITCH FOR OUTPUT - ADDRESS TYPER ODF=AR+1 ;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX TT=13 ;TEMPORARY TT1=TT+1 ;TEMPORARY TT2=15 ;TEMPORARY TT3=16 ;TEMPORATY P=17 ;PUSH DOWN IFNdef gpldf,< gpldf==0> ; Gpld jsys exists? IFNdef isigff,< isigff==<1-KL20F>> ; Isi's version of gfrks (no skip) IFNdef delchf,< delchf==<1-KL20F>> ; Delch jsys (for nifty editting)? IFNdef adbrkf,< adbrkf==KL20F> ; Address break stuff IFNDEF MIT, ;ASSUME FOR MIT IFN DELCHF,> ;DEFINE BITS FOR USE IN LEFT HALF OF ACCUMULATOR F COMF==200000 ;COMMA TYPED FLAG TIF==100000 ;TRUNCATE TO 18 BITS - SET BY SPACE OR COMMA PTF==100 ; +, -, OR * HAS BEEN TYPED CTF==400 SF==4 ;SYLLABLE FLAG QF==1 ;QUANTITY TYPED IN TO WORD ASSEMBLER CF==40 ; $ TYPED CCF==10000 ; $$ TYPED MF==2 ;MINUS SIGN TYPED IN LTF==20 ;LETTER TYPED IN TO CURRENT SYLLABLE ROF==10 ;REGISTER OPEN FLAG STF==4000 FAF==1000 ; < TYPED SAF==2000 ; > TYPED FPF==20000 ; . TYPED IN FEF==400000 ; E FLAG MLF==200 ;*FLAG DVF==40000 ;DIVIDE FLAG ;DEFINE BITS FOR USE IN RIGHT HALF OF ACCUMULATOR F ITF==2 ;INSTRUCTION TYPED IF ITF=1 OUTF==4 ;OUTPUT IF OUTF=1 CF1==400 ;OUTPUT 1 REGISTER AS CONSTANT LF1==2000 ;OUTPUT 1 REGISTER AS FORCED SYMBOLIC OR CONSTANT Q2F==1 ;NUMBER TYPED AFTER ALT MODE NAF==200 ;NEGATIVE ADDRESSES PERMISSABLE POWF==4000 ;ARGUMENT FOR EXPONENT COMING XEQ==40 ;WE'RE IN A $X SSTEPF==20 ; WE ARE SINGLE STEPPING YSTEPF==40000 ; WE ARE IN $Y SINGLE STEP MODE VS $J MODE CONDX==1000 ;WE'RE EXECUTING THE CONDITIONAL BREAK INSTR. TEMF==10000 ;TEMPORARY FLAG TEM2F==10 ;ANOTHER TEMPORARY, USED ONLY IN ;O STUFF ; And in merge not to clear INTFLG==20000 ;EXPR CONTAINS DDT INTERNAL REGISTER SEMIF==100 ;SEMICOLON TYPED SEMIF2==100000 ;TWO SEMICOLI TYPED SUPTEM==200000 ;SUPER-TEMPORARY TYPEOUT MODE ;RANDOM THINGS MAXJFN==155 ;HIGHEST JFN NUMBER STRBFL==10 ;STRING (ATOM) BUFFER LENGTH ;DEFINE PUSH DOWN LENGTH LPDL==100 ;MAX LENGTH PUSH DOWN LIST PCSL==150 ;OLD PC STACK LENGTH ;DEFINE SYMBOL TABLE SYMBOL TYPES GLOBAL==040000 ;GLOBAL SYMBOL LOCAL==100000 PNAME==740000 ;PROGRAM NAME DELI==200000 ;DELETE INPUT DELO==400000 ;DELETE OUTPUT ;DEFINE UDEFINED SYMBOL TABLE TYPES STADD==1B0 ;IF 1, THEN ADDITIVE REQUEST STLH==1B1 ;IF 1, THEN REQUEST FOR LEFT HALF STNEG==1B4 ;IF 1, THEN NEGATIVE REQUEST ;FLAG SAYING ADDRESS IS IN NDDT'S ADDRESS SPACE ;MUST BE DIFFERENT THAN UNDEFINED SYMTAB TYPE BITS DDTINT==1B5 NRBL==50 ;NUMBER OF RING-BUGGER LOCATIONS (FOR SAVING OF EXAMINED LOCS) NBP==10 ;NUMBER OF BREAKPOINTS NTBPTS==3 ;NUMBER OF TEMPORARY BREAKPOINTS OPDEF TYO [PBOUT] ;OPDEF TYI [PBIN] OPDEF CALL [PUSHJ P,] OPDEF RET [POPJ P,] DEFINE INTOFF < MOVEI 1,400000 MOVSI 2,(1B0) DIC> DEFINE INTON < MOVEI 1,400000 MOVSI 2,(1B0) ;THE RUBOUT CHANNEL AIC> LOW: PHASE HOME NDDT: ;ENTRY VECTOR EVEC: JRST INIT ;"START" JRST INIT ;"REENETER" JRST SPLICD ;INFERIOR HAS BEEN SPLICED BY EXEC VERSN: 1 PATVER: 0 X116: 0 ;COPY OF 116 ;FORK HANDLE SUPPLIED IN AC1 FROM EXEC SPLICD: MOVEM 1,TPFORK ;SAY WE HAVE AN INFERIOR MOVEM 1,FORK MOVE P,PS ;GET A STACK IFN KL20F,< ffork> CALL SETTRP ; SET JSYS TRAP FOR BPT INIT: INTOFF ;PREVENT SURPRISES DURING INIT MOVE P,PCSTAK MOVEM P,PCSPTR ;RESET STACK OF PC'S MOVE P,PS ;MAIN STACK MOVEI 1,.FHSLF ;SET UP CAPABILITIES RPCAP SETOM 3 ;TRY FOR EVERYTHING EPCAP SKIPLE TPFORK ;DOES USER ALREADY EXIST? JRST INIT3 ;YES MOVEI 1,100 SIBE ;ANY TYPE AHEAD? JRST INIT09 ;YES MOVEI 1,101 HRROI 2,[ASCIZ /NDDT./] SETZ 3, SOUT MOVE 2,VERSN MOVEI 3,^D10 NOUT JFCL SKIPN PATVER JRST INIT09 MOVEI 2,"." BOUT MOVE 2,PATVER MOVEI 3,^D10 NOUT JFCL INIT09: CALL NEWFRK ;GET A NEW FORK repeat 0,< ;COPY TO INFERIOR FORK MOVEI 1,400000 GEVEC CAMN 2,[3,,EVEC] SETZM 2 SEVEC HRLZI 1,410001 HRROI 2,[ASCIZ /CORE-SWAP.NDDT/] GTJFN 0 HRLI 1,400000 MOVE 2,[-,,560000] SETZM 3 SSAVE HRLZI 1,1 HRROI 2,[ASCIZ /CORE-SWAP.NDDT/] CALL GETFIL ;GET INTO INFERIOR FORK MOVEI 1,400000 MOVE 2,[3,,EVEC] SEVEC ;SET IT BACK AGAIN MOVSI 1,100001 HRROI 2,[ASCIZ /CORE-SWAP.NDDT/] GTJFN JRST INIT3 DELF JFCL > INIT3: MOVE 1,FORK RUNTM MOVEM 1,TIMUSD MOVEM 3,TIMCON MOVE 1,TPFORK FFORK ;FREEZE THE USER AOSE USRFLG ;WERE WE IN THE USER BEFORE ^C, REE?? JRST INIT4 ;NO, NDDT HAS USER INFO ALREADY CALL USTATE ;GET COMPLETE STATE OF USER FORK SKIPL SYMPTR ;DO WE ALREADY HAVE SYMBOLS? CALL SYMVEC ;GET SYMBOLS, ENT. VEC. ;SETUP INTERRUPT SYSTEM ON NDDT FORK INIT4: MOVEI 1,400000 MOVE 2,[LEVTAB,,CHNTAB] SIR ;SETUP CIS EIR IFE ADBRKF,< MOVSI 2,(1B0!1B1!1B2)> ;RUBOUT, ^T, AND BPT CHANS IFN ADBRKF,< MOVE 2,[1B0!1B1!1B2!1B19]> ;INFERIOR TERMINATION TOO AIC JRST DDT ;ENTRIES FROM USER ;RUBOUT HIT, MAKE BELIEVE INSTR TRAP HAPPEND RUBOUT: AOSE USRFLG ;WE'RE WE IN USER? JRST RENWRG ;NO, REENTER NDDT AT WRONG MOVEI 1,100 CFIBF ;FLUSH TYPE-AHEAD JRST TRAP ;BPT INTERRUPT BPTINT: MOVE 1,TPFORK FFORK ; STOP THE WORLD. RTFRK ; READ WHICH FORK HIT BPT IFE KL20F,< JRST BPTIN1> IFN KL20F,< erjmp bptin1> BPTIN4: IFE KL20F,< HLRZS 1> CAME 1,FORK CALL UNMAP MOVEM 1,FORK UTFRK INTOFF MOVEI 1,BPTIN0 MOVEM 1,IPC1 DEBRK BPTIN0: SETZM BPTFLG CALL USTATE MOVSI 1,6 JRST TRAPD1 BPTIN1: MOVSI 2,-14 BPTIN2: MOVEI 1,BPTS BPTI2A: HRRZ 3,7(1) CAIN 3,400001(2) JRST BPTIN3 ; FORK HANDLE IN USE -- SKIP IT ADDI 1,NBPTV CAIE 1,> JRST BPTI2A MOVEI 1,400001(2) CAME 1,FORK CAMN 1,TPFORK JRST BPTIN3 RFRKH BPTIN3: AOBJN 2,BPTIN2 RTFRK IFE KL20F,< 0 > JRST BPTIN4 ;INSTR. TRAP. COULD BE ILL INSTR, ETC. TRAP: INTOFF MOVE 1,TPFORK CAME 1,FORK CALL UNMAP MOVEM 1,FORK MOVE 1,TPFORK FFORK IFE KL20F,< MOVEI 1,TRAPD MOVEM 1,IPC2 DEBRK> CIS TRAPD: SETZM BPTFLG ;ASSUME NOT FROM BPT CALL USTATE ;GET USER STATE TLZ 1,400000 ;INTERRUPT --> 0 TRAPD1: MOVEM 1,WHY HLRZ W,1 ;W HAS TERMINATION REASON HRRZS 1 ;1 HAS REASON WHY ILLEGAL IF W NOT = 2 SETZM TRAPWD SETZM WDATA IFN ADBRKF,< CAIE W,7 ;ADDRESS BREAK HIT? CAIN W,10 ;OR JOB WANTS THE TTY JRST TRAP7> ;YES CAIE W,6 ;NEW BPT CLASS CAIN W,2 ;HALTF, HFORK, BPT JRST TRAP2 CAIN W,3 ;ILL INST., ILL MEM REF, ETC JRST TRAP3 ;INTERRUPT, IO WAIT, FORK WAIT TR014: MOVEI 1,10 ;HANDLE AS INTERRUPT, WHY=10 FOR XXX: HRRM 1,WHY JRST NOTMT ;GO TYPE BREAK MESSAGE IFN ADBRKF,< TRAP7: MOVEI 1,25-7(W) ;FAKE REASON (ABK: OR TTY:) HRRM 1,WHY JRST NOTMT> ;FORCED TERMINATION CLASS TRAP3: CAIL 1,20 CAILE 1,22 JRST NOTMT ;NOT A MEMORY TRAP ;MEMORY ACCESS VIOLATION MEMTRP: MOVE 1,FORK GTRPW MOVEM 1,TRAPWD MOVEM 2,WDATA TLNN 1,12 ;READ AND EXECUTE TRAPS LEAVE GOOD PC SOS PC ;WRITE LEAVES IT STEPPED, AND BIT-5 ON(R/W/X) NOTMT: TRNN F,CONDX ;ARE BPT'S IN? CALL REMOVB ;YES, PULL THEM OUT MOVEI 1,100 CFIBF ;CLEAR TYPE-AHEAD AT ERROR JRST TBRK ;TYPE THE BREAK MESSAGE ;VOLUNTARY TERMINATION (HFORK, HALTF, BPT) ;GET ACTUAL INSTRUCTION THAT CAUSED TRAP TRAP2: HRRZ R,PC TRAP21: CALL FETCH ;FETCH AN INSTR SETZM T ;PROTECTED, MAKE LIKE ILLEGAL INSTR. TRAP22: LDB W1,[POINT 9,T,8] CAIE W1,</1B8> ;IS THIS AN XCT? JRST TRAP23 TRAP29: LDB R,[POINT 4,T,17] CAIE R,0 ;ANY XR SPECIFIED? MOVE R,AC0(R) ;YES, GET IT ADD R,T ;DO INDEX ADDITION HRRZS R TLNN T,(@) ;ANY INDIRECTION? JRST TRAP21 ;NO, CHECK FOR ANOTHER XCT CALL FETCH ;FETCH INDIRECT ADDR SETZM T JRST TRAP29 TRAP23: PUSH P,T ;SAVE IT PUSH P,R TRNN F,CONDX CALL REMOVB ;PULL OUT BPT'S IF THEY ARE IN POP P,R POP P,T CAMN T,[BPT] JRST CHKBPT ;POSSIBLE BPT HIT CAME T,[HFORK] CAMN T,[HALTF] AOSA PC ;SO A $P WILL CONTINUE JRST TRAP27 MOVSI W1,(1B5) IORM W1,REALPC MOVE W1,[ASCIZ "NDDT"] CALL TEXT JRST DD1 ;HERE IS AN OBSCURE CASE. THE FORK HAS BEEN HALTED BY A SUPERIOR ;OF NDDT. THE RIGHT THING TO DO IS JUST RFORK (IE JRST TOUSER). ;HOWEVER THE WFORK WILL IMMEDIATELY COMPLETE AGAIN AND WE WILL BE ;IN A GIANT LOOP, BURNING CYCLES. TO AVOID THIS WE WILL HANDLE IT ;JUST LIKE A RUBOUT INTERRUPT, USING THE TIME IT TAKES THE ;USER TO TYPE $P AS A DELAY. ;THE GENERAL PROBLEM IS THAT THE USER FORK HAS TWO PROCESSES WRITING ;ON ITS STATUS -- NDDT AND THE SUPERIOR. THIS REQUIRES SOME FORM OF ;COOPERATION BETWEEN THE WRITES AS NOT TO CONFUSE THINGS! TRAP27: MOVEI W,16 ;FAKE BREAK NUMBER MOVEM W,WHY JRST NOTMT ;GO TYPE THE HFK:... MSG CHKBPT: TRNE F,CONDX ;HIT BPT, WERE THEY IN? JRST CHKBP2 ;NO, TRY FOR $X COMPLETION, ETC. ;SEE IF IT IS A BPT PUSH P,R JSP TT1,CHKADR ; GET OWNING FORK MOVE R,(P) ANDCMI R,777000 ; FLUSH PAGE HRRZ T,LASFPG LSH T,9 IOR R,T MOVEI T,BPTS CHKBP1: HRRZ W,0(T) ;WHERE THIS BPT IS PLANTED HLRZ W1,LASFPG XOR W1,7(T) CAMN R,W ;WHERE ONE ENCOUNTERED TRNE W1,777777 JRST CHKB1A POP P,R JRST BCOM CHKB1A: ADDI T,NBPTV CAIE T,BPTS+NBP*NBPTV JRST CHKBP1 POP P,R ;IS IT A PSEUDO BPT -- $X COMPLETION, ETC CHKBP2: MOVEM R,TT HRRZ W1,XRG ;WHERE $X HAPPENS IN USER SUB TT,W1 JUMPLE TT,CHKBPZ ;WITHIN ALLOWED RANGE OF SKIPS? CAILE TT,3 JRST CHKBPZ ;NO, CALL IT ILLEGAL ;PSEUDO BPT HIT, SEE WHY TRNE F,XEQ ;IN $X? JRST XCOM ;YES. TRNE F,SSTEPF ;SINGLE STEPPING? JRST JSTEP2 TRNE F,CONDX ;IN A CONDITIONAL BREAK EVAL? JRST CONCOM ;YES. JRST ILLINS ;HUH? ;NOT LEGAL AS $X, BUT MIGHT BE $^N COMPLETION CHKBPZ: MOVEM R,TT HRRZ W1,$CTRLN+3 ;LOCATION OF FIRST BPT SUB TT,W1 JUMPL TT,ILLINS ;WITHIN ALLOWED RANGE OF SKIPS? CAIL TT,3 JRST ILLINS ;NO, CALL IT ILLEGAL TRNN F,SSTEPF ;SINGLE STEPPING? JRST ILLINS ;NOPE, MUST BE ILL INS MOVE TT,R SUB TT,$CTRLN ;TT GETS AMOUNT TO OFFSET REALPC BY JRST JSTCTN ;TYPE SOFTWARE GENERATED (NDDT) ILLEGAL INSTRUCTION ILLINS: MOVEI W,17 ;ILL: MOVEM W,WHY ;TYPE BREAK MESSAGE, WHY SAYS WHICH TBRK: CALL CRF ;CARRIAGE RETURN HRRZ W,WHY TBRK1: MOVE W1,MSG(W) ;TEXT OF BREAK REASON CALL TEXT2 ;TYPE IT HRRZ T,PC CAIN T,20 ;WAS THIS AT STUPID BREAKPOINT OR ^N HACK? HRRZ T,LLOC ;GET REAL LOCATION SETOM PINFF ;PRINT APPROPRIATE AC AND EFF ADR CALL LI1 ;EXAMINE THE BREAK LOCATION, SETUP "." CALL LCT HRRZ W,WHY CAIE W,10 ;INTERRUPT CODE TRNN F,XEQ!CONDX JRST DD2 CALL UNSET ;POP PREVIOUS $X CONTEXT JRST DD1 ;READ THE USER'S STATE ;SWITCH TTY AND SUBSYS TO NDDT USTATE: MOVEI 1,100 RFMOD MOVEM 2,SAVTTY RFCOC MOVEM 2,SAVTT2 MOVEM 3,SAVTT3 MOVE 2,TTYCC2 MOVE 3,TTYCC3 SFCOC GTABS MOVEM 2,USRTB2 MOVEM 3,USRTB3 MOVEM 4,USRTB4 MOVE 2,DDTTB2 MOVE 3,DDTTB3 MOVE 4,DDTTB4 STABS GETNM MOVEM 1,SUBSYS MOVE 1,['NDDT '] SETNM ;SET SUBSYSTEM NAME CALL GETUSR ; GET STATE OF USER FORK RET ;GET STATE OF USER FORK INTO NDDT SPACE GETUSR: MOVE 1,FORK RWM MOVEM 1,USRPSI+0 ;USER CHANNELS WITH WAITING REQ. MOVE 1,FORK RCM MOVEM 1,USRPSI+1 ;ACTIVE USER CHANNELS MOVEM 2,USRPSI+2 ;BREAKS IN PROGRESS MOVE 1,FORK SETOM USRPSI+3 SKPIR ;SEE IF USR HAS INTERRUPTS ON SETZM USRPSI+3 DIR TLO 1,(RT%DIM) RTIW ; Terminal interrupt word DMOVEM 2,USRPSI+4 HRRI 1,.FHJOB RTIW DMOVEM 2,USRPSI+6 SETZB 2,3 STIW ERJMP .+1 ; Can fail if no ^C capability MOVEI 1,.FHJOB MOVE 2,[060000,,100000] STIW ERJMP .+1 MOVE 1,FORK MOVEI 2,AC0 RFACS ;GET USER'S AC'S RFSTS MOVEM 2,REALPC TLNN 2,(1B5) ;MONITOR MODE PC? SOS 2 ;YES, BACK IT UP SO . WILL APPEAR OK MOVEM 2,PC ;AND HIS PC SETZM USRFLG ;WE'RE NOT IN THE USER. RET ; SET STATE OF USER FORK FROM NDDT SPACE SETUSR: MOVE 1,FORK MOVEI 2,AC0 SFACS ;GIVE BACK HIS AC'S SETOM 2 DIC ;DEASSIGN ALL CHANNELS MOVE 2,USRPSI+1 ;TURN ON ONES WHICH SHOULD BE ACTIVE AIC SKIPE USRPSI+3 EIR ;INTERRUPTS ARE SUPPOSED TO BE ON IFN KL20F,< TLO 1,(ST%DIM) ; TERMINAL INTERRUPT WORD >;IFN KL20F DMOVE 2,USRPSI+4 STIW ERJMP .+1 ; Can fail if no ^C capability HRRI 1,-5 DMOVE 2,USRPSI+6 STIW ERJMP .+1 TOUSR6: MOVE 1,FORK RFSTS ;GET PC MOVE 1,FORK CAMN 2,REALPC ;SAME AS IT WAS AT ENTRY? RET ;YES, RFORK TO RESUME MOVE 2,REALPC ;NO, SET IT TO WHAT IT SHOULD BE SFORK ;IT IS FROZEN RET DDT: SETZM STRING ;GET COMMANDS FROM TTY, NOT STRING AT BPT CALL CHKSYM ;INITIALIZE SYMBOL TABLE CALL PGMST ;DO A $: IF POSSIBLE DD1: CALL CRF ;TYPE CAR.RET. LINE FEED ;CARR. RET. ETC., COME BACK HERE DD1.5: TLZ F,ROF ;CLOSE ANY OPEN REGISTER DD1.6: MOVE T,[SCHM,,SCH] BLT T,ODF ;LOAD MODE CONTROL SWITCHES DD2: SETZM WAKALL ;WAKEUP ON PUNCT AND CTRLS TRZE F,SUPTEM MOVE SCH,SCHSAV ;RESTORE IF SUPER-TEMPORARY MODE SETZM PRNC ;PARENTHESES COUNT INTOFF ;SOME COMMANDS DO INTON MOVE P,PS CALL REMTBP ;REMOVE TEMPORARY BPTS (PUT IN FOR $^N) ;OPEN PAREN COMES BACK HERE LIS: MOVE T,ESTU MOVEM T,ESTUT ;INIT UNDEFINED SYM ASSEM MOVEI 1,100 RFMOD ANDCMI 2,17B23!3B25!3B29 IORI 2,16B23!2B25!1B29 ;DON'T AWAKEN ON ALPHA SFMOD TDZ F,[777777-ROF-STF,,LF1+CF1+ITF+Q2F] ; < AND > COME BACK HERE WHICH==SEMIF!SEMIF2!NAF!CONDX!TEMF!TEM2F!INTFLG LIS0: TDZ F,[777777-ROF-STF-FAF-SAF,,WHICH] SETZM WRD ;SPACE AND , HERE LIS1: SETZM FRASE ;+ - @ ETC. HERE LIS2: MOVEI T,1 MOVEM T,FRASE1 TLZ F,MLF+DVF ;* / HERE L1: TLZ F,CF+CCF+SF+FPF ;TURN OFF CONTROL, SYL, PERIOD FLAG L1A: SETZM SYL ;NO SYL YET ;^ ETC. HERE L1RPR: SETZM SYM MOVEI T,6 MOVEM T,TEM ;INIT CHR PER SYMBOL COUNTER MOVE T,[POINT 7,TXT] MOVEM T,CHP ;SETUP FOR OPEVAL SYMBOL SETZM TXT SETZM TXT+1 ;TO KEEP JSYS LOOKUP HAPPY SETZM DEN ;DECIMAL NUMBER ACCUMULATOR SETZM WRD2 ;NUMBER TO RIGHT OF $ IN COMMAND ;NUMBERS, LETTERS COME BACK HERE FOR MORE OF SYMBOL L2: MOVE 1,[^D20,,1] ;^T TO CHANNEL 1 ATI MOVE 1,ESCCOD ;THE CURRENT ESCAPE CODE (^D) DTI CALL TIN ;PICK UP CHARACTER LZ: HRLZ 1,ESCCOD ;ASSIGN TO CHAN. 0 ATI CAIL T,"A"+40 ;LOWER CASE A CAILE T,"Z"+40 ;LOWER CASE Z CAIA ;NOT LOWERCASE TRC T,40 ;CHANGE LOWER CASE TO UPPER CASE TRNN F,SEMIF ;SEMICOLON CONTROL, OR... TLNE F,CF ;ALT. MODE CONTROL FLAG? JRST L21 ;CONTROL CAIG T,"Z" ;Z CAIGE T,"A" ;A JRST L21 ;NOT A LETTER JRST LET ;CONTROL OR NOT-LETTER L21: CAILE T,137 JRST ERR TRNE F,SEMIF ADDI T,140 ;USE OTHER TABLE MOVE R,T IDIVI R,3 ;REMAINDER GIVES COLUMN, QUOTIENT GIVES ROW LDB W,BDISP(R+1) ;GET 12 BIT ADDRESS FROM DISPATCH TABLE CAIGE W,MULT-DDT ;FIRST EVAL ROUTINE JRST DDT(W) ;NO EVAL MOVE T,SYL TLZN F,LTF JRST POWER CAIN W,SPACE-DDT ;IS TERMINATOR A SPACE? SKIPE WRD ;AND WORD SO FAR ZERO? SKIPA T,[OPEVAL,,EVAL];NO, SEARCH EVAL 1ST MOVS T,[OPEVAL,,EVAL];YES, DO OP SEARCH MOVEM T,TEM1 JRST L213 L212: HLRZS T,TEM1 ;GET ADDRESS OF THE OTHER LOOKUP ROUTINE JUMPE T,UND1 ;IF ADR=0, THEN SYMBOL UNDEFINED L213: CALL (T) ;CALL OPEVAL OR EVAL JRST L212 ;SYMBOL NOT FOUND CAIN W,ASSEM-DDT ;DEFINED SYMBOL FOLLOWED BY #? JRST ERR ;EXPONENT ROUTINE COMES BACK HERE L4: TLZE F,MF MOVN T,T TLNN F,SF CAIE W,LPRN-DDT SKIPA JRST LPRN EXCH T,FRASE1 TLNN F,DVF IMULB T,FRASE1 TLZE F,DVF IDIVB T,FRASE1 CAIGE W,ASSEM-DDT JRST DDT(W) ;MULTIPLY OR DIVIDE ADDB T,FRASE CAIGE W,SPACE-DDT JRST DDT(W) ; + - @ , ADD T,WRD TLNE F,TIF ;TRUNCATE INDICATOR FLAG HLL T,WRD ;TRUNCATE MOVEM T,WRD TLNN F,QF MOVE T,LWT SETZM R MOVE W1,ESTUT ;W1 IS USED IN DEPRA CAMN W1,ESTU JRST L5 CAILE W,CARR-DDT JRST ERR L5: CAIG W,RPRN-DDT JRST DDT(W) PUSH P,[JRST RETX] SKIPN PRNC JRST DDT(W) ;GIVE GENERALIZED ERROR COMMENT ERR: SETZM STRING SETZM BBC ;KILL THE BUFFERED CHARACTER IF AN ERROR MOVEI W1,"?" JRST WRONG1 ;UNDEFINED SYMBOL TYPED. UNDEF: MOVEI W1,"U" JRST WRONG1 ;RUBOUT FROM INSIDE NDDT ;REENTER NDDT AT WRONG RENWRG: MOVEI 1,100 CFIBF MOVEI 1,101 CFOBF IFE KL20F,< MOVEI 1,WRONG MOVEM 1,IPC2 DEBRK> IFN KL20F,< cis> WRONG: MOVE W1,[ASCII /XXX/] WRONG1: MOVE P,PS CALL TEXT TLNN F,ROF ;REG OPEN? JRST DD1 ;NO, CR AND RESET ;COMMON RETURN RETX: MOVE P,PS CALL LCT ;COMMON RETURN FOR TAB;,JRST LIS JRST DD2 UND1: MOVE R,ESTUT ;UNDEFINED SYM ASSEMBLER JUMPE R,UNDEF ;UNDEFINED IF NO UNDEF TAB HLRE S,ESTUT ASH S,-1 ;SETUP EVAL END TEST HRLOI W1,37777+DELI+LOCAL CALL EVAL2 CAIN W,ASSEM-DDT TLNN F,ROF JRST UNDEF SKIPE PRNC JRST UNDEF MOVEI T,"#" CAIE W,ASSEM-DDT CALL TOUT MOVN R,[2,,2] ADDB R,ESTUT MOVE T,SYM TLO T,GLOBAL MOVEM T,(R) HRRZ T,LLOCO TLNE F,MF TLO T,(STNEG) ;SET FLAG TO SHOW SUBTRACTIVE REQUEST TLO T,(STADD) ;SET FLAG TO SHOW UNCHAINED REQUEST MOVEM T,1(R) MOVEI T,0 JRST L4 ;? COMMAND QUESTN: TLNE F,CF ;MAKE $$? = ;? LIKE DEC DDT JRST SEM.QU CALL CRF ;LIST UNDEFINED SYMBOLS INTON TLNE F,LTF ;HAS A SYMBOL BEEN TYPED? JRST QLIST ;NO MOVE R,ESTU QUEST1: JUMPGE R,DD1 MOVE T, (R) SKIPA W1,ESTU QUEST2: ADD W1,[2,,2] CAME T,(W1) JRST QUEST2 CAME R,W1 JRST QUEST4 CALL SPT CALL CRF QUEST4: ADD R,[2,,2] JRST QUEST1 QLIST: HLRE S,SYMPTR ASH S,-1 ;NUMBER OF ENTRIES SKIPL R,SYMPTR JRST RETX ;NO SYM TAB QLIST1: SETZM QLPNT ;SAY NO REFERENCE YET QLIST2: MOVE T,(R) ;GET SYM TLZN T,PNAME ;A PROG NAME? JRST QLIST6 ;YES CAMN T,SYM ;NO, IS AN OCCURANCE FOUND? HRRZM R,QLPNT ;YES, REMEMBER WHERE QLIST3: AOBJN R,.+1 ;MOVE TO NEXT TAB ENTRY AOBJN R,QLIST4 ;END OF TABLE? MOVE R,SYMPTR ;YES RING PTR QLIST4: AOJLE S,QLIST2 ;DONE ALL SYMS? JRST DD1 ;YES QLIST6: SKIPN QLPNT ;FOUND THE SYM? JRST QLIST3 ;NO, KEEP LOOKING CALL SPT1 ;PRINT PROGRAM NAME MOVE T,@QLPNT ;GET SYM BACK TLNN T,GLOBAL JRST QLIST7 ;NOT GLOBAL CALL TSPC ;TYPE SPACE AND G MOVEI T,"G" CALL TOUT QLIST7: CALL CRF SETZM QLPNT ;RESET FIND FLG JRST QLIST3 ;RESUME SEARCH ;DIGITS, ADD IN TO OCTAL ;ACCUMULATOR (SYL), FLOATING NUM (FH,SYL) ;AND DECIMAL NUMBER (DEN), THEN HANDLE AS A LETTER NUM: ANDI T,17 ;T HOLDS CHARACTER TLNE F,CF+FPF ;$ TYPED OR EXPONENT JRST NM1 ;FORM WRD2 MOVE W,SYL LSH W,3 ADD W,T MOVEM W,SYL MOVE W,DEN IMULI W,12 ;CONVERT TO DECIMAL ADD W,T MOVEM W,DEN AOJA T,LE1A ;$ SIGN DOLLAR: SKIPA T,[46+"A"-13] ;RADIX 50 $ TO BE ;PER CENT SIGN PERC: MOVEI T,47+"A"-13 ;PERCENT SIGN ;LETTERS, ADD IN TO SYMBOL (SYM) BEING TYPED IN LET: TLC F,SF+FPF ;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1 TLZN F,LTF+FEF+SF+FPF CAIE T,"E" TLOA F,LTF TLOA F,FEF JRST LET1 TLZN F,MF SKIPA W1,SYL MOVN W1,SYL MOVEM W1,FSV SETZM DEN LET1: SUBI T,"A"-13 ;FORM RADIX 50 SYMBOL LE1A: TLO F,SF+QF ;PACK CHARACTER INTO SYM LE2: MOVE W,SYM MOVEI R,"A"-13(T) IMULI W,50 ;CONVERT TO RADIX 50 ADD W,T SOSGE TEM ;IGNORE CHARACS AFTER 6 JRST L2 MOVEM W,SYM IDPB R,CHP JRST L2 ;FORM NUMBER AFTER $ NUM1: EXCH T,WRD2 IMULI T,12 ADDM T,WRD2 TRO F,Q2F JRST L2 NM1: TLNE F,CF JRST NUM1 MOVEI W1,6 ;FORM FLOATING POINT NUMBER AOS W2,NPWR10 ;GET THE NEGATIVE POWER OF TEN MOVSI R,(1.0) NM1A: TRZE W2,1 FMPR R,FT(W1) JUMPE W2,NM1B LSH W2,-1 SOJG W1,NM1A NM1B: MOVSI W1,211000(T) ;UNNORMALIZED FP VALUE OF DIGIT FMPR R,W1 ;COMPUTE VALUE OF NEW DIGIT FADRB R,FH ;ADD VALUE INTO FLOATING NO. MOVEM R,SYL AOJA T,LE1A ;THIS SEQUENCE INITIALIZES THE SYM TAB LOGIC CHKSYM: HLRZ T,ESTU SUB T,ESTU MOVE W,SYMPTR ADD T,W ;IF THE TOP OF THE UNDEFINED SYM TAB DOES TRNE T,-1 ; NOT POINT TO BOTTOM OF REGULAR SYM TAB,THEN HRRZM W,ESTU ; RE-INIT UNDEFINED SYM TABLE POINTER, ESTU. MOVE T,PRGM SUB T,W ;IF THE SYM TABLE PNTR AND THE PROGRAM TSC T,T ; NAME (PRGM) PNTR DO NOT END UP IN THE MOVE W1,PRGM ; SAME PLACE, OR THEY DO NOT BOTH START ON XOR W1,W ; AN EVEN (OR BOTH ON ODD) LOCATION, OR TRNN W1,1 ; PRGM .GE. 0, THEN RE-INIT PRGM. JUMPE T,CHKSY0 SETZM PRGM SETZM BLOCK ;RESET WORLD ;SETUP $X LOCATION FROM DEFINITION OF PAT.. CHKSY0: MOVE S,SYMPTR ;SEARCH LOW TO HIGH. PAT.. IS 1ST! CHKSY1: MOVE T,0(S) ;GET A SYMBOL AOBJN S,.+1 ;BUMP POINTER TO VALUE XOR T,[RADIX50 4,PAT..];WHAT WE ARE LOOKING FOR TDNE T,[177777,,777777] ;BITS WHICH MATTER AOBJN S,CHKSY1 ;NO MATCH. TRY NEXT SYM. SKIPGE S ;DID WE FIND IT? SKIPA T,0(S) ;YES. GET THE VALUE MOVEI T,20 ;NO. DEFAULT $X LOCATION HRRZM T,XRG ;WHERE $X WILL BE DONE. (PATCHES TOO) RET ;AUTOMATIC $: FOR PROGRAM CONTAINING THE START ADDRESS PGMST: MOVE 1,FORK GEVEC JUMPE 2,CPOPJ ;NO ENTRY VECTOR HRRZ W,2 ;SA SKIPL PRGM ;DON'T IF ALREADY SET SKIPL R,SYMPTR ;OR IF NO SYMTAB RET MOVSI T,1 ;BIG NUMBER JRST PGMS19 PGMST0: MOVE T,0(R) ;GET ENTRY TLNE T,(17B3) ;PROGRAM NAME? JRST PGMST2 ;NO, SKIP IT PGMST1: HRRZ T,1(R) ;LOW BREAK SUB T,W ;COMPARE WITH SA MOVN T,T ;Make sign right. JUMPL T,PGMST2 ;THIS PRGM'S BRK IS BELOW THE SA CAML T,TEM ;BREAK CLOSER THAN LAST ONE? JRST PGMST2 ;NO MOVEM R,PRGM ;CURRENT BEST PROGRAM PGMS19: MOVEM T,TEM ;CUNNENT BEST DISTANCE PGMST2: AOBJN R,.+1 AOBJN R,PGMST0 ;TRY NEXT ENTRY SETZM BLOCK SKIPL R,PRGM ;DID IT GET SET? RET MOVE T,0(R) ;THE PROGRAM NAME MOVEM T,SYM ;SETUP FOR SB1 CALL SB1 ;LOOK FOR BLK NAME = PRGM NAME RET ;NONE(UGH! EVAL WILL LOOP AROUND EV2B) MOVEM R,BLOCK ;DO $& TOO RET POWER: TLNN F,FEF JRST L4 ;NO EXPONENT CAIE W,PLUS-DDT CAIN W,MINUS-DDT TROE F,POWF TRZA F,POWF JRST DDT(W) ; E+- MOVE W2,DEN SETZM FRASE MOVEI W1,FT-1 TLZE F,MF MOVEI W1,FT01 SKIPA T,FSV POW2: LSH W2,-1 TRZE W2,1 FMPR T,(W1) JUMPE W2,L4 SOJA W1,POW2 PERIOD: MOVE T,DEN ;VALUE OF DECIMAL NUMBER TLNE F,SF ;SYLLABLE STARTED? JRST PERIO2 ;YES, TAKE AS DECIMAL NUMBER MOVE T,LLOC ; VALUE OF "." IN CURRENT SEQUENCE TLZE F,CF!CCF ;IF $ OR $$ THEN USE PC HRRZ T,PC TLNN T,(DDTINT) ; "." INTERNAL TO NDDT? JRST PERIO2 ;NO TROE F,INTFLG ;SAY THIS EXPR IS INTERNAL JRST ERR ;INTERNAL ARITHMETIC PERIO2: MOVEM T,SYL TLNE F,FPF ;HAS A PERIOD BEEN SEEN BEFORE? TLO F,LTF ;YES, TWO PERIODS MAKES A SYMBOL TLON F,FPF+SF+QF MOVEI T,0 IDIVI T,400 SKIPE T TLC T,243000 TLC W1,233000 FAD T,[0] ;NORMALIZE T AND W1 FAD W1,[0] FADR T,W1 MOVEM T,FH SETZM NPWR10 ;NUM OF DIGITS PASSED THE DEC. PT. MOVEI T,45 ;RADIX 50 PERIOD JRST LE2 ;PROCESS AS SYMBOL CONSTITUENT ;$Q VALUE OF LAST THING TYPED BY NDDT OR USER QUAN: TLNN F,CCF SKIPA T,LWT ;$Q, GET LAST WORD TYPED MOVS T,LWT ;$$Q, GET IT SWAPPED JRST QUAN1 ;$V LEVT HALF -- $$V TO GET SIGN EXTENDED LEFT: HLRE T,LWT TLNN F,CCF HRRZS T JRST QUAN1 ;HERE TO EXAMINE AN INTERNAL REGISTER -- READ SIXBIT NAME AND LOOKUP INTSYM: TRZ F,SEMIF!SEMIF2 ;CLEAR SEMICOLON TYPED FLAGS MOVEI W1,6 ;ALLOW SIX CHARACTERS PUSH P,[0] ;BUILD SIXBIT ON TOP OF STACK MOVE W2,[POINT 6,(P)] INTSY2: CALL TIN MOVEM T,BBC ;SAVE BUFFERED-BACK CHARACTER CAIL T,"a" CAILE T,"z" SKIPA SUBI T,"a"-"A" ;IF LOWERCASE CONVERT TO UPPERCASE CAIL T,"A" ;MUST BE ALPHABETIC CAILE T,"Z" JRST INTSY1 ;NOT, SO TRY NUMERIC INTSY3: SUBI T," " ;MAKE SIXBIT SETZM BBC ;NO LONGER BUFFERED, WE USED IT SOJL W1,INTSY2 ;ONLY PUT 6 CHARACTERS INTO T IDPB T,W2 JRST INTSY2 INTSY1: CAIL T,"0" CAILE T,"9" ;NUMERIC? SKIPA JRST INTSY3 ;YES, SO BUILD UP MORE SIXBIT SETZI W1, POP P,T ;GET SIXBIT JUMPE T,INTXIT ;NULL, SO RETURN 0 MOVEI W2,INSYMB ;GET START OF INTERNAL SYMBOL TABLE INTSY4: HLRZ TT,(W2) ;THE POINTER TO THE SIXBIT CAMN T,(TT) ;MATCH THIS INTERNAL SYMBOL? JRST INTXI1 ;YUP, READ VALUE AND MAKE INTERNAL CAIGE W2,INSYME ;DONE WITH TABLE? AOJA W2,INTSY4 ;NOPE, TRY NEXT ENTRY JRST ERR ;ELSE SYMBOL NOT FOUND INTXI1: HRRZ T,(W2) ;PICK UP SYMBOL'S VALUE INTXIT: ;;; FALL INTO QUANIN ;;; FALL IN FROM INTSYM ;HERE TO EXAMINE INTERNAL REGISTER ;ADDRESS OF IT IN T ;USED BY $G $X ETC. QUANIN: TLO T,(DDTINT) ;MARK FOR ADR INTERNAL TO DDT TROE F,INTFLG ;DOES EXPR ALREADY CONTAIN INT SYM? JRST ERR ;YES. MOVEI W,1 MOVEM W,FRASE1 QUAN1: MOVEM T,SYL QUAN2: TLO F,SF+QF ;WRD,SYL STARTED TLZ F,CF+CCF JRST L2 ;SEMICOLON TYPED SEMIC: TROE F,SEMIF ;SEEN ONE ALREADY? TRO F,SEMIF2 ;YES JRST CONTR1 ; $ TYPED CONTRO: TLOE F,CF ;HAVE ALREADY SEEN ONE? TLO F,CCF ;YES CONTR1: SETOM WAKALL ;WAKEUP ON EVERYTHING JRST L2 ;BIT 40 - DELETE OUTPUT ; 20 - DELETE INPUT ; 10 - LOCAL ; 04 -GLOBAL ; NO BITS - PROGRAM NAME ;LOCAL+GLOBAL=BLOCK NAME, VALUE IS BLOCK LEVEL ;S IS -NUMBER OF SYMBOLS LEFT TO BE CONSIDERED ;R IS CURRENT SYM TAB POINTER ;SYM HAS SYMBOL BEING LOOKED UP ;W1 HAS CODE BITS WHICH WILL CAUSE THE CURRENT ; ENTRY TO BE SKIPPED OVER ;PRGM IS 0 OR POINTER TO CURRENT PROGRAM'S SYMBOLS ;BLOCK IS 0 OR POINTER TO CURRENT BLOCK'S SYMBOLS ;TBLK IS THE TEMPORARY BLOCK POINTER IF NOT 0 ;BLVL IS THE HIGHEST LEVEL BLOCK ALREADY SCANNED ;LOOKUP LOCAL IN THIS PROGRAM, OR ELSE GLOBAL ANYWHERE ;FOR PURPOSE OF KILLING ($$K) A SYMBOL EVAL0: HRLOI W1,37777+DELI ;IGNORE HALF-KILLED SYMBOLS HLRE S,SYMPTR ASH S,-1 ;SETUP END TEST (- NUM OF ENTRIES IN TABLE) JRST EVAL3 EVAL1: ADD R,[2,,2] EVAL2: SKIPL R MOVE R,SYMPTR AOJG S,CPOPJ ;TRANSFER IF NO SYMBOL FOUND EVAL3: MOVE T,(R) XOR T,SYM TLNN T,PNAME ;WHEN PROGRAM NAME ENCOUNTERD,... TLOA W1,LOCAL ; STOP LOOKING AT LOCAL SYMS TDNE T,W1 ;REJECT THIS ENTRY? JRST EVAL1 ;YES, WRONG TYPE OR NAME DOESN'T MATCH TLNN T,340000 ;IS THIS ENTRY DELETED? JRST EVAL1 ;YES. FORGET IT MOVE T,1(R) ;GET DEFINITION CPOPJ1: AOS (P) ;FOUND SYMBOL, SKIP CPOPJ: RET ;MAIN SYMBOL LOOKUP. EVAL: CALL EVALA ;SEARCH UP THE SYMBOL TREE JRST EV9 ;NOT FOUND. SEARCH WHOLE TREE JRST CPOPJ1 ;FOUND, SKIP. ;SCAN UP THE SYMBOL TREE. ;DON'T CONSIDER SYMS IN BLKS ON ; SAME OR DEEPER LEVELS. EVALA: MOVSI W1,DELI ;IGNORE HALF-KILLED SYMS HLRE S,SYMPTR ASH S,-1 ;END CHK. - # OF TAB ENTRIES SKIPL R,TBLK JRST EVL1 SETZM TBLK JRST EVL2 ;NO BLOCK SET EVL1: SKIPL R,BLOCK JRST EV5 ;NO PERM BLOCK EITHER. ;GET LEVEL FROM DEF OF CURRENT BLOCK EVL2: MOVE T,1(R) MOVEM T,BLVL ;BLKS DEEPER THAN BLVL WON'T BE CONSIDERED JRST EV1 ;START SCAN WITH THIS BLOCK'S SYMS EV3: CAMN R,SYMPTR ;JUST CHECKED LOWEST ENTRY? JRST EV4 ;YES, RING R TO TOP AND CONTINUE AOJGE S,CPOPJ ;NOTHING FOUND IF ALL ENTRIES SCANNED ;MAIN LOOP EV1: SUB R,[2,,2] ;MOVE TO NEXT ENTRY MOVE T,(R) ;GET NAME AND TYPE TDNE T,W1 ;TEST TYPE BITS JRST EV3 ;THIS TYPE BEING REJECTED LDB T,[POINT 4,(R),3] ;GET TYPE BITS CAIN T,3 JRST EV2 ;BLOCK NAME SKIPN T ;PROGRAM NAME? TLOA W1,LOCAL ;YES. START REJECTING LOCALS SKIPA T,(R) ;RESTORE T IF NOT PRGM NAME JRST EV3 ;RESUME SCAN AFTER PROGRAM NAME XOR T,SYM ;SEE IF ENTRY MATCHES KEY TLZ T,740000 ;FLUSH TYPE BITS FROM CONSIDERATION JUMPN T,EV3 ;NO MATCH. KEEP LOOKING MOVE T,1(R) ;GET DEFINITION JRST CPOPJ1 ;SKIP. ;SCAN HIT BOTTOM OF TABLE, RING TO TOP EV4: HLRE R,SYMPTR MOVNS R ;GET POSITIVE LENGTH ADD R,SYMPTR ;ONE ENTRY PASSED TOP AOJL S,EV1 ;KEEP SCANNING IF ALL NOT CHECKED RET ;NOT FOUND ;BLOCK NAME ENCOUNTERED EV2: MOVE T,1(R) ;DEF. IS LEVEL OF NEW BLOCK'S SYMBOLS CAMGE T,BLVL ;LEVEL < LEVELS ALREADY CONSIDERED? JRST EV2A ;YES. SCAN THEM EV2B: SUB R,[2,,2] ;NO. SKIP OVER THIS BLOCK ADDI S,1 ;LOOK FOR ANOTHER BLOCK WHICH ENCLOSES THIS ONE LDB T,[POINT 4,(R),3] CAIE T,3 JRST EV2B ;NOT A BLOCK NAME. KEEP LOOKING JRST EV2 ;BLOCK NAME. CHECK ITS LEVEL EV2A: MOVEM T,BLVL ;SAVE LEVEL OF ENCLOSING BLOCK JRST EV3 ;SO NO DEEPER BLOCKS WILL BE SCANNED ;HERE WHEN EVALA CALLED AND NO CURRENT TBLK OR BLOCK EV5: MOVEI T,1 MOVEM T,BLVL ;SET LEVEL TO 1 (MAIN) SKIPGE R,PRGM ;IS THERE A PRGM SET? JRST EV1 ;YES, SEARCH ITS SYMBOLS,ALL LEVELS HLRE R,SYMPTR ;RESET R TO TOP OF TAB MOVNS R ADD R,SYMPTR JRST EV1 ;SCAN WHOLE SYMBOL TREE LOOKING FOR PROGRAM AND ; BLOCK WHICH CONTAIN SYM. TYPE PRGM AND BLK ; IF APPROPRIATE. EV9: SETZM SVTB SETZM SVFB SETOM SVF ;INDICATE NO MATCH FOUND YET HLRE T,SYMPTR JUMPGE T,CPOPJ ; EMPTY SYMBOL TABLE MOVNS T ADD T,SYMPTR HRRZ R,T ;R POINTS AT END OF TABLE + 2 EV9A: SUB R,[2,,2] ;MOVE DOWN ONE ENTRY CAMN R,SYMPTR ;LOOKING AT BOTTOM ENTRY? JRST EV9B ;YES LDB T,[POINT 4,(R),3] ;GET TYPE BITS CAIN T,3 JRST EV9C ;BLOCK NAME CAIN T,0 JRST EV9D ;PROGRAM NAME TRNE T,4 JRST EV9A ;DELETED, IGNORE MOVE T,(R) XOR T,SYM TLZ T,740000 ;FLUSH TYPE BITS FROM CONSIDERATION JUMPN T,EV9A ;DOESNT MATCH KEY, TRY NEXT AOSE SVF ;IS THIS THE FIRST FIND? JRST EV9E ;NO MOVEM R,BLVL ;YES. REMEMBER BLOCK LEVEL MOVE T,1(R) MOVEM T,SVBTS JRST EV9A ;RESUME SCAN ;NOT FIRST MATCH EV9E: MOVE T,1(R) CAME T,SVBTS ;DEFINITION SAME AS FIRST MATCH? RET ;NO, REPORT FAILURE SETZM SVF ;MUST BE -1 OR 0 (0 FOR ON) JRST EV9A ;RESUME SCAN ;BLOCK NAME ENCOUNTERED EV9C: SKIPN SVF ;HAS A MATCH BEEN SEEN ALREADY? JRST EV9A ;YES, KEEP LOOKING MOVEM R,SVFB ;NO, REMEMBER WHICH BLOCK WE'RE AT JRST EV9A ;IN CASE WE GET A FIND IN THIS ONE ;PROGRAM NAME ENCOUNTERED EV9D: SKIPN SVF ;HAS A MATCH BEENSEEN ALREADY? JRST EV9A ;YES. KEEP SCANNING MOVEM R,SVTB ;NO. REMEMBER IN CASE MATCH IS FOUND SETZM SVFB ;NEW PRGM. DON'T KNOW BLK YET JRST EV9A ;KEEP SCANNING ;SCAN HIT BOTTOM ENTRY IN TABLE EV9B: SKIPE SVF ;MATCH FOUND? RET ;NO. REPORT FAILURE AOS (P) ;SET FOR SKIP RETURN MOVEI T,"'" CALL TOUT SKIPE R,SVTB ;DO WE HAVE A PRGM NAME, CAMN R,PRGM ;AND IS IT SAME AS CURRENT ONE? JRST EV9B1 ;YES. DON'T BOTHER PRINTING PRGM NAME MOVE T,(R) ;FROM NOW ON WHEN WE TYPE FOO$:, WE DO IT TOO! PUSH P,R CALL SPT1 MOVSI T+1,(ASCIZ /$:/) CALL TEXT2 POP P,R CALL SSBLK JRST EV9B2 EV9B1: MOVE W1,BLVL CALL SPT0 EV9B2: MOVE R,BLVL ;RETURN WHERE IN TABLE MOVE T,1(R) ;AND VALUE RET ;COME HERE TO DO A $: WHEN A SYMBOL IS NOT IN THE CURRENT BLOCK SSBLK: MOVE T,(R) MOVEM T,SYM MOVE R,SYMPTR ;SET PROGRAM NAME - DOLLAR COLON SSET1: JUMPGE R,UNDEF MOVE T,(R) CAMN T,SYM JRST SSET2 ADD R,[2,,2] JRST SSET1 SSET2: MOVEM R,PRGM SETZM BLOCK CALL SB1 CAIA MOVEM R,BLOCK POPJ P, TEXTYP: MOVE R,LLOC MOVE W1,[POINT 7,[ASCIZ /$0"/]] CALL TYPE PUSH P,R TEXTL1: CALL FETCH JRST TEXTL3 MOVE TT2,T MOVNI W1,5 MOVE TT1,[440700,,TT2] TEXTL2: ILDB T,TT1 JUMPE T,TEXTL3 CALL TOUT AOJN W1,TEXTL2 AOS R,(P) JRST TEXTL1 TEXTL3: POP P,R MOVEI T,"$" CALL TOUT JRST RETX TEXCHR: MOVEI R,CHRO JRST TEXHER TEXSQZ: MOVEI R,R50PNT JRST TEXHER TEXSIX: SKIPA R,[SIXBP] ;OUTPUT . IN SIXBIT TEXASC: MOVEI R,TEXTT ;OUTPUT . IN ASCII TEXHER: TRNE F,SUPTEM MOVEM SCH,SCHSAV ;SUPER TEMPORARY. SO SAVE MOVEM R,SCH MOVS S,[SCHM,,SCH] ;MODE SWITCHES TO MEMORY TLNE F,CCF BLT S,ODFM ;WITH $$, MAKE MODES PERMANENT TLO F,QF MOVE T,LLOC PUSH P,[RETX] JRST LI2A CHRO: MOVE W1,[POINT 7,[ASCIZ /$0#/]] CALL TYPE MOVE R,LLOC CALL FETCH JRST ERR CALL TOUT JRST RETX CHRI: TRO F,SUPTEM TLNN F,CF JRST TEXCHR TRZ F,SUPTEM TLNN F,CCF TRNN F,Q2F JRST TEXCHR PUSH P,[QUAN1] JRST TEXI1 SQZI: TRO F,SUPTEM TLNN F,CF ;NO $S TYPED. THIS IS SUPER TEMPORARY JRST TEXSQZ ;SO PRINT IT AND SET SUPTEM FLAG TRZ F,SUPTEM ;NOT SUPER-TEMPORARY TLNN F,CCF ;WAS IT $$&? TRNN F,Q2F ;WAS THERE A $& WITHOUT A NUMBER TYPED JRST TEXSQZ ;IF EITHER, GO AND TYPE IT PUSH P,[SQZIN] JRST TEXI1 SIXI: TRO F,SUPTEM TLNN F,CF ;NO $S TYPED. THIS IS SUPER TEMPORARY JRST TEXSIX ;SO PRINT IT AND SET SUPTEM FLAG TRZ F,SUPTEM ;NOT SUPER-TEMPORARY TLNN F,CCF ;WAS IT $$'? TRNN F,Q2F ;WAS THERE A $' WITHOUT A NUMBER TYPED JRST TEXSIX ;IF EITHER, GO AND TYPE IT PUSH P,[SIXBIN] JRST TEXI1 TEXI: TRO F,SUPTEM TLNN F,CF ;NO $'S TYPED. THIS IS SUPER TEMPORARY JRST TEXASC ;SO PRINT IT AND SET SUPTEM FLAG TRZ F,SUPTEM ;NOT SUPER-TEMPORARY TLNN F,CCF ;WAS IT $$"? TRNN F,Q2F ;WAS THERE A $" WITHOUT A NUMBER TYPED JRST TEXASC ;IF EITHER, GO AND TYPE IT PUSH P,[TEXI2+1] ;THIS MUST BE $0", SO GET INPUT SETZM TXUPRW SETZM TXQUOT TEXI1: PUSH P,2 INTON MOVEI 1,100 RFMOD IORI 2,17B23 ;WAKEUP ON EVERYTHING SFMOD POP P,2 MOVEI T,33 MOVEM T,SYL ;TERMINATE ON ALTMODE ALWAYS MOVEI W1,5 MOVEI T-1,0 CALL TIN CAIN T,33 ;NEW ALT MODE, ESCAPE JRST [MOVE W1,WRD2 IORM W1,T SETZM WRD2 JRST QUAN2] POP P,A JRST (A) TEXI2: CALL TIN SKIPE TXQUOT JRST TXQT CAMN T,SYL JRST TEXI3 SKIPE TXUPRW JRST TXUPR CAIN T,"Q"-100 JRST [SETOM TXQUOT JRST TEXI2] CAIN T,"^" JRST [SETOM TXUPRW JRST TEXI2] TEXI2A: ROT T,-7 LSHC T-1,7 SOJG W1,TEXI2 MOVE T,WRD2 IORM T,W ; SET BIT CALL TEXDEP ; DEPOSIT THIS WORD OF TEXT JRST TEXI2+1 ; AND CONTINUE TEXI3: LSHC T-1,-43 JUMPLE W1,[MOVE W1,WRD2 IORM W1,T SETZM WRD2 JRST QUAN1] LSH T,7 SOJA W1,.-2 TXQT: SETZM TXQUOT JRST TEXI2A TXUPR: SETZM TXUPRW CAIN T,"?" JRST TXDEL SUBI T,100 JUMPL T,ERR JRST TEXI2A TXDEL: MOVEI T,177 JRST TEXI2A TEXDEP: TLNN F,ROF ; IS A REGISTER OPEN? JRST TEXDE2 CALL TIN CAMN T,SYL TLNE F,CCF JRST .+2 RET PUSH P,T MOVE T,-1(P) XCT 1(T) MOVE R,LLOCO CALL DEP JRST ERR POP P,T AOS LLOCO MOVEI W1,5 MOVEI T-1,0 RET TEXDE2: AOS (P) ; Skip return CALL TTPEEK ; Look ahead CAME T, SYL ; Terminator? SKIPA T, SYL ; Type for him JRST TIN JRST TOUT SIXBIN: SKIPA W1,[6] SIXBI1: CALL TIN ; INPUT TEXT (SIXBIT) CAMN T,SYL JRST SIXBI2 CAIL T,"A"+40 ;IS CHAR BETWEEN LOWER CASE "A" AND CAILE T,"Z"+40 ; LOWER CASE "Z"? SKIPA ;NO TRC T,40 ;YES, CONVERT TO UPPER CASE CAIL T," " ;IS CHAR IN SIXBIT SET? CAILE T,"_" JRST ERR ;NO ANDI T,77 ;YES, MASK TO 6 BITS TRC T,40 ;CONVERT TO SIXBIT FORM ROT T,-6 LSHC T-1,6 SOJG W1,SIXBI1 CALL TEXDEP ; DEPOSIT THIS WORD OF TEXT JRST SIXBI1+1 SIXBI2: MOVE T,T-1 JUMPLE W1,[SETZM WRD2 JRST QUAN1] LSH T,6 SOJA W1,.-2 SQZIN: PUSH P,[0] SKIPA W1,[6] SQZIN1: CALL TIN CAMN T,SYL JRST SQZIN2 CAIL T,"A"+40 CAILE T,"Z"+40 SKIPA TRC T,40 SQZIN3: CAIL T,"A" CAILE T,"Z" JRST .+3 SUBI T,66 JRST SQZIN4 CAIL T,"0" CAILE T,"9" JRST .+3 SUBI T,57 JRST SQZIN4 CAIN T,"." JRST [MOVEI T,45 JRST SQZIN4] CAIN T,"$" JRST [MOVEI T,46 JRST SQZIN4] CAIN T,"%" JRST [MOVEI T,47 JRST SQZIN4] CAIE T,"#" JRST [SUB P,[1,,1] JRST ERR] SQZIN4: MOVEI 2,50 IMULM 2,(P) ADDM T,(P) SOJG W1,SQZIN1 CALL TEXDEP JRST SQZIN1+1 SQZIN2: CALL SQZFIX JUMPLE W1,[PUSHJ P,SQZFIX POP P,1 SETZM WRD2 JRST QUAN1] IMULI T,50 SOJA W1,.-2 SQZFIX: MOVE 1,WRD2 IDIVI 1,12 IMULI 1,10 ADD 1,2 LSH 1,36 TLZ 1,37777 MOVE T,-1(P) IORM 1,T POPJ P, ; ;R -- TAKE PRECEEDING SYMBOL AS RADIX 50 RDX50: MOVE T,SYM MOVEM T,SYL TLZ F,FPF!FEF!LTF!SF TRZ F,SEMIF!SEMIF2 ;ALLOW $ MODIFIERS JRST L1RPR ;$K -- KILL SYMBOL FOR OUTPUT ;$$K -- KILL FOR INPUT AND OUTPUT ;SYM HAS THE SYMBOL KILL: TLNN F,LTF ;DOES SYM CONTAIN A LETTER? JRST KILTAB ;NO CALL EVAL JRST KILL1 ;CANT FIND A DEFINED SYM BY THAT NAME ;FOUND. R POINTS AT NAME-VALUE PAIR IN SYM TAB MOVEI T,DELO/200000 ;DELETE OUTPUT TLNE F,CCF MOVEI T,DELI/200000 ;NO INPUT OR OUTPUT DPB T,[POINT 2,(R),1] ;LEFT 2 BITS IN SYMBOL JRST RETX KILL1: MOVE R,ESTU ;REMOVE UNDEFINED SYMS JUMPGE R,UNDEF ;EMPTY KILL2: CALL EVAL0 JRST RETX CALL REMUN JRST KILL2 ;REMOVE ONE SYMBOL FROM THE UNDEFINED TABLE REMUN: MOVE S,[2,,2] ADDB S,ESTU ;SHORTEN UNDEF TABLE AND MOVE ORG UP MOVE W,-2(S) ;PUT SYM WHICH FELL OFF BOTTOM MOVEM W,(R) ;IN PLACE OF SYM BEING DELETED MOVE W,-1(S) MOVEM W,1(R) RET ;$$K -- KILL ENTIRE SYMBOL TABLE KILTAB: TLNN F,CCF ;HOW MANY $'S JRST ERR ;NOT ENOUGH CALL FLSSYM JRST RETX ;SYMBOL TABLE FLUSHER FLSSYM: SKIPL T,SYMPTR ;OLD SYMBOL POINTER MOVE T,[-2,,HOME-2] MOVEM T,SYMPTR CAMN T,[-2,,HOME-2] JRST FLSUNS ;NO OLD SYMS PAGES TO WORRY ABOUT HRLZI R,0(T) TLZ R,777000 SUB T,R ASH T,-11 TRZ T,777000 SETZ 3, ;WATCH OUT FOR KL20 FLSSP: HRR 2,T ;PAGE HRLI 2,400000 ;NDDT FORK SETOM 1 ;DISMISS IT PMAP AOBJN T,FLSSP MOVE T,[-2,,HOME-2] ;"NULL" SYM PTR MOVEM T,SYMPTR SETZM PRGM SETZM BLOCK SETZM TBLK ;FLUSH UNDEFINED SYMBOL TABLE FLSUNS: SKIPL T,ESTU RET ;NONE HRLZI R,0(T) TLZ R,777000 SUB T,R ASH T,-11 TRZ T,777000 SETZ 3, ;WATCH OUT FOR KL20 FLSUN1: HRR 2,T ;PAGE HRLI 2,400000 ;NDDT FORK SETOM 1 ;DISMISS IT PMAP AOBJN T,FLSUN1 SETZM ESTU SETZM ESTUT RET ;SYM HAS SYMBOL TO LEFT OF : ;DEFV HAS VALUE OF A IN A$: MOVE W,LLOCO ;: COMMAND, LLOCO=VALUE OF . TLNE F,(DDTINT) JRST ERR ; . WAS INSIDE OF NDDT HRRZM W,DEFV tag0: call defin jrst retx ; Return ;DEFINE A SYMBOL ;SYM AND DEFV HAVE THE NAME AND VALUE DEFIN: CALL EVALA ;DEFINED SYMBOL? JRST DEF1 ;NO - DEFINE JRST DEF2 ;YES, REDEFINE DEF1: MOVN R,[2,,2] ADDB R,SYMPTR ;MOVE UNDEFINED TABLE 2 REGISTERS HRRZ T,ESTU SUBI T,2 HRL T,ESTU HRRM T,ESTU SKIPGE ESTU BLT T,-1(R) DEF2: MOVE T,DEFV MOVEM T,1(R) ;PUT IN NEW VALUE MOVSI T,GLOBAL IORB T,SYM MOVEM T,(R) ;PUT IN NEW SYM AS GLOBAL MOVE R,ESTU DEF3: JUMPGE R,CPOPJ ;PATCH IN VALUE FOR UNDEF SYM ENTRY MOVE T,SYM TLO T,GLOBAL ;UNDEFINED TAB HAS GLOBAL ENTRIES CAME T,(R) JRST DEF4 PUSH P,R ;SAVE PTR SKIPL R,1(R) ;IS ENTRY AN ADDITIVE REQUEST? JRST DEF7 ;NO, CHAINED IN RIGHT HALF CALL FETCH JRST ERR TLNN R,(STNEG) ;ADDITIVE OR SUBTRACTIVE? SKIPA S,DEFV ;ADDITIVE MOVN S,DEFV ;SUBTRACTIVE TLNE R,(STLH) ;RIGHT OR LEFT HALF? JRST DEF8 ;LEFT ADD S,T ;RIGHT HRRM S,T DEF5: CALL DEP JFCL DEF6: POP P,R CALL REMUN DEF4: ADD R,[2,,2] ;REMOVE THE NOW DEFINED SYMBOL JRST DEF3 DEF7: JUMPE R,DEF6 ;JUMP IF ALL DONE CALL FETCH JRST ERR HRRZ S,T ;SAVE CHAIN PTR HRR T,DEFV ;REPLACE WITH NEW VALUE CALL DEP JRST ERR ;LEAVES DANGLING CHAIN!!! HRRZ R,S JRST DEF7 DEF8: HRLZS S ;LEFT HALF FIXUP ADD T,S JRST DEF5 ;$: COMMAND SETNAM: MOVE R,SYMPTR ;SET PROGRAM NAME - DOLLAR COLON SET1: JUMPGE R,UNDEF MOVE T,(R) CAMN T,SYM JRST SET2 ADD R,[2,,2] JRST SET1 SET2: MOVEM R,PRGM SETZM BLOCK CALL SB1 JRST RETX SBPRM: MOVEM R,BLOCK JRST RETX ;SEARCH SYMBOLS IN PROGRAM BEGINNING AT R ;FOR BLOCK NAMED SYM SB1: CAMN R,SYMPTR RET ;HIT BOTTOM OF TAB. SUB R,[2,,2] LDB T,[POINT 4,(R),3] JUMPE T,CPOPJ ;BEGINNING OF NEXT PROGRAM CAIE T,3 JRST SB1 ;NOT A BLOCK NAME MOVE T,(R) XOR T,SYM TLZ T,740000 JUMPN T,SB1 ;NAME DOESN'T MATCH JRST CPOPJ1 SETBLK: TLNN F,LTF JRST SQZI ;NO LETTERS GIVEN SKIPL R,PRGM JRST ERR ;NO PROGRAM NAMED CALL SB1 JRST UNDEF TLNE F,CF ;$ OR $$ COMMAND? JRST SBPRM ;$: TO SET PROGRAM NAME MOVEM R,TBLK JRST L1RPR ;$$: TO SET BLOCK NAME ;FILE LOGIC ;THE FLAG TEMF IS USED TO CONTROL WHETHER OR NOT THE FORK IS ; TO BE STARTED AFTER THE GET ASSOCIATED WITH THE COMMAND (;Y, ;M ; ;L, OR $L). ON SUPPRESS RUNNING IT. ; ;Y -- YANK, BUT DON'T START A FILE YANK: MOVE W1,[POINT 7,[ASCIZ /ank file: /]] TLNE F,CF ; ALT-SEMI-Y MOVE W1,[POINT 7,[ASCIZ /ank data file: /]] TRO F,TEMF ;SUPPRESS RUNNING IT JRST LODFIL ; ;M -- MERGE FILE INTO CURRENT USER FORK MERGE: MOVE W1,[POINT 7,[ASCIZ /erge file: /]] TRO F,TEMF ;SUPPRESS RUNNING IT JRST LODFIL ;BYPASS NEWFORK GETTER ; ;L -- RUN THE NAMED FILE LOADGO: MOVE W1,[POINT 7,[ASCIZ /oadgo: /]] TRZ F,TEMF ;ALLOW IT TO RUN LODFIL: CALL TYPE LODFI2: IFN KL20F,< HRROI 1,[ASCIZ /EXE/]> IFE KL20F,< hrroi 1, [asciz /SAV/]> MOVEM 1,DEFALT+5 MOVSI 1,(gj%old!gj%cfm) MOVEM 1,DEFALT MOVEI 1,DEFALT MOVEI 2,0 JRST ASJFN ;$L -- RUN THE LOADER LOADER: IFE KL20F,< MOVE W1,[POINT 7,[ASCIZ /oader [Confirm]/]]> IFN KL20F,< MOVE W1,[POINT 7,[ASCIZ /ink [Confirm]/]]> CALL TYPE ; MOVEI 1,.PRIIN ; CFIBF ; RESET BUFFER AND ASK PBIN CAIN 1,15 ; OK ON CRLF PBIN CAIE 1,12 JRST [MOVE W1,[POINT 7,[ASCIZ / Aborted?/]] CALL TYPE JRST DD1.5] TLZ F,CF CALL KILFRK CALL NEWFRK TRZ F,TEMF ;ALLOW IT TO RUN HRLZI 1,100001 IFE KL20F,< HRROI 2,[ASCIZ /LOADER.SAV/]> IFN KL20F,< hrroi 2, [asciz /SYS:LINK.EXE/]> ; 1,2 ARE SET FOR GTJFN ASJFN: PUSH P,2 PUSH P,1 MOVE 1,FORK GEVEC ;MAYBE NULL POP P,1 EXCH 2,0(P) ;SAVE OLD EV CALL GETFIL ;LOAD FILE CALL SYMVEC ;GET SYMS, ENT. VEC TO R LODDN1: MOVEM R,0(P) MOVEI 2,0(R) TLO 2,(1B5) ;USERMODE MOVEM 2,PC MOVEM 2,REALPC POP P,2 MOVE 1,FORK SEVEC TRNE F,TEMF ;ARE WE SUPPOSED TO RUN IT? JRST DDT ;NO CALL CRF JRST TOUSER ; ;O -- OBTAIN SYMBOL FILE OBTAIN: YNKSYM: MOVE W1,[POINT 7,[ASCIZ /btain symbol file: /]] CALL TYPE CALL FLSSYM ;FLUSH PAGES CONTAINING PREVIOUS SYMS HRROI 1,[ASCIZ /SYMBOLS/] MOVEM 1,DEFALT+5 MOVSI 1,(gj%old!gj%cfm) MOVEM 1,DEFALT MOVEI 1,DEFALT MOVEI 2,0 CALL GETJFN JRST SYMSO4 ;NO SYMBOLS?? MOVEM 1,TEM1 MOVE 2,[44B5!1B19] OPENF JRST SYMSO3 YNKSY1: BIN JUMPGE 2,YNKSY9 ;NO DEFINED TAB HLRE 3,2 ;THE NEGATIVE LENGTH YNKSY2: MOVEI T,HOME ADD T,3 ;LOWEST ADDR OF DEF SYMTAB HRL T,3 ;MAKE AOBJN PTR MOVEM T,SYMPTR ;THAT'S THE SYMTAB PTR MOVSI 2,(POINT 36,0) HRR 2,T ;36-BIT POINTER SIN YNKSY3: BIN ;UNDEF TAB IOWD JUMPGE 2,YNKSY8 ;NO UNDEFINED TABLE HLRE 3,2 ;GET NEG. LENGTH MOVE T,SYMPTR ;PUT UNDER DEFINED TAB ADD T,3 ;BASE OF UNDEF TAB HRL T,3 ;MAKE AOBJN PTR MOVEM T,ESTU ;THAT'S THE UNDEF. PTR MOVSI 2,(POINT 36,0) HRR 2,T SIN YNKSY4: MOVE 1,TEM1 CLOSF JRST ERR JRST DD1 YNKSY8: SETZM ESTU ;SAY NO UNDEF SYMTAB JRST YNKSY4 ;GO CLOSE FILE YNKSY9: MOVE T,[-2,,HOME-2] ;DUMMY UP A GOOD PTR MOVEM T,SYMPTR JRST YNKSY3 ;LOOK FOR UNDEF. SYMTAB ;GET FILE, SYMBOLS, AND ENTRY VECTOR (IF ANY) ;1,2 ARE SETUP FOR GTJFN GETFIL: CALL GETJFN ;ONLY FLUSH STUFF IF GETJFN WINS JRST [MOVE W1,[POINT 7,[ASCIZ / GTJFN Failed?/]] CALL TYPE CALL CRF JRST DD1.5] HRRZM 1,SUBSYS HRRZM 1,JFN HRROI 1,JFNDIR MOVEM 1,DEFALT+.GJDIR MOVE 2,JFN MOVSI 3,(JS%DIR) SETZ 4, JFNS HRROI 1,JFNNAM MOVEM 1,DEFALT+.GJNAM MOVSI 3,(JS%NAM) JFNS CALL UNMAP ;FLUSH PAGE IN WINDOW CALL KILFRK CALL NEWFRK TLNE F,CF JRST GETDFL HRL 1,FORK HRR 1,JFN GET RET ;GET A FILE OF NON-RUNNABLE STUFF (LIKE $0L ON ITS) GETDFL: HRRZ 1,JFN MOVE 2,[444400,,OF%RD] OPENF JRST [MOVE W1,[POINT 7,[ASCIZ / Can't open file?/]] CALL TYPE JRST GETDF2] MOVEM 1,GDFROM MOVE 1,FORK MOVEM 1,GDTO GDENTR: SKIPN 1,DEFV ; GET LOWER LIMIT MOVE 1,SYL MOVEM 1,DEFV ; SAVE AWAY MOVEM 1,SYL ; TEMP SKIPN 1,ULIMIT MOVEI 1,777777 MOVEM 1,ULIMIT ; SAVE UPPER LIMIT SETZ 2, GETDLP: HRLZ 1,GDFROM HRR 1,DEFV PUSH P,2 RPACS ; FIND THIS PAGE TLNN 2,10000 JRST [POP P,2 JRST GETDF0] ; IF DOESN'T EXIST, STOP POP P,2 HRL 2,GDTO MOVSI 3,(PM%RD+PM%CPY) MOVE TT1,GDFROM CAMN TT1,FORK JRST [PUSH P,1 PUSH P,2 MOVE R,DEFV LSH R,9 ADDI R,100 CALL FETCH JRST ERR CALL DEP JRST ERR POP P,2 POP P,1 JRST .+1] PMAP ; KEEP THOSE PAGES COMING AOS 1,DEFV CAMG 1,ULIMIT AOJA 2,GETDLP GETDF0: CALL CRF MOVE T,DEFV SUB T,SYL ; #PAGES TRANSFERRED MOVEM T,TT2 JUMPE T,[MOVE W1,[POINT 7,[ASCIZ /No pages./]] CALL TYPE JRST GETDF1] CALL TOC MOVE W1,[POINT 7,[ASCIZ / page/]] CALL TYPE MOVEI 1,TT2 CAIE 1,1 JRST [MOVE W1,[POINT 7,[ASCIZ /s/]] CALL TYPE JRST .+1] MOVE W1,[POINT 7,[ASCIZ / starting with page /]] CALL TYPE MOVE T,SYL CALL TOC MOVEI T,"." CALL TOUT HRRZ 1,GDTO CAME 1,FORK JRST GETDF3 MOVE 1,JFN MOVE 2,SYL LSH 2,9 SFPTR JRST ERR MOVE 2,[444400,,AC0] MOVNI 3,20 SIN MOVE 1,FORK MOVEI 2,AC0 SFACS GETDF1: HRRZ 1,JFN CLOSF JFCL GETDF2: SUB P,[2,,2] GETDF4: SETZM DEFV SETZM ULIMIT JRST DDT GETDF3: MOVE 1,GDTO HRLI 1,12 SETO 2, MOVE 3,TT2 LSH 3,9 CHFDB MOVE 1,GDTO CLOSF JFCL JRST GETDF4 ;DO AN ITS $0Y (UN-ALT-SEMI-Y) UNASY: MOVE W1,[POINT 7,[ASCIZ /nyank data to file: /]] CALL TYPE HRROI 1,[ASCIZ /EXE/] MOVEM 1,DEFALT+.GJEXT MOVSI 1,(gj%fou!gj%msg!gj%cfm) MOVEM 1,DEFALT+.GJGEN MOVEI 1,DEFALT MOVEI 2,0 CALL GETJFN JRST ERR MOVEM 1,TT1 MOVE 2,[440000,,OF%WR] OPENF JRST ERR MOVEM 1,GDTO MOVE 1,FORK MOVEM 1,GDFROM MOVEI 2,AC0 RFACS MOVE 1,GDTO MOVEI 2,AC0 MOVNI 3,20 SOUT JRST GDENTR ;DO A GTJFN, ALLOWING THE CURRENT ESCAPE CHARACTER ;TO BE TYPED IN. GETJFN: PUSH P,1 MOVE 1,ESCCOD DTI ;ALLOW IT TO BE TYPED IN POP P,1 GTJFN JRST GETJF7 ;SEE IF TERMINATOR WAS ESCAPE CHARACTER GETJF5: PUSH P,1 HRLZ 1,ESCCOD ATI POP P,1 JRST CPOPJ1 ;SAY OK TO CALLER GETJF7: CAIE 1,GJFX4 ;ILLEGAL CHR IS REASON FOR LOSAGE? JRST GETJF8 ;NO HLRZ 1,2 ;GET INPUT JFN SKIPN 1 HLRZ 1,DEFALT+1 CAIN 1,100 BKJFN JRST GETJF8 ;NOT TTY: OR BKJFN BAD BIN ;GET PREVIOUS CHR CAMN 2,ESCCHR ;IS IT THE ESCAPE CHR? JRST WRONG ;YES (ATI WILL HAPPEN IN MAIN LOOP) GETJF8: HRLZ 1,ESCCOD ATI RET ;NO SKIP ;GET A NEW FORK NEWFRK: SETZ 1, CFORK JRST ERR MOVEM 1,FORK MOVEM 1,TPFORK FFORK ;NDDT DEALS ONLY WITH FROZEN FORKS CALL SETTRP MOVEI 1,400000 ;NDDT RPCAP SETZ 3, ;PASS CAP'S BUT NOT ENABLED MOVE 1,FORK EPCAP MOVE 1,FORK RUNTM MOVEM 1,TIMUSD MOVEM 3,TIMCON RET KILFRK: CALL UNMAP ;FLUSH ANY MAPPED PAGE MOVE 1,TPFORK KFORK SETZM FORK SETZM USRPSI SETZM USRPSI+1 SETZM USRPSI+2 SETZM USRPSI+3 SETZM BPTFLG SETZM SYMPTR SETZM ESTU SETZM PRGM SETZM BLOCK SETZM TBLK MOVE TT,PCSTAK MOVEM TT,PCSPTR RET ;SET JSYS TRAPS FOR BPT IN TPFORK SETTRP: MOVE 1,TPFORK IFE KL20F,< HRLI 1,(1B6)> IFN KL20F,< hrli 1, .tfres> TFORK ; RESET JSYS TRAPS IFE KL20F,< HALTF> IFE KL20F,< HRLI 1,(1B3)> IFN KL20F,< hrli 1, .tfsps> MOVSI 2,2 TFORK ; TURN ON TRAPS FOR BPT IFE KL20F,< HALTF HRLI 1,(1B0) MOVEI 2,JTAB> IFN KL20F,< hrli 1, .tfset movei 3, jtab> TFORK IFE KL20F,< HALTF> RET .R.==&777 .Q.==.R./^D36 .R.==.R.-<.Q.*^D36> JTAB: REPEAT .Q.,<0> 1B<.R.> REPEAT ^D<<512+35>/36>-.Q.-1,<0> ;GET NEW SYMBOLS, ENTRY VECTOR ;FLUSH BREAKPOINTS, AND PAGES CONTAINING OLD SYMTAB FIRST. SYMVEC: CALL FLSBPT ;FLUSH BREAKPOINTS CALL FLSSYM ;FLUSH OLD SYMBOLS NEWSYM: MOVEI R,116 ;JOBSYM GTSYMS: CALL FETCH ;ENTRY FROM ;S MOVE T,[-2,,HOME-2] ;JOBSYM READ-PROTECTED?? JUMPE T,.-1 MOVEM T,SYMPTR CAMN T,[-2,,HOME-2] JRST ENTVEC ;NO SYMS LOADED HRLZI R,0(T) TLZ R,777000 SUB T,R ASH T,-11 TRZ T,777000 MOVE W1,T ;SHARE THE SYMBOL TABLE SHRTAB: HRR 1,W1 ;PAGE HRL 1,FORK ;USER'S FORK RPACS TLNE 2,(1B10) ;PRIVATE ? JRST SHRTA2 ;YES, COPY IT ;SHARE THE PAGE RMAP HRR 2,W1 ;SAME PAGE HRLI 2,400000 ;NDDT'S FORK MOVSI 3,(1B2!1B4!1B9) ;R,C,X PMAP SHRTA0: AOBJN W1,SHRTAB SHRTA1: JRST ENTVEC ;NOW HANDLE THE ENTRY VECTOR ;COPY PRIVATE PAGE FROM USER TO NDDT SHRTA2: HRRZ R,W1 ;PAGE NUMBER LSH R,11 ;FIRST ADDRESS CAIGE R,20 MOVEI R,20 ;DON'T COPY AC'S. SHRTA3: CALL FETCH ;READ FROM USER FORK JRST ENTVEC ;READ PROTECTED?? MOVEM T,0(R) ;INTO NDDT FORK MOVEI R,1(R) TRNE R,777 ;HIT NEXT PAGE? JRST SHRTA3 ;NO, COPY ANOTHER WORD JRST SHRTA0 ;YES, WORRY ABOUT IT ;HANDLE ENTRY VECTOR ENTVEC: CALL CHKSYM MOVE 1,FORK GEVEC RET ; ;U UNLOAD THE CURRENT CORE IMAGE ; ;;U UNLOAD CORE AFTER HAVING COPIED SYMBOL TABLE BACK ; OPPOSITE OF ;Y SEMI.U: TLNE F,CF JRST UNASY TLNE F,QF!CF ;REASONABLE COMMAND? JRST ERR TRNN F,SEMIF2 ;HOW MANY SEMICOLI? JRST UNGET ;ONLY ONE UNLOAD: MOVE W1,[ASCIZ /nload/] CALL TEXT MOVE T,[RADIX50 4,PAT..];SETUP FOR DEFINE MOVEM T,SYM MOVE R,XRG ;CURRENT PATCH LOCATION ($X) MOVEM R,DEFV CALL DEFIN ;DO THE DEFINITION HRRZ T,ESTU ;WHERE UNDEFINED TABLE IS SKIPL ESTU ;BUT IS THERE ONE? HRRZ T,SYMPTR ;NO, USE DEFINED TABLE JUMPE T,UNLOA9 ;JUMP IF NO SYMBOLS AT ALL HRRZ R,XRG ;$X LOCATION SUB T,R ;GET AMOUNT OF FREE SPACE LEFT CAIL T,10 ;ENOUGH FOR NEXT TIME? TDZA T,T ;YES. DON'T MOVE SYMTAB SUBI T,100 ;NO. MAKE 100 FREE LOCATIONS FOR PATCHES MOVNS T ;MAKE OFFSET POSITIVE CALL STOSYM ;STORE SYMTAB BACK INTO USER SPACE JRST UNLOA9 ;NOW GO DO A ;U ;MAKE A COPY OF NDDT'S VERSION OF THE USER'S TABLE IN THE USER SPACE ; T/ OFFSET TO MOVE SYMTABLE UP BY STOSYM: PUSH P,T ;SAVE OFFSET FOR BELOW HLLZ S,SYMPTR ;NEG. LENGTH OF DEFINED TABLE ADD S,ESTU ;ACCOUNT FOR UNDEFINED TABLE HLRES S MOVNS S ;TOTAL LENGTH OF BOTH TABLES HLRE R,SYMPTR MOVNS R ADD R,SYMPTR HRRZS R ;TOP+1 (SOURCE IN NDDT) ADD T,R HRRZS T ;TOP+1 (DEST. IN USER) TRO F,TEMF ;SAY IT IS FIRST TIME THROUGH STOSY0: PUSH P,T ;SAVE TARGET ADDRESS SUBI R,1 ;MOVE TO NEXT DATA ADDRESS MOVE T,0(R) ;PICK UP A DATA WORD EXCH R,0(P) ;GET TARGET ADDR, SAVE SOURCE TRZN F,TEMF ;1ST TIME, OR TRNN R,777 ;GOING INTO NEW PAGE? SOJA R,STOSY1 ;YES. MUST MAP THE PAGE SOJA R,STOSY2 ;NO. IT IS MAPPED FROM LAST TIME STOSY1: PUSH P,R ;SAVE TARGET ADDR CALL DEP ;MAP AND STORE JRST ERR ;FAILED. JUST GET OUT JRST STOSY3 STOSY2: PUSH P,R ;SAVE TARGET ADDR ANDI R,777 ;SAVE OFFSET INTO PAGE MOVEM T,UCORE(R) ;STORE THE WORD STOSY3: POP P,T ;RESTORE TARGET ADDRESS POP P,R ;AND SOURCE SOJG S,STOSY0 ;AND DO MORE IF NEEDED. MOVE T,SYMPTR ADD T,0(P) ;COMPUTE NEW SYMPTR MOVEI R,116 SKIPGE T CALL DEP JFCL POP P,T ADD ESTU ;OFFSET UNDEFINED POINTER TOO MOVEI R,117 SKIPGE T CALL DEP JFCL RET ; ;U COMMAND UNLOA9: SKIPA W1,[POINT 7,[ASCIZ / to file: /]] UNGET: MOVE W1,[POINT 7,[ASCIZ /nget to file: /]] CALL TYPE SETZM DEFALT+2 SETZM DEFALT+3 SETZM DEFALT+4 IFN ka10f!ki10f,< HRROI 1,[ASCIZ /SAV/]> IFN KL20F,< hrroi 1, [asciz /EXE/]> MOVEM 1,DEFALT+5 MOVSI 1,(gj%fou!gj%msg!gj%cfm) MOVEM 1,DEFALT+0 ;FLAGS MOVEI 1,DEFALT MOVEI 2,0 CALL GETJFN JRST ERR MOVEM 1,TT1 UNGET0: MOVE 1,FORK GEVEC JUMPN 2,UNGET2 UNGET1: MOVE W1,[POINT 7,[ASCIZ / Start address is /]] CALL TYPE HRRZ T,LLOCO MOVE 1,FORK HRLI 2,1 ;LEN 1 HRR 2,T ;AT "." SEVEC CALL PAD UNGET2: HRR 1,TT1 HRL 1,FORK MOVE 2,[-1000,,520000] SETZM 3 SSAVE JRST DD1 ; ;W -- WRITE OUT SYMBOL FILE SYMSOT: MOVE W1,[POINT 7,[ASCIZ /rite symbols on file: /]] CALL TYPE TRO F,TEMF!TEM2F ;SAY BOTH TABS EXIST SKIPGE R,SYMPTR CAMN R,[-2,,HOME-2] TRZ F,TEMF ;NO MAIN SYMTAB SKIPL R,ESTU TRZ F,TEM2F ;NO UNDEF TAB TRNN F,TEMF!TEM2F JRST SYMSO4 ;NOTHING TO WRITE SYMSO1: HRROI 1,[ASCIZ /SYMBOLS/] MOVEM 1,DEFALT+5 MOVSI 1,(1B0!1B4) MOVEM 1,DEFALT MOVEI 1,DEFALT MOVEI 2,0 CALL GETJFN JRST ERR MOVEM 1,TEM1 MOVE 2,[44B5!1B20] OPENF JRST SYMSO3 SYMSO2: TRNE F,TEMF SKIPL T,SYMPTR SETZM T CALL WRTSYM TRNE F,TEM2F SKIPL T,ESTU SETZM T CALL WRTSYM MOVE 1,TEM1 CLOSF JFCL JRST DD1 SYMSO3: MOVE 1,TEM1 CLOSF JFCL JRST ERR SYMSO4: MOVE W1,[POINT 7,[ASCIZ/ No symbols??/]] CALL TYPE JRST ERR WRTSYM: PUSH P,3 HLL 2,T ;GET NEG. LENGTH HRRI 2,-1(T) ;MAKE IOWD BOUT HRLI 2,004400 ;POINT 36,.-.,-1 HLRE 3,T ;NEG. LENGTH SKIPGE 3 SOUT POP P,3 RET ; ;E COMMAND -- CHANGE ESCAPE CHARACTER ESCAP: MOVE W1,[POINT 7,[ASCIZ /scape character is: /]] CALL TYPE MOVE 1,ESCCOD ;THE OLD ESCAPE CODE DTI MOVEI 1,400000 ;NDDT RPCAP MOVE TT,3 MOVNI 1,5 ;SAY WHOLE JOB RTIW ;GET CURRENT TIW PUSH P,2 TLNE TT,(1B0) ;SEE IF ^C CAP IS ENABLED SETZB 2,3 STIW ;ALLOW EVERYTHING TO BE TYPED IN ESCAP0: PBIN MOVE T,1 MOVNI 1,5 SETZM 3 POP P,2 STIW ;RESTORE THINGS AS THEY WERE PUSH P,T CAIN T,177 ;RUBOUT? MOVEI T,^D28 ;YES CAIN T,40 ;SPACE MOVEI T,^D29 CAILE T,^D29 ;REST ARE ILLEGAL JRST ERR ESCAP1: PUSH P,T ;SAVE FOR LATER MOVNS T MOVSI W,(1B0) ;A SINGLE BIT ROT W,0(T) ;CONVERT TO MASK TDNN W,[1B7!1B9!1B10] ;DID TENEX ECHO PROPERLY? JRST ESCAP3 ;YES MOVEI T,"^" CALL TOUT MOVE T,-1(P) ;THE CHARACTER TRC T,100 ;MAKE INTO NON-CONTROL EQUIVALENT CALL TOUT ESCAP3: POP P,ESCCOD ;NEW ESCAPE CODE POP P,ESCCHR ;NEW ESCAPE CHARACTER ESCAP4: MOVE R,SAVCOC DPB R,COCPTR ;POINTER INTO CCOC WORD ESCAP5: MOVE TT,ESCCHR ;NEW ESCAPE CHARACTER IDIVI TT,^D18 ASH TT1,1 MOVNS TT1 ADDI TT1,^D34 ;NUMBER OF BITS LEFT IN WHICHEVER WORD ADD TT,[2B11+TTYCC2] ;TWO BIT BYTE POINTER DPB TT1,[POINT 6,TT,5] ;INSERT POSITION MOVEM TT,COCPTR LDB R,TT ;GET CURRENT SETTING MOVEM R,SAVCOC MOVEI R,0 DPB R,TT ;TURNOFF ECHOING FOR THAT CHAR ESCAP6: MOVEI 1,101 MOVE 2,TTYCC2 MOVE 3,TTYCC3 SFCOC HRLZ 1,ESCCOD ATI JRST DD1 ;***ROUTINES BEYOND HERE EVALUATE THEIR ARGUMENT*** MULT: TLOA F,PTF+MLF ;* DIVD: TLO F,DVF+PTF ;SINGLE QUOTE JRST L1 ASSEM: JRST PLUS ;# MINUS: TLO F,MF PLUS: TLO F,PTF JRST LIS2 LPRN: CAML P,[LPDL-4,,0] ;LEFT PARENTHESIS JRST ERR PUSH P,F ;RECURSE FOR OPEN PAREN PUSH P,WRD PUSH P,FRASE PUSH P,FRASE1 AOS,PRNC JRST LIS INDIRE: HRLZI W,20 ;@ IORB W,WRD TLO F,QF JRST LIS2 ACCF: MOVE R,T ;COMMA PROCESSOR ACCX: XCT ACCCF ;MOVEI T,"A" AS IN A,,B TLOE F,COMF ;COMMA TYPED BEFORE? JRST ACCF1 ;YES HRRM R,ACCCF ;NO, SAVE LEFT HALF OF A,,B HLLZ T,R LDB W1,[POINT 3,WRD,2] ;CHECK FOR IO INSTRUCTION IDIVI W1,7 LSH R,27(W1) ADD T,R ADDB T,WRD JRST SPAC1 ACCF1: ADD T,WRD ;SET LEFT HALF OF A,,B HRLZM T,WRD JRST SPAC1 SPACE: TLNE F,QF SPAC1: TLO F,TIF TLZ F,MF+PTF JRST LIS1 RPRN: TLNN F,QF ;) MOVEI T,0 MOVS T,T SOSGE,PRNC JRST ERR POP P,FRASE1 POP P,FRASE POP P,WRD POP P,F TLNE F,PTF TLNE F,SF JRST RPRN1 MOVEM T,SYL TLO F,QF+SF JRST L1RPR RPRN1: ADDB T,WRD TLO F,QF JRST L1A ; ;S -- SNARF SYMBOLS ;ARGUMENT IS ADDRESS CONTAINING POINTER TO TABLE ;ARG IS TAKEN AS 116 IF NOT SUPPLIED SNARF: TLNN F,QF ;ARG? MOVEI T,116 ;NO, DEFAULT MOVE R,T PUSH P,R CALL FETCH JRST ERR ;READ PROTECTED JUMPGE T,ERR ;BAD PTR TLNE T,1 ;MUST BE AN EVEN NUMBER LONG JRST ERR CALL FLSSYM ;FLUSH OLD SYMBOL TABLE POP P,R CALL GTSYMS ;GET AND CHECK NEW TABLE JRST DDT ; ;? TYPE THE MOST RECENT ERROR STRING ; NUM;? TYPE VALUE OF NUM AS ERSTR SEM.QU: PUSH P,T CALL CRF POP P,T HRROI 1,LINBF ;DUMP INTO STRING BUFFER FOR OUTPUT SETO 2, TLNE F,QF MOVEI 2,0(T) HRL 2,FORK SETZ 3, ERSTR JRST SEMQU1 ; No string for number JRST ERR SETZ 2, IDPB 2,1 ;MAKE ASCIZ MOVE W1,[POINT 7,LINBF] CALL TYPE ;COMMON OUTPUT ROUTINE JRST DD1 ;SO "OUTPUT TO FILE" WILL WORK ; No string for number SEMQU1: TLZ 2,-1 CAIE 2,-1 JRST ERR ; User specified bad number MOVE 1,FORK GETER HRROI 1,[ASCIZ /No string for error /] PSOUT TLZ 2,-1 MOVEI 1,.PRIOU MOVEI 3,10 NOUT JRST ERR JRST DD1 ;REGISTER EXAMINATION LOGIC ;LLOCO HAS CURRENTLY OPEN REGISTER. SET FROM C(LLOC) BY / ETC. ;LLOC HAS CURRENT SEQUENCE. RESTORED FROM SAVLOC BY $LF ETC. ;SAVLOC HAS SAVED SEQUENCE. SET FROM LLOC BY TAB ETC. ;PRINT ADDRESS AND EXAMINE REGISTER ;ENTER HERE FROM TAB, ^, BS, LF, OR FROM $E, $N, OR $W LI1: MOVEM T,LLOC ;MAY HAVE DDTINT FLAG ON IN LEFT HALF MOVEM T,LLOCO INTON CALL PAD MOVEI T,"/" CAME SCH,SCHM ; TEMP MODE SAME AS PERM MODE? JRST LI3 LI4: TLNE F,STF MOVEI T,"!" CALL TOUT ;ENTER HERE FROM /, [, ], !, \ ;ADDRESS HAS BEEN PRINTED, EXAMINE CONTENTS LI2: TLZ F,ROF ;CLOSE REGISTER(IN CASE OF SEARCHES ETC) CALL LCT LI2A: MOVE R,LLOCO CALL FETCH JRST LINCR TLO F,ROF ;REGISTER IS NOW OPEN TLNE F,STF ;IN SUPPRESSED TYPE-OUT MODE? JRST DD2 ;YES JRST CONSYM ;GO PRINT IN PROPER MODE AND RET LI3: CAIN SCH,FTOC ; NO, IF CONSTANT MODE MOVEI T,"[" ; USE [ CAIN SCH,PIN ; IF SYMBOLIC MODE MOVEI T,"]" ; USE ] JRST LI4 LINCR: TLO F,ROF ;PAGE NOT ASSIGNED, PRETEND WAS OPENED MOVEI W1,"?" ;BUT TYPE OUT ? JRST TEXT ;RETURN IS A POPJ ;LINEFEED COMMAND LINEF: CALL DEPRA ;NEXT REGISTER IFE KL20F,< ;LF WILL GENERATE CRLF (SEE SFCOC WORDS) CALL CRN ;HE TYPE THE LINEFEED, JUST NEED CAR RET > ; CAUSES LOSSAGE ON SOME TERMINALS TLNE F,CF ;$ MODIFIER? JRST LINEF1 ;YES, POP RING BUFFER AND ADD 1 AOS T,LLOC ;MOVE . TO NEXT LOCATION JRST VARRW1 LINEF1: TLNE F,CCF ;BUT TWO $'S TYPED? SKIPA T,LLOC ;YES, JUST CLOSE PATCH CALL PTRB ;POP THE RING BUFFER AOJA T,VARRW1 ; ^ AND BACKSPACE COMMANDS VARRW: CALL DEPRA CALL CRF TLNN F,CF ;POP RING BUFFER? SKIPA ;NOPE TLNE F,CCF ;BUT TWO $'S TYPED? SKIPA T,LLOC ;YES, JUST CLOSE PATCH CALL PTRB ;POP THE RING BUFFER SOS T ;PREVIOUS LOCATION VARRW1: MOVEM T,LLOC INTON SETZM PINFF ;DON'T PRINT AC AND/OR EFF ADR JRST LI1 ;DO THE EXAMINE ;RETURN COMMAND CARR: CALL DEPRA ;CLOSE THE REGISTER PUSHJ P,TIN ;GOBBLE UP FOLLOWING LINEFEED SETZM CHINP ;REINIT INPUT LINE SETZM CHINC TLZ F,STF ;[CKS] DON'T SUPPRESS TYPEOUT CALL PTRB ;ELSE POP THE RING BUFFER SETZM PINFF ;NO LONG INSTRUCTION PRINT TLNE F,CF ; $ PRECEEDED? JRST LI1 ;YES, PRINT THE LOCATION AND GO ON JRST DD1.5 ;NO, JUST GO AWAIT COMMAND ; [ COMMAND -- OPEN AS A CONSTANT OCON: TLNE F,QF ; QUANTITY TYPED? MOVEI SCH,FTOC ; YES SET TEMPORARY MODE TRO F,LF1+CF1 ;OPEN AS CONSTANT JRST SLASH ; ] COMMAND -- OPEN SYMBOLICALLY OSYM: TLNE F,QF MOVEI SCH,PIN TRZ F,CF1 ;OPEN SYMBOLICALLY TROA F,LF1 ; ! COMMAND -- LIKE / BUT DOESN'T TYPE CONTENTS SUPTYO: TLOA F,STF ;SUPPRESS TYPEOUT ; / COMMAND SLASH: TLZ F,STF ;TYPE OUT REGISTER HRRZS T ;FLUSH BITS LIKE DDTINT TLNN F,QF ;WAS ANY QUANTITY TYPED? JRST SLAS1 ;NO. DO NOT CHANGE MAIN SEQUENCE MOVE R,LLOC MOVEM R,SAVLOC ;ADDRESS TYPED; SAVE OLD SEQ. CALL ATRB ;ADD THE LOCATION TO THE RING BUFFER TRNE F,INTFLG ;ARG IS WITHIN NDDT? TLO T,(DDTINT) ;YES MOVEM T,LLOC ;VALUE OF "." SLAS1: MOVEM T,LLOCO ;TEMP VALUE OF "." SETZM PINFF ;DON'T WANT LONG INSTRUCTION TYPEOUT JRST LI2 ; \ COMMAND -- LIKE / OR ! BUT DOESN'T CHANGE "." ICON: TLNN F,ROF ;REGISTER OPENED? JRST SUPTYO ;NO. MAKE LIKE ! CALL DEPRS HRRZ T,LWT JRST SLAS1 ;TAB -- SET LOC TO ADDRESS PART AND DO A / OPERATION TAB: MOVE R,LLOC ;CURRENT SEQUENCE HRRZM R,TEM ;IN CASE WE ARE IN PATCH MODE CALL DEPRS ;OPEN REGISTER OF Q CALL CRF MOVE T,LLOC ;SET UP NEW SEQUENCE AND MOVEM T,SAVLOC ;SAVE OLD SEQUENCE PUSH P,R ;ADD THIS LOCATION TO RING BUFFER MOVE R,T CALL ATRB POP P,R MOVE T,LWT TLNE F,CF ;$ BEFORE TAB? MOVSS T ;YES, USE LH THEN HRRZS T ;NEW VALUE FOR . SETZM PINFF ;DON'T PRINT AC OR EFF ADR JRST LI1 ;HERE FOR PATCHING ;CONTROL-SHIFT-L FOR OPENING PATCH ;CONTROL-SHIFT-M FOR CLOSING PATCH ;LIKE ITS DDT, HUH? NPTCH: TRNE F,SEMIF2 JRST NPTCH2 MOVSI TT,(DDTINT) TDNE TT,LLOC ;NOT NICE TO FOOL MOTHER NDDT! JRST ERR MOVE W,[SQUOZE 0,PATCH] MOVEM W,SYM CALL EVAL ;FIND HIS PATCH SPACE JRST [ MOVE W,[SQUOZE 0,PAT..] ; Not there, try PAT.. MOVEM W,SYM CALL EVAL JRST [ MOVEI T,50 MOVEM T,DEFV CALL DEFIN ;GIVE HIM PATCH: AT 50 MOVEI T,50 ;ITS NOT SAVED, I GUESS JRST .+1] ADDI T,4 ; Make it +4, so BPTs don't interfere JRST .+1] MOVE R,LLOC MOVEM R,PATLOC ;SAVE HIS CURRENT LOCATION MOVEM T,PATPNT MOVEM T,LLOC ;MAKE HIS CURRENT LOCATION BE PATCH MOVEM T,LLOCO CALL FETCH JRST ERR PUSH P,T ;SAVE CONTENTS OF OLD LOCATION CALL CRF MOVE T,LLOC ;GET PATCH LOCATION IN T CALL LI1 ;PRINT THE LOCATION CALL LCT MOVE T,(P) CALL CONSYM ;PRINT OLD VALUE POP P,T MOVEM T,WRD TLO F,ROF+QF TRZ F,SEMIF+SEMIF2 JRST QUAN1 ;MAKE THIS CURRENT VALUE IF TYPED NPTCH2: PUSH P,T ; Save possible arg CALL CRF TLNN F,QF ; arg given? JRST NPTCH5 MOVE R,LLOC ; Yes, deposit it POP P,T CALL DEP JRST ERR AOSA LLOC NPTCH5: POP P,T TLNN F,CF+CCF ; $^[ or $$^[ ? JRST NPTCH3 ; No MOVE R,PATLOC ; Yes, retrieve patched-over instruction CALL FETCH JRST ERR MOVE R,LLOC CALL PTPRT TLNE F,CCF ; $$^[ ? JRST NPTCH4 AOSA R,LLOC NPTCH3: MOVE R,LLOC MOVEI W,2(R) PUSH P,W ;SAVE NEW PATCH LOCATION MOVSI T,(JUMPA 1,) HRR T,PATLOC ADDI T,1 CALL PTPRT ADDI R,1 ADDI T,1 CALL PTPRT NPTCH4: MOVE R,PATLOC ;GET OLD INSTRUCTION LOCATION MOVSI T,(JUMPA 3,) HRR T,PATPNT CALL PTPRTN POP P,DEFV ;GET NEW PATCH VALUE MOVE W,[SQUOZE 0,PATCH] MOVEM W,SYM CALL DEFIN ;AND DEFINE IT SUCH MOVE R,PATLOC MOVEM R,LLOC MOVEM R,LLOCO ;SET THE CURRENT LOCATION JRST RETX ;IN R, THE LOCATION ;IN T, THE NEW VALUE PTPRTN: TDZA W1,W1 PTPRT: SETO W1, PUSH P,W1 PUSH P,R PUSH P,T MOVE T,R CALL LI1 ;PRINT ADDRESS AND VALUE CALL LCT ;THEN TAB MOVE T,(P) MOVE R,-1(P) CALL DEP ;NEW DEPOSIT NEW VALUE JRST ERR CALL CONSYM ;PRINT NEW VALUE SKIPE -2(P) CALL CRF POP P,T POP P,R SUB P,[1,,1] RET ;FLUSH ALL UDEFINED SYMBOL REFERNECES TO THIS REGISTER. DEPRA: HRRZ R,LLOC ;WHERE "." IS NOW MOVE R,SAVLOC TLNE F,CF ;RESTORE OLD SEQUENCE IF $CR,$LF, OR EXCH R,LLOC ;IF $^ OR $BS WAS TYPED MOVEM R,SAVLOC ;SETUP "NEW" OLD SEQUENCE TLNE F,ROF ;IF REGISTER IS BEING CHANGED TLNN F,QF ;REMOVE ALL PREVIOUS UNDEFINED JRST DEPRS ;SYMBOL REFERENCES TO IT MOVE R,ESTU MOVEM W1,ESTU ;INCLUDE ALL #-D SYMS IN UNDEF TAB DEPRA2: JUMPGE R,DEPRS HRRZ W,1(R) CAMN W,LLOCO CALL REMUN ADD R,[2,,2] JRST DEPRA2 ;IF SOMETHING TYPED AND A REGISTER IS OPEN ;UPDATE THE OPEN REGISTER AND LWT DEPRS: MOVEM T,LWT ;DEPOSIT REGISTER AND SAVE AS LWT MOVE R,LLOCO ;QUAN TYPED IN REGIS EXAM TLZE F,ROF ;TEST AND CLOSE REGISTER TLNN F,QF RET CALL DEP ;STORE AWAY JRST ERR ;CAN'T STORE RET EQUAL: TROA F,LF1+CF1 ;= PSYM: TRZ F,CF1 ;@ TRO F,LF1 SETZM PINFF ;NEVER LONG INS PRINTOUT CALL CONSYM JRST RETX ;ROUTINE TO ADD ONE LOCATION TO THE RING-BUFFER - LOCATION IN R ATRB: PUSH P,T AOS T,RBPT ;GET NEW RING-BUFFER POINTER CAILE T,LRB ;AT END OF BUFFER? MOVEI T,RB ;YES, LOOP TO BEGINNING MOVEM T,RBPT ;UPDATE CURRENT POINTER MOVEM R,(T) ;INSERT ADR IN RING-BUFFER POP P,T RET ;ROUTINE TO "POP" THE RING-BUFFER, ADR RETURNED IN T PTRB: PUSH P,R SOS R,RBPT ;GET THE PREVIOUS LOCATION MOVE T,1(R) ;THE WORD POINTED TO BY THE TOP OF THE STACK CAIGE R,RB ;IF GONE TOO FAR, MOVEI R,LRB ; USE THE LAST LOCATION MOVEM R,RBPT POP P,R RET ;RADIX-50 SYMBOL PRINTER R50PNT: PUSH P,T MOVEI T,"$" CALL TOUT POP P,T LSH T,-36 ;RADIX 50 SYMBOL PRINTER TRZ T,3 CALL TOC MOVEI T,"&" CALL TOUT SETZM SVFB MOVEI W1,LWT ;SETUP FOR SPT JRST SPT SIXBP: MOVE W1,[POINT 7,[ASCIZ /$1'/]] CALL TYPE MOVNI W2,6 ;SIXBIT PRINTER MOVE W1,LWT SIXBP1: MOVEI T,0 ROTC T,6 JUMPE T,SIXBP2 ADDI T,40 CALL TOUT AOJL W2,SIXBP1 SIXBP2: MOVEI T,"$" CALL TOUT RET ;MODE CONTROL SWITCHES TEXO: MOVEI R,TEXTT-HLFW ;$T ASSUME 7 BIT ASCIZ MOVE T,WRD2 CAIN T,9 ;CHECK FOR $9T (BCPL STRINGS) MOVEI R,TEXT9-HLFW CAIN T,8 ;CHECK FOR $8T (NETBUFS ETC) MOVEI R,TEXT8-HLFW CAIN T,6 ;CHECK FOR $6T MOVEI R,SIXBP-HLFW ;SET MODE SWITCH FOR SIXBIT CAIN T,5 ;CHECK FOR $5T MOVEI R,R50PNT-HLFW ;SET MODE SWITCH FOR RADIX 50 HWRDS: ADDI R,HLFW-TFLOT ;H SFLOT: ADDI R,TFLOT-PIN ;F SYMBOL: ADDI R,PIN-FTOC ;S CON: ADDI R,FTOC ;C HRRZM R,SCH ;TEMPORARY MODE JRST BASE1 RELA: TRZE F,Q2F ;CHANGE ADDRESS MODE TO RELATIVE JRST BASECH MOVEI R,PADSO-TOC ABSA: ADDI R,TOC ;A HRRZM R,AR JRST BASE1 ;VARIOUS R COMMANDS BASECH: MOVE T,WRD2 ;$NR, CHANGE OUTPUT RADIX TO N CAIGE T,2 JRST ERR HRRZM T,ODF ;TEMPORARY RADIX CELL BASE1: MOVS S,[SCHM,,SCH] ;MODE SWITCHES TO MEMORY TLNN F,CCF JRST LIS1 BLT S,ODFM ;WITH $$, MAKE MODES PERMANENT JRST RETX ; SEMICOLON-SPACE COMMAND -- RETYPE ACCORDING TO CURRENT MODES SEMSPA: MOVEM T,LWT JRST @SCH ;VARIOUS "GO" COMMANDS GO: TLNN F,CCF ;ONE TYPED? JRST GOSET ;SETUP NEW START ADR OR START PROGRAM TRNE F,Q2F ;TWO ESC'S TYPED JRST GO1 ;USE ENTRY VECTOR GOS1: TLNE F,QF JRST GO5 ;ARG TYPED IN GO0: SETZM WRD2 GO1: TLNE F,QF JRST ERR ;FOO$$3G ?? MOVE 1,FORK GEVEC HLRZ 1,2 ;EV LENGTH JUMPE 1,ERR CAIL 1,10000 ;SKIP IF TENEX EV (1 HAS LENGTH) SKIPN 1,WRD2 ;10/50, ALLOW ONLY $$0G CAMGE 1,WRD2 ;EV LENGTH > THAN REQUESTED INDEX? JRST ERR ADD 2,WRD2 HRRZ T,2 ;ENTRY ADDR GO3: HLL T,PC ;FLAGS MOVEM T,PC ;NEW PC MOVE 2,T TLNN F,CCF JRST GO4 ;ENTRY FROM $L ETC. GO2: MOVE 1,FORK CIS ;$$G COMMANDS CLEAR INTERRUPTS SETZM USRPSI SETZM USRPSI+1 SETZM USRPSI+2 SETZM USRPSI+3 GO4: TLO 2,(1B5) ;INSIST ON USERMODE PC MOVEM 2,REALPC MOVE TT,PCSTAK MOVEM TT,PCSPTR ;NOT UNDER $X ETC ANY MORE TRZ F,XEQ!CONDX CALL CRF JRST TOUSER GO5: TRNN F,INTFLG ;DID ADDR CONTAIN AN INTERNAL SYMBOL? JRST GO3 ;NO, DO THE $G JRST ERR ;ATTEMPT TO GO INSIDE NDDT ;SETUP NEW START ADR, EXAMINE IT AS WITH ^N, BUT DO NOT START GOSET: TRNN F,Q2F ;ARG TYPE AFTER ? JRST GOS1 ;NOPE, IS NORMAL START THEN TRNE F,INTFLG ;DID ADDR CONTAIN INTERNAL SYMBOL? JRST ERR TLNN F,QF ;FOR ALT-0-G JRST GOSET1 GOSET2: PUSH P,T CALL CRF POP P,T HRRM T,PC ;STORE NEW PC SETOM PINFF ;LONG PRINTOUT JRST LI1 ;THEN EXAMINE AS IN ^N GOSET1: MOVE 1,FORK ;HERE FOR $G GEVEC HLRZ 1,2 ;EV LENGTH JUMPE 1,ERR CAIL 1,10000 ;SKIP IF TENEX EV (1 HAS LENGTH) SKIPN 1,WRD2 ;10/50, ALLOW ONLY $$0G CAMGE 1,WRD2 ;EV LENGTH > THAN REQUESTED INDEX? JRST ERR ADD 2,WRD2 HRRZ T,2 JRST GOSET2 ;CONTROL-L -- CLEAR THE SCREEN CTRLL: MOVEI 1,.PRIOU ;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY RFMOD ;CHANGE TO PUSH P,2 TRZ 2,TT%DAM ;BINARY MODE SFMOD GTTYP HRROI 1,BLNKTB(2) ;GET RIGHT MAGIC PSOUT MOVEI 1,.PRIOU POP P,2 SFMOD JRST DD1.5 BLNKTB: REPEAT 4, ; 0-3 IFE MIT,< BYTE (7) "Z"-100,0 ; 4 ADM3 > IFN MIT,< BYTE (7) 177,220-176,0 ; 4 IMLACS > BYTE (7) 35,36,0 ; 5 DM BYTE (7) 33,"H",33,"J",0 ; 6 HP2640 REPEAT 4, ; 7-10 BYTE (7) 33,"H",33,"J",0 ; 11 VT50 BYTE (7) 15,12,0 ; 12 BYTE (7) 33,"(",177,0 ; 13 LP BYTE (7) 15,12,0 ; 14 BYTE (7) 33,"H",33,"J",0 ; 15 VT52 REPEAT 3, ; ETC ;$$^N -- FUNNY BUSINESS TO FIXUP BLOWING IT (^N INSTEAD OF $^N) ;IF AC GIVEN, USE (AC) ;IF ADDRESS GIVEN, USE CONTENTS OF THAT ADDRESS ;SO, IF IN UUO HANDLER, USE UUOH$$^N CTRLNX: MOVEI W1,17 ;USE AC 17 IF NOT SUPPLIED TLNE F,QF ;ARGUMENT? MOVE W1,WRD ;ELSE USE HIS CAIG W1,17 CAIGE W1,0 JRST [HRRZ R,W1 ;GET RH -> POINTER TO LOCATION IN CORE CALL FETCH JRST ERR ;OOPSx2 JRST CTLNX1] ;USE THIS ADDRESS HRRZ R,AC0(W1) ;GET VALUE OF AC CALL FETCH ;GET (P) OR EQUIVALENT JRST ERR CTLNX1: TRZ F,XEQ!CONDX HRRZS T ;NO LEFT HALF, PLEASE SETZM BPTFLG MOVE R,PC MOVEM R,REALPC ;SAVE PC PUSH P,T ;SAVE ADDRESS FOR TEMP BP'S CALL CRF ;REQUIRED CRLF HRRZM R,$CTRLN POP P,R ;RESTORE THE ADDRESS, JRST JSTAN1+1 ;I.E. START OF TEMP BP'S AND GO ;CONTROL-N -- ITS-LIKE SINGLE STEPPING ctrln: TLNE F,CCF JRST CTRLNX setom fctrln ; Fake a $y, and flag it as such tlnn f, cf ; An turns $y fake to $j fake troa f, ystepf trz f, ystepf jrst ctrlna ; $Y -- single step, just doing one instruction, special handling ystep: troa f, ystepf ; $J -- single step, interpretting subrs as single instrs ; num(foo)$J proceed until num instructions excecuted or value of ; foo changed foo$$J proceed until foo changed jstep: trz f, ystepf setzm fctrln ; Losing output ctrlna: trz f, xeq!condx ; Not $x and for ddt setzm bptflg ; Any bpt will not be from user tlne f, ccf hrlos t ; Arg$$J like infinty(arg)$J tlnn f, qf!ccf ; No arg given? movei t, 1 ; Just once jumpe t, jstep3 ; 0$j toggles verbose switch hrrzm t, stepct ; Number of times hlrz r, t ; Get location to write protect movem r, wrprot tlnn f, qf ; Quantity typed? setzb r, wrprot ; So $$J works after breakpoint move T, pc ; In case of breakpoint movem T, realpc PUSH P,R MOVE R,T SETZM CNXBPT PUSHJ P,BPCHK SETOM CNXBPT POP P,R jumpe r, jstep1 ; None. call fetch ; Get contents jrst err movem t, wrcont ; Save it jstep1: call crf ; Always want a leading tro f, sstepf ; Say we are single stepping hrrz r, realpc ; Get next instruction from user call fetch ; Get it jrst err trne f, ystepf ; Need special handling? jrst ystep2 skipn fctrln ; $^N rather than $J? jrst jstp1a ; Nope, do it the wrong way hrrzm r, $ctrln ; This is the PC jstan1: aoj r, ; Initially, C(R) is C(REALPC) call fetch jrst jstp1b ; Failed, use normal, losing method tlce t, 777000 ; Find next reasonable instruction tlnn t, 774000 ; 0 < Opcode < 774 jrst jstan1 ; No, keep looking tlc t, 777000 ; Return instruction to normal movei w1, 3 ; Put in three breakpoints movem w1, $ctins ; Also remember in memory in case of interrupts jstan2: movem r, $ctrln(w1) ; Location of breakpoint cain w1,3 jrst jstan3 ; No need to do extra work if we have the ins call fetch jrst jstanu ; Undo damage and use losing method jstan3: movem t, $ctins(w1) ; Save the instruction move t, [BPT] ; Then insert the breakpoint call dep jrst jstanu ; Undo and use losing method sosle w1, $ctins ; Any locoations left to do? aoja r, jstan2 ; Yup, so go to next one and proceed call doset ; Save perishable stuff jrst touser ; Then start up user's program jstctn: call remtbp ; Here when returning from the user jrst jstep2 jstanu: call remtbp ; Remove any temp bpt's that are in jstp1b: hrrz r, realpc call fetch jrst err jstp1a: call setesi ; Set up user's memory for xec jrst touser jstep2: call unset addm tt, realpc ; Update user pc jstp2a: move tt, realpc movem tt, pc skipe sstepv ; Verbose? call jstep5 ; Yes, check things call jstep4 ; In any case print the instruction sosg stepct ; More? jrst jstpdd ; Back to ddt with no extra move r, wrprot ; Get new contents jumpe r, jstep1 call fetch jrst err camn t, wrcont ; Changed? jrst jstep1 ; No back for more move w1, [ascii /(WP)/] call text2 hrrz t, pc call pad call lct move t, wrprot ; Type attempted new contents setzm pinff ;never print ac or eff adr call li1 hrrz r, wrprot move t, wrcont call dep ; Restore old contents (should we?) jrst err jrst jstpdd jstpdd: call lct jrst dd1.6 ystep2: movem t, binstr ; Save instruction we are handling call proc12 ; Do interpretation jrst jstp1a ; Ok for regular handling jrst jstp2a ; Taken care of, see if more to do, etc. jstep3: setcmm sstepv ; Toggle verbose switch ret ; And return ; Print out current instruction and save AC's and view reg for printing changes jstep4: push p, t push p, r hrrz t, realpc setzm pinff ; Asumme quiet mode skipe sstepv ; Is that the case? setom pinff ; No, print eff adr and/or ac call li1x ; Print instruction and address move t, [ac0,,ssacs] blt t, ssacs+17 ; Save user acs skipge r, vaddr ; Anything in view cell? jrst jstp4a ; Nope hrrzs r call fetch caia ; Forget it movem t, ssacs+20 ; Save it jstp4a: pop p, r pop p, t ret ; Print changes to AC's if fctrln is off, also print change to view reg jstep5: setz t, ; skipe fctrln ; Should we print changes? ; jrst jstp5z ; Nope, only do view register jstp5a: move r, ac0(t) came r, ssacs(t) ; Has it changed call jstep6 ; Yes, say so caige t, 17 ; Done? aoja t, jstp5a jstp5z: skipge r, vaddr ; Anything here? ret hrrzs r skipe fctrln ; Next test only valid if not ^N jrst jstp5y caig r, 17 ; Is it an ac? ret ; Yes, already done it jstp5y: call fetch ret camn t, ssacs+20 ; Changed? ret move r, vaddr setzm pinff call li1 jrst crf ; Print c(c(t)), a trailing , then return jstep6: push p, t setzm pinff call li1 ; Type out new contents call crf pop p, t ret ;Routine to remove temporary breakpoints -- for now, these are set up only ; by $^N remtbp: skipge $ctins ; Any temporary breakpoints? ret ; Nope, return right away push p, tt movei w1, ntbpts ; Assume maximum number of breakpoints sub w1, $ctins ; Calculate actual number of things to undo movei w2, $ctins+ntbpts remtb1: jumple w1, remtb3 ; Return when done move r, $ctrln-$ctins(w2) ; Get address of instruction move t, (w2) ; And get the actual instruction call dep jrst remtb2 ; Can't undo, so turn off future attemps soj w2, ; Point to next item soja w1, remtb1 ; And go on until done remtb2: setom $ctins ; Flag that there are no temp bpts jrst err remtb3: setom $ctins pop p, tt ret ;Print ADDRESS/ INSTRUCTION li1x: movem t,lloc ;code like li1 but always type with pin movem t,lloco call pad movei t,"/" cain sch,pin movei t1,"]" call tout tlz f,rof call lct move r,lloco call fetch jrst lincr tlo f,rof ;reg is open movem t,lwt jrst pin ;type as instruction ; $X COMMAND -- EXECUTE AN INSTRUCTION ; INSTRUCTION TO EXECUTE IS IN T XEC: MOVEM T,R MOVEI T,XRG ;IN CASE ITS A $X EXAMINE TLNN F,QF ;WAS TYPED? JRST QUANIN ;NO, EXAMINE $X REGISTER MOVE T,R CALL SETESI ;SET UP USER'S MEMORY TRO F,XEQ ;WE'RE IN A $X CALL CRF JRST TOUSER ;$X COMMAND COMPLETION ;PSEUDO BPT HIT ;TT HAS NUMBER OF SKIPS XCOM: MOVEI W1,"$" CALL TEXT SOJG TT,.-2 CALL UNSET ;POP BACK TO PREVIOUS $X CONTEXT JRST DD1 ;GO TO USER ;PC SAYS WHERE ;XEQ, CONDX BITS SAY WHY ;AND TELL WHERE TO RETURN IN NDDT TOUSER: CALL UNMAP ;FLUSH THE USER'S PAGE TRNN F,CONDX ;USER WILL RUN FOR DDT'S PURPOSES, ; NOT HIS. THEREFORE, DON'T CALL INSRTB ;PUT BPT'S BACK IN MOVEI 1,100 MOVE 2,SAVTTY SFMOD MOVE 2,SAVTT2 MOVE 3,SAVTT3 SFCOC MOVE 2,USRTB2 MOVE 3,USRTB3 MOVE 4,USRTB4 STABS MOVE 1,SUBSYS TLNE 1,(77B5) ; Make sure name is meaningful SETNM ;RESTORE USER'S SUBSYSTEM NAME CALL SETUSR ; SET STATE OF USER FORK FROM NDDT TOUSR8: MOVE 1,TPFORK IFN KL20F,< TLO 1,(SF%CON) ; Continue the fork SFORK >;IFN KL20F MOVE 1,TPFORK RFORK SETOM USRFLG ;WE'RE NOW IN THE USER. INTON MOVE 1,TPFORK WAITPC: WFORK ;WAITPC BAD BETTER POINT TO THE WFORK (ADBRK) FFORK ;FREEZE IT IMMEDIATLY JRST TRAP ;FORK TERMINATED IFN ADBRKF,< ;INFERIOR FORK TERMINATION INTERRUPT (OR FORCED FREEZE -- ADBRK) FRKTRM: PUSH P,1 PUSH P,2 MOVE 1,FORK RFSTS ERJMP FRKTR2 ;IGNORE LOSSAGE HERE TLNN 1,(RF%FRZ) JRST FRKTR2 ;NOT FROZEN (IE NOT FORCED) WILL FALL THRU OK HRRZ 1,IPC1 ;SEE WHAT WE WERE DOING CAIE 1,WAITPC CAIN 1,WAITPC+1 JRST [ MOVSI 1,1000 IORM 1,IPC1 ;FORCE IT TO FALL THRU JRST FRKTR2] FRKTR2: POP P,2 POP P,1 DEBRK > ;ADBRKF ;BREAK POINT LOGIC ;HERE WHEN BPT HIT ;T POINTS AT PRIVATE BLOCK FOR THE BPT ;PRIVATE BLOCK FORMAT IS: ;WORD-0: LH HAS TRACE EXP., RH HAS ADDR. WHERE BPT SET ;WORD-1: 0 OR CONDITIONAL BREAK SKIP INSTR. ;WORD-2: PROCEED COUNT ;WORD-3: 0 OR STRING POINTER, FED TO DDT WHEN BPT HIT ;WORD-4: SAVED INSTRUCTION WHILE USER IS RUNNING ;WORD-5: 0 OR ELSE -1 IF AUTO-PROCEED ;WORD-6: ASCIZ NAME OF THIS BPT, LIKE $3B ;WORD-7: RH HAS FORK IN WHOSE ADR SPACE THE BPT IS SET BCOM: MOVEM T,BPTFLG ;INDICATE WHICH BPT WE'RE AT SKIPE CNXBPT JRST BCOM3 ;ARE WE GOING TO BREAK? BCOM1: SKIPE W1,1(T) ;DOES A CONDITIONAL INSTR. EXIST? CALL DOCNDX ;DO THE CONDITIONAL IN THE USER SOSG TT,2(T) ;GUNCH THE PROCEED COUNT JRST BREAK ;YES! ;DON'T BREAK, PROCEED BCOM3: SETZM CNXBPT MOVE T,4(T) JRST PROCX BCOM2: MOVE T,4(T) ;THE BREAK INSTRUCTION JRST PROC1 ;DO THE CONDITIONAL BREAK INSTRUCTION FOR THE USER DOCNDX: MOVE T,1(T) ;GET THE INSTRUCTION CALL SETESI TRO F,CONDX ;WHY WE'RE GOING TO USER JRST TOUSER ;RETURN FROM USER HERE ;TT HAS THE NUMBER OF SKIPS CONCOM: TRNN TT,1 ;ONLY THE LOW BIT COUNTS AOS 0(P) ;MAKE DOCNDX SKIP CALL UNSET ;POP BACK TO PREVIOUS CONTEXT MOVE T,BPTFLG ;GET BACK WHICH BPT WE'RE AT RET ;WE'RE REALLY BREAKING BREAK: PUSH P,T ;POINTER TO BPT PRV BLK CALL CRF ;NEED A LEADING CRLF WHEN BREAKING MOVE T,(P) TDZ F,[-1,,-1-XEQ] ;CLEAR ALL FLAGS EXECPT XEQ MOVE 2,FORK CAMN 2,TPFORK JRST BREAKT MOVEI 1,"(" PBOUT MOVEI 1,101 MOVEI 3,10 ANDI 2,77 NOUT JFCL MOVEI 1,")" PBOUT BREAKT: MOVE W1,6(T) ;ASCIZ NAME OF BREAK POINT -- $3B CALL TEXT2 ;PRINT IT MOVSI W1,(/>) ;TYPE > FOR COND BREAK SKIPG 2(T) ;TEST PROCEED COUNTER MOVSI W1,(>/>);TYPE >> FOR PROCEED COUNTER BREAK CALL TEXT2 MOVE W1,LLOC ;SAVE CURRENT SEQUENCE MOVEM W1,SAVLOC PUSH P,R MOVE R,W1 CALL ATRB ;ADD PREVIOUS LOCATION TO RING BUFFER POP P,R HRRZ T,PC HRRZM T,LLOC ;SET CURRENT SEQ TO BREAK ADR SETOM PINFF CALL LI1 ;TYPE PC AT BREAK HLRZ T,@0(P) ;GET TRACE LOCATION JUMPE T,BREAK1 ;TEST FOR REGISTER TO EXAMINE BREA1A: CALL LCT ;PRINT TAB HLRZ T,@0(P) SETZM PINFF ;DON'T PRINT EFF ADR AND/OR AC CALL LI1 ;EXAMINE REGISTER C($NB)LEFT BREAK1: POP P,T ;GET BPT BLK PTR BACK SKIPN 5(T) ;SKIP IF AUTO JRST RETB ;DONT PROCEED BREAK2: MOVEI TT,2 ;1 FOR SOS AT BCOM1, 1 FOR ADDB TT,2(T) ;PROCEEDING JUMPGE TT,BREAK3 ;NOT AUTOPROCEEDING ANYMORE CALL CRF JRST PROC0 ;DO THE PROCEED BREAK3: SETZM 5(T) ;CLEAR AUTO PROCEED ;START UP DDT, T POINTS AT BPT BLK RETB: SKIPE T,3(T) ;IS THERE A COMMAND STRING? HRLI T,() MOVEM T,STRING JRST RETX ;$P -- PROCEED THROUGH THIS BPT NUM TIMES ; IN T (IF ANY TYPED IN) PROCED: MOVE TT,T ;SO T CAN POINT TO BPT BLK CALL CRF SKIPN T,BPTFLG ;PROCEEDING FROM BPT? JRST TOUSER ;NO. JUST RUN HIM AT HIS PC. TLNE F,QF ;WAS AN ARG TYPED IN? JRST PROCD3 ; YES, USE IT. MOVEI TT,1 ; NO, ASSUME 1 TLNE F,CCF ;IF $$P MOVSI TT,200000 ;THEN VERY LARGE COUNT PROCD3: TLNE F,CCF ;IF AUTOPROC MOVNS TT ;NEGATE MOVEM TT,2(T) ;STORE COUNT FOR THIS BREAK IN $B+1 SETZM 5(T) ;ASSUME NOT AUTOPROCEED TLNE F,CCF SETOM 5(T) ;IT IS AUTOPROCEED ;ENTER HERE FROM AUTOPROCEED ;USER MAY HAVE CHANGED THE CONTENTS OF THE BREAK ;LOCATION BETWEEN THE TIME THE BPT WAS HIT AND THIS $P PROC0: HRRZ R,@BPTFLG ;ADDRESS OF LAST BPT HIT CALL FETCH ;GET INSTRUCTION TO PROCEED FROM JRST ERR ;PROCX. ENTER HERE FROM FUNNY ALT-CONTROL-N HACK PROCX: MOVEM T,BINSTR MOVEI 1,400000 RWM JUMPGE1 1,PROC12 JRST PROC1A ;ENTER HERE FROM NON-BREAKING BPT HIT PROC1: MOVEM T,BINSTR ;INSTRUCTION TO LEAVE FROM MOVEI 1,400000 RWM ;SEE IF RUBOUT INTERRUPT WAITING JUMPGE 1,PROC14 ;NO, KEEP AUTOPROCEEDING PROC1A: INTON WAIT ;LET IT RIP PROC14: TRZ F,SSTEPF!YSTEPF ;NOT SINGLE STEPPING PROC12: MOVEI S,100 ;MAX @ DEPTH ALLOWED FOR EA CALCULATION MOVEM S,TEM1 LDB W1,[POINT 9,T,8] ;OPCODE. LDB W2,[POINT 4,T,12] ;GET AC FIELD CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 ;CALCULATE EA AND INTERPRET CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 TRNN W1,700 JRST IUUO TRNN F,YSTEPF ;SINGLE STEPPING? JRST PROC2 ; NO, ENUF INTERPRETATION CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 CAIE W1,/1B8 CAIN W1,/1B8 JRST IXCT1 ANDI W1,770 ; REMOVE LOW 3 BITS OF OPCODE CAIE W1,/1B8 ; AOJ-SOMETHING CAIN W1,/1B8 JRST IXCT1 CAIN W1,/1B8 ; SOME FLAVOR JUMP JRST IXCT1 ;USE THE HARDWARE TO INTERPRET ALL ELSE. ;T HAS THE INSTRUCTION PROC2: TRNE F, YSTEPF ; ARE WE SINGLE STEPPING? RET ; YES, GIVE SINGLE RETURN HRRZ R,XRG ;LOCATION OF $X REGISTER CALL DEP JRST ERR MOVEI S,3 HRRZ T,PC ;WORK ON COPY IN CASE DEP FAILS PROC3: AOS T HRLI T,(JRST) AOS R CALL DEP JRST ERR SOJG S,PROC3 HLL R,PC ;FLAGS TLO R,(1B5) ;BE SURE IT'S USERMODE HRR R,XRG MOVEM R,REALPC ;WHAT FORK'S PC SHOULD BE JRST TOUSER ;THESE ROUTINES INTERPRET PC SAVING INSTRUCTIONS. ;R POINTS TO THE INSTRUCTION ;T,BINSTR HAVE THE INSTRUCTION ;W1 HAS THE OP CODE ;W2 HAS AC FIELD ;INTERPRET UUO IUUO: JUMPE T,PROC2 ;ILLEGAL INSTRUCTION CAIL W1,40 JRST PROC2 ;DEC 10/50 UUO, USE HARDWARE. MOVEI R,40 CALL DEP JRST ERR MOVEI R,41 ;NOW EXECUTE LOCATION 41. ;INTERPRET XCT IXCT: SOSL TEM1 ;TOO MUCH @'ING? CALL FETCH ;CODE PROTECTED? JRST ERR ;YES. MOVEM T,BINSTR ;GET EFFECTIVE ADDRESS IXCT1: MOVE T,BINSTR ;THE INSTRUCTION call eff2 ; Evaluate effective address jrst err ;CHECK XCT'D OR UUO'D INSTRUCTION TO SEE IF IT MUST BE INTERPRETED. IXCT3: HRRZS W1 DPB W1,[POINT 23,BINSTR,35] ;SMASH WITH EA LDB W2,[POINT 4,BINSTR,12] ;AC FIELD LDB W1,[POINT 9,BINSTR,8] ;GET OP. CODE MOVE T,BINSTR ;GET INSTR WITH EA COMPUTED CAIN W1,/1B8 JRST IPUSHJ CAIN W1,/1B8 JRST IJSR CAIN W1,/1B8 JRST IJSA CAIN W1,/1B8 JRST IJSP HRRZ R,BINSTR CAIN W1,/1B8 JRST IJSYS CAIN W1,/1B8 JRST IXCT TRNN W1,700 JRST IUUO ;ANOTHER ONE. TEM1 WILL RUN OUT. trnn f, ystepf ; More interpretation needed? JRST PROC2 ;OK, USE HARDWARE cain w1, /1b8 jrst ipopj cain w1, /1b8 jrst ijra caie w1, /1b8 cain w1, /1b8 caia cain w1, /1b8 jrst [push p, w1 jrst ijumps] cain w1, /1b8 jrst ijrst push p, w1 andi w1, 770 caie w1, /1b8 cain w1, /1b8 jrst ijumps cain w1, /1b8 jrst ijumps pop p, w1 jrst proc2 ;INTERPRET JSYS IJSYS: CAIGE R,1000 ;USER JSYS? JRST PROC2 ;NO. MONITOR-CALLING TYPE CALL FETCH ;GET RETPTR,,JUMPADDR JRST ERR PUSH P,T HRLZ R,T ;WHERE TO STORE PC,,FLAGS AOS T,PC ;RETURN ADDRESS FOR JSYS CALL DEP JRST ERR POP P,R ;WHERE TO JUMP TO JRST IPJ2 ; Compute effective address ; Instruction in T, returns eff adr in W1 and contents of ; Effective address in T if 1st instruction used an indirect reference effadr: movei w1, 100 movem w1, tem1 ; Maximum indirection count eff2: ldb w1, [point 4, T, 17] ; Get index field skipe w1 ; use 0 if xr=0 move w1, ac0(w1) ; Else his xr add w1, t tlne t, <(@)> ; Indirect? jrst .+3 ; Yep, keep going aos (p) ; Return skip ret hrrz r, w1 sosl tem1 ; Too much indirection? call fetch ; Get contents ret ; Error of some sort jrst effadr ; Back for more ;INTERPRET PUSHJ IPUSHJ: MOVE T,AC0(W2) ;USER'S PUSH POINTER MOVE TT,T ;SAVE UN-GUNCHED POINTER AOBJN T,.+1 XOR TT,T ;SEE IF SIGN CHANGED JUMPL TT,IPJ3 ;JUMP IF SO IPJ1: MOVEM T,AC0(W2) HRRZM T,R AOS T,PC CALL DEP ;DO PUSH FOR HIM JRST ERR ;PROTECTED HRRZ R,BINSTR ;EA OF PUSHJ IPJ2: HLL R,PC ;HIS NEW PC TLO R,(1B5) ;MUST BE USERMODE MOVEM R,REALPC ;TOUSER WILL DO SFORK trne f, ystepf ; Single stepping? jrst cpopj1 ; Yes, give double return (taken care of) JRST TOUSER IPJ3: MOVE 1,FORK MOVSI 2,(1B9) IIC ;GOOSE USER'S CHN, LET HIM TRAP IT JRST IPJ1 ;DOES INT HAPPEN BEFORE PUSHJ???? ipj4: hrrz r, pc jrst ipj2 ;INTERPRET JSA IJSA: AOS T,PC HRL T,BINSTR ;FORM EA.RET EXCH T,AC0(W2) JRST IJSR2 ;INTERPRET JSR IJSR: AOS T,PC IJSR2: HRRZ R,BINSTR CALL DEP JRST ERR AOSA R,BINSTR IJSR3: MOVE R,BINSTR IJSR4: JRST IPJ2 ;INTERPRET JSP IJSP: AOS W,PC MOVEM W,AC0(W2) JRST IJSR3 ; Interpret popj ipopj: hrrz r, ac0(w2) ; Get pushdown pointer call fetch jrst err movem t, pc move t, ac0(w2) sub t, [1,,1] movem t, ac0(w2) jrst ipj4 ; Interpret jra ijra: hrrz t, binstr hrrzm t, pc ; Pc_Ea hlrz r, ac0(w2) ; Get ac call fetch jrst err movem t, ac0(w2) ; Restore ac jrst ipj4 ijrst: hrrz t, binstr movem t, pc jrst ipj4 ; Interpret jumps, aobjn, aobjp, jffo, aojs, sojs, etc. ijumps: movei t, t hllz r, binstr ; Get instruction dpb t, [point 4, r, 12] ; Substitute t for original ac hrri r, ijump2 ; Substitute for ea move t, ac0(w2) ; Get real user ac xct r ; Ha Ha! aos pc ; Didnt jump, so increment pc jrst ijump3 ijump2: hrrz r, binstr ; Get ea movem r, pc ; Fake jump ijump3: movem t, ac0(w2) ; Update ac pop p, t cain t, /1b8 movem w1, ac0+1(w2) ; Update ac+1 for jffo jrst ipj4 ;INSERT BREAKPOINTS INSRTB: MOVEI W1,BPTS PUSH P,FORK ; SAVE CURRENT FORK INSRT1: HRRZ R,0(W1) JUMPE R,INSRT3 ;NOT IN USE HRRZ 1,7(W1) ; GET THE PERTINENT FORK CALL SETFRK JRST [SETZM 0(W1) ; FORK HAS GONE, CANCEL BPT JRST INSRT3] CAIN R,$CTRLN ;THIS WHERE THE TEMPORARY BREAKPOINT GOES? JRST INSRT3 ;YES, DON'T INSERT THE BREAKPOINT CALL FETCH ;GET THE USER'S INSTRUCTION JRST INSRT4 ;PAGE IS READ PROTECTED. ABORT. MOVEM T,4(W1) MOVE T,[BPT] CALL DEP ;STUFF IT INTO THE USER JRST INSRT5 ;PAGE IS WRITE PROTECTED INSRT3: ADDI W1,NBPTV ;MOVE TO NEXT BPT CAIE W1,> JRST INSRT1 POP P,1 CALL SETFRK ; BACK TO ORIGINAL FORK JFCL RET INSRT4: SKIPA 1,[POINT 7,[ASCIZ /? Can't read instruction under breakpoint /]] INSRT5: MOVE 1,[POINT 7,[ASCIZ /?Can't insert breakpoint /]] PUSH P,W1 ;SAVE BPT BLOCK PTR MOVE W1,1 ;SETUP FOR TYPE CALL TYPE MOVE A,0(P) SUBI A,BPTS ;GET BACK THE NUMBER IDIVI A,NBPTV ADDI A,1 CALL TOC5 ;PRINT NUMBER AND PERIOD. POP P,W1 ;RESTORE THE BPT BLOCK POINTER POP P,FORK ;GIVE REMOV0 SOMETHING TO PUSH CAIE W1,BPTS ;ANY NEED REMOVING? CALL REMOV0 ;YES JRST ERR ;REMOVE BREAKPOINTS REMOVB: MOVEI W1,-NBPTV> ;ADDR OF LAST BPT REMOV0: PUSH P,FORK ; SAVE CURRENT FORK REMOV1: MOVE T,4(W1) ;SAVED INSTRUCTION HRRZ R,0(W1) JUMPE R,REMOV2 ; NOT IS USE HRRZ 1,7(W1) CALL SETFRK ; SWITCH TO THIS FORK JRST [ SETZM 0(W1) ; FORK GONE. CANCEL BPT JRST REMOV2] CALL DEP JRST REMOV3 ;WRITE PROTECTED PAGE REMOV2: SUBI W1,NBPTV ;MOVE TO NEXT BPT CAIL W1,BPTS ;DONE ALL? JRST REMOV1 ;NO POP P,1 CALL SETFRK JFCL RET REMOV3: PUSH P,W1 MOVE W1,[POINT 7,[ASCIZ /?Can't remove breakpoint /]] CALL TYPE MOVE A,0(P) SUBI A,BPTS IDIVI A,NBPTV ADDI A,1 CALL TOC5 CALL CRF POP P,W1 JRST REMOV2 ;ALL $B COMMANDS OF FORM $B ;A$NB A$B $NB $B BPS: TLNE F,QF JRST BPS1 ;A$NB OR A$B TRNE F,Q2F JRST BPS2 ;$NB ;$B OR $$B -- DELETE BREAK POINTS TLNN F,CCF ; $$B ? JRST BPS0 ; No, remove current breakpoint CALL FLSBPT JRST RETX ;$B - DELETE CURRENT BREAKPOINT BPS0: SKIPN T,BPTFLG ; Get ptr to bpt block JRST ERR ; Not at one SETZ R, JRST BPS5 ;A$NB OR A$B BPS1: HRRZ R,T JUMPE R,[TRNN F,Q2F ;DELETE MUST NAME A SPECIFIC BPT JRST ERR ;0$B DOESN'T MEAN ANYTHING JRST BPS2] ;0$NB (CLEAR SPECIFIC BPT) PUSH P,T ; SAVE ADDR CALL FETCH ; CREATE IF NECESSARY JRST ERR CALL DEP ; MAKE COPY IF NECESSARY JRST ERR POP P,R ; GET BACK ADDRESS HRRZ T,LASFPG ; GET PAGE NUMBER IN OWNER LSH T,9 ANDCMI R,777000 ; FLUSH PAGE ADDRESS IOR R,T ; CONVERT TO ADDRESS IN OWNER TRNN F,Q2F JRST BPS3 ;A$B ;PROCESS THE $NB (A$NB TO SET, 0$NB TO CLEAR, $NB TO EXAMINE) BPS2: MOVE T,WRD2 CAIL T,1 CAILE T,NBP JRST ERR ;NO SUCH BPT NUMBER IMULI T,NBPTV ADDI T,BPTS-NBPTV TLZN F,QF JRST QUANIN ;$NB EXAMINE JRST BPS5 ;A$NB (SET BPT) OR 0$NB (CLEAR BPT) ;A$B (NOT 0$B). SEARCH FOR A FREE BPT TO USE BPS3: MOVEI T,BPTS ;PROCESS THE A$B BPS4: HRRZ W,(T) ;WHERE BPT IS TO BE PUT HLRZ W1,LASFPG ; GET OWNING FORK XOR W1,7(T) ; COMPARE TO FORK OF BPT TRNN W1,777777 ; SAME FORK CAIE W,(R) ;AND SAME ADDRESS? SKIPN (T) ;IS THIS BPT NOT IN USE? JRST BPS5 ;YES, USE THIS BPT ADDI T,NBPTV ;NO, TRY NEXT CAIE T,> JRST BPS4 JRST ERR ;NONE AVAILABLE ;USE THE BREAKPOINT POINTED TO BY T ;ADDR AT WHICH TO SET IT IN R BPS5: HRRZ W,0(T) ;WHERE THIS BPT IS PLACED HLRZ W1,LASFPG ; OWNING FORK FOR NEW BPT XOR W1,7(T) CAME T,BPTFLG ;CHANGING BPT JUST HIT? JRST BPS6 CAIN W,0(R) ;TO A DIFFENERT PLACE? TRNE W1,777777 CALL GOODPC ;YES. DON'T PROCEED FROM OLD ONE. BPS6: MOVEM R,0(T) ;INSERT LOCATION SETZM 1(T) SETZM 2(T) SETZM 3(T) SETZM 5(T) ;ASSUME NOT AUTOPROCEED HLRZ R,LASFPG HRRM R,7(T) TLNN F,CCF JRST RETX SETOM 5(T) ;IT IS AN AUTOPROCEED MOVSI R,600000 ;A MODERATLY NEGATIVE INFINITY/2 MOVEM R,2(T) ;FOR PROCEED COUNT JRST RETX ;FLUSH ALL BREAKPOINTS FLSBPT: MOVEI T,BPTS ;ADDRESS OF 1ST BPT BLK SETZM 0(T) ;DELETE THE BPT. 0-->ADDR ADDI T,NBPTV ;MOVE TO NEXT CAIE T,> JRST .-3 ;DO ANOTHER ;MAKE PC GOOD FOR $P GOODPC: SETZM BPTFLG ;NO LONGER AT A BPT SETPC: PUSH P,2 MOVSI 2,(1B5) IORB 2,PC MOVEM 2,REALPC POP P,2 RET ;CHECK WHETHER THERE IS A BREAKPOINT AT THE ADDRESS POINTED ;AT IN R. IF THERE IS, DON'T SKIP. IF THERE ISN'T, SKIP. ;SORT OF BACKWARDS, HUH? BPCHK: PUSH P,W1 PUSH P,TT1 PUSH P,R HRRZS R MOVEI W1,BPTS BPCHKL: HRRZ TT1,(W1) CAMN TT1,R JRST BPCHK1 ADDI W1,NBPTV CAIE W1,> JRST BPCHKL AOS -3(P) BPCHK1: POP P,R POP P,TT1 POP P,W1 POPJ P, ;PRINT SOME BREAKPOINT INFORMATION (LIKE :LISTB ON ITS) PRBRK: MOVE W1,[POINT 7,[ASCIZ /reakpoints Name Location Break Skip Proceed Count/]] CALL TYPE MOVEI W1,BPTS PRBRKL: SKIPN TT1,(W1) ; ONE HERE? JRST PRNXTB CALL CRF ; CR PUSH P,W1 MOVEI W1,6(W1) HRLI W1,440700 CALL TYPE ; NAME MOVEI T,10 CALL TALIGN MOVE T,TT1 CALL CONSYM ; PRINT OUT VALUE,,LOCN MOVEI T,35 CALL TALIGN MOVE W1,(P) MOVE T,1(W1) CALL CONSYM ; 0 OR CONDITIONAL BREAK SKIP MOVEI T,55 CALL TALIGN MOVE W1,(P) MOVE T,2(W1) CALL TOC ; PROCEED COUNT POP P,W1 PRNXTB: ADDI W1,NBPTV AOS (P) CAIE W1,> JRST PRBRKL JRST DD1 ;UNPROTECT PAGES IN USER'S FORK ;A IFN ADBRKF,< JRST DADBRK> ;SET UP ADDRESS BREAK MOVE TT,WRD2 ;NUMBER TO RIGHT OF $ TRNN F,Q2F ;IF NOT GIVEN, MOVEI TT,7 ; ASSUME RWX JUMPL TT,ERR CAILE TT,7 JRST ERR ROT TT,-5 ;STANDARD POSTION TLNE TT,(1B3) ;ASKING FOR WRITE ACCESS? TLO TT,(1B9) ;YES, GIVE WRITE COPY IF CAN'T GET WRITE UNPRO1: TLNE F,QF ;NUMBER TO LEFT OF $ ? JRST UNPRO2 ; YES. MOVE T,LLOC ;. TLNE T,(DDTINT) JRST ERR ;NICE TRY, RAY. LSH T,-11 ;MAKE INTO PAGE NUMBER UNPRO2: TLNN F,FAF ; < SEEN? MOVEM T,DEFV ;NO, MAKE FIRST AND LAST PAGES THE SAME CAIG T,777 CAMGE T,DEFV JRST ERR ;TOO BIG, OR WRONG ORDER hrrz w, lastpg ; Will we change the access of this page? lsh w, -11 caml w, defv camle w, t caia ; Ok, no problem call unmap ; Map it out if we will SKIPA 1,DEFV UNPRO3: AOS 1,DEFV camle 1, t JRST DD1 ;DONE HRL 1,FORK RPACS TLNN 2,(1B5) ;EXISTS? JRST UNPRO3 MOVE 2,TT ;NEW ACCESS SPACS JRST UNPRO3 IFN ADBRKF,< ;SET AND REMOVE ADDRESS BREAK ;$$U REMOVE ADDRESS BREAK ;$$U SET ADDRESS BREAK WITH MASK N FOR LOCATION ;N ASSUMED TO BE 2 (BREAK ON WRITE) IF NOT SPECIFIED DADBRK: TLNN F,QF ;ANY LOCATION GIVEN JRST DADBRR ;NO, GO REMOVE ALL ADDRESS BREAK MOVE 3,WRD2 ;GET BREAK MASK TRNN F,Q2F MOVEI 3,2 ;OR 2 IF NOT GIVEN JUMPL 3,ERR CAILE 3,7 ;RANGE CHECK IT JRST ERR ROT 3,-3 ;NORMALISE IT JUMPL T,ERR CAILE T,777777 ;RANGE CHECK ADDRESS TOO JRST ERR MOVEI 2,(T) ;ADDRESS TO BREAK WITH HRRZ 1,FORK ;THE FORK TO DO IT IN ADBRK ;SET IT UP RET ;AND DONE DADBRR: HRRZ 1,FORK ;THE FORK TO DO IT IN HRLI 1,2 ;CLEAR ADDRESS BREAK ADBRK RET ;AND RETURN > ; ;R -- GET JCL FOR RSCAN BUFFER RJCL: MOVE W1,[POINT 7,[ASCIZ /scan (JCL): /]] CALL TYPE SETZM JCL ; CLEAR BUFFER MOVE 1,[JCL,,JCL+1] BLT 1,ENDJCL HRROI 1,JCL ; Set up TEXTI block MOVEM 1,TXTBLK+.RDDBP MOVEI 1,20*5 MOVEM 1,TXTBLK+.RDDBC MOVEI 1,TXTBLK TEXTI ; READ IN SOME STUFF JFCL MOVE 1,TXTBLK+.RDFLG TLNE 1,(RD%BFE) ; DELETED PAST START? JRST WRONG HRROI 1,JCL RSCAN ; PUT JCL IN BUFFER JRST WRONG JRST DD1.5 ; ;J -- JFN STATUS ; ;J STATUS OF JUST THAT JFN SEMI.J: TRNE F,SEMIF2 JRST jobst ; ;;J? TLNE F,QF ;HAVE AN ARG? JRST SEMIJ1 ;YES MOVE W1,[POINT 7,[ASCIZ /fn status: /]] CALL TYPE INTON MOVEI T,MAXJFN CALL JSTAT SOJGE T,.-1 JRST DD1 SEMIJ1: JUMPL T,ERR CAILE T,MAXJFN JRST ERR INTON PUSH P,T TLNN F,QF CALL CRF TLNE F,QF CALL LCT POP P,T CALL JSTAT JRST DD1 ;TYPE STATUS OF JFN IN T JSTAT: HRRZ 1,T ;THE JFN GTSTS TLNE 2,(1B10) ;NO GOOD? (+++ apparently this doesn't catch all cases) JRST JSTAT0 ;NOT SO. MOVE W1,[POINT 7,[ASCIZ / not assigned/]] TLNE F,QF ;;J ? CALL TYPE ;YES. RET JSTAT0: PUSH P,T PUSH P,2 ;SAVE STATUS MOVEI 1,101 HRRZ 2,T MOVE 3,[4,,10] TLNN F,QF ;DONT TYPE JFN AGAIN IF N;J NOUT CALL TSPC CALL LCT ;TYPE A TAB MOVEI 1,101 HRRZ 2,-1(P) ;THE JFN SETZ 3, ;DEFAULT FORMAT JFNS ERJMP [HRROI 1,[ASCIZ /Unassigned/] PSOUT POP P,TT JRST JSTA10] CALL LCT TRZ F,TEMF ;USED BY MMAP14 POP P,TT ;GET THE STATUS WORD MOVE W1,[POINT 7,[ASCIZ /not open/]] TLNN TT,(1B0) CALL TYPE MOVSI W1,(ASCII / R/) TLNE TT,(1B1) CALL MMAP14 ;MAYBE TYPE A COMMA AND THE LETTER MOVSI W1,(ASCII / W/) TLNN TT,(1B4) MOVSI W1,(ASCII / A/) TLNE TT,(1B2) CALL MMAP14 ;OK TO WRITE AND MAYBE CHANGE POINTER MOVSI W1,(ASCII / X/) TLNE TT,(1B3) CALL MMAP14 MOVE W1,[ASCII / PPT/] TLNE TT,(1B5) CALL MMAP14 MOVE W1,[ASCII / PRC/] TLNE TT,(1B6) CALL MMAP14 MOVE W1,[ASCII / ERR/] TLNE TT,(1B9) CALL MMAP14 MOVE W1,[ASCII / EOF/] TLNE TT,(1B8) CALL MMAP14 TLNE TT,(1B1!1B2) TLNN TT,(1B0) JRST JSTA10 TLNE TT,(1B3!1B6) JRST JSTA10 HRRZ 1,0(P) ;THE JFN RFPTR JRST JSTA10 PUSH P,2 MOVEI T,"," CALL TOUT CALL TSPC MOVEI 1,101 POP P,2 MOVEI 3,12 NOUT JRST JSTA10 MOVEI T,"." CALL TOUT JSTA10: CALL CRF POP P,T RET ; ;A --TYPE ADDRESS SPACE -- MEMSTAT ;JUST LIKE THE EXEC'S ADRSPC: CALL UNMAP TLNE F,QF ;DO WE HAVE AN ARG? JRST ADRSP1 ;YES. MEMSTA: MOVE W1,[POINT 7,[ASCIZ /ddress space /]] CALL TYPE INTON HRLZ 1,FORK ;USER'S FORK PUSH P,[1000] ;HOW MANY PAGES TO DO SETZB T,W ;CURRENT PAGE MEMS1: RPACS TLNE 2,(1B5) ;EXISTS? AOS W,T ;YES,COUNT IT AOS 1 ;NEXT PAGE SOSLE 0(P) ;COUNT DOWN NUMBER OF PAGES LEFT JRST MEMS1 SUB P,[1,,1] ;FLUSH JUNK CALL TOC ;T,W = NUMBER OF PAGES WHICH EXIST MOVE W1,[POINT 7,[ASCIZ / Pages/]] CALL TYPE MEMS2: MOVE 1,FORK GEVEC JUMPE 2,MEMS3 ;NO ENTRY VECTOR PUSH P,2 MOVE W1,[POINT 7,[ASCIZ /, Entry vector location /]] CALL TYPE HRRZ T,0(P) push p, w CALL pad pop p, w MOVEI W1,[ASCIZ / length /] CALL TYPE POP P,T HLRZS T CALL TOC MEMS3: CALL CRF JUMPE W,DD1 CALL CRF MMAP: SETZM W MMAP1: HRL 1,FORK MMAP2: CAIL W,1000 JRST DD1 ;DONE HRR 1,W RPACS TLNN 2,(1B5!1B6) ;EXISTS OR @ AOJA W,MMAP2 ;NO, TRY NEXT CALL PAGID ;GET FULL IDENTITY JRST .+2 JRST .+1 MOVE TT,TT2 ;SAVE ID FOR LATER MOVE TT1,TT3 ;PRINTING, TESTING SETZM W2 ;HOW MANY IN THIS GROUP HRRZ T,W CALL TOC ;GROUP START, PAGE NUMBER ;HAVE THE FIRST PAGE, LOOK AT NEXT ONE TO SEE IF IT IS SAME GROUP CALL NPAGID ;NEXT PAGE ID, STEPS W SOJA W2,MMAP10 ;DIFFERENT, TYPE OUT JRST MMAP6 ;NEXT(CONSECUTIVE) PAGE IN SAME GROUP ;2ND PAGE IDENTICAL TO FIRST PAGE, SEE HOW MANY MORE ARE CALL NPAGID JRST .+3 JRST .+2 JRST .-3 ;IDENTICAL, KEEP GOING SETZM W2 ;SAY IDENTICAL, NO CONSECUTIVE PAGES JRST MMAP7 ;2ND PAGE IS NEXT HIGHER AFTER 1ST, IN SAME FORK/FILE. HOW MANY MORE MMAP6: CALL NPAGID JRST .+2 ;DIFFERENT JRST .-2 ;CONSECUTIVE, KEEP GOING ;PRINT LAST PAGE NUMBER OF GROUP MMAP7: MOVEI T,"-" CALL TOUT MOVEI T,-1(W) CALL TOC ;FINAL PAGE NUMBER ;PRINT IDENTITY OF PAGES(S) IN GROUP MMAP10: CALL LCT ;TAB CALL TSPC ;SPACE TLNE TT1,(1B6) JRST MMAP09 MMAP08: TLNN TT1,(1B5) JRST MMAP70 TLNE TT1,(1B10) JRST MMAP71 CAMN TT,[-1] JRST MMAP72 LDB 2,[POINT 9,TT,17] ;JFN OR FORK # TLNE TT,(1B0) ;ON IF FORK JRST MMAP69 MOVEI 1,101 ;TTY OUTPUT SETZM 3 ;NO SPECAIL OPTIONS JFNS ;PRINT FILE NAME MMAP11: CALL LCT HRRZ T,TT CALL TOC ;PAGE # IN FORK/FILE JUMPLE W2,MMAP13 ;0 => ONLY ONE PAGE MOVEI T,"-" CALL TOUT HRRZ T,TT ADDI T,-1(W2) CALL TOC ;LAST PAGE IN GROUP JRST MMAP13 MMAP09: MOVSI W1,(ASCII /@ /) CALL TEXT2 JRST MMAP08 MMAP69: MOVE W1,[POINT 7,[ASCIZ /Fork /]] CALL TYPE MOVE T,2 ;FORK NUMBER CALL TOC JRST MMAP11 MMAP70: MOVE W1,[POINT 7,[ASCIZ /No page/]] JRST MMAP12 MMAP71: MOVE W1,[POINT 7,[ASCIZ /Private/]] JRST MMAP12 MMAP72: MOVE W1,[POINT 7,[ASCIZ /Forgotten file/]] MMAP12: CALL TYPE MMAP13: TRZ F,TEMF ;SUPPRESS COMMA IN LIST MOVSI W1,(ASCII / R/) TLNE TT1,(1B2) CALL MMAP14 MOVSI W1,(ASCII / W/) TLNE TT1,(1B3) CALL MMAP14 MOVSI W1,(ASCII / C/) TLNE TT1,(1B9) CALL MMAP14 MOVSI W1,(ASCII / X/) TLNE TT1,(1B4) CALL MMAP14 MOVSI W1,(ASCII / L/) TLNE TT1,(1B7) CALL MMAP14 CALL CRF TLNE F,QF ;;A COMMAND? JRST DD1 ;YES. WE'RE DONE JRST MMAP1 ;DO NEXT GROUP ;TYPE ITEM IN ACCESS CAPABILITY LIST MMAP14: MOVEI 1,"," TROE F,TEMF CALL TOUT+1 JRST TEXT2 ;;A ADRSP1: SKIPL W,T CAIL W,1000 JRST ERR ;BAD ARG HRL 1,FORK HRR 1,W RPACS TLNN 2,(1B5!1B6) JRST ADRSP2 CALL PAGID JRST .+2 JRST .+1 MOVE TT,TT2 MOVE TT1,TT3 SETZM W2 JRST MMAP10 ADRSP2: MOVE W1,[POINT 7,[ASCIZ / No page/]] CALL TYPE CALL CRF JRST DD1 ;NEXT PAGE ID NPAGID: ADDI W,1 ;PAGE UNDER CONSIDERATION ADDI W2,1 ;HOW MANY IN CURRENT GROUP ;GET PAGE IDENTIFICATION PAGID: MOVE 1,W SETZM TT2 ;FOR NON-EXISTENT OR PRIVATE PAGE CAIL 1,1000 JRST PAGID7 HRL 1,FORK RPACS HLLZ TT3,2 ;RETURN ACCESS TLNE 2,(1B5) ;DOESN'T EXIST? TLNE 2,(1B10) ;PRIVATE? JRST PAGID8 ; ALL INFO REQUIRED RMAP MOVE TT2,1 ;RETURN ID ;COMPARE PRINTING INFO AGAINS SAME FOR PREVIOUS PAGE PAGID8: MOVE 1,TT2 XOR 1,TT TLNE 1,-1 JRST PAGID9 ;DIFFERENT FILES OR FORKS MOVE 2,TT3 XOR 2,TT1 TLNE 2,(37B6!1B7!3B10) JRST PAGID9 ;DIFFERENT ACCESS TRNE 1,-1 JRST PAGID6 AOS (P) AOS (P) PAGID9: RET PAGID6: MOVE 1,W2 ADD 1,TT SUB 1,TT2 TRNE 1,-1 RET JRST PAGID9-1 PAGID7: HRLZI TT3,(1B5) ;PAGES > 777 DON'T EXIST JRST PAGID8 ;SETUP TO EXECUTE A SINGLE INSTRUCTION ;T HAS THE INSTR. ;$X SAYS WHERE IN USER'S MEMORY TO DO IT SETESI: HRRZ R,XRG ;WHERE CALL DEP JRST ERR ;CAN'T DO IT IN PROTECTED MEMORY MOVEI W1,3 SETES1: MOVE T,[BPT] AOS R CALL DEP ;INSERT PSEUDO BREAKPOINTS JRST ERR SOJG W1,SETES1 CALL DOSET HLL R,PC ;GET FLAGS HRR R,XRG ;WHERE $X SHOULD BE DONE MOVEM R,PC ;HIS TEMPORARY PC MOVEM R,REALPC RET ;SETUP A SAVE FRAME ON THE AUXILIIARY STACK DOSET: EXCH P,PCSPTR PUSH P,F PUSH P,LLOC PUSH P,LLOCO PUSH P,TRAPWD PUSH P,WDATA PUSH P,BPTFLG ;WHICH BREAKPOINT WERE AT PUSH P,BINSTR ;CURRENT BREAK INSTRUCTION .RPCNT==0 REPEAT *2, MOVSI R,(1B5) ;USERMODE FLAG IORM R,PC PUSH P,PC ;SAVE HIS OLD PC EXCH P,PCSPTR RET ;UNSET THE ABOVE UNSET: EXCH P,PCSPTR HLL TT1,REALPC ;FLAGS RETURNED FROM $X ETC. POP P,PC HRR TT1,PC MOVEM TT1,PC ;WHAT TO TYPE FOR $G MOVEM TT1,REALPC ;WHERE TO DO SFORK (IN TOUSER) .RPCNT==0 REPEAT *2,*2-1>-.RPCNT .RPCNT==.RPCNT+1> POP P,BINSTR POP P,BPTFLG POP P,WDATA POP P,TRAPWD POP P,LLOCO POP P,LLOC POP P,F EXCH P,PCSPTR RET ;;J COMMAND -- JOBSTAT JOBST: CALL UNMAP ;WILL USE THAT AREA FOR BUFFER FRKTAB=UCORE MOVEI W1,[ASCIZ /ob status /] CALL TYPE INTON MOVEI W1,[ASCIZ/ Tss job /] CALL TYPE GJINF PUSH P,4 ;SAVE TTY PUSH P,1 ;SAVE USER MOVEI 1,101 MOVE 2,3 ;GET TSS JOB NUMBER HRRZI 3,^D10 NOUT ;PRINT IT OUT JFCL MOVEI W1,[ASCIZ/, user /] CALL TYPE POP P,2 ;GET USER NUMBER DIRST ;PRINT IT OUT JFCL MOVEI T,"," CALL TOUT CALL TSPC ;TYPE A SPACE HRROI 1,[ASCIZ /TTY/] PSOUT POP P,2 ;GET TTY NUMBER BACK MOVEI 1,101 ;TYPE IT HRRZI 3,^D8 NOUT JFCL CALL CRF ;FOLLOWED BY CARRIAGE RETURN ;TYPE FORK STRUCTURE MOVEI 1,400000 ;SAY START AT SELF IFN KL20F, JOBST1: movsi 2,(1B0) ;SAY ASSIGN HANDLES MOVEI 2,FRKTAB ;USE BUFFER GFRKS ;GET FORK STRUCTURE HRRZ W2,FRKTAB ;POINTER TO FORKS INFERIOR SETZ W, ;INITIALIZE LEVEL COUNTER CALL FSTRUC ;USE COMMON DISPLAY FORK JRST DD1 ;STRUCTURE ROUTINE ;FSTRUC ;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB. ;FOR EACH FORK, TYPES HANDLE AND STATUS. ; FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE AVAILABLE. ;STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER IT, ; INDENTING 3 COLUMNS PER LEVEL. ;THUS PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH ; NO LESS-INDENTED ENTRIES BETWEEN THEM. ;TAKES: S: POINTER TO GFRKS TABLE, SET UP BY CALLER. ; W: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER. ;ENTRY POINT IS AT END BUT COMES RIGHT HERE. ;TYPE STUFF FOR THIS FORK. FSTR1: CALL TSPC MOVE 1,W CALL LCT ;INDENT 3 SPACES PER LEVEL BELOW FIRST. SOJGE 1,.-1 MOVEI W1,[ASCIZ/Fork /] CALL TYPE HRRZ 2,1(W2) ;GET THIS FORK'S HANDLE FROM TABLE JUMPE 2,[MOVEI W1,[ASCIZ /**/] ;NO HANDLE ASSIGNED CALL TYPE JRST FSTR2] TRZ 2,(1B0) ;PRINT IN FORM ## NOT 4000## MOVEI 1,101 MOVEI 3,10 NOUT ;FORK HANDLE, OCTAL JRST ERR ;JSYS ERROR ROUTINE FOR ERROR NUM IN C FSTR2: MOVEI W1,[ASCIZ/: /]; CALL TYPE HRRZ 1,1(W2) ;HANDLE AGAIN CALL FSTAT ;TYPE ITS STATUS CALL CRF ;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION. PUSH P,W2 HRRZ W2,(W2) ;INFERIOR PTR FROM GFRKS TABLE. AOS W ;DOWN LEVEL CALL FSTRUC ;RECURSIVE CALL TO DO ENTIRE SUBTREE SOS W ;UP LEVEL POP P,W2 HLRZ W2,(W2) ;PARALLEL PTR FROM GFRKS TABLE ;ENTRY POINT. NOP IF 0 PTR GIVEN. FSTRUC: JUMPN W2,FSTR1 RET ; ;I -- Interrupt STATUS ;PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N PSIST: MOVEI W1,[ASCIZ/nterrupt status /] CALL TYPE INTON CALL TSPC SKIPGE 1,FORK JRST [ MOVEI W1,[ASCIZ /No program/] CALL TYPE JRST CRF] MOVEI W1,[ASCIZ /PSI is /] CALL TYPE MOVEI W1,[ASCIZ /on/] SKIPN USRPSI+3 ;SKIP IF HIS PSI SYSTEM IS ON MOVEI W1,[ASCIZ /off/] CALL TYPE RIR HLRZ 4,2 ;LEVTAB HRRZ TT3,2 ;CHNTAB MOVEI W1,[ASCIZ/, Levtab at /] CALL TYPE MOVEI t,(4) call pad MOVEI W1,[ASCIZ/, Chntab at /] CALL TYPE MOVEI t,(TT3) call pad MOVEI W1,[ASCIZ/ Channels active: /] CALL TYPE MOVE 1,USRPSI+1 CALL BITTYP PSIST2: MOVEI W1,[ASCIZ/ Breaks waiting: /] CALL TYPE MOVE 1,USRPSI+0 CALL BITTYP MOVEI W1,[ASCIZ/ Levels in progress: /] CALL TYPE MOVSI 1,(17B3) AND 1,USRPSI+2 CALL BITTYP MOVEI W1,[ASCIZ/ Fork tiw: /] CALL TYPE MOVEI 1,101 MOVE 2,USRPSI+4 MOVE 3,[1B0+^D8] ;PRINT MAGNITUDE IN OCTAL NOUT JFCL MOVEI W1,[ASCIZ/ Job tiw: /] CALL TYPE MOVNI 1,5 RTIW MOVEI 1,101 MOVE 3,[1B0+^D8] ;PRINT IN Octal NOUT JFCL CALL CRF JRST DD1 ; ; ROUTINE TO TYPE OUT THE BIT NUMBERS IN REGISTER 1. ; IF REGISTER 1 CONTAINS 500000,,0 THEN THIS ; ROUTINE WOULD PRINT 0, 1 FOLLOWED BY A CRLF ; BITTYP: SKIPE 4,1 ;GET THE ARGUMENT JRST BITYP1 ;JUMP IF THERE ARE BITS ON MOVEI W1,[ASCIZ/None /] ;PRINT NONE IF ALL ZEROES JRST TYPE ;AND RETURN DIRECTLY FROM TYPE BITYP1: MOVEI 1,101 MOVSI TT3,400000 SETZ 2, BITYP2: SETZ 3, LSHC 3,1 ;ROTATE A BIT INTO 3 JUMPE 3,BITYP3 ;JUMP IF BIT OFF MOVEI 3,^D10 ;PRINT MAGNITUDE NOUT JFCL ;IGNORE ERRORS JUMPE 4,CRF ;CRLF AND EXIT IF NO MORE ON CALL BEFORE ;PRINT , IF NECESSARY BITYP3: AOJA 2,BITYP2 ;NEXT BIT NUMBER ; ;V COMMAND -- SET ^T VIEW ADDRESS SEMI.V: TRNE F,SEMIF2 JRST ERR ;TOO MANY SEMICOLI TLNN F,QF ;HAVE AN ARG? JRST SEMIV1 ;NO TLNE T,-1 ;REASONABLE ADDRESS? JRST ERR ;NO CAIA SEMIV1: SETO T, MOVEM T,VADDR ;LEAVE FOR ^T TO SEE JRST DD1 ;F COMMAND -- FORKSTAT SEMI.F: TRNN F,SEMIF2 ; ;;F OR ;F? JRST FRKST ; ;F GO DO FORK STAT TLNN F,QF ; N;;F? JRST ERR ;NO CAIL T,0 CAIL T,16 JRST ERR ; BAD FORK NUMBER SKIPN T MOVE T,TPFORK IORI T,400000 MOVE 1,T TLNN F,FAF ; TWO ARGS? JRST SEM.F1 ;NO MOVE 2,DEFV ; GET ARG IORI 2,400000 ; INSURE ITS A FORK HANDLE GFRKH ; GET FORK HANDLE JRST ERR ; SOME KIND OF ERROR PUSH P,1 MOVEI 2,-400000(1) HRROI 1,[ASCIZ /(fork /] PSOUT MOVEI 1,101 MOVEI 3,10 NOUT JFCL HRROI 1,[ASCIZ /) /] PSOUT POP P,1 SEM.F1: CALL SETFRK JRST ERR JRST DD1 FRKST: CALL UNMAP ;WILL USE THAT AREA FOR BUFFER FRKTAB=UCORE TLNE F,QF ; N;;F? JRST FRKST1 ;YES MOVE W1,[POINT 7,[ASCIZ /ork status /]] CALL TYPE INTON FRKST2: IFN KA10F,< MOVE 2,[1B0+FRKTAB]> IFN KL20F,< MOVSI 2,(1B0) MOVE 3,[-1000,,FRKTAB] > GFRKS IFE isigff,< JRST ERR> IFN isigff,< JFCL> HRRZI W,FRKTAB ;WHAT TO PRINT MOVEI TT,1 ;LEVEL TO PRINT IT AT CALL PRFRK ;PRINT FORKS JRST DD1 PRFRK: JUMPE W,CPOPJ PUSH P,W ;SAVE FOR BELOW PUSH P,TT ;SAVE PRINTING LEVEL CALL TSPC ;TYPE A SPACE SOJG TT,.-1 HRRZ T,1(W) ;FORK HANDLE ANDI T,77 CALL TOC ;PRINT IT CALL LCT ;AND A TAB HRRZ 1,1(W) ;THE FORK HANDLE CALL FSTAT ;PRINT THE STATUS CALL CRF ;AND A CARRIAGE RETURN POP P,TT ;RESTORE LEVEL HRRZ W,@(P) ;POINTER TO INFERIORS AOS TT ;LEVEL OF INFERIORS CALL PRFRK ;PRINT THEM SOS TT ;NOW BACK TO THIS LEVEL POP P,W HLRZ W,0(W) ;PARALLEL FORKS JRST PRFRK FRKST1: JUMPL T,ERR ;BAD ARG CAIL T,20 JRST ERR ;BAD ARG PUSH P,T CALL LCT POP P,1 TRO 1,400000 ;MAKE INTO A GOOD FORK HANDLE CALL FSTAT ;PRINT STATUS CALL CRF JRST DD1 ;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE. ;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, AND FILSTAT. ;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT. BEFORE: PUSH P,1 PUSH P,2 MOVEI 1,101 RFPOS MOVEI 2,(2) ;MASK COLUMN POSITION CAIL 2,^D65 JRST [ CALL CRF JRST .+4] MOVEI T,"," TLOE TT3,(1B0) ;SUPPRESS COMMA BEFORE FIRST ONE CALL TOUT CALL TSPC ;SPACE AFTER COMMA OR EOL JRST [ POP P,2 POP P,1 RET] ;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT". ;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A ; DEVICE CHARACTERISTICS WORD (A LA "DVCHR" EXCEPT B5) IN 2, ; -1 OR JOB # ASSIGNED TO IN C. ;RETURNS +2. ;DESTROYS 1, 2, 3, 4. DEVNAM==6 DEVCHR==7 DEVUNT==10 DEVLUP: SETO 4, HRL 1,TT2 HRRI 1,DEVNAM ;GET # DEVICES FROM TABLE 6 GETAB JFCL HRLZ 4,1 ;AOBJN COUNT,,ABLE INDEX DEVL1: HRL 1,4 HRRI 1,DEVCHR ;GET DEVICE CHARACTERISTICS WORD FROM TABLE 7 GETAB JFCL MOVE 2,1 HRL 1,4 HRRI 1,DEVUNT ;GET JOB # ASS TO, OR -1, FROM LH TABLE 8 GETAB JFCL HLRE 3,1 HRL 1,4 HRRI 1,DEVNAM ;GET DEVICE NAME IN SIXBIT FROM TABLE 6 GETAB JFCL PUSH P,4 XCT @-1(P) POP P,4 AOBJN 4,DEVL1 JRST [ AOS (P) RET] ;TYPE SIXBIT SYMBOL FROM A. SIXPRT: PUSH P,2 MOVE 2,1 SIXPR1: SETZ 1, LSHC 1,6 ADDI 1,40 PBOUT JUMPN 2,SIXPR1 JRST [ POP P,2 RET] ;ARG< COMMAND FIRARG: MOVEM T,DEFV ;VALUE OF ARG TO DEFINITION VALUE TLO F,FAF ;INDICATE A < HAS BEEN SEEN JRST ULIM1 ;GIVE ERROR IF ARG NULL ;ARG> COMMAND ULIM: TLO F,SAF ;INDICATE A > HAS BEEN SEEN HRRZM T,ULIMIT ;UPPER LIMIT FOR $Z, $W ETC. ULIM1: TLNN F,QF ;ON IF ARG WAS TYPED JRST ERR JRST LIS0 ;GET REST OF COMMAND ;$I COMMAND -- NAME OF INTERRUPT STUFF FOR USER PSI SYSTEM INTRUP: TLNN F,QF ;MUST HAVE NO ARG TLNE F,CCF ;AND ONLY ONE $ SIGN JRST ERR ;ELSE, DIFFERENT COMMAND MOVEI T,USRPSI JRST QUANIN ; ;H -- HALTF BACK TO EXEC HALT: MOVE 1,ESCCOD DTI HALTF ;LIKE @QUIT JRST DDT ;LOOK FOR BEST FIT FOR SYMBOL TYPE-OUT LOOK: TLNN T,-1 ;IF LEFT HALF NON-0, OR CAIGE T,140 ;VALUE LESS THAN 140, LOOKE: TLOA F,(1B2) ;SKIP LOCALS OUTSIDE CURRENT PGM TLZ F,(1B2) ;OTHERWISE, ALLOW LCLS AND SAVE CONTEXT SETZM SVFB SETZM SVTB SETOM BLVL HLRE S,SYMPTR ASH S,-1 TLZ F,600000 HRLZI W2,DELO+DELI MOVEM T,TEM SKIPL R,PRGM JRST TOPDWN LOOK1: SUB R,[2,,2] TDNE W2,(R) JRST LOOK3 LDB T,[POINT 4,(R),3] CAIN T,3 JRST BLNME JUMPE T,PNAM TRNE T,LOCAL/40000 TLZA F,(1B1) TLO F,(1B1) MOVE T,TEM MOVE W,1(R) XOR W,T JUMPL W,LOOK3 SUB T,1(R) JUMPL T,LOOK3 JUMPGE F,LOOK2 MOVE W,1(R) SUB W,1(W1) JUMPL W,LOOK3 JUMPG W,LOOK2 SKIPN SVTB ; THIS SYMBOL NO PREFIX SKIPN SVFB ; AND LAST SYMBOL WITH PREFIX? JRST LOOK3 ; NO LOOK2: HRR W1,R TLO F,(1B0) ; REMEMBER WE HAVE FOUND SOME SYMBOL MOVE W,SVTB TLNE F,(1B1) ; IF THIS SYMBOL IS GLOBAL, MOVEI W,0 ; THEN DON'T SAVE BLOCK MOVEM W,SVFB SKIPN W ; ANY PREFIX? JUMPE T,SPT0 ; NO, THEN EXACT MATCH IS BEST LOOK3: CAMN R,SYMPTR JRST TOPDWN LOOK3A: AOJLE S,LOOK1 MOVE T,TEM TLNE F,(1B0) SUB T,1(W1) JUMPE T,SPT0 JRST CPOPJ1 TOPDWN: TLNE F,(1B2) TLO W2,LOCAL HLRE R,SYMPTR MOVNS R ADD R,SYMPTR JRST LOOK3A PNAM: TLNE F,(1B2) TLO W2,LOCAL SKIPA T,[-1] ; PROGRAM NAMES LIKE BLOCKS OF LEVEL -1 BLNME: MOVE T,1(R) ; GET BLOCK LEVEL MOVEM R,SVTB ; SAVE THIS BLOCK LOCATION CAMN R,BLOCK ; IS THIS THE CURRENT BLOCK? JRST BLNM1 ; YES CAML T,BLVL ; IS BLOCK BELOW CURRENT? JRST LOOK3 ; YES, RETAIN PREFIX BLNM1: SETZM SVTB ; THIS IS CURRENT OR ABOVE MOVEM T,BLVL JRST LOOK3 CONSYM: MOVEM T,LWT CONSY1: TRNN F,LF1 JRST (SCH) ;PIN OR FTOC TRNE F,CF1 JRST FTOC PIN: ;PRINT INSTRUCTION LDB T,[POINT 9,T,8] ;GET OPCODE JUMPE T,HLFW ;0. TYPE AS HALF WORDS CAIL T,700 ;CONO, CONI, ETC? JRST INOUT ;YES. TYPE AS IN/OUT INSTRUCTION CAIN T,_-33 JRST JSTYPE ;TYPE JSYS INSTRUCTION CAIN T,_-33 JRST CLTYPE ;OR CALLI CAIN T,_-33 JRST XMTYPE ;OR XMOVEI CAIN T,_-33 JRST XHTYPE ;OR XHLLI CAIN T,_-33 JRST TTTYPE ;OR TTCALL PIN0: HLLZ T,LWT TLZ T,777 CALL OPTYPE PIN1: TRNE F,ITF ;INSTRUCTION TYPED? JRST PFULI1 ;YES MOVE T,LWT ;TRY TO FIND FULL WORD MATCH TLNE T,777 ;BUT NOT IF AC, @, OR X FIELDS NON-0 JRST PFULI1 CALL LOOK JRST PADS1 ;FOUND PFULI1: MOVSI T,777000 AND T,LWT TRNN F,ITF ;HAS INSTRUCTION BEEN TYPED? CALL LOOK ;NO, LOOK IN SYMBOL TABLE TROA F,NAF ;INSTRUCTION TYPED, ALLOW NEG ADDRESSES JRST HLFW ;NOT FOUND, OUTPUT AS HALFWORDS CALL TSPC LDB T,[POINT 4,LWT,12] ;GET AC FIELD JUMPE T,PI4 CALL PAD PI3A: MOVEI W1,"," CALL TEXT PI4: MOVE W1,LWT MOVEI T,"@" TLNE W1,20 ;CHECK FOR INDIRECT BIT CALL TOUT HRRZ T,LWT LDB W,[POINT 9,LWT,8] ;INSTRUCTION BITS TLNE W1,20 JRST PI8 CAIE W,104 ;JSYS GETS ABSOLUTE ADDR CAIN W,47 ;SO DOES CALLI JRST PI7X CAIL W,240 CAILE W,247 JRST PI8A ;ALL (EXCEPT ASH,ROT,LSH) HAVE SYMB. ADRS CAIN W,_-33 JRST PI8 ;JFFO AND @ GET SYMBOLIC ADDRESSES PI7X: CALL PADS3A ;ONLY ABSOLUTE ADDRESSING FOR LSH, ASH, AND ROT PI7: TRZ F,NAF LDB R,[POINT 4,LWT,17] ;INDEX REGISTER CHECK JUMPE R,PIZ ;EXIT MOVEI T,"(" CALL TOUT MOVE T,R CALL PAD MOVEI T,")" CALL TOUT ;EXIT PIZ: SKIPN PINFF ;PRINT INSTRUCTION AC/EFF ADR? RET ;NOPE RETURN NOW SETZM PINFF ;NEVER CHANCE RECURSION... LDB T,[POINT 9,LWT,8] ;GET OPCODE MOVE T,PCPNTB(T) ;GET TABLE ENTRY LDB R,[POINT 4,LWT,12] ;GET AC FIELD PUSH P,LWT ;SAVE LWT OVER PRINTING TRNE T,1 ;OPEN THE AC? JRST PIZAC ;YES... TRNN T,2 ;OPEN AC UNLESS IT IS ZERO? JRST PIZNAC ;NOPE, SO NEVER PRINT AC JUMPE R,PIZNAC PIZAC: CALL LCT MOVE T,R ;ADDRESS INTO T CALL LI1 ;PRINT THE CONTENTS PIZNAC: LDB T,[POINT 9,(P),8] ;GET OPCODE MOVE T,PCPNTB(T) ;GET TABLE ENTRY TRNN T,4 ;PRINT EFF ADR? JRST PIZEA ;NOPE, WE ARE DONE CALL LCT MOVE T,(P) ;FOR EFFADR CALL EFFADR JRST PIZFAI HRRZ T,W1 ;ADR MUST BE IN T FOR LI1 CALL LI1 ;PRINT PIZRET: POP P,T RET PIZFAI: MOVEI T,"?" CALL TOUT JRST PIZRET PIZEA: MOVE T,(P) ;EVEN THOUGH WE DON'T PRINT EA, MAYBE SHOW IT TLNN T,37 ;ANY AC OR INDIRECT BITS? JRST PIZRET ;NOPE, SO DONE CALL LCT MOVEI W1,[ASCIZ \E.A. _ \] CALL TYPE MOVE T,(P) ;FOR EFFADR CALL EFFADR JRST PIZFAI HRRZ T,W1 ;ONLY WANT ADDRESS, NOT LEFT HALF BITS TRZ F,CF1 ;SWIPED FROM '_' CODE TRO F,LF1 PUSH P,LWT CALL CONSYM ;BUT DON'T DESTROY LWT POP P,LWT JRST PIZRET PI8A: CAIL W,600 ; IS THIS A TEST INSTRUCTION? CAILE W,677 JRST PI9 TRNE W,10 ; DIRECT OR SWAPPED? JRST PI8 ; YES, PRINT SYMBOLIC ADDRESS CALL PADFLG ; TLXX OR TRXX, PRINT ADDRESS AS FLAGS JRST PI7 PI8: CALL PAD JRST PI7 PI9: LDB W,[POINT 13,LWT,12] ANDI W,16007 CAIL W,16003 ; OP GREATER THAN DATAO? CAIN W,16005 ; AND NOT CONI? JRST PI8 ; NO CALL PADFLG JRST PI7 ; YES CONO, CONSZ AND CONSO PRINT BITS HLFW: HLRZ T,LWT ;PRINT AS HALF WORDS JUMPE T,HLFW1 ;TYPE ONLY RIGHT ADR IF LEFT ADR=0 TRO F,NAF ;ALLOW NEGATIVE ADDRESSES CALL PAD MOVSI W1,(ASCII /,,/) CALL TEXT2 ;TYPE ,, HLFW1: HRRZ T,LWT ;PRINT ADDRESSES (ARG USUALLY 18 BITS BUT CAN BE 36 BITS) PAD: TLZE T,(DDTINT) JRST PADINT ;INTERNAL TO NDDT ANDI T,-1 JRST @AR ;PADSO OR PAD1 PADSO: JUMPE T,FP7B ;PRINT A ZERO CALL LOOK PADS1: RET JUMPGE F,PADS3 ;PRINT NUMBER OF NO SYMBOL FOUND MOVE W2,1(W1) CAMG T,SYMOFS ;MAXIMUM OFFSET TO PRINT CAIGE W2,60 JRST PADS3 MOVEM T,TEM CALL SPT0 PADS0A: MOVEI T,"+" PADS1A: CALL TOUT HRRZ T,TEM PAD1: JRST TOC ;EXIT PADS3: MOVE T,TEM PADS3A: TRNE F,NAF CAIGE T,776000 JRST TOC PADS3B: MOVNM T,TEM MOVEI T,"-" JRST PADS1A ;PRINT INTERNAL ADDRESS PADINT: MOVEI TT,777777 ;INITIAL DIFFERENCE = ./. MOVE S,[INTTAB-INTEND,,INTTAB] PADIN1: HRRZ R,0(S) SUBM T,R JUMPL R,PADIN0 ;NEGATIVE IS NOT SMALLER THAN 0 CAMLE R,TT JRST PADIN0 ;NOT A BETTER MATCH MOVEM R,TT ;NEW DIFFERENCE HLRZ W1,0(S) ;NAME POINTER PADIN0: AOBJN S,PADIN1 PADIN2: JUMPE TT,PADIN3 ;EXACT MATCH CAIL T,FRSTIR ;LOWER THAN 1ST INTERNAL REGISTER CAIL T,LASTIR ;GREATER THAN LAST INTERNAL JRST ERR MOVEM TT,TEM CALL PADIN3 JRST PADS0A PADIN3: MOVEI W1,0(W1) ;GET ASCIZ CALL TYPE RET ; PRINT ADDRESS AS FLAGS PADFLG: PUSH P,T ; SAVE ADDRESS MOVEI W1,3 ;COUNT BITS TO SEE IF MORE THAN 3 MOVN W2,T ;FIND RIGHTMOST ONE IN T TDZE T,W2 ;SKIP IF NO MORE SOJGE W1,.-2 ;STOP COUNTING IF MORE THAN 3 JUMPL W1,PADFL6 ;GO TYPE NUMBER IF MORE THAN 3 BITS MOVEI T,400000 ; START WITH LEFT MOST BIT PADFL1: TDNN T,(P) ; IS THIS BIT IN THE THING JRST PADFL2 ; NO, GO TO NEXT BIT CALL LOOKE ; LOOK UP THIS BIT JRST PADFL3 ; EXACT MATCH FOUND AND PRINTED JRST PADFL4 PADFL3: MOVE T,TEM ANDCAM T,(P) ; REMOVE BIT FROM ADDRESS SKIPN (P) ; ANY MORE TO BE OUTPUT? JRST PADFL5 ; NO MOVEI T,"+" CALL TOUT ; YES, TYPE ! PADFL4: MOVE T,TEM PADFL2: ASH T,-1 ; SHIFT TO NEXT BIT CAILE T,10 ;DONE BITS 18-31? JRST PADFL1 ;NO, GO DO NEXT BIT PADFL6: POP P,T ; ELSE TYPE OUT THE REST AS A NUMBER JRST TOC PADFL5: POP P,T RET INOUT: MOVE T,LWT TDC T,[-1,,400000] ;IO INSTRUCTION OR NEG NUM TDCN T,[-1,,400000] JRST PADS3B ;TYPE AS NEG NUM LDB R,[POINT 7,T,9] ;PICK OUT IO DEVICE BITS CAIL R,700_-2 ;IF DEVICE .L. 700, THEN TYPE JRST HLFW ;TYPE AS HALF WORDS LDB R,[POINT 3,T,12] DPB R,[POINT 6,T,8] ;MOVE IO BITS OVER FOR OP DECODER CALL OPTYPE CALL TSPC MOVSI T,077400 AND T,LWT JUMPE T,PI4 CALL LOOK ;LOOK FOR DEVICE NUMBER JRST PI3A MOVE T,TEM LSH T,-30 CALL TOC JRST PI3A ;PRINT AS JSYS ; ONLY IF EXACT MATCH IS FOUND. ; IF NOT PRINTED, RETURNS TO PIN TO CALL OPTYPE TO ; GET THE INSTRUCTION PRINTED LIKE JSYS 501 JSTYPE: MOVE T,LWT ;GET LAST WORD TYPED TDNN T,[37,,777000] ;@ OR XR BITS ON, OR IS JSYS OUT OF RANGE? SKIPN T,JSYTAB(T) ;NO, GET RAD50 JSYS NAME JRST PIN0 ;GO TYPE AS JSYS XXX JRST SPT1 ;FOUND, TYPE AS JSYS NAME CLTYPE: MOVE T,LWT ;GET VAL TO TYPE TLNE T,37 ;@ OR XR BITS ON, GO TYPE AS CALLI XXX JRST PIN0 HRRE T,LWT ;RANGE CHECK RH TRNN T,500000 ;CLEAR UU.PHY TRZA T,200000 TRO T,200000 CAML T,[-1] CAILE T,CLILEN JRST PIN0 ;OUT OF RANGE, TOO BAD MOVE W1,LWT ;GET DIFF BETWEEN DIDDLED LWT AND REAL LWT SUB W1,T HRLI W1,0 ;CLEAR LH PUSH P,W1 ;SAVE FOR EFF ADR TYPEOUT MOVE T,CLITAB(T) ;GET RAD50 UUO NAME CALL SPT1 ;GO TYPE IT CALL TSPC ;SPACE LDB T,[POINT 4,LWT,12] ;AC FIELD JUMPE T,CLIT0 ;SKIP IF ZERO CALL PAD ;PRINT ADDRESS MOVEI W1,"," ;COMMA CALL TEXT CLIT0: POP P,T ;GET EFF ADR BACK JUMPE T,CPOPJ ;ZERO, DONE JRST TOC ;NONZERO, TYPE IN OCTAL XHTYPE: SKIPA T,[RADIX50 0,XHLLI] XMTYPE: MOVE T,[RADIX50 0,XMOVEI] CALL SPT1 TRO F,ITF ;INST HAS BEEN TYPED JRST PIN1 TTTYPE: LDB T,[POINT 4,LWT,12] ;GET AC FIELD CAIL T,TTCLEN ;IN RANGE? JRST PIN0 ;NO, TYPE AS TTCALL NNN MOVE T,TTCTAB(T) ;GET MNEMONIC CALL SPT1 ;TYPE IT CALL TSPC ;TYPE SPACE TRO F,NAF ;TYPE NEG ADDRESSES JRST PI4 ;GO TYPE REST OF INST ; $M COMMAND -- SET SEARCH MASK MASK: TLNE F,CCF ;HOW MANY $'S ? JRST ERR ;2 MOVE R,T MOVEI T,MSK TRNE F,Q2F ;ARGUMENT AFTER THE ESC ADD T,WRD2 TLNN F,QF JRST QUANIN ;INTERNAL REGISTER EXAMINATION SETUP MOVEM R,(T) ;SET THE MASK JRST RETX ; $W -- WORD EQUALITY SEARCH WORD: TLNE F,QF ;ARG TYPED? JRST EFWRD ;YES, DO WORD SEARCH MOVEI T,TRAPWD ;NO, EXAMINE $W REGISTER JRST QUANIN ; $E -- EFFECTIVE ADDRESS SEARCH EFFEC: TLNE F,CCF ;HOW MANY $'S ? JRST ERR ;2 TLO F,TEMF HRRZ T,T EFWRD: MOVEI R,(-) ; $N -- WORD NON-EQUALTIY SEARCH (R IS 0) NWORD: ADDI R,() HRLM R,SEAR2 MOVEI TT1,MSK ;LOOK AT MASK TRNE F,Q2F ADD TT1,WRD2 ;BUT IF $N USE THAT MAST MOVE TT1,(TT1) ;GET VALUE MOVEM TT1,CURMSK ;AND SAVE IT INTON TLZN F,QF ;QUANTITY TYPED IN? JRST ERR ;NO ARGUMENT SETCAM T,WRD MOVE T,ULIMIT ;WHAT TO USE IF SECOND ARG TYPED TLNE F,SAF ;IF 2ND ARG... TLO F,QF ;FOOL SETUP CALL SETUP ;1ST ADDR TO DEFV, LAST TO ULIMIT CALL CRF SEAR1: CALL FETCH ;OF R JRST SEAR2B TLNE F,TEMF ;CHECK FOR EFFECTIVE ADDRESS SEARCH JRST EFFEC0 ;DO E.A. COMPARE, RETURN TO SEAR2X EQV T,WRD AND T,CURMSK ;GO TO SEAR3 IF A FIND HAS OCCURRED SEAR2X: XCT SEAR2 ;A JUMPE T,SEAR3 OR JUMPN T,SEAR3 SEAR2A: AOS R,DEFV ;GET NEXT LOCATION CAMG R,ULIMIT ;END OF SEARCH? JRST SEAR1 ;NO, LOOK SOME MORE ;AT END OF SEARCH SEARFN: SETCMM LWT ;COMPLEMENT BITS BACK AND STOP SEARCH SETZM DEFV SETZM ULIMIT JRST DD1 SEAR2B: MOVEI R,777 IORB R,DEFV ;SKIP TO NEXT PAGE JRST SEAR2A ;FOUND A MATCH, R IS WHERE SEAR3: MOVE R,DEFV CALL FETCH JRST ERR TLZ F,STF ;GET RID OF SUPPRESS TYPEOUT MODE MOVE T,DEFV SETZM PINFF ;DON'T PRINT EFF ADR OR AC CALL LI1 ;EXAMINE REGISTER CALL CRF SETCMM LWT SETCMM TEM JRST SEAR2A ;CALCULATE EFFECTIVE ADDRESS AND DO ;COMPARE FOR INSTRUCTION AT R EFFEC0: MOVEI W,20 ;@ CHAIN DEPTH, MAX. MOVEM W,TEM EFFEC1: MOVE W,T LDB R,[POINT 4,T,17] ;GET XR FIELD JUMPE R,EFFEC2 ;NO XR SPECIFIED, TRY FOR @ CALL FETCH ;THE XR JRST ERR ADD T,W ;ADD IN THE XR ;T HAS THE INDEXED ADDRESS, SEE IF @ EFFEC2: HRR R,T TLNN W,(@) ;INDIRECT BIT CHECK JRST EFFEC3 ;NONE, R HAS EFFECTIVE ADDR SOSE TEM ;CHECK @ CHAIN LENGTH CALL FETCH ;GET INDIRECT WORD JRST SEAR2A ;CAN'T GET IT => NO MATCH JRST EFFEC1 ;GO BACK AND TRY TO INDEX ;GOT IT. DO COMPARE ON ADDRESS EFFEC3: EQV T,WRD ANDI T,777777 JRST SEAR2X ;SETUP SEARCH LIMITS ;1ST ADDR (0) TO R AND DEFV, LAST TO ULIMIT ;USED BY SEARCHES (W,N,E) AND ZERO (Z) SETUP: TLNN F,QF ;QUANTITY TYPED (2ND ARG)? MOVEI T,777777 ;NO, DEFAULT LAST ADDRESS HRRZM T,ULIMIT ;SAVE TOP OF SEARCH/ZERO HRRZS R,DEFV ;GET 1ST ADDRESS TLNN F,FAF ;WAS A 1ST ADR SPECIFIED? SETZB R,DEFV ;NO, MAKE IT ZERO CAMLE R,ULIMIT ;LIMITS IN A REASONABLE ORDER? JRST ERR ;NO RET ;YES, RETURN ;$$Z ZERO MEMORY FROM ZLOW TO ULIMIT AND AC'S ZERO: TLNN F,CCF JRST ERR CALL UNMAP ;FORGET ABOUT ANY MAPPED PAGE CALL SETUP ZERO0: CAIL R,700000 CAIL R,740000 JRST ZERO2 ;NOT ZERO'ING COMPATIBILITY MOVE 1,FORK PUSH P,R SETZB 2,3 SCVEC ;FLUSH PAT POP P,R ZERO2: MOVE T,WRD2 ;0 (OR WHATEVER) TO STORE IN MEMORY ZERO3: CAMLE R,ULIMIT ;ABOVE LIMITS? JRST DD1 ;YES, STOP TRNN R,777 ;START OF PAGE? JRST ZERO4 ;YES, CHECK FOR EXISTENCE ZERO33: CALL DEP ;DEPOSIT T AT USER LOC IN R JRST ZERO5 ;WOULDN'T DEPOSIT AOJA R,ZERO0 ZERO4: JUMPN T,ZERO33 ;NOT REALLY ZEROING MOVE TT,ULIMIT SUB TT,R ;NUMBER OF WORDS LEFT TO ZERO CAIGE TT,777 ;LESS THAN A PAGE? JRST ZERO33 ;YES, ZERO THEM ZERO5: MOVE TT,R ;R=2 HRRZS 2 LSH 2,-11 HRL 2,FORK SETZ 3, ;WATCH OUT FOR KL20 SETOM 1 PMAP MOVE R,TT IORI R,777 ;TOP OF THIS PAGE AOJA R,ZERO0 ;DO NEXT PAGE BITO: MOVEI R,BITT ;BYTE OUTPUT SUBROUTINE HRRZI AR,TOC TRZN F,Q2F JRST ERR MOVE T,WRD2 MOVEM T,SVBTS MOVEI T,^D36 IDIV T,WRD2 SKIPE T+1 ADDI T,1 MOVEM T,SVBTS2 HRRZ SCH,R JRST BASE1 BITT: MOVE T,SVBTS2 MOVEM T,SVBT2 MOVE T+1,LWT MOVEM T+1,SVBT3 PUSH P,LWT BITT2: MOVEI T,0 MOVE T+2,SVBTS LSHC T,(T+2) MOVEM T,LWT MOVEM T+1,SVBT3 CAIE AR,PADSO CALL TOCA CAIE AR,TOC CALL PIN SOSG SVBT2 JRST BITT4 MOVEI T,"," CALL TOUT MOVE T+1,SVBT3 JRST BITT2 BITT4: POP P,LWT RET ;NUMERIC OUTPUT SUBROUTINE FTOC: TOC: HRRZ W1,ODF CAIN W1,10 ;IS OUPUT RADIX NOT OCTAL, OR TLNN T,-1 ;ARE THERE NO LEFT HALF BITS? JRST TOCA ;YES, DO NOTHING SPECIAL HRRM T,TOCS ;NO, TYPE AS HALF WORD CONSTANT HLRZS T ;GET LEFT HALF CALL TOC0 ;TYPE LEFT HALF MOVSI W1,(ASCII /,,/) CALL TEXT2 ;TYPE ,, TOCSX: XCT TOCS ;A MOVEI T,.-. TO GET RIGHT HALF BACK TOCA: HRRZ W1,ODF ;IS OUTPUT RADIX DECIMAL? CAIN W1,12 JRST TOC4 ;YES,TYPE SIGNED WITH PERIOD TOC0: LSHC T,-43 LSH W1,-1 ;W1=T+1 DIVI T,@ODF HRLM W1,0(P) SKIPE T CALL TOC0 HLRZ T,0(P) cail t, ^d10 addi t, "A"-"0"-^d10 ADDI T,"0" JRST TOUT TOC4: MOVM A,T ;TYPE AS SIGNED DECIMAL INTEGER JUMPGE T,TOC5 MOVEI T,"-" CALL TOUT TOC5: CALL FP7 ;DECIMAL PRINT ROUTINE TOC6: MOVEI T,"." JRST TOUT ;SYMBOL OUTPUT SUBROUTINE SPT0: HRRZM W1,SPSAV ;SAVE POINTER TO TYPED SYM SPT: MOVE T,SVFB JUMPE T,SPT1W CAMN T,BLOCK JRST SPT1W PUSH P,W1 LDB T,[POINT 32,(T),35] CALL SPT1 MOVEI T,"&" CALL TOUT POP P,W1 SPT1W: LDB T,[POINT 32,(W1),35] ;GET SYMBOL ;RADIX 50 SYMBOL PRINT SPT1: IDIVI T,50 HRLM W1,0(P) JUMPE T,SPT2 CALL SPT1 SPT2: HLRZ T,0(P) JUMPE T,CPOPJ ;FLUSH NULL CHARACTERS ADDI T,260-1 CAILE T,271 ADDI T,301-272 CAILE T,332 SUBI T,334-244 CAIN T,243 SPT3: MOVEI T,256 JRST TOUT ;$D ;DELETE LAST SYM & PRINT NEW SYMD: MOVEI T,DELO/200000 HRRZ R,SPSAV ;PICK UP POINTER TO LAST SYM JUMPE R,ERR DPB T,[POINT 2,(R),1] ;STORE SEMI-DELETE BITS IN SYMBOL MOVE T,LWT SETZM PINFF ;NEVER WANT LONG INS PRINTOUT JRST CONSYM ;PRINT OUT NEXT BEST SYMBOL ;FLOATING POINT OUTPUT TFLOT: MOVE A,T JUMPG A, TFLOT1 JUMPE A,FP1A MOVNS A MOVEI T,"-" CALL TOUT TLZE A,400000 JRST FP1A TFLOT1: TLNN A, 400 JRST TOC5 ;IF UNNORMALIZED, TYPE AS DECIMAL INTEGER FP1: MOVEI S,0 CAMGE A,FT01 JRST FP4 CAML A,FT8 AOJA S,FP4 FP1A: MOVEI W,0 FP3: MULI A,400 ASHC S,-243(A) SETZM TEM1 ;INIT 8 DIGIT COUNTER SKIPE A,S ;DON'T TYPE A LEADING 0 CALL FP7 ;PRINT INTEGER PART OF 8 DIGITS CALL TOC6 ;PRINT DECIMAL POINT MOVNI A,10 ADD A,TEM1 MOVE W1,W FP3A: MOVE T,W1 MULI T,12 CALL FP7B SKIPE,W1 AOJL A,FP3A RET FP4: MOVNI W,6 MOVEI W2,0 FP4A: ASH W2,1 XCT,FCP(S) JRST FP4B FMPR A,@FCP+1(S) IORI W2,1 FP4B: AOJN W,FP4A PUSH P,W2 ;SAVE EXPONENT PUSH P,FSGN(S) ;SAVE "E+" OR "E-" CALL FP3 ;PRINT OUT FFF.FFF PART OF NUMBER POP P,W1 ;GET "E+" OR "E-" BACK CALL TEXT POP P,A ;GET EXPONENT BACK FP7: IDIVI A,12 ;DECIMAL OUTPUT SUBROUTINE AOS,TEM1 HRLM S,(P) JUMPE A,FP7A1 CALL FP7 FP7A1: HLRZ T,(P) FP7B: ADDI T,260 JRST TOUT FCP: CAMLE A, FT0(W) CAMGE A, FT(W) Z FT0(W) ;8,9-BIT TEXT TYPERS TEXT8: SKIPA 1,[8] ;8 AND 9 BIT TYPERS DONT GUESS ABOUT TEXT9: MOVEI 1,9 ;LEFT BYTE MOVE W1,T PUSH P,[-4] JRST ALLTXT TEXTT: MOVE W1,T ;MAKE IT FOOBAR MOVEI T,"$" CALL TOUT MOVEI T,"0" TRZE W1,1 MOVEI T,"1" CALL TOUT MOVEI T,42 CALL TOUT SETZ 2, PUSH P,[-5] JRST TEXTXX TEXT: SETO 2, PUSH P,[-1000] TEXTX: TLNN W1,774000 ;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL LSH W1,35 JRST TEXTXX TEXT2: SETO 2, PUSH P,[-1000] TEXTXX: MOVEI 1,7 ;7-BIT BYTES IN W1 ALLTXT: PUSH P,1 ;TEXT IN W1. BYTESIZE IN 1 ALLTX1: MOVEI T,0 LSHC T,@0(P) SKIPN T JRST [MOVEI T,"^" CALL TOUT MOVEI T,"@" JRST .+1] CAIG T,26 JRST [SKIPE 2 JRST .+1 MOVE TT1,T MOVEI T,"^" CALL TOUT MOVEI T,"A"-1(TT1) JRST .+1] CALL TOUT AOSE -1(P) ;COUNTER JUMPN W1,ALLTX1 MOVEI T,"$" SKIPN 2 CALL TOUT POP P,1 POP P,1 RET ;STRING TYPER, ANY LENGTH ;W1 HAS BYTE POINTER TYPE: TLNN W1, -1 HRLI W1, <(POINT 7,)> EXCH W1, 1 PSOUT EXCH W1, 1 RET ;TYPE CARRIAGE RETURN CRN: MOVEI T,15 SETZM HPOS JRST TOUT ;TYPE NEW LINE CRF: CALL CRN MOVEI T,12 JRST TOUT ;TYPE LOWER CASE AND TAB, FROM PDP-1!!! LCT: CALL TSPC CALL TSPC ;TYPE SPACE TSPC: MOVEI T," " ;SPACE ;CHARACTER OUTPUT FROM AC1 TOUT: SETZM CHINP ;RESET INPUT LINE SETZM CHINC EXCH 1,T TYO EXCH 1,T AOS HPOS RET ;ALIGNMENT (MAYBE) ;IN T, THE NUMBER YOU WANT TALIGN: CAMG T,HPOS POPJ P, PUSH P,T MOVEI T," " CALL TOUT POP P,T JRST TALIGN TIN: SKIPN T,BBC ;ANY BUFFER-BACK CHARACTER? JRST TINZ ;NOPE, NORMAL PROCESSING SETZM BBC ;CLEAR THE CHARACTER RET ;AND RETURN TINZ: SKIPE STRING ; ARE WE INPUTTING FROM A STRING? JRST TINST TIN0: ;from DEC DDT 41A(313) SOSGE CHINC ;CHARACTER LEFT IN LINE BUFFER? JRST CHIN1 ;NO, GO REFILL BUFFER ILDB T,CHINP ;GET CHARACTER POPJ P, ;RETURN WITH CHARACTER IN T ;REFILL LINE BUFFER WITH EDITING CHIN1: SKIPE T1,CHINP ;REINIT LINE? JRST CHIN2 ;NO MOVEI T1,NLINBF*5 ;YES, SETUP MAX CHAR COUNT MOVEM T1,LINSPC MOVE T1,LINBP ;SETUP POINTER MOVEM T1,CHINP CHIN2: MOVEM T1,TEXTIB+.RDBKL ;SET BACKUP LIMIT SKIPG LINSPC ;ROOM LEFT IN BUFFER? JRST ERR ;NO, TOO MUCH TYPIN SETZ T1, SKIPE WAKALL ;WAKEUP ON EVERYTHING? MOVEI T1,[EXP -1,-1,-1,-1] ;YES, USE WAKEUP TABLE MOVEM T1,ETXTB PUSH P,LINSPC ;SAVE CURRENT SPACE PUSH P,CHINP ;AND POINTER XMOVEI T1,TEXTIB ;POINT TO ARG BLOCK TEXTI ;INPUT TO NEXT BREAK CHAR JRST ERR ;BAD ARGS (IMPOSSIBLE) POP P,CHINP ;RESTORE POINTER TO CHARS JUST TYPED MOVE T1,TEXTIB+.RDFLG ;GET FLAGS TLNE T1,(RD%BFE+RD%BLR) ;DELETIONS? JRST CHIN3 ;YES POP P,T1 ;RECOVER OLD SPACE COUNT SUB T1,LINSPC ;COMPUTE NUMBER CHARS JUST TYPED MOVEM T1,CHINC ;SETUP COUNT JRST TIN0 ;GO RETURN NEXT CHAR ;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE ;LINE MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN ;DELETED. CHIN3: MOVEI T1,NLINBF*5 ;COMPUTE NUMBER CHARS NOW IN LINE SUB T1,LINSPC JUMPE T1,WRONG ;JUMP IF WHOLE LINE DELETED MOVEM T1,CHINC ;LINE NOT NULL, SETUP CHAR COUNT MOVE T1,LINBP ;REINIT POINTER MOVEM T1,CHINP JRST DD2 ;CLEAR WORLD AND REDO LINE textib: 10 ;size rd%brk+rd%top+rd%pun+rd%rnd+rd%jfn+rd%bbg+rd%sui ;flags .priin,,.priout ;in/out jfn chinp: block 1 ;pointer to next char linspc: block 1 ;free space count lindb: point 7,linbf ;beginning of buffer linbp: point 7,linbf ;beginning of ^R buffer etxtb: block 1 ;wakeup table (all ones) block 1 ;backup limit pointer nlinbf==20 linbf: block nlinbf ;line buffer wakall: block 1 ;nonzero to wakeup on everything chinc: block 1 ;count of characters ttpeek: JRST ERR ;;;;; ** TEMP ** ;INPUT FROM STRING AT BPT TINST: ILDB T,STRING JUMPN T,TINST1 ;NOT END OF STRING SETZM STRING ;SAY NO MORE JRST TIN0 ;GET FROM TTY TINST1: CAIE T,33 JRST TINST2 MOVEI T,"$" CALL TOUT MOVEI T,33 RET TINST2: CALL TOUT RET ;DEPOSIT INTO MEMORY SUBROUTINE ;R HAS ADDRESS, T HAS VALUE ;LH OF R INDICATES IF IT IS INTERNAL TO DDT -- LIKE $3B, ETC. DEP: TLNE R,(DDTINT) JRST DEPINT ;DEPOSIT IN INTERNAL REGISTER TRNN R,777760 JRST DEPAC ;DEPOSIT IN AC PUSH P,R ;SAVED FOR REST OF DDT CALL UNMAP JSP TT1,CHKADR ;CHECK ADDRESS, MAP INTO UCORE JUMPE TT,DEP2 ;IF NO PAGE, OK TO STORE TLNE TT,(1B3+1B9) ;STORE OK IF WRITE OR WRITE-COPY JRST DEP2 HRRZ 1,(P) ; Try to unprotect page LSH 1,-^D9 HRL 1,FORK MOVSI 2,(PA%RD+PA%WT+PA%EX+PA%CPY) SPACS ERJMP [POP P,R ; Failed RET] PUSH P,T PUSH P,1 CALL LCT ; Inform the user POP P,T HRRZI T,(T) CALL TOC PUSH P,W1 MOVE W1,[POINT 7,[ASCIZ /$U/]] CALL TYPE POP P,W1 POP P,T MOVE R,(P) JSP TT1,CHKADR ; Try again DEP2: MOVEM T,UCORE(R) POP P,R ;USER'S ADDRESS JRST CPOPJ1 ;SKIP RETURN DEPAC: MOVEM T,AC0(R) ;DEPOSIT IN AC JRST CPOPJ1 ;SKIP RETURN DEPINT: MOVEI TT,PC CAIE TT,0(R) JRST DEPIN4 ;NOT CHANGING PC DEPIN1: HRRZ TT,PC ;GET ADDRESS PART CAIE TT,0(T) ;CHANGING TO SOMETHING DIFFERENT? SETZM BPTFLG ;YES, DONT RESUME AT CURRENT BREAKPT. CAIE TT,0(T) JRST DEPIN3 ;TURN ON USERMODE, TO GET SFORK DEPIN2: MOVSI TT,(1B5) TDNE TT,PC ;COPY USERMODE BIT FROM OLD PC WORD DEPIN3: TLO T,(1B5) MOVEM T,REALPC JRST DEPIN5 DEPIN4: MOVEI TT,USRPSI ;SEE IF TRYING TO CHANGE REQUESTS. CAIN TT,0(R) RET ;CAN'T DO THAT. DEPIN5: MOVEM T,0(R) ;STORE INTO INTERNAL REGISTER JRST CPOPJ1 ;SKIP RETURN ;FETCH FROM MEMORY SUBROUTINE ;R HAS ADDRESS. LH INDICATES INTERNAL OR NOT FETCH: TLNE R,(DDTINT) JRST FETINT ;INTERNAL REGISTER READ TRNN R,777760 ;IN AC? JRST FETAC ;YES PUSH P,R ;SAVE USER'S ADDR JSP TT1,CHKADR TLNE TT,(1B2) ;READ ACCESS? JRST .+3 ;YES POP P,R RET MOVE T,UCORE(R) ERJMP [POP P,R ; Page may not exist RET ] POP P,R ;GET USER'S ADDR BACK JRST CPOPJ1 ;SKIP RETURN ONLY FOR LEGAL ADDRESS FETAC: MOVE T,AC0(R) JRST CPOPJ1 FETINT: MOVE T,0(R) ;FROM INTERNAL REGISTER IN DDT JRST CPOPJ1 SETFRK: PUSH P,2 PUSH P,1 CALL UNMAP RFSTS TLC 1,-1 TLNN 1,-1 JRST FCHK1 CALL SETUSR POP P,FORK CALL GETUSR MOVE 1,FORK POP P,2 JRST CPOPJ1 FCHK1: POP P,1 POP P,2 RET ;CHECK USER'S ADDRESS IN R (=2) ;BRING IT INTO UCORE IF NOT ALREADY THERE CHKADR: PUSH P,1 PUSH P,3 PUSH P,2 MOVEI 1,0(R) ;DESIRED ADDRESS LSH 1,-9 ;DESIRED PAGE HRL 1,FORK ;FORM FORK,,PAGE MOVE 2,IDPACS ;ACCESS TO CURRENTLY MAPPED PAGE TLNE 2,(1B5) ;DOES NOT EXIST, OR CAME 1,LASTPG ;DIFFERENT PAGE? JRST CHKA2 ;YES ;PAGE IS ALREADY MAPPED. MAKE R HAVE AN OFFSET INTO UCORE CHKA1: POP P,R ;ORIGINAL ADDRESS REQUESTED ANDI R,777 ;CONVERT TO OFFSET INTO MAPPED PAGE HLLZ TT,IDPACS ;TT IS WHERE ACCESS INFO IS RETURNED POP P,3 POP P,1 JRST 0(TT1) ;MAP USER'S PAGE INTO NDDT'S UCORE CHKA2: CHKA3: MOVEM 1,LASTPG ;SAVE FOR NEXT TIME CHKA3A: MOVE 3,1 ;SAVE FOR CHKA3B RPACS ;GET ITS REAL ACCESS HLLM 2,IDPACS ;SAVE ACCESS TLNN 2,(1B6) ;INDIRECT? JRST CHKA3B ;NO, FOUND RMAP ; YES, CHASE DOWN THE CHAIN CAMN 1,[-1] ;INDIRECT TO NOWHERE? JRST ERR ;YES. AVOID AWFUL DEATH JUMPL 1,CHKA3A ;NO. IF TO FORK, CHASE IT. CHKA3B: MOVE 1,3 MOVEM 1,LASFPG ; SAVE FOR LATER CHKA4: MOVE 2,[400000,,UCORE/1000] ;NDDT'S FORK,,PAGE MOVSI 3,(1B2!1B3!1B4) ;R,W,X PMAP JRST CHKA1 ;UNMAP THE PAGE CURRENTLY MAPPED INTO UCORE UNMAP: PUSH P,1 PUSH P,2 PUSH P,3 SETZB 3,IDPACS ;CLEAR BIT 5, AND 3 FOR KL20 SETOB 1,LASTPG ;IMPOSSIBLE PAGE NUMBER MOVE 2,[400000,,UCORE/1000] PMAP ;AWAY! POP P,3 POP P,2 POP P,1 RET ;TABLE SAYING WHAT TO DO ABOUT EACH INSN VIS-A-VIS OPENING ITS AC ;AND MEMORY ADDRESS. EACH OP CODE HAS A 4-BIT BYTE. ;1 BIT => OPEN THE AC. ;2 BIT => OPEN THE AC UNLESS THE AC FIELD IS 0. ;4 BIT => OPEN THE MEMORY LOCATION. ;10 BIT => OPEN THE MEM LOCATION AS EXTEND OPERAND ;HANDLE AN INSTRUCTION LIKE "AND" WHICH HAS DIRECT, IMMED., MEMORY AND BOTH. DEFINE AIMB (BITS) PCPNTB: REPEAT 40,;USER UUOS: OPEN BOTH. REPEAT 40,;UUO'S MEDIATED BY SYSTEM: 50 THROUGH 77. 0 ;100 0 ;101 0 ;102 GFAD 0 ;103 GFSB 0 ;104 JSYS 0 ;105 ADJSP 0 ;106 GFMP 0 ;107 GFDV 0 ;110 DFAD 0 ;111 DFSB 0 ;112 DFMP 0 ;113 DFDV 0 ;114 DADD 0 ;115 DSUB 0 ;116 DMUL 0 ;117 DDIV 0 ;120 DMOVE 0 ;121 DMOVN 5 ;122 FIX 11 ;123 EXTEND 0 ;124 DMOVEM 0 ;125 DMOVNM 5 ;126 FIXR 5 ;127 FLTR 5 ;UFA 130 5 ;DFN 1 ;FSC 4 ;IBP 5 ;ILDB 5 ;LDB 5 ;IDPB 5 ;DPB 137 REPEAT 40,;FLOATING POINT 140-177 REPEAT 4,< ;REPEAT OVER MOVE, MOVS, MOVN, MOVM 200-217 5 ;TO AC. 1 ;IMMEDIATE 5 ;TO MEMORY. 6 ;TO SELF. > REPEAT 4,< ;REPEAT OVER IMUL, MUL, IDIV, DIV 220-237 AIMB 0 ;TO AC, IMMED, TO MEM, TO BOTH. > REPEAT 10,;SHIFTS, AND JFFO 240-247 5 ;EXCH 250 1 ;BLT 1 ;AOBJP 1 ;AOBJN 0 ;JRST 0 ;JFCL 4 ;XCT 5 ;UNUSED 0 ;PUSHJ 260 4 ;PUSH 4 ;POP 0 ;POPJ 0 ;JSR 1 ;JSP 1 ;JSA 1 ;JRA AIMB 0 ;ADD ;270 AIMB 0 ;SUB REPEAT 10,;CAI... 300-307 REPEAT 10,;CAM... 310-317 REPEAT 3,< ;REPEAT OVER JUMP,SKIP; AOJ,AOS; SOJ,SOS. 320-377 REPEAT 10,;JUMP, AOJ, SOJ. REPEAT 10,;SKIP, AOS, SOS. > 1 ;SETZ 400 1 ;SETZI 4 ;SETZM 5 ;SETZB AIMB 0 ;AND 404 AIMB 0 ;ANDCA 410 AIMB 0 ;SETM 414 AIMB 0 ;ANDCM 420 1 ;SETA 424 1 ;SETAI 5 ;SETAM 5 ;SETAB AIMB 0 ;XOR 430 AIMB 0 ;OR 434 AIMB 0 ;ANDCB 440 AIMB 0 ;EQV 444 1 ;SETCA 450 1 ;SETCAI 5 ;SETCAM 5 ;SETCAB AIMB ;ORCA 454 5 ;SETCM 460 11 ;SETCMI 4 ;SETCMM 5 ;SETCMB AIMB 0 ;ORCM 464 AIMB 0 ;ORCB 470 1 ;SETO 474 1 ;SETOI 4 ;SETOM 5 ;SETOB REPEAT 10,< ;REPEAT OVER HLL, HRL, HLLZ, ..., HRLE. 500-537 5 ;TO AC. 1 ;IMMEDIATE. 5 ;TO MEM. 6 ;TO SELF. > REPEAT 10,< ;REPEAT OVER HRR, HLR, HRRZ, ..., HLRE. 540-577 5 ;TO AC. 1 ;IMMEDIATE. 5 ;TO MEM. 6 ;TO SELF. > REPEAT 4,< ;REPEAT OVER TRN, TRZ, TRC, TRO. 600-677. REPEAT 10,;THE TR AND TL VARIANTS. REPEAT 10,;THE TD AND TS VARIANTS. > REPEAT 100,;I-O INSTRUCTIONS HAVE NO AC FIELD. ;TYPE OP CODE OF INSTR IN LWT ;OP CODE EVALUATER. TXT, TXT+1 HAVE 6 OR LESS ASCII ; CHARACTERS PACKED WITH A 7 BIT IDPB. OPEVAL: MOVEI T,0 ;EVALUATE FOR AN OP CODE IDPB T,CHP ;INSERT NULL IN TEXT FOR SYMBOL MOVEM P,SAVPDL TRZA F,OUTF OPTYPE: TRO F,OUTF ;TYPE AN OPCODE SYMBOLICALLY LSH T,-33 MOVEM T,INST ;GET OPCODE INTO RIGHT 9 BITS MOVE T,[POINT 7,TXT] MOVEM T,CHP ;FOR OPEVAL,SETUP POINTER TO INPUT TEXT TRZ F,ITF ;CLEAR INSTRUCTION TYPED FLAG CLEARB R,W1 MOVE W2,BTAB DC1: ILDB T,W2 ;GET NEXT BYTE IN TBL CAILE T,40 CAIL T,74 SOJGE R,DC1 ;SKIP OVER # BYTES = C(R) JUMPG R,DC1 ;SKIP OVER ALPHA TEXT WITHOUT COUNTING SUBI T,40 JUMPE T,DECX ;TRANSFER ON ASTOP CODE JUMPG T,DC2 DPB T,[340500,,PNTR] ;SETUP R ON A DISPATCH BYTE TRZ T,-4 AOS T DPB T,[300600,,PNTR] TRNN F,OUTF JRST DC6 ;FOR OPEVAL ONLY LDB R,PNTR ;GET # BYTES TO SKIP OVER JRST DC1 DC2: HRREI T,-33(T) JUMPL T,DECT ;TYPE OUT A LETTER jumpg t, dc3 ; Byte .ge. 74? ildb t, w2 movei t, 1000-74*2+1(t) ; Add in extension dc3: MOVEI W1,FIR.-1(T) ;BYTE IS A TRANSFER IDIVI W1,4 MOVE W2,BTAB(W2) ;CALCULATE POINTER TO NEXT BYTE ADDI W2,(W1) JRST DC1 DECT: TRNE F,OUTF JRST DC8 ;TYPE OUT A LETTER ILDB W1,CHP ;GET NEXT INPUT LETTER CAIE W1,133(T) ;COMPARE WITH ASSUMED NEXT LETTER JRST NOMAT ;DOESNT MATCH JRST DC1 ;MATCHES, TRY NEXT DECX: TRNE F,OUTF ;STOP (CODE 40) HAS BEEN SEEN RET ;IF FOR OUTPUT, RETURN ILDB W1,CHP ;GET NEXT INPUT CHAR IF ANY JUMPE W1,DC7 ;DOES # OF CHARS MATCH NOMAT: POP P,R ;NO, BACK UP AND TRY SOME MORE POP P,W2 POP P,PNTR POP P,CHP NOMAT1: AOS R ;ASSUME NEXT NUMBER FOR BIN VALUE DPB R,PNTR ;STUFF INTO ANSWER LDB R,PNTR JUMPN R,DC6AA ;IF =0, BYTE WAS TOO BIG CAME P,SAVPDL JRST NOMAT ;NOT AT TOP LEVEL JRST JSYCHK ;UNDEFINED? GO CHECK JSYS/CALLI TABLES FIRST DC6: MOVEI R,0 ;ASSUME 0 FOR INITIAL BINARY VALUE DPB R,PNTR DC6AA: CAMN P,SAVPDL JRST DC6BB LDB T,-2(P) ;OLD VALUE OF PNTR CAME T,(P) JRST NOMAT1 DC6BB: PUSH P,CHP PUSH P,PNTR PUSH P,W2 PUSH P,R JRST DC1 DC7: MOVE P,SAVPDL ;RESTORE PUSH DOWN POINTER MOVE T,INST LSH T,33 ;PUSH BINARY INTO POSITION FOR OPEVAL LDB R,[POINT 3,T,8] TLC T,700000 TLCN T,700000 DPB R,[POINT 10,T,12] ;ONLY DONE FOR IO INSTRUCTIONS JRST CPOPJ1 ;SYMBOL FOUND, SKIP RETURN DC8: TRO F,ITF ;SET INSTRUCTION TYPED FLAG MOVEI T,133(T) CALL TOUT ;OUTPUT A LETTER SETZM SPSAV ;SO $D WONT TRY TO DELETE OP CODES JRST DC1 JSYCHK: MOVSI T,-1000 ;LOOP THRU JSYS TABLE MOVE R,SYM ;GET RAD50 SYMBOL WE'RE LOOKING UP IDIVI R,50 ;STRIP TRAILING %, IF PRESENT CAIE R+1, MOVE R,SYM JUMPE R,XTNCHK CAME R,JSYTAB(T) ;COMPARE SYM WITH JSYTAB AOBJN T,.-1 ;LOOP UNTIL TABLE END JUMPGE T,XTNCHK ;NOT JSYS, GO CHECK EXTEND MNEMONICS HRLI T,(JSYS) ;WAS A JSYS, PUT OP CODE IN JRST CPOPJ1 ;SYMBOL IS DEFINED XTNCHK: MOVE R,SYM ;GET SYM BACK MOVSI T,-XTNDLN ;LOOP THRU EXTEND TABLE CAME R,XTNDMN(T) ;COMPARE SYM WITH TABLE AOBJN T,.-1 ;LOOP UNTIL TABLE END JUMPGE T,UUOCHK ;NOT EXTEND MNEMONIC, GO CHECK UUO LSH T,^D27 ;SHIFT INTO OPCODE FIELD JRST CPOPJ1 ;SYMBOL IS DEFINED UUOCHK: MOVE T,[-CLILEN-2,,-1] ;LOOK FOR CALLI MNEMONIC CAME R,CLITAB(T) ;COMPARE SYM WITH TABLE AOBJN T,.-1 ;LOOP UNTIL TABLE END JUMPGE T,TTCCHK ;NOT CALLI, CHECK TTCALL HRLI T,(CALLI) ;FOUND IT, PUT IN OP CODE JRST CPOPJ1 ;SYMBOL IS DEFINED TTCCHK: MOVSI T,-TTCLEN ;LOOP THRU TTCALL TABLE CAME R,TTCTAB(T) ;COMPARE SYM WITH TABLE AOBJN T,.-1 ;LOOP UNTIL TABLE END JUMPGE T,STRCHK ;NOT TTCALL, GO CHECK STRANGE INSTRUCTIONS LSH T,5 ;SHIFT INTO AC FIELD MOVSI T,<(TTCALL)>(T) ;PUT IN OP CODE JRST CPOPJ1 ;SYMBOL IS DEFINED STRCHK: SETZ T, ;NOT FOUND YET CAMN R,[RADIX50 0,XMOVEI] MOVSI T,(SETMI) CAMN R,[RADIX50 0,XHLLI] MOVSI T,(HLLI) JUMPN T,CPOPJ1 ;FOUND, GOOD RET ;ELSE UNDEFINED, WHEW SUBTTL CONTROL-T INTERRUPT HANDLER CT.PSI: PUSH P,TEM PUSH P,TEM1 PUSH P,SVFB PUSH P,SVTB PUSH P,SPSAV PUSH P,BLVL ADD P,[20,,20] JUMPGE P,CT.PSY MOVEM 0,-17(P) HRLI 0,1 HRRI 0,-16(P) BLT 0,0(P) CT.PS1: MOVEI 1,-1 ;CTY: RFCOC PUSH P,2 PUSH P,3 MOVE 2,TTYCC2 MOVE 3,TTYCC3 SFCOC ;SETUP TTY FOR NDDT CT.PS2: CALL CRF MOVE 1,FORK ;DO CURRENT FORK CALL FSTAT IFN gpldf,< CALL GRPLOD> ; Group lodav, if it exists CALL USED ;RETURNS DELTA CPU AND CONSOLE IN 1,2 CALL VIEW CALL CRF CT.PS9: POP P,3 POP P,2 MOVEI 1,-1 SFCOC CT.PSX: HRLI 0,-16(P) HRRI 0,1 BLT 0,17 MOVE 0,-17(P) CT.PSY: SUB P,[20,,20] POP P,BLVL POP P,SPSAV POP P,SVTB POP P,SVFB POP P,TEM1 POP P,TEM DEBRK ;DO FORK STATUS FOR FORK HANDLE IN 1 FSTAT: RFSTS IFN KL20F, HLRZ 3,1 CAIN 3,-1 JRST FSTATD PUSH P,2 ;SAVE THE PC FOR LATER FSTAT1: TRZ 3,(1B0) ;FROZEN BIT CAIN 3,6 JRST FSTAT2 CAIE 3,2 CAIN 3,3 FSTAT2: TLZ 1,(1B0) MOVE W1,[POINT 7,[ASCIZ /Interrupted from /]] TLNE 1,(1B0) CALL TYPE FSTAT3: MOVSI W1,(POINT 7,) HRR W1,[[ASCIZ /Running/] [ASCIZ /IO wait/] [ASCIZ /Halt/] [ASCIZ /Halt: /] [ASCIZ /Fork wait/] [ASCIZ /Sleep/] [ASCIZ /JSYS trap/] [ASCIZ /Address break/] [ASCIZ /TTY wait/]](3) CALL TYPE MOVE 1,WHY MOVE W1,MSG(1) CAIN 3,3 CALL TEXT2 FSTAT4: MOVE W1,[ASCIZ / at /] CALL TEXT POP P,T ;THE PC MOVEI T,0(T) ;ONLY THE PC BITS! CALL PAD RET FSTATD: MOVE W1,[POINT 7,[ASCIZ /Fork disappeared/]] CALL TYPE RET ;TYPE THE LOAD AVERAGE IFN gpldf,< GRPLOD: MOVNI 1,1 GPLD RET PUSH P,2 CALL LCT ;PRINT TAB MOVE W1,[ASCIZ / GL=/] CALL TEXT MOVEI 1,-1 POP P,2 MOVE 3,[00B1!00B3!1B4!1B6!00B8!1B11!04B17!04B23!02B29] FLOUT JFCL RET> ;TYPE TIME USED ETC SINCE LAST RESET ; RETURNS DELTA CPU TIME IN 1 AND DELTA CONSOLE TIME IN 2 USED: CALL LCT MOVE 1,FORK RUNTM ERJMP CPOPJ SUB 1,TIMUSD PUSH P,1 ;CPU PUSH P,2 ;TICK/SEC SUB 3,TIMCON PUSH P,3 ;CONSOLE USED1: MOVE W1,[ASCIZ /used /] CALL TEXT MOVE T,-2(P) MOVE TT,-1(P) CALL TIMPRT USED3: MOVE W1,[ASCIZ / in /] CALL TEXT MOVE T,0(P) MOVE TT,-1(P) CALL TIMPRT USEDX: POP P,2 SUB P,[1,,1] POP P,1 RET ;TIME PRINTER ; T: TIME TO BE PRINTED IN SECONDS ; TT: NUMBER OF TICKS PER SECOND TIMPRT: PUSH P,T PUSH P,TT IDIVI T,0(TT) ;GET SECONDS PUSH P,T+1 CALL TOC4 ;DECIMAL PRINT OF T, WITH "." TIMPR1: MOVE 1,-1(P) IDIVI 1,^D10 ;TICKS PER 1/10 TH OF A SECOND MOVE T,0(P) ;FRACTION OF SEC IN TICKS IDIVI T,0(1) ;FIND OUT HOW MANY TENTHS ADDI T,"0" ;ASCIIFICATE CALL TOUT SUB P,[3,,3] RET ;PRINT THE CELL TO BE VIEWED (SET BY ;V) VIEW: SKIPGE R,VADDR ;IS THERE ANYTHING? RET ;NO. WE ARE DONE HRRZS R CALL FETCH ;MEM(R) TO T RET ;CAN'T SO FORGET IT PUSH P,T CALL LCT ;TYPE A TAB HRRZ T,VADDR CALL PAD ;PRINT THE ADDRESS MOVEI T,"/" CALL TOUT CALL LCT ;TYPE A TAB POP P,T SETZM PINFF ;NEVER WANT LONG INSTRUCTION PRINTOUT JRST CONSYM ;TYPE AS CONSTANT OR SYMBOLIC ;READ-ONLY AREA RO: ;INTERNAL REGISTER MAP ;LH HAS POINTER TO TEXT FOR NAME ;RH HAS POINTER TO VALUE DEFINE INTDIS (X) < $'X'B+6,,$'X'B> QZ==1 RADIX 10 INTTAB: REPEAT NBP,< INTDIS \QZ QZ==QZ+1> RADIX 8 [ASCIZ /$X/],,XRG [ASCIZ /$G/],,PC [ASCIZ /$W/],,TRAPWD [ASCIZ /UUO/],,UUOL [ASCIZ /$M/],,MSK [ASCIZ /$1M/],,MSK+1 [ASCIZ /$2M/],,MSK+2 [ASCIZ /$3M/],,MSK+3 [ASCIZ /$4M/],,MSK+4 [ASCIZ /$5M/],,MSK+5 [ASCIZ /6M/],,MSK+6 [ASCIZ /7M/],,MSK+7 [ASCIZ /$I/],,USRPSI [ASCIZ /;.SYMOFS/],,SYMOFS [ASCIZ /;.PC/],,PC INTEND: INSYMB: [SIXBIT /SYMOFS/],,SYMOFS [SIXBIT /PC/],,PC INSYME: 353473426555 ;1.0E32 266434157116 ;1.0E16 FT8: 233575360400 ;1.0E8 216470400000 ;1.0E4 207620000000 ;1.0E2 204500000000 ;1.0E1 FT: 201400000000 ;1.0E0 026637304365 ;1.0E-32 113715126246 ;1.0E-16 146527461671 ;1.0E-8 163643334273 ;1.0E-4 172507534122 ;1.0E-2 FT01: 175631463146 ;1.0E-1 FT0=FT01+1 BDISP: POINT 12,DISP(R),11 POINT 12,DISP(R),23 POINT 12,DISP(R),35 DEFINE D (Z1,Z2,Z3)< IFG , IFG , IFG , _30+_14+Z3-DDT> ;THIS MACRO PACKS 3 ADDRESSES INTO ONE WORD ; EACH ADR IS 12 BITS, RELATIVE TO DDT DISP: D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,VARRW ;- - BACKSPACE(^H) D TAB,LINEF,ERR ;TAB - D CTRLL,CARR,CTRLN ;^L ^N D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,SUPTYO ;- - ^W D ERR,ERR,HALT ;- - ^Z D CONTROL,NPTCH,NPTCH2 ;ESC - - D ERR,ERR,SPACE ;- - SPACE D DIVD,TEXI,CHRI ;! " # D DOLLAR,PERC,SETBLK ;$ % & D SIXI,LPRN,RPRN ;' ( ) D MULT,PLUS,ACCF ;* + , D MINUS,PERIOD,SLASH ;- . / D NUM,NUM,NUM ;0 1 2 D NUM,NUM,NUM ;3 4 5 D NUM,NUM,NUM ;6 7 8 D NUM,TAG,SEMIC ;9 : ; D FIRARG,EQUAL,ULIM ;< = > D QUESTN,INDIRECT,ABSA ;? @ A D BPS,CON,SYMD ;B C D D EFFEC,SFLOT,GO ;E F G D HWRDS,INTRUP,JSTEP ;H I J D KILL,LOADER,MASK ;K L M D NWORD,BITO,PROCED ;N O P D QUAN,RELA,SYMBOL ;Q R S D TEXO,UNPRO,LEFT ;T U V D WORD,XEC,YSTEP ;W X Y D ZERO,OCON,ICON ;Z [ \ D OSYM,VARRW,PSYM ;] ^ _ ;SEMICOLON DISPATCH D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,ERR ;- - - D ERR,ERR,SEMSPA ;- - SPACE D ERR,TEXTYP,ERR ;! " # D ERR,ERR,ERR ;$ % & D ERR,ERR,ERR ;' ( ) D ERR,ERR,ERR ;* + , D ERR,INTSYM,ERR ;- . / D NUM,NUM,NUM ;0 1 2 D NUM,NUM,NUM ;3 4 5 D NUM,NUM,NUM ;6 7 8 D NUM,ERR,SEMIC ;9 : ; D ERR,EQUAL,ERR ;< = > D SEM.QU,INDIRECT,ADRSPC ;? @ A D PRBRK,ERR,ERR ;B C D D ESCAP,SEMI.F,ERR ;E F G D HALT,PSIST,SEMI.J ;H I J D ERR,LOADGO,MERGE ;K L M D ERR,OBTAIN,ERR ;N O P D ERR,RJCL,SNARF ;Q R S D ERR,SEMI.U,SEMI.V ;T U V D SYMSOT,ERR,YANK ;W X Y D ERR,ERR,ERR ;Z [ \ D ERR,ERR,ERR ;] ^ _ ;DESCRIPTION OF OP DECODER FOR DDT: ; ;THE ENTIRE INSTRUCTION SET FOR THE PDP-10 CAN BE COMPACTED INTO ;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL. THIS OCCURS ;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN ;FOR THE PDP-10. FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL ;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY ;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH ;BEGIN WITH 110(2). ; ;THE TABLE TBL IN DDT CONSISTS OF 9 BIT BYTES, 4 TO A WORD. ;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE: ; ;0-37(8) ; THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER. ; LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS ; EQUAL P. ; ; THE CONTENTS OF INST (INSTRUCTION) CONTAIN IN THE RIGHT ; MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION. ; P AND N REFER TO THE CONTENTS OF INST, AND THE OP DECODER ; WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS ; OF INST. N+1 IS THE NUMBER OF BITS IN INST WHICH ARE ; TO BE CONSIDERED. P GIVES THE ; POSITION (NUMBER OF BITS FROM THE RIGHT EDGE) OF THE N+1 BITS. ; ; EXAMPLE: P = 6 ; N = 2 ; ; C(INST) = .010 101 100(2) ; ; THE RESULT = D = 010(2) = 2(8) ; ; D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE. ; IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH ; PRINT TEXT, 41-72(8)) ARE SKIPPED OVER AND THE 6TH BYTE RESUMES ; THE INTERPRETATION. ; ;40(8) THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION ; IS FINISHED. ;41(8)-72(8) THE ALPHABET IS ENCODED INTO THIS RANGE. ; 41- A ; 42- B ; 72- Z ; WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING ; LETTER IS TYPED. ; ;73(8)-777(8) THIS IS A TRANSFER BYTE. IF THE BYTE IN THIS RANGE IS ; CONSIDERED TO BE A, TRANSFER INTERPRETATION ; TO THE A-73(8) BYTE IN THE TABLE. ; ;MACROS TO ASSEMBLE THE OPCODE TREE ; ;.TRA FOO CAUSES INTERPRETER TO TRANSFER TO THE POINT IN THE ; TREE TAGGED "FOO". ; ;.ADR FOO CAUSES THIS POINT IN THE TREE TO BE TAGGED "FOO". ; ;.END MARKS A LEAF (A DEEPEST POINT) IN THE TREE. ; INTERPRETATION RESUMES AT THE NEXT HIGHEST ; BRANCH. ; ;.TXT STUFF CAUSES THE TEXT "STUFF" TO BE PACKED AS ONE ASCII ; CHARACTER PER 9-BIT BYTE IN THE TREE. THE ; INTERPRETER TAKES NO ACTION IF IT ENCOUNTERS TEXT. ; ;.DIS MN WHERE M AND N ARE TWO ONE-DIGIT INTEGERS. M IS THE ; NUMBER OF BITS TO THE RIGHT OF THE FIELD OF INTEREST. ; N IS THE NUMBER OF BITS TO CONSIDER. FOR INSTANCE ; .DIS 63 WILL CONSIDER THE LEFT THREE BITS OF A 9-BIT ; OPCODE STORED IN INST. THE INTERPRETER DISPATCHES ; 0 TO 7 BYTES TO THE RIGHT DEPENDING ON THE VALUE ; OF THE SELECTED FIELD. ; ; ;WHEN USED TO LOOKUP AN OPCODE (OPEVAL), THE INTERPRETER ;OPERATES BY TYPING OUT ALL OPCODES A CHARACTER AT A TIME, ;CHECKING EACH CHARACTER FOR EQUALITY AGAINST THE KEY THAT IS ;BEING LOOKED UP. THUS, TO LOOK UP "JRST", THE INTERPRETER ;TRIES ALL TOP LEVEL BRANCHES UNTIL IT FINDS ONE WHICH WILL TYPE OUT ;A "J", AND THEN PROCEEDS TO SEE IF THE REST OF THAT BRANCH WILL ;TYPE OUT "RST". ETC. SUBTTL OP DECODER DEFINE BYT9 (A) > IF1,< DEFINE .ADR (A) < %'A== CLOC FIR.== CLOC DEFINE .ADR (B) < %'B== CLOC LASTB==CLOC+74-FIR.>> DEFINE .TRA(A) DEFINE .TRAX(A) SYN .TRA, .DIS DEFINE .TXT (A) < IFNB , >> DEFINE .END (A) < IFNB , > CLOC== CLOC+1> > ;END OF IF1 IF2,< DEFINE .ADR (A)> DEFINE .TRA (A) DEFINE .TRAX (A), IFL Z1,> DEFINE .DIS (A) DEFINE .TXT (A) , >> DEFINE .END (A) < IFNB , > OUTP 40> DEFINE OUTP (A)< IFGE -1000, IFE -^D27, IFE BINC-^D18, IFE BINC-9, IFE BINC,< BYTE (9) BINR1,BINR2,BINR3, BINC==^D36> CLOC==CLOC+1 > > TBL: .XCREF ;OPDECODER BYTE TABLE CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0 BINC== ^D36 ;INIT BYTES/WORD COUNTER ;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO ;**************TERMINATES AT THE NEXT COMMENT WITH: ************** ;; To remove UUOs from the decoder table, replace the first ;; .DIS 63,.TRA UUO with .DIS 63,.END BYT9 < .DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE .TXT H,.TRA HWT,.TXT T,.TRA ACBM ;IO INSTRUCTIONS .DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O .ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O .ADR OI,.DIS 01,.TRA O,.TRA I ;UUOS .ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60 .DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01 .TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O .ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I .ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT .ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T .ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT .ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S ;BYTE AND FLOATING INSTRUCTIONS .ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB .TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A .DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT .ADR L,.END L,.TXT,.ADR M,.END M,.TXT .ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.TRAX I100,.TRAX I110,.TRA I120,.TXT .DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N .TXT FS,.TRA C,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD .ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B ;FWT-FIXED POINT ARITH-MISC .ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV .TRA SH,.TRA H1,.TRA JP .DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT .ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22 .ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M .ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT .ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB .ADR DV,.DIS 21,.TXT I,.TRA DV1 .ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL .ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ .TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P .ADR AOB,.DIS 01,.TRA P,.TRA N .ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO .ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT .TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA .ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP .DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L .ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END .ADR S1,.DIS 21,.END,.TXT,.ADR C,.END C,.TXT ;ARITH COMP-SKIP-JUMP .ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S .ADR JS,.TXT O,.DIS 31 .TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP .ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP .DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E .ADR N,.END N,.TXT,.END G,.TXT ;HALF WORDS .ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3 .ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L .ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS ;TEST INSTRUCTIONS .ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2 .ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L .ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O .ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N ;BOOLEAN .ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST .TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ .TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR .ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB .ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB .ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB .ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA .TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB ;INSTRUCTION GROUP 120 .ADR I120,.DIS 11,.TRAX DMOV,.DIS 01,.TXT FIX,.TRAX FIX2,.DIS 21,.END EXTEND .TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R .ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N .ADR EM,.DIS 21,.END,.TRA M ;MORE UUO'S .ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END .TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T .ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S .TXT MTAP,.TRA E,.TXT UGET,.TRA F ;INSTRUCTION GROUP 110 - DF ARITHMETIC .ADR I110,.DIS 21,.TXT DF,.TRAX DF,.TXT D,.TRAX FXDP,.ADR DF,.DIS 02 .END AD,.END SB,.TXT M,.TRA P,.END DV ;KL10 FIXED POINT DOUBLE PRECISION OPERATIONS .ADR FXDP,.DIS 02,.END ADD,.END SUB,.END MUL,.END DIV ;OPCODES 100 TO 107 COME HERE .ADR I100,.DIS 03,.END,.END,.END GFAD,.END GFSB,.END JSYS,.END ADJSP .END GFMP,.END GFDV ;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT****** > IF1,< BLOCK /4> IF2,< IFN BINC-^D36,< BYTE (9) BINR1,BINR2,BINR3,0>> IFNDEF CLOC., IFN CLOC.-CLOC, .CREF ;TURN CREF BACK ON BTAB: POINT 9,TBL ;TABLE USED TO GET NEXT BYTE POINTER POINT 9,TBL,8 ;FOR TRANSFER BYTE POINT 9,TBL,17 POINT 9,TBL,26 FSGN: ASCII .E-. ASCII .E+. ;JSYS INSTRUCTIONS DEFINE DEFJS (NAME,NUM)< REPEAT NUM-<.-JSYTAB>,<0> RADIX50 0,NAME > JSYTAB: DEFJS LOGIN,1 DEFJS CRJOB,2 DEFJS LGOUT,3 DEFJS CACCT,4 DEFJS EFACT,5 DEFJS SMON,6 DEFJS TMON,7 DEFJS GETAB,10 DEFJS ERSTR,11 DEFJS GETER,12 DEFJS GJINF,13 DEFJS TIME,14 DEFJS RUNTM,15 DEFJS SYSGT,16 DEFJS GNJFN,17 DEFJS GTJFN,20 DEFJS OPENF,21 DEFJS CLOSF,22 DEFJS RLJFN,23 DEFJS GTSTS,24 DEFJS STSTS,25 DEFJS DELF,26 DEFJS SFPTR,27 DEFJS JFNS,30 DEFJS FFFFP,31 DEFJS RDDIR,32 DEFJS CPRTF,33 DEFJS CLZFF,34 DEFJS RNAMF,35 DEFJS SIZEF,36 DEFJS GACTF,37 DEFJS STDIR,40 DEFJS DIRST,41 DEFJS BKJFN,42 DEFJS RFPTR,43 DEFJS CNDIR,44 DEFJS RFBSZ,45 DEFJS SFBSZ,46 DEFJS SWJFN,47 DEFJS BIN,50 DEFJS BOUT,51 DEFJS SIN,52 DEFJS SOUT,53 DEFJS RIN,54 DEFJS ROUT,55 DEFJS PMAP,56 DEFJS RPACS,57 DEFJS SPACS,60 DEFJS RMAP,61 DEFJS SACTF,62 DEFJS GTFDB,63 DEFJS CHFDB,64 DEFJS DUMPI,65 DEFJS DUMPO,66 DEFJS DELDF,67 DEFJS ASND,70 DEFJS RELD,71 DEFJS CSYNO,72 DEFJS PBIN,73 DEFJS PBOUT,74 DEFJS PSIN,75 DEFJS PSOUT,76 DEFJS MTOPR,77 DEFJS CFIBF,100 DEFJS CFOBF,101 DEFJS SIBE,102 DEFJS SOBE,103 DEFJS DOBE,104 DEFJS GTABS,105 DEFJS STABS,106 DEFJS RFMOD,107 DEFJS SFMOD,110 DEFJS RFPOS,111 DEFJS RFCOC,112 DEFJS SFCOC,113 DEFJS STI,114 DEFJS DTACH,115 DEFJS ATACH,116 DEFJS DVCHR,117 DEFJS STDEV,120 DEFJS DEVST,121 DEFJS MOUNT,122 DEFJS DSMNT,123 DEFJS INIDR,124 DEFJS SIR,125 DEFJS EIR,126 DEFJS SKPIR,127 DEFJS DIR,130 DEFJS AIC,131 DEFJS IIC,132 DEFJS DIC,133 DEFJS RCM,134 DEFJS RWM,135 DEFJS DEBRK,136 DEFJS ATI,137 DEFJS DTI,140 DEFJS CIS,141 DEFJS SIRCM,142 DEFJS RIRCM,143 DEFJS RIR,144 DEFJS GDSTS,145 DEFJS SDSTS,146 DEFJS RESET,147 DEFJS RPCAP,150 DEFJS EPCAP,151 DEFJS CFORK,152 DEFJS KFORK,153 DEFJS FFORK,154 DEFJS RFORK,155 DEFJS RFSTS,156 DEFJS SFORK,157 DEFJS SFACS,160 DEFJS RFACS,161 DEFJS HFORK,162 DEFJS WFORK,163 DEFJS GFRKH,164 DEFJS RFRKH,165 DEFJS GFRKS,166 DEFJS DISMS,167 DEFJS HALTF,170 DEFJS GTRPW,171 DEFJS GTRPI,172 DEFJS RTIW,173 DEFJS STIW,174 DEFJS SOBF,175 DEFJS RWSET,176 DEFJS GETNM,177 DEFJS GET,200 DEFJS SFRKV,201 DEFJS SAVE,202 DEFJS SSAVE,203 DEFJS SEVEC,204 DEFJS GEVEC,205 DEFJS GPJFN,206 DEFJS SPJFN,207 DEFJS SETNM,210 DEFJS FFUFP,211 DEFJS DIBE,212 DEFJS FDFRE,213 DEFJS GDSKC,214 DEFJS LITES,215 DEFJS TLINK,216 DEFJS STPAR,217 DEFJS ODTIM,220 DEFJS IDTIM,221 DEFJS ODCNV,222 DEFJS IDCNV,223 DEFJS NOUT,224 DEFJS NIN,225 DEFJS STAD,226 DEFJS GTAD,227 DEFJS ODTNC,230 DEFJS IDTNC,231 DEFJS FLIN,232 DEFJS FLOUT,233 DEFJS DFIN,234 DEFJS DFOUT,235 DEFJS CRDIR,240 DEFJS GTDIR,241 DEFJS DSKOP,242 DEFJS SPRIW,243 DEFJS DSKAS,244 DEFJS SJPRI,245 DEFJS STO,246 DEFJS ARCF,247 DEFJS ASNDP,260 DEFJS RELDP,261 DEFJS ASNDC,262 DEFJS RELDC,263 DEFJS STRDP,264 DEFJS STPDP,265 DEFJS STSDP,266 DEFJS RDSDP,267 IFE KL20F,< DEFJS ATPTY,274 > IFN KL20F,< DEFJS GTNCP,272 DEFJS GTHST,273 DEFJS ATNVT,274> DEFJS CVSKT,275 DEFJS CVHST,276 DEFJS FLHST,277 DEFJS GCVEC,300 DEFJS SCVEC,301 DEFJS STTYP,302 DEFJS GTTYP,303 DEFJS BPT,304 DEFJS GTDAL,305 DEFJS WAIT,306 DEFJS USRIO,310 DEFJS PEEK,311 DEFJS MSFRK,312 DEFJS ESOUT,313 DEFJS SPLFK,314 DEFJS ADVIZ,315 DEFJS JOBTM,316 DEFJS DELNF,317 DEFJS SWTCH,320 DEFJS TFORK,321 DEFJS RTFRK,322 DEFJS UTFRK,323 DEFJS SCTTY,324 DEFJS CFGRP,325 DEFJS OPRFN,326 IFE KL20F,< DEFJS CGRP,327 DEFJS VACCT,330 DEFJS GDACC,331 DEFJS ATGRP,332 DEFJS GACTJ,333 DEFJS GPSGN,334 DEFJS GFACC,335 > ;IFE KL20F DEFJS SETER,336 IFE KL20F,< DEFJS ASPTY,360 DEFJS REPTY,361 DEFJS PSTI,362 DEFJS PSTO,363 DEFJS SRUBA,365 DEFJS DLON,400 DEFJS DLOFF,401 DEFJS DLPUT,402 DEFJS DLGET,403 DEFJS DLOPR,404 > ;IFE KL20F DEFJS PUPI,441 DEFJS PUPO,442 DEFJS PUPNM,443 DEFJS PUPSK,444 IFN KL20F,< DEFJS RSCAN,500 DEFJS HPTIM,501 DEFJS CRLNM,502 DEFJS INLNM,503 DEFJS LNMST,504 DEFJS RDTXT,505 DEFJS SETSN,506 DEFJS GETJI,507 DEFJS MSEND,510 DEFJS MRECV,511 DEFJS MUTIL,512 DEFJS ENQ,513 DEFJS DEQ,514 DEFJS ENQC,515 DEFJS SNOOP,516 DEFJS SPOOL,517 DEFJS ALLOC,520 DEFJS CHKAC,521 DEFJS TIMER,522 DEFJS RDTTY,523 DEFJS TEXTI,524 DEFJS UFPGS,525 DEFJS SFPOS,526 DEFJS SYERR,527 DEFJS DIAG,530 DEFJS SINR,531 DEFJS SOUTR,532 DEFJS RFTAD,533 DEFJS SFTAD,534 DEFJS TBDEL,535 DEFJS TBADD,536 DEFJS TBLUK,537 DEFJS STCMP,540 DEFJS SETJB,541 DEFJS GDVEC,542 DEFJS SDVEC,543 DEFJS COMND,544 DEFJS PRARG,545 DEFJS GACCT,546 DEFJS LPINI,547 DEFJS GFUST,550 DEFJS SFUST,551 DEFJS ACCES,552 DEFJS RCDIR,553 DEFJS RCUSR,554 DEFJS MSTR,555 DEFJS STPPN,556 DEFJS PPNST,557 DEFJS PMCTL,560 DEFJS PLOCK,561 DEFJS BOOT,562 DEFJS UTEST,563 DEFJS USAGE,564 DEFJS WILD,565 DEFJS VACCT,566 DEFJS NODE,567 DEFJS ADBRK,570 DEFJS SINM,571 DEFJS SOUTM,572 DEFJS SWTRP,573 DEFJS GETOK,574 DEFJS RCVOK,575 DEFJS GIVOK,576 DEFJS SKED,577 DEFJS MTU,600 DEFJS XRIR,601 DEFJS XSIR,602 DEFJS GTBLT,634 DEFJS VTSOP,635 DEFJS RTMOD,636 DEFJS STMOD,637 DEFJS RTCHR,640 DEFJS STCHR,641 DEFJS DBGIM,677 ;TEMPORARY JSYS DEFINITIONS DEFJS SEND,740 DEFJS RECV,741 DEFJS OPEN,742 DEFJS CLOSE,743 DEFJS SCSLV,744 DEFJS STAT,745 DEFJS CHANL,746 DEFJS ABORT,747 DEFJS SNDIM,750 DEFJS RCVIM,751 DEFJS ASNSQ,752 DEFJS RELSQ,753 DEFJS SNDIN,754 DEFJS RCVIN,755 DEFJS ASNIQ,756 DEFJS RELIQ,757 DEFJS METER,766 DEFJS SMAP,767 DEFJS THIBR,770 DEFJS TWAKE,771 DEFJS MRPAC,772 DEFJS SETPV,773 DEFJS MTALN,774 DEFJS TTMSG,775 DEFJS MDDT,777 >; IFN KL20F IFE KL20F,< DEFJS TVPIC,600 DEFJS FIFOP,601 DEFJS CNTSZ,605 DEFJS SKUSR,606 DEFJS PSTIN,611 DEFJS RAND,612 DEFJS DELCH,625 DEFJS SJPCT,626 DEFJS RJPCT,627 DEFJS IIT,630 DEFJS PARRD,631 DEFJS PARST,632 DEFJS STCHA,633 DEFJS GTSIG,730 DEFJS RLSIG,731 DEFJS WTFOR,732 DEFJS SIGNL,733 DEFJS ABORT,737 DEFJS SEND,740 DEFJS RECV,741 DEFJS OPEN,742 DEFJS CLOSE,743 DEFJS INTRP,744 DEFJS STAT,745 DEFJS CHANL,746 DEFJS FORKX,747 DEFJS SNDIM,750 DEFJS RCVIM,751 DEFJS ASNSQ,752 DEFJS RELSQ,753 DEFJS GPGC,764 DEFJS CADSK,770 DEFJS MRPAC,772 DEFJS DSKCV,774 DEFJS TTMSG,775 DEFJS EXEC,777 > ;IFE KL20F REPEAT 1000-<.-JSYTAB>,<0> JSYEND: ;EXTEND INSTRUCTION MNEMONICS DEFINE X (NAME) XTNDMN: 0 X CMPSL ;1 X CMPSE ;2 X CMPSLE ;3 X EDIT ;4 X CMPSGE ;5 X CMPSN ;6 X CMPSG ;7 X CVTDBO ;10 X CVTDBT ;11 X CVTBDO ;12 X CVTBDT ;13 X MOVSO ;14 X MOVST ;15 X MOVSLJ ;16 X MOVSRJ ;17 X XBLT ;20 X GSNGL ;21 X GDBLE ;22 X DGFIX ;23 X GFIX ;24 X DGFIXR ;25 X GFIXR ;26 X DGFLTR ;27 X GFLTR ;30 X GFSC ;31 XTNDLN==.-XTNDMN ;CALLI MNEMONICS DEFINE X (NAME) X LIGHTS CLITAB: X RESET X DDTIN X SETDDT X DDTOUT X DEVCHR X DDTGT X GETCHR X DDTRL X WAIT X CORE X EXIT X UTPCLR X DATE X LOGIN X APRENB X LOGOUT X SWITCH X REASSI X TIMER X MSTIME X GETPPN X TRPSET X TRPJEN X RUNTIM X PJOB X SLEEP X SETPOV X PEEK X GETLIN X RUN X SETUWP X REMAP X GETSEG X GETTAB X SPY X SETNAM X TMPCOR X DSKCHR X SYSSTR X JOBSTR X STRUUO X SYSPHY X FRECHN X DEVTYP X DEVSTS X DEVPPN X SEEK X RTTRP X LOCK X JOBSTS X LOCATE X WHERE X DEVNAM X CTLJOB X GOBSTR X ACTIVAT X DEACTI X HPQ X HIBER X WAKE X CHGPPN X SETUUO X DEVGEN X OTHUSR X CHKACC X DEVSIZ X DAEMON X JOBPEK X ATTACH X DAEFIN X FRCUUO X DEVLNM X PATH. X METER. X MTCHR. X JBSET. X POKE. X TRMNO. X TRMOP. X RESDV. X UNLOK. X DISK. X DVRST. X DVURS. X XTTSK. X CAL11. X MTAID. X IONDX. X CNECT. X MVHDR. X ERLST. X SENSE. X CLRST. X PIINI. X PISYS. X DEBRK. X PISAV. X PIRST. X IPCFR. X IPCFS. X IPCFQ. X PAGE. X SUSET. X COMPT. X SCHED. X ENQ. X DEQ. X ENQC. X TAPOP. X FILOP. X CAL78. X NODE. X ERRPT. X ALLOC. X PERF. X DIAG. X DVPHY. X GTNTN. X GTXTN. X ACCT. X DTE. X DEVOP. X SPPRM. X MERGE. X UTRP. X PIJBI. X SNOOP. X TSK. X KDP. X QUEUE. X RECON. X PITMR. CLILEN==.-CLITAB-1 ;TTCALL MNEMONICS TTCTAB: X INCHRW X OUTCHR X INCHRS X OUTSTR X INCHWL X INCHSL X GETLCH X SETLCH X RESCAN X CLRBFI X CLRBFO X SKPINC X SKPINL X IONEOU TTCLEN==.-TTCTAB ;LEVEL TABLE FOR INTERRUPTS FROM USER LEVTAB: IPC1 IPC2 IPC3 ;CHANNEL TABLE FOR USER INTERRUPTS CHNTAB: 2,,RUBOUT ;RUBOUT 2,,CT.PSI ;^T INTERRUPT 1,,BPTINT ; BREAKPOINT 0,,ERR 0,,ERR 0,,ERR 0,,ERR ;INTEGER OVERFLOW 0,,ERR ;FLOATING POINT OVERFLOW 0,,ERR 0,,ERR ;PUSHDOWN OVERFLOW 0,,ERR ;END OF FILE 0,,ERR ;DATA TRANSMISSION ERROR 0,,ERR ;QUOTA EXCEEDED OR DISK FULL (+++) 0,,ERR 0,,ERR 0,,ERR ;ILLEGAL INSTRUCTION 0,,ERR ;ILLEGAL MEMORY READ 0,,ERR ;ILLEGAL MEMORY WRITE 0,,ERR ;ILLEGAL MEMORY EXECUTE IFE ADBRKF,< 0,,ERR> ;SUBSIDIARY FORK TERMINATION IFN ADBRKF,< 1,,FRKTRM> 0,,ERR ;MACHINE SIZE EXCEEDED REPEAT CHNTAB+36-.,<0,,ERR> ;TRAP MESSAGE TABLE -- OFFSET BY 6, SEE TBRK MSG=.-6 ASCII /IOV:/ ;INTEGER OVERFLOW ASCII /FOV:/ ;FLOATING POINT OVERFLOW ASCII /XXX:/ ;RUBOUT (FAKE BREAK) ASCII /POV:/ ;PUSHDOWN OVERFLOW ASCII /EOF:/ ;END OF FILE ASCII /DTE:/ ;DATA TRANSMISSION ERROR ASCII /QOT:/ ;QUOTA EXCEEDED OR DISK FULL ASCII /FOO:/ ;RESERVED ASCII /FOO:/ ;RESERVED ASCII /ILL:/ ;ILLEGAL INSTRUCTION ASCII /IMR:/ ;ILLEGAL MEMORY READ ASCII /IMW:/ ;ILLEGAL MEMORY WRITE ASCII /IMX:/ ;ILLEGAL MEMORY EXECUTE (RESERVED ON KL) ASCII /FKT:/ ;SUBSIDIARY FORK TERMINATION ASCII /MSE:/ ;MACHINE SIZE EXCEEDED ASCII /FOO:/ ;RESERVED ASCII /NXP:/ ;NON-EXISTANT PAGE ASCII /ABK:/ ;ADDRESS BREAK (FAKE) ASCII /TTY:/ ;JOB WANTS THE TTY (FAKE BREAK) ASCII /HFK:/ ;FORK HALTED BY SUPERIOR OF NDDT (FAKE BREAK) LIT ;READ/WRITE/EXECUTE AREA QZQZ==<.+777>&777000 DEPHASE RELOC QZQZ-NDDT+LOW PHASE QZQZ RWX: TBLK: 0 TEM: 0 ;GENERAL TEMPORARY GDTO: 0 ;USED IN ALT-SEMI-Y GDFROM: 0 ;AND ALT-SEMI-U TXUPRW: 0 ;FOR ASCII INPUT MODE TXQUOT: 0 ;FOR ASCII INPUT MODE HPOS: 0 ;FOR ALIGNMENT SCHSAV: PIN ;TEMPORARY MODE SAVED HERE IN SUPER-TEMPORARY MODE JFNS1: ;FOR DEFAULT NAMES JFNDIR: BLOCK 10 JFNNAM: BLOCK 7 JFNS2: 0 BLOCK: 0 SVF: 0 SW1: 0 SVFB: 0 SVTB: 0 BLVL: 0 ;CURRENT BLOCK LEVEL IN SYM TAB WRD: 0 ;VALUE OF EXPRESSION TYPED WRD2: 0 ;VALUE OF EXPRESSION TO RIGHT OF $ PRNC: 0 ;PAREN COUNT NPWR10: 0 ;NEG POWER OF 10 DURING FRACTION PART OF FP NUM FRASE: 0 ;****DONT CHANGE ORDER, SEE SEARC+3*********** SYL: 0 ;NUMBER TYPED, TAKEN AS OCTAL LWT: 0 ;LAST WORD TYPED IN OR OUT TEM2: 0 FRASE1: TEM3: 0 DEN: 0 ;NUMBER TYPED, TAKEN AS DECIMAL PRGM: 0 ;0 OR POINTER TO THIS PROGRAM'S SYMBOLS ESTU: 0 ;BEGINNING OF UNDEFINED SYMBOL TABLE ESTUT: 0 FSV: 0 FH: 0 SYM: 0 ;RADIX 50 SYMBOL BEING GATHERED SPSAV: 0 ;POINTER TO LAST SYMBOL TYPED DEFV: 0 ;DEFINITION VALUE FOR SYMBOLS, FA FOR SEARCH ULIMIT: 0 ;LA FOR SEARCH, ETC. LLOC: 0 ;TEMPORARY VALUE OF . LLOCO: 0 ;VALUE OF . SAVLOC: 0 ;THE ADR OF OLD REGISTER EXAMINATION SEQUENCE PATLOC: 0 ;LOCATION ON INSTRUCTION BEING PATCHED UPON PATPNT: 0 ;"." DURING A PATCH STRING: 0 ;0 OR POINTER TO STORED COMMAND STRING BBC: 0 ;BUFFERED BACK CHARACTER CNXBPT: 0 pinff: 0 ; non-zero means print c(eff adr) and C(ac) of instruction wrprot: 0 ; Location to be monitored in single stepping wrcont: 0 ; Contents thereof stepct: 1 ; Number of single steps sstepv: -1 ; Verbose single stepping fctrln: 0 ; -1 means winning ^N, 0 means losing $y/$j $ctrln: 0 ; First word is pc of instruction block ntbpts ; Saved PC's of temp BPT's $ctins: -1 ; 1st word is 3-<# of saved locs>, rest is displaced instr's block ntbpts ssacs: block 20; User ac's before single step JCL: BLOCK 17 ENDJCL: 0 TIMUSD: 0 ;CPU TIME USED AT LAST RESET TIMCON: 0 ;CONSOLE TIME USED AT LAST RESET VADDR: -1 ;^T VIEW ADDRESS JFN: 0 ;JFN FOR PROGRAM UNDER $L,$Y IPC1: 0 ;INTERRUPT PC'S IPC2: 0 IPC3: 0 SYMPTR: 0,,HOME ;INITIAL (EMPTY) SYM. TAB. PTR. ;THE USER'S TTY STATE SAVTTY: 0 SAVTT2: 0 ;TTY CONTROL CHARACTER MODES SAVTT3: 0 USRTB2: 0 ;TTY TAB SETTINGS USRTB3: 0 USRTB4: 0 ;DDT'S TTY STATE (CHANGE TTYCC2,3 MEAN CHANGE TO LITERAL AFTER ESCAP2) CRFLAG: 0 ;NON-0 IF LAST CHR IN WAS A CR TTYCC2: IFE KL20F,< BYTE (2) 0,0,1,1,1,1,1,2,0,0,2,1,1,2,1,1,1,1 > IFN KL20F,< BYTE (2) 1,1,1,1,1,1,1,2,1,2,3,1,1,2,1,1,1,1 > TTYCC3: IFE KL20F,< BYTE (2) 1,1,0,0,1,1,1,1,1,0,1,1,1,2 > IFN KL20F,< BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1 > DDTTB2: 401002,,4010 ;NDDT'S TTY TAB SETTINGS DDTTB3: 20040,,100200 DDTTB4: 401002,,4010 TOCS: MOVEI T,.-. ;GET RIGHT HALF BACK SEAR2: JUMPE T,SEAR3 ;OR JUMPN T,SEAR3 ACCCF: MOVEI T,.-. ;LEFT HALF OF A,,B BPTFLG: 0 ;ADDR OF BPT BLK IF A $P WILL BE FROM A BPT QLPNT: 0 ;USED IN ? COMMAND AS PTR ;0 IF IT WILL BE FROM ILLINST OR RUBOUT USRFLG: -1 ;-1 WHILE USER RUNNING, >=0 IF IN DDT LASTPG: 0 ;FORK,,PAGE CURRENTLY MAPPED IN LASFPG: 0 ;CURRENTLY MAPPED OWNINGFORK,,PAGE IDPACS: 0 ;ACCESS OF MAPPED PAGE REALPC: 0 ;WHAT FORK'S PC SHOULD BE WHEN NEXT RUN ;ESCAPE CHARACTER CONTROL ESCCHR: "D"-100 ;THE ASCII CHARACTER ESCCOD: "D"-100 ; AND TERM CODE SAVCOC: 1 ;SAVED CCOC (2-BIT) FIELD COCPTR: POINT 2,TTYCC3,9;POINTER TO ABOVE FIELD ;DEFAULT VALUES FOR FILE GTJFN'S DEFALT: 0 ;OR 1B0 100,,101 0 0 0 0 ;SYMBOLS OR SAV 0 0 0 ;BLOCK FOR TEXTI TXTBLK: 4 RD%BEL!RD%RND!RD%JFN!RD%SUI .PRIIN,,.PRIOU -1,,JCL <20*5> ;INTERNAL REGISTERS ;BREAK POINTS DEFINE BPTBLK(Z.)< $'Z.'B: 0 0 0 0 0 0 ASCIZ /$'Z.'B/ 0 > RADIX 10 FRSTIR==. ;MARKS BEGINNING OF INTERNAL REGISTER LIST QZ==1 BPTS: REPEAT NBP, NBPTV==<.-BPTS>/NBP ;NUMBER OF BPT VARIABLES RADIX 8 RB: BLOCK NRBL ;RING-BUFFER OF EXAMINED ADDRESSES LRB==.-1 RBPT: RB ;RING-BUFFER POINTER: START AT HEAD OF BUFFER SYMOFS: 777 ;MAXIMUM OFFSET FROM SYMBOL TO PRINT TRAPWD: 0 ;TRAP STATUS WORD WDATA: 0 ;WRITE DATA DURNING INSTR TRAP XRG: 20 ;LOCATION WHERE $X IS DONE PC: 0 ;INDICATED USER'S PC CURMSK: 0 ;THE MASK USED FOR A PARTICULAR SEARCH UUOL: 0 MSK: -1,,-1 ;MASK FOR SEARCHES 0,,-1 ;AND OTHERS.... -1,,0 740,,0 17,,0 -1000,,0 -1 ;LAST TWO ARE USER DEFINED... -1 USRPSI: 0 0 0 0 0 0 0 0 FORK: -1 ;FORK HANDLE OF CURRENT USER FORK SUBSYS: 'NDDT' ;SUBSYSTEM NAME FOR USER TPFORK: -1 ; FORK HANDLE OF TOP FORK OF USER LASTIR==. ;MARKS END OF INTERNAL REGISTERS BINSTR: 0 ;INSTR. TO INTERPRET WHEN PROCEEDING WHY: 0 ;WHY NDDT ENTERED, RH OF FORK STATUS ;USER'S ACCUMULATORS, WHILE IN DDT AC0: BLOCK 20 ;PERMANENT CONTROL SWITCHES (AC'S 10,11,12 ARE TEMP EQUIV'S) SCHM: PIN ;DO NOT CHANGE ORDER ARM: PADSO ODFM: 10 TEM1: 0 SVBTS: 0 SVBTS2: 0 SVBT3: 0 SVBT2: 0 PNTR: EXP INST ;POINTER TO BITS IN INST INST: 0 ;BINARY FOR INSTRUCTION CHP: 0 ;CHAR POINTER INTO TXT, TXT+1 TXT: BLOCK 2 ;STORE INPUT TEXT FOR OPEVAL SAVPDL: 0 ;PDL PTR SAVED DURING OPEVAL LITS: LIT VAR PS: IOWD LPDL,.+1 BLOCK LPDL PCSPTR: 0 ;OLD PC STACK POINTER PCSTAK: IOWD PCSL,.+1 BLOCK PCSL PATCHS:PAT: ;PATCH SPACE QZQZ==<.+777>&777000 DEPHASE RELOC QZQZ-DDT+LOW PHASE QZQZ ;WINDOW INTO USER'S CORE UCORE: BLOCK 1000 DDTEND: DEPHASE ; LOCAL MODES: ; MODE: MIDAS ; END: END BLAST