perm filename DDT.MAC[JCR,GUE] blob
sn#023777 filedate 1973-12-30 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00107 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00010 00002 10-NOV-71 /TW/TWE/PFC
00011 00003 REPEAT 0,<
00014 00004 DEFINE XP (X.,Y.),<
00016 00005 IFN EDDT&SWFILE,< CM==2 DEFINE SOFTWARE CHANS.
00017 00006 DEFINE BITS FOR USE IN LEFT HALF OF ACCUMULATOR F
00020 00007 IFE EDDT&SWFILE,<
00021 00008 DEFINE I/O DEVICE MNEMONICS
00022 00009 DDTOFS: OFFSET BASE FOR DISPATCH TABLES
00023 00010 IFN EDDT&SWFILE,<
00025 00011 STILL EDDT&SWFILE
00026 00012 STILL EDDT&SWFILE
00027 00013 STILL EDDT&SWFILE
00028 00014 STILL EDDT&SWFILE
00030 00015 STILL EDDT&SWFILE
00032 00016 STILL EDDT&SWFILE
00034 00017 STILL EDDT&SWFILE
00037 00018 DD1: PUSHJ P,CRF
00040 00019 MOVE T,SYL
00043 00020 ERR: MOVEI W1,"?"
00045 00021 QUESTN: PUSHJ P,CRF HERE FOR "?"
00047 00022 NUM: ANDI T,17 T HOLDS CHARACTER
00049 00023 NUM1: EXCH T,WRD2 FORM NUMBER AFTER $
00051 00024 PERIOD: MOVE T,LLOC
00053 00025 SYMBOL TABLE LOGIC
00056 00026 SYMBOL TABLE POINTER AND COUNT SET UP ROUTINE
00059 00027 SETNAM: SKIPGE R,@SYMP LOOK UP PROGRAM NAME FOR $:
00061 00028 KILL: TLNN F,LTF DELETE SYMBOLS
00064 00029 TAG: TLNN F,LTF NO LETTERS IS ERROR
00066 00030 DEF3: JUMPGE R,RET PATCH IN VALUE FOR UNDEF SYM ENTRY
00068 00031
00070 00032 ***ROUTINES BEYOND HERE EVALUATE THEIR ARGUMENT***
00072 00033 RPRN: TLNN F,QF )
00073 00034 REGISTER EXAMINATION LOGIC
00075 00035 OCON: TROA F,LF1+CF1 OPEN AS CONSTANT
00077 00036 DEPRA: MOVE R,SAVLOC
00080 00037 MODE CONTROL SWITCHES
00082 00038 GO AND EXECUTE LOGIC
00084 00039 ENTER AND LEAVE DDT LOGIC
00086 00040 MOVEI P,PS SET UP PUSH DOWN POINTER
00088 00041 STILL UNDER EDDT&SWFILE
00089 00042 BREAK POINT LOGIC
00090 00043 STILL UNDER EDDT&SWFILE
00092 00044 STILL UNDER EDDT&SWFILE
00094 00045 STILL UNDER EDDT&SWFILE
00095 00046 STILL UNDER EDDT&SWFILE
00097 00047 STILL UNDER EDDT&SWFILE
00099 00048 STILL UNDER EDDT&SWFILE
00100 00049 STILL UNDER EDDT&SWFILE
00102 00050 STILL UNDER EDDT&SWFILE
00103 00051 MEMORY MANAGER SUBROUTINES
00105 00052 IFN EDDT&SWFILE,<
00107 00053 DEPMEM: SKIPN PATCHS SEE IF PATCHING
00109 00054 STILL UNDER EDDT&SWFILE
00111 00055 STILL UNDER EDDT&SWFILE
00112 00056 FETCH FROM MEMORY SUBROUTINE
00115 00057 CHKADR: HRRZ TT,.JBREL GET HIGHEST ADDRESS IN LOW SEGMENT
00116 00058 BINARY TO SYMBOLIC CONVERSION
00119 00059 LOOK4: TLNE F,(1B0) ANY GOOD SYMBOLS FOUND?
00121 00060 CONSYM: MOVEM T,LWT
00122 00061 PUSHJ P,TSPC
00124 00062 HLFW: REPEAT 0,< MOVE T,LWT
00126 00063 INOUT: TDC T,[XWD -1,400000] IO INSTRUCTION OR NEG NUM
00128 00064 SEARCH LOGIC
00130 00065 SEAR3: MOVE R,DEFV
00131 00066 SETUP: TLNN F,QF QUANTITY TYPED?
00134 00067 OUTPUT SUBROUTINES
00136 00068 SYMD: $D DELETE LAST SYM & PRINT NEW
00137 00069 FLOATING POINT OUTPUT
00139 00070 FP7: IDIVI A,12 DECIMAL OUTPUT SUBROUTINE
00140 00071 TEXTT: MOVE W1,T
00142 00072 BITO: MOVEI R,BITT BYTE OUTPUT SUBROUTINE
00143 00073 PUNCH PAPER TAPE LOGIC
00145 00074 PUNCH NON-ZERO BLOCKS
00147 00075 LOADER: SKPUSR
00149 00076 LOADB:
00150 00077 TELETYPE IO LOGIC
00152 00078 XTTYRE: MOVEI T,3410
00153 00079 IFN EDDT&4,< ASSEMBLE WITH OLD DDT MODE IO
00155 00080 IFE EDDT&4,< ASSEMBLE WITH TTCALL TELETYPE IO
00156 00081 LISTEN:
00158 00082 DDT COMMAND FILE LOGIC
00161 00083 HAVECM: SETOM COMAND FLAG CMD FILE FOUND
00162 00084 IFN EDDT&SWYANK,<
00164 00085 COMMAND FILE IO
00165 00086 IFN EDDT&SWEXEC,<
00167 00087 IFN EDDT&SWFILE,<
00168 00088 DISPATCH TABLE
00170 00089 D (NUM,NUM,NUM) (60)
00171 00090 SUBTTL OP DECODER
00174 00091 73(8) THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
00177 00092 REPEAT 0,<
00179 00093 TBL: OPDECODER BYTE TABLE
00182 00094 HALF WORDS
00184 00095 DEFINE BYT9 (A) <IRP A,<
00186 00096 TBL: OPDECODER BYTE TABLE
00189 00097 FWT-FIXED POINT ARITH-MISC
00192 00098 HALF WORDS
00194 00099 INSTRUCTION GROUP 120
00196 00100 PNTR: EXP INST POINTER TO BITS IN INST
00199 00101 DECT: TRNE F,OUTF
00202 00102 LIT
00203 00103 VARIABLE STORAGE
00205 00104 IFE EDDT&SWFILE,<
00206 00105 IFN EDDT&SWFILE,< FILDDT STUFF
00208 00106 PS: BLOCK LPDL STORAGE FOR PUSH DOWN LIST
00209 00107
00210 ENDMK
⊗;
SUBTTL 10-NOV-71 /TW/TWE/PFC
;COPYRIGHT (C) 1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS., USA
;SWITCHES FOR DDT FEATURES
SWEXEC==1B35 ;EXEC MODE
SWPTP==1B34 ;PAPER TAPE
SWFILE==1B32 ;FILDDT
SWYANK==1B31 ;$Y
%DDTVR==<3300,,62>
IFNDEF EDDT,<EDDT==0>
IFE EDDT&SWFILE,<INTERN %DDTVR>
REPEAT 0,<
DDT ASSEMBLY INSTRUCTIONS
THE SOURCE FILE OF DDT WILL ASSEMBLE INTO SEVERAL DIFFERENT
VERSIONS; THE ASSEMBLY IS CONTROLLED BY THE VALUE ASSIGNED
TO THE SYMBOL "EDDT". THE SYMBOL "EDDT" IS DECODED AS FOLLOWS:
BIT 35 =0; ASSEMBLE A USER MODE DDT
=1; ASSEMBLE AN EXECUTIVE MODE DDT (WILL ALSO RUN IN USER MODE)
BIT 34 =0; DO NOT ASSEMBLE THE PAPER TAPE FEATURES INTO DDT
=1; ASSEMBLE THE PAPER TAPE FEATURES BUT ONLY IF
ASSEMBLING AN EXECUTIVE MODE DDT
BIT 33 =0; FOR USER MODE DDT ONLY- ASSEMBLE USING THE
"TTCALL" UUO FOR TELETYPE IO
=1; FOR USER MODE DDT ONLY- ASSEMBLE USING THE
"DDTIN" AND "DDTOUT" UUO'S FOR TELETYPE IO
*** THIS SWITCH IS NO LONGER SUPPORTED BY DEC. 22-SEPT-70 *** MCO #D-343
BIT 32 =1; ASSEMBLE A FILE DDT -- USUALLY SET 30
BIT 31 =1; ASSEMBLE A PAPER TAPE INPUT DDT ($Y)
BITS (0-17)
=0; ASSEMBLE A RELOCATABLE VERSION OF DDT (RELOC 0)
NOT=0; ASSEMBLE AN ABSOLUTE (NON-RELOCATABLE) VERSION
OF DDT WITH A STARTING ADDRESS BEING THE
NUMBER IN BITS 0-17
(IF THE SYMBOL "EDDT" IS NOT DEFINED AT ALL, DDT WILL BE ASSEMBLED
WITH EDDT=0.)
EXAMPLES OF "EDDT" DEFINITIONS:
EDDT=0 ASSEMBLE A RELOCATABLE USER MODE DDT
EDDT=23 ASSEMBLE A RELOCATABLE EXECUTIVE MODE DDT
EDDT=<XWD 4000,23>
ASSEMBLE AN ABSOLUTE EXECUTIVE MODE DDT
WHOSE STARTING ADDRESS IS LOCATION 4000.
EDDT=30 ASSEMBLE A FILDDT
> ;END OF REPEAT 0
DEFINE XP (X.,Y.),<
IF2,<X.=Y.
INTERN X.>>
IFN EDDT&SWEXEC,< TITLE EDDT -EXEC MODE DDT >
IFN EDDT&<SWEXEC!SWFILE>,<
XJBSYM==36
XJBUSY==32
XZLOW==40>
IFE EDDT&SWEXEC,<
IFE EDDT&SWFILE,< TITLE UDDT -USER MODE DDT >
IFN EDDT&SWFILE,< TITLE FILDDT -FILE DDT
LN.RES==400 ;LENGTH OF FILDDT RESIDENT AREA
LN.CUR==400 ;LENGTH OF FILDDT WINDOW
T30SYM==131 ;SPMON (10/30)>
>
EXTERN .JBREL,.JBSA,.JBHRL,.JBSYM,.JBFF,.JBHSM,.JBHNM,.JBUSY
ZLOW==140
INTERNAL .JBVER,.JBDDT
.JBDDT==74
.JBVER==137
IFE EDDT&SWEXEC,<
LOC .JBVER ;DO NOT SET IF EXEC DDT(OK USER OR FILDDT)
%DDTVR ;PUT VERSION # IN .JBVER
>
IFE EDDT&SWFILE,<
LOC .JBDDT
XWD DDTEND,DDTX
>
RELOC 0
IFN EDDT&<XWD -1,0>,<LOC <EDDT>B53>
IFN EDDT&SWEXEC,<
OPDEF SKPUSR [SKIPL USRFLG] ;SKIP IN USER MODE
OPDEF SKPEXC [SKIPGE USRFLG] ;SKIP IN EXEC MODE
>
IFN EDDT&SWFILE,< CM==2 ;DEFINE SOFTWARE CHANS.
DP==3
>
;DEFINE ACCUMULATORS
F=0 ;FLAGS
P=1 ;PUSH DOWN
R=<A=2> ;POINTERS TO TABLES, CORE, ETC.
S=<B=3>
W=<C=4> ;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
T=5 ;TRANSFER DATA
W1=6
W2=7
SCH=10 ;MODE CONTROL SWITCH FOR OUTPUT
AR=11 ;MODE CONTROL SWITCH FOR OUTPUT
ODF=12 ;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
TT=13 ;TEMPORARY
TT1=14 ;TEMPORARY
TT2=15 ;TEMPORARY (USED FOR PTR INPUT ONLY)
;DEFINE I/O DEVICE MNEMONICS FOR DDT USE
PRS==4
TTYY==120
PTRR==104
PTPP==100
;DEFINE PUSH DOWN LENGTH
LPDL==50 ;MAX LENGTH PUSH DOWN LIST
;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
R20F==10 ;TEMP FLAG USED IN SETUP
SBF==20
NAF==200 ;NEGATIVE ADDRESSES PERMISSABLE
POWF==4000 ;ARGUMENT FOR EXPONENT COMING
PNAMEF==10000 ;PROGRAM NAME SEEN IN SYM TABLE SEARCH
MDLCLF==20000 ;USED BY EVAL- MULTIPLY DEFINED LOCAL SYMBOL
;DEFINE SYMBOL TABLE SYMBOL TYPES
GLOBAL==040000 ;GLOBAL SYMBOL
LOCAL==100000
PNAME==740000 ;PROGRAM NAME
DELI==200000 ;DELETE INPUT
DELO==400000 ;DELETE OUTPUT
;DEFINE UNDEFINED SYMBOL TABLE (.JBUSY) TYPES
STADD==1B0 ;IF 1, THEN ADDITIVE REQUEST
STLH==1B1 ;IF 1, THEN REQUEST FOR LEFT HALF
STNEG==1B4 ;IF 1, THEN NEGATIVE REQUEST
IFE EDDT&SWFILE,<
INTERN DDTEND ;DECLARE END OF DDT AS INTERNAL, FOR
; USER TO SEE (USER MODE) AND ONCE ONLY CODE
; (MONITOR)
IFE EDDT&SWEXEC,< ENTRY DDT>
IFN EDDT&SWEXEC,< INTERNAL DDT
ENTRY DDTX ;NEEDED BY MONITOR>>
;DEFINE $ SYMBOLS INTERNAL TO DDT
OPDEF DDTINT [Z 0,] ;ADDRESS FLAG FOR INTERNAL REGISTERS
IFE EDDT&SWFILE,<
RADIX 10
NBP==8 ;NUMBER OF BREAKPOINTS
DEFINE DBPNT (Z.)<XP $'Z.'B,<DDTINT B1ADR+3*Z.-3>>
ZZ==0
REPEAT NBP,<DBPNT \<ZZ==ZZ+1>>
RADIX 8
XP $M,<DDTINT MSK>
XP $I,<DDTINT SAVPI>>
;DEFINE I/O DEVICE MNEMONICS
IFN EDDT&SWEXEC,<
XP PI,004B11
XP PAG,010B11
XP CCI,014B11
XP DLB,060B11
XP DLC,064B11
XP CLK,070B11
XP PTP,100B11
XP PTR,104B11
XP CDP,110B11
XP CDR,114B11
XP TTY,120B11
XP LPT,124B11
XP DIS,130B11
XP PLT,140B11
XP CR,150B11
XP DSK,170B11
XP DC,200B11
XP UTC,210B11
XP UTS,214B11
XP MTC,220B11
XP MTS,224B11
XP MTM,230B11
XP DLS,240B11
XP DPC,250B11
XP DCSA,300B11
XP DCSB,304B11
XP DTC,320B11
XP DTS,324B11
XP TMC,340B11
XP TMS,344B11 >
;DEFINE EXTENDED OPERATIONS
IFE EDDT&SWFILE,<
XP JOV,2554B11
XP JEN,2545B11
XP HALT,2542B11 >
DDTOFS: ;OFFSET BASE FOR DISPATCH TABLES
IFE EDDT&SWFILE,<
DDTX:
IFN EDDT&SWYANK,<
SETZM COMAND ;INDICATE NO COMMAND FILE IF STARTING BY DDT COMMAND
>
DDT: JSR SAVE
PUSHJ P,REMOVB
MOVEI T,XEC1 ;RESTET $P DEFAULT RETURN SO
HRRM T,PROC0 ; $P WILL NO-OP
IFN EDDT&SWEXEC,<
MOVE W1,[ASCII /DDT/]
SKPUSR
MOVE W1,[ASCII /EDDT/]
PUSHJ P,TEXT2 ;TYPE MESSAGE SAYING WHICH DDT
>
> ;END EDDT&SWFILE
IFN EDDT&SWFILE,<
DDT: CALLI
SETZM COMAND ;CLEAR $Y FLAG
SETZM FWAZER ;CLEAR BLOCK OF STORAGE
MOVE T,[FWAZER,,FWAZER+1]
BLT T,LWAZER
MOVEI P,PS ;PRESET PUSH DOWN LIST
MOVSI T,'DSK' ;PRESET DEVICE
MOVEM T,FILDEV+1
OUTSTR [ASCIZ /File: /]
PUSHJ P,TINCH
JRST FDINO ;IN CASE NULL LINE TYPED IN
SETOM CRASHS ;PRESET FOR FILE MODE
MOVEI TT,0 ;CLEAR NAME
MOVE TT1,[POINT 6,TT] ;PRESET ACCUMULATOR
FDILP: CAIN T,"/" ;SEE IF SWITCH
JRST FDISW ;YES--GO DO IT
CAIN T,":" ;SEE IF DEVICE
JRST [JUMPE TT,FDIERR
MOVEM TT,FILDEV+1
JRST FDILNP]
CAIN T,"." ;SEE IF EXTENSION FLAGGED
JRST [MOVEM TT,FILBLK
SETOM FDIDOT
JRST FDILNP]
CAIE T,"[" ;SEE IF PPN FLAGGED
JRST FDILET ;NO--MUST BE IN NAME
PUSHJ P,FDIOCT ;YES--GET PROJECT
JUMPLE TT2,FDIERR ;DISALLOW JUNK
CAIG TT2,377777 ;DISALLOW INVALID NUMBERS
CAIE T,"," ;VERIFY
JRST FDIERR ;BOMB ERROR
HRLZM TT2,FILBLK+3 ;STORE
PUSHJ P,FDIOCT ;GET PROGRAMMER
JUMPLE TT2,FDIERR ;DISALLOW JUNK
CAILE TT2,-1 ;DISALLOW INVALID
JRST FDIERR ; NUMBERS
HRRM TT2,FILBLK+3 ;STORE
JUMPE T,FDILDP ;EXIT IF DONE
CAIE T,"]" ;SEE IF END OF PPN
JRST FDIERR ;NO--BOMB OUT
JRST FDILOP ;GET MORE WORDS
;STILL EDDT&SWFILE
FDIOCT: MOVEI TT2,0 ;CLEAR ANSWER
FDIOC1: PUSHJ P,TINCH ;GET CHAR
POPJ P, ;IF DONE
TLNE TT2,(7B2) ;IF OVERFLOWING,
POPJ P, ; GIVE UP
CAIL T,"0" ;SEE IF
CAILE T,"7" ; OCTAL
POPJ P, ;NO--GIVE UP
LSH TT2,3 ;YES--MULT AC
ADDI TT2,-"0"(T) ;INCREMENT
JRST FDIOC1 ;LOOP
FDILET: CAIL T,"0" ;SEE IF ALPHA-NUM
CAILE T,"Z"
JRST FDIERR
CAILE T,"9"
CAIL T,"A"
JRST .+2
JRST FDIERR
SUBI T,40 ;YES--MAKE SIXBIT
TLNE TT1,(77B5) ;DON'T OVERFLOW
IDPB T,TT1 ;STORE
JRST FDILOP ;AND LOOP
;STILL EDDT&SWFILE
FDIERF: OUTSTR [ASCIZ /? Can't get at file
/]
JRST FDIERE
FDIHLP: ASCIZ \
Type dev:file.ext[p,pn]/switches
/M examine monitor
/P patch monitor or file
type ↑Z to exit from file patching
/S reload symbol table from file
if no spec, examine monitor
file defaults: if /P or /S: DSK:SYSTEM.XPN
else: DSK:CRASH.XPN
use $Y to read DSK:FILDDT.DDT and write LPT:FILDDT.LST
\
;STILL EDDT&SWFILE
TINCH: INCHWL T ;GET NEXT CHAR
CAIE T,177
CAIN T,15
JRST TINCH
CAIE T,40
CAIN T,11
JRST TINCH
CAIE T,3
CAIN T,32
JRST [RESET
EXIT 1,
JRST DDT]
JUMPE T,TINCH
CAIGE T,175
CAIGE T,40
JRST [MOVEI T,0
POPJ P,]
CAIL T,140
SUBI T,40
JRST CPOPJ1
FDISW: PUSHJ P,TINCH ;GET SWITCH
JRST FDIERR
CAIN T,"H" ;HELP
JRST [OUTSTR FDIHLP
JRST FDIERE]
CAIN T,"P" ;PATCH
JRST [SETOM PATCHS
JRST FDILOP]
CAIN T,"S" ;LOAD SYMBOLS
JRST [SETOM SYMGET
JRST FDILOP]
CAIN T,"M" ;MONITOR
JRST [SETZM CRASHS
JRST FDILOP]
;FALL INTO ERROR
;STILL EDDT&SWFILE
;FALL HERE FROM ABOVE
FDIERR: OUTSTR [ASCIZ \? Command error -- type /H for help
\]
FDIERE: CLRBFI ;CLEAR ANY TYPE AHEAD
JRST DDT ;AND START OVER
FDILNP: MOVEI TT,0 ;CLEAR WORD
MOVE TT1,[POINT 6,TT] ;RESET POINTER
FDILOP: PUSHJ P,TINCH ;GET NEXT CHAR
SKIPA
JRST FDILP ;LOOP BACK TO PROCESS IT
FDILDP: SKIPE TT ;ALL DONE--SEE IF FILE NAME ASSEMBLED
JRST [SKIPE FDIDOT
HLLZM TT,FILBLK+1
SKIPN FDIDOT
MOVEM TT,FILBLK
JRST .+1]
FDINO: SKIPE PATCHS ;SEE IF /P
SKIPN CRASHS ;AND NOT /M
JRST .+2 ;NO
SETOM SYMGET ;YES--SET /S
MOVEI T,17 ;PRESET I/O MODE
MOVEM T,FILDEV
MOVE T,['CRASH ']
SKIPE SYMGET ;SEE IF /S OR /P
MOVE T,['SYSTEM']
SKIPN FILBLK ;PRESET FILE NAME
MOVEM T,FILBLK
MOVSI T,'XPN' ;AND FILE EXT
SKIPN FDIDOT
HLLZM T,FILBLK+1
;STILL EDDT&SWFILE
SKIPN SYMGET ;SEE IF /S
SKIPE CRASHS ;SEE IF /M
JRST .+2 ;/S OR -/M
JRST FDINOT ;PROCEED IF NOT
OPEN 1,FILDEV ;YES--OPEN FILE
JRST FDIERF
PUSH P,FILBLK+3 ;SAVE PPN
LOOKUP 1,FILBLK ;LOOK IT UP
JRST FDIERF
HLRE T,FILBLK+3 ;GET LENGTH
SKIPGE T
MOVNS T
SKIPL FILBLK+3
IMULI T,↑D128
MOVEM T,MONSIZ ;STORE AS WORDS
POP P,FILBLK+3 ;RESTORE PPN
SKIPE PATCHS ;SEE IF PATCHING
SKIPN CRASHS ;YES--SEE IF FILE
JRST FDINOE ;NO--SKIP ENTER
SETZM FILBLK+2 ;CLEAR E+2
HLLZS FILBLK+1 ;CLEAR RH(E+1)
ENTER 1,FILBLK ;/P AND -/M
JRST FDIERF
FDINOE: USETI 1,1 ;POSITION TO START
INPUT 1,RSILST ;READ FIRST K
STATZ 1,740000 ;CHECK FOR ERRORS
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
SETOM RSAVE ;PRESET TO FORCE ACTIVE BLOCK READ
SKIPE RSIDNT ;SEE IF .XPN FORMAT
JRST [OUTSTR [ASCIZ /? Not in .XPN format
/]
JRST DDT]
SKIPE SYMGET ;SEE IF /S
PUSHJ P,SYMFIX ;YES--GO GET THEM
SKIPN CRASHS ;SEE IF REASON TO HOLD OPEN
RELEAS 1, ;NO--CLEAR FILE
SKIPE SYMGET ;SEE IF /S
SKIPE PATCHS ;SEE IF /P
JRST FDINOT ;CONTINUE IF /P OR -/S
SKIPE CRASHS ;SEE IF -/M
JRST DDT ;IF /S AND NOT /P OR /M, START OVER
FDINOT: JRST DD1 ;GO START DDT
;STILL EDDT&SWFILE
EXTERN .JBREN,.JBCOR
SYMFIX: PUSHJ P,SYMPTR ;GO GET SYMBOL POINTER IN T AND TT
MOVEM TT,FIUPTR ;SAVE JOBUSY
HLRES TT,TT
MOVMS TT,TT
MOVEM T,FISPTR ;SAVE IT
HLRES T,T
MOVMS T,T ;LENGTH OF SYMBOL TABLE
SKIPN W,SAVEFF ;PICK UP START OF SYMBOL TABLE
MOVE W,.JBFF ;GET FROM LOADER IF FIRST TIME
MOVEM W,SAVEFF ;SAVE FOR FUTURE PASSES
ADDI W,200 ;LEAVE SPACE FOR EXTRA SYMBOL DEFNS.
HRRZ W1,W ;SAVE LOC FOR COPY
ADD W,T ;ADD TABLE LENGTH
ADD W,TT ;INCLUDE USY TABLE
HRRZM W,.JBFF ;UPDATE MONITOR TO END FOR ITS BUFFER
HRLM W,.JBSA ; ALLOCATION MECHANISMS
HRLM W,.JBCOR ;INDICATE SYMBOLS FOR SAVE
CALLI W,11 ;GET CORE
JRST [OUTSTR [ASCIZ /? Not enough core
/]
JRST DDT]
MOVE R,FIUPTR ;GET USY POINTER
JUMPGE R,SYMCPY ;SKIP IF NONE
HRRM W1,FIUPTR
UCOPY: PUSHJ P,FETCH
JRST ERR
MOVEM T,(W1)
AOS W1
AOBJN R,UCOPY
SYMCPY: MOVE R,FISPTR ;WHEREABOUTS OF MONITOR SYMBOLS
HRRM W1,FISPTR ;NOW POINT TO FILDDT SYMBOLS
JUMPGE R,CPOPJ ;RETURN IF NO TABLE
TCOPY: PUSHJ P,FETCH ;GET A WORD
JRST ERR
MOVEM T,0(W1) ;STASH IT
AOS W1
AOBJN R,TCOPY
POPJ P, ;RETURN TO CALLER
;STILL EDDT&SWFILE
REPEAT 0,<
THE MONITOR CAN BE LOADED IN ANY OF THREE WAYS(IN ORDER OF PREFERENCE):
1. UNDER TIME SHARING WITH REGULAR LOADER AND COMMON
2. UNDER SPECIAL 10/30 MONITOR(SPMON) WITH REGULAR 10/30 LOADER & COMMON
3. UNDER SPECIAL 10/30 MONITOR(SPMON) WITH BUILD
THE 3 WAYS LEAVE XJBSYM(36),.JBSYM(116) & T30SYM(131) IN DIFFERENT STATES:
XJBSYM .JBSYM T30SYM
1. JUNK S.T.PTR JUNK
2. JUNK JUNK(NON-NEG) S.T.PTR
3. S.T.PTR S.T.PTR JUNK
ALSO, MORE LIKELY, IS THAT EDDT HAS ALREADY RUN ONCE:
S.T.PTR OLD S.T.PTR JUNK
>
SYMPTR: MOVSI S,-LN.TRY ;PRESET TABLE FOR TRIES AT PTRS
SYMPT1: HLRZ R,PTRTRY(S) ;GET USY LOCATION
MOVEI T,0 ;(IN CASE SKIP)
JUMPE R,SYMPT2 ;JUMP IF NONE
PUSHJ P,FETCH ;GET IT
JRST ERR
SYMPT2: MOVE TT,T ;SAVE AS ANSWER
HRRZ R,PTRTRY(S) ;GET SYM LOCATION
PUSHJ P,FETCH ;GET POINTER
JRST ERR
JUMPL T,SYMPT3 ;IF GOOD, CONTINUE
AOBJN S,SYMPT1 ;ELSE LOOP
SYMPT3: MOVE S,PTRTRY(S) ;GOOD--PICK UP LOCATIONS
JUMPGE TT,SYMPT4 ;MAKE SURE USY TABLE IS OK
HLRE W,TT ; BY COMPARING
MOVMS W ; ITS END
ADDI W,(TT) ; WITH START OF SYM
CAIE W,(T) ;IF EQUAL, OK
SYMPT4: MOVEI TT,0 ;NO--CLEAR USY POINTER
POPJ P, ;RETURN
PTRTRY: XJBUSY,,XJBSYM ;IN CASE EDDT HAS RUN
.JBUSY,,.JBSYM ;REGULAR LOADER RAN LAST
0,,T30SYM ;10/30 LOADER
XJBUSY,,XJBSYM ;BUILD OR JUNK
LN.TRY==.-PTRTRY
> ;END EDDT&SWFILE
DD1: PUSHJ P,CRF
DD1.5: TLZ F,ROF ;CLOSE ANY OPEN REGISTER
MOVE T,[XWD SCHM,SCH]
BLT T,ODF ;LOAD ACS
DD2: CLEARM PRNC ;PARENTHESES COUNT
MOVEI P,PS
LIS: MOVE T,@USYMP ;GET UNDEF SYMBOL POINTER
JUMPL T,LIS0B ;IF POINTER OK, TRANSFER
SKIPGE T,@SYMP ;IF POINTER NOT OK, USE .JBSYM ADR
JRST LIS0A ; SO LONG AS IT IS NEGATIVE
IFE EDDT&SWFILE,<
MOVEI R,400000+.JBHSM ;IF LO ADR NOT OK, TRY HIGH
IFN EDDT&SWEXEC,<SKPEXC> ; UNLESS IN EXEC MODE
PUSHJ P,FETCH ;GET HIGH SYM TABLE POINTER>
MOVEI T,0 ;IT DOESN'T EXIST
JUMPG T,.-1 ;IF POINTER .G. 0, GIVE 0 RESULT
LIS0A: HRRZS T ;USE ADR OF SYM TABLE TO INIT
MOVEM T,@USYMP ; UNDEFINED SYM TABLE POINTER
LIS0B: MOVEM T,ESTUT ;INIT UNDEFINED SYM ASSEMBLER
TDZ F,[XWD 777777-ROF-STF,LF1+CF1+SBF+2+Q2F]
LIS0: TDZ F,[XWD 777777-ROF-STF-FAF-SAF,NAF]
CLEARM,WRD
LIS1: CLEARM,FRASE
LIS2: MOVEI T,1
MOVEM T,FRASE1
TLZ F,MLF+DVF
L1: TLZ F,CF+CCF+SF+FPF ;TURN OFF CONTROL, SYL, PERIOD FLAG
L1A: CLEARM,SYL
L1RPR: CLEARM,SYM
MOVEI T,6
MOVEM T,TEM ;INIT SYMBOL COUNTER
MOVE T,[POINT 7,TXT]
MOVEM T,CHP ;SETUP FOR OPEVAL SYMBOL
CLEARM,DEN
CLEARM,WRD2
L2: PUSHJ P,TIN ;PICK UP CHARACTER
CAIL T,"A"+40 ;LOWER CASE A
CAILE T,"Z"+40 ;LOWER CASE Z
JRST .+2
TRC T,40 ;CHANGE LOWER CASE TO UPPER CASE
TLNE F,CF ;CONTROL FLAG
JRST L21
CAIG T,"Z" ;Z
CAIGE T,"A" ;A
JRST .+2
JRST LET
L21: MOVE R,T
CAILE T,137 ;DISPATCH TABLE HAS ENTRIES ONLY .LE. 137
JRST ERR
IDIVI R,3 ;REMAINDER GIVES COLUMN, QUOTIENT GIVES ROW
LDB W,BDISP(R+1) ;GET 12 BIT ADDRESS FROM DISPATCH TABLE
CAIGE W,MULT-DDTOFS ;FIRST EVAL ROUTINE
JRST DDTOFS(W)
MOVE T,SYL
TLZN F,LTF
JRST POWER
CAIN W,SPACE-DDTOFS ;IS TERMINATOR A SPACE?
SKIPE WRD ;IS CONSTRUCTED WORD SO FAR ZERO?
SKIPA T,[OPEVAL,,EVAL] ;SEARCH EVAL 1ST IFF: -SPACE .OR. (WRD).NE.0
MOVS T,[OPEVAL,,EVAL] ;SEARCH OPEVAL 1ST IFF: SPACE .AND. (WRD)=0
MOVEM T,SYMORD ;SAVE SYMBOL TABLE SEARCH ORDER
JRST L213
L212: HLRZS T,SYMORD ;GET ADDRESS OF THE OTHER LOOKUP ROUTINE
JUMPE T,UND1 ;IF ADR=0, THEN SYMBOL UNDEFINED
L213: PUSHJ P,(T) ;CALL OPEVAL OR EVAL
JRST L212 ;SYMBOL NOT FOUND
CAIN W,ASSEM-DDTOFS ;DEFINED SYMBOL FOLLOWED BY #?
JRST ERR ;IF DEFINED, DON'T ALLOW #
L4: TLZE F,MF
MOVN T,T
TLNN F,SF
CAIE W,LPRN-DDTOFS
JRST .+2
JRST LPRN
EXCH T,FRASE1
TLNN F,DVF
IMULB T,FRASE1
TLZE F,DVF
IDIVB T,FRASE1
CAIGE W,ASSEM-DDTOFS
JRST DDTOFS(W) ;MULTIPLY OR DIVIDE
ADDB T,FRASE
CAIGE W,SPACE-DDTOFS
JRST DDTOFS(W) ; + - @ ,
ADD T,WRD
TLNE F,TIF ;TRUNCATE INDICATOR FLAG
HLL T,WRD ;TRUNCATE
MOVEM T,WRD
TLNN F,QF
MOVE T,LWT
CLEARM,R
MOVE W1,ESTUT
CAMN W1,@USYMP ;IF THERE ARE ANY UNDEFINED SYMBOLS IN
JRST L5 ;THE CURRENT EXPRESSION, ANYTHING EXCEPT
CAILE W,CARR-DDTOFS ;FURTHER EXPRESSION INPUT, OR DEPOSITING
JRST ERR ; INTO MEMORY IS ILLEGAL
L5: CAIG W,RPRN-DDTOFS
JRST DDTOFS(W)
PUSH P,KILRET ;WHEN INSIDE ( ), CURRENT EXPRESSION
SKIPN PRNC ;INVALID FOR ANYTHING OTHER
JRST DDTOFS(W) ; THAN MORE EXPRESSION INPUT
ERR: MOVEI W1,"?"
JRST WRONG1
UNDEF: MOVEI W1,"U"
JRST WRONG1
WRONG: MOVE W1,[ASCII /XXX/]
WRONG1: MOVEI P,PS
PUSHJ P,TEXT
PUSHJ P,LCT ;TYPE TAB
PUSHJ P,LISTEN ;GOBBLE ANY INPUT CHARACTER
JFCL
JRST DD2
RET: MOVEI P,PS
PUSHJ P,LCT ;COMMON RETURN FOR TAB;,JRST LIS
JRST DD2
UND1: MOVE R,ESTUT ;UNDEFINED SYM ASSEMBLER
JUMPE R,UNDEF ;UNDEFINED IF NO UNDEF SYM TABLE
HLRE S,ESTUT
ASH S,-1 ;SETUP EVAL END TEST
PUSHJ P,EVAL2
CAIN W,ASSEM-DDTOFS
TLNN F,ROF
JRST UNDEF
SKIPE PRNC
JRST UNDEF
MOVEI T,"#"
CAIE W,ASSEM-DDTOFS
PUSHJ P,TOUT
MOVN R,[XWD 2,2]
ADDB R,ESTUT
MOVE T,SYM
TLO T,GLOBAL
PUSHJ P,DSYMER ;DEPOSIT AND TYPE ? IF IT FAILS
HRRZ T,LLOCO
TLNE F,MF
TLO T,(STNEG) ;SET FLAG TO SHOW SUBTRACTIVE REQUEST
TLO T,(STADD) ;SET FLAG TO SHOW UNCHAINED REQUEST
ADDI R,1
PUSHJ P,DSYMER
MOVEI T,0
JRST L4
QUESTN: PUSHJ P,CRF ;HERE FOR "?"
TLNE F,LTF ;HAS A SYMBOL BEEN TYPED?
JRST QLIST ;NO
MOVE R,@USYMP ;YES, LIST UNDEFINED SYMBOLS
QUEST1: JUMPGE R,DD1
MOVE T, (R)
SKIPA W1,@USYMP
QUEST2: ADD W1,[XWD 2,2]
CAME T,(W1)
JRST QUEST2
CAME R,W1
JRST QUEST4
PUSHJ P,SPT
PUSHJ P,CRF
QUEST4: ADD R,[XWD 2,2]
JRST QUEST1
QLIST: PUSHJ P,SYMSET ;LIST REFERENCES TO THE SYMBOL
QLIST1: SETZM QLPNT ;ZERO FLAG SHOWING REFERENCE
QLIST2: MOVE T,(R) ;PICK UP SYMBOL
TLZN T,PNAME ;A PROGRAM NAME?
JRST QLIST6 ;YES
CAMN T,SYM ;NO, IS AN OCCURANCE FOUND?
HRRZM R,QLPNT ;YES, REMEMBER WHERE
QLIST3: AOBJN R,.+1 ;LOOK THRU TABLE
AOBJN R,QLIST4 ;END OF TABLE SEGMENT?
IFE EDDT&SWFILE,<
TRNN R,1B18 ;YES, WRAP AROUND
SKIPL R,SAVHSM
>
MOVE R,@SYMP
QLIST4: AOJLE S,QLIST2 ;THRU SEARCHING?
JRST DD1 ;YES
QLIST6: SKIPN QLPNT ;FOUND THE SYMBOL?
JRST QLIST3 ;NO
PUSHJ P,SPT1 ;YES, PRINT THE PROGRAM NAME
MOVE T,@QLPNT ;GET THE SYMBOL BACK AND
TLNN T,GLOBAL ; TEST FOR A GLOBAL SYMBOL
JRST QLIST7 ;NOT GLOBAL
PUSHJ P,TSPC ;IS GLOBAL, TYPE " G"
MOVEI T,"G"
PUSHJ P,TOUT
QLIST7: PUSHJ P,CRF
SETZM QLPNT ;RESET FLAG
JRST QLIST3 ; AND SEARCH THE NEXT SET OF SYMBOLS
NUM: ANDI T,17 ;T HOLDS CHARACTER
TLNE F,CF+FPF
JRST NM1
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
DOLLAR: SKIPA T,[46+101-13] ;RADIX 50 $ TO BE
PERC: MOVEI T,47+101-13 ;PERCENT SIGN
LET: TLC F,SF+FPF ;EXPONENT IFF LTF'*FEF'*(T=105)*SF*FPF=1
TLZN F,LTF+FEF+SF+FPF
CAIE T,105 ; E
TLOA F,LTF
TLOA F,FEF
JRST LET1
TLZN F,MF
SKIPA W1,SYL
MOVN W1,SYL
MOVEM W1,FSV
CLEARM DEN
LET1: SUBI T,101-13 ;FORM RADIX 50 SYMBOL
LE1A: TLO F,SF+QF
LE2: SOSGE TEM ;IGNORE CHARACS AFTER 6
JRST L2
MOVEI W,50
IMULM W,SYM ;MULTIPLY BY RADIX 50
ADDM T,SYM ; AND ADD NEW CHAR INTO SYM
MOVEI T,"A"-13(T) ;CONVERT LETTERS BACK TO ASCII
IDPB T,CHP
JRST L2
NUM1: EXCH T,WRD2 ;FORM NUMBER AFTER $
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 NM1A
NM1A: MOVEI W2,0
MOVSI R,201400
NM1A1: TRZE W2,1
FMPR R,FT(W1)
JUMPE W2,NM1B
LSH W2,-1
SOJG W1,NM1A1
NM1B: MOVSI W1,211000(T)
FMPR R,W1 ;COMPUTE VALUE OF NEW DIGIT
FADRB R,FH ;ADD VALUE INTO FLOATING NO.
MOVEM R,SYL
AOJA T,LE1A
POWER: TLNN F,FEF
JRST L4 ;NO EXPONENT
CAIE W,PLUS
CAIN W,MINUS
TROE F,POWF
TRZA F,POWF
JRST (W) ; E+-
MOVE W2,DEN
CLEARM 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,LLOC
TLNE F,SF ;SYLLABLE STARTED
MOVE T,DEN
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
HLLZS NM1A
MOVEI T,45 ;RADIX 50 PERIOD
JRST LE2
IFE EDDT&SWFILE,<
PILOC: MOVEI T,SAVPI ;GET ADDRESS FOR $I>
QUANIN:;TLO T,(DDTINT) ;(FUTURE) FLAG DDT INTERNAL REGISTERS
JRST QUAN1
QUAN: TLNN F,CCF ;$Q OR $$Q, WHICH?
SKIPA T,LWT ;$Q STRAIGHT
QUANSW: MOVS T,LWT ;$$Q SWAPPED (ALSO FOR $V)
QUAN1: MOVEM T,SYL
QUAN2: TLO F,SF+QF ;WRD,SYL STARTED
TLZ F,CF+CCF
JRST L2
CONTRO: ;SOME KIND OF ALTMODE
IFN EDDT&SWEXEC,< MOVEI T,"$" ;$
SKPUSR
PUSHJ P,TOUT ;TYPE OUT $
>
TLOE F,CF
TLO F,CCF
JRST L2
IFN EDDT&SWFILE,<PILOC==ERR>
SUBTTL SYMBOL TABLE LOGIC
;SYMBOL EVALUATION ROUTINE
EVAL: PUSHJ P,SYMSET ;SET UP SYM TABLE POINTER AND COUNT
EVAL2: TRZ F,PNAMEF!MDLCLF ;CLEAR FLAGS FOR EVAL
SETZM SYMPNT ;CLEAR LOCAL SYM POINTER
JUMPE S,CPOPJ ;XFER IF SYM TABLE EMPTY
JUMPGE R,CPOPJ ;XFER IF POINTER NOT VALID
EVAL3: MOVE T,(R) ;GET SYM FROM SYM TABLE
TLZN T,PNAME ;PROGRAM NAME? ALSO CLEAR THE FLAGS
JRST [JUMPE T,EVAL4 ;YES, IGNORE IF SYMBOL IS NULL
TRO F,PNAMEF ;SET PROGRAM NAME FLAG-MCO#D-533
JRST .+1]
CAMN T,SYM ;SYMBOL MATCH?
JRST EVAL6 ;YES
EVAL4: AOBJN R,.+1 ;NO VALID MATCH, CONTINUE LOOKING
AOBJN R,EVAL4A ;POINTER EXPIRED?
IFE EDDT&SWFILE,<
TRNN R,1B18 ;TEST FOR HIGH SEGMENT SYM TABLE
SKIPL R,SAVHSM ;WAS LOW SEG, GET HIGH SEG POINTER, IF ANY
>
MOVE R,@SYMP ;WRAP AROUND TO LOW SEG END OF TABLE
EVAL4A: AOJLE S,EVAL3 ;TRANSFER IF ANY SYMBOLS LEFT
SKIPE R,SYMPNT ;SEARCH FINISHED, ANY LOCAL SYMS OUTSIDE
;CURRENT PROGRAM AREA?
TRNE F,MDLCLF ;YES, WITH A UNIQUE VALUE?
POPJ P, ;NO, SEARCH FAILS
EVAL5: MOVE T,1(R) ;GET VALUE OF SYMBOL
CPOPJ1: AOS (P) ;FOUND SYMBOL, SKIP
CPOPJ: POPJ P,
EVAL6: MOVE T,(R) ;SYM MATCHES, GET FLAGS BACK
TLNE T,DELI ;IS SYMBOL DELETED FOR INPUT?
JRST EVAL4 ;YES
TLNN T,GLOBAL ;GLOBAL SYMS VALID ANYWHERE
TRNN F,PNAMEF ;HAS SECOND PROGRAM TABLE BEEN STARTED?
JRST EVAL5 ;LOCALS ALWAYS VALID IN CURRENT PROGRAM
SKIPN T,SYMPNT ;LOCAL OUTSIDE OF CURRENT PROGRAM
JRST EVAL7 ;YES, AND THE 1ST ONE OF THEM
MOVE T,1(T) ;GET VALUE OF PREVIOUS LOCAL
CAME T,1(R) ;IS IT THE SAME VALUE?
TRO F,MDLCLF ;NO, MULTIPLY DEFINED
EVAL7: MOVEM R,SYMPNT ;SAVE POINTER TO THIS LOCAL
JRST EVAL4 ;CONTINUE LOOKING FOR GLOBALS
;BIT 40 - DELETE OUTPUT
; 20 - DELETE INPUT
; 10 - LOCAL
; 04 -GLOBAL
; NO BITS - PROGRAM NAME
;SYMBOL TABLE POINTER AND COUNT SET UP ROUTINE
SYMSET: IFE EDDT&SWFILE,<
MOVEI R,400000+.JBHSM ;TRY TO GET HIGH SEG SYM TABLE POINTER
IFN EDDT&SWEXEC,<SKPEXC> ;NO HI SYM TABLE POINTER IN EXEC MODE
PUSHJ P,FETCH
MOVEI T,0 ;NO HIGH SEGMENT
MOVEM T,SAVHSM ;SAVE HIGH SEG POINTER (OR 0)
>
HLLZ S,@SYMP ;GET WORD COUNT FOR LOW SEG TABLE
IFE EDDT&SWFILE,<
SKIPGE T ;IF .JBHSM .GT. 0, INVALID
ADD S,T ;ADD WORD COUNT FOR HIGH SEG TABLE
>
ASH S,-↑D19 ;PUSH TO RIGHT HALF AND DIVIDE BY 2
SKIPL T,PRGM ;GET $: POINTER, GOOD ONLY IF .LT. 0
JRST SYMS4 ;NOT GOOD, USE .JBSYM
IFE EDDT&SWFILE,<
TRNE T,1B18 ;POINTER FROM .JBSYM OR .JBHSM?
JRST [MOVE R,SEGNAM ;.JBHSM. DOES SEGMENT NAME MATCH?
SKIPGE T,SAVHSM ; AND ALSO GOOD .JBHSM?
CAME R,400000+.JBHNM
JRST SYMS4 ;NO .JBHSM OR HI SEG NAME MISMATCH
JRST SYMS2]
>
SKIPL T,@SYMP ;PRGM CAME FROM .JBSYM
JRST SYMS5 ;.JBSYM POINTER INVALID
SYMS2: HLRE R,T ;GET NEGATIVE LENGTH
SUB T,R ;GET LAST ADR OF TABLE
MOVS R,PRGM ;GET NEG. LENGTH FOR $: POINTER
ADD R,T ; AND CALCULATE STARTING ADR
HLL R,PRGM ; AND SET UP TABLE LENGTH
JUMPL R,CPOPJ ;NO, POINTER IS OK AS LONG AS IT IS .LT. 0
SYMS4: SKIPL R,@SYMP ;SET UP POINTER INTO LOW SEG TABLE
SYMS5: IFE EDDT&SWFILE,<
MOVE R,SAVHSM ;LOW SEG POINTER BAD, TRY HI SEG
>
IFN EDDT&SWFILE,<
MOVEI R,0
>
POPJ P,
SETNAM: SKIPGE R,@SYMP ;LOOK UP PROGRAM NAME FOR $:
PUSHJ P,SETSUB ;SEARCH LO SEG SYM TABLE
JUMPL R,SETN2 ;XFER IF NAME FOUND
IFE EDDT&SWFILE,<
MOVEI R,400000+.JBHSM
IFN EDDT&SWEXEC,<SKPEXC> ;NO HI SYM TABLE POINTER IN EXEC MODE
PUSHJ P,FETCH ;GET .JBHSM
JRST UNDEF ;NO HI SEG, NAME$: UNDEFINED
SKIPGE R,T ;IS HI SEG POINTER GOOD?
PUSHJ P,SETSUB ;YES, LOOK THRU HI SYM TABLE
>
JUMPGE R,UNDEF ;UNDEFINED IF NOT IN HI SEG
HRRI W,1B18 ;SET FLAG SHOWING HI SEGMENT
SETN2: MOVEM W,PRGM ;SAVE -WC IN LH, HISEG=1 FLAG IN RH
JRST RET ;DONE, THANK YOU
;SUBROUTINE TO SEARCH A SYM TABLE FOR A PROGRAM NAME
SETSB1: MOVE T,(R) ;ENTRY POINT IS "SETSUB"
CAMN T,SYM ;MATCH FOR PROGRAM NAME?
POPJ P, ;YES, RETURN WITH "ANSWER" IN W
ADD R,[2,,2] ;GO TO NEXT ENTRY
TLNN T,PNAME ;WAS LAST ENTRY A PROG NAME?
SETSUB: HLLZ W,R ;(ENTRY POINT) YES, SAVE POINTER TO HERE
JUMPL R,SETSB1 ;XFER IF ANY SYMBOLS LEFT
POPJ P, ;SEARCH FAILED, RETURN
KILL: TLNN F,LTF ;DELETE SYMBOLS
JRST ERR
PUSHJ P,EVAL
JRST KILL1
MOVE T,(R) ;GET SYM WITH FLAGS
TLO T,DELO ;ASSUME DELETE OUTPUT
TLNE F,CCF ;$$K?
MOVSI T,DELO!DELI!37777 ;MAKE SYM IMPOSSIBLE LOCAL, DELETED IN AND OUT
PUSHJ P,DSYMER ;DEPOSIT IF LEGAL, ELSE ?
KILRET: JRST RET ;USED AS A CONSTANT
KILL1: SKIPL R,@USYMP ;REMOVE UNDEFINED SYMS
JRST UNDEF
KILL1A: HLRE S,R ;GET LENGTH OF UNDEFINED TABLE, AND
ASH S,-1 ;DIVIDE BY 2 TO GET # OF ENTRIES
IFE EDDT&SWFILE,<
SETZM SAVHSM ;LOOK ONLY IN LOW SEG
>
KILL2: PUSHJ P,EVAL2
JRST RET
REPEAT 0,< ;IF ASSEMBLED OUT, DON'T ZERO CHAINED ADDRESSES
PUSH P,R
SKIPL R,1(R) ;CHAINED REQUEST?
JRST KILL4 ;YES
KILL3: POP P,R >
PUSHJ P,REMUN
MOVE R,@USYMP ;START TABLE SEARCH OVER
JRST KILL1A
REPEAT 0,< ;IF ASSEMBLED OUT, DON'T ZERO CHAINED ADDRESSES
KILL4A: SKIPE R,S ;GET CHAIN ADR, STOP IF 0
KILL4: PUSHJ P,FETCH ;GET NEXT ADR OF CHAIN
JRST KILL3 ;FAILED, QUIT SEARCHING LIST
HRRZ S,T ;SAVE CHAIN POINTER
HLLZS T ;GET RID OF CHAIN ADDRESS, AND
PUSHJ P,DEPMEM ; DEPOSIT BACK INTO MEMORY
JFCL ;IGNORE IF WRITE LOCKED SEG
JRST KILL4A >
REMUN: MOVE S,@USYMP ;REMOVE ONE UNDEFINED SYMBOL
MOVE T,(S) ;MOVE SYMBOL 2 LOCATIONS
PUSHJ P,DSYMER
MOVE T,1(S)
ADDI R,1
PUSHJ P,DSYMER
SUBI R,1
MOVE S,[2,,2]
ADDB S,@USYMP
POPJ P,
TAG: TLNN F,LTF ; NO LETTERS IS ERROR
JRST ERR ; GO SAY ERROR
TLNE F,FAF ; DEFINE SYMBOLS
JRST DEFIN ;A.LT.B:
TLNE F,CF ;DEFINE SYMBOL AS OPEN REGISTER
JRST SETNAM
MOVE W,LLOCO
HRRZM W,DEFV
DEFIN: PUSHJ P,EVAL ;DEFINED SYMBOL?
JRST DEF1 ;NO - DEFINE
MOVE T,0(R) ;YES, GET FLAGS FOR SYMBOL TYPE
TLNE T,PNAME ;PROGRAM NAME?
JRST DEF2 ;NO, REDEFINE SYMBOL
DEF1: SKIPL R,@SYMP ;DEFINE A NEW SYMBOL
IFE EDDT&SWFILE,<
JRST [MOVEI R,400000+.JBHSM
IFN EDDT&SWEXEC,<SKPEXC> ;NO HI SYM POINTER IN EXEC MODE
PUSHJ P,FETCH ;GET HI SEG SYM POINTER
JRST ERR ;THERE IS NO SYM POINTER ANYWHERE
SUB T,[2,,2] ;MAKE ROOM FOR ANOTHER ENTRY
PUSHJ P,DSYMER ; AND STORE IT BACK
MOVE R,T
JRST DEF1A]
>
IFN EDDT&SWFILE,<
JRST ERR
>
SUB R,[2,,2]
MOVEM R,@SYMP ;DECREMENT LO SEG SYM POINTER
DEF1A: SKIPL @USYMP ;DOES AN UNDEFINED TABLE EXIST?
JRST DEF2 ;NO
MOVE S,R
SOS R,@USYMP ;MOVE HI NUMBERED ENTRY ON UNDEFINED
MOVE T,1(S) ; TABLE TO LOW END
PUSHJ P,DSYMER
SOS R,@USYMP ;SAME FOR SECOND WORD
MOVE T,(S)
PUSHJ P,DSYMER
MOVE R,S ;GET DEFINED SYM POINTER BACK
DEF2: MOVSI T,GLOBAL
IORB T,SYM
PUSHJ P,DSYMER
MOVE T,DEFV
MOVEI R,1(R)
PUSHJ P,DSYMER
MOVE R,@USYMP
DEF3: JUMPGE R,RET ;PATCH IN VALUE FOR UNDEF SYM ENTRY
MOVE T,SYM
TLO T,GLOBAL ;UNDEFINED TABLE HAS GLOBAL ENTRIES
CAME T,(R)
JRST DEF4
PUSH P,R ;SAVE POINTER INTO UNDEF TABLE
SKIPL R,1(R) ;IS ENTRY AN ADDITIVE REQUEST?
JRST DEF7 ;NO, CHAINED IN RIGHT HALF
PUSHJ P,FETCH ;GET OBJECT CELL
JRST ERR
TLNN R,(STNEG) ;ADDITIVE OR SUBTRACTIVE?
SKIPA S,DEFV ;ADDITIVE
MOVN S,DEFV ;SUBTRACTIVE
TLNE R,(STLH) ;RIGHT OR LEFT HALF?
JRST [HRLZS S ;LEFT HALF
ADD T,S ;ADD INTO LEFT HALF
JRST DEF5]
ADD S,T ;RIGHT HALF, ADD HALVES
HRR T,S ; AND REPLACE RIGHT HALF
DEF5: PUSHJ P,DMEMER ;STORE RESULT BACK INTO MEMORY
DEF6: POP P,R ;GET UNDEF TABLE POINTER BACK
PUSHJ P,REMUN
DEF4: ADD R,[XWD 2,2] ;REMOVE THE NOW DEFINED SYMBOL
JRST DEF3
DEF7: JUMPE R,DEF6 ;JUMP IF ALL DONE
PUSHJ P,FETCH ;GET OBJECT CELL
JRST ERR
HRRZ S,T ;SAVE CHAIN POINTER
HRR T,DEFV ;REPLACE WITH NEW VALUE
PUSHJ P,DMEMER ; AND STORE BACK INTO MEMORY
HRRZ R,S ;LOOP TO END
JRST DEF7 ; OF CHAIN
SUBTTL
TEXI: PUSHJ P,TEXIN ;INPUT TEXT
TLNE F,CF ;$ IMPLIES SIXBIT INPUT
PUSHJ P,CONV6 ;CONVERT TO SIXBIT
MOVEM T,SYL
MOVEI W1,5
MOVEI T-1,0
PUSHJ P,TEXIN
CAIN T,33 ;NEW ALT MODE, ESCAPE
JRST QUAN2
TLNE F,CF
JRST SIXBIN
SKIPA
TEXI2: PUSHJ P,TEXIN
CAMN T,SYL
SOJA W1,TEXI3
ROT T,-7
LSHC T-1,7
SOJA W1,TEXI2
TEXI3: LSHC T-1,-43
JUMPL W1,QUAN1
LSH T,7
SOJA W1,.-2
SIXBI1: PUSHJ P,TEXIN ; INPUT TEXT (SIXBIT)
SIXBIN: PUSHJ P,CONV6 ;CONVERT TO SIXBIT
CAMN T,SYL
JRST SIXBI2
ROT T,-6
LSHC T-1,6
SOJA W1,SIXBI1
SIXBI2: MOVE T,T-1
JUMPL W1,QUAN1
LSH T,6
SOJA W1,.-2
CONV6: 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
POPJ P,
;***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,[XWD 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
ACCCF: MOVEI T,.-. ;LEFT HALF OF 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 ; FOR ",," GET LEFT HALF TOGETHER
HRLZM T,WRD ; AND PUT IT IN LEFT HALF
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
SUBTTL REGISTER EXAMINATION LOGIC
LINEF: PUSHJ P,DEPRA ;NEXT REGISTER
IFN EDDT&SWEXEC,<SKPUSR
JRST LI0 ;NO CARRIAGE RETURN IF EXEC MODE >
PUSHJ P,CRNRB ;TYPE CARRIAGE RETURN-RUBOUT MCO #D-626
JRST .+2
LI0: PUSHJ P,CRF
AOS T,LLOC
LI1: ;PUSHJ P,LINCHK ;TRUNCATE ADRS (UNLESS INSIDE DDT)
HRRZM T,LLOC
HRRZM T,LLOCO
PUSHJ P,PAD
MOVEI T,"/"
TLNE F,STF
MOVEI T,"!"
PUSHJ P,TOUT
LI2: TLZ F,ROF
PUSHJ P,LCT
MOVE R,LLOCO
PUSHJ P,FETCH
JRST ERR
TLO F,ROF
TLNE F,STF
JRST DD2
JRST CONSYM ;RETURN IS A POPJ
REPEAT 0,<
LINCHK: CAML T,[DDTINT SAVPI] ;TRUNCATE ADDRESSES
CAMLE T,[DDTINT BNADR+2]
HRRZS T
MOVEM T,LLOC
MOVEM T,LLOCO
POPJ P,
>
VARRW: PUSHJ P,DEPRA ;↑
PUSHJ P,CRF
SOS T,LLOC
JRST LI1
CARR: PUSHJ P,DEPRA ;CLOSE REGISTER
IFN EDDT&SWEXEC,< SKPUSR
JRST DD1 ;NO NEED TO FLUSH CR IN EXEC MODE >
PUSHJ P,TIN
CAIN T,15
JRST .-2
JRST DD1.5
OCON: TROA F,LF1+CF1 ;OPEN AS CONSTANT
OSYM: TRZ F,CF1 ;OPEN SYMBOLICALLY
TROA F,LF1
SUPTYO: TLOA F,STF ;SUPPRESS TYPEOUT
SLASH: TLZ F,STF ;TYPE OUT REGISTER
TLNN F,QF ;WAS ANY QUANTITY TYPED?
JRST SLAS1 ;NO. DO NOT CHANGE MAIN SEQUENCE
MOVE R,LLOC ;YES. SAVE OLD SEQUENCE AND
MOVEM R,SAVLOC
HRRZM T,LLOC ;PUSHJ P,LINCHK ;TRUNCATE ADRS- SET UP NEW SEQUENCE
SLAS1: HRRZM T,LLOCO
JRST LI2
ICON: PUSHJ P,DEPRS ;BACKSLASH
JRST SLAS1
TAB: PUSHJ P,DEPRS ;OPEN REGISTER OF Q
MOVEI T,-1(T)
EXCH T,LLOC ;SET UP NEW SEQUENCE AND
MOVEM T,SAVLOC ;SAVE OLD SEQUENCE
HRROI T,700000 ;3 RUBOUTS
PUSHJ P,TEXTT
JRST LI0
DEPRA: MOVE R,SAVLOC
TLNE F,CF ;RESTORE OLD SEQUENCE IF $CR,$CF, 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,@USYMP ;GET POINTER TO ALL OLD UNDEF ITEMS
MOVEM W1,@USYMP ;INCLUDE THE NEW ITEMS IN UNDEF LIST
IFN EDDT&SWFILE,<
SKIPN CRASHS ;SEE IF /M
JRST DEPRS ;YES--NO UNDEF FIXUPS
>
MOVEM T,LWT ;SAVE T IN LWT, DEPRS DOES IT ANYWAY
DEPRA2: MOVE T,LWT ;RESTORE T
JUMPGE R,DEPRS ;IF JOBUSY SYM TABLE EDITED, STOP
PUSH P,R
MOVE W,1(R) ;GET FLAGS AND POINTER
JUMPG W,DPRS3 ;1B0=0 IMPLIES CHAINING
DEPRA4: POP P,R
HRRZ T,1(R) ;GET ADDRESS OF FIXUP
SKIPE T ;DELETE ENTRY IF ADR=0, OR
CAMN T,LLOCO ; IF ADR IS BEING CHANGED
PUSHJ P,REMUN ;REMOVE ENTRY FROM JOBUSY TABLE
ADD R,[2,,2] ;CONTINUE SEARCHING TABLE
JRST DEPRA2
DPRS3: HRROI S,1(R) ;GET 1ST CHAIN ADR FROM JOBUSY TABLE
; AND SET FLAG TO USE DEPSYM FIRST TIME
DPRS4: HRRZ R,W ;GET NEXT ADR (AFTER ADR IN S)
JUMPE R,DEPRA4 ;STOP ON 0 ADR
PUSHJ P,FETCH ;GET CONTENTS OF ADR IN R
HALT . ;******WHAT HAPPENS IF A DEPOSIT FAILS***
EXCH T,W
EXCH S,R
CAME S,LLOCO ;IS THIS WORD BEING CHANGED?
JRST DPRS4 ;NO, CONTINUE SEARCHING LIST
HRR T,W ;PATCH CHAIN ADR AROUND ITEM
TLNN R,-1 ;SEE IF NEED TO USE DEPSYM
TDZA TT1,TT1 ;NO--USE DEPMEM
MOVEI TT1,DEPSYM-DEPMEM ;YES. NOTE THAT R CAME FROM S
; WHICH HAS -1 IN LH FIRST TIME AROUND
; LOOP AND 0 OTHER TIMES.
PUSHJ P,DEPMEM(TT1) ;CALL EITHER DEPMEM OR DEPSYM
HALT .
JRST DPRS4 ;CONTINUE DOWN CHAIN
SUBTTL MODE CONTROL SWITCHES
TEXO: MOVEI R,TEXTT-HLFW ;$T ASSUME 7 BIT ASCII
MOVE T,WRD2
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
JRST BASE1
RELA: TRZE F,Q2F ;CHANGE ADDRESS MODE TO RELATIE
JRST BASECH
MOVEI R,PADSO-TOC
ABSA: ADDI R,TOC ;A
HRRZM R,AR
JRST BASE1
BASECH: MOVE T,WRD2 ;$NR CHANGE OUTPUT RADIX TO N, N>1
CAIGE T,2
JRST ERR
HRRZM T,ODF
BASE1: MOVS S,[XWD SCHM,SCH]
TLNN F,CCF
JRST LIS1
BLT S,ODFM ;WITH $$, MAKE MODES PERMANENT
JRST RET
SEMIC: MOVEM T,LWT ;SEMICOLON TYPES IN CURRENT MODE
JRST @SCH
EQUAL: TROA F,LF1+CF1 ;=
PSYM: TRZ F,CF1 ;@
TRO F,LF1
PUSHJ P,CONSYM
JRST RET
FIRARG: MOVEM T,DEFV
TLO F,FAF
JRST ULIM1
ULIM: TLO F,SAF
HRRZM T,ULIMIT
ULIM1: TLNN F,QF
JRST ERR
JRST LIS0
SUBTTL GO AND EXECUTE LOGIC
IFE EDDT&SWFILE,<
CNTRLZ: IFN EDDT&SWEXEC,<
SKPUSR ;SEE IF USER MODE
JRST ERR ;NO--ERROR >
MOVE T,[CALLI 1,12] ;GET MONRET
JRST XEC0 ;GO EXECUTE IT
GO: HRLI T,(JRST) ;G
IFN EDDT&SWEXEC,< SKPUSR
JRST XEC ;EXEC MODE HAS NO .JBSA >
TLOE F,QF ;DID USER TYPE ADDRESS?
JRST XEC0 ;YES
HRR T,.JBSA ;NO. GET ADDR FROM .JBSA
TRNE T,-1 ;IF C(.JBSA)=0, THEN "?"
XEC: TLNN F,QF ;X
JRST ,ERR
XEC0: MOVEM T,TEM
PUSHJ P,CRF
PUSHJ P,INSRTB
JSP T,RESTORE
XCT,TEM
XEC1: JRST [JSR SAVE ;INSTRUCTION DID NOT SKIP
PUSHJ P,REMOVB
JRST DD1] ;TYPE 1 CR-LF
JSR,SAVE ;INSTRUCTION SKIPPED
PUSHJ P,REMOVB
PUSHJ P,CRF ;TYPE 2 CR-LFEEDS
JRST DD1
>
IFN EDDT&SWFILE,<
BCOM==<XEC==<GO==ERR>>
>
SUBTTL ENTER AND LEAVE DDT LOGIC
IFE EDDT&SWFILE,<
SAVE: 0 ;SAVE THE ACS AND PI SYSTEM
IFN EDDT&SWEXEC,< MOVEM T,TEM ;FREE AN AC
JSP T,.+1 ;GET USR FLAG
XOR T,SAVPI ;COMPARE WITH OLD USR FLAG(LAST DDT EXIT)
TLNE T,(1B5) ;SAME?
SETZM SARS ;NO, SAVE AC'S AND PC FOR EXIT
; SO EXEC/USER MODE FLOP RESTORED AS ENTERED
JSP T,.+1 ;GET PC WORD AGAIN
ROT T,5 ;ROTATE USER MODE BIT TO SIGN
MOVEM T,USRFLG ; AND SAVE IT
HRRI T,XJBSYM ;GET EXEC SYMBOL POINTER ADR
SKIPGE T ;EXEC MODE?
HRRI T,.JBSYM ;NO, GET USER MODE SYM POINTER ADR
HRRM T,SYMP ; AND SAVE IT
HRRI T,XJBUSY ;GET EXEC UNDEF SYM TABLE POINTER ADR
SKIPGE T ;EXEC MODE?
HRRI T,.JBUSY ;NO, GET USER MODE UNDEF SYM POINTER ADR
HRRM T,USYMP ; AND SAVE RESULTING ADR
MOVE T,TEM ;RESTORE THE AC >
SKIPN SARS
JRST SAV1
AOS SAVE
JRST SAV5
SAV1: IFN EDDT&SWEXEC,<
SKPEXC
JRST SAV11
CONI PRS,SAVPI
CONO PRS, @SAVPI+1>
SAV11: MOVEM 17,AC17
HRRZI 17,AC0
BLT 17,AC0+16
MOVE T, SAVE
HLLM T, SAVPI
IFN EDDT&SWEXEC,<
SKPEXC
JRST SAV12 ;TRANSFER IF IN USER MODE
CONI T ;GET APR FLAGS
TRNE T,1B23 ;TEST NXM FLAG AND
TLO T,(1B0) ; MOVE IT TO BIT 0
MOVEM T,SAVAPR ;SAVE STATE OF APR REGISTER
SAV12: >
MOVEI P,PS ;SET UP PUSH DOWN POINTER
PUSHJ P,TTYRET ;INITIALIZE TTY
SAV5:
REPEAT 0,< ;WAIT FOR 5.3 RELEASE FOR THIS TEST
IFN EDDT&SWYANK,<SKPEXC ;IF IN USER MODE, RETURNING FROM $G,$P
SKIPN COMAND ;AND A COMMAND FILE WAS OPEN
JRST SAV6
MOVEIT T,CM ;MAKE SURE A RELEASE HASN'T BEEN DMNE
CALLI T,4 ;DEVCHR
TRNN T,200000 ;DEVICE PAT STILL INITED?
SETZM COMAND ;NO, DONT READ ANY MORE
SAV6: > ;END IFN EDDT&SWYANK
> ;END OF REPEAT 0 CONDITIONAL
MOVEI F,0 ;INIT FLAG REGISTER
SETOM SARS ;FLAG PROTECTING SAVED REGISTERS
MOVEI P,PS
MOVE T,[XWD SCHM,SCH]
BLT T,ODF ;LOAD THE ACS WITH MODE SWITCHES
JRST @SAVE
;STILL UNDER EDDT&SWFILE
RESTOR: ;RESTORE ACS AND PI SYSTEM
HRRM T,SAVE
PUSHJ P,TTYLEV ;RESTORE STATUS OF CONSOL TTY (EXEC MODE)
MOVE T,SAVPI
TLZ T,010037 ;DON'T TRY TO RESTORE USER MODE FLAG
HLLM T, SAVE
IFN EDDT&SWEXEC,<
SKPEXC
JRST RESTR2
AND T, SAVPI+1
IORI T, 2000 ;TURN ON CHANNELS
MOVEM T, SAVPI>
RESTR2: HRLZI 17,AC0
BLT 17,17
SETZM SARS
IFN EDDT&SWEXEC,< SKPEXC
JRST RESTR3 ;TRANSFER IF IN USER MODE
CONO 1B23 ;CLEAR NXM FLAG
CONO @SAVAPR ;RESTORE APR REGISTER
SKIPGE SAVAPR ;TEST MOVED NXM FLAG
MOVES -1 ;SET NXM FLAG
CONO PRS,@SAVPI
RESTR3:>
JRST 2,@SAVE
SUBTTL BREAK POINT LOGIC
;STILL UNDER EDDT&SWFILE
BP1: REPEAT NBP,< 0 ;JSR TO HERE FOR BREAKPOINT
JSA T, BCOM
0 ;HOLDS INSTRUCTION WHILE BREAKPOINT IS IN PLACE
>
B1INS=BP1+2
BPN=.-3
;STILL UNDER EDDT&SWFILE
BCOM: 0
POP T,LEAV ;MOVE INSTRUCTION TO LEAV
MOVEI T,B1SKP-B1INS+1(T)
HRRM T,BCOM3 ;CONDITIONAL BREAK SETUP
MOVEI T,B1CNT-B1SKP(T)
HRRM T,BCOM2 ;PROCEDE COUNTER SETUP
MOVE T,BP1-B1CNT(T) ;GET PC WORD
HLLM T,LEAV1 ;SAVE FLAGS FOR RESTORING
EXCH T,BCOM ; ALSO SAVE PC WORD IN BCOM
BCOM3: SKIPE B1SKP ;ADDR MOD TO LOOK AT COND. INST.
XCT @.-1
BCOM2: SOSG B1CNT ;ADDR MOD TO LOOK AT PROCEED COUNTER
JRST BREAK
MOVEM T,AC0+T
LDB T,[POINT 9,LEAV,8] ;GET INSTRUCTION
CAIL T,264 ;JSR
CAILE T,266 ;JSA,JSP
TRNN T,700 ;UUO
JRST PROC1 ;MUST BE INTERPRETED
CAIE T,260 ;PUSHJ
CAIN T,256 ;XCT
JRST PROC1 ;MUST BE INTERPRETED
IFN EDDT&SWEXEC,<
MOVSI T,010000 ;DON'T TRY TO RESTORE USER MODE BIT
ANDCAM T,LEAV1 >
MOVE T,AC0+T
JRST 2,@LEAV1 ;RESTORE FLAGS, GO TO LEAV
LEAV1: XWD 0,LEAV
;STILL UNDER EDDT&SWFILE
BREAK: JSR SAVE ;SAVE THE WORLD
PUSHJ P,REMOVB ;REMOVE BREAKPOINTS
PUSHJ P,TTYCLR ;FLUSH WAITING TTY CHARACTERS FOR INPUT -MCO #D-343
SOS T,BCOM3
HRRZS T ;GET ADR OF CONDITIONAL BREAK INST
SUBI T,B1ADR-3 ;CHANGE TO ADDRESS OF $0B
IDIVI T,3 ;QUOTIENT IS BREAK POINT NUMBER
HRRM T,BREAK2 ;SAVE BREAK POINT #
MOVE W1,[BYTE (7) "$","0","B",76,0] ;PRELIMINARY TYPEOUT MESSAGE
REPEAT 0,<IFN EDDT&SWEXEC,<
SKPUSR
TRC W1,7←↑D15 ;IN EXEC MODE, TYPE "$NEG"
>>
SKIPG @BCOM2 ;TEST PROCEED COUNTER
TRO W1,76←1 ;CHANGE T TO /$0BGG/
DPB T,[POINT 4,W1,13] ;INSERT BREAK POINT # IN MESSAGE
PUSHJ P,TEXT2
MOVE T,BCOM
HLLM T, SAVPI ;SAVE PROCESSOR FLAGS
MOVEI T,-1(T)
PUSHJ P,PAD ;TYPE PC AT BREAK
HRRZ T,@BCOM3
HRRM T,PROC0 ;SETUP ADDRESS OF BREAK
HLRZ T,@BCOM3
JUMPE T,BREAK1 ;TEST FOR REGISTER TO EXAMINE
PUSHJ P,LCT ;PRINT TAB
HLRZ T,@BCOM3
PUSHJ P,LI1 ;EXAMINE REGISTER C($NB)LEFT
BREAK1: MOVSI S,400000
BREAK2: ROT S,.-. ;ROT BY # OF BREAK POINT
PUSHJ P,LISTEN ;DONT PROCEED IF TTY KEY HIT
TDNN S,AUTOPI ;DONT PROCEED IF NOT AUTOMATIC
JRST RET ;DONT PROCEED
JRST PROCD1
;STILL UNDER EDDT&SWFILE
PROCED: TLNN F,QF ;N$P ;PROCEED AT A BREAKPOINT
MOVEI T,1
MOVEM T,@BCOM2
HRRZ R,BCOM3
PUSHJ P,AUTOP
PROCD1: PUSHJ P,CRF
PROC0: HRRZI R,XEC1 ;MODIFIED TO ADDR OF BREAKPOINT
PUSHJ P,FETCH
JRST BPLUP1 ;ONLY GET HERE IF MEMORY SHRANK
MOVEM T,LEAV
PUSHJ P,INSRTB
JRST PROC2
PROC1: MOVE T,AC0+T
JSR SAVE
JFCL
MOVE T,BCOM ;STORE FLAGS WHERE "RESTORE"
HLLM T,SAVPI ; CAN FIND THEM
PROC2: MOVEI W,100
MOVEM W,TEM1 ;SETUP MAX LOOP COUNT
JRST IXCT5
;STILL UNDER EDDT&SWFILE
IXCT4:
IFN EDDT&SWEXEC,< SKPUSR
JRST IXCT41 ;INIT NOT SPECIAL CASE IN EXEC MODE >
SUBI T,041 ;IS UUO "INIT"?
JUMPE T,BPLUP
AOJGE T,IXCT6 ;DONT PROCEDE FOR INIT
;DONT INTERPRET FOR SYSTEM UUOS
IXCT41: MOVEM R,40 ;INTERPRET FOR NON-SYSTEM UUOS
MOVEI R,41
IXCT: SOSL TEM1
PUSHJ P,FETCH
JRST BPLUP ;BREAKPOINT LOOPING OR FETCH FAILED
MOVEM T,LEAV
IXCT5: LDB T,[POINT 9,LEAV,8] ;GET INSTRUCTION
CAIN T,254 ;DON'T DO ANYTHING TO JRST
JRST IXCT6
IXCT51: HRLZI 17,AC0
BLT 17,17
MOVEI T,@LEAV
DPB T,[POINT 23,LEAV,35] ;STORE EFFECTIVE ADDRESS
LDB W1,[POINT 4,LEAV,12] ;PICK UP AC FIELD
LDB T,[POINT 9,LEAV,8] ;PICK UP INSTRUCTION FIELD
MOVEI P,PS
CAIN T,260
JRST IPUSHJ ;INTERPRET PUSHJ
CAIN T,264
JRST IJSR ;INTERPRET JSR
CAIN T,265
JRST IJSP ;INTERPRET JSP
CAIN T,266
JRST IJSA ;INTERPRET JSA
MOVE R,LEAV
TRNN T,700
JRST IXCT4 ;INTERPRET UUO
CAIN T,256
JRST IXCT ;INTERPRET XCT
IXCT6: JSP T,RESTORE
LEAV: 0 ;INSTRUCTION MODIFIED
JRST @BCOM
AOS BCOM
JRST @BCOM
BPLUP: PUSHJ P,REMOVB ;BREAKPOINT PROCEED ERROR
BPLUP1: JSR SAVE
JFCL
JRST ERR
;STILL UNDER EDDT&SWFILE
IPUSHJ: DPB W1,[POINT 4,CPUSHP,12] ;STORE AC FIELD INTO A PUSH
HLL T,SAVPI ;PICK UP FLAGS
HLLM T,BCOM ;SET UP THE OLD PC WORD
MOVSI T,(1B4) ;TURN OFF BIS FLAG IN NEW PC WORD
ANDCAM T,SAVPI
JSP T,RESTORE ;RESTORE THE MACHINE STATE
CPUSHP: PUSH .-.,BCOM ;GETS MODIFIED IN AC FIELD
JRST @LEAV ;JUMP TO "E" OF THE PUSHJ
IJSA: MOVE T,BCOM ;INTERPRET JSA
HRL T,LEAV
EXCH T,AC0(W1)
JRST IJSR2
IJSR: MOVE T,BCOM ;INTERPRET JSR
HLL T,SAVPI ;SET UP THE OLD PC WORD
MOVSI W,(1B4) ;TURN OFF BIS IN NEW PC WORD
ANDCAM W,SAVPI
IJSR2: MOVE R,LEAV
PUSHJ P,DEPMEM
JRST BPLUP ;ERROR, CAN'T STORE
AOSA T,LEAV
IJSR3: MOVE T,LEAV
JRST RESTORE
IJSP: MOVE W,BCOM ;INTERPRET JSP
HLL W,SAVPI ;PICK UP PC WORD FLAGS
MOVEM W,AC0(W1) ;INSERT OLD PC WORD INTO AC
MOVSI T,(1B4) ;TURN OFF BIS FLAG IN NEW PC WORD
ANDCAM T,SAVPI
JRST IJSR3
;STILL UNDER EDDT&SWFILE
;INSERT BREAKPOINTS
INSRTB: MOVE S,[JSR BP1]
INSRT1: SKIPE R,B1ADR-BP1(S)
PUSHJ P,FETCH
JRST INSRT3
MOVEM T,B1INS-BP1(S)
MOVE T,S
PUSHJ P,DEPMEM
JFCL ;HERE ONLY IF CAN'T WRITE IN HIGH SEG
INSRT3: ADDI S,3
CAMG S,[JSR BPN]
JRST INSRT1
POPJ P,
;REMOVE BREAKPOINTS
REMOVB: MOVEI S,BNADR
REMOV1: MOVE T,B1INS-B1ADR(S)
SKIPE R,(S)
PUSHJ P,DEPMEM
JFCL ;HERE ONLY IF NO WRITE IN HIGH SEG
SUBI S,3
CAIL S,B1ADR
JRST REMOV1
POPJ P, ;MCO #D-343
; JRST TTYCLR ;FLUSH ALL TTY INPUT CHARACTERS MCO #D-343
;STILL UNDER EDDT&SWFILE
;ALL $B COMMANDS GET HERE IN FORM: <A>$<N>B
BPS: TLZE F,QF ;HAS <A> BEEN TYPED?
JRST BPS1 ;YES
TRZE F,Q2F ;NO, HAS <N> BEEN TYPED?
JRST BPS2 ;YES
MOVE T,[XWD B1ADR,B1ADR+1] ;NO, COMMAND IS $B - CLEAR ALL BREAKPOINTS
CLEARM B1ADR
BLT T,AUTOPI ;CLEAR OUT ALL BREAKPOINTS AND AUTO PROCEDE REGESTER
JRST RET
BPS1: MOVE R,T
PUSHJ P,FETCH ;CAN BREAKPOINT BE INSERTED HERE?
JRST ERR ;NO
PUSHJ P,DEPERR ; AGAIN NO
TRZN F,Q2F ;HAS <N> BEEN TYPED?
JRST BPS3 ;NO
TRO F,2 ;YES, PROCESS THE COMMAND A$NB
BPS2: MOVE T,WRD2
CAIL T,1
CAILE T,NBP
JRST ERR
IMULI T,3
ADDI T,B1ADR-3
TRZN F,2
JRST MASK2
EXCH R,T
JRST BPS5
;STILL UNDER EDDT&SWFILE
BPS3: MOVE T,R ;PUT THE BREAKPOINT ADR BACK IN T
MOVEI R,B1ADR ;PROCESS THE COMMAND A$B
BPS4: HRRZ W,(R)
CAIE W,(T)
SKIPN (R)
JRST BPS5
ADDI R,3
CAIG R,BNADR
JRST BPS4
JRST ERR
BPS5: MOVEM T,(R)
CLEARM,1(R)
CLEARM,2(R)
AUTOP: SUBI R,B1ADR ;AUTO PROCEDE SETUP SUBROUTINE
IDIVI R,3
MOVEI S,1
LSH S,(R)
ANDCAM S,AUTOPI
TLNE F,CCF
IORM S,AUTOPI
POPJ P,
> ;END EDDT&SWFILE
IFN EDDT&SWFILE,<BPS==<PROCEDE==ERR>>
SUBTTL MEMORY MANAGER SUBROUTINES
;DEPOSIT INTO MEMORY SUBROUTINE
DEPRS: MOVEM T,LWT ;DEPOSIT REGISTER AND SAVE AS LWT
MOVE R,LLOCO ;QUAN TYPED IN REGIS EXAM
TLZE F,ROF
TLNN F,QF
POPJ P,0
;CAIL R,DDT
;CAILE R,DDTEND-1
PUSHJ P,DEPMEM ;STORE AWAY
JRST ERR ;CAN'T STORE (IN DDT OR OUT OF BOUNDS)
POPJ P, ;RETURN
;DEPOSIT INTO MEMORY SUBROUTINE
IFE EDDT&SWFILE,<
DEPSYM:
DEPMEM: JSP TT1,CHKADR ;LEGAL ADDRESS?
JRST DEP4 ;YES BUT IN HI SEGMENT
TRNN R,777760
JRST DEPAC ;DEPOSIT IN AC
MOVEM T,(R)
JRST CPOPJ1 ;SKIP RETURN
DEPAC: MOVEM T,AC0(R) ;DEPOSIT IN AC
JRST CPOPJ1 ;SKIP RETURN
DEP4: MOVEI TT1,0
SETUWP TT1, ;IS HI SEGMENT PROTECTED? TURN OFF
POPJ P, ;PROTECTED, NO SKIP RETURN
MOVEM T,(R) ;STORE WORD IN HI SEGMENT
TRNE TT1,1 ;WAS WRITE PROTECT ON?
SETUWP TT1, ;YES, TURN IT BACK ON
JFCL
JRST CPOPJ1 ;SKIP RETURN
DSYMER: ;DEPOSIT FOR SYM TABLE ROUTINES
DEPERR:
>
DMEMER: PUSHJ P,DEPMEM ;DEPOSIT AND GO TO ERR IF IT FAILS
JRST ERR
POPJ P,
IFN EDDT&SWFILE,<
DSYMER: PUSHJ P,DEPSYM ;TRY SYMBOL TABLE DEPOSIT
HALT . ;GIVE UP
POPJ P, ;AND RETURN
DEPSYM: PUSH P,TT ;SAVE TWO LOCATIONS
PUSH P,TT1 ; TO PROTECT FILDDT
MOVE TT,FISPTR ;GET DEF POINTER
HLRE TT1,TT ;GET LENGTH
SUB TT,TT1 ;COMPUTE END OF SYMBOLS
TLZ TT,-1 ;CLEAR JUNK
SKIPL TT1,FIUPTR ;GET START OF UNDEF SYMBOLS
MOVE TT1,FISPTR ;FAILING THAT, GET START OF SYMBOLS
TLZ TT1,-1 ;CLEAR JUNK
CAIG TT1,(R) ;SEE IF TOO LOW
CAIGE TT,(R) ;OR TOO HIGH
HALT . ;YES--QUIT
POP P,TT1 ;OK--RESTORE TEMPS
POP P,TT ; AND PROCEDE
CAME T,(R) ;SEE IF DIFFERENT
SETOM CHGSFL ;YES--FLAG THAT SYMBOLS CHANGED
MOVEM T,(R) ;STORE NEW VALUE
JRST CPOPJ1 ;RETURN
DEPMEM: SKIPN PATCHS ;SEE IF PATCHING
JRST CPOPJ1 ;NO--GIVE NOOP
SKIPN CRASHS ;SEE IF CRASHING
JRST MONPOK ;NO--POKE MONITOR
PUSH P,T ;PRESERVE T
PUSHJ P,FETCH ;YES--GET WORD
JRST [POP P,T
POPJ P,]
POP P,T ;RESTORE WORD TO STORE
TLNN TT2,-1 ;SEE IF RESIDENT OR CURRENT WINDOW
JRST [CAME T,RSIDNT(TT2)
SETOM CHGRFL
MOVEM T,RSIDNT(TT2)
JRST DEPRET]
CAME T,CURENT(TT2)
SETOM CHGFLG
MOVEM T,CURENT(TT2)
DEPRET: JRST CPOPJ1 ;GIVE GOOD RETURN
MONPOK: PUSH P,T ;SAVE ARGUMENT
MOVEM T,POKER+2 ;SET AS NEW VALUE
HRRZM R,POKER ;SET ADDRESS
;NOTE--LAST TYPEOUT IS IN POKER+1
; SO THAT USER MUST KNOW WHAT
; HE IS CHANGING
MOVE T,[3,,POKER] ;GET POINTER
CALLI T,114 ;POKE. MONITOR
JRST ERR ;COMPLAIN IF WE CAN'T
POP P,T ;RESTORE VALUE
JRST CPOPJ1 ;SKIP RETURN
POKER: BLOCK 3 ;ARGUMENTS FOR POKING
;STILL UNDER EDDT&SWFILE
;HERE WHEN ↑Z TYPED TO CLOSE OUT
CNTRLZ: SKIPE CRASHS ;SEE IF NOT /M
SKIPN PATCHS ;OR NOT /P
JRST NOCHNZ ;RIGHT--JUST WRAP UP
SKIPN CHGSFL ;SEE IF SYMBOL TABLE CHANGED
JRST NOSCPY ;JUMP IF NOT
PUSHJ P,SYMPTR ;YES--REFETCH FILE POINTER
MOVE W1,FIUPTR ;PREPARE TO
MOVE R,T
JUMPGE W1,NOUCPY ;JUMP IF NONE
MOVE R,TT ; COPY UNDEF SYMS
OUCPY: MOVE T,(W1)
PUSHJ P,DMEMER
AOS R
AOBJN W1,OUCPY
NOUCPY: HRRZ T,TT ;GET START
HLL T,FIUPTR ;GET NEW LENGTH
PUSH P,R ;SAVE START OF SYMBOLS
HLRZ R,S ;GET LOCATION POINTER IS KEPT
PUSHJ P,DMEMER ;STORE NEW POINTER
HRRZ R,(P) ;START AT BEGINNING
MOVE W1,FISPTR ;PREPARE TO COPY SYMS
JUMPGE W1,NOSCP
OSCPY: MOVE T,(W1)
PUSHJ P,DMEMER
AOS R
AOBJN W1,OSCPY
NOSCP: POP P,T ;GET START
HLL T,FISPTR ;GET NEW LENGTH
HRRZ R,S ;GET LOCATION POINTER IS KEPT
PUSHJ P,DMEMER ;STORE NEW POINTER
;STILL UNDER EDDT&SWFILE
NOSCPY: SKIPL R,RSAVE ;SEE IF CURRENT WINDOW USED YET
SKIPN CHGFLG ;YES--SEE IF CHANGED
JRST NOCHNX ;NO--PROCEED BELOW
IFN LN.CUR-200,<
IMULI R,LN.CUR/200
>
USETO 1,1(R) ;POSITION
OUTPUT 1,CURLST ;WRITE IT
STATZ 1,740000
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
NOCHNX: SKIPN CHGRFL ;SEE IF RESIDENT CHANGED
JRST NOCHNY ;NO--PROCEED
USETO 1,1 ;YES--POSITION
OUTPUT 1,RSILST ;WRITE IT
STATZ 1,740000
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
NOCHNY: CLOSE 1, ;CLOSE OUTPUT
RELEAS 1, ;CLEAR CHANNEL
NOCHNZ: CALLI 12 ;EXIT WITHOUT RECOURSE
>
;FETCH FROM MEMORY SUBROUTINE
FETCH: IFE EDDT&SWFILE,<
JSP TT1,CHKADR ;LEGAL ADDRESS?
JFCL ;HIGH OR LOW OK FOR FETCH
TRNN R,777760 ;ACCUMULATOR?
SKIPA T,AC0(R) ;YES
MOVE T,(R) ;NO
JRST CPOPJ1 ;SKIP RETURN ONLY FOR LEGAL ADDRESS >
IFN EDDT&SWFILE,< SKIPN CRASHS ;CRASH.SAV EXIST?
JRST MONPEK ;NO - GO PEEK AT RUNNING MONITOR
HRRZ TT1,R ;STRIP OFF POSSIBLE COUNT
CAML TT1,MONSIZ ;IS LOC LARGER THAN FILE?
POPJ P, ;YES, ERROR RET
MOVEI TT2,(TT1) ;PRESET TT2
CAIGE TT2,LN.RES ;SEE IF RESIDENT
JRST RSDNT ;YES--GET FROM THERE
IDIVI TT1,LN.CUR ;TT1 HAD LOCATION
CAMN TT1,RSAVE ;IS LOC INCORE ?
JRST INCORE ;TT2=LOC
EXCH TT1,RSAVE ;UPDATE MEMORY
SKIPN CHGFLG ;SEE IF CHANGED
JRST NOCHNG ;JUMP IF NOT
IFN LN.CUR-200,<
IMULI TT1,LN.CUR/200
>
USETO 1,1(TT1) ;POSITION FOR OUTPUT
OUTPUT 1,CURLST
STATZ 1,740000
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
NOCHNG: SETZM CURENT ;CLEAR BUFFER SINCE MONITOR WON'T
MOVE TT1,[CURENT,,CURENT+1]
BLT TT1,CURENT+LN.CUR-1
MOVE TT1,RSAVE
IFN LN.CUR-200,<
IMULI TT1,LN.CUR/200 ;INCLUDE MULTIPLIER >
USETI 1,1(TT1) ;BLK 0 DOES NOT EXIST
INPUT 1,CURLST ;GET 16 BLKS
STATZ 1,740000
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
INCORE: TLO TT2,-1 ;FLAG CURRENT BLOCK
SKIPA T,CURENT(TT2)
RSDNT: MOVE T,RSIDNT(TT2)
JRST CPOPJ1
MONPEK: HRRZ T,R ;REMOVE COUNT
CALLI T,33 ;DO PEEK UUO
JRST CPOPJ1 ;RETURN VALUE IN AC T >
CHKADR: HRRZ TT,.JBREL ;GET HIGHEST ADDRESS IN LOW SEGMENT
IFN EDDT&SWEXEC,<
SKPUSR
JRST [CONO 1B23 ;IN EXEC MODE, CHECK FOR NXM
MOVE TT,(R) ;MAKE A TRIAL MEMORY REFERENCE
CONSO 1B23 ;TEST NXM FLAG
JRST 1(TT1) ;OK- LOW SEGMENT
POPJ P, ] ;NXM
>
CAIL TT,(R) ;CHECK FOR WITHIN LOW SEGMENT
JRST 1(TT1) ;ADDRESS IS OK IN LOW SEGMENT, SKIP RETURN
HRRZ TT,.JBHRL ;GET HIGHEST ADDRESS IN HIGH SEGMENT
TRNE R,400000 ;IS THE ADDRESS IN HIGH SEGMENT?
CAIGE TT,(R) ;IS THE ADR TOO BIG FOR HIGH SEGMENT?
POPJ P, ;NO,YES- ILL. ADR.
JRST 0(TT1)
SUBTTL BINARY TO SYMBOLIC CONVERSION
LOOK: MOVEM T,TEM ;SAVE VALUE BEING LOOKED UP
PUSHJ P,SYMSET ;SET UP SYM SEARCH POINTER AND COUNT
SETZM SYMPNT ;INIT "OUTSIDE LOCAL" FLAG
TRZ F,MDLCLF!PNAMEF ;INIT FLAGS
TLZ F,(1B0) ;CLEAR SYMBOL TYPED FLAG
MOVE T,TEM ;RESTORE VALUE BEING LOOKED UP
JUMPGE R,CPOPJ1 ;SKIP RETURN, NOTHING FOUND
LOOK1: MOVE W2,(R) ;GET FLAGS FOR SYMBOL
TLNE W2,DELI!DELO ;DELETED?
JRST LOOK3 ;YES, GET NEXT SYMBOL
TLNN W2,PNAME ;PROGRAM NAME?
JRST [JUMPE W2,LOOK3 ;YES, IGNORE NULL PROGRAM NAMES
TRO F,PNAMEF ;SET PROGRAM NAME FLAG
JRST LOOK3] ;GET NEXT SYMBOL
TLNN W2,GLOBAL ;NOT PROGRAM NAME. GLOBAL SYMBOL?
TRNN F,PNAMEF ;LOCAL SYMBOL. INSIDE SPECIFIED PROGRAM?
JRST LOOK5 ;CHECK FOR BEST VALUE SO FAR
CAIL T,20 ;NO OUTSIDE LOCALS LESS THAN 20 - MCO #D-366
CAME T,1(R) ;LOCAL OUTSIDE OF SPECIFIED PROGRAM. IS VALUE EXACT?
JRST LOOK3 ;NO, REJECT IT
SKIPN SYMPNT ;YES, IS THIS 1ST ONE?
JRST LOOK2 ;YES
XOR W2,@SYMPNT ;MASK THE TWO SYMBOLS AGAINST EACH OTHER
TDNE W2,[XWD 037777,-1] ;ARE THEY THE SAME SYMBOL?
TRO F,MDLCLF ;NO, VALUE HAS MANY SYMBOLS
LOOK2: HRRZM R,SYMPNT ;SAVE POINTER TO SYMBOL
LOOK3: AOBJN R,.+1
AOBJN R,LOOK3A ;ADVANCE POINTER TO NEXT SYM. ANY LEFT?
IFE EDDT&SWFILE,<
TRNN R,1B18 ;HIGH SEGMENT SEARCH?
SKIPL R,SAVHSM ;NO, SEARCH HIGH SEG TABLE , IF ANY
>
MOVE R,@SYMP ;NO, WRAP AROUND END OF TABLE
LOOK3A: AOJLE S,LOOK1 ;TRANSFER IF MORE SYMBOLS TO LOOK AT
SKIPE SYMPNT ;ANY GOOD LOCALS FOUND?
TRNE F,MDLCLF ;THAT ARE NOT MULTIPLY SYMBOLED?
JRST LOOK4 ;NO
MOVE W1,SYMPNT ;PICK UP POINTER TO SYMBOL
PUSHJ P,SPT0 ;YES, TYPE IT OUT
TLO F,(1B0) ;SET SYMBOL TYPED FLAG
MOVEI T,"#"
JRST TOUT ;TYPE # TO SHOW POSSIBLE AMBIGUITY
;TOUT EXITS WITH A POPJ P,
LOOK4: TLNE F,(1B0) ;ANY GOOD SYMBOLS FOUND?
SUB T,1(W1) ;YES, CALCULATE HOW FAR OFF
JRST CPOPJ1 ;SKIP RETURN SHOWING NOTHING TYPED
LOOK5: MOVE W,1(R) ;GET VALUE FROM TABLE
XOR W,T ;COMPARE SIGNS
JUMPL W,LOOK3 ;REJECT IF SIGNS DIFFERENT
MOVE W2,T
SUB W2,1(R) ;IS TABLE VALUE LARGER THAN DESIRED VALUE
JUMPL W2,LOOK3 ;REJECT IF YES
JUMPGE F,LOOK6 ;TRANSFER IF NOTHING FOUND YET
MOVE W,1(R) ;GET VALUE FROM TABLE
SUB W,1(W1) ;COMPARE WITH BEST VALUE SO FAR
JUMPLE W,LOOK3 ;REJECT IF WORSE
LOOK6: HRR W1,R ;SAVE AS BEST VALUES SO FAR
TLO F,(1B0) ;SET FLAG SHOWING SOMETHING FOUND
JUMPE W2,SPT0 ;IF PERFECT, TYPE IT OUT AND EXIT
JRST LOOK3 ;CONTINUE LOOKING
CONSYM: MOVEM T,LWT
IFN EDDT&SWFILE,<
MOVEM T,POKER+1 ;STORE FOR /P/M LOGIC>
TRNN F,LF1
JRST @SCH ;PIN OR FTOC
TRNE F,CF1
JRST FTOC
PIN: TLC T,700000 ;PRINT INSTRUCTION
TLCN T,700000
JRST INOUT ;IN-OUT INSTRUCTION OR NEG NUM
AND T,[XWD 777000,0] ;EXTRACT OPCODE BITS
JUMPE T,HLFW ;TYPE AS HALF WORDS
PUSHJ P,OPTYPE
MOVSI T,777000
AND T,LWT
TRNN F,ITF ;HAS INSTRUCTION BEEN TYPED?
PUSHJ P,LOOK ;NO, LOOK IN SYMBOL TABLE
TROA F,NAF ;INSTRUCTION TYPED, ALLOW NEG ADDRESSES
JRST HLFW ;NOT FOUND, OUTPUT AS HALFWORDS
PUSHJ P,TSPC
LDB T,[XWD 270400,LWT] ;GET AC FIELD
JUMPE T,PI4
HLRZ W,LWT
CAIL W,(JRST)
CAILE W,256777 ;IS INST BETWEEN JRST AND XCT?
JRST [PUSHJ P,PAD ;NO, PRINT SYMBOLIC AC
JRST PI3A]
PUSHJ P,TOC ;YES, PRINT NUMERIC AC
PI3A: MOVEI W1,","
PUSHJ P,TEXT
PI4: MOVE W1,LWT
MOVEI T,"@"
TLNE W1,20 ;CHECK FOR INDIRECT BIT
PUSHJ P,TOUT
HRRZ T,LWT
LDB W,[XWD 331100,LWT] ;INSTRUCTION BITS
CAIL W,240
CAILE W,247
JRST PI8 ;ALL (EXCEPT ASH,ROT,LSH) HAVE SYMBOLIC ADRS
TLNN W1,20
CAIN W,<JFFO>←-33
JRST PI8 ;JFFO AND @ GET SYMBOLIC ADDRESSES
PUSHJ P,PADS3A ;ONLY ABSOLUTE ADDRESSING FOR LSH, ASH, AND ROT
PI7: TRZ F,NAF
LDB R,[XWD 220400,LWT] ;INDEX REGISTER CHECK
JUMPE R,PADS1 ;EXIT
MOVEI T,"("
PUSHJ P,TOUT
MOVE T,R
PUSHJ P,PAD
MOVEI T,")"
JRST TOUT ;EXIT
PI8: PUSHJ P,PAD
JRST PI7
HLFW: REPEAT 0,< MOVE T,LWT
CAML T,[DDTINT SAVPI]
CAMLE T,[DDTINT BNADR+2]
SKIPA
JRST PAD>
HLRZ T,LWT ;PRINT AS HALF WORDS
JUMPE T,HLFW1 ;TYPE ONLY RIGHT ADR IF LEFT ADR=0
TRO F,NAF ;ALLOW NEGATIVE ADDRESSES
PUSHJ P,PAD
MOVSI W1,(ASCII /,,/)
PUSHJ P,TEXT2 ;TYPE ,,
HLFW1: HRRZ T,LWT
;PRINT ADDRESSES (ARG USUALLY 18 BITS BUT CAN BE 36 BITS)
PAD: ANDI T,-1
JRST @AR ;PADSO OR PAD1
PADSO: JUMPE T,FP7B ;PRINT A ZERO
PUSHJ P,LOOK
PADS1: POPJ P,0
MOVE W2,1(W1)
IFE EDDT&<SWEXEC!SWFILE>,<CAIGE T,100> ;IN USER MODE, PRINT NUMERIC IF SYMBOL OFF
IFN EDDT&<SWEXEC!SWFILE>,<CAIGE T,1000> ; BY 100(8) OR MORE- 1000(8) FOR EXEC DDT OR FILDDT
CAIGE W2,60
JRST PADS3
MOVEM T,TEM
JUMPGE F,PAD1
PUSHJ P,SPT0
MOVEI T,"+"
PADS1A: PUSHJ P,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
INOUT: TDC T,[XWD -1,400000] ;IO INSTRUCTION OR NEG NUM
TDCN T,[XWD -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
PUSHJ P,OPTYPE
PUSHJ P,TSPC
MOVSI T,077400
AND T,LWT
JUMPE T,PI4
PUSHJ P,LOOK ;LOOK FOR DEVICE NUMBER
JRST PI3A
MOVE T,TEM
LSH T,-30
PUSHJ P,TOC
JRST PI3A
MASK: TLNE F,QF
JRST MASK1
IFE EDDT&SWFILE,<
MOVEI T,MSK
MASK2: MOVEI W,1
MOVEM W,FRASE1
JRST QUANIN
>
IFN EDDT&SWFILE,<JRST ERR>
MASK1: MOVEM T,MSK
JRST RET
SUBTTL SEARCH LOGIC
EFFEC: TLO F,LTF
HRRZ T,T
WORD: MOVEI R,322000-326000 ;JUMPE-JUMPN
NWORD: ADDI R,326000+40*T ;JUMPN T,
HRLM R,SEAR2
TLZN F,QF
JRST ERR
SETCAM T,WRD
MOVSI T,FRASE-DEN-1 ;PREVENT TYPE OUT OF DDT PARTS
SETCMM FRASE(T)
AOBJN T,.-1
MOVE T,ULIMIT
TLNE F,SAF
TLO F,QF ;SIMULATE A $Q TYPED
PUSHJ P,SETUP
PUSHJ P,CRF
SEAR1: PUSHJ P,FETCH
JRST SEAR2B
TLNE F,LTF ;CHECK FOR EFFECTIVE ADDRESS SEARCH
JRST EFFEC0
EQV T,WRD
AND T,MSK
SEAR2: JUMPE T,SEAR3 ;OR JUMPN T
SEAR2A: AOS R,DEFV ;GET NEXT LOCATION
PUSHJ P,LISTEN ;ANYTHING TYPED?
CAMLE R,ULIMIT ;OR END OF SEARCH?
JRST SEARFN ;YES
JRST SEAR1 ;NO, LOOK SOME MORE
SEAR2B: MOVEI R,400000-1 ;MOVE UP TO HI SEGMENT
IORB R,DEFV ;PUT IN MEMORY TOO
TRNN R,400000 ;ALREADY IN HI SEGMENT?
JRST SEAR2A ;NO
SEARFN: SETCMM LWT ;COMPLEMENT BITS BACK AND STOP SEARCH
JRST DD1
SEAR3: MOVE R,DEFV
PUSHJ P,FETCH
JRST ERR
TLZ F,STF ;GET RID OF SUPPRESS TYPEOUT MODE
MOVE T,DEFV
PUSHJ P,LI1 ;CALL REGISTER EXAMINATION LOGIC TO TYPE OUT
PUSHJ P,CRF
SETCMM LWT
SETCMM TEM
SEAR4: JRST SEAR2A
EFFEC0: MOVEI W,100
MOVEM W,TEM
EFFEC1: MOVE W,T
LDB R,[POINT 4,T,17] ;GET IR FIELD
JUMPE R,EFFEC2
PUSHJ P,FETCH
JRST ERR
HRRZS T ;GET RID OF BITS IN LEFT IN ORDER
ADDI T,(W) ; PREVENT AROV WHEN ADDING ADDRESSES
EFFEC2: HRR R,T
TLNN W,20 ;INDIRECT BIT CHECK
JRST EFFEC3
SOSE,TEM
PUSHJ P,FETCH
JRST SEAR4
JRST EFFEC1
EFFEC3: EQV T,WRD
ANDI T,777777
JRST SEAR2
SETUP: TLNN F,QF ;QUANTITY TYPED?
MOVEI T,777777 ;NO, DEFAULT HIGH ADR IS TOP OF MEMORY
HRRZM T,ULIMIT ;SAVE LAST ADDRESS OF SEARCH
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
POPJ P, ;YES, RETURN
ZERO: TLNN F,CCF
JRST ERR
PUSHJ P,SETUP
HRRZ S,@SYMP ;GET 1ST ADR OF SYMBOL TABLE
HLRE W1,@SYMP ;GET LENGTH OF SYM TABLE
SUB W1,S ;GET NEG OF LAST ADR
MOVNS W1 ;GET POS LAST ADR
MOVEI T,0 ;0 TO STORE IN MEMORY
ZERO1: TRNN R,777760
JRST ZEROR ;OK TO ZERO AC'S
IFN EDDT&SWEXEC,<
SKPUSR
>
IFN EDDT&<SWEXEC!SWFILE>,<
JRST [CAIGE R,XZLOW
MOVEI R,XZLOW ;IN EXEC MODE, DON'T ZERO 20-40
JRST ZERO3 ] >
IFE EDDT&SWFILE,<
CAIGE R,ZLOW
MOVEI R,ZLOW ;DON'T ZERO 20 THRU ZLOW
ZERO3: CAIL R,DDTX
CAILE R,DDTEND
JRST .+2
MOVEI R,DDTEND ;DON'T ZERO DDT
CAML R,S
CAMLE R,W1
JRST .+2
HRRZ R,W1 ;DON'T ZERO SYMBOL TABLE
>IFN EDDT&SWFILE,<ZERO3:>
ZEROR: CAMLE R,ULIMIT ;ABOVE LIMITS?
JRST DD1 ;YES, STOP
PUSHJ P,DEPMEM ;DEPOSIT T
IFE EDDT&SWFILE,<
TROA R,377777 ;
AOJA R,ZERO1
TRNN R,400000 ;HI SEGMENT?
AOJA R,ZERO1 ;NO, KEEP GOING
>
JRST DD1 ;FINISH
IFN EDDT&SWFILE,<AOJA R,ZERO1>
SUBTTL OUTPUT SUBROUTINES
FTOC: ;NUMERIC OUTPUT SUBROUTINE
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
PUSHJ P,TOC0 ;TYPE LEFT HALF
MOVSI W1,(ASCII /,,/)
PUSHJ P,TEXT2 ;TYPE ,,
TOCS: MOVEI T,.-. ;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
PUSHJ P,TOC0
HLRZ T,0(P)
ADDI T,"0"
JRST TOUT
TOC4: MOVM A,T ;TYPE AS SIGNED DECIMAL INTEGER
JUMPGE T,TOC5
MOVEI T,"-"
PUSHJ P,TOUT
TOC5: PUSHJ P,FP7 ;DECIMAL PRINT ROUTINE
TOC6: MOVEI T,"."
JRST TOUT
;SYMBOL OUTPUT SUBROUTINE
SPT0: HRRZM W1,SPSAV ;SAVE POINTER TO TYPED SYM
SPT: ;RADIX 50 SYMBOL PRINT
LDB T,[POINT 32,0(W1),35] ;GET SYMBOL
SPT1: IDIVI T,50
HRLM W1,0(P)
JUMPE T,SPT2
PUSHJ P,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
MOVEI T,256
JRST TOUT
SYMD: ;$D ;DELETE LAST SYM & PRINT NEW
HRRZ R,SPSAV ;PICK UP POINTER TO LAST SYM
JUMPE R,ERR
MOVE T,(R) ;PICK UP SYMBOL
TLO T,DELO ;TURN ON "SUPPRESS OUTPUT" BIT
PUSHJ P,DSYMER ;STORE BACK IN SYMBOL TABLE
MOVE T,LWT
JRST CONSYM ;PRINT OUT NEXT BEST SYMBOL
;FLOATING POINT OUTPUT
TFLOT: MOVE A,T
JUMPGE A, TFLOT1
MOVNS A
MOVEI T,"-"
PUSHJ P,TOUT
TLZE A,400000
JRST FP1A
TFLOT1: TLNN A, 400
JRST TOC5 ;IF UNNORMALIZED, TYPE AS DECIMAL INTEGER
FP1: MOVEI B,0
CAMGE A,FT01
JRST FP4
CAML A,FT8
AOJA B,FP4
FP1A: MOVEI C,0
FP3: MULI A,400
ASHC B,-243(A)
SETZM TEM1 ;INIT 8 DIGIT COUNTER
SKIPE A,B ;DON'T TYPE A LEADING 0
PUSHJ P,FP7 ;PRINT INTEGER PART OF 8 DIGITS
PUSHJ P,TOC6 ;PRINT DECIMAL POINT
MOVNI A,10
ADD A,TEM1
MOVE W1,C
FP3A: MOVE T,W1
MULI T,12
PUSHJ P,FP7B
SKIPE,W1
AOJL A,FP3A
POPJ P,
FP4: MOVNI C,6
MOVEI W2,0
FP4A: ASH W2,1
XCT,FCP(B)
JRST FP4B
FMPR A,@FCP+1(B)
IORI W2,1
FP4B: AOJN C,FP4A
PUSH P,W2 ;SAVE EXPONENT
PUSH P,FSGN(B) ;SAVE "E+" OR "E-"
PUSHJ P,FP3 ;PRINT OUT FFF.FFF PART OF NUMBER
POP P,W1 ;GET "E+" OR "E-" BACK
PUSHJ P,TEXT
POP P,A ;GET EXPONENT BACK
FP7: IDIVI A,12 ;DECIMAL OUTPUT SUBROUTINE
AOS,TEM1
HRLM B,(P)
JUMPE A,FP7A1
PUSHJ P,FP7
FP7A1: HLRZ T,(P)
FP7B: ADDI T,260
JRST TOUT
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
FCP: CAMLE A, FT0(C)
CAMGE A, FT(C)
Z FT0(C)
FSGN: ASCII .E-.
ASCII .E+.
TEXTT: MOVE W1,T
TEXT: TLNN W1,774000 ;LEFT JUSTIFIED UNLESS LEFT CHAR IS NULL
LSH W1,35
TEXT2: MOVEI T,0 ;7 BIT ASCII TEXT OUTPUT SUBROUTINE
LSHC T,7
PUSHJ P,TOUT
JUMPN W1,TEXT2
POPJ P,
R50PNT: LSH T,-36 ;RADIX 50 SYMBOL PRINTER
TRZ T,3
PUSHJ P,TOC
PUSHJ P,TSPC
MOVEI W1,LWT ;SETUP FOR SPT
JRST SPT
SIXBP: MOVNI W2,6 ;SIXBIT PRINTER
MOVE W1,LWT
SIXBP1: MOVEI T,0
ROTC T,6
ADDI T,40
PUSHJ P,TOUT
AOJL W2,SIXBP1
POPJ P,
CRNRB: PUSHJ P,CRN ;TYPE A CARRIAGE RETURN FOLLOWED BY
MOVEI T,177 ; A RUBOUT MCO #D-626
JRST TOUT
CRN: MOVEI T,15 ;CARRIAGE RETURN
JRST TOUT
CRF: PUSHJ P,CRN
MOVEI T,12 ;LINE FEED
JRST TOUT
LCT: MOVEI T,11
IFN EDDT&SWEXEC,< SKPEXC >
JRST TOUT ;IN USER MODE, TYPE A TAB
IFN EDDT&SWEXEC,<
PUSHJ P,TSPC
PUSHJ P,TSPC >
TSPC: MOVEI T,40 ;SPACE
JRST TOUT
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
PUSHJ P,TOCA
CAIE AR,TOC
PUSHJ P,PIN
SOSG SVBT2
JRST BITT4
MOVEI T,","
PUSHJ P,TOUT
MOVE T+1,SVBT3
JRST BITT2
BITT4: POP P,LWT
POPJ P,
SVBTS: 0
SVBTS2: 0
SVBT3: 0
SVBT2: 0
SUBTTL PUNCH PAPER TAPE LOGIC
IFN EDDT&SWPTP,<IFN EDDT&SWEXEC,<
PUNCH: SKPEXC
JRST ERR ;PAPER TAPE STUFF ILLEGAL IN USER MODE
TLC F,FAF+QF
TLCE F,FAF+QF
JRST ERR ;ONE ARGUMENT MISSING
PUN2: ADDI T,1
HRRZM T,TEM1
SUB T,DEFV
JUMPLE T,ERR
PUN1: MOVEI T,4 ;PUNCH 4 FEED HOLES
PUSHJ P,FEED
TLNE F,CF ;PUNCH NON-ZERO BLOCKS?
JRST PUNZ ;YES
HRRZ R,DEFV
IORI R,37
ADDI R,1
CAMLE R,TEM1
MOVE R,TEM1
EXCH R,DEFV
MOVE T,R
SUB T,DEFV
HRL R,T
JUMPGE R,RET ;EXIT OR PUNCH
PBLK: MOVE T,R
SOS W,T ;INIT CHECKSUM
PUSHJ P,PWRD
PBLK1: PUSHJ P,FETCH
JRST ERR
ADD W,T
PUSHJ P,PWRD
AOBJN R,PBLK1
MOVE T,W
PUSHJ P,PWRD
JRST PUN1
;PUNCH NON-ZERO BLOCKS
PUNZ0: AOS DEFV ;LOOK AT NEXT WORD
PUNZ: HRRZ W,DEFV ;ENTER HERE - GET STARTING ADDRESS
MOVE R,W
SUB W,TEM1 ;CALCULATE NEGATIVE LENGTH
HRL R,W ;SET UP AOBJN POINTER
JUMPGE R,RET ;FINISHED?
CAMG R,[XWD -40,0] ;BLOCK LONGER THAN 40?
HRLI R,-40 ;YES, FIX IT UP
MOVSI W1,400000 ;W1 NEGATIVE MEANS FLUSH 0 WORDS
PUNZ2: PUSHJ P,FETCH ;GET WORD FROM MEMORY
JRST ERR
JUMPE T,[AOJA W1,PUNZ4] ;IF WORD IS 0, INDEX 0 WORD COUNTER
MOVEI W1,0 ;CLEAR 0 WORD COUNTER
PUNZ4: JUMPL W1,PUNZ0 ;FLUSH 0 WORD, GET ANOTHER
CAIL W1,3 ; NOSKIP FOR 3RD 0 WORD AFTER NON 0 WORD
AOSA R ;ADVANCE R TO LAST ADR+1
AOBJN R,PUNZ2
ADD W1,DEFV ;CALCULATE DEFV-R+W1=-WORD COUNT
SUB W1,R
HRLM W1,DEFV ;PUT -WC IN LEFT HALF OF FA
EXCH R,DEFV ;SAVE ADR FOR NEXT BLOCK, GET POINTER
JRST PBLK
LOADER: SKPUSR
TLNE F,QF
JRST ERR
MOVEI T,400
PUSHJ P,FEED
MOVE R,LOADE
LOAD1: MOVE T,0(R)
PUSHJ P,PWRD
AOBJN R,LOAD1
MOVEI T,20
LOAD2: PUSHJ P,FEED
JRST RET
BLKEND: SKPEXC
JRST ERR
TLNN F,QF ;BLOCK END
MOVE T,[JRST 4,DDT]
TLNN T,777000 ;INSERT JRST IF NO OPCODE
TLO T,(JRST)
PUSH P,T
MOVEI T,20
PUSHJ P,FEED
POP P,T
PUSHJ P,PWRD
PUSHJ P,PWRD ;EXTRA WORD FOR READER TO STOP ON
MOVEI T,400
JRST LOAD2
PWRD: MOVEI W1,6
PWRD2: ROT T,6
CONSZ PTPP,20
JRST .-1
CONO PTPP,50
DATAO PTPP,T
SOJG W1,PWRD2
POPJ P,0
FEED: CONSZ PTPP,20
JRST .-1
CONO PTPP,10
DATAO PTPP,FEED1
SOJN T,FEED
FEED1: POPJ P,0 ;ADDRESS USED AS A CONSTANT
LOADB:
PHASE 0 ;RIM10B CHECKSUM LOADER
XWD -16,0
BEG: CONO PTRR,60
HRRI AA,RD+1
RD: CONSO PTRR,10
JRST .-1
DATAI PTRR,@TBL1-RD+1(AA)
XCT TBL1-RD+1(AA)
XCT TBL2-RD+1(AA)
AA: SOJA AA,
TBL1: CAME CKSM,ADR
ADD CKSM,1(ADR)
SKIPL CKSM,ADR
TBL2: JRST 4,BEG
AOBJN ADR,RD
ADR: JRST BEG+1
CKSM=ADR+1
DEPHASE
LOADE: XWD LOADB-.,LOADB
>> ;END OF IFN EDDT&SWPTP
;FOR PAPER TAPE IO
SUBTTL TELETYPE IO LOGIC
IFN EDDT&SWEXEC,< ;EXECUTIVE MODE TELETYPE I/O
XTIN: PUSHJ P,XLISTE ;TELETYPE CHARACTER INPUT
JRST .-1
CAIE T,175
CAIN T,176
MOVEI T,33 ;CHANGE ALL ALT MODES TO NEW
CAIN T,177 ;RUBOUT?
JRST WRONG ;YES, TYPE XXX
TRNE T,140 ;DON'T ECHO CR,LF,ALT,TAB,BACK SPACE,ETC
XTOUT: CAIG T,04 ;DON'T TYPE EOT OR LOWER CHARS
POPJ P,
HRLM T,(P)
IMULI T,200401 ;GENERATE PARITY
AND T,[11111111]
IMUL T,[11111111]
HLR T,(P)
TLNE T,10
TRC T,200 ;MAKE PARITY EVEN
CONSZ TTYY,20
JRST .-1
DATAO TTYY,T
ANDI T,177 ;FLUSH PARITY
POPJ P,0
XLISTE:
IFN EDDT&SWYANK,<
SKIPE COMAND ;COMAND FILE?
JRST XPTRIN ;YES, READ IT
>
CONSO TTYY,40 ;NO, LISTEN FOR TTY
POPJ P,
DATAI TTYY,T
ANDI T,177
JRST CPOPJ1
XTTYRE: MOVEI T,3410
TTY1: MOVEI W2,40000
CONSZ TTYY,120
SOJG W2,.-1
CONI TTYY,SAVTTY
DATAI TTYY,W2
HRLM W2,SAVTTY
CONO TTYY,(T)
POPJ P,
XTTYLE: MOVE T,SAVTTY
TRZ T,160
TRO T,3600
TRNE T,10
TRZ T,200
JRST TTY1
; TTYCLR==CPOPJ
XTEXIN: PUSHJ P,XTIN ;INPUT SUBROUTINE FOR TEXT MODES
TRNN T,140
JRST XTOUT ;ECHO CHARACTERS (0-37) NOT ECHOED
POPJ P,
>
IFN EDDT&4,< ;ASSEMBLE WITH OLD DDT MODE IO
TIN: MOVE T,POUTBF ;GET NEXT CHARACTER ROUTINE
CAME T,[POINT 7,INBFF]
PUSHJ P,FINOUT
IFE EDDT&SWFILE,< ILDB T,PINBFF >
IFN EDDT&SWFILE,< PUSHJ P,INCHR >
CAIE T,176
CAIN T,175
MOVEI T,33 ;CHANGE TO NEW ALT MODE
CAIN T,177 ;RUBOUT?
JRST WRONG ;YES PRINT XXX
JUMPN T,CPOPJ
MOVE T,[POINT 7,INBFF]
MOVEM T,PINBFF
CALL T,[SIXBIT /DDTIN/]
JRST TIN
TOUT: JUMPE T,CPOPJ ;OUT PUT A CHARACTER FLUSH NULLS
IFN EDDT&SWFILE,< SKIPE COMAND
JRST PUTCHR >
IDPB T,POUTBF
CAIE T,12
POPJ P,
TTYLEV:
FINOUT: MOVEI T,0
IDPB T,POUTBF
MOVE T,[POINT 7,INBFF]
MOVEM T,PINBFF
MOVEM T,POUTBF
CALL T,[SIXBIT /DDTOUT/]
CLEARM INBFF
POPJ P,
PINBFF: POINT 7,INBFF
POUTBF: POINT 7,INBFF
TTYCLR=CPOPJ
LISTEN=CPOPJ
INBFF: BLOCK 21
TTYRET: MOVE T,[POINT 7,INBFF]
MOVEM T,POUTBF
MOVEM T,PINBFF
CLEARM INBFF
POPJ P,
TEXIN=TIN ;USE NORMAL INPUT FOR TEXT WHEN IN USER MODE
>
IFE EDDT&4,< ;ASSEMBLE WITH TTCALL TELETYPE IO
OPDEF TTCALL [51B8]
TEXIN:
IFN EDDT&SWEXEC,< SKPUSR
JRST XTEXIN >
TIN:
IFN EDDT&SWEXEC,< SKPUSR
JRST XTIN >
IFN EDDT&SWYANK,< SKIPE COMAND ;COMMAND FILE?
PUSHJ P,PTRIN ;YES>
TTCALL 0,T ;GET NEXT CHARACTER INTO T
CAIE T,175
CAIN T,176
MOVEI T,33 ;CHANGE OLD ALT MODES TO NEW
CAIN T,177
JRST WRONG ;TYPE XXX FOR A RUBOUT
POPJ P,
TOUT:
IFN EDDT&SWEXEC,< SKPUSR
JRST XTOUT >
IFN EDDT&SWFILE,< SKIPE COMAND ;IS THERE A COMMAND FILE?
JRST PUTCHR ;YES >
TTCALL 1,T ;OUTPUT A CHARACTER
POPJ P,
LISTEN:
IFN EDDT&SWEXEC,< SKPUSR
JRST XLISTE >
IFE EDDT&SWFILE,<
IFN EDDT&SWYANK,<
SKIPE COMAND
JRST PTRIN>>
IFN EDDT&SWFILE,< ;FILDDT?
SKIPN COMAND ;STILL READING COMAND FILE?
; IF YES, DO NOT LOOK FOR INPUT
; 1. SPEED UP FILDDT AND
; 2. ALLOW USER TO TYPE AHEAD
; (ONE CONTROL C)
>
TTCALL 2,T ;GET NEXT CHAR, NO IO WAIT
POPJ P, ;NO CHARACTER EXISTED, RETURN
JRST CPOPJ1 ;CHARACTER WAS THERE, SKIP RETURN
IFN EDDT&SWEXEC,<
TTYRET: SKPUSR
JRST XTTYRET
POPJ P, >
IFE EDDT&SWEXEC,<TTYRET==CPOPJ>
TTYCLR:
IFN EDDT&SWEXEC,< SKPEXC >
TTCALL 11, ;FLUSH ALL
POPJ P, ;WAITING INPUT CHARACTERS
IFN EDDT&SWEXEC,<
TTYLEV: SKPUSR
JRST XTTYLEV
POPJ P, >
IFE EDDT&SWEXEC,<TTYLEV==CPOPJ>
> ;END OF IFN EDDT&4
SUBTTL DDT COMMAND FILE LOGIC
;START PAPER TAPE INPUT
IFE EDDT&SWYANK,<TAPIN=ERR>
IFN EDDT&SWYANK,<
TAPIN:
IFN EDDT&SWEXEC,< SKPEXC ;SKIP IF EXEC MODE
JRST UTAPIN ;USER MODE
CONSO PTRR,400 ;TAPE IN READER?
JRST ERR ;NO - ERROR
SETZM EPTPTR ;YES. INDICATE START READING IN
SETOM COMAND ;SHOW THERE IS A COMMAND FILE
JRST RET
> ;END IFN EEDT&1
UTAPIN:
HIADDR=W ; NEW JOB BOUNDARY(.JBREL)
CM=17 ;CHAN FOR COMMANDS
INIT CM,0 ; ASCII MODE
SIXBIT /DSK/ ;ALWAYS ON DEVICE DSK
XWD 0,CBUF ; ESTABLISH RING HEADER
JRST ERR ; NOT ASSIGNED, ERROR
TLNE F,QF ;NAME GIVEN?
SKIPA T,SYL ;YES. USE IT
IFE EDDT&SWFILE,<
MOVE T,[SIXBIT /PATCH/] ;NO, DEFAULT=PATCH
>
IFN EDDT&SWFILE,<
MOVE T,[SIXBIT /FILDDT/]
>
MOVEM T,COMNDS ;SAVE NAME IN LOOKUP BLOCK
LOOKUP CM,COMNDS ; LOOKUP CMD FILE(IN CASE DIR DEV)
JRST ERR ; NOT FOUND
MOVE T,.JBFF ; LOAD .JBFF
MOVEM T,SVJBFF ; AND SAVE IT
HRRZ T,.JBREL ; LOAD .JBREL
MOVEI HIADDR,2000(T) ; NEEDED, NOW PRPARE NEW .JBREL
IORI HIADDR,1777 ; NEW .JBREL TO ASK FOR
HRRZ TT,@SYMP ; BOTTM OF SYM TBL
HLRE TT1,@SYMP ; NEG LENGTH
SUB TT,TT1 ; TOP OF SYMBOL TBL
MOVEM TT,.JBFF ; ASSUME THIS NEW .JBFF AND SAVE IT
SUB T,TT ; COMPUTE WDS BETWEEN SYM TOP AND .JBREL
CAILE T,207 ; ENUFF FOR DSK BUFF+FUDGE FACTOR?
JRST HAVECM ; YES
CALLI HIADDR,11 ; NO, GET ANOTHER 1K
JRST ERR ; NOT AVIL, TREAT AS NO CMD FILE
HAVECM: SETOM COMAND ; FLAG CMD FILE FOUND
INBUF CM,1 ; 1 BUFFER ONLY
IFN EDDT&SWFILE,<
INIT DP,1 ;ALSO DO LISTING FILE
SIXBIT /LPT/
XWD LBUF,0
JRST [SETZM COMAND
JRST ERR]
MOVSI TT,'LST'
MOVEM TT,COMNDS+1
SETZM COMNDS+3
ENTER DP,COMNDS
JRST [SETZM COMAND
JRST ERR]
OUTBUF DP,2
>
JRST RET
> ;END IFN EDDT&SWYANK
IFN EDDT&SWYANK,<
IFN EDDT&SWEXEC,<
XPTRIN: PUSHJ P,PTRXNX ;GET NEXT CHAR FROM PTR
JRST PTRDON ;THROUGH
JRST PTRCHR ;PROCESS THE CHAR.
>
PTRIN: PUSHJ P,PTRNX ;GET NEXT CHAR
JRST PTRDON ;EOF ON COMMAND FILE
PTRCHR: CAIE T,177 ;RUBOUT?
SKIPN TT2,T ;NULL?
JRST PTRNXT ;IGNORE IT
IFN EDDT&SWEXEC,<
SKPEXC ;EXEC MODE?
JRST PTRCH2
CAIE T,15 ;YES. CR?
JRST CPOPJ1 ;NO. ECHO OF CHAR WILL HAPPEN LATER
PUSHJ P,CRN ;YES. ECHO CR-LF
PUSHJ P,PTRXNX ;READ (AND IGNORE) NEXT CHAR
JFCL ; WHICH OUGHT TO BE A LINE-FEED
MOVEI T,15 ;RETURN CR AS CHAR
JRST CPOPJ1
PTRCH2: >;END IFN EDDT&SWEXEC
CAIE T,33 ;ESCAPE?
CAIL T,175 ;ALT-MODE?
MOVEI T,"$" ;YES, ECHO "$"
PUSHJ P,TOUT ;ECHO CHAR
MOVE T,TT2 ;RESTORE T
JRST CPOPJ1 ;SKIP-RETURN WITH DATA
PTRNXT:
IFN EDDT&SWEXEC,< SKPUSR
JRST XPTRIN>
JRST PTRIN
;THROUGH WITH COMMAND FILE
PTRDON: SETZM COMAND
PUSHJ P,.+1 ;2 CR-LFS
PUSHJ P,CRF
POPJ P, ;NON-SKIP RETURN
;COMMAND FILE IO
PTRNX: SOSLE CBUF+2 ;DATA LEFT?
JRST PTRNX1 ;YES
INPUT CM, ;GET NEXT BUF
STATZ CM,740000 ;ERROR?
HALT .+1 ;TOO BAD
STATZ CM,20000 ;EOF?
JRST PTRNX2 ;YES
PTRNX1: ILDB T,CBUF+1
JRST CPOPJ1 ;SKIP-RETURN WITH DATA
PTRNX2: RELEASE CM, ;EOF - DONE
IFN EDDT&SWFILE,<
CLOSE DP,
RELEAS DP,
>
MOVE TT,SVJBFF
MOVEM TT,.JBFF ;RESET .JBFF
POPJ P, ;NON-SKIP MEANS DONE WITH COMMAND FILE
IFN EDDT&SWEXEC,<
PTRXNX: SKIPE TT2,EPTPTR ;DATA IN PTR BUF?
JRST PTRXN3 ;YES
MOVE TT2,[POINT 7,EPTRBF] ;NO SET UP TO STORE IN PTR BUFFER
SETZM EPTRBF ;SWITCH FOR END OF TAPE TEST
CONO PTRR,20 ;START PTR GOING
PTRXN1: CONSO PTRR,400 ;EOT?
JRST PTRXN4 ;YES
CONSO PTRR,10 ;DATA?
JRST PTRXN1 ;WAIT SOME MORE
DATAI PTRR,T ;READ A CHAR
JUMPE T,PTRXN1 ;IGNORE NULLS
PTRXN2: IDPB T,TT2 ;SAVE IN DATA BUFFER
CAIE T,12 ;LF
CAMN TT2,EPTRND ; OR BUFFER FULL?
SKIPA TT2,[POINT 7,EPTRBF] ;YES. START TAKING CHARS OUT OF BUF
JRST PTRXN1 ;NO - READ ANOTHER
CONO PTRR,0 ;SHUT OFF PTR BEFORE READING NEXT CHAR
PTRXN3: ILDB T,TT2 ;GET A CHAR
CAIE T,12 ;LF
CAMN TT2,EPTRND ; OR END OF BUFFER?
SETZ TT2, ;YES, START PTR FOR NEXT CHAR
MOVEM TT2,EPTPTR ;SAVE PNTR FOR NEXT CHAR
JRST CPOPJ1 ;HAVE A CHAR RETURN
;EOT
PTRXN4: SKIPN EPTRBF ;ANY DATA?
POPJ P, ;NO - DONE RETURN
SETZ T, ;YES - FILL REST OF BUFFER WITH 0'S
JRST PTRXN2
EPTPTR: 0
EPTRBF: BLOCK 5 ;BUFFER SO PTR WONT CHATTER
EPTRND: POINT 7,EPTRBF+4,34 ;PNTR FOR LAST CHAR IN BUF
> ;END IFN EDDT&SWEXEC
COMAND: 0
SVJBFF: 0
CBUF: BLOCK 3
COMNDS: SIXBIT /PATCH/
SIXBIT /DDT/
0
0
> ;END EDDT&SWYANK
IFN EDDT&SWFILE,<
PUTCHR: SOSLE LBUF+2 ;ANY ROOM?
JRST PUTOK ;YES
OUTPUT DP,
STATZ DP,740000 ;ERRORS?
HALT .+1 ;YES
PUTOK:
IDPB T,LBUF+1 ;DEPOSIT CHAR.
POPJ P,
> ;END OF IFN EDDT&SWFILE
SUBTTL DISPATCH TABLE
BDISP: POINT 12,DISP(R),11
POINT 12,DISP(R),23
POINT 12,DISP(R),35
DISP:
DEFINE D (Z1,Z2,Z3)< BYTE (12) Z1-DDTOFS,Z2-DDTOFS,Z3-DDTOFS
IFN <<Z1-DDTOFS>!<Z2-DDTOFS>!<Z3-DDTOFS>>&<-1,,770000>,
<PRINTX Z1, Z2, OR Z3 TOO LARGE FOR DISPATCH TABLE> >
;THIS MACRO PACKS 3 ADDRESSES INTO ONE WORD; EACH ADR IS 12 BITS
IFN <EDDT&<SWPTP!SWEXEC>>-<SWPTP!SWEXEC>,< PUNCH==ERR
BLKEND==ERR
LOADER==ERR>
D (ERR,ERR,ERR); (0)
D (CNTRLZ,ERR,ERR); (3)
D (ERR,ERR,VARRW); (6)
D (TAB,LINEF,ERR); (11)
D (ERR,CARR,ERR); (14)
D (ERR,ERR,ERR); (17)
D (PUNCH,ERR,ERR); (22)
D (ERR,ERR,ERR); (25)
D (ERR,ERR,CNTRLZ); (30)
D (CONTROL,ERR,ERR); (33)
D (ERR,ERR,SPACE); (36)
D (SUPTYO,TEXI,ASSEM); (41)
D (DOLLAR,PERC,ERR); (44)
D (DIVD,LPRN,RPRN); (47)
D (MULT,PLUS,ACCF); (52)
D (MINUS,PERIOD,SLASH); (55)
D (NUM,NUM,NUM); (60)
D (NUM,NUM,NUM); (63)
D (NUM,NUM,NUM); (66)
D (NUM,TAG,SEMIC); (71)
D (FIRARG,EQUAL,ULIM); (74)
D (QUESTN,INDIRE,ABSA); (77)
D (BPS,CON,SYMD); (102)
D (EFFEC,SFLOT,GO); (105)
D (HWRDS,PILOC,BLKEND); (110)
D (KILL,LOADER,MASK); (113)
D (NWORD,BITO,PROCEDE); (116)
D (QUAN,RELA,SYMBOL); (121)
D (TEXO,ERR,QUANSW); (124)
D (WORD,XEC,TAPIN); (127)
D (ZERO,OCON,ICON); (132)
D (OSYM,VARRW,PSYM); (135)
;THIS TABLE DOES NOT HAVE ENTRIES FOR CHARS .GE. 140; THESE
; ARE DETECTED AS ERRORS NEAR L21:
SUBTTL OP DECODER
;DESCRIPTION OF OP DECODER FOR DDT:
;
; THE ENTIRE INSTRUCTION SET FOR THE PDP-6 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-6. 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 INSTX N+1 GIVES THE NUMBER OF BITS IN INST; P GIVES THE
; POSITION (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 OR ARE THE EXTEND BYTE, 41-73(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) THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
; IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
; BY <1000-74*2+FIR.> FIRST.
;
;74(8)-777(8) THIS IS A TRANSFER BYTE. IF THE BYTE IN THIS RANGE IS
; CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE
; <A-74(8)+FIR.>RD BYTE IN THE TABLE.
;
;MACROS ASSEMBLE THE TABLE TBL:
; 1. A NUMBER FOLLOWED BY ↑ ASSEMBLES A DISPATCH BYTE. THE FIRST
; DIGIT IS THE POSITION; THE SECOND DIGIT IS THE SIZE.
; 2. A POINT (.) ASSEMBLES A STOP CODE.
; 3. A NAME FOLLOWED BY A SLASH ASSEMBLES A TRANSFER TO THE
; SYMBOLICALLY NAMED BYTE.
; 4. A STRING OF LETTERS TERMINATED BY A SPACE, COMMA, OR POINT,
; ASSEMBLE INTO A STRING OF BYTES, EACH BYTE BEING ONE LETTER.
;
;EXAMPLE OF BINARY TO SYMBOLIC DECODING:
; THE MACHINE CODE FOR JRST IS 254
; INST 0 1 0 1 0 1 1 0 0
; THE INTERPRETER STARTS WITH THE FIRST BYTE IN THE TABLE (63↑).
; THE RESULT OF APPLYING THIS TO C(INST) GIVES 2. SKIPPING OVER
; 2 BYTES IN THE TABLE AND INTERPRETING THE THIRD RESULTS IN
; HAK/ BEING INTERPRETED. AT HAK:, THERE IS A 33↑. APPLYING
; THIS TO C(INST) RESULTS IN 5 NON PRINTING BYTES BEING SKIPPED
; OVER:
; 1. MV/
; MOV PRINTING TEXT
; 2. MO/
; 3. ML/
; 4. DV/
; 5. SH/
;
;H1/ IS THE NEXT BYTE INTERPRETER. AT H1: 03↑ IS FOUND SO
;4 BYTES ARE SKIPPED OVER:
; EXC PRINTING TEXT
; 1. S3/
; BL PRINTING TEXT
; T PRINTING TEXT
; 2. .
; 3. AO/
; 4. AOB/
; THE NEXT LETTERS JRS ARE TYPED OUT. THEN T/ IS FOUND. AT
;T; A T IS TYPED OUT; THEN A "." IS FOUND AND EVERYTHING STOPS.
;
; THE TABLE IS ALSO USED GOING FROM SYMBOLIC TO BINARY BUT A
; TREE SEARCH METHOD IS USED.
REPEAT 0,<
DEFINE REDEF (XX)<
DEFINE INFO (AA,BB)<
AA XX'BB>>
DEFINE BYT9 (L)<
XLIST
REDEF %
ZZ==0
ZZZ==0
ZZM==1
IRPC L,<
Z=="L"
IFE Z-":",<INFO <>,<==CLOC>
IFNDEF FIR.,<FIR.==CLOC>
IFGE CLOC+73-1000-FIR.,<PRINTX OPTABLE TOO LONG>
Z==0>
IFE Z-"/",<IF1 <OUTP 1>
IF2,<INFO OUTP,+73-FIR.>
Z==0>
IFE Z-"↑",<OUTP <ZZ&70/2+ZZ&7-1>
Z==0>
IFE <Z-",">*<Z-".">*<Z-40>,<IFN ZZZ,<
REPEAT 5,<ZZ==ZZZ&77
IFN ZZ,<OUTP ZZ>
ZZZ==ZZZ/100>>
IFE Z-".",<OUTP 40>
Z==0>
IFN Z,<INFO REDEF,L
ZZ==ZZ*10+Z&7
ZZZ==ZZZ+<Z-40>*ZZM
ZZM==ZZM*100>
IFE Z,<REDEF %
ZZ==0
ZZZ==0
ZZM==1>>
LIST>
DEFINE OUTP (A)<
BINRY==BINRY*400+BINRY*400+A
BINC==BINC-1
IFE BINC,<EXP BINRY
BINRY==0
BINC==4>
CLOC==CLOC+1>
TBL: ;OPDECODER BYTE TABLE
BINRY==0
CLOC==0 ;SET BYTE LOCATION COUNTER TO 0
BINC==4 ;INIT BYTES/WORD COUNTER
BYT9 <63↑UUO/FLO/HAK/ACCP/BOOLE/H HWT/T ACBM/>
;IO INSTRUCTIONS
BYT9 <21↑BD/CON,11↑OI/S,01↑Z/O/>
BYT9 <BD:01↑BLK,IO/DATA,IO:11↑I/O/OI:01↑O/I/>
;UUOS
BYT9 <UUO:51↑.,32↑U40/U50/U60/21↑U703/11↑USET/01↑>
BYT9 <LOOKU,P/ENTE,R/USET:USET,01↑I/O/>
BYT9 <U40:03↑CAL/INI T/.....,CALL I/>
BYT9 <U60:21↑U603/01↑IN,BPUT/OUT,BPUT:11↑BU,F:F.,PU,T/>
BYT9 <U603:01↑U6062/STAT,11↑O:O.,Z:Z.,U6062:11↑S,U62/G,U62:ETST,S/>
;BYTE AND FLOATING INSTRUCTIONS
BYT9 <FLO:51↑BYTE/F 32↑ AD A/SB A/MP A/DV A:>
BYT9 <21↑LMB/R,IMB/LMB:02↑.,L:L.,M:M.,B:B.,BYTE:32↑.,I110//,I120/,03↑UF,PA/DF,N/>
BYT9 <FS C/IB P:P.,I LD/LD:LD B/I DP/DP:DP B/>
;FWT,FIXED POINT ARITH,MISC.
BYT9 <HAK:33↑MV/MV:MOV MO/ML/DV/SH/H1/JP/>
BYT9 <21↑ADD IMB/SU BIMB:B IMB:02↑.,I:I.,M/B/MO:22↑>
BYT9 <EIMS:E IMS/S IMS/N IMS/M IMS:02↑.,I/M/S:S.,>
BYT9 <ML:21↑I ML1/ML1:MUL IMB/DV:21↑I DV1/DV1:>
BYT9 <DI DV2:V IMB/H1:03↑EXC S3/BL T:T.,AO/AO:AOBJ,>
BYT9 <AOB/JRS T/JFC L/XC T/.AOB:01↑P/N/>
BYT9 <JP:03↑PU/PU:PUSH PUS/PO/PO:POP POP/JS,R:R.,>
BYT9 <JS P/JS PA:A.,JR PA/PUS:01↑J:J..,POP:>
BYT9 <01↑.,J/SH:02↑A S2/ROT S1/L S2:S S3:H S1/21↑JFF O/.,S1:21↑.,C:C.,>
;ARITH COMP,SKIP,JUMP
BYT9 <ACCP:42↑CA CA1/SJ/A JS/S JS:O 31↑>
BYT9 <J COMP/S COMP/CA1:31↑I COMP/M COMP/>
BYT9 <SJ:31↑JUM PSJ/SKI PSJ:P COMP:>
BYT9 <03↑.,L/E:E.,L E/PA/G E/N:N.,G.,>
;HALF WORDS
BYT9 <HWT:51↑HW1/21↑R HW2/L HW2:R HW3/HW1:>
BYT9 <21↑L HW4/R HW4:L HW3:32↑IMS/Z IMS/O IMS/EIMS/>
;TEST INSTRUCTIONS
BYT9 <ACBM:31↑AC1/01↑D AC2/S AC2/AC1:01↑R AC2/L,>
BYT9 <AC2:42↑N EAN/Z EAN/C EAN/O EAN:12↑.,E/PA/N/>
;BOOLEAN
BYT9 <BOOLE:24↑ST/AN:AND B2/AN/ST/AN/ST/>
BYT9 <X OR:OR B2/I OR/AN/EQ DV2/ST/OR/ST/OR/OR/>
BYT9 <ST:SET B2:24↑Z IMB/IMB/CA:C TA/TM:M IMB/>
BYT9 <CM:C TM/TA:A IMB/IMB/IMB/CB:C BIMB/IMB/CA/>
BYT9 <CA/CM/CM/CB/O IMB/>
;INSTRUCTION GROUP 120
BYT9 <I120:11↑ DMOV/ 01↑ FIX,FIX2/ 21↑.,FLT,FIX2: 21↑. R/>
BYT9 <DMOV:DMOV,01↑ E,EM// N,EM:21↑. M/>
;MORE UUO'S
BYT9 <U50:03↑OPE,N/TT,CAL:CAL L/...,RENAM,E/I,N/OU,T/>
BYT9 <U703:02↑CLOS,E/RELEA,S/MTAP,E/UGET,F/>
;INSTRUCTION GROUP 110 - DF ARITHMETIC
BYT9 <I110:21↑DF DF// ., DF:02↑AD.,SB.,M P/ DV.>
REPEAT BINC,<BINRY==BINRY*400+BINRY*400>
IFN BINRY,<EXP BINRY>
> ;END OF REPEAT 0
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: **************
BYT9 <
.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
.TXT H,.TRA HWT,.TXT T,.TRA ACBM
;IO INSTRUCTIONS
.DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
.ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
.ADR OI,.DIS 01,.TRA O,.TRA I
;UUOS
.ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
.DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
.TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
.ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
.ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
.ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
.ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
.ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S
;BYTE AND FLOATING INSTRUCTIONS
.ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
.TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
.DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
.ADR L,.END L,.TXT,.ADR M,.END M,.TXT
.ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.END,.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,.TRA DMOV,.DIS 01,.TXT FIX,.TRA FIX2,.DIS 21,.END
.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,.END,.ADR DF,.DIS 02
.END AD,.END SB,.TXT M,.TRA P,.END DV
;**********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>
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 ;SAVE PUSH DOWN LIST POINTER
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
OPEVAL: MOVEI T,0 ;EVALUATE FOR AN OP CODE
IDPB T,CHP ;INSERT NULL IN TEXT FOR SYMBOL
MOVEM P,SAVPDL
TRZA F,OUTF
OPTYPE: TRO F,OUTF ;TYPE AN OPCODE SYMBOLICALLY
LSH T,-33
MOVEM T,INST ;GET OPCODE INTO RIGHT 9 BITS
MOVE T,[XWD 440700,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 (AND EXTEND BYTES) WITHOUT COUNTING
SUBI T,40
JUMPE T,DECX ;TRANSFER ON ASTOP CODE
JUMPG T,DC2
DPB T,[XWD 340500,PNTR] ;SETUP R ON A DISPATCH BYTE
TRZ T,-4
AOS T
DPB T,[XWD 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) ;TOTAL SUBTRACTED NOW IS 73
JUMPL T,DECT ;TYPE OUT A LETTER
JUMPG T,DC3 ;XFER IF BYTE .GE. 74
ILDB T,W2 ;BYTE IS EXTEND BYTE (73), GET NEXT
MOVEI T,1000-74*2+1(T) ; BYTE AND ADD IN EXTENSION (-OFFSET)
DC3: MOVEI W1,FIR.-1(T) ;BYTE IS AN XFER (1ST XFER IS 74)
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
POPJ P, ;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
POPJ P, ;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)
PUSHJ P,TOUT ;OUTPUT A LETTER
CLEARM SPSAV ;SO $D WONT TRY TO DELETE OP CODES
JRST DC1
LIT
SUBTTL VARIABLE STORAGE
WRD: 0
WRD2: 0
PRNC: 0
FRASE: 0 ;DONT CHANGE ORDER, SEE SEARC+3
SYL: 0
LWT: 0
TEM2: 0
FRASE1:
TEM3: 0
DEN: 0
SAVHSM: BLOCK 1 ;C(.JBHSM), USED BY EVAL, LOOK
SEGNAM: 0 ;THE HIGH SEGMENT NAME (OR 0)
;WHEN $: IS SUCCESSFULLY DONE
PRGM: 0
ESTUT: 0
FSV: 0
FH: 0
SYM: 0
IFE EDDT&SWFILE,<
SYMP: Z .JBSYM ;POINTS TO LOW SEG SYM TABLE POINTER
USYMP: Z .JBUSY ;POINTS TO UNDEF SYM TABLE POINTER
>
IFN EDDT&SWFILE,<
SYMP: Z FISPTR
USYMP: Z FIUPTR
>
SYMPNT: 0 ;USED BY SYM TABLE SEARCHES
SPSAV: 0 ;POINTER TO LAST SYMBOL TYPED
DEFV: 0
ULIMIT: 0
LLOC: 0
LLOCO: 0
SAVLOC: 0 ;THE ADR OF OLD REGISTER EXAMINATION SEQUENCE
SYMORD: 0 ;HOLDS ADDRESSES OF EVAL-OPEVAL ROUTINES
;SPECIFYING WHICH ORDER TO SEARCH THEM FOR SYMBOLS
QLPNT: 0 ;USED IN "QLIST" AS POINTER TO A SYMBOL
IFE EDDT&SWFILE,<
SAVAPR: 0 ;USED TO SAVE APR REGISTER IN EXEC MODE
SAVPI: 0
1177
SAVTTY: 0
>
MSK: XWD -1,-1
IFE EDDT&SWFILE,<
B1ADR: 0
B1SKP: 0
B1CNT: 0
REPEAT NBP*3-3, < 0>
BNADR=.-3
AUTOPI: 0
AC0: BLOCK 17
AC17: 0
>
SCHM: EXP PIN ;DO NOT CHANGE ORDER
ARM: EXP PADSO
ODFM: EXP 10
SARS: 0
TEM: 0
TEM1: 0
IFN EDDT&SWEXEC,<USRFLG: 0 ;-1 IN USER MODE, 0 IN EXEC MODE >
IFN EDDT&SWFILE,< ;FILDDT STUFF
FWAZER:! ;START OF AREA TO ZERO
FILDEV: BLOCK 3 ;OPEN BLOCK FOR CRASH FILE
FILBLK: BLOCK 4 ;LOOKUP BLOCK FOR CRASH FILE
LBUF: BLOCK 3
SYMGET: Z ;-1 IF /S, 0 IF NOT
CRASHS: Z ;-1 IF CRASH.SAV ON DISK ,0 IF PEEK AT MONITOR
FDIDOT: Z ;-1 IF . TYPED IN, 0 IF NOT
PATCHS: Z ;-1 IF PATCHING MODE
CHGFLG: Z ;CHANGED CURRENT WINDOW
CHGRFL: Z ;CHANGED RESIDENT BLOCK
CHGSFL: Z ;CHANGED SYMBOL TABLE
AC0=.
AC17=.+17
RSIDNT: BLOCK LN.RES ;LOCS 0-777 ALWAYS IN CORE
CURENT: BLOCK LN.CUR ;WINDOW TO THE FILE ON DISK
RSAVE: BLOCK 1 ;INDEX OF THE CURRENT BLOCK. 0,1,...
LWAZER==.-1 ;END OF AREA TO ZERO
FISPTR: Z ;POINTER TO SYMBOLS
FIUPTR: Z ;POINTER TO UNDEF SYMS
RSILST: IOWD LN.RES,RSIDNT
Z
CURLST: IOWD LN.CUR,CURENT
Z
MONSIZ: BLOCK 1 ;HIGHEST LOC+1 IN CRASH.SAV FILE
;(USED SO WE WON'T EXAMINE PAST END)
SAVEFF: Z ;WHERE TO LOAD SYMBOLS IF /S
>
PS: BLOCK LPDL ;STORAGE FOR PUSH DOWN LIST
DDTEND: ;ONLY STARTING ADDRESS FOR FILDDT
;NO START ADDRESS FOR EXEC OR USER DDT
;BECAUSE USER PROGRAMS AND MONITOR ARE LOADED
;WITH EXEC OR USER DDT
;BUT STILL WANT TO BE STARTED AT THEIR OWN START ADDRESSES
IFN EDDT&SWFILE,<END DDT>
END