Trailing-Edge
-
PDP-10 Archives
-
AP-D543V_SB
-
ddt.mac
There are 55 other files named ddt.mac in the archive. Click here to see a list.
SUBTTL DDT 15-Aug-78 /TW/PFC/TWE/DAL/DLM/EJW/RDH
COMMENT \
DDT -- "Dynamic Debugging Technique" for TOPS-10/TOPS-20
Copyright (C) 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977
Digital Equipment Corporation, Maynard, Massachusetts, U.S.A.
This software is furnished under a license and may be used and copyed only
in accordance with the terms of such license and with the inclusion of the
above copyright notice. This software or any other copies thereof may not
be provided or otherwise made available to any other person. No title to
and ownership of the software is hereby transferred.
The information in this software is subject to change without notice and
should not be construed as a commitment by Digital Equipment Corporation.
Digital assumes no responsibility for the use or reliability of its
software on equipment which is not supplied by Digital.
\
;<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
; TABLE OF CONTENTS FOR DDT
;
;
; SECTION PAGE
; 1. DDT TABLE OF CONTENTS..................................... 4
; 2. REVISION HISTORY.......................................... 5
; 3. DDT ASSEMBLY SWITCHES..................................... 9
; 4. TITLE AND VERSION SETTING................................. 10
; 5. OPDEFS, MACROS, ETC....................................... 11
; 6. DDT SYMBOLS............................................... 12
; 7. WRITE DDT.VMX............................................. 17
; 8. MAKE TOPS20 DDT........................................... 18
; 9. START DDT................................................. 20
; 10. FILDDT
; 10.1 COMMAND SCANNER................................... 21
; 10.2 PROCESS .EXE FILE................................. 27
; 10.3 SETUP SYMBOLS..................................... 29
; 11. HELP AND EXIT COMMANDS.................................... 33
; 12. COMMAND ERROR SUBROUTINES................................. 36
; 13. PARSING SUBROUTINES....................................... 38
; 14. CONSTANTS AND TABLES...................................... 40
; 15. VARIABLE DATA STORAGE..................................... 41
; 16. DDT COMMAND PARSER........................................ 44
; 17. SYMBOL TABLE LOGIC........................................ 52
; 18. TEXT COMMANDS (" AND $").................................. 58
; 19. REGISTER EXAMINATION LOGIC................................ 62
; 20. MODE CONTROL SWITCHES..................................... 67
; 21. PATCH COMMAND
; 21.1 PATCH BEGIN....................................... 69
; 21.2 PATCH END......................................... 70
; 22. PAGE TABLE CONTROL ($U)................................... 71
; 23. GO AND EXECUTE LOGIC...................................... 73
; 24. SINGLE STEP EXECUTE LOGIC................................. 75
; 25. ENTER AND LEAVE DDT LOGIC................................. 90
; 26. BREAK POINT LOGIC......................................... 94
; 27. MEMORY MANAGER SUBROUTINES................................ 102
; 28. BINARY TO SYMBOLIC CONVERSION............................. 117
; 29. MASK COMMAND HANDLING..................................... 127
; 30. SEARCH LOGIC.............................................. 128
; 31. OUTPUT SUBROUTINES........................................ 131
; 32. BYTE COMMAND AND TYPEOUT ROUTINES......................... 136
; 33. PUNCH PAPER TAPE LOGIC.................................... 137
; 34. TELETYPE IO LOGIC......................................... 141
; 35. DDT COMMAND FILE LOGIC.................................... 158
; 36. DISPATCH TABLE............................................ 164
; 37. FANCY TERMINAL INPUT LOGIC................................ 165
; 38. OP DECODER................................................ 181
; 39. VARIABLE STORAGE.......................................... 193
; 40. STORAGE
; 40.1 $X LOGIC AND PATCH COMMAND........................ 194
; 40.2 BREAKPOINTS....................................... 195
; 40.3 SYMBOL TABLE LOGIC................................ 197
; 40.4 SAVE AREAS FOR PREVIOUS CONTEXT................... 199
; 40.5 STATE VARIABLES................................... 201
; 40.6 PUSH DOWN LIST.................................... 203
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.
;220 JNG 28-JAN-77
; PREVENT ILL MEM REF ON PATCH CLOSE WHEN USING A WRITE-LOCKED
; (E.G. HISEG) SYMBOL TABLE.
;DDT %40(220) MARCH, 1977
;221 T?H 13-MAR-77
; ADD COMMAND FRONT END TO INTERFACE FILDDT TO TOPS-20 SYSTEM.
; ADD KL PAGING CODE TO CVTADR, ALL UNDER FTFD20 CONDITIONAL
; (FTFILE MUST STILL BE ON ALSO).
;222 A?M 13-MAR-77
; IN EXEC DDT DETERMINE EXEC VIRTUAL ADDRESS OF EPT BY SCANNING
; EXEC VIRT ADR SPACE IF PAGING IS ON.
;223 T?H 13-MAR-77
; MAKE LPDL LARGER FOR TOPS-20 MDDT
;224 RDH 13-MAR-77
; MAKE SEARCHES HANDLE NON-CONTIGUOUS CORE/FILE IMAGES, ADD
; TWO NEW ASSEMBLY PARAMETERS:
;
; INDPTH ;MAX INDIRECT NESTING FOR $E SEARCHES
; LISCNT ;NUM OF <PUSHJ P,LISTEN>'S TWEEN INCHRS'S
;225 RDH 13-MAR-77
; HANDLE TYPEOUT RADIX .GE. 10 (E.G., HEX) MORE GRACEFULLY
;226 RDH 13-MAR-77
; EDIT 215 IS WRONG, .GTSGN == 14
;227 JNG 13-MAR-77
; ADD CODE TO DDT TO WRITE-ENABLE PAGES ON TOPS-20 BEFORE
; ATTEMPTING TO WRITE THEM - E.G., FOR BREAKPOINTS, PATCHS,
; AND SO FORTH. IF PAGE NOT WRITE-ENABLED, SET COPY-ON-WRITE
; SO AS NOT TO ZAP OTHER USERS "SHARING" THE PAGE.
;230 RDH 13-MAR-77
; WHEN IN A COMMAND FILE ($Y) THEN DO NOT CHECK THE COMMAND
; FILE FOR INPUT ON CALLS TO LISTEN - ONLY ACCEPT PHYSICAL
; TTY INPUT.
;231 RDH 14-MAR-77
; CLEAR $U POINTERS IN FILDDT ON ^Z, START SEQUENCE
;232 RDH 14-MAR-77
; UPDATE LH(.JBSA) ON PATCH END IF .JBFF WAS DEFAULTED TO
; ON PATCH BEGIN. THIS WAY THE PATCH IS AT LEAST SAVED ON
; SAVE'S, RESET'S, AD NAUSEUM.
;233 RDH 14-MAR-77
; REVAMP PATCH LOGIC ($< AND $>) TO DISPLAY LOCATION BEFORE
; MODIFYING SAME LOCATION SO THAT FILDDT CAN PATCH RUNNING
; MONITOR (ALSO LOOKS NEATER).
;234 RDH 23-MAR-77
; ADD NEW "MASK" COMMAND <N>$2M TO SET THE SYMBOL OFFSET RANGE
; (I.E. THE RANGE IN WHICH VALUES WILL BE TYPED IN THE FORM
; SYMBOL+<OFFSET>) TO <N>. ADD ASSEMBLY PARAMETER "ADRNGE"
; AS THE DEFAULT VALUE. ALSO MAKE $1M/ ETC. WORK.
;235 RDH 24-MAR-77
; REVAMP BYTE TYPEOUT LOGIC: ADD <N>$3M AS BYTE TYPEOUT MASK
; (EACH "1" BIT IN THE MASK MARKS THE END OF A BYTE, BIT 35
; IS ALWAYS CONSIDERED THE END OF A BYTE). FOR VALUES OF <N>
; SUCH THAT 1 .LE. <N> .LE. 36(10) THE COMMANDS $<N>O & $$<N>O
; WORK AS USUAL BY SETTING AN INTERNAL BYTE MASK. FOR <N> = 0
; THE $3M BYTE MASK WILL BE USED. FOR <N> = <NULL> (I.E. THE
; $O COMMAND) THE CURRENTLY PREVAILING $O OR $$O MASK WILL
; BE USED IF NON-BLANK, ELSE THE $3M MASK WILL BE USED.
; $$O MAKES PERMANENT THE CURRENTLY PREVAILING $O (OR $$O)
; BYTE MASK.
;236 RDH 14-APR-77
; ADD IFN FTYANK CONDITIONALS SO THAT FILDDT CAN BE ASSEMBLED
; WITH FTYANK TURNED OFF
;237 RDH 17-APR-77
; GENERAL CLEANUP AND REARRANGEMENT. MAKE TOPS-10 DDT SEARCH
; THE "C" UNIVERSAL FILE. TYPE OUT "DDT" WHEN USER MODE DDT
; IS ENTERED. PUT TOPS-10-SPECIFIC CODE UNDER "IFN FTDEC10"
; RATHER THAN "IFE FTDEC20".
;240 RDH 15-JUN-77
; ADD CODE TO TYPE OUT SYMBOLIC WORDS WITH USER-DEFINED SYMBOLS
; SUCH AS THE CALLI OR JSYS MNEMONICS. ORDER OF SEARCH IS:
; 1) OPCODE & AC & I & X & Y FIELDS
; 2) OPCODE & I & X & Y FIELDS (E.G. CALLI OR JSYS)
; 3) OPCODE & AC FIELDS (E.G. TTCALLS)
; 4) OPCODE ONLY
; 5) HARDWARE-KNOWN OPCODE (JRST, ETC.)
; PUT CODE UNDER FTOPX .NE. 0 CONDITIONAL SINCE UNTIL SORTED
; SYMBOL TABLES AVAILABLE THIS CODE TAKES MUCH RUN TIME.
; ALSO MAKE TRXX AND TLXX TYPE OUT ADDRESS AS OCTAL RATHER
; THAN SYMBOL+OFFSET.
;241 RDH 15-SEP-77 SPR # 10-22011
; "777777" COULD GET TYPED OUT AS "-1" WHEN $X'ING IF THE
; AC BEING TYPED OUT WAS TYPED OUT IN XWD FORMAT.
;242 RDH 16-SEP-77 SPR # 10-22616
; "AOS UND#(AC)" LOST BOTH THE UND SYMBOL AND THE AC IN
; THE WORD BEING BUILT (I.E., LEFT ONLY THE AOS).
;243 RDH 16-SEP-77 SPR # 10-22788
; PATCHING WITH FILDDT WRONG IF NONE OF THE USUAL PATCHING
; SYMBOLS (PAT.., PAT, PATCH) ARE PRESENT AND THUS PATCHING
; DEFAULTS TO C(.JBFF) - THE .JBFF USED WAS FILDDT'S, NOT
; THE FILE'S.
;244 RDH 16-SEP-77 SPR # 10-22894
; SOME RUBOUT'S STILL GET TYPED OUT.
;245 RDH 17-SEP-77 SPR # 10-23013
; AFTER REFERENCING AN UNDEFINED SYMBOL, THE UNDEFINED SYMBOL
; IS LEFT IN THE SYMBOL CACHE WITH ITS BOGUS VALUE (E.G., THE
; ADDRESS TO FIX UP).
;246 RDH 25-SEP-77
; BE MORE CHOOSEY ABOUT TYPE-IN INVOLVING UNDEFINEDS - CATCH ERRORS
; SUCH AS "PUSHJ UND#,FOO" OR "MOVE 4,(UND#)"
;247 Reserved for development.
;250 JNG 15-Aug-78
; Search UUOSYM, MACTEN instead of C.
;DDT %40A(250) October, 1978
SUBTTL DDT ASSEMBLY SWITCHES
;SWITCHES FOR DDT FEATURES
;FTDEC10 ;TOPS-10 FACILITIES
;FTDEC20 ;TOPS-20 FACILITIES
;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 TOPS-10 VIRTUAL MEMORY
;FTMON ;TOPS-20 MONITOR DDT
;FTEDIT ;INCLUDE FANCY EDITING FEATURES WITH TOPS-20 EDDT
;FTFD20 ;FILE DDT FOR TOPS-20
;FTOPX ;EXTENDED OPCODE DECODING FOR TYPEOUT
;ABSDDT ;RELOCATABLE ASSEMBLY IF 0, ABSOLUTE ASSEMBLY
; WITH ORIGIN GIVEN BY B0-17 OTHERWISE
IFNDEF FTDEC10,<
IFNDEF FTDEC20,<
FTDEC10==-1
FTDEC20==0>>
IFNDEF FTDEC10,<FTDEC10==0>
IFNDEF FTDEC20,<FTDEC20==0>
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 FTMON,< FTMON==0>
IFNDEF FTEDIT,<FTEDIT==0>
IFNDEF FTFD20,<FTFD20==0>
IFNDEF FTOPX,<
IFN FTDEC10,<FTOPX==-1>
IFN FTDEC20,<FTOPX==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,FTDEC10,FTDEC20,FTMON,FTEDIT>
IFE FTDEC10!FTDEC20,<PRINTX ? Neither FTDEC10 nor FTDEC20 selected>
IFN FTDEC10&FTDEC20,<PRINTX ? Both FTDEC10 and FTDEC20 selected>
SUBTTL TITLE AND VERSION SETTING
SALL ;CLEAN LISTINGS
IFN FTDEC10,< ;TOPS-10 VERSIONS
IFN FTFD20,<SEARCH MONSYM> ;WANT PEEK JSYS, NOT PEEK UUO
SEARCH MACTEN,UUOSYM ;ALL STANDARD TOPS-10 DEFINITIONS
IFN FTEXEC,<TITLE EDDT - TOPS-10 EXEC MODE DDT>
IFN FTFILE&<^-FTFD20>,<TITLE FILDDT - TOPS-10 FILE DDT>
IFN FTVMX,<TITLE VMDDT - TOPS-10 VM DDT>
IFE FTFD20!FTFILE!FTEXEC!FTVMX,<TITLE UDDT - TOPS-10 USER MODE DDT>
> ;END OF TOPS-10 TITLES
IFN FTDEC20!FTFD20,< ;TOPS-20 VERSIONS
SEARCH MONSYM,MACSYM ;ALL STANDARD TOPS-20 DEFINITIONS
IFN FTEXEC,<TITLE EDDT - TOPS-20 EXEC MODE DDT>
IFN FTFD20,<TITLE FILDDT - TOPS-20 FILE DDT>
IFN FTMON,<TITLE MDDT - TOPS-20 MONITOR DDT>
IFE FTEXEC!FTFD20!FTMON,<TITLE UDDT - TOPS-20 USER MODE DDT>
> ;END OF TOPS-20 TITLES
;DDT VERSION IDENTIFICATION
MAJVER==40 ;MAJOR VERSION LEVEL
MINVER==1 ;MINOR (MAINTENANCE RELEASE) LEVEL
CSTVER==0 ;CUSTOMER VERSION (WHO LAST . . .)
EDTVER==250 ;EDIT LEVEL
%DDTVR==:<BYTE (3)CSTVER(9)MAJVER(6)MINVER(18)EDTVER>
IF2 <PURGE MAJVER,MINVER,CSTVER,EDTVER>
IFE FTDEC20,< ;TOPS-20 CURRENTLY DOESN'T USE VERSION
IFE FTEXEC,< ;SET VERSION ONLY IF NOT EXEC MODE
LOC <.JBVER==:137> ;WHERE THE TOPS-10 VERSION INFO GOES
EXP %DDTVR ;THE VERSION WORD
>> ;END OF IFE FTEXEC, IFE FTDEC20
SUBTTL OPDEFS, MACROS, ETC.
;GENERAL
OPDEF PJRST [JRST] ;NOT IN MACSYM
DEFINE ND(S,V),<IF2,<IFDEF S,<S==S>> IFNDEF S,<S==V>> ;NOT IN MACSYM
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
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
;TOPS-20 SPECIFIC
IFN FTDEC20!FTFD20,<
OPDEF CALL [040B8]
OPDEF MRPAC [JSYS 772]
DEFINE SE0INT,< ;[222]
JRST @.+1
EXP .+1 >
> ;END OF IFN FTDEC20!FTFD20
SUBTTL DDT SYMBOLS
;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
IFN FTDEC20!FTFD20,<
IFE FTMON,<LPDL==100> ;[223]
IFN FTMON,<LPDL==200> ;[223]
T1=1
T2=2
T3=3
P=17> ;OVERRIDES P=1 ABOVE
;BIT OF "HARDWARE" INTEREST
NXMKA==1B23 ;NON-EX-MEM FLAG FOR KA10
NXMKI==1B29 ;NON-EX-MEM FLAG FOR KI10
NXMKL==1B25 ;NON-EX-MEM FLAG FOR KL10
TRPENB==1B22 ;SAYS PAGING TRAPS ENABLED
;ASSEMBLY CONSTANTS
ND PAGSIZ,1000 ;"BLOCK" SIZE OF DISK/MEMORY ALLOCATION
PG2WRD==^D36-^L<PAGSIZ-1> ;"LSH" FOR PAGE TO WORD ADDRESS
WRD2PG==-PG2WRD ;"LSH" FOR WORD TO PAGE ADDRESS
ND NBP,^D8 ;NUMBER OF BREAKPOINTS
ND SKPMAX,4 ;[211] MAX NUMBER OF SKP'S IN $X LOGIC
ND INDPTH,100 ;[224] MAX NESTING IN $E SEARCHES
ND LISCNT,1 ;[224] NUM OF LISTEN'S BETWEEN INCHRS'S
ND ADRNGE,1000 ;[234] ADDRESS RANGE FOR SYMBOL+VALUE TYPEOUT
;FOR FILE DDT ONLY
IFN FTFILE,<
CM==2 ;DEFINE SOFTWARE CHANS.
DP==3
CT.RES==5 ;PAGE "CACHE" SIZE - PAGES KEPT IN CORE
MX.SIZ==^D8192 ;MAX PAGES IN .EXE FILE
T30SYM==131 ;SPMON (10/30)
> ;END OF IFN FTFILE
;*** 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
; 19-32 NOT USED
OKAF== 1B32 ;[240] OK AMBIGUOUS (LOOK ROUTINE)
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
EXTERN .JBREL,.JBSA,.JBHRL,.JBSYM,.JBFF,.JBHSM,.JBHNM,.JBUSY,.JBDA
IFN FTDEC10,<
IFN FTEXEC!FTFILE,<
XJBSYM==36 ;EXEC MODE .JBSYM
XJBUSY==32 ;EXEC MODE .JBUSY
XZLOW==40
> ;END IFN FTEXEC!FTFILE
ZLOW==140
INTERNAL .JBDDT
.JBDDT=74
IFE FTFILE!FTVMX,<
LOC .JBDDT
XWD DDTEND,DDTX
>
RELOC 0
IFE FTVMX,<IFN ABSDDT&<XWD -1,0>,<LOC <ABSDDT>B53>>
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
> ;END OF IFE 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,IO.ERR
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 IFN FTDEC10
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. TRY FOR FULL-WORD MATCH ON BINARY TO SYMBOLIC CONVERSIONS.
; NECESSARY FOR CORRECT JSYS MNEMONIC PRINTOUT.
; 5. USE 1000 AS MAX SYMBOL OFFSET FOR RELATIVE LOCATION PRINTOUT.
ZLOW==20 ;LOWER LIMIT FOR $$Z
IFE FTEXEC,<
IFE FTMON,<
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
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,<INTERN DDT,DDTX>
> ;END IFN 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 FTDEC20,<SE0INT> ;[222]
IFE FTVMX,<MOVE W1,[ASCII /DDT/]> ;IDENTIFY USER MODE DDT
IFN FTVMX,<MOVE W1,[ASCII /VMDDT/]> ;IDENTIFY TOPS-10 VM DDT
IFN FTMON,<MOVE W1,[ASCII /MDDT/]> ;IDENTIFY TOPS-20 MDDT
IFN FTEXEC&<^-FTMON>,<
SKPUSR ;IF EXEC MODE, THEN
MOVE W1,[ASCII /EDDT/] ;IDENTIFY EXEC MODE DDT
> ;END OF IFN FTEXEC
PUSHJ P,TEXT2 ;TYPE MESSAGE SAYING WHICH DDT
> ;END IFE FTFILE
SUBTTL FILDDT -- COMMAND SCANNER
IFN FTFILE,<
DDT: CALLI
IFN FTYANK,<SETZM COMAND> ;[236] CLEAR $Y FLAG
SETZM EPTUPT ;[231] CLEAR $U POINTERS
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,IO.ERR ;CHECK FOR ERRORS
JRST [OUTSTR [ASCIZ \? I/O error\]
HALT .-3]
HLRZ T,WIND0 ;GET FIRST WORD
CAIE T,.SVDIR ;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]
"] > ;[221]
IFN FTFD20,<
OUTSTR [ASCIZ "[AC's copied from BUGACS to 0-17]
"] > ;[221]
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
LIS0C: TLZ F,(-1B17-ROF-STF) ;[242] CLEAR FLAGS EXCEPT ROF, STF
TRZ F,LF1+CF1+OKAF+ITF+Q2F ;[240] CLEAR FLAGS
LIS0E: TLZ F,(-1B17-ROF-STF-FAF-SAF) ;[242] 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
PUSHJ P,CLRCSH ;[245] CLEAR CACHE OF BOGUS SYMBOLS
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 ;SEE IF SYM EXISTS AS UNDEFINED
;[245] @ UND1 + 5L
JRST UND3 ;[245] SYMBOL DOES NOT EXIST
TLNE F,(ROF) ;[245] SYM EXISTS, LOCATION OPEN
CAILE W,CARR-DDTOFS ;[245] AND STILL BUILDING WORD FOR IT?
JRST UNDEF ;[245] NO - THEN "U" ERROR (E.G. "=" CMD)
CAIE W,ACCF-DDTOFS ;[246] EXPRESSION INVOLVING A COMMA?
SKIPE PRNC ;[246] OR INSIDE PARENTHESIS?
JRST UNDEF ;[246] YES - "U" ERROR
JRST UND4 ;[245] NO, CONTINUE
UND3: CAIN W,ASSEM-DDTOFS ;[245] DEFINING SYMBOL VIA "#" CMD
TLNN F,(ROF) ;[245] FOR A LOCATION THAT IS OPEN?
JRST UNDEF ;[245] NO - THEN "U" ERROR
SKIPE PRNC ;[246] YES - INSIDE PARENTHESIS?
JRST ERR ;[246] YES - ILLEGAL, "?" ERROR
UND4: 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 LIS2 ;[242] #
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
SETZM WAKALL ;[242] SET WAKEUP SET TO PUNCT AND CTRLS
JRST LIS0C ;[242] AND READ NEW EXPRESSION
INDIRE: HRLZI W,20 ;@
IORB W,WRD
TLO F,(QF)
JRST LIS2
ACCF: MOVE R,ESTUT ;[246] GET UNDEFINED PROCESSOR SO FAR
CAME R,@USYMP ;[246] ANY UNDEFINED'S CREATED YET?
JRST ERR ;[246] YES, ERROR
;[246] (CAN ONLY GET HERE ON "FOO#," ETC.)
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
IFN FTDEC10,<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
;[244] HRROI T,700000 ;3 RUBOUTS
;[244] 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 LIS0E ;[242]
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
JUMPL W,PTCH4 ;[243] FOUND A SYMBOL, USE IT
IFN FTEXEC,<SKPUSR ;[243] USER MODE?
JRST ERR> ;[243] EXEC MODE LOSES HERE
MOVEI R,.JBFF ;[243] NONE OF THE SYMBOLS EXIST, USE .JBFF
PUSHJ P,FETCH ;[243] GET CONTENTS OF .JBFF
JRST ERR ;[243] USER LOSES
JRST PTCH2 ;[243] FAKE PATCH SYMBOL FOUND
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
SETZM PTAFTR ;[233] ASSUME PATCH BEFORE
TLNE F,(CCF) ;SAVE BEFORE/AFTER FLAG
SETOM PTAFTR ;[233] 0 MEANS BEFORE, -1 MEANS AFTER
PUSHJ P,CRF ;[233] OUTPUT <CR><LF>
HRRZ T,PTLOC ;[233] START OF PATCHING AREA
PUSHJ P,LI1 ;[233] OPEN LOCATION AND TYPEOUT
SKIPL PTAFTR ;[233] PATCH BEFORE OR AFTER?
POPJ P, ;[233] BEFORE, DONE FOR NOW
HRRZ R,LLOCO ;[233] CURRENT OPEN LOCATION
MOVE T,PTWRD ;[233] ORIGINAL INSTRUCTION
PUSHJ P,DEPERR ;[233] PUT AS FIRST IN PATCH AREA
PUSHJ P,LI2 ;[233] NOW TYPE OUT SO USER CAN SEE
PJRST LI0 ;[233] AND OPEN/TYPE NEXT LOCATION
;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 PTAFTR ;[233] PATCH BEFORE?
JRST PTCHE1 ;NO
PUSHJ P,LI0 ;[233] OPEN AND TYPE NEXT LOCATION
HRRZ R,LLOCO ;[233] CURRENT OPEN LOCATION
MOVE T,PTWRD ;[233] USER ORIGINAL INSTRUCTION
PUSHJ P,DEPERR ;[233] PUT AT END OF PATCH CODE
PUSHJ P,LI2 ;[233] AND TYPE OUT FOR USER TO SEE
PTCHE1: PUSHJ P,LI0 ;[233] OPEN AND TYPE NEXT LOCATION
HRRZ R,LLOCO ;[233] CURRENT OPEN LOCATION
HRRZ T,PTLLC ;[233] ORIGINAL USER LOCATION
ADD T,[JUMPA 1,1] ;[233] NON-SKIP CONTINUE/RETURN
PUSHJ P,DEPERR ;[233] PUT IN PATCH AREA
PUSHJ P,LI2 ;[233] KEEP USER UPDATED
PUSHJ P,LI0 ;[233] ADVANCE TO NEXT LOCATION
HRRZ R,LLOCO ;[233] CURRENT OPEN LOCATION
HRRZ T,PTLLC ;[233] ORIGINAL USER LOCATION
ADD T,[JUMPA 2,2] ;[233] SKIP CONTINUE/RETURN INSTRUCTION
PUSHJ P,DEPERR ;[233] PUT IN PATCH AREA
PUSHJ P,LI2 ;[233] AND TELL USER
AOS T,LLOC ;GET NEXT FREE PATCH LOC
HLRZ R,PTLOC ;UPDATE WORD THAT PATLOC CAME FROM
CAIE R,.JBFF ;[243] PATLOC DEFAULT TO .JBFF?
JRST PTCHE3 ;[243] NO - NORMAL USER SYMBOL
PUSH P,T ;[243] YES, SAVE T
PUSHJ P,DMEMER ;[243] UPDATE C(.JBFF) ACCORDINGLY
MOVEI R,.JBSA ;[243] C(.JBFF) ALSO STORED IN LH(.JBSA)
PUSHJ P,FETCH ;[243] SO GET .JBSA
JRST ERR ;[243] BZZZT?
HRL T,(P) ;[243] NEW LH(.JBSA)
PUSHJ P,DMEMER ;[243] SET AND HOPE FOR BEST
POP P,T ;[243] RESTORE STACK
JRST PTCHE4 ;[243] AND FINISH OFF PATCH
PTCHE3: HLL T,0(R) ;[243] PRESERVE LH OF PATCH SYMBOL VALUE
PUSHJ P,DSYMER ;[220] DEPOSIT NEW SYMBOL VALUE
PTCHE4: PUSHJ P,CRF ;[243] TYPE <CR><LF>
HRRZ T,PTLLC ;[233] ORIGINAL USER LOCATION
PUSHJ P,LI1 ;[233] OPEN AND TYPE ORIGINAL LOCATION
HRRZ R,LLOCO ;[233] CURRENT OPEN LOCATION
MOVSI T,(JUMPA) ;[233] JUMP TO PATCH AREA INSTRUCTION
HRR T,PTLOC ;[233] ADDRESS OF START OF PATCH
PUSHJ P,DEPERR ;[233] PUT IN JUMP INSTRUCTION
PUSHJ P,LI2 ;[233] AND SHOW USER
SETZM PTLOC ;SAY NO PATCH IN PROGRESS
POPJ P, ;DONE
SUBTTL PAGE TABLE CONTROL ($U)
IFN FTDEC10,<
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 IFN FTDEC10
SUBTTL GO AND EXECUTE LOGIC
IFE FTFILE,<
CNTRLZ: IFN FTEXEC,<
SKPUSR ;SEE IF USER MODE
JRST ERR> ;NO--ERROR
IFN FTDEC10,<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
IFN FTDEC10,<
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
IFN FTDEC10,<
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
IFN FTDEC10,<
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: IFN FTDEC10,<
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 IFN FTDEC10
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
TLNE TT,(PM%WT+PM%CPY) ;[227] WRITE OR COPY-WRITE?
JRST DEP2 ;[227] YES, GO DEPOSIT
LDB T1,[POINT 9,R,26] ;[227] NO, GET PAGE NUMBER
HRLI T1,.FHSLF ;[227] IN MY FORK
PUSH P,R ;[227] SAVE R=T2 (DDT IS A CROCK!)
HLLZ T2,TT ;[227] OLD ACCESS BITS (T2=R)
TLO T2,(PM%CPY) ;[227] SET COPY-ON-WRITE
SPACS ;[227] CHANGE PAGE ACCESS
EXCH R,0(P) ;[227] SAVE T2, RESTORE R (!!)
DEP2: SETOM LASTPG ;WRITE MAY CHANGE ACCESS
MOVEM T,0(R) ;DO IT
SKIPE TT ;[227] OK IF PAGE DOESN'T EXIST
TLNE TT,(PM%WT+PM%CPY) ;[227] WAS PAGE WRITEABLE?
JRST CPOPJ1 ;[227] YES, RETURN
EXCH T2,0(P) ;[227] NO, RESTORE OLD PAGE PROPERTIES
TLZ T2,(PM%CPY) ;[227] WRITE-LOCK IT AGAIN
SPACS ;[227] TELL THE MONITOR
POP P,R ;[227] RESTORE R FOR CALLER
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,IO.ERR ;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: IFN FTDEC10,<
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 IFN FTDEC10
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,<
IFN FTDEC10,<
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,14 ;[226] 14 = .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 IFN FTDEC10
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,
SYN CPOPJ1,CHKHSM ;OH WELL
SYN CPOPJ1,CHKHSR ; . . .
> ;END IFN FTDEC20
> ;END IFE 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,
>
IFN FTDEC10,<
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,PG2WRD ;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,<
IFE FTFD20,<
;MAP AN ADDRESS
CVTADR: SKIPN EPTUPT ;$U GIVEN
JRST CPOPJ1 ;NO
HLRZ T,EPTUPT ;EXEC PAGING
JUMPE T,CVTAD2 ;NO
LDB T,[POINT 9,R,26];GET PAGE #
CAIGE T,340 ;IS THERE A MAP ENTRY?
JRST CPOPJ1 ;NO--LOOK IN PHYSICAL CORE
CAIL T,400 ;PER PROCESS
JRST CVTAD1 ;NO--JUST LIKE USER
PUSH P,R ;SAVE ARGUMENT
LSH T,-1 ;CONVERT TO 1/2 WORD
HRRZ R,EPTUPT ;GET ADDRESS OF UPT
ANDI R,17777 ;JUST PAGE #
LSH R,9 ;CONVERT TO WORD
ADDI R,400-<340/2>(T) ;FOR THIS PAGE
JRST CVTAD3 ;COMPUTE ADDRESS
CVTAD1: HLRZ T,EPTUPT ;GET EPT ADDRESS
SKIPA
CVTAD2: HRRZ T,EPTUPT ;GET UPT ADDRESS
ANDI T,17777 ;JUST PAGE #
PUSH P,R ;SAVE R
LSH T,9 ;CONVERT TO WORD
LSH R,-12 ;CONVERT TO 1/2 WORD IN MAP
ANDI R,377 ;MASK OUT JUNK
ADD R,T ;ADDRESS OF MAP ENTRY
CVTAD3: PUSHJ P,FETX ;FETCH PAGE TABLE ENTRY
MOVEI T,017000 ;ERROR
POP P,R ;RESTORE R
TRNN R,1000 ;ODD PAGE
HLRZ T,T ;NO--FLIP ENTRY
TRZN T,400000 ;VAILD ENTRY
POPJ P,0 ;NO--ERROR
ANDI T,17777 ;JUST PAGE #
LSH T,9 ;CONVERT TO PAGE #
ANDI R,000777 ;GET NEW ADDRESS
IOR R,T ; ..
JRST CPOPJ1 ;GIVE GOOD RETURN
> ;END 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,PG2WRD ;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,PG2WRD ;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 IFN FTFD20
> ;END IFN FTFILE
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,"#" ;[240] HASH MARK IN CASE AMBIGUOUS
TRZN F,OKAF ;[240] DO WE CARE ABOUT AMBIGUITY?
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 ;TYPE OUT AS CONSTANT
;FALL INTO PIN
;CONTINUED ON NEXT PAGE
;FALL HERE FROM PREVIOUS PAGE
;PRINT OUT IN INSTRUCTION FORMAT (QUICK METHOD)
IFE FTOPX,< ;[240] THE OLD (FASTER) WAY
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
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
;[240] FALL INTO PIN2
> ;[240] END OF IFE FTOPX CONDITIONAL
;[240] NOTE: FALL INTO PIN2 AFTER FOLLOWING PAGES
;FALL HERE FROM PREVIOUS PAGE
;PRINT OUT IN INSTRUCTION FORMAT (EXTENDED)
IFN FTOPX,< ;[240] EXTENSIVE OPCODE DECODING
PIN: TLC T,700000 ;PRINT INSTRUCTION
TLCN T,700000
JRST INOUT ;IN-OUT INSTRUCTION OR NEG NUM
TLNN T,777000 ;[240] GOT A VALID OPCODE?
JRST HLFW ;[240] NO WAY! TYPE OUT XWD FORMAT
TRO F,OKAF ;[240] DON'T TYPE "#" AFTER OPERATOR
PUSHJ P,LOOK ;[240] DO 36-BIT OPERATOR SEARCH
JRST PIN0B ;[240] NOPE
JRST PIN0B ;[240] NOPE
POPJ P, ;[240] EXACT MATCH, ALL DONE
;[240] NOW TRY FOR OPERATORS OF FORM OPCODE + E-FIELD
PIN0B: MOVE T,LWT ;[240] FRESH COPY OF WORD
TLZ T,(17,) ;[240] MASK OUT AC FIELD
PUSHJ P,LOOK ;[240] AND LOOK FOR SYMBOLIC OPERATOR
JRST PIN0D ;[240] NOPE
JRST PIN0D ;[240] NOPE
PUSHJ P,TSPC ;[240] MATCH!!! SPACE OVER
LDB T,[POINT 4,LWT,12] ;[240] GET AC FIELD
JUMPE T,CPOPJ ;[240] AC FIELD NULL, ALL DONE
PUSHJ P,PAD ;[240] TYPE OUT SYMBOLIC AC FIELD
MOVEI T,"," ;[240] CAP OFF AC FIELD WITH COMMA
PJRST TOUT ;[240] AND TYPEOUT IS COMPLETE
;[240] NOW TRY FOR OPCODE AND AC FIELD
PIN0D: HLLZ T,LWT ;[240] FRESH COPY OF WORD
TLZ T,37 ;[240] REDUCE TO OPCODE AND AC FIELD
TLNN T,(17,) ;[240] NON-ZERO AC FIELD?
JRST PIN0F ;[240] ZERO, I.E, JUST AN OPCODE
PUSHJ P,LOOK ;[240] SEE IF ANY SUCH ANIMAL
JRST PIN0F ;[240] NOPE
JRST PIN0F ;[240] NOPE
TRO F,NAF ;[240] YEP, SO ALLOW NEGATIVE ADDRESS
PUSHJ P,TSPC ;[240] SPACE OVER ONE
JRST PI4 ;[240] AND GO TYPE OUT I, X, AND Y
;[240] LAST TRY FOR A USER SYMBOL - OPCODE FIELD ONLY
PIN0F: HLLZ T,LWT ;[240] FRESH COPY OF WORD
TLZ T,777 ;[240] OPCODE ONLY
IFN FTDEC10,< ;[240] A QUICK KROCK FOR NEATNESS
CAME T,[CALLI 0,0] ;[240] A CALLI?
CAMN T,[TTCALL 0,0] ;[240] OR A TTCALL?
JRST PIN0H ;[240] YES, DON'T TYPE "RESET 200064" ETC.
CAMN T,[MTAPE 0,0] ;[240] AN MTAPE?
JRST PIN0H ;[240] YES, DON'T TYPE "MTWAT. 37" ETC.
> ;[240] END OF IFN FTDEC10
PUSHJ P,LOOK ;[240] SEE IF USER SYMBOL
JRST PIN0H ;[240] NOPE
JRST PIN0H ;[240] NOPE
JRST PIN2 ;[240] GOT IT, TYPE AC, I, X, AND Y
;[240] LAST DITCH - LOOK AT NORMAL HARDWARE OPCODES
PIN0H: TRZ F,OKAF ;[240] CLEAR CROCK FLAG
HLLZ T,LWT ;[240] FRESH COPY OF WORD
TLZ T,777 ;[240] OPCODE ONLY
PUSHJ P,OPTYPE ;[240] TRY INTERNAL TABLES
TRNN F,ITF ;[240] DID WE WIN?
PJRST HLFW ;[240] COMPLETELY UNKNOWN OPERATOR
;[240] FALL INTO PIN2
> ;[240] END OF IFN FTOPX CONDITIONAL
;[240] FALL INTO PIN2 ON NEXT PAGE
;[240] COMMON INSTRUCTION-FORMAT TYPEOUT CODE
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
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] ;CONTINUE WITH INDEX CHECK
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: TRZ F,NAF ;[241] CLEAR STICKY BIT FROM $X LOGIC
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
CAMGE T,SYMOFS ;[234] ADR WITHIN SYMBOL + OFFSET RANGE?
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
IFN FTOPX,< ;[240] LOOK FOR USER OPERATORS
AND T,[777740,,0] ;[240] OPERATOR & DEVICE CODE
TRO F,OKAF ;[240] NO "#" AFTER OPERATOR SYMBOL
PUSHJ P,LOOK ;[240] LOOK FOR USER-DEFINED OPERATOR
JRST INOUT1 ;[240] NOPE
JRST INOUT1 ;[240] NOPE
TRZ F,OKAF ;[240] FOUND ONE, CLEAR KROCK FLAG
PUSHJ P,TSPC ;[240] SPACE OVER FROM OPERATOR SYMBOL
JRST PI4 ;[240] GO TYPE OUT I, X, AND Y FIELDS
INOUT1: TRZ F,OKAF ;[240] CLEAR KROCK FLAG
MOVE T,LWT ;[240] RESTORE T
> ;[240] END OF IFN FTOPX
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
SUBTTL MASK COMMAND HANDLING
MASK: TLNE F,(QF)
JRST MASK1
IFE FTFILE,<
TRZN F,Q2F ;[234] SECOND ARG TYPED?
TDZA TT1,TT1 ;[234] NO - DEFAULT TO SEARCH MASK
SKIPL TT1,WRD2 ;[234] YES - PICK UP MASK NUMBER
CAIL TT1,MSKMAX ;[234] WITHIN LEGAL LIMITS?
JRST ERR ;[234] NO - COMPLAIN AT USER
MOVEI T,@MSKADR(TT1) ;[234] YES - GET RELEVANT MASK ADDRESS
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
Z SYMOFS ;[234] SYMBOL + OFFSET RANGE "MASK"
Z BYTMSK ;[235] BYTE TYPEOUT MASK
MSKMAX==.-MSKADR ;[210] MAX MASK "FUNCTION"
SUBTTL SEARCH LOGIC
EFFEC: TLO F,(LTF)
TLZA T,-1 ;[224] ONLY LH (ADDRESS) VALID
NWORD: MOVEI R,(JUMPE-JUMPN) ;[224] 'NOT' SEARCH, ANY BITS DIFFERENT
WORD: ADDI R,(JUMPN T,) ;[224] WORD SEARCH, ALL BITS THE SAME
HRLM R,SEARXJ ;[224] SET MODE "FLAG" (XCT'ED AT SEAR2)
TLZN F,(QF) ;[224] QUANTITY TO SEARCH FOR TYPED?
JRST ERR
SETCAM T,WRD ;SAVE SO AS TO NOT FIND IN SEARCH
MOVSI T,FRASE-DEN-1 ;PREVENT TYPE OUT OF DDT PARTS
SETCMM FRASE(T)
AOBJN T,.-1
MOVE T,ULIMIT
TLNE F,(SAF)
TLO F,(QF) ;SIMULATE A $Q TYPED
PUSHJ P,SETUP
PUSHJ P,CRF
SEAR1: PUSHJ P,FETCH
JRST [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
SEAR2: XCT SEARXJ ;[224] (JUMPE T, OR JUMPN T,)
;[224] TO SEAR2A IF NOT MATCH
MOVE R,DEFV ;[224] MATCH FOUND
PUSHJ P,FETCH ;GET REAL CONTENTS AGAIN
JRST ERR ;CAN'T HAPPEN
TLZ F,(STF) ;GET RID OF SUPPRESS TYPEOUT MODE
MOVE T,DEFV ;GET MATCHED ADDRESS AGAIN
PUSHJ P,PSHLLC ;PUSH OLD LOCATION COUNTER
PUSHJ P,LI1 ;CALL REGISTER EXAMINATION LOGIC TO TYPE OUT
PUSHJ P,CRF
SETCMM LWT
SETCMM TEM
AOS R,DEFV ;[224] GET NEXT ADDRESS
JRST SEAR2B ;[224] AND ALWAYS DO A LISTEN
SEAR2A: AOS R,DEFV ;GET NEXT LOCATION
TRNN R,777 ;CHECK LISTEN ONLY ONCE PER PAGE
SEAR2B: PUSHJ P,LISTEN ;ANYTHING TYPED?
CAMLE R,ULIMIT ;OR END OF SEARCH?
JRST SEARFN ;YES
JRST SEAR1 ;NO, LOOK SOME MORE
SEARFN: SETCMM LWT ;COMPLEMENT BITS BACK AND STOP SEARCH
JRST DD1
EFFEC0: MOVEI W,INDPTH ;[224] MAX NESTING LEVEL OF INDIRECTION
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 SEAR2A ;[224] MISSING WORD, JUST CONT SEARCH
JRST EFFEC1
EFFEC3: EQV T,WRD
ANDI T,777777
JRST SEAR2 ;[224] GO SEE IF A MATCH FOUND
SETUP: TLNN F,(QF) ;QUANTITY TYPED?
MOVEI T,777777 ;[224] DEFAULT UPPER LIMIT
HRRZM T,ULIMIT ;SAVE LAST ADDRESS OF SEARCH
HRRZS R,DEFV ;GET 1ST ADDRESS
TLNN F,(FAF) ;WAS A 1ST ADR SPECIFIED?
SETZB R,DEFV ;NO, MAKE IT ZERO
CAMLE R,ULIMIT ;LIMITS IN A REASONABLE ORDER?
JRST ERR ;NO
POPJ P, ;YES, RETURN
ZERO: TLNN F,(CCF)
JRST ERR
PUSHJ P,SETUP
HRRZ S,@SYMP ;GET 1ST ADR OF SYMBOL TABLE
HLRE W1,@SYMP ;GET LENGTH OF SYM TABLE
SUB W1,S ;GET NEG OF LAST ADR
MOVNS W1 ;GET POS LAST ADR
MOVEI T,0 ;0 TO STORE IN MEMORY
ZERO1: TRNN R,777760
JRST ZEROR ;OK TO ZERO AC'S
IFN FTDEC10,<
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
IFN FTDEC10,<
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"
CAILE T,"9" ;[225] RADIX-DIGIT .GT. 9?
ADDI T,"A"-"9"-1 ;[225] YES, SHIFT TO LETTERS
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: IFN FTDEC10,<
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
SUBTTL BYTE COMMAND AND TYPEOUT ROUTINES
;[235] THIS ENTIRE PAGE (BITO & BITT ROUTINES) IS EDIT 235
BITO: TRZN F,Q2F ;DOES <N> EXIST FOR $<N>O?
JRST BITO5 ;NO, DEFAULT TO CURRENT MASK
BITO1: SETZB W2,SVBTS ;MAKE ROOM FOR A NEW MASK
MOVEI W1,1 ;PROTOTYPE BIT
MOVN T,WRD2 ;FOR SHIFTING THE PROTOTYPE BIT
BITO2: LSHC W1,(T) ;POSITION TO A BYTE BOUNDRY
IORM W2,SVBTS ;MARK NEXT BYTE BOUNDRY
JUMPN W2,BITO2 ;LOOP FOR ALL BYTES
BITO5: SKIPN OLDAR ;GOT A SAVED AR ALREADY?
MOVEM AR,OLDAR ;NO, THEN SAVE THE CURRENT ONE
MOVEI AR,TOC ;SET OCTAL TYPEOUT BY DEFAULT
MOVEI SCH,BITT ;AND BYTE TYPEOUT
PJRST BASE1O ;HANDLE $$ IF NEED BE . . .
;HERE FOR ACTUAL BYTE TYPEOUT
BITT: PUSH P,LWT ;SAVE LAST WORD TYPED . . .
SKIPN T,SVBTS ;GET CURRENTLY PREVAILING $O MASK
MOVE T,BYTMSK ;BLANK, USE $3M MASK INSTEAD
IORI T,1B35 ;BIT 35 ALWAYS MARKS END OF A BYTE
PUSH P,T ;SET WORKING COPY OF MASK
PUSH P,LWT ;WORKING COPY OF WORD TO BE TYPED
JRST BITT4 ;ENTER LOOP
BITT2: MOVEI T,"," ;SEPERATE BYTES WITH A COMMA
PUSHJ P,TOUT ;TYPE IT OUT
BITT4: POP P,T ;[REMNANTS OF] WORD TO BE TYPED
POP P,W1 ;[REMNANTS OF] BYTE MASK
JFFO W1,.+3 ;GET NEXT COUNT OF BITS
POP P,LWT ;DONE, RESTORE LWT FOR OTHERS
POPJ P, ;RETURN
LSH W1,1(W2) ;UPDATE MASK
PUSH P,W1 ;SAVE AWAY FOR NEXT ROUND
LSHC T,-^D36 + 1(W2) ;GET NEXT BYTE TO BE TYPED
PUSH P,W1 ;SAVE REMAINING BYTES FOR NEXT ROUND
CAIN AR,TOC ;NUMERIC OUTPUT?
PUSHJ P,TOCA ;YES, OUTPUT ACCORDINGLY
CAIN AR,PADSO ;SYMBOLIC OUTPUT?
PUSHJ P,PIN ;YES, OUTPUT ACCORDINGLY
SKIPE -1(P) ;MORE BYTES COMING UP?
JRST BITT2 ;YES, TYPE A COMMA
JRST BITT4 ;NO, CLEAN UP STACK AND LEAVE
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
>
IFN FTDEC10!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
>
XLISTN: SKPNKL ;[230] "LISTEN" ENTRY POINT
JRST KLXLIS ;DO KL10 TTY INPUT
CONSO TTY,40 ;DO KA OR KI TTY INPUT
POPJ P, ;NO CHARACTER
DATAI TTY,T ;READ IN PHYSICAL CHARACTER
XLIST1: ANDI T,177 ;STRIP OFF GARBAGE
JRST CPOPJ1 ;AND RETURN CHARACTER IN AC T
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,PG2WRD ;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 ;REDUCE TO PAGE NUMBER
CONSO PAG,TRPENB ;[222] PAGING ON NOW?
JRST LTTYR0 ;[222] NO, EBR IS BOTH PHYS AND VIRT
SETZ W1, ;[222] YES, MUST SCAN EXEC VIRT ADR SPACE
LSH T,PG2WRD ;[222] MAKE EBR WORD ADDRESS
LTTYR5: MAP W2,0(W1) ;[222] GET PHYSICAL ADDRESS
TLNN W2,(1B2) ;[222] ACCESSIBLE?
JRST LTTYR6 ;[222] NO, SKIP THIS PAGE
TLZ W2,777740 ;[222] YES, MAKE PHYSICAL ADDRESS ONLY
CAMN W2,T ;[222] IS THIS ONE THE EBR?
JRST [MOVE T,W1 ;[222] YES, GET VIRTUAL ADDRESS
LSH T,WRD2PG ;[222] REDUCE TO PAGE NUMBER
JRST LTTYR0] ;[222] AND DONE
LTTYR6: ADDI W1,1000 ;[222] NEXT PAGE
CAIG W1,777777 ;[222] SCANNED ENTIRE SECTION?
JRST LTTYR5 ;[222] NO, LOOK AT SOME MORE PAGES
HALT . ;[222] YES - EPT NOT IN EXEC VIRT ADR
LTTYR0: 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 ;CONO TO SET PI0
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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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,PG2WRD ;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,PG2WRD ;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,
IFN FTDEC10,<
OPDEF TTCALL [51B8]
TOUT0:
IFN FTEXEC,< SKPUSR
JRST XTOUT >
IFN FTFILE&FTYANK,< ;[236]
SKIPE COMAND ;IS THERE A COMMAND FILE?
JRST PUTCHR> ;YES
TTCALL 1,T ;OUTPUT A CHARACTER
POPJ P,
LISTEN:
IFN FTEXEC,<
SKPUSR ;IN EXEC MODE?
JRST XLISTN ;[230] YES, USE SPECIAL EXEC CODE
> ;END OF IFN FTEXEC
;[230] IFE FTFILE,<
;[230] IFN FTYANK,<
;[230] SKIPE COMAND
;[230] JRST PTRIN>>
;[230] IFN FTFILE,< ;FILDDT?
;[230] SKIPE COMAND ;STILL READING COMAND FILE?
;[230] POPJ P,0 ; IF YES, DO NOT LOOK FOR INPUT
;[230] ; 1. SPEED UP FILDDT AND
;[230] ; 2. ALLOW USER TO TYPE AHEAD
;[230] ; (ONE CONTROL C)
;[230] >
IFG LISCNT-1,< ;[224] "CACHING" LISTEN'S?
SOSLE LCNT ;TIME TO DO TTCALL
POPJ P,0 ;NO--RETURN
MOVEI T,LISCNT ;[224] YES--RESET COUNT
MOVEM T,LCNT ; ..
> ;[224] END OF IFG LISCNT-1
TTCALL 2,T ;GET NEXT CHAR, NO IO WAIT
POPJ P, ;NO CHARACTER EXISTED, RETURN
JRST CPOPJ1 ;CHARACTER WAS THERE, SKIP RETURN
IFN FTEXEC,<
TTYRET: SKPUSR
JRST XTTYRET
POPJ P, >
IFE FTEXEC,<TTYRET==CPOPJ>
TTYCLR:
IFN FTEXEC,< SKPEXC >
TTCALL 14, ;CLEAR ^O, SKIP ON INPUT CHARS
POPJ P, ;NO INPUT CHARS, OR EXEC MODE
TTCALL 11, ;FLUSH ALL
PUSHJ P,LISTEN
JFCL
POPJ P, ;WAITING INPUT CHARACTERS
IFN FTEXEC,<
TTYLEV: SKPUSR
JRST XTTYLEV
POPJ P, >
IFE FTEXEC,<TTYLEV==CPOPJ>
> ;END IFN FTDEC10
TEXIN: AOSA TEXINF ;NOTE TEXT INPUT
TIN: SETZM TEXINF ;NOTE NOT TEXT INPUT
IFN FTDEC20&FTEXEC&<^-FTEDIT>,<
SKPUSR ;EXEC MODE?
JRST XTIN> ;YES, SIMPLE INPUT
TIN1: SOSGE CHINC ;CHARACTER LEFT IN LINE BUFFER?
JRST CHIN1 ;NO, GO REFILL BUFFER
ILDB T,CHINP ;GET CHARACTER
POPJ P,
;REFILL LINE BUFFER WITH EDITING
IFN FTDEC20,<
CHIN1:
IFN FTEXEC&FTEDIT,<
SKPUSR ;EXEC MODE?
JRST XCHIN1> ;YES, USE SIMULATION ROUTINES
SKIPE T1,CHINP ;REINIT LINE?
JRST CHIN2 ;NO
MOVEI T1,NLINBF*5 ;YES, SETUP MAX CHAR COUNT
MOVEM T1,LINSPC
MOVE T1,LINBP ;SETUP POINTER
MOVEM T1,CHINP
CHIN2: MOVEM T1,TEXTIB+.RDBKL ;SET BACKUP LIMIT
SKIPG LINSPC ;ROOM LEFT IN BUFFER?
JRST ERR ;NO, TOO MUCH TYPIN
SETZ T1,
SKIPE WAKALL ;WAKEUP ON EVERYTHING?
MOVEI T1,ONES4 ;YES, USE WAKEUP TABLE
MOVEM T1,ETXTB
PUSH P,LINSPC ;SAVE CURRENT SPACE
PUSH P,CHINP ;AND POINTER
SKIPN TEXINF ;TEXT INPUT?
PUSHJ P,TTYTOF ;NO, SUPPRESS TAB ECHO
MOVEI T1,TEXTIB ;POINT TO ARG BLOCK
TEXTI ;INPUT TO NEXT BREAK CHAR
JRST ERR ;BAD ARGS (IMPOSSIBLE)
PUSHJ P,TTYTON ;RESTORE NORMAL TAB ECHO
POP P,CHINP ;RESTORE POINTER TO CHARS JUST TYPED
MOVE T1,TEXTIB+.RDFLG ;GET FLAGS
TXNE T1,RD%BFE+RD%BLR ;DELETIONS?
JRST CHIN3 ;YES
POP P,T1 ;RECOVER OLD SPACE COUNT
SUB T1,LINSPC ;COMPUTE NUMBER CHARS JUST TYPED
MOVEM T1,CHINC ;SETUP COUNT
JRST TIN1 ;GO RETURN NEXT CHAR
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE
;LINE MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN
;DELETED.
CHIN3: MOVEI T1,NLINBF*5 ;COMPUTE NUMBER CHARS NOW IN LINE
SUB T1,LINSPC
JUMPE T1,WRONG ;JUMP IF WHOLE LINE DELETED
MOVEM T1,CHINC ;LINE NOT NULL, SETUP CHAR COUNT
MOVE T1,LINBP ;REINIT POINTER
MOVEM T1,CHINP
JRST DD2 ;CLEAR WORLD AND REDO LINE
> ;END IFN FTDEC20
IFN FTDEC10!<FTEXEC&FTEDIT>,<
IFNDEF T1,<
T1==A
PURGT1==-1
>
IFN FTDEC10,<
CHIN1:>
XCHIN1: SKIPE T1,CHINP ;REINIT LINE?
JRST XCHIN2 ;NO
MOVEI T1,NLINBF*5 ;YES, SETUP MAX CHAR COUNT
MOVEM T1,LINSPC
MOVE T1,LINBP ;SETUP POINTER
MOVEM T1,CHINP
XCHIN2: MOVEM T1,LINDB ;SET BEGINNING OF DELETE BUFFER
SKIPG LINSPC ;ROOM LEFT IN BUFFER?
JRST ERR ;NO, TOO MUCH TYPIN
MOVEI T1,LINBP-TEXTIB ;SIZE OF BLOCK
SKIPE WAKALL ;WAKEUP ON EVERYTHING?
MOVEI T1,ETXTB-TEXTIB ;YES, INCLUDE WAKEUP TABLE
MOVEM T1,TEXTIB ;SET SIZE IN BLOCK
PUSH P,LINSPC ;SAVE CURRENT SPACE
PUSH P,CHINP ;AND POINTER
MOVEI T1,TEXTIB ;POINT TO ARG BLOCK
PUSHJ P,TXTI
JRST ERR ;BAD ARGS (IMPOSSIBLE)
POP P,CHINP ;RESTORE POINTER TO CHARS JUST TYPED
POP P,T1 ;RECOVER OLD SPACE COUNT
IFN FTYANK,<
AOSN PTDFLG ;EOF ON COMMAND FILE
JRST [SETZM CHINC
SETZM CHINP
JRST DD2] ;YES--GET BACK TO TOP LEVEL
> ;END FTYANK
SKIPN 0(P) ;REPROCESS NEEDED?
JRST [MOVEI T1,NLINBF*5
SUB T1,LINSPC ;YES, COMPUTE NUMBER CHARS IN LINE
JUMPE T1,WRONG ;JUMP IF WHOLE LINE DELETED
MOVEM T1,CHINC ;LINE NOT NULL, SETUP CHAR COUNT
MOVE T1,LINBP ;REINIT POINTER
MOVEM T1,CHINP
JRST DD2] ;CLEAR WORLD AND REDO LINE
SUB T1,LINSPC ;COMPUTE NUMBER CHARS JUST TYPED
JUMPG T1,[MOVEM T1,CHINC ;SETUP COUNT
JRST TIN1] ;GO RETURN NEXT CHAR
;CONTINUED ON NEXT PAGE
;USER HAS DELETED BACK INTO TEXT ALREADY PROCESSED, THEREFORE LINE
;MUST BE REPROCESSED FROM BEGINNING. POSSIBLY ALL TEXT HAS BEEN
;DELETED.
PUSHJ P,RDBKIN
SETZM 0(P) ;REQUEST REPROCESS OF LINE
MOVE T1,LINBP ;RESET DELETE BOUNDARY TO BEGINNING OF LINE
JRST XCHIN2
IFDEF PURGT1,<IFL PURGT1,< PURGE PURGT1,T1>>
> ;END IFN FTDEC10...
ONES4: OCT -1,-1,-1,-1 ;WAKEUP MASK
IFN FTDEC20,<
TOUT0: IFN FTEXEC,<
SKPUSR
JRST XTOUT>
EXCH T1,T
PBOUT ;CHAR TO TTY FROM T1
EXCH T1,T
POPJ P,
LISTEN: IFN FTEXEC,<
SKPUSR
JRST XLISTE>
EXCH T1,T
MOVEI T1,.PRIIN ;PRIMARY INPUT (TTY)
SIBE ;INPUT BUFFER EMPTY?
AOS 0(P) ;NO, GIVE SKIP RETURN
EXCH T1,T
POPJ P, ;RETURN NOSKIP
;HANDLE TTY WHEN RETURNING TO DDT FROM USER CONTEXT
TTYRET: IFN FTEXEC,<
SKPUSR
JRST XTTYRET>
SKIPE SAVTTY ;ALREADY HAVE STATE?
JRST TTYR1 ;YES
MOVEI T1,.PRIIN
RFMOD ;GET MODES
MOVEM T2,SAVTTY
RFCOC ;GET CC MODES
MOVEM T2,SAVTT2
MOVEM T3,SAVTT3
TTYR1: MOVEI T1,.PRIIN
RFMOD
TXZ T2,TT%WAK+TT%DAM
TXO T2,<TT%WKF+TT%WKN+TT%WKP+TT%ECO+FLD(.TTASC,TT%DAM)>
SFMOD
MOVE T2,TTYCC2
MOVE T3,TTYCC3
SFCOC ;SETUP PROPER DDT MODES
MOVEI T1,.FHSLF
IFN FTEXEC,<
SKPEXC>
DIR
POPJ P,
TTYLEV: IFN FTEXEC,<
SKPUSR
JRST XTTYLE>
MOVEI T1,.PRIIN
MOVE T2,SAVTTY
SFMOD ;RESTORE MODES
MOVE T2,SAVTT2
MOVE T3,SAVTT3
SFCOC ;RESTORE CC MODES
MOVEI T1,.FHSLF
SKIPGE SAVSTS ;PSI SYSTEM ON FOR USER?
EIR ;YES
SETZM SAVTTY ;NOTE USER MODES IN EFFECT
POPJ P,
TTYCLR: MOVEI T1,.PRIIN
IFN FTEXEC,<
SKPEXC> ;SKIP CFIBF IF EXEC
CFIBF
PUSHJ P,LISTEN
JFCL
POPJ P,0
;ROUTINES TO TURN TAB ECHO ON/OFF
TTYTOF: MOVE T1,TTYCC2 ;NORMAL MODE WORD
TRZA T1,3B19 ;TURN TAB OFF
TTYTON: MOVE T1,TTYCC2
PUSH P,T2 ;PRESERVE REGS
PUSH P,T3
MOVEM T1,T2
MOVEI T1,.PRIIN
MOVE T3,TTYCC3
SFCOC ;SET CONTROL CHAR MODES
POP P,T3
POP P,T2
POPJ P,
TTYCC2: BYTE (2) 0,1,1,1,1,1,1,2,1,2,3,1,1,2,1,1,1,1
TTYCC3: BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,1
> ;END IFN FTDEC20
IFN FTDEC10,<
SUBTTL DDT COMMAND FILE LOGIC
;START PAPER TAPE INPUT
IFN FTYANK,<
TAPIN:
IFN FTEXEC,< SKPEXC ;SKIP IF EXEC MODE
JRST UTAPIN ;USER MODE
CONSO PTR,400 ;TAPE IN READER?
JRST ERR ;NO - ERROR
SETZM EPTPTR ;YES. INDICATE START READING IN
SETOM COMAND ;SHOW THERE IS A COMMAND FILE
JRST RET
> ;END IFN EEDT&1
UTAPIN:
HIADDR=W ; NEW JOB BOUNDARY(.JBREL)
CM=17 ;CHAN FOR COMMANDS
INIT CM,0 ; ASCII MODE
SIXBIT /DSK/ ;ALWAYS ON DEVICE DSK
XWD 0,CBUF ; ESTABLISH RING HEADER
JRST ERR ; NOT ASSIGNED, ERROR
TLNE F,(QF) ;NAME GIVEN?
SKIPA T,SYL ;YES. USE IT
IFE FTFILE,<
MOVE T,[SIXBIT /PATCH/] ;NO, DEFAULT=PATCH
>
IFN FTFILE,<
MOVE T,[SIXBIT /FILDDT/]
>
MOVEM T,COMNDS ;SAVE NAME IN LOOKUP BLOCK
MOVSI T,'DDT' ;EXTENSION
MOVEM T,COMNDS+1 ; ..
SETZM COMNDS+3 ;CLEAR PPN
LOOKUP CM,COMNDS ; LOOKUP CMD FILE(IN CASE DIR DEV)
JRST ERR ; NOT FOUND
MOVE T,.JBFF ; LOAD .JBFF
MOVEM T,SVJBFF ; AND SAVE IT
IFE FTFILE,<
HRRZ T,.JBREL ; LOAD .JBREL
MOVEI HIADDR,2000(T) ; NEEDED, NOW PRPARE NEW .JBREL
IORI HIADDR,1777 ; NEW .JBREL TO ASK FOR
HRRZ TT,@SYMP ; BOTTM OF SYM TBL
HLRE TT1,@SYMP ; NEG LENGTH
SUB TT,TT1 ; TOP OF SYMBOL TBL
MOVEM TT,.JBFF ; ASSUME THIS NEW .JBFF AND SAVE IT
SUB T,TT ; COMPUTE WDS BETWEEN SYM TOP AND .JBREL
CAILE T,207 ; ENUFF FOR DSK BUFF+FUDGE FACTOR?
JRST HAVECM ; YES
CALLI HIADDR,11 ; NO, GET ANOTHER 1K
JRST ERR ; NOT AVIL, TREAT AS NO CMD FILE
> ;END FTFILE
HAVECM: SETOM COMAND ; FLAG CMD FILE FOUND
SETZM CHINP
SETZM CHINC
INBUF CM,1 ; 1 BUFFER ONLY
IFN FTFILE,<
INIT DP,1 ;ALSO DO LISTING FILE
SIXBIT /LPT/
XWD LBUF,0
JRST [SETZM COMAND
JRST ERR]
MOVSI TT,'LST'
MOVEM TT,COMNDS+1
SETZM COMNDS+3
SETZM COMNDS+2
ENTER DP,COMNDS
JRST [SETZM COMAND
JRST ERR]
OUTBUF DP,2
>
JRST RET
> ;END IFN FTYANK
IFN FTYANK,<
IFN FTEXEC,<
XPTRIN: PUSHJ P,PTRXNX ;GET NEXT CHAR FROM PTR
JRST PTRDON ;THROUGH
JRST PTRCHR ;PROCESS THE CHAR.
>
PTRIN: PUSHJ P,PTRNX ;GET NEXT CHAR
JRST PTRDON ;EOF ON COMMAND FILE
PTRCHR: CAIE T,177 ;RUBOUT?
SKIPN TT2,T ;NULL?
JRST PTRNXT ;IGNORE IT
IFN FTEXEC,<
SKPEXC ;EXEC MODE?
JRST PTRCH2
CAIE T,15 ;YES. CR?
JRST CPOPJ1 ;NO. ECHO OF CHAR WILL HAPPEN LATER
PUSHJ P,PTRXNX ;READ (AND IGNORE) NEXT CHAR
JFCL ; WHICH OUGHT TO BE A LINE-FEED
MOVEI T,15 ;RETURN CR AS CHAR
JRST CPOPJ1
PTRCH2: >;END IFN FTEXEC
CAIE T,33 ;ESCAPE?
CAIL T,175 ;ALT-MODE?
MOVEI T,"$" ;YES, ECHO "$"
PUSHJ P,ECHO ;ECHO CHAR
MOVE T,TT2 ;RESTORE T
JRST CPOPJ1 ;SKIP-RETURN WITH DATA
PTRNXT:
IFN FTEXEC,< SKPUSR
JRST XPTRIN>
JRST PTRIN
;THROUGH WITH COMMAND FILE
PTRDON: SETZM COMAND
PUSH P,CHINC
PUSH P,CHINP
PUSHJ P,CRF ;2 CR-LFS
PUSHJ P,CRF
POP P,CHINP
POP P,CHINC
SETOM PTDFLG
POPJ P, ;NON-SKIP RETURN
;COMMAND FILE IO
PTRNX: SOSLE CBUF+2 ;DATA LEFT?
JRST PTRNX1 ;YES
INPUT CM, ;GET NEXT BUF
STATZ CM,740000 ;ERROR?
HALT .+1 ;TOO BAD
STATZ CM,20000 ;EOF?
JRST PTRNX2 ;YES
PTRNX1: ILDB T,CBUF+1
JRST CPOPJ1 ;SKIP-RETURN WITH DATA
PTRNX2: RELEASE CM, ;EOF - DONE
IFN FTFILE,<
CLOSE DP,
RELEAS DP,
>
MOVE TT,SVJBFF
MOVEM TT,.JBFF ;RESET .JBFF
POPJ P, ;NON-SKIP MEANS DONE WITH COMMAND FILE
IFN FTEXEC,<
PTRXNX: SKIPE TT2,EPTPTR ;DATA IN PTR BUF?
JRST PTRXN3 ;YES
MOVE TT2,[POINT 7,EPTRBF] ;NO SET UP TO STORE IN PTR BUFFER
SETZM EPTRBF ;SWITCH FOR END OF TAPE TEST
CONO PTR,20 ;START PTR GOING
PTRXN1: CONSO PTR,400 ;EOT?
JRST PTRXN4 ;YES
CONSO PTR,10 ;DATA?
JRST PTRXN1 ;WAIT SOME MORE
DATAI PTR,T ;READ A CHAR
JUMPE T,PTRXN1 ;IGNORE NULLS
PTRXN2: IDPB T,TT2 ;SAVE IN DATA BUFFER
CAIE T,12 ;LF
CAMN TT2,EPTRND ; OR BUFFER FULL?
SKIPA TT2,[POINT 7,EPTRBF] ;YES. START TAKING CHARS OUT OF BUF
JRST PTRXN1 ;NO - READ ANOTHER
CONO PTR,0 ;SHUT OFF PTR BEFORE READING NEXT CHAR
PTRXN3: ILDB T,TT2 ;GET A CHAR
CAIE T,12 ;LF
CAMN TT2,EPTRND ; OR END OF BUFFER?
SETZ TT2, ;YES, START PTR FOR NEXT CHAR
MOVEM TT2,EPTPTR ;SAVE PNTR FOR NEXT CHAR
JRST CPOPJ1 ;HAVE A CHAR RETURN
;EOT
PTRXN4: SKIPN EPTRBF ;ANY DATA?
POPJ P, ;NO - DONE RETURN
SETZ T, ;YES - FILL REST OF BUFFER WITH 0'S
JRST PTRXN2
EPTPTR: 0
EPTRBF: BLOCK 5 ;BUFFER SO PTR WONT CHATTER
EPTRND: POINT 7,EPTRBF+4,34 ;PNTR FOR LAST CHAR IN BUF
> ;END IFN FTEXEC
COMAND: 0
SVJBFF: 0
CBUF: BLOCK 3
COMNDS: SIXBIT /PATCH/
SIXBIT /DDT/
0
0
> ;END FTYANK
IFN FTFILE,<
PUTCHR: SOSLE LBUF+2 ;ANY ROOM?
JRST PUTOK ;YES
OUTPUT DP,
STATZ DP,740000 ;ERRORS?
HALT .+1 ;YES
PUTOK:
IDPB T,LBUF+1 ;DEPOSIT CHAR.
POPJ P,
> ;END OF IFN FTFILE
> ;END IFN FTDEC10
SUBTTL DISPATCH TABLE
BDISP: POINT 12,DISP(R),11
POINT 12,DISP(R),23
POINT 12,DISP(R),35
DISP:
DEFINE D (Z1,Z2,Z3)<
BYTE (12) Z1-DDTOFS,Z2-DDTOFS,Z3-DDTOFS
IFN <<Z1-DDTOFS>!<Z2-DDTOFS>!<Z3-DDTOFS>>&<-1,,770000>,
<PRINTX Z1, Z2, OR Z3 TOO LARGE FOR DISPATCH TABLE> >
;THIS MACRO PACKS 3 ADDRESSES INTO ONE WORD; EACH ADR IS 12 BITS
IFE FTYANK,<TAPIN=ERR>
IFE FTEXEC&FTPTP,< PUNCH==ERR
BLKEND==ERR
LOADER==ERR>
IFN FTDEC20,<SETPAG==ERR>
D (ERR,ERR,ERR); (0)
D (CNTRLZ,ERR,DDT); (3)
D (ERR,ERR,VARRW); (6)
D (TAB,LINEF,ERR); (11)
D (ERR,CARR,ERR); (14)
D (ERR,ERR,ERR); (17)
D (PUNCH,ERR,ERR); (22)
D (ERR,ERR,ERR); (25)
D (ERR,ERR,CNTRLZ); (30)
D (CONTROL,ERR,ERR); (33)
D (ERR,ERR,SPACE); (36)
D (SUPTYO,TEXI,ASSEM); (41)
D (DOLLAR,PERC,ERR); (44)
D (DIVD,LPRN,RPRN); (47)
D (MULT,PLUS,ACCF); (52)
D (MINUS,PERIOD,SLASH); (55)
D (NUM,NUM,NUM); (60)
D (NUM,NUM,NUM); (63)
D (NUM,NUM,NUM); (66)
D (NUM,TAG,SEMIC); (71)
D (FIRARG,EQUAL,ULIM); (74)
D (QUESTN,INDIRE,ABSA); (77)
D (BPS,CON,SYMD); (102)
D (EFFEC,SFLOT,GO); (105)
D (HWRDS,PILOC,BLKEND); (110)
D (KILL,LOADER,MASK); (113)
D (NWORD,BITO,PROCEDE); (116)
D (QUAN,RELA,SYMBOL); (121)
D (TEXO,SETPAG,ERR); (124)
D (WORD,XEC,TAPIN); (127)
D (ZERO,OCON,ICON); (132)
D (OSYM,VARRW,PSYM); (135)
;THIS TABLE DOES NOT HAVE ENTRIES FOR CHARS .GE. 140; THESE
; ARE DETECTED AS ERRORS NEAR L21:
SUBTTL FANCY TERMINAL INPUT LOGIC
IFN FTDEC10!<FTEXEC&FTEDIT>,<
TXTI:
DOTXTI: PUSH P,A ;SAVE ALL AC'S USED
PUSH P,B
PUSH P,C
PUSH P,T
PUSH P,W1
PUSH P,W2
MOVE W1,LINSPC ;COUNT OF BYTES IN DESTINATION
SKIPN W2,LINDB ;WAS IT NON-ZERO?
MOVE W2,CHINP ;NO. USE DEFAULT
; VERIFY ALL OF THE STRING POINTERS
RDTXT1: MOVE A,CHINP ;HAVE A DEST POINTER?
PUSHJ P,RDCBP ;YES. CHECK IT OUT
MOVEM A,CHINP ;GET CONVERTED POINTER
SKIPN A,LINBP ;HAVE A ^R BUFFER?
JRST RDTOPM ;NO. GO AROUND THEN
PUSHJ P,RDCBP ;YES. VERIFY IT
MOVEM A,LINBP ;STORE VERIFIED POINTER
RDTOPM: MOVE A,W2 ;GET TOP OF BUFFER
PUSHJ P,RDCBP ;VERIFY IT
MOVE W2,A ;ALL VERIFIED NOW
JUMPLE W1,WRAP0 ;MAKE SURE COUNT HAS ROOM IN IT
; ..
;MAIN LOOP - DOES INPUT OF BYTE AND DISPATCH ON CHARACTER CLASS
;ACTION ROUTINES EXIT TO:
; INSRT - APPEND CHARACTER AND CONTINUE
; NINSRT - CONTINUE WITHOUT APPENDING CHARACTER
; DING - BUFFER NOW EMPTY, POSSIBLE RETURN TO USER
; WRAP, WRAP0 - RETURNS TO USER
NINSRT: MOVEM W1,LINSPC ;STORE COUNT
PUSHJ P,RDBIN ;DO BIN
MOVE A,B ;SAVE BYTE
IDIVI B,CHRWRD ;SETUP TO GET CHAR CLASS
LDB B,CCBTAB(C) ;GET IT FROM BYTE TABLE
IDIVI B,2 ;SETUP TO REF DISPATCH TABLE
JUMPE C,[HLRZ T,DISPTC(B) ;GET LH ENTRY
JRST .+2]
HRRZ T,DISPTC(B) ;GET RH ENTRY
MOVE B,A ;ROUTINES GET BYTE IN B
JRST 0(T) ;DISPATCH TO ACTION ROUTINE
;RETURN FROM ACTION ROUTINE TO APPEND CHARACTER AND CONTINUE.
; B/ CHARACTER
INSRT: SKIPE WAKALL ;BREAK ON EVERYTHING?
JRST WRAP ;YES. WRAP IT UP THEN
IDPB B,CHINP ;APPEND BYTE TO USER STRING
SOJG W1,NINSRT ;CONTINUE IF STILL HAVE COUNT
JRST WRAP0 ;COUNT EXHAUSTED, RETURN
;RETURNS TO USER.
;RETURN TO USER IF BUFFER EMPTY
NDING: CAME W2,CHINP ;BUFFER EMPTY?
JRST NINSRT ;NO, GO GET MORE INPUT
JRST WRAP0
;APPEND LAST CHARACTER AND RETURN
WRAP: IDPB B,CHINP ;APPEND BYTE
SUBI W1,1 ;UPDATE COUNT
;STORE NULL ON STRING AND RETURN
WRAP0: JUMPLE W1,WRAP1 ;DON'T STORE NULL IF COUNT EXHAUSTED
SETZ B,
MOVE A,CHINP
IDPB B,A ;STORE NULL WITHOUT CHANGING USER PTR
;UPDATE USER VARIABLES AND RETURN
WRAP1: MOVEM W1,LINSPC ;UPDATE USER'S BYTE COUNT
POP P,W2
POP P,W1
POP P,T
POP P,C
POP P,B
POP P,A
JRST CPOPJ1
;PARAMETERS FOR CLASS TABLE
CCBITS==4 ;BITS/BYTE
CHRWRD==^D36/CCBITS ;BYTES/WORD
;DEFINED CHARACTER CLASSES:
TOP==0 ;TOPS10 BREAK
BRK==1 ;REGULAR BREAK SET
ZER==2 ;NULL
EOLC==3 ;EOL
PUN==4 ;PUNCTUATION
SAFE==5 ;ALL OTHERS
RUBO==6 ;DELETE A CHARACTER
RTYP==7 ;RETYPE THE LINE
KLL==10 ;DELETE THE LINE
KWRD==11 ;DELETE A WORD
RDCRC==12 ;CARRIAGE RETURN
RDQTC==13 ;QUOTE CHARACTER
;TABLE OF BYTE PTRS TO REFERENCE CLASS TABLE
XX==CCBITS-1
XALL
CCBTAB: REPEAT CHRWRD,<
POINT CCBITS,CTBL(B),XX
XX=XX+CCBITS>
SALL
;CLASS DISPATCH TABLE
DISPTC: WRAP,,WRAP
ZNULL,,EOL1
WRAP,,INSRT
DELC,,RTYPE
DELIN,,KLWORD
RDCR,,RDQT
;CHARACTER CLASS TABLE
DEFINE CCN (A,B)<
REPEAT B,<
CC1 (A)>>
DEFINE CC1 (C)<
QQ=QQ+CCBITS
IFG QQ-^D35,<
QW
QW=0
QQ=CCBITS-1>
QW=QW+<C>B<QQ>>
QW==0
QQ==-1
CTBL: CC1(ZER) ;0
CCN(PUN,6) ;1-6
CC1(TOP) ;7
CCN(PUN,2) ;10-11
CC1(EOLC) ;12
CC1(PUN) ;VT
CC1(TOP) ;FF
CC1(RDCRC) ;CR
CCN(PUN,4) ;16-21 (^N-^Q)
CC1(RTYP) ;^R
CCN(PUN,2) ;^S,^T
CC1(KLL) ;^U
CC1(RDQTC) ;^V
CC1(KWRD) ;^W
CCN(PUN,2) ;^X,^Y
CCN(BRK,2) ;^Z,$
CCN(PUN,4) ;34-37
CCN(PUN,^D16) ;40-/
CCN(SAFE,^D10) ;0-9
CCN(PUN,7) ;:-@
CCN(SAFE,^D26) ;A-Z
CCN(PUN,6) ;]-140
CCN(SAFE,^D26) ;A-Z
CCN(PUN,4) ;173-176
CC1(RUBO) ;177
QW ;GET LAST WORD IN
;LOCAL ROUTINES TO DO LOGICAL BIN AND BOUT.
RDBIN: SKIPE B,SAVCHR ;WANT TO BACK UP?
JRST [SETZM SAVCHR ;ONLY ONCE
POPJ P,0] ;RETURN
IFN FTEXEC,<
SKPUSR
JRST [PUSH P,T ;SAVE T
IFN FTYANK,<
SKIPE COMAND
PUSHJ P,XPTRIN>
PUSHJ P,XTIN ;GET A BYTE
MOVE B,T ;PUT IN CORRECT PLACE
POP P,T ;RESTORE T
JRST RDBIN1] ;SKIP NEXT INST
>
IFN FTDEC20,<HALT DDT> ;SHOULD NOT BE HERE IN USER MODE
IFN FTDEC10,<
IFN FTYANK,<
PUSH P,T ;SAVE AN AC
SKIPE COMAND ;COMMAND FILE OPEN?
PUSHJ P,PTRIN ;READ COMMAND FILE
JRST [MOVEI T," " ;ASSUME EOF
SKIPL PTDFLG ;WAS IT EOF?
INCHRW T ;NO--READ A BYTE
JRST .+1] ;CONTINUE
MOVE B,T ;COPY BYTE
POP P,T> ;RESTORE T
IFE FTYANK,<INCHRW B>> ;READ BYTE UNDER TOPS-10
RDBIN1: MOVEM B,LASCHR ;SAVE LAST CHAR READ
POPJ P,0 ;RETURN
;RDBOUT
; B/ BYTE
; PUSHJ P,RDBOUT
; RETURN +1 ALWAYS
RDBOUT: PUSH P,T ;SAVE AN AC
PUSH P,CHINC
PUSH P,CHINP
MOVE T,B ;SET FOR ECHO
PUSHJ P,TOUT ;TYPE IT
POP P,CHINP
POP P,CHINC
POP P,T
POPJ P,0
;RDSOUT - OUTPUT STRING ALA RDBOUT
; B/ STRING PTR
; PUSHJ P,RDSOUT
; RETURN +1 ALWAYS
RDSOUT: MOVE A,B ;COPY POINTER
PUSHJ P,RDCBP
RDSL: ILDB B,A
JUMPE B,CPOPJ ;EXIT ON NULL
PUSHJ P,RDBOUT
JRST RDSL
;CHECK BYTE POINTER GIVEN AS ARGUMENT
; A/ BYTE POINTER
; PUSHJ P,RDCBP
; RETURN +1: OK, LH INITIALIZED IF NECESSARY
RDCBP: HLRZ B,A ;GET LH
CAIN B,-1 ;IS DEFAULT?
HRLI A,(<POINT 7,0>) ;YES, FILL IN 7-BIT
LDB B,[POINT 6,A,11] ;CHECK BYTE SIZE
CAIGE B,7 ;7 OR GREATER?
HALT . ;BAD BYTE SIZE
IBP A ;INCR IT AND DECR IT ONCE SO WILL
JRST DBP ; BE IN KNOWN STATE FOR COMPARES
;LOCAL ROUTINES FOR EDITING FUNCTIONS
;DELETE CHARACTER FROM DESTINATION - BACKUP PTR AND CHECK
;FOR TOP OF BUFFER
; PUSHJ P,BACK
; RETURN +1: AT TOP OF BUFFER, NO CHARACTER TO DELETE
; RETURN +2: CHARACTER DELETED
BACK: CAMN W2,CHINP ;AT TOP OF BUFFER?
POPJ P,0 ;YES
MOVE A,CHINP ;GET DEST PTR
PUSHJ P,DBP ;DECREMENT IT
MOVEM A,CHINP ;PUT IT BACK
AOJA W1,CPOPJ1 ;UPDATE COUNT AND RETURN
;PUT BYTE BACK INTO SOURCE
; B/ BYTE
; PUSHJ P,RDBKIN
; RETURN +1 ALWAYS
RDBKIN:
DOBKIN: MOVE A,LASCHR ;GET LAST BYTE READ
MOVEM A,SAVCHR ;MAKE NEXT BYTE READ
POPJ P,0
;FIND BEGINNING OF CURRENT LINE.
; PUSHJ P,FNDLIN
; RETURN +1: AT TOP OF BUFFER
; RETURN +2: A/ BACKED-UP BYTE PTR TO BEGINNING OF LINE
; B/ BYTE COUNT CONSISTENT WITH CHINP IN A
FNDLIN: CAMN W2,CHINP ;AT TOP OF BUFFER?
POPJ P,0 ;YES
PUSH P,CHINP ;SAVE CURRENT LINE VARIABLES
PUSH P,W1
FNDLN1: MOVE A,CHINP ;BACKUP ONE CHARACTER
PUSHJ P,DBP
MOVEM A,CHINP
ADDI W1,1
CAMN W2,CHINP ;NOW AT TOP OF BUFFER?
JRST FNDLN2 ;YES, RETURN
LDB B,CHINP ;NO, LOOK AT NEXT CHAR TO BE DELETED
CAIN B,12 ;EOL OR LF?
JRST FNDLN2 ;YES, RETURN
JRST FNDLN1 ;NO, KEEP LOOKING
FNDLN2: MOVE A,CHINP ;RETURN NEW LINE VARIABLES
MOVE B,W1
POP P,W1 ;RESTORE OLD LINE VARIABLES
POP P,CHINP
JRST CPOPJ1
;ACTION ROUTINES
;ZERO BYTE
ZNULL: SKIPE WAKALL ;USER HAVE A MASK?
JRST INSRT ;YES. GO SEE ABOUT IT THEN
JRST WRAP0 ;NO. ALWAYS BREAK THEN
;CARRIAGE RETURN - IF LINE FEED FOLLOWS, TREAT LIKE EOL
RDCR: CAIGE W1,2 ;ROOM FOR CR AND LF?
JRST [PUSHJ P,RDBKIN ;NO, PUT THE CR BACK
JRST WRAP0] ;WILL GET IT NEXT TIME
PUSHJ P,RDBIN ;GET THE NEXT CHAR
CAIN B,12 ;LF?
JRST RDCR1 ;YES, NORMAL NEWLINE
PUSHJ P,RDBKIN ;NO, PUT BACK THE SECOND BYTE
MOVEI B,15 ;APPEND A REAL CR
JRST WRAP
RDCR1: MOVEI B,15
IDPB B,CHINP ;APPEND CR
SOS W1
RDCR2: MOVEI B,12
EOL1: JRST WRAP ;YES
;QUOTE CHARACTER (^V) - INHIBITS EDITING ACTION OF FOLLOWING CHARACTER
RDQT: CAIGE W1,2 ; ROOM FOR BOTH?
JRST [PUSHJ P,RDBKIN ; NO. BACK UP
JRST WRAP0] ; AND WAIT FOR NEXT TIME
IDPB B,CHINP ;STORE QUOTE
SOS W1 ; ONE LESS
PUSHJ P,RDBIN ;GET THE NEXT CHAR
JRST WRAP ;YES
;DELETE CHARACTER (RUBOUT)
DELC: PUSHJ P,BACK ;BACKUP PTR
JRST WRAP0 ;NOTHING LEFT IN BUFFER
MOVE T,CHINP
ILDB B,T ;GET CHAR JUST DELETED
CAIN B,12 ;WAS IT LF?
JRST DELC2 ;YES
MOVE T,TTYMSK ;[210] GET FORMAT MASK
TRNE T,1B35 ;[210] (NEED SYMBOL) FANCY <DEL>'S?
JRST DELC3 ;[210] YES - <BS><SP><BS>
PUSHJ P,RDBOUT ;TYPE IT OUT
MOVEI B,"\" ;INDICATE DELETION
PUSHJ P,RDBOUT
DELC4: JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
DELC3: HRROI B,[BYTE(7) 10,40,10,00,00] ;[210] <BS><SP><BS>
JRST DELC0 ;[210] REJOIN COMMON CODE
DELC2: CAMN W2,CHINP ;AT BEGINNING OF DEST BUFFER?
JRST DELC1 ;YES
LDB B,CHINP ;NO, CHECK CHARACTER PRECEEDING LF
CAIE B,15 ;A CR?
JRST DELC1 ;NO, LEAVE IT ALONE
PUSHJ P,BACK ;YES, DELETE IT ALSO
JRST WRAP ;(CAN'T HAPPEN)
DELC1: HRROI B,[ASCIZ /
/]
DELC0: PUSHJ P,RDSOUT ;DO CRLF WHEN DELETING EOL OR CRLF
JRST DELC4
;DELETE LINE (CONTROL-U)
DELIN: MOVEI C,0
PUSHJ P,FNDLIN ;FIND BEGINNING OF LINE
JRST NDING ;NOTHING IN BUFFER
LDB C,CHINP ;GET LAST CHAR IN BUFFER
MOVEM A,CHINP ;SET LINE VARIABLES TO BEGINNING
MOVEM B,W1
JRST NDING ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;DELETE WORD (CONTROL-W)
KLWORD: PUSHJ P,BACK ;DELETE AT LEAST ONE CHARACTER
JRST WRAP0 ;WASN'T ONE
MOVE T,CHINP
ILDB B,T ;GET CHAR JUST DELETED
CAIN B,12 ;LF OR EOL?
JRST BWRD3 ;YES, DON'T DELETE
BWRD1: PUSHJ P,BACK ;DELETE NEXT CHARACTER
JRST BWRD2 ;NO MORE LEFT
MOVE T,CHINP ;LOOK AT CHARACTER JUST DELETED
ILDB B,T
IDIVI B,CHRWRD ;GET ITS CHARACTER CLASS
LDB B,CCBTAB(C)
CAIN B,SAFE ;IS IT A WORD SEPARATOR?
JRST BWRD1 ;KEEP DELETING
BWRD3: IBP CHINP ;YES, KEEP THAT CHARACTER
SUBI W1,1
BWRD2: MOVEI B,"_" ;INDICATE WORD DELETION
PUSHJ P,RDBOUT
JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;RETYPE LINE (CONTROL-R)
RTYPE: PUSHJ P,RTYPES ;DO THE WORK
JRST NINSRT
;SUBROUTINE TO RETYPE LINE
RTYPES: HRROI B,[ASCIZ /
/]
PUSHJ P,RDSOUT ;NON-DISPLAY, GET CLEAN LINE
PUSHJ P,FNDLIN ;FIND BEGINNING OF LINE
MOVE A,W2 ;AT TOP OF BUFFER - USE IT
MOVE T,A ;SAVE PTR TO BEGINNING OF LINE
CAME T,W2 ;BEG OF LINE IS TOP OF BUFFER?
JRST RTYP1 ;NO, DON'T TYPE ^R BFR
SKIPE T,LINBP ;GET ^R BFR IF ANY
RTYW1: CAMN T,W2 ;UP TO TOP OF BFR?
JRST RTYP4 ;YES, DONE WITH ^R BFR
ILDB B,T ;GET CHAR FROM ^R BFR
JUMPN B,[PUSHJ P,RDBOUT ;TYPE IT
JRST RTYW1]
RTYP4: MOVE T,W2 ;DONE WITH ^R BFR, NOW DO MAIN BFR
RTYP1: CAMN T,CHINP ;BACK TO END OF LINE?
POPJ P,0 ;YES
ILDB B,T ;NO, GET NEXT BYTE
PUSHJ P,RDBOUT ;TYPE IT
JRST RTYP1 ;LOOP UNTIL AT END OF BUFFER
;DECREMENT BYTE POINTER
; A/ BYTE PTR
; PUSHJ P,DBP
; RETURNS +1, CLOBBERS B AND C
DBP: LDB B,[POINT 6,A,5] ;GET P
LDB C,[POINT 6,A,11] ;GET S
ADD B,C ;NEW P = P + S
CAIGE B,^D36 ;NEW P .GE 36?
JRST DBP1 ;NO, BYTE IS IN SAME WORD.
HRRI A,-1(A) ;DECREMENT ADDRESS
MOVEI B,^D36 ;MAKE P = REMAINDER (36,S)
IDIV B,C
MOVEI B,0(C)
DBP1: DPB B,[POINT 6,A,5]
POPJ P,0
> ;END IFN FTDEC10...
SUBTTL OP DECODER
;DESCRIPTION OF OP DECODER FOR DDT:
;
; THE ENTIRE INSTRUCTION SET FOR THE PDP-6 CAN BE COMPACTED INTO
;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL. THIS OCCURS
;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
;FOR THE PDP-6. FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
;BEGIN WITH 110(2).
;
; THE TABLE TBL IN DDT CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
;0-37(8): THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
; LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
; EQUAL P.
;
; THE CONTENTS OF INST (INSTRUCTION) CONTAIN IN THE RIGHT
; MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
; P AND N REFER TO THE CONTENTS OF INST, AND THE OP DECODER
; WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
; OF INSTX N+1 GIVES THE NUMBER OF BITS IN INST; P GIVES THE
; POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
;
; EXAMPLE: P = 6
; N = 2
;
;; C(INST) = .010 101 100(2)
;
; THE RESULT = D = 010(2) = 2(8)
;
; D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
; IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
; PRINT TEXT OR ARE THE EXTEND BYTE, 41-73(8))
; ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
; THE INTERPRETATION.
;
;40(8) THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
; IS FINISHED.
;41(8)-72(8) THE ALPHABET IS ENCODED INTO THIS RANGE.
; 41- A
; 42- B
; 72- Z
; WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
; LETTER IS TYPED.
;73(8) THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
; IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
; BY <1000-74*2+FIR.> FIRST.
;
;74(8)-777(8) THIS IS A TRANSFER BYTE. IF THE BYTE IN THIS RANGE IS
; CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE
; <A-74(8)+FIR.>RD BYTE IN THE TABLE.
;
;MACROS ASSEMBLE THE TABLE TBL:
; 1. A NUMBER FOLLOWED BY ^ ASSEMBLES A DISPATCH BYTE. THE FIRST
; DIGIT IS THE POSITION; THE SECOND DIGIT IS THE SIZE.
; 2. A POINT (.) ASSEMBLES A STOP CODE.
; 3. A NAME FOLLOWED BY A SLASH ASSEMBLES A TRANSFER TO THE
; SYMBOLICALLY NAMED BYTE.
; 4. A STRING OF LETTERS TERMINATED BY A SPACE, COMMA, OR POINT,
; ASSEMBLE INTO A STRING OF BYTES, EACH BYTE BEING ONE LETTER.
;
;EXAMPLE OF BINARY TO SYMBOLIC DECODING:
; THE MACHINE CODE FOR JRST IS 254
; INST 0 1 0 1 0 1 1 0 0
; THE INTERPRETER STARTS WITH THE FIRST BYTE IN THE TABLE (63^).
; THE RESULT OF APPLYING THIS TO C(INST) GIVES 2. SKIPPING OVER
; 2 BYTES IN THE TABLE AND INTERPRETING THE THIRD RESULTS IN
; HAK/ BEING INTERPRETED. AT HAK:, THERE IS A 33^. APPLYING
; THIS TO C(INST) RESULTS IN 5 NON PRINTING BYTES BEING SKIPPED
; OVER:
; 1. MV/
; MOV PRINTING TEXT
; 2. MO/
; 3. ML/
; 4. DV/
; 5. SH/
;
;H1/ IS THE NEXT BYTE INTERPRETER. AT H1: 03^ IS FOUND SO
;4 BYTES ARE SKIPPED OVER:
; EXC PRINTING TEXT
; 1. S3/
; BL PRINTING TEXT
; T PRINTING TEXT
; 2. .
; 3. AO/
; 4. AOB/
; THE NEXT LETTERS JRS ARE TYPED OUT. THEN T/ IS FOUND. AT
;T; A T IS TYPED OUT; THEN A "." IS FOUND AND EVERYTHING STOPS.
;
; THE TABLE IS ALSO USED GOING FROM SYMBOLIC TO BINARY BUT A
; TREE SEARCH METHOD IS USED.
REPEAT 0,<
DEFINE REDEF (XX)<
DEFINE INFO (AA,BB)<
AA XX'BB>>
DEFINE BYT9 (L)<
XLIST
REDEF %
ZZ==0
ZZZ==0
ZZM==1
IRPC L,<
Z=="L"
IFE Z-":",<INFO <>,<==CLOC>
IFNDEF FIR.,<FIR.==CLOC>
IFGE CLOC+73-1000-FIR.,<PRINTX OPTABLE TOO LONG>
Z==0>
IFE Z-"/",<IF1 <OUTP 1>
IF2,<INFO OUTP,+73-FIR.>
Z==0>
IFE Z-"^",<OUTP <ZZ&70/2+ZZ&7-1>
Z==0>
IFE <Z-",">*<Z-".">*<Z-40>,<IFN ZZZ,<
REPEAT 5,<ZZ==ZZZ&77
IFN ZZ,<OUTP ZZ>
ZZZ==ZZZ/100>>
IFE Z-".",<OUTP 40>
Z==0>
IFN Z,<INFO REDEF,L
ZZ==ZZ*10+Z&7
ZZZ==ZZZ+<Z-40>*ZZM
ZZM==ZZM*100>
IFE Z,<REDEF %
ZZ==0
ZZZ==0
ZZM==1>>
LIST>
DEFINE OUTP (A)<
BINRY==BINRY*400+BINRY*400+A
BINC==BINC-1
IFE BINC,<EXP BINRY
BINRY==0
BINC==4>
CLOC==CLOC+1>
TBL: ;OPDECODER BYTE TABLE
.XCREF ;KEEP THIS MESS OUT OF CREF
BINRY==0
CLOC==0 ;SET BYTE LOCATION COUNTER TO 0
BINC==4 ;INIT BYTES/WORD COUNTER
BYT9 <63^UUO/FLO/HAK/ACCP/BOOLE/H HWT/T ACBM/>
;IO INSTRUCTIONS
BYT9 <21^BD/CON,11^OI/S,01^Z/O/>
BYT9 <BD:01^BLK,IO/DATA,IO:11^I/O/OI:01^O/I/>
;UUOS
BYT9 <UUO:51^.,32^U40/U50/U60/21^U703/11^USET/01^>
BYT9 <LOOKU,P/ENTE,R/USET:USET,01^I/O/>
BYT9 <U40:03^CAL/INI T/.....,CALL I/>
BYT9 <U60:21^U603/01^IN,BPUT/OUT,BPUT:11^BU,F:F.,PU,T/>
BYT9 <U603:01^U6062/STAT,11^O:O.,Z:Z.,U6062:11^S,U62/G,U62:ETST,S/>
;BYTE AND FLOATING INSTRUCTIONS
BYT9 <FLO:51^BYTE/F 32^ AD A/SB A/MP A/DV A:>
BYT9 <21^LMB/R,IMB/LMB:02^.,L:L.,M:M.,B:B.,BYTE:32^.,I110//,I120/,03^UF,PA/DF,N/>
BYT9 <FS C/IB P:P.,I LD/LD:LD B/I DP/DP:DP B/>
;FWT,FIXED POINT ARITH,MISC.
BYT9 <HAK:33^MV/MV:MOV MO/ML/DV/SH/H1/JP/>
BYT9 <21^ADD IMB/SU BIMB:B IMB:02^.,I:I.,M/B/MO:22^>
BYT9 <EIMS:E IMS/S IMS/N IMS/M IMS:02^.,I/M/S:S.,>
BYT9 <ML:21^I ML1/ML1:MUL IMB/DV:21^I DV1/DV1:>
BYT9 <DI DV2:V IMB/H1:03^EXC S3/BL T:T.,AO/AO:AOBJ,>
BYT9 <AOB/JRS T/JFC L/XC T/.AOB:01^P/N/>
BYT9 <JP:03^PU/PU:PUSH PUS/PO/PO:POP POP/JS,R:R.,>
BYT9 <JS P/JS PA:A.,JR PA/PUS:01^J:J..,POP:>
BYT9 <01^.,J/SH:02^A S2/ROT S1/L S2:S S3:H S1/21^JFF O/.,S1:21^.,C:C.,>
;ARITH COMP,SKIP,JUMP
BYT9 <ACCP:42^CA CA1/SJ/A JS/S JS:O 31^>
BYT9 <J COMP/S COMP/CA1:31^I COMP/M COMP/>
BYT9 <SJ:31^JUM PSJ/SKI PSJ:P COMP:>
BYT9 <03^.,L/E:E.,L E/PA/G E/N:N.,G.,>
;HALF WORDS
BYT9 <HWT:51^HW1/21^R HW2/L HW2:R HW3/HW1:>
BYT9 <21^L HW4/R HW4:L HW3:32^IMS/Z IMS/O IMS/EIMS/>
;TEST INSTRUCTIONS
BYT9 <ACBM:31^AC1/01^D AC2/S AC2/AC1:01^R AC2/L,>
BYT9 <AC2:42^N EAN/Z EAN/C EAN/O EAN:12^.,E/PA/N/>
;BOOLEAN
BYT9 <BOOLE:24^ST/AN:AND B2/AN/ST/AN/ST/>
BYT9 <X OR:OR B2/I OR/AN/EQ DV2/ST/OR/ST/OR/OR/>
BYT9 <ST:SET B2:24^Z IMB/IMB/CA:C TA/TM:M IMB/>
BYT9 <CM:C TM/TA:A IMB/IMB/IMB/CB:C BIMB/IMB/CA/>
BYT9 <CA/CM/CM/CB/O IMB/>
;INSTRUCTION GROUP 120
BYT9 <I120:11^ DMOV/ 01^ FIX,FIX2/ 21^.,FLT,FIX2: 21^. R/>
BYT9 <DMOV:DMOV,01^ E,EM// N,EM:21^. M/>
;MORE UUO'S
BYT9 <U50:03^OPE,N/TT,CAL:CAL L/...,RENAM,E/I,N/OU,T/>
BYT9 <U703:02^CLOS,E/RELEA,S/MTAP,E/UGET,F/>
;INSTRUCTION GROUP 110 - DF ARITHMETIC
BYT9 <I110:21^DF DF// ., DF:02^AD.,SB.,M P/ DV.>
REPEAT BINC,<BINRY==BINRY*400+BINRY*400>
IFN BINRY,<EXP BINRY>
.CREF ;TURN CREF BACK ON
> ;END OF REPEAT 0
;THE FOLLOWING IS AN ALTERNATE SET OF MACROS FOR BUILDING THE OP
;TABLE. THEY ASSEMBLE MUCH FASTER THAN THE ONES ABOVE. THEY ARE:
;.ADR - DECLARE TAG; .TRA - TRANSFER BYTE; .TRAX - EXTENDED TRANSFER
;BYTE; .DIS - DISPATCH BYTE; .TXT - TEXT BYTES; .END - TEXT BYTES
;FOLLOWED BY STOP BYTE.
DEFINE BYT9 (A) <
XLIST
IRP A,<
A>
LIST>
IF1,<
DEFINE .ADR (A) <
%'A== CLOC
FIR.== CLOC
DEFINE .ADR (B) <
%'B== CLOC
LASTB==CLOC+74-FIR.>>
DEFINE .TRA (A)<CLOC==CLOC+1>
DEFINE .TRAX (A)<CLOC==CLOC+2>
SYN .TRA, .DIS
DEFINE .TXT (A) <
IFNB <A>, <IRPC A,<CLOC==CLOC+1>>>
DEFINE .END (A) <
IFNB <A>, <IRPC A,<CLOC==CLOC+1>>
CLOC== CLOC+1>
> ;END OF IF1
IF2,<
DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>
DEFINE .TRA (A) <OUTP %'A+74-FIR.>
DEFINE .TRAX (A),<OUTP 73
OUTP 74+<Z1==%'A-FIR.-1000+74>
IFL Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>
DEFINE .DIS (A) <OUTP A&70/2+A&7-1>
DEFINE .TXT (A) <IFNB <A>,<IRPC A,<OUTP "A"-40>>>
DEFINE .END (A) <
IFNB <A>, <IRPC A,<OUTP "A"-40>>
OUTP 40>
DEFINE OUTP (A)<
IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
IFE <BINC==BINC-9>-^D27,<BINR1==A>
IFE BINC-^D18,<BINR2==A>
IFE BINC-9,<BINR3==A>
IFE BINC,< BYTE (9) BINR1,BINR2,BINR3,<A>
BINC==^D36>
CLOC==CLOC+1 >
>
TBL: .XCREF ;OPDECODER BYTE TABLE
CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0
BINC== ^D36 ;INIT BYTES/WORD COUNTER
;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
;**************TERMINATES AT THE NEXT COMMENT WITH: **************
IFN FTDEC20,<
BYT9 <
.DIS 63,.END,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
> ;END IFN FTDEC20
IFN FTDEC10,<
BYT9 <
.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
.TXT H,.TRA HWT,.TXT T,.TRA ACBM>
> ;END IFN FTDEC10
BYT9 <
;IO INSTRUCTIONS
.DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
.ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
.ADR OI,.DIS 01,.TRA O,.TRA I
;UUOS
.ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
.DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
.TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
.ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
.ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
.ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
.ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
.ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S
;BYTE AND FLOATING INSTRUCTIONS
.ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
.TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
.DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
.ADR L,.END L,.TXT,.ADR M,.END M,.TXT
.ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.TRAX I100,.TRAX I110,.TRA I120,.TXT
.DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N
.TXT FS,.TRA C,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD
.ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B
;FWT-FIXED POINT ARITH-MISC
.ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV
.TRA SH,.TRA H1,.TRA JP
.DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT
.ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22
.ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M
.ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT
.ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB
.ADR DV,.DIS 21,.TXT I,.TRA DV1
.ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL
.ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ
.TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P
.ADR AOB,.DIS 01,.TRA P,.TRA N
.ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO
.ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT
.TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA
.ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP
.DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L
.ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END
.ADR S1,.DIS 21,.END,.TXT,.ADR C,.END C,.TXT
;ARITH COMP-SKIP-JUMP
.ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S
.ADR JS,.TXT O,.DIS 31
.TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP
.ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP
.DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E
.ADR N,.END N,.TXT,.END G,.TXT
;HALF WORDS
.ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3
.ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L
.ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS
;TEST INSTRUCTIONS
.ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2
.ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L
.ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O
.ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N
;BOOLEAN
.ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST
.TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ
.TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR
.ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB
.ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB
.ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB
.ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA
.TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB
;INSTRUCTION GROUP 120
.ADR I120,.DIS 11,.TRAX DMOV,.DIS 01,.TXT FIX,.TRAX FIX2,.DIS 21,.END EXTEND
.TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R
.ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N
.ADR EM,.DIS 21,.END,.TRA M
;MORE UUO'S
.ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END
.TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T
.ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S
.TXT MTAP,.TRA E,.TXT UGET,.TRA F
;INSTRUCTION GROUP 110 - DF ARITHMETIC
.ADR I110,.DIS 21,.TXT DF,.TRAX DF,.TXT D,.TRAX FXDP,.ADR DF,.DIS 02
.END AD,.END SB,.TXT M,.TRA P,.END DV
;KL10 FIXED POINT DOUBLE PRECISION OPERATIONS
.ADR FXDP,.DIS 02,.END ADD,.END SUB,.END MUL,.END DIV
;OPCODES 100 TO 107 COME HERE
.ADR I100,.DIS 21,.END,.DIS 02,.END JSYS,.END ADJSP,.END,.END
;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
>
IF1,< BLOCK <CLOC+3>/4>
IF2,< IFN BINC-^D36,<BYTE (9) BINR1,BINR2,BINR3,0> >
IFNDEF CLOC.,<CLOC.==CLOC>
IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>
.CREF ;TURN CREF BACK ON
BTAB: POINT 9,TBL ;TABLE USED TO GET NEXT BYTE POINTER
POINT 9,TBL,8 ;FOR TRANSFER BYTE
POINT 9,TBL,17
POINT 9,TBL,26
OPEVAL: MOVEI T,0 ;EVALUATE FOR AN OP CODE
IDPB T,CHP ;INSERT NULL IN TEXT FOR SYMBOL
MOVEM P,SAVPDL
TRZA F,OUTF
OPTYPE: TRO F,OUTF ;TYPE AN OPCODE SYMBOLICALLY
LSH T,-33
MOVEM T,INST ;GET OPCODE INTO RIGHT 9 BITS
MOVE T,[XWD 440700,TXT]
MOVEM T,CHP ;FOR OPEVAL,SETUP POINTER TO INPUT TEXT
TRZ F,ITF ;CLEAR INSTRUCTION TYPED FLAG
CLEARB R,W1
MOVE W2,BTAB
DC1: ILDB T,W2 ;GET NEXT BYTE IN TBL
CAILE T,40
CAIL T,74
SOJGE R,DC1 ;SKIP OVER # BYTES = C(R)
JUMPG R,DC1 ;SKIP OVER ALPHA TEXT (AND EXTEND BYTES) WITHOUT COUNTING
SUBI T,40
JUMPE T,DECX ;TRANSFER ON ASTOP CODE
JUMPG T,DC2
DPB T,[XWD 340500,PNTR] ;SETUP R ON A DISPATCH BYTE
TRZ T,-4
AOS T
DPB T,[XWD 300600,PNTR]
TRNN F,OUTF
JRST DC6 ;FOR OPEVAL ONLY
LDB R,PNTR ;GET # BYTES TO SKIP OVER
JRST DC1
DC2: HRREI T,-33(T) ;TOTAL SUBTRACTED NOW IS 73
JUMPL T,DECT ;TYPE OUT A LETTER
JUMPG T,DC3 ;XFER IF BYTE .GE. 74
ILDB T,W2 ;BYTE IS EXTEND BYTE (73), GET NEXT
MOVEI T,1000-74*2+1(T) ; BYTE AND ADD IN EXTENSION (-OFFSET)
DC3: MOVEI W1,FIR.-1(T) ;BYTE IS AN XFER (1ST XFER IS 74)
IDIVI W1,4
MOVE W2,BTAB(W2) ;CALCULATE POINTER TO NEXT BYTE
ADDI W2,(W1)
JRST DC1
DECT: TRNE F,OUTF
JRST DC8 ;TYPE OUT A LETTER
ILDB W1,CHP ;GET NEXT INPUT LETTER
CAIE W1,133(T) ;COMPARE WITH ASSUMED NEXT LETTER
JRST NOMAT ;DOESNT MATCH
JRST DC1 ;MATCHES, TRY NEXT
DECX: TRNE F,OUTF ;STOP (CODE 40) HAS BEEN SEEN
POPJ P, ;IF FOR OUTPUT, RETURN
ILDB W1,CHP ;GET NEXT INPUT CHAR IF ANY
JUMPE W1,DC7 ;DOES # OF CHARS MATCH
NOMAT: POP P,R ;NO, BACK UP AND TRY SOME MORE
POP P,W2
POP P,PNTR
POP P,CHP
NOMAT1: AOS R ;ASSUME NEXT NUMBER FOR BIN VALUE
DPB R,PNTR ;STUFF INTO ANSWER
LDB R,PNTR
JUMPN R,DC6AA ;IF =0, BYTE WAS TOO BIG
CAME P,SAVPDL
JRST NOMAT ;NOT AT TOP LEVEL
POPJ P, ;UNDEFINED, FINALLY
DC6: MOVEI R,0 ;ASSUME 0 FOR INITIAL BINARY VALUE
DPB R,PNTR
DC6AA: CAMN P,SAVPDL
JRST DC6BB
LDB T,-2(P) ;OLD VALUE OF PNTR
CAME T,(P)
JRST NOMAT1
DC6BB: PUSH P,CHP
PUSH P,PNTR
PUSH P,W2
PUSH P,R
JRST DC1
DC7: MOVE P,SAVPDL ;RESTORE PUSH DOWN POINTER
MOVE T,INST
LSH T,33 ;PUSH BINARY INTO POSITION FOR OPEVAL
LDB R,[POINT 3,T,8]
TLC T,700000
TLCN T,700000
DPB R,[POINT 10,T,12] ;ONLY DONE FOR IO INSTRUCTIONS
JRST CPOPJ1 ;SYMBOL FOUND, SKIP RETURN
DC8: TRO F,ITF ;SET INSTRUCTION TYPED FLAG
MOVEI T,133(T)
PUSHJ P,TOUT ;OUTPUT A LETTER
CLEARM SPSAV ;SO $D WONT TRY TO DELETE OP CODES
JRST DC1
;*** LITERALS XLISTED ***
XLIST
LIT
LIST
END.C: ;END OF CODE
SUBTTL VARIABLE STORAGE
IFN FTDEC20,< IFDEF VARLOC,<
PHVAR: PHASE VARLOC>> ;PHASE VARIABLES FOR UDDT AND MDDT
BEG.V: ;BEGINNING OF VARIABLES
NM1A: MOVEI W2,0
ACCCF: MOVEI T,.-. ;LEFT HALF OF A,,B
SEARXJ: JUMP SEAR2A ;[224] SET BY SEARCH CODE
TOCS: MOVEI T,.-. ;GET RIGHT HALF BACK
;VARIABLES FOR LINE BUFFER INPUT
TTYMSK: BLOCK 1 ;[210] FANCY TTY HANDLING MASK
TEXINF: 0 ;NON-0 FOR TEXT INPUT MODE
CHINC: 0 ;COUNT OF CHARACTERS
WAKALL: 0 ;NON-0 TO WAKEUP ON EVERYTHING
;*** DO NOT REORDER THE FOLLOWING ***
TEXTIB: 10 ;TEXTI ARG BLOCK - SIZE
IFN FTDEC20,<
RD%BRK+RD%TOP+RD%PUN+RD%RND+RD%JFN+RD%BBG+RD%SUI ;FLAGS
.PRIIN,,.PRIOU ;INPUT/OUTPUT JFNS
>
CHINP: 0 ;POINTER TO NEXT CHAR
LINSPC: 0 ;FREE SPACE COUNT
LINDB: POINT 7,LINBF ;BEGINNING OF BUFFER
LINBP: POINT 7,LINBF ;BEGINNING OF ^R BUFFER
ETXTB: 0 ;WAKEUP TABLE (ALL ONES)
0 ;BACKUP LIMIT POINTER
;***END OF "DO NOT REORDER" BLOCK***
IFN FTDEC10!<FTEXEC&FTEDIT>,<
SAVCHR: 0 ;PRESET RESULT FOR NEXT CALL TO RDBIN
LASCHR: 0 ;ANSWER FROM LAST CALL TO RDBIN
>
NLINBF==^D20
LINBF: BLOCK NLINBF ;LINE BUFFER
SUBTTL STORAGE -- $X LOGIC AND PATCH COMMAND
IFE FTFILE,<
;VARIABLES USED IN $X LOGIC
I.XCT: XCT I.NST
I.NST: 0 ;INSTRUCTION BEING EXECUTED
SAV0: 0 ;SAVES AC 0 IN SWAP ROUTINE
XCTS: 0 ;XCT DEPTH COUNTER
I.NSTAC:0 ;AC FIELD OF INST BEING EXECUTED
I.NSTEA:0 ;E FIELD OF INST BEING EXECUTED
I.EA2: 0 ;SECOND EA FOR TWO-PART ADDR COMPUTATION
XTEM: 0 ;$X REPEAT COUNTER
I.NSTPC:0 ;PC OF INST BEING EXECUTED
FLAGS: 0 ;SAVES DDT FLAG REGISTER
LOCSAV: 0 ;SAVES LOCATION OF INST BEING EXECUTED
SAFETY: 0 ;SAVES T
> ;END FTFILE
;VARIABLES FOR PATCH COMMAND
PTLOC: BLOCK 1 ; SOURCE OF PATCH ADR ,, PATCH ADR
PTLLC: BLOCK 1 ; OLD LLOCO VALUE
PTWRD: BLOCK 1 ; ORIGINAL WORD AT OLD LLOCO
PTAFTR: BLOCK 1 ;[233] 0 IF BEFORE, -1 IF AFTER
SUBTTL STORAGE -- BREAKPOINTS
IFE FTFILE,<
SAVE: 0 ;SAVE THE ACS AND PI SYSTEM
JRST SAVEG
BP1: REPEAT NBP,<
0 ;JSR TO HERE FOR BREAKPOINT
JSA T, BCOM
0 ;HOLDS INSTRUCTION WHILE BREAKPOINT IS IN PLACE
>
B1INS=BP1+2
BPN=.-3
BCOM: 0
JRST BCOMG
BCOM3: SKIPE 0 ;ADDR MOD TO LOOK AT COND. INST.
BCOM2: SOSG 0 ;ADDR MOD TO LOOK AT PROCEED COUNTER
LEAV1: XWD 0,LEAVG
BREAK2: ROT S,.-. ;ROT BY # OF BREAK POINT
PROC0: HRRZI R,XEC1 ;MODIFIED TO ADDR OF BREAKPOINT
LEAV: 0 ;INSTRUCTION MODIFIED
CPUSHP: PUSH .-.,BCOM ;GETS MODIFIED IN AC FIELD
SWAP: 0
JRST SWAPG
> ;END IFE FTFILE
SVBTS: 0 ;BYTE MASK FOR $O TYPEOUT
SVBTS2: 0
OLDAR: 0
PSVBTS: BLOCK 3 ;SAVE BLOCK FOR ABOVE 3 ON $$O
BYTMSK: BLOCK 1 ;[235] $3M BYTE MASK
SUBTTL STORAGE -- SYMBOL TABLE LOGIC
PNTR: EXP INST ;POINTER TO BITS IN INST
INST: 0 ;BINARY FOR INSTRUCTION
CHP: 0 ;CHAR POINTER INTO TXT, TXT+1
TXT: BLOCK 2 ;STORE INPUT TEXT FOR OPEVAL
SAVPDL: 0 ;SAVE PUSH DOWN LIST POINTER
WRD: 0
WRD2: 0
PRNC: 0
FRASE: 0 ;DONT CHANGE ORDER, SEE SEARC+3
SYL: 0
LWT: 0
TEM2: 0
FRASE1:
TEM3: 0
DEN: 0
SAVHSM: BLOCK 1 ;C(.JBHSM), USED BY EVAL, LOOK
SEGNAM: 0 ;THE HIGH SEGMENT NAME (OR 0)
;WHEN $: IS SUCCESSFULLY DONE
PRGM: 0
ESTUT: 0
FSV: 0
FH: 0
SYM: 0
IFN FTDEC10,<
IFE FTFILE,<
SYMP: Z .JBSYM ;POINTS TO LOW SEG SYM TABLE POINTER
USYMP: Z .JBUSY ;POINTS TO UNDEF SYM TABLE POINTER
>
IFN FTFILE,<
SYMP: Z FISPTR
USYMP: Z FIUPTR
>>
IFN FTDEC20,<
IFN FTEXEC,<
SYMP: Z .JBSYM
USYMP: Z .JBUSY>
IFE FTEXEC,<
SYMP: Z .DDSYM
USYMP: Z .DDUSY
>
JDTFLG: -1 ;JOB DATA AREA VALID IF NON-0
> ;END IFN FTDEC20
SYMPNT: 0 ;USED BY SYM TABLE SEARCHES
SPSAV: 0 ;POINTER TO LAST SYMBOL TYPED
DEFV: 0
ULIMIT: 0
LLOC: 0
LLOCO: 0
SAVLP: 0 ;POINTER TO SAVLOC TABLE
NSAVTB==20 ;SIZE OF SAVLOC TABLE (RING BUFFER)
SAVLTB: BLOCK NSAVTB ;SAVLOC TABLE
SYMORD: 0 ;HOLDS ADDRESSES OF EVAL-OPEVAL ROUTINES
;SPECIFYING WHICH ORDER TO SEARCH THEM FOR SYMBOLS
QLPNT: 0 ;USED IN "QLIST" AS POINTER TO A SYMBOL
LCNT: EXP LISCNT ;[224] LISTEN'S BETWEEN INCHRS'S
SKPCT: 0 ;SKIP COUNT FOR XCT
EFAFLG: 0 ;EFF ADR COMP MODE
IFN FTEXEC!FTFILE,<
EPTUPT: 0 > ;LH - EPT POINTER , RH - UPT POINTER
IFN FTYANK,<PTDFLG: 0> ;EOF SEEN ON COMMAND FILE
SUBTTL STORAGE -- SAVE AREAS FOR PREVIOUS CONTEXT
IFE FTFILE,<
SAVAPR: 0 ;USED TO SAVE APR REGISTER IN EXEC MODE
SAVPI: 0
1177
;THESE LOCATIONS MUST BE IN ORDER - THEY ARE USED TO SAVE AND
;RESTORE THE STATE OF DTE FOR KL10
SAVTTY: 0
IFN FTEXEC,<
SAVUNS: 0
SAVEPW: 0
SAVERW: 0
SAVDPW: 0
SAVDRW: 0
SAVEBR: 0 ;SAVED EXEC BASE REG
MTRCNI: 0 ;RESULT OF CONI MTR,
TIMCNI: 0 ;RESULT OF CONI TIM,
MSTRDT: 0 ;ID OF MASTER -11
DING11: 0 ;PROTOTYPE CONO WORD FOR DTE
> ;END IFN EDDT
IFN FTDEC20,<
SAVTT2: 0
SAVTT3: 0
LASTPG: 0
SAVSTS: 0
> ;END IFN FTDEC20
> ;END IFE FTFILE
MSK: XWD -1,-1
IFN FTEXEC,< ;CELLS FOR TRACE FACILITY
TRCON: 0 ;ASSUMED AT $M+1
TRCDMP: 0> ;ASSUMED AT $M+2
IFE FTFILE,<
B1ADR: 0
B1SKP: 0
B1CNT: 0
REPEAT NBP*3-3, < 0>
BNADR=.-3
AUTOPI: 0
AC0: BLOCK 17
AC17: 0
>
SUBTTL STORAGE -- STATE VARIABLES
SCHM: EXP PIN ;DO NOT CHANGE ORDER
ARM: EXP PADSO
ODFM: EXP 10
SARS: 0
TEM: 0
TEM1: 0
SYMOFS: EXP ADRNGE ;[234] RANGE FOR SYMBOL+OFFSET TYPEOUT
NSYMCS==40 ;SIZE OF SYMBOL TABLE CACHE
SYMCSH: BLOCK NSYMCS ;SYMBOL TABLE CACHE
SYMCSP: BLOCK 1 ;POINTER TO NEXT FREE ENTRY
OLDSYM: BLOCK 1 ;REMEMBER CACHE SYMBOL TABLE
IFN FTEXEC,<
USRFLG: 0 ;-1 IN USER MODE, 0 IN EXEC MODE
KAFLG: 0 ;0 FOR KI10; 1,,0 FOR KA10 OR PDP-6
XNXTCH: 0 ;PRESET INPUT CHAR AT XLISTE
> ;END IFN FTEXEC
IFN FTFILE,< ;FILDDT STUFF
FWAZER:! ;START OF AREA TO ZERO
FILDEV: BLOCK 3 ;OPEN BLOCK FOR CRASH FILE
FILBLK: BLOCK 6 ;LOOKUP BLOCK FOR CRASH FILE
LBUF: BLOCK 3
SYMGET: Z ;-1 IF /S, 0 IF NOT
CRASHS: Z ;-1 IF CRASH.SAV ON DISK ,0 IF PEEK AT MONITOR
FDIDOT: Z ;-1 IF . TYPED IN, 0 IF NOT
PATCHS: Z ;-1 IF PATCHING MODE
FDIDSW: BLOCK 1 ;[207] "/D" TYPED IF .NE. 0
IFN FTFD20,<
XBLOC: Z ;INDEX BLOCK SPT INDEX
SPTLOC: Z ;SPT LOCATION (FROM FILE)
REFADR: Z ;TEMP STORAGE IN CVTADR
>
CHGSFL: Z ;CHANGED SYMBOL TABLE
AC0=.
AC17=.+17
CRSHAC: BLOCK 20 ;CRASH AC'S
FAKEAC: BLOCK 1 ;[207] .NE. 0 FOR AC REFS TO CRASHAC
FETPAG: BLOCK 1 ;ADDRESS OF PAGTBL ENTRY FOR LAST
; CALL TO FETCH
FETADR: BLOCK 1 ;INCORE ADDRESS OF DATA WORD FROM LAST
; CALL TO FETCH
WINNUM: BLOCK 1 ;WINDOW TO READ OR WRITE
WINDIR: BLOCK CT.RES ;ADDRESS OF PAGTBL ENTRY FOR
; EACH WINDOW SLOT
PAGTBL: BLOCK MX.SIZ ;1 WORD FOR EVERY VIRT. PAGE
;BITS 0-4 .EXE FORMAT FLAGS
;BIT 5 PAGE IN CORE CHANGED
;BITS 9-17 WINDOW # PLUS 1
;RH - FILE PAGE NUMBER
WIND0: BLOCK CT.RES*PAGSIZ ;WINDOWS
XPNFMT: BLOCK 1 ;FILE IS IN .XPN FORMAT
LWAZER==.-1 ;END OF AREA TO ZERO
FISPTR: Z ;POINTER TO SYMBOLS
FIUPTR: Z ;POINTER TO UNDEF SYMS
MONSIZ: BLOCK 1 ;HIGHEST LOC+1 IN CRASH.SAV FILE
;(USED SO WE WON'T EXAMINE PAST END)
SAVEFF: Z ;WHERE TO LOAD SYMBOLS IF /S
> ;END IFN FTFILE
SUBTTL STORAGE -- PUSH DOWN LIST
PDL: BLOCK LPDL ;STORAGE FOR PUSH DOWN LIST
END.V==.
IFN FTDEC20,< IFE FTEXEC,<
VAREND: ;END OF INITIALIZED VARIABLES AREA
.DDSYM: 0 ;SYMTAB PTR (COPIED FROM .JBSYM USUALLY)
.DDUSY: 0 ;UNDEF SYMTAB PTR (COPIED FROM .JBUSY " )
SETRT1: 0 ;SCRATCH FOR VARIABLE INITIALIZATION
END.V==.
DEPHASE
>>
DDTEND:
IFDEF VARLOC,< IFDEF RUNLOC,< IFDEF PHDDT,<
IFL <VARLOC-RUNLOC>-<DDTEND-PHDDT>,<
PRINTX ?VARIABLES OVERLAP CODE
>>>>
DEFINE PRSIZE(CODEN,DATAN),<
IF2,< PRINTX [ CODEN WORDS CODE + DATAN WORDS DATA]
>>
RADIX 10
PRSIZE(\<END.C-DDT>,\<END.V-BEG.V>)
RADIX 8
;THE FOLLOWING DEFINES CERTAIN SYMBOLS RELEVANT TO HARDWARE OR TO
;DDT ITSELF. THESE ARE *NOT* NEEDED FOR THE ASSEMBLY OF DDT AND
;IN FACT MAY BE IN CONFLICT WITH DEFINITIONS WHICH ARE USED
;DURING ASSEMBLY (E.G. TTY). HENCE, THESE DEFINITIONS ARE ASSEMBLED
;LAST AND ON PASS 2 ONLY. THE SYMBOLS ARE ALL DECLARED INTERNAL
;SO THAT THEY WILL BE KEPT IN THE PROGRAM SYMBOL TABLE AFTER
;LOADING. THESE SYMBOLS ARE THEN USED DURING DDT INSTRUCTION
;ASSEMBLY OR DEASSEMBLY ONLY.
IFN FTDEC10,< ;DDT SYMTAB NEVER USED ON DEC20
IF2,<
DEFINE XP (SS,VV)<
SS=VV
INTERN SS>
OPDEF DDTINT [Z 0,] ;ADDRESS FLAG FOR INTERNAL REGISTERS
;DEFINE $ SYMBOLS INTERNAL TO DDT
IFE FTFILE,<
RADIX 10
DEFINE DBPNT (Z.)<XP $'Z.'B,<DDTINT B1ADR+3*Z.-3>>
ZZ==0
REPEAT NBP,<DBPNT \<ZZ==ZZ+1>>
RADIX 8
XP $M,<DDTINT MSK>
XP $I,<DDTINT SAVPI>
> ;END FTFILE
;DEFINE I/O DEVICE MNEMONICS
IFN FTEXEC,<
XP PI,004B11
XP PAG,010B11
XP CCI,014B11
XP DLB,060B11
XP DLC,064B11
XP CLK,070B11
XP PTP,100B11
XP PTR,104B11
XP CDP,110B11
XP CDR,114B11
XP TTY,120B11
XP LPT,124B11
XP DIS,130B11
XP PLT,140B11
XP CR,150B11
XP DSK,170B11
XP DTE,200B11
XP UTC,210B11
XP UTS,214B11
XP MTC,220B11
XP MTS,224B11
XP MTM,230B11
XP DLS,240B11
XP DPC,250B11
XP DCSA,300B11
XP DCSB,304B11
XP DTC,320B11
XP DTS,324B11
XP TMC,340B11
XP TMS,344B11 >
;DEFINE EXTENDED OPERATIONS
IFE FTFILE,<
XP JOV,2554B11
XP JEN,2545B11
XP HALT,2542B11 >
> ;END IF2
> ;END IFN FTDEC10
;ONLY STARTING ADDRESS FOR FILDDT AND VMDDT
;NO START ADDRESS FOR EXEC OR USER DDT
;BECAUSE USER PROGRAMS AND MONITOR ARE LOADED
;WITH EXEC OR USER DDT
;BUT STILL WANT TO BE STARTED AT THEIR OWN START ADDRESSES
IFN FTVMX,<END MAKDDT>
IFN FTFILE,<END DDT>
IFE FTEXEC,<
IFN FTDEC20,<
IFE FTMON,<
END BLTDDT>>> ;UDDT HAS SPECIAL START ADR
END