Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/smddt.mac
There is 1 other file named smddt.mac in the archive. Click here to see a list.
;MAINDEC-10-SMDDT
MCNVER=0
DECVER=2
TITLE SMDDT DECSYSTEM 2020 DIAGNOSTICS DDT, VERSION 0.2
;FIXED PROBLEM WITH KS-10 I/O INST AC FIELD TYPEIN, FEB 2,1978
;FIXED PROBLEM WITH VARIABLE HIGHER THAN 17000, DEC 29,1977
;MODIFIED EXEC TTY OUTPUT TO NOT CLEAR APR ASG, DEC 1,1977
;MODIFIED FROM KLDDT FOR THE KS-10
;MODIFIED FOR APPROP MUUO/JSYS OPERATION, JUNE 20,1977
;MODIFIED FROM <SYSTEM> DDT, APRIL 6,1977
;CHANGED TO ALLOW EXEC TO USE USER SYMBOL TABLE POINTERS
;AND ALLOW $G TO START PROGRAM FROM .JBSA
;SM10 EXEC MODE OPERATION CHANGED TO CONFORM TO DIAGNOSTICS PROCEDURES
;modified to output <cr><cr> for a single <cr>, 22 sep 77
;COPYRIGHT 1978
;DIGITAL EQUIPMENT CORPORATION
;MARLBORO, MASS. 01752
;JOHN R. KIRCHOFF
LOC 137
MCNVER,,DECVER
NOSYM
SALL
FTEXEC==-1
ABSDDT==10000,,0
LOC 441
JRST DDT ;EPT DDT START ADDRESS
SUBTTL DEFINITIONS
COMMENT \
TABLE OF CONTENTS FOR DDT
DEFINE DDT SYMBOLS
START DDT
DDT COMMAND PARSER
SYMBOL TABLE LOGIC
TEXT COMMANDS (" AND $")
REGISTER EXAMINATION LOGIC
MODE CONTROL SWITCHES
PATCH COMMAND -- PATCH BEGIN
PATCH COMMAND -- PATCH END
PAGE TABLE CONTROL ($U)
GO AND EXECUTE LOGIC
SINGLE STEP EXECUTE LOGIC
ENTER AND LEAVE DDT LOGIC
BREAK POINT LOGIC
MEMORY MANAGER SUBROUTINES
BINARY TO SYMBOLIC CONVERSION
SEARCH LOGIC
OUTPUT SUBROUTINES
PUNCH PAPER TAPE LOGIC
TELETYPE IO LOGIC
DDT COMMAND FILE LOGIC
DISPATCH TABLE
FANCY TERMINAL INPUT LOGIC
OP DECODER
VARIABLE STORAGE
STORAGE -- $X LOGIC AND PATCH COMMAND
STORAGE -- BREAKPOINTS
STORAGE -- SYMBOL TABLE LOGIC
STORAGE -- SAVE AREAS FOR PREVIOUS CONTEXT
STORAGE -- STATE VARIABLES
STORAGE -- PUSH DOWN LIST
\
;DDT VERSION IDENTIFICATION
$EDITN==177 ;EDIT NUMBER
$VERSN==37 ;VERSION NUMBER
%DDTVR==<$VERSN>B11+$EDITN ;COMPOSIT VERSION IDENT
;SWITCHES FOR DDT FEATURES
;FTEXEC ;EXEC MODE FACILITIES (ALSO RUNS IN USER MODE)
;FTPTP ;PAPER TAPE FACILITIES (EXEC MODE ONLY)
;FTFILE ;FILE DDT
;FTYANK ;PAPER TAPE INPUT FACILITIES ($Y)
;FTVMX ;BUILD DDT.VMX FOR TOPS10 VIRTUAL MEMORY
;FTDEC20 ;DEC20 FACILITIES
;FTMON ;DEC20 MONITOR DDT
;FTEDIT ;INCLUDE FANCY EDITING FEATURES WITH DEC20 EDDT
;ABSDDT ;RELOCATABLE ASSEMBLY IF 0, ABSOLUTE ASSEMBLY
;WITH ORIGIN GIVEN BY B0-17 OTHERWISE
IFNDEF ABSDDT,<ABSDDT==0>
IFNDEF FTEXEC,<FTEXEC==0>
IFNDEF FTPTP,<FTPTP==0>
IFNDEF FTFILE,<FTFILE==0>
IFNDEF FTYANK,<FTYANK==0>
IFNDEF FTVMX,<FTVMX==0>
IFNDEF FTDEC20,<FTDEC20==0>
IFNDEF FTMON,<FTMON==0>
IFNDEF FTEDIT,<FTEDIT==0>
;NORMALIZE ALL SWITCH VALUES TO 0 OR -1 SO BOOLEAN EXPRESSIONS IN
;CONDITIONALS WORK CORRECTLY.
DEFINE ..N (SW)<
IRP SW,<
IFN SW,<SW==-1>>>
..N <FTEXEC,FTPTP,FTFILE,FTYANK,FTVMX,FTDEC20,FTMON,FTEDIT>
; IFN FTDEC20,<
SEARCH MONSYM,MACSYM
OPDEF CALL [040B8]
OPDEF MRPAC [JSYS 772] ;>
IFE FTFILE,<INTERN %DDTVR>
EXTERN .JBREL,.JBSA,.JBHRL,.JBSYM,.JBFF,.JBHSM,.JBHNM,.JBUSY,.JBDA
IFE FTDEC20,<
IFN FTEXEC,<
; TITLE EDDT -EXEC MODE DDT >
IFN FTEXEC!FTFILE,<
XJBSYM==36
XJBUSY==32
XZLOW==40>
IFE FTEXEC,<
IFE FTFILE,<
TITLE UDDT -USER MODE DDT >
IFN FTFILE,<
TITLE FILDDT -FILE DDT
CT.RES==5 ;NUMBER OF PAGES TO KEEP IN CORE
MX.SIZ==^D1024 ;MAX PAGES IN FILE
T30SYM==131> ;SPMON (10/30)
> ;END IFE FTEXEC
ZLOW==140
INTERNAL .JBVER,.JBDDT
.JBDDT=74
.JBVER=137
IFE FTEXEC,<
LOC .JBVER ;DO NOT SET IF EXEC DDT(OK USER OR FILDDT)
%DDTVR ;PUT VERSION # IN .JBVER
>
IFE FTFILE!FTVMX,<
LOC .JBDDT
XWD DDTEND,DDTX
>
RELOC 0
IFE FTVMX,<IFN ABSDDT&<XWD -1,0>,<LOC <ABSDDT>B53>>
OPDEF PAGE. [CALLI 145] ;PAGING UUO
.GTUPM==100
> ;END IFE FTDEC20
IFN FTEXEC,<
OPDEF SKPUSR [SKIPL USRFLG] ;SKIP IN USER MODE
OPDEF SKPEXC [SKIPGE USRFLG] ;SKIP IN EXEC MODE
OPDEF SKPKA [SKIPG KAFLG] ;SKIP FOR KA10
OPDEF SKPKI [SKIPE KAFLG] ;SKIP FOR KI10
OPDEF SKPKL [SKIPL KAFLG] ;SKIP FOR KL10
OPDEF SKPNKL [SKIPGE KAFLG] ;SKIP NOT KL10
> ;END IFN FTEXEC
XLIST
SUBTTL MAKE TOPS20 DDT
IFN FTDEC20,<
;IN ADDITION TO DIFFERENT MONITOR CALLS AND PAGING CONVENTIONS,
;THE FOLLOWING FUNCTIONAL DIFFERENCES EXIST UNDER FTDEC20:
; 1. EVAL ALWAYS CALLED BEFORE OPEVAL - ALLOWS USER REDEFINITION
; OF BUILT-IN OPCODES.
; 2. PRESERVE PREVIOUSLY SAVED ACS WHEN SWITCHING USER/EXEC MODE.
; DEC20 DUMP PROCEDURE ASSUMES CRASH ACS ARE SAVED IN EDDT.
; 3. FORCE SAVE OF ACS ALWAYS WHEN ENTERING BREAKPOINT. HELPFUL
; WHEN UNKNOWN BREAKPOINT ENCOUNTERED BECAUSE SET BY
; ANOTHER PROCESS OR LEFT OVER FROM ABORTED DDT.
; 4. PRINT $ FOR EACH PC INCREMENT ON <INSTR>$X.
; 5. TRY FOR FULL-WORD MATCH ON BINARY TO SYMBOLIC CONVERSIONS.
; NECESSARY FOR CORRECT JSYS MNEMONIC PRINTOUT.
; 6. USE 1000 AS MAX SYMBOL OFFSET FOR RELATIVE LOCATION PRINTOUT.
ZLOW==20 ;LOWER LIMIT FOR $$Z
IFE FTEXEC,<
IFE FTMON,<
TITLE UDDT ;DEC20 USER DDT
INTERN PHDDT
RUNLOC==770000 ;RUNTIME LOCATION OF CODE
VARLOC==776000 ;RUNTIME LOCATION OF VARIABLES
;ONCE-ONLY CODE TO BLT DDT TO RUNTIME LOCATION. RUN IMMEDIATELY
;AFTER LOADING.
BLTDDT: MOVEI 1,.FHSLF
SETZB 2,3
SCVEC ;FLUSH PA1050 INFO
MOVE 2,[1,,DDT]
SEVEC ;SET PROPER ENTRY VECTOR
SETO 1,
MOVE 2,[.FHSLF,,700]
MOVE 3,[1B0+100]
PMAP ;CLEAR PAGES AROUND RUN LOCATION
MOVE 1,[PHDDT,,DDT]
BLT 1,DDT+DDTEND-PHDDT ;MOVE PROGRAM
MOVE 10,[PMAP] ;SETUP EXIT CODE IN ACS
MOVE 11,[HALTF]
SETO 1, ;SETUP TO CLEAR ALL PAGES
MOVE 2,[.FHSLF,,0]
MOVE 3,[1B0+700]
JRST 10 ;CLEAR MAP AND EXIT
LIT
> ;END OF USER DDT ONCE ONLY CODE
IFN FTMON,< ;MONITOR DDT ONCE ONLY CODE
TITLE MDDT ;DEC20 MONITOR DDT
INTERN MDDT,DDTSYM,DDTUSY
TWOSEG 400000
MDDT=DDT
DDTSYM=DDT+1
DDTUSY=DDT+2 ;PTR TO UNDEF SYMTAB
VARLOC==774000 ;PRIVATE STG AREA, 1 PAGE MAX
> ;END OF MDDT ONCE-ONLY CODE
PHDDT:
IFE FTMON,<
PHASE RUNLOC> ;PHASE IF USER VERSION ONLY
> ;END IFE FTEXEC
IFN FTEXEC,<
TITLE EDDT ;DEC20 EXEC DDT
INTERN DDT,DDTX>
> ;END IFN FTDEC20
LIST
SUBTTL DEFINE DDT SYMBOLS
IFN FTFILE,<
CM==2 ;DEFINE SOFTWARE CHANS.
DP==3
>
;DEFINE ACCUMULATORS
F=0 ;FLAGS
P=17 ;PUSH DOWN (SMDDT)
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)
; AND FOR DTE COMMUNICATIONS
;DEFINE PUSH DOWN LENGTH
LPDL==50 ;MAX LENGTH PUSH DOWN LIST
NXMKA==1B23 ;NON-EX-MEM FLAG FOR KA10
NXMKI==1B29 ;NON-EX-MEM FLAG FOR KI10
NXMKL==1B25 ;NON-EX-MEM FLAG FOR KL10
NXMKS==1B27 ;NON-EX-MEM FLAG FOR KS10
NBP==^D8 ;NUMBER OF BREAKPOINTS
IFN FTDEC20,<
LPDL==100
P=17> ;OVERRIDES P=1 ABOVE
T1=1
T2=2
T3=3
TRPENB==1B22 ;SAYS PAGING TRAPS ENABLED
;*** FLAGS IN F ***
FEF== 1B0 ;"E" FLAG
COMF== 1B1 ;COMMA TYPED
TIF== 1B2 ;TRUNCATE TO 18 BITS - SET BY SPACE OR COMMA
DVF== 1B3 ;DIVIDE
FPF== 1B4 ;"." TYPED
CCF== 1B5 ;"$$" TYPED
STF== 1B6 ;SUPPRESS TYPEOUT
SAF== 1B7 ;RIGHT ANGLEBRACKET TYPED
FAF== 1B8 ;LEFT ANGLEBRACKET TYPED
;== 1B9 ;NOT USED
MLF== 1B10 ;MULTIPLY
PTF== 1B11 ;ARITHMETIC OPERATOR TYPED
CF== 1B12 ;"$" TYPED
LTF== 1B13 ;LETTER TYPED IN CURRENT SYLLABLE
ROF== 1B14 ;REGISTER OPEN
SF== 1B15 ;SYLLABLE
MF== 1B16 ;MINUS SIGN TYPED
QF== 1B17 ;QUANTITY TYPED IN TO WORD ASSEMBLER
; 18-21 NOT USED
MDLCLF==1B22 ;MULT DEF LOCAL SYMBOL (EVAL)
PNAMEF==1B23 ;PROGRAM NAME SEEN IN SYM TABLE SEARCH
POWF== 1B24 ;ARGUMENT FOR EXPONENT COMING
LF1== 1B25 ;OUTPUT ONE REGISTER IN FORCED MODE
;== 1B26 ;NOT USED
CF1== 1B27 ;OUTPUT ONE REGISTER AS CONSTANT
NAF== 1B28 ;NEGATIVE ADDRESSES PERMISSABLE
; 29-32 NOT USED
OUTF== 1B33 ;OUTPUT
ITF== 1B34 ;INSTRUCTION TYPED
Q2F== 1B35 ;NUMBER TYPED AFTER $
;DEFINE SYMBOL TABLE SYMBOL TYPES
GLOBL==04B5 ;GLOBAL SYMBOL
LOCL==10B5
PNAME==74B5 ;PROGRAM NAME
DELI==20B5 ;DELETE INPUT
DELO==40B5 ;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 FTDEC20,<
IFE FTFILE,<
INTERN DDTEND ;DECLARE END OF DDT AS INTERNAL, FOR
; USER TO SEE (USER MODE) AND ONCE ONLY CODE
; (MONITOR)
IFE FTEXEC,< ENTRY DDT>
IFN FTEXEC,<
INTERNAL DDT
ENTRY DDTX>> ;NEEDED BY MONITOR
IFN FTEXEC!FTFILE,<
DEFINE OD(A,B),<
A=:<B,,0>>
;KL10 "FUNNY" I/O INSTRUCTIONS
OD APRID,700000 ;READ APR ID
OD WRFIL,700100 ;WRITE CACHE REFIL ALGORITHM
OD RDERA,700400 ;READ ERROR ADDRESS REGISTER
OD SBDIAG,700500 ;S-BUS DIAG
OD RDPERF,702000 ;READ PERF. COUNTER
OD RDTIME,702040 ;READ TIME OF DAY
OD RDMACC,702400 ;READ MBOX ACCOUNTING
OD RDEACC,702440 ;READ EBOX ACCOUNTING
OD WRPAE,702100 ;WRITE PERF. ANALYSIS ENABLES
OD SWPIA,701440 ;SWEEP INVALIDATE ALL
OD SWPVA,701500 ; " VALIDATE ALL
OD SWPUA,701540 ; " UNLOAD ALL
OD SWPIO,701640 ; " INVALIDATE 1 PAGE
OD SWPVO,701700 ; " VALIDATE 1 PAGE
OD SWPUO,701740 ; " UNLOAD 1 PAGE
> ;END IFN FTEXEC!FTFILE
;*CONSOLE TTY COMUNICATIONS
OPDEF CTYINI [JSR $TYINI] ;INITIALIZATION
OPDEF CTYCLR [JSR $TYCLR] ;CLEAR
OPDEF CTYTYI [JSR $CYTYI] ;INPUT
OPDEF CTYTYO [JSR $CYTYO] ;OUTPUT
OPDEF KTYTYI [JSR $KYTYI] ;INPUT
OPDEF KTYTYO [JSR $KYTYO] ;OUTPUT
OPDEF BTYTYI [JSR $BYTYI] ;INPUT
OPDEF BTYTYO [JSR $BYTYO] ;OUTPUT
$80STAT=31 ;8080 STATUS WORD
$80MM= 1B13 ;MAINTENANCE MODE BIT
$80CIW= 32 ;8080 TO KS-10 INPUT WORD
$80COW= 33 ;KS-10 TO 8080 OUTPUT WORD
$80KIW= 34 ;8080 TO KS-10 INPUT WORD - KLINIK
$80KOW= 35 ;KS-10 TO 8080 OUTPUT WORD - KLINIK
$80CHR= 1B27 ;CHAR AVAILABLE BIT
$80INT= 012000 ;INTERRUPT 8080
XLIST
SUBTTL WRITE DDT.VMX
IFN FTVMX,<
IFN FTFILE,<
PRINTX ?CAN NOT BUILD BOTH VMDDT AND FILDDT
END
>
IFN FTEXEC,<
PRINTX %BUILDING BOTH EDDT AND VMDDT
>
IFE ABSDDT&<-1B17>,<
PRINTX %VMDDT WITH AN OFFSET OF ZERO REQUESTED.
PRINTX % OFFSET OF 700000 WILL BE USED
ABSDDT==ABSDDT!7B2
>
DEFINE MERR (TXT)<
JRST [OUTSTR [ASCIZ "
? TXT
"]
EXIT]
>
MAKDDT: RESET
INIT 1,17
SIXBIT /DSK/
0
MERR CAN NOT INIT DEVICE DSK:
ENTER 1,DDTVMX
MERR CAN NOT ENTER DSK:DDT.VMX
OUT 1,IOWD
SKIPA
MERR OUTPUT ERROR WRITING DSK:DDT.VMX
CLOSE 1,
STATZ 1,740000
MERR OUTPUT ERROR CLOSING DSK:DDT.VMX
OUTSTR [ASCIZ "
DSK:DDT.VMX WRITTEN
"]
EXIT
DDTVMX: SIXBIT /DDT/
SIXBIT /VMX/
EXP 0,0
IOWD: IOWD DDTEND-DDT+1,DDTORG
EXP 0
XLIST ;MAKDDT LITERALS
LIT
LIST
DDTORG: PHASE ABSDDT_<-^D18>
>
> ;END IFE FTDEC20
LIST
SUBTTL START DDT
DDTOFS: ;OFFSET BASE FOR DISPATCH TABLES
IFE FTFILE,<
DDTX:
IFN FTYANK,<
SETZM COMAND ;INDICATE NO COMMAND FILE IF STARTING BY DDT COMMAND
>
REPEAT 0,<
DDT: IFN FTDEC20&<^-FTEXEC>,<
JRST .+2 ;SKIP SYMTAB PTRS
Z .DDSYM
JUMP .DDUSY
MOVEM T,SETRT1 ;SAVE AN AC
MOVE T,BP1+1
CAMN T,[JSA T,BCOM] ;VARIABLES AREA INITIALIZED?
JRST DDTIN1 ;YES
MOVE T,[PHVAR,,VARLOC] ;NO, DO IT
BLT T,VAREND-1
DDTIN1: MOVE T,SETRT1 ;RESTORE SCRATCH AC
> ;END IFN FTDEC20...
>
DDT: JRST .+2
ASCII /DDT/
JSR SAVE
PUSHJ P,REMOVB
IFN FTEXEC!FTDEC20,<
MOVE W1,[ASCII /DDT/]
IFN FTEXEC,<
SKPUSR
MOVE W1,[ASCII /EDDT/]
>
IFN FTMON,<
MOVE W1,[ASCIZ/MDDT/] ;IF TOPS-20 MDDT, SAY "MDDT"
>
PUSHJ P,TEXT2 ;TYPE MESSAGE SAYING WHICH DDT
> ;END FTEXEC!FTDEC20
> ;END FTFILE
IFN FTVMX,< ;IF THIS IS VMDDT
MOVE W1,[ASCII "VMDDT"] ;PREPARE TO SAY VMDDT
PUSHJ P,TEXT2 ;PRINT THE MESSAGE
> ;END VMDDT SWITCH
XLIST
SUBTTL FILDDT -- COMMAND SCANNER
IFN FTFILE,<
DDT: CALLI
SETZM COMAND ;CLEAR $Y FLAG
SETZM FWAZER ;CLEAR BLOCK OF STORAGE
MOVE T,[FWAZER,,FWAZER+1]
BLT T,LWAZER
MOVE P,[IOWD LPDL,PDL] ;PRESET PUSH DOWN LIST
MOVSI T,'DSK' ;PRESET DEVICE
MOVEM T,FILDEV+1
OUTSTR [ASCIZ /File: /]
SETOM DEPNCT ;PRESET DEPOSIT ERROR COUNT TO -1
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 FTFILE
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 FTFILE
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
\
BADEXE: OUTSTR [ASCIZ "
?BAD DIRECTORY IN .EXE FILE
"]
JRST FDIERE
;STILL FTFILE
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 FTFILE
;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 FTFILE
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 [HLRZ T,FILBLK+1
CAIE T,'XPN'
JRST FDIERF
MOVSI T,'EXE'
MOVEM T,FILBLK+1
MOVE T,(P)
MOVEM T,FILBLK+3
LOOKUP 1,FILBLK
JRST FDIERF
JRST .+1]
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,[IOWD 2003,WIND0
0] ;READ DIRECTORY
STATZ 1,740000 ;CHECK FOR ERRORS
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
HLRZ T,WIND0 ;GET FIRST WORD
CAIE T,1776 ;IS THIS IN .EXE FORMAT?
JRST FDIXPN ;NO--SEE IF .XPN FORMAT
SUBTTL FILDDT -- PROCESS .EXE FILE
;FILE IS IN .EXE FORMAT -- PROCESS DIRECTORY
HRRZ W1,WIND0 ;GET WORD COUNT
TRZN W1,1 ;IS WORD COUNT ODD?
JRST BADEXE ;NO--SOMETHING IS WRONG
LSH W1,-1 ;CONVERT TO # OF ENTRIES
MOVEI W2,WIND0+1 ;FIRST ENTRY
FDIXL0: HRRZ TT1,1(W2) ;GET PROCESS PAGE NUMBER
CAIL TT1,MX.SIZ ;OUT OF RANGE
JRST BIGEXE ;YES--FILE IS BIG
ADDI TT1,PAGTBL ;FIRST PAGTBL SLOT
MOVE TT2,(W2) ;GET ENTRY
LDB TT,[POINT 9,1(W2),8] ;GET COUNT
FDIXL1: TLNN TT2,1777 ;JUNK IN LH
CAIL TT1,PAGTBL+MX.SIZ ;IN TABLE?
JRST BADEXE ;BAD DIRECTORY
MOVEM TT2,(TT1) ;STORE IN PAGTBL
TRNN TT2,3777 ;ALLOCATED BUT ZERO?
SETZM (TT1) ;YES--GIVE A ? ON FETCH
ADDI TT1,1 ;INCREMENT POINTERS
TRNE TT2,3777 ;DO NOT CHANGE ALLOCATED BUT
; ZERO TO PAGE 1
ADDI TT2,1 ; ..
SOJGE TT,FDIXL1 ;LOOP OVER THIS ENTRY
ADDI W2,2 ;STEP TO NEXT ENTRY
SOJG W1,FDIXL0 ;LOOP OVER ENTRE DIRECTORY
JRST FDISET
FDIXPN: SETOM XPNFMT ;FLAG AS .XPN FORMAT
SKIPE WIND0 ;IN .XPN FORMAT
JRST [OUTSTR [ASCIZ /% Not in .XPN format
/]
SETZM SYMGET
JRST .+1]
MOVE T,MONSIZ ;SIZE OF FILE
ADDI T,777 ;ROUND UP
LSH T,-9 ;CONVERT TO PAGES
CAIL T,MX.SIZ ;TOO BIG
MOVEI T,MX.SIZ-1 ;YES--ROUND DOWN
FDIXPL: TLO T,(1B2) ;SET WRITEABLE BIT
MOVEM T,PAGTBL(T) ;STORE POINTER
TLZ T,-1 ;CLEAR FLAGS
SOJGE T,FDIXPL ;LOOP OVER WHOLE FILE
SUBTTL FILDDT -- SETUP SYMBOLS
;PAGTBL IS SETUP MOVE AC'S (IF ARROUND) AND START DDT
FDISET: SKIPE SYMGET ;SEE IF /S
PUSHJ P,SYMFIX ;YES--GO GET THEM
SKIPE CRASHS ;ARE WE LOOKING AT A CRASH
SKIPE PATCHS ; AND NOT PATCHING?
JRST FDIST1 ;NO--CONTINUE
SKIPE SYMGET ;GETTING SYMBOLS
JRST FDIST1 ;YES--LEAVE AC'S WHERE THEY ARE
MOVE T,[RADIX50 0,CRSHAC]
MOVEM T,SYM ;LOOKUP CRSHAC
PUSHJ P,EVAL ; IN SYMBOL TABLE
JRST FDIST1 ;CAN NOT FIND IT
MOVSI W1,-20 ;NUMBER OF AC'S
HRRI R,(T) ;WHERE THE AC'S ARE
FDIGAC: PUSHJ P,FETCH ;GET THE AC
JRST FDIST1 ;CAN NOT FETCH
MOVEM T,AC0(W1) ;STORE AC
ADDI R,1 ;POINT TO NEXT CELL
AOBJN W1,FDIGAC ;GET THE AC'S
OUTSTR [ASCIZ "[ACS COPIED FROM CRSHAC TO 0-17]
"]
FDIST1: 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
BIGEXE: OUTSTR [ASCIZ "?TOO MANY PAGES IN .EXE FILE
?REBUILD FILDDT WITH MX.SIZ SET LARGER
"]
JRST FDIERE ;PUNT
;STILL FTFILE
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 FTFILE
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 FTFILE
LIST
SUBTTL DDT COMMAND PARSER
DD1: PUSHJ P,CRF
DD1.5: TLZ F,(ROF) ;CLOSE ANY OPEN REGISTER
MOVE T,[XWD SCHM,SCH]
BLT T,ODF ;LOAD ACS
MOVS T,[SVBTS,,PSVBTS]
BLT T,SVBTS+2
DD2: CLEARM PRNC ;PARENTHESES COUNT
MOVE P,[IOWD LPDL,PDL]
LIS: SETZM WAKALL ;SET WAKEUP SET TO PUNCT AND CTRLS
IFN FTDEC20,<
MOVEI R,.JBSYM ;VALIDATE JOB DATA AREA - CHECK .JBSYM
PUSHJ P,FETCH
SETZ T, ;CAN'T REF PAGE 0, NO JOBDAT
SKIPL T ;VALID SYMTAB PTR?
SETZM JDTFLG#> ;NO, NOTE NO JOBDAT
SKIPGE R,@USYMP ;GET UND SYM PTR, OK?
PUSHJ P,FETCH ;MAYBE, SEE IF CAN REFERENCE IT
SETZM @USYMP ;NO GOOD, FLUSH IT
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 FTFILE,<
MOVEI R,.JBHSM ;IF LO ADR NOT OK, TRY HIGH
IFN FTEXEC,<SKPEXC> ; UNLESS IN EXEC MODE
PUSHJ P,HFETCH> ;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
TLZ F,(-1B17-ROF-STF) ;CLEAR FLAGS EXCEPT ROF, STF
TRZ F,LF1+CF1+ITF+Q2F ;CLEAR FLAGS
LIS0: TLZ F,(-1B17-ROF-STF-FAF-SAF) ;CLEAR FLAGS EXCEPT ...
TRZ F,NAF ; ..
SETZM WRD
LIS1: SETZM 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: SETZM SYL
L1RPR: SETZM SYM
MOVEI T,6
MOVEM T,TEM ;INIT SYMBOL COUNTER
MOVE T,[POINT 7,TXT]
MOVEM T,CHP ;SETUP FOR OPEVAL SYMBOL
SETZM DEN
SETZM WRD2
;CONTINUED ON NEXT PAGE
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
SETZM 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
JRST ERR
WRONG: MOVE W1,[ASCII /XXX/]
PUSHJ P,TEXT
JRST WRONG2
ERR: MOVSI W1,(BYTE (7)"?","G"-100) ;QUESTION-DING
JRST WRONG1
UNDEF: MOVEI W1,"U"
WRONG1: MOVE P,[IOWD LPDL,PDL]
PUSHJ P,TEXT
PUSHJ P,TTYCLR ;CLEAR INPUT BUFFER
WRONG2: TLNN F,(ROF) ;REGISTER OPEN?
JRST DD1 ;NO, CRLF. OTHERWISE, FALL INTO RET
RET: MOVE P,[IOWD LPDL,PDL]
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,(GLOBL)
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 FTFILE,<
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,(GLOBL) ; 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
XCT NM1A ;MOVEI W2,..
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 FTFILE,<
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
;HERE WHEN ESC TYPED
CONTRO: TLOE F,(CF)
TLO F,(CCF)
SETOM WAKALL ;SET WAKEUP ON EVERYTHING
JRST L2
IFN FTFILE,<PILOC==ERR>
SUBTTL SYMBOL TABLE LOGIC
;SYMBOL EVALUATION ROUTINE
EVAL: PUSHJ P,CSHVER ;GO SEE IF CACHE IS USEFUL
JRST EVALC4 ;ITS NOT. GO DO OLD STYLE LOOKUP
MOVSI S,-NSYMCS ;SCAN SYMBOL CACHE FIRST
EVALC1: SKIPN R,SYMCSH(S) ;GET POINTER
JRST EVALC3 ;NOT IN USE
MOVE T,0(R) ;GET SYM
TLZ T,(PNAME) ;FLUSH BITS
CAMN T,SYM ;SAME?
JRST EVALC2 ;YES, DONE
EVALC3: AOBJN S,EVALC1 ;KEEP LOOKING
EVALC4: PUSHJ P,SYMSET ;SET UP SYM TABLE POINTER AND COUNT
;CERTAIN CALLS ENTER HERE WITH S AND R ALREADY SETUP
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,0(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
JRST EVAL4]
CAMN T,SYM ;SYMBOL MATCH?
JRST EVAL6 ;YES
EVAL4: AOBJN R,.+1 ;NO VALID MATCH, CONTINUE LOOKING
AOBJN R,EVAL4A ;POINTER EXPIRED?
IFE FTFILE,<
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
SKIPN R,SYMPNT ;SEARCH FINISHED, ANY LOCAL SYMS OUTSIDE
POPJ P, ;CURRENT PROGRAM AREA?
TRNE F,MDLCLF ;YES, WITH A UNIQUE VALUE?
JRST ERR ;NO, AMBIGIOUS
EVAL5: HRRZ W1,R
PUSHJ P,SYMCSI ;ADD SYM TO CACHE
EVALC2: 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,(GLOBL) ;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 FTFILE,<
MOVEI R,.JBHSM ;TRY TO GET HIGH SEG SYM TABLE POINTER
IFN FTEXEC,<SKPEXC> ;NO HI SYM TABLE POINTER IN EXEC MODE
PUSHJ P,HFETCH
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 FTFILE,<
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 FTFILE,<
TRNE T,1B18 ;POINTER FROM .JBSYM OR .JBHSM?
JRST [PUSH P,T ;SAVE T
MOVEI R,.JBHNM ;NAME WORD
PUSHJ P,HFETCH ;GET FROM HISEG
SETCM T,SEGNAM ;SHOULD NEVER FAIL
MOVE R,T ;SAVE IN BETTER AC
POP P,T ;RESTORE T
CAME R,SEGNAM ;SAME HISEG?
JRST SYMS4 ;NO
JRST SYMS2] ;YES
>
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 FTFILE,<
MOVE R,SAVHSM ;LOW SEG POINTER BAD, TRY HI SEG
>
IFN FTFILE,<
MOVEI R,0
>
POPJ P,
SETNAM: SETZM PRGM ;FORGET OLD PROGRAM
PUSHJ P,CLRCSH ;CLEAR SYMBOL CACHE
SKIPGE R,@SYMP ;LOOK UP PROGRAM NAME FOR $:
PUSHJ P,SETSUB ;SEARCH LO SEG SYM TABLE
JUMPL R,SETN2 ;XFER IF NAME FOUND
IFE FTFILE,<
MOVEI R,.JBHSM
IFN FTEXEC,<SKPEXC> ;NO HI SYM TABLE POINTER IN EXEC MODE
PUSHJ P,HFETCH ;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
IFE FTFILE,<
HRRI W,1B18 ;SET FLAG SHOWING HI SEGMENT
MOVEI R,.JBHNM ;GET ADR OF HI SEG PROGRAM NAME
IFN FTEXEC,<SKPEXC>
PUSHJ P,HFETCH ; AND GO GET THE NAME
MOVEI T,0 ;NO HI SEG NAME, OR EXEC MODE
MOVEM T,SEGNAM > ;SAVE HI SEG NAME
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!37777B17) ;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 FTFILE,<
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
JRST ERR ;CAN'T MODIFY SYMTAB
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,DEPSYM
POPJ P, ;CAN'T MODIFY SYMTAB
MOVE T,1(S)
ADDI R,1
PUSHJ P,DSYMER
SUBI R,1
MOVE S,[2,,2]
ADDB S,@USYMP
JRST CPOPJ1
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 FTFILE,<
JRST [MOVEI R,.JBHSM
IFN FTEXEC,<SKPEXC> ;NO HI SYM POINTER IN EXEC MODE
PUSHJ P,HFETCH ;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 FTFILE,<
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,(GLOBL)
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,(GLOBL) ;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
JRST ERR ;CAN'T MODIFY SYMTAB
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 TEXT COMMANDS (" AND $")
TEXI: TRZE F,Q2F ;QUANT AFTER $ ?
JRST [MOVE T,WRD2 ;YES
CAIE T,5 ; $5" ?
JRST ERR ;NO, ONLY CASE KNOWN
MOVE T,SYM ;YES, TAKE PREVIOUS SYL AS RADIX50
TLZ F,(FPF+FEF+LTF) ;REINIT SYL
JRST QUAN1]
HRRZ T,LLOCO ;GET ADR OF OPEN REG
MOVEM T,TEM ;SAVE IT FOR LOCAL USE
PUSHJ P,TEXIN0 ;GET TERMINATOR
MOVEM T,SYL ;SAVE TERMINATOR
PUSHJ P,TEXIN ;GET FIRST CHARACTER
CAIN T,33 ;ESC?
JRST QUAN2 ;YES, EQUALS ONE ASCII/SIXBIT CHAR
PUSHJ P,TEXIN1 ;CONVERT TO SIXBIT IF NECESSARY
TEXI4: MOVE W1,[POINT 7,W] ;SETUP TO BUILD WORD IN W
TLNE F,(CF) ;SIXBIT?
HRLI W1,(POINT 6,0) ;YES, MODIFY BYTE POINTER
MOVEI W,0 ;INIT WORD TO 0
TEXI2: CAMN T,SYL ;REACHED TERMINATOR?
JRST [MOVE T,W ;GET LAST WORD
HRRZ R,TEM
CAMN R,LLOCO ;MULTIPLE-WORD INPUT?
JRST QUAN1 ;NO, JUST RETURN QUANTITY
PUSHJ P,PSHLLC ;YES, SAVE OLD LOC
MOVEM R,LLOC ;SET LOC TO END OF INPUT
MOVEM R,LLOCO
JRST QUAN1] ;GO USE AS QUANTITY
TLNN W1,(76B5) ;ROOM FOR ANOTHER BYTE IN WORD?
JRST TEXI3 ;NO
IDPB T,W1 ;YES, STORE IT
PUSHJ P,TEXIN0 ;GET ANOTHER INPUT CHARACTER
JRST TEXI2
;HERE WHEN WORD FULL
TEXI3: MOVSI W1,(POINT 0,0)
TLNN F,(ROF) ;REGISTER OPEN?
JRST TEXI2 ;NO, LOSE ANY ADDITIONAL INPUT
PUSH P,T ;SAVE CHARACTER
MOVE T,W ;GET FULL WORD
HRRZ R,TEM ;GET LOC OF NEXT REGISTER
PUSHJ P,DEPMEM ;STORE WORD
JRST ERR ;CAN'T
AOS TEM ;BUMP LOC
POP P,T ;RECOVER CHARACTER
JRST TEXI4 ;GO REINIT WORD AND CONTINUE INPUT
;GET INPUT CHARACTER, CONVERT TO SIXBIT IF NECESSARY
TEXIN0: PUSHJ P,TEXIN ;GET CHAR
TEXIN1: TLNN F,(CF) ;SIXBIT MODE?
POPJ P, ;NO
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: 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
XCT ACCCF ;MOVEI T,..
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)
LDB W1,[POINT 9,WRD,8]
CAIL W1,710 ;KS-10 I/O INSTRUCTION ?
CAILE W1,727
JRST .+2
LSH R,-1 ;YES, CORRECT AC FIELD
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
PUSHJ P,CRN ;DO CR ONLY
AOS T,LLOC ;BUMP LOC
LI1: ;PUSHJ P,LINCHK ;TRUNCATE ADRS (UNLESS INSIDE DDT)
HRRZM T,LLOC
HRRZM T,LLOCO
PUSHJ P,PAD
MOVEI T,"/"
CAME SCH,SCHM ;TEMP MODE SAME AS PERM?
JRST [CAIN SCH,FTOC ;NO, CONSTANT?
MOVEI T,"[" ;YES
CAIN SCH,PIN ;INSTRUCTION?
MOVEI T,"]" ;YES
JRST .+1] ;USE APPROPRIATE INDICATION
TLNE F,(STF)
MOVEI T,"!"
PUSHJ P,TOUT
LI2: TLZ F,(ROF)
PUSHJ P,LCT
MOVE R,LLOCO
PUSHJ P,FETCH
IFE FTDEC20,<
JRST ERR>
IFN FTDEC20,<
JRST [TLO F,(ROF) ;SAY REGISTER OPENED
MOVEI W1,"?" ;BUT ONLY TYPE "?"
JRST TEXT]>
TLO F,(ROF)
TLNE F,(STF)
JRST DD2
JRST CONSYM ;RETURN IS A POPJ
;CRLF AND OPEN NEXT REGISTER SUBROUTINE
LI0: PUSHJ P,CRF
AOS T,LLOC
JRST LI1
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
PUSHJ P,TIN ;GLOBBLE UP FOLLOWING LINEFEED
CARR1: SETZM CHINP ;REINIT INPUT LINE
SETZM CHINC
HRRZ T,LLOC ;GET CURRENT LOC
TLNE F,(CF) ; $ PRECEEDED?
JRST LI1 ;YES, GO OPEN REGISTER
JRST DD1.5
SLASH: TLNN F,(CCF) ; $$/ ?
JRST SLAS2 ;NO
SETCMM EFAFLG ;YES, COMPLEMENT EFF ADR FLAG
JRST RET ;OPEN NO REGISTER
OCON: TLNE F,(QF) ;QUANT TYPED?
MOVEI SCH,FTOC ;YES, CHANGE TEMP MODE TO CONSTANT
TRO F,LF1+CF1 ;OPEN AS CONSTANT
JRST SLAS2 ;TYPE
OSYM: TLNE F,(QF) ;QUANT TYPED?
MOVEI SCH,PIN ;YES, CHANGE TEMP MODE TO INSTRUCTION
TRZ F,CF1 ;OPEN SYMBOLICALLY
TROA F,LF1
SUPTYO: TLOA F,(STF) ;SUPPRESS TYPEOUT
SLAS2: TLZ F,(STF) ;TYPE OUT NOT SUPPRESSED
SLASH2: PUSHJ P,CEFF ;COMPUTE EFF ADR
TLNN F,(QF) ;WAS ANY QUANTITY TYPED?
JRST SLAS1 ;NO. DO NOT CHANGE MAIN SEQUENCE
PUSHJ P,PSHLLC ;PUSH OLD SEQUENCE
HRRZM T,LLOC ;SETUP NEW SEQUENCE
SLAS1: HRRZM T,LLOCO
JRST LI2
ICON: PUSHJ P,DEPRS ;BACKSLASH
PUSHJ P,CEFF ;COMPUTE EFF ADR
JRST SLAS1
TAB: PUSHJ P,DEPRS ;OPEN REGISTER OF Q
PUSHJ P,CEFF ;COMPUTE EFF ADR
MOVEI T,-1(T)
PUSHJ P,PSHLLC ;PUSH OLD SEQUENCE
MOVEM T,LLOC ;SETUP NEW SEQUENCE
HRROI T,700000 ;3 RUBOUTS
PUSHJ P,TEXTT
JRST LI0
;ROUTINE TO COMPUTE EFFECTIVE ADDRESS OF QUANTITY IN T. COMPUTATION
;IS PERFORMED USING USER PROGRAM VARIABLES.
; T/ QUANTITY
; PUSHJ P,CEFF
; RETURN +1 ALWAYS, T/ EFFECTIVE ADDRESS IN RH
;PRINTS "??" AND BOMBS OUT IF INDIRECT WORD NOT ACCESSIBLE
CEFF: SKIPE EFAFLG ;PERMANENT MODE CHANGED?
TLC F,(CF) ;YES, COMPLEMENT EFFECT OF ESC
TLZN F,(CF) ;ESC BEFORE COMMAND?
POPJ P, ;NO, USE RH ONLY
TLNN T,17 ;INDEXING?
JRST CEFF1 ;NO
PUSH P,T ;YES, SAVE QUANTITY
LDB R,[POINT 4,T,17] ;GET INDEX ADDRESS
PUSHJ P,FETCH ;FETCH CONTENTS OF XR
JFCL ;ASSUME AC'S ALWAYS ACCESSABLE
POP P,R ;RECOVER ORIGINAL QUANTITY
ADD T,R ;T=Y+C(XR)
HLL T,R ;KEEP ORIGINAL LH
CEFF1: TLNN T,(Z @0) ;HAVE INDIRECTION?
POPJ P, ;NO, DONE
HRRZ R,T ;YES, GET INDIRECT ADDRESS
PUSHJ P,FETCH ;FETCH CONTENTS
JRST CEFF2 ;FETCH FAILED
JRST CEFF ;REPEAT USING INDIRECT WORD
CEFF2: MOVSI W1,(ASCII /??/) ;INDIRECT FETCH FAILED
PUSHJ P,TEXT ;PRINT LOSS INDICATION
JRST DD1 ;LEAVE REGISTER NOT OPEN, DO CRLF, ETC.
;ROUTINES TO HANDLE RING BUFFER OF LOCATIONS
;'PUSH' CURRENT LOCATION
PSHLLC: AOS TT,SAVLP ;BUMP POINTER
CAIL TT,NSAVTB ;AT END OF TABLE?
SETZB TT,SAVLP ;YES, WRAPAROUND
PUSH P,LLOC ;GET CURRENT LOCATION
POP P,SAVLTB(TT) ;ADD IT TO TABLE
POPJ P,
;'POP' CURRENT LOCATION
POPLLC: MOVE TT,SAVLP ;GET POINTER
MOVE TT,SAVLTB(TT) ;REMOVE FROM TABLE
MOVEM TT,LLOC ;SET AS CURRENT LOC
SOS TT,SAVLP ;DECREMENT PTR
JUMPGE TT,POPLC1 ;AT TOP OF TABLE?
MOVEI TT,NSAVTB-1 ;YES, WRAPAROUND
MOVEM TT,SAVLP
POPLC1: POPJ P,
DEPRA: TLNE F,(CF) ;$ PRECEEDED?
PUSHJ P,POPLLC ;YES, POP 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 FTFILE,<
SKIPN CRASHS ;SEE IF /M
JRST DEPRS ;YES--NO UNDEF FIXUPS
>
MOVEM T,LWT ;SAVE T IN LWT, DEPRS DOES IT ANYWAY
DEPRA2: JUMPGE R,DEPRA5 ;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
JRST [PUSHJ P,REMUN ;REMOVE ENTRY FROM JOBUSY
JRST DEPRA5 ;FAILED, NO UNDEF FIXUPS
JRST .+1]
ADD R,[2,,2] ;CONTINUE SEARCHING TABLE
JRST DEPRA2
DEPRA5: MOVE T,LWT ;RESTORE QUANTITY
JRST DEPRS ;DO THE STORE
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
JRST DEPRA4 ;****UNDEFINED SYMBOL TABLE OR FIXUP
; CHAIN POINTS TO ILL. MEM. TRY
; TO CONTINUE.
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 RELATIVE
JRST BASECH
MOVEI R,PADSO-TOC
ABSA: ADDI R,TOC ;A
HRRZM R,AR
JRST BASE1S
BASECH: MOVE T,WRD2 ;$NR CHANGE OUTPUT RADIX TO N, N .GT. 1
CAIGE T,2
JRST ERR
HRRZM T,ODF
BASE1: SKIPE S,OLDAR
MOVE AR,S
BASE1S: SETZM OLDAR
BASE1O: MOVS S,[XWD SCHM,SCH]
TLNN F,(CCF)
JRST LIS1
BLT S,ODFM ;WITH $$, MAKE MODES PERMANENT
MOVE S,[SVBTS,,PSVBTS]
BLT S,PSVBTS+2
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
;OPEN ANGBKT, CLOSE ANGBKT
FIRARG: TLNE F,(CF+CCF) ;$ PRECEEDED?
JRST PTCH ;YES, PATCH COMMAND
MOVEM T,DEFV ;NO, SET FIRST ARG
TLO F,(FAF)
JRST ULIM1
ULIM: TLNE F,(CF+CCF) ;$ PRECEEDED?
JRST PTCHE ;YES, PATCH END COMMAND
TLO F,(SAF) ;NO, SET SECOND ARG
HRRZM T,ULIMIT
ULIM1: TLNN F,(QF)
JRST ERR
JRST LIS0
SUBTTL PATCH COMMAND -- PATCH BEGIN
PTCH: TLNN F,(TIF+COMF+PTF+MF) ;EXPRESSION TYPED?
TLNN F,(ROF) ;NO REGISTER OPEN?
JRST ERR ;YES, ERROR
TLNE F,(QF) ;ANYTHING TYPED?
JRST [PUSHJ P,EVAL ;YES, LOOKUP SYMBOL
JRST ERR ;STRANGE TYPEIN, LOSE
JRST PTCH4] ;FOUND, USE VALUE AS PATCH LOC
MOVSI W,-NPSYM ;SETUP TO SCAN PATCH SYMBOLS
PTCH1: MOVE T,PCHSYM(W) ;GET A POSSIBLITY
MOVEM T,SYM ;SET IT UP FOR EVAL
PUSHJ P,EVAL ;TRY TO FIND VALUE
AOBJN W,PTCH1 ;NOT FOUND, TRY NEXT SYMBOL
JUMPGE W,[MOVEI R,.JBFF ;NONE OF THE SYMBOLS EXIST, USE .JBFF
HRRZ T,0(R)
JRST PTCH2]
PTCH4: MOVEI R,1(R) ;POINT TO VALUE WORD
PTCH2: CAIGE T,.JBDA ;HAVE REASONABLE PATCH ADDRESS?
JRST ERR ;NO
HRRZM T,PTLOC ;YES, SAVE IT
HRLM R,PTLOC ;SAVE WHERE IT CAME FROM
HRRZ R,LLOCO ;LOC OF OPEN REGISTER
HRRZM R,PTLLC ;SAVE IT
PUSHJ P,FETCH ;GET CONTENTS
JRST ERR ;FETCH FAILED
MOVEM T,PTWRD ;SAVE ORIGINAL WORD
PUSHJ P,DEPERR ;BE SURE IT CAN BE CHANGED, ERR IF NOT
TLNE F,(CCF) ;SAVE BEFORE/AFTER FLAG
HRROS PTLLC ;0 MEANS BEFORE, 1 (NEGATIVE) MEANS AFTER
SKIPL PTLLC ;PATCH AFTER?
JRST PTCH3 ;NO
HRRZ R,PTLOC ;YES, MOVE INSTRUCTION TO PTLOC NOW
MOVE T,PTWRD
PUSHJ P,DEPERR ;STORE IT
PTCH3: PUSHJ P,CRF ;OPEN REG AT PTLOC AND PRINT CONTENTS
HRRZ T,PTLOC
PUSHJ P,LI1
SKIPGE PTLLC ;PATCH AFTER?
PUSHJ P,LI0 ;YES, OPEN SECOND LOC IN PATCH AREA
POPJ P, ;DONE FOR NOW
;TABLE OF SYMBOLS IDENTIFYING PATCH AREAS
PCHSYM: RADIX50 0,PATCH ;ANOTHER LIKELY POSSIBILITY
RADIX50 0,PAT.. ;USUAL LINK10 SYMBOL
RADIX50 0,PAT ;TOPS-10 SYMBOL
NPSYM==.-PCHSYM
SUBTTL PATCH COMMAND -- PATCH END
PTCHE: SKIPN PTLOC ;PATCH IN PROGRESS?
JRST ERR ;NO, ERROR
TLZ F,(CF+CCF) ;FLUSH FLAGS BEFORE DEPRA
PUSHJ P,DEPRA ;STORE LAST WORD IF ANY
SKIPGE PTLLC ;PATCH BEFORE?
JRST PTCHE1 ;NO
HRRZ R,LLOC ;YES, MOVE ORIG INSTRUCTION NOW
AOS R ;MOVE IT TO NEXT LOC
MOVE T,PTWRD
PUSHJ P,DEPERR ;STORE IT
PUSHJ P,LI0 ;OPEN FOR USER TO SEE
PTCHE1: HRRZ R,LLOC ;STORE JUMPA 1,ORIG+1
AOS R ; IN NEXT LOC
HRRZ T,PTLLC
ADD T,[JUMPA 1,1]
PUSHJ P,DEPERR
PUSHJ P,LI0 ;OPEN FOR USER TO SEE
HRRZ R,LLOC ;STORE JUMPA 2,ORIG+2
AOS R ; IN NEXT LOC
HRRZ T,PTLLC
ADD T,[JUMPA 2,2]
PUSHJ P,DEPERR
PUSHJ P,LI0 ;OPEN FOR USER TO SEE
AOS T,LLOC ;GET NEXT FREE PATCH LOC
HLRZ R,PTLOC ;UPDATE WORD THAT PATLOC CAME FROM
HRRM T,0(R)
HRRZ R,PTLLC ;GET ORIG ADDRESS
HRRZ T,PTLOC ;PUT JUMPA PATCH INTO IT
HRLI T,(JUMPA 0,)
PUSHJ P,DEPERR
PUSHJ P,CRF
HRRZ T,R ;NOW OPEN ORIG REGISTER FOR USER TO SEE
PUSHJ P,LI1
SETZM PTLOC ;SAY NO PATCH IN PROGRESS
POPJ P, ;DONE
SETPAG==ERR
XLIST
REPEAT 0,<
SUBTTL PAGE TABLE CONTROL ($U)
IFE FTDEC20,<
IFE FTEXEC!FTFILE,< SETPAG==ERR>
IFN FTEXEC!FTFILE,<
;COMMAND TO MAKE LIFE EASIER ON THE KI10 AND KL10.
;FORMAT IS:
; <USER-BASE>$<EXEC-BASE>U
;
; 1. $U - RESTORE NORMAL MODE
; 2. K$U - SET USER PAGING WITH UPT AT PAGE K
; 3. K$NU - SET EXEC PAGING WITH UPT AT K AND EPT AT N
;
SETPAG: TLZE F,(QF) ;USER SPECIFIED
JRST SETPG1 ;YES--CHARGE AHEAD
TRZE F,Q2F ;EXEC TYPED
JRST ERR ;YES--ERROR
SETZM EPTUPT ;JUST $U CLEAR FLAG WORD
JRST RET ;DONE
SETPG1: TRO T,400000 ;DO NOT STORE ZERO
PUSH P,EPTUPT ;SAVE OLD VALUE
PUSH P,T ;SAVE NEW VALUE
SETZM EPTUPT ;RESTORE PHYSICAL ADDRESSING
MOVE R,T ;COPY ADDRESS
LSH R,9 ;CONVERT TO WORD ADDR
TLNN R,777377 ;TEST FOR JUNK
PUSHJ P,FETCH ;TEST ADDRESS
JRST SETPGE ;ERROR
TRZN F,Q2F ;EXEC GIVEN
JRST SETPGX ;NO--DONE
MOVE R,WRD2 ;GET SECOND WORD
TRO R,400000 ;MAKE SURE NON-ZERO
HRLM R,(P) ;STORE IN ANSWER
LSH R,9 ;TEST FOR VALID
TLNN R,777377 ; POINTER
PUSHJ P,FETCH ; ..
JRST SETPGE ;BAD ADDRESS
SETPGX: POP P,EPTUPT ;SET ANSWER
POP P,T ;RESTORE T
JRST RET ;DONE
SETPGE: POP P,T ;UNDO THIS COMMAND
POP P,EPTUPT ; ..
JRST ERR ;SET ERROR
> ;END EDDT AND FILDDT SWITCH
> ;END IFE FTDEC20
>
LIST
SUBTTL GO AND EXECUTE LOGIC
IFE FTFILE,<
CNTRLZ: IFN FTEXEC,<
SKPUSR ;SEE IF USER MODE
JRST ERR> ;NO--ERROR
; IFE FTDEC20,<
MOVE T,[CALLI 1,12] ;> ;GET MONRET
SKIPE TOPS20
; IFN FTDEC20,<
MOVE T,[HALTF] ;> ;HALT THIS FORK
JRST XEC0 ;GO EXECUTE IT
GO: HRLI T,(JRST) ;G
TLOE F,(QF) ;DID USER TYPE AN ARG TO $G?
JRST XEC ;YES, GO DO IT
XLIST
REPEAT 0,<
IFN FTDEC20,<
IFN FTEXEC,<
SKPUSR
JRST ERR> ;NO SUCH COMMAND IN EDDT
MOVEI T1,.FHSLF
GEVEC ;GET ENTRY VECTOR
HLRZ TT,T2 ;GET ITS LENGTH
CAIN TT,(JRST) ;TOPS10 FORMAT?
JRST GO1 ;YES
CAIL TT,1000 ;REASONABLE?
JRST ERR ;NO
HRR T,T2 ;SETUP FIRST LOCATION
TRNN F,Q2F ;SECOND QUANT? (I.E. $1G)
SETZM WRD2 ;NO, ASSUME ZERO
CAMG TT,WRD2 ;WITHIN RANGE?
JRST ERR ;NO
ADD T,WRD2 ;ADD OFFSET WITHIN VECTOR
JRST XEC ;NOW HAVE JRST ADR IN T, XCT IT
GO1:> ;END IFN FTDEC20
HRR T,.JBSA ;NO, GET ADDR FROM .JBSA
IFN FTEXEC,<
SKPEXC ;EXEC MODE HAS NO .JBSA, SO ERROR
>
>
LIST
HRR T,.JBSA
TRNN T,-1 ;WAS C(.JBSA) NONZERO?
JRST ERR ;NO, SO ERROR
XEC: TLNN F,(QF) ;SKIP IF QUANTITY TYPED
TDZA T,T ;MAKE SURE COUNT IS ZERO
TLNN T,777000 ;SKIP IF VALID INSTRUCTION
JRST $X ;GOTO SINGLE STEP EXECUTE ROUTINE
XEC0: MOVEM T,TEM
PUSHJ P,CRF
PUSHJ P,INSRTB
SETZM SKPCT ;INIT SKIP COUNT
JSP T,RESTORE
XCT TEM
XEC1: AOS SKPCT ;NOTE NOSKIP, SKIP, DOUBLE SKIP
AOS SKPCT
JSR SAVE ;SAVE CONTEXT
PUSHJ P,REMOVB ;REMOVE BRKPTS
MOVEI TT,3
SUB TT,SKPCT ;COMPUTE AMOUNT OF PC INCREMENT
IFE FTDEC20,<
CAIG TT,1 ;INSTRUCTION SKIPPED?
JRST DD1 ;NO
MOVE W1,[ASCII "<SKP>"] ;MAKE SURE IT IS CLEAR
PUSHJ P,TEXT2 ; THAT THIS WAS A SKIP
PUSHJ P,CRF ;TYPE 2 CR-LFEEDS
JRST DD1
>
IFN FTDEC20,<
MOVEI W1,"$"
PUSHJ P,TEXT ;PRINT $ FOR EACH INCREMENT
SOJG TT,.-2
JRST DD1>
>
IFN FTFILE,<
BCOM==<XEC==<GO==ERR>>
>
SUBTTL SINGLE STEP EXECUTE LOGIC
IFE FTFILE,<
;$X IS A FEATURE THAT OPERATES AS FOLLOWS:
; $X OR N$X OR $$X OR N$$X, WHERE N .LT. 2^27, WILL DISPATCH TO
; THIS CODE. THE FOLLOWING ACTIONS WILL BE PERFORMED:
;
; $X EXECUTE A SINGLE INSTRUCTION, THEN INCREMENT THE PC. THE
; OPERANDS TO THE INSTRUCTION WILL BE PRINTED OUT AS THEY
; EXIST **AFTER** EXECUTION OF THE INSTRUCTION. AN EXTRA
; LINE FEED WILL BE PRINTED IF THE INSTRUCTION SKIPPED OR
; JUMPED. THE NEXT INSTRUCTION WILL THEN BE PRINTED.
; $P WILL ALWAYS DO THE RIGHT THING AFTER ANY NUMBER OF $X'S.
;
; N$X REPEAT THE $X CYCLE N TIMES.
;
; N$$X SAME AS N$X EXCEPT THAT ALL PRINTOUT IS SUPPRESSED FOR
; ALL BUT THE LAST $X CYCLE.
;
; $$X PERFORM A NON-PRINTING $X CYCLE UNTIL THE PC REACHES EITHER
; .+1 OR .+2; I.E. UNTIL ONE OF THE NEXT 2 INSTRUCTIONS IS
; EXECUTED. THIS IS USEFUL FOR TREATING A SUBROUTINE CALL
; AS A SINGLE INSTRUCTION FOR THE PURPOSES OF $X.
;FLAGS USED IN $X LOGIC ONLY
FAC== 1 ;SIGNALS AC TO BE PRINTED
DFAC== 2 ;SIGNALS INST THAT USES 2 AC'S
FLG== 4 ;INST MODIFIES FLAGS (JRST,JFCL)
IMM== 10 ;SIGNALS IMMEDIATE MODE INST
EA== 20 ;SIGNALS MEMORY REFERENCE INST
DEA== 40 ;SIGNALS INST THAT REFERENCES 2 MEM LOCS
FLA== 100 ;SIGNALS FLOATING AC OPERAND
FLE== 200 ;SIGNALS FLOATING MEM OPERAND
;COME HERE FROM $X COMMAND, WITH T SET TO ZERO IF NO QUANTITY WAS
; TYPED.
$X: MOVEM T,XTEM ;STORE REPETITION COUNT
JUMPG T,$X00 ;JUMP IF POSITIVE COUNT
HRRZ T,PROC0 ;ZERO, FETCH CURRENT PC
MOVEM T,LOCSAV ;AND REMEMBER IT
SETOM XTEM ;SET REPETITION COUNT NEGATIVE
TLNN F,(CCF) ;$$X WITH NO ARG?
MOVNS XTEM ;NO, ONLY $X. TREAT AS 1$X
$X00: PUSHJ P,CRF ;OUTPUT CRLF TO START
;HERE ON REPEATED $X CYCLES
$X01: SOSN XTEM ;DECREMENT AND TEST COUNTER
TLZ F,(CCF) ;CLEAR $$ FLAG TO END REPETITIONS
TLZ F,(QF!CF!STF) ;TURN OFF QUANT, $, ! FLAGS
MOVEM F,FLAGS ;SAVE REGULAR DDT FLAGS
HRRZI T,100 ;SETUP MAX XCT DEPTH
HRRZM T,XCTS
HRRZ R,PROC0 ;FETCH ADR OF CURRENT INST
CAIN R,XEC1 ;JUST HIT BREAKPOINT OR DID $X LAST?
JRST ERR ;NO, JUST ENTERED DDT, SO ERROR
SKIPL XTEM ;INDEFINITE $$X BEING EXECUTED?
MOVEM R,LOCSAV ;NO, REMEMBER OLD PC FOR THIS INST
$X02: PUSHJ P,FETCH ;FETCH CURRENT INSTRUCTION
JRST ERR ;ERROR
$XO3: MOVEM T,I.NST ;STORE CURRENT INSTRUCTION
MOVEM T,I.SM10 ;SAVE INCASE SM IOT
JSR SWAP ;SWAP TO USER CONTEXT
MOVEM T,SAFETY ;SAVE T
MOVEI T,@I.NST ;COMPUTE EFFECTIVE ADR OF INST
DPB T,[POINT 23,I.NST,35] ;STORE COMPUTED ADR IN CURRENT INST
HRRZM T,I.NSTEA ;REMEMBER IT AGAIN
MOVE T,SAFETY ;RESTORE T
JSR SWAP ;SWAP BACK TO DDT CONTEXT
LDB W1,[POINT 4,I.NST,12] ;EXTRACT AC FIELD
MOVEM W1,I.NSTAC ;STORE IT AWAY
MOVSI T,777000 ;MASK FOR OPCODE
AND T,I.NST ;FETCH OPCODE
HLRZ F,T ;SAVE IN RH FOR LATER
CAMLE T,$XTBL(T) ;IN RANGE OF CURRENT TABLE ENTRY?
AOJA T,.-1 ;NO, KEEP SEARCHING
JRST @$XTBL(T) ;YES, DISPATCH
IFE FTEXEC,<
MONUI== JUSTI ;IF USER DDT, TREAT MONITOR UUOS
MONUE== JUSTE ; AS HARDWARE INSTRUCTIONS
MONUAI==SETI
MONUAE==SETEA
MONINI==ERR ;CANNOT TRACE INIT
>
;OPCODE DISPATCH TABLE.
; LH OF EACH ENTRY CONTAINS LARGEST OPCODE COVERED BY THAT ENTRY,
; RH CONTAINS DISPATCH ADDRESS.
$XTBL: SETZB SET ; 400-403 SETZX
ORCBB CHECKI ; 404-473 ALL LOGICAL EXCEPT SETX
SETOB SET ; 474-477 SETOX
HLRES CHEKIS ; 500-577 HALFWORD
TSON TESTS ; 600-677 TEST CLASS
707000,,IOTS ; 700-707 I/O INSTRUCTIONS
727000,,SMIOTS ; 710-727 SM-10 UNIBUS I/O *** SM10
777000,,IOTS ; 730-777 I/O INSTRUCTIONS
0 ,, ERR ; 000 ALWAYS ILLEGAL
037000,,USRUUO ; 001-037 USER UUOS
CALL MONUAE ; 040 CALL
INIT MONINI ; 041 INIT
CALLI MONUAI ; 042-047 UNDEFINED AND CALLI
TTCALL MONUE ; 050-051 OPEN,TTCALL
054000,,MONUAI ; 052-054 UNDEFINED
OUT MONUE ; 055-057 RENAME,IN,OUT
STATO MONUI ; 060-061 SETSTS,STATO
GETSTS MONUE ; 062 GETSTS
OUTBUF MONUI ; 063-065 STATZ,INBUF,OUTBUF
OUTPUT MONUE ; 066-067 INPUT,OUTPUT
USETO MONUI ; 070-075 CLOSE,RELEAS,MTAPE,UGETF,USETI,USETO
ENTER MONUE ; 076-077 LOOKUP,ENTER
103000,,SETI ; 100-103 UNDEFINED
104000,,DOIT ; 104 JSYS
107000,,SETI ; 105-107 UNDEFINED
DFDV DFLOT ; 110-113 DFAD,DFSB,DFMP,DFDV *** KI10
117000,,SETI ; 114-117 UNDEFINED
DMOVN DMOV ; 120-121 DMOVE,DMOVN *** KI10
FIX FXAFLE ; 122 FIX *** KI10
123000,,SETI ; 123 UNDEFINED
DMOVNM DMOV ; 124-125 DMOVEM,DMOVNM *** KI10
FIXR FXAFLE ; 126 FIXR *** KI10
FLTR FLAFXE ; 127 FLTR *** KI10
UFA IUFA ; 130 UFA
DFN IDFN ; 131 DFN
FSC IFSC ; 132 FSC
IBP JUSTE ; 133 IBP
DPB SETEA ; 134-137 XLDB,XDPB
FDVRB FLOAT ; 140-177 FADXX,FSBXX,FMPXX,FDVXX
;CONTINUATION OF OPCODE DISPATCH TABLE.
MOVMS CHEKIS ; 200-217 MOVXX
IMULB CHECKI ; 220-223 IMULX
DIVB MULDIV ; 224-237 MULX,XDIVX
LSH SETI ; 240-242 ASH,ROT,LSH
JFFO IJFFO ; 243 JFFO
LSHC DBLI ; 244-246 ASHC,ROTC,LSHC
247000,,SETI ; 247 UNDEFINED
EXCH SETEA ; 250 EXCH
BLT SETI ; 251 BLT
AOBJN IAOBJ ; 252-253 AOBJP,AOBJN
JRST IJRST ; 254 JRST
JFCL IJFCL ; 255 JFCL
XCT IIXCT ; 256 XCT
MAP SETEA ; 257 MAP *** KI10
PUSHJ IIPUSHJ ; 260 PUSHJ
POP SETEA ; 261-262 PUSH,POP
POPJ IPOPJ ; 263 POPJ
JSR I.JSR ; 264 JSR
JSP I.JSP ; 265 JSP
JSA I.JSA ; 266 JSA
JRA IAOBJ ; 267 JRA
SUBB CHECKI ; 270-277 ADDX,SUBX
CAIG SETI ; 300-307 CAIXX
CAMG SETEA ; 310-317 CAMXX
SOSG JMPSKP ; 320-377 JUMPXX,SKIPXX,AOJXX,AOSXX,SOJXX,SOSXX
;MONITOR UUO HANDLER
IFN FTEXEC,<
MONUAI: TLO F,FAC ;REMEMBER TO PRINT AC
MONUI: SKPEXC ;SKIP IF EXEC MODE
JRST JUSTI ;USER MODE, TREAT UUO AS SINGLE INST
JRST MONUE ;EXEC MODE, TRACE THE UUO
MONUAE: TLO F,FAC ;REMEMBER TO PRINT AC
MONUE: SKPEXC ;SKIP IF EXEC MODE
JRST JUSTE ;USER MODE, TREAT UUO AS SINGLE INST
SKPKA ;CAN SIMULATE ON A KA
JRST ERR ;PUNT ON A KL OR KI
JRST USRUUO ;EXEC MODE, TRACE THE UUO
MONINI: SKPEXC ;SKIP IF EXEC MODE
JRST ERR ;USER MODE, CAN'T FOLLOW AN INIT
;EXEC MODE, TRACE NORMALLY
>
;USER UUO HANDLER
USRUUO: MOVEI R,40 ;SETUP JOBUUO
EXCH F,FLAGS ;RESTORE REGULAR FLAGS
MOVE T,I.NST ;FETCH INST WITH EFF ADR COMPUTED
PUSHJ P,DEPMEM ;STORE USER UUO IN JOBUUO
JRST ERR ;ERROR
EXCH F,FLAGS ;RESTORE $X FLAGS
MOVE T,[XCT 41] ;PRETEND INSTRUCTION WAS AN XCT
JRST $XO3
;INTERPRET UFA
IUFA: TLOA F,FLA+FLE+DFAC ;REMEMBER FLTG PT, USES 2 AC'S
;INTERPRET DFN
IDFN: TLO F,FLA!FLE ;DFN, REMEMBER AC AND E FLOAT
JRST SETEA
;INTERPRET FLOATING POINT INSTRUCTIONS
FLOAT: ANDI F,7000 ;FLOATING PT, GET MODE
CAIN F,1000 ;LONG MODE?
TLOA F,DFAC ;YES, PRINT 2 AC'S
CAIE F,5000 ;IMMEDIATE MODE?
TLOA F,FLA+FLE+FAC+EA ;NO, PRINT AC AND E BOTH FLOATING
FLOATI: TLO F,FLA+FLE+FAC+IMM ;YES, PRINT AC AND E IMMEDIATE FLTG
JRST DOIT
;INTERPRET JRST
IJRST: TLO F,IMM ;REMEMBER TO PRINT E
TRNE W1,2 ;IS INSTRUCTION JRSTF?
TLO F,FLG ;YES, REMEMBER TO PRINT FLAGS
IJRST0: PUSHJ P,FETCH ;FETCH INST OR INDIRECT WORD
JRST ERR ;ERROR
MOVE W1,T ;COPY INTO W1
LDB R,[POINT 4,T,17] ;LOAD INDEX FIELD
JUMPE R,IJRST1 ;JUMP IF NO INDEXING TO PERFORM
MOVE T,AC0(R) ;FETCH CONTENTS OF INDEX REGISTER
TLZ T,(Z @(17)) ;CLEAR I AND X FIELDS IN INDEX REG
ADDI T,(W1) ;COMPUTE INDEXED ADDRESS
TLZ T,(Z @(17)) ;CLEAR ANY OVERFLOW
IJRST1: MOVEI R,(T) ;COPY RESULTING ADDRESS
TLNE W1,(@) ;INDIRECT?
JRST IJRST0 ;YES, FOLLOW NEXT LEVEL OF INDIRECTION
;LH OF T NOW CONTAINS FLAGS THAT WILL BE RESTORED
IFN FTEXEC!FTMON,<
IFN FTEXEC,< ;DEC20 MONITOR DDT DOESN'T HAVE SKPEXC
SKPEXC ;NOW IN EXEC MODE?
JRST IJRST3 ;NO, USER MODE
>
MOVE W1,I.NSTAC ;YES, FETCH AC FIELD OF JRST INST
TRNE W1,1 ;JUMP TO USER MODE?
JRST JRSPRC ;YES, CAN'T TRACE. GO DO $P
TRNE W1,2 ;JRSTF?
TLNN T,(1B5) ;YES, GOING TO ENTER USER MODE?
JRST IJRST3 ;NO TO EITHER, HANDLE NORMALLY
JRSPRC: EXCH F,FLAGS ; $X OPERATION IMPOSSIBLE. RESTORE FLAGS
TLZ F,(QF+CCF) ;CLEAR QUANT AND $$ FLAGS
JRST PROCD1 ;AND EXECUTE $P TO GO INTO USER MODE
>
IJRST3: HRRI T,NOSKIP ;MODIFY THE JRST EFFECTIVE ADR
MOVEM T,BCOM ;STORE NEW FLAGS,,NOSKIP
MOVE T,I.NST ;FETCH INST AGAIN
HRRM T,PROC0 ;STORE EFF ADR AS NEW PC
HRRI T,BCOM ;TURN INTO JRST @BCOM
TLO T,(@)
MOVEM T,I.NST ;AND STORE
JRST DOIT ;DO IT
;INTERPRET XCT
IIXCT:
IFN FTEXEC!FTMON,<
DPB W1,[POINT 4,I.XCT,12]> ; USE IN XCT PAGED
MOVE F,FLAGS ;GET BACK NORMAL DDT FLAGS
SOSG XCTS ;CHECK XCT COUNTER
JRST ERR ;ERROR - DEPTH EXCEEDED
TLNE F,(CCF) ;$$X?
JRST IIXCT1 ;YES, DON'T PRINT ANYTHING
HRRZ T,I.NSTEA ;GET EFF ADR OF XCT
PUSHJ P,PINST ;PRINT INST BEING XCT'ED
PUSHJ P,CRF ;OUTPUT CRLF AFTER INST
IIXCT1: HRRZ R,I.NSTEA ;GET EFF ADR OF XCT AGAIN
JRST $X02 ;PROCESS EXECUTED INST
;INTERPRET PUSHJ
IIPUSHJ:AOS T,PROC0 ;GET CURRENT PC +1
HLL T,SAVPI ;PUT FLAGS IN LH
MOVEM T,I.NSTPC ;STORE AWAY TO BE STACKED
MOVSI T,(1B4) ;CLEAR BIS FLAG IN NEW PC WORD
ANDCAM T,SAVPI
SOS T,I.NST ;GET EFF ADR OF PUSHJ, -1 TO FOOL DOIT
HRRM T,PROC0 ;STORE NEW PC -1
HRLZI T,(<PUSH>-<PUSHJ>) ;WANT TO TURN PUSHJ INTO A PUSH
DPB T,[POINT 5,I.NST,17] ;CLEAR I AND AC FIELD
JRST IPOPJ2 ;REST OF CODE COMMON WITH POPJ
;INTERPRET POPJ
IPOPJ: EXCH F,FLAGS ;POPJ, RESTORE NORMAL DDT FLAGS
HRRZ R,AC0(W1) ;FETCH CONTENTS OF CORRECT USER AC
PUSHJ P,FETCH ;FETCH PCWORD IT POINTS TO
JRST ERR ;ERROR
EXCH F,FLAGS ;RESTORE $X FLAGS
HRRI T,-1(T) ;DECREMENT PC TO FOOL CODE AT DOIT
HRRM T,PROC0 ;STORE AS CURRENT PC
HRLZI T,(<POP>-<POPJ>) ;SETUP TO TURN POPJ INTO POP
;COMMON CODE FOR PUSHJ, POPJ
IPOPJ2: ADDM T,I.NST ;TURN PUSHJ INTO PUSH OR POPJ INTO POP
HRRZI T,I.NSTPC ;SETUP ADR OF PC WORD FOR PUSHJ
HRRM T,I.NST
TLOA F,FAC ;REMEMBER TO PRINT AC
;INTERPRET FSC
IFSC: TLO F,FAC+FLA+IMM ;FLOATING AC, FIXED IMMEDIATE E
JRST DOIT
;INTERPRET JSA
I.JSA: AOS T,PROC0 ;JSA, SETUP RETURN PC
HRL T,I.NSTEA ;PUT EFF ADR IN LH LIKE JSA DOES
EXCH T,AC0(W1) ;STORE IN USER AC, GET OLD CONTENTS
JRST I.JSR2 ;STORE OLD CONTENTS LIKE JSR, THEN JUMP
;INTERPRET JSR
I.JSR: AOS T,PROC0 ;JSR, GET CURRENT PC
HLL T,SAVPI ;SETUP LH OF PC WORD
TLO F,FAC ;REMEMBER NOT TO PRINT AC FIELD
MOVSI W1,(1B4) ;CLEAR BIS FLAG IN NEW PC WORD
ANDCAM W1,SAVPI
I.JSR2: TLO F,EA ;PRINT E NORMALLY
EXCH F,FLAGS ;RESTORE NORMAL DDT FLAGS
HRRZ R,I.NSTEA ;FETCH EFF ADR OF JSR OR JSA
PUSHJ P,DEPMEM ;STORE PC WORD
JRST ERR ;ERROR
EXCH F,FLAGS ;RESTORE $X FLAGS
HRRZ T,I.NSTEA ;GET EFF ADR AGAIN
AOJA T,I.JSR4 ;INC PAST STORED PC WORD
;INTERPRET JSP
I.JSP: AOS T,PROC0 ;JSP, SETUP RETURN PC
HLL T,SAVPI ;SETUP LH OF PC WORD
MOVEM T,AC0(W1) ;STORE IN USER AC
MOVSI T,(1B4) ;CLEAR BIS FLAG IN NEW PC WORD
ANDCAM T,SAVPI
HRRZ T,I.NSTEA ;GET BACK EFF ADR
I.JSR4: HRRM T,PROC0 ;STORE NEW PC
TLC F,FAC ;REMEMBER TO PRINT AC
JRST TELL ;GO PERFORM PRINTOUT
;INTERPRET KI10 INSTRUCTIONS
DFLOT: TLO F,FLA+FLE ;REMEMBER THAT AC AND E ARE FLOATING
DMOV: TLO F,DFAC+DEA ;REMEMBER AC AND E BOTH DOUBLE
JRST SETEA
FXAFLE: TLOA F,FLE ;REMEMBER THAT E FLOATS (FIX,FIXR)
FLAFXE: TLO F,FLA ;REMEMBER THAT AC FLAOATS (FLTR)
JRST SETEA
;INTERPRET JFFO
IJFFO: TLO F,DFAC ;REMEMBER JFFO USES 2 AC'S
;INTERPRET JUMP AND SKIP INSTRUCTIONS
JMPSKP: TRNE F,10000 ;JUMP/SKIP, WHICH IS IT?
JRST SKP ;SKIP CLASS
;INTERPRET AOBJN AND AOBJP
IAOBJ: TLOA F,FAC+IMM ;HANDLE AS IMMEDIATE MODE INST WITH AC
;INTERPRET JFCL
IJFCL: TLO F,FLG ;REMEMBER TO PRINT FLAGS
MOVEI T,JMP ;JUMP CLASS OR AOBJ, COME BACK TO $X
HRRM T,I.NST ;STORE MODIFIED INST
JRST DOIT ;GO EXECUTE CONDITIONAL INST
;HERE AFTER EXECUTING CONDITIONAL JUMP INSTRUCTION THAT ACTUALLY
; DOES JUMP
JMP: EXCH T,I.NSTEA ;SAVE T, GET EFF ADR OF JUMP
HRRM T,PROC0 ;STORE EFF ADR AS NEW PC
EXCH T,I.NSTEA
JRST NOSKIP ;NOW DO PRINTOUT
;HERE FOR ALL SKIP INSTRUCTIONS
SKP: JUMPN W1,SETEA ;SKIP CLASS - AC FIELD ZERO?
JUSTE: TLOA F,EA ;YES, JUST PRINT E
;INTERPRET SHIFT COMBINED INSTRUCTIONS
DBLI: TLO F,FAC+DFAC+IMM ;REMEMBER 2 AC'S USED, IMMEDIATE
JRST DOIT ;EXECUTE NORMALLY
;INTERPRET TEST CLASS INSTRUCTIONS
TESTS: TRNN F,10000 ;SKIP ON TD OR TS BUT NOT ON TR OR TL
TLOA F,FAC+IMM ;IMMEDIATE MODE
TLO F,FAC+EA ;NORMAL MODE
JRST DOIT
;I/O INSTRUCTIONS
SMIOTS: TLO F,FAC ;TREAT SM-10 UNIBUS I/O AS AC
PUSH P,F
MOVE F,I.SM10
MOVEM F,I.NST
POP P,F
JRST DOIT
IOTS: TRNE W1,4 ;SKIP IF BLKI,DATAI,BLKO,DATAO
CAIN W1,5 ;SKIP IF NOT CONI
TLOA F,EA ;MEM REF INSTRUCTION
JUSTI: TLO F,IMM ;IMMEDIATE INST
JRST DOIT
;ALL PATHS CONVERGE HERE
CHEKIS: TRC F,3000 ;HERE TO TEST FOR IMMEDIATE OR SELF MODE
TRCE F,3000 ;SKIP IF SELF MODE
JRST CHECKI ;NO, CHECK IMMEDIATE
JRST SKP ;YES, GO TEST FOR NONZERO AC FIELD
SET: ANDI F,3000 ;HERE FOR SETZX,SETOX
CAIE F,2000 ;SETZM,SETOM?
TLO F,FAC ;NO, AC IS ALWAYS AFFECTED
TRNE F,2000 ;SETZM,SETZB,SETOM,SETOB?
TLO F,EA ;YES, MEM IS ALWAYS AFFECTED
JRST DOIT
;FIXED POINT MULTIPLY AND DIVIDE (NOT INCLUDING IMULX)
MULDIV: ANDI F,3000 ;MASK MODE BITS
CAIE F,2000 ;TO MEMORY ONLY?
TLO F,DFAC ;NO, INST USES 2 AC'S
CHECKI: TRNE F,1000 ;TEST FOR IMMEDIATE MODE INST
TRNE F,2000
SETEA: TLOA F,FAC+EA ;MEM REF INSTRUCTION
SETI: TLO F,FAC+IMM ;IMMEDIATE MODE INSTRUCTION
DOIT: EXCH F,FLAGS ;RESTORE NORMAL DDT FLAGS
PUSHJ P,TTYLEV ;RESTORE STATUS OF CTY (EXEC MODE)
JSR SWAP ;SWAP TO USER CONTEXT
XCT I.XCT ;EXECUTE THE INSTRUCTION (IF IN EXEC MODE
; ON A KI10 THIS MAY BE EXECUTIVE XCT)
JRST IXS1 ;NO SKIP, INCREMENT PC ONCE
JRST IXS2 ;SKIP, INCREMENT PC TWICE
AOS PROC0 ;DOUBLE SKIP, INCREMENT PC THRICE
IXS2: AOS PROC0
IXS1: AOS PROC0
;HERE AFTER SIMULATING OR EXECUTING INSTRUCTION.
; PERFORM REQUIRED PRINTOUT.
NOSKIP: JSR SWAP ;RESTORE DDT CONTEXT
PUSHJ P,TTYRET ;RESTORE DDT TTY MODES
JRST .+2
TELL: EXCH F,FLAGS ;GET DDT'S FLAGS
IFN FTEXEC!FTMON,<
MOVEI T,0 ;CLEAR THE AC FIELD OF I.XCT
DPB T,[POINT 4,I.XCT,12] ;SO NEXT INSTRUCTION HAPPENS OK
>
TLNE F,(CCF) ;IF $$X, DON'T PRINT ANYTHING
JRST NXTIT
EXCH F,FLAGS ;RESTORE $X'S FLAGS
PUSH P,SCH ;SAVE CURRENT OUTPUT MODE
TLNE F,FLA ;FLOATING AC?
MOVEI SCH,TFLOT ;YES, SETUP TO OUTPUT IN FLOATING PT
TLNE F,FAC ;AC TO BE PRINTED?
PUSHJ P,FAC0 ;YES, DO IT
TLNE F,DFAC ;INST USE 2 AC'S?
PUSHJ P,DBL0 ;YES, PRINT LOW-ORDER AC
TLNE F,FLG ;INSTRUCTION ACCESS THE FLAGS?
PUSHJ P,FLG0 ;YES, PRINT FLAGS
MOVE SCH,(P) ;RESTORE OLD MODE
TLNE F,FLE ;FLOATING MEMORY OPERAND?
MOVEI SCH,TFLOT ;YES, SETUP FLTG OUTPUT
TLNE F,IMM ;IMMEDIATE MODE?
PUSHJ P,IMM0 ;YES, JUST PRINT E
TLNE F,EA ;MEM REF INST?
PUSHJ P,EA0 ;YES, PRINT C(E)
TLNE F,DEA ;DOUBLE-WORD MEM OPERAND?
PUSHJ P,DEA0 ;YES, OUTPUT 2ND WORD
POP P,SCH ;RESTORE CURRENT OUTPUT MODE
EXCH F,FLAGS ;RESTORE DDT FLAGS
PUSHJ P,CRF ;OUTPUT CRLF
;NOW TEST WHETHER TO CONTINUE, AND PRINT NEXT INST IF REQUIRED.
NXTIT: HRRZ T,PROC0 ;FETCH NEW PC
MOVEI W1,1(T) ;COMPUTE PC+1
HRRZM W1,BCOM ;STORE FOR $P
HRRZ W1,LOCSAV ;FETCH OLD PC
SKIPL XTEM ;INDEFINITE $$X IN PROGRESS?
JRST NXT0 ;NO
CAIE T,1(W1) ;YES, ARE WE NOW AT OLD PC +1?
CAIN T,2(W1) ; OR +2?
JRST $XQUIT ;YES, STOP ITERATION NOW
NXT0: PUSHJ P,LISTEN ;NO, HAS USER TYPED ANYTHING?
JRST NXT1 ;NO, CONTINUE
$XQUIT: SETZM XTEM ;YES, STOP ITERATION BY ZEROING COUNTER
TLZ F,(CCF) ; AND CLEARING CONTROL FLAG
NXT1: TLNE F,(CCF) ;$$ STILL IN EFFECT?
JRST NXT2 ;YES, DON'T PRINT ANYTHING
HRRZ T,PROC0 ;NO, GET CURRENT PC AGAIN
CAIN T,1(W1) ;DOES IT EQUAL OLD PC +1?
JRST NXT1A ;YES--JUST CONTINUE
CAIN T,2(W1) ;SKIP OR JUMP
SKIPA W1,[ASCII "<SKP>"] ;SKIP
MOVE W1,[ASCII "<JMP>"] ;JUMP
PUSHJ P,TEXT2 ;SAY SKIP OR JUMP
PUSHJ P,CRF ;ADD CRLF
NXT1A: HRRZ T,PROC0 ;FETCH CURRENT PC AGAIN
PUSHJ P,PINST ;PRINT INSTRUCTION ABOUT TO BE EXECUTED
SKIPE XTEM ;ARE WE STILL LOOPING?
PUSHJ P,CRF ;YES, PRINT CRLF AFTER INST
NXT2: SKIPE XTEM ;SKIP IF REPEAT COUNTER IS ZERO
JRST $X01 ;NONZERO, REPEAT $X CYCLE AGAIN
JRST TTYCLR ;ZERO, FLUSH ANY WAITING INPUT CHARACTERS
; AND RETURN FROM $X INSTRUCTION
;OUTPUT ROUTINES
;ROUTINE TO PRINT SECOND ACCUMULATOR
DBL0: AOS T,I.NSTAC ;INCREMENT AC NUMBER
TRZA T,777760 ;ENSURE 17 WRAPS AROUND TO 0
;ROUTINE TO PRINT CONTENTS OF ACCUMULATOR
FAC0: MOVE T,I.NSTAC ;FETCH AC NUMBER
JRST EA2
;ROUTINE TO PRINT THE FLAGS
FLG0: PUSHJ P,LCT ;PRINT TAB
HLRZ T,SAVPI ;GET LH OF PC WORD
JRST IMM1 ;PRINT FLAGS
;ROUTINE TO PRINT JUST E FOR AN IMMEDIATE MODE INSTRUCTION
IMM0: PUSHJ P,LCT ;PRINT TAB
HRRZ T,I.NSTEA ;FETCH E
TLNE F,FLE ;FLTG PT MEM OPERAND?
MOVS T,T ;YES, IMMEDIATE SWAPS HALVES
IMM1: EXCH F,FLAGS ;RESTORE DDT FLAGS
PUSHJ P,CONSYM ;OUTPUT CONTENTS OF T
JRST EA6 ;RESTORE $X FLAGS AND RETURN
;ROUTINE TO PRINT 2ND MEMORY OPERAND
DEA0: AOS I.NSTEA ;INC TO ADR OF 2ND OPERAND
;ROUTINE TO PRINT MEMORY OPERAND
EA0: MOVE T,I.NSTEA ;FETCH ADR OF MEM OPERAND
EA2: EXCH F,FLAGS ;HERE FROM DBL0,FAC0
PUSH P,T ;SAVE ARG
PUSHJ P,LCT ;OUTPUT TAB
POP P,T ;RESTORE ADR OF LOC TO BE PRINTED
PUSHJ P,LI1 ;PRINT ADR/ CONTENTS
EA6: EXCH F,FLAGS ;RESTORE $X FLAGS
POPJ P,
;ROUTINE TO PRINT INSTRUCTION ALWAYS IN SYMBOLIC DESPITE CURRENT MODE
PINST: PUSH P,SCH ;SAVE CURRENT OUTPUT MODE
MOVEI SCH,PIN ;SET TO PRINT SYMBOLIC INST MODE
PUSHJ P,LI1 ;OUTPUT INST
POP P,SCH ;RESTORE CURRENT MODE
POPJ P,
;ROUTINE TO SWAP BETWEEN DDT AND USER CONTEXTS.
; AC'S AND FLAGS ARE SWAPPED, BUT BREAKPOINTS AND OTHER STUFF
; ARE NOT TOUCHED, SINCE CONTROL IS EXPECTED TO RETURN TO DDT SOON.
SWAPG: EXCH 0,AC0 ;SWAP AC 0
MOVEM 0,SAV0 ;SAVE 0 FOR WORK
HLLZ 0,SWAP ;GET CURRENT FLAGS
HLR 0,SAVPI ;GET SAVED FLAGS
HRLM 0,SWAP ;SWITCH FLAGS
HLLM 0,SAVPI
MOVE 0,[EXCH 1,AC0+1] ;SETUP INST FOR SWAPPING AC'S
SWAPL: XCT 0 ;SWAP AN AC
ADD 0,[Z 1,1] ;INC AC AND MEM FIELDS
TLNN 0,1000 ;AC 20 REACHED?
JRST SWAPL ;NO, LOOP
MOVE 0,SAV0 ;YES, RESTORE SAVED AC
JRSTF @SWAP ;RETURN, RESTORING NEW FLAGS
> ;END IFE FTFILE
SUBTTL ENTER AND LEAVE DDT LOGIC
;SKIPS IF CONTEXT ALREADY SAVED
IFE FTFILE,<
SAVEG: ;SAVE THE ACS AND PI SYSTEM
IFN FTEXEC,<
; SKIPN TRCON ;TRACE FACILITY IN USE?
; JRST SAVEG1 ;NO
; DATAI PI,TRCDMP ;YES, DUMP CURRENT POINTER
; DATAO PI,[0] ;TURN IT OFF
SAVEG1:
MOVEM 0,TEM
SETZM TOPS20#
JSP 0,.+1
TLNN 0,(1B5)
JRST .+6
MOVE [112,,11]
GETTAB
CAM
CAIN 40000
SETOM TOPS20
MOVE 0,TEM
MOVEM T,TEM ;FREE AN AC
; IFE FTDEC20,<
SKIPE TOPS20
JRST SAVEG2
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
SAVEG2: JSP T,.+1 ;GET PC WORD AGAIN
ROT T,5 ;ROTATE USER MODE BIT TO SIGN
MOVEM T,USRFLG ; AND SAVE IT
MOVE T,TEM ;RESTORE THE AC
> ;END FTEXEC
;NOW SAVE USER STATUSES AND MODES AND SETUP DDT MODES. DON'T SAVE
;MODES IF ALREADY SAVED (I.E. WHEN REENTERING DDT), BUT DO SET DDT
;MODES IN CASE THEY WERE CHANGED.
SKIPE SARS ;ALREADY SAVED?
AOS SAVE ;YES, SKIP RETURN
IFN FTEXEC,<
SKPEXC
JRST SAV11
SKIPE SARS ;ALREADY SAVED?
JRST SAV3 ;YES
CONI PI,SAVPI
HRRZS SAVPI+1
SAV3: CONO PI, @SAVPI+1>
SAV11: SKIPE SARS ;ALREADY SAVED?
JRST SAV5 ;YES
MOVEM 17,AC17 ;SAVE ACS
HRRZI 17,AC0
BLT 17,AC0+16
MOVE T,SAVE ;SAVE PC FLAGS
HLLM T, SAVPI
SAV5: MOVE P,[IOWD LPDL,PDL] ;SETUP STACK
; ..
;IF EDDT, DETERMINE PROCESSOR TYPE.
;IF UDDT, DETERMINE MONITOR TYPE.
;IF SM-10, KAFLG SET TO -1 AS IF KL10.
IFN FTEXEC,<
; MOVNI T,1 ;LOAD T WITH ALL ONES
; AOBJN T,.+1 ;ADD ONE TO BOTH HALFS
; MOVEM T,KAFLG ;0 MEANS KI10; 1,,0 MEANS KA10
; SETZ T, ;TEST FOR KL10
; BLT T,0 ;NOP BLT
; CAMN T,[1,,1] ;KL WILL STORE POINTER AS 1,,1
SETOM KAFLG ;A KL10
IFE FTDEC20,<
SKIPE TOPS20
JRST SAV20
; HRRI T,XJBSYM ;GET EXEC SYMBOL POINTER ADR
; SKPEXC ;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
; SKPEXC ;EXEC MODE?
HRRI T,.JBUSY ;NO, GET USER MODE UNDEF SYM POINTER ADR
HRRM T,USYMP ; AND SAVE RESULTING ADR
; SKPEXC
JRST SAV12 ;TRANSFER IF IN USER MODE
; SKPKA ;IS THIS A KA10?
; JRST SAV12 ;NO--LEAVE APR ALONE
; CONI T ;GET APR FLAGS
; TRNE T,NXMKA ;TEST NXM FLAG AND
; TLO T,(1B0) ; MOVE IT TO BIT 0
; TLZ T,37 ;FLUSH I AND X SO INDIRECT WORKS
; MOVEM T,SAVAPR ;SAVE STATE OF APR REGISTER
; JRST SAV12
>> ;END IFN EDDT
; ..
;SAVE STATE AND SETUP DDT MODES...
; IFN FTDEC20,<
SAV20: SETOM LASTPG# ;FORGET LAST PAGE ACCESS
IFN FTEXEC,<
SKPUSR
JRST SAV2>
MOVSI T,(1B0)
MOVEI T1,.FHSLF
SKPIR ;PSI SYSTEM ON?
SETZ T, ;NO
SKIPN SARS ;SKIP IF ALREADY HAVE SAVED STATUS
MOVEM T,SAVSTS# ;REMEMBER STATUS
SAV2: ;> ;END IFN FTDEC20
SAV12: PUSHJ P,TTYRET ;INITIALIZE TTY
REPEAT 0,< ;WAIT FOR 5.3 RELEASE FOR THIS TEST
IFN FTYANK,<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 DONE
CALLI T,4 ;DEVCHR
TRNN T,200000 ;DEVICE PAT STILL INITED?
SETZM COMAND ;NO, DONT READ ANY MORE
SAV6: > ;END IFN FTYANK
> ;END OF REPEAT 0 CONDITIONAL
MOVEI F,0 ;INIT FLAG REGISTER
SETOM SARS ;FLAG PROTECTING SAVED REGISTERS
MOVE T,[XWD SCHM,SCH]
BLT T,ODF ;LOAD THE ACS WITH MODE SWITCHES
JRST @SAVE
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 FTEXEC,<
SKPEXC
JRST RESTR2
AND T, SAVPI+1
IORI T, 2000 ;TURN ON CHANNELS
TRZ T,1000 ;MAKE SURE WE DON'T ASK FOR BOTH
HRRZM T, SAVPI
> ;END FTEXEC
RESTR2: HRLZI 17,AC0
BLT 17,17
SETZM SARS
IFN FTEXEC,<
SKPEXC
JRST RESTR3 ;TRANSFER IF IN USER MODE
IFE FTDEC20,<
SKIPGE SAVAPR ;WANT NXM SET?
MOVES 777777 ;YES--ASSUME KA-10
>
; SKIPE TRCON ;TRACE FACILITY ON?
; DATAO PI,TRCON ;YES, START TRACING
CONO PI,@SAVPI
RESTR3:>
JRST 2,@SAVE
SUBTTL BREAK POINT LOGIC
BCOMG: 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 ;PROCEED 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
XCT BCOM3 ;(SKIPE) CONDITIONAL BPT SETUP?
XCT @BCOM3 ;YES, XCT IT
XCT BCOM2 ;(SOSG) PROCEED COUNTER NOW 0?
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 FTEXEC,<
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 LEAVG
BREAK: IFN FTDEC20,<
SETZM SARS> ;BE SURE TO SAVE ACS ON BKPT
JSR SAVE ;SAVE THE WORLD
PUSHJ P,REMOVB ;REMOVE BREAKPOINTS
PUSHJ P,TTYCLR ;FLUSH WAITING TTY CHARACTERS FOR INPUT
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 FTEXEC,<
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,PSHLLC ;PUSH OLD SEQUENCE
MOVEM T,LWT ;BKPT ADR BECOMES LAST WORD TYPED
MOVEM T,LLOC ;BKPT ADR BECOMES CURRENT LOC
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
MOVEM T,LLOC ;EXAMINE ADR BECOMES CURRENT LOC
PUSHJ P,LI1 ;EXAMINE REGISTER C($NB)LEFT
BREAK1: MOVSI S,400000
XCT BREAK2 ;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
PROCED: HRRZ TT,BCOM2 ;SEE IF PROCEED POSSIBLE
JUMPE TT,ERR ;JUMP IF NOT SETUP
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
XCT PROC0 ;(HRRZI) GET ADR OF BPT
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
HLLZS BCOM2 ;CLEAR FLAG, PREVENT SECOND $P
JRST IXCT5
IXCT4:
IFN FTEXEC,< SKPUSR
JRST IXCT41> ;INIT NOT SPECIAL CASE IN EXEC MODE
SUBI T,041 ;IS UUO "INIT"?
JUMPE T,BPLUP
AOJGE T,IXCT6 ;DONT PROCEED 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
MOVE P,[IOWD LPDL,PDL]
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
JSP T,[JUMPE W1,IXCT ;INTERPRET XCT IF AC = 0
TLNN T,(1B5) ;AC FIELD NOT 0 - IN EXEC MODE?
JRST IXCT6 ;YES, DON'T INTERPRET MAPPED XCT
JRST IXCT] ;NO, INTERPRET. IGNORE AC FIELD
IXCT6: JSP T,RESTORE
LEAVG: XCT LEAV ;DO BPT INSTRUCTION
JRST @BCOM
SKIPA ;SINGLE SKIP
AOS BCOM ;DOUBLE SKIP
AOS BCOM
JRST @BCOM
BPLUP: PUSHJ P,REMOVB ;BREAKPOINT PROCEED ERROR
BPLUP1: JSR SAVE
JFCL
JRST ERR
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
XCT CPUSHP ;(PUSH ..,BCOM)
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
;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,
;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 PROCEED REGISTER
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
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)
SETZM 1(R)
SETZM 2(R)
AUTOP: SUBI R,B1ADR ;AUTO PROCEED SETUP SUBROUTINE
IDIVI R,3
MOVEI S,1
LSH S,(R)
ANDCAM S,AUTOPI
TLNE F,(CCF)
IORM S,AUTOPI
POPJ P,
> ;END FTFILE
IFN FTFILE,<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
JRST DMEMER
;DEPOSIT INTO MEMORY SUBROUTINE
IFE FTFILE,<
DEPSYM:
DEPMEM: IFE FTDEC20,<
SKIPE TOPS20
JRST DEPM20
PUSHJ P,CHKPAG ;GET PAGE ACCESS BITS INTO TT1
JUMPL TT1,CPOPJ ;ILLEGAL ADDRESS IF NEGATIVE
TLNE TT1,(1B1) ;IS PAGE KNOWN TO BE WRITEABLE?
JRST DEP1 ;YES--GO DO THE DEPOSIT RIGHT AWAY
JUMPN TT1,DEP4 ;IF WE KNOW ANYTHING THEN IT MUST BE
; A WRITE LOCKED HISEG
JSP TT1,CHKADR ;LEGAL ADDRESS?
JRST DEP4 ;YES BUT IN HI SEGMENT
DEP1: 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: IFN FTEXEC,<
SKPUSR ;IN EXEC MODE WE CAN NOT DO
POPJ P,0 ; SETUWP -- INDICATE ERROR
>
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
; > ;END IFE FTDEC20
; IFN FTDEC20,< ;DEPSYM, DEPMEM FOR DEC20
DEPM20: TRNN R,777760 ;AC?
JRST [MOVEM T,AC0(R) ;YES, DO IT
JRST CPOPJ1]
PUSHJ P,CHKADR ;GET ACCESS
JUMPE TT,DEP2 ;EMPTY PAGE OK
TLNN TT,(PM%WT+PM%CPY) ;WRITE OR COPY-WRITE?
POPJ P, ;NO, FAIL
DEP2: SETOM LASTPG ;WRITE MAY CHANGE ACCESS
MOVEM T,0(R) ;DO IT
JRST CPOPJ1
; > ;END IFN FTDEC20
DSYMER: PUSHJ P,CLRCSH ;DEPOSIT FOR SYM TABLE ROUTINES
> ;END IFE FTFILE
DEPERR:
DMEMER: PUSHJ P,DEPMEM ;DEPOSIT AND GO TO ERR IF IT FAILS
JRST ERR
POPJ P,
XLIST
IFN FTFILE,<
DSYMER: PUSHJ P,DEPSYM ;TRY SYMBOL TABLE DEPOSIT
HALT . ;GIVE UP
POPJ P, ;AND RETURN
DEPSYM: PUSH P,TT ;SAVE THREE LOCATIONS
PUSH P,TT1 ; TO PROTECT FILDDT
PUSH P,R ; ..
MOVE TT,FISPTR ;GET DEF POINTER
HLRE TT1,TT ;GET LENGTH
SUB TT,TT1 ;COMPUTE END OF SYMBOLS
TLZ TT,-1 ;CLEAR JUNK
MOVE TT1,FIUPTR ;GET START OF UNDEF S.T.
CAMLE TT1,ESTUT ; IN THE CASE OF UND1 CODE ALREADY
; TRYING TO EXTEND S.T.
MOVE TT1,ESTUT ;YES--USE THAT VALUE
SKIPL TT1 ;MIGHT NOT BE ANY UNDEFINED SYMBOLS
MOVE TT1,FISPTR ;FAILING THAT, GET START OF SYMBOLS
TLZ TT1,-1 ;CLEAR JUNK
TLZ R,-1 ; ..
CAIG TT1,(R) ;SEE IF TOO LOW
CAIGE TT,(R) ;OR TOO HIGH
HALT . ;YES--QUIT
POP P,R
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: HRRZ TT1,R ;COPY ADDRESS
CAIG TT1,17 ;IS IT AN AC?
JRST [MOVEM T,AC0(TT1) ;STORE
JRST CPOPJ1]
SKIPN PATCHS ;SEE IF PATCHING
JRST DEPNPT ;NO--GIVE NOOP
PUSHJ P,CVTADR ;CHANGE ADDRESS PER $U
POPJ P,0 ;ERROR
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
MOVSI TT2,(1B5) ;SET CHANGED BIT
CAME T,@FETADR ;UNLESS NO CHANGE
IORM TT2,@FETPAG ; ..
MOVEM T,@FETADR ;CHANGE WINDOW
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
DEPNPT: AOSG DEPNCT ;FIRST TRY?
OUTSTR [ASCIZ \
?Patching was not enabled by /P
\]
JRST CPOPJ1
DEPNCT: BLOCK 1
;STILL UNDER FTFILE
;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
HLRE W1,FIUPTR ;GET LENGTH OF UNDEFINED S.T.
HLRE R,FISPTR ;GET LENGTH OF STANDARD S.T.
ADD W1,R ;ADD TOGETHER
MOVM W1,W1 ;MAKE POSITIVE
HRRZ R,TT ;GET BASE OF UNDEFINED S.T.
SKIPN TT ;IN CASE NOTHING THERE
HRRZ R,T ;USE BASE OF DEFINED S.T.
ADD W1,R ;ADD BASE AND LENGTH OF TABLES
MOVEM W1,MONSIZ ;STORE AS NEW SIZE OF .XPN FILE
MOVE W1,FIUPTR ;PREPARE TO
MOVE R,T
JUMPGE W1,NOUCPY ;JUMP IF NONE
JUMPE TT,NOUCPY
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 FTFILE
NOSCPY: SETZM WINNUM ;START WITH WINDOW ZERO
WRTLP: MOVE T,WINNUM ;GET WINDOW NUMBER
MOVE T,WINDIR(T) ;GET PAGTBL ADDRESS
MOVSI TT1,(1B5) ;SEE IF PAGE CHANGED
TDNE TT1,(T) ; ..
PUSHJ P,WRTWIN ;WRITE THE WINDOW
AOS T,WINNUM ;STEP TO NEXT WINDOW
CAIGE T,CT.RES ;MORE
JRST WRTLP ;NO--KEEP GOING
MOVSI TT,-MX.SIZ ;LOOK FOR CHNAGED BITS
MOVSI TT1,(1B5) ; ..
TDNN TT1,PAGTBL(TT) ; ..
AOBJN TT,.-1 ; ..
SKIPG TT ;ANY FOUND
OUTSTR [ASCIZ "
?FILDDT INTERNAL ERROR -- VERIFY YOUR PATCHES
"]
CLOSE 1,
STATZ 1,760000 ;ALL OK
OUTSTR [ASCIZ "
?OUTPUT ERROR ON CLOSE
"]
NOCHNZ: CALLI 12
> ;END FILDDT CASE
LIST
;FETCH FROM MEMORY SUBROUTINE
;HFETCH GETS A WORD FROM THE HISEG GIVEN AN OFFSET INTO THE SEGMENT
;CALL WITH:
; R = HISEG OFFSET
; PUSHJ P,HFETCH
; NO HISEG RETURN
; HERE WITH WORD IN T
;
HFETCH:
IFN FTEXEC,<
; SKPUSR ;NO HISEG SYMBOLS IN EXEC MODE (OR SMDDT)
POPJ P,0> ; ..
PUSHJ P,GETHSO ;GET START OF HISEG
JUMPE T,CPOPJ ;EXIT IF NONE
ADD R,T ;RELOCATE
;FALL INTO FETCH
;SUBROTINE GET A WORD FROM MEMORY
;CALL WITH:
; R = JUNK,,ADDRESS
; PUSHJ P,FETCH
; HERE IF ADDRESS IS NOT VALID
; HERE WITH WORD IN T AND R UNCHANGED
;
;AC'S TT1 AND TT2 CHANGED
FETCH: IFE FTDEC20,<
IFE FTFILE,<
SKIPE TOPS20
JRST FET20
PUSHJ P,CHKPAG ;GET ACCESS BITS FOR PAGE
JUMPL TT1,CPOPJ ;ERROR IF PAGE DOES NOT EXIST
TLNE TT1,(1B2) ;IS PAGE READABLE?
JRST FET1 ;YES--GO READ IT
JUMPN TT1,CPOPJ ;EXIT IF KNOW CONCEALED
JSP TT1,CHKADR ;LEGAL ADDRESS?
JFCL ;HIGH OR LOW OK FOR FETCH
FET1: TRNN R,777760 ;ACCUMULATOR?
SKIPA T,AC0(R) ;YES
MOVE T,(R) ;NO
JRST CPOPJ1> ;SKIP RETURN ONLY FOR LEGAL ADDRESS
; > ;END OF IFE FTDEC20
; IFN FTDEC20,< ;FETCH FOR DEC20
FET20: TRNN R,777760 ;AC?
JRST [MOVE T,AC0(R) ;YES, DO IT
JRST CPOPJ1]
PUSHJ P,CHKADR ;GET ACCESS
TLNE TT,(PA%EX) ;EXISTS?
TLNN TT,(PM%RD) ;HAVE READ?
POPJ P, ;NO, FAIL
MOVE T,0(R) ;YES, DO IT
JRST CPOPJ1
; > ;END IFN FTDEC20
XLIST
IFN FTFILE,<
HRRZ TT1,R ;STRIP OF COUNT
CAIG TT1,17 ;IS IT AN AC
JRST [MOVE T,AC0(TT1) ;YES--GET THE AC
JRST CPOPJ1] ;GIVE GOOD RETURN
PUSH P,R ;SAVE JUNK IN R
TLZ R,-1 ;CLEAR JUNK
PUSHJ P,CVTADR ;MAP THE ADDRESS
SKIPA ;ERROR
PUSHJ P,FETX ;GET THE WORD
SOS -1(P) ;ERROR
POP P,R ;RESTORE R
JRST CPOPJ1 ;RETURN
FETX: SKIPN CRASHS ;CRASH.SAV EXIST?
JRST MONPEK ;NO - GO PEEK AT RUNNING MONITOR
HRRZ TT1,R ;STRIP OFF POSSIBLE COUNT
LSH TT1,-9 ;CONVERT TO PAGE #
CAIL TT1,MX.SIZ ;TOO BIG?
POPJ P,0 ;YES--PUNT
SKIPN PAGTBL(TT1) ;SOMETHING THERE?
POPJ P,0 ;NO--ERROR
ADDI TT1,PAGTBL ;SET TO START OF TABLE
MOVEM TT1,FETPAG ;SAVE FOR LATER
LDB T,[POINT 9,@FETPAG,17] ;GET WINDOW NUMBER
SOJGE T,INCORE ;JUMP IF IN CORE
AOS T,WINNUM ;STEP TO NEXT WINDOW
CAIL T,CT.RES ;ARE THERE THAT MANY?
SETZB T,WINNUM ;NO--WRAP AROUND
MOVEI TT2,1(T) ;STORE WINDOW # PLUS 1
DPB TT2,[POINT 9,@FETPAG,17] ;IN PAGTBL
MOVSI TT1,(1B5) ;CHANGE BIT
TDNE TT1,@WINDIR(T) ;DID THIS PAGE CHANGE?
PUSHJ P,WRTWIN ;YES--WRITE OUT WINDOW
MOVE T,WINNUM ;GET WINDOW NUMBER BACK
MOVEI TT1,0 ;MARK CURRENT PAGE AS NOT IN CORE
DPB TT1,[POINT 9,@WINDIR(T),17]
MOVE TT1,FETPAG ;FIX UP DIRECTORY
MOVEM TT1,WINDIR(T) ; ..
PUSHJ P,REDWIN ;READ NEW DATA
MOVE T,WINNUM ;GET NUMBER OF CURRENT WINDOW
INCORE: LSH T,9 ;CONVERT TO WORDS
ADDI T,WIND0 ;BUMP TO BASE OF WINDOWS
LDB TT1,[POINT 9,R,35] ;GET WORD OFFSET
ADD T,TT1 ;ADDRESS OF WORD
MOVEM T,FETADR ;SAVE FOR DEPOSIT
MOVE T,(T) ;GET DATA
JRST CPOPJ1 ;GOOD RETURN
MONPEK: HRRZ T,R
CALLI T,33
JRST CPOPJ1
WRTWIN: SKIPA T,[OUT 1,TT1]
REDWIN: MOVE T,[IN 1,TT1]
PUSH P,T ;SAVE UUO
MOVE T,WINNUM ;GET CURRENT WINDOW NUMBER
MOVSI TT2,(1B5) ;CLEAR MODIFIED BIT
ANDCAM TT2,@WINDIR(T) ; IN THE PAGE TABLE
HRRZ TT1,@WINDIR(T) ;GET FILE PAGE #
LSH TT1,2 ;CONVERT TO BLOCK
USETI 1,1(TT1) ;POINT FILSER
LSH T,9 ;CONVERT WINDOW # TO WORDS
ADDI T,WIND0 ;BASE OF WINDOWS
MOVSI TT1,-1000 ;NEGATIVE WORD COUNT
HRRI TT1,-1(T) ;IOWD
MOVEI TT2,0 ;TERMINATE LIST
POP P,T ;RESTORE UUO
XCT T ;DO I/O
POPJ P,0 ;DONE
GETSTS 1,T
SETSTS 1,17
TLNN T,740000
POPJ P,0 ;JUST EOF
OUTSTR [ASCII "?FATAL I/O ERROR
"]
CALLI 1,12 ;SAY .
SETSTS 1,17 ;CLEAR ERROR BITS
POPJ P,0 ;IGNORE ERROR
> ;END FILDDT CONDITIONAL
LIST
IFE FTDEC20,<
CHKADR: SKIPE TOPS20
JRST CHKA20
HRRZ TT,.JBREL ;GET HIGHEST ADDRESS IN LOW SEGMENT
IFN FTEXEC,<
SKPUSR
JRST CHKA4 ;DO MAP IN EXEC MODE
>
CAIL TT,(R) ;CHECK FOR WITHIN LOW SEGMENT
JRST 1(TT1) ;ADDRESS IS OK IN LOW SEGMENT, SKIP RETURN
SKIPN .JBHRL ;ANY HISEG?
POPJ P,0 ;NO--ERROR
PUSH P,T ;SAVE T
PUSHJ P,GETHSO ;GET START OF HISEG
HRRZ TT,R ;COPY DESIRED ADDRESS
SUB TT,T ;GET OFFSET INTO HISEG
POP P,T
JUMPL TT,CPOPJ ;MUST BE POSITIVE
HRRZ TT,.JBHRL ;TOP OF HISEG
CAIGE TT,(R) ;IS ADDRESS TOO BIG?
POPJ P,0 ;YES--ERROR
JRST (TT1) ;NO--INDICATE HISEG
CHKPAG: IFN FTEXEC,<
MOVEI TT1,0 ;PRESET UNKNOWN ANSWER
SKPUSR ;SKIP IF IN USER MODE
POPJ P,0 ;DO NOT DO UUO'S IN EXEC MODE
>
HRRZ TT1,R ;COPY ADDRESS
LSH TT1,-9 ;SHIFT LEFT 9 BITS
HRLI TT1,6 ;FUNCTION TO GET ACCESS BITS
PAGE. TT1, ;ASK THE MONITOR
TDZA TT1,TT1 ;RETURN ZERO IF UNKNOWN
TRO TT1,1 ;MAKE SURE NON-ZERO IF UUO WON
POPJ P,0 ;ELSE RETURN GOOD STUFF
GETHSO: IFN FTEXEC,<
SKPUSR
JRST [MOVEI T,400000
POPJ P,0]
>
SKIPE TOPS20
JRST GETH20
MOVE T,[-2,,.GTUPM]
GETTAB T,
MOVEI T,0
HLRZ T,T
CAIGE T,777
MOVEI T,400000
POPJ P,
; > ;END IFE FTDEC20
; IFN FTDEC20,<
CHKA20: IFN FTEXEC,<
SKPUSR
JRST CHKA4>
PUSH P,T2
PUSH P,R
HRRZ T2,0(P) ;GET DESIRED ADDRESS
XOR T2,LASTPG ;COMPARE WITH LAST ONE TESTED
TRNN T2,777000 ;SAME PAGE?
JRST CHKA1 ;YES, ALREADY HAVE ACCESS
XORM T2,LASTPG ;NO, SET NEW LAST PAGE
JSP T1,.+1 ;GET USER FLAG
TLNN T1,(PC%USR) ;IN USER MODE?
JRST [HRRZ T1,0(P) ;NO, MONITOR. GET ADDRESS
MRPAC ;READ MONITOR PAGE ACCESS
JRST CHKA2] ;RETURN IT
LDB T1,[POINT 9,0(P),26] ;GET PAGE NUMBER
HRLI T1,.FHSLF
RPACS ;READ PAGE ACCESS
CHKA2: HLLM T2,LASTPG ;SAVE ACCESS WITH ADDRESS
CHKA1: HLLZ TT,T2 ;RETURN ACCESS IN TT
POP P,R
POP P,T2
POPJ P,
; > ;END FTDEC20
IFN FTEXEC,<
CHKA4: SKPNKL ;KL10?
JRST [MAP TT,0(R) ;YES, GET PAGING DATA
TLNN TT,(1B8) ;MAPPED REF?
JRST CHKA5 ;NO, ALLOW IT
TLNN TT,(1B1) ;HARD PAGE FAIL?
TLNN TT,(1B2) ;OR NO ACCESS?
JRST CHKA3 ;YES
TLNN TT,(1B3+1B4) ;WRITE ALLOWED?
JRST CHKA7 ;NO
JRST CHKA5] ;YES
SKPKI ;KI10?
JRST CHKA8 ;NO, NO MAP INSTRUCTION
MAP TT,0(R) ;GET ACCESS BITS FOR PAGE
TRNN TT,1B18 ;PAGE FAIL?
JRST CHKA6 ;NO, GO INSPECT DATA
TRNE TT,1B22 ;YES, HAVE MATCH?
JRST CHKA3 ;NO, PAGE HAS NO ACCESS
CHKA6: TRNN TT,1B20+1B22 ;WRITABLE OR NO MATCH? (UNMAPPED REF)
IFN FTDEC20,<
CHKA7: SKIPA TT,[PM%RD+PA%EX] ;NO
CHKA8:
CHKA5: MOVSI TT,(PM%RD+PM%WT+PA%EX) ;YES
POPJ P,
CHKA3: MOVSI TT,(1B5) ;SAY NO ACCESS
POPJ P,
>
IFE FTDEC20,<
CHKA7: JRST (TT1) ;CAN NOT WRITE -- INDICATE HISEG
CHKA5: JRST 1(TT1) ;CAN WRITE -- INDICATE LOWSEG
CHKA3: POPJ P,0 ;PAGE FAIL -- INDICATE ERROR
CHKA8: CONO APR,NXMKA ;CLEAR NXM FLAG
MOVE TT,(R) ;SEE IF NXM SETS
CONSO APR,NXMKA ;TEST NXM FLAG
JRST 1(TT1) ;OK
POPJ P,0 ;ERROR
>> ;END FTEXEC AND FTDEC20
; IFN FTDEC20,<
GETH20: IFN FTEXEC,<
SKPUSR
JRST GETHSZ> ;NO HIGHSEG IN EXEC MODE
; SKIPN JDTFLG# ;JOB DATA AREA VALID?
; JRST GETHSZ ;NO, ASSUME NO HIGHSEG
; MOVE T,.JBHSO ;CHECK SPECIAL LOSEG CELL
; LSH T,^D9 ;MAKE PAGE INTO ADDRESS
; SKIPN T ;BUT IF NOTHING SETUP,
; MOVEI T,400000 ;ASSUME USUAL
; SKIPN .JBHRL ;ANY HIGHSEG?
GETHSZ: SETZ T, ;NO, SAY NO HIGHSEG
POPJ P, ; >;END IFN FTDEC20
XLIST
IFN FTFILE,<
;MAP AN ADDRESS
CVTADR: SKIPN EPTUPT ;$U GIVEN
JRST CPOPJ1 ;NO
HLRZ T,EPTUPT ;EXEC PAGING
JUMPE T,CVTAD2 ;NO
LDB T,[POINT 9,R,26];GET PAGE #
CAIGE T,340 ;IS THERE A MAP ENTRY?
JRST CPOPJ1 ;NO--LOOK IN PHYSICAL CORE
CAIL T,400 ;PER PROCESS
JRST CVTAD1 ;NO--JUST LIKE USER
PUSH P,R ;SAVE ARGUMENT
LSH T,-1 ;CONVERT TO 1/2 WORD
HRRZ R,EPTUPT ;GET ADDRESS OF UPT
ANDI R,17777 ;JUST PAGE #
LSH R,9 ;CONVERT TO WORD
ADDI R,400-<340/2>(T) ;FOR THIS PAGE
JRST CVTAD3 ;COMPUTE ADDRESS
CVTAD1: HLRZ T,EPTUPT ;GET EPT ADDRESS
SKIPA
CVTAD2: HRRZ T,EPTUPT ;GET UPT ADDRESS
ANDI T,17777 ;JUST PAGE #
PUSH P,R ;SAVE R
LSH T,9 ;CONVERT TO WORD
LSH R,-12 ;CONVERT TO 1/2 WORD IN MAP
ANDI R,377 ;MASK OUT JUNK
ADD R,T ;ADDRESS OF MAP ENTRY
CVTAD3: PUSHJ P,FETX ;FETCH PAGE TABLE ENTRY
MOVEI T,017000 ;ERROR
POP P,R ;RESTORE R
TRNN R,1000 ;ODD PAGE
HLRZ T,T ;NO--FLIP ENTRY
TRZN T,400000 ;VAILD ENTRY
POPJ P,0 ;NO--ERROR
ANDI T,17777 ;JUST PAGE #
LSH T,9 ;CONVERT TO PAGE #
ANDI R,000777 ;GET NEW ADDRESS
IOR R,T ; ..
JRST CPOPJ1 ;GIVE GOOD RETURN
> ;END FTFILE
LIST
SUBTTL BINARY TO SYMBOLIC CONVERSION
; PUSHJ P,LOOK ;AC T CONTAINS BINARY TO BE INTERPRETED
; RETURN 1 ;NOTHING AT ALL FOUND THAT'S USEFUL
; RETURN 2 ;SOMETHING FOUND, BUT NO EXACT MATCH
; RETURN 3 ;EXACT MATCH FOUND AND PRINTED
LOOK: MOVEM T,TEM ;SAVE VALUE BEING LOOKED UP
PUSHJ P,CSHVER ;SEE IF CACHE IS USEFUL
JRST LOOKC2 ;ITS NOT. DO IT THE OLD WAY
MOVE T,TEM ;RECOVER VALUE
MOVSI R,-NSYMCS ;CHECK SYMBOL CACHE FIRST
LOOKC1: SKIPE W1,SYMCSH(R) ;GET POINTER AND CHECK IN USE
CAME T,1(W1) ;VALUE SAME?
SKIPA ;NO. DON'T LOOK AT IT THEN
JRST [MOVE W2,0(W1) ;CHECK SYMBOL
TLNE W2,(DELI+DELO) ;DELETED?
JRST .+1 ;YES, IGNORE IT
MOVEM W1,SYMPNT ;GOOD ONE
JUMPL W1,LOOKO2 ;WAS OUTSIDE LOCAL
JRST LOOKO4] ;WAS GLOBAL OR PROGRAM
AOBJN R,LOOKC1
LOOKC2: 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,CPOPJ ;RETURN, NOTHING FOUND
LOOK1: MOVE W2,(R) ;GET FLAGS FOR 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
CAML T,1(R) ;VALUE TOO LARGE?
TLNE W2,(DELI!DELO) ;DELETED?
JRST LOOK3 ;YES, GET NEXT SYMBOL
TLNN W2,(GLOBL) ;NOT PROGRAM NAME. GLOBAL SYMBOL?
TRNN F,PNAMEF ;LOCAL SYMBOL. INSIDE SPECIFIED PROGRAM?
JRST LOOK5 ;CHECK FOR BEST VALUE SO FAR
CAIGE T,20 ;QUANT IS IN AC RANGE?
JRST LOOK3 ;YES, IGNORE OUTSIDE LOCALS
MOVE W,1(R) ;GET VALUE
XOR W,T ;COMPARE
JUMPL W,LOOK3 ;REJECT IF SIGNS DIFFERENT
SKIPN W2,SYMPNT ;HAVE ANY OUTSIDE LOCAL NOW?
JRST LOOK2 ;NO, USE THIS ONE
MOVE W,1(R) ;COMPARE VALUES
SUB W,1(W2)
JUMPLE W,LOOK3 ;REJECT UNLESS BETTER
LOOK2: TRZ F,MDLCLF ;NOTE NO AMBIGUITY NOW
HRRZM R,SYMPNT ;SAVE POINTER TO SYMBOL
LOOK3: AOBJN R,.+1
AOBJN R,LOOK3A ;ADVANCE POINTER TO NEXT SYM. ANY LEFT?
IFE FTFILE,<
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 W2,SYMPNT ;OUTSIDE LOCALS FOUND?
TRNE F,MDLCLF ;THAT ARE NOT MULTIPLY SYMBOLED?
JRST LOOK4 ;NO
JUMPGE F,LOOKO1 ;JUMP IF NO REGULAR SYMBOL FOUND
MOVE W,1(W2) ;GET OUTSIDE LOCAL VALUE
CAMG W,1(W1) ;BETTER THAN REGULAR SYM VALUE?
JRST LOOK4 ;NO, USE REGULAR SYM
LOOKO1: HRLI W1,(1B0) ;FLAG OUTSIDE LOCAL
PUSHJ P,SYMCSI ;ADD TO SYMBOL CACHE
LOOKO2: MOVE W1,SYMPNT ;PICK UP POINTER TO SYMBOL
CAME T,1(W1) ;VALUE IDENTICAL?
JRST [SUB T,1(W1) ;NO, COMPUTE DIFFERENCE
JRST CPOPJ1] ;RETURN INEXACT
PUSHJ P,SPT0 ;YES, TYPE IT OUT
MOVEI T,"#"
PUSHJ P,TOUT ;TYPE # TO SHOW POSSIBLE AMBIGUITY
JRST LOOKO3 ;DOUBLE SKIP RETURN
LOOK4: SETZM SYMPNT ;FORGET ANY OUTSIDE LOCAL SEEN
JUMPGE F,CPOPJ ;RETURN 1 IF NO GOOD SYMBOLS FOUND
SUB T,1(W1) ;SOMETHING FOUND, CALCULATE HOW FAR OFF
JRST CPOPJ1 ;RETURN 2, SOMETHING FOUND BUT NOT EXACT
LOOK5: MOVE W2,1(R) ;GET VALUE FROM TABLE
XOR W2,T ;COMPARE SIGNS
JUMPL W2,LOOK3 ;REJECT IF SIGNS DIFFERENT
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
JUMPN W2,LOOK3 ;IF NOT PERFECT, CONTINUE LOOKING
HRLI W1,0 ;FLAG GLOBAL OR PROGRAM LOCAL
PUSHJ P,SYMCSI ;ADD TO SYMBOL CACHE
LOOKO4: PUSHJ P,SPT0 ;PERFECT, TYPE IT OUT
LOOKO3: AOS (P) ;SKIP TWICE
JRST CPOPJ1
;ADD SYMBOL TO SYMBOL CACHE
SYMCSI: AOS W2,SYMCSP ;ROUND-ROBIN INSERT
CAIL W2,NSYMCS ;WRAPAROUND?
SETZB W2,SYMCSP ;YES
MOVEM W1,SYMCSH(W2) ;STORE POINTER
POPJ P,
;VERIFY CACHE IS NOW USEFUL, I.E. IT POINTS TO THE PROPER SYMBOL
;TABLE
CSHVER: PUSHJ P,SYMSET ;GET CURRENT POINTERS
CAMN R,OLDSYM ;SAME AS PREVIOUS?
JRST CPOPJ1 ;YES. GO USE IT
MOVEM R,OLDSYM ;SAVE CURRENT SYMBOL POINTER
; AND FALL THROUGH TO FLUSH CACHE
;CLEAR SYMBOL CACHE
CLRCSH: MOVE TT1,[SYMCSH,,SYMCSH+1]
SETZM -1(TT1)
BLT TT1,SYMCSH+NSYMCS-1
POPJ P,
CONSYM: MOVEM T,LWT
IFN FTFILE,<
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
; IFN FTDEC20,<
TLNE T,(700B8) ;NO BUILT-IN OPCODES .L. 100
;>
PUSHJ P,OPTYPE
; IFN FTDEC20,<
TRNE F,ITF ;INSTRUCTION TYPED?
JRST PFULI1 ;YES
MOVE T,LWT ;NO, GET WORD
PUSHJ P,LOOK ;TRY FOR FULL WORD MATCH
JRST PFULI1 ;NOT FOUND
JRST PFULI1 ;CLOSE IS NOT GOOD ENOUGH
POPJ P, ;FOUND AND PRINTED
PFULI1: ;>
MOVSI T,777000
AND T,LWT
TRNE F,ITF ;HAS INSTRUCTION BEEN TYPED?
JRST PIN2 ;YES
PUSHJ P,LOOK ;NO, LOOK IN SYMBOL TABLE
JRST HLFW ;NOTHING FOUND, OUTPUT AS HALFWORDS
JRST HLFW ;NO EXACT MATCH, OUTPUT AS HALFWORDS
PIN2: TRO F,NAF ;EXACT MATCH TYPED, ALLOW NEG ADDRESSES
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
IFN FTDEC20,<
MOVE W1,W ;GET COPY
TRC W1,600
TRNN W1,710 ;IS INST TRXX OR TLXX?
JRST [PUSHJ P,TOC ;YES, PRINT ADDRESS NUMERIC
JRST PI7]> ;END IFN FTDEC20
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,CPOPJ ;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
JRST PADS3 ;NOTHING FOUND, TYPE NUMERIC
SKIPA W2,1(W1) ;SOMETHING FOUND, GET VALUE
POPJ P, ;EXACT MATCH FOUND AND TYPED
IFN FTDEC20,<
CAIGE T,1000>
IFE FTDEC20,<
IFE FTEXEC!FTFILE,<
CAIGE T,100> ;IN USER MODE, PRINT NUMERIC IF SYMBOL OFF
IFN FTEXEC!FTFILE,<
CAIGE T,200> ; BY 100(8) OR MORE- 200(8) FOR SMDDT
>
CAIGE W2,30000 ;PRINT ADRS .LT. 30000 NUMERICALLY (SMDDT)
JRST PADS3 ;PRINT ADDRESS NUMERICALLY
MOVE W2,TEM ;GET ORIGINAL QUANTITY
CAIL W2,-100 ;ADDRESS BETWEEN -100 AND -1?
JRST PADS3 ;YES, PRINT NUMERICALLY
MOVEM T,TEM
PUSHJ P,SPT0
MOVEI T,"#"
SKIPE SYMPNT ;SYMBOL IS OUTSIDE LOCAL?
PUSHJ P,TOUT ;YES, FLAG
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 6,T,5] ;GET HI-ORDER OP CODE BITS
CAIN R,71 ;OP CODE 71X ?
JRST SMINOUT ;YES, SM-10 I/O
CAIN R,72 ;OP CODE 72X ?
JRST SMINOUT ;YES, SM-10 I/O
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 INOUT2 ;NOTHING FOUND, PRINT AS OCTAL
JRST INOUT2 ;NO EXACT MATCH, PRINT AS OCTAL
JRST PI3A ;EXACT MATCH TYPED
INOUT2: MOVE T,TEM
LSH T,-30
PUSHJ P,TOC
JRST PI3A
MASK: TLNE F,(QF)
JRST MASK1
IFE FTFILE,<
MOVEI T,MSK
MASK2: MOVEI W,1
MOVEM W,FRASE1
JRST QUANIN
>
IFN FTFILE,<JRST ERR>
MASK1: MOVEM T,MSK
JRST RET
;SM-10 I/O INSTRUCTION PRINT
SMINOUT:PUSH P,W1
PUSH P,W2
LDB R,[POINT 4,T,8] ;GET INST BITS
SETZM SMIOB#
TRZN R,10 ;SM-10 BYTE I/O INST ?
SETOM SMIOB ;YES
MOVE T,SMTABLE(R) ;GET ASCII I/O CODE
PUSHJ P,TEXTT ;PRINT IT
MOVEI T,"B"
SKIPE SMIOB
PUSHJ P,TOUT ;IF I/O BYTE, PRINT "B"
POP P,W2
POP P,W1
JRST PIN2
SMTABLE:ASCII/TIOE/
ASCII/TION/
ASCII/RDIO/
ASCII/WRIO/
ASCII/BSIO/
ASCII/BCIO/
ASCII/UNDEF/
ASCII/UNDEF/
ASCII/UNDEF/
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
IFE FTDEC20,<
JRST SEAR2B>
IFN FTDEC20,<
JRST [MOVEI R,777 ;FETCH FAILED, BUMP TO NEXT PAGE
IORB R,DEFV
JRST SEAR2A]> ;CONTINUE SEARCH
TLNE F,(LTF) ;CHECK FOR EFFECTIVE ADDRESS SEARCH
JRST EFFEC0
EQV T,WRD
AND T,MSK
SEAR2G: XCT SEAR2 ;(JUMPE T, OR JUMPN T,) TO SEAR3 IF FOUND
SEAR2A: AOS R,DEFV ;GET NEXT LOCATION
TRNN R,777 ;CHECK LISTEN ONLY ONCE PER PAGE
PUSHJ P,LISTEN ;ANYTHING TYPED?
CAMLE R,ULIMIT ;OR END OF SEARCH?
JRST SEARFN ;YES
JRST SEAR1 ;NO, LOOK SOME MORE
IFE FTDEC20,<
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: PUSHJ P,LISTEN ;ANY TYPEIN?
SKIPA ;NO
JRST SEARFN ;YES, TERMINATE SEARCH
MOVE R,DEFV
PUSHJ P,FETCH
JRST ERR
TLZ F,(STF) ;GET RID OF SUPPRESS TYPEOUT MODE
MOVE T,DEFV
PUSHJ P,PSHLLC ;PUSH OLD LOCATION COUNTER
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 SEAR2G
SETUP: TLNN F,(QF) ;QUANTITY TYPED?
IFE FTDEC20,<
MOVEI T,777777> ;NO, DEFAULT HIGH ADR IS TOP OF MEMORY
IFN FTDEC20,<
IFN FTEXEC,<
HRRZ T,.JBFF> ;DEFAULT UPPER LIMIT
IFE FTEXEC,<
MOVEI T,777777>>
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
IFE FTDEC20,<
IFN FTEXEC,<
SKPUSR
>
IFN FTEXEC!FTFILE,<
JRST [CAIGE R,XZLOW
MOVEI R,XZLOW ;IN EXEC MODE, DON'T ZERO 20-40
JRST ZERO3 ] >
>
IFE FTFILE,<
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
IFE FTDEC20,<
CAML R,S
CAMLE R,W1>
JRST .+2
HRRZ R,W1 ;DON'T ZERO SYMBOL TABLE
>
IFN FTFILE,<
ZERO3:>
ZEROR: CAMLE R,ULIMIT ;ABOVE LIMITS?
JRST DD1 ;YES, STOP
PUSHJ P,DEPMEM ;DEPOSIT T
IFE FTFILE,<
TROA R,377777 ;
AOJA R,ZERO1
TRNN R,400000 ;HI SEGMENT?
AOJA R,ZERO1 ;NO, KEEP GOING
>
JRST DD1 ;FINISH
IFN FTFILE,<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 ,,
XCT TOCS ;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: MOVE 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
JFCL ;PREVENT OVERFLOW MESSAGE
; FROM FORTRAN PROGRAMS
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
MOVMS B ;MAKE POSITIVE
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,
CRN: MOVEI T,15 ;CARRIAGE RETURN
JRST TOUT
CRF: PUSHJ P,CRN
MOVEI T,12 ;LINE FEED
JRST TOUT
LCT: IFE FTDEC20,<
MOVEI T,11
IFN FTEXEC,<
SKPEXC >
JRST TOUT> ;IN USER MODE, TYPE A TAB
IFN FTEXEC!FTDEC20,<
PUSHJ P,TSPC
PUSHJ P,TSPC >
TSPC: MOVEI T,40 ;SPACE
JRST TOUT
BITO: MOVEI R,BITT ;BYTE OUTPUT SUBROUTINE
SKIPN OLDAR
MOVEM AR,OLDAR
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 BASE1O
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,
XLIST
SUBTTL PUNCH PAPER TAPE LOGIC
IFN FTPTP,<IFN FTEXEC,<
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 PTP,20
JRST .-1
CONO PTP,50
DATAO PTP,T
SOJG W1,PWRD2
POPJ P,0
FEED: CONSZ PTP,20
JRST .-1
CONO PTP,10
DATAO PTP,FEED1
SOJN T,FEED
FEED1: POPJ P,0 ;ADDRESS USED AS A CONSTANT
LOADB:
PHASE 0 ;RIM10B CHECKSUM LOADER
XWD -16,0
BEG: CONO PTR,60
HRRI AA,RD+1
RD: CONSO PTR,10
JRST .-1
DATAI PTR,@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 FTPTP
;FOR PAPER TAPE IO
LIST
SUBTTL TELETYPE IO LOGIC
IFN FTEXEC,< ;EXECUTIVE MODE TELETYPE I/O
;APR INTERNAL CLOCK SERVICE
;CONI/CONO MTR,
MTR==024 ;DEVICE CODE
MTRLOD==1B18 ;LOAD BITS 21-23
; 19-20 ;UNUSED, MBZ
MTREPA==1B21 ;ENABLE EXEC PI ACCOUNTING
MTRENA==1B22 ;ENABLE EXEC NON-PI ACCOUNTING
MTRAMN==1B23 ;ACCOUNTING METERS ON
MTRTBF==1B24 ;TIME BASE OFF
MTRTBN==1B25 ;TIME BASE ON
MTRCTB==1B26 ;CLEAR TIME BASE
; 27-32 ;UNUSED, MBZ
MTRPIA==7B35 ;PI ASSIGNMENT
;CONI/CONO TIM
TIM==020 ;DEVICE ASSIGNMENT
TIMCIC==1B18 ;CLEAR INTERVAL COUNTER
; 19-20 ;UNUSED, MBZ
TIMITO==1B21 ;INTERVAL TIMER ON
TIMDON==1B22 ;DONE/CLEAR DONE
TIMICO==1B23 ;COUNTER OVERFLOW
;GET TYPEIN CHARACTER - EXEC MODE
XTIN: PUSHJ P,XLISTE ;TELETYPE CHARACTER INPUT
JRST .-1
JUMPE T,XTIN ;FILTER NULLS
CAIE T,175
CAIN T,176
MOVEI T,33 ;CHANGE ALL ALT MODES TO NEW
IFN FTDEC20&<^-FTEDIT>,< ;IF NO FANCY EDITING...
CAIE T,"U"-100 ;^U?
CAIN T,177 ;RUBOUT?
JRST WRONG ;YES, TYPE XXX
>
IFE FTDEC20&<^-FTEDIT>,< ;IF FANCY EDITING...
CAIE T,177 ;DON'T ECHO EDIT CHARACTERS
CAIN T,"U"-100
JRST XTIN1
CAIE T,"R"-100
CAIN T,"W"-100
JRST XTIN1>
CAIN T,15 ;CR?
JRST [MOVEI T,12 ;YES, PRESET LF FOR NEXT TIME
MOVEM T,XNXTCH
MOVEI T,15 ;ECHO AND RETURN CR NOW
JRST .+1]
SKIPN TEXINF ;DON'T ECHO TAB UNLESS TEXT INPUT
CAIE T,11
PUSHJ P,ECHO ;ECHO THE CHAR
XTIN1: POPJ P,
;TYPEOUT CHARACTER FROM T
XLIST
REPEAT 0,<
XTOUT: SKPNKL ;KL10?
JRST KLXTYO ;YES
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 TTY,20
JRST .-1
DATAO TTY,T
ANDI T,177 ;FLUSH PARITY
POPJ P,0
XLIST
REPEAT 0,<
KLXTYO: PUSHJ P,EBRIDX ;GET INDEX OF EPR IN TT2
MOVEI T,.DTMTO(T) ;GET MONITOR OUTPUT COMMAND AND CHAR IN T
MOVEM T,DTECMD(TT2) ;PUT IN COMMAND WORD
SETZM DTEMTD(TT2) ;CLEAR DONE FLAG.
XCT DING11 ;RING THE DOORBELL
SKIPN DTEMTD(TT2) ;DONE YET?
JRST .-1 ;NO, LOOP
ANDI T,377 ;CLEAN UP CHARACTER IN T
POPJ P,0 ;RETURN
>
LIST
KLXTYO: PUSH P,0
MOVE 0,T
PUSHJ P,$DTEXX ;PRINT CHAR
POP P,0
ANDI T,177
POPJ P,
$DTEXX: PUSHJ P,EBRIDX ;GET INDEX OF EBR IN TT2
SETZM DTEFLG(TT2)
MOVEM 0,DTECMD(TT2) ;LOAD COMMAND CODE
XCT DING11 ;RING -11 DOORBELL
SKIPN DTEFLG(TT2)
JRST .-1 ;WAIT TILL DONE
MOVE 0,DTEF11(TT2)
SETZM DTEFLG(TT2)
POPJ P,
>
LIST
XTOUT: PUSH P,0
MOVE 0,T
BTYTYO ;OUTPUT CHAR
POP P,0
POPJ P,
;SKIP IF HAVE INPUT CHAR AND RETURN IT IN T
XLISTE: SKIPE T,XNXTCH ;PRESET CHAR?
JRST [SETZM XNXTCH ;YES, RETURN IT ONCE
JRST XLIST1]
IFN FTYANK,<
SKIPE COMAND ;COMAND FILE?
JRST XPTRIN ;YES, READ IT
>
XLIST
REPEAT 0,<
SKPNKL
JRST KLXLIS ;DO KL10 INPUT
CONSO TTY,40 ;NO, LISTEN FOR TTY
POPJ P,
DATAI TTY,T
XLIST1: ANDI T,177
JRST CPOPJ1
XLIST
REPEAT 0,<
KLXLIS: PUSHJ P,EBRIDX ;GET EPT INDEX IN TT2
SKIPN DTEMTI(TT2) ;ANY INPUT YET?
POPJ P, ;NO
MOVE T,DTEF11(TT2) ;GET IT
SETZM DTEMTI(TT2) ;YES
JRST XLIST1
>
LIST
KLXLIS: PUSH P,0
MOVEI 3400 ;SETUP DDT MODE INPUT REQ CODE
PUSHJ P,$DTEXX ;REQUEST TTY INPUT FROM PDP-11
MOVEM 0,T
POP P,0
ANDI T,177
CAIN T,003 ;CONTROL C ?
JRST KLCC ;YES
SKIPN T ;ANY RESPONSE ?
POPJ P, ;NO, NON-SKIP RETURN
JRST XLIST1
KLCC: MOVE T,[JRST KLCC1]
JRST XEC0 ;RESTORE BP'S ETC.
KLCC1: CONO 0,0 ;CLEAR APR
MOVEM 0,KLCC0#
CONI 10,0
TRNN 600000 ;IS CACHE ON ?
JRST KLCC2 ;NO
BLKO 14,0 ;YES, FLUSH CACHE
CONSZ 0,200000
JRST .-1 ;WAIT TILL BUSY GOES AWAY
KLCC2: PUSH P,TT2
PUSHJ P,EBRIDX
MOVEI 403
MOVEM DTECMD(TT2) ;END OF PROGRAM CALL
POP P,TT2
MOVE 0,KLCC0
XCT DING11 ;DOORBELL THE -11
JRST . ;HANG UP, -11 WILL ABORT
>
LIST
PUSH P,0
BTYTYI ;GET CHAR
POP P,0
POPJ P, ;NONE AVAILABLE
MOVE T,0
POP P,0
XLIST1: ANDI T,177 ;MASK TO 7 BITS
CAIN T,003 ;CONTROL C ?
JRST SMCC ;YES
JRST CPOPJ1 ;CHAR FOUND, RETURN +2
SMCC: MOVE T,[JRST SMCC1]
JRST XEC0 ;RESTORE BP'S ETC.
SMCC1: JRST 20000 ;NOW GO TO "SMMON"
;CONSOLE TTY COMMUNICATIONS
$TYINI: 0
SETZM $80CIW ;CLEAR INPUT WORD
SETZM $80COW ;CLEAR OUTPUT WORD
SETZM $80KIW ;CLEAR INPUT WORD
SETZM $80KOW ;CLEAR OUTPUT WORD
SETZM MMFLAG#
MOVE 0,$80STAT ;GET CONSOLE STATUS WORD
TLNE 0,($80MM) ;MAINTENANCE MODE BIT SET ?
SETOM MMFLAG ;YES, SET TTY IN MAINT MODE
JRST @$TYINI
$TYCLR: 0
JRST @$TYCLR ;NOTHING REQUIRED
$CYTYI: 0
MOVE 0,$80CIW ;GET INPUT WORD
TRNN 0,$80CHR ;CHAR FLAG BIT SET ?
JRST @$CYTYI ;NO
SETZM $80CIW ;CLEAR INPUT WORD
ANDI 0,177
AOS $CYTYI
AOS $CYTYI
JRST @$CYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
$KYTYI: 0
MOVE 0,$80KIW ;GET INPUT WORD
TRNN 0,$80CHR ;CHAR FLAG BIT SET ?
JRST @$KYTYI ;NO
SETZM $80KIW ;CLEAR INPUT WORD
ANDI 0,177
AOS $KYTYI
AOS $KYTYI
JRST @$KYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
$BYTYI: 0
CTYTYI ;ANY CTY INPUT ?
JRST .+5 ;NO
HALT .
AOS $BYTYI
AOS $BYTYI
JRST @$BYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
KTYTYI ;ANY KLINIK INPUT ?
JRST @$BYTYI ;NO
HALT .
JRST .-6
$COMTI: 0
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
JRST .+7 ;YES
CTYTYI ;ANY CTY INPUT ?
JRST @$COMTI ;NO
HALT .
AOS $COMTI
AOS $COMTI
JRST @$COMTI ;DOUBLE SKIP RETURN, CHAR IN AC0
KTYTYI ;ANY KLINIK INPUT ?
JRST @$COMTI ;NO
HALT .
AOS $COMTI
AOS $COMTI
JRST @$COMTI ;DOUBLE SKIP RETURN, CHAR IN AC0
$CYTYO: 0
TRO 0,$80CHR ;SET FLAG BIT
MOVEM 0,$80COW ;PUT IN COMM AREA
CONI APR,0 ;GET PRESENT APR
ANDI 7 ;KEEP PI ASSIGNMENT
TRO $80INT ;SET INTERRUPT 8080
CONO APR,@0 ;INTERRUPT 8080
MOVE 0,$80COW ;GET OUTPUT WORD
TRNE 0,$80CHR ;8080 SENT THIS CHAR ?
JRST .-2 ;NO, WAIT
JRST @$CYTYO ;YES
$KYTYO: 0
TRO 0,$80CHR ;SET FLAG BIT
MOVEM 0,$80KOW ;PUT IN COMM AREA
CONI APR,0 ;GET PRESENT APR
ANDI 7 ;KEEP PI ASSIGNMENT
TRO $80INT ;SET INTERRUPT 8080
CONO APR,@0 ;INTERRUPT 8080
MOVE 0,$80KOW ;GET OUTPUT WORD
TRNE 0,$80CHR ;8080 SENT THIS CHAR ?
JRST .-2 ;NO, WAIT
JRST @$KYTYO ;YES
$BYTYO: 0
MOVEM 0,$BYTYC# ;SAVE OUTPUT CHAR
CTYTYO ;OUTPUT CHAR TO CTY
MOVE 0,$BYTYC ;GET OUTPUT CHAR
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
KTYTYO ;YES, OUTPUT CHAR TO KLINIK
JRST @$BYTYO
$COMTO: 0
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
JRST .+3 ;YES
CTYTYO ;OUTPUT CHAR TO CTY
JRST @$COMTO
KTYTYO ;OUTPUT CHAR TO KLINIK
JRST @$COMTO
;SAVE USER STATUS ('RETURN' TO DDT)
XLIST
REPEAT 0,<
XTTYRE: SKPNKL
JRST LTTYRE ;DO KL10 SAVE STATUS
SKIPE SAVTTY ;ALREADY HAVE IT?
JRST TTY1 ;YES
CONI TTY,SAVTTY ;SAVE PI ASSMT
CONO TTY,0 ;SET PI ASSMT TO 0
MOVSI W2,(1000000)
CONSZ TTY,120 ;WAIT FOR PREVIOUS ACTIVITY TO FINISH
SOJG W2,.-1 ;BUT DON'T WAIT FOREVER
CONI TTY,W2 ;UPDATE STATUS BITS
DPB W2,[POINT 15,SAVTTY,32]
DATAI TTY,W2
HRLM W2,SAVTTY
TTY1: CONO TTY,3410 ;INIT TTY FOR DDT
POPJ P,
>
LIST
XTTYRE: CTYINI ;INIT CTY
POPJ P,
;RESTORE USER STATUS ('LEAVE' DDT)
XLIST
REPEAT 0,<
XTTYLE: SKPNKL
JRST LTTYLE ;DO KL10 RESTORE STATUS
CONSZ TTY,120 ;WAIT FOR LAST OUTPUT
JRST .-1
CONO TTY,1200 ;CLEAR DONE FLAGS
MOVE T,SAVTTY
CONO TTY,0(T) ;RESTORE USER STATE
SETZM SAVTTY ;NOTE USER STATE NOW IN EFFECT
POPJ P,
LTTYRE: SETZM DTEFLG
SETZM DTET11
SETZM DTEF11
MOVE T,DTEOPR
OR T,[CONO 200,TO11DB]
MOVEM T,DING11
POPJ P,
LTTYLE: MOVEI T,3000
PUSHJ P,KLXTYO
JRST LTTYRE
EBRIDX: SETZM TT2
POPJ P,
XLIST
>
LIST
XTTYLE: CTYCLR
POPJ P,
XLIST
REPEAT 0,<
;ROUTINES TO SAVE AND RESTORE KL10 TTY STATUS
; WHICH AMOUNTS TO SAVING AND RESTORING DTE INTERRUPT
; INSTRUCTION IN LOCATION DTEII
LTTYLE: MOVE T,MSTRDT ;GET ID OF MASTER DTE
LSH T,3 ;FIND EPT CHUNK
MOVE W2,SAVEBR ;THE OLD EBR
LSH W2,^D9 ;MAKE IT A CORE ADDRESS
ADDI W2,0(T) ;POINT TO BEGINNING OF EPT CHUNK
MOVEI T,DTEII(W2) ;WHERE TO DO RESTORE
HRLI T,SAVTTY ;WHERE TO RESTORE FROM
BLT T,DTEDRW(W2) ;UP THROUGH DEPOSIT, LAST WORD
HRRZ T,MTRCNI ;GET SAVED MTR CONI
CONO MTR,MTRLOD(T) ;RESTORE ALL STATES
HRRZ T,TIMCNI ;GET SAVED TIM CONI
TRZ T,TIMDON+TIMICO ;FLUSH CONI-ONLY BITS
CONO TIM,0(T) ;RESTORE STATE
SETZM SAVTTY ;NOTE PGM MODES NOW IN EFFECT
CONSZ PAG,TRPENB ;IS PAGING NOW ENABLED?
SKIPN DTEEPW(W2) ;YES SECONDARY PROTOCOL IN EFFECT,
POPJ P, ;JUST RETURN, DON'T TURN IT OFF
MOVEI T,.DTNMC ;WE WERE IN REGULAR PROTOCOL, SETUP OFF COMMAND
JRST DTEDCM ;DO COMMAND
;CODE TO SAVE TTY STATE (I.E. THE DTE STATE FOR THE MASTER -11)
LTTYRE: SKIPE SAVTTY ;PGM MODES IN EFFECT?
JRST LTTYR1 ;NO, DON'T SAVE
CONI MTR,MTRCNI ;SAVE MTR STATE
CONI TIM,TIMCNI ;SAVE TIM STATE
CONI PAG,T ;READ EBR
ANDI T,017777
CONSO PAG,TRPENB ;PAGING ON NOW?
JRST LTTYR0 ;NO. EBR IS BOTH PHYSICAL AND VIRTUAL
MOVEI W1,0 ;YES. MUST SCAN MAP FOR VIRTUAL ADDRESS
LSH T,^D9 ;MAKE THIS A PHYSCIAL ADDRESS
LTTYR5: MAP W2,0(W1) ;GET PHYSICAL ADDRESS
TLNN W2,(1B2) ;ACCESSIBLE?
JRST LTTYR6 ;NO. SKIP THIS PAGE
AND W2,[37777777] ;GET PHYSICAL ADDRESS
CAMN W2,T ;IS THIS ONE THE EBR?
JRST [MOVE T,W1 ;YES. GET VIRTUAL ADDRESS
LSH T,-^D9 ;MAKE IT A PAGE
JRST LTTYR0] ;AND DONE
LTTYR6: ADDI W1,1000 ;NEXT PAGE
CAIG W1,777777 ;SCANNED ENTIRE SECTION?
JRST LTTYR5 ;NO. LOOK AT SOME MORE PAGES
HALT . ;YES. CAN'T FIND EPT.
LTTYR0: MOVEM T,SAVEBR ;SAVE EPT VIRTUAL ADDRESS
MOVSI T,-DTEN ;POLL ALL DTES
MOVE W2,[CONSO DTE,DTEPRV] ;GET TEST WORD
MOVE W1,[CONSO DTE,PI0ENB+7] ;TEST FOR PI0 ENABLED
; OR PI ASSIGNMENT UP
MOVE W,[CONO DTE,0] ;PROTOTYPE CONO
LTTYR2: XCT W1 ;PI 0 UP ON THIS GUY?
JRST [HRRI W,PIENB+PI0ENB ;NO. SET PI0
XCT W
XCT W1 ;NOW UP?
JRST LTTYR4 ;NO. DOESN'T EXIST THEN
TRZ W,PI0ENB ;TURN OFF ZERO
XCT W ;DO IT
JRST .+1] ;AND PROCEED
XCT W2 ;THIS THE MASTER?
JRST [MOVEI T,0(T) ;YES. GET ITS NUMBER
MOVEM T,MSTRDT ;SAVE IT
LSH T,^D<35-9> ;POSITION CODE IN B9
ADD T,[CONO DTE,TO11DB] ;GET THE INSTRUCTION
MOVEM T,DING11 ;SAVE IT
JRST LTTYR3] ;AND DONE
LTTYR4: ADD W2,[1B9] ;NEXT DTE
ADD W,[1B9]
ADD W1,[1B9] ;ADJUST ALL I/O INSTRUCTIONS
AOBJN T,LTTYR2 ;POLL ALL OF THEM
HALT . ;CAN'T HAPPEN!!!!!!!!!!!!!
LTTYR3: MOVE T,SAVEBR ;GET EBR AGAIN
LSH T,^D9 ;MAKE IT A CORE ADDRESS
MOVE W2,MSTRDT ;GET MASTER'S NUMBER
LSH W2,3 ;HIS CHUNK
ADD T,W2 ;THE POSITION IN THE EPT
MOVE W2,T ;SAVE EBR FOR INDEXING
MOVSI T,DTEII(T) ;START OF EPT LOCATIONS TO SAVE
HRRI T,SAVTTY ;WHERE TO SAVE THEM
BLT T,SAVDRW
SKIPN DTEEPW(W2) ;USING PRIMARY PROTOCAL?
JRST LTTYR1 ;NO. GO ON
MOVE T,MSTRDT ;GET MASTER'S ID
LSH T,^D<35-9> ;POSITION CODE IN B9
ADD T,[CONSZ DTE,TO11DB] ;GET TEST INSTRUCTION
XCT T ;WAIT FOR -11 TO ANSWER ALL DOORBELLS
JRST .-1 ;THE WAIT
LTTYR1: CONO MTR,MTRLOD+MTRTBF ;TURN OFF ALL METERS AND TIME BASE
CONO TIM,0 ;TURN OFF INTERVAL TIMER
MOVSI T,(HALT)
MOVEM T,DTEII(W2) ;NO INTERRUPTS
SETZM DTEEPW(W2) ;CLEAR EXAMINE PROTECTION WORD
MOVEI T,.DTMMC ;TURN ON SECONDARY TTY I/O SYSTEM
DTEDCM: PUSHJ P,EBRIDX ;GET EPT INDEX IN TT2
SETZM DTEFLG(TT2) ;CLEAR DONE FLAG
MOVEM T,DTECMD(TT2) ;STORE COMMAND FOR 11
XCT DING11 ;RING HIS DOORBELL
SKIPN DTEFLG(TT2) ;WAIT FOR FINISH
JRST .-1
POPJ P, ;RETURN
;ROUTINE TO LOAD EPT ADDRESS IN TT2. CALLED BY ROUTINES WISHING
;TO LOCATE THE MONITOR PROTOCOL LOCATIONS
EBRIDX: MOVE TT2,SAVEBR ;GET EBR ADDRSSS
LSH TT2,^D9 ;MAKE IT A CORE ADDRESS
POPJ P, ;AND DONE
> ;END IFN FTEXEC
>
LIST
;TELETYPE OUTPUT - COMMON START POINT
TOUT: SETZM CHINP ;RESET INPUT LINE
SETZM CHINC
ECHO: PUSH P,T ;SAVE ORIG CHAR
CAIN T,33 ;CONVERT ESC
JRST [MOVEI T,"$"
JRST ECHO1]
CAIn T,15 ;CR ?
jrst echo2 ;yes, output <cr><cr>
CAIN T,12
JRST ECHO1 ;YES, NO CONVERSION
CAIN T,"G"-100 ;BELL?
JRST ECHO1 ;NO CONVERSION
CAIN T,11 ;TAB?
IFE FTEXEC,<
JRST ECHO1> ;NO CONVERSION OF TAB IN USER MODE
IFN FTEXEC,<
JRST [SKPEXC
JRST ECHO1 ;DITTO
MOVEI T," " ;CONVERT TAB TO SPACES IN EXEC MODE
PUSHJ P,TOUT0
MOVEI T," "
PUSHJ P,TOUT0
MOVEI T," "
JRST ECHO1]
> ;END FTEXEC
CAIL T,40 ;CONTROL CHAR?
JRST ECHO1 ;NO
MOVEI T,"^" ;YES, INDICATE
PUSHJ P,TOUT0
MOVE T,0(P) ;RECOVER ORIG CHAR
ADDI T,100 ;CONVERT TO PRINTING EQUIVALENT
ECHO1: PUSHJ P,TOUT0 ;DO DEVICE-DEPENDENT OUTPUT
POP P,T
POPJ P,
echo2: pushj p,tout0
jrst echo1
IFE FTDEC20,<
OPDEF TTCALL [51B8]
TOUT0: IFN FTEXEC,< SKPUSR
JRST XTOUT >
IFN FTFILE,< SKIPE COMAND ;IS THERE A COMMAND FILE?
JRST PUTCHR> ;YES
SKIPE TOPS20
JRST .+3
TTCALL 1,T ;OUTPUT A CHARACTER
POPJ P,
EXCH T1,T
PBOUT
EXCH T1,T
POPJ P,
LISTEN: IFN FTEXEC,< SKPUSR
JRST XLISTE >
IFE FTFILE,<
IFN FTYANK,<
SKIPE COMAND
JRST PTRIN>>
IFN FTFILE,< ;FILDDT?
SKIPE COMAND ;STILL READING COMAND FILE?
POPJ P,0 ; IF YES, DO NOT LOOK FOR INPUT
; 1. SPEED UP FILDDT AND
; 2. ALLOW USER TO TYPE AHEAD
; (ONE CONTROL C)
>
SOSLE LCNT ;TIME TO DO TTCALL
POPJ P,0 ;NO--RETURN
MOVEI T,12 ;YES--RESET COUNT
MOVEM T,LCNT ; ..
SKIPE TOPS20
JRST .+4
TTCALL 2,T ;GET NEXT CHAR, NO IO WAIT
POPJ P, ;NO CHARACTER EXISTED, RETURN
JRST CPOPJ1 ;CHARACTER WAS THERE, SKIP RETURN
EXCH T1,T
MOVEI T1,.PRIIN
SIBE
AOS (P)
EXCH T1,T
POPJ P,
IFN FTEXEC,<
TTYRET: SKPUSR
JRST XTTYRET
SKIPN TOPS20
POPJ P,
SKIPE SAVTTY ;ALREADY HAVE STATE ?
JRST TTYR1 ;YES
MOVEI T1,.PRIIN
RFMOD ;GET MODES
MOVEM T2,SAVTTY
RFCOC ;GET CC MODES
MOVEM T2,SAVTT2
MOVEM T3,SAVTT3
TTYR1: MOVEI T1,.PRIIN
RFMOD
TRZ T2,TT%WAK+TT%DAM
TRO T2,TT%WKF+TT%WKN+TT%WKP+TT%ECO+01B29
SFMOD
MOVE T2,TTYCC2
MOVE T3,TTYCC3
SFCOC ;SETUP PROPER DDT MODES
MOVEI T1,.FHSLF
DIR
POPJ P, >
TTYCC2: BYTE (2) 0,1,1,1,1,1,1,2,1,2,3,1,1,2,1,1,1,1
TTYCC3: BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1
IFE FTEXEC,<TTYRET==CPOPJ>
TTYCLR:
IFN FTEXEC,< SKPUSR >
POPJ P,
SKIPE TOPS20
JRST .+5
TTCALL 14, ;CLEAR ^O, SKIP ON INPUT CHARS
POPJ P, ;NO INPUT CHARS, OR EXEC MODE
TTCALL 11, ;FLUSH ALL
JRST .+7
MOVEI 1,.PRIOU
RFMOD
TLZ 2,(TT%OSP)
SFMOD
MOVEI 1,.PRIIN
CFIBF
PUSHJ P,LISTEN
JFCL
POPJ P, ;WAITING INPUT CHARACTERS
IFN FTEXEC,<
TTYLEV: SKPUSR
JRST XTTYLEV
SKIPN TOPS20
POPJ P,
MOVEI T1,.PRIIN
MOVE T2,SAVTTY
SFMOD ;RESTORE MODES
MOVE T2,SAVTT2
MOVE T3,SAVTT3
SFCOC ;RESTORE CC MODES
MOVEI 1,.FHSLF
SKIPGE SAVSTS
EIR
SETZM SAVTTY
POPJ P, >
IFE FTEXEC,<TTYLEV==CPOPJ>
> ;END IFE FTDEC20
TEXIN: AOSA TEXINF ;NOTE TEXT INPUT
TIN: SETZM TEXINF ;NOTE NOT TEXT INPUT
IFN FTDEC20&FTEXEC&<^-FTEDIT>,<
SKPUSR ;EXEC MODE?
JRST XTIN> ;YES, SIMPLE INPUT
TIN1: SOSGE CHINC ;CHARACTER LEFT IN LINE BUFFER?
JRST CHIN1 ;NO, GO REFILL BUFFER
ILDB T,CHINP ;GET CHARACTER
POPJ P,
;REFILL LINE BUFFER WITH EDITING
CHIN1: SKPUSR ;EXEC MODE?
JRST XCHIN1 ;YES, USE SIMULATION ROUTINES
SKIPN TOPS20
JRST XCHIN1 ;TOPS-10
SKIPE T1,CHINP ;REINIT LINE?
JRST CHIN2 ;NO
MOVEI T1,NLINBF*5 ;YES, SETUP MAX CHAR COUNT
MOVEM T1,LINSPC
MOVE T1,LINBP ;SETUP POINTER
MOVEM T1,CHINP
CHIN2: MOVEM T1,TEXTIB+.RDBKL ;SET BACKUP LIMIT
SKIPG LINSPC ;ROOM LEFT IN BUFFER?
JRST ERR ;NO, TOO MUCH TYPIN
SETZ T1,
SKIPE WAKALL ;WAKEUP ON EVERYTHING?
MOVEI T1,ONES4 ;YES, USE WAKEUP TABLE
MOVEM T1,ETXTB
PUSH P,LINSPC ;SAVE CURRENT SPACE
PUSH P,CHINP ;AND POINTER
SKIPN TEXINF ;TEXT INPUT?
PUSHJ P,TTYTOF ;NO, SUPPRESS TAB ECHO
MOVEI T1,TEXTIB ;POINT TO ARG BLOCK
TEXTI ;INPUT TO NEXT BREAK CHAR
JRST ERR ;BAD ARGS (IMPOSSIBLE)
PUSHJ P,TTYTON ;RESTORE NORMAL TAB ECHO
POP P,CHINP ;RESTORE POINTER TO CHARS JUST TYPED
MOVE T1,TEXTIB+.RDFLG ;GET FLAGS
TXNE T1,RD%BFE+RD%BLR ;DELETIONS?
JRST CHIN3 ;YES
POP P,T1 ;RECOVER OLD SPACE COUNT
SUB T1,LINSPC ;COMPUTE NUMBER CHARS JUST TYPED
MOVEM T1,CHINC ;SETUP COUNT
JRST TIN1 ;GO RETURN NEXT CHAR
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE
;LINE MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN
;DELETED.
CHIN3: MOVEI T1,NLINBF*5 ;COMPUTE NUMBER CHARS NOW IN LINE
SUB T1,LINSPC
JUMPE T1,WRONG ;JUMP IF WHOLE LINE DELETED
MOVEM T1,CHINC ;LINE NOT NULL, SETUP CHAR COUNT
MOVE T1,LINBP ;REINIT POINTER
MOVEM T1,CHINP
JRST DD2 ;CLEAR WORLD AND REDO LINE
IFN <^-FTDEC20>!<FTEXEC&FTEDIT>,<
IFNDEF T1,<
T1==A
PURGT1==-1
>
XCHIN1: SKIPE T1,CHINP ;REINIT LINE?
JRST XCHIN2 ;NO
MOVEI T1,NLINBF*5 ;YES, SETUP MAX CHAR COUNT
MOVEM T1,LINSPC
MOVE T1,LINBP ;SETUP POINTER
MOVEM T1,CHINP
XCHIN2: MOVEM T1,LINDB ;SET BEGINNING OF DELETE BUFFER
SKIPG LINSPC ;ROOM LEFT IN BUFFER?
JRST ERR ;NO, TOO MUCH TYPIN
MOVEI T1,LINBP-TEXTIB ;SIZE OF BLOCK
SKIPE WAKALL ;WAKEUP ON EVERYTHING?
MOVEI T1,ETXTB-TEXTIB ;YES, INCLUDE WAKEUP TABLE
MOVEM T1,TEXTIB ;SET SIZE IN BLOCK
PUSH P,LINSPC ;SAVE CURRENT SPACE
PUSH P,CHINP ;AND POINTER
MOVEI T1,TEXTIB ;POINT TO ARG BLOCK
PUSHJ P,TXTI
JRST ERR ;BAD ARGS (IMPOSSIBLE)
POP P,CHINP ;RESTORE POINTER TO CHARS JUST TYPED
POP P,T1 ;RECOVER OLD SPACE COUNT
IFN FTYANK,<
AOSN PTDFLG ;EOF ON COMMAND FILE
JRST [SETZM CHINC
SETZM CHINP
JRST DD2] ;YES--GET BACK TO TOP LEVEL
> ;END FTYANK
SKIPN 0(P) ;REPROCESS NEEDED?
JRST [MOVEI T1,NLINBF*5
SUB T1,LINSPC ;YES, COMPUTE NUMBER CHARS IN LINE
JUMPE T1,WRONG ;JUMP IF WHOLE LINE DELETED
MOVEM T1,CHINC ;LINE NOT NULL, SETUP CHAR COUNT
MOVE T1,LINBP ;REINIT POINTER
MOVEM T1,CHINP
JRST DD2] ;CLEAR WORLD AND REDO LINE
SUB T1,LINSPC ;COMPUTE NUMBER CHARS JUST TYPED
JUMPG T1,[MOVEM T1,CHINC ;SETUP COUNT
JRST TIN1] ;GO RETURN NEXT CHAR
;CONTINUED ON NEXT PAGE
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE LINE
;MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN
;DELETED.
PUSHJ P,RDBKIN
SETZM 0(P) ;REQUEST REPROCESS OF LINE
MOVE T1,LINBP ;RESET DELETE BOUNDARY TO BEGINNING OF LINE
JRST XCHIN2
IFDEF PURGT1,<IFL PURGT1,< PURGE PURGT1,T1>>
> ;END IFN ^-FTDEC20...
ONES4: OCT -1,-1,-1,-1 ;WAKEUP MASK
;ROUTINES TO TURN TAB ECHO ON/OFF
TTYTOF: MOVE T1,TTYCC2 ;NORMAL MODE WORD
TRZA T1,3B19 ;TURN TAB OFF
TTYTON: MOVE T1,TTYCC2
PUSH P,T2 ;PRESERVE REGS
PUSH P,T3
MOVEM T1,T2
MOVEI T1,.PRIIN
MOVE T3,TTYCC3
SFCOC ;SET CONTROL CHAR MODES
POP P,T3
POP P,T2
POPJ P,
XLIST
IFN FTDEC20,<
TOUT0: IFN FTEXEC,<
SKPUSR
JRST XTOUT>
EXCH T1,T
PBOUT ;CHAR TO TTY FROM T1
EXCH T1,T
POPJ P,
LISTEN: IFN FTEXEC,<
SKPUSR
JRST XLISTE>
EXCH T1,T
MOVEI T1,.PRIIN ;PRIMARY INPUT (TTY)
SIBE ;INPUT BUFFER EMPTY?
AOS 0(P) ;NO, GIVE SKIP RETURN
EXCH T1,T
POPJ P, ;RETURN NOSKIP
;HANDLE TTY WHEN RETURNING TO DDT FROM USER CONTEXT
TTYRET: IFN FTEXEC,<
SKPUSR
JRST XTTYRET>
SKIPE SAVTTY ;ALREADY HAVE STATE?
JRST TTYR1 ;YES
MOVEI T1,.PRIIN
RFMOD ;GET MODES
MOVEM T2,SAVTTY
RFCOC ;GET CC MODES
MOVEM T2,SAVTT2
MOVEM T3,SAVTT3
TTYR1: MOVEI T1,.PRIIN
RFMOD
TXZ T2,TT%WAK+TT%DAM
TXO T2,<TT%WKF+TT%WKN+TT%WKP+TT%ECO+FLD(.TTASC,TT%DAM)>
SFMOD
MOVE T2,TTYCC2
MOVE T3,TTYCC3
SFCOC ;SETUP PROPER DDT MODES
MOVEI T1,.FHSLF
IFN FTEXEC,<
SKPEXC>
DIR
POPJ P,
TTYLEV: IFN FTEXEC,<
SKPUSR
JRST XTTYLE>
MOVEI T1,.PRIIN
MOVE T2,SAVTTY
SFMOD ;RESTORE MODES
MOVE T2,SAVTT2
MOVE T3,SAVTT3
SFCOC ;RESTORE CC MODES
MOVEI T1,.FHSLF
SKIPGE SAVSTS ;PSI SYSTEM ON FOR USER?
EIR ;YES
SETZM SAVTTY ;NOTE USER MODES IN EFFECT
POPJ P,
TTYCLR: MOVEI T1,.PRIIN
IFN FTEXEC,<
SKPEXC> ;SKIP CFIBF IF EXEC
CFIBF
PUSHJ P,LISTEN
JFCL
POPJ P,0
TTYCC2: BYTE (2) 0,1,1,1,1,1,1,2,1,2,3,1,1,2,1,1,1,1
TTYCC3: BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1
> ;END IFN FTDEC20
IFE FTDEC20,<
SUBTTL DDT COMMAND FILE LOGIC
;START PAPER TAPE INPUT
IFN FTYANK,<
TAPIN:
IFN FTEXEC,< SKPEXC ;SKIP IF EXEC MODE
JRST UTAPIN ;USER MODE
CONSO PTR,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 FTFILE,<
MOVE T,[SIXBIT /PATCH/] ;NO, DEFAULT=PATCH
>
IFN FTFILE,<
MOVE T,[SIXBIT /FILDDT/]
>
MOVEM T,COMNDS ;SAVE NAME IN LOOKUP BLOCK
MOVSI T,'DDT' ;EXTENSION
MOVEM T,COMNDS+1 ; ..
SETZM COMNDS+3 ;CLEAR PPN
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
IFE FTFILE,<
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
> ;END FTFILE
HAVECM: SETOM COMAND ; FLAG CMD FILE FOUND
SETZM CHINP
SETZM CHINC
INBUF CM,1 ; 1 BUFFER ONLY
IFN FTFILE,<
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
SETZM COMNDS+2
ENTER DP,COMNDS
JRST [SETZM COMAND
JRST ERR]
OUTBUF DP,2
>
JRST RET
> ;END IFN FTYANK
IFN FTYANK,<
IFN FTEXEC,<
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 FTEXEC,<
SKPEXC ;EXEC MODE?
JRST PTRCH2
CAIE T,15 ;YES. CR?
JRST CPOPJ1 ;NO. ECHO OF CHAR WILL HAPPEN LATER
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 FTEXEC
CAIE T,33 ;ESCAPE?
CAIL T,175 ;ALT-MODE?
MOVEI T,"$" ;YES, ECHO "$"
PUSHJ P,ECHO ;ECHO CHAR
MOVE T,TT2 ;RESTORE T
JRST CPOPJ1 ;SKIP-RETURN WITH DATA
PTRNXT:
IFN FTEXEC,< SKPUSR
JRST XPTRIN>
JRST PTRIN
;THROUGH WITH COMMAND FILE
PTRDON: SETZM COMAND
PUSH P,CHINC
PUSH P,CHINP
PUSHJ P,CRF ;2 CR-LFS
PUSHJ P,CRF
POP P,CHINP
POP P,CHINC
SETOM PTDFLG
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 FTFILE,<
CLOSE DP,
RELEAS DP,
>
MOVE TT,SVJBFF
MOVEM TT,.JBFF ;RESET .JBFF
POPJ P, ;NON-SKIP MEANS DONE WITH COMMAND FILE
IFN FTEXEC,<
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 PTR,20 ;START PTR GOING
PTRXN1: CONSO PTR,400 ;EOT?
JRST PTRXN4 ;YES
CONSO PTR,10 ;DATA?
JRST PTRXN1 ;WAIT SOME MORE
DATAI PTR,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 PTR,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 FTEXEC
COMAND: 0
SVJBFF: 0
CBUF: BLOCK 3
COMNDS: SIXBIT /PATCH/
SIXBIT /DDT/
0
0
> ;END FTYANK
IFN FTFILE,<
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 FTFILE
> ;END IFE FTDEC20
LIST
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
IFE FTYANK,<TAPIN=ERR>
IFE FTEXEC&FTPTP,< PUNCH==ERR
BLKEND==ERR
LOADER==ERR>
IFN FTDEC20,<SETPAG==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,SETPAG,ERR); (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 FANCY TERMINAL INPUT LOGIC
IFN ^-FTDEC20!<FTEXEC&FTEDIT>,<
TXTI:
DOTXTI: PUSH P,A ;SAVE ALL AC'S USED
PUSH P,B
PUSH P,C
PUSH P,T
PUSH P,W1
PUSH P,W2
MOVE W1,LINSPC ;COUNT OF BYTES IN DESTINATION
SKIPN W2,LINDB ;WAS IT NON-ZERO?
MOVE W2,CHINP ;NO. USE DEFAULT
; VERIFY ALL OF THE STRING POINTERS
RDTXT1: MOVE A,CHINP ;HAVE A DEST POINTER?
PUSHJ P,RDCBP ;YES. CHECK IT OUT
MOVEM A,CHINP ;GET CONVERTED POINTER
SKIPN A,LINBP ;HAVE A ^R BUFFER?
JRST RDTOPM ;NO. GO AROUND THEN
PUSHJ P,RDCBP ;YES. VERIFY IT
MOVEM A,LINBP ;STORE VERIFIED POINTER
RDTOPM: MOVE A,W2 ;GET TOP OF BUFFER
PUSHJ P,RDCBP ;VERIFY IT
MOVE W2,A ;ALL VERIFIED NOW
JUMPLE W1,WRAP0 ;MAKE SURE COUNT HAS ROOM IN IT
; ..
;MAIN LOOP - DOES INPUT OF BYTE AND DISPATCH ON CHARACTER CLASS
;ACTION ROUTINES EXIT TO:
; INSRT - APPEND CHARACTER AND CONTINUE
; NINSRT - CONTINUE WITHOUT APPENDING CHARACTER
; DING - BUFFER NOW EMPTY, POSSIBLE RETURN TO USER
; WRAP, WRAP0 - RETURNS TO USER
NINSRT: MOVEM W1,LINSPC ;STORE COUNT
PUSHJ P,RDBIN ;DO BIN
MOVE A,B ;SAVE BYTE
IDIVI B,CHRWRD ;SETUP TO GET CHAR CLASS
LDB B,CCBTAB(C) ;GET IT FROM BYTE TABLE
IDIVI B,2 ;SETUP TO REF DISPATCH TABLE
JUMPE C,[HLRZ T,DISPTC(B) ;GET LH ENTRY
JRST .+2]
HRRZ T,DISPTC(B) ;GET RH ENTRY
MOVE B,A ;ROUTINES GET BYTE IN B
JRST 0(T) ;DISPATCH TO ACTION ROUTINE
;RETURN FROM ACTION ROUTINE TO APPEND CHARACTER AND CONTINUE.
; B/ CHARACTER
INSRT: SKIPE WAKALL ;BREAK ON EVERYTHING?
JRST WRAP ;YES. WRAP IT UP THEN
IDPB B,CHINP ;APPEND BYTE TO USER STRING
SOJG W1,NINSRT ;CONTINUE IF STILL HAVE COUNT
JRST WRAP0 ;COUNT EXHAUSTED, RETURN
;RETURNS TO USER.
;RETURN TO USER IF BUFFER EMPTY
NDING: CAME W2,CHINP ;BUFFER EMPTY?
JRST NINSRT ;NO, GO GET MORE INPUT
JRST WRAP0
;APPEND LAST CHARACTER AND RETURN
WRAP: IDPB B,CHINP ;APPEND BYTE
SUBI W1,1 ;UPDATE COUNT
;STORE NULL ON STRING AND RETURN
WRAP0: JUMPLE W1,WRAP1 ;DON'T STORE NULL IF COUNT EXHAUSTED
SETZ B,
MOVE A,CHINP
IDPB B,A ;STORE NULL WITHOUT CHANGING USER PTR
;UPDATE USER VARIABLES AND RETURN
WRAP1: MOVEM W1,LINSPC ;UPDATE USER'S BYTE COUNT
POP P,W2
POP P,W1
POP P,T
POP P,C
POP P,B
POP P,A
JRST CPOPJ1
;PARAMETERS FOR CLASS TABLE
CCBITS==4 ;BITS/BYTE
CHRWRD==^D36/CCBITS ;BYTES/WORD
;DEFINED CHARACTER CLASSES:
TOP==0 ;TOPS10 BREAK
BRK==1 ;REGULAR BREAK SET
ZER==2 ;NULL
EOLC==3 ;EOL
PUN==4 ;PUNCTUATION
SAFE==5 ;ALL OTHERS
RUBO==6 ;DELETE A CHARACTER
RTYP==7 ;RETYPE THE LINE
KLL==10 ;DELETE THE LINE
KWRD==11 ;DELETE A WORD
RDCRC==12 ;CARRIAGE RETURN
RDQTC==13 ;QUOTE CHARACTER
;TABLE OF BYTE PTRS TO REFERENCE CLASS TABLE
XX==CCBITS-1
XALL
CCBTAB: REPEAT CHRWRD,<
POINT CCBITS,CTBL(B),XX
XX=XX+CCBITS>
SALL
;CLASS DISPATCH TABLE
DISPTC: WRAP,,WRAP
ZNULL,,EOL1
WRAP,,INSRT
DELC,,RTYPE
DELIN,,KLWORD
RDCR,,RDQT
;CHARACTER CLASS TABLE
DEFINE CCN (A,B)<
REPEAT B,<
CC1 (A)>>
DEFINE CC1 (C)<
QQ=QQ+CCBITS
IFG QQ-^D35,<
QW
QW=0
QQ=CCBITS-1>
QW=QW+<C>B<QQ>>
QW==0
QQ==-1
CTBL: CC1(ZER) ;0
CCN(PUN,6) ;1-6
CC1(TOP) ;7
CCN(PUN,2) ;10-11
CC1(EOLC) ;12
CC1(PUN) ;VT
CC1(TOP) ;FF
CC1(RDCRC) ;CR
CCN(PUN,4) ;16-21 (^N-^Q)
CC1(RTYP) ;^R
CCN(PUN,2) ;^S,^T
CC1(KLL) ;^U
CC1(RDQTC) ;^V
CC1(KWRD) ;^W
CCN(PUN,2) ;^X,^Y
CCN(BRK,2) ;^Z,$
CCN(PUN,4) ;34-37
CCN(PUN,^D16) ;40-/
CCN(SAFE,^D10) ;0-9
CCN(PUN,7) ;:-@
CCN(SAFE,^D26) ;A-Z
CCN(PUN,6) ;]-140
CCN(SAFE,^D26) ;A-Z
CCN(PUN,4) ;173-176
CC1(RUBO) ;177
QW ;GET LAST WORD IN
;LOCAL ROUTINES TO DO LOGICAL BIN AND BOUT.
RDBIN: SKIPE B,SAVCHR ;WANT TO BACK UP?
JRST [SETZM SAVCHR ;ONLY ONCE
POPJ P,0] ;RETURN
IFN FTEXEC,<
SKPUSR
JRST [PUSH P,T ;SAVE T
IFN FTYANK,<
SKIPE COMAND
PUSHJ P,XPTRIN>
PUSHJ P,XTIN ;GET A BYTE
MOVE B,T ;PUT IN CORRECT PLACE
POP P,T ;RESTORE T
JRST RDBIN1] ;SKIP NEXT INST
>
IFN FTDEC20,<HALT DDT> ;SHOULD NOT BE HERE IN USER MODE
IFE FTDEC20,<
IFN FTYANK,<
PUSH P,T ;SAVE AN AC
SKIPE COMAND ;COMMAND FILE OPEN?
PUSHJ P,PTRIN ;READ COMMAND FILE
JRST [MOVEI T," " ;ASSUME EOF
SKIPL PTDFLG ;WAS IT EOF?
INCHRW T ;NO--READ A BYTE
JRST .+1] ;CONTINUE
MOVE B,T ;COPY BYTE
POP P,T> ;RESTORE T
SKIPE TOPS20
JRST .+3
IFE FTYANK,<INCHRW B>> ;READ BYTE UNDER TOPS-10
JRST RDBIN1
PUSH P,1
PBIN
MOVE B,1
POP P,1
RDBIN1: MOVEM B,LASCHR ;SAVE LAST CHAR READ
POPJ P,0 ;RETURN
;RDBOUT
; B/ BYTE
; PUSHJ P,RDBOUT
; RETURN +1 ALWAYS
RDBOUT: PUSH P,T ;SAVE AN AC
PUSH P,CHINC
PUSH P,CHINP
MOVE T,B ;SET FOR ECHO
PUSHJ P,TOUT ;TYPE IT
POP P,CHINP
POP P,CHINC
POP P,T
POPJ P,0
;RDSOUT - OUTPUT STRING ALA RDBOUT
; B/ STRING PTR
; PUSHJ P,RDSOUT
; RETURN +1 ALWAYS
RDSOUT: MOVE A,B ;COPY POINTER
PUSHJ P,RDCBP
RDSL: ILDB B,A
JUMPE B,CPOPJ ;EXIT ON NULL
PUSHJ P,RDBOUT
JRST RDSL
;CHECK BYTE POINTER GIVEN AS ARGUMENT
; A/ BYTE POINTER
; PUSHJ P,RDCBP
; RETURN +1: OK, LH INITIALIZED IF NECESSARY
RDCBP: HLRZ B,A ;GET LH
CAIN B,-1 ;IS DEFAULT?
HRLI A,(<POINT 7,0>) ;YES, FILL IN 7-BIT
LDB B,[POINT 6,A,11] ;CHECK BYTE SIZE
CAIGE B,7 ;7 OR GREATER?
HALT . ;BAD BYTE SIZE
IBP A ;INCR IT AND DECR IT ONCE SO WILL
JRST DBP ; BE IN KNOWN STATE FOR COMPARES
;LOCAL ROUTINES FOR EDITING FUNCTIONS
;DELETE CHARACTER FROM DESTINATION - BACKUP PTR AND CHECK
;FOR TOP OF BUFFER
; PUSHJ P,BACK
; RETURN +1: AT TOP OF BUFFER, NO CHARACTER TO DELETE
; RETURN +2: CHARACTER DELETED
BACK: CAMN W2,CHINP ;AT TOP OF BUFFER?
POPJ P,0 ;YES
MOVE A,CHINP ;GET DEST PTR
PUSHJ P,DBP ;DECREMENT IT
MOVEM A,CHINP ;PUT IT BACK
AOJA W1,CPOPJ1 ;UPDATE COUNT AND RETURN
;PUT BYTE BACK INTO SOURCE
; B/ BYTE
; PUSHJ P,RDBKIN
; RETURN +1 ALWAYS
RDBKIN:
DOBKIN: MOVE A,LASCHR ;GET LAST BYTE READ
MOVEM A,SAVCHR ;MAKE NEXT BYTE READ
POPJ P,0
;FIND BEGINNING OF CURRENT LINE.
; PUSHJ P,FNDLIN
; RETURN +1: AT TOP OF BUFFER
; RETURN +2: A/ BACKED-UP BYTE PTR TO BEGINNING OF LINE
; B/ BYTE COUNT CONSISTENT WITH CHINP IN A
FNDLIN: CAMN W2,CHINP ;AT TOP OF BUFFER?
POPJ P,0 ;YES
PUSH P,CHINP ;SAVE CURRENT LINE VARIABLES
PUSH P,W1
FNDLN1: MOVE A,CHINP ;BACKUP ONE CHARACTER
PUSHJ P,DBP
MOVEM A,CHINP
ADDI W1,1
CAMN W2,CHINP ;NOW AT TOP OF BUFFER?
JRST FNDLN2 ;YES, RETURN
LDB B,CHINP ;NO, LOOK AT NEXT CHAR TO BE DELETED
CAIN B,12 ;EOL OR LF?
JRST FNDLN2 ;YES, RETURN
JRST FNDLN1 ;NO, KEEP LOOKING
FNDLN2: MOVE A,CHINP ;RETURN NEW LINE VARIABLES
MOVE B,W1
POP P,W1 ;RESTORE OLD LINE VARIABLES
POP P,CHINP
JRST CPOPJ1
;ACTION ROUTINES
;ZERO BYTE
ZNULL: SKIPE WAKALL ;USER HAVE A MASK?
JRST INSRT ;YES. GO SEE ABOUT IT THEN
JRST WRAP0 ;NO. ALWAYS BREAK THEN
;CARRIAGE RETURN - IF LINE FEED FOLLOWS, TREAT LIKE EOL
RDCR: CAIGE W1,2 ;ROOM FOR CR AND LF?
JRST [PUSHJ P,RDBKIN ;NO, PUT THE CR BACK
JRST WRAP0] ;WILL GET IT NEXT TIME
PUSHJ P,RDBIN ;GET THE NEXT CHAR
CAIN B,12 ;LF?
JRST RDCR1 ;YES, NORMAL NEWLINE
PUSHJ P,RDBKIN ;NO, PUT BACK THE SECOND BYTE
MOVEI B,15 ;APPEND A REAL CR
JRST WRAP
RDCR1: MOVEI B,15
IDPB B,CHINP ;APPEND CR
SOS W1
RDCR2: MOVEI B,12
EOL1: JRST WRAP ;YES
;QUOTE CHARACTER (^V) - INHIBITS EDITING ACTION OF FOLLOWING CHARACTER
RDQT: CAIGE W1,2 ; ROOM FOR BOTH?
JRST [PUSHJ P,RDBKIN ; NO. BACK UP
JRST WRAP0] ; AND WAIT FOR NEXT TIME
IDPB B,CHINP ;STORE QUOTE
SOS W1 ; ONE LESS
PUSHJ P,RDBIN ;GET THE NEXT CHAR
JRST WRAP ;YES
;DELETE CHARACTER (RUBOUT)
DELC: PUSHJ P,BACK ;BACKUP PTR
JRST WRAP0 ;NOTHING LEFT IN BUFFER
MOVE T,CHINP
ILDB B,T ;GET CHAR JUST DELETED
CAIN B,12 ;WAS IT LF?
JRST DELC2 ;YES
PUSH P,B
MOVEI B,"\"
PUSHJ P,RDBOUT
POP P,B
PUSHJ P,RDBOUT ;TYPE IT OUT
MOVEI B,"\" ;INDICATE DELETION
PUSHJ P,RDBOUT
DELC4: JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
DELC2: CAMN W2,CHINP ;AT BEGINNING OF DEST BUFFER?
JRST DELC1 ;YES
LDB B,CHINP ;NO, CHECK CHARACTER PRECEEDING LF
CAIE B,15 ;A CR?
JRST DELC1 ;NO, LEAVE IT ALONE
PUSHJ P,BACK ;YES, DELETE IT ALSO
JRST WRAP ;(CAN'T HAPPEN)
DELC1: HRROI B,[ASCIZ /
/]
PUSHJ P,RDSOUT ;DO CRLF WHEN DELETING EOL OR CRLF
JRST DELC4
;DELETE LINE (CONTROL-U)
DELIN: MOVEI C,0
PUSHJ P,FNDLIN ;FIND BEGINNING OF LINE
JRST NDING ;NOTHING IN BUFFER
LDB C,CHINP ;GET LAST CHAR IN BUFFER
MOVEM A,CHINP ;SET LINE VARIABLES TO BEGINNING
MOVEM B,W1
JRST NDING ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;DELETE WORD (CONTROL-W)
KLWORD: PUSHJ P,BACK ;DELETE AT LEAST ONE CHARACTER
JRST WRAP0 ;WASN'T ONE
MOVE T,CHINP
ILDB B,T ;GET CHAR JUST DELETED
CAIN B,12 ;LF OR EOL?
JRST BWRD3 ;YES, DON'T DELETE
BWRD1: PUSHJ P,BACK ;DELETE NEXT CHARACTER
JRST BWRD2 ;NO MORE LEFT
MOVE T,CHINP ;LOOK AT CHARACTER JUST DELETED
ILDB B,T
IDIVI B,CHRWRD ;GET ITS CHARACTER CLASS
LDB B,CCBTAB(C)
CAIN B,SAFE ;IS IT A WORD SEPARATOR?
JRST BWRD1 ;KEEP DELETING
BWRD3: IBP CHINP ;YES, KEEP THAT CHARACTER
SUBI W1,1
BWRD2: MOVEI B,"_" ;INDICATE WORD DELETION
PUSHJ P,RDBOUT
JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;RETYPE LINE (CONTROL-R)
RTYPE: PUSHJ P,RTYPES ;DO THE WORK
JRST NINSRT
;SUBROUTINE TO RETYPE LINE
RTYPES: HRROI B,[ASCIZ /
/]
PUSHJ P,RDSOUT ;NON-DISPLAY, GET CLEAN LINE
PUSHJ P,FNDLIN ;FIND BEGINNING OF LINE
MOVE A,W2 ;AT TOP OF BUFFER - USE IT
MOVE T,A ;SAVE PTR TO BEGINNING OF LINE
CAME T,W2 ;BEG OF LINE IS TOP OF BUFFER?
JRST RTYP1 ;NO, DON'T TYPE ^R BFR
SKIPE T,LINBP ;GET ^R BFR IF ANY
RTYW1: CAMN T,W2 ;UP TO TOP OF BFR?
JRST RTYP4 ;YES, DONE WITH ^R BFR
ILDB B,T ;GET CHAR FROM ^R BFR
JUMPN B,[PUSHJ P,RDBOUT ;TYPE IT
JRST RTYW1]
RTYP4: MOVE T,W2 ;DONE WITH ^R BFR, NOW DO MAIN BFR
RTYP1: CAMN T,CHINP ;BACK TO END OF LINE?
POPJ P,0 ;YES
ILDB B,T ;NO, GET NEXT BYTE
PUSHJ P,RDBOUT ;TYPE IT
JRST RTYP1 ;LOOP UNTIL AT END OF BUFFER
;DECREMENT BYTE POINTER
; A/ BYTE PTR
; PUSHJ P,DBP
; RETURNS +1, CLOBBERS B AND C
DBP: LDB B,[POINT 6,A,5] ;GET P
LDB C,[POINT 6,A,11] ;GET S
ADD B,C ;NEW P = P + S
CAIGE B,^D36 ;NEW P .GE 36?
JRST DBP1 ;NO, BYTE IS IN SAME WORD.
HRRI A,-1(A) ;DECREMENT ADDRESS
MOVEI B,^D36 ;MAKE P = REMAINDER (36,S)
IDIV B,C
MOVEI B,0(C)
DBP1: DPB B,[POINT 6,A,5]
POPJ P,0
> ;END IFN ^-FTDEC20...
SUBTTL OP DECODER
;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 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
.XCREF ;KEEP THIS MESS OUT OF CREF
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>
.CREF ;TURN CREF BACK ON
> ;END OF REPEAT 0
;THE FOLLOWING IS AN ALTERNATE SET OF MACROS FOR BUILDING THE OP
;TABLE. THEY ASSEMBLE MUCH FASTER THAN THE ONES ABOVE. THEY ARE:
;.ADR - DECLARE TAG; .TRA - TRANSFER BYTE; .TRAX - EXTENDED TRANSFER
;BYTE; .DIS - DISPATCH BYTE; .TXT - TEXT BYTES; .END - TEXT BYTES
;FOLLOWED BY STOP BYTE.
DEFINE BYT9 (A) <
XLIST
IRP A,<
A>
LIST>
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: .XCREF ;OPDECODER BYTE TABLE
CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0
BINC== ^D36 ;INIT BYTES/WORD COUNTER
;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
;**************TERMINATES AT THE NEXT COMMENT WITH: **************
IFN FTDEC20,<
BYT9 <
.DIS 63,.END,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
> ;END FTDEC20
IFE FTDEC20,<
BYT9 <
.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
> ;END FTDEC20
BYT9 <
;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,.END,.END ADJSP,.END,.END
;**********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>
.CREF ;TURN CREF BACK ON
BTAB: POINT 9,TBL ;TABLE USED TO GET NEXT BYTE POINTER
POINT 9,TBL,8 ;FOR TRANSFER BYTE
POINT 9,TBL,17
POINT 9,TBL,26
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
;*** LITERALS XLISTED ***
XLIST
LIT
LIST
END.C: ;END OF CODE
SUBTTL VARIABLE STORAGE
IFN FTDEC20,< IFDEF VARLOC,<
PHVAR: PHASE VARLOC>> ;PHASE VARIABLES FOR UDDT AND MDDT
BEG.V: ;BEGINNING OF VARIABLES
NM1A: MOVEI W2,0
ACCCF: MOVEI T,.-. ;LEFT HALF OF A,,B
SEAR2: JUMPE T,SEAR3 ;OR JUMPN T
TOCS: MOVEI T,.-. ;GET RIGHT HALF BACK
;VARIABLES FOR LINE BUFFER INPUT
TEXINF: 0 ;NON-0 FOR TEXT INPUT MODE
CHINC: 0 ;COUNT OF CHARACTERS
WAKALL: 0 ;NON-0 TO WAKEUP ON EVERYTHING
;*** DO NOT REORDER THE FOLLOWING ***
TEXTIB: 10 ;TEXTI ARG BLOCK - SIZE
; IFN FTDEC20,<
RD%BRK+RD%TOP+RD%PUN+RD%RND+RD%JFN+RD%BBG+RD%SUI ;FLAGS
.PRIIN,,.PRIOU ;INPUT/OUTPUT JFNS
; >
CHINP: 0 ;POINTER TO NEXT CHAR
LINSPC: 0 ;FREE SPACE COUNT
LINDB: POINT 7,LINBF ;BEGINNING OF BUFFER
LINBP: POINT 7,LINBF ;BEGINNING OF ^R BUFFER
ETXTB: 0 ;WAKEUP TABLE (ALL ONES)
0 ;BACKUP LIMIT POINTER
;***END OF "DO NOT REORDER" BLOCK***
IFN ^-FTDEC20!<FTEXEC&FTEDIT>,<
SAVCHR: 0 ;PRESET RESULT FOR NEXT CALL TO RDBIN
LASCHR: 0 ;ANSWER FROM LAST CALL TO RDBIN
>
NLINBF==^D20
LINBF: BLOCK NLINBF ;LINE BUFFER
SUBTTL STORAGE -- $X LOGIC AND PATCH COMMAND
IFE FTFILE,<
;VARIABLES USED IN $X LOGIC
I.XCT: XCT I.NST
I.NST: 0 ;INSTRUCTION BEING EXECUTED
I.SM10: 0
SAV0: 0 ;SAVES AC 0 IN SWAP ROUTINE
XCTS: 0 ;XCT DEPTH COUNTER
I.NSTAC:0 ;AC FIELD OF INST BEING EXECUTED
I.NSTEA:0 ;E FIELD OF INST BEING EXECUTED
XTEM: 0 ;$X REPEAT COUNTER
I.NSTPC:0 ;PC OF INST BEING EXECUTED
FLAGS: 0 ;SAVES DDT FLAG REGISTER
LOCSAV: 0 ;SAVES LOCATION OF INST BEING EXECUTED
SAFETY: 0 ;SAVES T
> ;END FTFILE
;VARIABLES FOR PATCH COMMAND
PTLOC: 0 ; SOURCE OF PATCH ADR ,, PATCH ADR
PTLLC: 0 ; BEFORE/AFTER FLAG ,, OLD LLOCO
PTWRD: 0 ; ORIGINAL WORD AT OLD LLOCO
SUBTTL STORAGE -- BREAKPOINTS
IFE FTFILE,<
SAVE: 0 ;SAVE THE ACS AND PI SYSTEM
JRST SAVEG
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
BCOM: 0
JRST BCOMG
BCOM3: SKIPE 0 ;ADDR MOD TO LOOK AT COND. INST.
BCOM2: SOSG 0 ;ADDR MOD TO LOOK AT PROCEED COUNTER
LEAV1: XWD 0,LEAVG
BREAK2: ROT S,.-. ;ROT BY # OF BREAK POINT
PROC0: HRRZI R,XEC1 ;MODIFIED TO ADDR OF BREAKPOINT
LEAV: 0 ;INSTRUCTION MODIFIED
CPUSHP: PUSH .-.,BCOM ;GETS MODIFIED IN AC FIELD
SWAP: 0
JRST SWAPG
> ;END IFE FTFILE
SVBTS: 0
SVBTS2: 0
OLDAR: 0
SVBT3: 0
SVBT2: 0
PSVBTS: BLOCK 3
SUBTTL STORAGE -- SYMBOL TABLE LOGIC
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
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 FTDEC20,<
IFE FTFILE,<
SYMP: Z .JBSYM ;POINTS TO LOW SEG SYM TABLE POINTER
USYMP: Z .JBUSY ;POINTS TO UNDEF SYM TABLE POINTER
>
IFN FTFILE,<
SYMP: Z FISPTR
USYMP: Z FIUPTR
>>
IFN FTDEC20,<
IFN FTEXEC,<
SYMP: Z .JBSYM
USYMP: Z .JBUSY>
IFE FTEXEC,<
SYMP: Z .DDSYM
USYMP: Z .DDUSY
>
JDTFLG: -1 ;JOB DATA AREA VALID IF NON-0
> ;END IFN FTDEC20
SYMPNT: 0 ;USED BY SYM TABLE SEARCHES
SPSAV: 0 ;POINTER TO LAST SYMBOL TYPED
DEFV: 0
ULIMIT: 0
LLOC: 0
LLOCO: 0
SAVLP: 0 ;POINTER TO SAVLOC TABLE
NSAVTB==20 ;SIZE OF SAVLOC TABLE (RING BUFFER)
SAVLTB: BLOCK NSAVTB ;SAVLOC TABLE
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
LCNT: 12 ;USED IN LISTEN
SKPCT: 0 ;SKIP COUNT FOR XCT
EFAFLG: 0 ;EFF ADR COMP MODE
IFN FTEXEC!FTFILE,<
EPTUPT: 0 ;LH - EPT POINTER , RH - UPT POINTER
>
IFN FTYANK,<
PTDFLG: 0 ;EOF SEEN ON COMMAND FILE
>
SUBTTL STORAGE -- SAVE AREAS FOR PREVIOUS CONTEXT
IFE FTFILE,<
SAVAPR: 0 ;USED TO SAVE APR REGISTER IN EXEC MODE
SAVPI: 0
1177
;THESE LOCATIONS MUST BE IN ORDER - THEY ARE USED TO SAVE AND
;RESTORE THE STATE OF DTE FOR KL10
SAVTTY: 0
IFN FTEXEC,<
SAVUNS: 0
SAVEPW: 0
SAVERW: 0
SAVDPW: 0
SAVDRW: 0
SAVEBR: 0 ;SAVED EXEC BASE REG
MTRCNI: 0 ;RESULT OF CONI MTR,
TIMCNI: 0 ;RESULT OF CONI TIM,
MSTRDT: 0 ;ID OF MASTER -11
DING11: 0 ;PROTOTYPE CONO WORD FOR DTE
> ;END IFN EDDT
; IFN FTDEC20,<
SAVTT2: 0
SAVTT3: 0
LASTPG: 0
SAVSTS: 0
; > ;END IFN FTDEC20
> ;END IFE FTFILE
MSK: XWD -1,-1
IFN FTEXEC,< ;CELLS FOR TRACE FACILITY
TRCON: 0 ;ASSUMED AT $M+1
TRCDMP: 0> ;ASSUMED AT $M+2
IFE FTFILE,<
B1ADR: 0
B1SKP: 0
B1CNT: 0
REPEAT NBP*3-3, < 0>
BNADR=.-3
AUTOPI: 0
AC0: BLOCK 17
AC17: 0
>
SUBTTL STORAGE -- STATE VARIABLES
SCHM: EXP PIN ;DO NOT CHANGE ORDER
ARM: EXP PADSO
ODFM: EXP 10
SARS: 0
TEM: 0
TEM1: 0
NSYMCS==40 ;SIZE OF SYMBOL TABLE CACHE
SYMCSH: BLOCK NSYMCS ;SYMBOL TABLE CACHE
SYMCSP: BLOCK 1 ;POINTER TO NEXT FREE ENTRY
OLDSYM: BLOCK 1 ;REMEMBER CACHE SYMBOL TABLE
IFN FTEXEC,<
USRFLG: 0 ;-1 IN USER MODE, 0 IN EXEC MODE
KAFLG: 0 ;0 FOR KI10; 1,,0 FOR KA10 OR PDP-6
XNXTCH: 0 ;PRESET INPUT CHAR AT XLISTE
> ;END IFN FTEXEC
XLIST
IFN FTFILE,< ;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
CHGSFL: Z ;CHANGED SYMBOL TABLE
AC0=.
AC17=.+17
CRSHAC: BLOCK 20 ;CRASH AC'S
FETPAG: BLOCK 1 ;ADDRESS OF PAGTBL ENTRY FOR LAST
; CALL TO FETCH
FETADR: BLOCK 1 ;INCORE ADDRESS OF DATA WORD FROM LAST
; CALL TO FETCH
WINNUM: BLOCK 1 ;WINDOW TO READ OR WRITE
WINDIR: BLOCK CT.RES ;ADDRESS OF PAGTBL ENTRY FOR
; EACH WINDOW SLOT
PAGTBL: BLOCK MX.SIZ ;1 WORD FOR EVERY VIRT. PAGE
;BITS 0-4 .EXE FORMAT FLAGS
;BIT 5 PAGE IN CORE CHANGED
;BITS 9-17 WINDOW # PLUS 1
;RH - FILE PAGE NUMBER
WIND0: BLOCK CT.RES*1000 ;WINDOWS
XPNFMT: BLOCK 1 ;FILE IS IN .XPN FORMAT
LWAZER==.-1 ;END OF AREA TO ZERO
FISPTR: Z ;POINTER TO SYMBOLS
FIUPTR: Z ;POINTER TO UNDEF SYMS
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
> ;END IFN FTFILE
LIST
SUBTTL STORAGE -- PUSH DOWN LIST
PDL: BLOCK LPDL ;STORAGE FOR PUSH DOWN LIST
END.V==.
IFN FTDEC20,< IFE FTEXEC,<
VAREND: ;END OF INITIALIZED VARIABLES AREA
.DDSYM: 0 ;SYMTAB PTR (COPIED FROM .JBSYM USUALLY)
.DDUSY: 0 ;UNDEF SYMTAB PTR (COPIED FROM .JBUSY " )
SETRT1: 0 ;SCRATCH FOR VARIABLE INITIALIZATION
END.V==.
DEPHASE
>>
DDTEND:
IFDEF VARLOC,< IFDEF RUNLOC,< IFDEF PHDDT,<
IFL <VARLOC-RUNLOC>-<DDTEND-PHDDT>,<
PRINTX ?VARIABLES OVERLAP CODE
>>>>
DEFINE PRSIZE(CODEN,DATAN),<
IF2,< PRINTX [ CODEN WORDS CODE + DATAN WORDS DATA]
>>
RADIX 10
PRSIZE(\<END.C-DDT>,\<END.V-BEG.V>)
RADIX 8
;THE FOLLOWING DEFINES CERTAIN SYMBOLS RELEVANT TO HARDWARE OR TO
;DDT ITSELF. THESE ARE *NOT* NEEDED FOR THE ASSEMBLY OF DDT AND
;IN FACT MAY BE IN CONFLICT WITH DEFINITIONS WHICH ARE USED
;DURING ASSEMBLY (E.G. TTY). HENCE, THESE DEFINITIONS ARE ASSEMBLED
;LAST AND ON PASS 2 ONLY. THE SYMBOLS ARE ALL DECLARED INTERNAL
;SO THAT THEY WILL BE KEPT IN THE PROGRAM SYMBOL TABLE AFTER
;LOADING. THESE SYMBOLS ARE THEN USED DURING DDT INSTRUCTION
;ASSEMBLY OR DEASSEMBLY ONLY.
IFE FTDEC20,< ;DDT SYMTAB NEVER USED ON DEC20
IF2,<
DEFINE XP (SS,VV)<
SS=VV
INTERN SS>
OPDEF DDTINT [Z 0,] ;ADDRESS FLAG FOR INTERNAL REGISTERS
;DEFINE $ SYMBOLS INTERNAL TO DDT
IFE FTFILE,<
RADIX 10
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>
> ;END FTFILE
;DEFINE I/O DEVICE MNEMONICS
IFN FTEXEC,<
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 DTE,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 FTFILE,<
XP JOV,2554B11
XP JEN,2545B11
XP HALT,2542B11 >
> ;END IF2
> ;END IFE FTDEC20
;ONLY STARTING ADDRESS FOR FILDDT AND VMDDT
;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
REPEAT 0,<
IFN FTVMX,<END MAKDDT>
IFN FTFILE,<END DDT>
IFE FTEXEC,<
IFN FTDEC20,<
IFE FTMON,<
END BLTDDT>>> ;UDDT HAS SPECIAL START ADR
>
; END
END DDT ;SMDDT HAS START ADDRESS