Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/raid.fai
There is 1 other file named raid.fai in the archive. Click here to see a list.
COMMENT VALID 00084 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00008 00002 SWITCHES DEFINE VERSIONS, TITLE STATEMENT
C00012 00003 Accumulators, Bits, Macros
C00018 00004 Descriptions, Global Structures
C00027 00005 Cache Structures, Explanations -- other DCS additions
C00032 00006 Break Tables, for Special Activation Mode Scanning
C00034 00007 Gchr1, Gchr, Chtb1, Chtb2
C00038 00008 Non-Stanford Get a character, activate on activation routine
C00040 00009 GCHRS
C00043 00010 Main Dispatch, <ctrl>., Numbers -- SCAN
C00048 00011 Letters, Decimal, Text -- SLET, DECMAL, TEXT
C00053 00012 TMPMOD, EXTTXT, AMPER, ENSYM
C00058 00013 Byte Input
C00062 00014 PNTIN POINT MODE INPUT
C00064 00015 Escan -- Scan and Check Reasonable
C00065 00016 Eval
C00070 00017 ATCHK: 0
C00074 00018 Racgt, Jacgt, Once, Svacs
C00089 00019 Parameters, Headers, Buffers, Variables for Data Display
C00096 00020 Spwget, Dset, Mksel
C00101 00021 Redraw, Redisp, Fredsp -- Display Program
C00103 00022 Loop1, Rdo -- Main Line Control, Each Line Code
C00105 00023 RET2, ARND1
C00107 00024 Godis -- Actual Displaying Code
C00108 00025 RDTRKE, WRTRK
C00114 00026 Bclr, Mooror (Display Driver), Crlfot, Offok
C00120 00027 Getpoi -- Handle Multi-Level Display
C00123 00028 Conv -- Output Conversion Routine Dispatch
C00125 00029 Fndptr, Fndtbl, Conflg, Rhflg, Lhflg -- J, L, R Commands
C00129 00030 Hlfwrd, Instr, Opdret, Noacq
C00135 00031 INPTBL INSTRUCTION PRINTING TABLE
C00140 00032 Rhtext, Adtyp, R5typ, ADSEL, TRYSYM
C00145 00033 Conoct, Consix, Sixout, Opdf
C00148 00034 Conasc -- Ascii Printer
C00151 00035 CONR50, CONXWD, CONBP
C00153 00036 Conflt -- Floating Point Output Routine
C00158 00037 Condec, Conbyt -- Decimal, Byte Printer
C00161 00038 Stsprt, Prgprt, Blkprt -- special top lines conversions
C00164 00039 Spblt, Iotbl, Iofndi -- These Belong Elsewhere
C00167 00040 Search Routines -- Oplook -- Opcode (Built-in) Finder
C00174 00041 TABIO, TAB, TABOR
C00179 00042 TAB1LO:
C00183 00043 SRCH1, SRCH, FNDOP
C00189 00044 SUUO
C00192 00045 IFE SORTED,< STANDARD SYMBOL TABLE (UNSORTED) ROUTINES (ENDS ON PAGE 46)
C00197 00046 BLKCHK: MOVE E,1(PV) GET VLOCK LEVEL
C00199 00047 Symlok -- SymbolValue Searcher -- Wrap, Csflush, Cpopj
C00204 00048 Prgfnd, Prgset, Blkfnd, Blkfn
C00209 00049 IFN SORTED,< (ENDS ON PAGE 55) SETSYM
C00213 00050 Fndsym -- The VALSYM Symbol Table Searcher.
C00218 00051 FSYM
C00221 00052 BINGO, WCHBLK, GETRNG
C00227 00053 TABLES FOR LOG SEARCH OF SYMBOL TABLE SUBRNG
C00229 00054 Symlok -- SymbolValue Searcher -- Csflush
C00236 00055 Prgfnd, Prgset, Blkfnd, Blkfn
C00242 00056 Raid, Eret, Main, Inerr, Cerr, Pu, Unpur -- Main Loop, Dispatcher
C00247 00057 Ctab -- Dispatch Table
C00254 00058 Modset, Tmdst, Amodst, Nmdst, Umodst, Bytmod, Flgmod, Lftt, Rftt
C00257 00059 Depo1, Echk
C00260 00060 IFE SORTED,<
C00262 00061 IFN SORTED,<
C00264 00062 Depo, Opens, Openu, Fndscr, Openp -- Open a Cell (see if it's there)
C00268 00063 Macdef, Macexp, Macimm -- Define and Expand Macros
C00270 00064 Edit -- Edit Previous Value Using System Line Editor
C00275 00065 Upar,Lnfd,Lefsq2,Tab,<,>,Routs,<tab>,MVTST,MOVDN,MOVUP,REMPER,SCLR
C00281 00066 Sclrsv, Incr, Leffnd, Eqiv, Wdsrch, Etc., Inc
C00287 00067 Wdsrch Subroutines
C00289 00068 Symdef, Symdf1, Symkil, Symfnd, Symfn1 -- Create and Delete Symbols
C00292 00069 IFN SORTED,< Symdef, Symdf1, Symkil -- Create and Delete Symbols
C00301 00070 REVIVE, SYMKIL, SYMNIL, ZAPSYM, SYMFND, SYMFN1
C00305 00071 $nB, 1 n Brknum -- Brkins, Brkjsr, Dobrk, Brkpln
C00312 00072 Brkrem, Brkpul, Tbproc
C00315 00073 Proced, Gpelop, Elop, Pstbrk, Prmbrk, $SBP
C00322 00074 Steppe, Stepp, Xeq1, Xeq2
C00326 00075 Xeq3, Yxeq, Mstep, LEAVE
C00332 00076 Some Random Variables
C00333 00077 SORTED SYMBOL TABLE FORMAT
C00338 00078 SORT
C00341 00079 NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
C00345 00080 PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE. BUILD BN/BS AREAS
C00349 00081 WE SORT THINGS HERE
C00353 00082 CALL WITH B=FIRST ADDRESS IN RANGE, C=ADDRESS OF LAST ITEM IN RANGE
C00356 00083 SYLPOP, CLASS
C00360 00084 VAR
C00361 ENDMK
C;
;SWITCHES; DEFINE VERSIONS, TITLE STATEMENT
DEFINE SETSYS (SWITCH,VAR) <
IFDEF VAR,<SWITCH__1>
IFNDEF VAR,<SWITCH__0>
>
SETSYS (STANFO,SPCWAR)
SETSYS (TENEX,GETJFN)
IFE STANFO!TENEX,<DECSW__1;>DECSW__0
SORTED__1 ;SORTED SYMBOL TABLE
REALSW__1 ;ASSEMBLE VERSION WITH ALL INTERNALS
;(REALSW_0 FOR DEBUGGING SO NO GLOBAL CONFILICTS)
DMOVSW__REALSW ;IF ONE, THE DISPLAY IS IN THE NORMAL RAID AREA
PADSYM__1-STANFO ;PAD THE SYMBOL TALBE WITH ....XX GLOBALS
FILESW__0 ;ASSEMBLE FRAID FOR GROVELLING OVER FILES
UESW__0 ;ASSEMBLE UERAID FOR LOOKING AT SYSTEM
EXDSW__1 ;LEAVE THIS WAY UNTIL RAID IS FIXED TO LOOK
;AT $IO INDEPENDENT OF THIS SWITCH, AND ALSO
;LOOK FIRST IN THE SYMBOL TABLE FOR DEVICE CODES
DEFINE PRNTOP <PRINTS>
DEFINE VALPNT (VAL) <
PRNTOP /VAL/
>
IFN STANFO,<PRNTOP /ASSEMBLING FOR STANFORD
/>
IFN TENEX,<PRNTOP /ASSEMBLING FOR TENEX
/>
IFN DECSW,<PRNTOP /ASSEMBLING FOR DEC SYSTEM
/>
PRNTOP /SWITCHES ARE:
/
FOR SWITCH IN (STANFO,TENEX,DECSW,REALSW,UESW,FILESW,DMOVSW,EXDSW,SORTED,PADSYM) <
PRNTOP /SWITCH(/
VALPNT (\SWITCH)
PRNTOP /) /
>
PRNTOP /
TYPE NEW VALUES FOR THESE SYMBOLS, IF ANY, FOLLOWED BY /
IFN STANFO,<PRNTOP /CONTROL-META-LF
/>
IFE STANFO,<PRNTOP /CONTROL Z
/>
.INSERT TTY:
FOR SWITCH IN (STANFO,TENEX,DECSW,REALSW,UESW,FILESW,DMOVSW,EXDSW,SORTED,PADSYM) <
IFN SWITCH,<SWITCH__1>
IFE SWITCH,<SWITCH__0>
>
IFN UESW,<
TITLE UERAID
PRNTOP /ASSEMBLING UERAID
/
REALSW__0
FILESW__0
>
IFN FILESW,<
TITLE FRAID
PRNTOP /ASSEMBLING FRAID
/
REALSW__0
SORTED__1
PADSYM__0
>
IFE FILESW!UESW,<
IFE REALSW,<
TITLE DRAID
PRNTOP /ASSEMBLING DRAID
/>
IFN REALSW,<
TITLE RAID
PRNTOP /ASSEMBLING RAID
/>
>
IFE REALSW,<IFNDEF DEBSYM,DEBSYM__0> ;DEBSYM USES JOBSYM LOCAL INSTEAD OF EXTERN
IFN REALSW,<DEBSYM__0>
DEBSYM__DEBSYM
IFN FILESW,<.INSERT RAID.SUB[CSP,SYS]>
IFE UESW!TENEX,<SEGSW__1;>SEGSW__0
;SEGSW MEANS BE ABLE TO LOOK AT SECOND SEGMENT CORE
;Accumulators, Bits, Macros
A_1
B_2
C_3
D1_4
D2_5
D3_6
E_7
F_10
M_11
T_12
F1_13
PNT_14
PV_15
V_16
P_17
EXTERNAL JOBHRL,JOBFF,JOBOPC,JOBDDT
;FLAGS -- FLAG REGISTER, LEFT HALF
NUMF__200000 ;SCAN RETURNED A NUMBER (VALUE)
SYMF__100000 ;SCAN RETURNED A SYMBOL
UNDF__40000 ;SCAN RETURNED AN UNDEF SYM.
FLTF__20000 ;SCAN RETURNED A FLOATING POINT NUM.
SCFL__10000 ;SCAN IS AHEAD ONE CHR.
R5FL__4000 ;INTERNAL SCAN FLAG -- RADIX50 INPUT
VALF__2000 ;EVAL RETURNED A VALUE
LOCOPF__1000 ;LOCATION OPEN (STORE LEGAL)
SINGF__400 ;EVAL SAW A SINGLE SYMBOL
EHDF__200 ;EVAL IS AHEAD ONE THING
ESPCF__100 ;EVAL SAW A SPACE (TRUNCATE TO 18 BITS)
FIRF__40 ;SCAN -- DO NOT LOOK FOR OPCODES
USINGF__20 ;EVAL SAW UNDEFINED SINGLE SYMBOL
PMULFL__10 ;MULTIPLY DEFINED SYMBOL
PUFL__4 ;UNDEFINED SYMBOL, DISPLAY "U"
EVMF__2 ;EVAL MINUS FLAG
STARSW__1 ;PUT BIG * ON SCREEN NEXT REDISP
;FLAG REGISTER, RIGHT HALF
SRCHSW__400000 ;SEARCH IN PROGRESS
BYTSW__200000 ;SWITCH FOR EVAL::: TERMINATE ON COMMA
CONOF__100000 ;I/O OPCODE FOUND -- EVAL HANDLE COMMA DIFFERENT
CONOFF__40000 ;I/O OPCODE FOUND ON OUTPUT
CNVABS__20000 ;USE ABS VALUES IN CONVERTING
DOSETL__10000 ;WE HAVE SEEN AN ALT-MODE, AND HAVE TO SET REGULAR
;ACITIVATION MODE.
DRWALL__2000 ;REDRAW ALL DISPLAY LINES NEXT REDISP
DPYALL__1000 ;REGENERATE ALL DISPLAY LINES NEXT REDISP
ISOPC__400 ;JOBOPC USED FOR BP ADDR
;SYMBOLIC REPRESENTATIONS OF DATA MODE CODES, FOUND IN DPNT AND DCON ARRAYS
CYM__1 ;"C"YMBOLIC
OCL__2 ;OCTAL
OCL1__3 ;SIGNED OCTAL
HLF__4 ;HALFWORD
TXT__5 ;TEXT, 5 IS RADIX50, 6 IS SIXBIT, 7 IS ASCII
FLG__10 ;FLOATING
BYT__11 ;BYTE MODE OUTPUT
DCM__12 ;DECIMAL
UTX__13 ;RH BYTE TEXT, 13 IS RADIX50, 14 IS SIXBIT, 15 IS ASCII
BTP__16 ;CTRLQ, BYTE POINTER DISPLAY
BTS__17 ;BIT BY BIT DISPLAY, USING TABLE
LBT__20 ;LEFT HALF BIT DISPLAY
RBT__21 ;RIGHT HALF BIT DISPLAY
STS__22 ;STATUS LINE CONVERSION (U, OK, PURE, ?, ETC.)
PRG__23 ;PROGRAM NAME CONVERSION
BLK__24 ;BLOCK NAME CONVERSION
;...
ABS__40 ;ABSOLUTE MODE (OR'ED WITH OTHERS)
;INDICES FOR STATUS LINE ENTRIES
.OK__0 ;"OK"
.HUH__1 ;"?"
.MUL__2 ;"M -- sym"
.UND__3 ;"U -- sym"
.SKIP__4 ;"SKIPn"
.STAR__5 ;"*"
.MEM__6 ;"MEM?" NONEXISTENT ADDR (TENEX)
.PURE__7 ;"PURE?"
.PROT__10 ;"PROT?" ;MEMORY PROTECTION VIOLATION
.ILL__11 ;"INST?" ;ILLEGAL INSTR (TENEX)
;SEE DPNT ARRAY DESCRIPTION FOR POSITION OF THESE BITS
OPDEF FLOAT [FSC 233]
OPDEF TNOFFS [043000,,'SSW']
IFE STANFO,<
DEFINE SETLIN (A,B) <>
DEFINE GETLIN (A,B) <>
DEFINE SETACT (A,B) <>
DEFINE UNPURE (A,B) <>
>;NOT STANFO
IFN TENEX,<
OPDEF JSYS [104000,,]
OPDEF PBIN [JSYS 73]
OPDEF PBOUT [JSYS 74]
OPDEF PSOUT [JSYS 76]
OPDEF CBIBF [JSYS 100]
OPDEF RFMOD [JSYS 107]
OPDEF SFMOD [JSYS 110]
DEFINE INCHRS <
MOVEI A,100
SIBE
JRST [ PBIN
JRST .+2]
>
>;TENEX
DEFINE RDF ! (SYM,VAL) <
SYM__VAL
SYM!V__1
>
DEFINE LDF ! (SYM,VAL) <
SYM__VAL
SYM!V__0
>
DEFINE TB $ (E,A,B) <
IFE B$V,<TL$E A,B>
IFN B$V,<TR$E A,B>
>
IFN UESW,<
DEFINE MO(A,B) <
MOVEI A,(B)
PEEK A,
>
>
DEFINE CMOVE (A,B) <
IFE UESW,<
CAIGE B,20
ADDI B,JAC
MOVE A,(B)
>
IFN UESW,<
MO (A,B)
>
>
IFN STANFO,<ALTMOD__175> ;CODE FOR ALT MODE
IFE STANFO,<ALTMOD__33>
ESC__176 ;CODE FOR VTS ESCAPE CHAR
HILOC__135
;Descriptions, Global Structures
COMMENT
Here (and below, in display routines) are some of the crucial
variables and arrays in RAID.
IFE SORTED,<
SYMPRG
contains [2*#syms left,,prog name] for currently `open'
program. #syms left is # symbols between this point and the
base of the symbol table. Routines which search for things
start here and are forced to `WRAP' when the count runs out
SYMPNT
is [#syms left,,block name] (or prog name) for currently
`open' block. It is normally used as the starting point in
symbol searches. It is located directly before the DPNT array,
which contains one entry per line, because some routines treat
SYMPNT nonspecifically as an integral part of the state
description for the screen.
>;NOT SORTED
IFN SORTED,<
PID
is index within BLKNAM/BLKVAL tables (see storage structure)
of currently open program, -1 if none.
BID
is the index of the currently open block, -1 if none. It is located
directly before the DPNT array, which contains one entry per line,
because some routines treat BID nonspecifically as an integral
part of the state description for the screen.
>;SORTED
DPNT
is long enough to contain one entry per line, for the maximum
(MAXDLN) number of lines allowed. Each entry contains 0 (not used)
or a word locating the thing displayed on that line, and identifying
its current display mode. Each word has the following format:
Left half:
Bit 0: If on, this line is protected
Bits 1-6: any numeric value needed to completely specify the mode
(e.g. the number of bits per byte, the number of the
`bit descriptor table' for J,L, and R modes).
Bit 7: On if ABS mode active -- don't display addresses or ACs as
symbols.
Bits 8-12: The data mode code -- one of the values described symbolically
above.
Bit 13: Not only is the value whose adr is RH(this) displayed, but some
part of that value is used as an address of another thing to
display. (CTRL1-CRTL2@ was used on this guy, for example).
There exists elsewhere in DPNT another entry requesting display
of that further value (see directly below).
Bit 16: LH of value word used as address of another word to display,
unless bit 17 is also on.
Bit 17: If bit 16=0, RH of value word used as address of another, else
effective address represented by value word is used.
Right half:
The address of the thing being displayed (or a pointer to it, see above).
SPNT
Left half: DPNT, first word
Right half:
Minus the number of lines currently displayed (changed by the
I command). This pointer is used to control systematic searches
of DPNT and related tables. Why it is stored swapped is
probably a function of some clever trick in the code below. (SEE INCR)
DCON
This array has one entry for each one in DPNT, and one extra for
SYMPNT. In it is stored the current DPNT values, after each time the
screen is updated. The screen updater next time through compares these
saved values to the current ones to detect changed lines.
DDCON
In this array is stored the current values of the things pointed
to by DPNT entries. If a DPNT entry matches its DCON entry, then
the current core location value is checked against the saved value in
the REDISP (screen update) routine, to determine whether changes must
be made.
These latter two arrays are to be found down around REDISP
CURMOD
Left half -- `permanent' mode, set by CTRL2<mode>.
Right half -- `current' mode, set by CTRL1<mode>, reset to permanent by
[CR] with no argument.
These modes are in the format described above
LOCOP: address of currently open location
STPOP: address of next instruction to be executed
(Set by breakpoint or CTRL-X, or CTRL-S)
JAC: job's ACs are stored here while RAID is running
RAC: RAID's ACs are stored here while job is running
IFN SORTED,<
BLKVAL, BLKVL1, BLKNAM, BLKNM1, BLKSIZ, SYMBAS, RNGBAS, RNGBS1, etc.,
are @ pointers to the various areas of the symbol table, see description
of table structure. The different versions of the same thing differ
only by what AC they have in their index field.
>;SORTED
IFN REALSW,<
LOC 74
RAIDVER__4 ;PROGRAMS CAN DETECT VERSION
<RAIDVER5>,,DDT ;SET JOBDDT
RELOC
INTERNAL $BGDDT
$BGDDT: ;IDENTIFY BEGINNING OF RAID
>
BEGDDT:
DPLOC: 777400
IFN SORTED,<
SYMBAS:0
SYMRNG:0
SAVJSM:-1 ;SAVED JOBSYM, USED FOR SEEING IF JOBSYM HAS CHANGED
RNGBAS:0
RNGBS1:0
BLKVAL:0
BLKVL1:0
BLKNAM:0
BLKNM2:0
BLKSIZ:0
UNIQ: 0 ;USED DURING SYMBOL SEARCH
UNIQP: 0
GLOBB: 0
BESTB: 0
PID: -1 ;PROGRAM INDEX
BID: -1 ;BLOCK INDEX, MUST IMMEDIATELY PRECEDE DPNT
>;SORTED
IFE SORTED,<
SYMPRG: 0 ;MUST IMMEDIATELY PRECEDE SYMPNT
SYMPNT: 0 ;MUST IMMEDIATELY PRECEDE DPNT
>;NOT SORTED
MAXDLN__27
DPNT: STS5,,NBIGWD ;STATUS LINE
IFN SORTED,<PRG5,,BID>
IFE SORTED,<PRG5,,SYMPNT>
BLOCK MAXDLN
SPNT: DPNT+2,,-=20 ;RH INITIALIZED AT DSET
CURMOD: CYM5,,CYM5 ;START SYMBOLICALLY
SCRMAX: MAXDLN-2-1 ;MAXIMUM NUMBER OF LOCATIONS DISPLAYED - 1
RAC: BLOCK 20 ;RAID'S ACS
LOCOP: 0
STPOP: 0
SAVPNT: 0
DDSW: -1 ;DEVICE SPECIFIER, SEE DPY CODE
ACSW: 0 ;RACGT'S SWITCH
PDLEN__200
PDL: BLOCK PDLEN
JAC: BLOCK 20 ;JOB'S ACS
;Cache Structures, Explanations -- other DCS additions
COMMENT
The following data was added by DCS -- 10/15/70
SAVMOD -- approp. mode codeRH(SAVMOD) from first EVAL call on SCAN
(via TMPMOD rout.) If EVALs value is deposited (via CR, >,<, etc.)
this mode is used for this line only. Cleared in MAIN loop and elsewhere.
EXBUF -- stores text string during collection of multi-word ASCII input.
Text string takes form of several single-word ASCII deposit specifications,
separated by ">" commands. Feature incited by use of CTRL1"...
STSAV -- BP to EXBUF put here after multi-word string collected. This
word 0 tells DEPO routine that STSAV should be transferred to STRING,
causing successive deposits of the words in the string.
BRKREF -- up to NUMREF copies of different SYMPNTs (BIDs) are stored here
when CLTR1& is executed. No duplicate entries allowed.
PRGREF -- corresponding program names
REFPNT -- contains index to most recent entry into BLKREF, PRGREF
REFGET -- ditto of most recently opened block. CTRL1-Z can be used to open
blocks remembered by these arrays and pointers. CTRL1-Z effects REFGET,
not REFPNT. See REFBLK and following routines for details.
SYMCSH -- contains the NUMCSH most recently-seen symbol names.
SYMVAL -- contains the corresponding symbol table pointers. These
are placed here by SYMLOK; SYMLOK also searches this small list
before referring to the complete symbol table.
SCSHPT -- (wraparound) index of most recent entry in above arrays
VALCSH,VALSYM,VALBLK,NCSHPT serve similar functions to SYMCSH et. al.
in the inverse FNDSYM routine.
SAVMOD: 0
EXTLN__=32
EXBUF: BLOCK EXTLN ;FOR EXTENDED TEXT STRING INPUT
EXEND_.-1
STSAV: 0 ;SAVE BP FOR EXTENDED TEXT OPERATIONS
;PREVIOUS PROG/BLOCK REFERENCE TABLES
NUMREF__8 ;MAX NUMBER OF SAVED PROG/BLOCK REF'S
REFPNT: IFE SORTED,<0;>-1 ;MOST RECENTLY ENTERED PROG/BLOCK
REFGET: 0 ;MOST RECENTLY OPENED PROG/BLOCK
PRGREF: BLOCK NUMREF ;SAVED SYMPRG'S
BLKREF: BLOCK NUMREF ;SAVED SYMPNT'S
;SYMBOL "CACHES" FOR SPEEDING UP SYMBOL TABLE SEARCHES
NUMCSH__8 ;MAX NUMBER OF SAVED SYMBOLS, ETC.
SCSHPT: 0 ;
NCSHPT: 0 ;MOST RECENTLY ENTERED VALUE RANGE
SYMCSH: BLOCK NUMCSH ;SYMBOL NAMES, USED IN SEARCH
SYMVAL: BLOCK NUMCSH ;VALUES OF ABOVE SYMBOLS
IFE SORTED,<
VALCSH: BLOCK NUMCSH ;EXACT MATCHES OF PREVIOUS SYMBOL SEARCHES
VALSYM: BLOCK NUMCSH ;SYMBOLS CORRESPONDING TO ABOVE VALUES
VALBLK: BLOCK NUMCSH ;BLOCK NAMES FOR ABOVE SYMBOLS
>;NOT SORTED
CSHEND__.-1
IFE STANFO,<
INBP: 0 ;INPUT BUFFER BYTE POINTER
INBF: BLOCK =40 ;INPUT BUFFER
>;NOT STANFO
SKPVAL: 0
;Break Tables, for Special Activation Mode Scanning
COMMENT BREAK TABLE FOR SPECIAL ACTIVATION MODE -- DCS
IN THIS MODE, ONLY THE CHARACTERS ; < > CR LF ALTMODE TAB
WILL CAUSE ACTIVATION, ALLOWING EDITING BACK OVER MOST ANY
MISTAKE
Simulated for Non-Stanford systems
WD1__WD2__WD3__WD4__0 ;WILL COLLECT BREAK BITS
DEFINE STBT (CHLIST) <
FOR II3 IN (CHLIST) <
II1__II3-(II3/=36*=36) ;MOD
IFN STANFO,<II2__1(=35-II1)> ;THE NEW BIT
IFE STANFO,<II2__1II1> ;THE NEW BIT
IFLE II3-=35,<WD1__WD1!II2>
IFG II3-=35,<IFLE II3-=71,<WD2__WD2!II2>>
IFG II3-=71,<IFLE II3-=107,<WD3__WD3!II2>>
IFG II3-=107,<IFLE II3-=143,<WD4__WD4!II2>>
>
>
;SET UP WD1 THRU WD4
IFN STANFO,<STBT (<11,12,15,74,76,"\",";"," ",ALTMOD>)>
IFE STANFO,<STBT (<11,12,15,74,76,"\",";",ALTMOD>)>
STBT (<""," ">)
IFN STANFO,<
SUPCT__40000 ;SUPPRESS CONTROL T,B,L LINED CMDS (BACKWARD STUFF)
WD4__WD4!SUPCT
>;IFN STANFO
BRKTAB: WD1WD2WD3WD4 ;THE BREAK TABLE
IFN STANFO,<
BRKTI: BLOCK 4 ;ROOM FOR USER'S BREAK TABLE
>;STANFO
IFE STANFO,<
NBSSW: 0
>
;Gchr1, Gchr, Chtb1, Chtb2
BEGIN SCAN
;CHARACTER IDENTIFICATION FLAGS
ILLG__1
NUM__2
LET__4
AROP__20
SSPC__40
BOK__100
BIL__200
BIG__400
SLT__1000
STRID__2000 ;START AN ID GODDAMMIT (FOR FORTRAN KLUDGE)
UOK__4000 ;IT'S OK FOR A SYMBOL PRECEDING THIS CHAR
;TO BE UNDEFINED (OTHERWISE COMPLAIN)
COMMENT
GET A CHARACTER ROUTINES
GCHR1: GET A SINGLE CHARACTER. IF STRIN CONTAINS NON-ZERO,
IT IS ASSUMED TO CONTAIN A BYTE POINTER WHICH IT
THEN USES FOR GETTING CHRS. IF STRIN CONTAINS A ZERO,
IT GETS INPUT FROM THE KEYBOARD.
GCHR: GETS A CHARACTER AND WORRIES ABOUT ALT-MODE (1 ALT = CTRL,
2 ALTS = META, 3 ALTS = CTRL-META) AND BUCKY BITS
GCHRS: GETS A CHARACTER ALONG WITH ITS BITS FROM THE TABLE
LOP1: SETZM STRIN ;CLEAR BUF POINTER
PUSHJ P,SVACS ;SAVE ACS FOR RESTARTING
XCT TYII ;GET 1 CHR. -- THIS WAITS UNTIL AN ACTIVATION CHAR.
IFE STANFO,<
POPJ P,
>
IFN STANFO,<
SKIPN DETFLG
POPJ P,
PUSH P,V
MOVNI V,1
GETLIN V
CAMN V,[-1]
JRST [ POP P,V ;STILL DETACHED
POPJ P, ]
SETZM DETFLG
MOVEM V,USERLIN ;SAVE FOR USER
TLO V,100 ;SPECIAL ACTIVATION MODE
MOVEM V,RADLIN ;FOR NORMAL RAID OPERATIONS
TLZ V,100 ;FOR ASCII INPUT OPERATIONS
MOVEM V,ASCLIN
TLO V,20 ;FULL CHARACTER SET MODE, FOR EDITING
MOVEM V,EDTLIN
POP P,V
POPJ P,
>;STANFO
^GCHR1: ILDB C,STRIN ;GET CHR. (1 CHR.)
JUMPE C,LOP1 ;NONE?
POPJ P,
IFN STANFO,<
^TYII: INCHWL C
>;STANFO
;RETURN 7 BIT CHARACTER IN C, BUCKY BITS IN B. EACH ALTMODE GIVES ANOTHER
;BUCKY BIT.
^GCHR: MOVEI B,0
GCHRB: PUSHJ P,GCHRA
CAIN C,ALTMOD ;ALT-MODE?
IFN STANFO,<
AOJA B,[TRO F,DOSETL ;YES -- FLAG WE HAVE CHANGED MODES.
PUSH P,[INCHRW C]
POP P,TYII ;THIS IS THE INSTRUCTION.
JRST GCHRB]
>;STANFO
IFE STANFO,<AOJA B,GCHRB>
TRNE C,600 ;BUCKY BITS?
LDB B,[POINT 2,C,28] ;YES, GET THEM IN B
IFN STANFO,<
TRZN F,DOSETL ;IF WE WERE IN SPECIAL MODE,
JRST .+3
PUSH P,[INCHWL C] ;PUT TYII BACK
POP P,TYII
>;STANFO
ANDI C,177
POPJ P, ;NO
^GCHRA: PUSHJ P,GCHR1 ;GET 1 CHR.
IFN STANFO,<
CAIN C,15
JRST EATLF
>;STANFO
POPJ P,
IFN STANFO,<
EATLF: SKIPN STRIN
INCHRW C ;GET LF WHICH FOLLOWS CR (ALONG WITH BUCKY BITS)
SKIPE STRIN
ILDB C,STRIN
XORI C,1512 ;CHANGE IT BACK TO CR, PRESERVING BITS
POPJ P,
>
; Non-Stanford Get a character, activate on activation routine
IFE STANFO,<
^TYII: PUSHJ P,.+1
GETCHR: ILDB C,INBP
JUMPN C,CPOPJ
PUSH P,A
JRST GLSET
GLRESET:
IFN TENEX,<
HRROI A,[XS: ASCIZ /XXX
/]
PSOUT
>;TENEX
IFE TENEX,<
OUTSTR [ASCIZ /XXX
/]>;NOT TENEX
GLSET: MOVEI B,0
MOVE C,[POINT 7,INBF-1,34]
MOVEM C,INBP
GLP:
IFE TENEX,<
INCHRW C
>
IFN TENEX,<
PBIN
MOVE C,1
>
SKIPE NBSSW
JRST NOBS
CAIN C,25
JRST GLRESET
CAIN C,177
JRST ADJ
NOBS: CAIN C,177
JRST GLRESET
CAIN C,1 ;CTRL A
JRST ADJ
CAIE C,10
JRST VANILLA
ADJ: MOVSI C,70000
ADD C,INBP
JUMPGE C,.+2
SUB C,[430000,,1]
CAMN C,[POINT 7,INBF-1,27]
JRST GLRESET
MOVEM C,INBP
ILDB C,C
CAIN C,ALTMOD
SUBI B,1
SKIPN NBSSW
MOVEI C,10
IFN TENEX,<
MOVE A,C
MOVE C,[PBOUT]
EXCH C,VTINST
PUSHJ P,VTSOUT
EXCH C,VTINST ;RESET
>;TENEX
IFE TENEX,<
OUTCHR C
>
JRST GLP
VANILLA:CAIN C,15
IFE TENEX,<INCHRW;>PBIN ;SUCK IT
CAIN C,37 ;EOT
MOVEI C,15
IDPB C,INBP
CAIN C,ALTMOD
AOJA B,GLP
JUMPN B,ACT
MOVE A,C
IDIVI A,=36
MOVE A,BRKTAB(A)
MOVEI C,1
LSH C,(B)
MOVEI B,0
TDNN A,C
JRST GLP
ACT: MOVEI B,0
IDPB B,INBP
MOVE A,[POINT 7,INBF-1,34]
MOVEM A,INBP
POP P,A
JRST GETCHR
>;NOT STANFO
;GCHRS
;GET WORD OF CHARACTER IDENTIFICATION FLAGS IN D1 CORRESPONDING TO THE
;CHARCTER READ IN. RETURN THE CHARACTER IN C AND ITS BUCKY BITS IN B
^GCHRS: PUSHJ P,GCHR ;GET 1 CHR IN C, BUCKY BITS IN B
CAIG C,140 ;LOWER CASE?
JRST GCHRSA ;NO
SUBI C,40 ;YES, CONVERT TO UPPER
CAIL C,133 ;LOWER CASE SPECIAL?
ADDI C,5 ;YES
GCHRSA: MOVE D1,C ;GET CHR.
IDIVI D1,=9 ;SEPARATE FOR TABLE FETCH
LDB D1,CHTB1(D2) ;GET TABLE ENTRY
MOVE D1,CHTB3(D1) ;GET BITS
TRNE D1,ILLG ;ILLEGAL CHR?
JRST GCHRS1 ;YES
TRNE D1,BIG ;IGNORE BUCKY?
MOVEI B,0 ;YES, SET BUCKY BITS TO ZERO
TRNN D1,BIL ;BUCKY ILLEGAL?
POPJ P, ;NO
JUMPE B,.-1 ;YES, ANY BUCKY?
GCHRS1: JRST INERR ;YES, ILLEGAL
RADIX =10
CHTB1: FOR I_3,35,4
< POINT 4,CHTB2(D1),I
>
RADIX 8
DEFINE TBM1 (A1,A2,A3,A4,A5,A6,A7,A8,A9,Q)
<IFDIF <>,<Q>,<.FATAL TOO MANY AT CHTB2>
IFIDN <>,<A9>,<.FATAL TOO FEW AT CHTB2>
BYTE (4)A1,A2,A3,A4,A5,A6,A7,A8,A9 >
CHTB2: TBM1 0,0,0,10,10,0,0,0,0 ;0-10
TBM1 10,6,0,0,10,0,0,0,0 ;11-21
TBM1 6,6,0,0,12,0,6,6,6 ;22-32
TBM1 6,0,0,6,10,3,3,5,10 ;33-43
TBM1 11,11,13,5,10,10,3,3,10 ;44-54
TBM1 3,4,3,2,2,2,2,2,2 ;55-65
TBM1 2,2,2,2,13,6,6,5,6 ;66-76
TBM1 10,6,1,1,1,1,1,1,1 ;77-107
TBM1 1,1,1,14,1,1,1,1,1 ;110-120
TBM1 1,1,1,1,1,1,1,1,1 ;121-131
TBM1 1,6,6,6,6,13,0,6,0 ;132-142
TBM1 6,6,0,0,0,0,0,0,0 ;143-153
CHTB3: ILLG ; 0 ILLEGAL CHR.
LET!BOK ; 1 LETTER- BUCKY O.K.
NUM!BOK ; 2 NUMBER - BUCKY O.K.
AROP!BIG ; 3 ARITH OP-IGNORE BUCKY
SSPC!LET!BOK!SLT ; 4 SPCL CHR-LETTR (.)
SSPC!BOK ; 5 " " " BUCKY OK (" ')
BOK ; 6 BUCKY O.K.
BIL ; 7 " ILLEGAL
BIG ;10 " IGNORE
LET!SLT!BOK ;11 SPECIAL LTR ($ %)
STRID!LET ;12 START AN ID GODDAMMIT
BOK!UOK ;13 OK FOR PREV TO BE UNDF (& : _)
BOK!UOK!LET ;14 SAME, LETTER (K)
;Main Dispatch, <ctrl>., Numbers -- SCAN
^SCAN: TLZ F,NUMF!SYMF!UNDF!FLTF!R5FL ;CLEAR FLAGS
TLZN F,SCFL ;GOT A CHR?
PUSHJ P,GCHRS ;NO, GET ONE
TRNE D1,LET ;LETTER?
JRST SLET ;YES
TRNE D1,NUM ;DIGIT?
JRST SNUM ;YES
TRNN D1,SSPC ;SPECIAL SCANNER CHR?
POPJ P, ;NO
CAIN C,"=" ;=?
JRST DECMAL ;YES
CAIN C,42 ; "
JRST TEXT ;YES, TEXT FOLLOWS
CAIN C,"'" ;'
JRST STEXT ;YES, SIXBIT TEXT FOLLOWS
JRST 4,.
LETSPC: CAIN C,"." ;.?
JRST ITDOT ;YES
CAIN C,"%" ;IS IT %?
JRST BYTIN ;YES
POPJ P, ;NO
;WANT VALUE OF CURRENTLY OPEN LOCATION
ITDOT: CAIE B,1 ;1 BUCKY?
JRST DOTBKY ;NO
HRRZ E,LOCOP ;GET VALUE OF .
^ITD1:
IFE UESW,<
JSR ECHK
IFE FILESW,<
MOVE E,(E) ;GET VALUE THERE
>
IFN FILESW,<
PUSHJ P,RDTRKE
MOVE E,@TRKOFF
ITD1A:
>
>;NOT UESW
IFN UESW,<MO (E,E)>
MOVEM E,NM ;STORE VALUE
TLO F,NUMF!SYMF ;SET FLAGS
POPJ P,
DOTBKY: CAIE B,2 ;IS IT META
POPJ P, ;NO
JRST PNTIN ;YES, GET BYTE MODE INPUT
;OCTAL OR FLOATING NUMBER INPUT
SNUM: JUMPN B,CPOPJ ;BUCKY BITS?
MOVE V,[LSH V,3];SET RADIX TO OCTAL
MOVEM V,RAD
DNUM: SETZM FNM ;CLEAR FLOATING NUMBER
SETZM NM ;CLEAR NUMBER
TLOA F,NUMF ;NUMBER, SET FLAG
LOP2: PUSHJ P,GCHRS ;GET CHR.
TRNN D1,NUM ;NUM?
JRST NODIG ;NO
JUMPN B,NODIG ;BUCKY BITS?
MOVEI V,-60(C)
EXCH V,NM ;GET CURRENT NUMBER
RAD: LSH V,3 ;MULT
ADDM V,NM ;ADD IN DIGIT
MOVEI V,-60(C) ;GET DIGIT VALUE
FLOAT V, ;FLOAT DIGIT
EXCH V,FNM ;GET CURRENT FLOATING
FMPR V,[10.0] ;MULT
FADRM V,FNM ;ADD IN DIGIT
JRST LOP2
NODIG: CAIN C,"." ;.?
JRST FLT ;YES
TRNE D1,LET ;LETTER?
JRST SINER ;YES
SINRET: TLO F,NUMF!SCFL ;SET FLAGS
HRRZ E,NM ;IN CASE WANT CONTENTS
JRST ITCHK ;CHECK FOR <ctrl1>`.'
SINER: JUMPN B,SINRET ;BUCKY BITS?
SCINR: JRST INERR ;NO, ERROR
; FLOATING NUMBER INPUT
FLT: JUMPN B,SINRET ;BUCKY BITS?
MOVE C,[0.1]
MOVEM C,NM
MOVEI V,FLG ;SET FLOATING IF ONLY THING SO FAR
PUSHJ P,TMPMOD
FLOP: PUSHJ P,GCHRS ;GET CHR.
TRNN D1,NUM ;NUM?
JRST NODIGF ;NO
JUMPN B,NODIGF ;BUCKY BITS?
ANDI C,17 ;GET DIGIT
FLOAT C, ;FLOAT IT
FMPR C,NM ;SCALE IT
FADRM C,FNM ;ADD IN
MOVE V,NM ;GET SCALE FACTOR
FDVR V,[10.0] ;ADJUST IT
MOVEM V,NM
JRST FLOP
NODIGF: TRNN D1,LET ;LETTER?
JRST FLTRET ;NO
JUMPN B,FLTRET ;NO BUCKY BITS?
CAIE C,"E"
JRST INERR ;LETTER WITHOUT B BITS, ERROR
PUSHJ P,GCHRS ;GET NEXT CHAR
JUMPN B,INERR ;MUST BE + OR - OR NUMBER ALL WITHOUT BUCKY
SETZM NEGPWR#
SETZM NM ;ACCUMULATE EXPONENT HERE
TRNE D1,NUM
JRST FLTEL
CAIN C,"+"
JRST FLTEL1
CAIE C,"-"
JRST INERR
SETOM NEGPWR ;INDICATE NEGATIVE POWER
FLTEL1: PUSHJ P,GCHRS
TRNN D1,NUM
JRST FLTELD
JUMPN B,INERR
FLTEL: MOVE B,NM
IMULI B,=10
ADDI B,-"0"(C)
MOVEM B,NM
JRST FLTEL1
FLTELD: MOVE V,NM
CAILE V,=38
JRST INERR
SKIPE NEGPWR
MOVN V,V
MOVE V,PTENTB(V)
FMPRM V,FNM
TRNN D1,LET
JRST FLTRET
JUMPE B,INERR
FLTRET: TLO F,NUMF!FLTF!SCFL;SET FLAGS
MOVE V,FNM
MOVEM V,NM
POPJ P,
RADIX =10
FOR @! I_=38,1,-1 <
1.0E-!I
>
PTENTB: 1.0
FOR @! I_1,38,1 <
1.0E!I
>
RADIX 8
;Letters, Decimal, Text -- SLET, DECMAL, TEXT
;SYMBOLIC INPUT
SLET: JUMPN B,LETSPC ;BUCKY BITS
TRNE D1,STRID ;START AN ID?
PUSHJ P,GCHRS ;YES -- GET FIRST CHAR.
SETZM SIXSYM
MOVE D2,[POINT 6,SIXSYM]
MOVEM D2,BYTSAV ;SET UP BYTE POINTER FOR SIXBIT
SUBI C,40 ;CONV TO SIXBIT
IDPB C,BYTSAV
TRNE D1,SLT ;SPECIAL LETTER?
PUSHJ P,SLTCN ;YES
SUBI C,'A'-13 ;CONVERT TO RADIX 50
TRNE D1,NUM
ADDI C,'A'-13-17 ;IN CASE FIRST CHAR IS NUMBER.
MOVEM C,SYM ;SAVE
MOVEI V,6 ;COUNT
LOP3: PUSHJ P,GCHRS ;GET CHR.
TRNN D1,LET!NUM ;LETTER OR DIGIT?
JRST ENSYM ;NO
JUMPN B,ENSYM ;BUCKY BITS?
SOJLE V,LOP3 ;STOP AT 6 CHRS.
SUBI C,40 ;CONV TO SIXBIT
TLNN F,R5FL
IDPB C,BYTSAV ;DEPOSIT
TRNE D1,SLT ;SPECIAL LETTER?
PUSHJ P,SLTCN ;YES
SUBI C,'A'-13 ;CONVERT TO RADIX 50
TRNE D1,NUM
ADDI C,'A'-13-17 ;CONVER NUM TO RADIX 50
EXCH C,SYM ;GET SYMBOL
IMULI C,50 ;SHIFT
ADDB C,SYM
MOVEM C,NM
JRST LOP3
SLTCN: CAIN C,5 ;% ?
MOVEI C,47+'A'-13
CAIN C,4 ;$ ?
MOVEI C,46+'A'-13
CAIN C,'.'
MOVEI C,45+'A'-13
POPJ P,
BYTSAV: 0
;DECIMAL NUMBER INPUT
DECMAL: JUMPN B,CPOPJ
MOVEI V,DCM ;PERHAPS SET TEMPORARILY TO
PUSHJ P,TMPMOD ;DECIMAL
MOVE C,[IMULI V,12]
MOVEM C,RAD ;SET RADIX TO DECIMAL
PUSHJ P,GCHRS ;GET CHR.
TRNE D1,NUM ;DIGIT?
JRST DNUM ;YES, GO PROCESS
JRST SCINR ;NO, ERROR
;ASCII WORD (OR EXTENDED TEXT) INPUT "/string/
TEXT: JUMPN B,EXTTXT ;BUCKY BITS MEANS MULTI-WORD DEPOSIT
MOVEI T,5 ;ASCII CHR COUNT
MOVEI V,TXT+2 ;SET FOR ASCII OUTPUT MAYBE
TEX: PUSHJ P,TMPMOD
MOVEI V,0 ;INIT VALUE
MOVNI M,-14(T) ;FORM SHIFT COUNT
PUSHJ P,GCHR1 ;GET TERM CHR.
MOVE E,C ;HOLD
LOP8: PUSHJ P,GCHR1 ;GET CHR.
CAMN C,E ;TERMINATOR?
JRST TEXDON ;YES
DPB C,[POINT 5,C-6(M),34];CONVERT TO SIXBIT IF M=6
LSH C,-7(M) ;BUT NOT IF M=7
LSH V,(M) ;SHIFT VALUE
OR V,C ;OR IN CHR.
SOJG T,LOP8 ;CHR. COUNT DONE?
PUSHJ P,GCHR1 ;GET CHR
CAME C,E ;TERM?
JRST .-2 ;NO
TEXRET: LSH V,-6(M) ;ADJUST IF ASCII
MOVEM V,NM ;STORE VALUE
TLO F,NUMF ;SET NUMBER FLAG
POPJ P,
LSH V,(M) ;NO, ADJUST
TEXDON: SOJGE T,.-1 ;ENOUGH CHRS.?
JRST TEXRET ;YES
;SIXBIT or RADIX50 INPUT '/string/
STEXT: MOVEI T,6 ;SIXBIT CHR. COUNT
MOVEI V,TXT+1 ;SET MAYBE FOR SIXBIT OUTPUT
JUMPE B,TEX ;GO DO IF NO BUCKY BITS
;RADIX50 INPUT CTRL1'string
R5TEXT: TLO F,NUMF!SCFL!R5FL ;SET FLAGS
MOVEI V,TXT ;SET MAYBE FOR RADIX50 OUTPUT
PUSHJ P,TMPMOD
SETZM SYM ;CLEAR LOCATION
MOVEI V,7 ;CHR. COUNT
JRST LOP3 ;GO CONVERT
;TMPMOD, EXTTXT, AMPER, ENSYM
;IF THE FIRST THING TYPED IN IS RECOGNIZABLE AS BEING OF A GIVEN
;DATA TYPE, WE WILL DISPLAY IT IN THAT MODE, AREN'T WE NICE? --DCS
TMPMOD: TLNN F,FIRF ;FIRST THING?
MOVEM V,SAVMOD ;YES, SET UP FOR SPECIAL MODE SET
POPJ P,
;MULTI-WORD ASCII INPUT CTRL1"/stringggggggggggggg.../
^EXTTXT:MOVE M,[EXBUF,,EXBUF+1] ;CLEAR BUFFER
SETZM EXBUF
BLT M,EXEND
MOVE M,[POINT 7,EXBUF] ;DEPOSIT POINTER
SETLIN ASCLIN ;TURN OFF SPECIAL ACTIVATION MODE
MOVEI V,5*EXTLN-10 ;#CHARS ALLOWED
PUSHJ P,GCHR1 ;GET CHAR
MOVE E,C ;DELIM CHARACTER
MOVEI T,42
IDPB T,M ;PUT IN "/ OR SOMETHING
IDPB E,M
MOVEI T,5 ;#CHARS BETWEEN INTERVENTIONS
EXL1: PUSHJ P,GCHRA ;GET A CHARACTER (DON'T DO ALT MODE THING)
CAMN C,E ;ALL DONE?
JRST EXTDN ;YES
EXL3: JUMPN T,EXPTH ;MORE TO GO BEFORE INTERVENTION?
IDPB E,M ;PUT IN DELIM,BROCK,",DELIM
MOVEI T,">"
IDPB T,M
MOVEI T,42 ; " CHAR
IDPB T,M
IDPB E,M
MOVEI T,5 ;RESET COUNT
SUBI V,4
EXPTH: IDPB C,M ;PUT CHAR AWAY
SOJL V,[EXL2: PUSHJ P,GCHR1 ;TOSS OUT REMAINING CHARS
CAME C,E ;UNTIL DELIMITER SEEN
JRST EXL2
JRST EXTDN] ;THEN QUIT
IFN STANFO,<
CAIN C,15
JRST [ MOVEI C,12
SOJA T,EXL3 ]
>;STANFO
SOJA T,EXL1 ;LOOP
EXTDN: IDPB E,M ;ONE MORE DELIMITER
MOVEI T,15 ;END THE STRING
IDPB T,M ;WITH A CRLF
IFN STANFO,<
MOVEI T,12
IDPB T,M
>;STANFO
MOVE T,[POINT 7,EXBUF] ;LET RAID READ THIS!
MOVEM T,STSAV ;SAVE BP FOR DEPO ROUTINE (IF CALLED)
SETLIN RADLIN
TLZ F,SCFL ;NOT AHEAD ONE
JRST SCAN ;RESTART (GET CRLF OR WHATEVER)
;SYMBOL WITH BLOCK NAME MODIFIER
AMPER:
IFE SORTED,<
PUSH P,SYMPNT ;SAVE CURRENT SYMBOL TABLE POINTER
>
IFN SORTED,<
PUSH P,BID
>
PUSH P,V ;SAVE ACS
PUSH P,E
PUSH P,T
PUSH P,F1
MOVSI F1,SINGF ;SET UP DUMMY BIT ("YOU STUPID BIT!")
PUSHJ P,CSFLUSH ;FLUSH CACHES
PUSHJ P,BLKFND ;FIND THE INDICATED BLOCK
PUSHJ P,SCAN ;SCAN NEXT THING
POP P,F1 ;RESTORE ACS
POP P,T
POP P,E
POP P,V
IFE SORTED,<
POP P,SYMPNT ;RESTORE SYMBOL TABLE POINTER
>
IFN SORTED,<
POP P,BID
>
JRST CSFLUSH ;CLEAR CACHES AND RETURN
ENSYM: MOVEI V,CYM ;ALWAYS SET TEMP MODE TO CYMBOLIC IF SYM IS SEEN
TLNN F,R5FL ;DON'T CHANGE MODE IF RADIX50 INPUT
PUSHJ P,TMPMOD
CAIN C,"&" ;IS IT & ?
JUMPE B,AMPER ;YES, TREAT AS BLOCK NAME, SYMBOL TO FOLLOW
TLNE F,R5FL ;RADIX 50 CONVERT?
POPJ P, ;YES
HRRZ E,LOCOP ;GET VALUE OF .
MOVEI V,45 ;RADIX 50 "."
CAMN V,SYM ;IS THAT IT?
JRST SYMDOT ;YES
TLNN F,FIRF ;FIRST THING?
PUSHJ P,FNDOP ;YES
JRST SYMLOK ;GO LOOK UP SYMBOL
;Byte Input
BYTIN: PUSH P,D3 ;SAVE ACS
PUSH P,PV
PUSH P,F
TRO F,BYTSW ;MAKE EVAL STOP ON COMMAS
PUSHJ P,EVAL ;GET NEXT NUMBER
TLNN F,USINGF ;UNDEF?
TLNN F,VALF ;VALUE?
JRST CERR ;NO
ANDI V,77 ;TRUNCATE
SETZM BVAL ;CLEAR VALUE
SETZM SHFT ;CLEAR BYTE SIZE
JUMPE V,ZERSZ ;ZERO?
MOVNM V,SHFT ;NO, STORE COUNT
TLNN F,FIRF ;IF FIRST THING, STORE
DPB V,[POINT 6,SAVMOD,29] ;BYTE SIZE
MOVEI D2,44 ;GET MAX (INITIAL SHIFT COUNT)
MOVEM D2,SHFTA ;STORE
MOVEI D2,1
LSH D2,(V) ;FORM MASK.....
SUBI D2,1 ;...
MOVEM D2,BMSK ;STORE
BLOP: PUSHJ P,EVAL ;GET NEXT
TLNE F,VALF ;VALUE?
JRST CERR ;YES, BUT THIS ISNT POSSIBLE
CAIE C,"," ;,?
JRST BYDON ;NO, DONE
PUSHJ P,EVAL ;GET NEXT
TLNN F,VALF ;VALUE?
JRST BYDON ;NO, LEAVE
TLNE F,USINGF ;DEFINED?
JRST CERR ;NO
MOVE D2,SHFT
ADDB D2,SHFTA ;CALCULATE NEW SHIFT COUNT
AND V,BMSK ;AND VALUE WITH MASK
LSH V,(D2) ;SHIFT
IORM V,BVAL ;OR WITH VALUE
JRST BLOP ;LOOP
BYDON: POP P,PV ;GET OLD FLAGS
AND PV,FLGMSK
ANDCM F,FLGMSK ;PUT BACK...
IOR F,PV ;CERTAIN FLAGS
MOVE PV,BVAL ;GET VALUE
MOVEM PV,NM ;STORE
POP P,PV ;RESTORE ACS
POP P,D3
TLO F,SCFL!NUMF ;SET FLAGS
MOVN V,SHFT ;BYTE SIZE, IF GIVEN
LSH V,6 ;INTO POSITION
TRO V,BYT
MOVEM V,SAVMOD ;ALWAYS SWITCH MODE HERE
POPJ P, ;LEAVE
FLGMSK: EHDF!VALF!SINGF!ESPCF!FIRF!EVMF!USINGF,,BYTSW!CONOF
SHFT: 0
SHFTA: 0
BMSK: 0
BVAL: 0
ZERSZ: SKIPL D2,SMASK+1 ;GET MASK
SETCA D2, ;NORMALIZE
MOVEM D2,BMSK ;STORE
ZLOP: PUSHJ P,EVAL ;GET NEXT THING
TLNE F,VALF ;VALUE?
JRST CERR ;NOT POSIBLE
CAIE C,"," ;,?
JRST BYDON ;NO, DONE
PUSHJ P,EVAL ;GET NEXT
TLNN F,VALF ;VALUE?
JRST BYDON ;NO, DONE
TLNE F,USINGF ;DEFINED?
JRST CERR ;NO
MOVEI D2,44 ;INITL POSITION
MOVEI D3, ;INITL SIZE
SKIPN PV,BMSK ;GET MASK
JRST ZLOP ;ZERO, NO MORE ROOM
JUMPL PV,ZERARN ;ALREADY GOT A 1 BIT?
SUBI D2,1 ;NO, COUNT
LSH PV,1 ;SHIFT
JUMPGE PV,.-2
ZERARN: ADDI D3,1 ;COUNT SIZE
LSH PV,1
JUMPL PV,.-2
MOVE PV,D2 ;SAVE POSITION
ROT D3,-6 ;GET SIZE
LSHC D2,-6 ;GET POSITION
ADDI D3,BVAL ;AND ADDRS
IDPB V,D3 ;DEPOSIT VALUE
ROT PV,-6 ;GET POSITION
MOVEI V,
IOR PV,[4400,,BMSK]
SETCMM BMSK ;SET THIS FIELD TO 0, NEXT TO 1
DPB V,PV ;CLEAR HIGH ORDER BITS
JRST ZLOP
;PNTIN POINT MODE INPUT
PNTIN: PUSH P,D3 ;SAVE ACS
PUSH P,PV
PUSH P,F
TRO F,BYTSW ;MAKE EVAL STOP ON COMMAS
PUSHJ P,EVAL ;GET NEXT NUMBER
TLNN F,USINGF ;UNDEF?
TLNN F,VALF ;VALUE?
JRST CERR ;NO
ANDI V,77
LSH V,=24
MOVEM V,BVAL ;SAVE BYTE SIZE
PUSHJ P,EVAL ;GET NEXT
TLNN F,VALF ;VALUE?
CAIE C,"," ;,?
JRST CERR ;YES, BUT THIS ISNT POSSIBLE
PUSHJ P,EVAL ;GET NEXT
TLNN F,USINGF ;UNDEFINED?
TLNN F,VALF ;VALUE?
JRST CERR ;NO, LOSE
TLZ V,777740 ;KEEP @ AND XR FIELD
IORM V,BVAL
PUSHJ P,EVAL
TLNE F,VALF
JRST CERR
CAIE C,","
JRST PNT44
PUSHJ P,EVAL
TLNN F,USINGF ;UNDEFINED
TLNN F,VALF ;VALUE
JRST CERR
MOVN V,V
ADDI V,=35
JUMPL V,CERR
CAILE V,=35
JRST CERR
PNTDON: DPB V,[POINT 6,BVAL,5]
POP P,PV ;GET OLD FLAGS
AND PV,FLGMSK
ANDCM F,FLGMSK ;PUT BACK...
IOR F,PV ;CERTAIN FLAGS
MOVE PV,BVAL ;GET VALUE
MOVEM PV,NM ;STORE
POP P,PV ;RESTORE ACS
POP P,D3
TLO F,SCFL!NUMF ;SET FLAGS
MOVEI V,BTP
MOVEM V,SAVMOD ;ALWAYS SWITCH MODE HERE
POPJ P, ;LEAVE
PNT44: MOVEI V,44
JRST PNTDON
;Escan -- Scan and Check Reasonable
COMMENT CALL THIS TO SCAN, AND CHECK FOR UNDEFINED
SYMBOLS -- IF UNDEFINED, ABORT UNLESS IT'S OK FOR
AN UNDEFINED SYMBOL TO BE HERE
^ESCAN: PUSHJ P,SCAN ;NEED TO SCAN
TLNE F,SYMF ;SYMBOL
TLNN F,UNDF ; AND UNDEFINED?
POPJ P, ;NO, OK
PUSH P,F ;SAVE (PU WILL CLEAR IF ABORT)
PUSHJ P,SCAN ;GET NEXT THING
TLNN F,SYMF!NUMF ;SYMBOL, NUMBER, OR
TRNN D1,UOK ; NOT OK TO BE UNDEF?
JRST PU ;RIGHT, UNDEF ERROR
POP P,F ;GET UNDF, SCFL (LOOKAHEAD) BACK
POPJ P, ;RETURN NORMALLY
;Eval
BEGIN EVAL
^EVAL: TLZ F,VALF!SINGF!ESPCF!FIRF!EVMF
TRZ F,CONOF
TLZE F,EHDF ;ALREADY GOT ONE?
JRST [ MOVE B,SAVB ;YES
MOVE C,SAVC
POPJ P,]
PUSHJ P,ESCAN ;NO
TLNN F,NUMF!SYMF ;NUMBER OR SYMBOL?
JRST NONUM3
TLNE F,SYMF ;SYMBOL?
TLO F,SINGF!USINGF!VALF ;YES
TLNE F,UNDF ;DEFINED?
POPJ P, ; NO
TLZ F,USINGF
TLO F,FIRF ;DO NOT LOOK FOR OPCODES
LOOP1.: MOVE D3,NM ;GET VALUE
LOOP1: PUSHJ P,ESCAN ;GET NEXT THING
TLNE F,SYMF!NUMF ;SYMBOL OR NUMBER?
JRST PNT1 ;YES
TRNE D1,AROP ;ARITH OP?
JRST ARP ;YES
CAIN C,"," ;,?
JRST COM1 ;YES, HANDLE
JSR ATCHK ;CHECK FOR @... HANDLE
JRST LOOP1 ;YES, IT WAS A @
TLO F,ESPCF
PUSHJ P,LPRNC ;CHECK FOR AND HANDLE (
JRST PNT1 ;YES
LEVE: TLO F,EHDF!VALF ;WE'RE AHEAD AND WE HAVE A VALUE
MOVE V,D3 ;GET VALUE
MOVEM B,SAVB
MOVEM C,SAVC ;SALIENT VALUES
POPJ P,
ARP: TLZ F,SINGF
CAIE C,"/" ;/?
CAIN C,"*" ;*?
JRST MULDIV ;ONE OR THE OTHER
LOP1: CAIN C,"-" ;-?
JRST SUBT ;YES
CAIN C,"!"
JRST EXCL
CAIN C,40 ;SPACE?
TLO F,ESPCF ;YES, SET FLAG
LOOP3: SKIPA PV,[ADD D3,(P)] ;GET OPERATOR
SUBT: MOVE PV,[SUB D3,(P)] ; LIKEWISE
LOP4: PUSHJ P,ESCAN ;GET NEXT THING
LOOP2: TLNN F,NUMF ;NUMBER?
JRST NONUM2 ;NO
LOOP7: TLZE F,EVMF ;NEGATE?
MOVNS NM ;YES
TLNE F,ESPCF ;SPACE SEEN?
HRRZS NM ;YES, CLEAR LEFT HALF
PUSH P,NM ;SAVE NUMBER
LOP2: PUSHJ P,ESCAN ;GET NEXT THING
TLNE F,NUMF ;NUMBER?
JRST PNT1 ;YES
TRNN D1,AROP ;ARITH OP?
JRST NOOP1 ;NO
LOP5: CAIN C,"*" ;*?
JRST MULP ;YES
CAIN C,"/" ;/?
JRST DIVP ;YES
XCT PV ;DO OP
SUB P,[1,,1] ;POP
JRST LOP1
MULP: SKIPA M,[IMULM D2,(P)] ;GET OPERATOR
DIVP: MOVE M,[IDIVM D2,(P)] ; LIKEWISE
LOOP5: PUSH P,M ;SAVE
PUSHJ P,ESCAN ;GET NEXT THING
POP P,M ;GET BACK
TLNN F,NUMF ;NUMBER?
JRST NONUM1 ;NO
LOOP6: MOVE D2,NM ;GET OPERAND
LOP3: EXCH D2,(P) ;SWITCH AROUND
XCT M ;DO OP
JRST LOP2
NONUM1: PUSHJ P,LPRNC ;CHECK FOR ( AND HANDLE
JRST LOOP6 ;YES IT WAS
JSR ATCHK ;CHECK FOR @ AND HANDLE
JRST LOOP5 ;YES IT WAS
CAIE C,40 ;SPACE?
CAIN C,"+" ;+?
JRST LOOP5 ;YES, IGNORE
CAIE C,"-" ;-?
JRST INERR ;NO
PUSHJ P,ESCAN ;GET NEXT
TLNN F,NUMF ;NUMBER?
JRST INERR ;HOW LONG CAN THIS GO ON?
MOVN D2,NM ;YES
JRST LOP3
NOOP1: CAIN C,"," ;,?
JRST COM2 ;YES, HANDLE
JSR ATCHK ;CHECK FOR @ AND HANDLE
JRST LOP2 ;YES, IT WAS
NOOP.1: XCT PV ;DO OP
SUB P,[1,,1] ;POP
TLO F,ESPCF
PUSHJ P,LPRNC ;TEST FOR AND HANDLE (
JRST PNT1 ;YES, IT WAS A (
JRST LEVE
NONUM2: PUSHJ P,LPRNC ;CHECK FOR ( AND HANDLE
JRST LOOP7 ;YES, IT WAS A (
JSR ATCHK ;CHECK FOR @ AND HANDLE
JRST LOP4 ;YES, IT WAS A @
CAIE C,40 ;SPACE?
CAIN C,"+" ;+?
JRST LOP4 ;YES, IGNORE
CAIE C,"-" ;-?
JRST LEVE ;NO
TLC F,EVMF ;COMPLIMENT SWITCH ("YOU ARE A WONDERFULL SWITCH!")
JRST LOP4
MULDIV: MOVE PV,[ADD D3,(P)] ;GET DUMMY OP
MOVEI D3, ;GET DUMMY OPERAND
PUSH P,NM ;SAVE NUMBER
JRST LOP5
EXCL: MOVE PV,[IOR D3,(P)]
JRST LOP4
ATCHK: 0
JUMPN B,ATCHKX
CAIN C,"@" ;@?
TLOA D3,20 ;YES, SET @ BIT
ATCHKX: AOS ATCHK ;NO, SKIP
JRST @ATCHK ;LEAVE
NONUM3: PUSHJ P,LPRNC ;CHECK FOR ( AND HANDLE
JRST LOOP1. ;YES, IT WAS (
CAIN C,40 ;SPACE?
JRST EVAL ;YES, IGNORE
CAIN C,"-"
JRST [ MOVEI D3,0 ;YES , SET UP DUMMY ZERO
TLO F,FIRF ;SET FLAG
JRST SUBT] ;GO SUBTRACT
CAIN C,","
JRST [ MOVEI D3,0 ;YES, SET UP DUMMY ZERO
TLO F,FIRF
JRST COM1]
CAIE C,"@" ;IS IT @?
POPJ P, ;NO, LEAVE
JUMPN B,CPOPJ ;LEAVE IF BUCKY BITS
MOVSI D3,20 ;YES, GET @ BIT
TLO F,FIRF
JRST LOOP1
COM1: TRNE F,BYTSW ;STOP ON ,?
JRST LEVE ;YES
HRLZS D3 ;SHIFT RIGHT HALF TO LEFT HALF
TLO F,ESPCF ;TRUNCATE FURTHER NUMBERS TO 18 BITS
PUSHJ P,ESCAN ;GET NEXT THING
TLNN F,NUMF ;NUMBER?
JRST CM1 ;NO
LOOP4: TRNE F,CONOF ;I/O OPCODE?
JRST [ LSH D3,6 ;YES
TLZ D3,700377
JRST PNT1]
LSH D3,5 ;MAKE AC FIELD
TLZ D3,777000 ;...
PNT1: MOVE PV,[ADD D3,(P)];GET DUMMY ADD (+)
JRST LOOP2
CM1: CAIN C,"," ;ANOTHER ,?
JRST LOOP3 ;YES
JRST LOOP4 ;NO
COM2: TRNE F,BYTSW ;STOP ON ,?
JRST NOOP.1 ;YES
PUSHJ P,ESCAN ;GET NEXT THING
TLNN F,NUMF ;NUMBER?
JRST CM2 ;NO
LLP4: MOVE M,(P) ;GET THING
TRNE F,CONOF ;I/O OPCODE?
JRST [ ANDI M,774 ;YES
LSH M,22+6
JRST LLQ4]
ANDI M,17 ;MAKE AC FIELD
LSH M,22+5
LLQ4: MOVEM M,(P)
XCT PV ;DO OP
SUB P,[1,,1] ;POP
TLO F,ESPCF
JRST PNT1
CM2: CAIE C,"," ;ANOTHER ,?
JRST LLP4 ;NO
XCT PV ;DO OP
SUB P,[1,,1] ;POP
HRLZS D3 ;SWAP
JRST LOOP3-1
LPRNC: CAIE C,"(" ;(?
JRST LL1 ;NO
PUSH P,D3 ;YES, SAVE D3
PUSH P,M
PUSH P,PV
PUSHJ P,EVAL ;EVALUATE THING IN ()
TLNN F,VALF ;GET BACK A VALUE?
JRST CERR ;NO
PUSH P,V ;YES, SAVE IT
PUSHJ P,EVAL ;GET NEXT THING
CAIN C,")" ;IS IT A )?
TLNE F,VALF!SYMF!SINGF;...
JRST CERR ;NO, ERROR
POP P,NM ;PUT VALUE IN NM
MOVSS NM ;SWAP IT
POP P,PV ;RESTORE
POP P,M
POP P,D3
TLOA F,FIRF!VALF!NUMF
LL1: AOS (P)
POPJ P,
BEND EVAL
^EVAL_EVAL
BEND SCAN
;Racgt, Jacgt, Once, Svacs
BEGIN SUBS
^RACGT: 0 ;GET RAID ACS
SKIPE ACSW ;SEE IF USER'S ACS ALREADY SAVED
JRST RACGT2 ;YES, DON'T CLOBBER, BUT GET OURS AGAIN FOR SAFETY
MOVEM 17,JAC+17
MOVEI 17,JAC
BLT 17,JAC+16
SETOB V,ACSW
IFN STANFO,<
GETLIN V ;GET LINE BITS
CAME V,[-1]
JRST RACNDT ;NOT DETACHED
SETOM DETFLG
MOVEI V,0
RACNDT: MOVEM V,USERLIN ;SAVE FOR USER
TLO V,100 ;SPECIAL ACTIVATION MODE
MOVEM V,RADLIN ;FOR NORMAL RAID OPERATIONS
TLZ V,100 ;FOR ASCII INPUT OPERATIONS
MOVEM V,ASCLIN
TLO V,20 ;FULL CHARACTER SET MODE, FOR EDITING
MOVEM V,EDTLIN
SETACT [BRKTI,,0];SAVE HIS BREAK TABLE
>
RACGT2: MOVSI 17,RAC
BLT 17,17
IFE FILESW,< ;AVOID DOING SETSYM HERE IF FILE VERSION (DONE IN ONCE)
IFN SORTED,<
MOVE V,JOBSYM
CAME V,SAVJSM
PUSHJ P,SETSYM ;RESET SYMBOL TABLE IF MOVED (OR FIRST TIME)
>;SORTED
>;NOT FILESW
HRRZS RACGT ;BLAST FLAGS
JRST 2,@RACGT ;SO WE CAN CLEAR THEM HERE (ESP IOT-USER)
IFE UESW!FILESW,<
^JACGT: 0 ;GET JOB AC'S
SKIPN ACSW
JRST @JACGT
SETZM ACSW
MOVEM 17,RAC+17
MOVEI 17,RAC
BLT 17,RAC+16
IFN STANFO,<
SETLIN USERLIN ;RESTORE USER'S LINE CHARACTERISTICS.
MOVE BRKJSR
TLNE 4000
EIOTM ;RESTORE IOT-USER
>;STANFORD
MOVSI 17,JAC
BLT 17,17
IFN STANFO,<
SETACT [BRKTI] ;PUT BACK USER'S BREAK TABLE
>
JRST @JACGT
>;UESW!FILESW=0
^DETFLG: 0 ;-1 IF WE ARE DETACHED WHEN STARTING UP
^USERLIN: 0
^EDTLIN: 0
^ASCLIN: 0
^RADLIN: 0
^SVACS: MOVEM 17,RAC+17 ;CALL THIS ROUTINE TO STASH AWAY RAID'S ACS
MOVEI 17,RAC ;WHEN WAITING FOR TTY INPUT
BLT 17,RAC+16 ;SO <CALL>, <SAVE>, <DDT> WILL WORK
MOVE 17,RAC+17
POPJ P,
^ONCE: 0
JFCL CHKSYM ;JFCL CLOBBERED TO A JRST WHEN ONCE IS DONE
MOVE P,[-PDLEN,,PDL-1]
IFN FILESW,<
RAIDXX: OUTSTR [ASCIZ /
DMP FILE? (Y or N) /]
INCHRW A
CAIE A,"Y"
CAIN A,"y"
JRST RDDMPF
SETZM DMPFSW
GETFIL (<
TYPE FILE NAME - >,'')
JRST RDDMP1
RDDMP4: SETOM MODFSW
ENTER SVLUP
JRST 4,.
JRST RDDMP3
RDDMPF: SETOM DMPFSW
GETFIL (<
TYPE DMP FILE NAME - >,'DMP')
RDDMP1: OUTSTR [ASCIZ /DO YOU WANT TO MODIFY THE FILE? /]
SETZM MODFSW
INCHRW A
CAIE A,"Y"
CAIN A,"y"
JRST RDDMP4
RDDMP3: MOVS A,FILLUP+3 ;- WORD COUNT
SETCA A, ;WORD COUNT-1
SKIPE DMPFSW
ADDI A,74
MOVEM A,FILLST
SKIPN DMPFSW
JRST RDDMP2 ;MAKE A PHONEY SYMBOL TABLE
IN [ -<140-74>,,TRKBUF-1
0 ]
JRST FONCA0
OUTSTR [ASCIZ /LOST TRYING TO READ LOW CORE
/]
JRST 4,.
FONCA0: SKIPE E,TRKBUF-74+HILOC ;CORE ADDRESS OF START OF UPPER
JRST FONC3C ;JUMP IF THERE IS AN UPPER SEGMENT
MOVE E,FILLST
HRRZM E,FLOWND
IORI E,1777
MOVEM E,FJBREL
MOVEM E,FJBHRL
SETZM UPPRST ;NO UPPER
JRST FONC3B
FONC3C: HRRZM E,HILOCF ;SAVE CORE ADDRESS OF BEGINNING OF UPPER
HRRZM E,FLOWND
IORI E,1777
HRRZM E,FJBREL
HRRZ E,TRKBUF-74+HILOC ;CORE ADDRESS OF START OF UPPER
CAIGE E,400000
MOVEI E,400000
MOVEM E,UPPRST ;START OF UPPER
HRRZ E,TRKBUF-74+HILOC ;CORE ADDRESS OF START OF UPPER
MOVN E,E
ADD E,FILLST ;SIZE OF THE UPPER - 1
ADD E,UPPRST
MOVEM E,FJBHRL ;LAST ADDRESS OF UPPER
FONC3B: SKIPN A,TRKBUF-74+JOBSYM;SYMBOL TABLE POINTER
JRST RDDMP2 ;NO SYMBOL TABLE
HLRE C,A ;-SIZE OF SYMBOL TABLE
MOVN C,C ;SIZE OF SYMBOL TABLE
ADDI C,-1(A) ;CORE ADDRESS OF LAST WORD OF SYMBOL TABLE
HRRZ A,A ;CORE ADDRESS OF FIRST WORD OF SYMBOL TABLE
CAMLE A,FLOWND ;SKIP IF SYMBOL TABLE BEGINS IN LOWER
JRST FONC4A ;SYMBOL TABLE BEGINS IN UPPER
CAMLE C,FLOWND ;SKIP IF SYMBOL TABLE ENTIRELY IN LOWER
JRST RDDMP2 ;GOES PAST END OF LOWER
JRST FONC4B
FONC4A: SKIPN UPPRST
JRST RDDMP2 ;NO UPPER, NO SYMBOLS
CAML A,UPPRST ;SKIP (LOSE) IF SYMBOL TABLE STARTS BEFORE UPPER
CAMLE C,FJBHRL ;SKIP (WIN) IF SYM TABLE FINISHES BEFORE UPPER ENDS
JRST RDDMP2 ;LOSE. SYMBOL TABLE DOESN'T FIT ENTIRELY IN UPPER
SUB A,UPPRST ;DISTANCE FROM START OF UPPER TO START OF SYM TAB
ADD A,HILOCF ;(PSEUDO) CORE ADDRESS OF START OF UPPER
FONC4B: MOVEI B,-74(A) ;DISK ADDRESS OF SYMBOL TABLE
IDIVI B,200 ;C GETS OFFSET OF SYM TAB FROM RECORD BOUNDARY
USETI 1(B) ;ACCESS TO RECORD CONTAINING SYM TAB
MOVE B,TRKBUF-74+JOBSYM ;-LENGTH OF SYM TAB,,
HRR B,JOBFF
ADD B,C
MOVEM B,JOBSYM
HRL C,C
SUB B,C ;AOBJN POINTER FOR TRANSFER
HLRE C,B ;- NUMBER OF WORDS IN TRANSFER
MOVN C,C
ADD C,JOBFF
MOVEM C,JOBFF
FONCA1: MOVE C,JOBFF
IORI C,1777
CORE C,
JRST FONCA1
SUBI B,1 ;MAKE INTO IOWD
MOVEI C,0
IN B ;READ IN THE SYMBOL TABLE
JRST FONCE3
OUTSTR [ASCIZ /LOST TRYING TO READ IN SYMBOL TABLE
/]
JRST 4,.
RDDMP2: PUSHJ P,MKSYTB
FONCE3: MOVE E,FILLST
ADDI E,1
FONC3A: MOVEM E,TUBOUN
MOVEM E,PUBOUN
MOVEI E,20
MOVEM E,TLBOUN
MOVEM E,PLBOUN
IFN SORTED,<
PUSHJ P,SETSYM
>;SORTED
>;END FILESW
IFE FILESW,<
MOVEI E,BEGDDT
CAIN E,140 ;START AT 140 UNLESS RAID IS FIRST
MOVEI E,ENDDT ;SET LOWER BOUND AT DDTEND TO START WITH
MOVEM E,TLBOUN
MOVEM E,PLBOUN
>;NOT FILESW
IFE SORTED&FILESW,<
MOVE E,JOBSYM ;SET UPPER BOUND AT LOWER OF JOBSYM AND
>
IFE SORTED,<
MOVEM E,SAVSYM#
>;NOT SORTED
IFE FILESW,<
MOVEI E,-20(E) ;REMOVE DEFAULT OFFSET
CAML E,JOBFF ; JOBFF CONTENTS TO START WITH
HRRZ E,JOBFF
CAIN E,ENDDT ;IF RAID IS AT END
MOVEI E,BEGDDT ;THEN SET UPPER BOUND BELOW IT
MOVEM E,TUBOUN
MOVEM E,PUBOUN
>;NOT FILESW
MOVEI E,CTABCN ;NO MACROS YET
MOVEM E,TABLEN
SETOM DDSW ;DON'T KNOW WHAT KIND OF DISPLAY YET
MOVS PNT,SPNT
MOVE E,PNT
SUB PNT,[1,,1]
HRLI E,-MAXDLN
SETZM (E)
AOBJN E,.-1
SETZB F,DCON
SETOM STPOP
SETOM LOCOP
SETZM SAVMOD ;SPECIAL CURMOD SAVE VARIABLE (SEE TMPMOD ROUTINE)
SETZB C,NBIGWD ;CLEAR C FOR PRGSET
MOVSI F1,SINGF
PUSHJ P,PRGSET ;FIND A REASONABLE FIRST PROG
IFN UESW,<MOVE T,[400001,,SPBLT]
SETZM SPSWT1#
SETZM SPSWT2#
CALL T,[SIXBIT/SPCWGO/]
SKIPN SPSWT1
JRST .-1
HRRZ T,SPSWT1
CALL T,[SIXBIT /CORE/]
JRST 4,.
SETOM SPSWT2
SKIPE SPSWT2
JRST .-1
PUSHJ P,WRAP
MOVEM V,SYMPRG
MOVEM V,SYMPNT
TNOFFS>
MOVSI E,(<JRST>) ;DESTROY THIS ROUTINE
HLLM E,ONCE+1
JRST @ONCE
IFN FILESW!DEBSYM,<
^^MKSYTB:MOVE A,JOBFF
ADDI A,216
CORE A,
JRST 4,.
MOVE A,JOBFF
HRRZ B,A
ADDI B,216
MOVEM B,JOBFF
HRLI A,-216
MOVEM A,JOBSYM
SETOM (A)
MOVEI B,12
MOVEM B,1(A)
MOVEI B,13
MOVEM B,2(A)
MOVEI B,14
MOVEM B,3(A)
MOVEM B,4(A)
MOVEI B,214
MOVEM B,5(A)
MOVEI B,216
MOVEM B,6(A)
MOVEM B,7(A)
MOVEM B,10(A)
MOVEM B,11(A)
IFN FILESW,<
MOVE B,[RADIX50 0,FRAID]
>
IFN DEBSYM,<
MOVE B,[RADIX50 0,DRAID]
>
MOVEM B,12(A)
SETZM 13(A)
MOVE B,[RADIX50 50,AFRAID]
MOVEM B,214(A)
SETZM 215(A)
POPJ P,
>;FILESW!DEBSYM
IFE SORTED,<
CHKSYM: MOVE T,JOBSYM
SUB T,SAVSYM
JUMPE T,@ONCE
PUSH P,ONCE
ADDM T,SAVSYM
HRRE V,T
CAME V,T
JRST SYMRST ;SYMTAB REALLY GRONKED
ADDM T,SYMPNT
ADDM T,SYMPRG
MOVEI V,NUMREF
CHKSY2: SKIPE PRGREF(V)
ADDM T,PRGREF(V)
SKIPE BLKREF(V)
ADDM T,BLKREF(V)
SOJGE V,CHKSY2
POPJ P,
>;NOT SORTED
IFN SORTED,<
CHKSYM: JRST @ONCE
>;SORTED
IFN FILESW,<
;^XTRASW:0 ;-1 IF READING FROM EXTRA CYLINDERS, 0 IF FROM DMP FILE
; ;1 IF FROM XCOP FILE
^DMPFSW:0 ;-1 IF DUMP FILE
^MODFSW:0 ;+1 IF WANTS TO MODIFY THE FILE
^FILLST:0 ;LAST ADDRESS IN FILE
^NOTFIL:0 ;FLAG TO GETPOI TO FORGET ABOUT LOOKING IN THE FILE
^FLOWND:0 ;LAST USEFUL ADDRESS IN LOWER
^FJBREL:0 ;JOBREL OF LOWER
^FJBHRL:0 ;JOBREL OF UPPER
^UPPRST:0 ;STARTING ADDRESS OF UPPER
^HILOCF:0 ;BEGINNING CORE ADDRESS OF UPPER
>;FILESW
; END OF ONCE ONLY CODE
;Parameters, Headers, Buffers, Variables for Data Display
IFN REALSW,<RAIDPG__17;>RAIDPG__16
DEFINE HJUMDS <35>
HJUMSZ__5
^LINLEN__=24
; Device bits, Stanford status word
IFN STANFO,<
DDBIT__20000
IIIBIT__400000
DMBIT__40000
>;STANFORD
; Space count for status line, one for large chars, one for small
LITSPS __ 16 ;small chars, needs more spaces
BIGSPS __ 5 ;large chars, need fewer spaces
; Device indices
^^.TTY__0 ;Best efforts on TTY
^^.VTS__1 ;Xerox-PARC VTS protocol
^^.NGP__2 ;Sproull's proposed Net. graph. protocol
^^.DD__3 ;Data-Disk
^^.III__4 ;III displays
^^.DM__5 ;Data Media display
; Bits controlling display of lines, arrows
; Bit 400000 Display this line -- tested with sign test
DOEX__40000 ;IF ON, DISPLAY `x' -- EXECUTION POINT
DODOT__20000 ;IF ON, DISPLAY `.' -- DOT
DOPT__10000 ;IF ON, DISPLAY `' -- POINTING HERE
; IF ALL ON, USE <=> INSTEAD OF x, ., OR
; RAID text page image buffer
; See end of prog for actual def, SORT shares DISB
;IQJ__MAXDLN+2 IQJ__IQJ*LINLEN
;DISB: BLOCK IQJ ;ROOM FOR ALL THE DATA
; Display pointer tables:
; DSAV: One word per line, currently displayed info:
; LH: 400000, DOEX, DODOT, DOPT bits controlling display
; RH: Address of first word for this line in page image buffer
; DCON: Saved DPNT pointers, to see what changed
; DDCON: Saved displayed address values, to see what changed
DEFINE $SETBLK,<
IQI__0
^^DSAV: REPEAT MAXDLN+2,
<DISB+IQI
IQI__IQI+LINLEN
>
0
>;END OF $SETBLK
XLIST
XCREF
$SETBLK
LIST ;AVOID INFINITE EXPANSION
CREF
DCON: BLOCK MAXDLN+2
DDCON: BLOCK MAXDLN+2
IFN STANFO,<
; Display and line information UUO buffer -- Stanford only
PPIBUF: BLOCK =20
>;STANFO
; Status control word -- routines set to control status line display
; LH: Index into STSTXT -- a table of ASCII Status indicators
; RH: Number of spaces to precede status --
; Low-order bit complemented in main loop to draw attention
^NBIGWD: 0
; STATUS TEXT TABLE
STSTXT: ASCII /OK/
ASCII /?/
ASCII /M/
ASCII /U/
ASCII /SKIP /
ASCII /*/
ASCII /MEM?/
ASCII /PURE?/
ASCII /PROT?/
ASCII /INST?/
; Arrow tables -- one table for each collection of arrow
; characters for "dot", "execpt", "arrow", and "universal" combinations
GDAROW: ASCID / / ;NO ARROWS -- GOOD KIND
ASCID / / ; GOT HERE VIA `;' OR SOMETHING
ASCID / . / ; `.' ONLY
ASCID / ./ ; `.' AND POINTING, NO EXECUTE
ASCID / x / ; EXECUTION POINT ONLY
ASCID / x / ; ALL BUT `.'?
ASCID / x. / ; DID `;' TO TAKE ELSEWHERE
ASCID / /; SPECIAL CHARACTER FOR ALL
BDAROW: ASCID / / ;NO ARROWS -- BAD KIND
ASCID / >/ ; GOT HERE VIA `;' OR SOMETHING
ASCID / . / ; `.' ONLY
ASCID / .>/ ; `.' AND POINTING, NO EXECUTE
ASCID / x / ; EXECUTION POINT ONLY
ASCID / x >/ ; ALL BUT `.'?
ASCID / x. / ; DID `;' TO TAKE ELSEWHERE
ASCID / <=>/ ;SPECIAL CHARACTER FOR ALL
; Index pointer, selecting arrow table (see DSET)
^ARRTAB: V,,GDAROW
; Special device-select word, set by user to select undetectable devices
; (NGP, VTS)
IFN REALSW,<INTERNAL $DEV>
$DEV:
SPECDEV: -1,,0 ;ASSUME TTY, NO PHYSICAL BACKSPACE
IFN STANFO,<
; Data-Disk Definitions (Control words, sizes, etc.)
VJUMSZ__=12
IFN DMOVSW,<VSTT__=48;>VSTT__=240
; COMMAND WORD -- ALTERNATING COMMANDS AND PARAMETERS
DEFINE CW(C1,B1,C2,B2,C3,B3) <
<BYTE (8)<B1>,<B2>,<B3> (3)<C1>,<C2>,<C3>>!4
>
; COMMAND NAMES FOR DD COMMAND BYTES
EXCT__0 ;EXECUTE
FNCN__1 ALPHBG__6 ALPHA__46 ;FUNCTION, USUAL VALUE BYTES
CHNL__2 ;CHANNEL SELECT
COLM__3 ;COLUMN SELECT
HILIN__4 ;HIGH 5 BITS OF LINE
LOLIN__5 ;LOW 5 BITS OF LINE
; III Definitions
; ABSOLUTE INVISIBLE VECTOR (III DISPLAY)
DEFINE AIVECT (X,Y,B) < 146+((X)=25)+((Y)=14)+(B10)>
IIIHST__3000
IIIVSZ__30
IFN DMOVSW,<IIIVST__640;>IIIVST__0
; DD and III display control block, Display buffer
; DPYOUT CONTROL WORDS
400000,,DTEM ;USE OVERLAPPED MODE ON DD
TWC: 0 ;WILL BE DPYOUT COUNT
DDACT: 0 ;DD XFER ACTIVE FLAG FROM SYS
^DTEM: BLOCK 1000
>;STANFO
; VTS initializing string, outstr'd from DSET
VINIT: BYTE (7) ESC,"D",1,ESC,"D",2,ESC,"C",1,MAXDLN+2
BYTE (7) ESC,"B",1,1,2,1,76,7,150,5
BYTE (7) 60,ESC,"T",1,177,1,ESC,"C",2,2,ESC,"B",2,1,2
BYTE (7) 1,2,5,170,1,122,ESC,"F",2,1,6,6,ESC,"T",2,177,1,0
;Spwget, Dset, Mksel
IFN UESW,< SPWGET: SKIPN SPGG3
0
HRLI 2,-1
DATAO 2
MOVN 4,2
ADD 4,SPGG2
MOVE 5,(4)
MOVEM 5,SPGG1#
SETZM SPGG3
0>
^DSET: MOVEI M,.TTY ; HERE WE USE IT TO SEE WHAT
IFN STANFO,<
MOVNI T,1
GETLIN T ;GET LINE CHARACTERISTICS
TLNN T,DDBIT!IIIBIT!DMBIT ;SKIP IF III, DATA DISK OR DATAMEDIA
JRST ISTTY
PPINFO PPIBUF
MOVEI M,.III ; ASSUME III
TLNE T,DDBIT
MOVEI M,.DD
TLNE T,DMBIT
MOVEI M,.DM
ISTTY:
>;STANFO
SKIPLE T,SPECDEV ;ALSO, IF REMOTE PROTOCOL WAS ASKED
HRRZ M,T ; (VTS, NGP), USE THAT DEVICE.
IFE STANFO,<
HLRM T,NBSSW
>
CAMN M,DDSW ;NEED TO RE-INITIALIZE IF DEVICE HAS
POPJ P, ; CHANGED.
MOVEM M,DDSW
TRO F,DPYALL ;FORCE COMPLETE SCREEN REGENERATION
MOVE D2,[.OK,,LITSPS] ;ASSUME LITTLE STATUS LINE
MOVEM D2,NBIGWD
MOVEI D2,GDAROW ;ASSUME THIS SET OF ARROWS
HRRM D2,ARRTAB
MOVE T,[-MAXDLN-1,,DSAV]
JRST @[ TTYST ;DEVICE-DEPENDENT
VTSSET ; INITIALIZATION
NGPSET
IFN STANFO,<
DDSET
IIISET
DMSET
>;STANFORD
](M)
TTYST: TDZA D2,D2
NGPSET: HRRI D2,LITSPS
HRRM D2,NBIGWD
MOVEI D2,BDAROW
HRRM D2,ARRTAB
POPJ P,
VTSSET: MOVEI D2,BDAROW ;HAVE TO USE BAD SET
HRRM D2,ARRTAB
MOVEI D2,BIGSPS
HRRM D2,NBIGWD
IFE TENEX,<
OUTSTR VINIT ;INITIALIZE DISPLAY AREA
>
IFN TENEX,<
MOVE A,[PSOUT]
MOVEM A,VTINST
HRROI A,VINIT
PUSHJ P,VTSOUT ;WRITE THE STRING, TRANSPARENT MODE
>
MOVE M,[BYTE (7) ESC,"R",2,1,1]
JSP D2,CNTRL ;First (OK) line special
MOVE M,[BYTE (7) ESC,"R",1,1,1]
ALVDS: JSP D2,CNTRL ;Store VTS replace command in
ADDI M,110 ; first word for each line
JRST ALVDS ; BCLR will complete command in wd 2
IFN STANFO,<
IIISET: MOVEI M,777300 ;PP POSITION
MOVEM M,DPLOC
MOVEI D2,BIGSPS
HRRM D2,NBIGWD
SETZM DTEM
MOVE M,[AIVECT(IIIHST,IIIVST-6,7)] ;Status LINE
JSP D2,CNTRL
MOVE M,[AIVECT(IIIHST,IIIVST-IIIVSZ,2)] ;PROG/BLOCK NAME LINE
ALLDS: JSP D2,CNTRL ;STORE WORD, CYCLE UNTIL DONE
SUB M,[IIIVSZ=14] ;NEXT LINE
JRST ALLDS
DDSET: MOVEI M,777400
MOVEM M,DPLOC
MOVEI E,VSTT-=12
PUSHJ P,MKSEL
MOVEI E,VSTT ;FIRST LINE
ALDDS: JSP D2,CNTRL
ADDI E,VJUMSZ
ALDDSL: PUSHJ P,MKSEL
JRST ALDDS ;AROUND
MKSEL: MOVE M,[CW (\COLM,2,\HILIN,0,\LOLIN,0)]
DPB E,[POINT 4,M,23] ;LOW FOUR
ROT E,-4
DPB E,[POINT 5,M,15] ;HIGH FIVE
ROT E,4 ;RESTORE IT
POPJ P,
DMSET: MOVEI M,777340 ;FOR A DM WITH 24 LINES ...
MOVEM M,DPLOC ; ... PUT THE PAGE PRINTER HERE
MOVEI D2,BDAROW
HRRM D2,ARRTAB
HRROI M,[015000,,D2] ;GET DISPLAY HEIGHT IN D2
TTYSET M,
HRREI M,-=24(D2)
IMUL M,[-2000/=24] ;GET VALUE TO DIDDLE DPYPOS LOCATION BY
ADDM M,DPLOC
SUBI D2,6+4+1 ;SUBTRACT PP NBIGWD PID AND WHO LINE AND FUDGE
SKIPGE D2
JRST DMSET1
MOVEM D2,SCRMAX ;STORE SCREEN MAXIMUM - 1
MOVN D2,D2
HRRE M,SPNT
SUBM D2,M ;M _ POSITIVE AMOUNT BY WHICH SPNT DECREASES
HRLZ M,M
ADD PNT,M ;KEEP PNT HONEST
HRRM D2,SPNT
DMSET1: MOVE M,[BYTE(7)177,14,140,142]
ALMDS: JSP D2,CNTRL
ADDI M,18
JRST ALMDS
>;STANFORD
CNTRL: MOVEM M,@(T) ;STORE A WORD
AOBJN T,(D2) ;CONTINUE UNLESS DONE
POPJ P, ;DONE
;Redraw, Redisp, Fredsp -- Display Program
^REDISP:MOVE M,DDCON+1
IFE SORTED,<
CAME M,SYMPNT
>
IFN SORTED,<
CAME M,BID
>
^FREDSP:TRO F,DPYALL
PUSHJ P,DSET
TRZE F,DPYALL
JRST [ SETZM DCON
MOVE V,[DCON,,DCON+1]
BLT V,DCON+MAXDLN+1
TRZ F,DRWALL
JRST NUFSED]
IFN STANFO,<
MOVE M,PPIBUF+2
TRZN F,DRWALL
TLNE M,200000
;STANFO>
IFE STANFO,<
TRZE F,DRWALL
>;NOT STANFO
JRST [ MOVSI V,400000
MOVS T,SPNT
SUB T,[2,,2]
ALLP: IORM V,DSAV-DPNT(T) ;TURN ON DOIT BIT
AOBJN T,ALLP ;CONTINUE UNTIL
TLNN T,7
JRST ALLP ; REALLY DONE
JRST NUFSED]
NUFSED:
IFN STANFO,<
HRLZ M,DPLOC ;IF POSITION AND SIZE ARE DIFFERENT THAN WE
HRRI M,3002 ;WANT THEM TO BE, WE SHOULD MOVE THEM
MOVE T,DDSW
CAIL T,.DD ;SKIP IF NOT A STANFORD DISPLAY (DD,III,DM)
CAMN M,PPIBUF+3 ;PP 0'S CURRENT SETTINGS
JRST NEXTT
DPYSIZ 3002
DPYPOS @DPLOC ;NOW THEY'RE RIGHT
>;STANFO
NEXTT:
LOP1B: MOVS T,SPNT ;GET POINTER
SUB T,[2,,2]
MOVEM PNT,SAVPNT ;SAVE VALUE
;FALLS THROUGH
; Loop1, Rdo -- Main Line Control, Each Line Code
;FALLS THROUGH FROM PREVIOUS PAGE
;LOOK AT NEXT LINE, SET UP TO EXAMINE IT
LOOP1: SKIPN V,(T) ;DONE?
JRST GODIS ;YES
MOVE M,DSAV-DPNT(T)
HRRZ E,M ;SET UP BP TO 2D HALF OF LINE
ADD E,[POINT 7,HJUMSZ,HJUMDS] ; (FOR ARROW INSERTION)
MOVEM E,STRTHR# ;SAVE HERE
HLRZ D3,V
IFN FILESW,<
SETZM NOTFIL
HRRZ E,T
CAIGE E,DPNT+2
SETOM NOTFIL
>;FILESW
PUSHJ P,GETPOI
JRST [ MOVE E,[ASCII /???/]
MOVEI D3,<TXT+2>5
JRST LOOP1A]
IFE FILESW,<MOVE E,(E) >
IFN FILESW,<
SKIPE NOTFIL
JRST [ MOVE E,(E)
JRST LOOP1A ]
PUSHJ P,RDTRKE ;READ IN TRACK WITH ADDRESS THAT'S IN E
MOVE E,@TRKOFF
>
LOOP1A: MOVE D2,(T)
TLNE D2,3
JRST RDO ;ALWAYS REDO DYNAMIC CELLS
CAMN D2,DCON-DPNT(T)
CAME E,DDCON-DPNT(T)
JRST RDO
JRST ARND1
RDO: MOVEM E,DDCON-DPNT(T)
PUSHJ P,BCLR ;CLEAR LINE AND SET UP BYTE POINTER IN E
MOVEI M,40
TRNE D3,400000
MOVEI M,"*"
IDPB M,E
MOVEI M,CYM5
CAIE D3,STS5
CAIN D3,PRG5
HRRZ M,D3
PUSH P,T
PUSH P,D3
PUSHJ P,CONV
POP P,M
CAIN M,STS5
JRST RET2
CAIN M,PRG5
MOVEI M,BLK5
TRZ M,400037
MOVE E,STRTHR
MOVE T,(P)
MOVE V,DDCON-DPNT(T)
PUSHJ P,CONV
;FALLS THROUGH
;RET2, ARND1
;FALLS THROUGH FROM PREVIOUS PAGE
RET2: POP P,T ;RESTORE IT
PUSHJ P,CRLFOT ;FINISH LINE, COMPUTE SIZE IF NECESSARY
MOVSI V,400000 ;DO SOMETHING BIT
IORM V,DSAV-DPNT(T)
;WHETHER OR NOT DATA CHANGED, HANDLE VARIOUS ARROW INDICATIONS
ARND1: HLRZ V,(T)
TRZ V,776037 ;RETAIN ONLY TYPE
CAIL V,STS5
JRST ARND2
MOVEI V,0
CAMN T,PNT ;IS THIS WHAT WE'RE POINTING AT?
TRO V,DOPT ; YES, OR DBL THIS LINE
HRRZ M,(T) ;GET LOCATION DISPLAYED
CAMN M,LOCOP ;IS THIS LINE `DOT'?
TRO V,DODOT ; YES, . OR DBL THIS LINE
CAMN M,STPOP ;IS THIS LINE THE EX. POINT?
TRO V,DOEX ; YES, x OR DBL THIS LINE
HLRZ M,DSAV-DPNT(T) ;GET OLD ARROW BITS
SKIPN DDSW
JRST [ TDC M,V
TRNN M,400000
TDNE M,V
TRO V,400000
JRST TR1 ]
CAME M,V ;SAME AS LAST TIME?
TRO V,400000
TR1: HRLM V,DSAV-DPNT(T) ;STORE NEW, WITH DISPL DIRECTIVE
TRZ V,400000
LSH V,-=12 ;GET 3 ARROW BITS AS INDEX
MOVE V,@ARRTAB ;INDEXED BY V, GET APPROP. ARROWSPEC
MOVEM V,@STRTHR ;PLACE INTO LINE
; AROUND THE LINE LOOP
ARND2: AOBJN T,LOOP1 ;DONE?
TLNN T,7 ;REALLY DONE?
JRST LOOP1
;Godis -- Actual Displaying Code
GODIS: MOVE M,T ;SAVE PTR TO LAST
HRRZ V,DSAV-DPNT(M) ;SAVE END OF LINE LIST
PUSH P,V
SETZM DSAV-DPNT(M) ;MARK END OF LINE LIST
PUSHJ P,DISPLAY ;DISPLAY CHANGED LINES
POP P,DSAV-DPNT(M) ;RESTORE
MOVE V,[DPNT,,DCON]
BLT V,DCON+MAXDLN+1
POPJ P,
;RDTRKE, WRTRK
IFN FILESW,<
NFILPG__20 ;NUMBER OF 200 WORD BLOCKS
;READ INTO TRACK BUFFER THE TRACK WITH LOC E IN IT
^RDTRKE:PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D1
MOVEI A,(E)
JRST RDTREA
RDTREX: POP P,D1
POP P,C
POP P,B
POP P,A
POPJ P,
RDTRE3: AOS FILCNT(C)
MOVEM C,LSTTRK
IMULI C,200
ADDI C,TRKBUF(B)
MOVEM C,TRKOFF
JRST RDTREX
RDTREV: MOVSI C,-NFILPG
HRLOI D1,377777 ;BIG NUMBER
RDTRE5: CAMG D1,FILCNT(C) ;SKIP IF FILCNT SMALLER THAN CURRENT MINIMUM
RDTRE6: AOBJN C,RDTRE5
JUMPGE C,RDTRE7 ;JUMP IF SCAN THROUGH
MOVE D1,FILCNT(C) ;NEW MINIMUM
HRLM C,(P) ;SAVE INDEX
JRST RDTRE6 ;LOOP
RDTRE7: HLRZ D1,(P) ;GET BACK INDEX OF SLOT TO USE
POPJ P,
;NORMAL FILE SYSTEM READ
RDTREA: SKIPN DMPFSW
JRST RDTRA1
CAMG A,FJBREL
JRST RDTRA2
CAMLE A,FJBHRL
JRST RDTREX
SUB A,UPPRST ;DISTANCE FROM START OF UPPER TO ADDRESS WE WANT
ADD A,HILOCF ;ADD IN STARTING FILE ADDRESS OF UPPER
RDTRA2: SUBI A,74
JUMPL A,RDTREX
RDTRA1: IDIVI A,200 ;A_REC # IN FILE (INDEX FROM 0), B_OFFSET IN REC
MOVSI C,-NFILPG
MOVNI D1,1 ;INDEX OF LAST FREE SLOT
RDTREB: CAMN A,FILTAB(C)
JRST RDTRE3
SKIPGE FILTAB(C) ;SKIP IF SLOT IN USE
HRRZ D1,C ;NOT IN USE, REMEMBER ITS INDEX
AOBJN C,RDTREB
JUMPL D1,RDTREC ;NO FREE SLOTS. EVICT SOMEONE
RDTRED: MOVEM A,FILTAB(D1)
SETZM FILCNT(D1)
AOS FILCNT(D1)
USETI 1(A)
IMULI A,200
MOVN A,A
ADD A,FILLST
ADDI A,1 ;DISTANCE FROM BEGINNING OF OUR REC TO EOF
CAILE A,200
MOVEI A,200
MOVN A,A ;SIZE OF XFER
IMULI D1,200
ADDI B,TRKBUF(D1)
MOVEM B,TRKOFF
ADDI D1,TRKBUF-1 ;IOWD FOR TRANSFER
MOVEM D1,FILEWD
HRLM A,FILEWD
INPUT FILEWD
JRST RDTREX
RDTREC: PUSHJ P,RDTREV
JRST RDTRED
^WRTRK: SKIPN MODFSW
POPJ P,
PUSH P,A
PUSH P,B
MOVE A,LSTTRK
MOVE B,FILTAB(A)
USETO 1(B)
IMULI A,200
ADDI A,TRKBUF-1
HRLI A,-200
MOVEI B,0
OUTPUT A
POP P,B
POP P,A
POPJ P,
^TRKOFF:0
LSTTRK: 0
FILEWD: 0 ;IOWD STORED HERE
0
TRKBUF: BLOCK NFILPG*200
FILTAB: REPEAT NFILPG,<-1 ;DISK ADDRESS OF BEGINNING OF THIS PAGE
>
FILCNT: REPEAT NFILPG,<0 ;NUMBER OF TIMES REFERENCED
>
^LEAVE: EXIT
^CLRIO: TDZA V,V
^SETIO: MOVNI V,1
MOVEM V,$IO
TRO F,DPYALL
POPJ P,
>;FILESW
;Bclr, Mooror (Display Driver), Crlfot, Offok
BCLR: MOVE E,[ASCID / /]
MOVEM E,1(M) ;CLEAR TO ASCID BLANKS
MOVEI E,2(M) ;GET BLT WORD
HRLI E,1(M)
BLT E,LINLEN-1(M)
MOVEI E,1(M) ;SET UP BYTE POINTER
HRLI E,(<POINT 7,0>)
PUSH P,V ;DEVICE-DEPENDENT BUFFER INIT
MOVE V,DDSW
JRST @[ BCRET
VTBRET
BCRET
IFN STANFO,<
BCRET
BCRET
BCRET
>;STANFO
](V)
VTBRET: MOVE V,[BYTE (7) =63,0,40,40,40] ;END OF REPLACE, SPACES
MOVEM V,1(M) ; 0 WILL BE REPLACED BY LENGTH IN BYTES
HRLI E,(<POINT 7,0,13>) ;FIRST SPACE
BCRET: POP P,V ;FOR NOW, CLD JUST TEST VTS, BUT...
POPJ P,
; Write crlf into line data buffer, finish it up
CRLFOT: MOVEI V,15 ;WRITE CR
IDPB V,E
MOVEI V,12 ;WRITE LF
IDPB V,E
ZEROSS: MOVE V,DDSW
CAIE V,.VTS
JRST ZEROS1
; Compute char count, deposit for Replace command (VTS)
PUSH P,E
LDB V,[POINT 3,E,5]
TRC V,4
SUB E,DSAV-DPNT(T)
HRRES E
IMULI E,5
ADDI E,-7(V)
MOVE V,DSAV-DPNT(T)
DPB E,[POINT 7,1(V),13]
POP P,E
ZEROS1: TDZA V,V
IDPB V,E ;DEPOSIT A 0
TLNE E,760000 ;IS BP AT END OF WORD?
JRST .-2 ; NO, DEPOSIT 0'S UNTIL TRUE
SETZM 1(E) ;CLEAR NEXT WORD TO FLAG COPLUP
POPJ P,
DISPLAY:MOVSI V,400000
MOVE E,DDSW
JRST @[ TTDPY
VTDPY
NGDPY
IFN STANFO,<
DDDPY
IIDPY
DMDPY
>;STANFO
](E)
IFN STANFO,<
DDDPY: SETZB V,T
SKIPE DDACT
DPYOUT RAIDPG,[0 0] ;DON'T CLOBBER DATA UNTIL WRITING STOPS
PUSHJ P,DDTXT ;COPY IN ONCET
MOVSI V,400000 ;PREPARE TO COPY AGAIN, AND CLEAR DOLINE
PUSHJ P,DDTXT ;DO IT
JRST DPYDUN
DMDPY: MOVSI V,400000 ;CLEAR DOIT BITS
TDZA T,T
IIDPY: MOVEI T,1 ;LEAVE ROOM FOR III TO STORE RETURN
PUSHJ P,DPYTXT ;COPY TWICET (WILL SET ODD FIELDS)
DPYDUN: SETZM DTEM(T) ;HALT
SETZM DTEM+1(T) ;HALT!
MOVEM T,TWC ;COUNT WORD
AOS TWC ;THIS MANY
DPYOUT RAIDPG,TWC-1 ;SHOW ME
POPJ P,
DDTXT: MOVE D2,[CW(\FNCN,\ALPHA,\CHNL,0,\CHNL,0)]
MOVEM D2,DTEM(T)
ADDI T,1
>;STANFO
TTDPY:
VTDPY:
NGDPY:
DPYTXT: SKIPA D2,[DSAV] ;CONSTANT STUFF
LINLUP: JUMPE D3,CPOPJ ;COME HERE AT END OF EACH LINE
MOVE D3,(D2) ;DO THIS LINE?
JUMPL D3,DOLIN ;YES, MARKED
CAIN E,.III ;Also, always for III
JUMPG D3,DOLIN ;UNLESS DONE
AOJA D2,LINLUP ; NO OR DONE
DOLIN: ANDCAM V,(D2) ;CLEAR DOIT BIT
MOVE F1,(D3) ;FIRST WORD IS ROW SELECT FOR DD
JRST @[ OUTTTY
OUTVTS
OUTNGP
IFN STANFO,<
DDCOPY
IICOPY
IICOPY ;FOR DM TOO
>;STANFO
](E)
IFN STANFO,<
DDCOPY: JUMPE V,IICOPY ;Odd rows?
TRO F1,10000 ;YES, THIS SHOULD DO IT
JRST IICOPY ;USE END OF LOOP TO STORE
COPLUP: SKIPN F1,(D3) ;DONE WITH LINE?
AOJA D2,LINLUP ;YES, TEST END OF SCREEN
IICOPY: MOVEM F1,DTEM(T) ;STORE A WORD
ADDI T,1 ;COUNT WORDS
AOJA D3,COPLUP ;INCR SOURCE PTR AND LOOP
>;STANFORD
OUTNGP: OUTTTY:
IFE TENEX,<
OUTSTR 1(D3)
>
IFN TENEX,<
HRROI A,1(D3)
PSOUT
>
AOJA D2,LINLUP ;JUST THE STRING
OUTVTS:
IFE TENEX,<
OUTSTR (D3)
>
IFN TENEX,<
HRROI A,(D3)
PUSHJ P,VTSOUT
>
AOJA D2,LINLUP ;STRING AND REPLACE CMD
IFN TENEX,<
^VTSOUT: PUSH P,B
PUSH P,A
MOVEI A,100
RFMOD
PUSH P,B
TRZ B,300
SFMOD
EXCH A,-1(P)
XCT VTINST
POP P,B
POP P,A
SFMOD
POP P,B
POPJ P,
^VTINST: PSOUT
>;TENEX VTS OUT
;Getpoi -- Handle Multi-Level Display
^^GETPOI:PUSH P,M
TLNN V,3
JRST NOPNT
MOVS M,V ;GET MODE
IFE FILESW,<MOVE V,(V)> ;GET THING POINTED TO
IFN FILESW,<
SKIPGE NOTFIL
JRST [ MOVE V,(V)
JRST GPTNTF ]
HRRZ E,V
PUSHJ P,RDTRKE
MOVE V,@TRKOFF
>
GPTNTF: PUSHJ P,GETPOI ;GET REAL POINTER
JRST POPMJ
GTPNO: ANDI M,3 ;GET RID OF RANDOM BITS
IFN FILESW,<
SKIPGE NOTFIL
>;FILESW
XCT (M)[MOVE V,(E)
MOVS V,(E)
JRST [ MOVE M,(E)
PUSH P,T
PUSHJ P,GPELOP ;CALC EFF. ADDRS.
POP P,T
MOVE V,E
JRST NOPNT]
]-1
IFN FILESW,<
PUSHJ P,RDTRKE
XCT (M)[MOVE V,@TRKOFF
MOVS V,@TRKOFF
JRST [ MOVE M,@TRKOFF
PUSH P,T
PUSHJ P,GPELOP ;CALC EFF. ADDRS.
POP P,T
MOVE V,E
JRST NOPNT]
]-1
>
NOPNT: HRRZS V
IFE FILESW,<
IFE TENEX,<
CAMLE V,JOBREL
IFE SEGSW,<JRST POPMJ>
IFN SEGSW,<JRST [ CAIL V,400000 ;IN UPPER SEGMENT?
CAILE V,@JOBHRL
JRST POPMJ
JRST .+1]>
>;NOT TENEX
>;NOT FILESW
HRRZ E,V
IFE FILESW,<
CAIGE V,20
ADDI E,JAC
>
IFN FILESW,<
; SKIPN XTRASW
JRST GETPOX
; CAIGE V,20
; JRST POPMJ
>;FILESW
POPMJ1: AOS -1(P)
POPMJ: POP P,M
POPJ P,
IFN FILESW,<
GETPOX: SKIPE NOTFIL
JRST POPMJ1
SKIPE DMPFSW
JRST GETPX1 ;DUMP FILE
CAMLE V,FILLST
JRST POPMJ
JRST POPMJ1
GETPX1: CAIL V,74
CAMLE V,FJBHRL
JRST POPMJ
CAMLE V,FJBREL
CAML V,UPPRST
JRST POPMJ1
JRST POPMJ
>;FILESW
;Conv -- Output Conversion Routine Dispatch
; THESE ARE THE OUTPUT ROUTINES -- THEY ALL WRITE INTO THE
; STRING CONTROLLED BY THE BYTE POINTER IN `E'. THIS IS
; THE MAIN DISPATCH
^CONV: LDB T,[POINT 6,M,24] ;GET POSSIBLE ARGUMENT TO CONVERT ROUTINE
LSH M,-5 ;GET CONVERT ROUTINE NUMBER
TRZ F,CNVABS
TRZE M,40 ;ABS MODE?
TRO F,CNVABS ;YES
ANDI M,77 ;GET RID OF EXTRANEOUS GARBAGE
CAIGE M,PRG
JUMPE V,IT0 ;USUALLY, 0 IS JUST 0
JRST @TABC-1(M) ;GO TO APPROPRIATE ROUTINE
POPJ P,
TABC: INSTR ; 1
HLFWRD ; 2
CONOCT ; 3
CONXWD ; 4
CONR50 ; 5
CONSIX ; 6
CONASC ; 7
CONFLT ;10
CONBYT ;11
CONDEC ;12
RHTEXT ;13
RHTEXT ;14
RHTEXT ;15
CONBP ;16
CONFLG ;17
LHFLG ;20
RHFLG ;21
STSPRT ;22
PRGPRT ;23
BLKPRT ;24
; Fndptr, Fndtbl, Conflg, Rhflg, Lhflg -- J, L, R Commands
BEGIN CONFLG
FNDPTR: SKIPN M,FLGPTR ;GET POINTER WORD
POPJ P, ;NO POINTER
FNDTBL: SOJL T,CPOPJ1 ;THE NUMBER OF TABLE IS IN T
HLRZS M ;GET POINTER
JUMPE M,CPOPJ ;NO LINK
SKIPE M,(M) ;CHECK ADRESS
JRST FNDTBL ;GO ON
POPJ P,
PRNTIT: HRLI M,-=18 ;ONE HALF OF THE WORD
SETZM FULLFL#
MOVEI D3,0 ;FLAG TO SAY IF WE SHOULD PRINT !
SETZM FLGNUM# ;SAVE EXTRA BITS HERE
LP1: TDNN V,T ;IS THE NEXT BIT ON?
JRST NOBIT ;NO
SKIPN D2,(M) ;IS THERE A NAME FOR IT?
JRST [FLGFOO: IORM T,FLGNUM ;NO SAVE UP BITS
JRST NOBIT]
PUSH P,D2
MOVEI D2,-13(E) ;GET POINTER
CAML D2,SAVEE ;TOO MANY CHRS. SO FAR?
SETOM FULLFL ;YES
POP P,D2
SKIPE FULLFL ;TOO FULL?
JRST FLGFOO
SKIPE D3
IDPB D3,E ;PUT IN ! IF NEEDED
PUSHJ P,R5TYP
MOVEI D3,"!" ;SET FLAG
NOBIT: LSH T,-1 ;SHIFT TO NEXT BIT
AOBJN M,LP1 ;TRY FOR MORE
SKIPE FLGNUM ;ANYTHING EXTRA?
JRST [PUSH P,V ;SAVE VALUE
SKIPE D3
IDPB D3,E
MOVE V,FLGNUM
TRNN V,-1 ;CHECK HALF
MOVSS V
PUSHJ P,CONOCT ;PRINT IT
MOVEI D3,"!" ;SET FLAG
POP P,V
POPJ P,]
POPJ P,
; J PRINTER -- VALUE IN V, TABLE# IN T
^CONFLG:PUSHJ P,FNDPTR ;GET POINTER NUMBER
JRST HLFWRD ;NO POINTERS, PRINT OCTAL
HRRZM E,SAVEE# ;SAVE STARTING POINTER
MOVSI T,400000 ;START UP
LP2: PUSHJ P,PRNTIT ;GO PRINT
JUMPE T,[TRON D3,"0" ;IF WE PRINTED NOTHING
IDPB D3,E ;THIS WILL NOT SKIP AND GET "0" IN D3
POPJ P,] ;EXIT
TRCN D3,",""!" ;CHENGE ! TO , AND SKIP IF ANY WERE ON (! WAS THERE)
JRST LP2 ;NO GO DO NEXT HALF
IDPB D3,E
IDPB D3,E ;PUT IN ,,
JRST LP2
; L PRINTER
^LHFLG: PUSHJ P,FNDPTR ;SET UP POINTER
JRST INSTR ;PRINT AN INSTRUCTION
COMTPN: PUSH P,M
HRRZM E,SAVEE ;SAVE STARTING POINTER
PUSH P,V
HLLZS V ;NO ADR FIELD
PUSHJ P,INSTR ;PRINT INSTR
POP P,V
POP P,M ;RESTORE VALUE AND POINTER
MOVEI T,400000 ;CHECK RH
PUSHJ P,PRNTIT
TRON D3,"0"
IDPB D3,E
POPJ P,
; R PRINTER
^RHFLG: PUSHJ P,FNDPTR
JRST INSTR
ADDI M,=18 ;USE RH BITS
JRST COMTPN
BEND CONFLG
; Hlfwrd, Instr, Opdret, Noacq
IT0: MOVEI V,"0"
IDPB V,E
POPJ P,
CSW1: 0
BEGIN HLFWRD
; (UNSIGNED HALFWORD),,(UNSIGNED HALFWORD) PRINTER
^HLFWRD:SETZM CSW1 ;CLEAR FLAG
LOOP5: MOVEI M,6 ;GET COUNT
MOVEI PV,0 ;CLEAR AC
LOOP4: LSHC PV,3 ;GET DIGIT
JUMPN PV,PNT1 ;NON-ZERO?
SOJG M,LOOP4 ;NO, ZERO
SETOM CSW1
JRST LOOP5
PNT1: IORI PV,60 ;OR IN ASCII
IDPB PV,E ;DEPOSIT
SOJLE M,PNT2 ;COUNT
PNT3: MOVEI PV,0 ;CLEAR
LSHC PV,3 ;GET NEXT DIGIT
JRST PNT1
PNT2: SKIPE CSW1 ;FIRST OR SECOND HALF?
POPJ P, ;SECOND
SETOM CSW1 ;SET SWITCH
MOVEI PV,"," ;PUT OUT TWO
IDPB PV,E ;COMMAS
IDPB PV,E
MOVEI M,6
SOJA F1,PNT3
BEND HLFWRD
BEGIN INSTR
^INSTR:
TLCN V,-1 ;LEFT HALF ZERO?
JRST [ TLC V,-1 ;YES
JRST CONXWD]
TLCN V,-1 ;LEFT HALF =-1?
JRST CONOCT ;YES
TLCN V,777000 ;NO OP-CODE?
JRST [ TLC V,777000
PUSHJ P,TRYSYM ;TRY TO TYPE AS SYM +OR- SMALL OFFSET
POPJ P,
JRST CONXWD] ;CAN'T PRINT AS SYM
TLCN V,777000
JRST CONXWD
MOVE T,V ;SAVE VALUE
PUSHJ P,OPLOOK ;LOOK UP OPCODE
JUMPE D2,OPDF ;NO OP-CODE?
MOVE D3,D2 ;YES, OPCODE
PUSHJ P,SIXOUT ;TYPE IT OUT
^OPDRET:MOVEI D3,40
IDPB D3,E
IFN EXDSW,<
TRZE F,CONOFF ;I/O OPCODE?
JRST OPIOPT ;YES
>
LDB D2,[POINT 9,T,8] ;GET OP CODE
MOVEI PV,-67(D2)
IDIVI PV,9
LDB D3,INPPTB(V) ;GET TABLE ENTRY
CAIL D2,600
JRST OPTEST
LDB V,[POINT 4,T,12] ;GET AC FIELD
JUMPN V,ACNZ
TRNE D3,2 ;NO SKIP IF DON'T PRINT ZERO AC FIELD
JRST NOAC
ACTYP: PUSH P,D3
PUSHJ P,EXACTY ;TYPE OUT AC FIELD AS SYMBOL IF POSSIBLE
POP P,D3
JRST ACTYPD
ACNZ: TRNN D3,1 ;SKIP IF PRINT NON-ZERO AC AS NUMBER
JRST ACTYP
PUSHJ P,CONOCT
ACTYPD: MOVEI V,","
IDPB V,E ;OUTPUT A ,
NOAC: MOVEI V,"@"
TLNE T,20 ;@ BIT?
IDPB V,E ;YES
HRRZ V,T ;GET ADDRESS FIELD
TRNE D3,20
JRST ACTYIO ;I/O INSTRUCTION
JUMPN V,ENZ
TLNN T,17 ;SKIP IF XR FIELD IS NON-ZERO
TRNE D3,4
JRST ETYPD ;NOT SUPPOSED TO TYPE 0 E FIELD
TLNN T,20 ;IF @ WE WANT SYMBOLIC
TRNN D3,10
JRST ETYP
JRST EOCT ;WANT TO TYPE LESS THAN 20 AS OCTAL
ETYP: PUSHJ P,ADTYP ;TYPE IT OUT
JRST ETYPD
ENZ: CAIL V,20
JRST ETYP
TLNE T,17
JRST EOCT
TLNN T,20 ;IF @ WE WANT SYMBOLIC
TRNN D3,10
JRST ETYP
EOCT: PUSHJ P,CONOCT
ETYPD: LDB V,[POINT 4,T,17] ;GET INDEX FILED
JUMPE V,NOIX ;NO INDEX FIELD?
MOVEI PV,"("
IDPB PV,E ;PUT OUT A (
PUSHJ P,EXACTY ;TYPE IX
MOVEI V,")"
IDPB V,E ;PUT OUT A )
NOIX: POPJ P,
ACTYIO: LDB D3,[POINT 3,T,12] ;GET I/O INSTRUCTION TYPE
CAIN D3,4 ;CONO?
JRST EOCT ;YES
CAIE D3,6 ;CONSZ?
CAIN D3,7 ;OR CONSO?
JRST EOCT ;YES
JRST ETYP
OPTEST: LDB V,[POINT 4,T,12] ;GET AC FIELD
JUMPN V,TSTANZ
TRNE D3,2
JRST TSTACD
TSTANZ: PUSH P,D3
PUSHJ P,EXACTY
POP P,D3
MOVEI V,","
IDPB V,E
TSTACD: MOVEI V,"@"
TLNE T,20 ;@ BIT?
IDPB V,E ;YES
HRRZ V,T ;GET ADDRESS FIELD
JUMPN V,TSTENZ
TLNN T,17
TRNE D3,4
JRST ETYPD
JRST ETYP
;SOME DAY THIS SHOULD DO THE RIGHT THING W.R.T FLAG MODE
TSTENZ: TRNN D3,10
JRST ENZ
CAIL V,20
JRST ETYP
JRST EOCT
^NOACQ: MOVEI D3,0 ;GET HERE FROM BYTE POINTER PRINTER
JRST ACTYPD
IFN EXDSW,<
OPIOPT: MOVE D3,V ;GET DEVICE NAME
LDB V,[320700,,T]
LSH V,2
JUMPE D3,OPIOP1 ;PRINT NUMERIC DEV
PUSHJ P,SIXOUT
MOVEI D3,20 ;INDICATE OPCODE IS I/O INSTRUCTION
JRST ACTYPD
OPIOP1: MOVEI D3,20 ;INDICATE OPCODE IS I/O INSTRUCTION
JRST ACTYP ;TYPE V (DEVICE CODE) AS A NUMBER
>;EXDSW
;INPTBL INSTRUCTION PRINTING TABLE
;THIS TABLE CONTAINS 4 BITS OF INFORMATION FOR EACH OPCODE BETWEEN
;100 AND 677. THE BITS CONTROL HOW THE REST OF THE INSTRUCTION IS
;PRINTED
;1: PRINT AC FIELD AS A NUMBER IF NON-ZERO
;2: DON'T PRINT AC FIELD IF ZERO
;4: DON'T PRINT E FIELD IF ZERO
;8: PRINT E FIELD AS A NUMBER IF LESS THAN 20 UNLESS @
;IN THE CASE OF THE TEST (6XX) INSTRUCTIONS BITS 2 AND 4 WILL HAVE THE SAME
;VALUE: ON IN THE CASE OF THE NEVER SKIP OR ALWAYS SKIP N-TYPE INSTRUCTIONS.
;THE 8 BIT MEANS THAT THE E FIELD REPRESENTS BITS, USE FLAG NAMES OR NUMBERS
INPTBL: BYTE (4)0,1,2,4,6,0,0,0,0 ;67-77 (PHONEY FOR UUOS)
BYTE (4)0,0,0,0,0,10,0,0,0 ;100-110
BYTE (4)0,0,0,0,0,0,0,0,0 ;111-121
BYTE (4)0,0,0,0,0,0,0,0,10 ;122-132
BYTE (4)2,0,0,0,0,0,0,0,0 ;133-143
BYTE (4)0,10,0,0,0,0,0,0,0 ;144-154
BYTE (4)10,0,0,0,0,0,0,0,10 ;155-165
BYTE (4)0,0,0,0,0,0,0,10,0 ;166-176
BYTE (4)0,0,10,0,2,0,10,0,2 ;177-207
BYTE (4)0,10,0,2,0,10,0,2,0 ;210-220
BYTE (4)10,0,0,0,10,0,0,0,10 ;221-231
BYTE (4)0,0,0,10,0,0,10,10,10 ;232-242
BYTE (4)0,10,10,10,10,0,0,0 ;243-253
BYTE (4)3,7,3,0,0,0,0,4,3 ;254-264
BYTE (4)0,0,0,0,10,0,0,0,10 ;265-275
BYTE (4)0,0,16,10,10,10,16,10,10 ;276-306
BYTE (4)10,6,0,0,0,6,0,0,0 ;307-317
BYTE (4)6,0,0,0,6,0,0,0,6 ;320-330
BYTE (4)2,2,2,6,2,2,2,4,0 ;331-341
BYTE (4)0,0,4,0,0,0,2,2,2 ;342-352
BYTE (4)2,2,2,2,2,4,0,0,0 ;353-363
BYTE (4)4,0,0,0,2,2,2,2,2 ;364-374
BYTE (4)2,2,2,4,4,2,0,0,10 ;375-405
BYTE (4)0,0,0,10,0,0,0,10,2 ;406-416
BYTE (4)0,0,10,0,0,4,4,0,0 ;417-427
BYTE (4)0,10,0,0,0,10,0,0,0 ;430-440
BYTE (4)10,0,0,0,10,0,0,4,4 ;441-451
BYTE (4)0,0,0,10,0,0,0,10,2 ;452-462
BYTE (4)0,0,10,0,0,0,10,0,0 ;463-473
BYTE (4)4,4,2,0,0,10,0,2,0 ;474-504
BYTE (4)10,0,2,0,10,0,2,0,10 ;505-515
BYTE (4)0,2,0,10,0,2,0,10,0 ;516-526
BYTE (4)2,0,10,0,2,0,10,0,2 ;527-537
BYTE (4)0,10,0,2,0,10,0,2,0 ;540-550
BYTE (4)10,0,2,0,10,0,2,0,10 ;551-561
BYTE (4)0,2,0,10,0,2,0,10,0 ;562-572
BYTE (4)2,0,10,0,2,16,16,10,10 ;573-603
BYTE (4)16,16,10,10,6,6,0,0,6 ;604-614
BYTE (4)6,0,0,10,10,10,10,10,10 ;615-625
BYTE (4)10,10,0,0,0,0,0,0,0 ;626-636
BYTE (4)0,0,0,0,0,0,0,0,0 ;637-647
BYTE (4)0,0,0,0,0,0,0,0,10 ;650-660
BYTE (4)10,10,10,10,10,10,10,0,0 ;661-671
BYTE (4)0,0,0,0,0,0 ;672-677
INPPTB: POINT 4,INPTBL(PV),3
POINT 4,INPTBL(PV),7
POINT 4,INPTBL(PV),11
POINT 4,INPTBL(PV),15
POINT 4,INPTBL(PV),19
POINT 4,INPTBL(PV),23
POINT 4,INPTBL(PV),27
POINT 4,INPTBL(PV),31
POINT 4,INPTBL(PV),35
; Rhtext, Adtyp, R5typ, ADSEL, TRYSYM
; INSTRUCTION PRINTER, R50, SIXBIT, ASCII IN RH
^RHTEXT:PUSH P,M
PUSH P,V
HLLZ V,V
PUSHJ P,INSTR
LDB T,E ;GET LAST CHARACTER OUTPUT
CAIN T,"0"
ADD E,[070000,,]
POP P,V
MOVE M,(P)
MOVE T,(M)0-13+['"'+40
"'"
'"'+40]
IDPB T,E
XCT (M)0-13+[ HRRZ D2,V ;R5TYP TAKES INPUT IN D2
HRLZS V
HRRZS V]
PUSHJ P,@(M)0-13+[R5TYP
CONSIX
RJASC]
POP P,M
MOVE T,(M)0-13+["'"
"'"
'"'+40]
IDPB T,E
POPJ P,
; ADDRESS (SYMBOLIC+/-DISPLACEMENT) PRINTER
IFN REALSW,<
$ADTYP:
INTERNAL $ADTYP
>
^ADTYP: CAIGE V,140
JRST EXACTY
MOVE F1,E ;SAVE BYTE POINTER
MOVEM V,VSV ;SAVE VALUE
PUSHJ P,FNDSYM ;LOOK UP IN SYMBOL TABLE
MOVE E,F1 ;RESTORE BYTE POINTER
ADTYP1: PUSHJ P,ADSEL
JRST CON3Q ;NEITHER ONE IS CLOSE ENOUGH
JRST DNWIN ;DNSYM IS THE CLOSER ONE
MOVEI PV,"-" ;HOLD A -
MOVE M,D2
MOVE V,UPSYM ;GET SYMBOL NAME
MOVE D2,UPCUR ;GET BLOCK NAME
DNRET: PUSHJ P,SYMTYP ;TYPE OUT SYMBOL
JUMPE M,CPOPJ ;DONE?
MOVE V,M
IDPB PV,E
JRST CONOCT
DNWIN: MOVEI PV,"+" ;HOLD A +
MOVE V,DNSYM ;GET SYMBOL NAME
MOVE D2,DNCUR ;GET BLOCK NAME
JRST DNRET
;CALL ADSEL AFTER FNDSYM. RETURNS DIRECT IF BOTH ARE TOO FAR AWAY. SKIPS
; ONCE IF DNSYM IS THE WINNER AND SKIPS TWICE IF UPSYM IS THE WINNER
^^ADSEL:MOVM D2,UPDIF ;GET DIFFERENCES
JUMPE D2,ADJ2 ;EXACT MATCH?
MOVM M,DNDIF
MOVEI PV,777
ANDM PV,WCNT
ANDM PV,WCNT+1
CAMLE M,WCNT ;IS DNDIF TOO BIG?
JRST DNBIG ;YES
CAMLE D2,WCNT+1 ;IS UPDIF TOO BIG?
JRST ADJ1 ;YES
MOVE V,WCNT+3
IMUL V,M
ASH V,-6
SUB V,D2
SUB V,WCNT+2
JUMPLE V,ADJ1
ADJ2: AOS (P)
ADJ1: AOS (P)
POPJ P,
DNBIG: CAMLE D2,WCNT+1
POPJ P,
JRST ADJ2
^TRYSYM:MOVEM V,VSV
MOVE F1,E
PUSHJ P,FNDSYM ;LOOKUP IN SYM TABLE
MOVE E,F1
MOVE V,VSV
MOVEI D2,777
ANDM D2,WCNT
ANDM D2,WCNT+1
MOVM D2,DNDIF
MOVM D3,UPDIF
CAMLE D2,WCNT
CAMG D3,WCNT+1
JRST ADTYP1 ;TYPE AS SYMBOL + OR - OFFSET
AOS (P)
POPJ P, ;CAN'T PRINT AS A SYMBOL
IFN REALSW,<INTERN $C
>
$C:
^WCNT: 77
77
10
40
BEND INSTR
VSV: 0
EXACTY: MOVEM E,D2 ;SAVE BYTE POINTER
PUSHJ P,FNDSYM ;LOOK UP IN TABLE
MOVE E,D2 ;RESTORE BYTE POINTER
SKIPE UPDIF ;EXACT MATCH?
JRST CONOCT ;NO, TYPE AS NUMBER
MOVE V,UPSYM ;GET SYMBOL
MOVE D2,UPCUR ;GET BLOCK NAME
SYMTYP: JUMPE D2,NOBLK ;NO BLOCK NAME?
PUSHJ P,R5TYP ;TYPE BLOCK NAME
MOVEI D2,"&" ;TYPE A &
IDPB D2,E
NOBLK: MOVE D2,V ;GET SYMBOL NAME
; R5typ -- Radix50 Printer
; VALUE IN D2
; OUTPUT TO E'S BP, AS USUAL
^R5TYP: TLZ D2,740000 ;CLEAR HIGH ORDER BITS
IDIVI D2,50 ;GET CHR
ADDI D3,60-1 ;CONVERT
CAIGE D3,13+(60-1);LETTER?
JRST GOTYP ;NO
ADDI D3,101-13-(60-1);CONVERT
CAIG D3,132 ;FUNNY LETTER?
JRST GOTYP ;NO
CAIN D3,133
MOVEI D3,"."
CAIN D3,134
MOVEI D3,"$"
CAIN D3,135
MOVEI D3,"%"
GOTYP: JUMPE D2,GOAT1
HRLM D3,(P) ;SAVE CHR
PUSHJ P,R5TYP ;TYPE FIRST PART
HLRZ D3,(P) ;GET CHR.
GOAT1: IDPB D3,E ;TYPE THE LETTER
POPJ P,
; Conoct, Consix, Sixout, Opdf
; VALUE IN V
TYPNEG__774000
CON3Q: SETCM PV,VSV ;GET IT
TRNE PV,TYPNEG ;SMALL NEGATIVE NUMBER?
TLC PV,-1 ;NO
TRCA PV,-1
CONOCT: MOVE PV,V
JUMPL PV,CON3B
CON3A: IDIVI PV,10 ;THIS HERE IS THE FAMOUS ...
JUMPE PV,CON3C ;.. ANY-RADIX-NUMBER-PRINTER
HRLM V,(P)
PUSHJ P,CON3A
HLRZ V,(P)
CON3C: ORI V,60
IDPB V,E
POPJ P,
CON3B: MOVEI V,"-"
IDPB V,E
MOVMS PV
JRST CON3A
; SIXBIT PRINTER -- VALUE IN V
CONSIX: MOVSI D2,40000
SKIPA D3,V
SIXOUT: MOVEI D2, ;CLEAR
SIXOT: LSH D2,-7
LSHC D2,6 ;GET CHR.
JUMPE D2,SIXOUQ ;NULL?
ADDI D2,40 ;CONV. TO ASCII
IDPB D2,E ;OUTPUT
SIXOUQ: JUMPN D3,SIXOT ;LOOP IF MORE TO GO
POPJ P,
; USER-DEFINED OPCODE FINDER AND PRINTER
; USED BY INSTR ABOVE (I DON'T KNOW EITHER)
OPDF: MOVE V,T ;GET VALUE
MOVE F1,E
PUSHJ P,FNDSYM ;LOOKUP IN SYM TABLE
MOVE E,F1
SKIPE D3,UPDIF ;EXACT?
SKIPA D3,DNDIF ;NO
SKIPA D2,UPSYM ;YES, GET NAME
MOVE D2,DNSYM ;NO, GET NAME
MOVE V,T ;RESTORE VALUE
TLNE D3,777000 ;CLOSE ENOUGH?
JRST OPDF1 ;NO
MOVE T,D3 ;YES, GET DIFF.
TLO T,067000 ;PHONEY OPCODE FOR CLEVER CYMBOLIC PRINTOUT
PUSHJ P,R5TYP
JRST OPDRET
OPDF1: PUSHJ P,TRYSYM ;TRY TO TYPE AS SYM + OR - N
POPJ P, ;DID IT
JRST CONXWD ;CAN'T DO IT
; Conasc -- Ascii Printer
; VALUE IN V
; IF ALL BUT RH 7 BITS=0, ASSUMES RIGHT-JUSTIFIED, ELSE LEFT
CONASC: TDNN V,[-1,,777600] ;ASSUME RJ ONLY IF RH 7 BITS ONLY
RJASC: LSH V,1
PUSH P,T ;SAVE ANOTHER
MOVEI D3,5 ;CONVT.
CONALP: MOVEI PV,0
LSHC PV,7 ;GET CHR.
JUMPE PV,PLOPP
CAIN PV,12
JRST ITLF
CAIN PV,15
JRST ITCR
CAIN PV,11 ;TAB?
JRST ITAB ;YES
IFN STANFO,<
CAIN PV,177 ;BACKSPACE?
>;STANFORD
IFE STANFO,<
CAIN PV,177 ;DEL?
JRST ITDEL
CAIN PV,10 ;BACKSPACE??
>;NOT STANFORD
JRST ITBS ;YES, USE "\" CHARACTER
CAIN PV,ALTMOD ;ALTMODE?
JRST ITALT ;YES
PLOP2: IDPB PV,E ;DEPOSIT
PLOPP: SOJG D3,CONALP ;LOOP
JUMPGE V,PPPOPJ ;LOW ORDER BIT ON?
MOVEI PV,"@" ;YES, DENOTE IT
IDPB PV,E ;AND WRITE IT
PPPOPJ: POP P,T ;RESTORE
POPJ P,
PTEM: 0
IFE STANFO,<
ITDEL: SKIPA T,[ASCII /DEL/]
>;NOT STANFO
ITBS: MOVE T,[ASCII /BS/]
JRST IT
ITALT: SKIPA T,[ASCII /ALT/]
ITAB: MOVE T,[ASCII /TAB/]
JRST IT
ITCR: SKIPA T,[ASCII /CR/]
ITLF: MOVE T,[ASCII /LF/]
IT: PUSH P,D3
MOVE D3,DDSW
JRST @[ ITTTY
ITVTS
ITNGP
IFN STANFO,<
ITDD
ITIII
ITDM
>;STANFO
](D3)
IFN STANFO,<
ITIII: TDZA PV,PV ;CLEAR REST OF WORD
IDPB PV,E
TLNE E,760000 ;EOW(ORD)?
JRST .-2
TRO T,1
MOVEM T,2(E)
MOVEI T,110+46
MOVEM T,1(E)
MOVEI T,210+46
MOVEM T,3(E)
ADDI E,3
HRLI E,700
JRST POPD
ITDD: MOVEI T,177
IDPB T,E ;PUT OUT 177 TO SIGNAL SPECIAL
POP P,D3
JRST PLOP2 ; (EENSY WORDS DESCRIBING CHARS)
>;STANFO
ITTTY: ITNGP: ITVTS: ITDM:
MOVEI PV,"<"
IDPB PV,E
IDPB PV,E
PUSH P,V
MOVE V,T
PUSHJ P,CONASC
POP P,V
MOVEI PV,">"
IDPB PV,E
IDPB PV,E
POPD: POP P,D3
JRST PLOPP
;CONR50, CONXWD, CONBP
; Conr50 -- For Printing Radix50 on Request -- 5T -- Conbp
; VALUE IN V
CONR50: MOVE D2,V
LDB V,[POINT 4,D2,3];GET HIGH ORDER BITS
LSH V,2
PUSHJ P,CONOCT ;TYPE OUT
MOVEI V,40 ;SPACE
IDPB V,E
JRST R5TYP
; L,,R PRINTER (EACH HALF SYMBOLIC)
CONXWD: MOVE T,V ;HOLD VALUE
HLRZS V ;GET LEFT HALF
JUMPE V,[SETCM PV,T
TRNE PV,TYPNEG ;SMALL NEG NUM IN RIGHT HALF?
JRST C4R1 ;NO
PUSHJ P,IT0 ;YES
JRST C4R2]
PUSHJ P,ADTYP ;TYPE IT
C4R2: MOVEI V,","
IDPB V,E
IDPB V,E
C4R1: HRRZ V,T ;GET RIGHT HALF
JUMPE V,IT0 ;ZERO?
JRST ADTYP ;TYPE IT
; BYTE POINTER PRINTER
CONBP: PUSH P,V
MOVE D3,['POINT']
PUSHJ P,SIXOUT ;TYPE 'POINT'
MOVEI V,40
IDPB V,E ;TYPE A SPACE
LDB V,[POINT 6,(P),11] ;GET SIZE
PUSHJ P,PDECCN ;TYPE IT
MOVE T,(P) ;GET WORD AGAIN
TLZ T,777740 ;CLEAR HIGH PART
PUSHJ P,NOACQ ;TYPE ADDRESS ETC.
LDB V,[POINT 6,(P),5] ;GET POSITION
SUB P,[1,,1]
CAIN V,44 ;IS POSITION 44?
JRST CPOPJ ;YES, DON'T TYPE IT
MOVEI M,","
IDPB M,E ;TYPE A COMMA
SUBI V,43
JRST PDECCN ;TYPE POSITION
; Conflt -- Floating Point Output Routine
CONFLT: JUMPL V,CF1
TLNN V,400 ;NORMALIZED?
JRST CONDEC ;NO
JRST CF2
CF1: MOVM T,V
TLNN T,400 ;NORMALIZED?
JRST CONDEC ;NO
MOVMS V
MOVEI T,"-" ;GET -
IDPB T,E ;DEPOSIT
CF2: MOVEM D1,D1SV ;SAVE D1
MOVE D1,V ;GET WORD
SETZB D2,D3
CAMGE D1,FT01 ;TOO SMALL?(LESS THAN .1?)
JRST FP4 ;YES
CAML D1,FT8 ;TOO BIG?(GREATER THAN 10**8?)
AOJA D2,FP4 ;YES
FP3:
;TYPE SCALED FLOATING POINT NUMBER IN D1. WE USE THE ALGORITHM DEVISED BY
;STEELE AND WHITE IN THE PAPER "A CRITERION FOR TERMINATION OF RADIX CONVERSION."
SETZB D2,D3
ASHC D1,-=27 ;D1_EXPONENT, D2_FRACTION
ASHC D2,-243(D1) ;INTEGER PART IN D2, FRACTION IN D3
MOVSI V,200000 ;GENERATE MASK, = 1/2 LEAST SIGNIFICANT ...
ASH V,-233(D1) ;...DIGIT (I.E. ONE PAST LAST FRACT BIT)
MOVE D1,V ;KEEP MASK IN D1
MOVE V,D2 ;GET WHOLE (INTEGER) PART
PUSHJ P,PDECCN ;PRINT WHOLE PART
MOVEI V,"." ;GET A .
IDPB V,E ;PRINT IT
CF3: MOVE D2,D3 ;GET THE REMAINING FRACTION
MULI D2,=10 ;NEXT DEC DIGIT IN D2, NEW FRACTION IN D3
MOVE V,D2
JOV .+1 ;CLEAR OV FLAG
IMULI D1,=10 ;MULTIPLY MASK TOO. 1 IF OVERFLOW
JOV CF31 ; 1 SO REMAINDER CAN'T BE IN [M,1-M]
CAMGE D3,D1 ;SKIP IF REMAINDER M
JRST CF31 ;AGAIN REMAINDER NOT IN [M,1-M]
MOVN M,D1 ;COMPUTE 1-M BY NEGATING M IN 35 BITS
TLZ M,400000
CAMLE D3,M ;SKIP IF REMAINDER 1-M
AOJA V,CF3D ;REMAINDER .GT. 1-M, SO ALSO .GT. 1/2
PUSHJ P,CON10B ;REMAINDER IN [M,1-M], PRINT DIGIT AND LOOP
JRST CF3
;GET HERE WHEN EITHER THE RANGE [M,1-M] IS EMPTY DUE TO M 1 OR WHEN
;THE REMAINDER .LT. M. EITHER WAY, THE REMAINDER COULD BE ON EITHER SIDE
;OF 1/2. DETERMINE WHICH SIDE AND INCREMENT THE LAST DIGIT APPROPRIATELY.
CF31: TLNE D3,200000 ;SKIP IF REMAINDER .LT. 1/2
ADDI V,1 ;BUMP LAST DIGIT
CF3D: PUSHJ P,CON10B ;PRINT LAST DIGIT
MOVE D1,D1SV
POPJ P,
D1SV: 0
FP4: MOVNI D3,6
MOVEI T,0
FP4A: ASH T,1 ;SHIFT COUNT
XCT FCP(D2) ;COMPARE
JRST FP4B ;NO YET
FMPR D1,@FCP+1(D2);YES, MULTIPLY
IORI T,1 ;INSERT A BIT IN COUNT
FP4B: AOJN D3,FP4A ;LOOP
PUSH P,FSGN(D2)
PUSHJ P,FP3 ;PRINT ADJUSTED #
POP P,M ;GET SIGN
MOVEI D2,"E" ;GET AN E
IDPB D2,E
IDPB M,E ;DEPOSIT SIGN
MOVE V,T ;GET COUNT
JRST DECCON
353473426555 ;1.0E32
266434157116 ;1.0E16
FT8: 233575360400 ;1.0E8
216470400000 ;1.0E4
207620000000 ;1.0E2
204500000000 ;1.0E1
FT: 201400000000 ;1.0
026637304366 ;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 D1,FT0(D3)
CAMGE D1,FT(D3)
FT0(D3)
FSGN: "-"
"+"
; Condec, Conbyt -- Decimal, Byte Printer
CONDEC: MOVE PV,V
JUMPGE PV,CONDE1 ;POSITIVE?
MOVEI V,"-" ;NO, PRINT A -
IDPB V,E
MOVMS PV
CONDE1: MOVEI V,"="
JUMPE PV,CON10A
IDPB V,E
JRST CON10A
DECCON: SKIPL PV,V
JRST CON10A
MOVEI V,"-"
IDPB V,E
PDECCN: MOVM PV,V
CON10A: JUMPGE PV,CON10C
SUBI PV,1 ;MUST BE 400000,, PRINT 377777,,777777
PUSHJ P,CON10C
ADDI V,1 ;THEN BUMP LOW DIGIT BY 1
DPB V,E
POPJ P,
CON10C: IDIVI PV,12 ;GET DIGIT
ADDI M,1
JUMPE PV,CON10B ;THAT ALL?
HRLM V,(P) ;NO, SAVE REMAINDER
PUSHJ P,CON10C ;PRINT REST
HLRZ V,(P) ;GET REMAINDER BACK
CON10B: ADDI V,"0"
IDPB V,E ;DEPOSIT CHR
POPJ P,
;CONBYT: BYTE MODE OUTPUT
CONBYT: MOVE M,T ;GET BYTE SIZE
MOVE D3,V ;GET #
MOVEI T,1
JUMPE M,CONB0 ;ZERO SIZE?
CONB1: MOVEI D2,
LSHC D2,(M) ;GET BYTE
LSH T,(M) ;COUNT BYTES
MOVE V,D2
PUSHJ P,CONOCT ;TYPE OUT BYTE
JUMPE T,CPOPJ ;DONE?
MOVEI V,"," ;NO
IDPB V,E ;TYPE A ,
JRST CONB1 ;LOP
CONB0: SKIPL M,SMASK+1 ;GET MASK
CONB2: SETCA M, ;COMPLEMENT
MOVEI D2,
CONB4: LSHC D2,1 ;SHIFT VALUE
LSH T,1 ;SHIFT COUNT
LSH M,1 ;SHIFT MASK
JUMPE T,.+2
JUMPL M,CONB4 ;LOOP
MOVE V,D2
PUSHJ P,CONOCT ;PRINT RESULT
JUMPE T,CPOPJ ;DONE?
MOVEI V,"," ;TYPE A ,
IDPB V,E
JRST CONB2
;Stsprt, Prgprt, Blkprt -- special top lines conversions
; Status:
; Go out rh(NBIGWD) spaces
; Print text indicated by index in LH(NBIGWD)
; If undefined, or multiply defined, (check F),
; print "-- symbol name"
; Do special size select things for DD
; Set LH(NBIGWD) to .OK, for next time
STSPRT:
IFN STANFO,<
MOVE T,DDSW
CAIE T,.DD
JRST STSPR1
MOVE M,[CW(\FNCN,\ALPHBG,\CHNL,0,\CHNL,0)]
MOVEM M,(E)
ADDI E,1
>;STANFO
STSPR1: HRRZ M,NBIGWD
SKIPA V,[" "]
IDPB V,E
SOJGE M,.-1
HLRZ V,NBIGWD
CAIE V,.OK ;MAKE SURE NEXT STATUS PRINTS IF
SETOM DDCON ; THIS ONE IS NOT "OK"
MOVE V,STSTXT(V)
PUSHJ P,CONASC
HRRI V,.OK
HRLM V,NBIGWD
TLCN F,PUFL!PMULFL ;BOTH ON MEANS "SKIP"
JRST SMLSET ; WERE BOTH OFF
TLNN F,PUFL!PMULFL ;BOTH ON?
JRST [ MOVE V,SKPVAL
PUSHJ P,CONOCT
JRST SMLSET ]
SKIPN D2,SYM
JRST SMLSET
MOVE V,[ASCII / -- /]
PUSHJ P,CONASC
PUSHJ P,R5TYP
SMLSET: TLZ F,PUFL!PMULFL ;ALL TOOK CARE OF
IFN STANFO,<
CAIE T,.DD
POPJ P,
PUSHJ P,CRLFOT ;NEED CR BEFORE SELECT SMALL
MOVE M,[CW(\FNCN,\ALPHA,\CHNL,0,\CHNL,0)]
MOVEM M,1(E)
ADDI E,1 ;ANOTHER CRLFOT WILL BE OK
>;STANFO
POPJ P,
; PRGNAM, BLKNAM -- just print (r50) the approp. names
IFE SORTED, <
PRGPRT: SKIPA D2,SYMPRG
BLKPRT: MOVE D2,SYMPNT
MOVE D2,(D2)
JRST R5TYP
>;NOT SORTED
IFN SORTED,<
PRGPRT: SKIPA D2,PID
BLKPRT: MOVE D2,BID
MOVE D2,@BLKNM2
JRST R5TYP
>;SORTED
;Spblt, Iotbl, Iofndi -- These Belong Elsewhere
; CODE TO SET UP SPACEWAR STUFF
IFN UESW,< SPBLT: HRLI 2,-1
DATAO 2
EXTERN JOBFF
MOVN 3,2
MOVE 4,36(3)
MOVEM 4,SPB1 ;SYS SYMBOL TABLE PTR
MOVS 5,4
ADD 4,3
MOVSS 4
HRR 4,JOBFF
MOVEM 4,JOBSYM
MOVEM 4,SPB2 ;BLT WORD
HRLM 5,JOBSYM
MOVNS 5
ADD 5,JOBFF
MOVEM 5,SPSWT1
SKIPN SPSWT2
0
BLT 4,-1(5)
SETZM SPBLT
SETZM SPSWT2
0
SPB1: 0
SPB2: 0>
IFN EXDSW,<
;I/O DEVICE TABLE
DEFINE IOMACR ()<
FOR A IN (<APR,0>,<PI,4>,<KLPAG,1010>,<CCA,1014>,<TIM,1020>,<PAG,2024>
,<MTR,1024>,<PTP,2100>,<PTR,2104>,<IOP,110>,<CTY,2120>,<LPT,1124>
,<C1A,1140>,<C1B,1144>,<DTE0,1200>,<DC,1204>,<DCB,2204>,<DTC,1210>
,<DTS,1214>,<MTC,1220>,<MTS,1224>,<MTM,1230>,<ADC,2240>,<DAC,2244>
,<DCSA,1300>,<DCSB,1304>,<DKB,1310>,<DCA,1320>
,<VDS,1340>,<FRM,3340>,<SIX,1344>,<PLT,2344>
,<HOT,1350>,<CAR,1354>,<KIM,1360>,<VMI,1364>,<PK,1370>,<DIL,1374>
,<IMP,1400>,<TV,1404>,<AD,2424>,<DPY,1430>,<KBD,1434>,<XGP,2440>
,<DSK,1444>,<ELF,1470>,<PMP,1500>,<IBM,1504>,<DDD,1510>,<MPX,1530>
,<SAMA,3540>,<SAMB,3544>,<SAMC,3550>,<SAMD,3554>
,<PCLK,2730>,<AS,1774>)>
DEFINE IOTB (NAME,NUM)<'NAME'>
$IOTAB:
IOTBL: REPEAT 4,<-1> ;DEV CODE PATCH AREA
IOMACR <IOTB (A)
>
IOTBLN__.-IOTBL
DEFINE IOTB (NAME,NUM)<NUM>
$IOTBN:
IOTBN: REPEAT 4,<-1>
IOMACR <IOTB (A)
>
IFN REALSW,<
INTERNAL $IOTAB,$IOTBN
>
^IOFNDI:SKIPA E,SIXSYM ;GET SYM
LSH E,-6 ;RIGHT ADJUST
TRNN E,77 ;DONE?
JRST .-2 ;NO
MOVEI T,IOTBLN ;GET TABLE LENGTH
ILOPO: CAME E,IOTBL-1(T) ;SAME?
SOJG T,ILOPO ;NO, LOOP
JUMPE T,CPOPJ ;NONE?
LDB M,[POINT 7,IOTBN-1(T),33];GET NUM
LSH M,2
MOVEM M,NM ;STORE VALUE
JRST CPOPJ1
>;END EXDSW
^CPOPJ1:AOS (P)
POPJ P, ;LEAVE
;Search Routines -- Oplook -- Opcode (Built-in) Finder
BEGIN OPLOOK
IFN REALSW,<
$OPLOOK:
INTERNAL $OPLOOK
>
;ON ENTRY T HAS A COPY OF THE INSTRUCTION (V)
^OPLOOK:SETZB PV,D2 ;CLEAR
MOVEM V,VSAV ;SAVE VALUE
LSHC PV,3 ;GET HIGH-ORDER BITS
JRST @OTB1(PV) ;GO TO APPROPRIATE ROUTINE
OTB1: OPUUO
OP1
OP2
OP3
OP4
OP5
OP6
OPIO
OP3: MOVEI PV,0 ;CLEAR
LSHC PV,3 ;GET NEXT 3 BITS
ADDI PV,TAB ;GO TO TABLE
LOP1: MOVE D3,(PV) ;GET ENTRY
LDB PV,[POINT 3,D3,35] ;GET SHIFT COUNT
IMULI PV,6
LSHC D2,(PV) ;GET CORRECT # OF LETTERS
MOVNS PV
LSH D3,-3(PV) ;SHIFT BACK
DPB D3,[POINT 2,PNT1,35];DEPOSIT # OF BITS FOR NEXT TEST
AOS PNT1 ;ADJUST
MOVEI PV,0 ;CLEAR
PNT1: LSHC PV,0 ;GET BITS (INSTRUCTION GETS CLOBBERED)
ANDI D3,774 ;GET NEXT TABLE #
JUMPE D3,DONE ;DONE?
ADDI PV,TAB(D3) ;GET NEXT ENTRY
JRST LOP1
OP4: MOVEI PV,0 ;CLEAR
LSHC PV,4 ;GET 4 BITS
MOVE D3,TAB4(PV) ;GET TABLE ENTRY
LDB PV,[POINT 3,D3,35] ;GET # OF CHRS.
IMULI PV,6
LSHC D2,(PV) ;SHIFT IN CHRS.
MOVEI PV,0 ;CLEAR
LSHC PV,2 ;GET NEXT BITS
ADDI PV,TAB+40 ;GO TO IMB TABLE
JRST LOP1
OP5: TLCE V,240000 ;SWAP BITS
TLCE V,240000
TLC V,240000
MOVEI PV,0
LSHC PV,2 ;GET 2 BITS
ADDI PV,TAB12
JRST LOP1
OP6: FOR @$ I IN (50,21,5)
<REPEAT 3,<TLCE V,I$0000>
>
MOVEI PV,0
LSHC PV,2 ;GET 2 BITS
ADDI PV,TAB14
JRST LOP1
OP2: MOVEI PV,0
LSHC PV,1 ;GET NEXT BIT (OPCODE 40 BIT)
JUMPN PV,OP2HI ;JUMP IF OPCODES 240-247
LSHC PV,3 ;GET 3 MORE BITS
ADDI PV,TAB17 ;GO TO TABLE 17
JRST LOP1
OP1: MOVEI PV,0
LSHC PV,1 ;GET NEXT BIT (OPCODE 40 BIT)
JUMPE PV,OP1LOW ;JUMP IF OP CODES 100-137
LSHC PV,3 ;GET 3 MORE BITS
ADDI PV,TAB21-10
JRST LOP1
OP1LOW: LSHC PV,5 ;GET REMAINING OPCODE BITS
MOVE D2,TAB1LO(PV) ;GET TEXT OF OPCODE
CAIE PV,33 ;SKIP IF IT'S IBP
JRST DONE
LSHC PV,4
TRNE PV,17 ;SKIP IF AC FIELD IS ZERO
MOVE D2,[SIXBIT /ADJBP/] ;IBP AC,N IS REALLY ADJBP AC,N
DONE: MOVE V,VSAV
POPJ P,
OP2HI: LSHC PV,5 ;GET REMAINING OPCODE BITS
MOVE D2,TAB2HI-40(PV) ;GET TEXT OF OPCODE
JRST DONE
OPUUO: LSHC PV,6 ;GET REST OF OP-CODE
IFN STANFO,<
CAIGE PV,40
POPJ P, ;NOT SYS UUO
CAIN PV,<CALLI>-33
JRST OPCLI ;SPECIAL TREATMENT FOR CALLIS
IONOT: MOVE V,VSAV
HLLZ D2,V
TLZ D2,37
CALLIT D2, ;TRY IT WITH AC FIELD
JUMPN D2,OPUU2 ;GOT IT - NOW AVOID PRINTING AC
OPUU1: HLLZ D2,V
TLZ D2,777
TLO D2,1 ;FORCE MAJOR OPCODE LOOKUP
CALLIT D2, ;NOW TRY OP ALONE
JUMPE D2,OPLUZ
>;STANFO
OPWIN: MOVEI V,73
DPB V,[POINT 9,T,8] ;STORE DUMMY OPCODE FOR CLEVER CYMBOLIC MODE PRINTER
OPLUZ: POPJ P, ;RETURN WHATEVER
IFN STANFO,<
OPCLI: MOVE V,VSAV
TLNE V,37 ;DON'T DECODE WITH ADR IF ANY @() BITS
JRST OPUU1
MOVE D2,V
TLZ D2,777
CALLIT D2, ;LOOK UP WITH ADR
JUMPE D2,OPUU1 ;LOSE - RETURN "CALLI" ANYWAY
TRZA T,-1 ;WIN - AVOID PRINTING ADR
OPUU2: TLZ T,740 ;FLUSH AC FIELD (ZERO OR PART OF OPCODE)
>;STANFO
IFE STANFO,<
TRZE PV,40
MOVE D2,TABUUO(PV)
IONOT:
>;NOT STANFO
JRST OPWIN
^^$IO: IFN UESW!FILESW,<-1;>0 ;IF ON, SHOULD PRINT IOTS (SEE BELOW)
IFN REALSW,<
INTERNAL $IO
>
IFN EXDSW,<
OPIO: MOVE V,VSAV ;GET VALUE
SKIPN $IO ;ARE WE TO PRINT MACHINE IOTS
IFN STANFO,<JRST IONOT> ;NO, TRY UUO IOTS
IFE STANFO,<POPJ P,>
LDB PV,[POINT 3,V,12] ;GET REST OF I/O CODE
MOVE D2,TABIO(PV) ;GET OPCODE
LDB PV,[POINT 7,V,9] ;GET DEVICE #
MOVEI D3,IOTBLN ;GET TABLE LENGTH
IOLOP: LDB V,[POINT 7,IOTBN-1(D3),33];GET #
CAIE V,(PV) ;SAME?
IOLOP2: SOJG D3,IOLOP ;NO, LOOP
JUMPE D3,OPIO2 ;NOT FOUND?
HRLI PV,(D3) ;SAVE POTENTIAL CANDIDATE
LDB V,[POINT 3,IOTBN-1(D3),26] ;SEE WHICH PROCESSOR
CAME V,$IO
JUMPN V,IOLOP2 ;WRONG ONE
OPIO1: SKIPE V,D3
MOVE V,IOTBL-1(D3) ;GET NAME
TRO F,CONOFF
POPJ P,
OPIO2: SKIPL $IO ;NEG MEANS ALWAYS PRINT AS I/O
JRST IONOT ;TRY AS SYS CALL
HLRZ D3,PV
JRST OPIO1
>;END EXDSW
IFE EXDSW,<OPIO_IONOT>
;TABIO, TAB, TABOR
;D IS NUMBER OF CHARACTERS (3 BIT FIELD). MUST BE 4 OR LESS.(5 IF AT END OF LIST)
;C IS THE NUMBER OF BITS - 1 TO LOOK AT FOR THE NEXT TABLE
;B IS A 7 BIT FIELD WHICH IS MULTIPLIED BY 4 TO GIVE THE DISTANCE
; FROM TAB OF THE NEXT TABLE TO LOOK AT. THE NUMBER OF BITS FROM
; THE INSTRUCTION SPECIFIED BY THE C FIELD (+1) IS ADDED IN TO GIVE
; THE OFFSET WITHIN THE NEW TABLE.
DEFINE TT (A,B,C,D)
<<SIXBIT /A/>+D+B5+C3>
TABOR:
TT(OR,0,0,2)
TABIO: FOR S IN (BLKI,DATAI,BLKO,DATAO,CONO,<CONI>
,CONSZ,CONSO)
<'S'
>
TAB: ;0 (TAB)
TT(CAI,2,2,3)
TT(CAM,2,2,3)
TT(JUMP,2,2,4)
TT(SKIP,2,2,4)
TT(AOJ,2,2,3) ;1 (TAB+4)
TT(AOS,2,2,3)
TT(SOJ,2,2,3)
TT(SOS,2,2,3)
TT(A,0,0,0) ;2 (TAB+10)
TT(L,0,0,1)
TT(E,0,0,1)
TT(LE,0,0,2)
TT(A,0,0,1) ;3 (TAB+14)
TT(GE,0,0,2)
TT(N,0,0,1)
TT(G,0,0,1)
TAB4: ;(AUTOMATICALLY USES TABLE 10 FOR I,M,B)
TT(SETZ,0,0,4) ;4 (TAB+20)
TT(AND,0,0,3)
TT(ANDCA,0,0,5)
TT(SETM,0,0,4)
TT(ANDCM,0,0,5) ;5 (TAB+24)
TT(SETA,0,0,4)
TT(XOR,0,0,3)
TT(IOR,0,0,3)
TT(ANDCB,0,0,5) ;6 (TAB+30)
TT(EQV,0,0,3)
TT(SETCA,0,0,5)
TT(ORCA,0,0,4)
TT(SETCM,0,0,5) ;7 (TAB+34)
TT(ORCM,0,0,4)
TT(ORCB,0,0,4)
TT(SETO,0,0,4)
TT(A,0,0,0) ;10 (TAB+40)
TT(I,0,0,1)
TT(M,0,0,1)
TT(B,0,0,1)
TT(A,0,0,0) ;11 (TAB+44)
TT(I,0,0,1)
TT(M,0,0,1)
TT(S,0,0,1)
TAB12: ;12 (TAB+50)
TT(HLL,13,1,3)
TT(HRL,13,1,3)
TT(HRR,13,1,3)
TT(HLR,13,1,3)
TT(A,11,1,0) ;13 (TAB+54)
TT(O,11,1,1)
TT(Z,11,1,1)
TT(E,11,1,1)
TAB14: ;14 (TAB+60)
TT(TR,15,1,2)
TT(TL,15,1,2)
TT(TD,15,1,2)
TT(TS,15,1,2)
TT(N,16,1,1) ;15 (TAB+64)
TT(Z,16,1,1)
TT(C,16,1,1)
TT(O,16,1,1)
TT(A,0,0,0) ;16 (TAB+70)
TT(A,0,0,1)
TT(E,0,0,1)
TT(N,0,0,1)
TAB17: ;17 (TAB+74)
TT(MOVE,11,1,4)
TT(MOVS,11,1,4)
TT(MOVN,11,1,4)
TT(MOVM,11,1,4)
TT(IMUL,10,1,4) ;20 (TAB+100)
TT(MUL,10,1,3)
TT(IDIV,10,1,4)
TT(DIV,10,1,3)
TAB21:
TT(FAD,23,1,3) ;21 (TAB+104)
TT(FADR,10,1,4)
TT(FSB,23,1,3)
TT(FSBR,10,1,4)
TT(FMP,23,1,3) ;22
TT(FMPR,10,1,4)
TT(FDV,23,1,3)
TT(FDVR,10,1,4)
TT(0,0,0,0) ;23 (TAB+114)
TT(L,0,0,1)
TT(M,0,0,1)
TT(B,0,0,1)
TAB1LO:
0 ;100
0 ;101
0 ;102
0 ;103
0 ;104 JSYS
SIXBIT /ADJSP/ ;105
0 ;106 SXCT
0 ;107
SIXBIT /DFAD/ ;110
SIXBIT /DFSB/ ;111
SIXBIT /DFMP/ ;112
SIXBIT /DFDV/ ;113
SIXBIT /DADD/ ;114
SIXBIT /DSUB/ ;115
SIXBIT /DMUL/ ;116
SIXBIT /DDIV/ ;117
SIXBIT /DMOVE/ ;120
SIXBIT /DMOVN/ ;121
SIXBIT /KIFIX/ ;122 FIX
SIXBIT /EXTEND/ ;123
SIXBIT /DMOVEM/ ;124
SIXBIT /DMOVNM/ ;125
SIXBIT /FIXR/ ;126
SIXBIT /FLTR/ ;127
SIXBIT /UFA/ ;130
SIXBIT /DFN/ ;131
SIXBIT /FSC/ ;132
SIXBIT /IBP/ ;133 (ALSO ADJBP)
SIXBIT /ILDB/ ;134
SIXBIT /LDB/ ;135
SIXBIT /IDPB/ ;136
SIXBIT /DPB/ ;137
TAB2HI:
SIXBIT /ASH/ ;240
SIXBIT /ROT/ ;241
SIXBIT /LSH/ ;242
SIXBIT /JFFO/ ;243
SIXBIT /ASHC/ ;244
SIXBIT /ROTC/ ;245
SIXBIT /LSHC/ ;246
SIXBIT /KAFIX/ ;247
SIXBIT /EXCH/ ;250
SIXBIT /BLT/ ;251
SIXBIT /AOBJP/ ;252
SIXBIT /AOBJN/ ;253
SIXBIT /JRST/ ;254
SIXBIT /JFCL/ ;255
SIXBIT /XCT/ ;256
SIXBIT /MAP/ ;257
SIXBIT /PUSHJ/ ;260
SIXBIT /PUSH/ ;261
SIXBIT /POP/ ;262
SIXBIT /POPJ/ ;263
SIXBIT /JSR/ ;264
SIXBIT /JSP/ ;265
SIXBIT /JSA/ ;266
SIXBIT /JRA/ ;267
SIXBIT /ADD/ ;270
SIXBIT /ADDI/ ;271
SIXBIT /ADDM/ ;272
SIXBIT /ADDB/ ;273
SIXBIT /SUB/ ;274
SIXBIT /SUBI/ ;275
SIXBIT /SUBM/ ;276
SIXBIT /SUBB/ ;277
IFE STANFO,<
TABUUO: FOR QQ IN ('CALL','INIT',0,'SPCWAR',0,0,0,'CALLI','OPEN','TTYUUO')
<QQ
>
FOR I_52,54
<0
>
FOR QQ IN (RENAME,IN,OUT,SETSTS,STATO,<GETSTS>
,STATZ,INBUF,OUTBUF,INPUT,OUTPUT,CLOSE,<RELEAS>
,MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER)
<'QQ'
>
>;NOT STANFO
;SRCH1, SRCH, FNDOP
;CALL WITH TABLE POINTER IN RIGHT HALF OF E, COUNT IN LEFT HALF.
;SEARCHES THE TABLE FOR AN OCCURENCE OF THE FIRST N CHARS OF V.
;LH(T) HAS INITIAL VALUE, RH(T) HAS VALUE TO SHIFT IT BY.
;SKIP RETURNS IF NOT FOUND
SRCH1: HRRZM T,LCNT
HLRZM T,VAL
HLRZM E,CNT1
BEGIN SRCH
^SRCH: MOVSI M,E
LOOP1: MOVE D3,@M ;GET ENTRY
LDB T,[POINT 3,D3,35] ;GET # OF CHARACTERS
IMULI T,6
LSHC D2,(T)
LSHC PV,(T) ;GET CHRS
MOVNS T
CAMN D2,PV ;SAME?
JRST SAM2 ;YES
LOOP2: LSHC D2,(T)
LSHC PV,(T) ;PUT BACK, NOT SAME
SOSLE CNT1 ;NOT SAME, TRY NEXT. DONE WITH THIS TABLE?
AOJA M,LOOP1 ;NO, TRY NEXT
AOS (P) ;SKIP RETURN, NOT FOUND
POPJ P,
SAM2: PUSH P,M ;SAVE...
PUSH P,E
PUSH P,T
LSH D3,-3(T) ;READJUST
MOVE T,VAL ;GET VALUE SO FAR
LSH T,@LCNT ;SHIFT
IORI T,(M) ;OR IN ADDITIONAL VALUE
PUSH P,VAL ;SAVE...
PUSH P,LCNT
PUSH P,CNT1
MOVEM T,VAL ;STORE VALUE
LDB T,[POINT 2,D3,35] ;GET # OF BITS
ADDI T,1
ANDI D3,774 ;GET TABLE NUMBER
SKIPN E,D3 ;TABLE # ZERO?
JRST ADON ;YES, ALL DONE
ADDI E,TAB
MOVEM T,LCNT ;SAVE # OF BITS (SHIFT COUNT)
MOVEI D3,1
LSH D3,(T) ;FORM TABLE LENGTH
MOVEM D3,CNT1 ;STORE
PUSHJ P,SRCH ;TRY NEXT TABLE
JRST ADON ;DONE?
ARET: POP P,CNT1 ;NOT DONE, RESTORE EVERYTHING
POP P,LCNT
POP P,VAL
POP P,T
POP P,E
POP P,M
JRST LOOP2 ;TRY SOME MORE
ADON: JUMPN V,ARET ;ANY LEFT?
SUB P,[6,,6] ;THROW AWAY SAVED STUFF
POPJ P, ;LEAVE
BEND SRCH
CNT1: 0
LCNT: 0
VAL: 0
^FNDOP: PUSH P,D3
PUSH P,PV
MOVEI D2,0
MOVE V,SIXSYM ;GET SYMBOL
BEGIN FNDOP
MOVEI PV,0
LSHC PV,6 ;GET FIRST CHR.
CAIN PV,'H' ;IS IT H?
JRST ITH ;YES
CAIN PV,'T' ;IS IT T?
JRST ITT ;YES
LSHC PV,-6
PUSHJ P,SOTH
SUUOQ: PUSHJ P,SUUO
POP P,PV
POP P,D3
POPJ P,
ITH: LSHC PV,-6 ;READJUST
PUSHJ P,SHCH ;RETURNS ONLY IF NOT SUCCESSFUL
JRST SUUOQ
ITT: LSHC PV,-6
PUSHJ P,STTZ ;RETURNS ONLY IF NOT SUCCESSFUL
JRST SUUOQ
SOTH: MOVEI T,TAB4 ;FIRST TRY BOOLEAN INSTRUCTIONS
MOVEI M,20
LOOP3: MOVE D3,(T) ;GET TABLE ENTRY
LOOP3A: LDB E,[POINT 3,D3,35] ;GET # OF CHRS
IMULI E,6
LSHC D2,(E)
LSHC PV,(E)
MOVNS E
CAMN PV,D2 ;SAME?
JRST SAM3 ;YES, FIND MODE (COME BACK IF TWO OR MORE LEFT)
NOSM3: LSHC PV,(E)
LSHC D2,(E)
ADDI T,1 ;NO, TRY AGAIN
SOJG M,LOOP3
JUMPL M,PNTQ
MOVE D3,TABOR
MOVEI T,TAB4+7 ;ENTRY FOR "IOR"
JRST LOOP3A
SAM3: TLNE V,7700 ;IF MORE THAN ONE
JRST NOSM3 ; LETTER LEFT TO SATISFY, LOOK SOME MORE
SUBI T,TAB4-100 ;ADJUST VALUE
MOVSS T
HRRI T,2 ;2 BITS NEXT
PUSH P,E
MOVE E,[4,,TAB+40]
PUSHJ P,SRCH1
JRST ADONE2 ;MATCH
POP P,E
LSHC PV,(E) ;READJUST
MOVEI D2,0
JRST PNTQ
ADONE2: POP P,E
JRST ADONE
PNTQ: MOVE T,[2,,4] ;NOT HERE, TRY THE 2 GROUP
MOVE E,[10,,TAB17]
PUSHJ P,SRCH1 ;SEARCH THE TABLE
JRST ADONE ;SAME
MOVE T,[3,,3] ;NO MATCH, TRY THE 3 GROUP
MOVE E,[10,,TAB]
PUSHJ P,SRCH1
JRST ADONE ;MATCH
MOVE T,[3,,3] ;NO MATCH, TRY THE 1 GROUP
MOVE E,[10,,TAB21]
PUSHJ P,SRCH1
JRST ADONE ;MATCH
MOVSI T,-40
PNTQ1: CAME V,TAB2HI(T)
AOBJN T,PNTQ1
JUMPGE T,PNTQ2 ;JUMP IF NO MATCH
MOVEI E,240(T)
JRST ADONE9
PNTQ2: MOVSI T,-40
PNTQ3: CAME V,TAB1LO(T)
AOBJN T,PNTQ3
JUMPGE T,PNTQ4 ;JUMP IF NO MATCH
MOVEI E,100(T)
JRST ADONE9
PNTQ4: MOVEI E,133
CAMN V,[SIXBIT /ADJBP/]
JRST ADONE9
MOVEI E,0 ;NO, TRY I/O
MOVEI T,10
JSR [ RTJS: 0
MOVE PV,V
LPL: TRNE PV,77
JRST @RTJS
LSH PV,-6
JRST LPL ]
;FALLS THROUGH
;SUUO
;FALLS THROUGH FROM PREVIOUS PAGE
LOOP4: CAMN PV,TABIO(E) ;MATCH?
JRST IMAT ;YES
ADDI E,1
SOJG T,LOOP4 ;NO
POPJ P, ;NO MATCH ANYWHERE
IMAT: ADDI E,16000 ;FORM OPCODE
LSH E,27 ;ADJUST
TRO F,CONOF ;SET FLAG
RET: MOVEM E,NM ;DEPOSIT
POP P,E ;THROW AWAY RETURN
POP P,PV ;RESTORE
POP P,D3
POP P,E ;THROW AWAY RETURN
TLO F,NUMF!SYMF!SCFL ;SET FLAGS
POPJ P, ;RETURN TO FNDOP'S CALLER'S CALLER
ADONE: MOVE E,VAL ;GET VALUE
ADONE9: LSH E,33 ;ADJUST
JRST RET
STTZ: MOVE D2,PV
MOVE T,[6,,2] ;TRY THE 6 GROUP (T)
MOVE E,[4,,TAB14]
PUSHJ P,SRCH1
JRST .+2 ;MATCH
POPJ P, ;NO MATCH
MOVE E,VAL
FOR @$ I IN (5,21,50)
<REPEAT 3,<TRCE E,I>
>
JRST ADONE9
SHCH: MOVE D2,PV
MOVE T,[5,,2] ;TRY THE 5 GROUP
MOVE E,[4,,TAB12]
PUSHJ P,SRCH1
JRST .+2
POPJ P,
MOVE E,VAL
TRCE E,24
TRCE E,24
TRCE E,24
JRST ADONE9
IFN STANFO,<
SUUO: MOVE E,V
TLNN E,77
JRST SUUOSM ;ONE OR TWO CHARACTERS
SUUOS1: CALLIT E, ;SEE IF SYSTEM KNOWS ABOUT IT
JUMPN E,RET ;AHA! GOT VALUE FROM SYSTEM
POPJ P, ;NO LUCK NOHOW
SUUOSM: CAME E,[SIXBIT /IN/]
POPJ P,
JRST SUUOS1
>;STANFO
IFE STANFO,<
SUUO: MOVEI E,
MOVEI T,40
JSR RTJS
SLOP1: CAMN PV,TABUUO(E) ;SAME
JRST SDONN ;YES
ADDI E,1
SOJG T,SLOP1 ;DONE?
POPJ P, ;YUP, NO LUCK
SDONN: ADDI E,40
JRST ADONE9
>;NOT STANFO
BEND FNDOP
^FNDOP__FNDOP
BEND OPLOOK
^FNDOP__FNDOP
IFE SORTED,< ;STANDARD SYMBOL TABLE (UNSORTED) ROUTINES (ENDS ON PAGE 46)
BEGIN FNDSYM
RDF(MNBLK,1)
RDF(CNTF,2)
; Fndsym -- The VALSYM Symbol Table Searcher.
;
; VALUE IN V
; RETURNS IN
; DNSYM, DNDIF, DNCUR THE SYMBOL NAME, VALUE, AND BLOCK NAME
; (-1 IF SHOULD NOT BE TYPED) OF THE SYMBOL WHOSE VALUE IS
; EQUAL TO OR LEAST LESS THAN THE VALUE IN V.
; UPSYM, UPDIF, UPCOR THE CORRESPODING THINGS FOR THE SYMBOL
; WHOSE VALUE IS LEAST GREATER THAN THE VALUE IN V.
^FNDSYM:
MOVEI PV,NUMCSH-1 ;FIRST SEARCH FOR RECENT FINDS
FNDL1: CAME V,VALCSH(PV) ;IS VALUE EQ THIS VALUE?
SOJGE PV,FNDL1 ;NO, CONTINUE
JUMPL PV,FNDS1 ;WE FAILED
QUICFD: SETZM DNDIF ;EXACT MATCHES ONLY
MOVEI E,DNSYM-1 ;NOW SAVE SYMBOL NAMES AND BLOCK NAMES
PUSH E,VALSYM(PV) ;LOWER SYMBOL NAME
PUSH E,VALBLK(PV) ;LOWER BLOCK NAME
JRST BDON ;ALL DONE
FNDS1: MOVEI E,SYMPRG ;INITIALIZE
HRRM E,PNT1
MOVE E,[400000,,1]
MOVEM E,UPDIF ;INITIALIZE DIFERENCES
HRLOI E,377777
MOVEM E,DNDIF
SETZM UPSYM
SETZM DNSYM
SETOM WRPSW
SETOM UPCUR
SETOM DNCUR
TRNN F,CNVABS ;USE ABS VAL?
SKIPGE PV,SYMPNT ;GET SYMBOL POINTER
POPJ P, ;NONE
MOVE E,1(PV) ;GET BLOCK LEVEL
MOVEM E,BLKLV ;SAVE
TB O,F,MNBLK
TB Z,F,CNTF
LOP2: MOVSI M,400000 ;INITIAL CODE BIT MASK
LOP1: SUB PV,[2,,2] ;GO TO NEXT
JUMPL PV,ATTOP ;AT TOP (BOTTOM?) OF TABLE?
PNT1: ;CAMN PV,SYMPRG ;BACK TO START?
CAMN PV,SYMPNT ;BACK TO REAL START?
JRST DON ;YES
TDNE M,(PV) ;MASK BIT ON?
JRST LOP1 ;YES
LDB E,[POINT 4,(PV),3];GET CODE BITS
CAIN E,3 ;BLOCK NAME?
JRST BLKCHK ;YES
JUMPE E,PRGCHK ;PROGRAM NAME?
MOVE E,V ;GET VALUE
SUB E,1(PV) ;GET DIFFERENCE
JUMPGE E,PNT2 ;FOUND ONE SMALLER?
CAMGE E,UPDIF ;NO, COMPARE FOR BETTER MATCH
JRST LOP1 ;NOT BETTER
CAME E,UPDIF ;EQUAL MATCH?
JRST .+4
TB NE,F,MNBLK, ;IN MAIN BLOCK?
SKIPN UPCUR ;OTHER IN MAIN BLOCK?
JRST LOP1 ;NO, YES
MOVEM E,UPDIF ;DEPOSIT NEW DIF.
MOVE E,1(PV) ;ACTUAL VALUE
MOVEM E,UPADR ;SAVE FOR QUICK-FIND CACHE STORAGE
MOVE E,(PV) ;GET SYMBOL NAME
MOVEM E,UPSYM ;SAVE
SETZM UPCUR
TB NE,F,MNBLK, ;IN THE MAIN BLOCK?
JRST LOP1 ;YES
LOP3: MOVE E,CURBL ;NO, GET BLOCK NAME
MOVEM E,UPCUR ;SAVE
JRST LOP1
PNT2: JUMPE E,PNT3 ;EXACT MATCH
CAMLE E,DNDIF ;COMPARE FOR BETTER MATCH
JRST LOP1 ;NO
CAME E,DNDIF ;EQUAL MATCH?
JRST .+4
TB NE,F,MNBLK, ;IN MAIN BLOCK?
SKIPN DNCUR ;OTHER IN MAIN BLOCK?
JRST LOP1 ;NO, YES
MOVEM E,DNDIF ;DEPOSIT NEW DIF
MOVE E,1(PV) ;SAVE ACTUAL VALUE FOR
MOVEM E,DNADR ; QUICK-FIND CACHE STORAGE
MOVE E,(PV) ;GET SYMBOL NAME
MOVEM E,DNSYM ;SAVE
SETZM DNCUR
TB NE,F,MNBLK, ;IN THE MAIN BLOCK?
JRST LOP1 ;YES
MOVE E,CURBL ;NO, GET BLOCK NAME
MOVEM E,DNCUR ;SAVE
JRST LOP1
PNT3: SETZM UPDIF
MOVE E,(PV) ;GET NAME
MOVEM E,UPSYM ;SAVE
SETZM UPCUR
TB NE,F,MNBLK, ;IN THE MAIN BLOCK?
JRST ADON ;YES
JRST LOP3 ;YES
BLKCHK: MOVE E,1(PV) ;GET VLOCK LEVEL
TB O,F,MNBLK
CAMGE E,BLKLV ;COMPARE WITH CURRENT
JRST [MOVEM E,BLKLV ;THESE O.K.
JRST LOP1]
TB Z,F,MNBLK, ;CLEAR FLAG
MOVE E,(PV) ;GET BLOCK NAME
MOVEM E,CURBL ;SAVE
JRST LOP1
PRGCHK: TLO M,100000 ;LOOK ONLY FOR GLOBALS
JRST LOP1
ATTOP:
SKIPLE WRPSW
JRST ADON
EXCH PV,V ;HOLD VALUE
;NOW V HAS THE SYMBOL TABLE POINTER FOR WRAPQ.
PUSHJ P,WRAPQ ;GO TO BOTTOM (TOP?) OF TABLE
EXCH PV,V ;RESTORE VALUE
JRST PNT1
DON: TB OE,F,CNTF, ;ALL DONE?
JRST ADON ;YES
CAMN PV,SYMPNT ;NO BLOCKS?
JRST ADON ;YES
MOVEI E,SYMPNT ;LOOK FOR SSTARTING POINT
HRRM E,PNT1
SETZM BLKLV
SETZM WRPSW ;HO HO......
JRST LOP2
ADON: SKIPN DNSYM ;EXACT MATCH?
SKIPE DNDIF ;EXACT MATCH?
JRST BDON ; NO, DON'T STORE IN CACHE
SOSGE PV,NCSHPT ;UPDATE MOST RECENT POINTER
MOVEI PV,NUMCSH-1 ;WRAPAROUND
MOVEM PV,NCSHPT
HRROI E,DNADR ;NOW STORE NEWLY FOUND VALUES IN CACHE
POP E,VALCSH(PV) ;LOWER VALUE
POP E,VALBLK(PV) ;LOWER BLOCK NAME
POP E,VALSYM(PV) ;LOWER DITTO
BDON: TB Z,F,CNTF
TB Z,F,MNBLK
POPJ P,
BEND FNDSYM
WRPSW: 0
^WRPSW_WRPSW
DNSYM: 0
DNCUR: 0
DNADR: 0
UPSYM: 0
UPCUR: 0
UPADR: 0
UPDIF: 0
DNDIF:0
CURBL:0
VSAV:0
BEND SUBS
;Symlok -- SymbolValue Searcher -- Wrap, Csflush, Cpopj
; HERE IS THE SYMVALUE SYMBOL TABLE SEARCHER
; RADIX50 FOR SYMBOL IN `SYM', SKIPS AND CONTAINS SYMBOL ENTRY IN SPNT
; AND V IF FINDS IT, ELSE NO SKIP
^SYMLOK: MOVEI V,NUMCSH-1 ;FIRST SEARCH THE RECENT CACHE
MOVE E,SYM
CAME E,SYMCSH(V) ;HAVE WE SEEN IT RECENTLY?
SOJGE V,.-1 ; NOT YET
JUMPL V,SYMLK1 ;QUICK SEARCH FAILED
MOVE V,SYMVAL(V) ;GET POINTER TO SYMTAB FOR THIS SYM
JRST LOP77 ;RETURN FAST FAST FAST
SYMLK1:
SKIPGE V,SYMPNT ;GET SYMBOL TABLE POINTER
JRST NONE ;NO SYMBOLS
MOVE E,1(V) ;GET BLOCK LEVEL
MOVEM E,BLKLV ;SAVE BLOCK LEVEL
MOVSI M,200000 ;INITIAL CODE BIT MASK
HLRE T,JOBSYM ;GET COUNT
ASH T,-1 ;ADJUST
LOP4: SUB V,[2(2)] ;GO TO NEXT
AOJGE T,NONE ;DONE?
JUMPGE V,.+2 ;AT TOP (BOTTOM?) OF TABLE?
PUSHJ P,WRAPQ ;YES
LOP5: TDNE M,(V) ;MASK BITS ON?
JRST LOP4 ;YES, IGNORE SYMBOL
LDB E,[POINT 4,(V),3];GET CODE BITS
CAIN E,3 ;BLOCK NAME?
JRST BLKCHK ;YES
JUMPE E,PRGCHK ;PROGRAM NAME?
LDB E,[POINT 32,(V),35];GET SYMBOL
CAME E,SYM ;SAME?
JRST LOP4 ;NO
LOP7: SOSGE E,SCSHPT ;GET NEXT FREE MOD SIZE OF CACHE
MOVEI E,NUMCSH-1 ;WRAP-AROUND
MOVEM E,SCSHPT
MOVE M,SYM ;SYMBOL NAME (NO BITS)
MOVEM M,SYMCSH(E) ;SAVE NAME FOR QUICK SEARCH
MOVEM V,SYMVAL(E) ;SAVE SYMBOL POINTER
LOP77: MOVE E,1(V) ;GET VALUE
SYMDOT: MOVEM E,NM ;STORE
MOVEM V,SYMP ;SAVE POINTER
TLO F,NUMF!SYMF!SCFL ;SET FLAGS
ITCHK: CAIN C,"." ;IS AHEAD CHAR <ctrl1>. ?
CAIE B,1
POPJ P, ; NO
TLZ F,SCFL ;NOT AHEAD ANY MORE
SETZM SAVMOD ;DON'T USE ANY INPUT-DRIVEN MODE
JSR FNDSCR ;ON SCREEN?
JRST [ HLRZ M,(M)
TLZ M,400037 ;CLEAR NON-MODE BITS
LSH M,-5 ;IN SAVMOD FORMAT
TLNN F1,FIRF ;FIRST THING?
HRRM M,SAVMOD ;YES, USE THIS MODE
JRST .+1 ]
JRST ITD1 ;USE CONTENTS OF THAT CELL
POPJ P,
; FLUSH ALL CACHES, SOMETHING DRASTIC HAS CHANGED
^CSFLUSH:
SETOM SYMCSH ;SET TO RIDICULOUS VALUE
MOVE E,[XWD SYMCSH,SYMCSH+1]
BLT E,CSHEND ;CLEAR ALL TO -1
POPJ P,
^WRAPQ: ^WRAP:
ORDWRP: HLRE E,JOBSYM ;GET SYMBOL TABLE LENGTH
MOVNS E ;PUT IN POSITIVE FORM
MOVEI V,-2(E) ;REDUCE BY 2
ADD V,JOBSYM ;FIND END OF TABLE
WRPDON: HRL V,E ;PUT POSITIVE COUNT IN LEFT
AOS WRPSW
POPJ P,
PRGCHK: TLO M,100000 ;LOOK ONLY FOR GLOBALS
JRST LOP4
BLKCHK: MOVE E,1(V) ;GET BLOCK LEVEL
CAMGE E,BLKLV ;COMPARE WITH CURRENT LEVEL
JRST [MOVEM E,BLKLV ;THESE SYMBOLS O.K.
JRST LOP4 ]
LOP6A: MOVSI E,40000 ;MASK BIT
LOP6: SUB V,[2(2)] ;GO TO NEXT
AOJGE T,NONE ;DONE?
JUMPGE V,.+2 ;AT TOP?
PUSHJ P,WRAPQ ;YES
TDNN E,(V) ;GLOBAL OR BLOCK?
JRST LOP6 ;NO
LDB E,[POINT 4,(V),3];GET CODE BITS
CAIN E,3 ;BLOCK NAME?
JRST BLKCHK ;YES
LDB E,[POINT 32,(V),35] ;GET SYMBOL NAME
CAME E,SYM ;SAME?
JRST LOP6A ;NO
JRST LOP7 ;YES
NONE:
IFN EXDSW,<PUSHJ P,IOFNDI> ;FIND AS I/O DEV. NAME
TLOA F,SYMF!SCFL!UNDF ;NOT FOUND
TLO F,NUMF!SYMF!SCFL ;FOUND
^CPOPJ: POPJ P,
;Prgfnd, Prgset, Blkfnd, Blkfn
^PRGFND: PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
TLNN F1,SINGF ;SINGLE SYMBOL?
JRST CERR ;NO
MOVEI T,0 ;HUNT FOR PROGRAM NAME
SETZM WRPSW
PUSHJ P,WRAP ;GET START
PUSHJ P,PGFND ;FIND
JRST PU ;COULDN'T
MOVEM V,SYMPNT ;SAVE POINTER
MOVEM V,SYMPRG ; " "
MOVE T,(V)
MOVEM T,PRGSAV#
MOVEI T,3 ;LOOK FOR BLOCK
PUSHJ P,PBCON
JRST INSBLK ;INSERT IN REF LIST
MOVEM V,SYMPNT
JRST INSBLK
; PROGRAM NAMES ARE LINKED TOGETHER (USUALLY) VIA NEGATIVE DISTANCES
; IN LEFT HALF OF VALUE WORD -- FIND RIGHT PROGRAM REAL FAST
PGFND: MOVE E,(V) ;GET SYMBOL NAME AT THIS LOC (GUARANTEED PROG NAME)
MOVEI T,0 ;IN CASE HAVE TO CALL PBCON FOR PROG NAME
CAMN E,SYM ; (TYPE BITS 0, CAM OK) ;ALL DCS
JRST OKPOPJ ; THIS IS IT
HLRE E,1(V) ;GET NEG DISTANCE TO NEXT
JUMPE E,PBCON ;END OF LINKS, MAYBE NOT LINKED
MOVNS E ;GET POS VALUE
HRLS E ;USE ON BOTH HALVES
SUB V,E ;NEXT
JRST PGFND
PBFND: LDB E,[POINT 4,(V),3];GET CODE BITS
CAMN E,T ;SAME?
JRST SAM1 ;YES
JUMPE E,CPOPJ ;PRG NAME?
PBCON: SUB V,[2,,2] ;GO TO NEXT
JUMPGE V,PBFND ;LOOP IF MORE TO GO
POPJ P, ;NOT FOUND
SAM1: LDB E,[POINT 32,(V),35];GET SYMBOL
CAME E,SYM ;SAME?
JRST PBCON ;NO, PROCEED
OKPOPJ: AOS (P) ;FOUND WHAT WERE LOOKING FOR
POPJ P,
^PRGSET:
IFE UESW,<
HLRO V,JOBSYM
MOVN V,V
ADD V,JOBSYM ;PROG CHAIN STARTS AT SYMTAB END
ONCE1: MOVE E,-2(V)
CAME E,[RADIX50 0,RAID] ;THESE ARE USUALLY BAD CHOICES
CAMN E,[RADIX50 0,JOBDAT]
JRST ONCE2
HLRZ B,-1(V)
JUMPE B,ONCE4
CAIL B,-6
JRST ONCE4 ;NOT MANY SYMS - TRY DIFFFERENT PROG
ONCE3: MOVEM E,SYM
JRST PRGFND ;FIND AND DISPLAY THIS ONE
ONCE4: JUMPN C,ONCE2
MOVE C,E ;REMEMBER IT THE FIRST TIME
ONCE2: HLRE E,-1(V)
ADD V,E
JUMPL E,ONCE1 ;KEEP LOOKING
SKIPN E,C
IFN REALSW,< MOVE E,[RADIX50 0,RAID] ;NO MORE - HAVE TO SETTLE FOR RAID>
IFE REALSW,< MOVE E,[RADIX50 0,TRAID]>
JRST ONCE3
;> POPJ P,
^BLKFN: PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
PUSHJ P,BLKFND
; INSERT PROG/BLOCK PAIR IN BUFFER FOR QUICK REFERENCE (CTRL-Z)
INSBLK: MOVEI T,NUMREF ;SEARCH FIRST, MAKE SURE IT'S NOT THERE ALREADY
MOVE E,SYMPNT ;CURRENT BLOCK POINTER
CAME E,BLKREF(T) ;IS IT?
SOJGE T,.-1 ; NOT YET
JUMPGE T,SETGET ;WAS THERE, GO REFRESH
SOSGE T,REFPNT ;GET NEXT FREE POINTER
MOVEI T,NUMREF-1 ;WRAPAROUND
MOVEM T,REFPNT
HRROI E,SYMPNT ;SAVE PROG POINTER, BLOCK POINTER
POP E,BLKREF(T)
POP E,PRGREF(T)
SETGET: MOVEM T,REFGET ;TAKER POINTER
POPJ P, ;GO REFRESH, RETURN
^BLKFND:TLNN F1,SINGF ;SINGLE SYMBOL?
JRST CERR ;NO
MOVEI T,3 ;HUNT FOR BLOCK NAME
MOVE V,SYMPRG ;GET POINTER
PUSHJ P,PBCON ;FIND
JRST PU
MOVEM V,SYMPNT ;SAVE POINTER
MOVE T,(V)
MOVEM T,BLKSAV#
POPJ P,
>;NOT SORTED (BEGAN ON PAGE 43 NEAR THE BEGINNING OF THE BLOCK FNDSYM)
IFN SORTED,< ;(ENDS ON PAGE 55) SETSYM
; Setsym -- Initialize (reset) Symbol Table Variables (SORTED BEGINS HERE)
BEGIN SETSYM
^SETSYM:SETOM DDSW ;FORCE COMPLETE DEVICE RE-EVALUATION
IFN STANFO,<
MOVE A,JOBSYM
HLRE A,(A)
AOJE A,SETSY1 ;IF LH OF FIRST WORD OF SYMTAB IS -1
>;STANFO
IFE STANFO,<
MOVS A,JOBSYM
CAIE A,-1
>;NOT STANFO
PUSHJ P,SORT ;WE HAVE DONE THE SORT ALREADY
SETSY1: MOVE E,JOBSYM ;-SIZE,,LOC
MOVEM E,SAVJSM ;IF DIFFERENT NEXT TIME, CALL AGAIN
HRRZM E,SYMBAS ;FOR RELOCATING OTHER POINTERS
HRRE A,(E)
AOJN A,.+2
HLLZS (E) ;SET RH OF FIRST WORD TO ZERO IF WAS -1
HRRZ V,5(E) ;RELATIVE ADDRESS OF FIRST BLOCK OF SYMBOLS
HRRZ A,11(E) ;RELATIVE ADDRESS OF WORD AFTER LAST SYMBOL
SUBM V,A ;A GETS -NUMBER OF WORDS OF SYMBOLS
ADD V,E ;ABSOLUTE ADDRESS OF FIRST WORD OF SYMBOLS
HRL V,A
MOVEM V,SYMRNG ;-SIZE,,FIRST FOR ACTUAL SYMBOLS
MOVEI V,5(E)
HRLI V,A ;ABSOLUTE ADDRESS OF RELATIVE POINTERS
MOVEM V,RNGBAS ; TO THE SYMBOLS
ADDI V,1
MOVEM V,RNGBS1 ; RANGE TABLE+1(A)
HRRZ V,2(E) ;BLKVAL
ADD V,E ; TABLE
HRLI V,E ; BLKVAL(E)
MOVEM V,BLKVAL
HRLI V,M
MOVEM V,BLKVL1 ; BLKVAL(M)
HRRZ V,1(E) ; REPEAT FOR NAMES
ADD V,E
HRLI V,D2
MOVEM V,BLKNM2
HRLI V,E
MOVEM V,BLKNAM
SUB V,BLKVAL
MOVMM V,BLKSIZ ; SIZE OF BLOCK STRUCTURE TABLES
^FREPOPJ:TRO F,DPYALL
NOPROG: POPJ P,
BEND SETSYM
^SETSYM_SETSYM
^FREPOPJ_FREPOPJ
; Fndsym -- The VALSYM Symbol Table Searcher.
;
; VALUE IN V
; RETURNS IN
; DNSYM, DNDIF, DNCUR THE SYMBOL NAME, VALUE, AND BLOCK NAME
; (-1 IF SHOULD NOT BE TYPED) OF THE SYMBOL WHOSE VALUE IS
; EQUAL TO OR LEAST LESS THAN THE VALUE IN V.
; UPSYM, UPDIF, UPCUR THE CORRESPODING THINGS FOR THE SYMBOL
; WHOSE VALUE IS LEAST GREATER THAN THE VALUE IN V.
BEGIN FNDSYM
;initialize the search
^^FNDSYM:SKIPGE PID ;Don't bother if there are no symbols
POPJ P,
PUSHJ P,GETRNG ;Assign range to A. Swap V if class 3
JRST @[ FSYM ;Class 1 -- search low-seg addrs only
FSYM ; 2 -- high-seg addrs only
QOPCOD ; 3 -- better of "op code", "full srch"
BIGNUM](A) ; 4 -- better of "full", "op" srch
QOPCOD: PUSHJ P,FSYM ;Classes 3 and 4 cover the same range,
MOVMS UPDIF
TRNN F,CNVABS ; really, tho class 3 only has those
SKIPN UPDIF ; symbols whose values have 18 low-order 0's
POPJ P, ;Don't bother 2d try if Abs mode, just
PUSHJ P,[SVVAL: MOVE E,[DNSYM,,ODNSYM]
BLT E,ODNDIF ; called FSYM to set up UPDIF, DNDIF, etc.
POPJ P,] ;This symbol has 18 low-order zeroes, so
HLRZS V ;undo what getrng did ; first try class 3, then if no exact
MOVEI A,3 ; match, try class 4. Choose the best
PUSHJ P,FSYM ; difference, using some reasonable
MOVMS UPDIF
MOVEI E,1000
CAMLE E,ODNDIF ;SKIP IF DIFFERENCE IS RIDICULOUSLY BIG
MOVSS ODNDIF
CAMLE E,OUPDIF
MOVSS OUPDIF
JRST DCIDE ; algorithm.
BIGNUM: PUSHJ P,FSYM ;Here the value has some low order 1's
MOVMS UPDIF
SKIPN UPDIF ; in the low 18 bits. So first
POPJ P, ; try the class 4 symbols, then if there's
PUSHJ P,SVVAL ; no exact match, zap the low 18,
PUSH P,V ; search class 3 for that, then create the
HLRZ V,V ; actual differences by re-including the
MOVEI A,2 ; low-order 1's. Finally, again, decide
PUSHJ P,FSYM ; which set of results gives the best
MOVMS UPDIF
POP P,V ; answer.
HRRZ V,V
MOVEI E,1000
CAMLE E,DNDIF ;SKIP IF DIFFERENCE IS RIDICULOUSLY BIG
JRST [ MOVSS DNDIF
HRRM V,DNDIF
JRST .+1]
CAMLE E,UPDIF
JRST [ SKIPN UPDIF
JRST BIGNU1
MOVSS UPDIF
SUB V,UPDIF
MOVNM V,UPDIF
JRST .+1]
DCIDE: MOVE E,ODNDIF ;Here, just choose the set of results
CAME E,DNDIF ; which seem to give the best results.
JRST DCIDE1 ;ONE OF THEM IS BETTER
MOVE E,OUPDIF
CAML E,UPDIF
POPJ P, ;NEW IS AS GOOD OR BETTER
FRST: MOVE E,[ODNSYM,,DNSYM] ;OLD ONE IS BETTER
BLT E,DNDIF
POPJ P,
DCIDE1: MOVE V,OUPDIF
CAME V,UPDIF
JRST DCIDE2 ;ONE OF THESE IS BETTER TOO
MOVE V,ODNDIF
CAML V,DNDIF
POPJ P, ;NEW ONE IS AS GOOD OR BETTER
JRST FRST ;OLD ONE IS BETTER
DCIDE2: CAML E,DNDIF
CAMG V,UPDIF
JRST .+2
POPJ P, ;NEW ONE IS BETTER ON BOTH COUNTS
CAMG E,DNDIF
CAML V,UPDIF
JRST .+2
JRST FRST
MOVEI A,0
CAML E,DNDIF
AOJA A,[MOVE E,DNDIF
JRST .+1]
CAML E,@[UPDIFOUPDIF](A)
JRST DCIDE3
JUMPE A,FRST
POPJ P,
DCIDE3: JUMPN A,FRST
POPJ P,
BIGNU1: HRLOI E,377777
MOVEM E,UPDIF
JRST DCIDE
;FSYM
FSYM: MOVEM A,RANGE ; only concerned with 3's and 3's
HRLOI E,377777 ;The differences start out very large,
MOVEM E,DNDIF ; to be diminished if symbols
MOVE E,[400000,,1]
MOVEM E,UPDIF ; bracketing the value are found
SETZM UPSYM
SETZM DNSYM
SETOM UPCUR
SETOM DNCUR
SETZM UPSYMP
SETZM DNSYMP
TRNE F,CNVABS ;Forget it if abs mode (wants numerical
POPJ P, ; value), just wanted to set up result vals.
PUSH P,PNT
HRRZ PNT,SYMBAS
MOVE B,@RNGBAS ; because the compare is more @ with 3's.
ADD B,PNT ;Blowest symbol entry in range
MOVE C,@RNGBS1
ADDI C,-2(PNT) ;Chighest symbol entry in range
MOVE A,SUBRNG(A) ;A is 0 if RANGE 3, 1 if 3.
;check boundary conditions
CAMLE B,C ;If the range doesn't exist, just
JRST PNPOPJ ; use the number (may change).
MOVE PV,B ;If the symbol falls outside the
MOVE E,V ; actual range within this range
XCT SUB1(A) ; for this program, just accept
JUMPLE E,BINGO ; the closest in the range
TRYHI: MOVE PV,C ;Again, this time on high side
MOVE E,V
XCT SUB1(A)
JUMPGE E,BINGO
;search out best match
GOLOOK: MOVE E,C
SUBI E,-2(B) ;NUMBER OF WORDS LEFT TO SEARCH OVER
LSH E,-1 ;NUMBER OF SYMBOLS LEFT TO LOOK AT
TRZ E,1 ;LIKE (E/2)*2 # WORDS TILL MIDDLE SYM
MOVE PV,B ;BEGINNING ADDRESS OF RANGE
JRST ADDCOM
LESS: SUBI PV,(E)
CAIGE PV,(B)
MOVEI PV,(B)
BINSRC: LSH E,-1
TRZ E,1 ;COMPUTE HALF AGAIN
TRNN E,777776
MOVEI E,2 ;MINIMUM OF 2
XCT CAMGE1(A) ;CA I OR M GE V,@1(PV)
JRST LESS
XCT CAMG3(A) ;CA I OR M G V,@3(PV)
JRST BINGO
ADDCOM: ADD PV,E ;ADDRESS MIDWAY FROM BEGINNING TO END
CAILE PV,(C)
MOVEI PV,(C) ;MAKE SURE IT'S IN THE RANGE
JRST BINSRC
;BINGO, WCHBLK, GETRNG
;found it, find nearest symbols in same program
BINGO: PUSH P,T
PUSH P,PV
MOVE T,PV
SETZM EX
MOVNI M,1
L3: CAMGE PV,B ;If just prev matches, back
JRST L1 ; up to exact match
XCT CAMLE1(A) ; of exact matches for beginning
JRST L1
SUBI PV,2
JRST L3
L1: ADDI PV,2 ; symbol in same program,
CAMLE PV,C ; give up if none
JRST NV
XCT MOVE3(A) ;Quit, reject if diff gets out
SUB M,V ; of WCNT range
MOVE E,RANGE
XCT CAMW1(E) ;There may have been an
JRST [ NV: MOVNI M,1
PUSHJ P,VALDAT ; exact match, and if there
JRST NOUPR ; was, use it
JRST ACCEPUP]
PUSHJ P,VALIDATE ;Accept if possible
JRST L1 ;Not possible
PUSHJ P,VALDAT ;Ok, but check for exact match
JFCL ;Exact match same block
ACCEPUP:MOVEM M,UPDIF ;Store the Difference, Symbol
MOVEM T,UPSYM ; value, block value results
MOVEM E,UPCUR
MOVEM PV,UPSYMP
NOUPR: POP P,PV
JUMPE M,ACCEPDN
JRST .+2
L2: SUBI PV,2 ;Same sort of thing for lower.
CAMGE PV,B
JRST NOLWR
XCT MOVE3(A)
SUBM V,M
JUMPL M,L2 ;make sure that the thing we use is lower
MOVE E,RANGE
XCT CAMW(E)
JRST NOLWR
PUSHJ P,VALIDATE
JRST L2
JFCL ;There won't be an exact match
ACCEPDN:MOVEM M,DNDIF
MOVEM T,DNSYM
MOVEM E,DNCUR
MOVEM PV,DNSYMP
NOLWR: POP P,T
PNPOPJ: POP P,PNT
POPJ P,
VALIDATE:
PUSH P,M ;PV a symbol which is within
MOVE T,(PV) ; printing range of V. Accept it
TLNE T,400000 ; (skip-return with block name, etc.
JRST MPOPJ ; if it is not half-killed, and if
MOVEI E,0 ; it is INTERNAL or in the same
TLNN T,100000 ; program. A 0 return for block-name
JRST ACCEP ; means no block name should be
LDB E,[POINT 13,1(PV),12] ; printed, since symbol is in
HLRZ M,@BLKVAL ; current nest.
CAME E,PID
CAMN M,PID
JRST .+2
JRST MPOPJ
PUSHJ P,WCHBLK
ACCEP: POP P,M
JUMPN M,APOPJ ;If an exact match, and no block name
JUMPE E,APOPJ1 ; to print, use it; else if exact,
MOVEM E,EXB ; save values for later, will use
MOVEM PV,EX ; if no better (exact) found
POPJ P, ; Fail for now
; Now T has the symbol, E the block name or 0, M the difference
APOPJ1: AOS (P)
APOPJ: AOS (P)
POPJ P,
MPOPJ: POP P,M
POPJ P,
;RETURN RANGE IN A FOR VALUE IN V. SWAP THE VALUE TO THE RIGHT HALF FOR
;CLASS 3 VALUES.
^GETRNG:MOVEI A,0 ;Symbols fall into four ranges:
TDNN V,[-1,,400000] ; 0 -- 0 x<400000 >
JRST GOTRNG ; 1 -- 400000 x<1000000 >
TLNN V,-1 ; 2 -- (0 or 1), rh 18 bits=0
AOJA A,GOTRNG ; 3 -- (0 or 1 or 2)
TRNE V,-1 ;For range 2 symbols, the value is
AOJA A,MORRNG ; swapped in the table, so we also
HLRZS V ; swap our input value here.
MORRNG: ADDI A,2 ;CLASSES 1-4 ARE RANGES 0-3
GOTRNG: POPJ P,
VALDAT: SKIPN EX
POPJ P,
MOVE PV,EX
MOVE E,EXB
MOVEI M,0
MOVE T,(PV)
SETZM EX
JRST APOPJ
;WCHBLK: CALL WITH E AS AN INDEX INTO BLOCK STRUCTURE SPACE FOR A SYMBOL
; RETURNS E 0 IF SYMBOL IS IN CURRENT NEST, BLOCK NAME OTHERWISE
^WCHBLK:MOVE M,BID
WCH: CAMN M,E
JRST THISONE
JUMPE M,NOONE ;IF GOT TO TOP THEN IT'S NOT IN THIS NEST
HRRZ M,@BLKVL1 ;GET NEXT CONTAINING BLOCK STARTING FROM BID
JRST WCH
NOONE: SKIPA E,@BLKNAM ;FETCH BLOCKNAME OF BLOCK THAT THE SYMBOL IS IN
THISONE:MOVEI E,0
POPJ P,
;TABLES FOR LOG SEARCH OF SYMBOL TABLE SUBRNG
EX: 0
EXB: 0
^SUBRNG:0
0
0
1
SUB1: SUBI E,@1(PV)
SUB E,@1(PV)
SUB2: SUBI M,@1(B)
SUB M,@1(B)
MOVE1: MOVEI M,@1(B)
MOVE M,@1(B)
MOVE2: MOVEI M,@1(C)
MOVE M,@1(C)
MOVE3: MOVEI M,@1(PV)
MOVE M,@1(PV)
CAMG3: CAIG V,@3(PV)
CAMG V,@3(PV)
^^CAMG1:CAIG V,@1(PV)
CAMG V,@1(PV)
CAML1: CAIL V,@1(PV)
CAML V,@1(PV)
CAME1: CAIE V,@1(PV)
CAME V,@1(PV)
^CAMGE1:CAIGE V,@1(PV)
CAMGE V,@1(PV)
^CAMLE1:CAILE V,@1(PV)
CAMLE V,@1(PV)
CAMW: CAMLE M,WCNT
CAMLE M,WCNT
CAIL M,1000
CAML M,[1000,,0]
CAMW1: CAMLE M,WCNT+1
CAMLE M,WCNT+1
CAIL M,1000
CAML M,[1000,,0]
BEND FNDSYM
^GETRNG_GETRNG
^SUBRNG_SUBRNG
^WCHBLK_WCHBLK
^CAMLE1_CAMLE1
^CAMGE1_CAMGE1
WRPSW: 0
^WRPSW_WRPSW
DNSYM: 0 ;THESE MUST STAY IN ORDER
DNCUR: 0
^DNSYMP:0
UPSYM: 0
UPCUR: 0
^UPSYMP:0
UPDIF: 0
DNDIF:0
ODNSYM: 0
ODNCUR: 0
ODNSYP: 0
OUPSYM: 0
OUPCUR: 0
OUPSYP: 0
OUPDIF: 0
ODNDIF:0 ;ALL THE WAY TO HERE
CURBL:0
^RANGE:0
VSAV:0
BEND SUBS
; Symlok -- SymbolValue Searcher -- Csflush
; HERE IS THE SYMVALUE SYMBOL TABLE SEARCHER
; RADIX50 FOR SYMBOL IN `SYM', SKIPS AND CONTAINS SYMBOL ENTRY IN SPNT
; AND V IF FINDS IT, ELSE NO SKIP
^SYMLOK:PUSH P,PV
MOVEI PV,NUMCSH-1 ;FIRST, SEARCH THE CACHE OF RECENTLY SEEN
MOVE E,SYM ; SYMBOLS, AND IF THE SYM IS FOUND,
CAME E,SYMCSH(PV) ; RETURN IMMEDIATELY -- GUARANTEED OK
SOJGE PV,.-1 ; BECAUSE CACHE IS FLUSHED WHENEVER IT
JUMPL PV,SYMLK1 ; MIGHT BE INVALID
MOVE PV,SYMVAL(PV)
JRST GOTHIM
SYMLK1: SETZM UNIQP
SETZM UNIQ
SETZM GLOBB
SETZM BESTB
MOVE PV,SYMRNG
SYMLP: LDB E,[POINT 32,(PV),35];GET SYMBOL WITHOUT TYPE BITS IN E
CAME E,SYM ;SKIP IF IT MATCHES
JRST SYML ;NO MATCH, LOOK AT MORE SYMBOLS
MOVE E,(PV)
TLNN E,100000 ;SKIP IF NOT GLOBAL
JRST [ HRROM PV,GLOBB
JRST SYML]
LDB E,[POINT 13,1(PV),12];GET BLOCK STRUCTURE POINTER FOR THIS SYMBOL
CAMN E,PID
JRST MAYBE ;SYMBOL IS IN THE RIGHT PROGRAM
MOVE M,@BLKNAM ;GET BLOCK NAME OF BLOCK SYMBOL IS IN
HLRZ V,@BLKVAL ;GET POINTER TO PROGRAM CONTAINING BLOCK SYM IS IN
TLNE M,140000 ;THE ID IS A PROG-ID IF THESE BITS ARE OFF.
CAME V,PID
JRST [ SKIPE UNIQP ;NOT IN RIGHT PROGRAM, SKIP IF DON'T HAVE SUCH YET
JRST SYMLK2 ;WE DO, NOT UNIQUE OUTSIDE OF CURRENT PROGRAM
HRRZM PV,UNIQP
JRST SYML]
MAYBE: PUSHJ P,WCHBLK ;RETURN 0 IN E IF BLOCK IS IN CURRENT BLOCK NEST
JUMPE E,SYMLK3 ;JUMP IF THIS SYMBOL IS IN THE BLOCK NEST
SKIPE UNIQ ;SKIP IF NO OTHER IN THIS PROG BUT NOT IN BLOCK NEST
JRST SYMLK4 ;NOT UNIQUE
HRRZM PV,UNIQ ;ONLY ONE SO FAR IN PROG BUT NOT IN BLOCK NEST
JRST SYML
SYMLK3: LDB E,[POINT 13,1(PV),12];GET BLOCK STRUCTURE POINTER FOR THIS SYMBOL
SKIPN M,BESTB ;SKIP IF THERE IS A SYM IN THE BLOCK NEST ALREADY
JRST SYMLK6
CAIL E,(M) ;SKIP IF NEW ONE IS BETTER THAN PREVIOUS ONE
JRST SYML
SYMLK6: HRLI E,(PV)
MOVSM E,BESTB
JRST SYML
SYMLK2: HRROS UNIQP
JRST SYML
SYMLK4: HRROS UNIQ
SYML: ADD PV,[2,,2]
SYML1: JUMPL PV,SYMLP
SKIPN PV,BESTB ;SKIP IF THERE WAS ONE IN THE CURRENT BLOCK NEST
SKIPE PV,GLOBB ;SKIP IF THERE WAS NONE AND NO GLOBAL EITHER
JRST GOTSYM ;USE IT
SKIPN PV,UNIQ ;SKIP IF THERE IS ONE IN THIS PROG NOT IN BLOCK NEST
SKIPE PV,UNIQP ;SKIP IF NON IN THIS PROG OR ANY PROG
JRST SYMLK5 ;FOUND IN SOME PROG NOT IN CURRENT BLOCK NEST
PNONE: POP P,PV
NONE:
IFN EXDSW,<PUSHJ P,IOFNDI> ;FIND AS I/O DEV. NAME
TLOA F,SYMF!SCFL!UNDF ;NOT FOUND
TLO F,NUMF!SYMF!SCFL ;FOUND
^CPOPJ: POPJ P,
SYMLK5: JUMPGE PV,GOTSYM
TLO F,PMULFL ;MULTIPLY DEFINED, MARK AS SUCH.
MOVEI E,.MUL
HRLM E,NBIGWD
GOTSYM: SOSGE E,SCSHPT ;STORE THE NEW-FOUND SYMBOL NAME AND POINTER
MOVEI E,NUMCSH-1 ; IN THE CACHE (CIRCULAR)
MOVEM E,SCSHPT
MOVE M,SYM
MOVEM M,SYMCSH(E)
HRRZM PV,SYMVAL(E)
GOTHIM: HRRZS PV ;ADDR IN SYM TABLE OF SYMBOL (MAYBE FOUND IN CACHE)
PUSH P,PNT ;PNT IS IN THE INDEX FIELD OF CLASS 4 VALUES
HRRZ PNT,SYMBAS ;ADDRESS OF BEGINNING OF SYMBOL TABLE
MOVE V,PV ;ADDRESS OF SYMBOL
SUB V,PNT ;RELATIVE ADDRESS OF SYMBOL
MOVEI E,@1(PV) ;GET VALUE (OR ADDRESS OF VALUE FOR CLASS 4)
MOVE M,RNGBAS ;GET ADDRESS OF RELATIVE POINTERS TO SYM CLASSES
CAML V,2(M) ;SKIP IF CLASS1 OR CLASS2 (RH VALUES)
MOVSS E ;CLASS 3 VALUES ARE LEFT HALF ONLY VALUES
CAML V,3(M) ;SKIP IF CLASS 1, 2 OR 3 (NOT 36 BIT VALUES)
MOVE E,@1(PV) ;GET 36 BIT VALUE
POP P,PNT
MOVE V,PV ;ADDRESS OF SYMBOL
POP P,PV
SYMDOT: MOVEM E,NM ;SAVE VALUE FOR LATER USE.
MOVEM V,SYMP ;SAVE POINTER TOO.
TLO F,NUMF!SYMF!SCFL ;SET FLAGS
ITCHK: CAIN C,"." ;IS AHEAD CHAR <CTRL1>`.'?
CAIE B,1
POPJ P, ; NO
TLZ F,SCFL ;NOT AHEAD ANY MORE
SETZM SAVMOD ;DON'T USE ANY INPUT-DRIVEN MODE
JSR FNDSCR ;ON SCREEN?
JRST [ HLRZ M,(M)
TLZ M,400037 ;CLEAR NON-MODE BITS
LSH M,-5 ;IN SAVMOD FORMAT
TLNN F1,FIRF ;FIRST THING?
HRRM M,SAVMOD ;YES, USE THIS MODE
JRST .+1]
JRST ITD1 ;USE CONTENTS OF THAT CELL
POPJ P,
; FLUSH ALL CACHES, SOMETHING DRASTIC HAS CHANGED
^CSFLUSH:
SETOM SYMCSH ;SET TO RIDICULOUS VALUE
MOVE E,[SYMCSH,,SYMCSH+1]
BLT E,CSHEND ;CLEAR ALL TO -1
POPJ P,
;Prgfnd, Prgset, Blkfnd, Blkfn
^PRGFND:PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
TLNN F1,SINGF ;SINGLE SYMBOL?
JRST CERR ;NO
MOVEI E,0
MOVE M,SYM
CPRG: CAMN M,@BLKNAM
JRST HERE
HLRZ E,@BLKVAL
JUMPN E,CPRG
JRST PU
HERE: MOVEM E,PID
MOVEM E,BID
PUSHJ P,BLFND ;SEARCH FOR BLOCK WHOSE NAME IS IN SYM
JFCL
MOVE E,BID
JRST INSBLK
^PRGSET:
IFE UESW,<
MOVEI E,0
JRST CPRG2
CPRG1: HLRZ E,@BLKVAL
JUMPE E,CPRG3
CPRG2: MOVE M,@BLKNAM
CAME M,[RADIX50 0,RAID]
CAMN M,[RADIX50 0,JOBDDT]
JRST CPRG1 ;DON'T USE EITHER OF THESE PROGS
CPRG3: MOVE M,@BLKNAM ;GET PROG NAME AND STORE IN SYM FOR
MOVEM M,SYM ;BLFND TO FIND
JRST HERE
>;NOT UESW
IFN UESW,<POPJ P,>
^BLKFN: PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
PUSHJ P,BLKFND
; INSERT PROG/BLOCK PAIR IN BUFFER FOR QUICK REFERENCE (CTRL-Z)
INSBLK: SKIPGE T,REFPNT ;FIRST, IF THERE IS A LIST YET,
JRST INSIT ; LOOK IN IT FOR A MATCH
CAIE T,NUMREF-1 ;FULL?
JRST CAMIT
MOVE M,[BLKREF+3,,BLKREF] ;REMOVE THE OLDEST 3
BLT M,BLKREF+NUMREF-4
SUBI T,3
MOVEM T,REFPNT
CAMIT: CAME E,BLKREF(T) ;WHEREVER IT IS, AND REPLACE
SOJGE T,.-1 ; IT AT THE TOP OF THE "STACK"
JUMPL T,INSIT
; E is block ID to be inserted in list.
; T block ID index to be removed.
^ZAPIT: CAMN T,REFPNT
JRST INSIT1
MOVE M,BLKREF+1(T)
MOVEM M,BLKREF(T)
AOJA T,ZAPIT
INSIT: AOS T,REFPNT
INSIT1: HRRZM E,BLKREF(T)
POPJ P,
^BLKFND:TLNN F1,SINGF ;SINGLE SYMBOL?
JRST BLKTHS ;NO
PUSHJ P,BLFND ;FIND
JRST PU
POPJ P,
BLKTHS: HRRZ V,LOCOP
PUSHJ P,FNDSYM
PUSHJ P,ADSEL
JRST CERR ;NO SYMBOL BEING SHOWN FOR . ANYWAY
SKIPA E,DNSYMP ;DNSYM IS THE WINNER
MOVE E,UPSYMP ;UPSYM IS THE WINNER
JUMPE E,CERR
LDB E,[POINT 13,1(E),12];GET BLOCK STRUCTURE INDEX OF THIS SYMBOL
JRST SETBL
; Open the block containing the last symbol typed.
;BLKTHS:TLNN F1,VALF ;If there is a value, it's a bug
; SKIPN E,SYMP ;If no symbols yet, a bug
; JRST CERR
; LDB E,[POINT 13,1(E),12]
; JRST SETBL
;SEARCH THE BLOCK STRUCTURE TABLE FOR THE BLOCK WHOSE NAME IS IN SYM.
;IF IT IS FOUND IN THE CURRENT PROGRAM, THEN PUT ITS INDEX IN BID AND
;SKIP RETURN. IF NOT, THEN SEARCH THE ENTIRE TABLE, AND IF A UNIQUE
;BLOCK NAME IS FOUND, SET PID AND BID TO THE PROGRAM AND BLOCK INDICES
;RESPECTIVELY AND SKIP RETURN. IF IT IS NOT FOUND ANYWHERE, THEN TAKE
;THE DIRECT RETURN.
BLFND: MOVE E,PID ;FIRST SEARCH THE BLOCKS IN
MOVEI V,0 ;THE CURRENTLY OPEN PROGRAM (V=0 IS FLAG)
SETOM UNIQ
HLRZ M,@BLKVAL ;GET THE INDEX OF THE NEXT PROGRAM (OR ZERO)
JUMPN M,BLF1
BLF: MOVE M,BLKSIZ
BLF1: SUBM E,M
HRL E,M ;E IS -COUNT-1,,BID CANDIDATE-1
MOVE M,SYM ;M IS RADIX50 14,BLOCKNAME
TLOA M,140000
BFLUP: CAME M,@BLKNAM ;SEARCH THE ENTIRE RANGE UNTIL
BFL1: AOBJN E,BFLUP ; A MATCH IS FOUND OR THE RANGE IS EXHAUSTED
JUMPGE E,BLNOP1 ;IF THE RANGE IS EXHAUSTED, CHECK FOR MORE.
JUMPE V,GOTIT1 ;IF V IS STILL 0, FOUND IN OWN PROG, ACCEPT.
SKIPL UNIQ ;OTHERWISE, WE'RE SEARCHING THE REST, AND
JRST BLNOPE ; IT IS REQUIRED THAT THERE BE A UNIQUE
HRRZM E,UNIQ ; BLOCK OF THAT NAME SOMEWHERE, OR GIVE UP.
JRST BFL1
GOTIT1: HRRZM E,BID ;ACCEPT THE BLOCK, OPEN IT, REPORT SUCCESS.
AOS (P)
BLNOPE: POPJ P, ;COME HERE TO RETURN UNSUCCESSFUL.
BLNOP1: JUMPN V,CKNOPE ;WHEN THE RANGE IS EXHAUSTED, IF ONLY THE
MOVEI E,0 ; CURRENT PROGRAM HAS BEEN SEARCHED, DO ALL OF THEM
AOJA V,BLF
CKNOPE: SKIPGE E,UNIQ ;OTHERWISE, IF A UNIQUE BLOCK NAME WAS FOUND
JRST BLNOPE ; SOMEWHERE, USE IT, AND MAKE SURE THAT ITS
^SETBL: MOVE M,@BLKNAM ; PROGRAM IS ALSO OPEN.
TLNN M,140000 ;THE CANONICAL PROGRAM NOT BLOCK TEST
SKIPA M,E
HLRZ M,@BLKVAL
HRRZM M,PID ;RESET PROG ID.
JRST GOTIT1 ; AND ACCEPT
>;SORTED (BEGAN ON PAGE 49)
;Raid, Eret, Main, Inerr, Cerr, Pu, Unpur -- Main Loop, Dispatcher
BEGIN MAIN -- THIS HERE IS RAID
IFN REALSW,<
RPTCNT
BEGDDT
DDTEND
$C
$I
$1B
>;REALSW
IFE REALSW,<000000>
$IO
$M
IFN REALSW,<
$RBP
$SBP ;GIVE USER ACCESS TO THINGS
>;REALSW
IFE REALSW,<00>
IFN REALSW,<
INTERNAL DDT
DDT:
>;REALSW
^RAID: SETZM OACSW#
SKIPE ACSW
SETOM OACSW ;SAVE OLD STATE OF ACSW
MOVEM P,RAC+P
MOVE P,[-PDLEN,,PDL-1]
EXCH P,RAC+P
JSR RACGT ;GET RAID ACS
JSR ONCE ;FIRST TIME STUFF, IF NECESSARY
AND F,[LOCOPF,,0] ;CLEAR MOST BITS
IFE FILESW,<
IFE UESW,<
IFE TENEX,<
SKIPE OACSW ;DON'T DO THIS IF WE ALREADY WERE IN RAID
JRST IGNOPC
MOVE V,JOBOPC ;SIMULATE BREAKPOINT
MOVEI M,(V)
CAIGE M,ENDDT ;BUT AVOID USING PC FROM INSIDE RAID
CAIGE M,BEGDDT
MOVEM V,BRKJSR
>;NOT TENEX
IGNOPC: TRO F,ISOPC ;INDICATE SPECIAL NATURE OF BREAK
JRST DOBRK ;GO HAVE A BREAKPOINT
>>
^E1RET: TRO F,DRWALL ;REFRESH DISPLAY, SOMETHING GLITCHED.
^ERET: MOVE P,[-PDLEN,,PDL-1]
TLZ F,SCFL!EHDF
TRZ F,BYTSW!ISOPC
IFE FILESW,<
IFE UESW,<
SETZM MSTSW1
SETZM MSTSW2 >>
^MAIN: SETZM SAVMOD ;IF THERE WAS A SUPER-TEMPORARY MODE...
^MAIN1: SETZM STSAV ;CLEAR EXTENDED ASCII BP
SETACT [BRKTAB] ;SET RAID'S SPECIAL BREAK TABLE
MOVEI M,1 ;SHIFT STATUS BACK AND FORTH TO INDICATE DONE
SKIPE DDSW ; EXCEPT ON TTY,
XORM M,NBIGWD
PUSHJ P,REDISP
SETLIN RADLIN ;SET TO SPECIAL ACTIVATION MODE
IFE STANFO,<
SETZM INBP ;CLEAR STANFORD SIMULATION BUFFER
>;STANFO
PUSHJ P,EVAL ;GET SOMETHING
TLNE F,VALF ;VALUE?
JRST VALFIR ;YES
MOVEI F1,0
LOP3: MOVEI V,1
LSH V,(B) ;GET UNIQUE SET OF BITS FOR BUCKY BITS
MOVE T,TABLEN ;GET CURRENT LENGTH
LOP1: LDB M,[POINT 7,CTAB(T),13];GET CHR.
CAMN C,M ;IS THE CHARACTER THE SAME?
JRST FOUND ;YES
^CDCONT:
LOP2: SOJGE T,LOP1 ;NO, LOOP
JRST CERR ;NOT FOUND, ERROR
FOUND: HLRZ M,CTAB(T) ;GET BUCKY MASK
AND M,V ;AND WITH BUCKY BITS
JUMPE M,LOP2 ;NOT ALLOWED, TRY AGAIN
MOVE M,CTAB(T) ;GET DISPATCH
PUSHJ P,(M)
JRST MAIN
VALFIR: MOVEM V,VALUE ;SAVE VALUE
MOVE F1,F ;SAVE FLAGS
PUSHJ P,EVAL ;GET NEXT THING
TLNE F,VALF ;VALUE?
JRST CERR ;YES, ERROR
JRST LOP3
^ZPU: SETZM SYM ;NO NAME KNOWN
^PU:
IFN TENEX,<
MOVEI A,100 ;PRIMARY INPUT
CBIBF ;CLEAR
>;TENEX
IFE TENEX,<CLRBFI> ;DEC CLEAR
SETZM STRIN
MOVEI V,.UND
TLOA F,PUFL ;SET BADDDDD FLAG
^INERR:
^CERR: MOVEI V,.HUH
HRLM V,NBIGWD
JRST ERET
^UNPUR: UNPURE
JRST UNPUR1
POPJ P,
UNPUR1:
; MOVEI T,0
; SETUWP T,
SKIPA T,[.PURE]
POPJ P,
HRLM T,NBIGWD
JRST ERET
; Ctab -- Dispatch Table
; COMMENT COMMAND DISPATCH TABLE
DEFINE CT (CHR,MASK,ADDRS)
<"CHR"*20+MASK,,ADDRS>
DEFINE CTT (V,CHR)
<V14+"CHR"*20+16,,MODSET>
^TABLEN:0 ;CTABLEN+<NUMBER OF MACROS>
^CTAB:
CT(M,2,MACDEF) ;M -- DEFINE MACRO
CT(M,4,MACIMM) ;M -- IMMEDIATE MACRO
IFE FILESW,<
IFE UESW,<CT(Y,10,YXEQ)> ;Y -- EXECUTE DIRECT
>
CTT(BTP,Q) ;Q -- BYTE POINTER MODE
CT(L,16,LFTT) ;L -- E AS LEFT-HALF BITS MODE
CT(R,16,RFTT) ;R -- E AS RIGHT-HALF BITS MODE
CT(J,16,FLGMOD) ;J -- W AS BITS MODE
CT(V,16,BYTMOD) ;V -- BYTE MODE
CT(U,16,UMODST) ;U -- E AS CHARACTER MODE
IFE FILESW,<
IFE UESW,<CT(S,10,MSTEP)> ;S -- MULTIPLE-STEP
>
CT(I,2,INCR) ;I -- INCREASE # SCREEN ENTRIES
CT(I,4,SCLR) ;I -- ZERO ALL SCREEN ENTRIES
CT(I,10,SCLRSV) ;I -- ZERO ALL UNPROTECTED ENTRIES
IFE FILESW,<
IFE UESW,<CT(X,10,XEQ3)> ;X -- EXECUTE SIMULATING
>
IFN STANFO,<
IFE UESW,<CT(E,10,LEAVE)> ;E -- EXIT (LIKE EXITY)
CT( ,1,EQIV) ; -- VALUE OF EXPRESSION REQUEST
CT(,1,LB1) ; -- SET TEMP LOWER SEARCH BOUND
CT(,2,LB2) ; -- PERMANENT LOWER SEARCH BOUND
CT(,1,RB1) ; -- TEMP UPPER SEARCH BOUND
CT(,2,RB2) ; -- PERMANENT UPPER SEARCH BOUND
CT( ,1,SRCON) ; -- CONTINUE SEARCH
CT(,1,SRCON) ; -- CONTINUE SEARCH
>;STANFO
IFE STANFO,<
CT(,173*20+1,LB1 ; -- SET TEMP LOWER SEARCH BOUND
CT(,173*20+2,LB2) ; -- PERMANENT LOWER
CT(,175*20+1,RB1)
CT(,175*20+1,RB2) ;SIMILARLY, UPPER BOUND
CT($,1,SRCON) ; $, CONTINUE SEARCH
>;NOT STANFORD
CT(K,2,SYMKIL) ;K -- KILL SYMBOL
IFN SORTED,<
CT(:,10,REVIVE) ;: -- REVIVE KILLED SYMBOL
>;SORTED
CT(K,4,SYMNIL) ;K -- ANNIHILATE SYMBOL
CT(Z,4,REFCLR) ;Z -- ZERO ALL BLOCK RECORDS
CT(Z,2,REFBLK) ;Z -- OPEN SOME RECORDED BLOCK
IFE FILESW,<
IFE UESW,<CT(S,4,STEPP)> ;S -- SINGLE-STEP, STARTING HERE
>
CT(W,2,WDSRCH) ;W -- SEARCH FOR WORD
CT(E,2,ESRCH) ;E -- SEARCH FOR EFFECTIVE ADDRESS
CT(N,2,NWDSR) ;N -- SEARCH FOR WORD
CT(_,1,SYMDEF) ; _ -- DEFINE SYMBOL=VALUE
CT(:,1,SYMDF1) ; : -- DEFINE SYMBOL=.
CT(D,16,NMDST) ;D -- DECIMAL MODE
CT(A,16,AMODST) ;A -- ABSOLUTE MODE
IFE FILESW,<
IFE UESW,<CT(B,2,BRKPLN) ;B -- PLANT BREAKPOINT
CT(B,4,BRKREM) ;B -- REMOVE BREAKPOINT
CT(P,4,TBPROC) ;P -- PROCEED TO TEMP BREAKPOINT AT .
CT(P,2,PROCED) ;P -- PROCEED TO NEXT BREAKPOINT
>>
CT(:,2,PRGFND) ;: -- NEW PROGRAM NAME
CT(&,2,BLKFN) ;& -- NEW BLOCK NAME
CT(=,2,EQIV) ;= -- VALUE OF EXPRESSION REQUEST
CT(@,2,ATSIN2) ;@ -- TO @EFFECTIVE ADDRESS OF
CT(@,4,ATSIN4) ;@ -- . TO @EFFECTIVE ADDRESS OF
CT(@,10,ATSIN1) ;@ -- FREEZE , EFFECTIVE ADDRESS OF
CT(<[>,4,TAB) ;[ -- . TO @RH ADDRESS OF
CT(<[>,2,LEFSQ2) ;[ -- TO @RH ADDRESS OF
CT(<[>,10,LEFSQ1) ;[ -- FREEZE , @RH ADDRESS OF
CT(<]>,2,RITSQ2) ;] -- TO @LH ADDRESS OF
CT(<]>,4,RITSQ4) ;] -- . TO @LH ADDRESS OF
CT(<]>,10,RITSQ1) ;] -- FREEZE , @LH ADDRESS OF
IFN STANFO,<
CT(E,4,EDIT) ;E -- EDIT ., REPLACE IT
>;STANFORD
CT( ,1,TAB) ;TAB-- . TO @RH ADDRESS OF
CT(;,4,REMPER) ;; -- UNFREEZE . OR SPECIFIED ADDR
CT(;,2,OPENP) ;; -- FREEZE . OR SPECIFIED ADDR
CTT(HLF,H) ;H -- HALF-WORD MODE
CT(T,16,TMDST) ;T -- CHARACTER MODE (ASC, SIXB, RAD50)
CTT(CYM,C) ;C -- CYMBOLIC MODE
CTT(OCL,O) ;O -- OCTAL MODE
CTT(FLG,F) ;F -- FLOATING POINT MODE
IFE FILESW,<
IFE UESW,<CT(G,16,GOGOGO)> ;G -- RELEASE CONTROL AT @JOBSA OR SPECIFIED ADDR
IFE UESW,< CT(X,4,XEQ2) ;X -- START SINGLE-EXECUTION HERE
CT(_,2,LEFFND) ;_ -- . TO x
>>
CT(,15*20+17,DEPO) ;CR -- DEPOSIT VALUE
IFE FILESW,<
IFE UESW,<CT(X,2,XEQ1) ;X -- SINGLE-EXECUTE ONCE FROM .
CT(S,2,STEPPE) ;S -- SINGLE-STEP ONCE FROM .
>>
IFN FILESW,<
CT(S,2,SETIO) ;S -- IN FRAID SET $IO TO -1
CT(S,4,CLRIO) ;S -- IN FRAID SET $IO TO 0
>;FILESW
XWD "<"*20+5,UPAR ; < -- MOVE UP ONE, FROM .
XWD ">"*20+5,LNFD ; > -- MOVE DOWN ONE, FROM .
XWD "<"*20+12,MOVUP ;< -- MOVE UP ONE, ON SCREEN
XWD ">"*20+12,MOVDN ;> -- MOVE DOWN ONE, ON SCREEN
CT(,"\"*20+17,BSSET) ;\ -- EQUIV TO <
CT(,12*20+17,LFSET) ;LF -- EQUIV TO >
CT(;,1,OPENS) ; ; -- TO @RH , OR . TO SPECIFIED ADDR
^CTABCN__.-CTAB-1
^CTAB1: BLOCK 20 ;MACRO SPECS
^MACLOC:BLOCK 20
BEND MAIN
; Modset, Tmdst, Amodst, Nmdst, Umodst, Bytmod, Flgmod, Lftt, Rftt
BEGIN ROUTS -- THESE ARE THE ROUTINES DISPATCHED TO
^MODSET:LDB V,[POINT 6,M,5] ;GET MODE
MODSE1: LSH V,5 ;ADJUST
MDGO: HRLS V
SETZM SAVMOD ;DON'T USE TEMP MODE IF CHANGING MODE
LDB M,[POINT 12,V,30]
XCT MODTB-1(B) ;PUT IN CORRECT PLACE (B HAS BUCKY COUNT)
POPJ P, ;LEAVE
MODTB: DPB M,[POINT 12,(PNT),12];SET MODE FOR THIS ONE
HRRM V,CURMOD ;SET CURRENT MODE
MOVEM V,CURMOD ;SET PERMANENT MODE
^TMDST: TLNE F1,VALF ;VALUE TYPED?
SKIPA V,VALUE ;YES, GET IT
MOVEI V,7 ;NO (TXT=5)
CAIG V,7
CAIG V,4
JRST CERR
JRST MODSE1
^AMODST:MOVE M,CURMOD
HRLI M,405
TRO M,405
MOVEI V,1
XCT AMODTB-1(B) ;B HAS BUCKY COUNT
POPJ P,
AMODTB: DPB V,[POINT 1,(PNT),7]
HRRM M,CURMOD
IORM M,CURMOD
^NMDST: MOVEI V,DCM5 ;DECIMAL MODE
TLNE F1,VALF ;VALUE TYPED?
MOVEI V,OCL15 ;YES, OCATL
JRST MDGO
^UMODST:TLNE F1,VALF ;VALUE?
SKIPA V,VALUE ;YES,GET IT
MOVEI V,7 ;NO
CAIG V,7
CAIG V,4
JRST CERR
ADDI V,6 ;UTX=13
JRST MODSE1
^BYTMOD:TLNN F1,VALF
JRST CERR
MOVE V,VALUE
ANDI V,77
LSH V,13
ADDI V,BYT5
JRST MDGO
^FLGMOD:MOVEI M,BTS5 ;THE MODE BITS
COMFLG: TLNN F1,VALF ;VALUE TYPED?
TDZA V,V ;NO SET ZERO
MOVE V,VALUE ;ELSE USE TYPE VALUE
ANDI V,77
LSH V,13 ;PACK AWAY
ADD V,M ;AND PUT IN MODE BITS
JRST MDGO ;GO GO
^RFTT: MOVEI M,RBT5
JRST COMFLG
^LFTT: MOVEI M,LBT5
JRST COMFLG
;Depo1, Echk
DEPO1: TLNE F,LOCOPF ;LOCATION OPEN?
TLNN F1,VALF ;VALUE?
POPJ P, ;JUST QUIT
SKIPE E,SAVMOD ;SPECIAL MODE FOR THIS THING?
DPB E,[POINT 7,(PNT),12];YES, CHANGE MODE FOR THIS LINE
LSH E,-6 ;IF V, THIS IS BYTE SIZE
JUMPE E,.+2
DPB E,[POINT 6,(PNT),6] ;PUT THERE
SETZM SAVMOD ;FOR GRINS
HRRZ E,LOCOP
JSR ECHK
MOVE V,VALUE ;GET VALUE
IFE UESW,<
IFE FILESW,<
CAIG E,@JOBREL
IFN SEGSW,<
JRST .+3
SKIPGE JOBHRL
PUSHJ P,UNPUR
>
IFE SEGSW,<
JRST .+2
JRST CERR
>
MOVEM V,(E) ;DEPOSIT
>;NOT FILESW
IFN FILESW,<
PUSHJ P,RDTRKE ;READ IN TRACK THAT CONTAINS E
MOVEM V,@TRKOFF
PUSHJ P,WRTRK ;WRITE IT BACK OUT
>
>;END NOT UESW
IFN UESW,< MOVEM V,SSS1#
MOVEM E,SSS2#
SETZM SSS3#
MOVE V,[XWD 400001,SSSDO]
CALL V,[SIXBIT /SPCWGO/]
SKIPN SSS3
JRST .-1
TNOFFS
MOVE V,SSS1>
POPJ P,
IFN UESW,< SSSDO: SKIPE SSS3
0
HRLI 2,-1
DATAO 2
MOVN 3,2
ADD 3,SSS2
MOVE 4,SSS1
MOVEM 4,(3)
SETOM SSS3
0>
^ECHK: 0
IFE FILESW,<
IFE UESW,<
CAIG E,17 ;AC?
ADDI E,JAC ;YES
CAMLE E,JOBREL ;TOO BIG?
IFE SEGSW,<
JRST CERR ;YES
>
IFN SEGSW,<
JRST [ CAIL E,400000
CAILE E,@JOBHRL
JRST CERR
JRST @ECHK]
>
JRST @ECHK
>;END NOT UESW
>;END NOT FILESW
IFN FILESW,<
SKIPE DMPFSW
JRST ECHKD1 ;DUMP FILE
CAMLE E,FILLST
JRST CERR
JRST @ECHK
ECHKD1: CAIL E,74
CAMLE E,FJBHRL
JRST CERR
CAMLE E,FJBREL
CAML E,UPPRST
JRST @ECHK
JRST CERR
>;FILESW
IFE SORTED,<
; Refblk, Refclr, Refrst, Frepopj
; GET BACK A PREVIOUS PROG/BLOCK PAIR (nCTRL1-Z, n=1 DEFAULT)
^REFBLK: TLNE F1,VALF ;WAS A VALUE TYPED?
SKIPA D1,VALUE ;YES, USE IT
MOVEI D1,1 ;NO, USE LAST PROG/BLOCK USED
ADD D1,REFGET ;OFFSET FROM LAST ENTERED
MOVMS D1
IDIVI D1,NUMREF ;GET MOD
REFDSP: SKIPN E,PRGREF(D2) ;GET PROGRAM POINTER
JRST CERR ;NONE THERE
MOVEM D2,REFGET ;CURRENT GETTER
MOVEM E,SYMPRG ;UPDATE THIS
MOVE E,BLKREF(D2) ;GET BLOCK POINTER
MOVEM E,SYMPNT
^FREPOPJ:TRO F,DPYALL ;START FROM SCRATCH
POPJ P, ;REFRESH THE SCREEN, USE NEW BLOCK
;GET HERE WHEN SOMETHING GROSS BEFALLS THE SYMBOL TABLE
^SYMRST:MOVSI F1,SINGF
MOVE T,PRGSAV
MOVEM T,SYM
PUSHJ P,PRGFND
MOVE T,BLKSAV
TLZ T,740000
PUSHJ P,BLKFND
;CTRL2-Z -- clears block reference history, enters current block
^REFCLR:SETZM PRGREF
MOVE E,[PRGREF,,PRGREF+1]
BLT E,BLKREF+NUMREF-1
SETZM REFGET
SETZM REFPNT
JRST INSBLK ;GO INSERT CURRENT IN BUFFER
>;NOT SORTED
IFN SORTED,<
; Refblk, Refclr
;GET BACK A PREVIOUS PROG/BLOCK PAIR (nCTRL1-Z, n=1 default)
^REFBLK:SKIPGE REFPNT ;THERE MUST BE SOMETHING OPEN
JRST CERR
TLNN F1,VALF ;WAS A VALUE TYPED?
SKIPA T,[-1] ;NO
MOVN T,VALUE ;YES, USE IT
ADD T,REFPNT ;OFFSET FROM LAST ENTERED
JUMPGE T,.+2
MOVEI T,0 ;TOO LARGE YIELDS BOTTOM OF STACK
HRRZ E,BLKREF(T) ;USE THIS BLOCK ID
PUSHJ P,SETBL ;MAKE SURE ITS PROGRAM IS OPEN
JFCL ; (SKIP-RETURNS)
PUSHJ P,ZAPIT ;REMOVE AND RE-INSERT AT TOP
JRST FREPOPJ ;MARK COMPLETE REDISPLAY AND QUIT
;CTRL2-Z -- CLEARS BLOCK REFERENCE HISTORY, ENTERS CURRENT BLOCK
^REFCLR:SETZM BLKREF
MOVE E,[BLKREF,,BLKREF+1]
BLT E,BLKREF+NUMREF-1
SETOM REFPNT
MOVE E,BID
JRST INSBLK ;GO INSERT CURRENT IN BUFFER
>;SORTED
; Depo, Opens, Openu, Fndscr, Openp -- Open a Cell (see if it's there)
^DEPO: SKIPN E,STSAV ;WAS MULTI-WORD ASCII INDICATED?
JRST DPO11 ; NO
MOVEM E,STRIN ;YES, LET RAID READ THIS WEIRD STRING
JRST MAIN ;FROM THE TOP
DPO11: PUSHJ P,DEPO1
HLRS CURMOD ;RESET MODE
POPJ P,
^OPENS: TLNE F1,VALF ;VALUE TYPED?
JRST SOPENS ;YES
TRO F1,1 ;NO, SET FLAG
HRRZ E,(PNT) ;GET CURRENT ADDRS
JSR ECHK
IFE UESW,<
IFE FILESW,< MOVE E,(E) >
IFN FILESW,<
PUSHJ P,RDTRKE ;READ IN THE TRACK THAT CONTAINS E
MOVE E,@TRKOFF
>
>
IFN UESW,< MO (E,E)>
OPENU: MOVEM E,VALUE
SOPENS: MOVEI T,0 ;400000,, BIT ON FOR PERMANENT
OPENQ: HRRZ E,VALUE ;GET VALUE
JSR FNDSCR ;ON SCREEN? (ALSO SETS `M' TO POINT TO THE LINE)
JRST PNT2 ; YES
PNT4: TLO F,LOCOPF ;LOCATION OPEN
AOBJN PNT,PNT1 ;GO TO NEXT, AT END?
TLNE PNT,7 ;NOT REALLY AT END?
PNT9: MOVS PNT,SPNT ;AT END,GET START POINTER
PNT1: SKIPL (PNT) ;PERMANENT?
JRST GOTIT ;NO
JUMPGE PNT,PNT99 ;AT LAST ONE?
MOVE E,PNT ;GET POINTER
SKIPGE 1(E) ;NEXT ONE PERMANENT?
AOBJN E,.-1 ;YES, TRY AGAIN
JUMPGE E,[ PNT99: TRON F1,2
JRST PNT9
JRST CERR]
HRRZS E
LOP1: MOVE V,(E) ;FOUND ONE, SHUFFLE DOWN
MOVEM V,1(E)
TLNN V,20 ;DOES SOMEONE POINT HERE?
JRST NOPONT ;NO
MOVS D2,SPNT ;GET POINTER FOR SEARCH
LOP2: MOVE D3,(D2)
TLNN D3,17 ;IS THIS A POINT TYPE THING?
JRST NOLOP1 ;NO
CAIN E,(D3) ;DOES THIS POINT TO IT?
AOS (D2) ;YES, UPDATE
NOLOP1: AOBJN D2,LOP2 ;LOOP
TLNN D2,7
JRST LOP2
NOPONT: CAIE E,(PNT) ;BACK TO START?
SOJA E,LOP1 ;NO
GOTIT: MOVE E,VALUE ;GET LOCATION
HRL E,CURMOD ;GET CURRENT MODE
MOVEM E,(PNT) ;DEPOSIT
TRZN F1,1
HRRZM E,LOCOP
OPNTP: IORM T,(PNT) ;MARK AS PERMANENT
POPJ P,
PNT2: MOVE PNT,M
TLO F,LOCOPF
IORM T,(PNT)
HRRZ E,(PNT)
TRZN F1,1
MOVEM E,LOCOP
POPJ P,
^FNDSCR: 0
MOVS M,SPNT ;GET START POINTER
PNT3: SKIPN D2,(M) ;DONE?
JRST PNT44 ;YES
TLZ D2,777760
CAMN E,D2 ;SAME?
JRST @FNDSCR ;YES
AOBJN M,PNT3 ;LOOP, AT END?
TLNN M,7 ;REALLY AT END?
JRST PNT3 ;NO
PNT44: AOS FNDSCR ;SKIP ROUTINE, FIND
JRST @FNDSCR
^OPENP: MOVSI T,400000
TLNE F1,-1 ;A VALUE TYPED IN?
JRST OPENQ ;YES
MOVS E,SPNT
CAML PNT,E ;BLANK SCREEN?
JRST OPNTP ;NO
POPJ P, ;YES, DO NOTHING
^BSSET: SKIPA C,["<"]
^LFSET: MOVEI C,">"
SUB P,[1,,1]
JRST CDCONT
; Macdef, Macexp, Macimm -- Define and Expand Macros
^MACDEF:TLNN F1,VALF ;THERE MUST BE AN ADDRESS
JRST CERR ; THERE ISN'T
IFE TENEX,<
MOVE T,[INCHRW C] ;ONE CHAR
>
IFN TENEX,<
MOVE T,[^BIN1: PUSHJ P,[PBIN
MOVE C,1
POPJ P,] ]
>
EXCH T,TYII
PUSHJ P,GCHRS
MOVEM T,TYII ;HAVE A CHARACTER
LSH C,4 ;PREPARE DISPATCH TABLE ENTRY
TRO C,10 ;DOUBLE-BUCKY CHARACTER FOR MACRO
HRLI C,MACEXP ;ROUTINE WHICH EXPANDS MACROS
AOS T,TABLEN ;GET A NEW ENTRY
CAIG T,CTABCN+20 ;IS THERE ROOM?
JRST OKMAC ; YES, ENTER IT
IFE TENEX,<
OUTSTR [ASCIZ /TOO MANY MACROS /]
>
IFN TENEX,<
HRROI A,[ASCIZ /TOO MANY MACROS /]
PSOUT
>
SOS TABLEN
JRST CERR ;GO COMPLAIN
OKMAC: MOVSM C,CTAB(T) ;A NEW DISPATCH ENTRY
MOVE V,VALUE ;THE MACRO TEXT LOCATION
TLNN V,-1 ;UNLESS USER SUPPLIED BP BITS,
HRLI V,440700 ;CREATE A BYTE POINTER
MOVEM V,MACLOC-CTABCN(T) ;PARALLELS DISPATCH ENTRY
POPJ P, ;DONE
^MACIMM:TLNN F1,VALF ;THERE MUST BE AN ADDRESS
JRST CERR ; THERE ISN'T
MOVE V,VALUE ;GET IT
TLNN V,-1 ;MAKE BP IF NOT THERE
HRLI V,440700
SKIPA
^MACEXP:MOVE V,MACLOC-CTABCN(T) ;BYTE POINTER
MOVEM V,STRIN ;TTY SIMULATOR
JRST ERET ;ROUND WE GO
; Edit -- Edit Previous Value Using System Line Editor
IFN STANFO,<
^EDIT: MOVE E,DDSW
JRST @[ CERR
CERR
CERR
EDDIT
EDDIT
EDDIT](E)
EDDIT: HRRZ E,VALUE ;IF THERE IS ONE
TLNN F1,VALF ;A VALUE?
HRRZ E,LOCOP ;NO, USE .
JSR FNDSCR ;ON SCREEN?
JRST [ HLRZ M,(M) ;YES, USE SCREEN LINE'S MODE
JRST ED1]
HRRZ M,CURMOD ;NO, USE CURRENT MODE
ED1: JSR ECHK ;ADJUST IF AC
TRZ M,774037 ;CLEAR NON-MODE BITS
MOVE V,M
LSH V,-5 ;PUT IN SAVMOD FORMAT
MOVEM V,SAVMOD ;SAVE IT
; NOW PREPARE FOR CONVERSION
IFE FILESW,<
MOVE V,(E) ;SAVE VALUE
>
IFN FILESW,<
PUSHJ P,RDTRKE
MOVE V,@TRKOFF
>
MOVE E,[POINT 7,EXBUF] ;PUT STRING REP HERE
; MOVEM E,STRIN ;FOR RAID STRING INPUT
MOVEI T,0 ;ASSUME NOT TEXT
CAIN M,65 ;SIXBIT
MOVEI T,"'" ; YES
CAIN M,75 ;ASCII?
MOVEI T,42 ;YES, " CHAR
JUMPE T,NOTX1 ;NOT A TEXT RQST
IDPB T,E ;TEXT RQST
; FOR ASCII TEXT, MUST EDIT THE VALUE, FIND VALID DELIM, ELIMINATE
; ACTIVATION CHARS
MOVEI D2,""
PUSH P,D2 ;SAVE DELIMITER
CAIE M,75 ;ASCII?
JRST NOASCI ;NO
MOVE D3,V ;GET TEXT VAL
SETZB V,T ;CLEAR THESE
ASL: JUMPE D3,ASD ;DONE
MOVEI D2,0
LSHC D2,7 ;NEXT CHAR
CAIE D2,15 ;ELIMINATE ACTIVATION
CAIN D2,12 ;CHARS
JRST ASL
CAIN D2,ALTMOD
JRST ASL
CAIN D2,""
TRO T,4
CAIN D2,""
TRO T,2
CAIN D2,""
TRO T,1
LSH V,7
IOR V,D2 ;COLLECT NEW VALUE
JRST ASL
LSH V,7
ASD: JUMPE V,.+3
TLNN V,376000 ;SHIFT TO LEFT
JRST .-3 ;UNTIL TO LEFT
LSH V,1 ;ONE MORE
MOVEI D2,0 ;NOW GET DELIM
TRNN T,4
MOVEI D2,""
TRNN T,2
MOVEI D2,""
TRNN T,1
MOVEI D2,""
JUMPE D2,CERR ;NO AVAIL DELIM
MOVEM D2,(P) ;SET UP DELIM
NOASCI: IDPB D2,E ;PUT IN DELIMITER
NOTX1: PUSHJ P,CONV ;CONVERT TO EXTERNAL REP
HRRZ V,SAVMOD
CAIL V,6 ;IF TEXT,
CAILE V,7
JRST ABCDE
POP P,T
IDPB T,E ;FINISH OUT TEXT INPUT FORMAT
ABCDE: PUSHJ P,[FINLIN:
MOVEI C,15
IDPB C,E
MOVEI C,12
IDPB C,E
MOVEI C,0
IDPB C,E
POPJ P,]
; TIME TO PLAY EDITOR
SETLIN EDTLIN ;FCS ON, SPECIAL ACTIVATION OFF
; CLRBFI ;CLEAR INPUT ;LET HIM TYPE AHEAD
PTLOAD [0
EXBUF] ;SEND TO LINE EDITOR
SETLIN ASCLIN ;FCS SAME AS USER'S, SPECIAL ACTIVATION OFF
PUSHJ P,SVACS
REPEAT 0,<
INWAIT T ;#CHARS EDITED
SETLIN RADLIN ;NORMAL RAID CHARACTERISTICS
MOVE E,[POINT 7,EXBUF]
JRST EDL1 ;GO LOOP
EDL: INCHRW C ;GET CHAR
CAIN C,ALTMOD
JRST EDL2 ;ABORT
CAIE C,15 ;IGNORE CRLFS
CAIN C,12
JRST EDL1
IDPB C,E ;COLLECT STRING
EDL1: SOJGE T,EDL
PUSHJ P,FINLIN ;INSERT CRLF-NULL
SUB P,[1,,1] ;FLUSH CALL FROM MAIN
JRST MAIN1 ;WILL FEED DEPO
EDL2: CLRBFI
JRST ERET
>;END REPEAT 0
INWAIT ;WAIT FOR AN ACTIVATION
SETLIN RADLIN ;NORMAL RAID CHARACTERISTICS
MOVEI M,1 ;SHIFT STATUS BACK AND FORTH TO INDICATE DONE
SKIPE DDSW ; EXCEPT ON TTY,
XORM M,NBIGWD
POPJ P,
>;STANFORD
;Upar,Lnfd,Lefsq2,Tab,<,>,Routs,<tab>,MVTST,MOVDN,MOVUP,REMPER,SCLR
^UPAR: PUSHJ P,MVTST ;GET CURRENT LOCATION
HLLZ M,(PNT) ;GET MODE OF CURRENT ONE
MOVS T,PNT ;GET CURRENT POINTER
CAMGE T,SPNT
SOJA E,MOVL1 ;IF BEFORE BEGINNING, GO TO BEGINNING
CAME T,SPNT ;AT TOP?
JRST UPA1 ;NO
AOBJN PNT,. ;YES, GO TO END (THERE'S ONE MORE AFTER AOBJN END)
SKIPN -1(PNT) ;NULL?
SOJA E,[MOVS PNT,SPNT ;YES, MOVE DOWN INSTEAD
JRST MOVL1]
UPAR2: SKIPL (PNT) ;PERMANENT?
JRST UPA1A ;NO
SUB PNT,[1,,1] ;YES
JRST UPAR2
UPA1: SUB PNT,[1,,1]
UPA1A: SUB PNT,[1,,1]
SOJA E,MOVL1 ;GO TO PREVIOUS
^LNFD: PUSHJ P,MVTST ;GET CURRENT LOCATION
HLLZ M,(PNT) ;GET MODE OF CURRENT ONE
ADDI E,1 ;GO TO NEXT
MOVL1: TRNN B,2 ;LEFT BUCKY ON?
JRST OPENU ;NO
TLZ M,400037 ;CLEAR RANDOM BITS
PUSH P,M ;SAVE MODE OF THIS ONE
MOVEI F1,4
PUSHJ P,OPENU
MOVSI M,377777
ANDCAM M,(PNT) ;CLEAR MODE
POP P,M ;GET MODE OF OLD ONE
IORM M,(PNT)
POPJ P,
^MOVUP: PUSHJ P,MVTST
MOVS M,(PNT) ;GET MODE OF CURRENT ONE
TLO F,LOCOPF ;LOCATION OPEN
MOVS E,SPNT ;GET STARTING POINTER
CAMGE PNT,E
POPJ P, ;BLANK SCREEN, DO NOTHING
CAMN E,PNT ;AT THE TOP?
JRST MOVL2 ;YES
SUB PNT,[1,,1] ;NO, MOVE UP 1
JRST MOVL3 ;GO DISPLAY
MOVL2: AOBJN PNT,. ;GO TO END
MOVL2A: SKIPE (PNT) ;IS THIS LOCATION USED?
JRST MOVL3 ;YES
SUB PNT,[1,,1] ;NO, BACK UP
JRST MOVL2A
^MOVDN: PUSHJ P,MVTST
MOVS M,(PNT) ;GET MODE OF CURRENT LOCATION
TLO F,LOCOPF ;LOCATION OPEN
MOVS E,SPNT ;STARTING POINTER
CAMGE PNT,E
POPJ P, ;BLANK SCREEN, DO NOTHING
TLNE PNT,-1 ;ARE WE AT THE END?
SKIPN 1(PNT) ;NO, IS NEXT LOCATION USED?
JRST MOVD1 ;AT THE LAST LOCATION USED OR THE END, MOVE TO TOP
ADD PNT,[1,,1] ;MOVE DOWN 1
JRST MOVL3
MOVD1: MOVS PNT,SPNT
MOVL3: HRRZ T,(PNT)
MOVEM T,LOCOP
TRNN B,2 ;LEFT BUCKY BIT ON?
POPJ P, ;NO
LSH M,-5
DPB M,[POINT 12,(PNT),12];SET NEW MODE ON THIS ONE
POPJ P,
^LEFSQ2:TRO F1,1
^TAB: MOVEI D2,0
JRST RLCON
^RITSQ2:TRO F1,1
^RITSQ4:MOVEI D2,1
JRST RLCON
^ATSIN2:TRO F1,1
^ATSIN4:MOVEI D2,2
RLCON: PUSHJ P,MVTST
MOVE V,(PNT)
PUSHJ P,GETPOI
JRST CERR
IFE UESW,<
IFE FILESW,<
XCT (D2)[MOVE E,(E)
MOVS E,(E)
MOVE M,(E)]
>
IFN FILESW,<
PUSHJ P,RDTRKE
XCT (D2)[MOVE E,@TRKOFF
MOVS E,@TRKOFF
MOVE M,@TRKOFF]
>
>;END NOT UESW
IFN UESW,< MO (E,E)
CAIN D2,1
MOVSS E
>
CAIN D2,2
PUSHJ P,GPELOP
JRST OPENU
MVTST: HRRZ E,LOCOP
TLNE F,LOCOPF
TLNN F1,VALF ;ANY VALUE TYPED?
POPJ P,
PUSHJ P,DEPO1 ;YES, DEPOSIT
MOVE E,LOCOP
POPJ P, ;NO
^LEFSQ1:MOVEI D2,1
JRST LRATDO
^RITSQ1:SKIPA D2,[2]
^ATSIN1:MOVEI D2,3
LRATDO: MOVSI M,400020
IORM M,(PNT) ;MARK THIS ONE
MOVEM PNT,VALUE ;OPEN A POINTER
TRO D2,400000 ;MAKE IT PERMANENT
MOVS T,D2
TRO F1,1
JRST PNT4 ;AVOID FINDING ANOTHER COPY ON SCREEN
^REMPER:MOVSI V,400000 ;GET SIGN BIT
MOVS E,SPNT
CAMGE PNT,E ;BLANK SCREEN
POPJ P, ;DO NOTHING
ANDCAM V,(PNT) ;CLEAR
JRST REDISP
^SCLR:
IFN STANFO,<
PUSHJ P,SCLRCL
>
MOVS PNT,SPNT
SUB PNT,[1,,1]
MOVEI M,0
TLZ F,LOCOPF
JRST INC
IFN STANFO,<
SCLRCL: MOVE M,DDSW
CAIE M,.DD
JRST SCLRC1
DDUPG [DDCLRP 2 0 0]
SCLRC2: TRO F,DRWALL
POPJ P,
DDCLRP: BYTE (8)17,0,0 (3)1,2,2,4
0
SCLRC1: CAIE M,.DM
POPJ P,
UPGIOT [DMCLRP 2 0]
JRST SCLRC2
DMCLRP: BYTE (7) 177,37
0
>;STANFO
; Sclrsv, Incr, Leffnd, Eqiv, Wdsrch, Etc., Inc
^SCLRSV:
IFN STANFO,<
PUSHJ P,SCLRCL ;CLEAR THE SCREEN IF DATA DISK
>
TRZ F,DRWALL
TRO F,DPYALL
MOVS M,SPNT ;GET POINTER TO DPNT
MOVE V,M
SCLRS1: SKIPGE T,(M) ;SKIP IF NOT PERMANENT
JRST SCLRS4
SCLRS3: AOBJN M,SCLRS1
TLNN M,7
JRST SCLRS1
MOVE PNT,V
SUB PNT,[1,,1] ;POINTER TO LAST LINE USED
JUMPGE V,SCLRS6
SCLRS5: SETZM (V)
AOBJN V,SCLRS5
TLNN V,7
JRST SCLRS5
SCLRS6: TLNN F,LOCOPF
POPJ P,
MOVE E,LOCOP
JSR FNDSCR ;SKIP IF NOT ON SCREEN NOW
POPJ P, ;ON SCREEN, OK
MOVS V,PNT
ADD V,[1,,1]
CAMN V,SPNT
TLZA F,LOCOPF
CAIA
POPJ P,
MOVE V,(PNT)
PUSHJ P,GETPOI
JFCL
HRRZM E,LOCOP
POPJ P,
SCLRS4: MOVEM T,(V) ;FOUND A PERMANENT ENTRY
MOVE T,DSAV-DPNT(M)
HLLM T,DSAV-DPNT(V) ;MOVE THE ARROW FLAGS
AOBJN V,SCLRS3
JRST SCLRS3
^INCR: TLNE F1,VALF ;VALUE TYPED?
JRST .+3 ;YES
MOVN E,SPNT ;NO, GET CURRENT #
AOJA E,.+2 ;INCREMENT
SOS E,VALUE ;GET TYPED VALUE
HRRZS E
CAMG E,SCRMAX ;BIGGER THAN DISPLAY HEIGHT?
CAILE E,MAXDLN-2-1 ;TOO BIG?
JRST CERR ;YES
MOVS V,PNT
SUB V,SPNT ;GET POINTER TO WHERE WE ARE IN DISPLAY
CAIGE E,(V)
JRST [ MOVEI V,0
HLRZ M,SPNT
HRRM M,PNT
JRST .+1]
MOVN M,E
HLL M,SPNT
EXCH M,SPNT ;DEPOSIT NEW DISPLAY SIZE
IFN STANFO,<
SUB M,SPNT ;OLD -SIZE MINUS NEW -SIZE
TRNE M,400000 ;SKIP IF NOT DECREASING SIZE
PUSHJ P,SCLRCL ;CLEAR THE SCREEN
>;STANFO
SUB E,V
MOVN M,E
HRL PNT,M
INC: SUBM PNT,M ;POINTER TO LAST ELEMENT IN THIS SIZE
SETZM 1(M)
HRLI M,1(M)
ADDI M,2
BLT M,DPNT+MAXDLN-1
POPJ P,
^LEFFND:MOVE E,STPOP
JRST OPENU
^EQIVL: 0
^EQIV: MOVEI V,IFE UESW!FILESW,<EQIVL;> -1
EXCH V,VALUE ;DEPOSIT AND GET TYPED VALUE
TLNE F1,VALF ;VALUE TYPED?
MOVEM V,EQIVL ;YES, DEPOSIT IT
TRO F1,1 ;DO NOT MOVE .
PUSH P,CURMOD
MOVEI V,100 ;CHANGE MODE TO OCTAL
HRRM V,CURMOD
PUSHJ P,SOPENS ;OPEN IT
POP P,CURMOD ;RESTORE MODE
POPJ P,
^LB1: MOVEI E,TLBOUN
JRST LRB
^LB2: MOVEI E,PLBOUN
LRB: TLNN F1,VALF
JRST CERR
MOVE V,VALUE
HRRZM V,(E)
HRRZM V,1(E)
POPJ P,
^RB1: MOVEI E,TUBOUN
JRST LRB
^RB2: MOVEI E,PUBOUN
JRST LRB
^PLBOUN:0
^TLBOUN:0
0
^PUBOUN:0
^TUBOUN:0
0
; WORD, EFFECTIVE ADDRESS, NOT-EQUAL SEARCHES
^ESRCH: MOVEI M,2
JRST SRST
^NWDSR: MOVEI M,1
JRST SRST
^SRCON: TRZN F,SRCHSW ;SEARCH IN PROGRESS?
POPJ P, ;NO
MOVE V,VSSVQ
MOVE M,SRCHCN
JRST WDSCON
^WDSRCH:MOVEI M,0
SRST: MOVE V,TLBOUN
MOVE E,VALUE ;GET VALUE
XCT STB1(M)
JRST ZPU
MOVEM E,SRVAL# ;STORE
WDSCON: MOVEI E,1 ;GET INITL COUNT
MOVS T,SPNT ;GET POINTER
SKIPL (T) ;PERMANENT?
ADDI E,1 ;NO, COUNT
AOBJN T,.-2 ;LOOP
TLNN T,7 ;DONE?
JRST .-4 ;NO
LSH E,-1 ;DIVIDE BY 2
JUMPE E,CERR ;NO LOCATIONS
MOVEM E,SRCNT#
LOPP1: CAML V,TUBOUN ;DONE?
JRST WDON ;YES
IFN FILESW,<
CAIGE V,20
JRST [ MOVE E,JAC(V)
JRST LOPP1A]
HRRZ E,V
PUSHJ P,RDTRKE
MOVE E,@TRKOFF
LOPP1A:
>
IFE FILESW,<
CAIG V,17 ;AC?
SKIPA E,JAC(V) ;YES
MOVE E,(V) ;GET WORD
>
XCT STB1(M)
AOJA V,LOPP1
XOR E,SRVAL ;COMPARE
AND E,@STB3(M) ;AND WITH MASK
XCT STB4(M)
AOJA V,LOPP1 ;NO
FND1: PUSH P,V
PUSH P,M
MOVEM V,VALUE
SETZB T,F1
PUSHJ P,OPENQ ;OPEN FOUND LOCATION
SOSG SRCNT ;n FOUND?
SKIPA E,[.STAR]
PUSHJ P,REDISP ;DRAW HERE IF NOT RETURNING TO TOP LEVEL
POP P,M
POP P,V
SKIPLE SRCNT ;ENOUGH FOUND?
AOJA V,LOPP1
TRO F,SRCHSW ;YES, SET FLAG
HRLM E,NBIGWD
MOVEM M,SRCHCN# ;SAVE TYPE OF SEARCH
MOVEM V,VSSVQ#
AOS VSSVQ
POPJ P,
WDON: MOVE V,PLBOUN
MOVEM V,TLBOUN
MOVE V,PUBOUN
MOVEM V,TUBOUN
TRZ F,SRCHSW
POPJ P,
; Wdsrch Subroutines
^STRIN: 0 ;IT'S $M-1 IF REALLY RAID
IFN REALSW,<INTERN $M,DDTEND>
^$M:
^SMASK: -1
-1
0
^FLGPTR:0
STB1: SKIPA
SKIPA
PUSHJ P,CALCE
STB3: SMASK
SMASK
[777777]
STB4: JUMPE E,FND1
JUMPN E,FND1
JUMPE E,FND1
CALCE: MOVE T,E
LDB D2,[POINT 4,E,17] ;GET IX
JUMPE D2,CLOP1 ;NO IX
ADD T,JAC(D2) ;ADD IX
CLOP1: HRRZS T ;CLEAR LEFT HALF
MOVEM T,CTSV
TLNN E,20 ;@?
JRST CDONE ;NO
IFE FILESW,<
CAMLE T,JOBREL ;O.K.?
IFE SEGSW,< POPJ P, ;NO>
IFN SEGSW,<JRST [CAIL T,400000
CAILE T,@JOBHRL
POPJ P,
JRST .+1]>
>;NOT FILESW
IFN FILESW,<
CAIGE T,20
JRST [ MOVE E,JAC(T)
JRST CALCE1]
HRRZ E,T
CAIL E,74
CAMLE E,FJBHRL
POPJ P,
CAMLE E,FJBREL
CAML E,UPPRST
JRST .+2
POPJ P,
PUSHJ P,RDTRKE
MOVE E,@TRKOFF
CALCE1:
>
IFE FILESW,<
CAIG T,17 ;AC?
ADDI T,JAC ;YES
MOVE E,(T) ;GET WORD
>
HRRZ T,E
CAME T,CTSV
JRST CALCE
POPJ P,
CTSV: 0
CDONE: MOVE E,T
AOS (P)
POPJ P,
; Symdef, Symdf1, Symkil, Symfnd, Symfn1 -- Create and Delete Symbols
IFE SORTED,<
; SYMBOL_VALUE
^SYMDEF: PUSHJ P,CSFLUSH ;FLUSH ALL CACHES, SO AS NOT TO CONFUSE
PUSH P,SYM ;SAVE SYMBOL
PUSHJ P,EVAL ;GET VALUE
TLNN F,VALF ;VALUE?
JRST CERR ;NO
POP P,SYM ;RESTORE SYMBOL
JRST DFQ1 ;GO ENTER
; SYMBOL:
^SYMDF1: PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
TLNN F,LOCOPF ;LOCATION OPEN?
JRST ZPU ; ;NO
MOVE V,LOCOP ;GET VALUE OF .
DFQ1: MOVEM V,VALUE ;SAVE
PUSHJ P,SYMFN1 ;FIND THE CURRENT NAME ENTRY, IF ANY
JRST THERE ; FOUND ONE
MOVN V,[2,,2]
ADDB V,JOBSYM ;FIX JOBSYM
MOVSI E,2 ;UPDATE POINTERS
ADDM E,SYMPNT
ADDM E,SYMPRG
MOVE E,SYM ;GET SYMBOL
TLO E,40000 ;MAKE GLOBAL
MOVEM E,(V) ; SYMBOL
THERE: MOVE E,VALUE ;SAVED VALUE
MOVEM E,1(V) ;TO OLD LOCATION, OVERRIDING PREVIOUS DEF.
JRST FREPOPJ
;SYMBOLK
^SYMKIL:PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
PUSHJ P,SYMFND ;FIND ENTRY
CAIA ;FOUND ONE
JRST PU ;NONE
MOVE PV,SYMP ;GET POINTER
MOVSI D3,400000 ;GET KILL FLAG
IORM D3,(PV) ;KILL SYMBOL
TRO F,DPYALL ;HAVE TO START FROM SCRATCH
JRST CSFLUSH
;SYMBOLK -- ANNIHILATE IT
^SYMNIL:PUSHJ P,SYMKIL ;MERELY KILL IT
MOVE D3,[RADIX50 50,$UNDEF]
MOVEM D3,(PV) ;NO SUCH NAME ANYMORE!
POPJ P,
;SUBROUTINE USED BY ABOVE BIG GUYS
SYMFND: TLNE F1,USINGF ;DEFINED?
POPJ P, ; NO
SYMFN1: TLNN F1,SINGF ;ySINGLE SYMBOL?
JRST CERR ;NO
TLZ F,UNDF
MOVS PV,F ;SAVE FLAGS
PUSHJ P,SYMLOK ;FIND IN TABLE
TLZ F,SCFL ;RESTORE SCFL FLAG...
ANDI PV,SCFL ;....
TSO F,PV ;...
TLNE F,UNDF ;DEFINED?
AOS (P) ;YES
POPJ P,
>;NOT SORTED
IFN SORTED,< ; Symdef, Symdf1, Symkil -- Create and Delete Symbols
; SYMBOL_VALUE
^SYMDEF:PUSHJ P,CSFLUSH ;FLUSH ALL CACHES, SO AS NOT TO CONFUSE
PUSH P,SYM ;SAVE SYMBOL
PUSHJ P,EVAL ;GET VALUE (MIGHT MAKE CACHE ENTRY)
TLNN F,VALF ;VALUE?
JRST CERR ;NO
POP P,SYM ;RESTORE SYMBOL
PUSHJ P,DFQ1 ;GO ENTER
JRST CSFLUSH ;FLUSH AGAIN SINCE WE MOVED THE SYMBOLS
; SYMBOL:
^SYMDF1:PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
TLNN F,LOCOPF ;LOCATION OPEN?
JRST ZPU ;NO
MOVE V,LOCOP ;GET VALUE OF .
DFQ1: PUSH P,B ;Save EVAL Ahead-values
PUSH P,C
PUSH P,PNT
MOVEM V,VALUE ;Assume INTERNAL (not prev. def), and set
MOVE E,PID ; up symbol for that -- in that case, any
LSH E,5 ; PID will do, really, so use current.
PUSH P,E
PUSHJ P,SYMFN1 ;If the symbol already exists, save its
JRST NTHERE ; type bits and its block ID, then remove
MOVE PV,SYMP
PUSH P,(PV) ; it from the face of the globe.
HLRZ E,1(PV)
MOVEM E,-1(P)
PUSHJ P,SYMNIL
POP P,SYM
NTHERE: MOVE PNT,SYMBAS
MOVE V,VALUE ;Determine the range of the new value,
PUSHJ P,GETRNG ; and under the conditions:
MOVEM A,RANGE ; 1) The symbol is in range 3 (full value)
MOVEM V,VALUE ; 2) There are no free list entries for oflow
MOVE M,5(PNT) ;REL PTR TO ONE AFTER LAST FREE
MOVE T,4(PNT) ;REL PTR TO FIRST FREE
HRRZ PV,(PNT) ;SEE IF THERE IS A FREE LIST FOR 36 BIT VALUES
JUMPN PV,RM ;THERE IS ONE. WORD FOR VAL WILL COME FROM IT
CAIN A,3 ;A HAS THE RANGE
ADDI T,1 ;RESERVE FIRST WORD OF FREE FOR THE 36 BIT VALUE
SUBI M,2 ;NEW FIRST SYMBOL
RM: CAIL T,(M)
JRST CERR ;WON'T DO IT IF CAN'T LEAVE AT LEAST ONE FREE
MOVEM T,4(PNT) ;STORE BACK IN CASE IT WAS INCREMENTED ABOVE
MOVE PV,@RNGBAS ;BEGINNING OF RANGE THAT SYM GOES IN
ADDI PV,(PNT)
MOVE B,@RNGBS1 ;BEGINNING OF FOLLOWING RANGE
ADDI B,(PNT)
MOVNI M,2
SETCM E,A ;-NUMBER OF CLASSES THAT ARE MOVING
MOVEI T,5(PNT) ;ADDRESS OF RELATIVE POINTER OF CLASS 1
HRLI T,(E)
ADDM M,(T)
AOBJN T,.-1 ;UPDATE POINTERS OF ALL CLASSES THAT MOVED
MOVN E,[2,,2]
ADDM E,SYMRNG
MOVE E,SUBRNG(A) ;E GETS 0 IF CLASSES 1-3 , 1 IF CLASS 4
HRDLUP: CAIGE PV,(B)
XCT CAMG1(E)
JRST INSTAL
ADDI PV,2 ;IN EITHER CASE WILL INDICATE THE ENTRY JUST
JRST HRDLUP ;AFTER THE NEW SYMBOL LOCATION
INSTAL: MOVE T,5(PNT) ;POINTER TO NEW START OF CLASS 1
ADDI T,(PNT)
MOVEI M,2(T) ;POINTER TO OLD START OF CLASS 1
HRLI T,(M) ;MAKE A BLT POINTER
BLT T,-3(PV)
MOVE T,SYM ;THE NAME IS EASY -- INCLUDING THE TYPE
TLNN T,740000
TLO T,40000
MOVEM T,-2(PV) ; DERIVED ABOVE.
CAIE A,3
JRST NBD
HRRZ T,(PNT) ;POINTER TO FREE LIST OF 36 BIT VALUE WORDS
JUMPE T,NEWW
ADDI T,(PNT) ;MAKE ABSOLUTE
HRRZ M,(T) ;RELATIVE POINTER TO NEW HEAD OF FREE LIST
HRRM M,(PNT) ;UPDATE POINTER TO FREE
JRST HHERE
NEWW: HRRZ T,4(PNT)
ADDI T,-1(PNT)
HHERE: MOVEM V,(T)
HRRZ V,T
SUBI V,(PNT) ;REL POINTER TO VALUE GETS STORED IN RH OF SYM
MOVEI T,PNT
IORM T,(P) ;TURN ON INDEX FIELD IN BLOCK POINTER HALF
NBD: POP P,E ;The new symbol value word has Block ID
HRL V,E ; info in the left half, value (or ptr)
MOVEM V,-1(PV)
POP P,PNT
POP P,C
POP P,B
JRST FREPOPJ
;REVIVE, SYMKIL, SYMNIL, ZAPSYM, SYMFND, SYMFN1
;SYMBOL:
^REVIVE:SKIPA D1,[ANDCAM D3,(PV)] ;REVIVE KILLED SYMBOL
;SYMBOLK
^SYMKIL:MOVE D1,[IORM D3,(PV)] ;KILL A SYMBOL
PUSHJ P,CSFLUSH ;FLUSH ALL CACHES
PUSHJ P,SYMFND ;FIND ENTRY
JRST PU ;NONE
MOVE PV,SYMP ;GET POINTER
MOVSI D3,400000 ;GET KILL FLAG
XCT D1 ;KILL SYMBOL
TRO F,DPYALL ;HAVE TO START FROM SCRATCH
JRST CSFLUSH
;SYMBOLK -- ANNIHILATE IT
^SYMNIL:PUSHJ P,SYMKIL ;This one looks up the symbol,
^ZAPSYM:MOVE PNT,SYMBAS
MOVE D1,1(PV) ; gets its pointer to PV.
TLNN D1,37 ;If the deleted symbol has an
JRST NOFLOW ; overflow word, put into oflow
HRRZ T,(PNT)
HRRM D1,(PNT)
ADD D1,PNT
HRROM T,(D1)
NOFLOW: MOVEI T,(PV) ;DESTINATION IS WHERE SYMBOL WAS
MOVE E,5(PNT)
ADDI E,(PNT) ;ABSOLUTE ADDRESS OF FIRST SYMBOL
NOFLW1: CAIGE T,2(E) ;SKIP IF SOURCE IS STILL A SYMBOL
JRST NOFLW2
MOVE A,-2(T)
MOVEM A,(T)
MOVE A,-1(T)
MOVEM A,1(T)
SUBI T,2
JRST NOFLW1
NOFLW2: SETZM (T)
SETZM 1(T)
MOVEI T,2
MOVEI A,0
SUBI PV,(PNT) ;MAKE PV A RELATIVE POINTER
NOFLW3: CAMGE PV,@RNGBAS
JRST SETSYM
ADDM T,@RNGBAS ;UPDATE RELATIVE POINTERS TO SYMS
AOJA A,NOFLW3
;SUBROUTINE USED BY ABOVE BIG GUYS
SYMFND: TLNE F1,USINGF ;DEFINED?
JRST APOPJ2 ; NO
SYMFN1: TLNN F1,SINGF ;SINGLE SYMBOL?
JRST CERR ;NO
TLZ F,UNDF
MOVS PV,F ;SAVE FLAGS
PUSHJ P,SYMLOK ;FIND IN TABLE
TLZ F,SCFL ;RESTORE SCFL FLAG...
ANDI PV,SCFL ;....
TSO F,PV ;...
TLNN F,UNDF ;DEFINED?
APOPJ2: AOS (P)
POPJ P,
>;SORTED
;$nB, 1 n Brknum -- Brkins, Brkjsr, Dobrk, Brkpln
COMMENT THE FORMAT OF THE BREAKPOINT TABLE
IS AS FOLLOWS:
$1B: RIGHT HALF IS THE ADDRESS OF THE BREAKPOINT
LEFT HALF IS ZERO, THIS LOCATION IS -1 IF NOT USED
BRKCNT__1 ;THIS IS THE MULTIPLE PROCEDE COUNT
BRKSKP__2 ;THIS IS THE CONDITIONAL SKIP INSTRUCTION.
;IF NON-ZERO, RAID WILL EXECUTE THIS INST.
;WHEN YOU HIT THIS BREAKPOINT AND WILL
;IGNORE THE BREAKPOINT IF THE INST. SKIPS
BRKSTR__3 ;THIS IS THE STRING POINTER. WHEN YOU HIT THIS
;BREAKPOINT, THE STRING POINTED TO GETS EXECUTED
;AS IF IT WAS BEING TYPED IN; AS LONG AS THE POINTER IS NON-ZERO
BRKCON__4 ;THE REAL CONTENTS OF THE BREAKPOINT LOCATION ARE STORED HERE
BRKNUM__20 ;MAX NUMBER OF BREAKPOINTS
BLOCNM__5 ;NUMBER OF WORDS PER BREAKPOINT IN TABLE
IFN UESW,<
^JOBREL:,,-1
^JOBSYM:0 ;DON'T CLOBBER REAL JOBSYM SO WE CAN DEBUG
>
IFN DEBSYM,<
^JOBSYM: 0
>
IFN FILESW,<EXTERNAL JOBREL,JOBSA,JOBSYM>
IFE UESW!FILESW,<
$1B: -1
BLOCK BLOCNM-1
FOR @@ ZILCH_2,BRKNUM
<IFN REALSW,<$@ZILCH@B:> -1
BLOCK BLOCNM-1
>
IFN REALSW,<INTERN $1B
FOR @! Z_2,BRKNUM
<INTERN $!Z!B
>>
^BRKINS:0
SKIPE BRKSW# ;SKIP IF BREAKPOINTS ARE NOT IN CORE YET
JRST @BRKINS
SETOM BRKSW ;INDICATE BREAKPOINTS ARE IN CORE
MOVEI M,$1B ;GET POINTER TO TABLE
MOVEI D3,BRKNUM
LOP11: SKIPGE V,(M) ;USED?
JRST ARN1 ;NO
MOVE T,[JSR BRKJSR] ;GET THE JSR
CAIG V,17 ;AC?
ADDI V,JAC ;YES
EXCH T,(V) ;DEPOSIT
MOVEM T,BRKCON(M) ;SAVE VALUE
ARN1: ADDI M,BLOCNM ;GO TO NEXT
SOJG D3,LOP11 ;LOOP IF NOT DONE
JRST @BRKINS
IFN REALSW,< $I:
INTERN $I
>
^BRKJSR:0
MOVEM P,RAC+P
MOVE P,[-PDLEN,,PDL-1]
EXCH P,RAC+P
JSR RACGT ;GET THE AC'S
JSR ONCE ;TO BE SURE
SOS BRKJSR ;POINT TO BREAKPOINT INSTR
^DOBRK: SETZM PNTREM
JSR BRKPUL ;PULL OUT THE BREAKPOINTS
SKIPN M,PNTREM ;GET POINTER TO THIS ONE
JRST HITT ;NO???????
SKIPN V,BRKSKP(M) ;GET SKIP INST.
JRST NORMAL ;NO SKIP
MOVEI T,0 ;SKIP-DETECTOR
JSR JACGT ;GET USER BACK
XCT RAC+V ;EXECUTE IT (RAID SAVED AC)
AOS RAC+T ;SKIPPED NONE
AOS RAC+T ;SKIPPED ONE
JSR RACGT ;GET RAID'S ACS BACK (INCL M.)
JRST .+1(T)
JRST PROCEE ;SKIPPED TWO
JRST HIT ;SKIPPED ONE
NORMAL: SOSLE BRKCNT(M) ;CHECK PROCEDE COUNT
JRST PROCEE ;NOT EXHAUSTED
SETZM BRKCNT(M) ;EXHAUSTED
HIT: SKIPN T,BRKSTR(M) ;IS THERE A STRING POINTER?
JRST HIT1 ; NO
TLNN T,-1 ;DID USER SPECIFY BP PART?
HRLI T,440700 ; NO, START AT WORD BEGINNING
HIT1: MOVEM T,STRIN ;SET RAID INTERNAL INPUT BP
MOVE V,(M)
TLNE V,40 ;DID WE HIT A TEMPORARY BREAKPOINT????
SETOM (M) ;YES, REMOVE IT..
HITT: SKIPN V,BRKJSR ;WAS THERE A LOCATION?
JRST NOVALU
MOVEI T,.STAR
HRLM T,NBIGWD
PUSHJ P,OPNQQQ ;OPEN BREAKPOINT LOCATION
SKIPN PNTREM ;REAL BPT?
TRNE F,ISOPC ;NO, JOBOPC KLUDGE?
JRST NOVALU ;ONE OF THE ABOVE
AOS V,BRKJSR ;IT'S A JSR $I, FIX THE PC
PUSHJ P,OPNQQQ ;AND DISPLAY THE PROCEED LOC
SOS VALUE
PUSHJ P,OPENQ ;NOW SET . BACK TO JSR
NOVALU: MOVE V,F ;SAVE ISOPC FLAG
IFN TENEX,<
MOVEI A,100
TRZN F,ISOPC
CBIBF
>
IFE TENEX,<
TRZN F,ISOPC
CLRBFI
>
TRNN V,ISOPC ;REDRAW ON TTY FOR RAID STARTUP
SKIPE DDSW ;TEST DEVICE
JRST E1RET ;GO DO RAID
JRST ERET ;TTY, NO NEED TO REDRAW
OPNQQQ: HRRZM V,VALUE
OPENQQ: HRRZM V,STPOP
MOVE T,V
SUB T,(PNT)
MOVEI T,-2(T)
JUMPN T,NOSKPT
SOS VALUE
MOVEI T,0
MOVEI F1,4
PUSHJ P,OPENQ
AOS VALUE
NOSKPT: SETZB T,F1
JRST OPENQ
^GOGOGO:MOVE V,VALUE ;GET VALUE
TLNN F1,VALF ;WAS THERE A VALUE?
MOVE V,JOBSA ;NO, GET JOBSA
HRRM V,BRKJSR ;DEPOSIT
GOPRO: JSR BRKINS ;INSERT BREAKPOINT
JSR JACGT ;GET JOB AC'S
JRST 2,@BRKJSR ;GO TO JOB
EXTERN JOBREL,JOBSA
IFE DEBSYM,<EXTERN JOBSYM>
^BRKPLN:TLNN F1,VALF ;VALUE TYPED?
JRST CERR ; NO
PUSHJ P,BRKREM
MOVEI M,$1B
MOVEI T,BRKNUM
BLOP: SKIPGE (M) ;EMPTY?
JRST BBFND ;YES
ADDI M,BLOCNM ;GO TO NEXT
SOJG T,BLOP
JRST CERR ;NO ROOM
BBFND: HRRZ V,VALUE
CAIG V,@JOBREL
JRST BBOK
IFN SEGSW,<
CAIL V,400000
CAILE V,@JOBHRL
JRST CERR
SKIPGE JOBHRL
PUSHJ P,UNPUR
>
IFE SEGSW,<JRST CERR>
BBOK: MOVEM V,(M) ;STORE
SETZM BRKCNT(M)
SETZM BRKSTR(M)
SETZM BRKSKP(M)
POPJ P,
; Brkrem, Brkpul, Tbproc
^BRKREM:
^BKRM: HRRZ V,VALUE ;GET VALUE IF ANY
MOVEI T,$1B ;GET TABLE POINTER
MOVEI M,BRKNUM ;AND COUNT
TLNN F1,VALF ;VALUE?
JRST REMALL ;NO, REMOVE ALL BREAKPOINTS
LOOP1: CAMN V,(T) ;THIS IT?
JRST BFND ;YES
ADDI T,BLOCNM ;NO, GO TO NEXT
SOJG M,LOOP1 ;LOOP IF NOT DONE
POPJ P,
BFND: SETOM (T) ;REMOVE IT
POPJ P,
REMALL: SETOM (T)
ADDI T,BLOCNM ;GO TO NEXT
SOJG M,REMALL ;LOOP
POPJ P,
;REMOVE THE BREAKPOINTS. PNTREM GETS SET TO THE INDEX OF THE BREAKPOINT WHOSE
;LOCATION IS NOW IN BRKJSR
^BRKPUL:0
SKIPN BRKSW ;SKIP IF BREAKPOINTS HAVE BEEN INSTALLED IN CORE
JRST @BRKPUL
SETZM BRKSW ;SAY THAT BREAKPOINTS ARE NO LONGER IN CORE
MOVEI M,$1B ;GET POINTER TO TABLE
MOVEI D3,BRKNUM
LOP12: SKIPGE V,(M) ;GET LOCATION
JRST ARN2 ;NOT USED
MOVE T,BRKCON(M) ;GET WORD WHICH GOES THERE
ANDI V,-1
CAIN V,@BRKJSR ;IS THIS THE ONE?
MOVEM M,PNTREM ;YES REMEMBER POINTER
CAIG V,17 ;AC?
ADDI V,JAC ;YES
MOVEM T,(V) ;DEPOSIT
ARN2: ADDI M,BLOCNM ;GO TO NEXT
SOJG D3,LOP12 ;LOOP
JRST @BRKPUL
; TBPROC: PLANT A TEMPORARY BREAKPOINT AT "." AND PROCEED
^TBPROC:HRRZ E,(PNT) ;GET "."
MOVEM E,VALUE ;PRETENT IT...
TLO F1,VALF ;...WAS TYPED
PUSHJ P,BRKPLN ;PLANT A BREAKPOINT AT "."
MOVSI V,40
ORM V,(M) ;MAKE IT A TEMPORARY BREAKPOINT
JRST PROCEE ;PROCEED..
; Proced, Gpelop, Elop, Pstbrk, Prmbrk, $SBP
^PROCED:SKIPN M,PNTREM ;HAVE A POINTER?
JRST GOPRO ;NO, USER JSR $I'ED, OR JRSTED DDT
MOVE V,VALUE ;REPEAT COUNT
TLNE F1,VALF ;VALUE TYPED?
HRRZM V,BRKCNT(M) ;YES, DEPOSIT
PROCEE: PUSHJ P,STEP ;STEP ONE LOCATION
JRST GOPRO ;PROCEDE
PNTREM: 0
STEP: HRRZ M,BRKJSR ;GET CURRENT PC
CAIG M,17 ;AC?
ADDI M,JAC ;YES
MOVEM M,BRKJSQ# ;SAVE
STP1: MOVE M,@BRKJSQ ;GET THE INST. TO BE DONE
PUSHJ P,ECALC ;CALCULATE EF. ADDRS.
CAMGE M,[SOS] ;IF INST IS SOS OR GREATER, IT'S SAFE
CAMGE M,[JFFO] ;IF IT IS LESS THAN JFFO, IT'S SAFE
JRST SAFE
LDB M,[POINT 9,M,8] ;GET OPCODE
CAIL M,321 ;IF IT'S JUMPL OR GREATER IT'S JUMP-SKIP
JRST JSKP
CAIN M,243 ;JFFO?
JRST OJUM ;YES
CAIGE M,252 ;AOBJNP OR GREATER?
JRST SAFE ;NO
CAIL M,270 ;IF ADD OR GREATER, SAFE
JRST SAFE
JRST @JUMSTP-252(M) ;DISPATCH ON TYPE OF JUMP
JUMSTP: OJUM ;AOBJP
OJUM ;AOBJN
OJRST ;JRST
OJUM ;JFCL
HXCT ;XCT
SAFE ;?????
HPSHJ ;PUSHJ
SAFE ;PUSH
SAFE ;POP
HPPJ ;POPJ
HJSR ;JSR
HJSP ;JSP
HJSA ;JSA
OJUM ;JRA
OJUM: PUSHJ P,ECALC ;GET THE EFFECTIVE ADDRS. IN E, INST IN M
TLZ M,37 ;CLEAR @ AND X
HRRI M,ITJ ;PUT IN OUR OWN ADDRESS
MOVEM M,OINST ;STORE INTR.
JSR JACGT1 ;GET JOB AC'S
OINST: 0 ;DO THE INSTR.
JSR RACGT1 ;GET RAID AC'X
AOSR: AOS BRKJSR ;UPDATE PC
POPJ P, ;LEAVE
ITJ: JSR RACGT1 ;GET RAID AC'S
HRRM E,BRKJSR ;UPDATE PC
POPJ P,
OJRST: PUSHJ P,ECALC
TLNN M,100 ;AC 2 ON?
JRST OJUM+1 ;NO
TLNN M,20 ;@ ON?
JRST OJUM+1 ;NO
TLZ M,17
HRRI M,MSAV
MOVEM M,OINST
MOVE M,MSAV
TLZ M,37
HRRI M,ITJ
MOVEM M,MSAV
JRST OINST-1
SAFE: MOVE M,@BRKJSQ ;GET INST.
SETZM BRCNT#
LDB T,[POINT 9,M,8] ;GET OPCODE
CAIN T,41 ;INIT?
JRST INITI ;YES
CAIGE T,100
JRST ITSUUO
SF1: JSR JACGT1 ;GET JOB AC
XCT @BRKJSQ ;EXECUTE THE INST (BRKJSQ IN CASE UNDER XCT)
AOS BRCNT
AOS BRCNT
AOS BRCNT
INRET: JSR RACGT1 ;GET RAID AC'S
MOVEI T,4 ;UPDATE PC
ADD T,BRKJSR
;...
SUB T,BRCNT
HRRM T,BRKJSR
POPJ P,
INITI: MOVS M,BRKJSQ
HRRI M,INTQ
BLT M,INTQ+2 ;GET THE INIT
JSR JACGT1 ;GET JOB AC
INTQ: BLOCK 3
AOS BRCNT
JRST INRET
ITSUUO: CAIGE T,40
JRST ITSU40
PUSH P,M ;SAVE INSTRUCTION
JSR BRKINS
POP P,@BRKJSQ ;RESTORE INSTRUCTION IN CASE IT HAS A BREAKPOINT
PUSHJ P,SF1
JSR BRKPUL
POPJ P,
ITSU40: JUMPE T,SF1
HRR M,E
TLZ M,37
MOVEM M,40
MOVEI E,41
MOVEM E,BRKJSQ
JRST STP1
RACGT1: 0
JSR RACGT ;GET RAID AC'S
HLL T,RACGT1 ;GET JOB FLAGS
HLLM T,BRKJSR ;DEPOSIT
JRST @RACGT1
JACGT1: 0
MOVE T,BRKJSR ;GET JOB FLAGS
HLLM T,JACGT1 ;DEPOSIT
JSR JACGT ;GET JOB AC'S
JRST 2,@JACGT1 ;RETURN & RESTORE JOB FLAGS
ECALC: SKIPA M,@BRKJSQ ;GET INST
^GPELOP:SETZM BRKJSQ
>;END OF IFE UESW!FILESW
IFN UESW!FILESW,<
^GPELOP:>
^ELOP: IFN UESW!FILESW,<PUSH P,M>
ELOOPP: HRRZ E,M ;GET ADDRESS FIELD
LDB T,[POINT 4,M,17] ;GET IX FIELD
JUMPE T,.+3 ;ANY IX?
ADD E,JAC(T) ;YES, ADD IN
HRRZS E
TLNN M,20 ;@?
JRST EDON ;NO
JSR ECHK
MOVE M,(E) ;GET WORD
JRST ELOOPP
EDON:
IFE UESW!FILESW,<
MOVEM M,MSAV
MOVE M,@BRKJSQ ;ELSE > POP P,M
POPJ P,
IFN REALSW,<
$SBP:
INTERN $SBP
>;REALSW
IFE UESW!FILESW,<
; USER CALLS JSR AC,$SBP TO SET BREAKPOINT AT LOCATION NAMED IN AC
^PSTBRK:0
JSR RACGT ;GET RAID ACS
JSR ONCE ;SET UP FOR RAID IF FIRST EXPOSURE
JSR BRKPUL ;PULL, BECAUSE THEY'RE GOING TO CHANGE
TLO F1,VALF ;SIMULATE SUCCESSFUL VALUE SCAN
HRRZ V,PSTBRK ;RETURN ADDR
LDB V,[POINT 4,-1(V),12];AC FIELD OF `JSR AC,$SBP'
HRRZ V,JAC(V) ;USER'S VERSION OF THIS AC
MOVEM V,VALUE ;FINISH SIMULATION
PUSHJ P,BRKPLN ;PLANT THE BREAKPOINT
JSR BRKINS ;INSERT BREAKPOINTS
JSR JACGT ;GET JOB'S ACS BACK
JRST 2,@PSTBRK ;RETURN TO SENDER
IFN REALSW,<
$RBP:
INTERN $RBP
>;REALSW
^PRMBRK:0
JSR RACGT ;PRETTY MUCH A REPEAT
JSR ONCE ;SET UP FOR RAID IF FIRST EXPOSURE
JSR BRKPUL ;PULL, BECAUSE THEY'RE GOING TO CHANGE
TLO F1,VALF ;SIMULATE SUCCESSFUL VALUE SCAN
HRRZ V,PRMBRK ;RETURN ADDR
LDB V,[POINT 4,-1(V),12];AC FIELD OF `JSR AC,$RBP'
HRRZ V,JAC(V) ;USER'S VERSION OF THIS AC
MOVEM V,VALUE ;FINISH SIMULATION
PUSHJ P,BKRM ;REMOVE THE BREAKPOINT
JSR BRKINS ;INSERT BREAKPOINTS
JSR JACGT ;GET JOB'S ACS BACK
JRST 2,@PRMBRK ;RETURN TO SENDER
; Steppe, Stepp, Xeq1, Xeq2
MSAV: 0
JSKP: TRNE M,10 ;JUMP OR SKIP?
JRST SAFE ;SKIP, SAFE
JRST OJUM ;JUMP, HANDLE
HJSR: PUSHJ P,ECALC ;GET DFFECTIVE ADDRESS IN E, INST IN M
AOS T,BRKJSR ;GET THE PC WORD
CAILE E,17 ;AC?
SKIPA V,E ;NO
MOVEI V,JAC(E) ;YES
MOVEM T,(V) ;DEPOSIT PC WORD
AOJA E,JSRET
HJSP: PUSHJ P,ECALC ;GET EF AD IN E
AOS T,BRKJSR ;GET THE PC
LDB V,[POINT 4,M,12];GET AC FIELD
MOVEM T,JAC(V) ;DEPOSIT PC IN THE AC
JSRET: HLL E,BRKJSR ;GET FLAGS
TLZ E,20000 ;CLEAR THE BIS FLAG
JSAET: MOVEM E,BRKJSR ;DEPOSIT NEW PC
POPJ P,
HJSA: PUSHJ P,ECALC ;GET DF AD
AOS T,BRKJSR ;GET THE PC
LDB V,[POINT 4,M,12];GET AC FIELD
MOVE PV,JAC(V) ;GET AC
CAILE E,17 ;IS E AN AC?
SKIPA D3,E ;NO
MOVEI D3,JAC(E) ;YES
HRL T,E ;PUT E IN LEFT OF PC WORD
MOVEM T,JAC(V) ;DEPOSIT PC IN AC
MOVEM PV,(D3) ;DEPOSIT AC IN E
HLL E,BRKJSR ;GET FLAGS
AOJA E,JSAET
HPSHJ: PUSHJ P,ECALC ;GET ADDRS
AOS T,BRKJSR ;GET THE PC
MOVEM T,OINST ;STORE
LDB T,[POINT 4,M,12] ;GET AC
DPB T,[POINT 4,HP1,12];DEPOSIT
JSR JACGT1 ;GET JOB AC
HP1: PUSH P,OINST ;PUSH THE PC
JSR RACGT1 ;GET RAID AC
JRST JSRET
HPPJ: MOVE M,@BRKJSQ ;GET INST
LDB T,[POINT 4,M,12];GET AC FIELD
DPB T,[POINT 4,HP2,12];DEPOSIT
JSR JACGT1 ;GET JOB AC
HP2: POP P,OINST ;GET THE RETURN ADDRS
JSR RACGT1 ;GET RAID AC
MOVE E,OINST ;GET THE NEW PC
HRRM E,BRKJSR ;STORE
POPJ P,
HXCT: PUSHJ P,ECALC ;GET EF AD
CAIG E,17 ;AC?
ADDI E,JAC ;YES
MOVEM E,BRKJSQ ;DEPOSIT
JRST STP1 ;DO THAT ONE
^STEPP: MOVE M,LOCOP
TLNN F,LOCOPF
JRST CERR
HRRM M,BRKJSR
^STEPPE:PUSHJ P,STEP ;DO IT
MOVE V,BRKJSR ;GET PC
HRRZM V,VALUE ;DISPLAY IT
JRST OPENQQ
XQINST: LDB T,[POINT 9,M,8] ;GET OPCODE
CAIE T,264 ;JSR?
CAIN T,260 ;PUSHJ?
AOS (P) ;YES
CAIE T,265 ;JSP?
CAIN T,266 ;JSA?
AOS (P) ;YES
CAIG T,37 ;UUO?
AOS (P) ;YES
POPJ P, ;NO
^XEQ2: MOVE M,LOCOP
TLNN F,LOCOPF
JRST CERR
HRRM M,BRKJSR
^XEQ1: HRRZ M,BRKJSR ;GET PC
CAIG M,17 ;AC?
ADDI M,JAC ;YES
MOVEM M,BRKJSQ
MOVE M,(M) ;GET INST
PUSHJ P,XQINST ;SUBR. CALL INST?
JRST STEPPE ;NO, STEP
NOSTPP: MOVEM M,NONST ;STORE INST
PUSHJ P,NOSTP ;DO IT
MOVE V,BRKJSR
HRRZM V,VALUE
PUSHJ P,OPENQQ
JRST ERET
; Xeq3, Yxeq, Mstep, LEAVE
^XEQ3: TLNN F1,VALF ;VALUE TYPED?
JRST CERR ;NO
MOVE M,VALUE ;GET INST
MOVEM M,NONST
PUSHJ P,XQINST ;SUBR. CALL INST?
SKIPA ;NO
JRST YES1 ;YES
PUSH P,BRKJSR ;SAVE PC
MOVEI T,NONST ;SET UP TEMP PC
HRRM T,BRKJSR
PUSHJ P,STEP ;DO THE INST
HRRZ M,BRKJSR
SUBI M,NONST
PUSHJ P,SKPSET
POP P,M ;RESTORE PC
HRRM M,BRKJSR
POPJ P,
YES1: MOVE T,XQPNT ;GET TABLE POINTER
PUSH T,BRKJSR ;SAVE PC
MOVEM T,XQPNT ;SAVE OVER BRKINS
PUSHJ P,NOSTP ;GO GET BRKPNTS, DO
HRRZ M,BRKJSR
SUBI M,@(T)
PUSHJ P,SKPSET
POP T,M
MOVEM T,XQPNT ;RESTORE TABLE POINTER
HRRM M,BRKJSR ;RESTORE PC
JRST ERET
SNUM__10
NOSTP: JSR BRKINS ;INSERT BREAKPOINTS
MOVE T,XQPNT ;GET TABLE POINTER
NOST: PUSH T,BRKJSX# ;SAVE OLD PC
PUSH T,BRKJSR ;SAVE OLD USER PC TOO
POP P,M ;GET RETURN ADDRS
HRLM M,-1(T) ;SAVE
MOVEM T,XQPNT ;STORE POINTER
MOVEI M,SNUM
MOVEM M,BRKJSX
JSR JACGT1 ;GET JOB AC
NONST: 0 ;DO INST
REPEAT SNUM,<SOS BRKJSX>
JSR RACGT1 ;GET RAID AC
JSR BRKPUL ;REMOV BRK PNTS
MOVE M,NONST ;GET INST.
LDB E,[POINT 4,M,12] ;GET AC FIELD
PUSHJ P,ELOP ;CALC EF. ADDRS.
MOVE T,XQPNT
POP T,BRKJSR
AOS M,BRKJSX
ADDM M,BRKJSR
POP T,M
MOVEM T,XQPNT
HRRM M,BRKJSX
MOVSS M
JRST (M)
XQTBLN__20
XQTB: BLOCK XQTBLN
XQPNT: -XQTBLN,,XQTB-1
^MSTSW1:0
^MSTSW2:0
^LEAVE: MOVE M,[EXIT]
MOVEM M,VALUE
TLO F1,VALF
^YXEQ: TLNN F1,VALF
JRST CERR
MOVE M,VALUE ;GET INST TO BE EXECUTED
MOVEM M,YXINST ;DEPOSIT
PUSHJ P,XQINST ;IS IT SUBR CALL?
SKIPA
JRST XEQ3 ;YES
MOVEI T,2
MOVEM T,YXCNT
JSR BRKINS ;PLANT BREAKPOINTS
JSR JACGT1 ;GET JOB AC'S
YXINST: 0
SOS YXCNT
SOS YXCNT
JSR RACGT1
JSR BRKPUL
SKIPE M,YXCNT
PUSHJ P,SKPST1
JRST ERET
YXCNT: 0
SKPSET: SOJLE M,CPOPJ
SKPST1: MOVEM M,SKPVAL
TLO F,PMULFL!PUFL
HRRI M,.SKIP
HRLM M,NBIGWD
POPJ P,
^MSTEP: TLNN F1,VALF ;IF THERE WAS A REPEAT FACTOR,
JRST MSTEP2
MOVE M,VALUE ;USE IT AS NUMBER TO EXECUTE
MOVEM M,RPTCNT ;BEFORE DISPLAYING
JRST MSTEP2
STPQ: TRNE B,1
AOS MSTSW1
STP: PUSHJ P,STEPPE ;STEP INST
MSTEP1: SOSGE RPTCNT
PUSHJ P,REDISP ;DRAW INTERMEDIATE RESULTS
MSTEP2: HRRZ M,BRKJSR ;GET PC
MOVE V,M
MOVEM M,VALUE
CAIG M,17 ;AC?
ADDI M,JAC ;YES
MOVEM M,BRKJSQ ;DEPOSIT
MOVE M,(M) ;GET INST
MOVEM M,NONST ;DEPOSIT
PUSHJ P,XQINST ;SUBR. CALL INST?
JRST STPNOS ;NO
SKIPN MSTSW1 ;ANY SWITCH SETTING FOR THIS?
JRST STPYES ;NO
PUSHJ P,OPENQQ ;YES, OPEN IT
SKIPL MSTSW1 ;WHICH WAY
JRST STP ;STEP
JRST STPX ;XEQ
STPNOS: CAIE T,263 ;POPJ?
CAIN T,267 ;JRA?
JRST STPJ ;YES
CAIN T,254 ;JRST?
TLNN M,20 ;@?
JRST STPNO ;NO
STPJ: SKIPN MSTSW2 ;CHECK SWITCH
STPYES: TLO F,STARSW ;YES, TURN ON STAR
STPNO: PUSHJ P,OPENQQ ;OPEN PC LOCATION
TLZN F,STARSW ;WAS IT SUBR CALL?
JRST STPQQ ;NO
MOVEI M,.STAR
HRLM M,NBIGWD
PUSH P,TYII ;SAVE CURRENT INPUT INSTR
IFN TENEX,<
PUSH P,BIN1 ;> PUSH P,[INCHRW C]
POP P,TYII ;DDTIN MODE
PUSHJ P,REDISP ;DRAW CHANGE, STAR
PUSHJ P,GCHRS ;YES, GET A CHR.
PUSH P,B
PUSH P,C
PUSHJ P,REDISP ;TURN OFF THE STAR
POP P,C
POP P,B
POP P,TYII ;RESTORE PREV INSTR
TRNE B,2 ;CTL2?
SETOM MSTSW2 ;YES
TRNE B,1 ;CTL1?
SETZM MSTSW1 ;YES
CAIN C,"S" ;IS IT S?
JRST STPQ ;YES, STEP
CAIE C,"X" ;IS IT X?
JRST ERET ;NEITHER, LEAVE
TRNE B,1
SETOM MSTSW1
MOVE M,@BRKJSQ
PUSHJ P,XQINST ;IS IT SUBR TYPE?
JRST STP ;NO
STPX: PUSHJ P,NOSTP ;YES, EXECUTE THE INST
JRST MSTEP1 ;LOOP
STPQQ: INCHRS ;IS THERE A CHR?
JRST STP ;NO
JRST ERET ; AND LEAVE
>;UESW!FILESW
BEND
;Some Random Variables
IFE DMOVSW,<
^PATCH: BLOCK 20
>
SAVB: 0
SAVC: 0
VALUE: 0
SYM: 0
FNM: 0
NM: 0
SYMP: 0
BLKLV: 0
SIXSYM: 0
IFN REALSW, <INTERN $RPTCNT
$RPTCNT:>
^RPTCNT: 0
; Here is defined the data buffer area for displays -- shared
; by sort routine for sorted version
IQJ__MAXDLN+2
IQJ__IQJ*LINLEN
DISB: BLOCK IQJ ;ROOM FOR ALL THE DATA
^DISB__DISB
;SORTED SYMBOL TABLE FORMAT
COMMENT
Symbol Table Format
Word Description
0 -1 flags new format symbol table
1 BN relative pointer to Block Names
2 BS relative pointer to Block Structure
3 FULLV relative pointer to full word values
4 FREES relative pointer to free space
5 CLASS1 relative pointer to first class 1 symbol
6 CLASS2 relative pointer to first class 2 symbol
7 CLASS3 relative pointer to first class 3 symbol
10 CLASS4 relative pointer to first class 4 symbol
11 LASTV relative pointer to first word beyond
the symbol table
BN table of RADIX50 block and program names
BS table of block and program structure (see below)
FULLV table of full word values pointed to by class 4 symbols
FREES free space for adding symbols. initially zero
CLASS1 Pairs of words for each class 1 symbol.
First word is RADIX50 of symbol name with type flags
Second word: Byte(13)bnum(5)0(18)value
where bnum is an index to BN and BS table.
Class 1 symbols have values in the range 0 to 377777.
CLASS2 Same as CLASS1 space, except class2 symbols have
values in the range of 400000 to 777777.
CLASS3 Same as CLASS1 space, except class3 symbols have
non-zero values with zero right halves. The left
half of the value is stored in the right half of
the value word of the symbol entry.
CLASS4 Pairs of words for each class 4 symbol.
First word is RADIX50 of symbol name with type flags
Second word: Byte(13)bnum(5)14(18)vp.
Bnum is an index to BN and BS table.
Vp is a pointer, relative to beginning of symbol table,
to a word in the FULLV table that contains the value.
Note that the index field is set to 14, so that if 14
contains the address of the symbol table, you may
indirect through this word.
Class 4 values are all values not contained in the
other classes.
Values are sorted by arithmetic order in each class. Class 3 values
are considered as right-half quantities while being sorted.
Block Structure space:
All pointers in BS space are relative to BS space (and may be used
to index BN space). BN (block name) space comes before BS space
in the symbol table.
Words corresponding to program names have left-half links to the next
program name. Zero terminates this list. Right-halves are zero.
Word zero of BS space always corresponds to a program name.
Words corresponding to block names have left-half links to the BS
space word corresponding to the program containing this block. The
right-half links to the block immediately containing this block. The
outermost block's right-half link points to the program name word.
All blocks that are associated with a particular program are entered
immediately following that program name, and before the next program
name.
;SORT
IFN SORTED,<
^UNSHARE__.
RELOC DISB ;SHARE DISPLAY BUFFER AREA
BEGIN SORT
IFN TENEX,<
UPR__400000
SYMTP__765000
>
^SORT:
IFN DEBSYM,<
SKIPN JOBSYM
JRST MKSYTB
>
;PASS 1 - LOOK THRU THE OLD SYMBOL TABLE AND COUNT VARIOUS THINGS.
SETZM CLASST ;ZERO CLASS COUNTERS
MOVE A,[CLASST,,CLASST+1]
BLT A,CLASST+5
HLRE V,JOBSYM ;-N
MOVN V,V ;N
SUBI V,2
HRL V,V ;N-2,,N-2
HRRZ PV,JOBSYM ;ADDR
ADD PV,V ;N-2,,ADDR+N-2
MOVEM PV,OPTR ;SAVE POINTER
SYMLP1: SKIPN V,(PV) ;GET RADIX50
JRST SYLP1Z ;NOTHING THERE
MOVE A,1(PV) ;A_VALUE, V_RADIX50
MOVEI B,0 ;ASSUME "CLASS 0" = BLOCK/PROGRAM NAME
LDB T,[POINT 4,V,3] ;GET SYMBOL TYPE
JUMPE T,SYLP1A ;0 IS PROGRAM NAME
CAIN T,3
JRST SYLP1A ;14 IS BLOCK NAME
CAIE T,1 ;4 IS NON-DELETED, NON-HALF-KILLED INTERNAL
JRST NODOTS
LDB D1,[POINT 32,V,35] ;GET SYMBOL WITHOUT TYPE BITS
IDIVI D1,50*50 ;FLUSH LAST TWO CHARACTERS
CAME D1,[<RADIX50 0,....XX>/<50*50>]
JRST NODOTS
SETZM (PV) ;THIS IS A BOGUS SYMBOL DEFINED IN RAID FOR
SETZM 1(PV) ;JUST THIS PURPOSE OF PROVIDING SPACE
JRST SYLP1Z
NODOTS: PUSHJ P,CLASS ;B_CLASS TYPE (1,2,3 OR 4)
SYLP1A: AOSA CLASST(B) ;COUNT EACH SYMBOL CLASS
SYLP1Z: AOS CLASST+5 ;COUNT ANOTHER FREE
SUB PV,[2,,2]
JUMPG PV,SYMLP1
;;FALL OFF PAGE
;NOW, HOW BIG IS SYMBOL TABLE GOING TO BE?
IFE TENEX,<
IFE FILESW,<
MOVE V,CLASST+5
ADDM V,CLASST+5 ;NUMBER OF FREE WORDS
MOVE B,CLASST+4 ;NUMBER OF EXTRA WORDS FOR CLASS 4 SYMBOLS
ADDI B,12 ;PLUS OVERHEAD WORDS
CAMLE B,CLASST+5 ;SKIP IF THERE IS ROOM FOR IT ALL
JRST TOOMAN
MOVN B,B
ADDM B,CLASST+5 ;LEAVE COUNT OF FREE CELLS
TOOMA3:
>;NOT FILESW
IFN FILESW,<
MOVEI B,20
MOVEM B,CLASST+5
MOVE B,CLASST
ADD B,CLASST+1
ADD B,CLASST+2
ADD B,CLASST+3
ADD B,CLASST+4
ASH B,1
ADD B,CLASST+4
ADD B,CLASST+5
ADDI B,12 ;NUMBER OF WORDS OF SYMBOL TABLE
HRRZ C,JOBSYM
ADDI C,-1(B)
CORE C,
JRST 4,.
MOVN D1,B
HRLM D1,JOBSYM
>;FILESW
MOVE A,JOBREL
MOVEM A,SAVJRL
IFE FILESW,<
HLL A,JOBSYM ;-WC,,MA-1 OF NEW SYMBOL TABLE
>
IFN FILESW,<
MOVN B,B
HRL A,B ;-WC,,MA-1 OF NEW SYMBOL TABLE
>
ADDI A,1
MOVEM A,NPTR ;SAVE AOBJN POINTER TO NEW SYMBOL TABLE
HRRZM A,NBASE ;SET BASE OF NEW SYMBOL TABLE
HLRZ B,OPTR ;OLD WC-2
ADDI A,1(B) ;LAST ADDRESS NEEDED
MOVE C,A ;SAVE THIS (IS LAST ADDRESS FOR BLT)
HRRZ A,A ;SOME SYSTEMS CARE
CORE A, ;GET SOME CORE
JRST 4,.
>;NOT TENEX
IFN TENEX,<.FATAL FIGURE OUT WHAT TO DO HERE>
MOVE PNT,NBASE
SETZM (PNT)
HRL PNT,PNT ;NBASE,,NBASE
ADDI PNT,1 ;SOURCE,,DEST FOR BLT
BLT PNT,(C) ;ZERO NEW CORE SPACE FOR SYMBOL TABLE
MOVE PNT,NBASE ;GET BASE ADDRESS AGAIN
HRROS (PNT) ;-1,, FLAGS THE NEW FORMAT SYMBOLS
MOVEI C,12 ;POINTER TO BN
MOVEM C,1(PNT) ;BN POINTER
ADD C,CLASST ;PLUS NUMBER OF BN'S
MOVEM C,2(PNT) ;GIVES POINTER TO BS'S
ADD C,CLASST ;PLUS NUMBER OF BS'S (= NUMBER OF BN'S)
MOVEM C,3(PNT) ;GIVES POINTER TO FV'S
ADD C,CLASST+4 ;PLUS NUMBER OF FV'S
MOVEM C,4(PNT) ;GIVES POINTER TO FF
ADD C,CLASST+5 ;PLUS AMOUNT OF FREE SPACE
MOVEM C,5(PNT) ;GIVES POINTER TO CLASS1
ADD C,CLASST+1
ADD C,CLASST+1 ;PLUS 2*CLASS1 SPACES
MOVEM C,6(PNT) ;POINTER TO CLASS2 SPACE
ADD C,CLASST+2
ADD C,CLASST+2
MOVEM C,7(PNT) ;POINTER TO CLASS3 SPACE
ADD C,CLASST+3
ADD C,CLASST+3
MOVEM C,10(PNT) ;POINTER TO CLASS4 SPACE
ADD C,CLASST+4
ADD C,CLASST+4
MOVEM C,11(PNT) ;POINTER TO THE END OF THE AREA
;PASS 2 - COPY SYMBOL NAMES TO NEW SYMBOL TABLE. BUILD BN/BS AREAS
;PNT STILL CONTAINS NBASE
SETZM CLASST ;ZERO CLASS COUNTERS
MOVE B,[CLASST,,CLASST+1]
BLT B,CLASST+5
SETOM SVSTK
SETOM ID
SETZM PD
MOVE PV,OPTR ;GET POINTER TO OLD TABLE
SYMLP2: SKIPN V,(PV) ;GET RADIX50
JRST SYLP2Z ;NOTHING THERE.
MOVE A,1(PV) ;A_VALUE; V_RADIX50
LDB T,[POINT 4,V,3] ;GET SYMBOL TYPE
JUMPE T,SYLP2B ;0 IS PROGRAM NAME
CAIN T,3
JRST SYLP2C ;14 IS BLOCK NAME
PUSHJ P,CLASS ;B_CLASS TYPE (1,2,3 OR 4)
AOS C,CLASST(B) ;COUNT CLASS TYPE
CAIN B,3 ;CLASS 3 SYMBOL?
MOVSS 1(PV) ;YES. SWAP HALVES TO MAKE THE SORT WORK RIGHT
LSH C,1 ;DOUBLE COUNT TO MAKE INDEX
ADDI B,4(PNT) ;GET ADDRESS OF BASE OF CLASS
ADD C,(B) ;RELATIVE ADDRESS IN NEW SYMBOL TABLE+2
ADDI C,(PNT) ;ABSOLUTE ADDRESS+2
MOVEM V,-2(C) ;STORE RADIX50 OF SYMBOL
HRLZ M,ID ;GET BLOCK ID
LSH M,5 ;MOVE IT OVER TO MAKE ROOM FOR INDEX/INDIRECT
HRRI M,1(PV) ;POINTER TO THE VALUE CELL
MOVEM M,-1(C) ;STUFF IN NEW SYMBOL TABLE
JRST SYLP2Z ;LOOP
SYLP2B: MOVE D3,PD ;HERE IF SYMBOL IS PROGRAM NAME
MOVEI A,0 ;ARGUMENT TO SYLPOP
CAMGE D3,ID ;IF PD .LT. ID THERE WERE NESTED BLOCKS
PUSHJ P,SYLPOP ;POP NESTED BLOCKS BELONGING TO PREVIOUS PD
AOS D3,ID ;COUNT NEW PROGRAM ID
MOVE D1,1(PNT) ;GET BASE OF BN AREA
ADDI D1,(PNT)
ADDI D1,(D3) ;PLUS CURRENT INDEX
MOVEM V,(D1) ;STORE CURRENT PROGRAM NAME IN BN SPACE
MOVE E,PD ;GET PD OF PREVIOUS PROGRAM
MOVEM D3,PD ;STORE NEW PD
MOVE D1,2(PNT) ;GET POINTER TO BS SPACE
ADDI D1,(PNT)
ADDI D1,(E)
HRLZM D3,(D1) ;LH POINTER TO CURRENT ID IN PREVIOUS PROG'S WORD
JRST SYLP2Z ;GET NEXT
SYLP2C: AOS D3,ID ;COUNT NEW BLOCK
MOVE D1,1(PNT) ;GET BASE OF BN AREA
ADDI D1,(PNT)
ADDI D1,(D3) ;PLUS CURRENT INDEX
MOVEM V,(D1) ;STORE CURRENT BLOCK NAME IN BN SPACE
PUSHJ P,SYLPOP ;A HAS BLOCK LEVEL.
SYLP2Z: SUB PV,[2,,2]
JUMPG PV,SYMLP2
MOVE D3,PD
MOVE D1,2(PNT) ;GET BASE OF BS AREA
ADDI D1,(PNT)
ADDI D1,(D3) ;PLUS CURRENT INDEX
SETZB A,(D1) ;FINISH BS LINKAGE FOR LAST PROGRAM
CAMGE D3,ID
PUSHJ P,SYLPOP ;FINISH DANGLING BLOCK STRUCTURE
;;FALL OFF PAGE
;WE SORT THINGS HERE
MOVE B,5(PNT) ;FIRST ADDRESS FOR CLASS1
MOVE C,6(PNT) ;FIRST ADDRESS BEYOND CLASS1
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,-2(PNT) ;MAKE ADDRESS WITHIN CLASS
CAILE C,(B) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE B,6(PNT) ;FIRST ADDRESS FOR CLASS2
MOVE C,7(PNT) ;FIRST ADDRESS BEYOND CLASS2
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,-2(PNT) ;MAKE ADDRESS WITHIN CLASS
CAILE C,(B) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE B,7(PNT) ;FIRST ADDRESS FOR CLASS3
MOVE C,10(PNT) ;FIRST ADDRESS BEYOND CLASS3
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,-2(PNT) ;MAKE ADDRESS WITHIN CLASS
CAILE C,(B) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
MOVE B,10(PNT) ;FIRST ADDRESS FOR CLASS4
MOVE C,11(PNT) ;FIRST ADDRESS BEYOND CLASS4
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,-2(PNT) ;MAKE ADDRESS WITHIN CLASS
CAILE C,(B) ;DON'T SORT EMPTY RANGE OR ONLY ONE ELEMENT
PUSHJ P,SSORT ;SORT RANGE
;COPY SYMBOL VALUES TO NEW TABLE
MOVE B,5(PNT) ;FIRST CLASS1 VALUE
MOVE C,10(PNT) ;FIRST BEYOND CLASS3
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,(PNT)
SYMLP3: CAIL B,(C) ;AT THE END YET?
JRST SYML3A ;YES.
MOVE D1,@1(B) ;GET VALUE
HRRM D1,1(B) ;REPLACE POINTER WITH VALUE
ADDI B,2
JRST SYMLP3
SYML3A: MOVE B,10(PNT) ;FIRST CLASS4 VALUE
MOVE C,11(PNT) ;FIRST BEYOND CLASS4
MOVE D1,3(PNT) ;ADDRESS OF FULL WORD SPACE
ADDI B,(PNT) ;MAKE ADDRESSES ABSOLUTE
ADDI C,(PNT)
ADDI D1,(PNT)
MOVE D2,3(PNT) ;RELATIVE ADDRESS OF FULL WORD SPACE
HRLI D2,14 ;SET INDEX FIELD
SYML3B: CAIL B,(C) ;AT THE END YET?
JRST SYMXIT ;YES, ALL DONE
MOVE D3,@1(B) ;GET VALUE
MOVEM D3,(D1) ;STORE IN FULL WORD SPACE
DPB D2,[POINT 23,1(B),35] ;STORE RELATIVE POINTER TO SYMBOL. AND INDEX
ADDI B,2 ;ADVANCE TO NEXT SYMBOL
ADDI D1,1 ;ADVANCE ABSOLUTE POINTER TO FULL WD SPACE
AOJA D2,SYML3B ;ADVANCE RELATIVE POINTER TO FULL WD SPACE
SYMXIT: HRRZ A,JOBSYM
HRL A,NPTR
HLRE B,NPTR ;AMOUNT TO BLT
MOVN B,B
ADDI B,-1(A)
BLT A,(B)
IFE TENEX,<
MOVE A,SAVJRL
CORE A,
JFCL
>
IFN TENEX,<.FATAL HERE TOO>
POPJ P,
;CALL WITH B=FIRST ADDRESS IN RANGE, C=ADDRESS OF LAST ITEM IN RANGE
;THIS IS QUICKSORT WITHOUT STRAIGHT INSERTION SORT FOR SMALL SUBFILES.
SSORT: MOVEI D1,(B) ;LEFT POINTER
MOVEI D2,(C) ;RIGHT POINTER
MOVE D3,@1(D1) ;"KEY LEFT" ELEMENT
MRST1: CAML D3,@1(D2) ;IF "KEY LEFT" .GT. "KEY RIGHT"
JRST MRST2 ;NEED TO EXCHANGE (OR MAYBE STOP?)
SUBI D2,2 ;MOVE RIGHT SIDE TOWARD CENTER
JRST MRST1 ;LOOP
MRST2: CAIN D1,(D2) ;REACHED THE MIDDLE YET?
JRST MRST4 ;YES. NOW TIME TO SORT THE SUBFILES.
MOVE E,(D1) ;EXCHANGE
EXCH E,(D2)
MOVEM E,(D1)
MOVE E,1(D1)
EXCH E,1(D2)
MOVEM E,1(D1)
MRST3: ADDI D1,2 ;MOVE LEFT END TOWARD CENTER
CAMLE D3,@1(D1)
JRST MRST3 ;"KEY RIGHT" .GT. "KEY LEFT"
CAIN D1,(D2) ;REACHED THE MIDDLE YET?
JRST MRST4 ;YES. NOW TIME TO SORT THE SUBFILES.
MOVE E,(D1) ;EXCHANGE
EXCH E,(D2)
MOVEM E,(D1)
MOVE E,1(D1)
EXCH E,1(D2)
MOVEM E,1(D1)
SUBI D2,2 ;MOVE RIGHT SIDE TOWARD CENTER
JRST MRST1 ;LOOP
MRST4: MOVEI D3,(C)
SUBI D3,(B)
JUMPE D3,CPOPJ ;IF B=C, THE ONE ELEMENT FILE IS SORTED
LSH D3,-1 ;D3=1/2 SIZE OF ORIGINAL FILE.
MOVEI E,(C)
SUBI E,(D2) ;E=SIZE OF RIGHT SUBFILE
CAILE D3,(E) ;IF E .GT. D3 THEN SORT LEFT SUBFILE FIRST
JRST MRST5 ;D3 .GT. E SORT RIGHT SUBFILE FIRST
MOVSI D3,2(D1)
HRRI D3,(C) ;LEFT EDGE,,RIGHT EDGE OF RIGHTSUBFILE
MOVEI C,(D1) ;SET RIGHT EDGE OF SMALL SUBFILE
JRST MRST6
MRST5: MOVSI D3,(B)
HRRI D3,-2(D1)
MOVEI B,(D1)
MRST6: PUSH P,D3 ;STUFF ON STACK.
PUSHJ P,SSORT ;!
POP P,D3
MOVEI C,(D3)
HLRZ B,D3
JRST SSORT
;SYLPOP, CLASS
SYLPOP: HRL D3,PD ;PD COPIED TO LH OF ARGUMENT
SKIPGE E,SVSTK ;GET "STACK TOP"
JRST SYLPSH ;STACK IS EMPTY. TIME TO PUSH
SYLPP1: ADD E,2(PNT) ;GET STACK ADDRESS
ADDI E,(PNT)
HRRZ D2,(E)
CAMG D2,A ;IS STACK LEVEL GREATER THAN BLOCK LEVEL?
JRST SYLPSH ;NO. WE CAN PUSH NEW ENTRY
HLRE D2,(E) ;GET NEW STACK TOP TO 10
MOVEM D2,SVSTK ;SAVE NEW STACK TOP
MOVEM D3,(E) ;STORE NEW STUFF IN STACK
SKIPL E,D2
JRST SYLPP1 ;LOOP UNTIL NO STACK OR WE FIND THE PLACE
JUMPLE A,CPOPJ ;STACK EMPTIED. ONLY PUSH ITEM IF REAL
SYLPSH: HRL A,SVSTK ;OLD STACK POINTER,,BLOCK LEVEL
HRRZM D3,SVSTK ;STORE NEW TOP OF STACK
ADD D3,2(PNT)
ADDI D3,(PNT)
MOVEM A,(D3) ;STUFF DATA ON TOP OF STACK.
POPJ P,
;CALL WITH VALUE IN A, RETURNS CLASS NUMBER IN B
CLASS: MOVEI B,2
TDNN A,[-1,,400000]
SOJA B,CPOPJ
TLNN A,-1
POPJ P,
TRNE A,-1
ADDI B,1
AOJA B,CPOPJ
IFE FILESW,<
TOOMAN:
IFE TENEX,<
OUTSTR LOSMES
>
IFN TENEX,<
HRROI A,LOSMES
PSOUT
>
SUB B,CLASST+5 ;NUMBER OF FREE WORDS NEEDED
MOVNM B,CLASST+5
MOVE PV,OPTR
TOOMA1: SKIPN (PV)
JRST TOOMA2 ;NO VALUE THERE
MOVE A,1(PV) ;GET VALUE
PUSHJ P,CLASS ;GET ITS CLASS
CAIE B,4
JRST TOOMA2 ;NOT CLASS 4
SETZM (PV)
SETZM 1(PV)
SOS CLASST+3 ;ONE LESS CLASS 4
AOS CLASST+5 ;ANOTHER FREE
AOSL CLASST+5
JRST TOOMA3 ;GOT ENOUGH
TOOMA2: SUB PV,[2,,2]
JUMPG PV,TOOMA1
JRST TOOMA3
LOSMES: ASCIZ /
NOT ENOUGH ROOM FOR OVERHEAD WORDS AND FULLWORD VALUES,
DELETING ENOUGH CLASS 4 VALUES TO WIN.
/
>;NOT FILESW
NBASE: 0
OPTR: 0
NPTR: 0 ;POINTER TO NEW SYMBOLS
CLASST: BLOCK 6 ;PROG/BLOCK, CLASS 1 THRU CLASS 4, FREE
PD: 0
ID: 0
SVSTK: 0
SAVJRL: 0 ;SAVED JOBREL AT SORT
BEND SORT
IFN PADSYM,<
; Add 64 symbols with names ....xx and garbage values, to pad
; symbol table
FOR @' I_0,7,1,<
INTERNAL .....'I
.....'I_I
>
FOR @' I_10,77,1,<
INTERNAL ....'I
....'I_I
>
>;PADSYM
ENDSHARE__.
RELOC
IFL UNSHARE-ENDSHARE,<.FATAL SORTING CODE TOO BIG TO FIT IN DISPLAY BUFFER>
>;SORTED
XLIST
VAR
LIT
ENDDT:
IFN REALSW,<
DDTEND: END IFN FILESW,<RAID>
>
IFE REALSW,<END RAID>