Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-sources/filddt.mac
There are 5 other files named filddt.mac in the archive. Click here to see a list.
;<3-MONITOR>FILDDT.MAC.6, 7-Nov-77 13:01:42, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>FILDDT.MAC.5, 12-Oct-77 13:45:54, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>FILDDT.MAC.4, 24-Feb-77 22:22:05, Edit by HESS
;ADD PEEK FACILITIES
;<HESS>DDT.MAC.12, 13-Jan-77 14:38:15, Edit by HESS
;FIX FILE LENGTH IN COMPAT UUO CALL
;<HESS>DDT.MAC.10, 11-Jan-77 17:39:00, Edit by HESS
;<HESS>DDT.MAC.8, 11-Jan-77 16:29:33, Edit by HESS
;<HESS>DDT.MAC.6, 11-Jan-77 15:35:19, Edit by HESS
;ADD COMND FRONT END TO TOPS20 FILDDT
;<HESS>DDT.MAC.5, 11-Jan-77 11:48:44, Edit by HESS
;<HESS>DDT.MAC.4, 10-Jan-77 20:41:26, Edit by HESS
;<HESS>DDT.MAC.2, 10-Jan-77 19:18:26, Edit by HESS
;ADD FTFD20 CONDITIONAL FOR FILDDT ON TOPS20
;<2-MONITOR>DDT.MAC.18, 7-Nov-76 13:44:28, Edit by MCLEAN
;TCO 1652 USE EPT REFERENCES
;<2-MONITOR>DDT.MAC.17, 11-Oct-76 15:49:56, EDIT BY MURPHY
;<2-MONITOR>DDT.MAC.15, 11-Oct-76 15:13:51, EDIT BY MURPHY
;TCO #1587 - REMOVE UUO'S UNDER FTDEC20
;<2-MONITOR>DDT.MAC.14, 20-Aug-76 15:30:28, EDIT BY HURLEY
;MAKE MDDT TYPE OUT "MDDT" INSTEAD OF "DDT"
;<2-MONITOR>DDT.MAC.13, 6-Aug-76 17:26:22, EDIT BY MURPHY
;TCO #1483 - PREVENT ILLEGAL PROCEED
;<1B-MONITOR>DDT.MAC.12, 14-MAY-76 12:34:31, EDIT BY MURPHY
;TCO #1271 AGAIN
;<1B-MONITOR>DDT.MAC.11, 14-MAY-76 11:29:16, EDIT BY MILLER
;TCO 1271. MAKE EDDT POLL FOR MASTER -11 ON EACH ENTRY
;<1B-MONITOR>DDT.MAC.10, 13-MAY-76 18:00:37, EDIT BY MURPHY
;TCO #1271 - MORE CLEANUP
;<1B-MONITOR>DDT.MAC.14, 7-MAY-76 08:50:30, EDIT BY MILLER
;TCO 1282. FIX POLLING OF DTE'S
;<1B-MONITOR>DDT.MAC.13, 6-MAY-76 13:55:29, EDIT BY MURPHY
;<LEWINE>DDT.MAC.2, 6-MAY-76 13:12:30, EDIT BY LEWINE
;UPDATE EDIT NUMBER TO BE 177 TO AVOID CONFUSION WITH PREVIOUS
; DDT VERSION 37'S
;<LEWINE>DDT.MAC.1, 6-MAY-76 13:06:28, EDIT BY LEWINE
;1. MAKE FILDDT PRESERVE E+3 WHEN UPDATING DEFAULT .EXT FROM
; 'XPN' TO 'EXE'
;2. MAKE FILDDT FIX UNDEFINED SYMBOL TABLE CORRECTLY
;3. FIX PROBLEMS WITH EOF ON $Y
;<1B-MONITOR>DDT.MAC.12, 5-MAY-76 17:45:04, EDIT BY MURPHY
;TCO #1271 - CLEANUP
;<1B-MONITOR>DDT.MAC.10, 5-MAY-76 11:34:06, EDIT BY MURPHY
;TCO #1148 AGAIN - FIX CLOBBERED AC
;<1B-MONITOR>DDT.MAC.9, 4-MAY-76 13:50:44, EDIT BY MILLER
;<1B-MONITOR>DDT.MAC.8, 3-MAY-76 17:41:36, EDIT BY MURPHY
;<1B-MONITOR>DDT.MAC.7, 3-MAY-76 14:16:01, EDIT BY MURPHY
;TCO #1275 - ADD FTEDIT
;<1B-MONITOR>DDT.MAC.3, 3-MAY-76 12:03:39, EDIT BY MILLER
;TCO 1271. ADD IN EPT RELATIVE ADDRESSING FOR FE COMMUNICATION
;<1B-MONITOR>DDT.MAC.2, 30-APR-76 12:45:35, EDIT BY MURPHY
;TCO #1271 - MERGE DDT SOURCES
;<1MONITOR>DDT.MAC.8, 25-MAR-76 20:10:03, EDIT BY BOSACK
;MORE TCO 1065 - RETURN 'EXISTS' BIT FROM CHKADR IN EXEC MODE
;<1MONITOR>DDT.MAC.7, 25-MAR-76 15:34:15, EDIT BY MURPHY
;TCO #1065 - CHECK 'EXISTS' ACCESS ON FETCH
;<1MONITOR>DDT.MAC.6, 17-MAR-76 17:58:59, EDIT BY MURPHY
;<1MONITOR>DDT.MAC.5, 15-MAR-76 11:31:04, EDIT BY MILLER
;TCO 1148 AGAIN. ADD CSHVER ROUTINE TO MAKE SURE CACHE STILL VALID
;<1MONITOR>DDT.MAC.4, 14-MAR-76 13:52:08, EDIT BY MILLER
;TCO 1148. FIX CACHE LOOKUP TO CHECK FOR NOT IN USE ENTRIES
;<1MONITOR>DDT.MAC.3, 3-MAR-76 15:44:02, EDIT BY MURPHY
;TCO #1148 - SYMBOL CACHE
;<1MONITOR>DDT.MAC.2, 27-FEB-76 15:17:52, EDIT BY MILLER
;MCO 21. POLL FOR MASTER -11
;<2MONITOR>DDT.MAC.45, 20-NOV-75 14:09:08, EDIT BY MILLER
SUBTTL 1-APR-75 /TW/PFC/TWE/DAL/DLM/EJW
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SALL
COMMENT \
TABLE OF CONTENTS FOR DDT
1-APR-75 /TW/PFC/TWE/DAL/DLM/EJW
MAKE JSYS DDT
DEFINE DDT SYMBOLS
WRITE DDT.VMX
START DDT
FILDDT -- COMMAND SCANNER
FILDDT -- PROCESS .EXE FILE
FILDDT -- SETUP SYMBOLS
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
\
SUBTTL REVISION HISTORY
;THE REVISION HISTORY STARTS SUDDENLY AT EDIT 200
;
; DDT %37(200) RDH 14-NOV-76
;200 RDH 14-NOV-76 SPR 10-17714
; VALIDITY-CHECK THE SYMBOL POINTER FOR THE HIGH-SEG SYMBOL
; TABLE (.JBHSM) RATHER THAN ARBITRARILY BELIEVING IT (AND
; SUBSEQUENTLY ILL MEM REF'ING, ETC.).
;201 RDH 14-NOV-76 SPR 10-18806
; MORE OF EDIT 200, AT DEF1:
;202 RDH 14-NOV-76 SPR 10-19661
; TREAT THE MAP INSTRUCTION "E" FIELD AS AN IMMEDIATE QUANTITY
; RATHER THAN AS A MEMORY REFERENCE.
;203 RDH 14-NOV-76
; EXPAND FILDDT TO HANDLE FULL 22-BIT ADDRESSING IN EXE-FORMAT
; FILES (SPECIFICALLY CRASH.EXE).
;204 RDH 14-NOV-76 SPR 10-20165
; IMPLEMENT SPECIAL BYTE-FORMAT TYPEOUT FOR THE VARIOUS
; BYTE MANIPULATION INSTRUCTIONS. CODE COURTESY OF THE
; UNIVERSITY OF ARIZONA.
;205 RDH 15-NOV-76
; PUT TAG PTDFLG: UNDER FTYANK RATHER THAN FTEXEC!FTFILE FOR
; THOSE SITES THAT WISH TO TAKE THEIR CHANCES WITH $Y IN EITHER
; UDDT OR VMDDT (NOTE: $Y USES I/O CHANNEL 17 - BE WARNED)
;206 RDH 4-DEC-76
; REWRITTEN CODE IN CHKADR (TO BETTER HANDLE KL'S) FORGOT HOW
; KA'S WORKED AND LOST THE APR PI ASSIGNMENT.
;207 RDH 4-DEC-76
; IMPLEMENT "/D" FOR FILDDT -- TREAT FILE SPECIFIED AS PURE
; DATA FILE - DON'T CRUMP ON FIRST 20 LOCATIONS (THE "ACS"),
; DON'T LOOK FOR SYMBOL TABLE. IF NOT .EXE FORMAT AND NOT .XPN
; FORMAT THEN "/D" IS ASSUMED.
;210 RDH 6-DEC-76
; EXTEND THE $M COMMAND -- <M>$<N>M -- WHERE <N> IS THE
; MASK NUMBER AND <M> IS THE ASSOCIATED MASK.
;
; <N> = 0 OR NOT-SPECIFIED THEN <M> IS THE SEARCH MASK
; <N> = 1 THEN <M> IS TTY CONTROL MASK:
; 1B35 = 1 THEN "ECHO" <DEL>'S AS <BS><SP><BS>
;211 RDH 6-DEC-76
; NEW ASSEMBLY PARAMETER "SKPMAX" TO SET MAXIMUM NUMBER OF
; LOCATIONS SKIPPED FOR $X LOGIC. IF <INSTR>$X THEN TYPE
; <SKP> FOR EACH LOCATION SKIPPED. IF $$X THEN DO INDEFINITE
; $X UNTIL OLD-PC .LT. NEW-PC .LE. OLD-PC+SKPMAX
;212 RDH 7-DEC-76
;[214] MATCH ANGLE BRACKETTS -- <<
; WHEN PATCHING ($>) DON'T INSERT A 0 WORD UNLESS USER EXPLICITLY
; TYPED IT - I.E., ALLOW THE $> TO APPEAR BY ITSELF - THE WAY MOST
; PEOPLE TEND TO USE IT.
;213 RDH 9-DEC-76
; CHANGE SKIPN'S TO SKIPE'S IN [207] AND CAILE TO CAIL IN [210]
;214 RDH 18-DEC-76
; MATCH ANGLE BRACKETTS IN EDIT [212] COMMENTS TO KEEP VARIOUS
; AND SUNDRY PEOPLE HAPPY.
;215 RDH 19-DEC-76
; IF SPYSEG THEN NO HISEG SYMBOL TABLE.
;216 RDH 19-DEC-76
; CHKHSM ROUTINE ([200],[201]) IS TOO RESTRICTIVE, WON'T ALLOW
; .JBHSM TO POINT TO LOW SEG; CHKADR ROUTINE WON'T ALLOW RANDOM
; NON-CONTIGUOUS PAGES.
;217 RDH 19-DEC-76
; SETNAM ROUTINE (TO HANDLE MODULE$:) ASSUMES HIGH SEGMENT ALWAYS
; STARTS AT 400000, LEADING TO SUBSEQUENT ILL MEM REF'S.
;DDT VERSION IDENTIFICATION
MAJVER==37 ;MAJOR VERSION LEVEL
MINVER==0 ;MINOR (MAINTENANCE RELEASE) LEVEL
CSTVER==0 ;CUSTOMER VERSION (WHO LAST . . .)
EDTVER==217 ;EDIT LEVEL
%DDTVR==:<BYTE (3)CSTVER(9)MAJVER(6)MINVER(18)EDTVER>
IF2 <PURGE MAJVER,MINVER,CSTVER,EDTVER>
;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
;FTFD20 ;FILE DDT FOR TOPS20
;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>
IFNDEF FTFD20,<FTFD20==0>
IFN FTFD20,<
FTFILE==-1
FTYANK==-1
>
;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!FTFD20,<
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==^D8192 ;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
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
SUBTTL DEFINE DDT SYMBOLS
IFN FTFILE,<
CM==2 ;DEFINE SOFTWARE CHANS.
DP==3
>
;DEFINE ACCUMULATORS
F=0 ;FLAGS
P=1 ;PUSH DOWN
R=<A=2> ;POINTERS TO TABLES, CORE, ETC.
S=<B=3>
W=<C=4> ;CONTAINS DISPATCH ADDRESS IN WORD ASSEMBLER
T=5 ;TRANSFER DATA
W1=6
W2=7
SCH=10 ;MODE CONTROL SWITCH FOR OUTPUT
AR=11 ;MODE CONTROL SWITCH FOR OUTPUT
ODF=12 ;MODE CONTROL SWITCH FOR OUTPUT - CURRENT RADIX
TT=13 ;TEMPORARY
TT1=14 ;TEMPORARY
TT2=15 ;TEMPORARY (USED FOR PTR INPUT ONLY)
; 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
NBP==^D8 ;NUMBER OF BREAKPOINTS
SKPMAX==4 ;[211] MAX NUMBER OF SKP'S IN $X LOGIC
IFN FTDEC20!FTFD20,<
LPDL==100
T1=1
T2=2
T3=3
P=17> ;OVERRIDES P=1 ABOVE
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 ACCOUTING
OD RDEACC,702440 ;READ EBOX ACCOUNTINT
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
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
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
>
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...
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
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
IFN FTFD20,<
JRST CPARS ;ALTERNATE PARSER
>
IFE FTFD20,<
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
/D treat file as pure binary data, not code
/M examine monitor
/P patch monitor or file
type ^Z to exit from file patching
/S reload symbol table from file
IF no spec, examine monitor
file defaults: if /P or /S: DSK:SYSTEM.XPN
else: DSK:CRASH.XPN
use $Y to read DSK:FILDDT.DDT and write LPT:FILDDT.LST
\
;STILL 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]
CAIN T,"D" ;[207] DATA FILE
JRST [SETOM FDIDSW
JRST FDILOP]
;FALL INTO ERROR
;STILL FTFILE
;FALL HERE FROM ABOVE
FDIERR: OUTSTR [ASCIZ \? Command error -- type /H for help
\]
JRST FDIERE
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:
FDIOPN: USETI 1,1 ;POSITION TO START
SKIPE FDIDSW ;[207] "/D" TYPED
JRST FDIXPD ;[207] YEP - WE KNOW THE FORMAT
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
;FILE IS IN .XPN FORMAT OR IS PURE DATA FORMAT (FDIDSW .NE. 0)
FDIXPN: SKIPN WIND0 ;[207] IN .XPN FORMAT?
JRST FDIXPD ;[207] YES - GO AHEAD FOR CODE
IFE FTFD20,<
OUTSTR [ASCIZ \% Not in .XPN format -- /D assumed.
\] ;[207] NOT .XPN - ASSUME DATA FILE
>
IFN FTFD20,<
OUTSTR [ASCIZ \%Not in .EXE format -- Data file assumed.
\]
>
SETOM FDIDSW ;[207] BY FAKING A "/D"
FDIXPD: SKIPE FDIDSW ;[207] DATA FORMAT?
SETZM SYMGET ;[207] YES - NO SYMBOL TABLES
SETOM XPNFMT ;[207] FLAG AS .XPN HANLDING
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
;FALL INTO FDISET
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
SKIPN FDIDSW ;[207] DATA FORMAT?
SKIPE PATCHS ;[207] OR PATCHING?
JRST FDIST1 ;[207] YES - NO CRSHAC'S THEN
SKIPE CRASHS ;ARE WE LOOKING AT A CRASH?
SKIPE SYMGET ;GETTING SYMBOLS
JRST FDIST1 ;YES--LEAVE AC'S WHERE THEY ARE
IFE FTFD20,<
MOVE T,[RADIX50 0,CRSHAC]
>
IFN FTFD20,<
MOVE T,[RADIX50 0,BUGACS]
>
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
IFE FTFD20,<
OUTSTR [ASCIZ "[AC's copied from CRSHAC to 0-17]
>
IFN FTFD20,<
OUTSTR [ASCIZ "[AC's copied from BUGACS to 0-17]
>
"]
SETOM FAKEAC ;[207] FLAG USING FAKE LOC 0 - 17
IFN FTFD20,<
SETZM SPTLOC
SETZM XBLOC
MOVE T,[RADIX50 0,SPT]
MOVEM T,SYM
PUSHJ P,EVAL
JRST FDIST1
MOVEM T,SPTLOC
>
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:
IFN FTFD20,<
SKIPN CRASHS ;FILE?
JRST FDNOT1
OUTSTR [ASCIZ "[File: "]
OUTSTR NAMBUF
OUTSTR [ASCIZ " loaded]
"]
>
FDNOT1: JRST DD1 ;GO START DDT
BIGEXE: OUTSTR [ASCIZ "?TOO MANY PAGES IN .EXE FILE
?REBUILD FILDDT WITH MX.SIZ SET LARGER
"]
FDIERE: CLRBFI ;CLEAR ANY TYPE AHEAD
JRST DDT ;AND START OVER
BADEXE: OUTSTR [ASCIZ "
?BAD DIRECTORY IN .EXE FILE
"]
JRST FDIERE
IFN FTFD20,<
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
CPARS: HRROI T1,PROMPT ;GET POINTER TO PROMPT STRING
MOVEM T1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
MOVEI T1,PARSE1 ;GET RE-PARSE ADDRESS
MOVEM T1,CMDBLK+.CMFLG ;SAVE RE-PARSE ADDRESS
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
PARSE: HRROI T1,PROMPT ;GET POINTER TO PROGRAM'S PROMPT STRING
PUSHJ P,CMDINI ;OUTPUT THE PROMPT
PARSE1: MOVE P,[IOWD LPDL,PDL] ;SET UP STACK AGAIN
MOVEI T1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM T1,CMDBLK+.CMGJB ;STORE POINTER TO GTJFN BLOCK
HRROI T1,[ASCIZ 'EXE'] ;DEFAULT FOR GTJFN
MOVEM T1,GJFBLK+.GJEXT
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;GET FUNCTION BLOCK
COMND ;DO INITIAL PARSE
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
JRST PARSE5 ;YES, GO DISPATCH TO PROCESSING ROUTINE
PUSHJ P,TSTCOL ;TEST COLUMN POSITION, NEW LINE IF NEEDED
TMSG <? FILDDT: No such FILDDT command as ">
MOVE T1,CMDBLK+.CMABP ;GET POINTER TO ATOM BUFFER
PSOUT ;OUTPUT STRING ENTERED BY USER
TMSG <"
> ;OUTPUT END-OF-MESSAGE
JRST PARSE ;GO TRY TO GET A COMMAND AGAIN
PARSE5: HRRZ T1,(T2) ;GET DISPATCH ADDRESS
PUSHJ P,(T1) ;PERFORM REQUESTED FUNCTION
JRST PARSE ;GO PARSE NEXT COMMAND
SUBTTL HELP AND EXIT COMMANDS
; HELP COMMAND
.HELP: HRROI T2,[ASCIZ/WITH FILDDT/] ;GET NOISE WORDS
PUSHJ P,SKPNOI ;GO PARSE NOISE FIELD
POPJ P, ;FAILED, RETURN FAILURE
PUSHJ P,ENDCOM ;GO PARSE END OF COMMAND
POPJ P, ;BAD CONFIRMATION, RETURN
HRROI T1,HLPMSG ;GET POINTER TO HELP MESSAGE
PSOUT ;OUTPUT HELP MESSAGE
POPJ P, ;GO PARSE NEXT COMMAND
; EXIT COMMAND
.EXIT: HRROI T2,[ASCIZ/TO MONITOR/] ;GET NOISE PHRASE
PUSHJ P,SKPNOI ;GO PARSE NOISE FIELD
POPJ P, ;FAILED, RETURN FAILURE
PUSHJ P,ENDCOM ;GO PARSE END OF COMMAND
POPJ P, ;BAD CONFIRMATION, RETURN
CALLI
EXIT 1,
JRST DDT
;CRASH'S VERY OWN PEEK COMMAND
.PEEK: HRROI T2,[ASCIZ /AT RUNNING MONITOR/]
PUSHJ P,SKPNOI ;TELL HIM
POPJ P,
PUSHJ P,ENDCOM ;GET CR
POPJ P, ;ERROR
SETZM PATCHS ;FOR SAFETY
SETZM CRASHS ;NO FILE
SETOM DEPNCT ;NO PATCHING
JRST FDINOT ;GO TO IT
;ASM'S CONTINUE COMMAND
.CONT: HRROI T2,[ASCIZ /GROVELING/]
PUSHJ P,SKPNOI
POPJ P,
PUSHJ P,ENDCOM ;PARSE CRLF
POPJ P,
JRST DD1 ;THIS MAY NOT WORK
.GET: HRROI T2,[ASCIZ 'FILE']
PUSHJ P,SKPNOI
POPJ P,
MOVX T1,GJ%OLD
MOVEM T1,GJFBLK+.GJGEN
HRROI T1,[ASCIZ 'DUMP']
SKIPE PATCHS ;PATCHING?
HRROI T1,[ASCIZ 'MONITR']
MOVEM T1,GJFBLK+.GJNAM ;DEFAULT NAME
SETZM SYMGET ;CLEAR FLAG
GET02: MOVEI T1,CMDBLK
MOVEI T2,[FLDDB. (.CMFIL)]
COMND
TXNN T1,CM%NOP ;SPEC OK?
JRST GET10
PUSHJ P,TSTCOL ;SEE IF CRLF NEEDED
TMSG <? FILDDT: Invalid file specification, >
CALLRET PUTERR ;OUTPUT ERROR STRING TO TERMINAL
GET10: MOVEI T3,0
HRROI T1,NAMBUF ;STORE FILE-SPEC FOR COMPT.
JFNS
MOVE T1,T2
RLJFN
JFCL
PUSHJ P,ENDCOM ;END OF LINE
POPJ P, ;ERROR
SETOM CRASHS ;SAY LOOKING AT CRASH FILE
SKIPE PATCHS ;PATCHING?
SETOM SYMGET ;GET SYMS ALSO
HLLZS CMPTBF+3 ;CLEAR RHS
MOVX T1,OF%RD ;READ OPEN ACCESS
SKIPE PATCHS ;PATCHING?
IORX T1,OF%WR ;YES - WRITE ALSO
IORM T1,CMPTBF+3
MOVEI T1,5 ;SET FOR EXTENDED LOOKUP
MOVEM T1,FILBLK ; BLOCK
MOVE T1,[10,,CMPTBF] ;COMPAT BUFFER
COMPT. T1,
JRST PUTERR
MOVE T1,FILBLK+5 ;GET FILE SIZE
MOVEM T1,MONSIZ ;SETUP MAX SIZE
JRST FDIOPN ;ALL OPEN
.LOAD: HRROI T2,[ASCIZ 'SYMBOLS FROM']
PUSHJ P,SKPNOI
POPJ P,
HRROI T1,[ASCIZ 'MONITR']
MOVEM T1,GJFBLK+.GJNAM
SETOM SYMGET ;FLAG SYMBOL GET
JRST GET02 ;JOIN COMMON CODE
.ENBLE: MOVEI T1,CMDBLK
MOVEI T2,[FLDDB. (.CMKEY,,KEYTAB)]
COMND
TXNN T1,CM%NOP
JRST ENAB10
PUSHJ P,TSTCOL
TMSG <? FILDDT: No keyword ">
MOVE T1,CMDBLK+.CMABP
PSOUT ;PRINT OFFENDING ITEM
TMSG <"
>
RET ;RETURN
ENAB10: PUSH P,T2 ;SAVE INDEX
PUSHJ P,ENDCOM
JRST [ POP P,T1
RET] ;ERROR RETURN
POP P,T2 ;RESTORE INDEX
HRRZ T1,(T2) ;GET DISPATCH
JRST (T1) ;GO DO IT
.PATCH: SETOM PATCHS ;SET PATCHING
RET ;RETURN
.DATA: SETOM FDIDSW ;SET DATA FILE
RET
SUBTTL COMMAND ERROR SUBROUTINES
; INVALID END-OF-COMMAND
CFMERR: PUSHJ P,TSTCOL ;TEST COLUMN POSITION
TMSG <? FILDDT: Garbage at end-of-command
> ;OUTPUT ERROR MESSAGE
POPJ P, ;RETURN TO WHENCE WE CAME ...
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT DESIGNATOR
RFPOS ;READ FILE POSITION
HRRZ T2,T2 ;KEEP JUST THE COLUMN POSITION
JUMPE T2,CPOPJ ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
POPJ P, ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL: PUSHJ P,PUTERR
; RETURNS: +1 ALWAYS
PUTERR: MOVX T1,.PRIOU ;GET PRIMARY OUTPUT JFN
HRLOI T2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T3 ;
ERSTR ;OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
TMSG <
> ;OUTPUT NEW LINE
POPJ P, ;RETURN TO WHENCE WE CAME ...
;PUTATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PREFIX STRING TO BE TYPED
; PUSHJ P,TYPATM
;RETURNS: +1 ALWAYS
TYPATM: PUSH P,T1 ;SAVE POINTER
PUSHJ P,TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? FILDDT: > ;OUTPUT INITIAL PART OF MESSAGE
POP P,T1 ;RESTORE ATOM POINTER
PSOUT ;OUTPUT THE STRING
TMSG < "> ;OUTPUT PUNCTUATION
HRROI T1,ATMBFR ;GET POINTER TO THE ATOM BUFFER
PSOUT ;OUTPUT THE TEXT ENTERED
TMSG <"
> ;OUTPUT END OF LINE
POPJ P, ;RETURN
SUBTTL PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: PUSHJ P,ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET CFMERR ] ;NO, ISSUE ERROR MESSAGE AND RETURN
JRST CPOPJ1 ;SUCCESS, RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; PUSHJ P,SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND ;PARSE NOISE WORD
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
JRST CPOPJ1 ;YES - RETUR SUCCESS
PUSHJ P,TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,[ASCIZ/Invalid guide phrase/]
CALLRET TYPATM ;OUTPUT THE TEXT ENTERED AND RETURN
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PROMPT STRING
; PUSHJ P,CMDINI
;RETURNS: +1 ALWAYS, WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
; CALL TO CMDINI.
CMDINI: MOVEM T1,CMDBLK+.CMRTY ;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
POP P,SAVRET ;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
MOVEM P,SAVREP ;SAVE STACK POINTER TO BE RESET ON REPARSE
MOVEI T1,REPARS ;GET ADDRESS OF REPARSE ROUTINE
MOVEM T1,CMDBLK+.CMFLG ;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
JRST @SAVRET ;RETURN
; HERE TO PROCESS A REPARSE
REPARS: MOVE P,SAVREP ;RESET STACK POINTER
JRST @SAVRET ;RETURN TO CALLER OF CMDINI
SUBTTL CONSTANTS AND TABLES
DEFINE TB(RTN,TXT)
< [ASCIZ/TXT/] ,, RTN
>
CMDTAB: CMDSIZ-1,, CMDSIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (.ENBLE,ENABLE) ;ENABLE (PATCHING/DATA-FILE)
TB (.EXIT,EXIT) ;EXIT TO MONITOR
TB (.GET,GET) ;GET (FILE) FILE-SPEC
TB (.HELP,HELP) ;OUTPUT HELP MESSAGE
TB (.LOAD,LOAD) ;LOAD (SYMBOLS FROM) FILE-SPEC
TB (.PEEK,PEEK) ;PEEK AT RUNNING MONITOR
CMDSIZ== .-CMDTAB
KEYTAB: 2,,2
TB (.DATA,DATA-FILE)
TB (.PATCH,PATCHING)
;< YOU WOULDN'T BELIEVE IT IF I TOLD YOU
PROMPT: ASCIZ /FILDDT>/ ;PROMPT STRING
HLPMSG: ASCIZ \
GET (FILE) file-spec
Loads file for DDT to examine it.
LOAD (SYMBOLS FROM) file-spec
Reads specified file and builds internal symbol table.
EXIT (FROM FILDDT)
Returns to command level. You then may type a SAVE command
if a LOAD command was just done to pre-load symbols.
HELP
Types this text.
ENABLE PATCHING
Allows writing on an existing file specified by GET
ENABLE DATA-FILE
Assumes file is raw binary (i.e. no ACs).
DDT features:
n$U sets SPT index (n) for index block to be used for virtual
addresses in examining the file.
<CTRL/E> returns to FILDDT command level
\
SUBTTL VARIABLE DATA STORAGE
SAVRET: BLOCK 1 ;RETURN ADDRESS OF CMDINI CALLER
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
NAMBUF: BLOCK 50 ;BUFFER FOR NAME OF INPUT FILE
CMPTBF: 1,,1 ;CHL 1 ,, FUNCT 1
GJ%OLD!GJ%SHT ;OLD FILE ONLY
-1,,NAMBUF ;POINTER TO NAME
440000,,0 ;OPENF BITS
17 ;I/O MODE
0 ;IBUF
0 ;OBUF
FILBLK ;XTRA WORDS FOR LOOKUP
0 ;NO POINTERS
>
;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
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
PUSHJ P,CHKHSM ;[200] CHECK HI-SEG POINTER
SETZ T, ;[200] NOPE - GARBAGE IN .JBHSM
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,<
MOVE R,T ;[217] SAVE T FOR MOMENT
PUSHJ P,GETHSO ;[217] FIND HISEG ORIGIN
EXCH R,T ;[217] RESET T FOR OTHERS
JUMPE R,SYMS4 ;[217] NO HISEG
CAIG R,(T) ;[217] PRGM IN LOW OR HI SEG?
JRST [ PUSH P,T ;[217] HISEG, 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
PUSHJ P,CHKHSM ;[217] CHECK VALIDITY OF POINTER
JRST UNDEF ;[217] INVALID, MODULE UNDEFINED
MOVE R,T ;[217] SET R FOR SETSUB SEARCH
PUSH P,T ;[217] PRESERVE T ACROSS SETSUB
PUSHJ P,SETSUB ;YES, LOOK THRU HI SYM TABLE
POP P,T ;[217] RESTORE T (FOR FLAG IN W)
>
JUMPGE R,UNDEF ;UNDEFINED IF NOT IN HI SEG
IFE FTFILE,<
HRR W,T ;[217] FLAG IT FOR FUTURE SEARCHS
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
PUSHJ P,CHKHSR ;[201] SEE IF VALID SYM PTR
JRST ERR ;[201] NOPE - ERROR
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)
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 RELATIE
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,PAT.. ;USUAL LINK10 SYMBOL
RADIX50 0,PAT ;TOPS-10 SYMBOL
RADIX50 0,PATCH ;ANOTHER LIKELY POSSIBILITY
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
TLNE F,(ROF) ;[212] REGISTER OPEN?
TLNE F,(QF) ;[212] AND NOTHING YET TYPED?
CAIA ;[212] NO.
SOS LLOC ;[212] YES - DO NOT STORE A 0 WORD.
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
SUBTTL PAGE TABLE CONTROL ($U)
IFE FTDEC20,<
IFE FTEXEC!FTFILE,< SETPAG==ERR>
IFN FTEXEC!FTFILE,<
IFE FTFD20,<
;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
PUSHJ P,FETC22 ;[203] TEST 22-BIT 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
PUSHJ P,FETC22 ;[203] PICKUP 22-BIT ADDRESS
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 IFE FTFD20
IFN FTFD20,<
SETPAG: TRZE F,Q2F ;QUANITY AFTER $
JRST ERR ;YES - ERROR FOR NOW
TLZN F,(QF) ;SPT INDEX GIVEN?
JRST [ SETZM XBLOC ;NO - RESET TO PHYSICAL
JRST RET]
MOVEM T,XBLOC ;STORE SPTX FOR CVTADR
JRST RET
>
> ;END EDDT AND FILDDT SWITCH
> ;END IFE FTDEC20
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
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
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
>
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: REPEAT SKPMAX,<AOS SKPCT> ;[211] NOTE COUNT OF LOCS SKIPPED
JSR SAVE ;SAVE CONTEXT
PUSHJ P,REMOVB ;REMOVE BRKPTS
MOVEI TT,SKPMAX ;[211]
SUB TT,SKPCT ;COMPUTE AMOUNT OF PC INCREMENT
SETZM SKPCT ;[211] DON'T CONFUSE OTHERS
CAIG TT,0 ;INSTRUCTION SKIPPED?
JRST DD1 ;NO
XEC4: MOVE W1,[ASCII "<SKP>"] ;MAKE SURE IT IS CLEAR
PUSHJ P,TEXT2 ; THAT THIS WAS A SKIP
PUSHJ P,CRF ;TYPE 2 CR-LFEEDS
SOJG TT,XEC4 ;[211] SHOW NUM OF LOCS SKIPPED
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
TWOPA== 400 ;INSTRUCTION HAS 2 PART ADR COMPUTATION
BPE== 1000 ;BYTE MANIPULATION INSTRUCTION
IMM2== 2000 ;SECOND EA IS IMMEDIATE
;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
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
777000,,IOTS ; 700-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 IIBP ; 133 IBP
ILDB IIXBP ; 134 ILDB
LDB IXBP ; 135 LDB
IDPB IIXBP ; 136 IDPB
DPB IXBP ; 137 DPB
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 SETI ; 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
;HERE TO INTERPRET BYTE MANIPULATION INSTRUCTIONS
;TREAT ILDB/IDPB AS IBP THEN LDB/DPB
IIXBP: MOVSI T,(1B8) ;CONVERT TO LDB/DPB
IORM T,I.NST ; . . .
JSR SWAP ;GET USER CONTEXT
IBP @I.NSTEA ;INCREMENT POINTER
JRST IXBP1 ; COMMON CODE
IIBP: TLO F,IMM2!FAC ;FOR IBP NO AC, 2ND EA IMMEDIATE
IXBP: JSR SWAP ;GET USER CONTEXT
IXBP1: MOVEM T,I.EA2 ;SAVE USER'S AC
MOVSI T,(@) ;GET INDIRECT BIT
IORM T,I.NSTEA ;SET IN EA OF INSTR
MOVE T,I.EA2 ;GET AC FOR ADDR COMUTATION
MOVEI T,@I.NSTEA ;GET EFF ADDR OF POINTER
EXCH T,I.EA2 ;RESTORE USER'S ACS
JSR SWAP ;CONTEXT SWITCH BACK TO DDT
HRRZS I.NSTEA ;CLEAR INDIRECT BIT IN E FIELD
TLC F,FAC!EA!TWOPA!BPE ;SET FLAGS (CLEAR FAC IF IBP)
JRST DOIT ;AND GO DO GRUNDGE
;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
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)
SETZM SKPCT ;[211] NOTE NUMBER OF SKIPS
JSR SWAP ;SWAP TO USER CONTEXT
XCT I.XCT ;EXECUTE THE INSTRUCTION (IF IN EXEC MODE
; ON A KI10 THIS MAY BE EXECUTIVE XCT)
REPEAT SKPMAX,<AOS SKPCT> ;[211] NOTE COUNT OF SKIPS
MOVEM T,SAFETY ;SAVE USER T
MOVEI T,SKPMAX + 1 ;[211] MAX AMOUNT CAN BE SKIPPED
SUB T,SKPCT ;[211] MINUS THOSE NOT SKIPPED
ADDM T,PROC0 ;[211] IS THOSE SKIPPED, UPDATE PC
SETZM SKPCT ;[211] CLEAR COUNTER
MOVE T,SAFETY ;[211] RESTORE T
;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,BPE ;C(E) A BYTE POINTER
MOVEI SCH,TBPNT ;YES - TYPE AS SUCH
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
TLNN F,TWOPA ;TWO-PART ADDRESS COMPUTATION?
JRST NOSKIQ ;NO
MOVE T,I.EA2 ;YES - GET E(C(E))
EXCH T,I.NSTEA ;E:=E(C(E))
MOVEM T,I.EA2 ;REMEMBER E
TLNE F,IMM2 ;SECOND E IMMEDIATE?
PUSHJ P,IMM0 ;YES - TYPE E(C(E))
TLNN F,IMM2 ;SECOND E IMMEDIATE?
PUSHJ P,EA0 ;NO - TYPE E(C(E))/C(E(C(E)))
MOVE T,I.EA2 ;GET FIRST E BACK
MOVEM T,I.NSTEA ;AND RESTORE TO RIGHTFUL PLACE
NOSKIQ: 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
CAIL T,1(W1) ;[211] YES - AT OLD-PC+1
CAILE T,SKPMAX+1(W1) ;[211] TO OLD-PC+1+SKPMAX?
CAIA ;[211] NO.
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 T,TEM ;FREE AN AC
IFE FTDEC20,<
JSP T,.+1 ;GET USR FLAG
XOR T,SAVPI ;COMPARE WITH OLD USR FLAG(LAST DDT EXIT)
TLNE T,(1B5) ;SAME?
SETZM SARS> ;NO, SAVE AC'S AND PC FOR EXIT
; SO EXEC/USER MODE FLOP RESTORED AS ENTERED
JSP T,.+1 ;GET PC WORD AGAIN
ROT T,5 ;ROTATE USER MODE BIT TO SIGN
MOVEM T,USRFLG ; AND SAVE IT
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. USER DDT DOES NOT NEED TO KNOW PROCESSOR TYPE
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,<
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
SAV12: >> ;END IFN EDDT
; ..
;SAVE STATE AND SETUP DDT MODES...
IFN FTDEC20,<
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
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 DMNE
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 ;PROCEDE COUNTER SETUP
MOVE T,BP1-B1CNT(T) ;GET PC WORD
HLLM T,LEAV1 ;SAVE FLAGS FOR RESTORING
EXCH T,BCOM ; ALSO SAVE PC WORD IN BCOM
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 PROCEDE FOR INIT
;DONT INTERPRET FOR SYSTEM UUOS
IXCT41: MOVEM R,40 ;INTERPRET FOR NON-SYSTEM UUOS
MOVEI R,41
IXCT: SOSL TEM1
PUSHJ P,FETCH
JRST BPLUP ;BREAKPOINT LOOPING OR FETCH FAILED
MOVEM T,LEAV
IXCT5: LDB T,[POINT 9,LEAV,8] ;GET INSTRUCTION
CAIN T,254 ;DON'T DO ANYTHING TO JRST
JRST IXCT6
IXCT51: HRLZI 17,AC0
BLT 17,17
MOVEI T,@LEAV
DPB T,[POINT 23,LEAV,35] ;STORE EFFECTIVE ADDRESS
LDB W1,[POINT 4,LEAV,12] ;PICK UP AC FIELD
LDB T,[POINT 9,LEAV,8] ;PICK UP INSTRUCTION FIELD
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 PROCEDE REGESTER
JRST RET
BPS1: MOVE R,T
PUSHJ P,FETCH ;CAN BREAKPOINT BE INSERTED HERE?
JRST ERR ;NO
PUSHJ P,DEPERR ; AGAIN NO
TRZN F,Q2F ;HAS <N> BEEN TYPED?
JRST BPS3 ;NO
TRO F,2 ;YES, PROCESS THE COMMAND A$NB
BPS2: MOVE T,WRD2
CAIL T,1
CAILE T,NBP
JRST ERR
IMULI T,3
ADDI T,B1ADR-3
TRZN F,2
JRST MASK2
EXCH R,T
JRST BPS5
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 PROCEDE 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,<
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
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,
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
CAILE TT1,17 ;[207] IS ADR AN AC?
JRST DEPME0 ;[207] NO - REAL MEMORY
SKIPE CRASHS ;[207] LOOKING AT REAL MONITOR
SKIPE FAKEAC ;[213] OR AT FILE SANS "/D"?
JRST PUTFAC ;[207] YES - THEN "FAKE IT"
DEPME0: SKIPN PATCHS ;[207] 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
IFE FTFD20,<
MONPOK: PUSH P,T ;SAVE ARGUMENT
MOVEM T,POKER+2 ;SET AS NEW VALUE
HRRZM R,POKER ;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
>
IFN FTFD20,< MONPOK==ERR
DEPNPT: AOSG DEPNCT
OUTSTR [ASCIZ \
?PATCHING IS NOT AVAILABLE
\]
JRST CPOPJ1
>
IFE FTFD20,<
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
;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
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,<
FETC22: ;[203] DUMMY TAG FOR $U LOGIC
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
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
IFN FTFILE,<
HRRZ TT1,R ;STRIP OF COUNT
CAILE TT1,17 ;[207] READING AN AC?
JRST FETCH2 ;[207] NO - REGULAR DATA
SKIPE CRASHS ;[207] IF LOOKING AT MONITOR
SKIPE FAKEAC ;[213] OR FILE SANS "/D"
JRST GETFAC ;[207] THEN USE FAKE ACS
FETCH2: PUSH P,R ;[207] 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
;[203] FETC22 - SAME AS FETCH BUT USES FULL 22-BIT ADDRESSING
FETC22: MOVE TT1,R ;WORKING COPY OF R
TLZ TT1,777760 ;REDUCE TO 22-BIT ADDRESS
CAIG TT1,17 ;AC-FIELD?
JRST [MOVE T,AC0(TT1) ;YES
JRST CPOPJ1] ;RETURN HAPPILY
PUSH P,R ;PRESERVE R AS ADVERTISED
TLZ R,177760 ;CLEAR NON-22-BIT ADDRESS GARBAGE
PUSHJ P,FETX ;GET PHYSICAL MEM WORD
SOS -1(P) ;ERROR - FLAG
POP P,R ;RESTORE R
JRST CPOPJ1 ;AND RETURN AS INDICATED
FETX: SKIPN CRASHS ;CRASH.SAV EXIST?
JRST MONPEK ;NO - GO PEEK AT RUNNING MONITOR
MOVE TT1,R ;GET SPECIFIED ADDRESS
LSH TT1,-9 ;CONVERT TO PAGE #
ANDI TT1,17777 ;REDUCE TO 22-BIT PAGE ADDRESS
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
IFE FTFD20,<
MONPEK: HRRZ T,R
CALLI T,33
JRST CPOPJ1
>
IFN FTFD20,<
MONPEK: PUSH P,T1 ;SAVE T1 & T2
PUSH P,T2
HRRZ T1,R ;GET ADDRS
HRLI T1,1
MOVEI T2,T ;RETURN IN T
PEEK
SOS -2(P)
POP P,T2 ;RESTORE
POP P,T1
JRST CPOPJ1
>
GETFAC: SKIPA T,AC0(R) ;[207] READ FAKE AC
PUTFAC: MOVEM T,AC0(R) ;[207] WRITE FAKE AC
JRST CPOPJ1 ;[207] NEVER FAILS . . .
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
IFE FTFILE,<
IFE FTDEC20,<
CHKADR: 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?
JRST CHKADP ;[216] CHECK NON-CONTIGUOUS PAGE
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,CHKADP ;[216] MUST BE POSITIVE
HRRZ TT,.JBHRL ;TOP OF HISEG
CAIL TT,(R) ;[216] IS ADDRESS TOO BIG?
JRST (TT1) ;NO--INDICATE HISEG
CHKADP: LDB TT,[POINT 9,R,26] ;[216] PAGE NUMBER
HRLI TT,6 ;[216] .PAGCA; CHECK PAGE ACCESS
PAGE. TT, ;[216] IN CASE FUNNY PAGE
POPJ P, ;[216] PAGE CAN'T EXIST
JUMPL TT,CPOPJ ;[216] 1B0 = PA.GNE; NON EX PAGE
JRST 1(TT1) ;[216] EXISTS, MUST BE "LOW" SEG
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
; STILL FTFILE
;[200] CHKHSM - CHECK VALIDITY OF HIGH SEG SYMBOL TABLE POINTER
;[201] CHKHSR - CHECK VALIDITY OF HIGH SEG SYMBOL TABLE POINTER
;
; MOVX T,<SYM-PTR>
; PUSHJ P,CHKHSM/CHKHSR
; ERROR RETURN ;NOT A VALID .JBHSM POINTER
; NORMAL RETURN ;VALID .JBHSM
;
;CHKHSR PRESERVES R, CHKHSM USES R
;BOTH USE TT,TT1
CHKHSR: PUSH P,R ;SAVE R AS ADVERTISED
PUSHJ P,CHKHSM ;SEE IF T IS A VALID .JBHSM
CAIA ;NOPE
AOS -1(P) ;YES - GIVE SKIP RETURN
POP P,R ;RESTORE R AS ADVERTISED
POPJ P, ;RETURN AS INDICATED
CHKHSM:
IFN FTEXEC,<
SKPUSR ;NO .JBHSM IF EXEC MODE
POPJ P, ;EXEC MODE - RETURN
> ;END OF IFN FTEXEC
HRROI R,16 ;[215] 16 = .GTSGN; HI SEG INFO
GETTAB R, ;[215] READ JBTSGN TO SEE IF SPYING
SETZ R, ;[215] ASSUME NOT
JUMPL R,CPOPJ ;[215] 1B0 = SN%SPY; NO .JBHSM IF SPYING
CHKJSM: HRRZ R,T ;[216] GET BASE ADDRESS OF SYM TABLE
JSP TT1,CHKADR ;SEE IF LEGAL ADDRESS
CAIA ;IT WAS, WE WIN
JFCL ;[216] IT WAS, WE WIN
HLRE TT1,T ;GET NEGATIVE LENGTH MOD 18
MOVN TT1,TT1 ;GET POSITIVE LENGTH
ADDI R,-1(TT1) ;GET "TOP" OF SYM TABLE
JSP TT1,CHKADR ;SEE IF ALSO LEGAL ADDRESS
JRST CPOPJ1 ;[216] IT WAS - GIVE GOOD RETURN
JRST CPOPJ1 ;[216] IT WAS - GIVE GOOD RETURN
; STILL FTFILE
GETHSO: IFN FTEXEC,<
SKPUSR
JRST [ MOVEI T,400000
POPJ P,0]
>
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,<
CHKADR: 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
> ;END FTFILE
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: MOVE TT,SAVAPR ;[206] NEED TO PICK UP APR STATE
ANDI TT,7 ;[206] TO GET THE APR PI ASSIGNMENT
CONO APR,NXMKA(TT) ;[206] SO DON'T LOSE WHEN 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,<
GETHSO:
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
IFN FTFILE,<
GETHSO: SETZ T,
POPJ P,
>
IFN FTFILE,<
;MAP AN ADDRESS
IFE FTFD20,<
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 FTFD20
IFN FTFD20,<
;CONVERT ADDRESS IN R TO PHYSICAL LOC IN FILE
CVTADR: SKIPE SPTLOC ;HAVE SPT?
SKIPN T,XBLOC ;HAVE SPTX SETUP?
JRST CPOPJ1 ;NO - USE PHYSICAL ADDR
MOVEM R,REFADR ;SAVE ORIGINAL ADDRS
LDB R,[POINT 9,R,26] ;GET PAGE #
CVTAD1: PUSH P,R ;SAVE PAGE #
MOVE R,SPTLOC ;GET SPT BASE
ADD R,T ;ADD IN INDEX
PUSHJ P,FETX ;GET SPT ENTRY
MOVEI T,0
POP P,R ;RESTORE PAGE #
JUMPE T,CVTADE ;ERROR - RETURN ACTUAL ADDRS
TLNE T,17 ;IN CORE?
JRST CVTADE ;NO ERROR
ANDI T,17777 ;PAGE # OF PT
LSH T,^D9 ;CONVERT TO CORE ADDRS
ADD R,T ;ADD IN PAGE #
PUSHJ P,FETX ;GET PAGE POINTER
JRST CVTADE
LDB R,[POINT 3,T,2] ;GET TYPE CODE
JRST @CVTTBL(R) ;DISPATCH ON CODE
CVTYP1: TLNE T,17 ;IMMEDIATE (INCORE?)
JRST CVTADE
ANDI T,17777 ;YES - GET PAGE #
LSH T,^D9 ;MAKE INTO ADDRS
MOVE R,REFADR ;GET ORIGINAL ADDRS BACK
ANDI R,777 ;GET LINE #
ADD R,T ;REAL ADDRS
JRST CPOPJ1 ;SUCCESS
CVTYP2: HRRZ R,T ;GET SPT INDEX AGAIN
ADD R,SPTLOC ;RELOCATE INTO SPT
PUSHJ P,FETX
JRST CVTADE ;THIS IS BOTHERSOME
JRST CVTYP1 ;TREAT LIKE TYPE 1
CVTYP3: LDB R,[POINT 9,T,17] ;GET PAGE # (INDIRECT)
TLZ T,-1 ; AND NEW SPTX
JRST CVTAD1 ; THEN START OVER
CVTTBL: CVTADE ;0 - NO PAGE
CVTYP1 ;1 - IMMEDIATE POINTER
CVTYP2 ;2 - SHARED POINTER
CVTYP3 ;3 - INDIRECT POINTER
CVTADE ;4 - ILLEAGL
CVTADE ;5 - ILLEGAL
CVTADE ;6 - ILLEGAL
CVTADE ;7 - ILLEGAL
CVTADE: MOVE R,REFADR ;ORIGINAL ADDRS
POPJ P, ;ERROR RETURN
> ;END FTFD20
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,
;HERE TO PRINT A WORD IN BYTE POINTER FORMAT:
; P S [@][[Y](X) ! Y]
TBPNT: LDB T,[POINT 6,LWT,5] ;GET "P" BYTE FIELD
PUSHJ P,TOC ;TYPE OUT
PUSHJ P,TSPC ;FOLLOWED BY SPACE
LDB T,[POINT 6,LWT,11] ;SET "S" BYTE FIELD
PUSHJ P,TOC ;TYPE IT OUT
PUSHJ P,TSPC ;CAP OFF WITH ANOTHER SPACE
JRST PI4 ;GO DO I, X, AND Y FIELDS
CONSYM: MOVEM T,LWT
IFN FTFILE,<
IFE FTFD20,<
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 PIN1 ;YES
MOVE T,LWT ;NO, GET WORD
PUSHJ P,LOOK ;TRY FOR FULL WORD MATCH
JRST PIN1 ;NOT FOUND
JRST PIN1 ;CLOSE IS NOT GOOD ENOUGH
POPJ P, ;FOUND AND PRINTED
> ;END OF IFN FTDEC20
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
PIN1: 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,1000> ; BY 100(8) OR MORE- 1000(8) FOR EXEC DDT OR FILDDT
>
CAIGE W2,60 ;PRINT ADRS .LT. 60 NUMERICALLY
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 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: TRZN F,Q2F ;[210] SECOND ARG TYPED?
TDZA TT1,TT1 ;[210] NO - DEFAULT TO SEARCH MASK
SKIPL TT1,WRD2 ;[210] YES - PICK UP MASK NUMBER
CAIL TT1,MSKMAX ;[213] LEGAL RANGE?
JRST ERR ;[210] NO - COMPLAIN AT USER
MOVEM T,@MSKADR(TT1) ;[210] YES - STORE NEW MASK
JRST RET
MSKADR: Z MSK ;[210] SEARCH MASK
Z TTYMSK ;[210] TTY FORMAT CONTROL MASK
MSKMAX==.-MSKADR ;[210] MAX MASK "FUNCTION"
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,
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
SUBTTL TELETYPE IO LOGIC
IFN FTEXEC,< ;EXECUTIVE MODE TELETYPE I/O
DTE==200
DTEII=142 ;DTE20 INTERRUPT INST
DTEUNS=143 ;UNUSED
DTEEPW=144 ;EXAMINE PROTECTION WORD
DTEERW=145 ;EXAMINE RELOCATION WORD
DTEDPW=146 ;DEPOSIT PROTECTION WORD
DTEDRW=147 ;DEPOSIT RELOCATION WORD
DTEFLG=444
DTEF11=450
DTECMD=451
DTEMTD=455
DTEMTI=456
.DTMTO==10B27
.DTMMC==11B27
.DTNMC==12B27
DTEN==4 ;MAX NUMBER OF DTE'S
TO11DB==1B22 ;TO 11 DOORBELL
CL11PT==1B26 ;CLEAR TO 10 DOORBELL
PI0ENB==1B32 ;PI CHANNEL 0 ENABLE
PIENB==1B31 ;ENABLE PI SETTING
DTEPRV==1B20 ;RESTRICTED BIT
;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
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
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
;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
>
SKPNKL
JRST KLXLIS ;DO KL10 INPUT
CONSO TTY,40 ;NO, LISTEN FOR TTY
POPJ P,
DATAI TTY,T
XLIST1: ANDI T,177
JRST CPOPJ1
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
;SAVE USER STATUS ('RETURN' TO DDT)
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,
;RESTORE USER STATUS ('LEAVE' DDT)
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,
;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
MOVEM T,SAVEBR ;SAVE IT
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
;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]
CAIE T,15 ;CR OR LF?
CAIN T,12
JRST ECHO1 ;YES, NO CONVERSION
CAIE T,"G"-100 ;BELL?
CAIN T,"H"-100 ;[210] OR BACKSPACE?
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,
IFE FTDEC20,<
OPDEF TTCALL [51B8]
TOUT0:
IFN FTEXEC,< SKPUSR
JRST XTOUT >
IFN FTFILE,< SKIPE COMAND ;IS THERE A COMMAND FILE?
JRST PUTCHR> ;YES
TTCALL 1,T ;OUTPUT A CHARACTER
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 ; ..
TTCALL 2,T ;GET NEXT CHAR, NO IO WAIT
POPJ P, ;NO CHARACTER EXISTED, RETURN
JRS