Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/iddt.mac
There is 1 other file named iddt.mac in the archive. Click here to see a list.
; <GERGELY.NEMACS>NDDT.MAC.10, 19-Feb-82 09:27:48, Edit by GERGELY
; Increase the breakpoints and fix the blank screen to work at DREA
;<SOURCES>NDDT.MAC;6 19-Mar-81 14:39:03, Edit by MMCM
;FIX TENEX ASSEMBLY
;<SYS.UNSUPPORTED>NDDT.MAC.180, 1-Nov-80 18:32:00, Edit by TAA
; Update JSYS table
;<SYS.UNSUPPORTED>NDDT.MAC.179, 24-Sep-80 21:00:32, Edit by MT
; If error string not found for ;?, say so and show number
;<SYS.UNSUPPORTED>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)
;<SOURCES.UNSUPPORTED>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
;<SOURCES.UNSUPPORTED>NDDT.MAC.173, 15-Apr-80 00:33:35, Edit by MT
; Fondle TIW
;<SOURCES.UNSUPPORTED>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
;<SOURCES.UNSUPPORTED>NDDT.MAC.170, 14-Apr-80 16:22:36, Edit by MT
; Made ;R work
;<SOURCES.UNSUPPORTED>NDDT.MAC.169, 9-Apr-80 14:08:45, Edit by MT
; Leave LH(1) 0 in RFSTS calls for Rel4
;<SOURCES.UNSUPPORTED>NDDT.MAC.168, 8-Apr-80 17:31:40, Edit by MT
; Don't SETNM to weird things
;<SOURCES.UNSUPPORTED>NDDT.MAC.167, 10-Mar-80 17:28:40, Edit by MT
; Updated JSYS table
;<SOURCES.UNSUPPORTED>NDDT.MAC.166, 9-Mar-80 20:15:12, Edit by MT
; Don't lose when opening cells in nonexistant pages
;<SOURCES.UNSUPPORTED>NDDT.MAC.165, 7-Mar-80 03:14:36, Edit by MT
; Don't lose in ;J if JFN is unassigned
;<SOURCES.UNSUPPORTED>NDDT.MAC.164, 5-Mar-80 16:36:12, Edit by MT
; take care of <arg>^[ and altmoded equivalents
;<SOURCES.UNSUPPORTED>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
;<HIC>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
;<MMCM>IDDT.MAC.35, 19-Apr-78 22:57:40, Edit by MMCM
; Fix up CR after LF lossage for rel 3
;<MMCM>IDDT.MAC.34, 27-Dec-77 23:19:23, Edit by MMCM
; Added address break command ($$U) and related trap stuff
;<MMCM>IDDT.MAC.33, 14-Aug-77 22:11:13, Edit by MMCM
; Changes for Tops20 Jsys traps calling sequence
;<MMCM>IDDT.MAC.32, 19-Mar-77 06:51:30, Edit by MMCM
; Fixed multiple single stepping aobjn's
; Fixed ;;U and tag: incompatibility
;<MMCM>IDDT.MAC.30, 7-Mar-77 01:25:48, Edit by MMCM
; Changed to use Tops20 editting conventions
;<MMCM>IDDT.MAC.29, 26-Feb-77 01:15:03, Edit by MMCM
; Added KL opcodes
;<MMCM>IDDT.MAC.28, 15-Feb-77 15:39:35, Edit by MMCM
; Added tops20 jsys's and fixed up single stepping after breakpoint.
;<MMCM>IDDT.MAC;109 8-Jan-77 21:05:30 EDIT BY MMCM
; Added $Y single stepping
;<MMCM>IDDT.MAC;108 7-Jan-77 02:47:02 EDIT BY MMCM
; Added $J single stepping, fancy editting (delch);
; Made levtab, etc. typeout symbolic
;<MMCM>IDDT.MAC;108 6-Jan-77 00:53:23 EDIT BY MMCM
; Added various isi bug fixes and ;;jobstat and ;interrupt status
;<SOURCES>IDDT.MAC;46 1-Dec-76 13:59:29 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;45 1-Dec-76 12:11:24 EDIT BY PLUMMER
;<SOURCES>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.
;<SOURCES>IDDT.MAC;43 8-Nov-76 17:59:38 EDIT BY PLUMMER
; FIX UP / SO / AFER EXAMINE OF CELL WITH 1B5 ON WORKS
;<SOURCES>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
;<SOURCES>IDDT.MAC;41 6-Jul-76 11:57:23 EDIT BY PLUMMER
; FIX PRFRK TO SAVE W OVER CALLS TO FSTAT
;<SOURCES>IDDT.MAC;38 16-Jun-76 12:03:58 EDIT BY PLUMMER
; TURN ON FORKSTAT CODE
;<SOURCES>IDDT.MAC;35 11-Jun-76 16:00:12 EDIT BY PLUMMER
;<SOURCES>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
;<SOURCES>IDDT.MAC;33 10-Jun-76 14:44:53 EDIT BY PLUMMER
; FIX UP FORKSTAT
;<SOURCES>IDDT.MAC;32 9-Jun-76 14:37:04 EDIT BY PLUMMER
;<PLUMMER>IDDT.MAC;23 9-Jun-76 14:01:44 EDIT BY PLUMMER
; REVISE THE HFK: CASE AGAIN
;<PLUMMER>IDDT.MAC;22 9-Jun-76 12:57:37 EDIT BY PLUMMER
; INIT MAIN STACK AT SPLICD ENTRY SO THAT CALL SETTRP WILL WORK
;<PLUMMER>IDDT.MAC;21 9-Jun-76 11:51:22 EDIT BY PLUMMER
;<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
;<PLUMMER>IDDT.MAC;17 4-Jun-76 12:13:15 EDIT BY PLUMMER
; FIX UUO INTERPRETER, ADD INTERPRETER FOR USER JSYS'S
;<PLUMMER>IDDT.MAC;16 3-Jun-76 23:38:52 EDIT BY PLUMMER
; CHANGE SEQUENCE SAVING LOGIC IN SLASH
;<PLUMMER>IDDT.MAC;12 3-Jun-76 13:45:04 EDIT BY PLUMMER
; NEWFRK: MOVE FFORK AFTER CALL SETTRP TIL JSYS TRAP BUG FIXED
;<PLUMMER>IDDT.MAC;11 3-Jun-76 10:24:11 EDIT BY PLUMMER
; SOUP IN ALL OF TOMLINSON'S MULTI-FORK CODE
;<PLUMMER>IDDT.MAC;7 2-Jun-76 14:56:59 EDIT BY PLUMMER
; ;JFN STATUS COMMAND
;<PLUMMER>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
; <PAGE>;A COMMAND
; FIX INTERPRETATION OF PUSHJ AND POV
; USE DEBRK .+1 RATHER THAN CIS AT ENTRIES
; FIX THE HANDLING OF INTERRUPTS FROM HALTED FORKS
;<SOURCES>IDDT.MAC;31 1-APR-74 16:06:45 EDIT BY PLUMMER
; FIX THE ^T "RUNNING AT ?" BUG
;<SOURCES>IDDT.MAC;30 21-MAR-74 12:36:28 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;29 20-MAR-74 13:12:54 EDIT BY PLUMMER
; ADD "LOCKED BY USER" TYPEOUT TO ;A
;<SOURCES>IDDT.MAC;28 20-MAR-74 12:37:50 EDIT BY PLUMMER
;<SOURCES>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
;<SOURCES>IDDT.MAC;22 12-MAR-74 00:30:11 EDIT BY PLUMMER
; $$Z FIXED (AGAIN)
; $P AFTER HALTF, HFORK CONTINUES PROGRAM (AGAIN)
;<SOURCES>IDDT.MAC;21 11-MAR-74 23:59:16 EDIT BY PLUMMER
;? COMMAND
; FIX ;M
; ADD VERSION NUMBER STUFF
;<SOURCES>IDDT.MAC;17 23-AUG-73 10:58:55 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;16 23-AUG-73 01:23:56 EDIT BY PLUMMER
;<SOURCES>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
;<SOURCES>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"
;<SOURCES>IDDT.MAC;12 3-JUN-73 20:39:35 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;11 1-JUN-73 00:04:40 EDIT BY PLUMMER
; FIX FLSSYM -- HRL'S SHOULD HAVE BEEN HRLI'S
;<SOURCES>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
;<SOURCES>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
;<SOURCES>IDDT.MAC;8 11-APR-73 15:35:39 EDIT BY PLUMMER
; FIX $$B
; FIX AUTO PROCEED SO THAT IT SEES INTERRUPTS
;<SOURCES>IDDT.MAC;7 10-APR-73 22:30:19 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;6 10-APR-73 13:38:34 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;5 4-APR-73 01:09:59 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;4 4-APR-73 00:23:33 EDIT BY PLUMMER
;<SOURCES>IDDT.MAC;3 4-APR-73 00:10:12 EDIT BY PLUMMER
; CLEANUP START/REENTER/SPLICD ENTRIES
;<SOURCES>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
;<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)
;<PLUMMER>IDDT.MAC;13 13-SEP-72 13:39:40 EDIT BY PLUMMER
; OPCODE TABLE EXPLAINATION CLEANED UP
; OLD TABLE DISCARDED
;<PLUMMER>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
;<PLUMMER>IDDT.MAC;8 12-SEP-72 17:47:54 EDIT BY PLUMMER
; SYMBOL FILE COMMAND
;<PLUMMER>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
;<PLUMMER>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
SEARCH CPUNUM,MONSYM,MACSYM ; [PJG] PUT THE SEARCHES TOGETHER
HOME==740000 ;WHERE NDDT LIVES
BLAST: MOVEI 4,770-<HOME/1000>
MOVE 2,[400000,,<HOME/1000>-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
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,,<HOME/1000>-1 ;16
LIT
;DEFINE ACCUMULATORS
F=0 ;FLAGS
R=<A==2> ;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,<MIT==1> ;ASSUME FOR MIT
IFN DELCHF,<IFNDEF DELCH,<OPDEF DELCH [JSYS 625]>>
;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==20 ;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
;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,[-<HOME/1000>,,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: MOVNI 1,5
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,<BPTS+<NBP*NBPTV>>
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,<<XCT 0>/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: 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
MOVE T,[POINT 7,STRBUF-1,34]
MOVEM T,STRIP
MOVEM T,STROP ;INIT ATOM BUFFER POINTERS
;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: 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: PUSH P,2
MOVEI 1,100
RFMOD
IORI 2,17B23 ;WAKEUP ON EVERYTHING
SFMOD
POP P,2
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
;<SYM>$K -- KILL SYMBOL FOR OUTPUT
;<SYM>$$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<B:
TAG: TLNN F,LTF ; NO LETTERS IS ERROR
JRST ERR ; GO SAY ERROR
TLNE F,FAF ; DEFINE SYMBOLS
JRST tag0 ;A<B:
TLNE F,CF ;$ TYPED?
JRST SETNAM ;<PROGRAM>$:
MOVE W,LLOCO ;<TAG>: 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
;<PROGRAM>$: 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
CAIE 1,15 ; OK ON CRLF
CAIN 1,12
CAIA
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 /<SUBSYS>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
MOVNI 1,5
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.==<BPT>&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
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: TYI
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,[1B0!17B10!1B13!3B29] ;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,STRBUF ;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,STRBUF]
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
> ;<LF><CR> 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
TLNN F,CF ;$CR CHANGES SEQUENCE
JRST DD1.5
TLNE F,CCF ;DOUBLE ALTMODE?
JRST DD1.5 ;YES, THAT IS ALL WE WANT TO DO
CALL PTRB ;ELSE POP THE RING BUFFER
SETZM PINFF ;NO LONG INSTRUCTION PRINT
PBIN ;READ THE NEXT CHARACTER
CAIE 1,12 ;IF <LF> THEN FLUSH IT
MOVEM 1,BBC ;ELSE BUFFER IT
JRST LI1 ;PRINT THE LOCATION AND GO ON
; [ 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 <CR> 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 <ESC> 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 <ESC>?
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 $<N>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
MOVE 1,BLNKTB(2) ; [PJG] Get the right magic
TLOE 1,-1 ; [PJG] More than 5 chars?
HRROI 1,BLNKTB(2) ; [PJG] No, then use immediate
PSOUT
MOVEI 1,.PRIOU
POP P,2
SFMOD
JRST DD1.5
DEFINE CLRASCII <BYTE (7) .CHESC,"H",.CHESC,"J",0>;ASCII screen clear
DEFINE CLRANSI <[BYTE (7) .CHESC,"[","H",.CHESC,"[","J",0]> ;ANSI standard
BLNKTB:
REPEAT 4, <BYTE (7) 15,12,0> ; 0-3
IFE DREASW,<
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,<BYTE (7) 15,12,0> ; 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,<BYTE (7) 15,12,0> ; ETC
>
IFN DREASW,<
BYTE (7) .CHCNZ,0 ; [PJG] 4 ADM-3
BYTE (7) .CHCRB,.CHCUN,.CHCUN,0 ; [PJG] 5 Datamedia 2500
CLRANSI ; [PJG] 6 VT132 in native mode
BYTE (7) .CHESC,"?",.CHESC,.CHCNC,0 ; [PJG] 7 Concept 100
REPEAT 2,<BYTE (7) 15,12,0> ; [PJG] 8-9
BYTE (7) .CHCRB,.CHCUN,.CHCUN,.CHCUN,0 ; 10 VT05
CLRASCII ; [PJG] 11 VT50
BYTE (7) 15,12,0 ; [PJG] 12 LA30
BYTE (7) .CHCRB,.CHCUN,0 ; [PJG] 13 GT40
BYTE (7) 15,12,0 ; [PJG] 14 LA36
CLRASCII ; [PJG] 15 VT52
CLRANSI ; [PJG] 16 VT100
REPEAT 2,<BYTE (7) 15,12,0> ; 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 <esc> 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 <CR><LF>
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 <CR>
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 li1 ; Print out instruction
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 <CR>, 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
; $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 <INSTR> 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,(<ASCIZ />/>) ;TYPE > FOR COND BREAK
SKIPG 2(T) ;TEST PROCEED COUNTER
MOVSI W1,(<ASCIZ />>/>);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,(<POINT 7,0>)
MOVEM T,STRING
JRST RETX
;<NUM>$P -- PROCEED THROUGH THIS BPT NUM TIMES
;<NUM> 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 $<N>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,<XCT>/1B8
CAIN W1,<PUSHJ>/1B8
JRST IXCT1 ;CALCULATE EA AND INTERPRET
CAIE W1,<JSR>/1B8
CAIN W1,<JSA>/1B8
JRST IXCT1
CAIE W1,<JSYS>/1B8
CAIN W1,<JSP>/1B8
JRST IXCT1
TRNN W1,700
JRST IUUO
TRNN F,YSTEPF ;SINGLE STEPPING?
JRST PROC2 ; NO, ENUF INTERPRETATION
CAIE W1,<POPJ>/1B8
CAIN W1,<JRA>/1B8
JRST IXCT1
CAIE W1,<AOBJN>/1B8
CAIN W1,<AOBJP>/1B8
JRST IXCT1
CAIE W1,<JFFO>/1B8
CAIN W1,<JRST>/1B8
JRST IXCT1
ANDI W1,770 ; REMOVE LOW 3 BITS OF OPCODE
CAIE W1,<AOJ>/1B8 ; AOJ-SOMETHING
CAIN W1,<SOJ>/1B8
JRST IXCT1
CAIN W1,<JUMP>/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,<PUSHJ>/1B8
JRST IPUSHJ
CAIN W1,<JSR>/1B8
JRST IJSR
CAIN W1,<JSA>/1B8
JRST IJSA
CAIN W1,<JSP>/1B8
JRST IJSP
HRRZ R,BINSTR
CAIN W1,<JSYS>/1B8
JRST IJSYS
CAIN W1,<XCT>/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, <popj>/1b8
jrst ipopj
cain w1, <jra>/1b8
jrst ijra
caie w1, <aobjn>/1b8
cain w1, <aobjp>/1b8
caia
cain w1, <jffo>/1b8
jrst [push p, w1
jrst ijumps]
cain w1, <jrst>/1b8
jrst ijrst
push p, w1
andi w1, 770
caie w1, <aoj>/1b8
cain w1, <soj>/1b8
jrst ijumps
cain w1, <jump>/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, <jffo>/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,<BPTS+<NBP*NBPTV>>
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,<BPTS+<NBP*NBPTV>-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 <A>$<N>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,<BPTS+<NBP*NBPTV>>
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,<BPTS+<NBP*NBPTV>>
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,<BPTS+<NBP*NBPTV>>
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,<BPTS+<NBP*NBPTV>>
JRST PRBRKL
JRST DD1
;UNPROTECT PAGES IN USER'S FORK
;A<B$NU ;GIVES PROTECTION N TO PAGES A THRU B
;A$NU ;GIVES PROTECTION M TO PAGE A
;$NU ;GIVES PROTECTION N TO THE CURRENT PAGE
;4-BIT OF N MEANS READ ACCESS
;2-BIT OF N MEANS WRITE ACCESS
;1-BIT OF N MEANS EXECUTE ACCESS
;N ASSUMED TO BE 7 IF NOT SPECIFIED
UNPRO: TLNE F,CCF
IFE ADBRKF,< JRST ERR>
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
;<LOC>$$<N>U SET ADDRESS BREAK WITH MASK N FOR LOCATION <LOC>
;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
; <JFN>;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 ;<JFN>;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 ;<PAGE>;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
;<PAGE>;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 <NTBPTS+1>*2,<PUSH P,$CTRLN+.RPCNT
.RPCNT==.RPCNT+1>
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 <NTBPTS+1>*2,<POP P,$CTRLN+<<NTBPTS+1>*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
HRLM 1,4 ;SAVE DIRECTORY LOGGED IN
MOVEI 1,101
MOVE 2,3 ;GET TSS JOB NUMBER
HRRZI 3,^D10
NOUT ;PRINT IT OUT
MOVEI W1,[ASCIZ/, user /]
CALL TYPE
HLRZ 2,4 ;GET DIRECTORY NUMBER
DIRST ;PRINT IT OUT
JFCL
MOVEI T,","
CALL TOUT
CALL TSPC ;TYPE A SPACE
HRRE 2,4 ;GET THE DEVICE
DEVST ;PRINT THE TTY NUMBER
SKIPA W1,[[ASCIZ/det/]] ;PRINT OUT DET
TRNA ;SKIP
CALL TYPE ;TYPE IT OUT
CALL CRF ;FOLLOWED BY CARRIAGE RETURN
;TYPE FORK STRUCTURE
MOVEI 1,400000 ;SAY START AT SELF
IFN KL20F,<jrst frkst2>
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,<JSYS>/1B8
JRST JSTYPE ;TYPE JSYS INSTRUCTION
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
CAIL W,240
CAILE W,247
JRST PI8A ;ALL (EXCEPT ASH,ROT,LSH) HAVE SYMB. ADRS
CAIN W,<JFFO>_-33
JRST PI8 ;JFFO AND @ GET SYMBOLIC ADDRESSES
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: MOVEI T,100
MOVEM T,TEM1 ;SET MAX @ COUNTER
MOVE T,LWT
JSTYP0: LDB W1,[POINT 4,T,17] ;GET XR
CAIE W1,0 ;NONE?
MOVE W1,AC0(W1) ;NO. GET THE XR
ADD W1,T ;ADD IN XR
TLNN T,(@)
JRST JSTYP1 ;NO INDIRECT TO WORRY ABOUT
HRRZ R,W1
SOSL TEM1
CALL FETCH ;GET MEM(R) TO T
JRST ERR ;CANNOT GET IT
JRST JSTYP0
JSTYP1: HRRZM W1,TEM1 ;SAVE EFFECTIVE ADDRESS
HRRZ T,W1
HRLI T,(JSYS) ;CONSTRUCT A JSYS
CALL LOOK ;LOOK UP IN SYMTAB
RET ;FOUND, EXIT FROM PIN
HRRZ TT,TEM1 ;JSYS NUMBER
MOVE T,TT
IDIVI TT,<JSYEND-JSYTAB>/2
ASH TT1,1
MOVE TT3,TT1 ;END CHECK
MOVEI TT2,2
HRRZ W1,JSYTAB+1(TT1)
CAMG T,W1 ;SEARCH FORWARD ?
MOVNS TT2 ;NO.
PJSN: ADD TT1,TT2 ;MOVE TO NEXT ENTRY
SKIPGE TT1 ;OFF BOTTOM
MOVEI TT1,JSYEND-2-JSYTAB ;YES, RING TO TOP
CAIL TT1,JSYEND-JSYTAB ;AT TOP?
MOVEI TT1,0 ;YES, RING TO BOTTOM
HRRZ W1,JSYTAB+1(TT1)
CAMN T,W1
JRST PRJSY ;FOUND
CAME TT1,TT3 ;DONE ALL?
JRST PJSN ;NO
JRST PIN0 ;CAN'T PRINT AS KNOWN JSYS
PRJSY: MOVE W1,JSYTAB(TT1)
CALL TEXT2 ;PRINT NAME, EXIT FROM PIN
JRST LCT
; $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,(<JUMPE T,0>-<JUMPN T,0>)
; $N -- WORD NON-EQUALTIY SEARCH (R IS 0)
NWORD: ADDI R,(<JUMPN T,0>)
HRLM R,SEAR2
MOVEI TT1,MSK ;LOOK AT MASK
TRNE F,Q2F
ADD TT1,WRD2 ;BUT IF $<N>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 <ALT><NUM><QUOTE>FOOBAR<ALT>
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: 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: TDNE F,[CF,,SEMIF] ;NEED TO SEE EACH CHR AS IT COMES IN?
JRST TIN6 ;YES
MOVE T,STRIP ;IN PTR
CAME T,STROP ;OUT PTR
JRST TIN4 ;NON-EMPTY BUFFER
TIN1: MOVE T,[POINT 7,STRBUF-1,34]
MOVEM T,STRIP
MOVEM T,STROP
IFE KL20F,<
TIN2: CALL GETC
CAIE T,177
CAIN T,"A"-100
JRST TINCA ;^A
CAIN T,"V"-100
CALL TINCV ;^V
IDPB T,STRIP ;STORE IT IN BUF
MOVE T,STRIP
CAMN T,[POINT 7,STRBUF+STRBFL-1,34]
JRST ERR ;BUFFER FULL
TIN3: LDB T,STRIP ;GET BACK THE CHR
CAIL T,"A"
CAILE T,"Z"
CAIA
JRST TIN2 ;UPPERCASE LETTER, KEEP GOING
CAIL T,"A"+40
CAILE T,"Z"+40
CAIA
JRST TIN2 ;LOWERCASE LETTER
CAIL T,"0"
CAILE T,"9"
CAIA
JRST TIN2
TIN4: ILDB T,STROP ;RETURN NEXT CHR FROM BUFFER
TIN5: CAIN T,37 ;TENEX EOL CHARACTER
MOVEI T,15 ;EOL BECOMES CR ON WAY OUT
RET
TIN6: CALL GETC
JRST TIN5
;CONTROL V (QUOTE NEXT CHARACTER)
TINCV: TYI ;CHARACTER INTO 1
MOVE T,1
CAIE T,33
RET
MOVEI T,"$"
CALL TOUT ;ECHO $ FOR ALTMODE
MOVEI T,33
RET
;CONTROL A (DELETE PREVIOUS CHARACTER)
TINCA: MOVE T,STRIP
CAMN T,STROP
JRST WRONG ;BUFFER EMPTY
TINCA0:
IFN DELCHF,<
MOVEI 1, 101
DELCH
JRST .+4
JRST .+3
JRST TINCA2
JFCL
>
TINCA1: MOVEI T,"\"
CALL TOUT
LDB T,STRIP
CALL TOUT
TINCA2: SOS STRIP ;UNDEX BYTE PTR
REPEAT 4,<IBP STRIP>
JRST TIN2
> ; Kl20f
IFN KL20F,<
movem t, textib+.rddbp ; Set up byte pointer
movei t, strbfl*5 ; Buffer length
movem t, textib+.rddbc ; Set up count
tin2: movei 1, textib
texti ; Get the poop
jrst err ; Lossage
move t, textib+.rddbp ; Get updated pointer
camn t, [point 7, strbuf-1, 34]
jrst wrong ; Nothing new
ldb 1, t ; Get char that made it wake up
camn 1, escchr ; User's escape?
jrst wrong ; Yes
movem t, strip ; Update pointer
caie 1, 33 ; ESC?
jrst tin4 ; Nope
movei t, "$"
call tout ; Echo as $
tin4: ildb t, strop ; Get first char
ret
tin6: jrst getc ; Get char
textib: 7
rd%rnd!rd%jfn!rd%sui
.priin,,.priout
point 7, strbuf
strbfl*5
0
0
textim
; Break character set for texti
textim: -1 ; All controls
747764,,001760 ; Not on $,%,. or 0-9
400000,,000760 ; No letters
400000,,000760 ; Or lowercase letters
> ; KL20F
ttpeek: move t, strop ; opt buffer pointer
camn t, strip ; Buffer empty?
tdza t, t ; Return 0
ildb t, t ; Else get char
ret
;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
CALL TOUT ;SAY WHAT WE READ
JRST GOTC
;GET CHARACTER AND CHECK FOR ESCAPE CHR
GETC: TYI ;INPUT MAY BE FROM FILE (REDIRECT)
MOVE T,1
GOTC: CAIE T,33
JRST GETC2
MOVEI T,"$"
CALL TOUT
MOVEI T,33
GETC2: CAIE T,"U"-100
CAMN T,ESCCHR
JRST WRONG
SKIPE CRFLAG ;WAS LAST CHAR A CR?
CAIE T,12 ;AND THIS ONE AN LF?
JRST GETC3 ;NO.
SETZM CRFLAG ;YES. FORGET ABOUT THE PAIR
JRST GETC ;AND TRY AGAIN.
GETC3: SETZM CRFLAG
CAIN T,15
SETOM CRFLAG
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.
;HANDLE AN INSTRUCTION LIKE "AND" WHICH HAS DIRECT, IMMED., MEMORY AND BOTH.
DEFINE AIMB (BITS)<EXP 5, 1+BITS, 5, 5>
PCPNTB:
REPEAT 40,<EXP 0>;USER UUOS: OPEN BOTH.
REPEAT 40,<EXP 0>;UUO'S MEDIATED BY SYSTEM: 50 THROUGH 77.
REPEAT 4,<EXP 0>
0 ;104 JSYS
REPEAT 23,<EXP 5>;104-127 UNUSED.
5 ;UFA 130
5 ;DFN
1 ;FSC
4 ;IBP
5 ;ILDB
5 ;LDB
5 ;IDPB
5 ;DPB 137
REPEAT 40,<EXP 5>;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,<EXP 1>;SHIFTS, AND JFFO 240-247
5 ;EXCH 250
1 ;BLT
1 ;AOBJP
1 ;AOBJN
0 ;JRST
0 ;JFCL
4 ;XCT
5 ;UNUSED
0 ;PUSHJ 260
4 ;PUSH
4 ;POP
0 ;POPJ
0 ;JSR
1 ;JSP
1 ;JSA
1 ;JRA
AIMB 0 ;ADD ;270
AIMB 0 ;SUB
REPEAT 10,<EXP 1>;CAI... 300-307
REPEAT 10,<EXP 5>;CAM... 310-317
REPEAT 3,< ;REPEAT OVER JUMP,SKIP; AOJ,AOS; SOJ,SOS. 320-377
REPEAT 10,<EXP 1>;JUMP, AOJ, SOJ.
REPEAT 10,<EXP 6>;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,<EXP 1>;THE TR AND TL VARIANTS.
REPEAT 10,<EXP 5>;THE TD AND TS VARIANTS.
>
REPEAT 100,<EXP 4>;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. JSYS TABLE HAS SAME
; FORMAT WITH THE JSYS NUMBER IN THE RIGHT 9 BITS OF THE 2ND WORD.
OPEVAL: MOVE S,[<JSYTAB-JSYEND>,,0]
OPTRY: MOVE T,JSYTAB+0(S) ;FIRST WORD OF THIS ENTRY
HLLZ TT,JSYTAB+1(S) ;SECOND
CAMN T,TXT
CAME TT,TXT+1
JRST OPENXT
HRRZ T,JSYTAB+1(S) ;FOUND. GET NUMBER
HRLI T,(JSYS 0) ;MAKE INTO JSYS
JRST CPOPJ1 ;SKIP RETURN
OPENXT: AOBJP S,.+1
AOBJN S,OPTRY ;TRY NEXT ENTRY IN JSYSTABLE
OLDOEV: MOVEI T,0 ;NOT A JSYS SO DO USUAL OP EVAL
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
RET ;UNDEFINED, FINALLY
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
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,<erjmp fstatd>
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
MOVNI 1,5
RUNTM
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 <Z1-DDT-7777>,<PRINTX Z1 TOO FAR FROM DDT>
IFG <Z2-DDT-7777>,<PRINTX Z2 TOO FAR FROM DDT>
IFG <Z3-DDT-7777>,<PRINTX Z3 TOO FAR FROM DDT>
<Z1-DDT>_30+<Z2-DDT>_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 <LF> -
D CTRLL,CARR,CTRLN ;^L <CR> ^N
D ERR,ERR,ERR ;- - -
D ERR,ERR,ERR ;- - -
D ERR,ERR,SUPTYO ;- - ^W
D ERR,ERR,ERR ;- - -
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) <IRP A,<
A>>
IF1,<
DEFINE .ADR (A) <
%'A== CLOC
FIR.== CLOC
DEFINE .ADR (B) <
%'B== CLOC
LASTB==CLOC+74-FIR.>>
DEFINE .TRA(A)<CLOC== CLOC+1 >
DEFINE .TRAX(A)<CLOC==CLOC+2>
SYN .TRA, .DIS
DEFINE .TXT (A) <
IFNB <A>, <IRPC A,<CLOC==CLOC+1>>>
DEFINE .END (A) <
IFNB <A>, <IRPC A,<CLOC==CLOC+1>>
CLOC== CLOC+1>
> ;END OF IF1
IF2,<
DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>
DEFINE .TRA (A) <OUTP %'A+74-FIR.>
DEFINE .TRAX (A),<OUTP 73
OUTP 74+<Z1==%'A-FIR.-1000+74>
IFL Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>
DEFINE .DIS (A) <OUTP A&70/2+A&7-1>
DEFINE .TXT (A) <IFNB <A>, <IRPC A,<OUTP "A"-40>>>
DEFINE .END (A) <
IFNB <A>, <IRPC A,<OUTP "A"-40>>
OUTP 40>
DEFINE OUTP (A)<
IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
IFE <BINC==BINC-9>-^D27,<BINR1==A>
IFE BINC-^D18,<BINR2==A>
IFE BINC-9,<BINR3==A>
IFE BINC,< BYTE (9) BINR1,BINR2,BINR3,<A>
BINC==^D36>
CLOC==CLOC+1 >
>
TBL: ;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 INCLUDE UUOS IN THE DECODER TABLE, REPLACE THE FIRST
;; .DIS 63,.END WITH .DIS 63,.TRA UUO
BYT9 <
.DIS 63,.END,.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 21,.END,.DIS 02,.TRAX JSYS,.TRAX ADJS,,.END,.END
.ADR JSYS,.END JSYS,.ADR ADJS,.END ADJSP
;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
>
IF1,< BLOCK <CLOC+3>/4>
IF2,< IFN BINC-^D36,< BYTE (9) BINR1,BINR2,BINR3,0>>
IFNDEF CLOC.,<CLOC.==CLOC>
IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>
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)<
ASCII /'NAME'/
NUM>
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
DEFJS WATDP,270
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 HSYS,307
DEFJS USRIO,310
DEFJS PEEK,311
DEFJS MSFRK,312
DEFJS ESOUT,313
DEFJS SPLFK,314
DEFJS ADVIS,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 ;SCHEDULER CONTROL JSYS
DEFJS MTU,600 ;MTU JSYS
DEFJS XRIR,601 ;EXTENDED RIR
DEFJS XSIR,602 ;EXTENDED SIR
DEFJS PDVOP,603 ;MANIPULATE PROGRAM DATA VECTORS
DEFJS NTMAN,604 ;DECNET NETWORK MANAGEMENT INTERFACE
DEFJS XSFRK,605 ;START FORK AT GLOBAL PC
DEFJS XGVEC,606 ;GET FULL ENTRY VECTOR
DEFJS XSVEC,607 ;SET FULL ENTRY VECTOR
DEFJS RSMAP,610 ;READ SECTION MAP
DEFJS XRMAP,611 ;EXTENDED RMAP
DEFJS XGTPW,612 ;EXTENDED GET TRAP WORD
DEFJS XSSEV,613 ;EXTENDED SET SPECIAL ENTRY VECTOR
DEFJS XGSEV,614 ;EXTENDED GET SPECIAL ENTRY VECTOR
;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
JSYEND:
;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
STRIP: 0 ;STRING BUFFER INPUT PTR
STROP: 0 ;STRING BUFFER OUTPUT PTR
STRBUF: BLOCK STRBFL
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) 0,1,1,1,1,1,1,2,0,0,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,0,1,1,1,1,1,1,0,1,1,1,2
>
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: 00 ;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,<BPTBLK \QZ
QZ==QZ+1>
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